Factorize evaluation function of artifact

 in one private library and adds an abstract type
 to allow to postpone safely the evaluation.

Signed-off-by: François Bobot <[email protected]>

boot/libs.ml

@@ -24,6 +24,7 @@ let local_libraries =
   ; ("src/meta_parser", Some "Dune_meta_parser", false, None)
   ; ("src/dune", Some "Dune", true, None)
   ; ("vendor/cmdliner/src", None, false, None)
+  ; ("src/artifact_evaluation", Some "Dune_artifact_eval", false, None)
   ; ("otherlibs/build-info/src", Some "Build_info", false,
     Some "build_info_data")
   ]

otherlibs/build-info/src/dune

@@ -5,4 +5,6 @@
  (special_builtin_support
   (build_info
    (data_module build_info_data)
-   (api_version 1))))
+   (api_version 1)))
+ (libraries dune-private-libs.artifact-eval)
+)

otherlibs/build-info/test/run.t

@@ -60,6 +60,7 @@ Inside _build, we have no version information:
   n/a
   lib a: n/a
   lib b: n/a
+  lib dune-private-libs.artifact-eval: n/a
   lib dune-build-info: XXX
 
   $ grep version _build/install/default/lib/a/dune-package
@@ -74,6 +75,7 @@ Once installed, we have the version information:
   1.0+c
   lib a: 1.0+a
   lib b: 1.0+b
+  lib dune-private-libs.artifact-eval: n/a
   lib dune-build-info: XXX
 
   $ grep version _install/lib/a/dune-package
@@ -86,28 +88,16 @@ Check what the generated build info module looks like:
 
   $ cat _build/default/c/.c.eobjs/build_info_data.ml-gen \
   >   | sed 's/"dune-build-info".*/"dune-build-info", Some "XXX"/'
-  let eval s =
-    let len = String.length s in
-    if s.[0] = '=' then
-      let colon_pos = String.index_from s 1 ':' in
-      let vlen = int_of_string (String.sub s 1 (colon_pos - 1)) in
-      (* This [min] is because the value might have been truncated
-         if it was too large *)
-      let vlen = min vlen (len - colon_pos - 1) in
-      Some (String.sub s (colon_pos + 1) vlen)
-    else
-      None
-  [@@inline never]
-
-  let p1 = eval "%%DUNE_PLACEHOLDER:64:vcs-describe:1:a%%%%%%%%%%%%%%%%%%%%%%%%%%"
-  let p2 = eval "%%DUNE_PLACEHOLDER:64:vcs-describe:1:b%%%%%%%%%%%%%%%%%%%%%%%%%%"
-  let p0 = eval "%%DUNE_PLACEHOLDER:64:vcs-describe:1:c%%%%%%%%%%%%%%%%%%%%%%%%%%"
+  let p1 = Dune_artifact_eval.eval "%%DUNE_PLACEHOLDER:64:vcs-describe:1:a%%%%%%%%%%%%%%%%%%%%%%%%%%"
+  let p2 = Dune_artifact_eval.eval "%%DUNE_PLACEHOLDER:64:vcs-describe:1:b%%%%%%%%%%%%%%%%%%%%%%%%%%"
+  let p0 = Dune_artifact_eval.eval "%%DUNE_PLACEHOLDER:64:vcs-describe:1:c%%%%%%%%%%%%%%%%%%%%%%%%%%"
 
   let version = p0
 
   let statically_linked_libraries =
     [ "a", p1
     ; "b", p2
+    ; "dune-private-libs.artifact-eval", None
     ; "dune-build-info", Some "XXX"
     ]
 
@@ -118,6 +108,7 @@ Test substitution when promoting
   1.0+c
   lib a: 1.0+a
   lib b: 1.0+b
+  lib dune-private-libs.artifact-eval: n/a
   lib dune-build-info: XXX
 
 Version is picked from dune-project if available
@@ -130,4 +121,5 @@ Version is picked from dune-project if available
   project-version
   lib a: 1.0+a
   lib b: 1.0+b
+  lib dune-private-libs.artifact-eval: n/a
   lib dune-build-info: XXX

otherlibs/sites_locations/src/dune

@@ -7,4 +7,5 @@
   (sites_locations
    (data_module sites_locations_data)
  ))
+ (libraries dune-private-libs.artifact-eval)
 )

otherlibs/sites_locations/src/helpers.ml

@@ -60,20 +60,6 @@ let () =
     let l = String.split_on_char path_sep s in
     aux l
 
-(* Parse the replacement format described in [artifact_substitution.ml]. *)
-let eval s =
-  let len = String.length s in
-  if s.[0] = '=' then
-    let colon_pos = String.index_from s 1 ':' in
-    let vlen = int_of_string (String.sub s 1 (colon_pos - 1)) in
-    (* This [min] is because the value might have been truncated
-       if it was too large *)
-    let vlen = min vlen (len - colon_pos - 1) in
-    Some (String.sub s (colon_pos + 1) vlen)
-  else
-    None
-[@@inline never]
-
 let get_dir ~package ~section =
   Hashtbl.find_all dirs (package,section)
 
@@ -85,7 +71,8 @@ module HardcodedOcamlPath = struct
     | FindlibConfig of string
 
   let t = lazy (
-    match eval Sites_locations_data.hardcoded_ocamlpath with
+    match Dune_artifact_eval.get
+            Sites_locations_data.hardcoded_ocamlpath with
     | None -> None
     | Some "relocatable" -> Relocatable
     | Some s ->
@@ -117,15 +104,15 @@ let relocate_if_needed path =
 
 let site ~package ~section ~suffix ~encoded =
   let dirs = get_dir ~package ~section in
-  let dirs = match eval encoded with
+  let dirs = match Dune_artifact_eval.get encoded with
     | None -> dirs
     | Some d -> (relocate_if_needed d)::dirs
   in
   List.rev_map (fun dir -> Filename.concat dir suffix) dirs
 [@@inline never]
 
 let sourceroot local =
-  match eval local with
+  match Dune_artifact_eval.get local with
   | Some "" -> None
   | Some _ as x -> x
   | None ->
@@ -154,7 +141,7 @@ let ocamlpath = lazy (
   env@static)
 
 let stdlib = lazy (
-  match eval Sites_locations_data.stdlib_dir with
+  match Dune_artifact_eval.get Sites_locations_data.stdlib_dir with
   | None -> Sys.getenv "DUNE_OCAML_STDLIB"
   | Some s -> s
 )

otherlibs/sites_locations/src/helpers.mli

@@ -24,11 +24,11 @@ module Section : sig
 end
 
 val site : package:string -> section:Section.t ->
-  suffix:string -> encoded:string -> Location.t list
+  suffix:string -> encoded:Dune_artifact_eval.t -> Location.t list
 
 val relocatable: bool Lazy.t
 val ocamlpath: string list Lazy.t
-val sourceroot: string -> string option
+val sourceroot: Dune_artifact_eval.t -> string option
 val stdlib: string Lazy.t
 
 val path_sep: string

otherlibs/sites_locations/src/sites_locations.ml

@@ -1,3 +1,4 @@
 module Private_ = struct
   module Helpers = Helpers
+  module Artifact = Dune_artifact_eval
 end

otherlibs/sites_locations/src/sites_locations_data.mli

@@ -1,5 +1,5 @@
 (** {2 encoded} *)
 
-val hardcoded_ocamlpath: string
+val hardcoded_ocamlpath: Dune_artifact_eval.t
 
-val stdlib_dir: string
+val stdlib_dir: Dune_artifact_eval.t

src/artifact_evaluation/dune

@@ -0,0 +1,4 @@
+(library
+ (name dune_artifact_eval)
+ (public_name dune-private-libs.artifact-eval)
+ (synopsis "[Internal] evaluation of artifact subtitution format"))

src/artifact_evaluation/dune_artifact_eval.ml

@@ -0,0 +1,20 @@
+type t = string
+
+(* Parse the replacement format described in [artifact_substitution.ml]. *)
+let get s =
+  let len = String.length s in
+  if s.[0] = '=' then
+    let colon_pos = String.index_from s 1 ':' in
+    let vlen = int_of_string (String.sub s 1 (colon_pos - 1)) in
+    (* This [min] is because the value might have been truncated
+       if it was too large *)
+    let vlen = min vlen (len - colon_pos - 1) in
+    Some (String.sub s (colon_pos + 1) vlen)
+  else
+    None
+[@@inline never]
+
+let encoded x = x
+[@@inline never]
+
+let eval s = get s

src/artifact_evaluation/dune_artifact_eval.mli

@@ -0,0 +1,5 @@
+type t
+
+val encoded: string -> t
+val get: t -> string option
+val eval: string -> string option

src/dune/generate_module_rules.ml

@@ -6,19 +6,19 @@ let max_path_length = 4096
 let pr buf fmt = Printf.bprintf buf (fmt ^^ "\n")
 
 
-let encode buf e =
-  Printf.bprintf buf "(Sys.opaque_identity %S)"
-    (Artifact_substitution.encode ~min_len:max_path_length e)
-
 let helpers = "Sites_locations.Private_.Helpers"
 let plugins = "Sites_locations_plugins.Private_.Plugins"
 
+let encode buf e =
+  Printf.bprintf buf "(Sites_locations.Private_.Artifact.encoded %S)"
+    (Artifact_substitution.encode ~min_len:max_path_length e)
+
 let sourceroot_code buf =
   pr buf "let sourceroot = %s.sourceroot %a"
     helpers encode (ConfigPath SourceRoot)
 
 let relocatable_code buf =
-  pr buf "let relocatable = Lazy.force %s.relocatable"
+  pr buf "let relocatable = %s.relocatable"
     helpers
 
 let sites_code sctx buf (loc,pkg) =

src/dune/link_time_code_gen.ml

@@ -148,22 +148,8 @@ let build_info_code cctx ~libs ~api_version =
               placeholder p ) ))
   in
   let buf = Buffer.create 1024 in
-  (* Parse the replacement format described in [artifact_substitution.ml]. *)
-  pr buf "let eval s =";
-  pr buf "  let len = String.length s in";
-  pr buf "  if s.[0] = '=' then";
-  pr buf "    let colon_pos = String.index_from s 1 ':' in";
-  pr buf "    let vlen = int_of_string (String.sub s 1 (colon_pos - 1)) in";
-  pr buf "    (* This [min] is because the value might have been truncated";
-  pr buf "       if it was too large *)";
-  pr buf "    let vlen = min vlen (len - colon_pos - 1) in";
-  pr buf "    Some (String.sub s (colon_pos + 1) vlen)";
-  pr buf "  else";
-  pr buf "    None";
-  pr buf "[@@inline never]";
-  pr buf "";
   Path.Source.Map.iteri !placeholders ~f:(fun path var ->
-      pr buf "let %s = eval %S" var
+      pr buf "let %s = Dune_artifact_eval.eval %S" var
         (Artifact_substitution.encode ~min_len:64 (Vcs_describe path)));
   if not (Path.Source.Map.is_empty !placeholders) then pr buf "";
   pr buf "let version = %s" version;
@@ -175,9 +161,9 @@ let build_info_code cctx ~libs ~api_version =
 
 let sites_locations_code () =
   let buf = Buffer.create 5000 in
-  pr buf "let hardcoded_ocamlpath = (Sys.opaque_identity %S)"
+  pr buf "let hardcoded_ocamlpath = Dune_artifact_eval.encoded %S"
     (Artifact_substitution.encode ~min_len:4096 HardcodedOcamlPath);
-  pr buf "let stdlib_dir = (Sys.opaque_identity %S)"
+  pr buf "let stdlib_dir = Dune_artifact_eval.encoded %S"
     (Artifact_substitution.encode ~min_len:4096 (ConfigPath Stdlib));
   Buffer.contents buf