Make [add_fail] eager

We can just abort the exapnsion and return the error immediately

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

src/dune/action.ml

@@ -14,14 +14,16 @@ module Prog = struct
 
     let create ?hint ~context ~program ~loc () = { hint; context; program; loc }
 
-    let raise { context; program; hint; loc } =
+    let user_message { context; program; hint; loc } =
       let hint =
         match program with
         | "refmt" ->
           Some (Option.value ~default:"try: opam install reason" hint)
         | _ -> hint
       in
-      Utils.program_not_found ?hint ~loc ~context program
+      Utils.program_not_found_error ?hint ~loc ~context program
+
+    let raise t = raise (User_error.E (user_message t))
 
     let to_dyn { context; program; hint; loc = _ } =
       let open Dyn.Encoder in

src/dune/action.mli

@@ -28,6 +28,8 @@ module Prog : sig
       -> unit
       -> t
 
+    val user_message : t -> User_message.t
+
     val raise : t -> _
   end
 

src/dune/expander.ml

@@ -218,14 +218,18 @@ let expand_str t sw =
   expand t ~mode:Single ~template:sw |> Value.to_string ~dir:(Path.build t.dir)
 
 module Or_exn = struct
-  let of_partial = function
-    | String_with_vars.Partial.Expanded a -> Ok a
-    | Unexpanded _ -> Error (User_error.E (User_error.make []))
+  (* used to wrap exceptions in [add_fail]. To make sure that we don't
+     accidentally delay any exceptions that we aren't supposed to *)
+  exception E of exn
+
+  let raise e = raise (E e)
 
   let expand t ~mode ~template =
-    String_with_vars.partial_expand ~dir:(Path.build t.dir) ~mode template
-      ~f:(expand_var_exn t)
-    |> of_partial
+    try
+      Ok
+        (String_with_vars.expand ~dir:(Path.build t.dir) ~mode template
+           ~f:(expand_var_exn t))
+    with E e -> Error e
 
   let expand_path t sw =
     expand t ~mode:Single ~template:sw
@@ -329,9 +333,7 @@ let cc_of_c_flags t (cc : string list Build.t Foreign.Language.Dict.t) =
       Value.L.strings (t.c_compiler :: flags))
 
 let resolve_binary t ~loc ~prog =
-  match Artifacts.Bin.binary ~loc t.bin_artifacts_host prog with
-  | Ok path -> Ok path
-  | Error e -> Error { Import.fail = (fun () -> Action.Prog.Not_found.raise e) }
+  Artifacts.Bin.binary ~loc t.bin_artifacts_host prog
 
 let cannot_be_used_here pform =
   Pp.textf "%s cannot be used in this position"
@@ -347,6 +349,12 @@ let expand_and_record acc ~map_exe ~dep_kind ~expansion_kind
     | Static -> fun _ -> User_error.raise ~loc [ cannot_be_used_here pform ]
     | Dynamic -> Resolved_forms.add_ddep acc expansion
   in
+  let add_fail =
+    match expansion_kind with
+    | Static -> Or_exn.raise
+    | Dynamic ->
+      fun e -> Resolved_forms.add_fail acc { fail = (fun () -> raise e) }
+  in
   let open Build.O in
   match (expansion : Pform.Expansion.t) with
   | Var
@@ -377,7 +385,7 @@ let expand_and_record acc ~map_exe ~dep_kind ~expansion_kind
   | Macro (Dep, s) -> Some (path_exp (relative dir s))
   | Macro (Bin, s) -> (
     match resolve_binary ~loc:(Some loc) t ~prog:s with
-    | Error fail -> Resolved_forms.add_fail acc fail
+    | Error e -> add_fail (User_error.E (Action.Prog.Not_found.user_message e))
     | Ok path -> Some (path_exp path) )
   | Macro (Lib { lib_exec; lib_private }, s) -> (
     let lib, file = parse_lib_file ~loc s in
@@ -430,24 +438,21 @@ let expand_and_record acc ~map_exe ~dep_kind ~expansion_kind
         in
         add_ddep dep
     | Error e ->
-      Resolved_forms.add_fail acc
+      add_fail
         ( match lib_private with
-        | true -> { fail = (fun () -> raise e) }
+        | true -> e
         | false ->
           if Lib.DB.available (Scope.libs t.scope) lib then
-            { fail =
-                (fun () ->
-                  raise
-                    (User_error.raise ~loc
-                       [ Pp.textf
-                           "The library %S is not public. The variable \"lib\" \
-                            expands to the file's installation path which is \
-                            not defined for private libraries."
-                           (Lib_name.to_string lib)
-                       ]))
-            }
+            User_error.E
+              (User_error.make ~loc
+                 [ Pp.textf
+                     "The library %S is not public. The variable \"lib\" \
+                      expands to the file's installation path which is not \
+                      defined for private libraries."
+                     (Lib_name.to_string lib)
+                 ])
           else
-            { fail = (fun () -> raise e) } ) )
+            e ) )
   | Macro (Lib_available, s) ->
     let lib = Lib_name.parse_string_exn (loc, s) in
     Resolved_forms.add_lib_dep acc lib Optional;
@@ -662,3 +667,8 @@ let expand_and_eval_set t set ~standard =
 let eval_blang t = function
   | Blang.Const x -> x (* common case *)
   | blang -> Blang.eval blang ~dir:(Path.build t.dir) ~f:(expand_var_exn t)
+
+let resolve_binary t ~loc ~prog =
+  match resolve_binary t ~loc ~prog with
+  | Ok path -> Ok path
+  | Error e -> Error { Import.fail = (fun () -> Action.Prog.Not_found.raise e) }

src/dune/utils.ml

@@ -28,8 +28,8 @@ let bash_exn =
       User_error.raise
         [ Pp.textf "I need bash to %s but I couldn't find it :(" needed_to ]
 
-let not_found fmt ?loc ?context ?hint x =
-  User_error.raise ?loc
+let not_found_error fmt ?loc ?context ?hint x =
+  User_error.make ?loc
     ( Pp.textf fmt (String.maybe_quoted x)
     ::
     ( match context with
@@ -41,9 +41,15 @@ let not_found fmt ?loc ?context ?hint x =
       | None -> []
       | Some hint -> [ Pp.text hint ] )
 
+let not_found fmt ?loc ?context ?hint x =
+  raise (User_error.E (not_found_error fmt ?loc ?context ?hint x))
+
+let program_not_found_error ?context ?hint ~loc prog =
+  not_found_error "Program %s not found in the tree or in PATH" ?context ?hint
+    ?loc prog
+
 let program_not_found ?context ?hint ~loc prog =
-  not_found "Program %s not found in the tree or in PATH" ?context ?hint ?loc
-    prog
+  raise (User_error.E (program_not_found_error ?context ?hint ~loc prog))
 
 let library_not_found ?context ?hint lib =
   not_found "Library %s not found" ?context ?hint lib

src/dune/utils.mli

@@ -13,6 +13,13 @@ val bash_exn : needed_to:string -> Path.t
 val program_not_found :
   ?context:Context_name.t -> ?hint:string -> loc:Loc.t option -> string -> _
 
+val program_not_found_error :
+     ?context:Context_name.t
+  -> ?hint:string
+  -> loc:Loc.t option
+  -> string
+  -> User_message.t
+
 (** Raise an error about a library not found *)
 val library_not_found : ?context:Context_name.t -> ?hint:string -> string -> _