[Header]
open K_
open K

let test_run pgm_str =
  let pgm = Parser.program Lexer.start (Lexing.from_string pgm_str) in
  K.run (K.emptyMemory, K.emptyEnv, pgm)

let test_error_str pgm_str =
  let pgm = Parser.program Lexer.start (Lexing.from_string pgm_str) in
  try
    (try let _ =  K.run (K.emptyMemory, K.emptyEnv, pgm) in "" with
    K.Error s -> String.sub s 0 7)
  with Invalid_argument _ -> ""

[Test]
(* 1. LETV, ASSIGN, arithmetic *)
test_run
"
let x := 5 in
let y := 0 in
((x := 6) - 3) * 4 + (y := x * 2) / 5 + y
"

[Value]
K.Num 14


[Test]
(* 2. IF, SEQ, WRITE *)
test_run
"
if (3 < 5) then (
  write 1;
  if (not false) then (
    write 11;
    if (20 < 10) then
      write 111
    else
      write 222
  )
  else
    write 22
)
else
  false
"

[Output]
1
11
222


[Test]
(* 3. TypeError in arithmetic *)
test_error_str
"
true + 2
"

[Value]
"TypeErr"


[Test]
(* 4. unbound proecdure *)
test_error_str
"
let proc f (x) = x + 1 in
g(1)
"

[Value]
"Unbound"

[Test]
(* 5. WHILE + LETV *)
test_run
"let x := 1 in
let fac := 1 in
while (x < 6) do (
   fac := fac * x;
   x := x + 1
); fac"

[Value]
K.Num 120


[Test]
(* 6. RECORD + FIELD *)
test_run
"( {fst := true, snd := 5 } ).snd"

[Value]
K.Num 5

[Test]
(* 7. LETV + ASSIGNF *)
test_run
"
let x := {fst := true, snd := 3 } in
x.fst := 4;
x.fst
"

[Value]
K.Num 4


[Test]
(* 8. LETF + CALLV *)
test_run
"
let proc f (x, y, z) = (x + y) / z in
f (2, 3, 5)
"

[Value]
K.Num 1


[Test]
(* 9. recursive call *)
test_run
"
let proc f (x) =
  if (x < 1) then 1 else (x * f (x-1))
in
f (5)
"

[Value]
K.Num 120

[Test]
(* 10. LETF + CALLV + CALLR *)
test_run
"
let proc f (x) = (x := 3) in
let proc g (x) = (x := 3) in
let x := 1 in
let y := 2 in
f <x>; g (y);
x + y
"

[Value]
K.Num 5


[Test]
(* 11. EQUAL + Unbound in false branch *)
test_run
"
if 3 < 2 then
  x
else if (false = 3) then
  y
else if ({i := 1} = 0) then
  z
else
  7
"

[Value]
K.Num 7


[Test]
(* 12. EQUAL of record *)
test_run
"if {} = {} then
  if {i := 1} = {j := 2} then 101
  else if {x := 1, y := 2} = {y := 2, x := 1} then
    if {h := 1, t := {h := 2, t := 0}} = {h := 1, t := {h := 2, t := 0}} then
      102
    else
      103
  else 104
else 105"

[Value]
K.Num 102

[Test]
(* 13. result of ASSIGN *)
test_run
"
let x := 3 in
write x * (x := x + 1);
write (x := x + 1) * x;
if (x := 0) < x then
  write x;
  while (x := x + 1) < 3 do
    write x
else false
"

[Output]
16
20
0
1
2

[Test]
(* 14. scope *)
test_run
"
let x := 0 in
let z :=
  (let x := (x := 3; x + 1) in
   x := x + 1;
   (x := x + 1) * (let x := 2 in x := x + 1))
in
z
"

[Value]
K.Num 18

[Test]
(* 15. complex record *)
test_run
"
let x := {i1 := 1, i2 := 2, i3 := {ii1 := true, ii2 := false} } in
if x.i3.ii1 = false then 100 else 200
"

[Value]
K.Num 200


[Test]
(* 16. Arguments in CALLV *)
test_run
"
let x := 1 in
let proc f (x, y, z) = x * y + z in
f (x := x + 1, x := x + 1, x := x + 1)
"

[Value]
K.Num 10


[Test]
(* 17. Arguments in CALLR *)
test_run
"let x := 1 in
let y := {a := 1} in
let proc f (x, y, z) =
  (x := x + (y := y + 1) + (z := z + 1))
in
f <x, y.a, x>;
x * y.a
"

[Value]
K.Num 12


[Test]
(* 18. shadowing *)
test_run
"
let proc f (x) = x + 1 in
let f := 2 in
write (f + f)
"

[Value]
K.Num 4


[Test]
(* 19. InvalidArg *)
test_error_str
"
let proc f (x, y, z) = x + y + z in
(f (1, 2, 3) +
	let proc f (x, y) = x + y in
	f (1, 2, 3)
)
"

[Value]
"Invalid"


[Test]
(* 20. complex scope *)
test_run
"let x := 1 in
let y := 5 in
let proc f (z) =
  if z then (x := x + 1) else (y := y - 2)
in
let x := 10 in
let y := 50 in
let proc g (z) =
  if z then (x := x + 5) else (y := y - 10)
in
x + y + g (true) + g (false) + x + y + f (true) + f (false)
"

[Value]
K.Num 175