Commit | Line | Data |
---|---|---|
f0e1608b PS |
1 | module REPL |
2 | open System | |
3 | open Node | |
4 | open Types | |
5 | ||
6 | let rec iterPairs f = function | |
7 | | Pair(first, second, t) -> | |
8 | f first second | |
9 | iterPairs f t | |
10 | | Empty -> () | |
11 | | _ -> raise <| Error.errExpectedX "list or vector" | |
12 | ||
fbfe6784 NB |
13 | let rec qqLoop elt acc = |
14 | match elt with | |
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] | |
28 | | ast -> ast | |
f0e1608b PS |
29 | |
30 | let quoteForm = function | |
31 | | [node] -> node | |
32 | | _ -> raise <| Error.wrongArity () | |
33 | ||
34 | let rec macroExpand env = function | |
a71aefe1 | 35 | | Env.IsMacro env (Macro(_, _, f, _, _, _), rest) -> |
f0e1608b PS |
36 | f rest |> macroExpand env |
37 | | node -> node | |
38 | ||
39 | let rec eval_ast env = function | |
40 | | Symbol(sym) -> Env.get env sym | |
a71aefe1 PS |
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 | |
f0e1608b PS |
44 | | node -> node |
45 | ||
46 | and defBangForm env = function | |
47 | | [sym; form] -> | |
48 | match sym with | |
49 | | Symbol(sym) -> | |
50 | let node = eval env form | |
51 | Env.set env sym node | |
52 | node | |
53 | | _ -> raise <| Error.errExpectedX "symbol" | |
54 | | _ -> raise <| Error.wrongArity () | |
55 | ||
56 | and defMacroForm env = function | |
57 | | [sym; form] -> | |
58 | match sym with | |
59 | | Symbol(sym) -> | |
60 | let node = eval env form | |
61 | match node with | |
a71aefe1 | 62 | | Func(_, _, f, body, binds, outer) -> |
f0e1608b PS |
63 | let node = Env.makeMacro f body binds outer |
64 | Env.set env sym node | |
65 | node | |
66 | | _ -> raise <| Error.errExpectedX "user defined func" | |
67 | | _ -> raise <| Error.errExpectedX "symbol" | |
68 | | _ -> raise <| Error.wrongArity () | |
69 | ||
70 | and macroExpandForm env = function | |
71 | | [form] -> macroExpand env form | |
72 | | _ -> raise <| Error.wrongArity () | |
73 | ||
74 | and setBinding env first second = | |
75 | let s = match first with | |
76 | | Symbol(s) -> s | |
77 | | _ -> raise <| Error.errExpectedX "symbol" | |
78 | let form = eval env second | |
79 | Env.set env s form | |
80 | ||
81 | and letStarForm outer = function | |
82 | | [bindings; form] -> | |
83 | let inner = Env.makeNew outer [] [] | |
84 | let binder = setBinding inner | |
85 | match bindings with | |
86 | | List(_) | Vector(_) -> iterPairs binder bindings | |
87 | | _ -> raise <| Error.errExpectedX "list or vector" | |
88 | inner, form | |
89 | | _ -> raise <| Error.wrongArity () | |
90 | ||
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 () | |
95 | ||
96 | and ifForm3 env condForm trueForm falseForm = | |
97 | match eval env condForm with | |
98 | | Bool(false) | Nil -> falseForm | |
99 | | _ -> trueForm | |
100 | ||
101 | and doForm env = function | |
102 | | [a] -> a | |
103 | | a::rest -> | |
104 | eval env a |> ignore | |
105 | doForm env rest | |
106 | | _ -> raise <| Error.wrongArity () | |
107 | ||
108 | and fnStarForm outer nodes = | |
109 | let makeFunc binds body = | |
110 | let f = fun nodes -> | |
111 | let inner = Env.makeNew outer binds nodes | |
112 | eval inner body | |
113 | Env.makeFunc f body binds outer | |
114 | ||
115 | match nodes with | |
a71aefe1 PS |
116 | | [List(_, binds); body] -> makeFunc binds body |
117 | | [Vector(_, seg); body] -> makeFunc (List.ofSeq seg) body | |
f0e1608b PS |
118 | | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector" |
119 | | _ -> raise <| Error.wrongArity () | |
120 | ||
121 | and eval env = function | |
a71aefe1 | 122 | | List(_, _) as node -> |
f0e1608b | 123 | match macroExpand env node with |
f137cd30 | 124 | | List(_, []) as emptyList -> emptyList |
a71aefe1 PS |
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) -> | |
f0e1608b PS |
129 | let inner, form = letStarForm env rest |
130 | form |> eval inner | |
a71aefe1 PS |
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 | |
fbfe6784 NB |
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 () | |
a71aefe1 | 139 | | List(_, _) as node -> |
f0e1608b PS |
140 | let resolved = node |> eval_ast env |
141 | match resolved with | |
a71aefe1 PS |
142 | | List(_, BuiltInFunc(_, _, f)::rest) -> f rest |
143 | | List(_, Func(_, _, _, body, binds, outer)::rest) -> | |
f0e1608b PS |
144 | let inner = Env.makeNew outer binds rest |
145 | body |> eval inner | |
146 | | _ -> raise <| Error.errExpectedX "func" | |
36e287b5 | 147 | | node -> node |> eval_ast env |
f0e1608b PS |
148 | | node -> node |> eval_ast env |
149 | ||
150 | let READ input = | |
dd7a4f55 | 151 | Reader.read_str input |
f0e1608b PS |
152 | |
153 | let EVAL env ast = | |
dd7a4f55 | 154 | Some(eval env ast) |
f0e1608b PS |
155 | |
156 | let PRINT v = | |
157 | v | |
158 | |> Seq.singleton | |
159 | |> Printer.pr_str | |
160 | |> printfn "%s" | |
161 | ||
162 | let RE env input = | |
163 | READ input | |
164 | |> Seq.ofList | |
165 | |> Seq.choose (fun form -> EVAL env form) | |
166 | ||
167 | let REP env input = | |
168 | input | |
169 | |> RE env | |
170 | |> Seq.iter (fun value -> PRINT value) | |
171 | ||
172 | let getReadlineMode args = | |
173 | if args |> Array.exists (fun e -> e = "--raw") then | |
174 | Readline.Mode.Raw | |
175 | else | |
176 | Readline.Mode.Terminal | |
177 | ||
178 | let eval_func env = function | |
179 | | [ast] -> eval env ast | |
180 | | _ -> raise <| Error.wrongArity () | |
181 | ||
182 | let argv_func = function | |
a71aefe1 PS |
183 | | file::rest -> rest |> List.map Types.String |> makeList |
184 | | [] -> EmptyLIST | |
f0e1608b PS |
185 | |
186 | let configureEnv args = | |
187 | let env = Env.makeRootEnv () | |
188 | ||
189 | Env.set env "eval" <| Env.makeBuiltInFunc (fun nodes -> eval_func env nodes) | |
190 | Env.set env "*ARGV*" <| argv_func args | |
191 | ||
192 | RE env """ | |
193 | (def! not (fn* (a) (if a false true))) | |
e6d41de4 | 194 | (def! load-file (fn* (f) (eval (read-string (str "(do " (slurp f) "\nnil)"))))) |
b103e789 | 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))))))) |
f0e1608b PS |
196 | """ |> Seq.iter ignore |
197 | ||
198 | env | |
199 | ||
200 | [<EntryPoint>] | |
201 | let main args = | |
202 | let mode = getReadlineMode args | |
203 | let args = Seq.ofArray args |> Seq.filter (fun e -> e <> "--raw") |> List.ofSeq | |
204 | let env = configureEnv args | |
205 | ||
206 | match args with | |
207 | | file::_ -> | |
208 | System.IO.File.ReadAllText file | |
a1a3a8df | 209 | |> RE env |> Seq.iter ignore |
f0e1608b PS |
210 | 0 |
211 | | _ -> | |
212 | let rec loop () = | |
213 | match Readline.read "user> " mode with | |
214 | | null -> 0 | |
215 | | input -> | |
dd7a4f55 JM |
216 | try |
217 | REP env input | |
218 | with | |
219 | | Error.EvalError(str) | |
220 | | Error.ReaderError(str) -> | |
221 | printfn "Error: %s" str | |
222 | | ex -> | |
223 | printfn "Error: %s" (ex.Message) | |
f0e1608b PS |
224 | loop () |
225 | loop () |