From 10c01ac74187dc875cbf37ebe21c472ef3daca28 Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <rudi.grinberg@gmail.com>
Date: Tue, 24 Apr 2018 01:47:54 +0700
Subject: [PATCH] Move Sexp to stdune

In the process, change all the Loc.fail's to Of_sexp exceptions
---
 src/binary_kind.ml          |  2 ++
 src/binary_kind.mli         |  2 ++
 src/install.mli             |  2 ++
 src/installed_dune_file.mli |  2 ++
 src/{ => stdune}/sexp.ml    | 18 +++++++++---------
 src/{ => stdune}/sexp.mli   |  4 ++--
 src/stdune/stdune.ml        |  1 +
 src/syntax.mli              |  1 +
 8 files changed, 21 insertions(+), 11 deletions(-)
 rename src/{ => stdune}/sexp.ml (97%)
 rename src/{ => stdune}/sexp.mli (99%)

diff --git a/src/binary_kind.ml b/src/binary_kind.ml
index 4cde7c91..78174f49 100644
--- a/src/binary_kind.ml
+++ b/src/binary_kind.ml
@@ -1,3 +1,5 @@
+open Stdune
+
 type t =
   | Exe
   | Object
diff --git a/src/binary_kind.mli b/src/binary_kind.mli
index 462b74f6..707188b4 100644
--- a/src/binary_kind.mli
+++ b/src/binary_kind.mli
@@ -1,5 +1,7 @@
 (** Linking modes for binaries *)
 
+open Stdune
+
 type t =
   | Exe
   | Object
diff --git a/src/install.mli b/src/install.mli
index 99501d8e..225b0442 100644
--- a/src/install.mli
+++ b/src/install.mli
@@ -1,5 +1,7 @@
 (** Opam install file *)
 
+open Stdune
+
 module Section : sig
   type t =
     | Lib
diff --git a/src/installed_dune_file.mli b/src/installed_dune_file.mli
index 32532b55..18425920 100644
--- a/src/installed_dune_file.mli
+++ b/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
diff --git a/src/sexp.ml b/src/stdune/sexp.ml
similarity index 97%
rename from src/sexp.ml
rename to src/stdune/sexp.ml
index 64f1a754..6ea5468f 100644
--- a/src/sexp.ml
+++ b/src/stdune/sexp.ml
@@ -1,7 +1,4 @@
-open Stdune
-
-include (Usexp : module type of struct include Usexp end
-         with module Loc := Usexp.Loc)
+include Usexp
 
 let buf_len = 65_536
 
@@ -137,6 +134,9 @@ module Of_sexp = struct
   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
 
   let unit = function
@@ -262,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 =
@@ -279,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
@@ -297,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
diff --git a/src/sexp.mli b/src/stdune/sexp.mli
similarity index 99%
rename from src/sexp.mli
rename to src/stdune/sexp.mli
index 2f1a44b1..29dace12 100644
--- a/src/sexp.mli
+++ b/src/stdune/sexp.mli
@@ -1,5 +1,3 @@
-open Stdune
-
 include module type of struct include Usexp end with module Loc := Usexp.Loc
 
 val load : fname:string -> mode:'a Parser.Mode.t -> 'a
@@ -59,6 +57,8 @@ 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
diff --git a/src/stdune/stdune.ml b/src/stdune/stdune.ml
index 90676cd2..cf1f3241 100644
--- a/src/stdune/stdune.ml
+++ b/src/stdune/stdune.ml
@@ -18,6 +18,7 @@ module Set        = Set
 module Staged     = Staged
 module String     = String
 module Char       = Char
+module Sexp       = Sexp
 
 external reraise : exn -> _ = "%reraise"
 
diff --git a/src/syntax.mli b/src/syntax.mli
index d13bd3e3..219e376c 100644
--- a/src/syntax.mli
+++ b/src/syntax.mli
@@ -1,3 +1,4 @@
+open Stdune
 (** Versioned syntaxes *)
 
 module Version : sig