Change arity assertion code

1 files changed, 53 insertions, 35 deletions

@@ -20,7 +20,7 @@ function m.environ (inner, outer)
         return setmetatable(inner, mt)
 end
 
-local function call_proc (proc, r)
+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
@@ -50,57 +50,75 @@ function m.procedure (params, body, env)
         }
         local mt = {
                 __type = "procedure",
-                __call = call_proc,
+                __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]
+                                end
+                        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) return r[1] end,
-        quasiquote =
+        quote =
                 function (r, e)
-                        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]
-                                                end
-                                        end
-                                else
-                                        table.insert(QQ, car)
-                                end
-                                car, cdr = cdr[1], cdr[2]
-                        end
-                        return type.list(QQ, fin)
+                        assert_arity(r, 1, 1)
+                        return r[1]
                 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
-        define = function (r, e) rawset(e, r[1], m.eval(r[2][1], e)) end,
-        ["set!"] = function (r, e) e[r[1]] = m.eval(r[2][1], e) end,
+        define =
+                function (r, e)
+                        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)
+                        e[r[1]] = m.eval(r[2][1], e)
+                end,
         -- y'know, ... lambda
-        lambda = function (r, e) return m.procedure(r[1], r[2], e) end,
+        lambda =
+                function (r, e)
+                        assert_arity(r, 2)
+                        return m.procedure(r[1], r[2], e)
+                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]
                         if m.eval(test)