-- SPDX-FileCopyrightText: Chris Pressey, the original author of this work, has dedicated it to the public domain.
-- For more information, please refer to <https://unlicense.org/>
-- SPDX-License-Identifier: Unlicense
math = require "math"
require "decoy.model"
local Module = require "decoy.module"
local make_stdenv = function()
local env = {}
local equal_p
equal_p = function(a, b)
if type(a) == "function" or type(b) == "function" then
return False
elseif a == Nil and b == Nil then
return True
elseif String.is_class_of(a) and String.is_class_of(b) then
return Boolean.new(a:text() == b:text())
elseif Symbol.is_class_of(a) and Symbol.is_class_of(b) then
return Boolean.new(a:text() == b:text())
elseif Number.is_class_of(a) and Number.is_class_of(b) then
return Boolean.new(a:value() == b:value())
elseif Boolean.is_class_of(a) and Boolean.is_class_of(b) then
return Boolean.new(a:value() == b:value())
elseif Cons.is_class_of(a) and Cons.is_class_of(b) then
return equal_p(a:head(), b:head()) and equal_p(a:tail(), b:tail())
else
return False
end
end
env["equal?"] = function(args)
return equal_p(args[1], args[2])
end
env["+"] = function(args)
return Number.new(args[1]:value() + args[2]:value())
end
env["*"] = function(args)
return Number.new(args[1]:value() * args[2]:value())
end
env["-"] = function(args)
return Number.new(args[1]:value() - args[2]:value())
end
env["/"] = function(args)
return Number.new(args[1]:value() / args[2]:value())
end
env["-"] = function(args)
return Number.new(args[1]:value() - args[2]:value())
end
env[">"] = function(args)
return Boolean.new(args[1]:value() > args[2]:value())
end
env[">="] = function(args)
return Boolean.new(args[1]:value() >= args[2]:value())
end
env["<"] = function(args)
return Boolean.new(args[1]:value() < args[2]:value())
end
env["<="] = function(args)
return Boolean.new(args[1]:value() <= args[2]:value())
end
env["and"] = function(args)
-- FIXME: not actually short circuiting
local i, expr
for i, expr in ipairs(args) do
if not expr:value() then
return False
end
end
return True
end
env["or"] = function(args)
-- FIXME: not actually short circuiting
local i, expr
for i, expr in ipairs(args) do
if expr:value() then
return True
end
end
return False
end
env["not"] = function(args)
return Boolean.new(not args[1]:value())
end
env["error"] = function(args)
-- In Chicken by default. Not in R5RS Scheme. Should be in a different module!
error(args[1])
end
env["string-ref"] = function(args)
-- Note, returns a string instead of a char, because no chars here.
local s = args[1].text()
local n = args[2]:value() + 1
return String.new(string.sub(s, n, n))
end
env["sin"] = function(args)
return Number.new(math.sin(args[1]:value()))
end
env["cos"] = function(args)
return Number.new(math.cos(args[1]:value()))
end
env["abs"] = function(args)
return Number.new(math.abs(args[1]:value()))
end
env["ceiling"] = function(args)
return Number.new(math.ceil(args[1]:value()))
end
env["floor"] = function(args)
return Number.new(math.floor(args[1]:value()))
end
local m = Module.new()
-- FIXME this is horrible
m.symbols = env
return m
end
return make_stdenv