Add a bunch of base functions

author: Case Duckworth 2024-03-23 15:50:56 -0500
committer: Case Duckworth 2024-03-23 15:50:56 -0500
commit: 04beefb7169a9a1a3d44737786e0ef76ba676aba (patch)
tree: e2a69d01f5942a7e4383e6e6e38e1f95cab2946b
parent: Revert "Refactor eval" (diff)
download: lam-04beefb7169a9a1a3d44737786e0ef76ba676aba.tar.gz
lam-04beefb7169a9a1a3d44737786e0ef76ba676aba.zip
1 files changed, 229 insertions, 1 deletions
diff --git a/base.lua b/base.lua
index 6dc71e4..b6e3a30 100644
--- a/base.lua
+++ b/base.lua

@@ -2,9 +2,78 @@
 local base = {}
 local type = require "type"
-local isNull = type.isNull
+local isNull, isa, totable = type.isNull, type.isa, type.totable
+local math = math
 base.env = {
+        -- Equivalence
+        ["eqv?"] =
+                function (r)
+                        local a, b = r.car, r.cdr.car
+                        if a == b then
+                                return true
+                        else
+                                return false
+                        end
+                end,
+        -- ["eq?"] = function (r) end, -- how would this be different to eqv?
+        -- Numbers
+        ["number?"] = function (r) return isa(r.car, "Number") end,
+        -- ["complex?"] = function (r) end,
+        -- ["real?"] = function (r) end,
+        -- ["rational?"] = function (r) end,
+        -- ["integer?"] = function (r) end,
+        -- ["exact?"] = function (r) end,
+        -- ["inexact?"] = function (r) end,
+        -- ["exact-integer?"] = function (r) end,
+        -- ["finite?"] = function (r) end,
+        -- ["infinite?"] = function (r) end,
+        ["="] =
+                function (r)
+                        local n, r = r.car, r.cdr
+                        while r.cdr do
+                                if n ~= r.car then return false end
+                                r = r.cdr
+                        end
+                        return true
+                end,
+        ["<"] =
+                function (r)
+                        local n, r = r.car, r.cdr
+                        while r.cdr do
+                                if n >= r.car then return false end
+                                r = r.cdr
+                        end
+                        return true
+                end,
+        [">"] =
+                function (r)
+                        local n, r = r.car, r.cdr
+                        while r.cdr do
+                                if n <= r.car then return false end
+                                r = r.cdr
+                        end
+                        return true
+                end,
+        ["<="] =
+                function (r)
+                        local n, r = r.car, r.cdr
+                        while r.cdr do
+                                if n > r.car then return false end
+                                r = r.cdr
+                        end
+                        return true
+                end,
+        [">="] =
+                function (r)
+                        local n, r = r.car, r.cdr
+                        while r.cdr do
+                                if n < r.car then return false end
+                                r = r.cdr
+                        end
+                        return true
+                end,
+        -- Math
        ["+"] =
                function (r)
                        local r, a = r, 0
@@ -23,6 +92,165 @@ base.env = {
                        end
                        return a
                end,
+        ["*"] =
+                function (r)
+                        local r, a = r, 1
+                        while r.cdr do
+                                if r.cdr == 0 then return 0 end
+                                r, a = r.cdr, a * r.car
+                        end
+                        return a
+                end,
+        ["/"] =
+                function (r)
+                        if isNull(r) then error("Wrong arity") end
+                        if isNull(r.cdr) then return (1 / r.car) end
+                        local r, a = r.cdr, r.car
+                        while r.cdr do
+                                r, a = r.cdr, a / r.car
+                        end
+                        return a
+                end,
+        quotient =
+                function (r)
+                end,
+        remainder =
+                function (r)
+                end,
+        modulo =
+                function (r)
+                end,
+        -- numerator = function (r) end,
+        -- denominator = function (r) end,
+        abs = function (r) return math.abs(r.car) end,
+        floor = -- largest integer <= x
+                function (r) return math.floor(r.car) end,
+        ceiling = -- smallest integer >= x
+                function (r) return math.ceil(r.car) end,
+        truncate = -- smallest |integer| <= |x|
+                function (r)
+                        local i, _ = math.modf(r.car)
+                        return i
+                end,
+        round = -- closest integer to x (ties go even)
+                function (r)
+                        local i, f = math.modf(r.car)
+                        if f == 0.5 then
+                                if i % 2 == 0 then
+                                        return i
+                                else
+                                        return i+1
+                                end
+                        else
+                                return i -- is this right?
+                        end
+                end,
+        -- Trig
+        exp = function (r) return math.exp(r.car) end,
+        log = function (r) return math.log(r.car) end,
+        pi = math.pi, -- extension
+        sin = function (r) return math.sin(r.car) end,
+        cos = function (r) return math.cos(r.car) end,
+        tan = function (r) return math.tan(r.car) end,
+        asin = function (r) return math.asin(r.car) end,
+        acos = function (r) return math.acos(r.car) end,
+        atan = -- the two-argument variant of atan computes
+                -- (angle (make-rectangular x y)), even in implementations that
+                -- don't support general complex numbers [ed. note: whatever
+                -- that means] --- atan2 ???
+                function (r) return math.atan(r.car) end,
+        sqrt = function (r) return math.sqrt(r.car) end,
+        expt = function (r) return r.car ^ r.cdr.car end,
+        -- ["make-rectangular"] = function (r) end,
+        -- ["make-polar"] = function (r) end,
+        -- ["real-part"] = function (r) end,
+        -- ["imag-part"] = function (r) end,
+        -- ["magnitude"] = function (r) end,
+        -- ["angle"] = function (r) end,
+        -- ["exact->inexact"] = function (r) end,
+        -- ["inexact->exact"] = function (r) end,
+        ["number->string"] =
+                function (r)
+                        -- this will be somewhat complicated
+                end,
+        ["string->number"] =
+                function (r)
+                        local n = r.car
+                        if not isNull(r.cdr) then
+                                local radix = r.cdr.car
+                        end
+                        -- This is technically an extension to r5rs
+                        return tonumber(n, radix)
+                end,
+        -- Pairs
+        ["pair?"] = function (r) end,
+        cons = function (r) return type.Cons(r.car, r.cdr.car) end,
+        car = function (r) return r.car.car end,
+        cdr = function (r) return r.car.cdr end,
+        ["set-car!"] = function (r) r.car.car = r.cdr.car end,
+        ["set-cdr!"] = function (r) r.car.cdr = r.cdr.car end,
+        -- cxr
+        ["null?"] = function (r) return isNull(r.car) end,
+        ["list?"] = function (r) return type.isList(r.car) end,
+        list = function (r) return r end, -- r is already a list
+        -- Symbols
+        ["symbol?"] = function (r) return isa(r.car, "Symbol") end,
+        ["symbol->string"] = function (r) return type.String(r.car) end,
+        ["string->symbol"] = function (r) return type.Symbol(r.car.value) end,
+        -- Characters
+        ["char?"] = function (r) end,
+        ["char=?"] = function (r) end,
+        ["char<?"] = function (r) end,
+        ["char>?"] = function (r) end,
+        ["char<=?"] = function (r) end,
+        ["char>=?"] = function (r) end,
+        ["char->integer"] = function (r) end,
+        ["integer->char"] = function (r) end,
+        -- Strings
+        ["string?"] = function (r) end,
+        ["make-string"] = function (r) end,
+        ["string-length"] = function (r) end,
+        ["string-ref"] = function (r) end,
+        -- ["string-set!"] = function (r) end, -- not sure if i'll implement
+        -- Vectors
+        ["vector?"] = function (r) end,
+        ["make-vector"] = function (r) end,
+        ["vector-length"] = function (r) end,
+        ["vector-ref"] = function (r) end,
+        ["vector-set!"] = function (r) end,
+        -- Control
+        ["procedure?"] = function (r) end,
+        apply = function (r) end,
+        ["call-with-current-continuation"] = function (r) end,
+        values = function (r) end,
+        ["call-with-values"] = function (r) end,
+        ["dynamic-wind"] = function (r) end,
+        -- Eval
+        eval = function (r) end,
+        ["scheme-report-environment"] = function (r) end,
+        ["null-environment"] = function (r) end,
+        -- Ports
+        ["input-port?"] = function (r) end,
+        ["output-port?"] = function (r) end,
+        ["current-input-port"] = function (r) end,
+        ["current-output-port"] = function (r) end,
+        ["open-input-file"] = function (r) end,
+        ["open-output-file"] = function (r) end,
+        ["close-input-port"] = function (r) end,
+        ["close-output-port"] = function (r) end,
+        -- Input
+        read = function (r) end,
+        ["read-char"] = function (r) end,
+        ["peek-char"] = function (r) end,
+        ["eof-object?"] = function (r) end,
+        ["char-ready?"] = function (r) end,
+        -- Output
+        write = function (r) end,
+        display = function (r) end,
+        newline = function (r) end,
+        ["write-char"] = function (r) end,
+        -- System
+        load = function (r) end,
 }
 ---
author	Case Duckworth	2024-03-23 15:50:56 -0500
committer	Case Duckworth	2024-03-23 15:50:56 -0500
commit	04beefb7169a9a1a3d44737786e0ef76ba676aba (patch)
tree	e2a69d01f5942a7e4383e6e6e38e1f95cab2946b
parent	Revert "Refactor eval" (diff)
download	lam-04beefb7169a9a1a3d44737786e0ef76ba676aba.tar.gz lam-04beefb7169a9a1a3d44737786e0ef76ba676aba.zip

diff --git a/base.lua b/base.lua index 6dc71e4..b6e3a30 100644 --- a/base.lua +++ b/base.lua
@@ -2,9 +2,78 @@
2		2
3	local base = {}	3	local base = {}
4	local type = require "type"	4	local type = require "type"
5	local isNull = type.isNull	5	local isNull, isa, totable = type.isNull, type.isa, type.totable
		6	local math = math
6		7
7	base.env = {	8	base.env = {
		9	-- Equivalence
		10	["eqv?"] =
		11	function (r)
		12	local a, b = r.car, r.cdr.car
		13	if a == b then
		14	return true
		15	else
		16	return false
		17	end
		18	end,
		19	-- ["eq?"] = function (r) end, -- how would this be different to eqv?
		20	-- Numbers
		21	["number?"] = function (r) return isa(r.car, "Number") end,
		22	-- ["complex?"] = function (r) end,
		23	-- ["real?"] = function (r) end,
		24	-- ["rational?"] = function (r) end,
		25	-- ["integer?"] = function (r) end,
		26	-- ["exact?"] = function (r) end,
		27	-- ["inexact?"] = function (r) end,
		28	-- ["exact-integer?"] = function (r) end,
		29	-- ["finite?"] = function (r) end,
		30	-- ["infinite?"] = function (r) end,
		31	["="] =
		32	function (r)
		33	local n, r = r.car, r.cdr
		34	while r.cdr do
		35	if n ~= r.car then return false end
		36	r = r.cdr
		37	end
		38	return true
		39	end,
		40	["<"] =
		41	function (r)
		42	local n, r = r.car, r.cdr
		43	while r.cdr do
		44	if n >= r.car then return false end
		45	r = r.cdr
		46	end
		47	return true
		48	end,
		49	[">"] =
		50	function (r)
		51	local n, r = r.car, r.cdr
		52	while r.cdr do
		53	if n <= r.car then return false end
		54	r = r.cdr
		55	end
		56	return true
		57	end,
		58	["<="] =
		59	function (r)
		60	local n, r = r.car, r.cdr
		61	while r.cdr do
		62	if n > r.car then return false end
		63	r = r.cdr
		64	end
		65	return true
		66	end,
		67	[">="] =
		68	function (r)
		69	local n, r = r.car, r.cdr
		70	while r.cdr do
		71	if n < r.car then return false end
		72	r = r.cdr
		73	end
		74	return true
		75	end,
		76	-- Math
8	["+"] =	77	["+"] =
9	function (r)	78	function (r)
10	local r, a = r, 0	79	local r, a = r, 0
@@ -23,6 +92,165 @@ base.env = {
23	end	92	end
24	return a	93	return a
25	end,	94	end,
		95	["*"] =
		96	function (r)
		97	local r, a = r, 1
		98	while r.cdr do
		99	if r.cdr == 0 then return 0 end
		100	r, a = r.cdr, a * r.car
		101	end
		102	return a
		103	end,
		104	["/"] =
		105	function (r)
		106	if isNull(r) then error("Wrong arity") end
		107	if isNull(r.cdr) then return (1 / r.car) end
		108	local r, a = r.cdr, r.car
		109	while r.cdr do
		110	r, a = r.cdr, a / r.car
		111	end
		112	return a
		113	end,
		114	quotient =
		115	function (r)
		116	end,
		117	remainder =
		118	function (r)
		119	end,
		120	modulo =
		121	function (r)
		122	end,
		123	-- numerator = function (r) end,
		124	-- denominator = function (r) end,
		125	abs = function (r) return math.abs(r.car) end,
		126	floor = -- largest integer <= x
		127	function (r) return math.floor(r.car) end,
		128	ceiling = -- smallest integer >= x
		129	function (r) return math.ceil(r.car) end,
		130	truncate = -- smallest \|integer\| <= \|x\|
		131	function (r)
		132	local i, _ = math.modf(r.car)
		133	return i
		134	end,
		135	round = -- closest integer to x (ties go even)
		136	function (r)
		137	local i, f = math.modf(r.car)
		138	if f == 0.5 then
		139	if i % 2 == 0 then
		140	return i
		141	else
		142	return i+1
		143	end
		144	else
		145	return i -- is this right?
		146	end
		147	end,
		148	-- Trig
		149	exp = function (r) return math.exp(r.car) end,
		150	log = function (r) return math.log(r.car) end,
		151	pi = math.pi, -- extension
		152	sin = function (r) return math.sin(r.car) end,
		153	cos = function (r) return math.cos(r.car) end,
		154	tan = function (r) return math.tan(r.car) end,
		155	asin = function (r) return math.asin(r.car) end,
		156	acos = function (r) return math.acos(r.car) end,
		157	atan = -- the two-argument variant of atan computes
		158	-- (angle (make-rectangular x y)), even in implementations that
		159	-- don't support general complex numbers [ed. note: whatever
		160	-- that means] --- atan2 ???
		161	function (r) return math.atan(r.car) end,
		162	sqrt = function (r) return math.sqrt(r.car) end,
		163	expt = function (r) return r.car ^ r.cdr.car end,
		164	-- ["make-rectangular"] = function (r) end,
		165	-- ["make-polar"] = function (r) end,
		166	-- ["real-part"] = function (r) end,
		167	-- ["imag-part"] = function (r) end,
		168	-- ["magnitude"] = function (r) end,
		169	-- ["angle"] = function (r) end,
		170	-- ["exact->inexact"] = function (r) end,
		171	-- ["inexact->exact"] = function (r) end,
		172	["number->string"] =
		173	function (r)
		174	-- this will be somewhat complicated
		175	end,
		176	["string->number"] =
		177	function (r)
		178	local n = r.car
		179	if not isNull(r.cdr) then
		180	local radix = r.cdr.car
		181	end
		182	-- This is technically an extension to r5rs
		183	return tonumber(n, radix)
		184	end,
		185	-- Pairs
		186	["pair?"] = function (r) end,
		187	cons = function (r) return type.Cons(r.car, r.cdr.car) end,
		188	car = function (r) return r.car.car end,
		189	cdr = function (r) return r.car.cdr end,
		190	["set-car!"] = function (r) r.car.car = r.cdr.car end,
		191	["set-cdr!"] = function (r) r.car.cdr = r.cdr.car end,
		192	-- cxr
		193	["null?"] = function (r) return isNull(r.car) end,
		194	["list?"] = function (r) return type.isList(r.car) end,
		195	list = function (r) return r end, -- r is already a list
		196	-- Symbols
		197	["symbol?"] = function (r) return isa(r.car, "Symbol") end,
		198	["symbol->string"] = function (r) return type.String(r.car) end,
		199	["string->symbol"] = function (r) return type.Symbol(r.car.value) end,
		200	-- Characters
		201	["char?"] = function (r) end,
		202	["char=?"] = function (r) end,
		203	["char<?"] = function (r) end,
		204	["char>?"] = function (r) end,
		205	["char<=?"] = function (r) end,
		206	["char>=?"] = function (r) end,
		207	["char->integer"] = function (r) end,
		208	["integer->char"] = function (r) end,
		209	-- Strings
		210	["string?"] = function (r) end,
		211	["make-string"] = function (r) end,
		212	["string-length"] = function (r) end,
		213	["string-ref"] = function (r) end,
		214	-- ["string-set!"] = function (r) end, -- not sure if i'll implement
		215	-- Vectors
		216	["vector?"] = function (r) end,
		217	["make-vector"] = function (r) end,
		218	["vector-length"] = function (r) end,
		219	["vector-ref"] = function (r) end,
		220	["vector-set!"] = function (r) end,
		221	-- Control
		222	["procedure?"] = function (r) end,
		223	apply = function (r) end,
		224	["call-with-current-continuation"] = function (r) end,
		225	values = function (r) end,
		226	["call-with-values"] = function (r) end,
		227	["dynamic-wind"] = function (r) end,
		228	-- Eval
		229	eval = function (r) end,
		230	["scheme-report-environment"] = function (r) end,
		231	["null-environment"] = function (r) end,
		232	-- Ports
		233	["input-port?"] = function (r) end,
		234	["output-port?"] = function (r) end,
		235	["current-input-port"] = function (r) end,
		236	["current-output-port"] = function (r) end,
		237	["open-input-file"] = function (r) end,
		238	["open-output-file"] = function (r) end,
		239	["close-input-port"] = function (r) end,
		240	["close-output-port"] = function (r) end,
		241	-- Input
		242	read = function (r) end,
		243	["read-char"] = function (r) end,
		244	["peek-char"] = function (r) end,
		245	["eof-object?"] = function (r) end,
		246	["char-ready?"] = function (r) end,
		247	-- Output
		248	write = function (r) end,
		249	display = function (r) end,
		250	newline = function (r) end,
		251	["write-char"] = function (r) end,
		252	-- System
		253	load = function (r) end,
26	}	254	}
27		255
28	---	256	---