Merge pull request #1170 from rgrinberg/invert-sexp-stdune

Invert sexp stdune

bin/main.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Dune
 open Import
 open Cmdliner
@@ -985,11 +986,11 @@ let rules =
        in
        Build_system.build_rules setup.build_system ~request ~recursive >>= fun rules ->
        let sexp_of_action action =
-         Action.for_shell action |> Action.For_shell.sexp_of_t
+         Action.for_shell action |> Action.For_shell.dgen
        in
        let print oc =
          let ppf = Format.formatter_of_out_channel oc in
-         Sexp.prepare_formatter ppf;
+         Dsexp.prepare_formatter ppf;
          Format.pp_open_vbox ppf 0;
          if makefile_syntax then begin
            List.iter rules ~f:(fun (rule : Build_system.Rule.t) ->
@@ -1000,25 +1001,25 @@ let rules =
                (fun ppf ->
                   Path.Set.iter rule.deps ~f:(fun dep ->
                     Format.fprintf ppf "@ %s" (Path.to_string dep)))
-               Sexp.pp_split_strings (sexp_of_action rule.action))
+               Dsexp.pp_split_strings (sexp_of_action rule.action))
          end else begin
            List.iter rules ~f:(fun (rule : Build_system.Rule.t) ->
              let sexp =
                let paths ps =
-                 Sexp.To_sexp.list Path.sexp_of_t (Path.Set.to_list ps)
+                 Dsexp.To_sexp.list Path_dsexp.dgen (Path.Set.to_list ps)
                in
-               Sexp.To_sexp.record (
+               Dsexp.To_sexp.record (
                  List.concat
                    [ [ "deps"   , paths rule.deps
                      ; "targets", paths rule.targets ]
                    ; (match rule.context with
                       | None -> []
                       | Some c -> ["context",
-                                   Sexp.atom_or_quoted_string c.name])
+                                   Dsexp.atom_or_quoted_string c.name])
                    ; [ "action" , sexp_of_action rule.action ]
                    ])
              in
-             Format.fprintf ppf "%a@," Sexp.pp_split_strings sexp)
+             Format.fprintf ppf "%a@," Dsexp.pp_split_strings sexp)
          end;
          Format.pp_print_flush ppf ();
          Fiber.return ()
@@ -1472,7 +1473,7 @@ let printenv =
       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 Dune)) in
+                     (Format.pp_print_list (Dsexp.pp Dune)) in
       match l with
       | [(_, env)] ->
         Format.printf "%a@." pp env

bootstrap.ml

@@ -36,7 +36,7 @@ let dirs =
   ; "src/xdg"                , Some "Xdg"
   ; "src/ocaml-config"       , Some "Ocaml_config"
   ; "vendor/boot"            , None
-  ; "src/usexp"              , Some "Usexp"
+  ; "src/dsexp"              , Some "Dsexp"
   ; "src"                    , None
   ]
 

src/action.ml

@@ -1,5 +1,6 @@
+open! Stdune
 open Import
-open Sexp.Of_sexp
+open Dsexp.Of_sexp
 
 let ignore_loc k ~loc:_ = k
 
@@ -15,9 +16,9 @@ end
 module Diff_mode = Action_intf.Diff_mode
 
 module Make_ast
-    (Program : Sexp.Sexpable)
+    (Program : Dsexp.Sexpable)
-    (Path    : Sexp.Sexpable)
+    (Path    : Dsexp.Sexpable)
-    (String  : Sexp.Sexpable)
+    (String  : Dsexp.Sexpable)
     (Ast : Action_intf.Ast
      with type program := Program.t
      with type path    := Path.t
@@ -25,13 +26,13 @@ module Make_ast
 struct
   include Ast
 
-  let t =
+  let dparse =
-    let path = Path.t and string = String.t in
+    let path = Path.dparse and string = String.dparse in
-    Sexp.Of_sexp.fix (fun t ->
+    Dsexp.Of_sexp.fix (fun t ->
       sum
         [ "run",
-          (let%map prog = Program.t
+          (let%map prog = Program.dparse
-           and args = repeat string
+           and args = repeat String.dparse
            in
            Run (prog, args))
         ; "chdir",
@@ -129,55 +130,53 @@ struct
            Diff { optional = false; file1; file2; mode = Binary })
         ])
 
-  let rec sexp_of_t : _ -> Sexp.t =
+  let rec dgen =
-    let path = Path.sexp_of_t and string = String.sexp_of_t in
+    let open Dsexp in
+    let program = Program.dgen in
+    let string = String.dgen in
+    let path = Path.dgen in
     function
-    | Run (a, xs) -> List (Sexp.unsafe_atom_of_string "run"
+    | Run (a, xs) ->
-                           :: Program.sexp_of_t a :: List.map xs ~f:string)
+      List (atom "run" :: program a :: List.map xs ~f:string)
-    | Chdir (a, r) -> List [Sexp.unsafe_atom_of_string "chdir" ;
+    | Chdir (a, r) -> List [atom "chdir" ; path a ; dgen r]
-                            path a ; sexp_of_t r]
+    | Setenv (k, v, r) -> List [atom "setenv" ; string k ; string v ; dgen r]
-    | Setenv (k, v, r) -> List [Sexp.unsafe_atom_of_string "setenv" ;
-                                string k ; string v ; sexp_of_t r]
     | Redirect (outputs, fn, r) ->
-      List [ Sexp.atom (sprintf "with-%s-to" (Outputs.to_string outputs))
+      List [ atom (sprintf "with-%s-to" (Outputs.to_string outputs))
            ; path fn
-           ; sexp_of_t r
+           ; dgen r
            ]
     | Ignore (outputs, r) ->
-      List [ Sexp.atom (sprintf "ignore-%s" (Outputs.to_string outputs))
+      List [ atom (sprintf "ignore-%s" (Outputs.to_string outputs))
-           ; sexp_of_t r
+           ; dgen r
            ]
-    | Progn l -> List (Sexp.unsafe_atom_of_string "progn"
+    | Progn l -> List (atom "progn" :: List.map l ~f:dgen)
-                       :: List.map l ~f:sexp_of_t)
     | Echo xs ->
-      List (Sexp.unsafe_atom_of_string "echo" :: List.map xs ~f:string)
+      List (atom "echo" :: List.map xs ~f:string)
-    | Cat x -> List [Sexp.unsafe_atom_of_string "cat"; path x]
+    | Cat x -> List [atom "cat"; path x]
     | Copy (x, y) ->
-      List [Sexp.unsafe_atom_of_string "copy"; path x; path y]
+      List [atom "copy"; path x; path y]
     | Symlink (x, y) ->
-      List [Sexp.unsafe_atom_of_string "symlink"; path x; path y]
+      List [atom "symlink"; path x; path y]
     | Copy_and_add_line_directive (x, y) ->
-      List [Sexp.unsafe_atom_of_string "copy#"; path x; path y]
+      List [atom "copy#"; path x; path y]
-    | System x -> List [Sexp.unsafe_atom_of_string "system"; string x]
+    | System x -> List [atom "system"; string x]
-    | Bash   x -> List [Sexp.unsafe_atom_of_string "bash"; string x]
+    | Bash   x -> List [atom "bash"; string x]
-    | Write_file (x, y) -> List [Sexp.unsafe_atom_of_string "write-file";
+    | Write_file (x, y) -> List [atom "write-file"; path x; string y]
-                                 path x; string y]
+    | Rename (x, y) -> List [atom "rename"; path x; path y]
-    | Rename (x, y) -> List [Sexp.unsafe_atom_of_string "rename";
+    | Remove_tree x -> List [atom "remove-tree"; path x]
-                             path x; path y]
+    | Mkdir x       -> List [atom "mkdir"; path x]
-    | Remove_tree x -> List [Sexp.unsafe_atom_of_string "remove-tree"; path x]
+    | Digest_files paths -> List [atom "digest-files";
-    | Mkdir x       -> List [Sexp.unsafe_atom_of_string "mkdir"; path x]
-    | Digest_files paths -> List [Sexp.unsafe_atom_of_string "digest-files";
                                   List (List.map paths ~f:path)]
     | Diff { optional; file1; file2; mode = Binary} ->
       assert (not optional);
-      List [Sexp.unsafe_atom_of_string "cmp"; path file1; path file2]
+      List [atom "cmp"; path file1; path file2]
     | Diff { optional = false; file1; file2; mode = _ } ->
-      List [Sexp.unsafe_atom_of_string "diff"; path file1; path file2]
+      List [atom "diff"; path file1; path file2]
     | Diff { optional = true; file1; file2; mode = _ } ->
-      List [Sexp.unsafe_atom_of_string "diff?"; path file1; path file2]
+      List [atom "diff?"; path file1; path file2]
     | Merge_files_into (srcs, extras, target) ->
       List
-        [ Sexp.unsafe_atom_of_string "merge-files-into"
+        [ atom "merge-files-into"
         ; List (List.map ~f:path srcs)
         ; List (List.map ~f:string extras)
         ; path target
@@ -268,11 +267,12 @@ module Prog = struct
 
   type t = (Path.t, Not_found.t) result
 
-  let t : t Sexp.Of_sexp.t = Sexp.Of_sexp.map Path.t ~f:Result.ok
+  let dparse : t Dsexp.Of_sexp.t =
+    Dsexp.Of_sexp.map Path_dsexp.dparse ~f:Result.ok
 
-  let sexp_of_t = function
+  let dgen = function
-    | Ok s -> Path.sexp_of_t s
+    | Ok s -> Path_dsexp.dgen s
-    | Error (e : Not_found.t) -> Sexp.To_sexp.string e.program
+    | Error (e : Not_found.t) -> Dsexp.To_sexp.string e.program
 end
 
 module type Ast = Action_intf.Ast
@@ -283,13 +283,13 @@ module rec Ast : Ast = Ast
 
 module String_with_sexp = struct
   type t = string
-  let t = Sexp.Of_sexp.string
+  let dparse = Dsexp.Of_sexp.string
-  let sexp_of_t = Sexp.To_sexp.string
+  let dgen = Dsexp.To_sexp.string
 end
 
 include Make_ast
     (Prog)
-    (Path)
+    (Path_dsexp)
     (String_with_sexp)
     (Ast)
 
@@ -372,9 +372,19 @@ module Unexpanded = struct
 
   include Make_ast(String_with_vars)(String_with_vars)(String_with_vars)(Uast)
 
-  let t =
+  module Mapper = Make_mapper(Uast)(Uast)
+
+  let remove_locs =
+    let no_loc_template = String_with_vars.make_text Loc.none "" in
+    fun t ->
+      Mapper.map t ~dir:no_loc_template
+        ~f_program:(fun ~dir:_ -> String_with_vars.remove_locs)
+        ~f_path:(fun ~dir:_ -> String_with_vars.remove_locs)
+        ~f_string:(fun ~dir:_ -> String_with_vars.remove_locs)
+
+  let dparse =
     if_list
-      ~then_:t
+      ~then_:dparse
       ~else_:
         (loc >>| fun loc ->
          of_sexp_errorf
@@ -383,11 +393,11 @@ module Unexpanded = struct
 
   let check_mkdir loc path =
     if not (Path.is_managed path) then
-      Loc.fail loc
+      Errors.fail loc
         "(mkdir ...) is not supported for paths outside of the workspace:\n\
         \  %a\n"
-        (Sexp.pp Dune)
+        (Dsexp.pp Dune)
-        (List [Sexp.unsafe_atom_of_string "mkdir"; Path.sexp_of_t path])
+        (List [Dsexp.unsafe_atom_of_string "mkdir"; Path_dsexp.dgen path])
 
   module Partial = struct
     module Program = Unresolved.Program
@@ -538,7 +548,7 @@ module Unexpanded = struct
           Chdir (res, partial_expand t ~dir ~map_exe ~f)
         | Right fn ->
           let loc = String_with_vars.loc fn in
-          Loc.fail loc
+          Errors.fail loc
             "This directory cannot be evaluated statically.\n\
              This is not allowed by dune"
       end
@@ -733,7 +743,7 @@ module Infer = struct
         match fn with
         | Left  fn -> { acc with targets = Path.Set.add acc.targets fn }
         | Right sw ->
-          Loc.fail (String_with_vars.loc sw)
+          Errors.fail (String_with_vars.loc sw)
             "Cannot determine this target statically."
       let ( +< ) acc fn =
         match fn with

src/action.mli

@@ -1,3 +1,4 @@
+open! Stdune
 open! Import
 
 module Outputs : module type of struct include Action_intf.Outputs end
@@ -31,7 +32,7 @@ include Action_intf.Helpers
   with type string  := string
   with type t       := t
 
-val t : t Sexp.Of_sexp.t
+val dparse : t Dsexp.Of_sexp.t
 
 module For_shell : sig
   include Action_intf.Ast
@@ -39,7 +40,7 @@ module For_shell : sig
     with type path    := string
     with type string  := string
 
-  val sexp_of_t : t Sexp.To_sexp.t
+  val dgen : t Dsexp.To_sexp.t
 end
 
 (** Convert the action to a format suitable for printing *)
@@ -72,7 +73,7 @@ module Unexpanded : sig
     with type path    := String_with_vars.t
     with type string  := String_with_vars.t
 
-  include Sexp.Sexpable with type t := t
+  include Dsexp.Sexpable with type t := t
 
   module Partial : sig
     include Action_intf.Ast
@@ -94,6 +95,8 @@ module Unexpanded : sig
     -> map_exe:(Path.t -> Path.t)
     -> f:(Value.t list option String_with_vars.expander)
     -> Partial.t
+
+  val remove_locs : t -> t
 end
 
 (** Infer dependencies and targets.

src/action_exec.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 open Fiber.O
 

src/action_exec.mli

@@ -1,4 +1,4 @@
-open Stdune
+open! Stdune
 
 val exec
   :  targets:Path.Set.t

src/action_intf.ml

@@ -1,4 +1,4 @@
-open Stdune
+open! Stdune
 
 module Outputs = struct
   type t =

src/arg_spec.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 
 type 'a t =

src/arg_spec.mli

@@ -1,3 +1,4 @@
+open! Stdune
 (** Command line arguments specification *)
 
 (** This module implements a small DSL to specify the command line

src/artifacts.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 open Dune_file
 

src/artifacts.mli

@@ -1,3 +1,4 @@
+open! Stdune
 open! Import
 
 type t

src/bin.ml

@@ -1,4 +1,4 @@
-open Import
+open! Stdune
 
 let path_sep =
   if Sys.win32 then

src/bin.mli

@@ -1,6 +1,6 @@
 (** OCaml binaries *)
 
-open Stdune
+open! Stdune
 
 (** Character used to separate entries in [PATH] and similar
     environment variables *)

src/binary_kind.ml

@@ -1,12 +1,12 @@
-open Stdune
+open! Stdune
 
 type t =
   | Exe
   | Object
   | Shared_object
 
-let t =
+let dparse =
-  let open Sexp.Of_sexp in
+  let open Dsexp.Of_sexp in
   enum
     [ "exe"           , Exe
     ; "object"        , Object
@@ -21,7 +21,7 @@ let to_string = function
 let pp fmt t =
   Format.pp_print_string fmt (to_string t)
 
-let sexp_of_t t =
+let dgen t =
-  Sexp.unsafe_atom_of_string (to_string t)
+  Dsexp.unsafe_atom_of_string (to_string t)
 
 let all = [Exe; Object; Shared_object]

src/binary_kind.mli

@@ -1,15 +1,13 @@
 (** Linking modes for binaries *)
 
-open Stdune
+open! Stdune
 
 type t =
   | Exe
   | Object
   | Shared_object
 
-val t : t Sexp.Of_sexp.t
+include Dsexp.Sexpable with type t := t
-
-val sexp_of_t : t Sexp.To_sexp.t
 
 val all : t list
 

src/blang.ml

@@ -35,7 +35,7 @@ let rec eval_bool t ~dir ~(f : 'a expander) =
     begin match f.f ~mode:Single a with
     | _, String "true" -> true
     | _, String "false" -> false
-    | loc, _ -> Loc.fail loc "This value must be either true or false"
+    | loc, _ -> Errors.fail loc "This value must be either true or false"
     end
   | And xs -> List.for_all ~f:(eval_bool ~f ~dir) xs
   | Or xs -> List.exists ~f:(eval_bool ~f ~dir) xs

src/blang.mli

@@ -1,4 +1,4 @@
-open Stdune
+open! Stdune
 
 module Op : sig
   type t =

src/build.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 
 module Vspec = struct
@@ -59,8 +60,8 @@ module Repr = struct
     | G_evaluated l -> l
     | G_unevaluated (loc, path, _) ->
       Exn.code_error "Build.get_glob_result_exn: got unevaluated"
-        [ "loc", Loc.sexp_of_t loc
+        [ "loc", Loc.to_sexp loc
-        ; "path", Path.sexp_of_t path ]
+        ; "path", Path.to_sexp path ]
 end
 include Repr
 let repr t = t
@@ -130,7 +131,7 @@ let strings p =
 let read_sexp p syntax =
   contents p
   >>^ fun s ->
-  Usexp.parse_string s
+  Dsexp.parse_string s
     ~lexer:(File_tree.Dune_file.Kind.lexer syntax)
     ~fname:(Path.to_string p) ~mode:Single
 

src/build.mli

@@ -1,5 +1,6 @@
 (** The build arrow *)
 
+open! Stdune
 open! Import
 
 type ('a, 'b) t
@@ -95,7 +96,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 -> Usexp.syntax -> (unit, Sexp.Ast.t) t
+val read_sexp : Path.t -> Dsexp.syntax -> (unit, Dsexp.Ast.t) t
 
 (** Evaluates to [true] if the file is present on the file system or is the target of a
     rule. *)

src/build_interpret.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 open Build.Repr
 
@@ -82,11 +83,11 @@ let static_deps t ~all_targets ~file_tree =
           if Path.Set.is_empty result then begin
             match inspect_path file_tree dir with
             | None ->
-              Loc.warn loc "Directory %s doesn't exist."
+              Errors.warn loc "Directory %s doesn't exist."
                 (Path.to_string_maybe_quoted
                    (Path.drop_optional_build_context dir))
             | Some Reg ->
-              Loc.warn loc "%s is not a directory."
+              Errors.warn loc "%s is not a directory."
                 (Path.to_string_maybe_quoted
                    (Path.drop_optional_build_context dir))
             | Some Dir ->
@@ -187,7 +188,7 @@ let targets =
           match loop a [], loop b [] with
           | [], [] -> acc
           | a, b ->
-            let targets x = Path.Set.sexp_of_t (Target.paths x) in
+            let targets x = Path.Set.to_sexp (Target.paths x) in
             Exn.code_error "Build_interpret.targets: cannot have targets \
                             under a [if_file_exists]"
               [ "targets-a", targets a
@@ -219,7 +220,7 @@ module Rule = struct
       match targets with
       | [] ->
         begin match loc with
-        | Some loc -> Loc.fail loc "Rule has no targets specified"
+        | Some loc -> Errors.fail loc "Rule has no targets specified"
         | None -> Exn.code_error "Build_interpret.Rule.make: no targets" []
         end
       | x :: l ->
@@ -230,11 +231,11 @@ module Rule = struct
             match loc with
             | None ->
               Exn.code_error "rule has targets in different directories"
-                [ "targets", Sexp.To_sexp.list Path.sexp_of_t
+                [ "targets", Sexp.To_sexp.list Path.to_sexp
                                (List.map targets ~f:Target.path)
                 ]
             | Some loc ->
-              Loc.fail loc
+              Errors.fail loc
                 "Rule has targets in different directories.\nTargets:\n%s"
                 (String.concat ~sep:"\n"
                    (List.map targets ~f:(fun t ->

src/build_interpret.mli

@@ -1,3 +1,4 @@
+open! Stdune
 open! Import
 
 module Target : sig

src/build_system.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 open Fiber.O
 
@@ -233,13 +234,13 @@ module Alias0 = struct
       if not (Path.is_in_build_dir dir) || String.contains name '/' then
         Exn.code_error "Alias0.make: Invalid alias"
           [ "name", Sexp.To_sexp.string name
-          ; "dir", Path.sexp_of_t dir
+          ; "dir", Path.to_sexp dir
           ];
       { dir; name }
 
     let of_user_written_path ~loc path =
       if not (Path.is_in_build_dir path) then
-        Loc.fail loc "Invalid alias!\n\
+        Errors.fail loc "Invalid alias!\n\
                       Tried to reference path outside build dir: %S"
           (Path.to_string_maybe_quoted path);
       { dir = Path.parent_exn path
@@ -304,13 +305,13 @@ module Alias0 = struct
     match File_tree.find_dir file_tree src_dir with
     | None ->
       Build.fail { fail = fun () ->
-        Loc.fail loc "Don't know about directory %s!"
+        Errors.fail loc "Don't know about directory %s!"
           (Path.to_string_maybe_quoted src_dir) }
     | Some dir ->
       dep_rec_internal ~name:t.name ~dir ~ctx_dir
       >>^ fun is_empty ->
       if is_empty && not (is_standard t.name) then
-        Loc.fail loc
+        Errors.fail loc
           "This alias is empty.\n\
            Alias %S is not defined in %s or any of its descendants."
           t.name (Path.to_string_maybe_quoted src_dir)
@@ -461,7 +462,7 @@ let entry_point t ~f =
    | stack ->
      Exn.code_error
        "Build_system.entry_point: called inside the rule generator callback"
-       ["stack", Sexp.To_sexp.list Path.sexp_of_t stack]
+       ["stack", Sexp.To_sexp.list Path.to_sexp stack]
   );
   f ()
 
@@ -564,7 +565,7 @@ let add_spec t fn spec ~copy_source =
   | Some (File_spec.T { rule; _ }) ->
     match copy_source, rule.mode with
     | true, (Standard | Not_a_rule_stanza) ->
-      Loc.warn (Internal_rule.loc rule ~dir:(Path.parent_exn fn)
+      Errors.warn (Internal_rule.loc rule ~dir:(Path.parent_exn fn)
                   ~file_tree:t.file_tree)
         "File %s is both generated by a rule and present in the source tree.\n\
          As a result, the rule is currently ignored, however this will become an error \
@@ -686,7 +687,7 @@ let remove_old_artifacts t ~dir ~subdirs_to_keep =
 
 let no_rule_found =
   let fail fn ~loc =
-    Loc.fail_opt loc "No rule found for %s" (Utils.describe_target fn)
+    Errors.fail_opt loc "No rule found for %s" (Utils.describe_target fn)
   in
   fun t ~loc fn ->
     match Utils.analyse_target fn with
@@ -1067,7 +1068,7 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators =
               let present_targets =
                 Path.Set.diff source_files_for_targtes absent_targets
               in
-              Loc.fail
+              Errors.fail
                 (rule_loc
                    ~file_tree:t.file_tree
                    ~loc:rule.loc
@@ -1275,13 +1276,13 @@ let update_universe t =
   Utils.Cached_digest.remove universe_file;
   let n =
     if Path.exists universe_file then
-      Sexp.Of_sexp.(parse int) Univ_map.empty
+      Dsexp.Of_sexp.(parse int) Univ_map.empty
-        (Io.Sexp.load ~mode:Single universe_file) + 1
+        (Dsexp.Io.load ~mode:Single universe_file) + 1
     else
       0
   in
   make_local_dirs t (Path.Set.singleton Path.build_dir);
-  Io.write_file universe_file (Sexp.to_string ~syntax:Dune (Sexp.To_sexp.int n))
+  Io.write_file universe_file (Dsexp.to_string ~syntax:Dune (Dsexp.To_sexp.int n))
 
 let do_build t ~request =
   entry_point t ~f:(fun () ->
@@ -1535,8 +1536,8 @@ let get_collector t ~dir =
          "Build_system.get_collector called on external directory"
        else
          "Build_system.get_collector called on closed directory")
-      [ "dir", Path.sexp_of_t dir
+      [ "dir", Path.to_sexp dir
-      ; "load_dir_stack", Sexp.To_sexp.list Path.sexp_of_t t.load_dir_stack
+      ; "load_dir_stack", Sexp.To_sexp.list Path.to_sexp t.load_dir_stack
       ]
 
 let add_rule t (rule : Build_interpret.Rule.t) =
@@ -1557,7 +1558,7 @@ let prefix_rules t prefix ~f =
   | [] -> ()
   | targets ->
     Exn.code_error "Build_system.prefix_rules' prefix contains targets"
-      ["targets", Path.Set.sexp_of_t (Build_interpret.Target.paths targets)]
+      ["targets", Path.Set.to_sexp (Build_interpret.Target.paths targets)]
   end;
   let prefix =
     match t.prefix with
@@ -1620,7 +1621,7 @@ module Alias = struct
 
   let add_action build_system t ~context ~loc ?(locks=[]) ~stamp action =
     let def = get_alias_def build_system t in
-    def.actions <- { stamp = Digest.string (Sexp.to_string ~syntax:Dune stamp)
+    def.actions <- { stamp = Digest.string (Marshal.to_string stamp [])
                    ; action
                    ; locks
                    ; context

src/build_system.mli

@@ -1,5 +1,6 @@
 (** Build rules *)
 
+open! Stdune
 open! Import
 
 type t
@@ -173,7 +174,7 @@ module Alias : sig
     -> context:Context.t
     -> loc:Loc.t option
     -> ?locks:Path.t list
-    -> stamp:Sexp.t
+    -> stamp:_
     -> (unit, Action.t) Build.t
     -> unit
 end with type build_system := t

src/colors.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 
 type styles = Ansi_color.Style.t list

src/colors.mli

@@ -1,4 +1,4 @@
-open Stdune
+open! Stdune
 
 val colorize : key:string -> string -> string
 

src/compilation_context.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 
 module SC = Super_context

src/compilation_context.mli

@@ -1,5 +1,6 @@
 (** High-level API for compiling OCaml files *)
 
+open! Stdune
 open Import
 
 (** Represent a compilation context.

src/config.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open! Import
 
 let local_install_dir =
@@ -49,7 +50,7 @@ module Display = struct
       ; "quiet"    , Quiet
       ]
 
-  let t = enum all
+  let dparse = enum all
 end
 
 module Concurrency = struct
@@ -71,7 +72,7 @@ module Concurrency = struct
         else
           error
 
-  let t =
+  let dparse =
     plain_string (fun ~loc s ->
       match of_string s with
       | Error m -> of_sexp_errorf loc "%s" m
@@ -109,15 +110,15 @@ let default =
   ; concurrency = if inside_dune then Fixed 1 else Auto
   }
 
-let t =
+let dparse =
-  let%map display = field "display" Display.t ~default:default.display
+  let%map display = field "display" Display.dparse ~default:default.display
-  and concurrency = field "jobs" Concurrency.t ~default:default.concurrency
+  and concurrency = field "jobs" Concurrency.dparse ~default:default.concurrency
   in
   { display
   ; concurrency
   }
 
-let t = fields t
+let dparse = fields dparse
 
 let user_config_file =
   Path.relative (Path.of_filename_relative_to_initial_cwd Xdg.config_dir)
@@ -128,16 +129,16 @@ let () = Lang.register syntax ()
 
 let load_config_file p =
   match Which_program.t with
-  | Dune -> load p ~f:(fun _lang -> t)
+  | Dune -> load p ~f:(fun _lang -> dparse)
   | Jbuilder ->
     Io.with_lexbuf_from_file p ~f:(fun lb ->
       match Dune_lexer.maybe_first_line lb with
       | None ->
-        parse (enter t)
+        parse (enter dparse)
           (Univ_map.singleton (Syntax.key syntax) (0, 0))
-          (Io.Sexp.load p ~mode:Many_as_one ~lexer:Sexp.Lexer.jbuild_token)
+          (Dsexp.Io.load p ~mode:Many_as_one ~lexer:Dsexp.Lexer.jbuild_token)
       | Some first_line ->
-        parse_contents lb first_line ~f:(fun _lang -> t))
+        parse_contents lb first_line ~f:(fun _lang -> dparse))
 
 let load_user_config_file () =
   if Path.exists user_config_file then

src/config.mli

@@ -32,7 +32,7 @@ module Display : sig
     | Verbose  (** Display all commands fully     *)
     | Quiet    (** Only display errors            *)
 
-  val t : t Sexp.Of_sexp.t
+  val dparse : t Dsexp.Of_sexp.t
   val all : (string * t) list
 end
 
@@ -58,7 +58,7 @@ include S with type 'a field = 'a
 
 module Partial : S with type 'a field := 'a option
 
-val t : t Sexp.Of_sexp.t
+val dparse : t Dsexp.Of_sexp.t
 
 val merge : t -> Partial.t -> t
 

src/configurator/dune

@@ -3,6 +3,6 @@
 (library
  (name        configurator)
  (public_name dune.configurator)
- (libraries   stdune ocaml_config)
+ (libraries   stdune ocaml_config dsexp)
  (flags       (:standard -safe-string (:include flags/flags.sexp)))
  (preprocess  no_preprocessing))

src/configurator/v1.ml

@@ -1,4 +1,4 @@
-open Stdune
+open! Stdune
 
 let sprintf = Printf.sprintf
 let eprintf = Printf.eprintf
@@ -75,8 +75,8 @@ module Flags = struct
 
   let write_sexp fname s =
     let path = Path.in_source fname in
-    let sexp = Usexp.List (List.map s ~f:(fun s -> Usexp.Quoted_string s)) in
+    let sexp = Dsexp.List (List.map s ~f:(fun s -> Dsexp.Quoted_string s)) in
-    Io.write_file path (Usexp.to_string sexp ~syntax:Dune)
+    Io.write_file path (Dsexp.to_string sexp ~syntax:Dune)
 end
 
 module Find_in_path = struct

src/context.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 open Fiber.O
 
@@ -10,8 +11,8 @@ module Kind = struct
   end
   type t = Default | Opam of Opam.t
 
-  let sexp_of_t : t -> Sexp.t = function
+  let to_sexp : t -> Sexp.t = function
-    | Default -> Sexp.unsafe_atom_of_string "default"
+    | Default -> Sexp.To_sexp.string "default"
     | Opam o  ->
       Sexp.To_sexp.(record [ "root"  , string o.root
                            ; "switch", string o.switch
@@ -85,12 +86,12 @@ type t =
   ; which_cache             : (string, Path.t option) Hashtbl.t
   }
 
-let sexp_of_t t =
+let to_sexp t =
   let open Sexp.To_sexp in
-  let path = Path.sexp_of_t in
+  let path = Path.to_sexp in
   record
     [ "name", string t.name
-    ; "kind", Kind.sexp_of_t t.kind
+    ; "kind", Kind.to_sexp t.kind
     ; "profile", string t.profile
     ; "merlin", bool t.merlin
     ; "for_host", option string (Option.map t.for_host ~f:(fun t -> t.name))
@@ -102,16 +103,16 @@ let sexp_of_t t =
     ; "ocamlopt", option path t.ocamlopt
     ; "ocamldep", path t.ocamldep
     ; "ocamlmklib", path t.ocamlmklib
-    ; "env", Env.sexp_of_t (Env.diff t.env Env.initial)
+    ; "env", Env.to_sexp (Env.diff t.env Env.initial)
     ; "findlib_path", list path (Findlib.path t.findlib)
     ; "arch_sixtyfour", bool t.arch_sixtyfour
     ; "natdynlink_supported",
       bool (Dynlink_supported.By_the_os.get t.natdynlink_supported)
     ; "supports_shared_libraries",
       bool (Dynlink_supported.By_the_os.get t.supports_shared_libraries)
-    ; "opam_vars", string_hashtbl string t.opam_var_cache
+    ; "opam_vars", Hashtbl.to_sexp string string t.opam_var_cache
-    ; "ocaml_config", Ocaml_config.sexp_of_t t.ocaml_config
+    ; "ocaml_config", Ocaml_config.to_sexp t.ocaml_config
-    ; "which", string_hashtbl (option path) t.which_cache
+    ; "which", Hashtbl.to_sexp string (option path) t.which_cache
     ]
 
 let compare a b = compare a.name b.name
@@ -269,7 +270,7 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets
              %s"
           (Path.to_string ocamlc) msg
       | Error (Makefile_config file, msg) ->
-        Loc.fail (Loc.in_file (Path.to_string file)) "%s" msg
+        Errors.fail (Loc.in_file (Path.to_string file)) "%s" msg
     in
     Fiber.fork_and_join
       findlib_path
@@ -451,8 +452,8 @@ let create_for_opam ?root ~env ~env_nodes ~targets ~profile ~switch ~name
       ["config"; "env"; "--root"; root; "--switch"; switch; "--sexp"]
     >>= fun s ->
     let vars =
-      Usexp.parse_string ~fname:"<opam output>" ~mode:Single s
+      Dsexp.parse_string ~fname:"<opam output>" ~mode:Single s
-      |> Sexp.Of_sexp.(parse (list (pair string string)) Univ_map.empty)
+      |> Dsexp.Of_sexp.(parse (list (pair string string)) Univ_map.empty)
       |> Env.Map.of_list_multi
       |> Env.Map.mapi ~f:(fun var values ->
         match List.rev values with

src/context.mli

@@ -18,6 +18,7 @@
     it is obtained by looking in another context.
 *)
 
+open! Stdune
 open! Import
 
 module Kind : sig
@@ -127,7 +128,7 @@ type t =
   ; which_cache             : (string, Path.t option) Hashtbl.t
   }
 
-val sexp_of_t : t -> Sexp.t
+val to_sexp : t -> Sexp.t
 
 (** Compare the context names *)
 val compare : t -> t -> Ordering.t

src/dep_path.ml

@@ -1,4 +1,4 @@
-open Import
+open! Stdune
 
 module Entry = struct
   type t =
@@ -14,8 +14,8 @@ 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 ~syntax:Dune
+      Sexp.to_string
-        (List [ Sexp.unsafe_atom_of_string "pps"
+        (List [ Atom "pps"
               ; Sexp.To_sexp.(list string) l])
     | Loc loc ->
       Loc.to_file_colon_line loc

src/dep_path.mli

@@ -1,6 +1,6 @@
 (** Dependency path *)
 
-open Stdune
+open! Stdune
 
 module Entry : sig
   type t =

src/dir_contents.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 module Menhir_rules = Menhir
 open Dune_file
@@ -39,7 +40,7 @@ end = struct
           match m with
           | Ok m -> Some m
           | Error s ->
-            Loc.fail loc "Module %a doesn't exist." Module.Name.pp s)
+            Errors.fail loc "Module %a doesn't exist." Module.Name.pp s)
       , modules
       )
 
@@ -100,28 +101,28 @@ end = struct
     if missing_intf_only <> [] then begin
       match Ordered_set_lang.loc buildable.modules_without_implementation with
       | None ->
-        Loc.warn buildable.loc
+        Errors.warn buildable.loc
           "Some modules don't have an implementation.\
            \nYou need to add the following field to this stanza:\
            \n\
            \n  %s\
            \n\
            \nThis will become an error in the future."
-          (let tag = Sexp.unsafe_atom_of_string
+          (let tag = Dsexp.unsafe_atom_of_string
                        "modules_without_implementation" in
            let modules =
              missing_intf_only
              |> uncapitalized
-             |> List.map ~f:Sexp.To_sexp.string
+             |> List.map ~f:Dsexp.To_sexp.string
            in
-           Sexp.to_string ~syntax:Dune (List (tag :: modules)))
+           Dsexp.to_string ~syntax:Dune (List (tag :: modules)))
       | Some loc ->
         let list_modules l =
           uncapitalized l
           |> List.map ~f:(sprintf "- %s")
           |> String.concat ~sep:"\n"
         in
-        Loc.warn loc
+        Errors.warn loc
           "The following modules must be listed here as they don't \
            have an implementation:\n\
            %s\n\
@@ -135,7 +136,7 @@ end = struct
         |> Option.value_exn
       in
       (* CR-soon jdimino for jdimino: report all errors *)
-      Loc.fail loc
+      Errors.fail loc
         "Module %a has an implementation, it cannot be listed here"
         Module.Name.pp module_name
     end
@@ -154,7 +155,7 @@ end = struct
       )
     in
     Module.Name.Map.iteri fake_modules ~f:(fun m loc ->
-      Loc.warn loc "Module %a is excluded but it doesn't exist."
+      Errors.warn loc "Module %a is excluded but it doesn't exist."
         Module.Name.pp m
     );
     check_invalid_module_listing ~buildable:conf ~intf_only ~modules
@@ -280,8 +281,8 @@ let mlds t (doc : Documentation.t) =
   | Some x -> x
   | None ->
     Exn.code_error "Dir_contents.mlds"
-      [ "doc", Loc.sexp_of_t doc.loc
+      [ "doc", Loc.to_sexp doc.loc
-      ; "available", Sexp.To_sexp.(list Loc.sexp_of_t)
+      ; "available", Sexp.To_sexp.(list Loc.to_sexp)
                        (List.map map ~f:(fun (d, _) -> d.Documentation.loc))
       ]
 
@@ -378,7 +379,7 @@ let build_modules_map (d : Super_context.Dir_with_jbuild.t) ~modules =
     with
     | Ok x -> x
     | Error (name, _, (lib2, _)) ->
-      Loc.fail lib2.buildable.loc
+      Errors.fail lib2.buildable.loc
         "Library %S appears for the second time \
          in this directory"
         name
@@ -390,7 +391,7 @@ let build_modules_map (d : Super_context.Dir_with_jbuild.t) ~modules =
     with
     | Ok x -> x
     | Error (name, _, (exes2, _)) ->
-      Loc.fail exes2.buildable.loc
+      Errors.fail exes2.buildable.loc
         "Executable %S appears for the second time \
          in this directory"
         name
@@ -416,7 +417,7 @@ let build_modules_map (d : Super_context.Dir_with_jbuild.t) ~modules =
               Option.some_if (n = name) b.loc)
             |> List.sort ~compare
           in
-          Loc.fail (Loc.in_file (List.hd locs).start.pos_fname)
+          Errors.fail (Loc.in_file (List.hd locs).start.pos_fname)
             "Module %a is used in several stanzas:@\n\
              @[<v>%a@]@\n\
              @[%a@]"
@@ -441,7 +442,7 @@ let build_modules_map (d : Super_context.Dir_with_jbuild.t) ~modules =
             List.sort ~compare
               (b.Buildable.loc :: List.map rest ~f:(fun b -> b.Buildable.loc))
           in
-          Loc.warn (Loc.in_file b.loc.start.pos_fname)
+          Errors.warn (Loc.in_file b.loc.start.pos_fname)
             "Module %a is used in several stanzas:@\n\
              @[<v>%a@]@\n\
              @[%a@]@\n\
@@ -477,7 +478,7 @@ let build_mlds_map (d : Super_context.Dir_with_jbuild.t) ~files =
             | Some s ->
               s
             | None ->
-              Loc.fail loc "%s.mld doesn't exist in %s" s
+              Errors.fail loc "%s.mld doesn't exist in %s" s
                 (Path.to_string_maybe_quoted
                    (Path.drop_optional_build_context dir))
           )
@@ -513,7 +514,7 @@ module Dir_status = struct
       match stanza with
       | Include_subdirs (loc, x) ->
         if Option.is_some acc then
-          Loc.fail loc "The 'include_subdirs' stanza cannot appear \
+          Errors.fail loc "The 'include_subdirs' stanza cannot appear \
                         more than once";
         Some x
       | _ -> acc)
@@ -523,7 +524,7 @@ module Dir_status = struct
       match stanza with
       | Library { buildable; _} | Executables { buildable; _ }
       | Tests { exes = { buildable; _ }; _ } ->
-        Loc.fail buildable.loc
+        Errors.fail buildable.loc
           "This stanza is not allowed in a sub-directory of directory with \
            (include_subdirs unqualified).\n\
            Hint: add (include_subdirs no) to this file."
@@ -663,7 +664,7 @@ let rec get sctx ~dir =
             ~f:(fun acc (dir, files) ->
               let modules = modules_of_files ~dir ~files in
               Module.Name.Map.union acc modules ~f:(fun name x y ->
-                Loc.fail (Loc.in_file
+                Errors.fail (Loc.in_file
                             (Path.to_string
                                (match File_tree.Dir.dune_file ft_dir with
                                 | None ->

src/dir_contents.mli

@@ -4,6 +4,7 @@
     in the source tree or generated by user rules to library,
     executables, tests and documentation stanzas. *)
 
+open! Stdune
 open Import
 
 type t

src/dsexp/dsexp.ml

@@ -0,0 +1,869 @@
+open! Stdune
+
+module Atom = Atom
+module Template = Template
+
+type syntax = Atom.syntax = Jbuild | Dune
+
+type t =
+  | Atom of Atom.t
+  | Quoted_string of string
+  | List of t list
+  | Template of Template.t
+
+let atom_or_quoted_string s =
+  if Atom.is_valid_dune s then
+    Atom (Atom.of_string s)
+  else
+    Quoted_string s
+
+let atom s = Atom (Atom.of_string s)
+
+let unsafe_atom_of_string s = atom s
+
+let rec to_string t ~syntax =
+  match t with
+  | Atom a -> Atom.print a syntax
+  | Quoted_string s -> Escape.quoted s ~syntax
+  | List l ->
+    Printf.sprintf "(%s)" (List.map l ~f:(to_string ~syntax)
+                           |> String.concat ~sep:" ")
+  | Template t -> Template.to_string t ~syntax
+
+let rec pp syntax ppf = function
+  | Atom s ->
+    Format.pp_print_string ppf (Atom.print s syntax)
+  | Quoted_string 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 syntax ppf first;
+    List.iter rest ~f:(fun sexp ->
+      Format.pp_print_space ppf ();
+      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 pp_quoted =
+  let rec loop = function
+    | Atom (A s) as t ->
+      if Atom.is_valid_dune s then
+        t
+      else
+        Quoted_string s
+    | List xs -> List (List.map ~f:loop xs)
+    | (Quoted_string _ | Template _) as t -> t
+  in
+  fun ppf t -> pp Dune ppf (loop t)
+
+let pp_print_quoted_string ppf s =
+  let syntax = Dune in
+  if String.contains s '\n' then begin
+    match String.split s ~on:'\n' with
+    | [] -> Format.pp_print_string ppf (Escape.quoted ~syntax s)
+    | first :: rest ->
+       Format.fprintf ppf "@[<hv 1>\"@{<atom>%s"
+         (Escape.escaped ~syntax first);
+       List.iter rest ~f:(fun s ->
+           Format.fprintf ppf "@,\\n%s" (Escape.escaped ~syntax s));
+       Format.fprintf ppf "@}\"@]"
+  end else
+    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)
+  | Quoted_string s -> pp_print_quoted_string ppf 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_split_strings ppf first;
+    List.iter rest ~f:(fun sexp ->
+      Format.pp_print_space ppf ();
+      pp_split_strings ppf sexp);
+    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
+  | In_makefile_action
+  | In_makefile_stuff
+
+let prepare_formatter ppf =
+  let state = ref [] in
+  Format.pp_set_mark_tags ppf true;
+  let ofuncs = Format.pp_get_formatter_out_functions ppf () in
+  let tfuncs = Format.pp_get_formatter_tag_functions ppf () in
+  Format.pp_set_formatter_tag_functions ppf
+    { tfuncs with
+      mark_open_tag  = (function
+        | "atom" -> state := In_atom :: !state; ""
+        | "makefile-action" -> state := In_makefile_action :: !state; ""
+        | "makefile-stuff" -> state := In_makefile_stuff :: !state; ""
+        | s -> tfuncs.mark_open_tag s)
+    ; mark_close_tag = (function
+        | "atom" | "makefile-action" | "makefile-stuff" -> state := List.tl !state; ""
+        | s -> tfuncs.mark_close_tag s)
+    };
+  Format.pp_set_formatter_out_functions ppf
+    { ofuncs with
+      out_newline = (fun () ->
+        match !state with
+        | [In_atom; In_makefile_action] ->
+          ofuncs.out_string "\\\n\t" 0 3
+        | [In_atom] ->
+          ofuncs.out_string "\\\n" 0 2
+        | [In_makefile_action] ->
+          ofuncs.out_string " \\\n\t" 0 4
+        | [In_makefile_stuff] ->
+          ofuncs.out_string " \\\n" 0 3
+        | [] ->
+          ofuncs.out_string "\n" 0 1
+        | _ -> assert false)
+    ; out_spaces = (fun n ->
+        ofuncs.out_spaces
+          (match !state with
+           | In_atom :: _ -> max 0 (n - 2)
+           | _ -> n))
+    }
+
+module Ast = struct
+  type dsexp = t
+  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
+    | 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, _)
+          | Template { loc ; _ }) = loc
+
+  let rec remove_locs t : dsexp =
+    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)
+end
+
+let rec add_loc t ~loc : Ast.t =
+  match t with
+  | 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
+
+  let loc t : Loc.t = { start = t.start; stop = t.stop }
+  let message t = t.message
+end
+exception Parse_error = Lexer.Error
+
+module Lexer = Lexer
+
+module Parser = struct
+  let error (loc : Loc.t) message =
+    raise (Parse_error
+             { start = loc.start
+             ; stop  = loc.stop
+             ; message
+             })
+
+  module Mode = struct
+    type 'a t =
+      | Single      : Ast.t t
+      | Many        : Ast.t list t
+      | Many_as_one : Ast.t t
+
+    let make_result : type a. a t -> Lexing.lexbuf -> Ast.t list -> a
+      = fun t lexbuf sexps ->
+        match t with
+        | Single -> begin
+          match sexps with
+          | [sexp] -> sexp
+          | [] -> error (Loc.of_lexbuf lexbuf) "no s-expression found in input"
+          | _ :: sexp :: _ ->
+            error (Ast.loc sexp) "too many s-expressions found in input"
+        end
+        | Many -> sexps
+        | Many_as_one ->
+          match sexps with
+          | [] -> List (Loc.in_file lexbuf.lex_curr_p.pos_fname, [])
+          | x :: l ->
+            let last = List.fold_left l ~init:x ~f:(fun _ x -> x) in
+            let loc = { (Ast.loc x) with stop = (Ast.loc last).stop } in
+            List (loc, x :: l)
+  end
+
+  let rec loop depth lexer lexbuf acc =
+    match (lexer lexbuf : Lexer.Token.t) with
+    | Atom a ->
+      let loc = Loc.of_lexbuf lexbuf in
+      loop depth lexer lexbuf (Ast.Atom (loc, a) :: acc)
+    | Quoted_string s ->
+      let loc = Loc.of_lexbuf lexbuf in
+      loop depth lexer lexbuf (Quoted_string (loc, s) :: acc)
+    | Template t ->
+      let loc = Loc.of_lexbuf 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
+      let stop = Lexing.lexeme_end_p lexbuf in
+      loop depth lexer lexbuf (List ({ start; stop }, sexps) :: acc)
+    | Rparen ->
+      if depth = 0 then
+        error (Loc.of_lexbuf lexbuf)
+          "right parenthesis without matching left parenthesis";
+      List.rev acc
+    | Sexp_comment ->
+      let sexps =
+        let loc = Loc.of_lexbuf lexbuf in
+        match loop depth lexer lexbuf [] with
+        | _ :: sexps -> sexps
+        | [] -> error loc "s-expression missing after #;"
+      in
+      List.rev_append acc sexps
+    | Eof ->
+      if depth > 0 then
+        error (Loc.of_lexbuf lexbuf)
+          "unclosed parenthesis at end of input";
+      List.rev acc
+
+  let parse ~mode ?(lexer=Lexer.token) lexbuf =
+    loop 0 lexer lexbuf []
+    |> Mode.make_result mode lexbuf
+end
+
+let parse_string ~fname ~mode ?lexer str =
+  let lb = Lexing.from_string str in
+  lb.lex_curr_p <-
+    { pos_fname = fname
+    ; pos_lnum  = 1
+    ; pos_bol   = 0
+    ; pos_cnum  = 0
+    };
+  Parser.parse ~mode ?lexer lb
+
+type dsexp = t
+
+module To_sexp = struct
+  type nonrec 'a t = 'a -> t
+  let unit () = List []
+  let string = atom_or_quoted_string
+  let int n = Atom (Atom.of_int n)
+  let float f = Atom (Atom.of_float f)
+  let bool b = Atom (Atom.of_bool b)
+  let pair fa fb (a, b) = List [fa a; fb b]
+  let triple fa fb fc (a, b, c) = List [fa a; fb b; fc c]
+  let list f l = List (List.map l ~f)
+  let array f a = list f (Array.to_list a)
+  let option f = function
+    | None -> List []
+    | Some x -> List [f x]
+  let record l =
+    List (List.map l ~f:(fun (n, v) -> List [Atom(Atom.of_string n); v]))
+
+  type field = string * dsexp option
+
+  let field name f ?(equal=(=)) ?default v =
+    match default with
+    | None -> (name, Some (f v))
+    | Some d ->
+      if equal d v then
+        (name, None)
+      else
+        (name, Some (f v))
+  let field_o name f v = (name, Option.map ~f v)
+
+  let record_fields (l : field list) =
+    List (List.filter_map l ~f:(fun (k, v) ->
+      Option.map v ~f:(fun v -> List[Atom (Atom.of_string k); v])))
+
+  let unknown _ = unsafe_atom_of_string "<unknown>"
+end
+
+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 =
+    { on: string
+    ; candidates: string list
+    }
+
+  exception Of_sexp of Loc.t * string * hint option
+
+  let of_sexp_error ?hint loc msg =
+    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
+    ; entry  : Ast.t
+    ; prev   : unparsed_field option (* Previous occurrence of this field *)
+    }
+
+  module Name = struct
+    type t = string
+    let compare a b =
+      let alen = String.length a and blen = String.length b in
+      match Int.compare alen blen with
+      | Eq -> String.compare a b
+      | ne -> ne
+  end
+
+  module Name_map = Map.Make(Name)
+
+  type values = Ast.t list
+  type fields =
+    { unparsed : unparsed_field Name_map.t
+    ; known    : string list
+    }
+
+  (* Arguments are:
+
+     - the location of the whole list
+     - the first atom when parsing a constructor or a field
+     - the universal map holding the user context
+  *)
+  type 'kind context =
+    | Values : Loc.t * string option * Univ_map.t -> values context
+    | Fields : Loc.t * string option * Univ_map.t -> fields context
+
+  type ('a, 'kind) parser =  'kind context -> 'kind -> 'a * 'kind
+
+  type 'a t             = ('a, values) parser
+  type 'a fields_parser = ('a, fields) parser
+
+  let return x _ctx state = (x, state)
+  let (>>=) t f ctx state =
+    let x, state = t ctx state in
+    f x ctx state
+  let (>>|) t f ctx state =
+    let x, state = t ctx state in
+    (f x, state)
+  let (>>>) a b ctx state =
+    let (), state = a ctx state in
+    b ctx state
+  let map t ~f = t >>| f
+
+  let try_ t f ctx state =
+    try
+      t ctx state
+    with exn ->
+      f exn ctx state
+
+  let get_user_context : type k. k context -> Univ_map.t = function
+    | Values (_, _, uc) -> uc
+    | Fields (_, _, uc) -> uc
+
+  let get key ctx state = (Univ_map.find (get_user_context ctx) key, state)
+  let get_all 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
+      | Values (loc, cstr, uc) ->
+        t (Values (loc, cstr, Univ_map.add uc key v)) state
+      | Fields (loc, cstr, uc) ->
+        t (Fields (loc, cstr, Univ_map.add uc key v)) state
+
+  let set_many : type a k. Univ_map.t -> (a, k) parser -> (a, k) parser
+    = fun map t ctx state ->
+      match ctx with
+      | Values (loc, cstr, uc) ->
+        t (Values (loc, cstr, Univ_map.superpose uc map)) state
+      | Fields (loc, cstr, uc) ->
+        t (Fields (loc, cstr, Univ_map.superpose uc map)) state
+
+  let loc : type k. k context -> k -> Loc.t * k = fun ctx state ->
+    match ctx with
+    | Values (loc, _, _) -> (loc, state)
+    | Fields (loc, _, _) -> (loc, state)
+
+  let at_eos : type k. k context -> k -> bool = fun ctx state ->
+    match ctx with
+    | Values _ -> state = []
+    | Fields _ -> Name_map.is_empty state.unparsed
+
+  let eos ctx state = (at_eos ctx state, state)
+
+  let if_eos ~then_ ~else_ ctx state =
+    if at_eos ctx state then
+      then_ ctx state
+    else
+      else_ ctx state
+
+  let repeat : 'a t -> 'a list t =
+    let rec loop t acc ctx l =
+      match l with
+      | [] -> (List.rev acc, [])
+      | _ ->
+        let x, l = t ctx l in
+        loop t (x :: acc) ctx l
+    in
+    fun t ctx state -> loop t [] ctx state
+
+  let result : type a k. k context -> a * k -> a =
+    fun ctx (v, state) ->
+      match ctx with
+      | Values (_, cstr, _) -> begin
+          match state with
+          | [] -> v
+          | sexp :: _ ->
+            match cstr with
+            | None ->
+              of_sexp_errorf (Ast.loc sexp) "This value is unused"
+            | Some s ->
+              of_sexp_errorf (Ast.loc sexp) "Too many argument for %s" s
+        end
+      | Fields _ -> begin
+          match Name_map.choose state.unparsed with
+          | None -> v
+          | Some (name, { entry; _ }) ->
+            let name_loc =
+              match entry with
+              | List (_, s :: _) -> Ast.loc s
+              | _ -> assert false
+            in
+            of_sexp_errorf ~hint:{ on = name; candidates = state.known }
+              name_loc "Unknown field %s" name
+        end
+
+  let parse t context sexp =
+    let ctx = Values (Ast.loc sexp, None, context) in
+    result ctx (t ctx [sexp])
+
+  let capture ctx state =
+    let f t =
+      result ctx (t ctx state)
+    in
+    (f, [])
+
+  let end_of_list (Values (loc, cstr, _)) =
+    match cstr with
+    | None ->
+      let loc = { loc with start = loc.stop } in
+      of_sexp_errorf loc "Premature end of list"
+    | Some s ->
+      of_sexp_errorf loc "Not enough arguments for %s" s
+  [@@inline never]
+
+  let next f ctx sexps =
+    match sexps with
+    | [] -> end_of_list ctx
+    | sexp :: sexps -> (f sexp, sexps)
+  [@@inline always]
+
+  let next_with_user_context f ctx sexps =
+    match sexps with
+    | [] -> end_of_list ctx
+    | sexp :: sexps -> (f (get_user_context ctx) sexp, sexps)
+  [@@inline always]
+
+  let peek _ctx sexps =
+    match sexps with
+    | [] -> (None, sexps)
+    | sexp :: _ -> (Some sexp, sexps)
+  [@@inline always]
+
+  let peek_exn ctx sexps =
+    match sexps with
+    | [] -> end_of_list ctx
+    | sexp :: _ -> (sexp, sexps)
+  [@@inline always]
+
+  let junk = next ignore
+
+  let junk_everything : type k. (unit, k) parser = fun ctx state ->
+    match ctx with
+    | Values _ -> ((), [])
+    | Fields _ -> ((), { state with unparsed = Name_map.empty })
+
+  let keyword kwd =
+    next (function
+      | Atom (_, s) when Atom.to_string s = kwd -> ()
+      | sexp -> of_sexp_errorf (Ast.loc sexp) "'%s' expected" kwd)
+
+  let match_keyword l ~fallback =
+    peek >>= function
+    | Some (Atom (_, A s)) -> begin
+        match List.assoc l s with
+        | Some t -> junk >>> t
+        | None -> fallback
+      end
+    | _ -> fallback
+
+  let until_keyword kwd ~before ~after =
+    let rec loop acc =
+      peek >>= function
+      | None -> return (List.rev acc, None)
+      | Some (Atom (_, A s)) when s = kwd ->
+        junk >>> after >>= fun x ->
+        return (List.rev acc, Some x)
+      | _ ->
+        before >>= fun x ->
+        loop (x :: acc)
+    in
+    loop []
+
+  let plain_string f =
+    next (function
+      | Atom (loc, A s) | Quoted_string (loc, s) -> f ~loc s
+      | Template { loc ; _ } | List (loc, _) ->
+        of_sexp_error loc "Atom or quoted string expected")
+
+  let enter t =
+    next_with_user_context (fun uc sexp ->
+      match sexp with
+      | List (loc, l) ->
+        let ctx = Values (loc, None, uc) in
+        result ctx (t ctx l)
+      | sexp ->
+        of_sexp_error (Ast.loc sexp) "List expected")
+
+  let if_list ~then_ ~else_ =
+    peek_exn >>= function
+    | List _ -> then_
+    | _ -> else_
+
+  let if_paren_colon_form ~then_ ~else_ =
+    peek_exn >>= function
+    | List (_, Atom (loc, A s) :: _) when String.is_prefix s ~prefix:":" ->
+      let name = String.sub s ~pos:1 ~len:(String.length s - 1) in
+      enter
+        (junk >>= fun () ->
+         then_ >>| fun f ->
+         f (loc, name))
+    | _ ->
+      else_
+
+  let fix f =
+    let rec p = lazy (f r)
+    and r ast = (Lazy.force p) ast in
+    r
+
+  let loc_between_states : type k. k context -> k -> k -> Loc.t
+    = fun ctx state1 state2 ->
+      match ctx with
+      | Values _ -> begin
+          match state1 with
+          | sexp :: rest when rest == state2 -> (* common case *)
+            Ast.loc sexp
+          | [] ->
+            let (Values (loc, _, _)) = ctx in
+            { loc with start = loc.stop }
+          | sexp :: rest ->
+            let loc = Ast.loc sexp in
+            let rec search last l =
+              if l == state2 then
+                { loc with stop = (Ast.loc last).stop }
+              else
+                match l with
+                | [] ->
+                  let (Values (loc, _, _)) = ctx in
+                  { (Ast.loc sexp) with stop = loc.stop }
+                | sexp :: rest ->
+                  search sexp rest
+            in
+            search sexp rest
+        end
+      | Fields _ ->
+        let parsed =
+          Name_map.merge state1.unparsed state2.unparsed
+            ~f:(fun _key before after ->
+              match before, after with
+              | Some _, None -> before
+              | _ -> None)
+        in
+        match
+          Name_map.values parsed
+          |> List.map ~f:(fun f -> Ast.loc f.entry)
+          |> List.sort ~compare:(fun a b ->
+            Int.compare a.Loc.start.pos_cnum b.start.pos_cnum)
+        with
+        | [] ->
+          let (Fields (loc, _, _)) = ctx in
+          loc
+        | first :: l ->
+          let last = List.fold_left l ~init:first ~f:(fun _ x -> x) in
+          { first with stop = last.stop }
+
+  let located t ctx state1 =
+    let x, state2 = t ctx state1 in
+    ((loc_between_states ctx state1 state2, x), state2)
+
+  let raw = next (fun x -> x)
+
+  let unit =
+    next
+      (function
+        | List (_, []) -> ()
+        | sexp -> of_sexp_error (Ast.loc sexp) "() expected")
+
+  let basic desc f =
+    next (function
+      | Template { loc; _ } | List (loc, _) | Quoted_string (loc, _) ->
+        of_sexp_errorf loc "%s expected" desc
+      | Atom (loc, s)  ->
+        match f (Atom.to_string s) with
+        | Result.Error () ->
+          of_sexp_errorf loc "%s expected" desc
+        | Ok x -> x)
+
+  let string = plain_string (fun ~loc:_ x -> x)
+  let int =
+    basic "Integer" (fun s ->
+      match int_of_string s with
+      | x -> Ok x
+      | exception _ -> Result.Error ())
+
+  let float =
+    basic "Float" (fun s ->
+      match float_of_string s with
+      | x -> Ok x
+      | exception _ -> Result.Error ())
+
+  let pair a b =
+    enter
+      (a >>= fun a ->
+       b >>= fun b ->
+       return (a, b))
+
+  let triple a b c =
+    enter
+      (a >>= fun a ->
+       b >>= fun b ->
+       c >>= fun c ->
+       return (a, b, c))
+
+  let list t = enter (repeat t)
+
+  let array t = list t >>| Array.of_list
+
+  let option t =
+    enter
+      (eos >>= function
+       | true -> return None
+       | false -> t >>| Option.some)
+
+  let find_cstr cstrs loc name ctx values =
+    match List.assoc cstrs name with
+    | Some t ->
+      result ctx (t ctx values)
+    | None ->
+      of_sexp_errorf loc
+        ~hint:{ on         = name
+              ; candidates = List.map cstrs ~f:fst
+              }
+        "Unknown constructor %s" name
+
+  let sum cstrs =
+    next_with_user_context (fun uc sexp ->
+      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, _) | 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)
+
+  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
+        | Some value -> value
+        | None ->
+          of_sexp_errorf loc
+            ~hint:{ on         = s
+                  ; candidates = List.map cstrs ~f:fst
+                  }
+            "Unknown value %s" s)
+
+  let bool = enum [ ("true", true); ("false", false) ]
+
+  let consume name state =
+    { unparsed = Name_map.remove state.unparsed name
+    ; known    = name :: state.known
+    }
+
+  let add_known name state =
+    { state with known = name :: state.known }
+
+  let map_validate t ~f ctx state1 =
+    let x, state2 = t ctx state1 in
+    match f x with
+    | Result.Ok x -> (x, state2)
+    | Error msg ->
+      let loc = loc_between_states ctx state1 state2 in
+      of_sexp_errorf loc "%s" msg
+
+  let field_missing loc name =
+    of_sexp_errorf loc "field %s missing" name
+  [@@inline never]
+
+  let field_present_too_many_times _ name entries =
+    match entries with
+    | _ :: second :: _ ->
+      of_sexp_errorf (Ast.loc second) "Field %S is present too many times"
+        name
+    | _ -> assert false
+
+  let multiple_occurrences ?(on_dup=field_present_too_many_times) uc name last =
+    let rec collect acc x =
+      let acc = x.entry :: acc in
+      match x.prev with
+      | None -> acc
+      | Some prev -> collect acc prev
+    in
+    on_dup uc name (collect [] last)
+  [@@inline never]
+
+  let find_single ?on_dup uc state name =
+    let res = Name_map.find state.unparsed name in
+    (match res with
+     | Some ({ prev = Some _; _ } as last) ->
+       multiple_occurrences uc name last ?on_dup
+     | _ -> ());
+    res
+
+  let field name ?default ?on_dup t (Fields (loc, _, uc)) state =
+    match find_single uc state name ?on_dup  with
+    | Some { values; entry; _ } ->
+      let ctx = Values (Ast.loc entry, Some name, uc) in
+      let x = result ctx (t ctx values) in
+      (x, consume name state)
+    | None ->
+      match default with
+      | Some v -> (v, add_known name state)
+      | None -> field_missing loc name
+
+  let field_o name ?on_dup t (Fields (_, _, uc)) state =
+    match find_single uc state name ?on_dup with
+    | Some { values; entry; _ } ->
+      let ctx = Values (Ast.loc entry, Some name, uc) in
+      let x = result ctx (t ctx values) in
+      (Some x, consume name state)
+    | None ->
+      (None, add_known name state)
+
+  let field_b ?check ?on_dup name =
+    field name ~default:false ?on_dup
+      (Option.value check ~default:(return ()) >>= fun () ->
+       eos >>= function
+       | true -> return true
+       | _ -> bool)
+
+  let multi_field name t (Fields (_, _, uc)) state =
+    let rec loop acc field =
+      match field with
+      | None -> acc
+      | Some { values; prev; entry } ->
+        let ctx = Values (Ast.loc entry, Some name, uc) in
+        let x = result ctx (t ctx values) in
+        loop (x :: acc) prev
+    in
+    let res = loop [] (Name_map.find state.unparsed name) in
+    (res, consume name state)
+
+  let fields t (Values (loc, cstr, uc)) sexps =
+    let unparsed =
+      List.fold_left sexps ~init:Name_map.empty ~f:(fun acc sexp ->
+        match sexp with
+        | List (_, name_sexp :: values) -> begin
+            match name_sexp with
+            | Atom (_, A name) ->
+              Name_map.add acc name
+                { values
+                ; entry = sexp
+                ; prev  = Name_map.find acc name
+                }
+            | List (loc, _) | Quoted_string (loc, _) | Template { loc; _ } ->
+              of_sexp_error loc "Atom expected"
+          end
+        | _ ->
+          of_sexp_error (Ast.loc sexp)
+            "S-expression of the form (<name> <values>...) expected")
+    in
+    let ctx = Fields (loc, cstr, uc) in
+    let x = result ctx (t ctx { unparsed; known = [] }) in
+    (x, [])
+
+  let record t = enter (fields t)
+
+  type kind =
+    | Values of Loc.t * string option
+    | Fields of Loc.t * string option
+
+  let kind : type k. k context -> k -> kind * k
+    = fun ctx state ->
+      match ctx with
+      | Values (loc, cstr, _) -> (Values (loc, cstr), state)
+      | Fields (loc, cstr, _) -> (Fields (loc, cstr), state)
+
+  module Let_syntax = struct
+    let ( $ ) f t =
+      f >>= fun f ->
+      t >>| fun t ->
+      f t
+    let const = return
+  end
+end
+
+module type Sexpable = sig
+  type t
+  val dparse : t Of_sexp.t
+  val dgen : t To_sexp.t
+end
+
+let rec to_sexp = function
+  | Atom (A a) -> Sexp.Atom a
+  | List s -> List (List.map s ~f:to_sexp)
+  | Quoted_string s -> Sexp.Atom s
+  | Template t ->
+    List
+      [ Atom "template"
+      ; Atom (Template.to_string ~syntax:Dune t)
+      ]
+
+module Io = struct
+  let load ?lexer path ~mode =
+    Io.with_lexbuf_from_file path ~f:(Parser.parse ~mode ?lexer)
+end

src/dsexp/dsexp.mli

@@ -0,0 +1,410 @@
+open! Stdune
+(** Parsing of s-expressions.
+
+    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]
+
+  val is_valid : t -> syntax -> bool
+
+  val of_string : string -> t
+  val to_string : t -> string
+
+  val of_int : int -> t
+  val of_float : float -> t
+  val of_bool : bool -> t
+  val of_int64 : Int64.t -> t
+  val of_digest : Digest.t -> 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
+
+  val to_string : t -> syntax:syntax -> string
+
+  val remove_locs : t -> t
+end
+
+(** The S-expression type *)
+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.
+    @raise Invalid_argument if [s] does not satisfy [Atom.is_valid s]. *)
+
+val atom_or_quoted_string : string -> t
+
+val unsafe_atom_of_string : string -> t
+
+(** Serialize a S-expression *)
+val to_string : t -> syntax:syntax -> string
+
+(** Serialize a S-expression using indentation to improve readability *)
+val pp : syntax -> Format.formatter -> t -> unit
+
+(** Serialization that never fails because it quotes atoms when necessary
+    TODO remove this once we have a proper sexp type *)
+val pp_quoted : Format.formatter -> t -> unit
+
+(** Same as [pp ~syntax:Dune], but split long strings. The 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
+    formatter escape newlines when the tags "makefile-action" or
+    "makefile-stuff" are active. *)
+val prepare_formatter : Format.formatter -> unit
+
+(** Abstract syntax tree *)
+module Ast : sig
+  type sexp = t
+  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
+
+  val loc : t -> Loc.t
+
+  val remove_locs : t -> sexp
+end with type sexp := t
+
+val add_loc : t -> loc:Loc.t -> Ast.t
+
+module Parse_error : sig
+  type t
+
+  val loc     : t -> Loc.t
+  val message : t -> string
+end
+
+(** Exception raised in case of a parsing error *)
+exception Parse_error of Parse_error.t
+
+module Lexer : sig
+  module Token : sig
+    type t =
+      | Atom          of Atom.t
+      | Quoted_string of string
+      | Lparen
+      | Rparen
+      | Sexp_comment
+      | Eof
+      | Template of Template.t
+  end
+
+  type t = Lexing.lexbuf -> Token.t
+
+  val token : t
+  val jbuild_token : t
+end
+
+module Parser : sig
+  module Mode : sig
+    type 'a t =
+      | Single      : Ast.t t
+      | Many        : Ast.t list t
+      | Many_as_one : Ast.t t
+  end
+
+  val parse
+    :  mode:'a Mode.t
+    -> ?lexer:Lexer.t
+    -> Lexing.lexbuf
+    -> 'a
+end
+
+val parse_string
+  :  fname:string
+  -> mode:'a Parser.Mode.t
+  -> ?lexer:Lexer.t
+  -> string
+  -> 'a
+
+module To_sexp : sig
+  type sexp = t
+  include Sexp_intf.Combinators with type 'a t = 'a -> t
+
+  val record : (string * sexp) list -> sexp
+
+  type field
+
+  val field
+    :  string
+    -> 'a t
+    -> ?equal:('a -> 'a -> bool)
+    -> ?default:'a
+    -> 'a
+    -> field
+  val field_o : string -> 'a t-> 'a option -> field
+
+  val record_fields : field list t
+
+  val unknown : _ t
+end with type sexp := t
+
+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 =
+    { on: string
+    ; candidates: string list
+    }
+
+  exception Of_sexp of Loc.t * string * hint option
+
+  (** Monad producing a value of type ['a] by parsing an input
+      composed of a sequence of S-expressions.
+
+      The input can be seen either as a plain sequence of
+      S-expressions or a list of fields. The ['kind] parameter
+      indicates how the input is seen:
+
+      - with {['kind = [values]]}, the input is seen as an ordered
+      sequence of S-expressions
+
+      - with {['kind = [fields]]}, the input is seen as an unordered
+      sequence of fields
+
+      A field is a S-expression of the form: [(<atom> <values>...)]
+      where [atom] is a plain atom, i.e. not a quoted string and not
+      containing variables. [values] is a sequence of zero, one or more
+      S-expressions.
+
+      It is possible to switch between the two mode at any time using
+      the appropriate combinator. Some primitives can be used in both
+      mode while some are specific to one mode.  *)
+  type ('a, 'kind) parser
+
+  type values
+  type fields
+
+  type 'a t             = ('a, values) parser
+  type 'a fields_parser = ('a, fields) parser
+
+  (** [parse parser context sexp] parse a S-expression using the
+      following parser. The input consist of a single
+      S-expression. [context] allows to pass extra information such as
+      versions to individual parsers. *)
+  val parse : 'a t -> Univ_map.t -> ast -> 'a
+
+  val return : 'a -> ('a, _) parser
+  val (>>=) : ('a, 'k) parser -> ('a -> ('b, 'k) parser) -> ('b, 'k) parser
+  val (>>|) : ('a, 'k) parser -> ('a -> 'b) -> ('b, 'k) parser
+  val (>>>) : (unit, 'k) parser -> ('a, 'k) parser -> ('a, 'k) parser
+  val map : ('a, 'k) parser -> f:('a -> 'b) -> ('b, 'k) parser
+  val try_ : ('a, 'k) parser -> (exn -> ('a, 'k) parser) -> ('a, 'k) parser
+
+  (** Access to the context *)
+  val get : 'a Univ_map.Key.t -> ('a option, _) parser
+  val set : 'a Univ_map.Key.t -> 'a -> ('b, 'k) parser -> ('b, 'k) parser
+  val get_all : (Univ_map.t, _) parser
+  val set_many : Univ_map.t -> ('a, 'k) parser -> ('a, 'k) parser
+
+  (** Return the location of the list currently being parsed. *)
+  val loc : (Loc.t, _) parser
+
+  (** End of sequence condition. Uses [then_] if there are no more
+      S-expressions to parse, [else_] otherwise. *)
+  val if_eos : then_:('a, 'b) parser -> else_:('a, 'b) parser -> ('a, 'b) parser
+
+  (** If the next element of the sequence is a list, parse it with
+      [then_], otherwise parse it with [else_]. *)
+  val if_list
+    :  then_:'a t
+    -> else_:'a t
+    -> 'a t
+
+  (** If the next element of the sequence is of the form [(:<name>
+      ...)], use [then_] to parse [...]. Otherwise use [else_]. *)
+  val if_paren_colon_form
+    :  then_:(Loc.t * string -> 'a) t
+    -> else_:'a t
+    -> 'a t
+
+  (** Expect the next element to be the following atom. *)
+  val keyword : string -> unit t
+
+  (** {[match_keyword [(k1, t1); (k2, t2); ...] ~fallback]} inspects
+     the next element of the input sequence. If it is an atom equal to
+     one of [k1], [k2], ... then the corresponding parser is used to
+     parse the rest of the sequence. Other [fallback] is used. *)
+  val match_keyword
+    :  (string * 'a t) list
+    -> fallback:'a t
+    -> 'a t
+
+  (** Use [before] to parse elements until the keyword is
+      reached. Then use [after] to parse the rest. *)
+  val until_keyword
+    :  string
+    -> before:'a t
+    -> after:'b t
+    -> ('a list * 'b option) t
+
+  (** What is currently being parsed. The second argument is the atom
+      at the beginnig of the list when inside a [sum ...] or [field
+      ...]. *)
+  type kind =
+    | Values of Loc.t * string option
+    | Fields of Loc.t * string option
+  val kind : (kind, _) parser
+
+  (** [repeat t] use [t] to consume all remaning elements of the input
+      until the end of sequence is reached. *)
+  val repeat : 'a t -> 'a list t
+
+  (** Capture the rest of the input for later parsing *)
+  val capture : ('a t -> 'a) t
+
+  (** [enter t] expect the next element of the input to be a list and
+      parse its contents with [t]. *)
+  val enter : 'a t -> 'a t
+
+  (** [fields fp] converts the rest of the current input to a list of
+      fields and parse them with [fp]. This operation fails if one the
+      S-expression in the input is not of the form [(<atom>
+      <values>...)] *)
+  val fields : 'a fields_parser -> 'a t
+
+  (** [record fp = enter (fields fp)] *)
+  val record : 'a fields_parser -> 'a t
+
+  (** Consume the next element of the input as a string, int, char, ... *)
+  include Sexp_intf.Combinators with type 'a t := 'a t
+
+  (** Unparsed next element of the input *)
+  val raw : ast t
+
+  (** Inspect the next element of the input without consuming it *)
+  val peek : ast option t
+
+  (** Same as [peek] but fail if the end of input is reached *)
+  val peek_exn : ast t
+
+  (** Consume and ignore the next element of the input *)
+  val junk : unit t
+
+  (** Ignore all the rest of the input *)
+  val junk_everything : (unit, _) parser
+
+  (** [plain_string f] expects the next element of the input to be a
+      plain string, i.e. either an atom or a quoted string, but not a
+      template nor a list. *)
+  val plain_string : (loc:Loc.t -> string -> 'a) -> 'a t
+
+  val fix : ('a t -> 'a t) -> 'a t
+
+  val of_sexp_error
+    :  ?hint:hint
+    -> Loc.t
+    -> string
+    -> _
+  val of_sexp_errorf
+    :  ?hint:hint
+    -> Loc.t
+    -> ('a, unit, string, 'b) format4
+    -> 'a
+
+  val no_templates
+    : ?hint:hint
+    -> Loc.t
+    -> ('a, unit, string, 'b) format4
+    -> 'a
+
+  val located : ('a, 'k) parser -> (Loc.t * 'a, 'k) parser
+
+  val enum : (string * 'a) list -> 'a t
+
+  (** Parser that parse a S-expression of the form [(<atom> <s-exp1>
+      <s-exp2> ...)] or [<atom>]. [<atom>] is looked up in the list and
+      the remaining s-expressions are parsed using the corresponding
+      list parser. *)
+  val sum : (string * 'a t) list -> 'a t
+
+  (** Check the result of a list parser, and raise a properly located
+      error in case of failure. *)
+  val map_validate
+    :  'a fields_parser
+    -> f:('a -> ('b, string) Result.t)
+    -> 'b fields_parser
+
+  (** {3 Parsing record fields} *)
+
+  val field
+    :  string
+    -> ?default:'a
+    -> ?on_dup:(Univ_map.t -> string -> Ast.t list -> unit)
+    -> 'a t
+    -> 'a fields_parser
+  val field_o
+    :  string
+    -> ?on_dup:(Univ_map.t -> string -> Ast.t list -> unit)
+    -> 'a t
+    -> 'a option fields_parser
+
+  val field_b
+    :  ?check:(unit t)
+    -> ?on_dup:(Univ_map.t -> string -> Ast.t list -> unit)
+    -> string
+    -> bool fields_parser
+
+  (** A field that can appear multiple times *)
+  val multi_field
+    :  string
+    -> 'a t
+    -> 'a list fields_parser
+
+  (** Default value for [on_dup]. It fails with an appropriate error
+      message. *)
+  val field_present_too_many_times : Univ_map.t -> string -> Ast.t list -> _
+
+  module Let_syntax : sig
+    val ( $ ) : ('a -> 'b, 'k) parser -> ('a, 'k) parser -> ('b, 'k) parser
+    val const : 'a -> ('a, _) parser
+  end
+end
+
+module type Sexpable = sig
+  type t
+  val dparse : t Of_sexp.t
+  val dgen : t To_sexp.t
+end
+
+val to_sexp : t Sexp.To_sexp.t
+
+module Io : sig
+  val load : ?lexer:Lexer.t -> Path.t -> mode:'a Parser.Mode.t -> 'a
+end

src/dsexp/dune

@@ -1,6 +1,7 @@
 (library
- (name usexp)
+ (name dsexp)
  (synopsis "[Internal] S-expression library")
- (public_name dune._usexp))
+ (libraries stdune)
+ (public_name dune._dsexp))
 
 (ocamllex dune_lexer jbuild_lexer)

src/dsexp/dune_lexer.mll

@@ -1,4 +1,5 @@
 {
+open! Stdune
 open Lexer_shared
 
 type block_string_line_kind =

src/dsexp/escape.ml

@@ -1,4 +1,4 @@
-open Import
+open! Stdune
 
 let quote_length s ~syntax =
   let n = ref 0 in

src/dsexp/template.ml

@@ -1,4 +1,4 @@
-open Import
+open! Stdune
 
 include Types.Template
 
@@ -76,7 +76,7 @@ let pp_split_strings ppf (t : t) =
       | Var s ->
         Format.pp_print_string ppf (string_of_var s)
       | Text s ->
-        begin match String.split_on_char s ~on:'\n' with
+        begin match String.split s ~on:'\n' with
         | [] -> assert false
         | [s] -> Format.pp_print_string ppf (Escape.escaped ~syntax s)
         | split ->

src/dsexp/template.mli

@@ -1,3 +1,5 @@
+open! Stdune
+
 type var_syntax = Types.Template.var_syntax =
   | Dollar_brace
   | Dollar_paren

src/dsexp/types.ml

@@ -1,3 +1,5 @@
+open! Stdune
+
 module Template = struct
   type var_syntax = Dollar_brace | Dollar_paren | Percent
 
@@ -18,11 +20,3 @@ module Template = struct
     ; 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/dune

@@ -6,7 +6,7 @@
               xdg
               re
               opam_file_format
-              usexp
+              dsexp
               ocaml_config
               which_program)
  (synopsis    "Internal Dune library, do not use!")

src/dune_env.ml

@@ -1,3 +1,4 @@
+open! Stdune
 type stanza = Stanza.t = ..
 
 module Stanza = struct
@@ -36,7 +37,7 @@ module Stanza = struct
        in
        (pat, configs))
 
-  let t =
+  let dparse =
     let%map () = Syntax.since Stanza.syntax (1, 0)
     and loc = loc
     and rules = repeat rule

src/dune_env.mli

@@ -1,4 +1,4 @@
-open Import
+open! Stdune
 
 type stanza = Stanza.t = ..
 
@@ -18,7 +18,7 @@ module Stanza : sig
     ; rules : (pattern * config) list
     }
 
-  val t : t Sexp.Of_sexp.t
+  val dparse : t Dsexp.Of_sexp.t
 end
 
 type stanza +=

src/dune_file.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 open Stanza.Of_sexp
 
@@ -10,7 +11,7 @@ module Jbuild_version = struct
   type t =
     | V1
 
-  let t =
+  let dparse =
     enum
       [ "1", V1
       ]
@@ -53,7 +54,7 @@ module Lib_name : sig
 
   val validate : (Loc.t * result) -> wrapped:bool -> t
 
-  val t : (Loc.t * result) Sexp.Of_sexp.t
+  val dparse : (Loc.t * result) Dsexp.Of_sexp.t
 end = struct
   type t = string
 
@@ -78,9 +79,9 @@ end = struct
   let validate (loc, res) ~wrapped =
     match res, wrapped with
     | Ok s, _ -> s
-    | Warn _, true -> Loc.fail loc "%s" wrapped_message
+    | Warn _, true -> Errors.fail loc "%s" wrapped_message
-    | Warn s, false -> Loc.warn loc "%s" wrapped_message; s
+    | Warn s, false -> Errors.warn loc "%s" wrapped_message; s
-    | Invalid, _ -> Loc.fail loc "%s" invalid_message
+    | Invalid, _ -> Errors.fail loc "%s" invalid_message
 
   let valid_char = function
     | 'A'..'Z' | 'a'..'z' | '_' | '0'..'9' -> true
@@ -110,7 +111,7 @@ end = struct
         in
         loop false 0
 
-  let t = plain_string (fun ~loc s -> (loc, of_string s))
+  let dparse = plain_string (fun ~loc s -> (loc, of_string s))
 end
 
 let file =
@@ -210,12 +211,12 @@ module Pkg = struct
                  (hint name_s (Package.Name.Map.keys packages
                                |> List.map ~f:Package.Name.to_string)))
 
-  let t =
+  let dparse =
     let%map p = Dune_project.get_exn ()
-    and (loc, name) = located Package.Name.t in
+    and (loc, name) = located Package.Name.dparse in
     match resolve p name with
     | Ok    x -> x
-    | Error e -> Loc.fail loc "%s" e
+    | Error e -> Errors.fail loc "%s" e
 
   let field stanza =
     map_validate
@@ -266,11 +267,11 @@ module Pps_and_flags = struct
       in
       (pps, List.concat flags)
 
-    let t = list item >>| split
+    let dparse = list item >>| split
   end
 
   module Dune_syntax = struct
-    let t =
+    let dparse =
       let%map l, flags =
         until_keyword "--"
           ~before:(plain_string (fun ~loc s -> (loc, s)))
@@ -286,10 +287,10 @@ module Pps_and_flags = struct
       (pps, more_flags @ Option.value flags ~default:[])
   end
 
-  let t =
+  let dparse =
     switch_file_kind
-      ~jbuild:Jbuild_syntax.t
+      ~jbuild:Jbuild_syntax.dparse
-      ~dune:Dune_syntax.t
+      ~dune:Dune_syntax.dparse
 end
 
 module Bindings = struct
@@ -301,6 +302,11 @@ module Bindings = struct
 
   let fold t ~f ~init = List.fold_left ~f:(fun acc x -> f x acc) ~init t
 
+  let map t ~f =
+    List.map t ~f:(function
+      | Unnamed a -> Unnamed (f a)
+      | Named (s, xs) -> Named (s, List.map ~f xs))
+
   let to_list =
     List.concat_map ~f:(function
       | Unnamed x -> [x]
@@ -344,17 +350,25 @@ module Bindings = struct
       in
       loop String.Set.empty [] l)
 
-  let t elem =
+  let dparse elem =
     switch_file_kind
       ~jbuild:(jbuild elem)
       ~dune:(dune elem)
 
-  let sexp_of_t sexp_of_a bindings =
+  let dgen dgen bindings =
+    Dsexp.List (
+      List.map bindings ~f:(function
+        | Unnamed a -> dgen a
+        | Named (name, bindings) ->
+          Dsexp.List (Dsexp.atom (":" ^ name) :: List.map ~f:dgen bindings))
+    )
+
+  let to_sexp sexp_of_a bindings =
     Sexp.List (
       List.map bindings ~f:(function
         | Unnamed a -> sexp_of_a a
         | Named (name, bindings) ->
-          Sexp.List (Sexp.atom (":" ^ name) :: List.map ~f:sexp_of_a bindings))
+          Sexp.List (Sexp.To_sexp.string (":" ^ name) :: List.map ~f:sexp_of_a bindings))
     )
 end
 
@@ -368,9 +382,18 @@ module Dep_conf = struct
     | Package of String_with_vars.t
     | Universe
 
-  let t =
+  let remove_locs = function
-    let t =
+    | File sw -> File (String_with_vars.remove_locs sw)
-      let sw = String_with_vars.t in
+    | Alias sw -> Alias (String_with_vars.remove_locs sw)
+    | Alias_rec sw -> Alias_rec (String_with_vars.remove_locs sw)
+    | Glob_files sw -> Glob_files (String_with_vars.remove_locs sw)
+    | Source_tree sw -> Source_tree (String_with_vars.remove_locs sw)
+    | Package sw -> Package (String_with_vars.remove_locs sw)
+    | Universe -> Universe
+
+  let dparse =
+    let dparse =
+      let sw = String_with_vars.dparse in
       sum
         [ "file"       , (sw >>| fun x -> File x)
         ; "alias"      , (sw >>| fun x -> Alias x)
@@ -390,31 +413,33 @@ module Dep_conf = struct
         ]
     in
     if_list
-      ~then_:t
+      ~then_:dparse
-      ~else_:(String_with_vars.t >>| fun x -> File x)
+      ~else_:(String_with_vars.dparse >>| fun x -> File x)
 
-  open Sexp
+  open Dsexp
-  let sexp_of_t = function
+  let dgen = function
     | File t ->
-      List [ Sexp.unsafe_atom_of_string "file"
+      List [ Dsexp.unsafe_atom_of_string "file"
-           ; String_with_vars.sexp_of_t t ]
+           ; String_with_vars.dgen t ]
     | Alias t ->
-      List [ Sexp.unsafe_atom_of_string "alias"
+      List [ Dsexp.unsafe_atom_of_string "alias"
-           ; String_with_vars.sexp_of_t t ]
+           ; String_with_vars.dgen t ]
     | Alias_rec t ->
-      List [ Sexp.unsafe_atom_of_string "alias_rec"
+      List [ Dsexp.unsafe_atom_of_string "alias_rec"
-           ; String_with_vars.sexp_of_t t ]
+           ; String_with_vars.dgen t ]
     | Glob_files t ->
-      List [ Sexp.unsafe_atom_of_string "glob_files"
+      List [ Dsexp.unsafe_atom_of_string "glob_files"
-           ; String_with_vars.sexp_of_t t ]
+           ; String_with_vars.dgen t ]
     | Source_tree t ->
-      List [ Sexp.unsafe_atom_of_string "files_recursively_in"
+      List [ Dsexp.unsafe_atom_of_string "files_recursively_in"
-           ; String_with_vars.sexp_of_t t ]
+           ; String_with_vars.dgen t ]
     | Package t ->
-      List [ Sexp.unsafe_atom_of_string "package"
+      List [ Dsexp.unsafe_atom_of_string "package"
-           ; String_with_vars.sexp_of_t t]
+           ; String_with_vars.dgen t]
     | Universe ->
-      Sexp.unsafe_atom_of_string "universe"
+      Dsexp.unsafe_atom_of_string "universe"
+
+  let to_sexp t = Dsexp.to_sexp (dgen t)
 end
 
 module Preprocess = struct
@@ -429,20 +454,20 @@ module Preprocess = struct
     | Action of Loc.t * Action.Unexpanded.t
     | Pps    of pps
 
-  let t =
+  let dparse =
     sum
       [ "no_preprocessing", return No_preprocessing
       ; "action",
-        (located Action.Unexpanded.t >>| fun (loc, x) ->
+        (located Action.Unexpanded.dparse >>| fun (loc, x) ->
          Action (loc, x))
       ; "pps",
         (let%map loc = loc
-         and pps, flags = Pps_and_flags.t in
+         and pps, flags = Pps_and_flags.dparse in
          Pps { loc; pps; flags; staged = false })
       ; "staged_pps",
         (let%map () = Syntax.since Stanza.syntax (1, 1)
          and loc = loc
-         and pps, flags = Pps_and_flags.t in
+         and pps, flags = Pps_and_flags.dparse in
          Pps { loc; pps; flags; staged = true })
       ]
 
@@ -464,36 +489,36 @@ module Blang = struct
     ; "<>", Neq
     ]
 
-  let t =
+  let dparse =
     let ops =
       List.map ops ~f:(fun (name, op) ->
         ( name
-        , (let%map x = String_with_vars.t
+        , (let%map x = String_with_vars.dparse
-           and y = String_with_vars.t
+           and y = String_with_vars.dparse
            in
            Compare (op, x, y))))
     in
-    let t =
+    let dparse =
-      fix begin fun (t : String_with_vars.t Blang.t Sexp.Of_sexp.t) ->
+      fix begin fun (t : String_with_vars.t Blang.t Dsexp.Of_sexp.t) ->
         if_list
           ~then_:(
             [ "or", repeat t >>| (fun x -> Or x)
             ; "and", repeat t >>| (fun x -> And x)
             ] @ ops
             |> sum)
-          ~else_:(String_with_vars.t >>| fun v -> Expr v)
+          ~else_:(String_with_vars.dparse >>| fun v -> Expr v)
       end
     in
     let%map () = Syntax.since Stanza.syntax (1, 1)
-    and t = t
+    and dparse = dparse
     in
-    t
+    dparse
 end
 
 module Per_module = struct
   include Per_item.Make(Module.Name)
 
-  let t ~default a =
+  let dparse ~default a =
     peek_exn >>= function
     | List (loc, Atom (_, A "per_module") :: _) ->
       sum [ "per_module",
@@ -517,7 +542,7 @@ end
 
 module Preprocess_map = struct
   type t = Preprocess.t Per_module.t
-  let t = Per_module.t Preprocess.t ~default:Preprocess.No_preprocessing
+  let dparse = Per_module.dparse Preprocess.dparse ~default:Preprocess.No_preprocessing
 
   let no_preprocessing = Per_module.for_all Preprocess.No_preprocessing
 
@@ -537,7 +562,7 @@ end
 module Lint = struct
   type t = Preprocess_map.t
 
-  let t = Preprocess_map.t
+  let dparse = Preprocess_map.dparse
 
   let default = Preprocess_map.default
   let no_lint = default
@@ -552,7 +577,7 @@ module Js_of_ocaml = struct
     ; javascript_files : string list
     }
 
-  let t =
+  let dparse =
     record
       (let%map flags = field_oslu "flags"
        and javascript_files = field "javascript_files" (list string) ~default:[]
@@ -617,7 +642,7 @@ module Lib_dep = struct
         in
         loop String.Set.empty String.Set.empty preds)
 
-  let t =
+  let dparse =
     if_list
       ~then_:(
         enter
@@ -649,9 +674,9 @@ module Lib_deps = struct
     | Optional
     | Forbidden
 
-  let t =
+  let dparse =
     let%map loc = loc
-    and t = repeat Lib_dep.t
+    and t = repeat Lib_dep.dparse
     in
     let add kind name acc =
       match String.Map.find acc name with
@@ -686,7 +711,7 @@ module Lib_deps = struct
       : kind String.Map.t);
     t
 
-  let t = parens_removed_in_dune t
+  let dparse = parens_removed_in_dune dparse
 
   let of_pps pps =
     List.map pps ~f:(fun pp -> Lib_dep.of_pp (Loc.none, pp))
@@ -720,22 +745,22 @@ module Buildable = struct
 
   let modules_field name = Ordered_set_lang.field name
 
-  let t =
+  let dparse =
     let%map loc = loc
     and preprocess =
-      field "preprocess" Preprocess_map.t ~default:Preprocess_map.default
+      field "preprocess" Preprocess_map.dparse ~default:Preprocess_map.default
     and preprocessor_deps =
-      field "preprocessor_deps" (list Dep_conf.t) ~default:[]
+      field "preprocessor_deps" (list Dep_conf.dparse) ~default:[]
-    and lint = field "lint" Lint.t ~default:Lint.default
+    and lint = field "lint" Lint.dparse ~default:Lint.default
     and modules = modules_field "modules"
     and modules_without_implementation =
       modules_field "modules_without_implementation"
-    and libraries = field "libraries" Lib_deps.t ~default:[]
+    and libraries = field "libraries" Lib_deps.dparse ~default:[]
     and flags = field_oslu "flags"
     and ocamlc_flags = field_oslu "ocamlc_flags"
     and ocamlopt_flags = field_oslu "ocamlopt_flags"
     and js_of_ocaml =
-      field "js_of_ocaml" Js_of_ocaml.t ~default:Js_of_ocaml.default
+      field "js_of_ocaml" Js_of_ocaml.dparse ~default:Js_of_ocaml.default
     and allow_overlapping_dependencies =
       field_b "allow_overlapping_dependencies"
     in
@@ -803,7 +828,7 @@ module Sub_system_info = struct
     val name   : Sub_system_name.t
     val loc    : t -> Loc.t
     val syntax : Syntax.t
-    val parse  : t Sexp.Of_sexp.t
+    val parse  : t Dsexp.Of_sexp.t
   end
 
   let all = Sub_system_name.Table.create ~default_value:None
@@ -846,7 +871,7 @@ module Mode_conf = struct
   end
   include T
 
-  let t =
+  let dparse =
     enum
       [ "byte"  , Byte
       ; "native", Native
@@ -861,13 +886,13 @@ module Mode_conf = struct
   let pp fmt t =
     Format.pp_print_string fmt (to_string t)
 
-  let sexp_of_t t =
+  let dgen t =
-    Sexp.unsafe_atom_of_string (to_string t)
+    Dsexp.unsafe_atom_of_string (to_string t)
 
   module Set = struct
     include Set.Make(T)
 
-    let t = list t >>| of_list
+    let dparse = list dparse >>| of_list
 
     let default = of_list [Byte; Best]
 
@@ -886,7 +911,7 @@ module Library = struct
       | Ppx_deriver
       | Ppx_rewriter
 
-    let t =
+    let dparse =
       enum
         [ "normal"       , Normal
         ; "ppx_deriver"  , Ppx_deriver
@@ -920,11 +945,11 @@ module Library = struct
     ; dune_version             : Syntax.Version.t
     }
 
-  let t =
+  let dparse =
     record
-      (let%map buildable = Buildable.t
+      (let%map buildable = Buildable.dparse
        and loc = loc
-       and name = field_o "name" Lib_name.t
+       and name = field_o "name" Lib_name.dparse
        and public = Public_lib.public_name_field
        and synopsis = field_o "synopsis" string
        and install_c_headers =
@@ -939,8 +964,8 @@ module Library = struct
        and c_library_flags = field_oslu "c_library_flags"
        and virtual_deps =
          field "virtual_deps" (list (located string)) ~default:[]
-       and modes = field "modes" Mode_conf.Set.t ~default:Mode_conf.Set.default
+       and modes = field "modes" Mode_conf.Set.dparse ~default:Mode_conf.Set.default
-       and kind = field "kind" Kind.t ~default:Kind.Normal
+       and kind = field "kind" Kind.dparse ~default:Kind.Normal
        and wrapped = field "wrapped" bool ~default:true
        and optional = field_b "optional"
        and self_build_stubs_archive =
@@ -1038,7 +1063,7 @@ module Install_conf = struct
     | List (_, [Atom (_, A src); Atom (_, A "as"); Atom (_, A dst)]) ->
       junk >>> return { src; dst = Some dst }
     | sexp ->
-      of_sexp_error (Sexp.Ast.loc sexp)
+      of_sexp_error (Dsexp.Ast.loc sexp)
         "invalid format, <name> or (<name> as <install-as>) expected"
 
   type t =
@@ -1047,9 +1072,9 @@ module Install_conf = struct
     ; package : Package.t
     }
 
-  let t =
+  let dparse =
     record
-      (let%map section = field "section" Install.Section.t
+      (let%map section = field "section" Install.Section.dparse
        and files = field "files" (list file)
        and package = Pkg.field "install"
        in
@@ -1105,37 +1130,37 @@ module Executables = struct
       ]
 
     let simple =
-      Sexp.Of_sexp.enum simple_representations
+      Dsexp.Of_sexp.enum simple_representations
 
-    let t =
+    let dparse =
       if_list
         ~then_:
           (enter
-             (let%map mode = Mode_conf.t
+             (let%map mode = Mode_conf.dparse
-              and kind = Binary_kind.t in
+              and kind = Binary_kind.dparse in
               { mode; kind }))
         ~else_:simple
 
-    let simple_sexp_of_t link_mode =
+    let simple_dgen link_mode =
       let is_ok (_, candidate) =
         compare candidate link_mode = Eq
       in
       match List.find ~f:is_ok simple_representations with
-      | Some (s, _) -> Some (Sexp.unsafe_atom_of_string s)
+      | Some (s, _) -> Some (Dsexp.unsafe_atom_of_string s)
       | None -> None
 
-    let sexp_of_t link_mode =
+    let dgen link_mode =
-      match simple_sexp_of_t link_mode with
+      match simple_dgen link_mode with
       | Some s -> s
       | None ->
         let { mode; kind } = link_mode in
-        Sexp.To_sexp.pair Mode_conf.sexp_of_t Binary_kind.sexp_of_t (mode, kind)
+        Dsexp.To_sexp.pair Mode_conf.dgen Binary_kind.dgen (mode, kind)
 
     module Set = struct
       include Set.Make(T)
 
-      let t =
+      let dparse =
-        located (list t) >>| fun (loc, l) ->
+        located (list dparse) >>| fun (loc, l) ->
         match l with
         | [] -> of_sexp_errorf loc "No linking mode defined"
         | l ->
@@ -1175,12 +1200,12 @@ module Executables = struct
       s
 
   let common =
-    let%map buildable = Buildable.t
+    let%map buildable = Buildable.dparse
     and (_ : bool) = field "link_executables" ~default:true
                        (Syntax.deleted_in Stanza.syntax (1, 0) >>> bool)
-    and link_deps = field "link_deps" (list Dep_conf.t) ~default:[]
+    and link_deps = field "link_deps" (list Dep_conf.dparse) ~default:[]
     and link_flags = field_oslu "link_flags"
-    and modes = field "modes" Link_mode.Set.t ~default:Link_mode.Set.default
+    and modes = field "modes" Link_mode.Set.dparse ~default:Link_mode.Set.default
     and () = map_validate
                (field "inline_tests" (repeat junk >>| fun _ -> true) ~default:false)
                ~f:(function
@@ -1240,9 +1265,9 @@ module Executables = struct
         match Link_mode.Set.best_install_mode t.modes with
         | None when has_public_name ->
           let mode_to_string mode =
-            " - " ^ Sexp.to_string ~syntax:Dune (Link_mode.sexp_of_t mode) in
+            " - " ^ Dsexp.to_string ~syntax:Dune (Link_mode.dgen mode) in
           let mode_strings = List.map ~f:mode_to_string Link_mode.installable_modes in
-          Loc.fail
+          Errors.fail
             buildable.loc
             "No installable mode found for %s.\n\
              One of the following modes is required:\n\
@@ -1278,8 +1303,8 @@ module Executables = struct
           | Some (loc, _) ->
             let func =
               match file_kind with
-              | Jbuild -> Loc.warn
+              | Jbuild -> Errors.warn
-              | Dune   -> Loc.fail
+              | Dune   -> Errors.fail
             in
             func loc
               "This field is useless without a (public_name%s ...) field."
@@ -1358,7 +1383,7 @@ module Rule = struct
       | Not_a_rule_stanza
       | Ignore_source_files
 
-    let t =
+    let dparse =
       enum
         [ "standard"           , Standard
         ; "fallback"           , Fallback
@@ -1366,7 +1391,7 @@ module Rule = struct
         ; "promote-until-clean", Promote_but_delete_on_clean
         ]
 
-    let field = field "mode" t ~default:Standard
+    let field = field "mode" dparse ~default:Standard
   end
 
   type t =
@@ -1411,7 +1436,7 @@ module Rule = struct
       ]
 
   let short_form =
-    located Action.Unexpanded.t >>| fun (loc, action) ->
+    located Action.Unexpanded.dparse >>| fun (loc, action) ->
     { targets  = Infer
     ; deps     = Bindings.empty
     ; action   = (loc, action)
@@ -1422,10 +1447,11 @@ module Rule = struct
 
   let long_form =
     let%map loc = loc
-    and action = field "action" (located Action.Unexpanded.t)
+    and action = field "action" (located Action.Unexpanded.dparse)
     and targets = field "targets" (list file_in_current_dir)
-    and deps = field "deps" (Bindings.t Dep_conf.t) ~default:Bindings.empty
+    and deps =
-    and locks = field "locks" (list String_with_vars.t) ~default:[]
+      field "deps" (Bindings.dparse Dep_conf.dparse) ~default:Bindings.empty
+    and locks = field "locks" (list String_with_vars.dparse) ~default:[]
     and mode =
       map_validate
         (let%map fallback =
@@ -1433,7 +1459,7 @@ module Rule = struct
            ~check:(Syntax.renamed_in Stanza.syntax (1, 0)
                      ~to_:"(mode fallback)")
            "fallback"
-         and mode = field_o "mode" Mode.t
+         and mode = field_o "mode" Mode.dparse
          in
          (fallback, mode))
         ~f:(function
@@ -1472,10 +1498,10 @@ module Rule = struct
         | Some Action -> short_form
       end
     | sexp ->
-      of_sexp_errorf (Sexp.Ast.loc sexp)
+      of_sexp_errorf (Dsexp.Ast.loc sexp)
         "S-expression of the form (<atom> ...) expected"
 
-  let t =
+  let dparse =
     switch_file_kind
       ~jbuild:jbuild_syntax
       ~dune:dune_syntax
@@ -1582,7 +1608,7 @@ module Menhir = struct
       ~desc:"the menhir extension"
       [ (1, 0) ]
 
-  let t =
+  let dparse =
     record
       (let%map merge_into = field_o "merge_into" string
        and flags = field_oslu "flags"
@@ -1599,7 +1625,7 @@ module Menhir = struct
 
   let () =
     Dune_project.Extension.register syntax
-      (return [ "menhir", t >>| fun x -> [T x] ])
+      (return [ "menhir", dparse >>| fun x -> [T x] ])
 
   (* Syntax for jbuild files *)
   let jbuild_syntax =
@@ -1634,15 +1660,15 @@ module Alias_conf = struct
       else
         s)
 
-  let t =
+  let dparse =
     record
       (let%map name = field "name" alias_name
        and loc = loc
-       and package = field_o "package" Pkg.t
+       and package = field_o "package" Pkg.dparse
-       and action = field_o "action" (located Action.Unexpanded.t)
+       and action = field_o "action" (located Action.Unexpanded.dparse)
-       and locks = field "locks" (list String_with_vars.t) ~default:[]
+       and locks = field "locks" (list String_with_vars.dparse) ~default:[]
-       and deps = field "deps" (Bindings.t Dep_conf.t) ~default:Bindings.empty
+       and deps = field "deps" (Bindings.dparse Dep_conf.dparse) ~default:Bindings.empty
-       and enabled_if = field_o "enabled_if" Blang.t
+       and enabled_if = field_o "enabled_if" Blang.dparse
        in
        { name
        ; deps
@@ -1665,15 +1691,16 @@ module Tests = struct
 
   let gen_parse names =
     record
-      (let%map buildable = Buildable.t
+      (let%map buildable = Buildable.dparse
        and link_flags = field_oslu "link_flags"
        and names = names
-       and package = field_o "package" Pkg.t
+       and package = field_o "package" Pkg.dparse
-       and locks = field "locks" (list String_with_vars.t) ~default:[]
+       and locks = field "locks" (list String_with_vars.dparse) ~default:[]
-       and modes = field "modes" Executables.Link_mode.Set.t
+       and modes = field "modes" Executables.Link_mode.Set.dparse
                      ~default:Executables.Link_mode.Set.default
-       and deps = field "deps" (Bindings.t Dep_conf.t) ~default:Bindings.empty
+       and deps =
-       and enabled_if = field_o "enabled_if" Blang.t
+         field "deps" (Bindings.dparse Dep_conf.dparse) ~default:Bindings.empty
+       and enabled_if = field_o "enabled_if" Blang.dparse
        in
        { exes =
            { Executables.
@@ -1699,7 +1726,7 @@ module Copy_files = struct
            ; glob : String_with_vars.t
            }
 
-  let t = String_with_vars.t
+  let dparse = String_with_vars.dparse
 end
 
 module Documentation = struct
@@ -1709,7 +1736,7 @@ module Documentation = struct
     ; mld_files : Ordered_set_lang.t
     }
 
-  let t =
+  let dparse =
     record
       (let%map package = Pkg.field "documentation"
        and mld_files = Ordered_set_lang.field "mld_files"
@@ -1724,7 +1751,7 @@ end
 module Include_subdirs = struct
   type t = No | Unqualified
 
-  let t =
+  let dparse =
     enum
       [ "no", No
       ; "unqualified", Unqualified
@@ -1756,17 +1783,17 @@ module Stanzas = struct
 
   type Stanza.t += Include of Loc.t * string
 
-  type constructors = (string * Stanza.t list Sexp.Of_sexp.t) list
+  type constructors = (string * Stanza.t list Dsexp.Of_sexp.t) list
 
   let stanzas : constructors =
     [ "library",
-      (let%map x = Library.t in
+      (let%map x = Library.dparse in
        [Library x])
     ; "executable" , Executables.single >>| execs
     ; "executables", Executables.multi  >>| execs
     ; "rule",
       (let%map loc = loc
-       and x = Rule.t in
+       and x = Rule.dparse in
        [Rule { x with loc }])
     ; "ocamllex",
       (let%map loc = loc
@@ -1777,27 +1804,27 @@ module Stanzas = struct
        and x = Rule.ocamlyacc in
        rules (Rule.ocamlyacc_to_rule loc x))
     ; "install",
-      (let%map x = Install_conf.t in
+      (let%map x = Install_conf.dparse in
        [Install x])
     ; "alias",
-      (let%map x = Alias_conf.t in
+      (let%map x = Alias_conf.dparse in
        [Alias x])
     ; "copy_files",
-      (let%map glob = Copy_files.t in
+      (let%map glob = Copy_files.dparse in
        [Copy_files {add_line_directive = false; glob}])
     ; "copy_files#",
-      (let%map glob = Copy_files.t in
+      (let%map glob = Copy_files.dparse in
        [Copy_files {add_line_directive = true; glob}])
     ; "include",
       (let%map loc = loc
        and fn = relative_file in
        [Include (loc, fn)])
     ; "documentation",
-      (let%map d = Documentation.t in
+      (let%map d = Documentation.dparse in
        [Documentation d])
     ; "jbuild_version",
       (let%map () = Syntax.deleted_in Stanza.syntax (1, 0)
-       and _ = Jbuild_version.t in
+       and _ = Jbuild_version.dparse in
        [])
     ; "tests",
       (let%map () = Syntax.since Stanza.syntax (1, 0)
@@ -1808,11 +1835,11 @@ module Stanzas = struct
        and t = Tests.single in
        [Tests t])
     ; "env",
-      (let%map x = Dune_env.Stanza.t in
+      (let%map x = Dune_env.Stanza.dparse in
        [Dune_env.T x])
     ; "include_subdirs",
       (let%map () = Syntax.since Stanza.syntax (1, 1)
-       and t = Include_subdirs.t
+       and t = Include_subdirs.dparse
        and loc = loc in
        [Include_subdirs (loc, t)])
     ]
@@ -1837,18 +1864,18 @@ module Stanzas = struct
   exception Include_loop of Path.t * (Loc.t * Path.t) list
 
   let rec parse stanza_parser ~lexer ~current_file ~include_stack sexps =
-    List.concat_map sexps ~f:(Sexp.Of_sexp.parse stanza_parser Univ_map.empty)
+    List.concat_map sexps ~f:(Dsexp.Of_sexp.parse stanza_parser Univ_map.empty)
     |> List.concat_map ~f:(function
       | Include (loc, fn) ->
         let include_stack = (loc, current_file) :: include_stack in
         let dir = Path.parent_exn current_file in
         let current_file = Path.relative dir fn in
         if not (Path.exists current_file) then
-          Loc.fail loc "File %s doesn't exist."
+          Errors.fail loc "File %s doesn't exist."
             (Path.to_string_maybe_quoted current_file);
         if List.exists include_stack ~f:(fun (_, f) -> Path.equal f current_file) then
           raise (Include_loop (current_file, include_stack));
-        let sexps = Io.Sexp.load ~lexer current_file ~mode:Many in
+        let sexps = Dsexp.Io.load ~lexer current_file ~mode:Many in
         parse stanza_parser sexps ~lexer ~current_file ~include_stack
       | stanza -> [stanza])
 
@@ -1856,8 +1883,8 @@ module Stanzas = struct
     let (stanza_parser, lexer) =
       let (parser, lexer) =
         match (kind : File_tree.Dune_file.Kind.t) with
-        | Jbuild -> (jbuild_parser, Usexp.Lexer.jbuild_token)
+        | Jbuild -> (jbuild_parser, Dsexp.Lexer.jbuild_token)
-        | Dune   -> (Dune_project.stanza_parser project, Usexp.Lexer.token)
+        | Dune   -> (Dune_project.stanza_parser project, Dsexp.Lexer.token)
       in
       (Dune_project.set project parser, lexer)
     in
@@ -1873,7 +1900,7 @@ module Stanzas = struct
             (Path.to_string_maybe_quoted file)
             loc.Loc.start.pos_lnum
         in
-        Loc.fail loc
+        Errors.fail loc
           "Recursive inclusion of jbuild files detected:\n\
            File %s is included from %s%s"
           (Path.to_string_maybe_quoted file)
@@ -1889,6 +1916,6 @@ module Stanzas = struct
         ~f:(function Dune_env.T e -> Some e | _ -> None)
     with
     | _ :: e :: _ ->
-      Loc.fail e.loc "The 'env' stanza cannot appear more than once"
+      Errors.fail e.loc "The 'env' stanza cannot appear more than once"
     | _ -> stanzas
 end

src/dune_file.mli

@@ -1,5 +1,6 @@
 (** Representation and parsing of jbuild files *)
 
+open! Stdune
 open Import
 
 (** Ppx preprocessors  *)
@@ -90,6 +91,8 @@ module Bindings : sig
 
   type 'a t = 'a one list
 
+  val map : 'a t -> f:('a -> 'b) -> 'b t
+
   val find : 'a t -> string -> 'a list option
 
   val fold : 'a t -> f:('a one -> 'acc -> 'acc) -> init:'acc -> 'acc
@@ -100,7 +103,9 @@ module Bindings : sig
 
   val singleton : 'a -> 'a t
 
-  val sexp_of_t : ('a -> Usexp.t) -> 'a t -> Usexp.t
+  val dgen : 'a Dsexp.To_sexp.t -> 'a t Dsexp.To_sexp.t
+
+  val to_sexp : 'a Sexp.To_sexp.t -> 'a t Sexp.To_sexp.t
 end
 
 module Dep_conf : sig
@@ -113,8 +118,10 @@ module Dep_conf : sig
     | Package of String_with_vars.t
     | Universe
 
-  val t : t Sexp.Of_sexp.t
+  val remove_locs : t -> t
-  val sexp_of_t : t -> Sexp.t
+
+  include Dsexp.Sexpable with type t := t
+  val to_sexp : t Sexp.To_sexp.t
 end
 
 module Buildable : sig
@@ -170,7 +177,7 @@ module Sub_system_info : sig
     val syntax : Syntax.t
 
     (** Parse parameters written by the user in jbuid/dune files *)
-    val parse : t Sexp.Of_sexp.t
+    val parse : t Dsexp.Of_sexp.t
   end
 
   module Register(M : S) : sig end
@@ -184,13 +191,13 @@ module Mode_conf : sig
     | Native
     | Best (** [Native] if available and [Byte] if not *)
 
-  val t : t Sexp.Of_sexp.t
+  val dparse : t Dsexp.Of_sexp.t
   val compare : t -> t -> Ordering.t
   val pp : Format.formatter -> t -> unit
 
   module Set : sig
     include Set.S with type elt = t
-    val t : t Sexp.Of_sexp.t
+    val dparse : t Dsexp.Of_sexp.t
 
     (** Both Byte and Native *)
     val default : t
@@ -260,8 +267,7 @@ module Executables : sig
       ; kind : Binary_kind.t
       }
 
-    val t : t Sexp.Of_sexp.t
+    include Dsexp.Sexpable with type t := t
-    val sexp_of_t : t Sexp.To_sexp.t
 
     val exe           : t
     val object_       : t
@@ -391,6 +397,6 @@ module Stanzas : sig
     :  file:Path.t
     -> kind:File_tree.Dune_file.Kind.t
     -> Dune_project.t
-    -> Sexp.Ast.t list
+    -> Dsexp.Ast.t list
     -> t
 end

src/dune_fmt.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open! Import
 
 let parse_file path_opt =
@@ -13,20 +14,20 @@ let parse_file path_opt =
       let contents = String.concat ~sep:"\n" lines in
       ("<stdin>", contents)
   in
-  Sexp.parse_string
+  Dsexp.parse_string
     ~fname
-    ~mode:Usexp.Parser.Mode.Many
+    ~mode:Dsexp.Parser.Mode.Many
     contents
 
 let can_be_displayed_inline =
   List.for_all ~f:(function
-    | Usexp.Atom _
+    | Dsexp.Atom _
-    | Usexp.Quoted_string _
+    | Dsexp.Quoted_string _
-    | Usexp.Template _
+    | Dsexp.Template _
-    | Usexp.List [_]
+    | Dsexp.List [_]
       ->
       true
-    | Usexp.List _
+    | Dsexp.List _
       ->
       false
   )
@@ -42,21 +43,21 @@ let print_inline_list fmt indent sexps =
       first := false
     else
       Format.pp_print_string fmt " ";
-    Usexp.pp Usexp.Dune fmt sexp
+    Dsexp.pp Dsexp.Dune fmt sexp
   );
   Format.pp_print_string fmt ")"
 
 let rec pp_sexp indent fmt =
   function
-    ( Usexp.Atom _
+    ( Dsexp.Atom _
-    | Usexp.Quoted_string _
+    | Dsexp.Quoted_string _
-    | Usexp.Template _
+    | Dsexp.Template _
     ) as sexp
     ->
     Format.fprintf fmt "%a%a"
       pp_indent indent
-      (Usexp.pp Usexp.Dune) sexp
+      (Dsexp.pp Dsexp.Dune) sexp
-  | Usexp.List sexps
+  | Dsexp.List sexps
     ->
     if can_be_displayed_inline sexps then
       print_inline_list fmt indent sexps
@@ -96,7 +97,7 @@ let pp_top_sexps fmt sexps =
       first := false
     else
       Format.pp_print_string fmt "\n";
-    pp_top_sexp fmt (Sexp.Ast.remove_locs sexp);
+    pp_top_sexp fmt (Dsexp.Ast.remove_locs sexp);
   )
 
 let with_output path_opt k =
@@ -110,10 +111,10 @@ let with_output path_opt k =
 
 let format_file ~input ~output =
   match parse_file input with
-  | exception Usexp.Parse_error e ->
+  | exception Dsexp.Parse_error e ->
     Printf.printf
       "Parse error: %s\n"
-      (Usexp.Parse_error.message e)
+      (Dsexp.Parse_error.message e)
   | sexps ->
     with_output output (fun fmt ->
       pp_top_sexps fmt sexps;

src/dune_lexer.mli

@@ -1,3 +1,5 @@
+open! Stdune
+
 (** Returns [true] if the input starts with "(* -*- tuareg -*- *)" *)
 val is_script : Lexing.lexbuf -> bool
 

src/dune_lexer.mll

@@ -1,4 +1,5 @@
 {
+open! Stdune
 type first_line =
   { lang    : Loc.t * string
   ; version : Loc.t * string
@@ -11,7 +12,7 @@ let make_loc lexbuf : Loc.t =
 
 let invalid_lang_line start lexbuf =
   lexbuf.Lexing.lex_start_p <- start;
-  Loc.fail_lex lexbuf
+  Errors.fail_lex lexbuf
     "Invalid first line, expected: (lang <lang> <version>)"
 }
 

src/dune_project.ml

@@ -1,13 +1,14 @@
+open! Stdune
 open Import
-open Sexp.Of_sexp
+open Dsexp.Of_sexp
 
 module Kind = struct
   type t =
     | Dune
     | Jbuilder
 
-  let sexp_of_t t =
+  let to_sexp t =
-    Sexp.atom_or_quoted_string
+    Sexp.Atom
       (match t with
        | Dune -> "dune"
        | Jbuilder -> "jbuilder")
@@ -22,8 +23,8 @@ module Name : sig
 
   val to_string_hum : t -> string
 
-  val named_of_sexp : t Sexp.Of_sexp.t
+  val dparse : t Dsexp.Of_sexp.t
-  val sexp_of_t : t Sexp.To_sexp.t
+  val to_sexp : t Sexp.To_sexp.t
 
   val encode : t -> string
   val decode : string -> t
@@ -58,11 +59,11 @@ end = struct
     | Named     s -> s
     | Anonymous p -> sprintf "<anonymous %s>" (Path.to_string_maybe_quoted p)
 
-  let sexp_of_t = function
+  let to_sexp = function
     | Named s -> Sexp.To_sexp.string s
     | Anonymous p ->
-      List [ Sexp.unsafe_atom_of_string "anonymous"
+      List [ Atom "anonymous"
-           ; Path.sexp_of_t p
+           ; Path.to_sexp p
            ]
 
   let validate name =
@@ -84,12 +85,12 @@ end = struct
     else
       None
 
-  let named_of_sexp =
+  let dparse =
-    Sexp.Of_sexp.plain_string (fun ~loc s ->
+    Dsexp.Of_sexp.plain_string (fun ~loc s ->
       if validate s then
         Named s
       else
-        Sexp.Of_sexp.of_sexp_errorf loc "invalid project name")
+        Dsexp.Of_sexp.of_sexp_errorf loc "invalid project name")
 
   let encode = function
     | Named     s -> s
@@ -131,10 +132,10 @@ module Project_file = struct
     ; mutable exists : bool
     }
 
-  let sexp_of_t { file; exists } =
+  let to_sexp { file; exists } =
     Sexp.To_sexp.(
       record
-        [ "file", Path.sexp_of_t file
+        [ "file", Path.to_sexp file
         ; "exists", bool exists
         ])
 end
@@ -145,7 +146,7 @@ type t =
   ; root          : Path.Local.t
   ; version       : string option
   ; packages      : Package.t Package.Name.Map.t
-  ; stanza_parser : Stanza.t list Sexp.Of_sexp.t
+  ; stanza_parser : Stanza.t list Dsexp.Of_sexp.t
   ; project_file  : Project_file.t
   }
 
@@ -202,14 +203,14 @@ let append_to_project_file t str =
 module Extension = struct
   type t =
     { syntax  : Syntax.t
-    ; stanzas : Stanza.Parser.t list Sexp.Of_sexp.t
+    ; stanzas : Stanza.Parser.t list Dsexp.Of_sexp.t
     }
 
   type instance =
     { extension  : t
     ; version    : Syntax.Version.t
     ; loc        : Loc.t
-    ; parse_args : Stanza.Parser.t list Sexp.Of_sexp.t -> Stanza.Parser.t list
+    ; parse_args : Stanza.Parser.t list Dsexp.Of_sexp.t -> Stanza.Parser.t list
     }
 
   let extensions = Hashtbl.create 32
@@ -224,7 +225,7 @@ module Extension = struct
   let instantiate ~loc ~parse_args (name_loc, name) (ver_loc, ver) =
     match Hashtbl.find extensions name with
     | None ->
-      Loc.fail name_loc "Unknown extension %S.%s" name
+      Errors.fail name_loc "Unknown extension %S.%s" name
         (hint name (Hashtbl.keys extensions))
     | Some t ->
       Syntax.check_supported t.syntax (ver_loc, ver);
@@ -242,7 +243,7 @@ module Extension = struct
       if f name then
         let version = Syntax.greatest_supported_version ext.syntax in
         let parse_args p =
-          let open Sexp.Of_sexp in
+          let open Dsexp.Of_sexp in
           let dune_project_edited = ref false in
           parse (enter p) Univ_map.empty (List (Loc.of_pos __POS__, []))
           |> List.map ~f:(fun (name, p) ->
@@ -251,10 +252,10 @@ module Extension = struct
              if not !dune_project_edited then begin
                dune_project_edited := true;
                Project_file_edit.append project_file
-                 (Sexp.to_string ~syntax:Dune
+                 (Dsexp.to_string ~syntax:Dune
-                    (List [ Sexp.atom "using"
+                    (List [ Dsexp.atom "using"
-                          ; Sexp.atom name
+                          ; Dsexp.atom name
-                          ; Sexp.atom (Syntax.Version.to_string version)
+                          ; Dsexp.atom (Syntax.Version.to_string version)
                           ]))
              end;
              p))
@@ -279,16 +280,16 @@ let key =
     (fun { name; root; version; project_file; kind
          ; stanza_parser = _; packages = _ } ->
       Sexp.To_sexp.record
-        [ "name", Name.sexp_of_t name
+        [ "name", Name.to_sexp name
-        ; "root", Path.Local.sexp_of_t root
+        ; "root", Path.Local.to_sexp root
         ; "version", Sexp.To_sexp.(option string) version
-        ; "project_file", Project_file.sexp_of_t project_file
+        ; "project_file", Project_file.to_sexp project_file
-        ; "kind", Kind.sexp_of_t kind
+        ; "kind", Kind.to_sexp kind
         ])
 
-let set t = Sexp.Of_sexp.set key t
+let set t = Dsexp.Of_sexp.set key t
 let get_exn () =
-  let open Sexp.Of_sexp in
+  let open Dsexp.Of_sexp in
   get key >>| function
   | Some t -> t
   | None ->
@@ -310,7 +311,7 @@ let anonymous = lazy (
   ; root          = get_local_path Path.root
   ; version       = None
   ; stanza_parser =
-      Sexp.Of_sexp.(set_many parsing_context (sum lang.data))
+      Dsexp.Of_sexp.(set_many parsing_context (sum lang.data))
   ; project_file  = { file = Path.relative Path.root filename; exists = false }
   })
 
@@ -330,12 +331,12 @@ let default_name ~dir ~packages =
     match Name.named name with
     | Some x -> x
     | None ->
-      Loc.fail (Loc.in_file (Path.to_string (Package.opam_file pkg)))
+      Errors.fail (Loc.in_file (Path.to_string (Package.opam_file pkg)))
         "%S is not a valid opam package name."
         name
 
 let name_field ~dir ~packages =
-    let%map name = field_o "name" Name.named_of_sexp in
+    let%map name = field_o "name" Name.dparse in
     match name with
     | Some x -> x
     | None   -> default_name ~dir ~packages
@@ -348,7 +349,7 @@ let parse ~dir ~lang ~packages ~file =
        multi_field "using"
          (let%map loc = loc
           and name = located string
-          and ver = located Syntax.Version.t
+          and ver = located Syntax.Version.dparse
           and parse_args = capture
           in
           (* We don't parse the arguments quite yet as we want to set
@@ -361,7 +362,7 @@ let parse ~dir ~lang ~packages ~file =
             (Syntax.name e.extension.syntax, e.loc)))
      with
      | Error (name, _, loc) ->
-       Loc.fail loc "Extension %S specified for the second time." name
+       Errors.fail loc "Extension %S specified for the second time." name
      | Ok map ->
        let project_file : Project_file.t = { file; exists = true } in
        let extensions =
@@ -375,14 +376,14 @@ let parse ~dir ~lang ~packages ~file =
            (lang.data ::
             List.map extensions ~f:(fun (ext : Extension.instance) ->
               ext.parse_args
-                (Sexp.Of_sexp.set_many parsing_context ext.extension.stanzas)))
+                (Dsexp.Of_sexp.set_many parsing_context ext.extension.stanzas)))
        in
        { kind = Dune
        ; name
        ; root = get_local_path dir
        ; version
        ; packages
-       ; stanza_parser = Sexp.Of_sexp.(set_many parsing_context (sum stanzas))
+       ; stanza_parser = Dsexp.Of_sexp.(set_many parsing_context (sum stanzas))
        ; project_file
        })
 
@@ -399,7 +400,7 @@ let make_jbuilder_project ~dir packages =
   ; version = None
   ; packages
   ; stanza_parser =
-      Sexp.Of_sexp.(set_many parsing_context (sum lang.data))
+      Dsexp.Of_sexp.(set_many parsing_context (sum lang.data))
   ; project_file = { file = Path.relative dir filename; exists = false }
   }
 

src/dune_project.mli

@@ -1,3 +1,4 @@
+open! Stdune
 (** dune-project files *)
 
 open Import
@@ -22,7 +23,7 @@ module Name : sig
   (** Convert to a string that is suitable for human readable messages *)
   val to_string_hum : t -> string
 
-  val sexp_of_t : t -> Sexp.t
+  val to_sexp : t Sexp.To_sexp.t
 
   (** Convert to/from an encoded string that is suitable to use in filenames *)
   val encode : t -> string
@@ -41,7 +42,7 @@ val packages : t -> Package.t Package.Name.Map.t
 val version : t -> string option
 val name : t -> Name.t
 val root : t -> Path.Local.t
-val stanza_parser : t -> Stanza.t list Sexp.Of_sexp.t
+val stanza_parser : t -> Stanza.t list Dsexp.Of_sexp.t
 
 module Lang : sig
   (** [register id stanzas_parser] register a new language. Users will
@@ -62,7 +63,7 @@ module Extension : sig
 
       in their [dune-project] file. [parser] is used to describe
       what [<args>] might be. *)
-  val register : Syntax.t -> Stanza.Parser.t list Sexp.Of_sexp.t -> unit
+  val register : Syntax.t -> Stanza.Parser.t list Dsexp.Of_sexp.t -> unit
 end
 
 (** Load a project description from the following directory. [files]
@@ -86,5 +87,5 @@ val ensure_project_file_exists : t -> unit
 val append_to_project_file : t -> string -> unit
 
 (** Set the project we are currently parsing dune files for *)
-val set : t -> ('a, 'k) Sexp.Of_sexp.parser -> ('a, 'k) Sexp.Of_sexp.parser
+val set : t -> ('a, 'k) Dsexp.Of_sexp.parser -> ('a, 'k) Dsexp.Of_sexp.parser
-val get_exn : unit -> (t, 'k) Sexp.Of_sexp.parser
+val get_exn : unit -> (t, 'k) Dsexp.Of_sexp.parser

src/env.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 
 module Var = struct
@@ -62,7 +63,7 @@ let extend t ~vars =
 let extend_env x y =
   extend x ~vars:y.vars
 
-let sexp_of_t t =
+let to_sexp t =
   let open Sexp.To_sexp in
   (list (pair string string)) (Map.to_list t.vars)
 

src/env.mli

@@ -1,4 +1,4 @@
-open Import
+open! Stdune
 
 module Var : sig
   type t = string
@@ -28,6 +28,6 @@ val diff : t -> t -> t
 
 val update : t -> var:string -> f:(string option -> string option) -> t
 
-val sexp_of_t : t -> Sexp.t
+val to_sexp : t -> Sexp.t
 
 val of_string_map : string String.Map.t -> t

src/errors.ml

@@ -1,4 +1,4 @@
-open Stdune
+open! Stdune
 
 exception Already_reported
 
@@ -15,3 +15,84 @@ let kerrf fmt ~f =
 
 let die fmt =
   kerrf fmt ~f:(fun s -> raise (Exn.Fatal_error s))
+
+let exnf t fmt =
+  Format.pp_open_box err_ppf 0;
+  Format.pp_print_as err_ppf 7 ""; (* "Error: " *)
+  kerrf (fmt^^ "@]") ~f:(fun s -> Exn.Loc_error (t, s))
+
+let fail t fmt =
+  Format.pp_print_as err_ppf 7 ""; (* "Error: " *)
+  kerrf fmt ~f:(fun s ->
+    raise (Exn.Loc_error (t, s)))
+
+let fail_lex lb fmt =
+  fail (Loc.of_lexbuf lb) fmt
+
+let fail_opt t fmt =
+  match t with
+  | None -> die fmt
+  | Some t -> fail t fmt
+
+let file_line path n =
+  Io.with_file_in ~binary:false path
+    ~f:(fun ic ->
+      for _ = 1 to n - 1 do
+        ignore (input_line ic)
+      done;
+      input_line ic
+    )
+
+let file_lines path ~start ~stop =
+  Io.with_file_in ~binary:true path
+    ~f:(fun ic ->
+      let rec aux acc lnum =
+        if lnum > stop then
+          List.rev acc
+        else if lnum < start then
+          (ignore (input_line ic);
+           aux acc (lnum + 1))
+        else
+          let line = input_line ic in
+          aux ((string_of_int lnum, line) :: acc) (lnum + 1)
+      in
+      aux [] 1
+    )
+
+let print ppf loc =
+  let { Loc.start; stop } = loc in
+  let start_c = start.pos_cnum - start.pos_bol in
+  let stop_c  = stop.pos_cnum  - start.pos_bol in
+  let num_lines = stop.pos_lnum - start.pos_lnum in
+  let pp_file_excerpt pp () =
+    let whole_file = start_c = 0 && stop_c = 0 in
+    if not whole_file then
+      let path = Path.of_string start.pos_fname in
+      if Path.exists path then
+        let line = file_line path start.pos_lnum in
+        if stop_c <= String.length line then
+          let len = stop_c - start_c in
+          Format.fprintf pp "%s\n%*s\n" line
+            stop_c
+            (String.make len '^')
+        else if num_lines <= 10 then
+          let lines = file_lines path ~start:start.pos_lnum ~stop:stop.pos_lnum in
+          let last_lnum = Option.map ~f:fst (List.last lines) in
+          let padding_width = Option.value_exn
+                                (Option.map ~f:String.length last_lnum) in
+          List.iter ~f:(fun (lnum, l) ->
+            Format.fprintf pp "%*s: %s\n" padding_width lnum l)
+          lines
+  in
+  Format.fprintf ppf
+    "@{<loc>File \"%s\", line %d, characters %d-%d:@}@\n%a"
+    start.pos_fname start.pos_lnum start_c stop_c
+    pp_file_excerpt ()
+
+(* This is ugly *)
+let printer = ref (Printf.eprintf "%s%!")
+let print_to_console s = !printer s
+
+let warn t fmt =
+  kerrf ~f:print_to_console
+    ("%a@{<warning>Warning@}: " ^^ fmt ^^ "@.") print t

src/errors.mli

@@ -1,3 +1,4 @@
+open Stdune
 (** Dealing with errors *)
 
 (* CR-soon diml: stop including this in [Import] *)
@@ -21,3 +22,18 @@ val kerrf
   :  ('a, Format.formatter, unit, 'b) format4
   -> f:(string -> 'b)
   -> 'a
+
+val exnf     : Loc.t         -> ('a, Format.formatter, unit, exn) format4 -> 'a
+val fail     : Loc.t         -> ('a, Format.formatter, unit, 'b ) format4 -> 'a
+val fail_lex : Lexing.lexbuf -> ('a, Format.formatter, unit, 'b ) format4 -> 'a
+val fail_opt : Loc.t option  -> ('a, Format.formatter, unit, 'b ) format4 -> 'a
+
+(** Prints "File ..., line ..., characters ...:\n" *)
+val print : Format.formatter -> Loc.t -> unit
+
+(** Prints a warning *)
+val warn : Loc.t -> ('a, Format.formatter, unit) format -> 'a
+
+val print_to_console : string -> unit
+
+val printer : (string -> unit) ref

src/exe.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 open Build.O
 

src/fiber/fiber.ml

@@ -1,4 +1,4 @@
-open Stdune
+open! Stdune
 
 module Execution_context : sig
   type t
@@ -234,7 +234,7 @@ module Var = struct
     fiber ctx k
 
   let create () =
-    create ~name:"var" (fun _ -> Sexp.atom_or_quoted_string "var")
+    create ~name:"var" (fun _ -> Sexp.To_sexp.string "var")
 end
 
 let with_error_handler f ~on_error ctx k =

src/fiber/fiber.mli

@@ -1,6 +1,6 @@
 (** Concurrency library *)
 
-open Stdune
+open! Stdune
 
 (** {1 Generals} *)
 

src/file_tree.ml

@@ -1,8 +1,9 @@
+open! Stdune
 open! Import
 
 module Dune_file = struct
   module Kind = struct
-    type t = Usexp.syntax = Jbuild | Dune
+    type t = Dsexp.syntax = Jbuild | Dune
 
     let of_basename = function
       | "dune"   -> Dune
@@ -10,14 +11,14 @@ module Dune_file = struct
       | _ -> assert false
 
     let lexer = function
-      | Dune   -> Sexp.Lexer.token
+      | Dune   -> Dsexp.Lexer.token
-      | Jbuild -> Sexp.Lexer.jbuild_token
+      | Jbuild -> Dsexp.Lexer.jbuild_token
   end
 
   module Plain = struct
     type t =
       { path          : Path.t
-      ; mutable sexps : Sexp.Ast.t list
+      ; mutable sexps : Dsexp.Ast.t list
       }
   end
 
@@ -39,7 +40,7 @@ module Dune_file = struct
 
   let extract_ignored_subdirs =
     let stanza =
-      let open Sexp.Of_sexp in
+      let open Dsexp.Of_sexp in
       let sub_dir =
         plain_string (fun ~loc dn ->
           if Filename.dirname dn <> Filename.current_dir_name ||
@@ -58,9 +59,9 @@ module Dune_file = struct
     fun sexps ->
       let ignored_subdirs, sexps =
         List.partition_map sexps ~f:(fun sexp ->
-          match (sexp : Sexp.Ast.t) with
+          match (sexp : Dsexp.Ast.t) with
           | List (_, (Atom (_, A "ignored_subdirs") :: _)) ->
-            Left (Sexp.Of_sexp.parse stanza Univ_map.empty sexp)
+            Left (Dsexp.Of_sexp.parse stanza Univ_map.empty sexp)
           | _ -> Right sexp)
       in
       let ignored_subdirs =
@@ -75,7 +76,7 @@ module Dune_file = struct
           (Contents.Ocaml_script file, String.Set.empty)
         else
           let sexps =
-            Usexp.Parser.parse lb ~lexer:(Kind.lexer kind) ~mode:Many
+            Dsexp.Parser.parse lb ~lexer:(Kind.lexer kind) ~mode:Many
           in
           let ignored_subdirs, sexps = extract_ignored_subdirs sexps in
           (Plain { path = file; sexps }, ignored_subdirs)
@@ -88,11 +89,12 @@ let load_jbuild_ignore path =
     if Filename.dirname fn = Filename.current_dir_name then
       true
     else begin
-      Loc.(warn (of_pos ( Path.to_string path
+      Errors.(warn (Loc.of_pos
-                        , i + 1, 0
+                      ( Path.to_string path
-                        , String.length fn
+                      , i + 1, 0
-                        ))
+                      , String.length fn
-             "subdirectory expression %s ignored" fn);
+                      ))
+                "subdirectory expression %s ignored" fn);
       false
     end)
   |> String.Set.of_list

src/file_tree.mli

@@ -1,12 +1,13 @@
+open! Stdune
 (** Dune representation of the source tree *)
 
 open! Import
 
 module Dune_file : sig
   module Kind : sig
-    type t = Usexp.syntax = Jbuild | Dune
+    type t = Dsexp.syntax = Jbuild | Dune
 
-    val lexer : t -> Sexp.Lexer.t
+    val lexer : t -> Dsexp.Lexer.t
   end
 
   module Plain : sig
@@ -15,7 +16,7 @@ module Dune_file : sig
         as we don't need them. *)
     type t =
       { path          : Path.t
-      ; mutable sexps : Sexp.Ast.t list
+      ; mutable sexps : Dsexp.Ast.t list
       }
   end
 

src/findlib.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 
 module P  = Variant

src/findlib.mli

@@ -1,5 +1,6 @@
 (** Findlib database *)
 
+open! Stdune
 open Import
 
 (** Findlib database *)

src/gen_meta.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 open Meta
 

src/gen_rules.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 module Menhir_rules = Menhir
 open Dune_file
@@ -61,11 +62,11 @@ module Gen(P : Install_rules.Params) = struct
         match Module.Name.Map.find modules mod_name with
         | Some m ->
           if not (Module.has_impl m) then
-            Loc.fail loc "Module %a has no implementation."
+            Errors.fail loc "Module %a has no implementation."
               Module.Name.pp mod_name
           else
             { Exe.Program.name; main_module_name = mod_name }
-        | None -> Loc.fail loc "Module %a doesn't exist."
+        | None -> Errors.fail loc "Module %a doesn't exist."
                     Module.Name.pp mod_name)
     in
 
@@ -295,7 +296,7 @@ module Gen(P : Install_rules.Params) = struct
           SC.add_rule sctx
             (Build.fail ~targets
                { fail = fun () ->
-                   Loc.fail m.loc
+                   Errors.fail m.loc
                      "I can't determine what library/executable the files \
                       produced by this stanza are part of."
                })

src/gen_rules.mli

@@ -1,3 +1,4 @@
+open! Stdune
 open! Import
 
 (* Generate rules. Returns evaluated jbuilds per context names. *)

src/glob_lexer.mli

@@ -1,3 +1,3 @@
-open Import
+open Stdune
 
-val parse_string : string -> (Re.t, int * string) result
+val parse_string : string -> (Re.t, int * string) Result.result

src/glob_lexer.mll

@@ -1,4 +1,5 @@
 {
+open! Stdune
 open Re
 
 let no_slash        = diff any (char '/')
@@ -59,8 +60,8 @@ and char_set st = parse
   let parse_string s =
     let lb = Lexing.from_string s in
     match initial lb with
-    | re -> Import.Ok re
+    | re -> Result.Ok re
     | exception Failure msg ->
-      Import.Error (Lexing.lexeme_start lb, msg)
+      Error (Lexing.lexeme_start lb, msg)
 }
 

src/import.ml

@@ -1,3 +1,5 @@
+open! Stdune
+
 include Stdune
 include Errors
 
@@ -87,6 +89,4 @@ module No_io = struct
   module Io = struct end
 end
 
-(* This is ugly *)
+let print_to_console = Errors.print_to_console
-let printer = ref (Printf.eprintf "%s%!")
-let print_to_console s = !printer s

src/inline_tests.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 open Dune_file
 open Build.O
@@ -37,7 +38,7 @@ module Backend = struct
           (let%map loc = loc
            and runner_libraries = field "runner_libraries" (list (located string)) ~default:[]
            and flags = Ordered_set_lang.Unexpanded.field "flags"
-           and generate_runner = field_o "generate_runner" (located Action.Unexpanded.t)
+           and generate_runner = field_o "generate_runner" (located Action.Unexpanded.dparse)
            and extends = field "extends" (list (located string)) ~default:[]
            in
            { loc
@@ -74,21 +75,21 @@ module Backend = struct
                  resolve x >>= fun lib ->
                  match get ~loc lib with
                  | None ->
-                   Error (Loc.exnf loc "%S is not an %s" name
+                   Error (Errors.exnf loc "%S is not an %s" name
                             (desc ~plural:false))
                  | Some t -> Ok t))
       }
 
-    let to_sexp t =
+    let dgen t =
-      let open Sexp.To_sexp in
+      let open Dsexp.To_sexp in
       let lib x = string (Lib.name x) in
       let f x = string (Lib.name x.lib) in
       ((1, 0),
        record_fields
          [ field "runner_libraries" (list lib)
              (Result.ok_exn t.runner_libraries)
-         ; field "flags" Ordered_set_lang.Unexpanded.sexp_of_t t.info.flags
+         ; field "flags" Ordered_set_lang.Unexpanded.dgen t.info.flags
-         ; field_o "generate_runner" Action.Unexpanded.sexp_of_t
+         ; field_o "generate_runner" Action.Unexpanded.dgen
              (Option.map t.info.generate_runner ~f:snd)
          ; field "extends" (list f) (Result.ok_exn t.extends) ~default:[]
          ])
@@ -135,7 +136,7 @@ include Sub_system.Register_end_point(
           ~else_:
             (record
                (let%map loc = loc
-                and deps = field "deps" (list Dep_conf.t) ~default:[]
+                and deps = field "deps" (list Dep_conf.dparse) ~default:[]
                 and flags = Ordered_set_lang.Unexpanded.field "flags"
                 and backend = field_o "backend" (located string)
                 and libraries = field "libraries" (list (located string)) ~default:[]
@@ -260,9 +261,7 @@ include Sub_system.Register_end_point(
       SC.add_alias_action sctx
         ~loc:(Some info.loc)
         (Build_system.Alias.runtest ~dir)
-        ~stamp:(List [ Sexp.unsafe_atom_of_string "ppx-runner"
+        ~stamp:("ppx-runner", name)
-                     ; Quoted_string name
-                     ])
         (let module A = Action in
          let exe = Path.relative inline_test_dir (name ^ ".exe") in
          Build.path exe >>>

src/install.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 
 module Section = struct
@@ -58,8 +59,8 @@ module Section = struct
     |"misc"         -> Some Misc
     | _             -> None
 
-  let t =
+  let dparse =
-    let open Sexp.Of_sexp in
+    let open Dsexp.Of_sexp in
     enum
       [ "lib"          , Lib
       ; "lib_root"     , Lib_root
@@ -271,7 +272,7 @@ let load_install_file path =
       ; pos_cnum = col
       }
     in
-    Loc.fail { start =  pos; stop = pos } fmt
+    Errors.fail { start =  pos; stop = pos } fmt
   in
   List.concat_map file.file_contents ~f:(function
     | Variable (pos, section, files) -> begin

src/install.mli

@@ -1,6 +1,6 @@
 (** Opam install file *)
 
-open Stdune
+open! Stdune
 
 module Section : sig
   type t =
@@ -19,7 +19,7 @@ module Section : sig
     | Man
     | Misc
 
-  val t : t Sexp.Of_sexp.t
+  val dparse : t Dsexp.Of_sexp.t
 
   (** [true] iff the executable bit should be set for files installed
       in this location. *)

src/install_rules.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 open Dune_file
 open Build.O
@@ -22,7 +23,7 @@ module Gen(P : Params) = struct
       (Build.arr (fun () ->
          let dune_version = Option.value_exn (Lib.dune_version lib) in
          Format.asprintf "%a@."
-           (Sexp.pp (Stanza.File_kind.of_syntax dune_version))
+           (Dsexp.pp (Stanza.File_kind.of_syntax dune_version))
            (Lib.Sub_system.dump_config lib
             |> Installed_dune_file.gen ~dune_version))
        >>> Build.write_file_dyn

src/installed_dune_file.ml

@@ -1,9 +1,9 @@
-open Import
+open! Stdune
 
 let parse_sub_systems ~parsing_context sexps =
   List.filter_map sexps ~f:(fun sexp ->
     let name, ver, data =
-      Sexp.Of_sexp.(parse (triple string (located Syntax.Version.t) raw)
+      Dsexp.Of_sexp.(parse (triple string (located Syntax.Version.dparse) raw)
                       parsing_context) sexp
     in
     match Sub_system_name.get name with
@@ -12,12 +12,12 @@ let parse_sub_systems ~parsing_context sexps =
          correspond to plugins that are not in use in the current
          workspace. *)
       None
-    | Some name -> Some (name, (Sexp.Ast.loc sexp, ver, data)))
+    | Some name -> Some (name, (Dsexp.Ast.loc sexp, ver, data)))
   |> Sub_system_name.Map.of_list
   |> (function
     | Ok x -> x
     | Error (name, _, (loc, _, _)) ->
-      Loc.fail loc "%S present twice" (Sub_system_name.to_string name))
+      Errors.fail loc "%S present twice" (Sub_system_name.to_string name))
   |> Sub_system_name.Map.mapi ~f:(fun name (_, version, data) ->
     let (module M) = Dune_file.Sub_system_info.get name in
     Syntax.check_supported M.syntax version;
@@ -32,10 +32,10 @@ let parse_sub_systems ~parsing_context sexps =
       | (_, _) ->
         Univ_map.add parsing_context (Syntax.key M.syntax) (snd version)
     in
-    M.T (Sexp.Of_sexp.parse M.parse parsing_context data))
+    M.T (Dsexp.Of_sexp.parse M.parse parsing_context data))
 
 let of_sexp =
-  let open Sexp.Of_sexp in
+  let open Dsexp.Of_sexp in
   let version =
     plain_string (fun ~loc -> function
       | "1" -> (0, 0)
@@ -64,45 +64,45 @@ let load fname =
        which point we can decide what lexer to use for the reset of
        the file. *)
     let state = ref 0 in
-    let lexer = ref Sexp.Lexer.token in
+    let lexer = ref Dsexp.Lexer.token in
     let lexer lb =
-      let token : Sexp.Lexer.Token.t = !lexer lb in
+      let token : Dsexp.Lexer.Token.t = !lexer lb in
       (match !state, token with
        | 0, Lparen -> state := 1
        | 1, Atom (A "dune") -> state := 2
-       | 2, Atom (A "1") -> state := 3; lexer := Sexp.Lexer.jbuild_token
+       | 2, Atom (A "1") -> state := 3; lexer := Dsexp.Lexer.jbuild_token
-       | 2, Atom (A "2") -> state := 3; lexer := Sexp.Lexer.token
+       | 2, Atom (A "2") -> state := 3; lexer := Dsexp.Lexer.token
        | 2, Atom (A version) ->
-         Loc.fail (Sexp.Loc.of_lexbuf lexbuf) "Unsupported version %S" version
+         Errors.fail (Loc.of_lexbuf lexbuf) "Unsupported version %S" version
        | 3, _ -> ()
        | _ ->
-         Loc.fail (Sexp.Loc.of_lexbuf lexbuf)
+         Errors.fail (Loc.of_lexbuf lexbuf)
            "This <lib>.dune file looks invalid, it should \
             contain a S-expression of the form (dune x.y ..)"
       );
       token
     in
-    Sexp.Of_sexp.parse of_sexp Univ_map.empty
+    Dsexp.Of_sexp.parse of_sexp Univ_map.empty
-      (Sexp.Parser.parse ~lexer ~mode:Single lexbuf))
+      (Dsexp.Parser.parse ~lexer ~mode:Single lexbuf))
 
 let gen ~(dune_version : Syntax.Version.t) confs =
   let sexps =
     Sub_system_name.Map.to_list confs
     |> List.map ~f:(fun (name, (ver, conf)) ->
       let (module M) = Dune_file.Sub_system_info.get name in
-      Sexp.List [ Sexp.atom (Sub_system_name.to_string name)
+      Dsexp.List [ Dsexp.atom (Sub_system_name.to_string name)
-                ; Syntax.Version.sexp_of_t ver
+                ; Syntax.Version.dgen ver
                 ; conf
                 ])
   in
-  Sexp.List
+  Dsexp.List
-    [ Sexp.unsafe_atom_of_string "dune"
+    [ Dsexp.unsafe_atom_of_string "dune"
-    ; Sexp.unsafe_atom_of_string
+    ; Dsexp.unsafe_atom_of_string
         (match dune_version with
          | (0, 0) -> "1"
          | (x, _) when x >= 1 -> "2"
          | (_, _) ->
            Exn.code_error "Cannot generate dune with unknown version"
-             ["dune_version", Syntax.Version.sexp_of_t dune_version])
+             ["dune_version", Syntax.Version.to_sexp dune_version])
     ; List sexps
     ]

src/installed_dune_file.mli

@@ -1,9 +1,9 @@
 (** Dune files that are installed on the system *)
 
-open Stdune
+open! Stdune
 
 val load : Path.t -> Dune_file.Sub_system_info.t Sub_system_name.Map.t
 val gen
   : dune_version:Syntax.Version.t
-  -> (Syntax.Version.t * Sexp.t) Sub_system_name.Map.t
+  -> (Syntax.Version.t * Dsexp.t) Sub_system_name.Map.t
-  -> Sexp.t
+  -> Dsexp.t

src/jbuild_load.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 open Dune_file
 
@@ -73,7 +74,7 @@ module Jbuilds = struct
             (match (kind : File_tree.Dune_file.Kind.t) with
              | Jbuild -> ()
              | Dune ->
-               Loc.fail loc
+               Errors.fail loc
                  "#require is no longer supported in dune files.\n\
                   You can use the following function instead of \
                   Unix.open_process_in:\n\
@@ -84,7 +85,7 @@ module Jbuilds = struct
             | [] -> acc
             | ["unix"] -> Unix
             | _ ->
-              Loc.fail loc
+              Errors.fail loc
                 "Using libraries other that \"unix\" is not supported.\n\
                  See the manual for details.";
         in
@@ -207,7 +208,7 @@ end
              Did you forgot to call [Jbuild_plugin.V*.send]?"
           (Path.to_string file);
       Fiber.return
-        (Io.Sexp.load generated_jbuild ~mode:Many
+        (Dsexp.Io.load generated_jbuild ~mode:Many
            ~lexer:(File_tree.Dune_file.Kind.lexer kind)
          |> Jbuild.parse ~dir ~file ~project ~kind ~ignore_promoted_rules))
     >>| fun dynamic ->

src/jbuild_load.mli

@@ -1,4 +1,4 @@
-open Stdune
+open! Stdune
 
 module Jbuild : sig
   type t =

src/js_of_ocaml_rules.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 open! No_io
 open Build.O

src/js_of_ocaml_rules.mli

@@ -1,5 +1,6 @@
 (** Generate rules for js_of_ocaml *)
 
+open! Stdune
 open Import
 open Dune_file
 

src/lib.ml

@@ -1,4 +1,5 @@
 open Import
+open! Stdune
 open Result.O
 
 (* +-----------------------------------------------------------------+
@@ -202,7 +203,7 @@ module Sub_system0 = struct
   module type S = sig
     type t
     type sub_system += T of t
-    val to_sexp : (t -> Syntax.Version.t * Sexp.t) option
+    val dgen : (t -> Syntax.Version.t * Dsexp.t) option
   end
 
   type 'a s = (module S with type t = 'a)
@@ -319,7 +320,7 @@ exception Error of Error.t
 
 let not_available ~loc reason fmt =
   Errors.kerrf fmt ~f:(fun s ->
-    Loc.fail loc "%s %a" s
+    Errors.fail loc "%s %a" s
       Error.Library_not_available.Reason.pp reason)
 
 (* +-----------------------------------------------------------------+
@@ -455,7 +456,7 @@ module Sub_system = struct
       -> lib
       -> Info.t
       -> t
-    val to_sexp : (t -> Syntax.Version.t * Sexp.t) option
+    val dgen : (t -> Syntax.Version.t * Dsexp.t) option
   end
 
   module type S' = sig
@@ -491,7 +492,7 @@ module Sub_system = struct
     | M.Info.T info ->
       let get ~loc lib' =
         if lib.unique_id = lib'.unique_id then
-          Loc.fail loc "Library %S depends on itself" lib.name
+          Errors.fail loc "Library %S depends on itself" lib.name
         else
           M.get lib'
       in
@@ -502,7 +503,7 @@ module Sub_system = struct
   let dump_config lib =
     Sub_system_name.Map.filter_map lib.sub_systems ~f:(fun (lazy inst) ->
       let (Sub_system0.Instance.T ((module M), t)) = inst in
-      Option.map ~f:(fun f -> f t) M.to_sexp)
+      Option.map ~f:(fun f -> f t) M.dgen)
 end
 
 (* +-----------------------------------------------------------------+
@@ -582,25 +583,25 @@ let check_private_deps lib ~loc ~allow_private_deps =
     Ok lib
 
 let already_in_table (info : Info.t) name x =
-  let to_sexp = Sexp.To_sexp.(pair Path.sexp_of_t string) in
+  let dgen = Sexp.To_sexp.(pair Path.to_sexp string) in
   let sexp =
     match x with
     | St_initializing x ->
-      Sexp.List [Sexp.unsafe_atom_of_string "Initializing";
+      Sexp.List [Sexp.Atom "Initializing";
-                 Path.sexp_of_t x.path]
+                 Path.to_sexp x.path]
     | St_found t ->
-      List [Sexp.unsafe_atom_of_string "Found";
+      List [Sexp.Atom "Found";
-            Path.sexp_of_t t.info.src_dir]
+            Path.to_sexp t.info.src_dir]
     | St_not_found ->
-      Sexp.unsafe_atom_of_string "Not_found"
+      Sexp.Atom "Not_found"
     | St_hidden (_, { path; reason; _ }) ->
-      List [Sexp.unsafe_atom_of_string "Hidden";
+      List [Sexp.Atom "Hidden";
-            Path.sexp_of_t path; Sexp.atom reason]
+            Path.to_sexp path; Sexp.Atom reason]
   in
   Exn.code_error
     "Lib_db.DB: resolver returned name that's already in the table"
-    [ "name"            , Sexp.atom name
+    [ "name"            , Sexp.To_sexp.string name
-    ; "returned_lib"    , to_sexp (info.src_dir, name)
+    ; "returned_lib"    , dgen (info.src_dir, name)
     ; "conflicting_with", sexp
     ]
 
@@ -1137,7 +1138,7 @@ let report_lib_error ppf (e : Error.t) =
   | No_solution_found_for_select { loc } ->
     Format.fprintf ppf
       "%a@{<error>Error@}: No solution found for this select form.\n"
-      Loc.print loc
+      Errors.print loc
   | Dependency_cycle cycle ->
     Format.fprintf ppf
       "@{<error>Error@}: Dependency cycle detected between the \

src/lib.mli

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 
 (** {1 Generals} *)
@@ -331,7 +332,7 @@ module Sub_system : sig
       -> lib
       -> Info.t
       -> t
-    val to_sexp : (t -> Syntax.Version.t * Sexp.t) option
+    val dgen : (t -> Syntax.Version.t * Dsexp.t) option
   end
 
   module Register(M : S) : sig
@@ -339,7 +340,7 @@ module Sub_system : sig
     val get : lib -> M.t option
   end
 
-  val dump_config : lib -> (Syntax.Version.t * Sexp.t) Sub_system_name.Map.t
+  val dump_config : lib -> (Syntax.Version.t * Dsexp.t) Sub_system_name.Map.t
 end with type lib := t
 
 (** {1 Dependencies for META files} *)

src/lib_deps_info.ml

@@ -1,4 +1,4 @@
-open Import
+open! Stdune
 
 module Kind = struct
   type t =

src/lib_deps_info.mli

@@ -3,7 +3,7 @@
 (** This module implements tracking of external library dependencies,
     for [dune external-lib-deps] *)
 
-open Import
+open! Stdune
 
 module Kind : sig
   type t =

src/lib_rules.ml

@@ -1,3 +1,4 @@
+open! Stdune
 open Import
 open Build.O
 open Dune_file
@@ -226,7 +227,7 @@ module Gen (P : Install_rules.Params) = struct
       if not (match Path.parent p with
         | None -> false
         | Some p -> Path.Set.mem all_dirs p) then
-        Loc.fail loc
+        Errors.fail loc
           "File %a is not part of the current directory group. \
            This is not allowed."
           Path.pp (Path.drop_optional_build_context p)

src/lib_rules.mli

@@ -1,4 +1,4 @@
-open Stdune
+open! Stdune
 open Dune_file
 
 module Gen (S : sig val sctx : Super_context.t end) : sig
@@ -13,6 +13,6 @@ module Gen (S : sig val sctx : Super_context.t end) : sig
     -> dir_contents:Dir_contents.t
     -> dir:Path.t
     -> scope:Scope.t
-    -> dir_kind:Usexp.syntax
+    -> dir_kind:Dsexp.syntax
     -> Compilation_context.t * Merlin.t
 end

src/loc.ml

@@ -1,146 +0,0 @@
-open Import
-
-include Usexp.Loc
-
-(* TODO get rid of all this stuff once this parsing code moves to Usexp and
-   there will be no circular dependency *)
-let int n = Usexp.Atom (Usexp.Atom.of_int n)
-let string = Usexp.atom_or_quoted_string
-let record l =
-  let open Usexp in
-  List (List.map l ~f:(fun (n, v) -> List [Atom(Atom.of_string n); v]))
-
-let sexp_of_position_no_file (p : Lexing.position) =
-  record
-    [ "pos_lnum", int p.pos_lnum
-    ; "pos_bol", int p.pos_bol
-    ; "pos_cnum", int p.pos_cnum
-    ]
-
-let sexp_of_t t =
-  record (* TODO handle when pos_fname differs *)
-    [ "pos_fname", string t.start.pos_fname
-    ; "start", sexp_of_position_no_file t.start
-    ; "stop", sexp_of_position_no_file t.stop
-    ]
-
-let of_lexbuf lb =
-  { start = Lexing.lexeme_start_p lb
-  ; stop  = Lexing.lexeme_end_p   lb
-  }
-
-let exnf t fmt =
-  Format.pp_open_box err_ppf 0;
-  Format.pp_print_as err_ppf 7 ""; (* "Error: " *)
-  kerrf (fmt^^ "@]") ~f:(fun s -> Exn.Loc_error (t, s))
-
-let fail t fmt =
-  Format.pp_print_as err_ppf 7 ""; (* "Error: " *)
-  kerrf fmt ~f:(fun s ->
-    raise (Exn.Loc_error (t, s)))
-
-let fail_lex lb fmt =
-  fail (of_lexbuf lb) fmt
-
-let fail_opt t fmt =
-  match t with
-  | None -> die fmt
-  | Some t -> fail t fmt
-
-let in_file = Usexp.Loc.in_file
-
-let of_pos (fname, lnum, cnum, enum) =
-  let pos : Lexing.position =
-    { pos_fname = fname
-    ; pos_lnum  = lnum
-    ; pos_cnum  = cnum
-    ; pos_bol   = 0
-    }
-  in
-  { start = pos
-  ; stop  = { pos with pos_cnum = enum }
-  }
-
-let file_line path n =
-  Io.with_file_in ~binary:false path
-    ~f:(fun ic ->
-      for _ = 1 to n - 1 do
-        ignore (input_line ic)
-      done;
-      input_line ic
-    )
-
-let file_lines path ~start ~stop =
-  Io.with_file_in ~binary:true path
-    ~f:(fun ic ->
-      let rec aux acc lnum =
-        if lnum > stop then
-          List.rev acc
-        else if lnum < start then
-          (ignore (input_line ic);
-           aux acc (lnum + 1))
-        else
-          let line = input_line ic in
-          aux ((string_of_int lnum, line) :: acc) (lnum + 1)
-      in
-      aux [] 1
-    )
-
-let print ppf loc =
-  let { start; stop } = loc in
-  let start_c = start.pos_cnum - start.pos_bol in
-  let stop_c  = stop.pos_cnum  - start.pos_bol in
-  let num_lines = stop.pos_lnum - start.pos_lnum in
-  let pp_file_excerpt pp () =
-    let whole_file = start_c = 0 && stop_c = 0 in
-    if not whole_file then
-      let path = Path.of_string start.pos_fname in
-      if Path.exists path then
-        let line = file_line path start.pos_lnum in
-        if stop_c <= String.length line then
-          let len = stop_c - start_c in
-          Format.fprintf pp "%s\n%*s\n" line
-            stop_c
-            (String.make len '^')
-        else if num_lines <= 10 then
-          let lines = file_lines path ~start:start.pos_lnum ~stop:stop.pos_lnum in
-          let last_lnum = Option.map ~f:fst (List.last lines) in
-          let padding_width = Option.value_exn
-                                (Option.map ~f:String.length last_lnum) in
-          List.iter ~f:(fun (lnum, l) ->
-            Format.fprintf pp "%*s: %s\n" padding_width lnum l)
-          lines
-  in
-  Format.fprintf ppf
-    "@{<loc>File \"%s\", line %d, characters %d-%d:@}@\n%a"
-    start.pos_fname start.pos_lnum start_c stop_c
-    pp_file_excerpt ()
-
-let warn t fmt =
-  Errors.kerrf ~f:print_to_console
-    ("%a@{<warning>Warning@}: " ^^ fmt ^^ "@.") print t
-
-let to_file_colon_line t =
-  sprintf "%s:%d" t.start.pos_fname t.start.pos_lnum
-
-let pp_file_colon_line ppf t =
-  Format.pp_print_string ppf (to_file_colon_line t)
-
-let equal_position
-      { Lexing.pos_fname = f_a; pos_lnum = l_a
-      ; pos_bol = b_a; pos_cnum = c_a }
-      { Lexing.pos_fname = f_b; pos_lnum = l_b
-      ; pos_bol = b_b; pos_cnum = c_b }
-      =
-      let open Int.Infix in
-      String.equal f_a f_b
-      && l_a = l_b
-      && b_a = b_b
-      && c_a = c_b
-
-let equal
-      { start = start_a ; stop = stop_a }
-      { start = start_b ; stop = stop_b }
-  =
-  equal_position start_a start_b
-  && equal_position stop_a stop_b