about summary refs log tree commit diff stats
diff options
context:
space:
mode:
-rw-r--r--core.lua102
-rw-r--r--util.lua28
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 = {}
4local type = require "type" 4local type = require "type"
5local isa, null = type.isa, type.null 5local isa, null = type.isa, type.null
6local math = math 6local math = math
7local proc = require("util").proc
7 8
8local function fold (kons, knil, r) 9local function fold (kons, knil, r)
9 if r == null then 10 if r == null then
@@ -17,58 +18,71 @@ end
17 18
18m.env = { -- all functions here take R, which is the list of arguments 19m.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)
8end 8end
9 9
10function m.arity (r, min, max) 10function 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
14end 34end
15 35
16--- 36---