Changes in simplif.ml - removal of try_depth ref (#9827)

Changes

@@ -218,6 +218,9 @@ Working version
 - #9650, #9651: keep refactoring the pattern-matching compiler
   (Gabriel Scherer, review by Thomas Refis and Florian Angeletti)
 
+- #9827: Replace references with functions arguments in Simplif
+  (Anukriti Kumar, review by Vincent Laviron and David Allsop)
+
 - #9994: Make Types.type_expr a private type, and abstract marking mechanism
   (Jacques Garrigue and Takafumi Saikawa,
    review by Gabriel Scherer and Leo White)

lambda/simplif.ml

@@ -105,8 +105,6 @@ let simplify_exits lam =
   (* Count occurrences of (exit n ...) statements *)
   let exits = Hashtbl.create 17 in
 
-  let try_depth = ref 0 in
-
   let get_exit i =
     try Hashtbl.find exits i
     with Not_found -> {count = 0; max_depth = 0}
@@ -121,70 +119,82 @@ let simplify_exits lam =
         Hashtbl.add exits i r
   in
 
-  let rec count = function
-  | (Lvar _ | Lmutvar _ | Lconst _) -> ()
-  | Lapply ap -> count ap.ap_func; List.iter count ap.ap_args
-  | Lfunction {body} -> count body
+  let rec count ~try_depth = function
+  | (Lvar _| Lmutvar _ | Lconst _) -> ()
+  | Lapply ap ->
+      count ~try_depth ap.ap_func;
+      List.iter (count ~try_depth) ap.ap_args
+  | Lfunction {body} -> count ~try_depth body
   | Llet(_, _kind, _v, l1, l2)
   | Lmutlet(_kind, _v, l1, l2) ->
-      count l2; count l1
+      count ~try_depth l2; count ~try_depth l1
   | Lletrec(bindings, body) ->
-      List.iter (fun (_v, l) -> count l) bindings;
-      count body
-  | Lprim(_p, ll, _) -> List.iter count ll
+      List.iter (fun (_v, l) -> count ~try_depth l) bindings;
+      count ~try_depth body
+  | Lprim(_p, ll, _) -> List.iter (count ~try_depth) ll
   | Lswitch(l, sw, _loc) ->
-      count_default sw ;
-      count l;
-      List.iter (fun (_, l) -> count l) sw.sw_consts;
-      List.iter (fun (_, l) -> count l) sw.sw_blocks
+      count_default ~try_depth sw ;
+      count ~try_depth l;
+      List.iter (fun (_, l) -> count ~try_depth l) sw.sw_consts;
+      List.iter (fun (_, l) -> count ~try_depth l) sw.sw_blocks
   | Lstringswitch(l, sw, d, _) ->
-      count l;
-      List.iter (fun (_, l) -> count l) sw;
+      count ~try_depth l;
+      List.iter (fun (_, l) -> count ~try_depth l) sw;
       begin match  d with
       | None -> ()
       | Some d -> match sw with
-        | []|[_] -> count d
-        | _ -> count d; count d (* default will get replicated *)
+        | []|[_] -> count ~try_depth d
+        | _ -> (* default will get replicated *)
+            count ~try_depth d; count ~try_depth d
       end
-  | Lstaticraise (i,ls) -> incr_exit i 1 !try_depth; List.iter count ls
+  | Lstaticraise (i,ls) ->
+      incr_exit i 1 try_depth;
+      List.iter (count ~try_depth) ls
   | Lstaticcatch (l1,(i,[]),Lstaticraise (j,[])) ->
       (* i will be replaced by j in l1, so each occurrence of i in l1
          increases j's ref count *)
-      count l1 ;
+      count ~try_depth l1 ;
       let ic = get_exit i in
-      incr_exit j ic.count (max !try_depth ic.max_depth)
+      incr_exit j ic.count (max try_depth ic.max_depth)
   | Lstaticcatch(l1, (i,_), l2) ->
-      count l1;
+      count ~try_depth l1;
       (* If l1 does not contain (exit i),
          l2 will be removed, so don't count its exits *)
       if (get_exit i).count > 0 then
-        count l2
-  | Ltrywith(l1, _v, l2) -> incr try_depth; count l1; decr try_depth; count l2
-  | Lifthenelse(l1, l2, l3) -> count l1; count l2; count l3
-  | Lsequence(l1, l2) -> count l1; count l2
-  | Lwhile(l1, l2) -> count l1; count l2
-  | Lfor(_, l1, l2, _dir, l3) -> count l1; count l2; count l3
-  | Lassign(_v, l) -> count l
-  | Lsend(_k, m, o, ll, _) -> List.iter count (m::o::ll)
-  | Levent(l, _) -> count l
-  | Lifused(_v, l) -> count l
-
-  and count_default sw = match sw.sw_failaction with
+        count ~try_depth l2
+  | Ltrywith(l1, _v, l2) ->
+      count ~try_depth:(try_depth+1) l1;
+      count ~try_depth l2;
+  | Lifthenelse(l1, l2, l3) ->
+      count ~try_depth l1;
+      count ~try_depth l2;
+      count ~try_depth l3
+  | Lsequence(l1, l2) -> count ~try_depth l1; count ~try_depth l2
+  | Lwhile(l1, l2) -> count ~try_depth l1; count ~try_depth l2
+  | Lfor(_, l1, l2, _dir, l3) ->
+      count ~try_depth l1;
+      count ~try_depth l2;
+      count ~try_depth l3
+  | Lassign(_v, l) -> count ~try_depth l
+  | Lsend(_k, m, o, ll, _) -> List.iter (count ~try_depth) (m::o::ll)
+  | Levent(l, _) -> count ~try_depth l
+  | Lifused(_v, l) -> count ~try_depth l
+
+  and count_default ~try_depth sw = match sw.sw_failaction with
   | None -> ()
   | Some al ->
       let nconsts = List.length sw.sw_consts
       and nblocks = List.length sw.sw_blocks in
       if
         nconsts < sw.sw_numconsts && nblocks < sw.sw_numblocks
       then begin (* default action will occur twice in native code *)
-        count al ; count al
+        count ~try_depth al ; count ~try_depth al
       end else begin (* default action will occur once *)
         assert (nconsts < sw.sw_numconsts || nblocks < sw.sw_numblocks) ;
-        count al
+        count ~try_depth al
       end
   in
-  count lam;
-  assert(!try_depth = 0);
+  count ~try_depth:0 lam;
 
   (*
      Second pass simplify  ``catch body with (i ...) handler''
@@ -204,20 +214,22 @@ let simplify_exits lam =
   *)
 
   let subst = Hashtbl.create 17 in
-
-  let rec simplif = function
-  | (Lvar _ | Lmutvar _ | Lconst _) as l -> l
+  let rec simplif ~try_depth = function
+  | (Lvar _| Lmutvar _ | Lconst _) as l -> l
   | Lapply ap ->
-      Lapply{ap with ap_func = simplif ap.ap_func;
-                     ap_args = List.map simplif ap.ap_args}
+      Lapply{ap with ap_func = simplif ~try_depth ap.ap_func;
+                     ap_args = List.map (simplif ~try_depth) ap.ap_args}
   | Lfunction{kind; params; return; body = l; attr; loc} ->
-     Lfunction{kind; params; return; body = simplif l; attr; loc}
-  | Llet(str, kind, v, l1, l2) -> Llet(str, kind, v, simplif l1, simplif l2)
-  | Lmutlet(kind, v, l1, l2) -> Lmutlet(kind, v, simplif l1, simplif l2)
+     Lfunction{kind; params; return; body = simplif ~try_depth l; attr; loc}
+  | Llet(str, kind, v, l1, l2) ->
+      Llet(str, kind, v, simplif ~try_depth l1, simplif ~try_depth l2)
+  | Lmutlet(kind, v, l1, l2) ->
+      Lmutlet(kind, v, simplif ~try_depth l1, simplif ~try_depth l2)
   | Lletrec(bindings, body) ->
-      Lletrec(List.map (fun (v, l) -> (v, simplif l)) bindings, simplif body)
+      Lletrec(List.map (fun (v, l) -> (v, simplif ~try_depth l)) bindings,
+      simplif ~try_depth body)
   | Lprim(p, ll, loc) -> begin
-    let ll = List.map simplif ll in
+    let ll = List.map (simplif ~try_depth) ll in
     match p, ll with
         (* Simplify %revapply, for n-ary functions with n > 1 *)
       | Prevapply, [x; Lapply ap]
@@ -261,19 +273,21 @@ let simplify_exits lam =
       | _ -> Lprim(p, ll, loc)
      end
   | Lswitch(l, sw, loc) ->
-      let new_l = simplif l
-      and new_consts =  List.map (fun (n, e) -> (n, simplif e)) sw.sw_consts
-      and new_blocks =  List.map (fun (n, e) -> (n, simplif e)) sw.sw_blocks
-      and new_fail = Option.map simplif sw.sw_failaction in
+      let new_l = simplif ~try_depth l
+      and new_consts =
+      List.map (fun (n, e) -> (n, simplif ~try_depth e)) sw.sw_consts
+      and new_blocks =
+      List.map (fun (n, e) -> (n, simplif ~try_depth e)) sw.sw_blocks
+      and new_fail = Option.map (simplif ~try_depth) sw.sw_failaction in
       Lswitch
         (new_l,
          {sw with sw_consts = new_consts ; sw_blocks = new_blocks;
                   sw_failaction = new_fail},
          loc)
   | Lstringswitch(l,sw,d,loc) ->
       Lstringswitch
-        (simplif l,List.map (fun (s,l) -> s,simplif l) sw,
-         Option.map simplif d,loc)
+        (simplif ~try_depth l,List.map (fun (s,l) -> s,simplif ~try_depth l) sw,
+         Option.map (simplif ~try_depth) d,loc)
   | Lstaticraise (i,[]) as l ->
       begin try
         let _,handler =  Hashtbl.find subst i in
@@ -282,7 +296,7 @@ let simplify_exits lam =
       | Not_found -> l
       end
   | Lstaticraise (i,ls) ->
-      let ls = List.map simplif ls in
+      let ls = List.map (simplif ~try_depth) ls in
       begin try
         let xs,handler =  Hashtbl.find subst i in
         let ys = List.map (fun (x, k) -> Ident.rename x, k) xs in
@@ -304,38 +318,40 @@ let simplify_exits lam =
       | Not_found -> Lstaticraise (i,ls)
       end
   | Lstaticcatch (l1,(i,[]),(Lstaticraise (_j,[]) as l2)) ->
-      Hashtbl.add subst i ([],simplif l2) ;
-      simplif l1
+      Hashtbl.add subst i ([],simplif ~try_depth l2) ;
+      simplif ~try_depth l1
   | Lstaticcatch (l1,(i,xs),l2) ->
       let {count; max_depth} = get_exit i in
       if count = 0 then
         (* Discard staticcatch: not matching exit *)
-        simplif l1
-      else if count = 1 && max_depth <= !try_depth then begin
+        simplif ~try_depth l1
+      else if
+      count = 1 && max_depth <= try_depth then begin
         (* Inline handler if there is a single occurrence and it is not
            nested within an inner try..with *)
-        assert(max_depth = !try_depth);
-        Hashtbl.add subst i (xs,simplif l2);
-        simplif l1
+        assert(max_depth = try_depth);
+        Hashtbl.add subst i (xs,simplif ~try_depth l2);
+        simplif ~try_depth l1
       end else
-        Lstaticcatch (simplif l1, (i,xs), simplif l2)
+        Lstaticcatch (simplif ~try_depth l1, (i,xs), simplif ~try_depth l2)
   | Ltrywith(l1, v, l2) ->
-      incr try_depth;
-      let l1 = simplif l1 in
-      decr try_depth;
-      Ltrywith(l1, v, simplif l2)
-  | Lifthenelse(l1, l2, l3) -> Lifthenelse(simplif l1, simplif l2, simplif l3)
-  | Lsequence(l1, l2) -> Lsequence(simplif l1, simplif l2)
-  | Lwhile(l1, l2) -> Lwhile(simplif l1, simplif l2)
+      let l1 = simplif ~try_depth:(try_depth + 1) l1 in
+      Ltrywith(l1, v, simplif ~try_depth l2)
+  | Lifthenelse(l1, l2, l3) -> Lifthenelse(simplif ~try_depth l1,
+    simplif ~try_depth l2, simplif ~try_depth l3)
+  | Lsequence(l1, l2) -> Lsequence(simplif ~try_depth l1, simplif ~try_depth l2)
+  | Lwhile(l1, l2) -> Lwhile(simplif ~try_depth l1, simplif ~try_depth l2)
   | Lfor(v, l1, l2, dir, l3) ->
-      Lfor(v, simplif l1, simplif l2, dir, simplif l3)
-  | Lassign(v, l) -> Lassign(v, simplif l)
+      Lfor(v, simplif ~try_depth l1, simplif ~try_depth l2, dir,
+      simplif ~try_depth l3)
+  | Lassign(v, l) -> Lassign(v, simplif ~try_depth l)
   | Lsend(k, m, o, ll, loc) ->
-      Lsend(k, simplif m, simplif o, List.map simplif ll, loc)
-  | Levent(l, ev) -> Levent(simplif l, ev)
-  | Lifused(v, l) -> Lifused (v,simplif l)
+      Lsend(k, simplif ~try_depth m, simplif ~try_depth o,
+      List.map (simplif ~try_depth) ll, loc)
+  | Levent(l, ev) -> Levent(simplif ~try_depth l, ev)
+  | Lifused(v, l) -> Lifused (v,simplif ~try_depth l)
   in
-  simplif lam
+  simplif ~try_depth:0 lam
 
 (* Compile-time beta-reduction of functions immediately applied:
       Lapply(Lfunction(Curried, params, body), args, loc) ->