about summary refs log tree commit diff stats
path: root/core.lua
blob: f6d4e089ab38f856512437d1bd3b37c6a8971754 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
--- lam.core --- core procedures

local m = {}
local type = require "type"
local isa, null = type.isa, type.null
local math = math
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
		return fold(kons, step, r[2])
	end
end

m.env = { -- all functions here take R, which is the list of arguments
	------- equivalence
	["eqv?"] =
		function (r)
			assert_arity(r, 2, 2)
			return r[1] == r[2][1]
		end,
	["eq?"] =
		function (r)
			assert_arity(r, 2, 2)
			-- from how i understand the Scheme spec, it's okay to
			-- make `eqv?' and `eq?' the same.
			return r[1] == r[2][1]
		end,
	-- equal? can be done in-library
	------- i/o
	display =
		function (r)
			assert_arity(r, 1, 1)
			io.write(tostring(r[1]))
		end,
	newline =
		function (r)
			assert_arity(r, 0, 0)
			io.write("\n")
		end,
	------- numbers
	-- todo: assert all of these are numbers
	["number?"] =
		function (r)
			assert_arity(r, 1, 1)
			return isa(r[1], "number")
		end,
	["="] =
		function (r)
			if r[1] == nil then return true end
			if r[2] == nil then return true end
			while r[2] ~= null do
				if r[1] ~= r[2][1] then return false end
				r = r[2]
			end
			return true
		end,
	["<"] =
		function (r)
			if r[1] == nil then return true end
			if r[2] == nil then return true end
			while r[2] ~= null do
				if r[1] >= r[2][1] then return false end
				r = r[2]
			end
			return true
		end,
	[">"] =
		function (r)
			if r[1] == nil then return true end
			if r[2] == nil then return true end
			while r[2] ~= null do
				if r[1] <= r[2][1] then return false end
				r = r[2]
			end
			return true
		end,
	["<="] = function (r) return not m.env[">"](r) end,
	[">="] = function (r) return not m.env["<"](r) end,
	------- math
	["+"] =
		function (r)
			return fold(function (a, b) return a + b end, 0, r)
		end,
	["-"] =
		function (r)
			if r == null then return -1 end
			if r[2] == null then return (- r[1]) end
			return fold(function (a, b)
					return a - b
			end, r[1], r[2])
		end,
	["*"] =
		function (r)
			local function go (a, b)
				if a == 0 or b == 0 then
					return 0, 1
				end
				return a * b
			end
			return fold(go, 1, r)
		end,
	["/"] =
		function (r)
			assert_arity(r, 1)
			if r[2] == null then return (1 / r[1]) end
			return fold(function (a, b) return a / b end,
				r[1], r[2])
		end,
}

--------
return m