git @ Cat's Eye Technologies Decoy / master lib / lua / stdenv.lua
master

Tree @master (Download .tar.gz)

stdenv.lua @masterraw · history · blame

-- 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