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 | ||
13 | let quasiquoteForm nodes = | |
14 | let transformNode f = function | |
15 | | Elements 1 [|a|] -> f a | |
16 | | _ -> raise <| Error.wrongArity () | |
17 | let singleNode = transformNode (fun n -> n) | |
18 | let rec quasiquote node = | |
19 | match node with | |
20 | | Cons(Symbol("unquote"), rest) -> rest |> singleNode | |
21 | | Cons(Cons(Symbol("splice-unquote"), spliceRest), rest) -> | |
a71aefe1 PS |
22 | makeList [Symbol("concat"); singleNode spliceRest; quasiquote rest] |
23 | | Cons(h, t) -> makeList [Symbol("cons"); quasiquote h; quasiquote t] | |
24 | | n -> makeList [Symbol("quote"); n] | |
25 | makeList nodes |> transformNode quasiquote | |
f0e1608b PS |
26 | |
27 | let quoteForm = function | |
28 | | [node] -> node | |
29 | | _ -> raise <| Error.wrongArity () | |
30 | ||
31 | let rec macroExpand env = function | |
a71aefe1 | 32 | | Env.IsMacro env (Macro(_, _, f, _, _, _), rest) -> |
f0e1608b PS |
33 | f rest |> macroExpand env |
34 | | node -> node | |
35 | ||
36 | let rec eval_ast env = function | |
37 | | Symbol(sym) -> Env.get env sym | |
a71aefe1 PS |
38 | | List(_, lst) -> lst |> List.map (eval env) |> makeList |
39 | | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray | |
40 | | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap | |
f0e1608b PS |
41 | | node -> node |
42 | ||
43 | and defBangForm env = function | |
44 | | [sym; form] -> | |
45 | match sym with | |
46 | | Symbol(sym) -> | |
47 | let node = eval env form | |
48 | Env.set env sym node | |
49 | node | |
50 | | _ -> raise <| Error.errExpectedX "symbol" | |
51 | | _ -> raise <| Error.wrongArity () | |
52 | ||
53 | and defMacroForm env = function | |
54 | | [sym; form] -> | |
55 | match sym with | |
56 | | Symbol(sym) -> | |
57 | let node = eval env form | |
58 | match node with | |
a71aefe1 | 59 | | Func(_, _, f, body, binds, outer) -> |
f0e1608b PS |
60 | let node = Env.makeMacro f body binds outer |
61 | Env.set env sym node | |
62 | node | |
63 | | _ -> raise <| Error.errExpectedX "user defined func" | |
64 | | _ -> raise <| Error.errExpectedX "symbol" | |
65 | | _ -> raise <| Error.wrongArity () | |
66 | ||
67 | and macroExpandForm env = function | |
68 | | [form] -> macroExpand env form | |
69 | | _ -> raise <| Error.wrongArity () | |
70 | ||
71 | and setBinding env first second = | |
72 | let s = match first with | |
73 | | Symbol(s) -> s | |
74 | | _ -> raise <| Error.errExpectedX "symbol" | |
75 | let form = eval env second | |
76 | Env.set env s form | |
77 | ||
78 | and letStarForm outer = function | |
79 | | [bindings; form] -> | |
80 | let inner = Env.makeNew outer [] [] | |
81 | let binder = setBinding inner | |
82 | match bindings with | |
83 | | List(_) | Vector(_) -> iterPairs binder bindings | |
84 | | _ -> raise <| Error.errExpectedX "list or vector" | |
85 | inner, form | |
86 | | _ -> raise <| Error.wrongArity () | |
87 | ||
88 | and ifForm env = function | |
89 | | [condForm; trueForm; falseForm] -> ifForm3 env condForm trueForm falseForm | |
90 | | [condForm; trueForm] -> ifForm3 env condForm trueForm Nil | |
91 | | _ -> raise <| Error.wrongArity () | |
92 | ||
93 | and ifForm3 env condForm trueForm falseForm = | |
94 | match eval env condForm with | |
95 | | Bool(false) | Nil -> falseForm | |
96 | | _ -> trueForm | |
97 | ||
98 | and doForm env = function | |
99 | | [a] -> a | |
100 | | a::rest -> | |
101 | eval env a |> ignore | |
102 | doForm env rest | |
103 | | _ -> raise <| Error.wrongArity () | |
104 | ||
105 | and fnStarForm outer nodes = | |
106 | let makeFunc binds body = | |
107 | let f = fun nodes -> | |
108 | let inner = Env.makeNew outer binds nodes | |
109 | eval inner body | |
110 | Env.makeFunc f body binds outer | |
111 | ||
112 | match nodes with | |
a71aefe1 PS |
113 | | [List(_, binds); body] -> makeFunc binds body |
114 | | [Vector(_, seg); body] -> makeFunc (List.ofSeq seg) body | |
f0e1608b PS |
115 | | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector" |
116 | | _ -> raise <| Error.wrongArity () | |
117 | ||
118 | and eval env = function | |
a71aefe1 | 119 | | List(_, _) as node -> |
f0e1608b | 120 | match macroExpand env node with |
a71aefe1 PS |
121 | | List(_, Symbol("def!")::rest) -> defBangForm env rest |
122 | | List(_, Symbol("defmacro!")::rest) -> defMacroForm env rest | |
123 | | List(_, Symbol("macroexpand")::rest) -> macroExpandForm env rest | |
124 | | List(_, Symbol("let*")::rest) -> | |
f0e1608b PS |
125 | let inner, form = letStarForm env rest |
126 | form |> eval inner | |
a71aefe1 PS |
127 | | List(_, Symbol("if")::rest) -> ifForm env rest |> eval env |
128 | | List(_, Symbol("do")::rest) -> doForm env rest |> eval env | |
129 | | List(_, Symbol("fn*")::rest) -> fnStarForm env rest | |
130 | | List(_, Symbol("quote")::rest) -> quoteForm rest | |
131 | | List(_, Symbol("quasiquote")::rest) -> quasiquoteForm rest |> eval env | |
132 | | List(_, _) as node -> | |
f0e1608b PS |
133 | let resolved = node |> eval_ast env |
134 | match resolved with | |
a71aefe1 PS |
135 | | List(_, BuiltInFunc(_, _, f)::rest) -> f rest |
136 | | List(_, Func(_, _, _, body, binds, outer)::rest) -> | |
f0e1608b PS |
137 | let inner = Env.makeNew outer binds rest |
138 | body |> eval inner | |
139 | | _ -> raise <| Error.errExpectedX "func" | |
140 | | node -> node | |
141 | | node -> node |> eval_ast env | |
142 | ||
143 | let READ input = | |
144 | try | |
145 | Reader.read_str input | |
146 | with | |
147 | | Error.ReaderError(msg) -> | |
148 | printfn "%s" msg | |
149 | [] | |
150 | ||
151 | let EVAL env ast = | |
152 | try | |
153 | Some(eval env ast) | |
154 | with | |
155 | | Error.EvalError(msg) -> | |
156 | printfn "%s" msg | |
157 | None | |
158 | ||
159 | let PRINT v = | |
160 | v | |
161 | |> Seq.singleton | |
162 | |> Printer.pr_str | |
163 | |> printfn "%s" | |
164 | ||
165 | let RE env input = | |
166 | READ input | |
167 | |> Seq.ofList | |
168 | |> Seq.choose (fun form -> EVAL env form) | |
169 | ||
170 | let REP env input = | |
171 | input | |
172 | |> RE env | |
173 | |> Seq.iter (fun value -> PRINT value) | |
174 | ||
175 | let getReadlineMode args = | |
176 | if args |> Array.exists (fun e -> e = "--raw") then | |
177 | Readline.Mode.Raw | |
178 | else | |
179 | Readline.Mode.Terminal | |
180 | ||
181 | let eval_func env = function | |
182 | | [ast] -> eval env ast | |
183 | | _ -> raise <| Error.wrongArity () | |
184 | ||
185 | let argv_func = function | |
a71aefe1 PS |
186 | | file::rest -> rest |> List.map Types.String |> makeList |
187 | | [] -> EmptyLIST | |
f0e1608b PS |
188 | |
189 | let configureEnv args = | |
190 | let env = Env.makeRootEnv () | |
191 | ||
192 | Env.set env "eval" <| Env.makeBuiltInFunc (fun nodes -> eval_func env nodes) | |
193 | Env.set env "*ARGV*" <| argv_func args | |
194 | ||
195 | RE env """ | |
196 | (def! not (fn* (a) (if a false true))) | |
197 | (def! load-file (fn* (f) (eval (read-string (slurp f))))) | |
198 | (defmacro! or (fn* (& xs) (if (empty? xs) nil (if (= 1 (count xs)) (first xs) `(let* (or_ ~(first xs)) (if or_ or_ (or ~@(rest xs)))))))) | |
b103e789 | 199 | (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 |
200 | """ |> Seq.iter ignore |
201 | ||
202 | env | |
203 | ||
204 | [<EntryPoint>] | |
205 | let main args = | |
206 | let mode = getReadlineMode args | |
207 | let args = Seq.ofArray args |> Seq.filter (fun e -> e <> "--raw") |> List.ofSeq | |
208 | let env = configureEnv args | |
209 | ||
210 | match args with | |
211 | | file::_ -> | |
212 | System.IO.File.ReadAllText file | |
213 | |> REP env | |
214 | 0 | |
215 | | _ -> | |
216 | let rec loop () = | |
217 | match Readline.read "user> " mode with | |
218 | | null -> 0 | |
219 | | input -> | |
220 | REP env input | |
221 | loop () | |
222 | loop () |