The unpac monorepo manager self-hosting as a monorepo using unpac
TMC: fix translation of try-with, (&&), (||) (#12958)
authored by
Nicolás Ojeda Bär
and committed by
GitHub
a5108921
50ce58a3
+30
-11
+5
Changes
+5
Changes
···
876
876
- #12861: Fix a possible crash in the `threads` library.
877
877
(Mark Shinwell, review by Gabriel Scherer and KC Sivaramakrishnan)
878
878
879
+
- #12958: Fix tail-modulo-cons compilation of try-with, && and ||
880
+
expressions.
881
+
(Gabriel Scherer and Nicolás Ojeda Bär, report by Sylvain Boilard, review by
882
+
Gabriel Scherer)
883
+
879
884
OCaml 5.1.1 (8 December 2023)
880
885
----------------------------
881
886
+4
-11
lambda/tmc.ml
+4
-11
lambda/tmc.ml
···
642
642
| Ltrywith (l1, id, l2) ->
643
643
(* in [try l1 with id -> l2], the term [l1] is
644
644
not in tail-call position (after it returns
645
-
we need to remove the exception handler),
646
-
so it is not transformed here *)
647
-
let l1 = traverse ctx l1 in
648
-
let+ l2 = choice ctx ~tail l2 in
645
+
we need to remove the exception handler) *)
646
+
let+ l1 = choice ctx ~tail:false l1
647
+
and+ l2 = choice ctx ~tail l2 in
649
648
Ltrywith (l1, id, l2)
650
649
| Lstaticcatch (l1, ids, l2) ->
651
650
(* In [static-catch l1 with ids -> l2],
···
836
835
| _ -> invalid_arg "choice_prim" in
837
836
let+ l1 = choice ctx ~tail l1 in
838
837
Lprim (Popaque, [l1], loc)
839
-
| (Psequand | Psequor) as shortcutop ->
840
-
let l1, l2 = match primargs with
841
-
| [l1; l2] -> l1, l2
842
-
| _ -> invalid_arg "choice_prim" in
843
-
let l1 = traverse ctx l1 in
844
-
let+ l2 = choice ctx ~tail l2 in
845
-
Lprim (shortcutop, [l1; l2], loc)
846
838
847
839
(* in common cases we just return *)
848
840
| Pbytes_to_string | Pbytes_of_string
···
902
894
| Pbswap16
903
895
| Pbbswap _
904
896
| Pint_as_pointer
897
+
| Psequand | Psequor
905
898
->
906
899
let primargs = traverse_list ctx primargs in
907
900
Choice.lambda (Lprim (prim, primargs, loc))
+11
testsuite/tests/tmc/shortcut.ml
+11
testsuite/tests/tmc/shortcut.ml
···
1
+
(* TEST flags = "-w -71"; *)
2
+
3
+
let[@tail_mod_cons] rec f () = Some (g ())
4
+
and[@tail_mod_cons] g () = false && true
5
+
6
+
let () = assert (f () = Some false)
7
+
8
+
let[@tail_mod_cons] rec f () = Some (g ())
9
+
and[@tail_mod_cons] g () = true || false
10
+
11
+
let () = assert (f () = Some true)
+10
testsuite/tests/tmc/try_with.ml
+10
testsuite/tests/tmc/try_with.ml