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 /core.lua | |
| parent | Handle dotted lambda-lists and symbols (diff) | |
| download | lam-2a5c0883ca907e97110ea0050080f74ccbb143e2.tar.gz lam-2a5c0883ca907e97110ea0050080f74ccbb143e2.zip | |
Change arity assertion code
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 | -------- |