alicorn 0.1.2

Rust embedding of the Alicorn compiler
Documentation 
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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162

local U = require "alicorn-utils"
local metalanguage = require "metalanguage"

-- This file is a simple language built with metalanguage
-- it could be used to create tests of metalanguage that don't rely
-- on other parts of Alicorn

local eval

local function eval_passhandler(env, val)
	--print("eval pass handler", val, env)
	return true, val, env
end

local eval

---@param syntax ConstructedSyntax
---@param matcher Matcher
---@param environment Env
---@return ...
local function Eval(syntax, matcher, environment)
	return U.notail(eval(syntax, environment))
end

local evaluates = metalanguage.reducer(Eval, "evaluates")

local function eval_pairhandler(env, a, b)
	--print("in eval pairhandler", a, b, env)
	local ok, combiner, _ = a:match({
		evaluates(eval_passhandler, env),
	}, metalanguage.failure_handler, env)
	if not ok then
		return false, combiner
	end
	local ok, val, newenv = combiner:apply(b, env)
	--print("eval pair", ok, val, newenv)
	return ok, val, newenv
end

---@param env Env
---@param name string
---@return boolean
---@return any | string
local function symbolenvhandler(env, name)
	--print("symbolenvhandler(", name, env, ")")
	local res = env:get(name)
	if res ~= nil then
		return true, res
	else
		return false, "environment does not contain a binding for " .. name
	end
end

local function SymbolInEnvironment(syntax, environment)
	--print("in symbol in environment reducer", matcher.kind, matcher[1], matcher)
	return U.notail(syntax:match({
		metalanguage.issymbol(symbolenvhandler),
	}, metalanguage.failure_handler, environment))
end

local symbol_in_environment = metalanguage.reducer(SymbolInEnvironment, "symbol in env")

---@param syntax ConstructedSyntax
---@param environment Env
---@return ...
function eval(syntax, environment)
	return U.notail(syntax:match({
		symbol_in_environment(eval_passhandler, environment),
		metalanguage.isvalue(eval_passhandler),
		metalanguage.ispair(eval_pairhandler),
	}, metalanguage.failure_handler, environment))
end

---@generic T
---@param val T
---@param newenv Env
---@return boolean, T, Env
local function syntax_args_val_handler(_, val, newenv)
	return true, val, newenv
end

local function syntax_args_nil_handler(data)
	return true, false
end

---@generic T
---@param env Env
---@param a ConstructedSyntax
---@param b T
---@return boolean
---@return boolean
---@return any
---@return T
local function syntax_args_pair_handler(env, a, b)
	local ok, val, _ = a:match({
		evaluates(syntax_args_val_handler, env),
	}, metalanguage.failure_handler, nil)
	--print("args pair handler", ok, val, _, b)
	return true, true, val, b
end

---@param syntax ConstructedSyntax
---@param matcher Matcher
---@param environment Env
---@return boolean
---@return any[]
local function EvalArgs(syntax, matcher, environment)
	local args = {}
	local ok, ispair, val, tail = true, true, nil, nil
	while ok and ispair do
		ok, ispair, val, tail = syntax:match({
			metalanguage.ispair(syntax_args_pair_handler),
			metalanguage.isnil(syntax_args_nil_handler),
		}, metalanguage.failure_handler, environment)
		if not ok then
			return false, ispair
		end
		if ispair then
			args[#args + 1] = val
			syntax = tail
		end
	end
	return true, args
end

local evalargs = metalanguage.reducer(EvalArgs, "evalargs")

local primitive_applicative_mt = {
	__index = {
		apply = function(self, ops, env)
			local ok, args = ops:match({
				evalargs(metalanguage.accept_handler, env),
			}, metalanguage.failure_handler, nil)
			local res = self.fn(table.unpack(args))
			return true, U.notail(metalanguage.value(nil, nil, res)), env
		end,
	},
}

local function primitive_applicative(fn)
	return setmetatable({ fn = fn }, primitive_applicative_mt)
end

local primitive_operative_mt = {
	__index = {
		apply = function(self, ops, env)
			return U.notail(self.fn(ops, env))
		end,
	},
}

local function primitive_operative(fn)
	return setmetatable({ fn = fn }, primitive_operative_mt)
end

return {
	eval = eval,
	evalargs = evalargs,
	evaluates = evaluates,
	primitive_applicative = primitive_applicative,
	primitive_operative = primitive_operative,
}