Restrict TRMC to last field of a block

bytecomp/simplif.ml

@@ -723,10 +723,20 @@ type trmc_stub = {
   stub_arity: int;
   stub_body: lfunction;
   mutable stub_uses: (int * Ident.t) list;
-  mutable stub_frozen: bool;
-  mutable stub_warned: bool;
+  mutable stub_frozen: bool; (* true if no new function should be generated *)
+  mutable stub_warned: bool; (* true if a warning has already be emitted for
+                                this function *)
 }
 
+let rec list_last = function
+  | [] -> invalid_arg "list_last"
+  | [x] -> x
+  | _ :: xs -> list_last xs
+
+let rec list_map_last f = function
+  | [] -> invalid_arg "list_map_last"
+  | [x] -> [f x]
+  | x :: xs -> x :: list_map_last f xs
 
 (* Detection of trmc calls *)
 
@@ -751,8 +761,11 @@ let rec is_reccall all_candidates = function
   | _ -> None
 
 and is_trmc_call all_candidates = function
+  | Lprim (Pmakeblock _, []) ->
+      (* Is an empty block even well-formed ? *)
+     false
   | Lprim (Pmakeblock _, values) ->
-      begin match find_map (is_reccall all_candidates) values with
+      begin match is_reccall all_candidates (list_last values) with
       | Some _ -> true
       | None -> false
       end
@@ -762,7 +775,11 @@ and has_trmc all_candidates lam =
   is_trmc_call all_candidates lam ||
   (match lam with
    | Levent (lam,_) -> has_trmc all_candidates lam
-   | Lprim (Pmakeblock _, values) -> List.exists (has_trmc all_candidates) values
+   | Lprim (Pmakeblock _, []) ->
+       (* Is an empty block even well-formed ? *)
+       false
+   | Lprim (Pmakeblock _, values) ->
+       has_trmc all_candidates (list_last values)
    | _ -> false)
 
 and need_recfunc (id,stub) offset =
@@ -804,9 +821,10 @@ and extract_trmc all_candidates name lam =
     | _ -> assert false
 
 and extract_trmc_list all_candidates name acc = function
-  | arg :: args when has_trmc all_candidates arg ->
+  | [arg] ->
+      assert (has_trmc all_candidates arg);
       let result, arg' = extract_trmc all_candidates name arg in
-      result, List.rev_append acc (arg' :: args)
+      result, List.rev_append acc [arg']
   | arg :: args ->
       extract_trmc_list all_candidates name (arg :: acc) args
   | [] -> assert false