Merge pull request #719 from rgrinberg/path-stdune

Move Sexp to Studune

src/action_intf.ml

@@ -1,3 +1,5 @@
+open Stdune
+
 module Outputs = struct
   type t =
     | Stdout

src/bin.mli

@@ -1,5 +1,7 @@
 (** OCaml binaries *)
 
+open Stdune
+
 (** Character used to separate entries in [PATH] and similar
     environment variables *)
 val path_sep : char

src/binary_kind.ml

@@ -1,3 +1,5 @@
+open Stdune
+
 type t =
   | Exe
   | Object

src/binary_kind.mli

@@ -1,5 +1,7 @@
 (** Linking modes for binaries *)
 
+open Stdune
+
 type t =
   | Exe
   | Object

src/build.ml

@@ -62,12 +62,16 @@ module Repr = struct
   let get_if_file_exists_exn state =
     match !state with
     | Decided (_, t) -> t
-    | Undecided _ -> code_errorf "Build.get_if_file_exists_exn: got undecided"
+    | Undecided _ ->
+      Exn.code_error "Build.get_if_file_exists_exn: got undecided" []
 
   let get_glob_result_exn state =
     match !state with
     | G_evaluated l -> l
-    | G_unevaluated _ -> code_errorf "Build.get_glob_result_exn: got unevaluated"
+    | G_unevaluated (loc, path, _) ->
+      Exn.code_error "Build.get_glob_result_exn: got unevaluated"
+        [ "loc", Loc.sexp_of_t loc
+        ; "path", Path.sexp_of_t path ]
 end
 include Repr
 let repr t = t

src/build_interpret.ml

@@ -169,13 +169,19 @@ let targets =
     | Fail _ -> acc
     | If_file_exists (_, state) -> begin
         match !state with
-        | Decided _ -> code_errorf "Build_interpret.targets got decided if_file_exists"
+        | Decided (v, _) ->
+          Exn.code_error "Build_interpret.targets got decided if_file_exists"
+            ["exists", Sexp.To_sexp.bool v]
         | Undecided (a, b) ->
           match loop a [], loop b [] with
           | [], [] -> acc
-          | _ ->
-            code_errorf "Build_interpret.targets: cannot have targets \
-                         under a [if_file_exists]"
+          | a, b ->
+            let targets x = Path.Set.sexp_of_t (Target.paths x) in
+            Exn.code_error "Build_interpret.targets: cannot have targets \
+                            under a [if_file_exists]"
+              [ "targets-a", targets a
+              ; "targets-b", targets b
+              ]
       end
     | Memo m -> loop m.t acc
     | Catch (t, _) -> loop t acc

src/build_system.ml

@@ -407,9 +407,11 @@ let entry_point t ~f =
   (match t.load_dir_stack with
    | [] ->
      ()
-   | _ :: _ ->
-     code_errorf
-       "Build_system.entry_point: called inside the rule generator callback");
+   | stack ->
+     Exn.code_error
+       "Build_system.entry_point: called inside the rule generator callback"
+       ["stack", Sexp.To_sexp.list Path.sexp_of_t stack]
+  );
   f ()
 
 module Target = Build_interpret.Target
@@ -517,7 +519,7 @@ let add_spec t fn spec ~copy_source =
          As a result, the rule is currently ignored, however this will become an error \
          in the future.\n\
          %t"
-        (maybe_quoted (Path.basename fn))
+        (String.maybe_quoted (Path.basename fn))
         (fun ppf ->
            match rule.mode with
            | Not_a_rule_stanza ->

src/dep_path.mli

@@ -1,5 +1,7 @@
 (** Dependency path *)
 
+open Stdune
+
 module Entry : sig
   type t =
     | Path of Path.t

src/errors.ml

@@ -1,4 +1,5 @@
-exception Fatal_error of string
+open Stdune
+
 exception Already_reported
 
 let err_buf = Buffer.create 128
@@ -12,8 +13,5 @@ let kerrf fmt ~f =
        f s)
     err_ppf fmt
 
-let code_errorf fmt =
-  kerrf fmt ~f:(fun s -> Stdune.Exn.code_error s [])
-
 let die fmt =
-  kerrf fmt ~f:(fun s -> raise (Fatal_error s))
+  kerrf fmt ~f:(fun s -> raise (Exn.Fatal_error s))

src/errors.mli

@@ -3,15 +3,6 @@
 (* CR-soon diml: stop including this in [Import] *)
 (** This module is included in [Import] *)
 
-(* CR-soon diml:
-   - Rename to [User_error]
-   - change the [string] argument to [Loc.t option * string] and get rid of
-   [Loc.Error]. The two are a bit confusing
-   - change [string] to [Colors.Style.t Pp.t]
-*)
-(** A fatal error, that should be reported to the user in a nice way *)
-exception Fatal_error of string
-
 (* CR-soon diml: we won't need this once we can generate rules dynamically *)
 (** Raised for errors that have already been reported to the user and shouldn't be
     reported again. This might happen when trying to build a dependency that has already
@@ -19,12 +10,9 @@ exception Fatal_error of string
 exception Already_reported
 
 (* CR-soon diml: Rename to [user_errorf]. *)
-(** Raise a [Fatal_error] exception *)
+(** Raise a [Exn.Fatal_error] exception *)
 val die : ('a, Format.formatter, unit, 'b) format4 -> 'a
 
-(** Raise a [Code_error] exception *)
-val code_errorf : ('a, Format.formatter, unit, 'b) format4 -> 'a
-
 (**/**)
 (* Referenced in Ansi_color and Report_error *)
 val err_buf : Buffer.t

src/import.ml

@@ -86,15 +86,6 @@ let hint name candidates =
     sprintf "\nHint: did you mean %s?" (mk_hint l)
 
 
-(* [maybe_quoted s] is [s] if [s] doesn't need escaping according to OCaml lexing
-   conventions and [sprintf "%S" s] otherwise. *)
-let maybe_quoted s =
-  let escaped = String.escaped s in
-  if s == escaped || s = escaped then
-    s
-  else
-    sprintf {|"%s"|} escaped
-
 (* Disable file operations to force to use the IO module *)
 let open_in      = `Use_Io
 let open_in_bin  = `Use_Io

src/install.mli

@@ -1,5 +1,7 @@
 (** Opam install file *)
 
+open Stdune
+
 module Section : sig
   type t =
     | Lib

src/install_rules.mli

@@ -1,3 +1,5 @@
+open Stdune
+
 module type Params = sig
   val sctx : Super_context.t
 end

src/installed_dune_file.mli

@@ -1,4 +1,6 @@
 (** Dune files that are installed on the system *)
 
+open Stdune
+
 val load : fname:string -> Jbuild.Sub_system_info.t Sub_system_name.Map.t
 val gen : (Syntax.Version.t * Sexp.t) Sub_system_name.Map.t -> Sexp.t

src/jbuild_load.ml

@@ -136,7 +136,7 @@ end
         List.concat
           [ [ "-I"; "+compiler-libs" ]
           ; cmas
-          ; [ Path.to_absolute_filename wrapper ]
+          ; [ Path.to_absolute_filename wrapper ~root:!Clflags.workspace_root ]
           ]
       in
       (* CR-someday jdimino: if we want to allow plugins to use findlib:

src/jbuild_load.mli

@@ -1,4 +1,4 @@
-open Jbuild
+open Stdune
 
 module Jbuilds : sig
   type t
@@ -6,14 +6,14 @@ module Jbuilds : sig
   val eval
     :  t
     -> context:Context.t
-    -> (Path.t * Scope_info.t * Stanzas.t) list Fiber.t
+    -> (Path.t * Jbuild.Scope_info.t * Jbuild.Stanzas.t) list Fiber.t
 end
 
 type conf =
   { file_tree : File_tree.t
   ; jbuilds   : Jbuilds.t
   ; packages  : Package.t Package.Name.Map.t
-  ; scopes    : Scope_info.t list
+  ; scopes    : Jbuild.Scope_info.t list
   }
 
 val load

src/loc.ml

@@ -5,21 +5,41 @@ type t = Usexp.Loc.t =
   ; stop  : Lexing.position
   }
 
+(* 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
   }
 
-exception Error of t * string
-
 let exnf t fmt =
   Format.pp_print_as err_ppf 7 ""; (* "Error: " *)
-  kerrf fmt ~f:(fun s -> Error (t, s))
+  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 (Error (t, s)))
+    raise (Exn.Loc_error (t, s)))
 
 let fail_lex lb fmt =
   fail (of_lexbuf lb) fmt
@@ -29,17 +49,7 @@ let fail_opt t fmt =
   | None -> die fmt
   | Some t -> fail t fmt
 
-let in_file fn =
-  let pos : Lexing.position =
-    { pos_fname = fn
-    ; pos_lnum  = 1
-    ; pos_cnum  = 0
-    ; pos_bol   = 0
-    }
-  in
-  { start = pos
-  ; stop = pos
-  }
+let in_file = Usexp.Loc.in_file
 
 let of_pos (fname, lnum, cnum, enum) =
   let pos : Lexing.position =

src/loc.mli

@@ -3,9 +3,9 @@ type t = Usexp.Loc.t =
   ; stop  : Lexing.position
   }
 
-val of_lexbuf : Lexing.lexbuf -> t
+val sexp_of_t : t -> Usexp.t
 
-exception Error of t * string
+val of_lexbuf : Lexing.lexbuf -> t
 
 val exnf     : t             -> ('a, Format.formatter, unit, exn) format4 -> 'a
 val fail     : t             -> ('a, Format.formatter, unit, 'b ) format4 -> 'a

src/menhir.mli

@@ -1,5 +1,7 @@
 (** Menhir rules *)
 
+open Stdune
+
 (** Generate the rules for a [(menhir ...)] stanza. Return the list of
     targets that are generated by these rules. This list of targets is
     used by the code that computes the list of modules in the

src/merlin.ml

@@ -70,7 +70,7 @@ let ppx_flags sctx ~dir:_ ~scope ~src_dir:_ { preprocess; libname; _ } =
   | Pps { pps; flags } ->
     let exe = Preprocessing.get_ppx_driver sctx ~scope pps in
     let command =
-      List.map (Path.to_absolute_filename exe
+      List.map (Path.to_absolute_filename exe ~root:!Clflags.workspace_root
                 :: "--as-ppx"
                 :: Preprocessing.cookie_library_name libname
                 @ flags)

src/module.ml

@@ -31,7 +31,8 @@ module File = struct
 
   let to_ocaml t =
     match t.syntax with
-    | OCaml -> code_errorf "to_ocaml: can only convert reason Files" ()
+    | OCaml -> Exn.code_error "to_ocaml: can only convert reason Files"
+                 ["t.name", Sexp.To_sexp.string t.name]
     | Reason ->
       { syntax = OCaml
       ; name =
@@ -40,7 +41,9 @@ module File = struct
           (match Filename.extension t.name with
            | ".re" -> ".ml"
            | ".rei" -> ".mli"
-           | _ -> code_errorf "to_ocaml: unrecognized extension %s" ext ())
+           | _ -> Exn.code_error "to_ocaml: unrecognized extension"
+                    [ "name", Sexp.To_sexp.string t.name
+                    ; "ext", Sexp.To_sexp.string ext ])
       }
 end
 

src/modules_partitioner.mli

@@ -1,5 +1,7 @@
 (** Checks modules partitioning inside a directory *)
 
+open Stdune
+
 type t
 
 val create

src/ocaml_flags.mli

@@ -1,5 +1,7 @@
 (** OCaml flags *)
 
+open Stdune
+
 type t
 
 val make

src/ocamldep.mli

@@ -1,5 +1,7 @@
 (** ocamldep management *)
 
+open Stdune
+
 module Dep_graph : sig
   type t
 

src/package.ml

@@ -1,3 +1,4 @@
+open Stdune
 
 module Name = struct
   include Interned.Make()

src/package.mli

@@ -1,5 +1,7 @@
 (** Information about a package defined in the workspace *)
 
+open Stdune
+
 module Name : sig
   type t
 

src/print_diff.mli

@@ -1,2 +1,4 @@
+open Stdune
+
 (** Diff two files that are expected not to match. *)
 val print : Path.t -> Path.t -> _ Fiber.t

src/report_error.ml

@@ -25,7 +25,7 @@ let report_with_backtrace exn =
   | Some p -> p
   | None ->
     match exn with
-    | Loc.Error (loc, msg) ->
+    | Exn.Loc_error (loc, msg) ->
       let loc =
         { loc with
           start = { loc.start with pos_fname = !map_fname loc.start.pos_fname }
@@ -33,6 +33,19 @@ let report_with_backtrace exn =
       in
       let pp ppf = Format.fprintf ppf "@{<error>Error@}: %s\n" msg in
       { p with loc = Some loc; pp }
+    | Sexp.Of_sexp.Of_sexp (loc, msg, hint') ->
+      let loc =
+        { loc with
+          start = { loc.start with pos_fname = !map_fname loc.start.pos_fname }
+        }
+      in
+      let pp ppf = Format.fprintf ppf "@{<error>Error@}: %s%s\n" msg
+                     (match hint' with
+                      | None -> ""
+                      | Some { Sexp.Of_sexp. on; candidates } ->
+                        hint on candidates)
+      in
+      { p with loc = Some loc; pp }
     | Usexp.Parser.Error e ->
       let pos = Usexp.Parser.Error.position e in
       let msg = Usexp.Parser.Error.message e in
@@ -42,7 +55,7 @@ let report_with_backtrace exn =
         loc = Some loc
       ; pp  = fun ppf -> Format.fprintf ppf "@{<error>Error@}: %s\n" msg
       }
-    | Fatal_error msg ->
+    | Exn.Fatal_error msg ->
       { p with pp = fun ppf ->
           if msg.[String.length msg - 1] = '\n' then
             Format.fprintf ppf "%s" msg

src/scope.mli

@@ -1,5 +1,7 @@
 (** Scopes *)
 
+open Stdune
+
 (** Representation of a Scope. It contain a library database for all
     the private libraries in the scope. *)
 type t

src/stdune/exn.ml

@@ -2,10 +2,21 @@ type t = exn
 
 exception Code_error of Usexp.t
 
+exception Fatal_error of string
+
+exception Loc_error of Usexp.Loc.t * string
+
 external raise         : exn -> _ = "%raise"
 external raise_notrace : exn -> _ = "%raise_notrace"
 external reraise       : exn -> _ = "%reraise"
 
+let fatalf ?loc fmt =
+  Format.ksprintf (fun s ->
+    match loc with
+    | None -> raise (Fatal_error s)
+    | Some loc -> raise (Loc_error (loc, s))
+  ) fmt
+
 let protectx x ~f ~finally =
   match f x with
   | y           -> finally x; y

src/stdune/exn.mli

@@ -4,6 +4,23 @@
     shouldn't try to be developer friendly rather than user friendly. *)
 exception Code_error of Usexp.t
 
+
+(* CR-soon diml:
+   - Rename to [User_error]
+   - change the [string] argument to [Loc.t option * string] and get rid of
+   [Loc.Error]. The two are a bit confusing
+   - change [string] to [Colors.Style.t Pp.t]
+*)
+(** A fatal error, that should be reported to the user in a nice way *)
+exception Fatal_error of string
+
+exception Loc_error of Usexp.Loc.t * string
+
+val fatalf
+  :  ?loc:Usexp.Loc.t
+  -> ('a, unit, string, string, string, 'b) format6
+  -> 'a
+
 val code_error : string -> (string * Usexp.t) list -> _
 
 type t = exn

src/stdune/path.ml

@@ -1,5 +1,3 @@
-open Import
-
 let explode_path =
   let rec loop path acc =
     let dir  = Filename.dirname  path in
@@ -78,7 +76,7 @@ module Local = struct
 
   let parent = function
     | "" ->
-      code_errorf "Path.Local.parent called on the root"
+      Exn.code_error "Path.Local.parent called on the root" []
     | t ->
       match String.rindex_from t (String.length t - 1) '/' with
       | exception Not_found -> ""
@@ -86,7 +84,7 @@ module Local = struct
 
   let basename = function
     | "" ->
-      code_errorf "Path.Local.basename called on the root"
+      Exn.code_error "Path.Local.basename called on the root" []
     | t ->
       let len = String.length t in
       match String.rindex_from t (len - 1) '/' with
@@ -96,11 +94,11 @@ module Local = struct
   let relative ?error_loc t path =
     let rec loop t components =
       match components with
-      | [] -> Ok t
+      | [] -> Result.Ok t
       | "." :: rest -> loop t rest
       | ".." :: rest ->
         begin match t with
-        | "" -> Error ()
+        | "" -> Result.Error ()
         | t -> loop (parent t) rest
         end
       | fn :: rest ->
@@ -109,9 +107,9 @@ module Local = struct
         | _ -> loop (t ^ "/" ^ fn) rest
     in
     match loop t (explode_path path) with
-    | Ok t -> t
+    | Result.Ok t -> t
     | Error () ->
-       Loc.fail_opt error_loc "path outside the workspace: %s from %s" path
+       Exn.fatalf ?loc:error_loc "path outside the workspace: %s from %s" path
          (to_string t)
 
   let is_canonicalized =
@@ -247,7 +245,7 @@ let to_string = function
   | t  -> t
 
 let to_string_maybe_quoted t =
-  maybe_quoted (to_string t)
+  String.maybe_quoted (to_string t)
 
 let root = ""
 
@@ -272,15 +270,16 @@ let of_string ?error_loc s =
 let t sexp = of_string (Sexp.Of_sexp.string sexp) ~error_loc:(Sexp.Ast.loc sexp)
 let sexp_of_t t = Sexp.atom_or_quoted_string (to_string t)
 
+let initial_cwd = Sys.getcwd ()
+
 let absolute fn =
   if is_local fn then
     Filename.concat initial_cwd fn
   else
     fn
 
-let to_absolute_filename t =
+let to_absolute_filename t ~root =
   if is_local t then begin
-    let root = !Clflags.workspace_root in
     assert (not (Filename.is_relative root));
     Filename.concat root (to_string t)
   end else
@@ -466,7 +465,7 @@ let insert_after_build_dir_exn =
     if not (is_local a) || String.contains b '/' then error a b;
     match String.lsplit2 a ~on:'/' with
     | Some ("_build", rest) ->
-      sprintf "_build/%s/%s" b rest
+      Printf.sprintf "_build/%s/%s" b rest
     | _ ->
       error a b
 

src/stdune/path.mli

@@ -1,5 +1,3 @@
-open Import
-
 (** In the current workspace (anything under the current project root) *)
 module Local : sig
   type t
@@ -50,7 +48,7 @@ module Map : Map.S with type key = t
 
 val kind : t -> Kind.t
 
-val of_string : ?error_loc:Loc.t -> string -> t
+val of_string : ?error_loc:Usexp.Loc.t -> string -> t
 val to_string : t -> string
 
 (** [to_string_maybe_quoted t] is [maybe_quoted (to_string t)] *)
@@ -61,15 +59,15 @@ val is_root : t -> bool
 
 val is_local : t -> bool
 
-val relative : ?error_loc:Loc.t -> t -> string -> t
+val relative : ?error_loc:Usexp.Loc.t -> t -> string -> t
 
 (** Create an external path. If the argument is relative, assume it is
     relative to the initial directory jbuilder was launched in. *)
 val absolute : string -> t
 
-(** Convert a path to an absolute filename. Must be called after the
-    workspace root has been set. *)
-val to_absolute_filename : t -> string
+(** Convert a path to an absolute filename. Must be called after the workspace
+    root has been set. [root] is the root directory of local paths *)
+val to_absolute_filename : t -> root:string -> string
 
 val reach : t -> from:t -> string
 val reach_for_running : t -> from:t -> string
@@ -147,4 +145,4 @@ val extension : t -> string
 *)
 val drop_prefix : t -> prefix:t -> string option
 
-val pp : t Fmt.t
+val pp : Format.formatter -> t -> unit

src/stdune/sexp.ml

@@ -1,7 +1,4 @@
-open Import
-
-include (Usexp : module type of struct include Usexp end
-         with module Loc := Usexp.Loc)
+include Usexp
 
 let buf_len = 65_536
 
@@ -122,13 +119,23 @@ module Of_sexp = struct
     | Quoted_string of Loc.t * string
     | List of Loc.t * ast list
 
+  type hint =
+    { on: string
+    ; candidates: string list
+    }
+
+  exception Of_sexp of Loc.t * string * hint option
+
   type 'a t = ast -> 'a
 
   let located f sexp =
     (Ast.loc sexp, f sexp)
 
-  let of_sexp_error sexp str = raise (Loc.Error (Ast.loc sexp, str))
-  let of_sexp_errorf sexp fmt = ksprintf (of_sexp_error sexp) fmt
+  let of_sexp_error ?hint sexp str = raise (Of_sexp (Ast.loc sexp, str, hint))
+  let of_sexp_errorf ?hint sexp fmt = Printf.ksprintf (of_sexp_error ?hint sexp) fmt
+
+  let of_sexp_errorf_loc loc fmt =
+    Printf.ksprintf (fun s -> raise (Of_sexp (loc, s, None))) fmt
 
   let raw x = x
 
@@ -178,9 +185,9 @@ module Of_sexp = struct
   let string_set sexp = String.Set.of_list (list string sexp)
   let string_map f sexp =
     match String.Map.of_list (list (pair string f) sexp) with
-    | Ok x -> x
+    | Result.Ok x -> x
     | Error (key, _v1, _v2) ->
-      of_sexp_error sexp (sprintf "key %S present multiple times" key)
+      of_sexp_error sexp (Printf.sprintf "key %S present multiple times" key)
 
   let string_hashtbl f sexp =
     let map = string_map f sexp in
@@ -243,7 +250,7 @@ module Of_sexp = struct
   let map_validate parse ~f state =
     let x, state' = parse state in
     match f x with
-    | Ok x -> x, state'
+    | Result.Ok x -> x, state'
     | Error msg ->
       let parsed =
         Name_map.merge state.unparsed state'.unparsed ~f:(fun _key before after ->
@@ -255,14 +262,15 @@ module Of_sexp = struct
         match
           Name_map.values parsed
           |> List.map ~f:(fun f -> Ast.loc f.entry)
-          |> List.sort ~compare:(fun a b -> compare a.Loc.start.pos_cnum b.start.pos_cnum)
+          |> List.sort ~compare:(fun a b ->
+            Int.compare a.Loc.start.pos_cnum b.start.pos_cnum)
         with
         | [] -> state.loc
         | first :: l ->
           let last = List.fold_left l ~init:first ~f:(fun _ x -> x) in
           { first with stop = last.stop }
       in
-      Loc.fail loc "%s" msg
+      of_sexp_errorf_loc loc "%s" msg
 
   module Short_syntax = struct
     type 'a t =
@@ -272,8 +280,7 @@ module Of_sexp = struct
 
     let parse t entry name =
       match t with
-      | Not_allowed ->
-        Loc.fail (Ast.loc entry) "field %s needs a value" name
+      | Not_allowed -> of_sexp_errorf entry "field %s needs a value" name
       | This    x -> x
       | Located f -> f (Ast.loc entry)
   end
@@ -290,7 +297,7 @@ module Of_sexp = struct
       match default with
       | Some v -> (v, add_known name state)
       | None ->
-        Loc.fail state.loc "field %s missing" name
+        of_sexp_errorf_loc state.loc "field %s missing" name
 
   let field_o name ?(short=Short_syntax.Not_allowed) value_of_sexp state =
     match Name_map.find state.unparsed name with
@@ -338,8 +345,8 @@ module Of_sexp = struct
         | List (_, s :: _) -> s
         | _ -> assert false
       in
-      of_sexp_errorf name_sexp
-        "Unknown field %s%s" name (hint name state.known)
+      of_sexp_errorf ~hint:({ on = name ; candidates = state.known})
+        name_sexp "Unknown field %s" name
 
   type ('a, 'b) rest =
     | No_rest : ('a, 'a) rest
@@ -413,11 +420,11 @@ module Of_sexp = struct
     | Some cstr -> cstr
     | None ->
       of_sexp_errorf sexp
-        "Unknown constructor %s%s" name
-        (hint
-           (String.uncapitalize name)
-           (List.map cstrs ~f:(fun c ->
-              String.uncapitalize (C.name c))))
+        ~hint:{ on = String.uncapitalize name
+              ; candidates = List.map cstrs ~f:(fun c ->
+                  String.uncapitalize (C.name c))
+              }
+        "Unknown constructor %s" name
 
   let sum cstrs sexp =
     match sexp with
@@ -447,9 +454,8 @@ module Of_sexp = struct
       | Some (_, value) -> value
       | None ->
         of_sexp_errorf sexp
-          "Unknown value %s%s" s
-          (hint
-             (String.uncapitalize s)
-             (List.map cstrs ~f:(fun (name, _) ->
-                String.uncapitalize name)))
+          ~hint:{ on = String.uncapitalize s
+                ; candidates =List.map cstrs ~f:(fun (name, _) ->
+                    String.uncapitalize name) }
+          "Unknown value %s" s
 end

src/stdune/sexp.mli

@@ -1,5 +1,3 @@
-open Import
-
 include module type of struct include Usexp end with module Loc := Usexp.Loc
 
 val load : fname:string -> mode:'a Parser.Mode.t -> 'a
@@ -59,16 +57,25 @@ module To_sexp : sig
   val record_fields : field list t
 end with type sexp := t
 
+module Loc = Usexp.Loc
+
 module Of_sexp : sig
   type ast = Ast.t =
     | Atom of Loc.t * Atom.t
     | Quoted_string of Loc.t * string
     | List of Loc.t * ast list
 
+  type hint =
+    { on: string
+    ; candidates: string list
+    }
+
+  exception Of_sexp of Loc.t * string * hint option
+
   include Combinators with type 'a t = Ast.t -> 'a
 
-  val of_sexp_error  : Ast.t -> string -> _
-  val of_sexp_errorf : Ast.t -> ('a, unit, string, 'b) format4 -> 'a
+  val of_sexp_error  : ?hint:hint -> Ast.t -> string -> _
+  val of_sexp_errorf : ?hint:hint -> Ast.t -> ('a, unit, string, 'b) format4 -> 'a
 
   val located : 'a t -> (Loc.t * 'a) t
 
@@ -102,7 +109,10 @@ module Of_sexp : sig
     -> 'a option record_parser
   val field_b : string -> bool record_parser
 
-  val map_validate : 'a record_parser -> f:('a -> ('b, string) result) -> 'b record_parser
+  val map_validate
+    :  'a record_parser
+    -> f:('a -> ('b, string) Result.result)
+    -> 'b record_parser
 
   val ignore_fields : string list -> unit record_parser
 

src/stdune/stdune.ml

@@ -18,6 +18,8 @@ module Set        = Set
 module Staged     = Staged
 module String     = String
 module Char       = Char
+module Sexp       = Sexp
+module Path       = Path
 
 external reraise : exn -> _ = "%reraise"
 

src/stdune/string.ml

@@ -175,5 +175,13 @@ let exists s ~f =
   with Exit ->
     true
 
+let maybe_quoted s =
+  let escaped = escaped s in
+  if s == escaped || s = escaped then
+    s
+  else
+    Printf.sprintf {|"%s"|} escaped
+
+
 module Set = Set.Make(T)
 module Map = Map.Make(T)

src/stdune/string.mli

@@ -40,5 +40,9 @@ val longest_map : 'a list -> f:('a -> string) -> int
 
 val exists : t -> f:(char -> bool) -> bool
 
+(** [maybe_quoted s] is [s] if [s] doesn't need escaping according to OCaml
+    lexing conventions and [sprintf "%S" s] otherwise. *)
+val maybe_quoted : t -> t
+
 module Set : Set.S with type elt = t
 module Map : Map.S with type key = t

src/syntax.mli

@@ -1,3 +1,4 @@
+open Stdune
 (** Versioned syntaxes *)
 
 module Version : sig

src/usexp/usexp.ml

@@ -240,7 +240,21 @@ let prepare_formatter ppf =
            | _ -> n))
     }
 
-module Loc = Sexp_ast.Loc
+module Loc = struct
+  include Sexp_ast.Loc
+
+  let in_file fn =
+    let pos : Lexing.position =
+      { pos_fname = fn
+      ; pos_lnum  = 1
+      ; pos_cnum  = 0
+      ; pos_bol   = 0
+      }
+    in
+    { start = pos
+    ; stop = pos
+    }
+end
 
 module Ast = struct
   type t = Sexp_ast.t =

src/usexp/usexp.mli

@@ -28,6 +28,8 @@ module Loc : sig
     { start : Lexing.position
     ; stop  : Lexing.position
     }
+
+  val in_file : string -> t
 end
 
 (** The S-expression type *)

src/utils.ml

@@ -117,7 +117,7 @@ let executable_object_directory ~dir name =
 
 let program_not_found ?context ?hint prog =
   die "@{<error>Error@}: Program %s not found in the tree or in PATH%s%a"
-    (maybe_quoted prog)
+    (String.maybe_quoted prog)
     (match context with
      | None -> ""
      | Some name -> sprintf " (context: %s)" name)
@@ -127,7 +127,7 @@ let program_not_found ?context ?hint prog =
     hint
 
 let library_not_found ?context ?hint lib =
-  die "@{<error>Error@}: Library %s not found%s%a" (maybe_quoted lib)
+  die "@{<error>Error@}: Library %s not found%s%a" (String.maybe_quoted lib)
     (match context with
      | None -> ""
      | Some name -> sprintf " (context: %s)" name)

src/utop.ml

@@ -11,7 +11,8 @@ let pp_ml fmt include_dirs =
   let pp_include fmt =
     let pp_sep fmt () = Format.fprintf fmt "@ ; " in
     Format.pp_print_list ~pp_sep (fun fmt p ->
-      Format.fprintf fmt "%S" (Path.to_absolute_filename p)
+      Format.fprintf fmt "%S" (Path.to_absolute_filename p
+                                 ~root:!Clflags.workspace_root)
     ) fmt
   in
   Format.fprintf fmt "@[<v 2>Clflags.include_dirs :=@ [ %a@ ]@];@."

src/utop.mli

@@ -1,5 +1,7 @@
 (** Utop rules *)
 
+open Stdune
+
 val utop_exe : Path.t -> Path.t
 (** Return the path of the utop bytecode binary inside a directory where
     some libraries are defined. *)

test/unit-tests/action.mlt

@@ -12,7 +12,7 @@ let infer (a : Action.t) =
   (List.map (Path.Set.to_list x.deps) ~f:Path.to_string,
    List.map (Path.Set.to_list x.targets) ~f:Path.to_string)
 [%%expect{|
-val p : ?error_loc:Jbuilder.Loc.t -> string -> Jbuilder.Path.t = <fun>
+val p : ?error_loc:Usexp.Loc.t -> string -> Jbuilder.Import.Path.t = <fun>
 val infer : Jbuilder.Action.t -> string list * string list = <fun>
 |}]
 

test/unit-tests/path.mlt

@@ -1,6 +1,5 @@
 (* -*- tuareg -*- *)
-open Jbuilder;;
-open Import;;
+open Stdune;;
 
 let r = Path.(relative root);;
 
@@ -8,44 +7,44 @@ let r = Path.(relative root);;
 
 Path.(let p = relative root "foo" in descendant p ~of_:p)
 [%%expect{|
-val r : string -> Jbuilder.Path.t = <fun>
-- : Jbuilder.Path.t option = Some foo
+val r : string -> Stdune.Path.t = <fun>
+- : Stdune.Path.t option = Some foo
 |}]
 
 (* different strings but same length *)
 Path.(descendant (relative root "foo") ~of_:(relative root "bar"))
 [%%expect{|
-- : Jbuilder.Path.t option = None
+- : Stdune.Path.t option = None
 |}]
 
 Path.(descendant (r "foo") ~of_:(r "foo/"))
 [%%expect{|
-- : Jbuilder.Path.t option = Some foo
+- : Stdune.Path.t option = Some foo
 |}]
 
 Path.(descendant (r "foo/") ~of_:(r "foo"))
 [%%expect{|
-- : Jbuilder.Path.t option = Some foo
+- : Stdune.Path.t option = Some foo
 |}]
 
 Path.(descendant (r "foo/bar") ~of_:(r "foo"))
 [%%expect{|
-- : Jbuilder.Path.t option = Some bar
+- : Stdune.Path.t option = Some bar
 |}]
 
 Path.(descendant Path.root ~of_:(r "foo"))
 [%%expect{|
-- : Jbuilder.Path.t option = None
+- : Stdune.Path.t option = None
 |}]
 
 Path.(descendant Path.root ~of_:Path.root)
 [%%expect{|
-- : Jbuilder.Path.t option = Some .
+- : Stdune.Path.t option = Some .
 |}]
 
 Path.(descendant (r "foo") ~of_:Path.root)
 [%%expect{|
-- : Jbuilder.Path.t option = Some foo
+- : Stdune.Path.t option = Some foo
 |}]
 
 Path.explode (Path.of_string "a/b/c");