Skip to content

Commit 9fc74b7

Browse files
sim642sim642
committed
Lisa eval
1 parent d0b21e9 commit 9fc74b7

7 files changed

Lines changed: 265 additions & 0 deletions

File tree

‎src/eval/common.ml‎

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
(** Väärtuskeskkond.
2+
Muutujate nimed on sõned ja väärtused täisarvud. *)
3+
module Env =
4+
struct
5+
module M = Map.Make (String)
6+
7+
include M
8+
type t = int M.t [@@deriving eq, ord]
9+
10+
let pp ppf env =
11+
let pp_pair ppf (x, i) = Format.fprintf ppf "%s→%d" x i in
12+
let pp_sep ppf () = Format.fprintf ppf ", " in
13+
Format.fprintf ppf "{%a}" (Format.pp_print_list ~pp_sep pp_pair) (bindings env)
14+
15+
let show env = Format.asprintf "%a" pp env
16+
let of_list l = M.of_seq (List.to_seq l)
17+
end
18+
19+
type env = Env.t [@@deriving ord, show]

‎src/eval/concrete.ml‎

Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,33 @@
1+
(** Konkreetne väärtustaja. *)
2+
open Ast
3+
open Common
4+
5+
(** Rand avaldiste konkreetseks väärtustamiseks kasutame oraaklit.
6+
Vt. Münt Toylangs.Rnd-is. *)
7+
type oracle = int * int -> int
8+
9+
(** Teisendab tõeväärtuse täisarvuks. *)
10+
let int_of_bool b = if b then 1 else 0
11+
12+
(** Teisendab täisarvu tõeväärtuseks. *)
13+
let bool_of_int i = i <> 0
14+
15+
16+
(** Väärtustab binaarse operaatori.
17+
Vihje: mod operaator.
18+
Vihje: int_of_bool. *)
19+
let eval_binary (l: int) (b: binary) (r: int): int =
20+
failwith "TODO"
21+
22+
(** Väärtustab avaldise keskkonnas ja oraakliga.
23+
NB! Väärtustamise järjekord on oluline.
24+
Vihje: eval_binary. *)
25+
let rec eval_expr (env: env) (oracle: oracle) (expr: expr): int =
26+
failwith "TODO"
27+
28+
(** Väärtustab lause keskkonnas ja oraakliga.
29+
Vihje: Vea jaoks kasuta failwith funktsiooni.
30+
Vihje: bool_of_int.
31+
Vihje: While jaoks kasuta rekursiooni. *)
32+
let rec eval_stmt (env: env) (oracle: oracle) (stmt: stmt): env =
33+
failwith "TODO"

‎src/eval/dune‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
(library
2+
(name eval)
3+
(libraries ast)
4+
(preprocess (pps ppx_deriving.std)))

‎test/eval/concrete_test.ml‎

Lines changed: 196 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,196 @@
1+
open OUnit2
2+
open Eval.Common
3+
open Eval.Concrete
4+
5+
let test_eval_binary_arithmetic _ =
6+
let assert_equal = assert_equal ~printer:string_of_int in
7+
assert_equal 9 (eval_binary 5 Add 4);
8+
assert_equal 1 (eval_binary 5 Sub 4);
9+
assert_equal 20 (eval_binary 5 Mul 4);
10+
assert_equal 5 (eval_binary 20 Div 4);
11+
assert_equal 4 (eval_binary 18 Div 4);
12+
assert_equal 2 (eval_binary 18 Mod 4)
13+
14+
let test_eval_binary_comparison _ =
15+
let assert_equal = assert_equal ~printer:string_of_int in
16+
assert_equal 0 (eval_binary 5 Eq 4);
17+
assert_equal 1 (eval_binary 5 Eq 5);
18+
assert_equal 1 (eval_binary 5 Ne 4);
19+
assert_equal 0 (eval_binary 5 Ne 5);
20+
assert_equal 1 (eval_binary 4 Lt 5);
21+
assert_equal 0 (eval_binary 5 Lt 5);
22+
assert_equal 0 (eval_binary 5 Lt 4);
23+
assert_equal 1 (eval_binary 4 Le 5);
24+
assert_equal 1 (eval_binary 5 Le 5);
25+
assert_equal 0 (eval_binary 5 Le 4);
26+
assert_equal 0 (eval_binary 4 Gt 5);
27+
assert_equal 0 (eval_binary 5 Gt 5);
28+
assert_equal 1 (eval_binary 5 Gt 4);
29+
assert_equal 0 (eval_binary 4 Ge 5);
30+
assert_equal 1 (eval_binary 5 Ge 5);
31+
assert_equal 1 (eval_binary 5 Ge 4)
32+
33+
let failure_oracle (_, _) = failwith "failure_oracle"
34+
35+
let test_eval_expr_simple _ =
36+
let assert_equal = assert_equal ~printer:string_of_int in
37+
assert_equal 4 (eval_expr Env.empty failure_oracle (Num 4));
38+
assert_equal 4 (eval_expr (Env.singleton "x" 4) failure_oracle (Var "x"));
39+
assert_equal 4 (eval_expr (Env.singleton "y" 4) failure_oracle (Var "y"));
40+
assert_equal 9 (eval_expr (Env.singleton "x" 4) failure_oracle (Binary (Var "x", Add, Num 5)));
41+
assert_equal 0 (eval_expr (Env.singleton "x" 4) failure_oracle (Binary (Var "x", Gt, Num 5)))
42+
43+
let const_oracle c (l, r) =
44+
assert (l <= c && c <= r);
45+
c
46+
47+
let min_oracle (l, _) = l
48+
let max_oracle (_, r) = r
49+
50+
let list_oracle start: oracle =
51+
let state = ref start in
52+
fun (l, r) ->
53+
let i = List.hd !state in
54+
assert (l <= i && i <= r);
55+
state := List.tl !state;
56+
i
57+
58+
let test_eval_expr_rand _ =
59+
let assert_equal = assert_equal ~printer:string_of_int in
60+
assert_equal 4 (eval_expr Env.empty (const_oracle 4) (Rand (0, 10)));
61+
assert_equal 0 (eval_expr Env.empty min_oracle (Rand (0, 10)));
62+
assert_equal 10 (eval_expr Env.empty max_oracle (Rand (0, 10)));
63+
assert_equal 8 (eval_expr Env.empty (const_oracle 4) (Binary (Rand (0, 10), Add, Rand (0, 10))));
64+
assert_equal 0 (eval_expr Env.empty min_oracle (Binary (Rand (0, 10), Add, Rand (0, 10))));
65+
assert_equal 20 (eval_expr Env.empty max_oracle (Binary (Rand (0, 10), Add, Rand (0, 10))));
66+
assert_equal 12 (eval_expr Env.empty (list_oracle [8; 4]) (Binary (Rand (0, 10), Add, Rand (0, 10))))
67+
68+
let test_eval_expr_order _ =
69+
let assert_equal = assert_equal ~printer:string_of_int in
70+
assert_equal 2 (eval_expr Env.empty (list_oracle [8; 4]) (Binary (Rand (0, 10), Div, Rand (0, 10))));
71+
assert_equal 0 (eval_expr Env.empty (list_oracle [4; 8]) (Binary (Rand (0, 10), Div, Rand (0, 10))))
72+
73+
let test_eval_stmt_nop _ =
74+
let assert_equal = assert_equal ~cmp:Env.equal ~printer:Env.show in
75+
assert_equal (Env.singleton "x" 4) (eval_stmt (Env.singleton "x" 4) failure_oracle Nop)
76+
77+
let test_eval_stmt_assign _ =
78+
let assert_equal = assert_equal ~cmp:Env.equal ~printer:Env.show in
79+
assert_equal (Env.singleton "x" 5) (eval_stmt (Env.singleton "x" 4) failure_oracle (Assign ("x", Num 5)));
80+
assert_equal (Env.of_list [("y", 42); ("x", 5)]) (eval_stmt (Env.of_list [("y", 42); ("x", 4)]) failure_oracle (Assign ("x", Num 5)));
81+
assert_equal (Env.singleton "x" 5) (eval_stmt Env.empty failure_oracle (Assign ("x", Num 5)))
82+
83+
let test_eval_stmt_seq _ =
84+
let assert_equal = assert_equal ~cmp:Env.equal ~printer:Env.show in
85+
assert_equal (Env.of_list [("y", 10); ("x", 5)]) (eval_stmt Env.empty failure_oracle (
86+
Seq (
87+
Assign ("x", Num 5),
88+
Assign ("y", Binary (Var "x", Add, Num 5))
89+
)
90+
))
91+
92+
let test_eval_stmt_if _ =
93+
let assert_equal = assert_equal ~cmp:Env.equal ~printer:Env.show in
94+
assert_equal (Env.singleton "x" 5) (eval_stmt Env.empty failure_oracle (
95+
If (Num 1,
96+
Assign ("x", Num 5),
97+
Assign ("x", Num 10)
98+
)
99+
));
100+
assert_equal (Env.singleton "x" 10) (eval_stmt Env.empty failure_oracle (
101+
If (Num 0,
102+
Assign ("x", Num 5),
103+
Assign ("x", Num 10)
104+
)
105+
));
106+
assert_equal (Env.singleton "x" 5) (eval_stmt Env.empty failure_oracle (
107+
If (Num 42,
108+
Assign ("x", Num 5),
109+
Assign ("x", Num 10)
110+
)
111+
));
112+
assert_equal (Env.singleton "x" 10) (eval_stmt Env.empty min_oracle (
113+
If (Rand (0, 1),
114+
Assign ("x", Num 5),
115+
Assign ("x", Num 10)
116+
)
117+
));
118+
assert_equal (Env.singleton "x" 5) (eval_stmt Env.empty max_oracle (
119+
If (Rand (0, 1),
120+
Assign ("x", Num 5),
121+
Assign ("x", Num 10)
122+
)
123+
))
124+
125+
let test_eval_stmt_while _ =
126+
let assert_equal = assert_equal ~cmp:Env.equal ~printer:Env.show in
127+
assert_equal (Env.singleton "x" 0) (eval_stmt (Env.singleton "x" 0) failure_oracle (
128+
While (Num 0,
129+
Assign ("x", Binary (Var "x", Add, Num 1))
130+
)
131+
));
132+
assert_equal (Env.singleton "x" 10) (eval_stmt (Env.singleton "x" 0) failure_oracle (
133+
While (Binary (Var "x", Lt, Num 10),
134+
Assign ("x", Binary (Var "x", Add, Num 1))
135+
)
136+
));
137+
assert_equal (Env.singleton "x" 0) (eval_stmt (Env.singleton "x" 0) (list_oracle [0]) (
138+
While (Rand (0, 1),
139+
Assign ("x", Binary (Var "x", Add, Num 1))
140+
)
141+
));
142+
assert_equal (Env.singleton "x" 3) (eval_stmt (Env.singleton "x" 0) (list_oracle [1; 1; 1; 0]) (
143+
While (Rand (0, 1),
144+
Assign ("x", Binary (Var "x", Add, Num 1))
145+
)
146+
));
147+
assert_equal (Env.singleton "x" 3) (eval_stmt (Env.singleton "x" 0) (list_oracle [3; 2; 1; 0]) (
148+
While (Rand (0, 42),
149+
Assign ("x", Binary (Var "x", Add, Num 1))
150+
)
151+
))
152+
153+
let test_eval_stmt_error _ =
154+
OUnitTodo.assert_raises (Failure "eval_stmt: Error") (fun () -> eval_stmt Env.empty failure_oracle Error)
155+
156+
let test_eval_stmt_lazy _ =
157+
let assert_equal = assert_equal ~cmp:Env.equal ~printer:Env.show in
158+
assert_equal Env.empty (eval_stmt Env.empty failure_oracle (
159+
If (Num 1,
160+
Nop,
161+
Error
162+
)
163+
));
164+
assert_equal Env.empty (eval_stmt Env.empty failure_oracle (
165+
If (Num 0,
166+
Error,
167+
Nop
168+
)
169+
));
170+
assert_equal Env.empty (eval_stmt Env.empty failure_oracle (
171+
While (Num 0,
172+
Error
173+
)
174+
))
175+
176+
let tests =
177+
"concrete" >::: [
178+
"eval_binary" >::: [
179+
"arithmetic" >:: test_eval_binary_arithmetic;
180+
"comparison" >:: test_eval_binary_comparison;
181+
];
182+
"eval_expr" >::: [
183+
"simple" >:: test_eval_expr_simple;
184+
"rand" >:: test_eval_expr_rand;
185+
"order" >:: test_eval_expr_order;
186+
];
187+
"eval_stmt" >::: [
188+
"nop" >:: test_eval_stmt_nop;
189+
"assign" >:: test_eval_stmt_assign;
190+
"seq" >:: test_eval_stmt_seq;
191+
"if" >:: test_eval_stmt_if;
192+
"while" >:: test_eval_stmt_while;
193+
"error" >:: test_eval_stmt_error;
194+
"lazy" >:: test_eval_stmt_lazy;
195+
];
196+
]

‎test/eval/concrete_test.mli‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
val tests: OUnit2.test

‎test/eval/dune‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,4 @@
1+
(test
2+
(name eval_test)
3+
(libraries ounit2 ounittodo eval ast)
4+
(preprocess (pps ppx_deriving.std)))

‎test/eval/eval_test.ml‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
open OUnit2
2+
3+
let tests =
4+
"eval" >::: [
5+
Concrete_test.tests;
6+
]
7+
8+
let () = run_test_tt_main (OUnitTodo.wrap tests)

0 commit comments

Comments
 (0)