Upgrade templates for subsystems (#1638)

Upgrade subsystems to dune format when encoding them to dune-package

src/action_dune_lang.ml

@@ -11,6 +11,15 @@ module type Uast = Action_intf.Ast
 module rec Uast : Uast = Uast
 include Action_ast.Make(String_with_vars)(String_with_vars)(String_with_vars)(Uast)
 
+module Mapper = Action.Make_mapper(Uast)(Uast)
+
+let upgrade_to_dune =
+  let id ~dir:_ p = p in
+  let dir = String_with_vars.make_text Loc.none "" in
+  Mapper.map ~dir ~f_program:id ~f_path:id
+    ~f_string:(fun ~dir:_ -> String_with_vars.upgrade_to_dune)
+
+let encode_and_upgrade a = encode (upgrade_to_dune a)
 
 open Dune_lang.Decoder
 let decode =

src/action_dune_lang.mli

@@ -7,9 +7,10 @@ include Action_intf.Ast
 
 include Dune_lang.Conv with type t := t
 
+val encode_and_upgrade : t Dune_lang.Encoder.t
+
 include Action_intf.Helpers
   with type t := t and
   type program = String_with_vars.t and
   type string = String_with_vars.t and
   type path = String_with_vars.t
-

src/inline_tests.ml

@@ -89,8 +89,9 @@ module Backend = struct
       ((1, 0),
        record_fields Dune @@
          [ field_l "runner_libraries" lib (Result.ok_exn t.runner_libraries)
-         ; field "flags" Ordered_set_lang.Unexpanded.encode t.info.flags
-         ; field_o "generate_runner" Action_dune_lang.encode
+         ; field "flags" Ordered_set_lang.Unexpanded.encode_and_upgrade
+             t.info.flags
+         ; field_o "generate_runner" Action_dune_lang.encode_and_upgrade
              (Option.map t.info.generate_runner ~f:snd)
          ; field_l "extends" f (Result.ok_exn t.extends)
          ])

src/ordered_set_lang.ml

@@ -232,6 +232,11 @@ let standard =
   ; context = Univ_map.empty
   }
 
+let dune_kind t =
+  match Univ_map.find t.context (Syntax.key Stanza.syntax) with
+  | Some (0, _)-> Dune_lang.Syntax.Jbuild
+  | None | Some (_, _) -> Dune
+
 let field ?(default=standard) ?check name =
   let decode =
     match check with
@@ -256,6 +261,17 @@ module Unexpanded = struct
     ; context
     }
 
+  let map t ~f : t =
+    let rec map_ast : ast -> ast =
+      let open Ast in function
+      | Element sw -> Element (f sw)
+      | Include sw -> Include (f sw)
+      | Union xs -> Union (List.map ~f:map_ast xs)
+      | Diff (x, y) -> Diff (map_ast x, map_ast y)
+      | Standard as t -> t
+    in
+    { t with ast = map_ast t.ast }
+
   let encode t =
     let open Ast in
     let rec loop = function
@@ -270,6 +286,13 @@ module Unexpanded = struct
     in
     loop t.ast
 
+  let upgrade_to_dune t =
+    match dune_kind t with
+    | Dune -> t
+    | Jbuild -> map ~f:String_with_vars.upgrade_to_dune t
+
+  let encode_and_upgrade t = encode (upgrade_to_dune t)
+
   let standard = standard
 
   let of_strings ~pos l =
@@ -298,11 +321,7 @@ module Unexpanded = struct
       | Diff (l, r) ->
         loop (loop acc l) r
     in
-    let syntax =
-      match Univ_map.find t.context (Syntax.key Stanza.syntax) with
-      | Some (0, _)-> Dune_lang.Syntax.Jbuild
-      | None | Some (_, _) -> Dune
-    in
+    let syntax = dune_kind t in
     (syntax, loop Path.Set.empty t.ast)
 
   let has_special_forms t =

src/ordered_set_lang.mli

@@ -78,6 +78,9 @@ module Unexpanded : sig
   type t
 
   include Dune_lang.Conv with type t := t
+
+  val encode_and_upgrade : t Dune_lang.Encoder.t
+
   val standard : t
 
   val of_strings : pos:string * int * int * int -> string list -> t

src/preprocessing.ml

@@ -192,9 +192,9 @@ module Driver = struct
       let f x = Lib_name.encode (Lib.name (Lazy.force x.lib)) in
       ((1, 0),
        record_fields Dune @@
-         [ field "flags" Ordered_set_lang.Unexpanded.encode
+         [ field "flags" Ordered_set_lang.Unexpanded.encode_and_upgrade
              t.info.flags
-         ; field "lint_flags" Ordered_set_lang.Unexpanded.encode
+         ; field "lint_flags" Ordered_set_lang.Unexpanded.encode_and_upgrade
              t.info.lint_flags
          ; field "main" string t.info.main
          ; field_l "replaces" f (Result.ok_exn t.replaces)

src/string_with_vars.ml

@@ -8,13 +8,15 @@ type t =
   ; syntax_version : Syntax.Version.t
   }
 
+let make_syntax = (1, 0)
+
 let make ?(quoted=false) loc part =
   { template =
       { parts = [part]
       ; quoted
       ; loc
       }
-  ; syntax_version = (1, 0)
+  ; syntax_version = make_syntax
   }
 
 let make_text ?quoted loc s =
@@ -137,11 +139,9 @@ let loc t = t.template.loc
 
 let syntax_version t = t.syntax_version
 
-let virt_syntax = (1, 0)
-
 let virt ?(quoted=false) pos s =
   let template = Jbuild.parse ~quoted ~loc:(Loc.of_pos pos) s in
-  {template; syntax_version = virt_syntax}
+  {template; syntax_version = make_syntax}
 
 let virt_var ?(quoted=false) pos s =
   assert (String.for_all s ~f:(function ':' -> false | _ -> true));
@@ -157,11 +157,11 @@ let virt_var ?(quoted=false) pos s =
     ; quoted
     }
   in
-  {template; syntax_version = virt_syntax}
+  {template; syntax_version = make_syntax}
 
 let virt_text pos s =
   let template = { parts = [Text s];  loc = Loc.of_pos pos;  quoted = true } in
-  {template; syntax_version = virt_syntax}
+  {template; syntax_version = make_syntax}
 
 let concat_rev = function
   | [] -> ""
@@ -317,3 +317,42 @@ let has_vars t = Option.is_none (text_only t)
 let remove_locs t =
   { t with template = Dune_lang.Template.remove_locs t.template
   }
+
+let rename_vars t ~f =
+  let rename_part = function
+    | Text _ as s -> s
+    | Var v -> Var { v with name = f ~loc:v.loc v.name  }
+  in
+  let rename t =
+    { t with parts = List.map ~f:rename_part t.parts }
+  in
+  { t with template = rename t.template }
+
+let upgrade_to_dune =
+  let f ~loc = function
+    | "@" -> "targets"
+    | "^" -> "deps"
+    | "file" -> "dep"
+    | "SCOPE_ROOT" -> "project_root"
+    | "ROOT" -> "workspace_root"
+    | "findlib" -> "lib"
+    | "CPP" -> "cpp"
+    | "CC" -> "cc"
+    | "CXX" -> "cxx"
+    | "OCAML" -> "ocaml"
+    | "OCAMLC" -> "ocamlc"
+    | "OCAMLOPT" -> "ocamlopt"
+    | "ARCH_SIXTYFOUR" -> "arch_sixtyfour"
+    | "MAKE" -> "make"
+    | "path-no-dep" ->
+      Errors.fail loc "path-no-dep is not supported in dune files"
+    | "<" ->
+      Errors.fail loc
+        "${<} is not supported in dune files. Use a named binding instead."
+    | s -> s
+  in
+  fun t ->
+    if t.syntax_version >= make_syntax then
+      t
+    else
+      { (rename_vars t ~f) with syntax_version = make_syntax }

src/string_with_vars.mli

@@ -82,3 +82,5 @@ val partial_expand
   -> 'a Partial.t
 
 val remove_locs : t -> t
+
+val upgrade_to_dune : t -> t

test/blackbox-tests/dune.inc

@@ -1262,6 +1262,7 @@
   (alias lib-available)
   (alias lib-errors)
   (alias link-deps)
+  (alias lint)
   (alias loop)
   (alias macro-expand-error)
   (alias menhir)
@@ -1403,6 +1404,7 @@
   (alias lib-available)
   (alias lib-errors)
   (alias link-deps)
+  (alias lint)
   (alias loop)
   (alias macro-expand-error)
   (alias merlin-tests)
@@ -1451,6 +1453,6 @@
   (alias wrapped-false-main-module-name)
   (alias wrapped-transition)))
 
-(alias (name runtest-disabled) (deps (alias envs-and-contexts) (alias lint)))
+(alias (name runtest-disabled) (deps (alias envs-and-contexts)))
 
 (alias (name runtest-js) (deps (alias js_of_ocaml)))

test/blackbox-tests/gen_tests.ml

@@ -143,7 +143,6 @@ let exclusions =
   (* The next test is disabled as it relies on configured opam
      swtiches and it's hard to get that working properly *)
   ; make "envs-and-contexts" ~external_deps:true ~enabled:false
-  ; make "lint" ~enabled:false (* https://github.com/ocaml/dune/pull/1631 *)
   ]
 
 let all_tests = lazy (