Reorganization

author: Case Duckworth 2024-04-09 21:04:17 -0500
committer: Case Duckworth 2024-04-09 21:04:29 -0500
commit: 8ce2915e3c54598c2fda4fec0980ebfc2a3adf6e (patch)
tree: 124ef31663ed570bed358dffd9c861d10fabce7b /core.lua
parent: Uh (diff)
download: lam-8ce2915e3c54598c2fda4fec0980ebfc2a3adf6e.tar.gz
lam-8ce2915e3c54598c2fda4fec0980ebfc2a3adf6e.zip
1 files changed, 124 insertions, 117 deletions
diff --git a/core.lua b/core.lua
index fd78997..20c6b5c 100644
--- a/core.lua
+++ b/core.lua

@@ -1,131 +1,138 @@
 --- lam.core --- core procedures
-local m = {}
+local dump = require("dump")
-local type = require "type"
+local type = require("type")
-local isa, null = type.isa, type.null
+local null = type.null
-local math = math
+local assert_arity = type.assert_arity
-local dump = require("dump").dump
-- local load = require("repl").load -- circular dependency :<
-local util = require "util"
-local assert_arity = util.assert_arity
 local function fold (kons, knil, r)
        if r == null then
                return knil
        else
                local step, early_return = kons(r[1], knil)
-                if early_return then return step end
+                if early_return then return early_return end
                return fold(kons, step, r[2])
        end
 end
-m.env = { -- all functions here take R, which is the list of arguments
+local env = {}
-        ------- equivalence
-        ["eqv?"] =
+---[[ EQUIVALENCE ]]---
-                function (r)
-                        assert_arity(r, 2, 2)
+env["eqv?"] = function (r)
-                        return r[1] == r[2][1]
+        assert_arity(r,2,2)
-                end,
+        return r[1] == r[2][1]
-        ["eq?"] =
+end
-                function (r)
+-- from what i understand of the spec, it's okay that eqv? and eq? are the same
-                        assert_arity(r, 2, 2)
+env["eq?"] = env["eqv?"]
-                        -- from how i understand the Scheme spec, it's okay to
-                        -- make `eqv?' and `eq?' the same.
+---[[ TYPES ]]---
-                        return r[1] == r[2][1]
-                end,
+env["boolean?"] = function (r)
-        -- equal? can be done in-library
+        assert_arity(r,1,1)
-        ------- i/o
+        return r[1] == false or r[1] == true
-        display =
+end
-                function (r)
-                        assert_arity(r, 1, 1)
+env["port?"] = function (r)
-                        io.write(tostring(r[1]))
+        assert_arity(r,1,1)
-                end,
+        return type.isp(r[1], "input-port") or type.isp(r[1], "output-port")
-        newline =
+end
-                function (r)
-                        assert_arity(r, 0, 0)
+for _, t in ipairs {
-                        io.write("\n")
+        "symbol",
-                end,
+        -- todo: vector
-        dump =
+        "procedure",
-                function (r)
+        "pair",
-                        assert_arity(r, 1, 1)
+        "number",
-                        return dump(r[1])
+        "string",
-                end,
+        "port",
-        --[[    load = -- circular dependency :<
+} do
-                function (r)
+        env[t.."?"] = function (r)
-                assert_arity(r, 1, 1)
+                assert_arity(r,1,1)
-                load(r[1])
+                return type.isp(r[1], t)
-                end,
+        end
-        --]]
+end
-        ------- numbers
-        -- todo: assert all of these are numbers
+---[[ NUMBERS ]]---
-        ["number?"] =
-                function (r)
+env["="] = function (r)
-                        assert_arity(r, 1, 1)
+        if r[1] == nil then return true end
-                        return isa(r[1], "number")
+        if r[2] == nil then return true end
-                end,
+        while r[2] ~= null do
-        ["="] =
+                if r[1] ~= r[2][1] then return false end
-                function (r)
+                r = r[2]
-                        if r[1] == nil then return true end
+        end
-                        if r[2] == nil then return true end
+        return true
-                        while r[2] ~= null do
+end
-                                if r[1] ~= r[2][1] then return false end
-                                r = r[2]
+env["<"] = function (r)
-                        end
+        if r[1] == nil then return true end
-                        return true
+        if r[2] == nil then return true end
-                end,
+        while r[2] ~= null do
-        ["<"] =
+                if r[1] >= r[2][1] then return false end
-                function (r)
+                r = r[2]
-                        if r[1] == nil then return true end
+        end
-                        if r[2] == nil then return true end
+        return true
-                        while r[2] ~= null do
+end
-                                if r[1] >= r[2][1] then return false end
+env[">"] = function (r)
-                                r = r[2]
+        if r[1] == nil then return true end
-                        end
+        if r[2] == nil then return true end
-                        return true
+        while r[2] ~= null do
-                end,
+                if r[1] <= r[2][1] then return false end
-        [">"] =
+                r = r[2]
-                function (r)
+        end
-                        if r[1] == nil then return true end
+        return true
-                        if r[2] == nil then return true end
+end
-                        while r[2] ~= null do
+env["<="] = function (r) return not env[">"](r) end
-                                if r[1] <= r[2][1] then return false end
+env[">="] = function (r) return not env["<"](r) end
-                                r = r[2]
-                        end
+env["+"] = function (r)
-                        return true
+        return fold(function (a, b) return a + b end, 0, r)
-                end,
+end
-        ["<="] = function (r) return not m.env[">"](r) end,
-        [">="] = function (r) return not m.env["<"](r) end,
+env["-"] = function (r)
-        ------- math
+        if r == null then return -1 end
-        ["+"] =
+        if r[2] == null then return (- r[1]) end
-                function (r)
+        return fold(function (a, b)
-                        return fold(function (a, b) return a + b end, 0, r)
+                        return a - b
-                end,
+        end, r[1], r[2])
-        ["-"] =
+end
-                function (r)
-                        if r == null then return -1 end
+env["*"] = function (r)
-                        if r[2] == null then return (- r[1]) end
+        local function go (a, b)
-                        return fold(function (a, b)
+                if a == 0 or b == 0 then
-                                        return a - b
+                        return 0, 1
-                        end, r[1], r[2])
+                end
-                end,
+                return a * b
-        ["*"] =
+        end
-                function (r)
+        return fold(go, 1, r)
-                        local function go (a, b)
+end
-                                if a == 0 or b == 0 then
-                                        return 0, 1
+env["/"] = function (r)
-                                end
+        assert_arity(r,1)
-                                return a * b
+        if r[2] == null then return (1 / r[1]) end
-                        end
+        return fold(function (a, b) return a / b end,
-                        return fold(go, 1, r)
+                r[1], r[2])
-                end,
+end
-        ["/"] =
-                function (r)
+---[[ INPUT / OUTPUT ]]---
-                        assert_arity(r, 1)
-                        if r[2] == null then return (1 / r[1]) end
+env.dump = function (r)
-                        return fold(function (a, b) return a / b end,
+        assert_arity(r,1,1)
-                                r[1], r[2])
+        return dump.dump(r[1])
-                end,
+end
-}
+env.display = function (r)
+        assert_arity(r,1,1)
+        io.write(r[1])
+end
+env.newline = function (r)
+        assert_arity(r,0,0)
+        io.write("\n")
+end
 --------
-return m
+return {
+        environment = env,
+}
author	Case Duckworth	2024-04-09 21:04:17 -0500
committer	Case Duckworth	2024-04-09 21:04:29 -0500
commit	8ce2915e3c54598c2fda4fec0980ebfc2a3adf6e (patch)
tree	124ef31663ed570bed358dffd9c861d10fabce7b /core.lua
parent	Uh (diff)
download	lam-8ce2915e3c54598c2fda4fec0980ebfc2a3adf6e.tar.gz lam-8ce2915e3c54598c2fda4fec0980ebfc2a3adf6e.zip

diff --git a/core.lua b/core.lua index fd78997..20c6b5c 100644 --- a/core.lua +++ b/core.lua
@@ -1,131 +1,138 @@
1	--- lam.core --- core procedures	1	--- lam.core --- core procedures
2		2
3	local m = {}	3	local dump = require("dump")
4	local type = require "type"	4	local type = require("type")
5	local isa, null = type.isa, type.null	5	local null = type.null
6	local math = math	6	local assert_arity = type.assert_arity
7	local dump = require("dump").dump
8	-- local load = require("repl").load -- circular dependency :<
9	local util = require "util"
10	local assert_arity = util.assert_arity
11		7
12	local function fold (kons, knil, r)	8	local function fold (kons, knil, r)
13	if r == null then	9	if r == null then
14	return knil	10	return knil
15	else	11	else
16	local step, early_return = kons(r[1], knil)	12	local step, early_return = kons(r[1], knil)
17	if early_return then return step end	13	if early_return then return early_return end
18	return fold(kons, step, r[2])	14	return fold(kons, step, r[2])
19	end	15	end
20	end	16	end
21		17
22	m.env = { -- all functions here take R, which is the list of arguments	18	local env = {}
23	------- equivalence	19
24	["eqv?"] =	20	---[[ EQUIVALENCE ]]---
25	function (r)	21
26	assert_arity(r, 2, 2)	22	env["eqv?"] = function (r)
27	return r[1] == r[2][1]	23	assert_arity(r,2,2)
28	end,	24	return r[1] == r[2][1]
29	["eq?"] =	25	end
30	function (r)	26	-- from what i understand of the spec, it's okay that eqv? and eq? are the same
31	assert_arity(r, 2, 2)	27	env["eq?"] = env["eqv?"]
32	-- from how i understand the Scheme spec, it's okay to	28
33	-- make `eqv?' and `eq?' the same.	29	---[[ TYPES ]]---
34	return r[1] == r[2][1]	30
35	end,	31	env["boolean?"] = function (r)
36	-- equal? can be done in-library	32	assert_arity(r,1,1)
37	------- i/o	33	return r[1] == false or r[1] == true
38	display =	34	end
39	function (r)	35
40	assert_arity(r, 1, 1)	36	env["port?"] = function (r)
41	io.write(tostring(r[1]))	37	assert_arity(r,1,1)
42	end,	38	return type.isp(r[1], "input-port") or type.isp(r[1], "output-port")
43	newline =	39	end
44	function (r)	40
45	assert_arity(r, 0, 0)	41	for _, t in ipairs {
46	io.write("\n")	42	"symbol",
47	end,	43	-- todo: vector
48	dump =	44	"procedure",
49	function (r)	45	"pair",
50	assert_arity(r, 1, 1)	46	"number",
51	return dump(r[1])	47	"string",
52	end,	48	"port",
53	--[[ load = -- circular dependency :<	49	} do
54	function (r)	50	env[t.."?"] = function (r)
55	assert_arity(r, 1, 1)	51	assert_arity(r,1,1)
56	load(r[1])	52	return type.isp(r[1], t)
57	end,	53	end
58	--]]	54	end
59	------- numbers	55
60	-- todo: assert all of these are numbers	56	---[[ NUMBERS ]]---
61	["number?"] =	57
62	function (r)	58	env["="] = function (r)
63	assert_arity(r, 1, 1)	59	if r[1] == nil then return true end
64	return isa(r[1], "number")	60	if r[2] == nil then return true end
65	end,	61	while r[2] ~= null do
66	["="] =	62	if r[1] ~= r[2][1] then return false end
67	function (r)	63	r = r[2]
68	if r[1] == nil then return true end	64	end
69	if r[2] == nil then return true end	65	return true
70	while r[2] ~= null do	66	end
71	if r[1] ~= r[2][1] then return false end	67
72	r = r[2]	68	env["<"] = function (r)
73	end	69	if r[1] == nil then return true end
74	return true	70	if r[2] == nil then return true end
75	end,	71	while r[2] ~= null do
76	["<"] =	72	if r[1] >= r[2][1] then return false end
77	function (r)	73	r = r[2]
78	if r[1] == nil then return true end	74	end
79	if r[2] == nil then return true end	75	return true
80	while r[2] ~= null do	76	end
81	if r[1] >= r[2][1] then return false end	77	env[">"] = function (r)
82	r = r[2]	78	if r[1] == nil then return true end
83	end	79	if r[2] == nil then return true end
84	return true	80	while r[2] ~= null do
85	end,	81	if r[1] <= r[2][1] then return false end
86	[">"] =	82	r = r[2]
87	function (r)	83	end
88	if r[1] == nil then return true end	84	return true
89	if r[2] == nil then return true end	85	end
90	while r[2] ~= null do	86	env["<="] = function (r) return not env[">"](r) end
91	if r[1] <= r[2][1] then return false end	87	env[">="] = function (r) return not env["<"](r) end
92	r = r[2]	88
93	end	89	env["+"] = function (r)
94	return true	90	return fold(function (a, b) return a + b end, 0, r)
95	end,	91	end
96	["<="] = function (r) return not m.env[">"](r) end,	92
97	[">="] = function (r) return not m.env["<"](r) end,	93	env["-"] = function (r)
98	------- math	94	if r == null then return -1 end
99	["+"] =	95	if r[2] == null then return (- r[1]) end
100	function (r)	96	return fold(function (a, b)
101	return fold(function (a, b) return a + b end, 0, r)	97	return a - b
102	end,	98	end, r[1], r[2])
103	["-"] =	99	end
104	function (r)	100
105	if r == null then return -1 end	101	env["*"] = function (r)
106	if r[2] == null then return (- r[1]) end	102	local function go (a, b)
107	return fold(function (a, b)	103	if a == 0 or b == 0 then
108	return a - b	104	return 0, 1
109	end, r[1], r[2])	105	end
110	end,	106	return a * b
111	["*"] =	107	end
112	function (r)	108	return fold(go, 1, r)
113	local function go (a, b)	109	end
114	if a == 0 or b == 0 then	110
115	return 0, 1	111	env["/"] = function (r)
116	end	112	assert_arity(r,1)
117	return a * b	113	if r[2] == null then return (1 / r[1]) end
118	end	114	return fold(function (a, b) return a / b end,
119	return fold(go, 1, r)	115	r[1], r[2])
120	end,	116	end
121	["/"] =	117
122	function (r)	118	---[[ INPUT / OUTPUT ]]---
123	assert_arity(r, 1)	119
124	if r[2] == null then return (1 / r[1]) end	120	env.dump = function (r)
125	return fold(function (a, b) return a / b end,	121	assert_arity(r,1,1)
126	r[1], r[2])	122	return dump.dump(r[1])
127	end,	123	end
128	}	124
		125	env.display = function (r)
		126	assert_arity(r,1,1)
		127	io.write(r[1])
		128	end
		129
		130	env.newline = function (r)
		131	assert_arity(r,0,0)
		132	io.write("\n")
		133	end
129		134
130	--------	135	--------
131	return m	136	return {
		137	environment = env,
		138	}