6 let rec iterPairs
f = function
7 | Pair(first
, second
, t
) ->
11 | _ -> raise
<| Error.errExpectedX
"list or vector"
13 let rec qqLoop elt
acc =
15 | List(_, [Symbol("splice-unquote");list
]) -> makeList
[Symbol "concat"; list
; acc]
16 | List(_, Symbol("splice-unquote")::_) -> raise
<| Error.wrongArity
()
17 | _ -> makeList
[Symbol "cons"; quasiquote
elt; acc]
18 and quasiquote
= function
19 | List(_, [Symbol("unquote");form
]) -> form
20 | List(_, Symbol("unquote")::_) -> raise
<| Error.wrongArity
()
21 | List (_, list
) -> List.foldBack qqLoop list
Node.EmptyLIST
22 | Vector(_, segment
) ->
23 let array = Array.sub segment
.Array segment
.Offset segment.Count
24 let folded = Array.foldBack qqLoop
array Node.EmptyLIST
25 makeList
[Symbol "vec"; folded]
26 | Map(_) as ast -> makeList
[Symbol "quote"; ast]
27 | Symbol(_) as ast -> makeList
[Symbol "quote"; ast]
30 let quoteForm = function
32 | _ -> raise
<| Error.wrongArity
()
34 let rec macroExpand env
= function
35 | Env.IsMacro env
(Macro(_, _, f, _, _, _), rest
) ->
36 f rest
|> macroExpand env
39 let rec eval_ast
env = function
40 | Symbol(sym
) -> Env.get
env sym
41 | List(_, lst
) -> lst
|> List.map
(eval
env) |> makeList
42 | Vector(_, seg
) -> seg
|> Seq.map
(eval
env) |> Array.ofSeq
|> Node.ofArray
43 | Map(_, map
) -> map
|> Map.map
(fun k v
-> eval
env v
) |> makeMap
46 and defBangForm
env = function
50 let node = eval
env form
53 | _ -> raise
<| Error.errExpectedX
"symbol"
54 | _ -> raise
<| Error.wrongArity
()
56 and defMacroForm
env = function
60 let node = eval
env form
62 | Func(_, _, f, body
, binds
, outer
) ->
63 let node = Env.makeMacro
f body binds
outer
66 | _ -> raise
<| Error.errExpectedX
"user defined func"
67 | _ -> raise
<| Error.errExpectedX
"symbol"
68 | _ -> raise
<| Error.wrongArity
()
70 and macroExpandForm
env = function
71 | [form
] -> macroExpand
env form
72 | _ -> raise
<| Error.wrongArity
()
74 and setBinding
env first
second =
75 let s = match first
with
77 | _ -> raise
<| Error.errExpectedX
"symbol"
78 let form = eval
env second
81 and letStarForm
outer = function
83 let inner = Env.makeNew
outer [] []
84 let binder = setBinding
inner
86 | List(_) | Vector(_) -> iterPairs
binder bindings
87 | _ -> raise
<| Error.errExpectedX
"list or vector"
89 | _ -> raise
<| Error.wrongArity
()
91 and ifForm
env = function
92 | [condForm
; trueForm
; falseForm
] -> ifForm3
env condForm trueForm falseForm
93 | [condForm
; trueForm
] -> ifForm3
env condForm trueForm
Nil
94 | _ -> raise
<| Error.wrongArity
()
96 and ifForm3
env condForm trueForm falseForm
=
97 match eval
env condForm
with
98 | Bool(false) | Nil -> falseForm
101 and doForm
env = function
106 | _ -> raise
<| Error.wrongArity
()
108 and fnStarForm
outer nodes
=
109 let makeFunc binds
body =
111 let inner = Env.makeNew
outer binds
nodes
113 Env.makeFunc f body binds
outer
116 | [List(_, binds
); body] -> makeFunc binds
body
117 | [Vector(_, seg
); body] -> makeFunc (List.ofSeq seg
) body
118 | [_; _] -> raise
<| Error.errExpectedX
"bindings of list or vector"
119 | _ -> raise
<| Error.wrongArity
()
121 and eval
env = function
122 | List(_, _) as node ->
123 match macroExpand
env node with
124 | List(_, []) as emptyList -> emptyList
125 | List(_, Symbol("def!")::rest
) -> defBangForm
env rest
126 | List(_, Symbol("defmacro!")::rest
) -> defMacroForm
env rest
127 | List(_, Symbol("macroexpand")::rest
) -> macroExpandForm
env rest
128 | List(_, Symbol("let*")::rest
) ->
129 let inner, form = letStarForm
env rest
131 | List(_, Symbol("if")::rest
) -> ifForm
env rest
|> eval
env
132 | List(_, Symbol("do")::rest
) -> doForm
env rest
|> eval
env
133 | List(_, Symbol("fn*")::rest
) -> fnStarForm
env rest
134 | List(_, Symbol("quote")::rest
) -> quoteForm rest
135 | List(_, [Symbol("quasiquoteexpand");form]) -> quasiquote
form
136 | List(_, Symbol("quasiquoteexpand")::_) -> raise
<| Error.wrongArity
()
137 | List(_, [Symbol("quasiquote");form]) -> eval
env <| quasiquote form
138 | List(_, Symbol("quasiquote")::_) -> raise
<| Error.wrongArity
()
139 | List(_, _) as node ->
140 let resolved = node |> eval_ast
env
142 | List(_, BuiltInFunc(_, _, f)::rest
) -> f rest
143 | List(_, Func(_, _, _, body, binds
, outer)::rest
) ->
144 let inner = Env.makeNew
outer binds
rest
146 | _ -> raise
<| Error.errExpectedX
"func"
147 | node -> node |> eval_ast
env
148 | node -> node |> eval_ast
env
151 Reader.read_str input
165 |> Seq.choose
(fun form -> EVAL env form)
170 |> Seq.iter
(fun value
-> PRINT value
)
172 let getReadlineMode args
=
173 if args
|> Array.exists
(fun e
-> e
= "--raw") then
176 Readline.Mode.Terminal
178 let eval_func env = function
179 | [ast] -> eval
env ast
180 | _ -> raise
<| Error.wrongArity
()
182 let argv_func = function
183 | file::rest -> rest |> List.map
Types.String |> makeList
186 let configureEnv args
=
187 let env = Env.makeRootEnv
()
189 Env.set
env "eval" <| Env.makeBuiltInFunc
(fun nodes -> eval_func env nodes)
190 Env.set
env "*ARGV*" <| argv_func args
193 (def! not (fn* (a) (if a false true)))
194 (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil
)")))))
195 (defmacro! cond (fn* (& xs) (if (> (count xs) 0) (list 'if (first xs) (if (> (count xs) 1) (nth xs 1) (throw "odd number
of forms
to cond
")) (cons 'cond (rest (rest xs)))))))
196 """ |> Seq.iter ignore
202 let mode = getReadlineMode args
203 let args = Seq.ofArray
args |> Seq.filter
(fun e
-> e
<> "--raw") |> List.ofSeq
204 let env = configureEnv args
208 System.IO.File.ReadAllText file
209 |> RE env |> Seq.iter ignore
213 match Readline.read
"user> " mode with
219 | Error.EvalError(str
)
220 | Error.ReaderError(str
) ->
221 printfn
"Error: %s" str
223 printfn
"Error: %s" (ex.Message)