struct: remove test parts that are not required now (with new lambda model)

This commit is contained in:
ProgramSnail 2026-05-22 12:50:47 +00:00
parent 441b383762
commit 06f69ec4c2
4 changed files with 191 additions and 460 deletions

View file

@ -615,25 +615,6 @@ struct
let vg10 = VarP (globals_min_id + 10)
let vg11 = VarP (globals_min_id + 11)
let rf0E = RefE 0
let rf1E = RefE 1
let rf2E = RefE 2
let rf3E = RefE 3
let rf4E = RefE 4
let rf5E = RefE 5
let rf3E = RefE 3
let rf4E = RefE 4
let rf5E = RefE 5
let rfg0E = RefE globals_min_id
let rfg1E = RefE (globals_min_id + 1)
let rfg2E = RefE (globals_min_id + 2)
let rfg3E = RefE (globals_min_id + 3)
let rfg4E = RefE (globals_min_id + 4)
let rfg5E = RefE (globals_min_id + 5)
let rfg6E = RefE (globals_min_id + 6)
let rfg7E = RefE (globals_min_id + 7)
let rfg8E = RefE (globals_min_id + 8)
let pE p = PathE p
let drf p = DerefP p
@ -837,14 +818,13 @@ struct
let%expect_test "simple call with read, dsl" =
prog_eval_noret (
[
defg uT_r_mw;
defg (rfT uT_r_mw);
FunD (
[moded @@ cpT @@ uT_r],
rdS @@ drf @@ v0
)
],
callS vg2 [pE vg1]
callS vg1 [pE vg0]
);
Printf.printf "done!";
[%expect {| done! |}]
@ -852,14 +832,13 @@ struct
let%expect_test "simple call with write, dsl" =
prog_eval_noret (
[
defg uT_aw;
defg (rfT uT_aw);
FunD (
[moded @@ cpT @@ uT_aw],
wrS @@ drf @@ v0
)
],
callS vg2 [pE vg1]
callS vg1 [pE vg0]
);
Printf.printf "done!";
[%expect {| done! |}]
@ -867,7 +846,6 @@ struct
let%expect_test "simple call with read after write, dsl" =
prog_eval_noret (
[
defg uT_aw;
defg (rfT uT_aw);
FunD (
[moded @@ cpT @@ uT_aw],
@ -875,7 +853,7 @@ struct
(rdS @@ drf @@ v0)
)
],
callS vg2 [pE vg1]
callS vg1 [pE vg0]
);
Printf.printf "done!";
[%expect {| done! |}]
@ -883,31 +861,28 @@ struct
let%expect_test "simple call with forbidden write, dsl" =
try (prog_eval_noret (
[
defg uT_r_mw;
defg (rfT uT_r_mw);
FunD (
[moded @@ cpT @@ uT_r],
wrS @@ drf @@ v0
)
],
callS vg2 [pE vg1]
callS vg1 [pE vg0]
);
[%expect.unreachable]);
with Eval_error msg -> Printf.printf "%s" msg;
[%expect {| write: write tag |}]
(* TODO: FIXME: why is condition on always write in parent ?? *)
let%expect_test "simple call with write to ref, dsl" =
prog_eval_noret (
[
defg uT_r_aw;
defg (rfT uT_r_aw);
FunD (
[moded @@ rfT @@ uT_aw],
wrS @@ drf @@ v0
)
],
callS vg2 [pE vg1]
callS vg1 [pE vg0]
);
Printf.printf "done!";
[%expect {| done! |}]
@ -915,15 +890,14 @@ struct
let%expect_test "simple call with forbidden write to ref, dsl" =
try (prog_eval_noret (
[
defg uT_r_aw;
defg (rfT uT_r_aw);
FunD (
[moded @@ rfT @@ uT_aw],
wrS @@ drf @@ v0
)
],
(callS vg2 [pE vg1]) #.
(rdS @@ drf @@ vg1)
(callS vg1 [pE vg0]) #.
(rdS @@ drf @@ vg0)
);
[%expect.unreachable]);
with Eval_error msg -> Printf.printf "%s" msg;
@ -932,16 +906,15 @@ struct
let%expect_test "simple call with write to ref with fix, dsl" =
prog_eval_noret (
[
defg uT_r_aw;
defg (rfT uT_r_aw);
FunD (
[moded @@ rfT @@ uT_aw],
wrS @@ drf @@ v0
)
],
(callS vg2 [pE vg1]) #.
(wrS @@ drf @@ vg1) #.
(rdS @@ drf @@ vg1)
(callS vg1 [pE vg0]) #.
(wrS @@ drf @@ vg0) #.
(rdS @@ drf @@ vg0)
);
Printf.printf "done!";
[%expect {| done! |}]
@ -949,7 +922,6 @@ struct
let%expect_test "call inside call, dsl" =
prog_eval_noret (
[
defg uT_r_aw;
defg (rfT uT_r_aw);
FunD (
[moded @@ rfT @@ uT_aw],
@ -957,12 +929,12 @@ struct
);
FunD (
[moded @@ cpT @@ uT_aw],
(callS vg2 [pE v0]) #.
(callS vg1 [pE v0]) #.
(wrS @@ drf @@ v0)
)
],
(callS vg3 [pE vg1]) #.
(rdS @@ drf @@ vg1)
(callS vg2 [pE vg0]) #.
(rdS @@ drf @@ vg0)
);
Printf.printf "done!";
[%expect {| done! |}]
@ -971,16 +943,15 @@ struct
(* let%expect_test "call inside call, recursive, dsl" = *)
(* prog_eval_noret ( *)
(* [ *)
(* defg uT_r_aw; *)
(* defg (rfT uT_r_aw); *)
(* FunD ( *)
(* [moded @@ cpT @@ uT_aw], *)
(* (callS vg2 [pE v0]) #. *)
(* (callS vg1 [pE v0]) #. *)
(* (wrS @@ drf @@ v0) *)
(* ) *)
(* ], *)
(* (callS vg2 [pE vg1]) #. *)
(* (rdS @@ drf @@ vg1) *)
(* (callS vg1 [pE vg0]) #. *)
(* (rdS @@ drf @@ vg0) *)
(* ); *)
(* Printf.printf "done!"; *)
(* [%expect {| done! |}] *)
@ -988,7 +959,6 @@ struct
let%expect_test "call to fix after call, dsl" =
prog_eval_noret (
[
defg uT_r_aw;
defg (rfT uT_r_aw);
FunD (
[moded @@ rfT @@ uT_aw],
@ -999,9 +969,9 @@ struct
wrS @@ drf @@ v0
)
],
(callS vg2 [pE vg1]) #.
(callS vg3 [pE vg1]) #.
(rdS @@ drf @@ vg1)
(callS vg1 [pE vg0]) #.
(callS vg2 [pE vg0]) #.
(rdS @@ drf @@ vg0)
);
Printf.printf "done!";
[%expect {| done! |}]
@ -1009,16 +979,15 @@ struct
let%expect_test "simple call with global variable usage, dsl" =
prog_eval_noret (
[
defg uT_r_aw;
defg (rfT uT_r);
defg (rfT uT_r_aw);
FunD (
[moded @@ cpT @@ uT],
(wrS @@ vg0) #.
(rdS @@ drf @@ vg1)
(wrS @@ drf @@ vg0) #.
(rdS @@ drf @@ vg0)
)
],
(callS vg2 [pE vg1]) #.
(rdS @@ drf @@ vg1)
(callS vg1 [pE vg0]) #.
(rdS @@ drf @@ vg0)
);
Printf.printf "done!";
[%expect {| done! |}]
@ -1026,9 +995,7 @@ struct
let%expect_test "simple call with read & write (2 args), dsl" =
prog_eval_noret (
[
defg uT_r;
defg (rfT uT_r);
defg uT_aw;
defg (rfT uT_aw);
FunD (
[
@ -1039,7 +1006,7 @@ struct
(wrS @@ drf @@ v1)
)
],
callS vg4 [pE vg1; pE vg3]
callS vg2 [pE vg0; pE vg1]
);
Printf.printf "done!";
[%expect {| done! |}]
@ -1047,13 +1014,9 @@ struct
let%expect_test "simple call with different arguments modifiers, copy, dsl" =
prog_eval_noret (
[
defg uT_r_aw;
defg (rfT uT_r_aw);
defg uT_r_aw;
defg (rfT uT_r_aw);
defg uT_r_aw;
defg (rfT uT_r_aw);
defg uT_r_aw;
defg (rfT uT_r_aw);
FunD (
[
@ -1069,11 +1032,11 @@ struct
(wrS @@ drf @@ v3)
)
],
(callS vg8 [pE vg1; pE vg3; pE vg5; pE vg7]) #.
(callS vg4 [pE vg0; pE vg1; pE vg2; pE vg3]) #.
(rdS @@ drf @@ vg0) #.
(rdS @@ drf @@ vg1) #.
(rdS @@ drf @@ vg3) #.
(rdS @@ drf @@ vg5) #.
(rdS @@ drf @@ vg7)
(rdS @@ drf @@ vg2) #.
(rdS @@ drf @@ vg3)
);
Printf.printf "done!";
[%expect {| done! |}]
@ -1081,13 +1044,9 @@ struct
let%expect_test "simple call with different arguments modifiers, ref, dsl" =
prog_eval_noret (
[
defg uT_r;
defg (rfT uT_r);
defg uT_r;
defg (rfT uT_r);
defg uT_r_aw;
defg (rfT uT_r_aw);
defg uT_r_aw;
defg (rfT uT_r_aw);
FunD (
[
@ -1102,11 +1061,11 @@ struct
(wrS @@ drf @@ v3)
)
],
(callS vg8 [pE vg1; pE vg3; pE vg5; pE vg7]) #.
(callS vg4 [pE vg0; pE vg1; pE vg2; pE vg3]) #.
(rdS @@ drf @@ vg0) #.
(rdS @@ drf @@ vg1) #.
(rdS @@ drf @@ vg3) #.
(rdS @@ drf @@ vg5) #.
(rdS @@ drf @@ vg7)
(rdS @@ drf @@ vg2) #.
(rdS @@ drf @@ vg3)
);
Printf.printf "done!";
[%expect {| done! |}]
@ -1116,13 +1075,9 @@ struct
let%expect_test "presentation test 1 (simple types), dsl" =
prog_eval_noret (
[
defg uT_r_aw;
defg (rfT uT_r_aw); (* x *)
defg uT_r_aw;
defg (rfT uT_r_aw); (* y *)
defg uT_r_aw;
defg (rfT uT_r_aw); (* z *)
defg uT_r_aw;
defg (rfT uT_r_aw); (* k *)
FunD ( (* f *)
[
@ -1156,14 +1111,14 @@ struct
(rdS @@ drf @@ v0)
)
],
let xV = vg1 in
let yV = vg3 in
let zV = vg5 in
let kV = vg7 in
let fF = vg8 in
let wF = vg9 in
let gF = vg10 in
let rF = vg11 in
let xV = vg0 in
let yV = vg1 in
let zV = vg2 in
let kV = vg3 in
let fF = vg4 in
let wF = vg5 in
let gF = vg6 in
let rF = vg7 in
(callS wF [pE xV]) #.
(callS rF [pE xV]) #.
(callS fF [pE xV; pE yV]) #.