Reorganization

1 files changed, 59 insertions, 112 deletions

@@ -1,150 +1,97 @@
 --- lam.eval
 
 local m = {}
-local type = require "type"
-local assert_arity = require("util").assert_arity
+local type = require("type")
+local assert_arity = type.assert_arity
+local util = require("util")
+local error = util.error
 
-function m.environ (inner, outer)
-        local mt = {
-                __type = "environment",
-                __index = outer,
-                __newindex =
-                        function (self, key, val)
-                                if rawget(self, key) then
-                                        rawset(self, key, val)
+m.special_forms = {
+        quote =
+                function (r, _)
+                        assert_arity(r,1,1)
+                        return r[1]
+                end,
+        quasiquote =
+                function (r, e)
+                        assert_arity(r,1,1)
+                        local x = r[1]
+                        if not type.listp(x) or type.nullp(x) then
+                                return x
+                        end
+                        local QQ, fin = {}, nil
+                        while x[2] do
+                                if type.listp(x[1]) then
+                                        if x[1][1] == "unquote" then
+                                                table.insert(QQ,
+                                                        m.eval(x[1][2][1], e))
+                                        elseif x[1][1] == "unquote-splicing"
+                                        then
+                                                local y = m.eval(x[1][2][1], e)
+                                                if not type.listp(y) then
+                                                        fin = y
+                                                        break
+                                                end
+                                                while y[2] do
+                                                        table.insert(QQ, y[1])
+                                                        y = y[2]
+                                                end
+                                        end
                                 else
-                                        getmetatable(self).__index[key] = val
-                                end
-                        end,
-        }
-        return setmetatable(inner, mt)
-end
-
-local function procedure_call (proc, r)
-        local function doargs (p, r, e)
-                if p == type.null and r == type.null then return e end
-                if type.isa(p, "symbol") then
-                        e[p] = r
-                        return e
-                end
-                if p[1] == nil then error("Too many arguments") end
-                if r[1] == nil then error("Too few arguments") end
-                e[p[1]] = r[1]
-                doargs(p[2], r[2], e)
-        end
-
-        local e = doargs(proc.params, r, m.environ({}, proc.env))
-        local b = proc.body
-        while b[2] ~= type.null do
-                m.eval(b[1], e)
-                b = b[2]
-        end
-        return m.eval(b[1], e)
-end
-
-function m.procedure (params, body, env)
-        local t = {
-                params = params,
-                body = body,
-                env = env,
-        }
-        local mt = {
-                __type = "procedure",
-                __call = procedure_call,
-        }
-        return setmetatable(t, mt)
-end
-
-local function handle_quasiquote (r, e)
-        assert_arity(r, 1, 1)
-        local x = r[1]
-        if not type.islist(x) or x == type.null then
-                return x
-        end
-        local QQ, fin = {}, nil
-        local car, cdr = x[1], x[2]
-        while cdr do
-                if type.islist(car) then
-                        if car[1] == "unquote" then
-                                table.insert(QQ, m.eval(car[2][1], e))
-                        elseif car[1] == "unquote-splicing" then
-                                local usl = m.eval(car[2][1], e)
-                                if not type.islist(usl) then
-                                        fin = usl
-                                        break
-                                end
-                                while usl[2] do
-                                        table.insert(QQ, usl[1])
-                                        usl = usl[2]
+                                        table.insert(QQ, x[1])
                                 end
+                                x = x[2]
                         end
-                else
-                        table.insert(QQ, car)
-                end
-                car, cdr = cdr[1], cdr[2]
-        end
-        return type.list(QQ, fin)
-end
-
-m.specials = {
-        -- each of these takes R (a list of args) and E (an environment)
-        quote =
-                function (r, e)
-                        assert_arity(r, 1, 1)
-                        return r[1]
+                        return type.list(QQ, fin)
+                end,
+        unquote =
+                function (_, _)
+                        error("unexpected", ",")
                 end,
-        quasiquote = handle_quasiquote,
-        -- if not inside quasiquote, unquote and unquote-splicing are errors
-        unquote = function () error("Unexpected unquote") end,
         ["unquote-splicing"] =
-                function () error("Unexpected unquote-splicing") end,
-        -- define variables
+                function (_, _)
+                        error("unexpected", ",@")
+                end,
         define =
                 function (r, e)
-                        assert_arity(r, 2, 2)
+                        assert_arity(r,2,2)
                         rawset(e, r[1], m.eval(r[2][1], e))
                 end,
         ["set!"] =
                 function (r, e)
-                        assert_arity(r, 2, 2)
+                        assert_arity(r,2,2)
                         e[r[1]] = m.eval(r[2][1], e)
                 end,
-        -- y'know, ... lambda
         lambda =
                 function (r, e)
-                        assert_arity(r, 2)
-                        return m.procedure(r[1], r[2], e)
+                        assert_arity(r,2)
+                        return type.procedure(r[1], r[2], e, m.eval)
                 end,
-        -- control flow
         ["if"] =
                 function (r, e)
-                        assert_arity(r, 3, 3)
-                        local test, conseq, alt =
-                                r[1], r[2][1], r[2][2][1]
+                        assert_arity(r,3,3)
+                        local test, conseq, alt = r[1], r[2][1], r[2][2][1]
                         if m.eval(test, e)
                         then return m.eval(conseq, e)
                         else return m.eval(alt, e)
                         end
                 end,
-        -- TODO: include, import, define-syntax, ...
+        -- TODO: include, import, define-syntax ...
 }
--- Aliases
-m.specials.lam = m.specials.lambda
-m.specials.def = m.specials.define
 
-function m.eval (x, env) -- TODO: specify ENV on all calls
-        if type.isa(x, "symbol") then
+function m.eval (x, env)
+        if type.isp(x, "symbol") then
                 if env[x] == nil then
-                        error(string.format("Unbound variable: %s", x))
+                        error("unbound symbol", x)
                 end
                 return env[x]
-        elseif not type.islist(x) then
+        elseif not type.listp(x) then
                 return x
         else
                 local op, args = x[1], x[2]
-                if m.specials[op] then
-                        return m.specials[op](args, env)
-                else            -- procedure call
+                if m.special_forms[op] then
+                        return m.special_forms[op](args, env)
+                else -- procedure application
                         local fn = m.eval(op, env)
                         local params = {}
                         local r = args