Jsoo: do not inspect Command.Args.t

Signed-off-by: Hugo Heuzard <[email protected]>

src/dune_rules/ctypes_rules.ml

@@ -255,7 +255,7 @@ let exe_link_only ~dir ~shared_cctx ~sandbox program ~deps =
   let link_args =
     let open Action_builder.O in
     let+ () = deps in
-    Command.Args.empty
+    (`Linkall false, Command.Args.empty)
   in
   let program = program_of_module_and_dir ~dir program in
   Exe.link_many ~link_args ~programs:[ program ]

src/dune_rules/exe.ml

@@ -191,7 +191,7 @@ let link_exe ~loc ~name ~(linkage : Linkage.t) ~cm_files ~link_time_code_gen
               (Action_builder.map top_sorted_cms ~f:(fun x ->
                    Command.Args.Deps x))
           ; fdo_linker_script_flags
-          ; Dyn link_args
+          ; Dyn (Action_builder.map ~f:snd link_args)
           ]
     >>| Action.Full.add_sandbox sandbox
   in
@@ -202,53 +202,22 @@ let link_exe ~loc ~name ~(linkage : Linkage.t) ~cm_files ~link_time_code_gen
       | Some p -> Promote p)
     action_with_targets
 
-let command_args_has_flag ~f args =
-  let rec has_flag : 'a. 'a Command.Args.t -> bool Action_builder.t =
-    fun (type a) (a : a Command.Args.t) ->
-     match a with
-     | Command.Args.A a -> Action_builder.return (f a)
-     | As l -> Action_builder.return (List.exists l ~f)
-     | S l ->
-       Action_builder.all (List.map l ~f:has_flag)
-       |> Action_builder.map ~f:(List.exists ~f:(fun x -> x))
-     | Concat (s, l) ->
-       if f s then Action_builder.return true
-       else
-         Action_builder.all (List.map l ~f:has_flag)
-         |> Action_builder.map ~f:(List.exists ~f:(fun x -> x))
-     | Dyn a -> has_flag_action_builder a
-     | Dep _
-     | Deps _
-     | Target _
-     | Path _
-     | Paths _
-     | Hidden_deps _
-     | Hidden_targets _
-     | Fail _
-     | Expand _ -> Action_builder.return false
-  and has_flag_action_builder a =
-    Action_builder.bind a ~f:(fun t -> has_flag t)
-  in
-  has_flag args
-
 let link_js ~name ~loc ~obj_dir ~top_sorted_modules ~link_args ~promote
     ~link_time_code_gen cctx =
   let in_context =
     CC.js_of_ocaml cctx |> Option.value ~default:Js_of_ocaml.In_context.default
   in
   let src = exe_path_from_name cctx ~name ~linkage:Linkage.byte_for_jsoo in
-  let linkall =
-    Action_builder.bind link_args
-      ~f:(command_args_has_flag ~f:(String.equal "-linkall"))
-  in
+  let linkall = Action_builder.map ~f:(fun (`Linkall x, _) -> x) link_args in
   Jsoo_rules.build_exe cctx ~loc ~obj_dir ~in_context ~src ~top_sorted_modules
     ~promote ~link_time_code_gen ~linkall
 
 type dep_graphs = { for_exes : Module.t list Action_builder.t list }
 
-let link_many ?(link_args = Action_builder.return Command.Args.empty) ?o_files
-    ?(embed_in_plugin_libraries = []) ?sandbox ~programs ~linkages ~promote cctx
-    =
+let link_many
+    ?(link_args = Action_builder.return (`Linkall false, Command.Args.empty))
+    ?o_files ?(embed_in_plugin_libraries = []) ?sandbox ~programs ~linkages
+    ~promote cctx =
   let open Memo.O in
   let o_files =
     match o_files with

src/dune_rules/exe.mli

@@ -52,7 +52,9 @@ type dep_graphs = { for_exes : Module.t list Action_builder.t list }
 (* [link_many] is like [build_and_link_many], but it allows you to share modules
    between executables without requiring an intermediate library. *)
 val link_many :
-     ?link_args:Command.Args.without_targets Command.Args.t Action_builder.t
+     ?link_args:
+       ([ `Linkall of bool ] * Command.Args.without_targets Command.Args.t)
+       Action_builder.t
   -> ?o_files:Path.t Mode.Map.Multi.t
   -> ?embed_in_plugin_libraries:(Loc.t * Lib_name.t) list
   -> ?sandbox:Sandbox_config.t
@@ -63,7 +65,9 @@ val link_many :
   -> dep_graphs Memo.t
 
 val build_and_link :
-     ?link_args:Command.Args.without_targets Command.Args.t Action_builder.t
+     ?link_args:
+       ([ `Linkall of bool ] * Command.Args.without_targets Command.Args.t)
+       Action_builder.t
   -> ?o_files:Path.t Mode.Map.Multi.t
   -> ?embed_in_plugin_libraries:(Loc.t * Lib_name.t) list
   -> ?sandbox:Sandbox_config.t
@@ -74,7 +78,9 @@ val build_and_link :
   -> dep_graphs Memo.t
 
 val build_and_link_many :
-     ?link_args:Command.Args.without_targets Command.Args.t Action_builder.t
+     ?link_args:
+       ([ `Linkall of bool ] * Command.Args.without_targets Command.Args.t)
+       Action_builder.t
   -> ?o_files:Path.t Mode.Map.Multi.t
   -> ?embed_in_plugin_libraries:(Loc.t * Lib_name.t) list
   -> ?sandbox:Sandbox_config.t

src/dune_rules/exe_rules.ml

@@ -160,25 +160,28 @@ let executables_rules ~sctx ~dir ~expander ~dir_contents ~scope ~compile_info
       and+ ctypes_cclib_flags =
         Ctypes_rules.ctypes_cclib_flags sctx ~expander ~buildable:exes.buildable
       in
-      Command.Args.S
-        [ As flags
-        ; S
-            (let ext_lib = ctx.lib_config.ext_lib in
-             let foreign_archives =
-               exes.buildable.foreign_archives |> List.map ~f:snd
-             in
-             (* XXX: don't these need the msvc hack being done in lib_rules? *)
-             (* XXX: also the Command.quote_args being done in lib_rules? *)
-             List.map foreign_archives ~f:(fun archive ->
-                 let lib =
-                   Foreign.Archive.lib_file ~archive ~dir ~ext_lib
-                     ~mode:Mode.Select.All
-                 in
-                 Command.Args.S [ A "-cclib"; Dep (Path.build lib) ]))
-          (* XXX: don't these need the msvc hack being done in lib_rules? *)
-          (* XXX: also the Command.quote_args being done in lib_rules? *)
-        ; As (List.concat_map ctypes_cclib_flags ~f:(fun f -> [ "-cclib"; f ]))
-        ]
+      let has_linkall = List.mem ~equal:String.equal flags "-linkall" in
+      ( `Linkall has_linkall
+      , Command.Args.S
+          [ As flags
+          ; S
+              (let ext_lib = ctx.lib_config.ext_lib in
+               let foreign_archives =
+                 exes.buildable.foreign_archives |> List.map ~f:snd
+               in
+               (* XXX: don't these need the msvc hack being done in lib_rules? *)
+               (* XXX: also the Command.quote_args being done in lib_rules? *)
+               List.map foreign_archives ~f:(fun archive ->
+                   let lib =
+                     Foreign.Archive.lib_file ~archive ~dir ~ext_lib
+                       ~mode:Mode.Select.All
+                   in
+                   Command.Args.S [ A "-cclib"; Dep (Path.build lib) ]))
+            (* XXX: don't these need the msvc hack being done in lib_rules? *)
+            (* XXX: also the Command.quote_args being done in lib_rules? *)
+          ; As
+              (List.concat_map ctypes_cclib_flags ~f:(fun f -> [ "-cclib"; f ]))
+          ] )
     in
     let* o_files =
       o_files sctx ~dir ~expander ~exes ~linkages ~dir_contents

src/dune_rules/inline_tests.ml

@@ -180,7 +180,10 @@ include Sub_system.Register_end_point (struct
           Expander.expand_and_eval_set expander info.executable_link_flags
             ~standard:(Action_builder.return [ "-linkall" ])
         in
-        Command.Args.As link_args_info
+        let has_linkall =
+          List.mem ~equal:String.equal link_args_info "-linkall"
+        in
+        (`Linkall has_linkall, Command.Args.As link_args_info)
       in
       Exe.build_and_link cctx
         ~program:{ name; main_module_name = Module.name main_module; loc }

src/dune_rules/jsoo_rules.ml

@@ -285,10 +285,10 @@ let link_rule cc ~runtime ~target ~obj_dir cm ~flags ~linkall
            (Super_context.js_of_ocaml_flags sctx ~dir flags))
       |> Action_builder.map ~f:Config.of_flags
     and+ cm = cm
+    and+ linkall = linkall
     and+ libs = Resolve.Memo.read (Compilation_context.requires_link cc)
     and+ { Link_time_code_gen_type.to_link; force_linkall } =
       Resolve.read link_time_code_gen
-    and+ force_linkall2 = linkall
     and+ jsoo_verion =
       Action_builder.of_memo (Version.jsoo_verion (jsoo ~dir sctx))
     in
@@ -316,7 +316,7 @@ let link_rule cc ~runtime ~target ~obj_dir cm ~flags ~linkall
         (in_build_dir ~sctx ~config
            [ "stdlib"; "std_exit" ^ Js_of_ocaml.Ext.cmo ])
     in
-    let linkall = force_linkall || force_linkall2 in
+    let linkall = force_linkall || linkall in
     Command.Args.S
       [ Deps
           (List.concat

src/dune_rules/mdx.ml

@@ -401,7 +401,8 @@ let mdx_prog_gen t ~sctx ~dir ~scope ~expander ~mdx_prog =
   let+ (_ : Exe.dep_graphs) =
     Exe.build_and_link cctx
       ~program:{ name; main_module_name; loc }
-      ~link_args:(Action_builder.return (Command.Args.A "-linkall"))
+      ~link_args:
+        (Action_builder.return (`Linkall true, Command.Args.A "-linkall"))
       ~linkages:[ Exe.Linkage.byte ] ~promote:None
   in
   Path.Build.relative dir (name ^ ".bc")

src/dune_rules/toplevel.ml

@@ -115,7 +115,7 @@ let setup_rules_and_return_exe_path t =
     Exe.build_and_link t.cctx ~program ~linkages:[ linkage ]
       ~link_args:
         (Action_builder.return
-           (Command.Args.As [ "-linkall"; "-warn-error"; "-31" ]))
+           (`Linkall true, Command.Args.As [ "-linkall"; "-warn-error"; "-31" ]))
       ~promote:None
   in
   let+ () = setup_module_rules t in