Commit | Line | Data |
---|---|---|
aa2e1438 PS |
1 | module REPL |
2 | open System | |
4f3f9cd5 PS |
3 | open Node |
4 | open Types | |
aa2e1438 | 5 | |
4f3f9cd5 PS |
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 | |
4f3f9cd5 PS |
26 | |
27 | let quoteForm = function | |
28 | | [node] -> node | |
29 | | _ -> raise <| Error.wrongArity () | |
30 | ||
31 | let rec eval_ast env = function | |
32 | | Symbol(sym) -> Env.get env sym | |
a71aefe1 PS |
33 | | List(_, lst) -> lst |> List.map (eval env) |> makeList |
34 | | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray | |
35 | | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap | |
4f3f9cd5 PS |
36 | | node -> node |
37 | ||
38 | and defBangForm env = function | |
39 | | [sym; form] -> | |
40 | match sym with | |
41 | | Symbol(sym) -> | |
42 | let node = eval env form | |
43 | Env.set env sym node | |
44 | node | |
45 | | _ -> raise <| Error.errExpectedX "symbol" | |
46 | | _ -> raise <| Error.wrongArity () | |
47 | ||
48 | and setBinding env first second = | |
49 | let s = match first with | |
50 | | Symbol(s) -> s | |
51 | | _ -> raise <| Error.errExpectedX "symbol" | |
52 | let form = eval env second | |
53 | Env.set env s form | |
54 | ||
55 | and letStarForm outer = function | |
56 | | [bindings; form] -> | |
57 | let inner = Env.makeNew outer [] [] | |
58 | let binder = setBinding inner | |
59 | match bindings with | |
60 | | List(_) | Vector(_) -> iterPairs binder bindings | |
61 | | _ -> raise <| Error.errExpectedX "list or vector" | |
62 | inner, form | |
63 | | _ -> raise <| Error.wrongArity () | |
64 | ||
65 | and ifForm env = function | |
66 | | [condForm; trueForm; falseForm] -> ifForm3 env condForm trueForm falseForm | |
67 | | [condForm; trueForm] -> ifForm3 env condForm trueForm Nil | |
68 | | _ -> raise <| Error.wrongArity () | |
69 | ||
70 | and ifForm3 env condForm trueForm falseForm = | |
71 | match eval env condForm with | |
72 | | Bool(false) | Nil -> falseForm | |
73 | | _ -> trueForm | |
74 | ||
75 | and doForm env = function | |
76 | | [a] -> a | |
77 | | a::rest -> | |
78 | eval env a |> ignore | |
79 | doForm env rest | |
80 | | _ -> raise <| Error.wrongArity () | |
81 | ||
82 | and fnStarForm outer nodes = | |
83 | let makeFunc binds body = | |
84 | let f = fun nodes -> | |
85 | let inner = Env.makeNew outer binds nodes | |
86 | eval inner body | |
87 | Env.makeFunc f body binds outer | |
88 | ||
89 | match nodes with | |
a71aefe1 PS |
90 | | [List(_, binds); body] -> makeFunc binds body |
91 | | [Vector(_, seg); body] -> makeFunc (List.ofSeq seg) body | |
4f3f9cd5 PS |
92 | | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector" |
93 | | _ -> raise <| Error.wrongArity () | |
94 | ||
95 | and eval env = function | |
a71aefe1 PS |
96 | | List(_, Symbol("def!")::rest) -> defBangForm env rest |
97 | | List(_, Symbol("let*")::rest) -> | |
4f3f9cd5 PS |
98 | let inner, form = letStarForm env rest |
99 | form |> eval inner | |
a71aefe1 PS |
100 | | List(_, Symbol("if")::rest) -> ifForm env rest |> eval env |
101 | | List(_, Symbol("do")::rest) -> doForm env rest |> eval env | |
102 | | List(_, Symbol("fn*")::rest) -> fnStarForm env rest | |
103 | | List(_, Symbol("quote")::rest) -> quoteForm rest | |
104 | | List(_, Symbol("quasiquote")::rest) -> quasiquoteForm rest |> eval env | |
105 | | List(_, _) as node -> | |
4f3f9cd5 PS |
106 | let resolved = node |> eval_ast env |
107 | match resolved with | |
a71aefe1 PS |
108 | | List(_, BuiltInFunc(_, _, f)::rest) -> f rest |
109 | | List(_, Func(_, _, _, body, binds, outer)::rest) -> | |
4f3f9cd5 PS |
110 | let inner = Env.makeNew outer binds rest |
111 | body |> eval inner | |
f0e1608b | 112 | | _ -> raise <| Error.errExpectedX "func" |
4f3f9cd5 PS |
113 | | node -> node |> eval_ast env |
114 | ||
115 | let READ input = | |
aa2e1438 PS |
116 | try |
117 | Reader.read_str input | |
118 | with | |
6d809e32 | 119 | | Error.ReaderError(msg) -> |
aa2e1438 PS |
120 | printfn "%s" msg |
121 | [] | |
122 | ||
4f3f9cd5 | 123 | let EVAL env ast = |
aa2e1438 | 124 | try |
4f3f9cd5 | 125 | Some(eval env ast) |
aa2e1438 | 126 | with |
6d809e32 | 127 | | Error.EvalError(msg) -> |
aa2e1438 PS |
128 | printfn "%s" msg |
129 | None | |
130 | ||
4f3f9cd5 | 131 | let PRINT v = |
aa2e1438 PS |
132 | v |
133 | |> Seq.singleton | |
134 | |> Printer.pr_str | |
135 | |> printfn "%s" | |
136 | ||
4f3f9cd5 PS |
137 | let RE env input = |
138 | READ input | |
aa2e1438 | 139 | |> Seq.ofList |
4f3f9cd5 | 140 | |> Seq.choose (fun form -> EVAL env form) |
aa2e1438 | 141 | |
4f3f9cd5 | 142 | let REP env input = |
aa2e1438 | 143 | input |
4f3f9cd5 PS |
144 | |> RE env |
145 | |> Seq.iter (fun value -> PRINT value) | |
aa2e1438 PS |
146 | |
147 | let getReadlineMode args = | |
148 | if args |> Array.exists (fun e -> e = "--raw") then | |
149 | Readline.Mode.Raw | |
150 | else | |
151 | Readline.Mode.Terminal | |
152 | ||
153 | let eval_func env = function | |
4f3f9cd5 | 154 | | [ast] -> eval env ast |
6d809e32 | 155 | | _ -> raise <| Error.wrongArity () |
aa2e1438 PS |
156 | |
157 | let argv_func = function | |
a71aefe1 PS |
158 | | file::rest -> rest |> List.map Types.String |> makeList |
159 | | [] -> EmptyLIST | |
aa2e1438 PS |
160 | |
161 | let configureEnv args = | |
162 | let env = Env.makeRootEnv () | |
163 | ||
164 | Env.set env "eval" <| Env.makeBuiltInFunc (fun nodes -> eval_func env nodes) | |
165 | Env.set env "*ARGV*" <| argv_func args | |
166 | ||
4f3f9cd5 | 167 | RE env """ |
aa2e1438 PS |
168 | (def! not (fn* (a) (if a false true))) |
169 | (def! load-file (fn* (f) (eval (read-string (slurp f))))) | |
170 | """ |> Seq.iter ignore | |
171 | ||
172 | env | |
173 | ||
174 | [<EntryPoint>] | |
175 | let main args = | |
176 | let mode = getReadlineMode args | |
177 | let args = Seq.ofArray args |> Seq.filter (fun e -> e <> "--raw") |> List.ofSeq | |
178 | let env = configureEnv args | |
179 | ||
180 | match args with | |
181 | | file::_ -> | |
182 | System.IO.File.ReadAllText file | |
4f3f9cd5 | 183 | |> REP env |
aa2e1438 PS |
184 | 0 |
185 | | _ -> | |
186 | let rec loop () = | |
187 | match Readline.read "user> " mode with | |
188 | | null -> 0 | |
189 | | input -> | |
4f3f9cd5 | 190 | REP env input |
aa2e1438 PS |
191 | loop () |
192 | loop () |