Commit | Line | Data |
---|---|---|
a836d8f3 PS |
1 | module REPL |
2 | open System | |
e72de6d2 PS |
3 | open Node |
4 | open Types | |
a836d8f3 | 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" |
e72de6d2 PS |
12 | |
13 | let rec eval_ast env = function | |
14 | | Symbol(sym) -> Env.get env sym | |
a71aefe1 PS |
15 | | List(_, lst) -> lst |> List.map (eval env) |> makeList |
16 | | Vector(_, seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray | |
17 | | Map(_, map) -> map |> Map.map (fun k v -> eval env v) |> makeMap | |
e72de6d2 PS |
18 | | node -> node |
19 | ||
20 | and defBangForm env = function | |
21 | | [sym; form] -> | |
22 | match sym with | |
23 | | Symbol(sym) -> | |
24 | let node = eval env form | |
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 letStarForm env = function | |
38 | | [bindings; form] -> | |
39 | let newEnv = Env.makeNew env [] [] | |
40 | let binder = setBinding newEnv | |
41 | match bindings with | |
a71aefe1 | 42 | | List(_, _) | Vector(_, _) -> iterPairs binder bindings |
e72de6d2 PS |
43 | | _ -> raise <| Error.errExpectedX "list or vector" |
44 | eval newEnv form | |
45 | | _ -> raise <| Error.wrongArity () | |
46 | ||
47 | and ifForm env = function | |
48 | | [condForm; trueForm; falseForm] -> ifForm3 env condForm trueForm falseForm | |
49 | | [condForm; trueForm] -> ifForm3 env condForm trueForm Nil | |
50 | | _ -> raise <| Error.wrongArity () | |
51 | ||
52 | and ifForm3 env condForm trueForm falseForm = | |
53 | match eval env condForm with | |
54 | | Bool(false) | Nil -> eval env falseForm | |
55 | | _ -> eval env trueForm | |
56 | ||
57 | and doForm env = function | |
58 | | [a] -> eval env a | |
59 | | a::rest -> | |
60 | eval env a |> ignore | |
61 | doForm env rest | |
62 | | _ -> raise <| Error.wrongArity () | |
63 | ||
64 | and fnStarForm outer nodes = | |
65 | let makeFunc binds body = | |
66 | let f = fun nodes -> | |
67 | let inner = Env.makeNew outer binds nodes | |
68 | eval inner body | |
69 | Env.makeFunc f body binds outer | |
70 | ||
71 | match nodes with | |
a71aefe1 PS |
72 | | [List(_, binds); body] -> makeFunc binds body |
73 | | [Vector(_, seg); body] -> makeFunc (List.ofSeq seg) body | |
e72de6d2 PS |
74 | | [_; _] -> raise <| Error.errExpectedX "bindings of list or vector" |
75 | | _ -> raise <| Error.wrongArity () | |
76 | ||
77 | and eval env = function | |
a71aefe1 PS |
78 | | List(_, Symbol("def!")::rest) -> defBangForm env rest |
79 | | List(_, Symbol("let*")::rest) -> letStarForm env rest | |
80 | | List(_, Symbol("if")::rest) -> ifForm env rest | |
81 | | List(_, Symbol("do")::rest) -> doForm env rest | |
82 | | List(_, Symbol("fn*")::rest) -> fnStarForm env rest | |
83 | | List(_, _) as node -> | |
e72de6d2 PS |
84 | let resolved = node |> eval_ast env |
85 | match resolved with | |
a71aefe1 PS |
86 | | List(_, BuiltInFunc(_, _, f)::rest) -> f rest |
87 | | List(_, Func(_, _, _, body, binds, outer)::rest) -> | |
e72de6d2 PS |
88 | let inner = Env.makeNew outer binds rest |
89 | body |> eval inner | |
f0e1608b | 90 | | _ -> raise <| Error.errExpectedX "func" |
e72de6d2 PS |
91 | | node -> node |> eval_ast env |
92 | ||
93 | let READ input = | |
a836d8f3 PS |
94 | try |
95 | Reader.read_str input | |
96 | with | |
6d809e32 | 97 | | Error.ReaderError(msg) -> |
a836d8f3 PS |
98 | printfn "%s" msg |
99 | [] | |
100 | ||
e72de6d2 | 101 | let EVAL env ast = |
a836d8f3 | 102 | try |
e72de6d2 | 103 | Some(eval env ast) |
a836d8f3 | 104 | with |
6d809e32 PS |
105 | | Error.EvalError(msg) |
106 | | Error.ReaderError(msg) -> | |
a836d8f3 PS |
107 | printfn "%s" msg |
108 | None | |
109 | ||
e72de6d2 | 110 | let PRINT v = |
a836d8f3 | 111 | v |
6a4627fb | 112 | |> Seq.singleton |
a836d8f3 PS |
113 | |> Printer.pr_str |
114 | |> printfn "%s" | |
115 | ||
e72de6d2 PS |
116 | let RE env input = |
117 | READ input | |
a836d8f3 | 118 | |> Seq.ofList |
e72de6d2 | 119 | |> Seq.choose (fun form -> EVAL env form) |
a97c3028 | 120 | |
e72de6d2 | 121 | let REP env input = |
a97c3028 | 122 | input |
e72de6d2 PS |
123 | |> RE env |
124 | |> Seq.iter (fun value -> PRINT value) | |
a836d8f3 | 125 | |
52c92124 PS |
126 | let getReadlineMode args = |
127 | if args |> Array.exists (fun e -> e = "--raw") then | |
a836d8f3 PS |
128 | Readline.Mode.Raw |
129 | else | |
130 | Readline.Mode.Terminal | |
131 | ||
132 | [<EntryPoint>] | |
133 | let main args = | |
134 | let mode = getReadlineMode args | |
135 | let env = Env.makeRootEnv () | |
a97c3028 | 136 | |
e72de6d2 | 137 | RE env "(def! not (fn* (a) (if a false true)))" |> Seq.iter ignore |
a97c3028 | 138 | |
a836d8f3 PS |
139 | let rec loop () = |
140 | match Readline.read "user> " mode with | |
141 | | null -> 0 | |
142 | | input -> | |
e72de6d2 | 143 | REP env input |
a836d8f3 PS |
144 | loop () |
145 | loop () |