Implement arity checks

author: Case Duckworth 2024-04-02 12:46:16 -0500
committer: Case Duckworth 2024-04-02 12:46:16 -0500
commit: 434f9c1b3102ef1bbce5f73f17babdbf7b55d974 (patch)
tree: 29645b4ce2f334927090397920e6610f0264934f
parent: Implement list length (diff)
download: lam-434f9c1b3102ef1bbce5f73f17babdbf7b55d974.tar.gz
lam-434f9c1b3102ef1bbce5f73f17babdbf7b55d974.zip
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 = {}
 local type = require "type"
 local isa, null = type.isa, type.null
 local math = math
+local proc = require("util").proc
 local function fold (kons, knil, r)
        if r == null then
@@ -17,58 +18,71 @@ end
 m.env = { -- all functions here take R, which is the list of arguments
        ------- numbers
-        ["number?"] = function (r) return isa(r[1], "number") end,
+        ["number?"] = proc(1, function (r) return isa(r[1], "number") end),
        ["="] =
-                function (r)
+                proc({0}, function (r)
-                        local function go (a, b)
+                                if r[1] == nil then return true end
-                                if a ~= b then return false, 1 end
+                                if r[2] == nil then return true end
-                                return b
+                                while r[2] ~= null do
-                        end
+                                        if r[1] ~= r[2][1] then return false end
-                        return fold(go, r[1], r[2]) and true
+                                        r = r[2]
-                end,
+                                end
+                                return true
+                end),
        ["<"] =
-                function (r)
+                proc({0}, function (r)
-                        local function go (a, b)
+                                if r[1] == nil then return true end
-                                if a >= b then return false, 1 end
+                                if r[2] == nil then return true end
-                                return b
+                                while r[2] ~= null do
-                        end
+                                        if r[1] >= r[2][1] then return false end
-                        return fold(go, r[1], r[2]) and true
+                                        r = r[2]
-                end,
+                                end
+                                return true
+                end),
        [">"] =
-                function (r)
+                proc({0}, function (r)
-                        local function go (a, b)
+                                if r[1] == nil then return true end
-                                if a <= b then return false, 1 end
+                                if r[2] == nil then return true end
-                                return b
+                                while r[2] ~= null do
-                        end
+                                        if r[1] <= r[2][1] then return false end
-                        return fold(go, r[1], r[2]) and true
+                                        r = r[2]
-                end,
+                                end
-        ["<="] = function (r) return not m.env[">"](r) end,
+                                return true
-        [">="] = function (r) return not m.env["<"](r) end,
+                end),
+        ["<="] = proc({0}, function (r) return not m.env[">"](r) end),
+        [">="] = proc({0}, function (r) return not m.env["<"](r) end),
        ------- math
        ["+"] =
-                function (r)
+                proc({0}, function (r)
-                        return fold(function (a, b) return a + b end, 0, r)
+                                return fold(function (a, b)
-                end,
+                                                return a + b
+                                end, 0, r)
+                end),
        ["-"] =
-                function (r)
+                proc({0}, function (r)
-                        if r == null then return -1 end
+                                if r == null then return -1 end
-                        if r[2] == null then return (- r[1]) end
+                                if r[2] == null then return (- r[1]) end
-                        return fold(function (a, b) return a-b end, r[1], r[2])
+                                return fold(function (a, b)
-                end,
+                                                return a - b
+                                end, r[1], r[2])
+                end),
        ["*"] =
-                function (r)
+                proc({0}, function (r)
-                        local function go (a, b)
+                                local function go (a, b)
-                                if a == 0 or b == 0 then return 0, 1 end
+                                        if a == 0 or b == 0 then
-                                return a * b
+                                                return 0, 1
-                        end
+                                        end
-                        return fold(go, 1, r)
+                                        return a * b
-                end,
+                                end
+                                return fold(go, 1, r)
+                end),
        ["/"] =
-                function (r)
+                proc({1}, function (r)
-                        if r == null then error("Wrong arity") end
+                                if r[2] == null then return (1 / r[1]) end
-                        if r[2] == null then return (1 / r[1]) end
+                                return fold(function (a, b)
-                        return fold(function (a, b) return a/b end, r[1], r[2])
+                                                return a / b
-                end,
+                                end, r[1], r[2])
+                end),
 }
 --------
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)
        return table.remove(tbl, 1)
 end
-function m.arity (r, min, max)
+function m.proc (arity, fn)
-        --[[ Return whether R is within MIN and MAX (inclusive). ]]
+        --[[ Wrap RN in a check that for its ARITY.
-        local len = #r
+                ARITY can be a number, the minimum number of arguments,
-        return len >= min and len <= max
+                or a table {MIN, MAX}.  If MIN is nil or absent, it's 0;
+                if MAX is nil or absent, it's infinity.  MIN and MAX are
+                both inclusive.
+        ]]
+        local rmin, rmax, rstr
+        if type(arity) ~= "table" then
+                rmin, rmax = arity, arity
+                rstr = rmin
+        else
+                rmin, rmax = arity[1] or 0, arity[2] or 1/0 -- infinity
+                rstr = rmin .. ".." .. rmax
+        end
+        return function (r)
+                local rlen = r and #r or 0
+                if rlen < rmin or rlen > rmax then
+                        error(string.format("Wrong arity: %s, need %s",
+                                        rlen,
+                                        rstr))
+                end
+                return fn(r)
+        end
 end
 ---
author	Case Duckworth	2024-04-02 12:46:16 -0500
committer	Case Duckworth	2024-04-02 12:46:16 -0500
commit	434f9c1b3102ef1bbce5f73f17babdbf7b55d974 (patch)
tree	29645b4ce2f334927090397920e6610f0264934f
parent	Implement list length (diff)
download	lam-434f9c1b3102ef1bbce5f73f17babdbf7b55d974.tar.gz lam-434f9c1b3102ef1bbce5f73f17babdbf7b55d974.zip

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	---