diff options
| -rw-r--r-- | core.lua | 102 | ||||
| -rw-r--r-- | util.lua | 28 |
2 files changed, 82 insertions, 48 deletions
| diff --git a/core.lua b/core.lua index e8ad42b..dec4a39 100644 --- a/core.lua +++ b/core.lua | |||
| @@ -4,6 +4,7 @@ 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 | 8 | ||
| 8 | local function fold (kons, knil, r) | 9 | local function fold (kons, knil, r) |
| 9 | if r == null then | 10 | if r == null then |
| @@ -17,58 +18,71 @@ end | |||
| 17 | 18 | ||
| 18 | m.env = { -- all functions here take R, which is the list of arguments | 19 | m.env = { -- all functions here take R, which is the list of arguments |
| 19 | ------- numbers | 20 | ------- numbers |
| 20 | ["number?"] = function (r) return isa(r[1], "number") end, | 21 | ["number?"] = proc(1, function (r) return isa(r[1], "number") end), |
| 21 | ["="] = | 22 | ["="] = |
| 22 | function (r) | 23 | proc({0}, function (r) |
| 23 | local function go (a, b) | 24 | if r[1] == nil then return true end |
| 24 | if a ~= b then return false, 1 end | 25 | if r[2] == nil then return true end |
| 25 | return b | 26 | while r[2] ~= null do |
| 26 | end | 27 | if r[1] ~= r[2][1] then return false end |
| 27 | return fold(go, r[1], r[2]) and true | 28 | r = r[2] |
| 28 | end, | 29 | end |
| 30 | return true | ||
| 31 | end), | ||
| 29 | ["<"] = | 32 | ["<"] = |
| 30 | function (r) | 33 | proc({0}, function (r) |
| 31 | local function go (a, b) | 34 | if r[1] == nil then return true end |
| 32 | if a >= b then return false, 1 end | 35 | if r[2] == nil then return true end |
| 33 | return b | 36 | while r[2] ~= null do |
| 34 | end | 37 | if r[1] >= r[2][1] then return false end |
| 35 | return fold(go, r[1], r[2]) and true | 38 | r = r[2] |
| 36 | end, | 39 | end |
| 40 | return true | ||
| 41 | end), | ||
| 37 | [">"] = | 42 | [">"] = |
| 38 | function (r) | 43 | proc({0}, function (r) |
| 39 | local function go (a, b) | 44 | if r[1] == nil then return true end |
| 40 | if a <= b then return false, 1 end | 45 | if r[2] == nil then return true end |
| 41 | return b | 46 | while r[2] ~= null do |
| 42 | end | 47 | if r[1] <= r[2][1] then return false end |
| 43 | return fold(go, r[1], r[2]) and true | 48 | r = r[2] |
| 44 | end, | 49 | end |
| 45 | ["<="] = function (r) return not m.env[">"](r) end, | 50 | return true |
| 46 | [">="] = function (r) return not m.env["<"](r) end, | 51 | end), |
| 52 | ["<="] = proc({0}, function (r) return not m.env[">"](r) end), | ||
| 53 | [">="] = proc({0}, function (r) return not m.env["<"](r) end), | ||
| 47 | ------- math | 54 | ------- math |
| 48 | ["+"] = | 55 | ["+"] = |
| 49 | function (r) | 56 | proc({0}, function (r) |
| 50 | return fold(function (a, b) return a + b end, 0, r) | 57 | return fold(function (a, b) |
| 51 | end, | 58 | return a + b |
| 59 | end, 0, r) | ||
| 60 | end), | ||
| 52 | ["-"] = | 61 | ["-"] = |
| 53 | function (r) | 62 | proc({0}, function (r) |
| 54 | if r == null then return -1 end | 63 | if r == null then return -1 end |
| 55 | if r[2] == null then return (- r[1]) end | 64 | if r[2] == null then return (- r[1]) end |
| 56 | return fold(function (a, b) return a-b end, r[1], r[2]) | 65 | return fold(function (a, b) |
| 57 | end, | 66 | return a - b |
| 67 | end, r[1], r[2]) | ||
| 68 | end), | ||
| 58 | ["*"] = | 69 | ["*"] = |
| 59 | function (r) | 70 | proc({0}, function (r) |
| 60 | local function go (a, b) | 71 | local function go (a, b) |
| 61 | if a == 0 or b == 0 then return 0, 1 end | 72 | if a == 0 or b == 0 then |
| 62 | return a * b | 73 | return 0, 1 |
| 63 | end | 74 | end |
| 64 | return fold(go, 1, r) | 75 | return a * b |
| 65 | end, | 76 | end |
| 77 | return fold(go, 1, r) | ||
| 78 | end), | ||
| 66 | ["/"] = | 79 | ["/"] = |
| 67 | function (r) | 80 | proc({1}, function (r) |
| 68 | if r == null then error("Wrong arity") end | 81 | if r[2] == null then return (1 / r[1]) end |
| 69 | if r[2] == null then return (1 / r[1]) end | 82 | return fold(function (a, b) |
| 70 | return fold(function (a, b) return a/b end, r[1], r[2]) | 83 | return a / b |
| 71 | end, | 84 | end, r[1], r[2]) |
| 85 | end), | ||
| 72 | } | 86 | } |
| 73 | 87 | ||
| 74 | -------- | 88 | -------- |
| diff --git a/util.lua b/util.lua index b5a57b1..d151858 100644 --- a/util.lua +++ b/util.lua | |||
| @@ -7,10 +7,30 @@ 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.arity (r, min, max) | 10 | function m.proc (arity, fn) |
| 11 | --[[ Return whether R is within MIN and MAX (inclusive). ]] | 11 | --[[ Wrap RN in a check that for its ARITY. |
| 12 | local len = #r | 12 | ARITY can be a number, the minimum number of arguments, |
| 13 | return len >= min and len <= max | 13 | or a table {MIN, MAX}. If MIN is nil or absent, it's 0; |
| 14 | if MAX is nil or absent, it's infinity. MIN and MAX are | ||
| 15 | both inclusive. | ||
| 16 | ]] | ||
| 17 | local rmin, rmax, rstr | ||
| 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 | ||
| 14 | end | 34 | end |
| 15 | 35 | ||
| 16 | --- | 36 | --- |