Merge pull request #8692 from lpw25/remove-may-map

Remove Misc.may_map and similar

Changes

@@ -20,6 +20,9 @@ Working version
   [Flambda_middle_end].  Run [Un_anf] from the middle end, not [Cmmgen].
   (Mark Shinwell, review by Pierre Chambart)
 
+- #8692: Remove Misc.may_map and similar
+  (Leo White, review by Gabriel Scherer and Thomas Refis)
+
 ### Runtime system:
 
 - #8619: Ensure Gc.minor_words remains accurate after a GC.

asmcomp/cmmgen.ml

@@ -2239,7 +2239,7 @@ let rec transl env e =
       let dbg = Debuginfo.none in
       bind "switch" (transl env arg)
         (fun arg ->
-          strmatch_compile dbg arg (Misc.may_map (transl env) d)
+          strmatch_compile dbg arg (Option.map (transl env) d)
             (List.map (fun (s,act) -> s,transl env act) sw))
   | Ustaticfail (nfail, args) ->
       Cexit (nfail, List.map (transl env) args)

file_formats/cmt_format.ml

@@ -172,7 +172,7 @@ let save_cmt filename modname binary_annots sourcefile initial_env cmi =
            | None -> None
            | Some cmi -> Some (output_cmi temp_file_name oc cmi)
          in
-         let source_digest = Misc.may_map Digest.file sourcefile in
+         let source_digest = Option.map Digest.file sourcefile in
          let cmt = {
            cmt_modname = modname;
            cmt_annots = clear_env binary_annots;

lambda/lambda.ml

@@ -783,14 +783,14 @@ let shallow_map f = function
                  sw_consts = List.map (fun (n, e) -> (n, f e)) sw.sw_consts;
                  sw_numblocks = sw.sw_numblocks;
                  sw_blocks = List.map (fun (n, e) -> (n, f e)) sw.sw_blocks;
-                 sw_failaction = Misc.may_map f sw.sw_failaction;
+                 sw_failaction = Option.map f sw.sw_failaction;
                },
                loc)
   | Lstringswitch (e, sw, default, loc) ->
       Lstringswitch (
         f e,
         List.map (fun (s, e) -> (s, f e)) sw,
-        Misc.may_map f default,
+        Option.map f default,
         loc)
   | Lstaticraise (i, args) ->
       Lstaticraise (i, List.map f args)

lambda/simplif.ml

@@ -56,13 +56,13 @@ let rec eliminate_ref id = function
          sw_blocks =
             List.map (fun (n, e) -> (n, eliminate_ref id e)) sw.sw_blocks;
          sw_failaction =
-            Misc.may_map (eliminate_ref id) sw.sw_failaction; },
+            Option.map (eliminate_ref id) sw.sw_failaction; },
         loc)
   | Lstringswitch(e, sw, default, loc) ->
       Lstringswitch
         (eliminate_ref id e,
          List.map (fun (s, e) -> (s, eliminate_ref id e)) sw,
-         Misc.may_map (eliminate_ref id) default, loc)
+         Option.map (eliminate_ref id) default, loc)
   | Lstaticraise (i,args) ->
       Lstaticraise (i,List.map (eliminate_ref id) args)
   | Lstaticcatch(e1, i, e2) ->
@@ -254,7 +254,7 @@ let simplify_exits lam =
       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 = Misc.may_map simplif sw.sw_failaction in
+      and new_fail = Option.map simplif sw.sw_failaction in
       Lswitch
         (new_l,
          {sw with sw_consts = new_consts ; sw_blocks = new_blocks;
@@ -263,7 +263,7 @@ let simplify_exits lam =
   | Lstringswitch(l,sw,d,loc) ->
       Lstringswitch
         (simplif l,List.map (fun (s,l) -> s,simplif l) sw,
-         Misc.may_map simplif d,loc)
+         Option.map simplif d,loc)
   | Lstaticraise (i,[]) as l ->
       begin try
         let _,handler =  Hashtbl.find subst i in
@@ -536,7 +536,7 @@ let simplify_lets lam =
       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 = Misc.may_map simplif sw.sw_failaction in
+      and new_fail = Option.map simplif sw.sw_failaction in
       Lswitch
         (new_l,
          {sw with sw_consts = new_consts ; sw_blocks = new_blocks;
@@ -545,7 +545,7 @@ let simplify_lets lam =
   | Lstringswitch (l,sw,d,loc) ->
       Lstringswitch
         (simplif l,List.map (fun (s,l) -> s,simplif l) sw,
-         Misc.may_map simplif d,loc)
+         Option.map simplif d,loc)
   | Lstaticraise (i,ls) ->
       Lstaticraise (i, List.map simplif ls)
   | Lstaticcatch(l1, (i,args), l2) ->
@@ -615,13 +615,13 @@ let rec emit_tail_infos is_tail lambda =
       emit_tail_infos false lam;
       list_emit_tail_infos_fun snd is_tail sw.sw_consts;
       list_emit_tail_infos_fun snd is_tail sw.sw_blocks;
-      Misc.may  (emit_tail_infos is_tail) sw.sw_failaction
+      Option.iter  (emit_tail_infos is_tail) sw.sw_failaction
   | Lstringswitch (lam, sw, d, _) ->
       emit_tail_infos false lam;
       List.iter
         (fun (_,lam) ->  emit_tail_infos is_tail lam)
         sw ;
-      Misc.may (emit_tail_infos is_tail) d
+      Option.iter (emit_tail_infos is_tail) d
   | Lstaticraise (_, l) ->
       list_emit_tail_infos false l
   | Lstaticcatch (body, _, handler) ->

lambda/translcore.ml

@@ -644,12 +644,16 @@ and transl_apply ?(should_be_tailcall=false) ?(inlined = Default_inline)
         in
         let args, args' =
           if List.for_all (fun (_,opt) -> opt) args then [], args
-          else args, [] in
+          else args, []
+        in
         let lam =
-          if args = [] then lam else lapply lam (List.rev_map fst args) in
-        let handle = protect "func" lam
-        and l = List.map (fun (arg, opt) -> may_map (protect "arg") arg, opt) l
-        and id_arg = Ident.create_local "param" in
+          if args = [] then lam else lapply lam (List.rev_map fst args)
+        in
+        let handle = protect "func" lam in
+        let l =
+          List.map (fun (arg, opt) -> Option.map (protect "arg") arg, opt) l
+        in
+        let id_arg = Ident.create_local "param" in
         let body =
           match build_apply handle ((Lvar id_arg, optional)::args') l with
             Lfunction{kind = Curried; params = ids; return;
@@ -679,7 +683,7 @@ and transl_apply ?(should_be_tailcall=false) ?(inlined = Default_inline)
         lapply lam (List.rev_map fst args)
   in
   (build_apply lam [] (List.map (fun (l, x) ->
-                                   may_map transl_exp x, Btype.is_optional l)
+                                   Option.map transl_exp x, Btype.is_optional l)
                                 sargs)
      : Lambda.lambda)
 

middle_end/closure/closure.ml

@@ -184,7 +184,7 @@ let lambda_smaller lam threshold =
             size := !size+2 ;
             lambda_size lam)
           sw ;
-        Misc.may lambda_size d
+        Option.iter lambda_size d
     | Ustaticfail (_,args) -> lambda_list_size args
     | Ucatch(_, _, body, handler) ->
         incr size; lambda_size body; lambda_size handler
@@ -627,7 +627,7 @@ let rec substitute loc ((backend, fpc) as st) sb rn ulam =
       Ustringswitch
         (substitute loc st sb rn arg,
          List.map (fun (s,act) -> s,substitute loc st sb rn act) sw,
-         Misc.may_map (substitute loc st sb rn) d)
+         Option.map (substitute loc st sb rn) d)
   | Ustaticfail (nfail, args) ->
       let nfail =
         match rn with
@@ -1116,7 +1116,7 @@ let rec close ({ backend; fenv; cenv } as env) lam =
             s,uact)
           sw in
       let ud =
-        Misc.may_map
+        Option.map
           (fun d ->
             let ud,_ = close env d in
             ud) d in
@@ -1433,7 +1433,7 @@ let collect_exported_structured_constants a =
     | Ustringswitch (u,sw,d) ->
         ulam u ;
         List.iter (fun (_,act) -> ulam act) sw ;
-        Misc.may ulam d
+        Option.iter ulam d
     | Ustaticfail (_, ul) -> List.iter ulam ul
     | Ucatch (_, _, u1, u2)
     | Utrywith (u1, _, u2)

middle_end/flambda/closure_conversion.ml

@@ -502,14 +502,14 @@ let rec close t env (lam : Lambda.lambda) : Flambda.t =
           consts = List.map aux sw.sw_consts;
           numblocks = nums sw.sw_numblocks sw.sw_blocks sw.sw_failaction;
           blocks = List.map aux sw.sw_blocks;
-          failaction = Misc.may_map (close t env) sw.sw_failaction;
+          failaction = Option.map (close t env) sw.sw_failaction;
         }))
   | Lstringswitch (arg, sw, def, _) ->
     let scrutinee = Variable.create Names.string_switch in
     Flambda.create_let scrutinee (Expr (close t env arg))
       (String_switch (scrutinee,
         List.map (fun (s, e) -> s, close t env e) sw,
-        Misc.may_map (close t env) def))
+        Option.map (close t env) def))
   | Lstaticraise (i, args) ->
     Lift_code.lifting_helper (close_list t env args)
       ~evaluation_order:`Right_to_left

middle_end/flambda/effect_analysis.ml

@@ -37,12 +37,10 @@ let rec no_effects (flam : Flambda.t) =
     let aux (_, flam) = no_effects flam in
     List.for_all aux sw.blocks
       && List.for_all aux sw.consts
-      && Misc.Stdlib.Option.value_default no_effects sw.failaction
-        ~default:true
+      && Option.fold ~some:no_effects ~none:true sw.failaction
   | String_switch (_, sw, def) ->
     List.for_all (fun (_, lam) -> no_effects lam) sw
-      && Misc.Stdlib.Option.value_default no_effects def
-        ~default:true
+      && Option.fold ~some:no_effects ~none:true def
   | Static_catch (_, _, body, _) | Try_with (body, _, _) ->
     (* If there is a [raise] in [body], the whole [Try_with] may have an
        effect, so there is no need to test the handler. *)

middle_end/flambda/export_info_for_pack.ml

@@ -89,7 +89,7 @@ let import_set_of_closures units pack
       Closure_id.Map.map (import_approx_for_pack units pack)
         set_of_closures.results;
     aliased_symbol =
-      Misc.may_map
+      Option.map
         (import_symbol_for_pack units pack)
         set_of_closures.aliased_symbol;
   }

middle_end/flambda/flambda.ml

@@ -565,11 +565,11 @@ let rec variables_usage ?ignore_uses_as_callee ?ignore_uses_as_argument
         free_variable scrutinee;
         List.iter (fun (_, e) -> aux e) switch.consts;
         List.iter (fun (_, e) -> aux e) switch.blocks;
-        Misc.may aux switch.failaction
+        Option.iter aux switch.failaction
       | String_switch (scrutinee, cases, failaction) ->
         free_variable scrutinee;
         List.iter (fun (_, e) -> aux e) cases;
-        Misc.may aux failaction
+        Option.iter aux failaction
       | Static_raise (_, es) ->
         List.iter free_variable es
       | Static_catch (_, vars, e1, e2) ->
@@ -789,10 +789,10 @@ let iter_general ~toplevel f f_named maybe_named =
       | Switch (_, sw) ->
         List.iter (fun (_,l) -> aux l) sw.consts;
         List.iter (fun (_,l) -> aux l) sw.blocks;
-        Misc.may aux sw.failaction
+        Option.iter aux sw.failaction
       | String_switch (_, sw, def) ->
         List.iter (fun (_,l) -> aux l) sw;
-        Misc.may aux def
+        Option.iter aux def
   and aux_named (named : named) =
     f_named named;
     match named with

middle_end/flambda/flambda_invariants.ml

@@ -213,14 +213,14 @@ let variable_and_symbol_invariants (program : Flambda.program) =
           ignore_int n;
           loop env e)
         (consts @ blocks);
-      Misc.may (loop env) failaction
+      Option.iter (loop env) failaction
     | String_switch (arg, cases, e_opt) ->
       check_variable_is_bound env arg;
       List.iter (fun (label, case) ->
           ignore_string label;
           loop env case)
         cases;
-      Misc.may (loop env) e_opt
+      Option.iter (loop env) e_opt
     | Static_raise (static_exn, es) ->
       ignore_static_exception static_exn;
       List.iter (check_variable_is_bound env) es

middle_end/flambda/flambda_iterators.ml

@@ -32,10 +32,10 @@ let apply_on_subexpressions f f_named (flam : Flambda.t) =
   | Switch (_, sw) ->
     List.iter (fun (_,l) -> f l) sw.consts;
     List.iter (fun (_,l) -> f l) sw.blocks;
-    Misc.may f sw.failaction
+    Option.iter f sw.failaction
   | String_switch (_, sw, def) ->
     List.iter (fun (_,l) -> f l) sw;
-    Misc.may f def
+    Option.iter f def
   | Static_catch (_,_,f1,f2) ->
     f f1; f f2;
   | Try_with (f1,_,f2) ->

middle_end/flambda/flambda_to_clambda.ml

@@ -313,7 +313,7 @@ let rec to_clambda t env (flam : Flambda.t) : Clambda.ulambda =
   | String_switch (arg, sw, def) ->
     let arg = subst_var env arg in
     let sw = List.map (fun (s, e) -> s, to_clambda t env e) sw in
-    let def = Misc.may_map (to_clambda t env) def in
+    let def = Option.map (to_clambda t env) def in
     Ustringswitch (arg, sw, def)
   | Static_raise (static_exn, args) ->
     Ustaticfail (Static_exception.to_int static_exn,

middle_end/flambda/inconstant_idents.ml

@@ -286,12 +286,12 @@ module Inconstants (P:Param) (Backend:Backend_intf.S) = struct
       mark_var arg curr;
       List.iter (fun (_,l) -> mark_loop ~toplevel [] l) sw.consts;
       List.iter (fun (_,l) -> mark_loop ~toplevel [] l) sw.blocks;
-      Misc.may (fun l -> mark_loop ~toplevel [] l) sw.failaction
+      Option.iter (fun l -> mark_loop ~toplevel [] l) sw.failaction
     | String_switch (arg,sw,def) ->
       mark_curr curr;
       mark_var arg curr;
       List.iter (fun (_,l) -> mark_loop ~toplevel [] l) sw;
-      Misc.may (fun l -> mark_loop ~toplevel [] l) def
+      Option.iter (fun l -> mark_loop ~toplevel [] l) def
     | Send { kind = _; meth; obj; args; dbg = _; } ->
       mark_curr curr;
       mark_var meth curr;

middle_end/flambda/inlining_cost.ml

@@ -99,7 +99,7 @@ let lambda_smaller' lam ~than:threshold =
           size := !size + 2;
           lambda_size lam)
         sw;
-      Misc.may lambda_size def
+      Option.iter lambda_size def
     | Static_raise _ -> ()
     | Static_catch (_, _, body, handler) ->
       incr size; lambda_size body; lambda_size handler

middle_end/flambda/ref_to_variables.ml

@@ -60,11 +60,11 @@ let variables_not_used_as_local_reference (tree:Flambda.t) =
       set := Variable.Set.add cond !set;
       List.iter (fun (_, branch) -> loop branch) consts;
       List.iter (fun (_, branch) -> loop branch) blocks;
-      Misc.may loop failaction
+      Option.iter loop failaction
     | String_switch (cond, branches, default) ->
       set := Variable.Set.add cond !set;
       List.iter (fun (_, branch) -> loop branch) branches;
-      Misc.may loop default
+      Option.iter loop default
     | Static_catch (_, _, body, handler) ->
       loop body;
       loop handler

middle_end/flambda/simple_value_approx.ml

@@ -290,7 +290,7 @@ let value_closure ?closure_var ?set_of_closures_var ?set_of_closures_symbol
   let approx_set_of_closures =
     { descr = Value_set_of_closures value_set_of_closures;
       var = set_of_closures_var;
-      symbol = Misc.may_map (fun s -> s, None) set_of_closures_symbol;
+      symbol = Option.map (fun s -> s, None) set_of_closures_symbol;
     }
   in
   let value_closure =

middle_end/flambda/un_anf.ml

@@ -152,7 +152,7 @@ let make_var_info (clam : Clambda.ulambda) : var_info =
           ignore_string str;
           loop branch)
         branches;
-      Misc.may loop default
+      Option.iter loop default
     | Ustaticfail (static_exn, args) ->
       ignore_int static_exn;
       List.iter loop args
@@ -354,7 +354,7 @@ let let_bound_vars_that_can_be_moved var_info (clam : Clambda.ulambda) =
           loop branch)
         branches;
       let_stack := [];
-      Misc.may loop default;
+      Option.iter loop default;
       let_stack := []
     | Ustaticfail (static_exn, args) ->
       ignore_int static_exn;
@@ -516,7 +516,7 @@ let rec substitute_let_moveable is_let_moveable env (clam : Clambda.ulambda)
         branches
     in
     let default =
-      Misc.may_map (substitute_let_moveable is_let_moveable env) default
+      Option.map (substitute_let_moveable is_let_moveable env) default
     in
     Ustringswitch (cond, branches, default)
   | Ustaticfail (n, args) ->
@@ -735,7 +735,7 @@ let rec un_anf_and_moveable var_info env (clam : Clambda.ulambda)
       List.map (fun (s, branch) -> s, un_anf var_info env branch)
         branches
     in
-    let default = Misc.may_map (un_anf var_info env) default in
+    let default = Option.map (un_anf var_info env) default in
     Ustringswitch (cond, branches, default), Fixed
   | Ustaticfail (n, args) ->
     let args = un_anf_list var_info env args in