Commit | Line | Data |
---|---|---|
8f1ee487 PS |
1 | module Eval |
2 | ||
f877bf26 | 3 | open Node |
8f1ee487 PS |
4 | open Types |
5 | ||
6 | type Env = Map<string, Node> | |
7 | ||
f877bf26 PS |
8 | let rec iterPairs f = function |
9 | | Pair(first, second, t) -> | |
10 | f first second | |
11 | iterPairs f t | |
12 | | Empty -> () | |
6d809e32 | 13 | | _ -> raise <| Error.expectedX "list or vector" |
0756d620 | 14 | |
aa2e1438 | 15 | let quasiquoteForm nodes = |
0a6323d4 PS |
16 | let transformNode f = function |
17 | | Elements 1 [|a|] -> f a | |
6d809e32 | 18 | | _ -> raise <| Error.wrongArity () |
0a6323d4 | 19 | let singleNode = transformNode (fun n -> n) |
aa2e1438 PS |
20 | let rec quasiquote node = |
21 | match node with | |
f877bf26 PS |
22 | | Cons(Symbol("unquote"), rest) -> rest |> singleNode |
23 | | Cons(Cons(Symbol("splice-unquote"), spliceRest), rest) -> | |
0a6323d4 | 24 | List([Symbol("concat"); singleNode spliceRest; quasiquote rest]) |
f877bf26 | 25 | | Cons(h, t) -> List([Symbol("cons"); quasiquote h; quasiquote t]) |
aa2e1438 | 26 | | n -> List([Symbol("quote"); n]) |
0a6323d4 PS |
27 | List(nodes) |> transformNode quasiquote |
28 | ||
29 | let quoteForm = function | |
30 | | [node] -> node | |
6d809e32 | 31 | | _ -> raise <| Error.wrongArity () |
aa2e1438 | 32 | |
8f1ee487 | 33 | let rec eval_ast env = function |
37bb752e | 34 | | Symbol(sym) -> Env.get env sym |
8f1ee487 | 35 | | List(lst) -> lst |> List.map (eval env) |> List |
0a6323d4 | 36 | | Vector(seg) -> seg |> Seq.map (eval env) |> Array.ofSeq |> Node.ofArray |
8f1ee487 PS |
37 | | Map(map) -> map |> Map.map (fun k v -> eval env v) |> Map |
38 | | node -> node | |
39 | ||
6a4627fb PS |
40 | and defBangForm env = function |
41 | | [sym; form] -> | |
1e4687b4 | 42 | match sym with |
6a4627fb PS |
43 | | Symbol(sym) -> |
44 | let node = eval env form | |
37bb752e PS |
45 | Env.set env sym node |
46 | node | |
6d809e32 PS |
47 | | _ -> raise <| Error.expectedX "symbol" |
48 | | _ -> raise <| Error.wrongArity () | |
1e4687b4 | 49 | |
0756d620 PS |
50 | and setBinding env first second = |
51 | let s = match first with | |
52 | | Symbol(s) -> s | |
6d809e32 | 53 | | _ -> raise <| Error.expectedX "symbol" |
0756d620 PS |
54 | let form = eval env second |
55 | Env.set env s form | |
1e4687b4 | 56 | |
8862f80e | 57 | and letStarForm outer = function |
6a4627fb | 58 | | [bindings; form] -> |
8862f80e PS |
59 | let inner = Env.makeNew outer [] [] |
60 | let binder = setBinding inner | |
1e4687b4 | 61 | match bindings with |
f877bf26 | 62 | | List(_) | Vector(_) -> iterPairs binder bindings |
6d809e32 | 63 | | _ -> raise <| Error.expectedX "list or vector" |
8862f80e | 64 | inner, form |
6d809e32 | 65 | | _ -> raise <| Error.wrongArity () |
37bb752e | 66 | |
6a4627fb PS |
67 | and ifForm env = function |
68 | | [condForm; trueForm; falseForm] -> ifForm3 env condForm trueForm falseForm | |
69 | | [condForm; trueForm] -> ifForm3 env condForm trueForm Nil | |
6d809e32 | 70 | | _ -> raise <| Error.wrongArity () |
6a4627fb PS |
71 | |
72 | and ifForm3 env condForm trueForm falseForm = | |
73 | match eval env condForm with | |
8862f80e PS |
74 | | Bool(false) | Nil -> falseForm |
75 | | _ -> trueForm | |
6a4627fb PS |
76 | |
77 | and doForm env = function | |
8862f80e | 78 | | [a] -> a |
6a4627fb PS |
79 | | a::rest -> |
80 | eval env a |> ignore | |
81 | doForm env rest | |
6d809e32 | 82 | | _ -> raise <| Error.wrongArity () |
6a4627fb | 83 | |
a97c3028 PS |
84 | and fnStarForm outer nodes = |
85 | let makeFunc binds body = | |
8862f80e PS |
86 | let f = fun nodes -> |
87 | let inner = Env.makeNew outer binds nodes | |
88 | eval inner body | |
89 | Env.makeFunc f body binds outer | |
a97c3028 PS |
90 | |
91 | match nodes with | |
92 | | [List(binds); body] -> makeFunc binds body | |
aac99bed | 93 | | [Vector(seg); body] -> makeFunc (List.ofSeq seg) body |
6d809e32 PS |
94 | | [_; _] -> raise <| Error.expectedX "bindings of list or vector" |
95 | | _ -> raise <| Error.wrongArity () | |
a97c3028 | 96 | |
8f1ee487 | 97 | and eval env = function |
6a4627fb | 98 | | List(Symbol("def!")::rest) -> defBangForm env rest |
8862f80e PS |
99 | | List(Symbol("let*")::rest) -> |
100 | let inner, form = letStarForm env rest | |
101 | form |> eval inner | |
102 | | List(Symbol("if")::rest) -> ifForm env rest |> eval env | |
103 | | List(Symbol("do")::rest) -> doForm env rest |> eval env | |
a97c3028 | 104 | | List(Symbol("fn*")::rest) -> fnStarForm env rest |
aa2e1438 PS |
105 | | List(Symbol("quote")::rest) -> quoteForm rest |
106 | | List(Symbol("quasiquote")::rest) -> quasiquoteForm rest |> eval env | |
8f1ee487 PS |
107 | | List(_) as node -> |
108 | let resolved = node |> eval_ast env | |
109 | match resolved with | |
8862f80e PS |
110 | | List(Func(_, f, _, _, [])::rest) -> f rest |
111 | | List(Func(_, _, body, binds, outer)::rest) -> | |
112 | let inner = Env.makeNew outer binds rest | |
113 | body |> eval inner | |
6d809e32 | 114 | | _ -> raise <| Error.expectedX "function" |
8f1ee487 | 115 | | node -> node |> eval_ast env |