diff options
Diffstat (limited to 'eval.lua')
| -rw-r--r-- | eval.lua | 88 |
1 files changed, 53 insertions, 35 deletions
| 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) |