Merge pull request #905 from rgrinberg/template-sexp-take2

Template Parsing in Dune files via the Lexer

bin/main.ml

@@ -1383,7 +1383,8 @@ let printenv =
       in
       Build_system.do_build setup.build_system ~request
       >>| fun l ->
-      let pp ppf = Format.fprintf ppf "@[<v1>(@,@[<v>%a@]@]@,)" (Format.pp_print_list Sexp.pp) in
+      let pp ppf = Format.fprintf ppf "@[<v1>(@,@[<v>%a@]@]@,)"
+                     (Format.pp_print_list (Sexp.pp Dune)) in
       match l with
       | [(_, env)] ->
         Format.printf "%a@." pp env

doc/dune

@@ -1,5 +1,5 @@
 (rule
- (with-stdout-to dune.1 (run ${bin:dune} --help=groff)))
+ (with-stdout-to dune.1 (run %{bin:dune} --help=groff)))
 
 (install
  (section man)
@@ -8,7 +8,7 @@
 
 (rule
  (with-stdout-to dune-config.5
-  (run ${bin:jbuilder} help config --man-format=groff)))
+  (run %{bin:jbuilder} help config --man-format=groff)))
 
 (install
  (section man)
@@ -21,8 +21,8 @@
  (targets dune.inc.gen)
  (deps    (package dune))
  (action
-  (with-stdout-to ${@}
+  (with-stdout-to %{@}
-   (run bash ${path:update-jbuild.sh}))))
+   (run bash %{path:update-jbuild.sh}))))
 
 (alias
  (name runtest)

doc/project-layout-specification.rst

@@ -62,6 +62,9 @@ special characters. Special characters are:
 
 For instance ``hello`` or ``+`` are valid atoms.
 
+Note that backslashes inside atoms have no special meaning are always
+interpreted as plain backslashes characters.
+
 Strings
 -------
 
@@ -80,6 +83,7 @@ sequences:
 - ``\xHH``, a backslach followed by two hexidecimal characters to
   represent the character with ASCII code ``HH`` in hexadecimal
 - ``\\``, a double backslash to represent a single backslash
+- ``\%{`` to represent ``%{`` (see :ref:`variables`)
 
 Additionally, a backslash that comes just before the end of the line
 is used to skip the newline up to the next non-space character. For
@@ -137,6 +141,29 @@ descriptions. For instance:
     (body
       This is a simple example of using S-expressions))
 
+.. _variables:
+
+Variables
+---------
+
+Dune allows variables in a few places. Their interpretation often
+depend on the context in which they appear.
+
+The syntax of variables is as follow:
+
+.. code::
+
+   %{var}
+
+or, for more complex forms that take an argument:
+
+.. code::
+
+   %{fun:arg}
+
+In order to write a plain ``%{``, you need to write ``\%{`` in a
+string.
+
 .. _opam-files:
 
 dune-project files

example/dune

@@ -5,11 +5,11 @@
  (deps (package dune) (source_tree sample-projects/hello_world))
  (action
   (chdir sample-projects/hello_world
-   (run ${exe:../test/blackbox-tests/cram.exe} -test run.t))))
+   (run %{exe:../test/blackbox-tests/cram.exe} -test run.t))))
 
 (alias
  (name runtest)
  (deps (package dune) (source_tree sample-projects/with-configure-step))
  (action
   (chdir sample-projects/with-configure-step
-   (run ${exe:../test/blackbox-tests/cram.exe} -test run.t))))
+   (run %{exe:../test/blackbox-tests/cram.exe} -test run.t))))

example/sample-projects/hello_world/test/dune

@@ -1,7 +1,7 @@
 (rule
  ((targets (hello_world.output))
-  (action (with-stdout-to ${@} (run ${bin:hello_world})))))
+  (action (with-stdout-to %{@} (run %{bin:hello_world})))))
 
 (alias
  ((name runtest)
-  (action (run diff -uw ${path:hello_world.expected} ${path:hello_world.output}))))
+  (action (run diff -uw %{path:hello_world.expected} %{path:hello_world.output}))))

example/sample-projects/with-configure-step/dune

@@ -2,9 +2,9 @@
  ((fallback)
   (targets (config))
   (deps    (config.defaults))
-  (action  (copy ${<} ${@}))))
+  (action  (copy %{<} %{@}))))
 
 (rule
  ((targets (config.full))
   (deps    (config_common.ml config))
-  (action  (run ${OCAML} ${path:real_configure.ml}))))
+  (action  (run %{OCAML} %{path:real_configure.ml}))))

example/sample-projects/with-configure-step/src/dune

@@ -8,5 +8,5 @@
 (rule
  ((targets (config.ml))
   (deps    (../config.full))
-  (action  (copy ${<} ${@}))))
+  (action  (copy %{<} %{@}))))
 

src/action.ml

@@ -341,8 +341,6 @@ let prog_and_args_of_values p ~dir =
   | String s :: xs ->
     (Unresolved.Program.of_string ~dir s, Value.L.to_strings ~dir xs)
 
-module SW = String_with_vars
-
 module Unexpanded = struct
   module type Uast = Action_intf.Ast
     with type program = String_with_vars.t
@@ -355,7 +353,7 @@ module Unexpanded = struct
   let t =
     let open Sexp.Of_sexp in
     peek raw >>= function
-    | Atom _ | Quoted_string _ as sexp ->
+    | Template _ | Atom _ | Quoted_string _ as sexp ->
       of_sexp_errorf (Sexp.Ast.loc sexp)
         "if you meant for this to be executed with bash, write (bash \"...\") instead"
     | List _ -> t
@@ -365,7 +363,8 @@ module Unexpanded = struct
       Loc.fail loc
         "(mkdir ...) is not supported for paths outside of the workspace:\n\
         \  %a\n"
-        Sexp.pp (List [Sexp.unsafe_atom_of_string "mkdir"; Path.sexp_of_t path])
+        (Sexp.pp Dune)
+        (List [Sexp.unsafe_atom_of_string "mkdir"; Path.sexp_of_t path])
 
   module Partial = struct
     module Program = Unresolved.Program
@@ -450,7 +449,7 @@ module Unexpanded = struct
           | Left  path -> Mkdir path
           | Right tmpl ->
             let path = E.path ~dir ~f x in
-            check_mkdir (SW.loc tmpl) path;
+            check_mkdir (String_with_vars.loc tmpl) path;
             Mkdir path
         end
       | Digest_files x ->
@@ -511,7 +510,7 @@ module Unexpanded = struct
         | Left dir ->
           Chdir (res, partial_expand t ~dir ~map_exe ~f)
         | Right fn ->
-          let loc = SW.loc fn in
+          let loc = String_with_vars.loc fn in
           Loc.fail loc
             "This directory cannot be evaluated statically.\n\
              This is not allowed by jbuilder"
@@ -542,7 +541,7 @@ module Unexpanded = struct
     | Mkdir x ->
       let res = E.path ~dir ~f x in
       (match res with
-       | Left path -> check_mkdir (SW.loc x) path
+       | Left path -> check_mkdir (String_with_vars.loc x) path
        | Right _   -> ());
       Mkdir res
     | Digest_files x ->
@@ -649,7 +648,8 @@ module Promotion = struct
       | l ->
         Io.write_file db_file
           (String.concat ~sep:""
-             (List.map l ~f:(fun x -> Sexp.to_string (File.sexp_of_t x) ^ "\n")))
+             (List.map l ~f:(fun x ->
+                Sexp.to_string ~syntax:Dune (File.sexp_of_t x) ^ "\n")))
     end
 
   let load_db () =
@@ -1062,7 +1062,8 @@ module Infer = struct
         match fn with
         | Left  fn -> { acc with targets = Path.Set.add acc.targets fn }
         | Right sw ->
-          Loc.fail (SW.loc sw) "Cannot determine this target statically."
+          Loc.fail (String_with_vars.loc sw)
+            "Cannot determine this target statically."
       let ( +< ) acc fn =
         match fn with
         | Left  fn -> { acc with deps    = Path.Set.add acc.deps fn }
@@ -1095,7 +1096,7 @@ module Infer = struct
   module Unexp = Make(Unexpanded.Uast)(S_unexp)(Outcome_unexp)(struct
       open Outcome_unexp
       let ( +@ ) acc fn =
-        if SW.is_var fn ~name:"null" then
+        if String_with_vars.is_var fn ~name:"null" then
           acc
         else
           { acc with targets = fn :: acc.targets }

src/action.mli

@@ -83,7 +83,7 @@ module Unexpanded : sig
       :  t
       -> dir:Path.t
       -> map_exe:(Path.t -> Path.t)
-      -> f:(Loc.t -> String.t -> Value.t list option)
+      -> f:(String_with_vars.Var.t -> Value.t list option)
       -> Unresolved.t
   end
 
@@ -91,7 +91,7 @@ module Unexpanded : sig
     :  t
     -> dir:Path.t
     -> map_exe:(Path.t -> Path.t)
-    -> f:(Loc.t -> string -> Value.t list option)
+    -> f:(String_with_vars.Var.t -> Value.t list option)
     -> Partial.t
 end
 

src/build.ml

@@ -151,10 +151,12 @@ let strings p =
   >>^ fun l ->
   List.map l ~f:Scanf.unescaped
 
-let read_sexp p =
+let read_sexp p syntax =
   contents p
   >>^ fun s ->
-  Usexp.parse_string s ~fname:(Path.to_string p) ~mode:Single
+  Usexp.parse_string s
+    ~lexer:(File_tree.Dune_file.Kind.lexer syntax)
+    ~fname:(Path.to_string p) ~mode:Single
 
 let if_file_exists p ~then_ ~else_ =
   If_file_exists (p, ref (Undecided (then_, else_)))

src/build.mli

@@ -91,7 +91,7 @@ val lines_of : Path.t -> ('a, string list) t
 val strings : Path.t -> ('a, string list) t
 
 (** Load an S-expression from a file *)
-val read_sexp : Path.t -> (unit, Sexp.Ast.t) t
+val read_sexp : Path.t -> Usexp.syntax -> (unit, Sexp.Ast.t) t
 
 (** Evaluates to [true] if the file is present on the file system or is the target of a
     rule. *)

src/build_system.ml

@@ -29,7 +29,7 @@ module Promoted_to_delete = struct
       Io.write_file fn
         (String.concat ~sep:""
            (List.map (Path.Set.to_list db) ~f:(fun p ->
-              Sexp.to_string (Path.sexp_of_t p) ^ "\n")))
+              Sexp.to_string ~syntax:Dune (Path.sexp_of_t p) ^ "\n")))
 end
 
 let files_in_source_tree_to_delete () =
@@ -1226,7 +1226,7 @@ let update_universe t =
       0
   in
   make_local_dirs t (Path.Set.singleton Path.build_dir);
-  Io.write_file universe_file (Sexp.to_string (Sexp.To_sexp.int n))
+  Io.write_file universe_file (Sexp.to_string ~syntax:Dune (Sexp.To_sexp.int n))
 
 let do_build t ~request =
   entry_point t ~f:(fun () ->
@@ -1561,7 +1561,7 @@ module Alias = struct
 
   let add_action build_system t ~context ?(locks=[]) ~stamp action =
     let def = get_alias_def build_system t in
-    def.actions <- { stamp = Digest.string (Sexp.to_string stamp)
+    def.actions <- { stamp = Digest.string (Sexp.to_string ~syntax:Dune stamp)
                    ; action
                    ; locks
                    ; context

src/configurator/flags/dune

@@ -1,4 +1,4 @@
 (executable
  (name mk))
 
-(rule (with-stdout-to flags.sexp (run ./mk.exe -ocamlv ${ocaml_version})))
+(rule (with-stdout-to flags.sexp (run ./mk.exe -ocamlv %{ocaml_version})))

src/configurator/v1.ml

@@ -488,7 +488,7 @@ end
 let write_flags fname s =
   let path = Path.in_source fname in
   let sexp = Usexp.List(List.map ~f:Usexp.atom_or_quoted_string s) in
-  Io.write_file path (Usexp.to_string sexp)
+  Io.write_file path (Usexp.to_string sexp ~syntax:Dune)
 
 let main ?(args=[]) ~name f =
   let ocamlc  = ref (

src/dep_path.ml

@@ -14,8 +14,9 @@ module Entry = struct
     | Library (path, lib_name) ->
       sprintf "library %S in %s" lib_name (Path.to_string_maybe_quoted path)
     | Preprocess l ->
-      Sexp.to_string (List [Sexp.unsafe_atom_of_string "pps";
+      Sexp.to_string ~syntax:Dune
-                            Sexp.To_sexp.(list string) l])
+        (List [ Sexp.unsafe_atom_of_string "pps"
+              ; Sexp.To_sexp.(list string) l])
     | Loc loc ->
       Loc.to_file_colon_line loc
 

src/dune_project.ml

@@ -279,7 +279,7 @@ module Extension = struct
              if not !dune_project_edited then begin
                dune_project_edited := true;
                Project_file_edit.append project_file
-                 (Sexp.to_string
+                 (Sexp.to_string ~syntax:Dune
                     (List [ Sexp.atom "using"
                           ; Sexp.atom name
                           ; Sexp.atom (Syntax.Version.to_string version)

src/file_tree.ml

@@ -2,7 +2,7 @@ open! Import
 
 module Dune_file = struct
   module Kind = struct
-    type t = Dune | Jbuild
+    type t = Usexp.syntax = Jbuild | Dune
 
     let of_basename = function
       | "dune"   -> Dune

src/file_tree.mli

@@ -4,7 +4,7 @@ open! Import
 
 module Dune_file : sig
   module Kind : sig
-    type t = Dune | Jbuild
+    type t = Usexp.syntax = Jbuild | Dune
 
     val lexer : t -> Sexp.Lexer.t
   end

src/gen_rules.ml

@@ -107,9 +107,10 @@ module Gen(P : Install_rules.Params) = struct
              \nThis will become an error in the future."
             (let tag = Sexp.unsafe_atom_of_string
                          "modules_without_implementation" in
-             Sexp.to_string (List [ tag
+             Sexp.to_string ~syntax:Dune
-                                  ; Sexp.To_sexp.(list string) should_be_listed
+               (List [ tag
-                                  ]))
+                     ; Sexp.To_sexp.(list string) should_be_listed
+                     ]))
         | Some loc ->
           Loc.warn loc
             "The following modules must be listed here as they don't \

src/install_rules.ml

@@ -39,7 +39,7 @@ module Gen(P : Install_params) = struct
   let gen_lib_dune_file lib =
     SC.add_rule sctx
       (Build.arr (fun () ->
-         Format.asprintf "%a@." Sexp.pp
+         Format.asprintf "%a@." (Sexp.pp Dune)
            (Lib.Sub_system.dump_config lib |> Installed_dune_file.gen))
        >>> Build.write_file_dyn
              (lib_dune_file ~dir:(Lib.src_dir lib) ~name:(Lib.name lib)))

src/jbuild.ml

@@ -191,6 +191,8 @@ module Pps_and_flags = struct
 
     let item =
       peek raw >>= function
+      | Template { loc; _ } ->
+        no_templates loc "in the preprocessors field"
       | Atom _ | Quoted_string _ -> plain_string of_string
       | List _ -> list string >>| fun l -> Right l
 
@@ -260,7 +262,7 @@ module Dep_conf = struct
         ]
     in
     peek raw >>= function
-    | Atom _ | Quoted_string _ ->
+    | Template _ | Atom _ | Quoted_string _ ->
       String_with_vars.t >>| fun x -> File x
     | List _ -> t
 
@@ -363,9 +365,7 @@ module Lint = struct
   let no_lint = default
 end
 
-let field_oslu name =
+let field_oslu name = Ordered_set_lang.Unexpanded.field name
-  field name Ordered_set_lang.Unexpanded.t
-    ~default:Ordered_set_lang.Unexpanded.standard
 
 module Js_of_ocaml = struct
 
@@ -419,6 +419,7 @@ module Lib_dep = struct
           ; forbidden
           ; file
           }
+        | Template _ -> no_templates loc "in the select form"
         | List _ ->
           of_sexp_errorf loc "(<[!]libraries>... -> <file>) expected"
         | (Atom (_, A s) | Quoted_string (_, s)) ->
@@ -529,8 +530,7 @@ module Buildable = struct
     ; allow_overlapping_dependencies : bool
     }
 
-  let modules_field name =
+  let modules_field name = Ordered_set_lang.field name
-    field name Ordered_set_lang.t ~default:Ordered_set_lang.standard
 
   let t =
     loc >>= fun loc ->
@@ -972,7 +972,8 @@ module Executables = struct
     let to_install =
       match Link_mode.Set.best_install_mode t.modes with
       | None when has_public_name ->
-        let mode_to_string mode = " - " ^ Sexp.to_string (Link_mode.sexp_of_t mode) in
+        let mode_to_string mode =
+          " - " ^ Sexp.to_string ~syntax:Dune (Link_mode.sexp_of_t mode) in
         let mode_strings = List.map ~f:mode_to_string Link_mode.installable_modes in
         Loc.fail
           buildable.loc
@@ -1362,7 +1363,7 @@ module Documentation = struct
   let t =
     record
       (Pkg.field >>= fun package ->
-       field "mld_files" Ordered_set_lang.t ~default:Ordered_set_lang.standard
+       Ordered_set_lang.field "mld_files"
        >>= fun mld_files ->
        return
          { package

src/loc.ml

@@ -1,9 +1,6 @@
 open Import
 
-type t = Usexp.Loc.t =
+include Usexp.Loc
-  { start : Lexing.position
-  ; stop  : Lexing.position
-  }
 
 (* TODO get rid of all this stuff once this parsing code moves to Usexp and
    there will be no circular dependency *)
@@ -64,8 +61,6 @@ let of_pos (fname, lnum, cnum, enum) =
   ; stop  = { pos with pos_cnum = enum }
   }
 
-let none = in_file "<none>"
-
 let print ppf { start; stop } =
   let start_c = start.pos_cnum - start.pos_bol in
   let stop_c  = stop.pos_cnum  - start.pos_bol in

src/main.ml

@@ -88,7 +88,7 @@ let setup ?(log=Log.no_log)
   >>= fun contexts ->
   let contexts = List.concat contexts in
   List.iter contexts ~f:(fun (ctx : Context.t) ->
-    Log.infof log "@[<1>Jbuilder context:@,%a@]@." Sexp.pp
+    Log.infof log "@[<1>Jbuilder context:@,%a@]@." (Sexp.pp Dune)
       (Context.sexp_of_t ctx));
   let rule_done  = ref 0 in
   let rule_total = ref 0 in

src/ordered_set_lang.ml

@@ -15,6 +15,7 @@ end
 type 'ast generic =
   { ast : 'ast
   ; loc : Loc.t option
+  ; context: Univ_map.t
   }
 
 type ast_expanded = (Loc.t * string, Ast.expanded) Ast.t
@@ -24,7 +25,8 @@ let loc t = t.loc
 let parse_general sexp ~f =
   let rec of_sexp : Sexp.Ast.t -> _ = function
     | Atom (loc, A "\\") -> Loc.fail loc "unexpected \\"
-    | (Atom (_, A "") | Quoted_string (_, _)) as t -> Ast.Element (f t)
+    | (Atom (_, A "") | Quoted_string (_, _) | Template _ ) as t ->
+      Ast.Element (f t)
     | Atom (loc, A s) as t ->
       if s.[0] = ':' then
         Special (loc, String.sub s ~pos:1 ~len:(String.length s - 1))
@@ -42,14 +44,17 @@ let parse_general sexp ~f =
 
 let t =
   let open Sexp.Of_sexp in
+  context >>= fun context ->
   raw >>| fun sexp ->
   let ast =
     parse_general sexp ~f:(function
+      | Template t -> no_templates t.loc "here"
       | Atom (loc, A s) | Quoted_string (loc, s) -> (loc, s)
       | List _ -> assert false)
   in
   { ast
   ; loc = Some (Sexp.Ast.loc sexp)
+  ; context
   }
 
 let is_standard t =
@@ -168,20 +173,24 @@ end
 let standard =
   { ast = Ast.Special (Loc.none, "standard")
   ; loc = None
+  ; context = Univ_map.empty
   }
 
+let field ?(default=standard) name = Sexp.Of_sexp.field name t ~default
+
 module Unexpanded = struct
   type ast = (Sexp.Ast.t, Ast.unexpanded) Ast.t
   type t = ast generic
   let t =
     let open Sexp.Of_sexp in
+    context >>= fun context ->
     raw >>| fun sexp ->
     let rec map (t : (Sexp.Ast.t, Ast.expanded) Ast.t) =
       let open Ast in
       match t with
       | Element x -> Element x
       | Union [Special (_, "include"); Element fn] ->
-        Include (Sexp.Of_sexp.parse String_with_vars.t Univ_map.empty fn)
+        Include (Sexp.Of_sexp.parse String_with_vars.t context fn)
       | Union [Special (loc, "include"); _]
       | Special (loc, "include") ->
         Loc.fail loc "(:include expects a single element (do you need to quote the filename?)"
@@ -193,6 +202,7 @@ module Unexpanded = struct
     in
     { ast = map (parse_general sexp ~f:(fun x -> x))
     ; loc = Some (Sexp.Ast.loc sexp)
+    ; context
     }
 
   let sexp_of_t t =
@@ -225,7 +235,12 @@ module Unexpanded = struct
       | Diff (l, r) ->
         loop (loop acc l) r
     in
-    loop String.Set.empty t.ast
+    let syntax =
+      match Univ_map.find t.context (Syntax.key Stanza.syntax) with
+      | Some (0, _)-> File_tree.Dune_file.Kind.Jbuild
+      | None | Some (_, _) -> Dune
+    in
+    (syntax, loop String.Set.empty t.ast)
 
   let has_special_forms t =
     let rec loop (t : ast) =
@@ -242,12 +257,14 @@ module Unexpanded = struct
     loop t.ast
 
   let expand t ~files_contents ~f  =
+    let context = t.context in
     let rec expand (t : ast) : ast_expanded =
       let open Ast in
       match t with
       | Element s ->
-        Element (Sexp.Ast.loc s,
+        Element ( Sexp.Ast.loc s
-                 f (Sexp.Of_sexp.parse String_with_vars.t Univ_map.empty s))
+                , f (Sexp.Of_sexp.parse String_with_vars.t context s)
+                )
       | Special (l, s) -> Special (l, s)
       | Include fn ->
         let sexp =
@@ -264,7 +281,7 @@ module Unexpanded = struct
         in
         parse_general sexp ~f:(fun sexp ->
           (Sexp.Ast.loc sexp,
-           f (Sexp.Of_sexp.parse String_with_vars.t Univ_map.empty sexp)))
+           f (Sexp.Of_sexp.parse String_with_vars.t context sexp)))
       | Union l -> Union (List.map l ~f:expand)
       | Diff (l, r) ->
         Diff (expand l, expand r)

src/ordered_set_lang.mli

@@ -49,6 +49,8 @@ module Make(Key : Key)(Value : Value with type key = Key.t)
 val standard : t
 val is_standard : t -> bool
 
+val field : ?default:t -> string -> t Sexp.Of_sexp.fields_parser
+
 module Unexpanded : sig
   type expanded = t
   type t
@@ -61,7 +63,10 @@ module Unexpanded : sig
   val has_special_forms : t -> bool
 
   (** List of files needed to expand this set *)
-  val files : t -> f:(String_with_vars.t -> string) -> String.Set.t
+  val files
+    : t
+    -> f:(String_with_vars.t -> string)
+    -> Sexp.syntax * String.Set.t
 
   (** Expand [t] using with the given file contents. [file_contents] is a map from
       filenames to their parsed contents. Every [(:include fn)] in [t] is replaced by

src/report_error.ml

@@ -74,8 +74,8 @@ let report_with_backtrace exn =
       ; pp = fun ppf ->
           Format.fprintf ppf "@{<error>Internal error, please report upstream \
                               including the contents of _build/log.@}\n\
-                              Description: %a\n"
+                              Description:%a\n"
-            Usexp.pp sexp
+            (Usexp.pp Dune) sexp
       }
     | Unix.Unix_error (err, func, fname) ->
       { p with pp = fun ppf ->

src/stdune/path.ml

@@ -590,6 +590,7 @@ let of_string ?error_loc s =
 let t =
   Sexp.Of_sexp.(
     peek raw >>= function
+    | Template _
     | Atom _ | Quoted_string _ ->
       (* necessary for old build dirs *)
       plain_string (fun ~loc:_ s -> of_string s)

src/stdune/sexp.ml

@@ -63,6 +63,7 @@ module Of_sexp = struct
   type ast = Ast.t =
     | Atom of Loc.t * Atom.t
     | Quoted_string of Loc.t * string
+    | Template of Template.t
     | List of Loc.t * ast list
 
   type hint =
@@ -76,6 +77,9 @@ module Of_sexp = struct
     raise (Of_sexp (loc, msg, hint))
   let of_sexp_errorf ?hint loc fmt =
     Printf.ksprintf (fun msg -> of_sexp_error loc ?hint msg) fmt
+  let no_templates ?hint loc fmt =
+    Printf.ksprintf (fun msg ->
+      of_sexp_error loc ?hint ("No variables allowed " ^ msg)) fmt
 
   type unparsed_field =
     { values : Ast.t list
@@ -133,6 +137,8 @@ module Of_sexp = struct
 
   let get key ctx state = (Univ_map.find (get_user_context ctx) key, state)
 
+  let context ctx state = (get_user_context ctx, state)
+
   let set : type a b k. a Univ_map.Key.t -> a -> (b, k) parser -> (b, k) parser
     = fun key v t ctx state ->
       match ctx with
@@ -236,7 +242,8 @@ module Of_sexp = struct
   let plain_string f =
     next (function
       | Atom (loc, A s) | Quoted_string (loc, s) -> f ~loc s
-      | List (loc, _) -> of_sexp_error loc "Atom or quoted string expected")
+      | Template { loc ; _ } | List (loc, _) ->
+        of_sexp_error loc "Atom or quoted string expected")
 
   let enter t =
     next_with_user_context (fun uc sexp ->
@@ -285,7 +292,7 @@ module Of_sexp = struct
 
   let basic desc f =
     next (function
-      | List (loc, _) | Quoted_string (loc, _) ->
+      | Template { loc; _ } | List (loc, _) | Quoted_string (loc, _) ->
         of_sexp_errorf loc "%s expected" desc
       | Atom (loc, s)  ->
         match f (Atom.to_string s) with
@@ -361,13 +368,14 @@ module Of_sexp = struct
       match sexp with
       | Atom (loc, A s) ->
         find_cstr cstrs loc s (Values (loc, Some s, uc)) []
+      | Template { loc; _ }
       | Quoted_string (loc, _) ->
         of_sexp_error loc "Atom expected"
       | List (loc, []) ->
         of_sexp_error loc "Non-empty list expected"
       | List (loc, name :: args) ->
         match name with
-        | Quoted_string (loc, _) | List (loc, _) ->
+        | Quoted_string (loc, _) | List (loc, _) | Template { loc; _ } ->
           of_sexp_error loc "Atom expected"
         | Atom (s_loc, A s) ->
           find_cstr cstrs s_loc s (Values (loc, Some s, uc)) args)
@@ -375,6 +383,7 @@ module Of_sexp = struct
   let enum cstrs =
     next (function
       | Quoted_string (loc, _)
+      | Template { loc; _ }
       | List (loc, _) -> of_sexp_error loc "Atom expected"
       | Atom (loc, A s) ->
         match List.assoc cstrs s with
@@ -496,7 +505,7 @@ module Of_sexp = struct
                 ; entry = sexp
                 ; prev  = Name_map.find acc name
                 }
-            | List (loc, _) | Quoted_string (loc, _) ->
+            | List (loc, _) | Quoted_string (loc, _) | Template { loc; _ } ->
               of_sexp_error loc "Atom expected"
           end
         | _ ->

src/stdune/sexp.mli

@@ -56,6 +56,7 @@ module Of_sexp : sig
   type ast = Ast.t =
     | Atom of Loc.t * Atom.t
     | Quoted_string of Loc.t * string
+    | Template of Template.t
     | List of Loc.t * ast list
 
   type hint =
@@ -111,6 +112,8 @@ module Of_sexp : sig
   val set : 'a Univ_map.Key.t -> 'a -> ('b, 'k) parser -> ('b, 'k) parser
   val set_many : Univ_map.t -> ('a, 'k) parser -> ('a, 'k) parser
 
+  val context : (Univ_map.t, _) parser
+
   (** Return the location of the list currently being parsed. *)
   val loc : (Loc.t, _) parser
 
@@ -176,6 +179,12 @@ module Of_sexp : sig
     -> ('a, unit, string, 'b) format4
     -> 'a
 
+  val no_templates
+    : ?hint:hint
+    -> Loc.t
+    -> ('a, unit, string, 'b) format4
+    -> 'a
+
   val located : 'a t -> (Loc.t * 'a) t
 
   val enum : (string * 'a) list -> 'a t

src/string_with_vars.ml

@@ -1,111 +1,130 @@
 open! Import
 
-type var_syntax = Parens | Braces
+open Usexp.Template
 
-type item =
+type t = Usexp.Template.t
-  | Text of string
-  | Var of var_syntax * string
 
-type t =
+let literal ~quoted ~loc s =
-  { items : item list
+  { parts = [Text s]
-  ; loc : Loc.t
+  ; quoted
-  ; quoted : bool }
+  ; loc
+  }
 
-module Token = struct
+(* This module implements the "old" template parsing that is only used in jbuild
-  type t =
+   files *)
-    | String of string
+module Jbuild : sig
-    | Open   of var_syntax
+  val parse : string -> loc:Loc.t -> quoted:bool -> t
-    | Close  of var_syntax
+end = struct
+  type var_syntax = Parens | Braces
+  module Token = struct
+    type t =
+      | String of string
+      | Open   of var_syntax
+      | Close  of var_syntax
 
-  let tokenise s =
+    let tokenise s =
-    let len = String.length s in
+      let len = String.length s in
-    let sub i j = String.sub s ~pos:i ~len:(j - i) in
+      let sub i j = String.sub s ~pos:i ~len:(j - i) in
-    let cons_str i j acc = if i = j then acc else String (sub i j) :: acc in
+      let cons_str i j acc = if i = j then acc else String (sub i j) :: acc in
-    let rec loop i j =
+      let rec loop i j =
-      if j = len
+        if j = len
-      then cons_str i j []
+        then cons_str i j []
-      else
+        else
-        match s.[j] with
+          match s.[j] with
-        | '}' -> cons_str i j (Close Braces :: loop (j + 1) (j + 1))
+          | '}' -> cons_str i j (Close Braces :: loop (j + 1) (j + 1))
-        | ')' -> cons_str i j (Close Parens :: loop (j + 1) (j + 1))
+          | ')' -> cons_str i j (Close Parens :: loop (j + 1) (j + 1))
-        | '$' when j + 1 < len -> begin
+          | '$' when j + 1 < len -> begin
-            match s.[j + 1] with
+              match s.[j + 1] with
-            | '{' -> cons_str i j (Open Braces :: loop (j + 2) (j + 2))
+              | '{' -> cons_str i j (Open Braces :: loop (j + 2) (j + 2))
-            | '(' -> cons_str i j (Open Parens :: loop (j + 2) (j + 2))
+              | '(' -> cons_str i j (Open Parens :: loop (j + 2) (j + 2))
-            | _   -> loop i (j + 1)
+              | _   -> loop i (j + 1)
-          end
+            end
-        | _ -> loop i (j + 1)
+          | _ -> loop i (j + 1)
-    in
+      in
-    loop 0 0
+      loop 0 0
 
-  let to_string = function
+    let to_string = function
-    | String s     -> s
+      | String s     -> s
-    | Open  Braces -> "${"
+      | Open  Braces -> "${"
-    | Open  Parens -> "$("
+      | Open  Parens -> "$("
-    | Close Braces -> "}"
+      | Close Braces -> "}"
-    | Close Parens -> ")"
+      | Close Parens -> ")"
+  end
+  (* Remark: Consecutive [Text] items are concatenated. *)
+  let rec of_tokens
+    : Loc.t -> Token.t list -> part list = fun loc -> function
+    | [] -> []
+    | Open a :: String s :: Close b :: rest when a = b ->
+      let (name, payload) =
+        match String.lsplit2 s ~on:':' with
+        | None -> (s, None)
+        | Some (n, p) -> (n, Some p)
+      in
+      Var { loc
+          ; name
+          ; payload
+          ; syntax =
+              begin match a with
+              | Parens -> Dollar_paren
+              | Braces -> Dollar_brace
+              end
+          } :: of_tokens loc rest
+    | token :: rest ->
+      let s = Token.to_string token in
+      match of_tokens loc rest with
+      | Text s' :: l -> Text (s ^ s') :: l
+      | l -> Text s :: l
+
+  let parse s ~loc ~quoted =
+    { parts = of_tokens loc (Token.tokenise s)
+    ; loc
+    ; quoted
+    }
 end
 
-(* Remark: Consecutive [Text] items are concatenated. *)
-let rec of_tokens : Token.t list -> item list = function
-  | [] -> []
-  | Open a :: String s :: Close b :: rest when a = b ->
-    Var (a, s) :: of_tokens rest
-  | token :: rest ->
-    let s = Token.to_string token in
-    match of_tokens rest with
-    | Text s' :: l -> Text (s ^ s') :: l
-    | l -> Text s :: l
-
-let items_of_string s = of_tokens (Token.tokenise s)
-
 let t =
   let open Sexp.Of_sexp in
-  raw >>| fun sexp ->
+  let jbuild =
-  match sexp with
+    raw >>| function
-  | Atom(loc, A s) -> { items = items_of_string s;  loc;  quoted = false }
+    | Template _ as t ->
-  | Quoted_string (loc, s) ->
+      Exn.code_error "Unexpected dune template from a jbuild file"
-    { items = items_of_string s;  loc;  quoted = true }
+        [ "t", Usexp.Ast.remove_locs t
-  | List (loc, _) -> of_sexp_error loc "Atom or quoted string expected"
+        ]
+    | Atom(loc, A s) -> Jbuild.parse s ~loc ~quoted:false
+    | Quoted_string (loc, s) -> Jbuild.parse s ~loc ~quoted:true
+    | List (loc, _) -> Sexp.Of_sexp.of_sexp_error loc "Atom expected"
+  in
+  let dune =
+    raw >>| function
+    | Template t -> t
+    | Atom(loc, A s) -> literal ~quoted:false ~loc s
+    | Quoted_string (loc, s) -> literal ~quoted:true ~loc s
+    | List (loc, _) -> Sexp.Of_sexp.of_sexp_error loc "Unexpected list"
+  in
+  Syntax.get_exn Stanza.syntax >>= function
+  | (0, _) -> jbuild
+  | (_, _) -> dune
 
 let loc t = t.loc
 
 let virt ?(quoted=false) pos s =
-  { items = items_of_string s;  loc = Loc.of_pos pos;  quoted }
+  Jbuild.parse ~quoted ~loc:(Loc.of_pos pos) s
+
 let virt_var ?(quoted=false) pos s =
-  { items = [Var (Braces, s)];  loc = Loc.of_pos pos;  quoted }
+  assert (String.for_all s ~f:(function ':' -> false | _ -> true));
+  let loc = Loc.of_pos pos in
+  { parts =
+      [Var { payload = None
+           ; name = s
+           ; syntax = Percent
+           ; loc
+           }]
+  ; loc
+  ; quoted
+  }
+
 let virt_text pos s =
-  { items = [Text s];  loc = Loc.of_pos pos;  quoted = true }
+  { parts = [Text s];  loc = Loc.of_pos pos;  quoted = true }
-
-let sexp_of_var_syntax = function
-  | Parens -> Sexp.unsafe_atom_of_string "parens"
-  | Braces -> Sexp.unsafe_atom_of_string "braces"
-
-let sexp_of_item =
-  let open Sexp in function
-    | Text s -> List [Sexp.unsafe_atom_of_string "text" ;
-                      Sexp.atom_or_quoted_string s]
-    | Var (vs, s) -> List [sexp_of_var_syntax vs ;
-                           Sexp.atom_or_quoted_string s]
-
-let sexp_of_ast t = Sexp.To_sexp.list sexp_of_item t.items
-
-let fold t ~init ~f =
-  List.fold_left t.items ~init ~f:(fun acc item ->
-    match item with
-    | Text _ -> acc
-    | Var (_, v) -> f acc t.loc v)
-
-let iter t ~f = List.iter t.items ~f:(function
-  | Text _ -> ()
-  | Var (_, v) -> f t.loc v)
-
-let vars t = fold t ~init:String.Set.empty ~f:(fun acc _ x -> String.Set.add acc x)
-
-let string_of_var syntax v =
-  match syntax with
-  | Parens -> sprintf "$(%s)" v
-  | Braces -> sprintf "${%s}" v
 
 let concat_rev = function
   | [] -> ""
@@ -139,74 +158,99 @@ module Partial = struct
     | Unexpanded of t
 end
 
-let invalid_multivalue syntax ~var t x =
+let invalid_multivalue (v : var) x =
-  Loc.fail t.loc "Variable %s expands to %d values, \
+  Loc.fail v.loc "Variable %s expands to %d values, \
                   however a single value is expected here. \
                   Please quote this atom."
-    (string_of_var syntax var) (List.length x)
+    (string_of_var v) (List.length x)
 
-let partial_expand t ~mode ~dir ~f =
+module Var = struct
-  let commit_text acc_text acc =
+  type t = var
-    let s = concat_rev acc_text in
+
-    if s = "" then acc else Text s :: acc
+  let loc (t : t) = t.loc
-  in
+
-  let rec loop acc_text acc items =
+  type kind =
-    match items with
+    | Single of string
-    | [] ->
+    | Pair of string * string
-      begin match acc with
+
-      | [] -> Partial.Expanded (Mode.string mode (concat_rev acc_text))
+  let destruct { loc = _ ; name; payload; syntax = _ } =
-      | _  -> Unexpanded { t with items = List.rev (commit_text acc_text acc) }
+    match payload with
+    | None -> Single name
+    | Some p -> Pair (name, p)
+
+  let full_name t =
+    match destruct t with
+    | Single s -> s
+    | Pair (k, v) -> k ^ ":" ^ v
+end
+
+let partial_expand
+  : 'a.t
+  -> mode:'a Mode.t
+  -> dir:Path.t
+  -> f:(Var.t -> Value.t list option)
+  -> 'a Partial.t
+  = fun t ~mode ~dir ~f ->
+    let commit_text acc_text acc =
+      let s = concat_rev acc_text in
+      if s = "" then acc else Text s :: acc
+    in
+    let rec loop acc_text acc items =
+      match items with
+      | [] ->
+        begin match acc with
+        | [] ->
+          Partial.Expanded (Mode.string mode (concat_rev acc_text))
+        | _  ->
+          Unexpanded { t with parts = List.rev (commit_text acc_text acc) }
+        end
+      | Text s :: items -> loop (s :: acc_text) acc items
+      | Var var as it :: items ->
+        begin match f var with
+        | Some ([] | _::_::_ as e) when not t.quoted ->
+          invalid_multivalue var e
+        | Some t ->
+          loop (Value.L.concat ~dir t :: acc_text) acc items
+        | None -> loop [] (it :: commit_text acc_text acc) items
+        end
+    in
+    match t.parts with
+    | [] -> Partial.Expanded (Mode.string mode "")
+    | [Text s] -> Expanded (Mode.string mode s)
+    | [Var var] when not t.quoted ->
+      begin match f var with
+      | None -> Partial.Unexpanded t
+      | Some e -> Expanded (
+        match Mode.value mode e with
+        | None -> invalid_multivalue var e
+        | Some s -> s)
       end
-    | Text s :: items -> loop (s :: acc_text) acc items
+    | _ -> loop [] [] t.parts
-    | Var (syntax, var) as it :: items ->
-      begin match f syntax t.loc var with
-      | Some ([] | _::_::_ as e) when not t.quoted ->
-        invalid_multivalue syntax ~var t e
-      | Some t ->
-        loop (Value.L.concat ~dir t :: acc_text) acc items
-      | None -> loop [] (it :: commit_text acc_text acc) items
-      end
-  in
-  match t.items with
-  | [] -> Partial.Expanded (Mode.string mode "")
-  | [Text s] -> Expanded (Mode.string mode s)
-  | [Var (syntax, v)] when not t.quoted ->
-    (* Unquoted single var *)
-    begin match f syntax t.loc v with
-    | Some e -> Partial.Expanded (
-      match Mode.value mode e with
-      | None -> invalid_multivalue syntax ~var:v t e
-      | Some s -> s)
-    | None -> Unexpanded t
-    end
-  | _ -> loop [] [] t.items
 
 let expand t ~mode ~dir ~f =
   match
-    partial_expand t ~mode ~dir ~f:(fun syntax loc var ->
+    partial_expand t ~mode ~dir ~f:(fun var ->
-      match f loc var with
+      match f var with
-      | None -> Some [Value.String (string_of_var syntax var)]
+      | None ->
+        begin match var.syntax with
+        | Percent ->
+          begin match Var.destruct var with
+          | Single v -> Loc.fail var.loc "unknown variable %S" v
+          | Pair _ -> Loc.fail var.loc "unknown form %s" (string_of_var var)
+          end
+        | Dollar_brace
+        | Dollar_paren -> Some [Value.String (string_of_var var)]
+        end
       | s -> s)
   with
   | Partial.Expanded s -> s
   | Unexpanded _ -> assert false (* we are expanding every variable *)
 
-let partial_expand t ~mode ~dir ~f =
+let partial_expand t ~mode ~dir ~f = partial_expand t ~mode ~dir ~f
-  partial_expand t ~mode ~dir ~f:(fun _ loc v -> f loc v)
 
-let to_string t =
+let sexp_of_t t = Usexp.Template t
-  match t.items with
-  (* [to_string is only called from action.ml, always on [t]s of this form *)
-  | [Var (syntax, v)] -> string_of_var syntax v
-  | items ->
-    List.map items ~f:(function
-      | Text s -> s
-      | Var (syntax, v) -> string_of_var syntax v)
-    |> String.concat ~sep:""
 
-let sexp_of_t t = Sexp.To_sexp.string (to_string t)
+let is_var { parts ; quoted = _; loc = _ } ~name =
-
+  match parts with
-let is_var t ~name =
+  | [Var n] -> name = Var.full_name n
-  match t.items with
-  | [Var (_, v)] -> v = name
   | _ -> false

src/string_with_vars.mli

@@ -18,12 +18,6 @@ val loc : t -> Loc.t
 
 val sexp_of_t : t -> Sexp.t
 
-(** Same as [sexp_of_t] but the S-expression encodes the internal
-    structure of [t]. *)
-val sexp_of_ast : t -> Sexp.t
-
-val to_string : t -> string
-
 (** [t] generated by the OCaml code. The first argument should be
     [__POS__]. The second is either a string to parse, a variable name
     or plain text.  [quoted] says whether the string is quoted ([false]
@@ -32,17 +26,6 @@ val virt       : ?quoted: bool -> (string * int * int * int) -> string -> t
 val virt_var   : ?quoted: bool -> (string * int * int * int) -> string -> t
 val virt_text  : (string * int * int * int) -> string -> t
 
-val vars : t -> String.Set.t
-(** [vars t] returns the set of all variables in [t]. *)
-
-val fold : t -> init:'a -> f:('a -> Loc.t -> string -> 'a) -> 'a
-(** [fold t ~init ~f] fold [f] on all variables of [t], the text
-    portions being ignored. *)
-
-val iter : t -> f:(Loc.t -> string -> unit) -> unit
-(** [iter t ~f] iterates [f] over all variables of [t], the text
-    portions being ignored. *)
-
 val is_var : t -> name:string -> bool
 
 module Mode : sig
@@ -57,16 +40,29 @@ module Partial : sig
     | Unexpanded of t
 end
 
+module Var : sig
+  type t
+
+  val loc : t -> Loc.t
+  val full_name : t -> string
+
+  type kind =
+    | Single of string
+    | Pair of string * string
+
+  val destruct : t -> kind
+end
+
 val expand
   :  t
   -> mode:'a Mode.t
   -> dir:Path.t
-  -> f:(Loc.t -> string -> Value.t list option)
+  -> f:(Var.t -> Value.t list option)
   -> 'a
 
 val partial_expand
   :  t
   -> mode:'a Mode.t
   -> dir:Path.t
-  -> f:(Loc.t -> string -> Value.t list option)
+  -> f:(Var.t -> Value.t list option)
   -> 'a Partial.t

src/super_context.ml

@@ -88,7 +88,8 @@ let expand_var_no_root t var = String.Map.find t.vars var
 
 let (expand_vars, expand_vars_path) =
   let expand t ~scope ~dir ?(extra_vars=String.Map.empty) s =
-    String_with_vars.expand ~mode:Single ~dir s ~f:(fun _loc -> function
+    String_with_vars.expand ~mode:Single ~dir s ~f:(fun v ->
+      match String_with_vars.Var.full_name v with
       | "ROOT" -> Some [Value.Path t.context.build_dir]
       | "SCOPE_ROOT" -> Some [Value.Path (Scope.root scope)]
       | var ->
@@ -110,7 +111,8 @@ let expand_and_eval_set t ~scope ~dir ?extra_vars set ~standard =
   let open Build.O in
   let f = expand_vars t ~scope ~dir ?extra_vars in
   let parse ~loc:_ s = s in
-  match Ordered_set_lang.Unexpanded.files set ~f |> String.Set.to_list with
+  let (syntax, files) = Ordered_set_lang.Unexpanded.files set ~f in
+  match String.Set.to_list files with
   | [] ->
     let set =
       Ordered_set_lang.Unexpanded.expand set ~files_contents:String.Map.empty ~f
@@ -119,7 +121,8 @@ let expand_and_eval_set t ~scope ~dir ?extra_vars set ~standard =
     Ordered_set_lang.String.eval set ~standard ~parse
   | files ->
     let paths = List.map files ~f:(Path.relative dir) in
-    Build.fanout standard (Build.all (List.map paths ~f:Build.read_sexp))
+    Build.fanout standard (Build.all (List.map paths ~f:(fun f ->
+      Build.read_sexp f syntax)))
     >>^ fun (standard, sexps) ->
     let files_contents = List.combine files sexps |> String.Map.of_list_exn in
     let set = Ordered_set_lang.Unexpanded.expand set ~files_contents ~f in
@@ -564,13 +567,6 @@ module Scope_key = struct
     sprintf "%s@%s" key (Dune_project.Name.encode scope)
 end
 
-let parse_bang var : bool * string =
-  let len = String.length var in
-  if len > 0 && var.[0] = '!' then
-    (true, String.sub var ~pos:1 ~len:(len - 1))
-  else
-    (false, var)
-
 module Action = struct
   open Build.O
   module U = Action.Unexpanded
@@ -630,10 +626,13 @@ module Action = struct
       ; ddeps     = String.Map.empty
       }
     in
-    let expand loc key var = function
+    let expand var =
-      | Some ("exe"     , s) -> Some (path_exp (map_exe (Path.relative dir s)))
+      let loc = String_with_vars.Var.loc var in
-      | Some ("path"    , s) -> Some (path_exp          (Path.relative dir s) )
+      let key = String_with_vars.Var.full_name var in
-      | Some ("bin"     , s) -> begin
+      match String_with_vars.Var.destruct var with
+      | Pair ("exe"     , s) -> Some (path_exp (map_exe (Path.relative dir s)))
+      | Pair ("path"    , s) -> Some (path_exp          (Path.relative dir s) )
+      | Pair ("bin"     , s) -> begin
           let sctx = host sctx in
           match Artifacts.binary (artifacts sctx) s with
           | Ok path -> Some (path_exp path)
@@ -642,7 +641,7 @@ module Action = struct
         end
       (* "findlib" for compatibility with Jane Street packages which are not yet updated
          to convert "findlib" to "lib" *)
-      | Some (("lib"|"findlib"), s) -> begin
+      | Pair (("lib"|"findlib"), s) -> begin
           let lib_dep, file = parse_lib_file ~loc s in
           add_lib_dep acc lib_dep dep_kind;
           match
@@ -651,7 +650,7 @@ module Action = struct
           | Ok path -> Some (path_exp path)
           | Error fail -> add_fail acc fail
         end
-      | Some ("libexec" , s) -> begin
+      | Pair ("libexec" , s) -> begin
           let sctx = host sctx in
           let lib_dep, file = parse_lib_file ~loc s in
           add_lib_dep acc lib_dep dep_kind;
@@ -672,11 +671,11 @@ module Action = struct
               add_ddep acc ~key dep
             end
         end
-      | Some ("lib-available", lib) ->
+      | Pair ("lib-available", lib) ->
         add_lib_dep acc lib Optional;
         Some (str_exp (string_of_bool (
           Lib.DB.available (Scope.libs scope) lib)))
-      | Some ("version", s) -> begin
+      | Pair ("version", s) -> begin
           match Package.Name.Map.find (Scope.project scope).packages
                   (Package.Name.of_string s) with
           | Some p ->
@@ -691,7 +690,7 @@ module Action = struct
               Loc.fail loc "Package %S doesn't exist in the current project." s
             }
         end
-      | Some ("read", s) -> begin
+      | Pair ("read", s) -> begin
           let path = Path.relative dir s in
           let data =
             Build.contents path
@@ -699,7 +698,7 @@ module Action = struct
           in
           add_ddep acc ~key data
         end
-      | Some ("read-lines", s) -> begin
+      | Pair ("read-lines", s) -> begin
           let path = Path.relative dir s in
           let data =
             Build.lines_of path
@@ -707,7 +706,7 @@ module Action = struct
           in
           add_ddep acc ~key data
         end
-      | Some ("read-strings", s) -> begin
+      | Pair ("read-strings", s) -> begin
           let path = Path.relative dir s in
           let data =
             Build.strings path
@@ -716,17 +715,15 @@ module Action = struct
           add_ddep acc ~key data
         end
       | _ ->
-        match expand_var_no_root sctx var with
+        match expand_var_no_root sctx key with
         | Some _ as x -> x
-        | None -> String.Map.find extra_vars var
+        | None -> String.Map.find extra_vars key
     in
     let t =
-      U.partial_expand t ~dir ~map_exe ~f:(fun loc key ->
+      U.partial_expand t ~dir ~map_exe ~f:(fun var ->
-        let has_bang, var = parse_bang key in
+        let var_name = String_with_vars.Var.full_name var in
-        if has_bang then
+        let loc = String_with_vars.Var.loc var in
-          Loc.warn loc "The use of the variable prefix '!' is deprecated, \
+        match var_name with
-                        simply use '${%s}'@." var;
-        match var with
         | "ROOT" -> Some (path_exp sctx.context.build_dir)
         | "SCOPE_ROOT" -> Some (path_exp (Scope.root scope))
         | "@" -> begin
@@ -736,11 +733,11 @@ module Action = struct
             | Static l -> Some (Value.L.paths l)
           end
         | _ ->
-          match String.lsplit2 var ~on:':' with
+          match String_with_vars.Var.destruct var with
-          | Some ("path-no-dep", s) ->
+          | Pair ("path-no-dep", s) ->
             Some (path_exp (Path.relative dir s))
-          | x ->
+          | _ ->
-            let exp = expand loc key var x in
+            let exp = expand var in
             Option.iter exp ~f:(fun vs ->
               acc.sdeps <- Path.Set.union (Path.Set.of_list
                                              (Value.L.paths_only vs)) acc.sdeps;
@@ -750,12 +747,13 @@ module Action = struct
     (t, acc)
 
   let expand_step2 ~dir ~dynamic_expansions ~deps_written_by_user ~map_exe t =
-    U.Partial.expand t ~dir ~map_exe ~f:(fun loc key ->
+    U.Partial.expand t ~dir ~map_exe ~f:(fun var ->
+      let key = String_with_vars.Var.full_name var in
+      let loc = String_with_vars.Var.loc var in
       match String.Map.find dynamic_expansions key with
       | Some _ as opt -> opt
       | None ->
-        let _, var = parse_bang key in
+        match key with
-        match var with
         | "<" ->
           Some
             (match deps_written_by_user with

src/usexp/atom.ml

@@ -8,7 +8,14 @@ let is_valid_dune =
   let rec loop s i len =
     i = len ||
     match String.unsafe_get s i with
-    | '%' | '"' | '(' | ')' | ';' | '\000'..'\032' | '\127'..'\255' -> false
+    | '%' -> after_percent s (i + 1) len
+    | '"' | '(' | ')' | ';' | '\000'..'\032' | '\127'..'\255' -> false
+    | _ -> loop s (i + 1) len
+  and after_percent s i len =
+    i = len ||
+    match String.unsafe_get s i with
+    | '%' -> after_percent s (i + 1) len
+    | '"' | '(' | ')' | ';' | '\000'..'\032' | '\127'..'\255' | '{' -> false
     | _ -> loop s (i + 1) len
   in
   fun s ->

src/usexp/dune_lexer.mll

@@ -4,6 +4,91 @@ open Lexer_shared
 type block_string_line_kind =
   | With_escape_sequences
   | Raw
+
+module Template = struct
+  include Template
+
+  let dummy_loc =
+    { Loc.
+      start = Lexing.dummy_pos
+    ; stop = Lexing.dummy_pos
+    }
+
+  let add_text parts s =
+    match parts with
+    | Template.Text s' :: parts -> Template.Text (s' ^ s) :: parts
+    | _ -> Template.Text s :: parts
+
+  let token parts ~quoted ~start (lexbuf : Lexing.lexbuf) =
+    lexbuf.lex_start_p <- start;
+    match parts with
+    | [] | [Text ""] ->
+      error lexbuf "Internal error in the S-expression parser, \
+                    please report upstream."
+    | [Text s] ->
+      Token.Atom (Atom.of_string s)
+    | _ ->
+      Token.Template
+        { quoted
+        ; loc = dummy_loc
+        ; parts = List.rev parts
+        }
+
+  module Buffer : sig
+    val new_token : unit -> unit
+    val get : unit -> Token.t
+    val add_var : part -> unit
+    val add_text : string -> unit
+    val add_text_c : char -> unit
+  end = struct
+    type state =
+      | String
+      | Template of Template.part list
+
+    let text_buf = Buffer.create 256
+
+    let new_token () = Buffer.clear text_buf
+
+    let take_buf () =
+      let contents = Buffer.contents text_buf in
+      Buffer.clear text_buf;
+      contents
+
+    let state = ref String
+
+    let add_buf_to_parts parts =
+      match take_buf () with
+      | "" -> parts
+      | t -> add_text parts t
+
+    let get () =
+      match !state with
+      | String -> Token.Quoted_string (take_buf ())
+      | Template parts ->
+        state := String;
+        begin match add_buf_to_parts parts with
+        | [] -> assert false
+        | [Text s] -> Quoted_string s
+        | parts ->
+          Token.Template
+            { quoted = true
+            ; loc = dummy_loc
+            ; parts = List.rev parts
+            }
+        end
+
+    let add_var v =
+      match !state with
+      | String ->
+        state := Template (v :: add_buf_to_parts []);
+      | Template parts ->
+        let parts = add_buf_to_parts parts in
+        state := Template (v::parts)
+
+    let add_text   = Buffer.add_string text_buf
+    let add_text_c = Buffer.add_char text_buf
+  end
+end
 }
 
 let comment   = ';' [^ '\n' '\r']*
@@ -12,7 +97,8 @@ let blank     = [' ' '\t' '\012']
 let digit     = ['0'-'9']
 let hexdigit  = ['0'-'9' 'a'-'f' 'A'-'F']
 
-let atom_char = [^ '%' ';' '(' ')' '"' '\000'-'\032' '\127'-'\255']
+let atom_char = [^ ';' '(' ')' '"' '\000'-'\032' '\127'-'\255']
+let varname_char = atom_char # [ ':' '%' '{' '}' ]
 
 rule token = parse
   | newline
@@ -24,17 +110,26 @@ rule token = parse
   | ')'
     { Rparen }
   | '"'
-    { Buffer.clear escaped_buf;
+    { let start = Lexing.lexeme_start_p lexbuf in
-      let start = Lexing.lexeme_start_p lexbuf in
+      Template.Buffer.new_token ();
-      let s = start_quoted_string lexbuf in
+      let token = start_quoted_string lexbuf in
       lexbuf.lex_start_p <- start;
-      Quoted_string s
+      token
     }
-  | atom_char+ as s
-    { Token.Atom (Atom.of_string s) }
-  | _ as c { error lexbuf (Printf.sprintf "Invalid atom character '%c'" c) }
   | eof
     { Eof }
+  | ""
+    { atom [] (Lexing.lexeme_start_p lexbuf) lexbuf }
+
+and atom acc start = parse
+  | (atom_char # '%')+ as s
+    { atom (Template.add_text acc s) start lexbuf }
+  | "%{"
+    { atom ((template_variable lexbuf) :: acc) start lexbuf }
+  | "%"
+    { atom (Template.add_text acc "%") start lexbuf }
+  | ""
+    { Template.token acc ~quoted:false ~start lexbuf }
 
 and start_quoted_string = parse
   | "\\|"
@@ -47,7 +142,7 @@ and start_quoted_string = parse
 and block_string_start kind = parse
   | newline as s
     { Lexing.new_line lexbuf;
-      Buffer.add_string escaped_buf s;
+      Template.Buffer.add_text s;
       block_string_after_newline lexbuf
     }
   | ' '
@@ -56,8 +151,7 @@ and block_string_start kind = parse
       | Raw -> raw_block_string lexbuf
     }
   | eof
-    { Buffer.contents escaped_buf
+    { Template.Buffer.get () }
-    }
   | _
     { error lexbuf "There must be at least one space after \"\\|"
     }
@@ -65,7 +159,7 @@ and block_string_start kind = parse
 and block_string = parse
   | newline as s
     { Lexing.new_line lexbuf;
-      Buffer.add_string escaped_buf s;
+      Template.Buffer.add_text s;
       block_string_after_newline lexbuf
     }
   | '\\'
@@ -73,12 +167,17 @@ and block_string = parse
       | Newline -> block_string_after_newline lexbuf
       | Other   -> block_string               lexbuf
     }
+  | "%{" {
+      let var = template_variable lexbuf in
+      Template.Buffer.add_var var;
+      block_string lexbuf
+    }
   | _ as c
-    { Buffer.add_char escaped_buf c;
+    { Template.Buffer.add_text_c c;
       block_string lexbuf
     }
   | eof
-    { Buffer.contents escaped_buf
+    { Template.Buffer.get ()
     }
 
 and block_string_after_newline = parse
@@ -87,38 +186,42 @@ and block_string_after_newline = parse
   | blank* "\"\\>"
     { block_string_start Raw lexbuf }
   | ""
-    { Buffer.contents escaped_buf
+    { Template.Buffer.get ()
     }
 
 and raw_block_string = parse
   | newline as s
     { Lexing.new_line lexbuf;
-      Buffer.add_string escaped_buf s;
+      Template.Buffer.add_text s;
       block_string_after_newline lexbuf
     }
   | _ as c
-    { Buffer.add_char escaped_buf c;
+    { Template.Buffer.add_text_c c;
       raw_block_string lexbuf
     }
   | eof
-    { Buffer.contents escaped_buf
+    { Template.Buffer.get ()
     }
 
 and quoted_string = parse
   | '"'
-    { Buffer.contents escaped_buf }
+    { Template.Buffer.get () }
   | '\\'
     { match escape_sequence lexbuf with
       | Newline -> quoted_string_after_escaped_newline lexbuf
       | Other   -> quoted_string                       lexbuf
     }
+  | "%{"
+    { Template.Buffer.add_var (template_variable lexbuf);
+      quoted_string lexbuf
+    }
   | newline as s
     { Lexing.new_line lexbuf;
-      Buffer.add_string escaped_buf s;
+      Template.Buffer.add_text s;
       quoted_string lexbuf
     }
   | _ as c
-    { Buffer.add_char escaped_buf c;
+    { Template.Buffer.add_text_c c;
       quoted_string lexbuf
     }
   | eof
@@ -129,6 +232,10 @@ and escape_sequence = parse
   | newline
     { Lexing.new_line lexbuf;
       Newline }
+  | "%{" as s
+    { Template.Buffer.add_text s;
+      Other
+    }
   | ['\\' '\'' '"' 'n' 't' 'b' 'r'] as c
     { let c =
         match c with
@@ -138,7 +245,7 @@ and escape_sequence = parse
         | 't' -> '\t'
         | _   -> c
       in
-      Buffer.add_char escaped_buf c;
+      Template.Buffer.add_text_c c;
       Other
     }
   | (digit as c1) (digit as c2) (digit as c3)
@@ -146,7 +253,7 @@ and escape_sequence = parse
       if v > 255 then
         error lexbuf "escape sequence in quoted string out of range"
           ~delta:(-1);
-      Buffer.add_char escaped_buf (Char.chr v);
+      Template.Buffer.add_text_c (Char.chr v);
       Other
     }
   | digit digit digit
@@ -157,7 +264,7 @@ and escape_sequence = parse
     }
   | 'x' (hexdigit as c1) (hexdigit as c2)
     { let v = eval_hex_escape c1 c2 in
-      Buffer.add_char escaped_buf (Char.chr v);
+      Template.Buffer.add_text_c (Char.chr v);
       Other
     }
   | 'x' hexdigit*
@@ -173,3 +280,24 @@ and escape_sequence = parse
 and quoted_string_after_escaped_newline = parse
   | [' ' '\t']*
     { quoted_string lexbuf }
+
+and template_variable = parse
+  | (varname_char+ as name) (':' (varname_char* as payload))? '}'
+    { let payload =
+        match payload with
+        | Some "" -> error lexbuf "payload after : in variable cannot be empty"
+        | p -> p
+      in
+      Template.Var
+        { loc =
+            { start = Lexing.lexeme_start_p lexbuf
+            ; stop = Lexing.lexeme_end_p lexbuf
+            }
+        ; name
+        ; payload
+        ; syntax = Percent
+        }
+  }
+  | '}' | eof
+    { error lexbuf "%{...} forms cannot be empty" }
+  | _ { error lexbuf "This character not allowed inside %{...} forms" }

src/usexp/escape.ml

@@ -0,0 +1,67 @@
+open Import
+
+let quote_length s ~syntax =
+  let n = ref 0 in
+  let len = String.length s in
+  for i = 0 to len - 1 do
+    n := !n + (match String.unsafe_get s i with
+      | '\"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2
+      | '%' ->
+        if syntax = Atom.Dune && i + 1 < len && s.[i+1] = '{' then 2 else 1
+      | ' ' .. '~' -> 1
+      | _ -> 4)
+  done;
+  !n
+
+let escape_to s ~dst:s' ~ofs ~syntax =
+  let n = ref ofs in
+  let len = String.length s in
+  for i = 0 to len - 1 do
+    begin match String.unsafe_get s i with
+    | ('\"' | '\\') as c ->
+      Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n c
+    | '\n' ->
+      Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'n'
+    | '\t' ->
+      Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 't'
+    | '\r' ->
+      Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'r'
+    | '\b' ->
+      Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'b'
+    | '%' when syntax = Atom.Dune && i + 1 < len && s.[i + 1] = '{' ->
+      Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n '%'
+    | (' ' .. '~') as c -> Bytes.unsafe_set s' !n c
+    | c ->
+      let a = Char.code c in
+      Bytes.unsafe_set s' !n '\\';
+      incr n;
+      Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + a / 100));
+      incr n;
+      Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + (a / 10) mod 10));
+      incr n;
+      Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + a mod 10));
+    end;
+    incr n
+  done
+
+(* Escape [s] if needed. *)
+let escaped s ~syntax =
+  let n = quote_length s ~syntax in
+  if n = 0 || n > String.length s then
+    let s' = Bytes.create n in
+    escape_to s ~dst:s' ~ofs:0 ~syntax;
+    Bytes.unsafe_to_string s'
+  else s
+
+(* Surround [s] with quotes, escaping it if necessary. *)
+let quoted s ~syntax =
+  let len = String.length s in
+  let n = quote_length s ~syntax in
+  let s' = Bytes.create (n + 2) in
+  Bytes.unsafe_set s' 0 '"';
+  if len = 0 || n > len then
+    escape_to s ~dst:s' ~ofs:1 ~syntax
+  else
+    Bytes.blit_string ~src:s ~src_pos:0 ~dst:s' ~dst_pos:1 ~len;
+  Bytes.unsafe_set s' (n + 1) '"';
+  Bytes.unsafe_to_string s'

src/usexp/escape.mli

@@ -0,0 +1,4 @@
+
+val escaped : string -> syntax:Atom.syntax -> string
+
+val quoted : string -> syntax:Atom.syntax -> string

src/usexp/import.ml

@@ -0,0 +1,26 @@
+(* TODO get rid of this when inverting the deps between stdune and usexp *)
+
+module List = ListLabels
+module String = struct
+  include StdLabels.String
+
+  let split_on_char s ~on =
+    let rec loop i j =
+      if j = length s then
+        [sub s ~pos:i ~len:(j - i)]
+      else if s.[j] = on then
+        sub s ~pos:i ~len:(j - i) :: loop (j + 1) (j + 1)
+      else
+        loop i (j + 1)
+    in
+    loop 0 0
+end
+
+module Bytes = struct
+  include StdLabels.Bytes
+
+  (* [blit_string] was forgotten from the labeled version in OCaml
+     4.02—4.04. *)
+  let blit_string ~src ~src_pos ~dst ~dst_pos ~len =
+    Bytes.blit_string src src_pos dst dst_pos len
+end

src/usexp/lexer.mli

@@ -6,6 +6,7 @@ module Token : sig
     | Rparen
     | Sexp_comment
     | Eof
+    | Template of Template.t
 end
 
 type t = Lexing.lexbuf -> Token.t

src/usexp/lexer_shared.ml

@@ -6,6 +6,7 @@ module Token = struct
     | Rparen
     | Sexp_comment
     | Eof
+    | Template of Template.t
 end
 
 type t = Lexing.lexbuf -> Token.t

src/usexp/lexer_shared.mli

@@ -6,6 +6,7 @@ module Token : sig
     | Rparen
     | Sexp_comment
     | Eof
+    | Template of Template.t
 end
 
 type t = Lexing.lexbuf -> Token.t

src/usexp/loc.ml

@@ -0,0 +1,18 @@
+type t =
+  { start : Lexing.position
+  ; stop  : Lexing.position
+  }
+
+let in_file fn =
+  let pos : Lexing.position =
+    { pos_fname = fn
+    ; pos_lnum  = 1
+    ; pos_cnum  = 0
+    ; pos_bol   = 0
+    }
+  in
+  { start = pos
+  ; stop = pos
+  }
+
+let none = in_file "<none>"

src/usexp/loc.mli

@@ -0,0 +1,8 @@
+type t =
+  { start : Lexing.position
+  ; stop  : Lexing.position
+  }
+
+val in_file : string -> t
+
+val none : t

src/usexp/sexp.ml

@@ -0,0 +1,7 @@
+include Types.Sexp
+
+let atom_or_quoted_string s =
+  if Atom.is_valid_dune s then
+    Atom (Atom.of_string s)
+  else
+    Quoted_string s

src/usexp/sexp.mli

@@ -0,0 +1,7 @@
+type t = Types.Sexp.t =
+  | Atom of Atom.t
+  | Quoted_string of string
+  | List of t list
+  | Template of Types.Template.t
+
+val atom_or_quoted_string : string -> t

src/usexp/template.ml

@@ -0,0 +1,101 @@
+open Import
+
+include Types.Template
+
+let var_enclosers = function
+  | Percent      -> "%{", "}"
+  | Dollar_brace -> "${", "}"
+  | Dollar_paren -> "$(", ")"
+
+module Pp : sig
+  val to_string : t -> syntax:Atom.syntax -> string
+end = struct
+  let buf = Buffer.create 16
+
+  let add_var { loc = _; syntax; name; payload } =
+    let before, after = var_enclosers syntax in
+    Buffer.add_string buf before;
+    Buffer.add_string buf name;
+    begin match payload with
+    | None -> ()
+    | Some payload ->
+      Buffer.add_char buf ':';
+      Buffer.add_string buf payload
+    end;
+    Buffer.add_string buf after
+
+  (* TODO use the loc for the error *)
+  let check_valid_unquoted s ~syntax ~loc:_ =
+    if not (Atom.is_valid (Atom.of_string s) syntax) then
+      Printf.ksprintf invalid_arg "Invalid text %S in unquoted template" s
+
+  let to_string { parts; quoted; loc } ~syntax =
+    Buffer.clear buf;
+    if quoted then Buffer.add_char buf '"';
+    let commit_text s =
+      if s = "" then
+        ()
+      else if not quoted then begin
+        check_valid_unquoted ~loc ~syntax s;
+        Buffer.add_string buf s
+      end else
+        Buffer.add_string buf (Escape.escaped ~syntax s)
+    in
+    let rec add_parts acc_text = function
+      | [] ->
+        commit_text acc_text
+      | Text s :: rest ->
+        add_parts (if acc_text = "" then s else acc_text ^ s) rest
+      | Var v :: rest ->
+        commit_text acc_text;
+        add_var v;
+        add_parts "" rest
+    in
+    add_parts "" parts;
+    if quoted then Buffer.add_char buf '"';
+    Buffer.contents buf
+end
+
+let to_string = Pp.to_string
+
+let string_of_var { loc = _; syntax; name; payload } =
+  let before, after = var_enclosers syntax in
+  match payload with
+  | None -> before ^ name ^ after
+  | Some p -> before ^ name ^ ":" ^ p ^ after
+
+let pp syntax ppf t =
+  Format.pp_print_string ppf (Pp.to_string ~syntax t)
+
+let pp_split_strings ppf (t : t) =
+  let syntax = Atom.Dune in
+  if t.quoted || List.exists t.parts ~f:(function
+    | Text s -> String.contains s '\n'
+    | Var _ -> false) then begin
+    List.iter t.parts ~f:(function
+      | Var s ->
+        Format.pp_print_string ppf (string_of_var s)
+      | Text s ->
+        begin match String.split_on_char s ~on:'\n' with
+        | [] -> assert false
+        | [s] -> Format.pp_print_string ppf (Escape.escaped ~syntax s)
+        | split ->
+          Format.pp_print_list
+            ~pp_sep:(fun ppf () -> Format.fprintf ppf "@,\\n")
+            Format.pp_print_string ppf
+            split
+        end
+    );
+    Format.fprintf ppf "@}\"@]"
+  end
+  else
+    pp syntax ppf t
+
+let remove_locs t =
+  { t with
+    loc = Loc.none
+  ; parts =
+      List.map t.parts ~f:(function
+        | Var v -> Var { v with loc = Loc.none }
+        | Text _ as s -> s)
+  }

src/usexp/template.mli

@@ -0,0 +1,30 @@
+type var_syntax = Types.Template.var_syntax =
+  | Dollar_brace
+  | Dollar_paren
+  | Percent
+
+type var = Types.Template.var =
+  { loc: Loc.t
+  ; name: string
+  ; payload: string option
+  ; syntax: var_syntax
+  }
+
+type part = Types.Template.part =
+  | Text of string
+  | Var of var
+
+type t = Types.Template.t =
+  { quoted: bool
+  ; parts: part list
+  ; loc: Loc.t
+  }
+
+val to_string : t -> syntax:Atom.syntax -> string
+val string_of_var : var -> string
+
+val pp : Atom.syntax -> Format.formatter -> t -> unit
+
+val pp_split_strings : Format.formatter -> t -> unit
+
+val remove_locs : t -> t

src/usexp/types.ml

@@ -0,0 +1,28 @@
+module Template = struct
+  type var_syntax = Dollar_brace | Dollar_paren | Percent
+
+  type var =
+    { loc: Loc.t
+    ; name: string
+    ; payload: string option
+    ; syntax: var_syntax
+    }
+
+  type part =
+    | Text of string
+    | Var of var
+
+  type t =
+    { quoted: bool
+    ; parts: part list
+    ; loc: Loc.t
+    }
+end
+
+module Sexp = struct
+  type t =
+    | Atom of Atom.t
+    | Quoted_string of string
+    | List of t list
+    | Template of Template.t
+end

src/usexp/usexp.ml

@@ -1,140 +1,59 @@
-module UnlabeledBytes = Bytes
+open Import
-open StdLabels
-
-module Bytes = struct
-  include StdLabels.Bytes
-
-  (* [blit_string] was forgotten from the labeled version in OCaml
-     4.02—4.04. *)
-  let blit_string ~src ~src_pos ~dst ~dst_pos ~len =
-    UnlabeledBytes.blit_string src src_pos dst dst_pos len
-end
 
+module Loc = Loc
 module Atom = Atom
+module Template = Template
 
-type t =
+type syntax = Atom.syntax = Jbuild | Dune
-  | Atom of Atom.t
-  | Quoted_string of string
-  | List of t list
 
-type sexp = t
+include Sexp
 
 let atom s = Atom (Atom.of_string s)
 
 let unsafe_atom_of_string s = atom s
 
-let atom_or_quoted_string s =
+let rec to_string t ~syntax =
-  if Atom.is_valid_dune s then
+  match t with
-    Atom (Atom.of_string s)
+  | Atom a -> Atom.print a syntax
-  else
+  | Quoted_string s -> Escape.quoted s ~syntax
-    Quoted_string s
+  | List l ->
+    Printf.sprintf "(%s)" (List.map l ~f:(to_string ~syntax)
+                           |> String.concat ~sep:" ")
+  | Template t -> Template.to_string t ~syntax
 
-let quote_length s =
+let rec pp syntax ppf = function
-  let n = ref 0 in
-  for i = 0 to String.length s - 1 do
-    n := !n + (match String.unsafe_get s i with
-               | '\"' | '\\' | '\n' | '\t' | '\r' | '\b' -> 2
-               | ' ' .. '~' -> 1
-               | _ -> 4)
-  done;
-  !n
-
-let escape_to s ~dst:s' ~ofs =
-  let n = ref ofs in
-  for i = 0 to String.length s - 1 do
-    begin match String.unsafe_get s i with
-    | ('\"' | '\\') as c ->
-       Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n c
-    | '\n' ->
-       Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'n'
-    | '\t' ->
-       Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 't'
-    | '\r' ->
-       Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'r'
-    | '\b' ->
-       Bytes.unsafe_set s' !n '\\'; incr n; Bytes.unsafe_set s' !n 'b'
-    | (' ' .. '~') as c -> Bytes.unsafe_set s' !n c
-    | c ->
-       let a = Char.code c in
-       Bytes.unsafe_set s' !n '\\';
-       incr n;
-       Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + a / 100));
-       incr n;
-       Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + (a / 10) mod 10));
-       incr n;
-       Bytes.unsafe_set s' !n (Char.unsafe_chr (48 + a mod 10));
-    end;
-    incr n
-  done
-
-(* Escape [s] if needed. *)
-let escaped s =
-  let n = quote_length s in
-  if n = 0 || n > String.length s then
-    let s' = Bytes.create n in
-    escape_to s ~dst:s' ~ofs:0;
-    Bytes.unsafe_to_string s'
-  else s
-
-(* Surround [s] with quotes, escaping it if necessary. *)
-let quoted s =
-  let len = String.length s in
-  let n = quote_length s in
-  let s' = Bytes.create (n + 2) in
-  Bytes.unsafe_set s' 0 '"';
-  if len = 0 || n > len then
-    escape_to s ~dst:s' ~ofs:1
-  else
-    Bytes.blit_string ~src:s ~src_pos:0 ~dst:s' ~dst_pos:1 ~len;
-  Bytes.unsafe_set s' (n + 1) '"';
-  Bytes.unsafe_to_string s'
-
-let rec to_string = function
-  | Atom a -> Atom.print a Atom.Dune
-  | Quoted_string s -> quoted s
-  | List l -> Printf.sprintf "(%s)" (List.map l ~f:to_string |> String.concat ~sep:" ")
-
-let rec pp ppf = function
   | Atom s ->
-    Format.pp_print_string ppf (Atom.print s Atom.Dune)
+    Format.pp_print_string ppf (Atom.print s syntax)
   | Quoted_string s ->
-    Format.pp_print_string ppf (quoted s)
+    Format.pp_print_string ppf (Escape.quoted ~syntax s)
   | List [] ->
     Format.pp_print_string ppf "()"
   | List (first :: rest) ->
     Format.pp_open_box ppf 1;
     Format.pp_print_string ppf "(";
     Format.pp_open_hvbox ppf 0;
-    pp ppf first;
+    pp syntax ppf first;
     List.iter rest ~f:(fun sexp ->
       Format.pp_print_space ppf ();
-      pp ppf sexp);
+      pp syntax ppf sexp);
     Format.pp_close_box ppf ();
     Format.pp_print_string ppf ")";
     Format.pp_close_box ppf ()
-
+  | Template t -> Template.pp syntax ppf t
-let split_string s ~on =
-  let rec loop i j =
-    if j = String.length s then
-      [String.sub s ~pos:i ~len:(j - i)]
-    else if s.[j] = on then
-      String.sub s ~pos:i ~len:(j - i) :: loop (j + 1) (j + 1)
-    else
-      loop i (j + 1)
-  in
-  loop 0 0
 
 let pp_print_quoted_string ppf s =
+  let syntax = Dune in
   if String.contains s '\n' then begin
-    match split_string s ~on:'\n' with
+    match String.split_on_char s ~on:'\n' with
-    | [] -> Format.pp_print_string ppf (quoted s)
+    | [] -> Format.pp_print_string ppf (Escape.quoted ~syntax s)
     | first :: rest ->
-       Format.fprintf ppf "@[<hv 1>\"@{<atom>%s" (escaped first);
+       Format.fprintf ppf "@[<hv 1>\"@{<atom>%s"
+         (Escape.escaped ~syntax first);
        List.iter rest ~f:(fun s ->
-           Format.fprintf ppf "@,\\n%s" (escaped s));
+           Format.fprintf ppf "@,\\n%s" (Escape.escaped ~syntax s));
        Format.fprintf ppf "@}\"@]"
   end else
-    Format.pp_print_string ppf (quoted s)
+    Format.pp_print_string ppf (Escape.quoted ~syntax s)
 
 let rec pp_split_strings ppf = function
   | Atom s -> Format.pp_print_string ppf (Atom.print s Atom.Dune)
@@ -152,6 +71,7 @@ let rec pp_split_strings ppf = function
     Format.pp_close_box ppf ();
     Format.pp_print_string ppf ")";
     Format.pp_close_box ppf ()
+  | Template t -> Template.pp_split_strings ppf t
 
 type formatter_state =
   | In_atom
@@ -196,40 +116,26 @@ let prepare_formatter ppf =
            | _ -> n))
     }
 
-module Loc = struct
-  type t =
-    { start : Lexing.position
-    ; stop  : Lexing.position
-    }
-
-  let in_file fn =
-    let pos : Lexing.position =
-      { pos_fname = fn
-      ; pos_lnum  = 1
-      ; pos_cnum  = 0
-      ; pos_bol   = 0
-      }
-    in
-    { start = pos
-    ; stop = pos
-    }
-end
-
 module Ast = struct
   type t =
     | Atom of Loc.t * Atom.t
     | Quoted_string of Loc.t * string
+    | Template of Template.t
     | List of Loc.t * t list
 
   let atom_or_quoted_string loc s =
-    match atom_or_quoted_string s with
+    match Sexp.atom_or_quoted_string s with
     | Atom a -> Atom (loc, a)
     | Quoted_string s -> Quoted_string (loc, s)
+    | Template _
     | List _ -> assert false
 
-  let loc (Atom (loc, _) | Quoted_string (loc, _) | List (loc, _)) = loc
+  let loc (Atom (loc, _) | Quoted_string (loc, _) | List (loc, _)
+          | Template { loc ; _ }) = loc
 
-  let rec remove_locs : t -> sexp = function
+  let rec remove_locs t : Sexp.t =
+    match t with
+    | Template t -> Template (Template.remove_locs t)
     | Atom (_, s) -> Atom s
     | Quoted_string (_, s) -> Quoted_string s
     | List (_, l) -> List (List.map l ~f:remove_locs)
@@ -240,6 +146,7 @@ let rec add_loc t ~loc : Ast.t =
   | Atom s -> Atom (loc, s)
   | Quoted_string s -> Quoted_string (loc, s)
   | List l -> List (loc, List.map l ~f:(add_loc ~loc))
+  | Template t -> Template { t with loc }
 
 module Parse_error = struct
   include Lexer.Error
@@ -298,6 +205,9 @@ module Parser = struct
     | Quoted_string s ->
       let loc = make_loc lexbuf in
       loop depth lexer lexbuf (Quoted_string (loc, s) :: acc)
+    | Template t ->
+      let loc = make_loc lexbuf in
+      loop depth lexer lexbuf (Template { t with loc } :: acc)
     | Lparen ->
       let start = Lexing.lexeme_start_p lexbuf in
       let sexps = loop (depth + 1) lexer lexbuf [] in

src/usexp/usexp.mli

@@ -2,11 +2,11 @@
 
     This library is internal to jbuilder and guarantees no API stability.*)
 
+type syntax = Jbuild | Dune
+
 module Atom : sig
   type t = private A of string [@@unboxed]
 
-  type syntax = Jbuild | Dune
-
   val is_valid : t -> syntax -> bool
 
   val of_string : string -> t
@@ -26,6 +26,31 @@ module Loc : sig
     }
 
   val in_file : string -> t
+
+  val none : t
+end
+
+module Template : sig
+  type var_syntax = Dollar_brace | Dollar_paren | Percent
+
+  type var =
+    { loc: Loc.t
+    ; name: string
+    ; payload: string option
+    ; syntax: var_syntax
+    }
+
+  type part =
+    | Text of string
+    | Var of var
+
+  type t =
+    { quoted: bool
+    ; parts: part list
+    ; loc: Loc.t
+    }
+
+  val string_of_var : var -> string
 end
 
 (** The S-expression type *)
@@ -33,6 +58,7 @@ type t =
   | Atom of Atom.t
   | Quoted_string of string
   | List of t list
+  | Template of Template.t
 
 val atom : string -> t
 (** [atom s] convert the string [s] to an Atom.
@@ -43,13 +69,13 @@ val atom_or_quoted_string : string -> t
 val unsafe_atom_of_string : string -> t
 
 (** Serialize a S-expression *)
-val to_string : t -> string
+val to_string : t -> syntax:syntax -> string
 
 (** Serialize a S-expression using indentation to improve readability *)
-val pp : Format.formatter -> t -> unit
+val pp : syntax -> Format.formatter -> t -> unit
 
-(** Same as [pp], but split long strings. The formatter must have been
+(** Same as [pp ~syntax:Dune], but split long strings. The formatter
-    prepared with [prepare_formatter]. *)
+    must have been prepared with [prepare_formatter]. *)
 val pp_split_strings : Format.formatter -> t -> unit
 
 (** Prepare a formatter for [pp_split_strings]. Additionaly the
@@ -63,6 +89,7 @@ module Ast : sig
   type t =
     | Atom of Loc.t * Atom.t
     | Quoted_string of Loc.t * string
+    | Template of Template.t
     | List of Loc.t * t list
 
   val atom_or_quoted_string : Loc.t -> string -> t
@@ -85,17 +112,7 @@ end
 exception Parse_error of Parse_error.t
 
 module Lexer : sig
-  module Token : sig
+  type t
-    type t =
-      | Atom          of Atom.t
-      | Quoted_string of string
-      | Lparen
-      | Rparen
-      | Sexp_comment (** "#;", only used in the jbuild syntax *)
-      | Eof
-  end
-
-  type t = Lexing.lexbuf -> Token.t
 
   val token : t
   val jbuild_token : t

src/vfile_kind.ml

@@ -52,7 +52,7 @@ struct
 
   let id = Id.create ()
 
-  let to_string path x = To_sexp.t path x |> Sexp.to_string
+  let to_string path x = To_sexp.t path x |> Sexp.to_string ~syntax:Dune
 
   let load path =
     Of_sexp.t path (Io.Sexp.load path ~mode:Single)

test/blackbox-tests/dune

@@ -22,7 +22,7 @@
 (rule
  (targets dune.inc.gen)
  (deps    (source_tree test-cases))
- (action  (with-stdout-to ${@} (run ./gen_tests.exe))))
+ (action  (with-stdout-to %{@} (run ./gen_tests.exe))))
 
 (alias
  (name runtest)

test/blackbox-tests/dune.inc

@@ -4,7 +4,7 @@
  (action
   (chdir
    test-cases/aliases
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name bad-alias-error)
@@ -12,7 +12,7 @@
  (action
   (chdir
    test-cases/bad-alias-error
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name block-strings)
@@ -20,7 +20,7 @@
  (action
   (chdir
    test-cases/block-strings
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name byte-code-only)
@@ -28,7 +28,7 @@
  (action
   (chdir
    test-cases/byte-code-only
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name c-stubs)
@@ -36,7 +36,7 @@
  (action
   (chdir
    test-cases/c-stubs
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name configurator)
@@ -45,7 +45,7 @@
   (chdir
    test-cases/configurator
    (progn
-    (run ${exe:cram.exe} -skip-platforms win -test run.t)
+    (run %{exe:cram.exe} -skip-platforms win -test run.t)
     (diff? run.t run.t.corrected)))))
 
 (alias
@@ -54,7 +54,7 @@
  (action
   (chdir
    test-cases/copy_files
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name cross-compilation)
@@ -62,7 +62,7 @@
  (action
   (chdir
    test-cases/cross-compilation
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name custom-build-dir)
@@ -70,7 +70,7 @@
  (action
   (chdir
    test-cases/custom-build-dir
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name depend-on-the-universe)
@@ -78,7 +78,7 @@
  (action
   (chdir
    test-cases/depend-on-the-universe
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name dune-ppx-driver-system)
@@ -86,7 +86,7 @@
  (action
   (chdir
    test-cases/dune-ppx-driver-system
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name dune-project-edition)
@@ -94,7 +94,7 @@
  (action
   (chdir
    test-cases/dune-project-edition
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name env)
@@ -102,7 +102,7 @@
  (action
   (chdir
    test-cases/env
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name exclude-missing-module)
@@ -110,7 +110,7 @@
  (action
   (chdir
    test-cases/exclude-missing-module
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name exec-cmd)
@@ -118,7 +118,7 @@
  (action
   (chdir
    test-cases/exec-cmd
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name findlib)
@@ -126,7 +126,7 @@
  (action
   (chdir
    test-cases/findlib
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name force-test)
@@ -134,7 +134,7 @@
  (action
   (chdir
    test-cases/force-test
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name gen-opam-install-file)
@@ -142,7 +142,7 @@
  (action
   (chdir
    test-cases/gen-opam-install-file
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name github20)
@@ -150,7 +150,7 @@
  (action
   (chdir
    test-cases/github20
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name github24)
@@ -158,7 +158,7 @@
  (action
   (chdir
    test-cases/github24
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name github25)
@@ -169,7 +169,7 @@
    ./findlib-packages
    (chdir
     test-cases/github25
-    (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))))
+    (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))))
 
 (alias
  (name github534)
@@ -177,7 +177,7 @@
  (action
   (chdir
    test-cases/github534
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name github568)
@@ -185,7 +185,7 @@
  (action
   (chdir
    test-cases/github568
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name github597)
@@ -193,7 +193,7 @@
  (action
   (chdir
    test-cases/github597
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name github644)
@@ -201,7 +201,7 @@
  (action
   (chdir
    test-cases/github644
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name github660)
@@ -209,7 +209,7 @@
  (action
   (chdir
    test-cases/github660
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name github717-odoc-index)
@@ -218,7 +218,7 @@
   (chdir
    test-cases/github717-odoc-index
    (progn
-    (run ${exe:cram.exe} -skip-versions 4.02.3 -test run.t)
+    (run %{exe:cram.exe} -skip-versions 4.02.3 -test run.t)
     (diff? run.t run.t.corrected)))))
 
 (alias
@@ -227,7 +227,7 @@
  (action
   (chdir
    test-cases/github734
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name github759)
@@ -235,7 +235,7 @@
  (action
   (chdir
    test-cases/github759
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name github761)
@@ -243,7 +243,7 @@
  (action
   (chdir
    test-cases/github761
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name github764)
@@ -252,7 +252,7 @@
   (chdir
    test-cases/github764
    (progn
-    (run ${exe:cram.exe} -skip-platforms win -test run.t)
+    (run %{exe:cram.exe} -skip-platforms win -test run.t)
     (diff? run.t run.t.corrected)))))
 
 (alias
@@ -261,7 +261,7 @@
  (action
   (chdir
    test-cases/github784
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name ignored_subdirs)
@@ -269,7 +269,7 @@
  (action
   (chdir
    test-cases/ignored_subdirs
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name include-loop)
@@ -277,7 +277,7 @@
  (action
   (chdir
    test-cases/include-loop
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name inline_tests)
@@ -285,7 +285,7 @@
  (action
   (chdir
    test-cases/inline_tests
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name installable-dup-private-libs)
@@ -293,7 +293,7 @@
  (action
   (chdir
    test-cases/installable-dup-private-libs
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name intf-only)
@@ -301,7 +301,7 @@
  (action
   (chdir
    test-cases/intf-only
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name js_of_ocaml)
@@ -309,10 +309,10 @@
  (action
   (setenv
    NODE
-   ${bin:node}
+   %{bin:node}
    (chdir
     test-cases/js_of_ocaml
-    (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))))
+    (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected))))))
 
 (alias
  (name lib-available)
@@ -320,7 +320,7 @@
  (action
   (chdir
    test-cases/lib-available
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name link-deps)
@@ -328,7 +328,7 @@
  (action
   (chdir
    test-cases/link-deps
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name loop)
@@ -336,7 +336,7 @@
  (action
   (chdir
    test-cases/loop
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name menhir)
@@ -344,7 +344,7 @@
  (action
   (chdir
    test-cases/menhir
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name merlin-tests)
@@ -352,7 +352,7 @@
  (action
   (chdir
    test-cases/merlin-tests
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name meta-gen)
@@ -360,7 +360,7 @@
  (action
   (chdir
    test-cases/meta-gen
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name misc)
@@ -368,7 +368,7 @@
  (action
   (chdir
    test-cases/misc
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name multiple-private-libs)
@@ -377,7 +377,7 @@
   (chdir
    test-cases/multiple-private-libs
    (progn
-    (run ${exe:cram.exe} -skip-versions 4.02.3 -test run.t)
+    (run %{exe:cram.exe} -skip-versions 4.02.3 -test run.t)
     (diff? run.t run.t.corrected)))))
 
 (alias
@@ -386,7 +386,7 @@
  (action
   (chdir
    test-cases/no-installable-mode
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name null-dep)
@@ -394,7 +394,7 @@
  (action
   (chdir
    test-cases/null-dep
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name ocaml-syntax)
@@ -402,7 +402,7 @@
  (action
   (chdir
    test-cases/ocaml-syntax
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name ocamldep-multi-stanzas)
@@ -410,7 +410,7 @@
  (action
   (chdir
    test-cases/ocamldep-multi-stanzas
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name odoc)
@@ -419,7 +419,7 @@
   (chdir
    test-cases/odoc
    (progn
-    (run ${exe:cram.exe} -skip-versions 4.02.3 -test run.t)
+    (run %{exe:cram.exe} -skip-versions 4.02.3 -test run.t)
     (diff? run.t run.t.corrected)))))
 
 (alias
@@ -429,7 +429,7 @@
   (chdir
    test-cases/odoc-unique-mlds
    (progn
-    (run ${exe:cram.exe} -skip-versions 4.02.3 -test run.t)
+    (run %{exe:cram.exe} -skip-versions 4.02.3 -test run.t)
     (diff? run.t run.t.corrected)))))
 
 (alias
@@ -440,7 +440,7 @@
    test-cases/output-obj
    (progn
     (run
-     ${exe:cram.exe}
+     %{exe:cram.exe}
      -skip-versions
      <4.06.0
      -skip-platforms
@@ -455,7 +455,7 @@
  (action
   (chdir
    test-cases/package-dep
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name ppx-rewriter)
@@ -464,7 +464,7 @@
   (chdir
    test-cases/ppx-rewriter
    (progn
-    (run ${exe:cram.exe} -skip-versions 4.02.3 -test run.t)
+    (run %{exe:cram.exe} -skip-versions 4.02.3 -test run.t)
     (diff? run.t run.t.corrected)))))
 
 (alias
@@ -473,7 +473,7 @@
  (action
   (chdir
    test-cases/private-public-overlap
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name promote)
@@ -481,7 +481,7 @@
  (action
   (chdir
    test-cases/promote
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name quoting)
@@ -489,7 +489,7 @@
  (action
   (chdir
    test-cases/quoting
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name reason)
@@ -497,7 +497,7 @@
  (action
   (chdir
    test-cases/reason
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name redirections)
@@ -505,7 +505,7 @@
  (action
   (chdir
    test-cases/redirections
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name scope-bug)
@@ -513,7 +513,7 @@
  (action
   (chdir
    test-cases/scope-bug
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name scope-ppx-bug)
@@ -521,7 +521,7 @@
  (action
   (chdir
    test-cases/scope-ppx-bug
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name select)
@@ -529,7 +529,7 @@
  (action
   (chdir
    test-cases/select
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name syntax-versioning)
@@ -537,7 +537,7 @@
  (action
   (chdir
    test-cases/syntax-versioning
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name use-meta)
@@ -545,7 +545,7 @@
  (action
   (chdir
    test-cases/use-meta
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name utop)
@@ -553,7 +553,7 @@
  (action
   (chdir
    test-cases/utop
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name windows-diff)
@@ -561,7 +561,7 @@
  (action
   (chdir
    test-cases/windows-diff
-   (progn (run ${exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
+   (progn (run %{exe:cram.exe} -test run.t) (diff? run.t run.t.corrected)))))
 
 (alias
  (name runtest)

test/blackbox-tests/gen_tests.ml

@@ -12,6 +12,10 @@ module Sexp = struct
 
   let constr name args =
     Usexp.List (Usexp.atom name :: args)
+
+  let parse s =
+    Usexp.parse_string ~fname:"gen_tests.ml" ~mode:Single s
+    |> Usexp.Ast.remove_locs
 end
 
 let alias ?action name ~deps =
@@ -26,7 +30,7 @@ let alias ?action name ~deps =
 module Test = struct
   type t =
     { name           : string
-    ; env            : (string * string) option
+    ; env            : (string * Usexp.t) option
     ; skip_ocaml     : string option
     ; skip_platforms : Platform.t list
     ; enabled        : bool
@@ -59,10 +63,13 @@ module Test = struct
         ; atom (sprintf "test-cases/%s" t.name)
         ; List
             [ atom "progn"
-            ; Sexp.strings (["run"; "${exe:cram.exe}"]
+            ; Usexp.List
-                            @ skip_version
+                ([ atom "run"
-                            @ skip_platforms
+                 ; Sexp.parse "%{exe:cram.exe}" ]
-                            @ ["-test"; "run.t"])
+                 @ (List.map ~f:Usexp.atom_or_quoted_string
+                      (skip_version
+                       @ skip_platforms
+                       @ ["-test"; "run.t"])))
             ; Sexp.strings ["diff?"; "run.t"; "run.t.corrected"]
             ]
 
@@ -74,7 +81,7 @@ module Test = struct
       | Some (k, v) ->
         List [ atom "setenv"
              ; atom_or_quoted_string k
-             ; atom_or_quoted_string v
+             ; v
              ; action ] in
     alias t.name
       ~deps:(
@@ -83,14 +90,15 @@ module Test = struct
                        ; sprintf "test-cases/%s" t.name]
         ]
       ) ~action
-    |> Usexp.pp fmt
+    |> Usexp.pp Dune fmt
 end
 
 let exclusions =
   let open Test in
   let odoc = make ~external_deps:true ~skip_ocaml:"4.02.3" in
-  [ make "js_of_ocaml" ~external_deps:true ~js:true ~env:("NODE", "${bin:node}")
+  [ make "js_of_ocaml" ~external_deps:true ~js:true
-  ; make "github25" ~env:("OCAMLPATH", "./findlib-packages")
+      ~env:("NODE", Sexp.parse "%{bin:node}")
+  ; make "github25" ~env:("OCAMLPATH", Usexp.atom "./findlib-packages")
   ; odoc "odoc"
   ; odoc "odoc-unique-mlds"
   ; odoc "github717-odoc-index"
@@ -122,7 +130,7 @@ let pp_group fmt (name, tests) =
   alias name ~deps:(
     (List.map tests ~f:(fun (t : Test.t) ->
        Sexp.strings ["alias"; t.name])))
-  |> Usexp.pp fmt
+  |> Usexp.pp Dune fmt
 
 let () =
   let tests = Lazy.force all_tests in

test/blackbox-tests/test-cases/aliases/src/dune

@@ -1,3 +1,3 @@
 (alias
  (name x)
- (action (chdir ${ROOT} (echo "running in ${path-no-dep:.}\n"))))
+ (action (chdir %{ROOT} (echo "running in %{path-no-dep:.}\n"))))

test/blackbox-tests/test-cases/aliases/src/foo/bar/dune

@@ -1,3 +1,3 @@
 (alias
  (name x)
- (action (chdir ${ROOT} (echo "running in ${path-no-dep:.}\n"))))
+ (action (chdir %{ROOT} (echo "running in %{path-no-dep:.}\n"))))

test/blackbox-tests/test-cases/aliases/src/foo/baz/dune

@@ -1,3 +1,3 @@
 (alias
  (name x)
- (action (chdir ${ROOT} (echo "running in ${path-no-dep:.}\n"))))
+ (action (chdir %{ROOT} (echo "running in %{path-no-dep:.}\n"))))

test/blackbox-tests/test-cases/copy_files/dune

@@ -3,7 +3,7 @@
 
 (rule
  (targets dummy.ml)
- (action (with-stdout-to ${@} (echo ""))))
+ (action (with-stdout-to %{@} (echo ""))))
 
 (library
  (name foo)
@@ -19,4 +19,4 @@
 (alias
  (name bar-source)
  (deps bar.h)
- (action (echo "${read:bar.h}")))
+ (action (echo "%{read:bar.h}")))

test/blackbox-tests/test-cases/force-test/dune

@@ -4,4 +4,4 @@
 (alias
  (name runtest)
  (deps f.exe)
- (action (run ${<})))
+ (action (run %{<})))

test/blackbox-tests/test-cases/gen-opam-install-file/dune

@@ -25,7 +25,7 @@
 (alias
  (name runtest)
  (deps foo.install)
- (action (echo "${read:foo.install}")))
+ (action (echo "%{read:foo.install}")))
 
 (documentation
  (mld_files (doc)))

test/blackbox-tests/test-cases/github534/dune

@@ -6,5 +6,5 @@
  (deps (glob_files optional.ml)
        (glob_files *optional.ml))
  (action
-  (with-stdout-to ${@}
+  (with-stdout-to %{@}
    (run echo "let () = print_endline \"Hello World\""))))

test/blackbox-tests/test-cases/github568/dune

@@ -8,7 +8,7 @@
  (name runtest)
  (package lib1)
  (deps test1.exe)
- (action (run ${<})))
+ (action (run %{<})))
 
 (executable
  (name test1)
@@ -25,7 +25,7 @@
  (name runtest)
  (package lib2)
  (deps test2.exe)
- (action (run ${<})))
+ (action (run %{<})))
 
 (executable
  (name test2)

test/blackbox-tests/test-cases/github660/explicit-interfaces/dune

@@ -1,6 +1,6 @@
 (alias
  (name runtest)
  (deps main.exe)
- (action (run ${<})))
+ (action (run %{<})))
 
 (executable (name main))

test/blackbox-tests/test-cases/github660/no-interfaces/dune

@@ -1,6 +1,6 @@
 (alias
  (name runtest)
  (deps main.exe)
- (action (run ${<})))
+ (action (run %{<})))
 
 (executable (name main))

test/blackbox-tests/test-cases/github784/dune

@@ -1 +1 @@
-(rule (run ${bin:echo} foo))
+(rule (run %{bin:echo} foo))

test/blackbox-tests/test-cases/inline_tests/dune-file/dune

@@ -11,8 +11,8 @@
     (echo "let () = print_int 42")
     (echo "\n")
     (echo "let () = print_int 43;;")))
-  (flags (inline-test-runner ${library-name}
+  (flags (inline-test-runner %{library-name}
-           -source-tree-root ${ROOT} -diff-cmd -))))
+           -source-tree-root %{ROOT} -diff-cmd -))))
 
 (library
  (name foo_tests)
@@ -21,4 +21,4 @@
 (alias
  (name runtest)
  (deps foo.dune)
- (action (echo "${read:foo.dune}")))
+ (action (echo "%{read:foo.dune}")))

test/blackbox-tests/test-cases/inline_tests/run.t

@@ -28,9 +28,9 @@
      ((runner_libraries (str))
       (flags
        (inline-test-runner
-        ${library-name}
+        %{library-name}
         -source-tree-root
-        ${ROOT}
+        %{ROOT}
         -diff-cmd
         -))
       (generate_runner

test/blackbox-tests/test-cases/inline_tests/simple/dune

@@ -2,7 +2,7 @@
  (name backend_simple)
  (modules ())
  (inline_tests.backend
-  (generate_runner (run sed "s/(\\*TEST:\\(.*\\)\\*)/let () = \\1;;/" ${impl-files})
+  (generate_runner (run sed "s/(\\*TEST:\\(.*\\)\\*)/let () = \\1;;/" %{impl-files})
   )))
 
 (library

test/blackbox-tests/test-cases/lib-available/dune

@@ -1,7 +1,7 @@
 (alias
  (name runtest)
- (action (system "${lib-available:unix}")))
+ (action (system "%{lib-available:unix}")))
 
 (alias
  (name runtest)
- (action (system "${lib-available:library-that-surely-doesnt-exist} && exit 1 || exit 0")))
+ (action (system "%{lib-available:library-that-surely-doesnt-exist} && exit 1 || exit 0")))

test/blackbox-tests/test-cases/loop/dune

@@ -1,5 +1,5 @@
-(rule (copy ${read:x} a))
+(rule (copy %{read:x} a))
-(rule (copy ${read:y} b))
+(rule (copy %{read:y} b))
 
 (rule (progn (run true) (with-stdout-to x (echo b))))
 (rule (progn (run true) (with-stdout-to y (echo a))))

test/blackbox-tests/test-cases/merlin-tests/dune

@@ -1,4 +1,4 @@
 (alias
  (name print-merlins)
  (deps lib/.merlin exe/.merlin)
- (action (run ./sanitize-dot-merlin/sanitize_dot_merlin.exe ${^})))
+ (action (run ./sanitize-dot-merlin/sanitize_dot_merlin.exe %{^})))

test/blackbox-tests/test-cases/meta-gen/dune

@@ -43,4 +43,4 @@
 
 (alias
  (name runtest)
- (action (echo "${read:META.foobar}")))
+ (action (echo "%{read:META.foobar}")))

test/blackbox-tests/test-cases/misc/blah/dune

@@ -1,3 +1,3 @@
 (alias
  (name runtest)
- (deps ${SCOPE_ROOT}/023e1a58-4d08-11e7-a041-aa000008c8a6))
+ (deps %{SCOPE_ROOT}/023e1a58-4d08-11e7-a041-aa000008c8a6))

test/blackbox-tests/test-cases/misc/dune

@@ -1,17 +1,17 @@
-;; Test for ${^} with globs in rules
+;; Test for %{^} with globs in rules
 
 (rule
  (targets result expected)
  (deps    dune (glob_files *.txt))
  (action  (progn
-           (with-stdout-to result   (echo ${^}))
+           (with-stdout-to result   (echo %{^}))
            (with-stdout-to expected (echo "dune a.txt b.txt c.txt")))))
 
 (rule
  (targets result2 expected2)
  (deps    (source_tree sub-tree))
  (action  (progn
-           (with-stdout-to result2   (echo ${^}))
+           (with-stdout-to result2   (echo %{^}))
            (with-stdout-to expected2 (echo "sub-tree/a sub-tree/dir/b")))))
 
 (alias
@@ -31,21 +31,21 @@
 (alias
  (name   runtest)
  (deps   dune dune-plop)
- (action (run diff -u ${^})))
+ (action (run diff -u %{^})))
 
 ;; For some tests in subdirs
 
 (rule (with-stdout-to 023e1a58-4d08-11e7-a041-aa000008c8a6 (echo "plop")))
 
-;; Test for ${path-no-dep}
+;; Test for %{path-no-dep}
 
 (rule
  (progn
   (with-stdout-to pnd-result
    (chdir sub-tree/dir
     (progn
-     (echo "${path-no-dep:file-that-doesn't-exist}\n")
+     (echo "%{path-no-dep:file-that-doesn't-exist}\n")
-     (echo "${path-no-dep:.}\n"))))
+     (echo "%{path-no-dep:.}\n"))))
   (with-stdout-to pnd-expected
    (progn
     (echo "../../file-that-doesn't-exist\n")
@@ -54,7 +54,7 @@
 (alias
  (name   runtest)
  (deps   pnd-result pnd-expected)
- (action (run diff -u ${^})))
+ (action (run diff -u %{^})))
 
 ;; Test for globs
 

test/blackbox-tests/test-cases/null-dep/dune

@@ -1,3 +1,3 @@
 (alias
  (name runtest)
- (action (with-stdout-to ${null} (echo "hello world"))))
+ (action (with-stdout-to %{null} (echo "hello world"))))

test/blackbox-tests/test-cases/odoc/dune

@@ -18,14 +18,14 @@
 (alias
  (name runtest)
  (deps _doc/_html/index.html)
- (action (echo "${read:_doc/_html/index.html}")))
+ (action (echo "%{read:_doc/_html/index.html}")))
 
 (alias
  (name foo-mld)
  (deps _doc/_mlds/foo/index.mld)
- (action (echo "${read:_doc/_mlds/foo/index.mld}")))
+ (action (echo "%{read:_doc/_mlds/foo/index.mld}")))
 
 (alias
  (name bar-mld)
  (deps _doc/_mlds/bar/index.mld)
- (action (echo "${read:_doc/_mlds/bar/index.mld}")))
+ (action (echo "%{read:_doc/_mlds/bar/index.mld}")))

test/blackbox-tests/test-cases/output-obj/dune

@@ -2,10 +2,10 @@
  (name all)
  (deps test.bc
        test.exe
-       test.bc${ext_obj}
+       test.bc%{ext_obj}
-       test.exe${ext_obj}
+       test.exe%{ext_obj}
-       test.bc${ext_dll}
+       test.bc%{ext_dll}
-       test${ext_dll}
+       test%{ext_dll}
        static.bc
        static.exe))
 
@@ -20,20 +20,20 @@
 
 (rule
  (targets static.exe)
- (deps test.exe${ext_obj} static.c)
+ (deps test.exe%{ext_obj} static.c)
- (action (run ${CC} -o ${@} -I ${ocaml_where} -I . ${^}
+ (action (run %{CC} -o %{@} -I %{ocaml_where} -I . %{^}
-          ${ocaml-config:native_c_libraries})))
+          %{ocaml-config:native_c_libraries})))
 
 (rule
  (targets static.bc)
- (deps test.bc${ext_obj} static.c)
+ (deps test.bc%{ext_obj} static.c)
- (action (run ${CC} -o ${@} -I ${ocaml_where} -I . ${^}
+ (action (run %{CC} -o %{@} -I %{ocaml_where} -I . %{^}
-          ${ocaml-config:bytecomp_c_libraries})))
+          %{ocaml-config:bytecomp_c_libraries})))
 
 (rule
  (targets dynamic.exe)
  (deps dynamic.c)
- (action (run ${CC} -o ${@} ${<} ${ocaml-config:native_c_libraries})))
+ (action (run %{CC} -o %{@} %{<} %{ocaml-config:native_c_libraries})))
 
 (alias
  (name runtest)
@@ -47,10 +47,10 @@
 
 (alias
  (name   runtest)
- (deps   test.bc${ext_dll})
+ (deps   test.bc%{ext_dll})
- (action (run ./dynamic.exe ./${<})))
+ (action (run ./dynamic.exe ./%{<})))
 
 (alias
  (name   runtest)
- (deps   test${ext_dll})
+ (deps   test%{ext_dll})
- (action (run ./dynamic.exe ./${<})))
+ (action (run ./dynamic.exe ./%{<})))

test/blackbox-tests/test-cases/quoting/bad/dune

@@ -1,3 +1,3 @@
 (rule
  (targets x y)
- (action (with-stdout-to ${@} (echo foo))))
+ (action (with-stdout-to %{@} (echo foo))))

test/blackbox-tests/test-cases/quoting/filename-space/dune

@@ -1,8 +1,8 @@
 
 (alias
  (name unquoted)
- (action (echo ${read:foo bar.txt})))
+ (action (echo %{read:foo bar.txt})))
 
 (alias
  (name quoted)
- (action (echo "${read:foo bar.txt}")))
+ (action (echo "%{read:foo bar.txt}")))

test/blackbox-tests/test-cases/quoting/good/dune

@@ -1,3 +1,3 @@
 (rule
  (targets s t)
- (action (with-stdout-to "${@}" (echo foo))))
+ (action (with-stdout-to "%{@}" (echo foo))))

test/blackbox-tests/test-cases/quoting/quote-from-context/dune

@@ -3,4 +3,4 @@
 
 (alias
  (name runtest)
- (action (run ./count_args.exe ${read-lines:args})))
+ (action (run ./count_args.exe %{read-lines:args})))

test/blackbox-tests/test-cases/quoting/quotes-multi/dune

@@ -1,4 +1,4 @@
 
 (alias
  (name runtest)
- (action (echo "lines: ${read-lines:foo}")))
+ (action (echo "lines: %{read-lines:foo}")))

test/blackbox-tests/test-cases/quoting/run.t

@@ -3,8 +3,8 @@ that ${@} is not quoted and doesn't contain exactly 1 element
 
   $ dune build --root bad x
   Entering directory 'bad'
-  File "dune", line 3, characters 25-29:
+  File "dune", line 3, characters 27-29:
-  Error: Variable ${@} expands to 2 values, however a single value is expected here. Please quote this atom.
+  Error: Variable %{@} expands to 2 values, however a single value is expected here. Please quote this atom.
   [1]
 
 The targets should only be interpreted as a single path when quoted
@@ -26,9 +26,11 @@ The targets should only be interpreted as a single path when quoted
   lines: foo bar baz
 
   $ dune build @quoted --root filename-space
-  Entering directory 'filename-space'
+  File "dune", line 4, characters 17-18:
-  filename contains spaces
+  Error: This character not allowed inside %{...} forms
+  [1]
 
   $ dune build @unquoted --root filename-space
-  Entering directory 'filename-space'
+  File "dune", line 4, characters 17-18:
-  ${read:foo bar.txt}
+  Error: This character not allowed inside %{...} forms
+  [1]

test/blackbox-tests/test-cases/reason/dune

@@ -8,27 +8,27 @@
   (lint
    (per_module
     ((pps (reasonppx (-lint true))) (hello cppome))
-    ((action (run ./pp/reasononlypp.exe -lint ${<})) (foo bar pped))))
+    ((action (run ./pp/reasononlypp.exe -lint %{<})) (foo bar pped))))
   (preprocess
    (per_module
     ((pps (reasonppx)) (foo))
     ((pps (reasonppx (-lint false))) (hello))
-    ((action (run ./pp/reasononlypp.exe ${<})) (cppome))))))
+    ((action (run ./pp/reasononlypp.exe %{<})) (cppome))))))
 
 (executable
  ((name rbin)
   (modules (rbin))
-  (lint (action (run ./pp/reasononlypp.exe -lint ${<})))
+  (lint (action (run ./pp/reasononlypp.exe -lint %{<})))
-  (preprocess (action (run ./pp/reasononlypp.exe ${<})))
+  (preprocess (action (run ./pp/reasononlypp.exe %{<})))
   (libraries (rlib))))
 
 ;; we want to make sure that .rei files are present
 (alias
  ((name install-file)
   (deps (rlib.install))
-  (action (echo "${read:rlib.install}"))))
+  (action (echo "%{read:rlib.install}"))))
 
 (alias
  ((name runtest)
   (deps (rbin.exe))
-  (action (run ${<}))))
+  (action (run %{<}))))

test/blackbox-tests/test-cases/redirections/dune

@@ -15,15 +15,15 @@
 
 (rule
  (targets stdout.expected)
- (action  (with-stdout-to ${@} (echo "toto\n"))))
+ (action  (with-stdout-to %{@} (echo "toto\n"))))
 
 (rule
  (targets stderr.expected)
- (action  (with-stdout-to ${@} (echo "titi\n"))))
+ (action  (with-stdout-to %{@} (echo "titi\n"))))
 
 (rule
  (targets both.expected)
- (action  (with-stdout-to ${@} (echo "toto\ntiti\n"))))
+ (action  (with-stdout-to %{@} (echo "toto\ntiti\n"))))
 
 (alias
  (name runtest)

test/blackbox-tests/test-cases/select/dune

@@ -11,4 +11,4 @@
 (alias
  (name runtest)
  (deps main.exe)
- (action (run ${<})))
+ (action (run %{<})))

test/dune

@@ -51,27 +51,27 @@ Printf.fprintf (open_out Sys.argv.(2)) \"%g\n%!\" (Sys.time ())
 
 (executable (name incr) (libraries unix))
 
-(rule (targets 01.foo) (action (run ./incr.exe x ${@})))
+(rule (targets 01.foo) (action (run ./incr.exe x %{@})))
-(rule (targets 02.foo) (action (run ./incr.exe x ${@})))
+(rule (targets 02.foo) (action (run ./incr.exe x %{@})))
-(rule (targets 03.foo) (action (run ./incr.exe x ${@})))
+(rule (targets 03.foo) (action (run ./incr.exe x %{@})))
-(rule (targets 04.foo) (action (run ./incr.exe x ${@})))
+(rule (targets 04.foo) (action (run ./incr.exe x %{@})))
-(rule (targets 05.foo) (action (run ./incr.exe x ${@})))
+(rule (targets 05.foo) (action (run ./incr.exe x %{@})))
-(rule (targets 06.foo) (action (run ./incr.exe x ${@})))
+(rule (targets 06.foo) (action (run ./incr.exe x %{@})))
-(rule (targets 07.foo) (action (run ./incr.exe x ${@})))
+(rule (targets 07.foo) (action (run ./incr.exe x %{@})))
-(rule (targets 08.foo) (action (run ./incr.exe x ${@})))
+(rule (targets 08.foo) (action (run ./incr.exe x %{@})))
-(rule (targets 09.foo) (action (run ./incr.exe x ${@})))
+(rule (targets 09.foo) (action (run ./incr.exe x %{@})))
-(rule (targets 10.foo) (action (run ./incr.exe x ${@})))
+(rule (targets 10.foo) (action (run ./incr.exe x %{@})))
 
-(rule (targets 01.bar) (action (run ./incr.exe y ${@})) (locks m))
+(rule (targets 01.bar) (action (run ./incr.exe y %{@})) (locks m))
-(rule (targets 02.bar) (action (run ./incr.exe y ${@})) (locks m))
+(rule (targets 02.bar) (action (run ./incr.exe y %{@})) (locks m))
-(rule (targets 03.bar) (action (run ./incr.exe y ${@})) (locks m))
+(rule (targets 03.bar) (action (run ./incr.exe y %{@})) (locks m))
-(rule (targets 04.bar) (action (run ./incr.exe y ${@})) (locks m))
+(rule (targets 04.bar) (action (run ./incr.exe y %{@})) (locks m))
-(rule (targets 05.bar) (action (run ./incr.exe y ${@})) (locks m))
+(rule (targets 05.bar) (action (run ./incr.exe y %{@})) (locks m))
-(rule (targets 06.bar) (action (run ./incr.exe y ${@})) (locks m))
+(rule (targets 06.bar) (action (run ./incr.exe y %{@})) (locks m))
-(rule (targets 07.bar) (action (run ./incr.exe y ${@})) (locks m))
+(rule (targets 07.bar) (action (run ./incr.exe y %{@})) (locks m))
-(rule (targets 08.bar) (action (run ./incr.exe y ${@})) (locks m))
+(rule (targets 08.bar) (action (run ./incr.exe y %{@})) (locks m))
-(rule (targets 09.bar) (action (run ./incr.exe y ${@})) (locks m))
+(rule (targets 09.bar) (action (run ./incr.exe y %{@})) (locks m))
-(rule (targets 10.bar) (action (run ./incr.exe y ${@})) (locks m))
+(rule (targets 10.bar) (action (run ./incr.exe y %{@})) (locks m))
 
 (alias
  (name runtest-no-deps)

test/unit-tests/action.mlt

@@ -14,8 +14,8 @@ let infer (a : Action.t) =
    List.map (Path.Set.to_list x.targets) ~f:Path.to_string)
 [%%expect{|
 - : unit = ()
-val p : ?error_loc:Usexp.Loc.t -> string -> Dune.Import.Path.t = <fun>
+val p : ?error_loc:Usexp.Loc.t -> string -> Path.t = <fun>
-val infer : Dune.Action.t -> string list * string list = <fun>
+val infer : Action.t -> string list * string list = <fun>
 |}]
 
 infer (Copy (p "a", p "b"));;

test/unit-tests/configurator/dune

@@ -5,4 +5,4 @@
 (alias
  (name runtest)
  (deps ./test_configurator.exe)
- (action (run ${<})))
+ (action (run %{<})))

test/unit-tests/dune

@@ -19,71 +19,71 @@
 (alias
  (name runtest)
  (deps tests.mlt
-       (glob_files ${SCOPE_ROOT}/src/.dune.objs/*.cmi)
+  (glob_files %{SCOPE_ROOT}/src/.dune.objs/*.cmi)
-       (glob_files ${SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi)
+  (glob_files %{SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi)
-       (source_tree toolchain.d)
+  (source_tree toolchain.d)
-       (source_tree findlib-db))
+  (source_tree findlib-db))
- (action (chdir ${SCOPE_ROOT}
+ (action (chdir %{SCOPE_ROOT}
           (progn
-           (run ${exe:expect_test.exe} ${<})
+           (run %{exe:expect_test.exe} %{<})
-           (diff? ${<} ${<}.corrected)))))
+           (diff? %{<} %{<}.corrected)))))
 
 (alias
  (name runtest)
  (deps filename.mlt
-       (glob_files ${SCOPE_ROOT}/src/.dune.objs/*.cmi)
+  (glob_files %{SCOPE_ROOT}/src/.dune.objs/*.cmi)
-       (glob_files ${SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
+  (glob_files %{SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
- (action (chdir ${SCOPE_ROOT}
+ (action (chdir %{SCOPE_ROOT}
           (progn
-           (run ${exe:expect_test.exe} ${<})
+           (run %{exe:expect_test.exe} %{<})
-           (diff? ${<} ${<}.corrected)))))
+           (diff? %{<} %{<}.corrected)))))
 
 (alias
  (name runtest)
  (deps import_dot_map.mlt
-       (glob_files ${SCOPE_ROOT}/src/.dune.objs/*.cmi)
+  (glob_files %{SCOPE_ROOT}/src/.dune.objs/*.cmi)
-       (glob_files ${SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
+  (glob_files %{SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
- (action (chdir ${SCOPE_ROOT}
+ (action (chdir %{SCOPE_ROOT}
           (progn
-           (run ${exe:expect_test.exe} ${<})
+           (run %{exe:expect_test.exe} %{<})
-           (diff? ${<} ${<}.corrected)))))
+           (diff? %{<} %{<}.corrected)))))
 
 (alias
  (name runtest)
  (deps action.mlt
-       (glob_files ${SCOPE_ROOT}/src/.dune.objs/*.cmi)
+  (glob_files %{SCOPE_ROOT}/src/.dune.objs/*.cmi)
-       (glob_files ${SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
+  (glob_files %{SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
- (action (chdir ${SCOPE_ROOT}
+ (action (chdir %{SCOPE_ROOT}
           (progn
-           (run ${exe:expect_test.exe} ${<})
+           (run %{exe:expect_test.exe} %{<})
-           (diff? ${<} ${<}.corrected)))))
+           (diff? %{<} %{<}.corrected)))))
 
 (alias
  (name runtest)
  (deps path.mlt
-       (glob_files ${SCOPE_ROOT}/src/.dune.objs/*.cmi)
+  (glob_files %{SCOPE_ROOT}/src/.dune.objs/*.cmi)
-       (glob_files ${SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
+  (glob_files %{SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
- (action (chdir ${SCOPE_ROOT}
+ (action (chdir %{SCOPE_ROOT}
           (progn
-           (run ${exe:expect_test.exe} ${<})
+           (run %{exe:expect_test.exe} %{<})
-           (diff? ${<} ${<}.corrected)))))
+           (diff? %{<} %{<}.corrected)))))
 
 (alias
  (name runtest)
  (deps sexp.mlt
-       (glob_files ${SCOPE_ROOT}/src/.dune.objs/*.cmi)
+  (glob_files %{SCOPE_ROOT}/src/.dune.objs/*.cmi)
-       (glob_files ${SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
+  (glob_files %{SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
- (action (chdir ${SCOPE_ROOT}
+ (action (chdir %{SCOPE_ROOT}
           (progn
-           (run ${exe:expect_test.exe} ${<})
+           (run %{exe:expect_test.exe} %{<})
-           (diff? ${<} ${<}.corrected)))))
+           (diff? %{<} %{<}.corrected)))))
 
 (alias
  (name runtest)
  (deps jbuild.mlt
-       (glob_files ${SCOPE_ROOT}/src/.dune.objs/*.cmi)
+  (glob_files %{SCOPE_ROOT}/src/.dune.objs/*.cmi)
-       (glob_files ${SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
+  (glob_files %{SCOPE_ROOT}/src/stdune/.stdune.objs/*.cmi))
- (action (chdir ${SCOPE_ROOT}
+ (action (chdir %{SCOPE_ROOT}
           (progn
-           (run ${exe:expect_test.exe} ${<})
+           (run %{exe:expect_test.exe} %{<})
-           (diff? ${<} ${<}.corrected)))))
+           (diff? %{<} %{<}.corrected)))))

test/unit-tests/expect_test.mll

@@ -38,13 +38,48 @@ and expectation txt = parse
   }
 
 {
+module Outcometree_cleaner = struct
+  open Outcometree
+
+  let lid s =
+    match String.rindex s '.' with
+    | exception Not_found -> s
+    | i ->
+      let pos = i + 1 in
+      let len = String.length s in
+      String.sub s ~pos ~len:(len - pos)
+
+  let ident = function
+    | Oide_dot (_, s) -> Oide_ident (lid s)
+    | Oide_ident s -> Oide_ident (lid s)
+    | id -> id
+
+  let rec value = function
+    | Oval_array l -> Oval_array (values l)
+    | Oval_constr (id, l) -> Oval_constr (ident id, values l)
+    | Oval_list l -> Oval_list (values l)
+    | Oval_record l ->
+      Oval_record (List.map l ~f:(fun (id, v) -> ident id, value v))
+    | Oval_tuple l -> Oval_tuple (values l)
+    | Oval_variant (s, Some v) -> Oval_variant (s, Some (value v))
+    | v -> v
+
+  and values l = List.map l ~f:value
+
+  let () =
+    let print_out_value = !Toploop.print_out_value in
+    Toploop.print_out_value := (fun ppf v -> print_out_value ppf (value v))
+end
+
 let main () =
+  Clflags.real_paths := false;
   Test_common.run_expect_test Sys.argv.(1) ~f:(fun file_contents lexbuf ->
     let chunks = code file_contents lexbuf.lex_curr_p lexbuf in
 
     Toploop.initialize_toplevel_env ();
     List.iter
-      [ "src/stdune/.stdune.objs"
+      [ "src/usexp/.usexp.objs"
+      ; "src/stdune/.stdune.objs"
       ; "src/.dune.objs"
       ]
       ~f:Topdirs.dir_directory;

test/unit-tests/import_dot_map.mlt

@@ -15,6 +15,5 @@ String.Map.of_list_multi
   ]
 |> String.Map.to_list;;
 [%%expect{|
-- : (Dune.Import.String.Map.key * int list) list =
+- : (string * int list) list = [("a", [1; 2; 3]); ("b", [1; 2])]
-[("a", [1; 2; 3]); ("b", [1; 2])]
 |}]

test/unit-tests/jbuild.mlt

@@ -2,67 +2,63 @@
 open Dune;;
 open Stdune;;
 
+let sexp_pp = Sexp.pp Dune;;
 #install_printer Jbuild.Mode_conf.pp;;
 #install_printer Binary_kind.pp;;
-#install_printer Sexp.pp;;
+#install_printer sexp_pp;;
 
 (* Jbuild.Executables.Link_mode.t *)
 let test s =
   Sexp.Of_sexp.parse Jbuild.Executables.Link_mode.t Univ_map.empty
     (Sexp.parse_string ~fname:"" ~mode:Sexp.Parser.Mode.Single s)
 [%%expect{|
-val test : string -> Dune.Jbuild.Executables.Link_mode.t = <fun>
+val sexp_pp : Format.formatter -> Usexp.t -> unit = <fun>
+val test : string -> Jbuild.Executables.Link_mode.t = <fun>
 |}]
 
 (* Link modes can be read as a (<mode> <kind>) list *)
 test "(best exe)"
 [%%expect{|
-- : Dune.Jbuild.Executables.Link_mode.t =
+- : Jbuild.Executables.Link_mode.t = {mode = best; kind = exe}
-{Dune.Jbuild.Executables.Link_mode.mode = best; kind = exe}
 |}]
 
 (* Some shortcuts also exist *)
 test "exe"
 [%%expect{|
-- : Dune.Jbuild.Executables.Link_mode.t =
+- : Jbuild.Executables.Link_mode.t = {mode = best; kind = exe}
-{Dune.Jbuild.Executables.Link_mode.mode = best; kind = exe}
 |}]
 test "object"
 [%%expect{|
-- : Dune.Jbuild.Executables.Link_mode.t =
+- : Jbuild.Executables.Link_mode.t = {mode = best; kind = object}
-{Dune.Jbuild.Executables.Link_mode.mode = best; kind = object}
 |}]
 test "shared_object"
 [%%expect{|
-- : Dune.Jbuild.Executables.Link_mode.t =
+- : Jbuild.Executables.Link_mode.t = {mode = best; kind = shared_object}
-{Dune.Jbuild.Executables.Link_mode.mode = best; kind = shared_object}
 |}]
 test "byte"
 [%%expect{|
-- : Dune.Jbuild.Executables.Link_mode.t =
+- : Jbuild.Executables.Link_mode.t = {mode = byte; kind = exe}
-{Dune.Jbuild.Executables.Link_mode.mode = byte; kind = exe}
 |}]
 test "native"
 [%%expect{|
-- : Dune.Jbuild.Executables.Link_mode.t =
+- : Jbuild.Executables.Link_mode.t = {mode = native; kind = exe}
-{Dune.Jbuild.Executables.Link_mode.mode = native; kind = exe}
 |}]
 
 (* Jbuild.Executables.Link_mode.sexp_of_t *)
 let test l =
   Jbuild.Executables.Link_mode.sexp_of_t l
 [%%expect{|
-val test : Dune.Jbuild.Executables.Link_mode.t -> Stdune__Sexp.t = <fun>
+val test : Jbuild.Executables.Link_mode.t -> Usexp.t = <fun>
 |}]
 
 (* In the general case, modes are serialized as a list *)
 test {Jbuild.Executables.Link_mode.kind = Shared_object; mode = Byte }
 [%%expect{|
-- : Stdune__Sexp.t = (byte shared_object)
+- : Usexp.t = (byte shared_object)
 |}]
 
 (* But the specialized ones are serialized in the minimal version *)
 test Jbuild.Executables.Link_mode.exe
 [%%expect{|
-- : Stdune__Sexp.t = exe
+- : Usexp.t = exe
 |}]

test/unit-tests/ocaml-config/dune

@@ -5,4 +5,4 @@
 (alias
  (name runtest)
  (deps ./gh637.exe)
- (action (run ${<})))
+ (action (run %{<})))

test/unit-tests/path.mlt

@@ -13,15 +13,15 @@ let e = Path.of_filename_relative_to_initial_cwd;;
 Path.(let p = relative root "foo" in descendant p ~of_:p)
 [%%expect{|
 - : unit = ()
-val r : string -> Stdune.Path.t = <fun>
+val r : string -> Path.t = <fun>
-val e : string -> Stdune.Path.t = <fun>
+val e : string -> Path.t = <fun>
-- : Stdune.Path.t option = Some (In_source_tree ".")
+- : Path.t option = Some (In_source_tree ".")
 |}]
 
 (* different strings but same length *)
 Path.(descendant (relative root "foo") ~of_:(relative root "bar"))
 [%%expect{|
-- : Stdune.Path.t option = None
+- : Path.t option = None
 |}]
 
 Path.(is_descendant (r "foo") ~of_:(r "foo"))
@@ -91,37 +91,37 @@ Path.(is_descendant (e "/foo/bar") ~of_:(e "/"))
 
 Path.(descendant (r "foo") ~of_:(r "foo/"))
 [%%expect{|
-- : Stdune.Path.t option = Some (In_source_tree ".")
+- : Path.t option = Some (In_source_tree ".")
 |}]
 
 Path.(descendant (r "foo/") ~of_:(r "foo"))
 [%%expect{|
-- : Stdune.Path.t option = Some (In_source_tree ".")
+- : Path.t option = Some (In_source_tree ".")
 |}]
 
 Path.(descendant (r "foo/bar") ~of_:(r "foo"))
 [%%expect{|
-- : Stdune.Path.t option = Some (In_source_tree "bar")
+- : Path.t option = Some (In_source_tree "bar")
 |}]
 
 Path.(descendant Path.root ~of_:(r "foo"))
 [%%expect{|
-- : Stdune.Path.t option = None
+- : Path.t option = None
 |}]
 
 Path.(descendant Path.root ~of_:Path.root)
 [%%expect{|
-- : Stdune.Path.t option = Some (In_source_tree ".")
+- : Path.t option = Some (In_source_tree ".")
 |}]
 
 Path.(descendant (r "foo") ~of_:Path.root)
 [%%expect{|
-- : Stdune.Path.t option = Some (In_source_tree "foo")
+- : Path.t option = Some (In_source_tree "foo")
 |}]
 
 Path.(descendant (relative build_dir "foo") ~of_:root)
 [%%expect{|
-- : Stdune.Path.t option = Some (In_source_tree "_build/foo")
+- : Path.t option = Some (In_source_tree "_build/foo")
 |}]
 
 Path.(descendant (relative build_dir "foo") ~of_:(absolute "/foo/bar"))
@@ -132,17 +132,17 @@ Error: Unbound value absolute
 
 Path.(descendant (relative build_dir "foo/bar") ~of_:build_dir)
 [%%expect{|
-- : Stdune.Path.t option = Some (In_source_tree "foo/bar")
+- : Path.t option = Some (In_source_tree "foo/bar")
 |}]
 
 Path.(descendant (relative build_dir "foo/bar") ~of_:(relative build_dir "foo"))
 [%%expect{|
-- : Stdune.Path.t option = Some (In_source_tree "bar")
+- : Path.t option = Some (In_source_tree "bar")
 |}]
 
 Path.(descendant (relative build_dir "foo/bar") ~of_:(relative build_dir "foo"))
 [%%expect{|
-- : Stdune.Path.t option = Some (In_source_tree "bar")
+- : Path.t option = Some (In_source_tree "bar")
 |}]
 
 Path.(descendant (absolute "/foo/bar") ~of_:(absolute "/foo"))
@@ -188,27 +188,27 @@ Path.reach (Path.of_string "bar/foo") ~from:(Path.of_string "bar/baz/y")
 
 Path.relative (Path.of_string "relative") "/absolute/path"
 [%%expect{|
-- : Stdune.Path.t = (External "/absolute/path")
+- : Path.t = (External "/absolute/path")
 |}]
 
 Path.relative (Path.of_string "/abs1") "/abs2"
 [%%expect{|
-- : Stdune.Path.t = (External "/abs2")
+- : Path.t = (External "/abs2")
 |}]
 
 Path.relative (Path.of_string "/abs1") ""
 [%%expect{|
-- : Stdune.Path.t = (External "/abs1")
+- : Path.t = (External "/abs1")
 |}]
 
 Path.relative Path.root "/absolute/path"
 [%%expect{|
-- : Stdune.Path.t = (External "/absolute/path")
+- : Path.t = (External "/absolute/path")
 |}]
 
 e "/absolute/path"
 [%%expect{|
-- : Stdune.Path.t = (External "/absolute/path")
+- : Path.t = (External "/absolute/path")
 |}]
 
 Path.is_managed (e "relative/path")
@@ -218,72 +218,83 @@ Path.is_managed (e "relative/path")
 
 Path.insert_after_build_dir_exn Path.root "foobar"
 [%%expect{|
-Exception: Stdune__Exn.Code_error <abstr>.
+Exception:
+Code_error
+ (List
+   [Atom (A "Path.insert_after_build_dir_exn");
+    List [Atom (A "path"); List [Atom (A "In_source_tree"); Atom (A ".")]];
+    List [Atom (A "insert"); Atom (A "foobar")]]).
 |}]
 
 Path.insert_after_build_dir_exn Path.build_dir "foobar"
 [%%expect{|
-- : Stdune.Path.t = (In_build_dir "foobar")
+- : Path.t = (In_build_dir "foobar")
 |}]
 
 Path.insert_after_build_dir_exn (Path.relative Path.build_dir "qux") "foobar"
 [%%expect{|
-- : Stdune.Path.t = (In_build_dir "foobar/qux")
+- : Path.t = (In_build_dir "foobar/qux")
 |}]
 
 Path.append Path.build_dir (Path.relative Path.root "foo")
 [%%expect{|
-- : Stdune.Path.t = (In_build_dir "foo")
+- : Path.t = (In_build_dir "foo")
 |}]
 
 Path.append Path.build_dir (Path.relative Path.build_dir "foo")
 [%%expect{|
-- : Stdune.Path.t = (In_build_dir "_build/foo")
+- : Path.t = (In_build_dir "_build/foo")
 |}]
 
 Path.append Path.root (Path.relative Path.build_dir "foo")
 [%%expect{|
-- : Stdune.Path.t = (In_source_tree "_build/foo")
+- : Path.t = (In_source_tree "_build/foo")
 |}]
 
 Path.append Path.root (Path.relative Path.root "foo")
 [%%expect{|
-- : Stdune.Path.t = (In_source_tree "foo")
+- : Path.t = (In_source_tree "foo")
 |}]
 
 Path.append (Path.of_string "/root") (Path.relative Path.root "foo")
 [%%expect{|
-- : Stdune.Path.t = (External "/root/foo")
+- : Path.t = (External "/root/foo")
 |}]
 
 Path.append (Path.of_string "/root") (Path.relative Path.build_dir "foo")
 [%%expect{|
-- : Stdune.Path.t = (External "/root/_build/foo")
+- : Path.t = (External "/root/_build/foo")
 |}]
 
 Path.rm_rf (Path.of_string "/does/not/exist/foo/bar/baz")
 [%%expect{|
-Exception: Stdune__Exn.Code_error <abstr>.
+Exception:
+Code_error
+ (List
+   [Quoted_string "Path.rm_rf called on external dir";
+    List
+     [Atom (A "t");
+      List [Atom (A "External"); Atom (A "/does/not/exist/foo/bar/baz")]]]).
 |}]
 
 Path.drop_build_context (Path.relative Path.build_dir "foo/bar")
 [%%expect{|
-- : Stdune.Path.t option = Some (In_source_tree "bar")
+- : Path.t option = Some (In_source_tree "bar")
 |}]
 
 Path.drop_build_context (Path.of_string "foo/bar")
 [%%expect{|
-- : Stdune.Path.t option = None
+- : Path.t option = None
 |}]
 
 Path.drop_build_context (e "/foo/bar")
 [%%expect{|
-- : Stdune.Path.t option = None
+- : Path.t option = None
 |}]
 
 Path.drop_build_context Path.build_dir
 [%%expect{|
-- : Stdune.Path.t option = None
+- : Path.t option = None
 |}]
 
 Path.is_in_build_dir Path.build_dir
@@ -320,11 +331,11 @@ Path.(reach_for_running (relative root "foo") ~from:(Path.relative root "foo"))
 
 Path.relative Path.root "_build"
 [%%expect{|
-- : Stdune.Path.t = (In_build_dir ".")
+- : Path.t = (In_build_dir ".")
 |}]
 
 (* This is not right, but kind of annoying to fix :/ *)
 Path.relative (r "foo") "../_build"
 [%%expect{|
-- : Stdune.Path.t = (In_build_dir ".")
+- : Path.t = (In_build_dir ".")
 |}]

test/unit-tests/sexp.mlt

@@ -2,24 +2,10 @@
 open Stdune;;
 open Sexp.Of_sexp;;
 
-let pp_sexp_ast =
+let print_loc ppf (_ : Sexp.Loc.t) = Format.pp_print_string ppf "<loc>";;
-  let rec subst_atoms ~f (s : Sexp.t) =
+#install_printer print_loc;;
-    match s with
-    | Atom a -> f a
-    | Quoted_string _ -> s
-    | List xs -> List (List.map ~f:(subst_atoms ~f) xs)
-  in
-  fun ppf sexp ->
-    sexp
-    |> Sexp.Ast.remove_locs
-    |> subst_atoms ~f:(fun (A s) ->
-      List [(Sexp.atom "atom"); Sexp.atom_or_quoted_string s])
-    |> Sexp.pp ppf
-;;
-
-#install_printer pp_sexp_ast;;
 [%%expect{|
-val pp_sexp_ast : Format.formatter -> Stdune.Sexp.Ast.t -> unit = <fun>
+val print_loc : Format.formatter -> Usexp.Loc.t -> unit = <fun>
 |}]
 
 Printexc.record_backtrace false;;
@@ -27,43 +13,46 @@ Printexc.record_backtrace false;;
 - : unit = ()
 |}]
 
-let sexp = Sexp.parse_string ~fname:"" ~mode:Single {|
+let sexp = lazy (Sexp.parse_string ~fname:"" ~mode:Single {|
 ((foo 1)
  (foo 2))
-|}
+|});;
+Sexp.Ast.remove_locs (Lazy.force sexp)
 [%%expect{|
-val sexp : Usexp.Ast.t = (((atom foo) (atom 1)) ((atom foo) (atom 2)))
+val sexp : ast lazy_t = <lazy>
+- : Usexp.t =
+List
+ [List [Atom (A "foo"); Atom (A "1")]; List [Atom (A "foo"); Atom (A "2")]]
 |}]
 
 let of_sexp = record (field "foo" int)
-let x = parse of_sexp Univ_map.empty sexp
+let x = parse of_sexp Univ_map.empty (Lazy.force sexp)
 [%%expect{|
-val of_sexp : int Stdune.Sexp.Of_sexp.t = <abstr>
+val of_sexp : int t = <abstr>
-Exception:
+Exception: Of_sexp (<loc>, "Field \"foo\" is present too many times", None).
-Stdune__Sexp.Of_sexp.Of_sexp (<abstr>,
- "Field \"foo\" is present too many times", None).
 |}]
 
 let of_sexp = record (multi_field "foo" int)
-let x = parse of_sexp Univ_map.empty sexp
+let x = parse of_sexp Univ_map.empty (Lazy.force sexp)
 [%%expect{|
-val of_sexp : int list Stdune.Sexp.Of_sexp.t = <abstr>
+val of_sexp : int list t = <abstr>
 val x : int list = [1; 2]
 |}]
 
-type parse_result_diff =
+type 'res parse_result_diff =
-  { jbuild : (Sexp.Ast.t list, string) result
+  { jbuild : ('res, string) result
-  ; dune   : (Sexp.Ast.t list, string) result
+  ; dune   : ('res, string) result
   }
 
-type parse_result =
+type 'res parse_result =
-  | Same of (Sexp.Ast.t list, string) result
+  | Same of ('res, string) result
-  | Different of parse_result_diff
+  | Different of 'res parse_result_diff
 
 let parse s =
   let f ~lexer =
     try
-      Ok (Sexp.parse_string ~fname:"" ~mode:Many ~lexer s)
+      Ok (Sexp.parse_string ~fname:"" ~mode:Many ~lexer s
+          |> List.map ~f:Sexp.Ast.remove_locs)
     with
     | Sexp.Parse_error e -> Error (Sexp.Parse_error.message e)
     | Invalid_argument e -> Error e
@@ -75,122 +64,294 @@ let parse s =
   else
     Same jbuild
 [%%expect{|
-type parse_result_diff = {
+type 'res parse_result_diff = {
-  jbuild : (Stdune.Sexp.Ast.t list, string) Stdune.result;
+  jbuild : ('res, string) Stdune.result;
-  dune : (Stdune.Sexp.Ast.t list, string) Stdune.result;
+  dune : ('res, string) Stdune.result;
 }
-type parse_result =
+type 'res parse_result =
-    Same of (Stdune.Sexp.Ast.t list, string) Stdune.result
+    Same of ('res, string) Stdune.result
-  | Different of parse_result_diff
+  | Different of 'res parse_result_diff
-val parse : string -> parse_result = <fun>
+val parse : string -> Usexp.t list parse_result = <fun>
 |}]
 
 parse {| # ## x##y x||y a#b|c#d copy# |}
 [%%expect{|
-- : parse_result =
+- : Usexp.t list parse_result =
 Same
  (Ok
-   [(atom #); (atom ##); (atom x##y); (atom x||y); (atom a#b|c#d);
+   [Atom (A "#"); Atom (A "##"); Atom (A "x##y"); Atom (A "x||y");
-    (atom copy#)])
+    Atom (A "a#b|c#d"); Atom (A "copy#")])
 |}]
 
 
 parse {|x #| comment |# y|}
 [%%expect{|
-- : parse_result =
+- : Usexp.t list parse_result =
 Different
- {jbuild = Ok [(atom x); (atom y)];
+ {jbuild = Ok [Atom (A "x"); Atom (A "y")];
-  dune = Ok [(atom x); (atom #|); (atom comment); (atom |#); (atom y)]}
+  dune =
+   Ok
+    [Atom (A "x"); Atom (A "#|"); Atom (A "comment"); Atom (A "|#");
+     Atom (A "y")]}
 |}]
 
 parse {|x#|y|}
 [%%expect{|
-- : parse_result =
+- : Usexp.t list parse_result =
 Different
- {jbuild = Error "jbuild atoms cannot contain #|"; dune = Ok [(atom x#|y)]}
+ {jbuild = Error "jbuild atoms cannot contain #|";
+  dune = Ok [Atom (A "x#|y")]}
 |}]
 
 parse {|x|#y|}
 [%%expect{|
-- : parse_result =
+- : Usexp.t list parse_result =
 Different
- {jbuild = Error "jbuild atoms cannot contain |#"; dune = Ok [(atom x|#y)]}
+ {jbuild = Error "jbuild atoms cannot contain |#";
+  dune = Ok [Atom (A "x|#y")]}
 |}]
 
 parse {|"\a"|}
 [%%expect{|
-- : parse_result =
+- : Usexp.t list parse_result =
-Different {jbuild = Ok ["\\a"]; dune = Error "unknown escape sequence"}
+Different
+ {jbuild = Ok [Quoted_string "\\a"]; dune = Error "unknown escape sequence"}
 |}]
 
 parse {|"\%{x}"|}
 [%%expect{|
-- : parse_result =
+- : Usexp.t list parse_result =
-Different {jbuild = Ok ["\\%{x}"]; dune = Error "unknown escape sequence"}
+Different
+ {jbuild = Ok [Quoted_string "\\%{x}"]; dune = Ok [Quoted_string "%{x}"]}
 |}]
 
 parse {|"$foo"|}
 [%%expect{|
-- : parse_result = Same (Ok ["$foo"])
+- : Usexp.t list parse_result = Same (Ok [Quoted_string "$foo"])
 |}]
 
 parse {|"%foo"|}
 [%%expect{|
-- : parse_result = Same (Ok ["%foo"])
+- : Usexp.t list parse_result = Same (Ok [Quoted_string "%foo"])
 |}]
 
 parse {|"bar%foo"|}
 [%%expect{|
-- : parse_result = Same (Ok ["bar%foo"])
+- : Usexp.t list parse_result = Same (Ok [Quoted_string "bar%foo"])
 |}]
 
 parse {|"bar$foo"|}
 [%%expect{|
-- : parse_result = Same (Ok ["bar$foo"])
+- : Usexp.t list parse_result = Same (Ok [Quoted_string "bar$foo"])
 |}]
 
 parse {|"%bar$foo%"|}
 [%%expect{|
-- : parse_result = Same (Ok ["%bar$foo%"])
+- : Usexp.t list parse_result = Same (Ok [Quoted_string "%bar$foo%"])
 |}]
 
 parse {|"$bar%foo%"|}
 [%%expect{|
-- : parse_result = Same (Ok ["$bar%foo%"])
+- : Usexp.t list parse_result = Same (Ok [Quoted_string "$bar%foo%"])
 |}]
 
 parse {|\${foo}|}
 [%%expect{|
-- : parse_result = Same (Ok [(atom \${foo})])
+- : Usexp.t list parse_result = Same (Ok [Atom (A "\\${foo}")])
 |}]
 
 parse {|\%{foo}|}
 [%%expect{|
-- : parse_result =
+- : Usexp.t list parse_result =
 Different
- {jbuild = Ok [(atom "\\%{foo}")]; dune = Error "Invalid atom character '%'"}
+ {jbuild = Ok [Atom (A "\\%{foo}")];
+  dune =
+   Ok
+    [Template
+      {quoted = false;
+       parts =
+        [Text "\\";
+         Var {loc = <loc>; name = "foo"; payload = None; syntax = Percent}];
+       loc = <loc>}]}
 |}]
 
 parse {|\$bar%foo%|}
 [%%expect{|
-- : parse_result =
+- : Usexp.t list parse_result = Same (Ok [Atom (A "\\$bar%foo%")])
-Different
- {jbuild = Ok [(atom "\\$bar%foo%")];
-  dune = Error "Invalid atom character '%'"}
 |}]
 
 parse {|\$bar\%foo%|}
 [%%expect{|
-- : parse_result =
+- : Usexp.t list parse_result = Same (Ok [Atom (A "\\$bar\\%foo%")])
-Different
- {jbuild = Ok [(atom "\\$bar\\%foo%")];
-  dune = Error "Invalid atom character '%'"}
 |}]
 
 parse {|\$bar\%foo%{bar}|}
 [%%expect{|
-- : parse_result =
+- : Usexp.t list parse_result =
 Different
- {jbuild = Ok [(atom "\\$bar\\%foo%{bar}")];
+ {jbuild = Ok [Atom (A "\\$bar\\%foo%{bar}")];
-  dune = Error "Invalid atom character '%'"}
+  dune =
+   Ok
+    [Template
+      {quoted = false;
+       parts =
+        [Text "\\$bar\\%foo";
+         Var {loc = <loc>; name = "bar"; payload = None; syntax = Percent}];
+       loc = <loc>}]}
+|}]
+
+parse {|"bar%{foo}"|}
+[%%expect{|
+- : Usexp.t list parse_result =
+Different
+ {jbuild = Ok [Quoted_string "bar%{foo}"];
+  dune =
+   Ok
+    [Template
+      {quoted = true;
+       parts =
+        [Text "bar";
+         Var {loc = <loc>; name = "foo"; payload = None; syntax = Percent}];
+       loc = <loc>}]}
+|}]
+
+parse {|"bar\%{foo}"|}
+[%%expect{|
+- : Usexp.t list parse_result =
+Different
+ {jbuild = Ok [Quoted_string "bar\\%{foo}"];
+  dune = Ok [Quoted_string "bar%{foo}"]}
+|}]
+
+parse {|bar%%{foo}|}
+[%%expect{|
+- : Usexp.t list parse_result =
+Different
+ {jbuild = Ok [Atom (A "bar%%{foo}")];
+  dune =
+   Ok
+    [Template
+      {quoted = false;
+       parts =
+        [Text "bar%";
+         Var {loc = <loc>; name = "foo"; payload = None; syntax = Percent}];
+       loc = <loc>}]}
+|}]
+
+parse {|"bar%%{foo}"|}
+[%%expect{|
+- : Usexp.t list parse_result =
+Different
+ {jbuild = Ok [Quoted_string "bar%%{foo}"];
+  dune =
+   Ok
+    [Template
+      {quoted = true;
+       parts =
+        [Text "bar%";
+         Var {loc = <loc>; name = "foo"; payload = None; syntax = Percent}];
+       loc = <loc>}]}
+|}]
+
+parse {|"bar\%foo"|}
+[%%expect{|
+- : Usexp.t list parse_result =
+Different
+ {jbuild = Ok [Quoted_string "bar\\%foo"];
+  dune = Error "unknown escape sequence"}
+|}]
+
+(* +-----------------------------------------------------------------+
+   | Printing tests                                                  |
+   +-----------------------------------------------------------------+ *)
+
+let loc = Sexp.Loc.in_file "<none>"
+let a = Sexp.atom
+let s x = Sexp.Quoted_string x
+let t  x = Sexp.Template { quoted = false; parts = x; loc }
+let tq x = Sexp.Template { quoted = true ; parts = x; loc }
+let l x = Sexp.List x
+let var ?(syntax=Sexp.Template.Percent) ?payload name =
+  { Sexp.Template.
+    loc
+  ; name
+  ; payload
+  ; syntax
+  }
+
+type sexp = S of Sexp.syntax * Sexp.t
+
+let print_sexp ppf (S (syntax, sexp)) = Sexp.pp syntax ppf sexp;;
+#install_printer print_sexp
+
+type round_trip_result =
+  | Round_trip_success
+  | Did_not_round_trip of Sexp.t
+  | Did_not_parse_back of string
+
+let test syntax sexp =
+  (S (syntax, sexp),
+   let s = Format.asprintf "%a" (Sexp.pp syntax) sexp in
+   match
+     Sexp.parse_string s ~mode:Single ~fname:""
+       ~lexer:(match syntax with
+         | Jbuild -> Sexp.Lexer.jbuild_token
+         | Dune   -> Sexp.Lexer.token)
+   with
+   | sexp' ->
+     let sexp' = Sexp.Ast.remove_locs sexp' in
+     if sexp = sexp' then
+       Round_trip_success
+     else
+       Did_not_round_trip sexp'
+   | exception (Sexp.Parse_error e) ->
+     Did_not_parse_back (Sexp.Parse_error.message e))
+;;
+#install_printer print_sexp
+
+[%%expect{|
+val loc : Usexp.Loc.t = <loc>
+val a : string -> Usexp.t = <fun>
+val s : string -> Usexp.t = <fun>
+val t : Usexp.Template.part list -> Usexp.t = <fun>
+val tq : Usexp.Template.part list -> Usexp.t = <fun>
+val l : Usexp.t list -> Usexp.t = <fun>
+val var :
+  ?syntax:Usexp.Template.var_syntax ->
+  ?payload:string -> string -> Usexp.Template.var = <fun>
+type sexp = S of Usexp.syntax * Usexp.t
+val print_sexp : Format.formatter -> sexp -> unit = <fun>
+type round_trip_result =
+    Round_trip_success
+  | Did_not_round_trip of Usexp.t
+  | Did_not_parse_back of string
+val test : Usexp.syntax -> Usexp.t -> sexp * round_trip_result = <fun>
+|}]
+
+test Dune (a "toto")
+[%%expect{|
+- : sexp * round_trip_result = (toto, Round_trip_success)
+|}]
+
+test Dune (t [Text "x%{"])
+[%%expect{|
+Exception: Invalid_argument "Invalid text \"x%{\" in unquoted template".
+|}]
+
+test Dune (t [Text "x%"; Text "{"])
+[%%expect{|
+Exception: Invalid_argument "Invalid text \"x%{\" in unquoted template".
+|}]
+
+(* This round trip failure is expected *)
+test Dune (tq [Text "x%{"])
+[%%expect{|
+- : sexp * round_trip_result =
+("x\%{", Did_not_round_trip (Quoted_string "x%{"))
+|}]
+
+test Dune (tq [Text "x%"; Text "{"])
+[%%expect{|
+- : sexp * round_trip_result =
+("x\%{", Did_not_round_trip (Quoted_string "x%{"))
 |}]

test/unit-tests/sexp_tests.ml

@@ -5,13 +5,13 @@ let () = Printexc.record_backtrace true
 (* Test that all strings of length <= 3 such that [Usexp.Atom.is_valid
    s] are recignized as atoms by the parser *)
 
-let string_of_syntax (x : Usexp.Atom.syntax) =
+let string_of_syntax (x : Usexp.syntax) =
   match x with
   | Dune -> "dune"
   | Jbuild -> "jbuild"
 
 let () =
-  [ Usexp.Atom.Dune, Usexp.Lexer.token, (fun s -> Usexp.Atom.is_valid s Dune)
+  [ Usexp.Dune, Usexp.Lexer.token, (fun s -> Usexp.Atom.is_valid s Dune)
   ; Jbuild, Usexp.Lexer.jbuild_token, (fun s -> Usexp.Atom.is_valid s Jbuild)
   ]
   |> List.iter ~f:(fun (syntax, lexer, validator) ->

test/unit-tests/tests.mlt

@@ -18,7 +18,7 @@ let print_pkg ppf pkg =
 #install_printer String_map.pp;;
 
 [%%expect{|
-val print_pkg : Format.formatter -> Dune.Findlib.Package.t -> unit = <fun>
+val print_pkg : Format.formatter -> Findlib.Package.t -> unit = <fun>
 |}]
 
 let findlib =
@@ -29,7 +29,7 @@ let findlib =
 ;;
 
 [%%expect{|
-val findlib : Dune.Findlib.t = <abstr>
+val findlib : Findlib.t = <abstr>
 |}]
 
 let pkg =
@@ -38,7 +38,7 @@ let pkg =
   | Error _ -> assert false;;
 
 [%%expect{|
-val pkg : Dune.Findlib.Package.t = <package:foo>
+val pkg : Findlib.Package.t = <package:foo>
 |}]
 
 (* "foo" should depend on "baz" *)
@@ -60,7 +60,7 @@ let meta =
   |> Meta.load ~name:"foo"
 
 [%%expect{|
-val meta : Dune.Meta.Simplified.t =
+val meta : Simplified.t =
   { name = "foo"
   ; vars =
      (requires =
@@ -89,7 +89,7 @@ let conf =
     ~toolchain:"tlc" ~context:"<context>"
 
 [%%expect{|
-val conf : Dune.Findlib.Config.t =
+val conf : Findlib.Config.t =
   { vars =
      [ (FOO_BAR, { set_rules =
                     [ { preds_required = [ "tlc"; "env" ]
@@ -104,15 +104,15 @@ val conf : Dune.Findlib.Config.t =
   }
 |}]
 
-let env_pp fmt env = Sexp.pp fmt (Env.sexp_of_t env);;
+let env_pp fmt env = Sexp.pp Dune fmt (Env.sexp_of_t env);;
 #install_printer env_pp;;
 
 [%%expect{|
-val env_pp : Format.formatter -> Dune.Env.t -> unit = <fun>
+val env_pp : Format.formatter -> Env.t -> unit = <fun>
 |}]
 
 let env = Findlib.Config.env conf
 
 [%%expect{|
-val env : Dune.Env.t = ((FOO_BAR "my variable"))
+val env : Env.t = ((FOO_BAR "my variable"))
 |}]