Merge branch 'master' into fix_set_fragment

CHANGES.md

@@ -18,6 +18,7 @@
 * Compiler: fix js parser/printer wrt async functions (#1515)
 * Compiler: fix free variables pass wrt parameters' default value (#1521)
 * Compiler: fix free variables for classes
+* Compiler: fix internal invariant (continuation)
 * Lib: Url.Current.set_fragment need not any urlencode (#1497)
 
 # 5.4.0 (2023-07-06) - Lille

TODO.txt

@@ -7,9 +7,6 @@ Compiler optimizations
 - constant hoisting (including functions, out of loops and functions)
 - inline also partially applied functions
 
-- we should check stack compatibility when parsing:
-  when jumping somewhere, the stack should keep the same shape
-
 - cross-function optimizations
 
 - should we rebind variables from a deeper level ?

compiler/lib/code.ml

@@ -687,7 +687,7 @@ let invariant { blocks; start; _ } =
     let defs = Var.ISet.empty () in
     let check_cont (cont, args) =
       let b = Addr.Map.find cont blocks in
-      assert (List.length args >= List.length b.params)
+      assert (List.length args = List.length b.params)
     in
     let define x =
       if check_defs

compiler/lib/deadcode.ml

@@ -130,7 +130,7 @@ let rec filter_args st pl al =
   match pl, al with
   | x :: pl, y :: al ->
       if st.live.(Var.idx x) > 0 then y :: filter_args st pl al else filter_args st pl al
-  | [], _ -> []
+  | [], [] -> []
   | _ -> assert false
 
 let filter_cont blocks st (pc, args) =
@@ -184,7 +184,8 @@ let rec add_arg_dep defs params args =
   | x :: params, y :: args ->
       add_def defs x (Var y);
       add_arg_dep defs params args
-  | _ -> ()
+  | [], [] -> ()
+  | _ -> assert false
 
 let add_cont_dep blocks defs (pc, args) =
   match try Some (Addr.Map.find pc blocks) with Not_found -> None with

compiler/lib/effects.ml

@@ -926,6 +926,8 @@ let remove_empty_blocks ~live_vars (p : Code.program) : Code.program =
 let f (p, live_vars) =
   let t = Timer.make () in
   let p = remove_empty_blocks ~live_vars p in
+  (* [remove_empty_blocks] can affect [Deadcode.variable_uses] *)
+  let p, live_vars = Deadcode.f p in
   let flow_info = Global_flow.f ~fast:false p in
   let cps_needed = Partial_cps_analysis.f p flow_info in
   let p, cps_needed = rewrite_toplevel ~cps_needed p in

compiler/lib/flow.ml

@@ -81,7 +81,8 @@ let rec arg_deps vars deps defs params args =
       add_dep deps x y;
       add_assign_def vars defs x y;
       arg_deps vars deps defs params args
-  | _ -> ()
+  | [], [] -> ()
+  | _ -> assert false
 
 let cont_deps blocks vars deps defs (pc, args) =
   let block = Addr.Map.find pc blocks in

compiler/lib/global_flow.ml

@@ -139,7 +139,8 @@ let rec arg_deps st ?ignore params args =
       | Some y' when Var.equal y y' -> ()
       | _ -> add_assign_def st x y);
       arg_deps st params args
-  | _ -> ()
+  | [], [] -> ()
+  | _ -> assert false
 
 let cont_deps blocks st ?ignore (pc, args) =
   let block = Addr.Map.find pc blocks in