diff options
| author | Case Duckworth | 2024-04-02 21:04:32 -0500 |
|---|---|---|
| committer | Case Duckworth | 2024-04-02 21:04:32 -0500 |
| commit | 2a5c0883ca907e97110ea0050080f74ccbb143e2 (patch) | |
| tree | 073105fcdeba619db38aa40e467dfe88973fb45c | |
| parent | Handle dotted lambda-lists and symbols (diff) | |
| download | lam-2a5c0883ca907e97110ea0050080f74ccbb143e2.tar.gz lam-2a5c0883ca907e97110ea0050080f74ccbb143e2.zip | |
Change arity assertion code
| -rw-r--r-- | core.lua | 117 | ||||
| -rw-r--r-- | eval.lua | 88 | ||||
| -rw-r--r-- | util.lua | 31 |
3 files changed, 121 insertions, 115 deletions
| diff --git a/core.lua b/core.lua index dec4a39..7891f3a 100644 --- a/core.lua +++ b/core.lua | |||
| @@ -4,7 +4,8 @@ local m = {} | |||
| 4 | local type = require "type" | 4 | local type = require "type" |
| 5 | local isa, null = type.isa, type.null | 5 | local isa, null = type.isa, type.null |
| 6 | local math = math | 6 | local math = math |
| 7 | local proc = require("util").proc | 7 | local util = require "util" |
| 8 | local assert_arity = util.assert_arity | ||
| 8 | 9 | ||
| 9 | local function fold (kons, knil, r) | 10 | local function fold (kons, knil, r) |
| 10 | if r == null then | 11 | if r == null then |
| @@ -18,71 +19,73 @@ end | |||
| 18 | 19 | ||
| 19 | m.env = { -- all functions here take R, which is the list of arguments | 20 | m.env = { -- all functions here take R, which is the list of arguments |
| 20 | ------- numbers | 21 | ------- numbers |
| 21 | ["number?"] = proc(1, function (r) return isa(r[1], "number") end), | 22 | ["number?"] = |
| 23 | function (r) | ||
| 24 | assert_arity(r, 1, 1) | ||
| 25 | return isa(r[1], "number") | ||
| 26 | end, | ||
| 22 | ["="] = | 27 | ["="] = |
| 23 | proc({0}, function (r) | 28 | function (r) |
| 24 | if r[1] == nil then return true end | 29 | if r[1] == nil then return true end |
| 25 | if r[2] == nil then return true end | 30 | if r[2] == nil then return true end |
| 26 | while r[2] ~= null do | 31 | while r[2] ~= null do |
| 27 | if r[1] ~= r[2][1] then return false end | 32 | if r[1] ~= r[2][1] then return false end |
| 28 | r = r[2] | 33 | r = r[2] |
| 29 | end | 34 | end |
| 30 | return true | 35 | return true |
| 31 | end), | 36 | end, |
| 32 | ["<"] = | 37 | ["<"] = |
| 33 | proc({0}, function (r) | 38 | function (r) |
| 34 | if r[1] == nil then return true end | 39 | if r[1] == nil then return true end |
| 35 | if r[2] == nil then return true end | 40 | if r[2] == nil then return true end |
| 36 | while r[2] ~= null do | 41 | while r[2] ~= null do |
| 37 | if r[1] >= r[2][1] then return false end | 42 | if r[1] >= r[2][1] then return false end |
| 38 | r = r[2] | 43 | r = r[2] |
| 39 | end | 44 | end |
| 40 | return true | 45 | return true |
| 41 | end), | 46 | end, |
| 42 | [">"] = | 47 | [">"] = |
| 43 | proc({0}, function (r) | 48 | function (r) |
| 44 | if r[1] == nil then return true end | 49 | if r[1] == nil then return true end |
| 45 | if r[2] == nil then return true end | 50 | if r[2] == nil then return true end |
| 46 | while r[2] ~= null do | 51 | while r[2] ~= null do |
| 47 | if r[1] <= r[2][1] then return false end | 52 | if r[1] <= r[2][1] then return false end |
| 48 | r = r[2] | 53 | r = r[2] |
| 49 | end | 54 | end |
| 50 | return true | 55 | return true |
| 51 | end), | 56 | end, |
| 52 | ["<="] = proc({0}, function (r) return not m.env[">"](r) end), | 57 | ["<="] = function (r) return not m.env[">"](r) end, |
| 53 | [">="] = proc({0}, function (r) return not m.env["<"](r) end), | 58 | [">="] = function (r) return not m.env["<"](r) end, |
| 54 | ------- math | 59 | ------- math |
| 55 | ["+"] = | 60 | ["+"] = |
| 56 | proc({0}, function (r) | 61 | function (r) |
| 57 | return fold(function (a, b) | 62 | return fold(function (a, b) return a + b end, 0, r) |
| 58 | return a + b | 63 | end, |
| 59 | end, 0, r) | ||
| 60 | end), | ||
| 61 | ["-"] = | 64 | ["-"] = |
| 62 | proc({0}, function (r) | 65 | function (r) |
| 63 | if r == null then return -1 end | 66 | if r == null then return -1 end |
| 64 | if r[2] == null then return (- r[1]) end | 67 | if r[2] == null then return (- r[1]) end |
| 65 | return fold(function (a, b) | 68 | return fold(function (a, b) |
| 66 | return a - b | 69 | return a - b |
| 67 | end, r[1], r[2]) | 70 | end, r[1], r[2]) |
| 68 | end), | 71 | end, |
| 69 | ["*"] = | 72 | ["*"] = |
| 70 | proc({0}, function (r) | 73 | function (r) |
| 71 | local function go (a, b) | 74 | local function go (a, b) |
| 72 | if a == 0 or b == 0 then | 75 | if a == 0 or b == 0 then |
| 73 | return 0, 1 | 76 | return 0, 1 |
| 74 | end | ||
| 75 | return a * b | ||
| 76 | end | 77 | end |
| 77 | return fold(go, 1, r) | 78 | return a * b |
| 78 | end), | 79 | end |
| 80 | return fold(go, 1, r) | ||
| 81 | end, | ||
| 79 | ["/"] = | 82 | ["/"] = |
| 80 | proc({1}, function (r) | 83 | function (r) |
| 81 | if r[2] == null then return (1 / r[1]) end | 84 | assert_arity(r, 1) |
| 82 | return fold(function (a, b) | 85 | if r[2] == null then return (1 / r[1]) end |
| 83 | return a / b | 86 | return fold(function (a, b) return a / b end, |
| 84 | end, r[1], r[2]) | 87 | r[1], r[2]) |
| 85 | end), | 88 | end, |
| 86 | } | 89 | } |
| 87 | 90 | ||
| 88 | -------- | 91 | -------- |
| diff --git a/eval.lua b/eval.lua index 53292d0..60369a9 100644 --- a/eval.lua +++ b/eval.lua | |||
| @@ -20,7 +20,7 @@ function m.environ (inner, outer) | |||
| 20 | return setmetatable(inner, mt) | 20 | return setmetatable(inner, mt) |
| 21 | end | 21 | end |
| 22 | 22 | ||
| 23 | local function call_proc (proc, r) | 23 | local function procedure_call (proc, r) |
| 24 | local function doargs (p, r, e) | 24 | local function doargs (p, r, e) |
| 25 | if p == type.null and r == type.null then return e end | 25 | if p == type.null and r == type.null then return e end |
| 26 | if type.isa(p, "symbol") then | 26 | if type.isa(p, "symbol") then |
| @@ -50,57 +50,75 @@ function m.procedure (params, body, env) | |||
| 50 | } | 50 | } |
| 51 | local mt = { | 51 | local mt = { |
| 52 | __type = "procedure", | 52 | __type = "procedure", |
| 53 | __call = call_proc, | 53 | __call = procedure_call, |
| 54 | } | 54 | } |
| 55 | return setmetatable(t, mt) | 55 | return setmetatable(t, mt) |
| 56 | end | 56 | end |
| 57 | 57 | ||
| 58 | local function handle_quasiquote (r, e) | ||
| 59 | assert_arity(r, 1, 1) | ||
| 60 | local x = r[1] | ||
| 61 | if not type.islist(x) or x == type.null then | ||
| 62 | return x | ||
| 63 | end | ||
| 64 | local QQ, fin = {}, nil | ||
| 65 | local car, cdr = x[1], x[2] | ||
| 66 | while cdr do | ||
| 67 | if type.islist(car) then | ||
| 68 | if car[1] == "unquote" then | ||
| 69 | table.insert(QQ, m.eval(car[2][1], e)) | ||
| 70 | elseif car[1] == "unquote-splicing" then | ||
| 71 | local usl = m.eval(car[2][1], e) | ||
| 72 | if not type.islist(usl) then | ||
| 73 | fin = usl | ||
| 74 | break | ||
| 75 | end | ||
| 76 | while usl[2] do | ||
| 77 | table.insert(QQ, usl[1]) | ||
| 78 | usl = usl[2] | ||
| 79 | end | ||
| 80 | end | ||
| 81 | else | ||
| 82 | table.insert(QQ, car) | ||
| 83 | end | ||
| 84 | car, cdr = cdr[1], cdr[2] | ||
| 85 | end | ||
| 86 | return type.list(QQ, fin) | ||
| 87 | end | ||
| 88 | |||
| 58 | m.specials = { | 89 | m.specials = { |
| 59 | -- each of these takes R (a list of args) and E (an environment) | 90 | -- each of these takes R (a list of args) and E (an environment) |
| 60 | quote = function (r, e) return r[1] end, | 91 | quote = |
| 61 | quasiquote = | ||
| 62 | function (r, e) | 92 | function (r, e) |
| 63 | local x = r[1] | 93 | assert_arity(r, 1, 1) |
| 64 | if not type.islist(x) or x == type.null then | 94 | return r[1] |
| 65 | return x | ||
| 66 | end | ||
| 67 | local QQ, fin = {}, nil | ||
| 68 | local car, cdr = x[1], x[2] | ||
| 69 | while cdr do | ||
| 70 | if type.islist(car) then | ||
| 71 | if car[1] == "unquote" then | ||
| 72 | table.insert(QQ, | ||
| 73 | m.eval(car[2][1], e)) | ||
| 74 | elseif car[1] == "unquote-splicing" then | ||
| 75 | local usl = m.eval(car[2][1], e) | ||
| 76 | if not type.islist(usl) then | ||
| 77 | fin = usl | ||
| 78 | break | ||
| 79 | end | ||
| 80 | while usl[2] do | ||
| 81 | table.insert(QQ, usl[1]) | ||
| 82 | usl = usl[2] | ||
| 83 | end | ||
| 84 | end | ||
| 85 | else | ||
| 86 | table.insert(QQ, car) | ||
| 87 | end | ||
| 88 | car, cdr = cdr[1], cdr[2] | ||
| 89 | end | ||
| 90 | return type.list(QQ, fin) | ||
| 91 | end, | 95 | end, |
| 96 | quasiquote = handle_quasiquote, | ||
| 92 | -- if not inside quasiquote, unquote and unquote-splicing are errors | 97 | -- if not inside quasiquote, unquote and unquote-splicing are errors |
| 93 | unquote = function () error("Unexpected unquote") end, | 98 | unquote = function () error("Unexpected unquote") end, |
| 94 | ["unquote-splicing"] = | 99 | ["unquote-splicing"] = |
| 95 | function () error("Unexpected unquote-splicing") end, | 100 | function () error("Unexpected unquote-splicing") end, |
| 96 | -- define variables | 101 | -- define variables |
| 97 | define = function (r, e) rawset(e, r[1], m.eval(r[2][1], e)) end, | 102 | define = |
| 98 | ["set!"] = function (r, e) e[r[1]] = m.eval(r[2][1], e) end, | 103 | function (r, e) |
| 104 | assert_arity(r, 2, 2) | ||
| 105 | rawset(e, r[1], m.eval(r[2][1], e)) | ||
| 106 | end, | ||
| 107 | ["set!"] = | ||
| 108 | function (r, e) | ||
| 109 | assert_arity(r, 2, 2) | ||
| 110 | e[r[1]] = m.eval(r[2][1], e) | ||
| 111 | end, | ||
| 99 | -- y'know, ... lambda | 112 | -- y'know, ... lambda |
| 100 | lambda = function (r, e) return m.procedure(r[1], r[2], e) end, | 113 | lambda = |
| 114 | function (r, e) | ||
| 115 | assert_arity(r, 2) | ||
| 116 | return m.procedure(r[1], r[2], e) | ||
| 117 | end, | ||
| 101 | -- control flow | 118 | -- control flow |
| 102 | ["if"] = | 119 | ["if"] = |
| 103 | function (r, e) | 120 | function (r, e) |
| 121 | assert_arity(r, 3, 3) | ||
| 104 | local test, conseq, alt = | 122 | local test, conseq, alt = |
| 105 | r[1], r[2][1], r[2][2][1] | 123 | r[1], r[2][1], r[2][2][1] |
| 106 | if m.eval(test) | 124 | if m.eval(test) |
| diff --git a/util.lua b/util.lua index d151858..8fedbf7 100644 --- a/util.lua +++ b/util.lua | |||
| @@ -7,29 +7,14 @@ function m.pop (tbl) | |||
| 7 | return table.remove(tbl, 1) | 7 | return table.remove(tbl, 1) |
| 8 | end | 8 | end |
| 9 | 9 | ||
| 10 | function m.proc (arity, fn) | 10 | function m.assert_arity (r, min, max) |
| 11 | --[[ Wrap RN in a check that for its ARITY. | 11 | local rmin = min or 0 |
| 12 | ARITY can be a number, the minimum number of arguments, | 12 | local rmax = max or 1/0 -- infinity |
| 13 | or a table {MIN, MAX}. If MIN is nil or absent, it's 0; | 13 | local rlen = #r |
| 14 | if MAX is nil or absent, it's infinity. MIN and MAX are | 14 | if rlen < rmin or rlen > rmax then |
| 15 | both inclusive. | 15 | error(string.format("Wrong arity: %s; expecting %s", |
| 16 | ]] | 16 | rlen, |
| 17 | local rmin, rmax, rstr | 17 | rmin == rmax and rmin or (rmin..".."..rmax))) |
| 18 | if type(arity) ~= "table" then | ||
| 19 | rmin, rmax = arity, arity | ||
| 20 | rstr = rmin | ||
| 21 | else | ||
| 22 | rmin, rmax = arity[1] or 0, arity[2] or 1/0 -- infinity | ||
| 23 | rstr = rmin .. ".." .. rmax | ||
| 24 | end | ||
| 25 | return function (r) | ||
| 26 | local rlen = r and #r or 0 | ||
| 27 | if rlen < rmin or rlen > rmax then | ||
| 28 | error(string.format("Wrong arity: %s, need %s", | ||
| 29 | rlen, | ||
| 30 | rstr)) | ||
| 31 | end | ||
| 32 | return fn(r) | ||
| 33 | end | 18 | end |
| 34 | end | 19 | end |
| 35 | 20 | ||