diff options
Diffstat (limited to 'core.lua')
-rw-r--r-- | core.lua | 117 |
1 files changed, 60 insertions, 57 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 | -------- |