-
Notifications
You must be signed in to change notification settings - Fork 0
/
eval.ml
181 lines (152 loc) · 7.27 KB
/
eval.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
open Ast
(******************************************************************************)
(** types (see .mli) **********************************************************)
(******************************************************************************)
type value =
| VUnit | VInt of int | VBool of bool | VString of string
| VClosure of var * expr * environment
| VVariant of constructor * value
| VPair of value * value
| VError of string
and environment = (var * value ref) list
(******************************************************************************)
(** (optional) helper functions ***********************************************)
(******************************************************************************)
(** you may find it helpful to implement these or other helper
* functions, but they are not required. Feel free to implement them if you
* need them, change their types or arguments, delete them, whatever.
*)
(**
* try to match a value against a pattern. If the match succeeds, return an
* environment containing all of the bindings. If it fails, return None.
*)
let rec find_match (p : pattern) (v : value) : environment option =
failwith "Hot tunnels alternated with cool tunnels."
(** apply the given operator to the given arguments *)
let rec eval_operator op v1 v2 =
match v1 with
| VUnit -> (match v2 with
| VUnit -> if (op=Eq) then VBool true
else if (op=NotEq) then VBool false
else VError "Invalid operator"
| _ -> VError "Value mismatch")
| VInt i -> ( match v2 with
| VInt j -> if (op=Plus) then VInt (i+j)
else if (op=Minus) then VInt (i-j)
else if (op=Times) then VInt (i*j)
else if (op=Gt) then VBool (i>j)
else if (op=Lt) then VBool (i<j)
else if (op=GtEq) then VBool (i>=j)
else if (op=LtEq) then VBool (i<=j)
else if (op=NotEq) then VBool (i!=j)
else if (op=Eq) then VBool (i=j)
else VError "Invalid operator"
| _ -> VError "Value mismatch")
| VBool b -> (match v2 with
| VBool c -> if (op=Eq) then VBool (b=c)
else if (op=NotEq) then VBool (b!=c)
else VError "Invalid operator"
| _ -> VError "Value mismatch")
| VString s -> (match v2 with
| VString t -> if (op=Concat) then VString (s^t)
else if (op=Eq) then VBool ((compare s t)=0)
else if (op=NotEq) then VBool ((compare s t)!=0)
else VError "Invalid operator"
| _ -> VError "Value mismatch")
| VPair (x,y) -> (match v2 with
| VPair (a,b) -> VPair (eval_operator op x a,eval_operator op y b)
| _ -> VError "Value mismatch")
| _ -> VError "Invalid values"
(** Format a value for printing. *)
let rec format_value (f : Format.formatter) (v : value) : unit =
(* You will probably want to call Format.fprint f f <format string> <args>.
*
* Format.fprintf f <format string> has a different type depeding on the format
* string. For example, Format.fprintf f "%s" has type string -> unit, while
* Format.fprintf f "%i" has type int -> unit.
*
* Format.fprintf f "%a" is also useful. It has type
* (Format.formatter -> 'a -> unit) -> 'a -> unit
* which is useful for recursively formatting values.
*
* Format strings can contain multiple flags and also other things to be
* printed. For example (Format.fprintf f "result: %i %s") has type
* int -> string -> unit, so you can write
*
* Format.fprintf f "result: %i %s" 3 "blind mice"
*
* to output "result: 3 blind mice"
*
* See the documentation of the OCaml Printf module for the list of % flags,
* and see the printer.ml for some (complicated) examples. Printer, format_type is
* a nice example.
*)
failwith "The light was frozen, dead, a ghost."
(** use format_value to print a value to the console *)
let print_value = Printer.make_printer format_value
(** use format_value to convert a value to a string *)
let string_of_value = Printer.make_string_of format_value
(******************************************************************************)
(** eval **********************************************************************)
(******************************************************************************)
let rec eval env e =
match e with
| Unit -> VUnit
| Int a -> VInt a
| Bool a -> VBool a
| String a -> VString a
| BinOp (o,e1,e2) -> eval_operator o (eval env e1) (eval env e2)
| If (e1,e2,e3) -> (match (eval env e1) with
| VBool a -> if (a=true) then eval env e2
else if (a=false) then eval env e3
else VError "Invalid evaluation of bool"
| _ -> VError "Invalid evaluation of bool")
| Var a -> (match env with
| [] -> VError "Variable not found"
| h::d -> let (j,k) = h in
if (a=j) then (!k)
else eval d e)
| Let (v,e1,e2) -> let x = eval env e1 in
eval ((v,ref x)::env) e2
| LetRec (f,e1,e2) -> let g = VError "Not defined" in
let env1 = (f,ref g)::env in
let x = eval env e1 in
eval ((f,ref x)::env1) e2
| App (e1,e2) -> (match e1 with
| Fun (v,e) -> let x = eval env e2 in
eval ((v,ref x)::env) e
| _ -> VError "Cannot apply to non function")
| Fun (v,e) -> VClosure (v,e,env)
| Pair (e1,e2) -> VPair (eval env e1, eval env e2)
| Variant (c,e2) -> VVariant (c, eval env e2)
| Match (e0,li) -> let m p e =
let pm pat =
match pat with
| PUnit -> 0
| PInt a -> 1
| PBool a -> 2
| PString a -> 3
| PVar a -> 4
| PVariant (a,b) -> 5
| PPair (a,b) -> 6
in
let em exp =
match exp with
| Unit -> 0
| Int a -> 1
| Bool a -> 2
| String a -> 3
| Var a -> 4
| Variant (a,b) -> 5
| Pair (a,b) -> 6
| _ -> -1
in
match ((pm p)=(em e)) with
|true -> true
|false -> false
in
match li with
| [] -> VError "Match not found"
| h::d -> let (p,e) = h in
if ((m p e0) = true) then eval env e
else eval env (Match (e0,d))