Commit | Line | Data |
---|---|---|
37bb752e PS |
1 | module REPL |
2 | open System | |
e72de6d2 | 3 | open Node |
52bc43ad | 4 | open Types |
37bb752e | 5 | |
e72de6d2 PS |
6 | let rec iterPairs f = function |
7 | | Pair(first, second, t) -> | |
8 | f first second | |
9 | iterPairs f t | |
10 | | Empty -> () | |
a12b216d | 11 | | _ -> raise <| Error.errExpectedX "list or vector" |
52bc43ad PS |
12 | |
13 | let rec eval_ast env = function | |
14 | | Symbol(sym) -> Env.get env sym | |
15 | | List(lst) -> lst |> List.map (eval env) |> List | |
16 | | Vector(seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray | |
17 | | Map(map) -> map |> Map.map (fun k v -> eval env v) |> Map | |
18 | | node -> node | |
19 | ||
20 | and defBang env = function | |
21 | | sym::node::[] -> | |
22 | match sym with | |
23 | | Symbol(sym) -> | |
24 | let node = eval env node | |
25 | Env.set env sym node | |
26 | node | |
27 | | _ -> raise <| Error.errExpectedX "symbol" | |
28 | | _ -> raise <| Error.wrongArity () | |
29 | ||
30 | and setBinding env first second = | |
31 | let s = match first with | |
32 | | Symbol(s) -> s | |
33 | | _ -> raise <| Error.errExpectedX "symbol" | |
34 | let form = eval env second | |
35 | Env.set env s form | |
36 | ||
37 | and letStar env = function | |
38 | | bindings::form::[] -> | |
39 | let newEnv = Env.makeNew env [] [] | |
40 | let binder = setBinding newEnv | |
41 | match bindings with | |
e72de6d2 | 42 | | List(_) | Vector(_) -> iterPairs binder bindings |
52bc43ad PS |
43 | | _ -> raise <| Error.errExpectedX "list or vector" |
44 | eval newEnv form | |
45 | | _ -> raise <| Error.wrongArity () | |
46 | ||
47 | and eval env = function | |
48 | | List(Symbol("def!")::rest) -> defBang env rest | |
49 | | List(Symbol("let*")::rest) -> letStar env rest | |
50 | | List(_) as node -> | |
51 | let resolved = node |> eval_ast env | |
52 | match resolved with | |
f0e1608b PS |
53 | | List(BuiltInFunc(_, f)::rest) -> f rest |
54 | | _ -> raise <| Error.errExpectedX "func" | |
52bc43ad PS |
55 | | node -> node |> eval_ast env |
56 | ||
57 | let READ input = | |
37bb752e PS |
58 | try |
59 | Reader.read_str input | |
60 | with | |
6d809e32 | 61 | | Error.ReaderError(msg) -> |
37bb752e PS |
62 | printfn "%s" msg |
63 | [] | |
64 | ||
52bc43ad | 65 | let EVAL env ast = |
37bb752e | 66 | try |
52bc43ad | 67 | Some(eval env ast) |
37bb752e | 68 | with |
6d809e32 PS |
69 | | Error.EvalError(msg) |
70 | | Error.ReaderError(msg) -> | |
37bb752e PS |
71 | printfn "%s" msg |
72 | None | |
73 | ||
52bc43ad | 74 | let PRINT v = |
37bb752e | 75 | v |
6a4627fb | 76 | |> Seq.singleton |
37bb752e PS |
77 | |> Printer.pr_str |
78 | |> printfn "%s" | |
79 | ||
52bc43ad PS |
80 | let REP env input = |
81 | READ input | |
37bb752e | 82 | |> Seq.ofList |
52bc43ad PS |
83 | |> Seq.choose (fun form -> EVAL env form) |
84 | |> Seq.iter (fun value -> PRINT value) | |
37bb752e | 85 | |
52c92124 PS |
86 | let getReadlineMode args = |
87 | if args |> Array.exists (fun e -> e = "--raw") then | |
37bb752e PS |
88 | Readline.Mode.Raw |
89 | else | |
90 | Readline.Mode.Terminal | |
91 | ||
92 | [<EntryPoint>] | |
93 | let main args = | |
94 | let mode = getReadlineMode args | |
95 | let env = Env.makeRootEnv () | |
96 | let rec loop () = | |
97 | match Readline.read "user> " mode with | |
98 | | null -> 0 | |
99 | | input -> | |
52bc43ad | 100 | REP env input |
37bb752e PS |
101 | loop () |
102 | loop () |