From d22eebf5a15e15cf8dae2242d72621190fc4fcd0 Mon Sep 17 00:00:00 2001
From: Jeremie Dimino <jdimino@janestreet.com>
Date: Tue, 22 May 2018 17:34:39 +0100
Subject: [PATCH 01/11] Simplify the API for parsing remaining arguments of
 constructors

---
 src/action.ml       |  4 ++--
 src/jbuild.ml       |  2 +-
 src/stdune/sexp.ml  | 47 ++++++++++++++++++---------------------------
 src/stdune/sexp.mli | 14 +-------------
 4 files changed, 23 insertions(+), 44 deletions(-)

diff --git a/src/action.ml b/src/action.ml
index f6083123..6255d017 100644
--- a/src/action.ml
+++ b/src/action.ml
@@ -30,7 +30,7 @@ struct
   let rec t sexp =
     let path = Path.t and string = String.t in
     sum
-      [ cstr_rest "run" (Program.t @> nil) string (fun prog args -> Run (prog, args))
+      [ cstr "run" (Program.t @> rest string) (fun prog args -> Run (prog, args))
       ; cstr "chdir"    (path @> t @> nil)        (fun dn t -> Chdir (dn, t))
       ; cstr "setenv"   (string @> string @> t @> nil)   (fun k v t -> Setenv (k, v, t))
       ; cstr "with-stdout-to"  (path @> t @> nil) (fun fn t -> Redirect (Stdout, fn, t))
@@ -39,7 +39,7 @@ struct
       ; cstr "ignore-stdout"   (t @> nil)      (fun t -> Ignore (Stdout, t))
       ; cstr "ignore-stderr"   (t @> nil)      (fun t -> Ignore (Stderr, t))
       ; cstr "ignore-outputs"  (t @> nil)      (fun t -> Ignore (Outputs, t))
-      ; cstr_rest "progn"      nil t         (fun l -> Progn l)
+      ; cstr "progn"           (rest t)        (fun l -> Progn l)
       ; cstr "echo"           (string @> nil)         (fun x -> Echo x)
       ; cstr "cat"            (path @> nil)         (fun x -> Cat x)
       ; cstr "copy" (path @> path @> nil)              (fun src dst -> Copy (src, dst))
diff --git a/src/jbuild.ml b/src/jbuild.ml
index ecd5f483..5286d337 100644
--- a/src/jbuild.ml
+++ b/src/jbuild.ml
@@ -1265,7 +1265,7 @@ module Stanzas = struct
           (fun glob -> [Copy_files {add_line_directive = false; glob}])
       ; cstr "copy_files#" (Copy_files.v1 @> nil)
           (fun glob -> [Copy_files {add_line_directive = true; glob}])
-      ; cstr_rest_loc "env" nil Env.rule
+      ; cstr_loc "env" (rest Env.rule)
           (fun loc rules -> [Env { loc; rules }])
       (* Just for validation and error messages *)
       ; cstr "jbuild_version" (Jbuild_version.t @> nil) (fun _ -> [])
diff --git a/src/stdune/sexp.ml b/src/stdune/sexp.ml
index cc42e58a..45103d4f 100644
--- a/src/stdune/sexp.ml
+++ b/src/stdune/sexp.ml
@@ -336,35 +336,31 @@ module Of_sexp = struct
       of_sexp_errorf ~hint:({ on = name ; candidates = state.known})
         name_sexp "Unknown field %s" name
 
-  type ('a, 'b) rest =
-    | No_rest : ('a, 'a) rest
-    | Many    : 'a t -> ('a list -> 'b, 'b) rest
-
   module Constructor_args_spec = struct
     type 'a conv = 'a t
     type ('a, 'b) t =
       | Nil  : ('a, 'a) t
+      | Rest : 'a conv -> ('a  list -> 'b, 'b) t
       | Cons : 'a conv * ('b, 'c) t -> ('a -> 'b, 'c) t
 
-    let rec convert : type a b c. (a, b) t -> (b, c) rest -> Ast.t -> Ast.t list -> a -> c
-      = fun t rest sexp sexps f ->
-        match t, rest, sexps with
-        | Nil, No_rest, [] -> f
-        | Nil, Many _ , [] -> f []
-        | Cons _, _, [] -> of_sexp_error sexp "not enough arguments"
-        | Nil, No_rest, _ :: _ -> of_sexp_error sexp "too many arguments"
-        | Nil, Many conv, l -> f (List.map l ~f:conv)
-        | Cons (conv, t), _, s :: sexps ->
-          convert t rest sexp sexps (f (conv s))
+    let rec convert : type a b. (a, b) t -> Ast.t -> Ast.t list -> a -> b
+      = fun t sexp sexps f ->
+        match t, sexps with
+        | Nil, [] -> f
+        | Rest conv, l  -> f (List.map l ~f:conv)
+        | Cons (conv, t), s :: sexps -> convert t sexp sexps (f (conv s))
+        | Cons _, [] -> of_sexp_error sexp "not enough arguments"
+        | Nil, _ :: _ -> of_sexp_error sexp "too many arguments"
   end
 
   let nil = Constructor_args_spec.Nil
   let ( @> ) a b = Constructor_args_spec.Cons (a, b)
+  let rest f = Constructor_args_spec.Rest f
 
   let field_multi name ?default args_spec f state =
     match find_single state name with
     | Some { values; entry; _ } ->
-      (Constructor_args_spec.convert args_spec No_rest entry values f,
+      (Constructor_args_spec.convert args_spec entry values f,
        consume name state)
     | None ->
       match default with
@@ -377,7 +373,7 @@ module Of_sexp = struct
       | None -> acc
       | Some { values; entry; prev } ->
         let x =
-          Constructor_args_spec.convert args_spec No_rest entry values f
+          Constructor_args_spec.convert args_spec entry values f
         in
         loop (x :: acc) prev
     in
@@ -385,10 +381,9 @@ module Of_sexp = struct
     (res, consume name state)
 
   module Constructor_spec = struct
-    type ('a, 'b, 'c) tuple =
+    type ('a, 'b) tuple =
       { name : string
       ; args : ('a, 'b) Constructor_args_spec.t
-      ; rest : ('b, 'c) rest
       ; make : Loc.t -> 'a
       }
 
@@ -398,8 +393,8 @@ module Of_sexp = struct
       }
 
     type 'a t =
-      | Tuple  : (_, _, 'a) tuple -> 'a t
-      | Record : 'a record        -> 'a t
+      | Tuple  : (_, 'a) tuple -> 'a t
+      | Record : 'a record     -> 'a t
 
     let name = function
       | Tuple  x -> x.name
@@ -408,9 +403,7 @@ module Of_sexp = struct
   module C = Constructor_spec
 
   let cstr_loc name args make =
-    C.Tuple { name; args; make; rest = No_rest }
-  let cstr_rest_loc name args rest make =
-    C.Tuple { name; args; make; rest = Many rest }
+    C.Tuple { name; args; make }
 
   let cstr_record name parse =
     C.Record { name; parse }
@@ -418,9 +411,6 @@ module Of_sexp = struct
   let cstr name args make =
     cstr_loc name args (fun _ -> make)
 
-  let cstr_rest name args rest make =
-    cstr_rest_loc name args rest (fun _ -> make)
-
   let equal_cstr_name a b = Name.compare a b = Eq
 
   let find_cstr cstrs sexp name =
@@ -441,7 +431,7 @@ module Of_sexp = struct
     match sexp with
     | Atom (loc, A s) -> begin
         match find_cstr cstrs sexp s with
-        | C.Tuple  t -> Constructor_args_spec.convert t.args t.rest sexp [] (t.make loc)
+        | C.Tuple  t -> Constructor_args_spec.convert t.args sexp [] (t.make loc)
         | C.Record _ -> of_sexp_error sexp "'%s' expect arguments"
       end
     | Quoted_string _ -> of_sexp_error sexp "Atom expected"
@@ -451,7 +441,8 @@ module Of_sexp = struct
       | Quoted_string _ | List _ -> of_sexp_error name_sexp "Atom expected"
       | Atom (_, A s) ->
         match find_cstr cstrs sexp s with
-        | C.Tuple  t -> Constructor_args_spec.convert t.args t.rest sexp args (t.make loc)
+        | C.Tuple  t -> Constructor_args_spec.convert t.args sexp args
+                          (t.make loc)
         | C.Record r -> record r.parse (List (loc, args))
 
   let enum cstrs sexp =
diff --git a/src/stdune/sexp.mli b/src/stdune/sexp.mli
index e152d6ae..329355b4 100644
--- a/src/stdune/sexp.mli
+++ b/src/stdune/sexp.mli
@@ -129,6 +129,7 @@ module Of_sexp : sig
     :  'a t
     -> ('b, 'c) Constructor_args_spec.t
     -> ('a -> 'b, 'c) Constructor_args_spec.t
+  val rest : 'a t -> ('a list -> 'b, 'b) Constructor_args_spec.t
 
   (** Field that takes multiple values *)
   val field_multi
@@ -147,12 +148,6 @@ module Of_sexp : sig
     -> 'b list record_parser
 
   val cstr : string -> ('a, 'b) Constructor_args_spec.t -> 'a -> 'b Constructor_spec.t
-  val cstr_rest
-    :  string
-    -> ('a, 'b list -> 'c) Constructor_args_spec.t
-    -> 'b t
-    -> 'a
-    -> 'c Constructor_spec.t
 
   val cstr_record : string -> 'a record_parser -> 'a Constructor_spec.t
 
@@ -162,13 +157,6 @@ module Of_sexp : sig
     -> (Loc.t -> 'a)
     -> 'b Constructor_spec.t
 
-  val cstr_rest_loc
-    :  string
-    -> ('a, 'b list -> 'c) Constructor_args_spec.t
-    -> 'b t
-    -> (Loc.t -> 'a)
-    -> 'c Constructor_spec.t
-
   val sum
     :  'a Constructor_spec.t list
     -> 'a t

From b48b1a168b947a268088c27787d62023fd37d6b7 Mon Sep 17 00:00:00 2001
From: Jeremie Dimino <jdimino@janestreet.com>
Date: Tue, 22 May 2018 17:53:34 +0100
Subject: [PATCH 02/11] Simplify the API for capturing the location of
 constructors

---
 src/action.ml       |  2 +-
 src/jbuild.ml       | 12 ++++++------
 src/stdune/sexp.ml  | 19 +++++++++----------
 src/stdune/sexp.mli | 19 +++++++++++++------
 src/workspace.ml    |  2 +-
 5 files changed, 30 insertions(+), 24 deletions(-)

diff --git a/src/action.ml b/src/action.ml
index 6255d017..dd0b02ef 100644
--- a/src/action.ml
+++ b/src/action.ml
@@ -49,7 +49,7 @@ struct
       *)
       ; cstr "copy#" (path @> path @> nil) (fun src dst ->
           Copy_and_add_line_directive (src, dst))
-      ; cstr_loc "copy-and-add-line-directive" (path @> path @> nil) (fun loc src dst ->
+      ; cstr "copy-and-add-line-directive" (cstr_loc (path @> path @> nil)) (fun loc src dst ->
           Loc.warn loc "copy-and-add-line-directive is deprecated, use copy# instead";
           Copy_and_add_line_directive (src, dst))
       ; cstr "copy#" (path @> path @> nil) (fun src dst ->
diff --git a/src/jbuild.ml b/src/jbuild.ml
index 5286d337..efc6082d 100644
--- a/src/jbuild.ml
+++ b/src/jbuild.ml
@@ -1252,12 +1252,12 @@ module Stanzas = struct
       [ cstr "library"     (Library.v1 project @> nil) (fun x -> [Library x])
       ; cstr "executable"  (Executables.v1_single project @> nil) execs
       ; cstr "executables" (Executables.v1_multi  project @> nil) execs
-      ; cstr_loc "rule"      (Rule.v1     @> nil) (fun loc x -> [Rule { x with loc }])
-      ; cstr_loc "ocamllex" (Rule.ocamllex_v1 @> nil)
+      ; cstr "rule"        (cstr_loc (Rule.v1 @> nil)) (fun loc x -> [Rule { x with loc }])
+      ; cstr "ocamllex"    (cstr_loc (Rule.ocamllex_v1 @> nil))
           (fun loc x -> rules (Rule.ocamllex_to_rule loc x))
-      ; cstr_loc "ocamlyacc" (Rule.ocamlyacc_v1 @> nil)
+      ; cstr "ocamlyacc"   (cstr_loc (Rule.ocamlyacc_v1 @> nil))
           (fun loc x -> rules (Rule.ocamlyacc_to_rule loc x))
-      ; cstr_loc "menhir" (Menhir.v1 @> nil)
+      ; cstr "menhir"      (cstr_loc (Menhir.v1 @> nil))
           (fun loc x -> [Menhir { x with loc }])
       ; cstr "install"     (Install_conf.v1 project @> nil) (fun x -> [Install     x])
       ; cstr "alias"       (Alias_conf.v1 project @> nil)   (fun x -> [Alias       x])
@@ -1265,11 +1265,11 @@ module Stanzas = struct
           (fun glob -> [Copy_files {add_line_directive = false; glob}])
       ; cstr "copy_files#" (Copy_files.v1 @> nil)
           (fun glob -> [Copy_files {add_line_directive = true; glob}])
-      ; cstr_loc "env" (rest Env.rule)
+      ; cstr "env" (cstr_loc (rest Env.rule))
           (fun loc rules -> [Env { loc; rules }])
       (* Just for validation and error messages *)
       ; cstr "jbuild_version" (Jbuild_version.t @> nil) (fun _ -> [])
-      ; cstr_loc "include" (relative_file @> nil) (fun loc fn ->
+      ; cstr "include" (cstr_loc (relative_file @> nil)) (fun loc fn ->
           let include_stack = (loc, file) :: include_stack in
           let dir = Path.parent_exn file in
           let file = Path.relative dir fn in
diff --git a/src/stdune/sexp.ml b/src/stdune/sexp.ml
index 45103d4f..f29dbee2 100644
--- a/src/stdune/sexp.ml
+++ b/src/stdune/sexp.ml
@@ -341,13 +341,15 @@ module Of_sexp = struct
     type ('a, 'b) t =
       | Nil  : ('a, 'a) t
       | Rest : 'a conv -> ('a  list -> 'b, 'b) t
+      | Loc  : ('a, 'b) t -> (Loc.t -> 'a, 'b) t
       | Cons : 'a conv * ('b, 'c) t -> ('a -> 'b, 'c) t
 
     let rec convert : type a b. (a, b) t -> Ast.t -> Ast.t list -> a -> b
       = fun t sexp sexps f ->
         match t, sexps with
         | Nil, [] -> f
-        | Rest conv, l  -> f (List.map l ~f:conv)
+        | Rest conv, l -> f (List.map l ~f:conv)
+        | Loc t, sexps -> convert t sexp sexps (f (Ast.loc sexp))
         | Cons (conv, t), s :: sexps -> convert t sexp sexps (f (conv s))
         | Cons _, [] -> of_sexp_error sexp "not enough arguments"
         | Nil, _ :: _ -> of_sexp_error sexp "too many arguments"
@@ -356,6 +358,7 @@ module Of_sexp = struct
   let nil = Constructor_args_spec.Nil
   let ( @> ) a b = Constructor_args_spec.Cons (a, b)
   let rest f = Constructor_args_spec.Rest f
+  let cstr_loc x = Constructor_args_spec.Loc x
 
   let field_multi name ?default args_spec f state =
     match find_single state name with
@@ -384,7 +387,7 @@ module Of_sexp = struct
     type ('a, 'b) tuple =
       { name : string
       ; args : ('a, 'b) Constructor_args_spec.t
-      ; make : Loc.t -> 'a
+      ; make : 'a
       }
 
     type 'a record =
@@ -402,15 +405,12 @@ module Of_sexp = struct
   end
   module C = Constructor_spec
 
-  let cstr_loc name args make =
+  let cstr name args make =
     C.Tuple { name; args; make }
 
   let cstr_record name parse =
     C.Record { name; parse }
 
-  let cstr name args make =
-    cstr_loc name args (fun _ -> make)
-
   let equal_cstr_name a b = Name.compare a b = Eq
 
   let find_cstr cstrs sexp name =
@@ -429,9 +429,9 @@ module Of_sexp = struct
 
   let sum cstrs sexp =
     match sexp with
-    | Atom (loc, A s) -> begin
+    | Atom (_, A s) -> begin
         match find_cstr cstrs sexp s with
-        | C.Tuple  t -> Constructor_args_spec.convert t.args sexp [] (t.make loc)
+        | C.Tuple  t -> Constructor_args_spec.convert t.args sexp [] t.make
         | C.Record _ -> of_sexp_error sexp "'%s' expect arguments"
       end
     | Quoted_string _ -> of_sexp_error sexp "Atom expected"
@@ -441,8 +441,7 @@ module Of_sexp = struct
       | Quoted_string _ | List _ -> of_sexp_error name_sexp "Atom expected"
       | Atom (_, A s) ->
         match find_cstr cstrs sexp s with
-        | C.Tuple  t -> Constructor_args_spec.convert t.args sexp args
-                          (t.make loc)
+        | C.Tuple  t -> Constructor_args_spec.convert t.args sexp args t.make
         | C.Record r -> record r.parse (List (loc, args))
 
   let enum cstrs sexp =
diff --git a/src/stdune/sexp.mli b/src/stdune/sexp.mli
index 329355b4..8d3bf849 100644
--- a/src/stdune/sexp.mli
+++ b/src/stdune/sexp.mli
@@ -129,8 +129,15 @@ module Of_sexp : sig
     :  'a t
     -> ('b, 'c) Constructor_args_spec.t
     -> ('a -> 'b, 'c) Constructor_args_spec.t
+
+  (** Parse all remaining arguments using the following parser *)
   val rest : 'a t -> ('a list -> 'b, 'b) Constructor_args_spec.t
 
+  (** Capture the location of the constructor *)
+  val cstr_loc
+    :  ('a, 'b) Constructor_args_spec.t
+    -> (Loc.t -> 'a, 'b) Constructor_args_spec.t
+
   (** Field that takes multiple values *)
   val field_multi
     :  string
@@ -147,15 +154,15 @@ module Of_sexp : sig
     -> 'a
     -> 'b list record_parser
 
-  val cstr : string -> ('a, 'b) Constructor_args_spec.t -> 'a -> 'b Constructor_spec.t
-
-  val cstr_record : string -> 'a record_parser -> 'a Constructor_spec.t
-
-  val cstr_loc
+  val cstr
     :  string
     -> ('a, 'b) Constructor_args_spec.t
-    -> (Loc.t -> 'a)
+    -> 'a
     -> 'b Constructor_spec.t
+  val cstr_record
+    :  string
+    -> 'a record_parser
+    -> 'a Constructor_spec.t
 
   val sum
     :  'a Constructor_spec.t list
diff --git a/src/workspace.ml b/src/workspace.ml
index 7af6068b..a42d3c21 100644
--- a/src/workspace.ml
+++ b/src/workspace.ml
@@ -95,7 +95,7 @@ type item = Context of Sexp.Ast.t | Profile of Loc.t * string
 let item_of_sexp =
   sum
     [ cstr "context" (raw @> nil) (fun x -> Context x)
-    ; cstr_loc "profile" (string @> nil) (fun loc x -> Profile (loc, x))
+    ; cstr "profile" (cstr_loc (string @> nil)) (fun loc x -> Profile (loc, x))
     ]
 
 let t ?x ?profile:cmdline_profile sexps =

From 48cd886bfcd48b43a15dd661f092fc3e1c354039 Mon Sep 17 00:00:00 2001
From: Jeremie Dimino <jdimino@janestreet.com>
Date: Tue, 22 May 2018 18:09:30 +0100
Subject: [PATCH 03/11] Simplify the API for inlined records in constructors

---
 src/stdune/sexp.ml  | 60 ++++++++++++++++++++-------------------------
 src/stdune/sexp.mli |  7 +++---
 src/workspace.ml    | 10 +++++---
 3 files changed, 35 insertions(+), 42 deletions(-)

diff --git a/src/stdune/sexp.ml b/src/stdune/sexp.ml
index f29dbee2..6a918df9 100644
--- a/src/stdune/sexp.ml
+++ b/src/stdune/sexp.ml
@@ -339,18 +339,26 @@ module Of_sexp = struct
   module Constructor_args_spec = struct
     type 'a conv = 'a t
     type ('a, 'b) t =
-      | Nil  : ('a, 'a) t
-      | Rest : 'a conv -> ('a  list -> 'b, 'b) t
-      | Loc  : ('a, 'b) t -> (Loc.t -> 'a, 'b) t
-      | Cons : 'a conv * ('b, 'c) t -> ('a -> 'b, 'c) t
+      | Nil    : ('a, 'a) t
+      | Rest   : 'a conv -> ('a  list -> 'b, 'b) t
+      | Record : 'a record_parser -> ('a -> 'b, 'b) t
+      | Loc    : ('a, 'b) t -> (Loc.t -> 'a, 'b) t
+      | Cons   : 'a conv * ('b, 'c) t -> ('a -> 'b, 'c) t
 
     let rec convert : type a b. (a, b) t -> Ast.t -> Ast.t list -> a -> b
       = fun t sexp sexps f ->
         match t, sexps with
         | Nil, [] -> f
         | Rest conv, l -> f (List.map l ~f:conv)
-        | Loc t, sexps -> convert t sexp sexps (f (Ast.loc sexp))
-        | Cons (conv, t), s :: sexps -> convert t sexp sexps (f (conv s))
+        | Record rp, l -> begin
+            match sexp with
+            | Atom (_, A s) | Quoted_string (_, s) ->
+              of_sexp_errorf sexp "'%s' expect arguments" s
+            | List (loc, _) ->
+              f (record rp (List (loc, l)))
+          end
+        | Loc t, l -> convert t sexp l (f (Ast.loc sexp))
+        | Cons (conv, t), s :: l -> convert t sexp l (f (conv s))
         | Cons _, [] -> of_sexp_error sexp "not enough arguments"
         | Nil, _ :: _ -> of_sexp_error sexp "too many arguments"
   end
@@ -359,6 +367,7 @@ module Of_sexp = struct
   let ( @> ) a b = Constructor_args_spec.Cons (a, b)
   let rest f = Constructor_args_spec.Rest f
   let cstr_loc x = Constructor_args_spec.Loc x
+  let rest_as_record rp = Constructor_args_spec.Record rp
 
   let field_multi name ?default args_spec f state =
     match find_single state name with
@@ -384,32 +393,19 @@ module Of_sexp = struct
     (res, consume name state)
 
   module Constructor_spec = struct
-    type ('a, 'b) tuple =
+    type ('a, 'b) unpacked =
       { name : string
       ; args : ('a, 'b) Constructor_args_spec.t
       ; make : 'a
       }
 
-    type 'a record =
-      { name  : string
-      ; parse : 'a record_parser
-      }
+    type 'a t = T : (_, 'a) unpacked -> 'a t [@@unboxed]
 
-    type 'a t =
-      | Tuple  : (_, 'a) tuple -> 'a t
-      | Record : 'a record     -> 'a t
-
-    let name = function
-      | Tuple  x -> x.name
-      | Record x -> x.name
+    let name (T t) = t.name
   end
   module C = Constructor_spec
 
-  let cstr name args make =
-    C.Tuple { name; args; make }
-
-  let cstr_record name parse =
-    C.Record { name; parse }
+  let cstr name args make = C.T { name; args; make }
 
   let equal_cstr_name a b = Name.compare a b = Eq
 
@@ -422,27 +418,23 @@ module Of_sexp = struct
     | None ->
       of_sexp_errorf sexp
         ~hint:{ on = String.uncapitalize name
-              ; candidates = List.map cstrs ~f:(fun c ->
-                  String.uncapitalize (C.name c))
+              ; candidates = List.map cstrs ~f:C.name
               }
         "Unknown constructor %s" name
 
   let sum cstrs sexp =
     match sexp with
-    | Atom (_, A s) -> begin
-        match find_cstr cstrs sexp s with
-        | C.Tuple  t -> Constructor_args_spec.convert t.args sexp [] t.make
-        | C.Record _ -> of_sexp_error sexp "'%s' expect arguments"
-      end
+    | Atom (_, A s) ->
+      let (C.T cstr) = find_cstr cstrs sexp s in
+      Constructor_args_spec.convert cstr.args sexp [] cstr.make
     | Quoted_string _ -> of_sexp_error sexp "Atom expected"
     | List (_, []) -> of_sexp_error sexp "non-empty list expected"
-    | List (loc, name_sexp :: args) ->
+    | List (_, name_sexp :: args) ->
       match name_sexp with
       | Quoted_string _ | List _ -> of_sexp_error name_sexp "Atom expected"
       | Atom (_, A s) ->
-        match find_cstr cstrs sexp s with
-        | C.Tuple  t -> Constructor_args_spec.convert t.args sexp args t.make
-        | C.Record r -> record r.parse (List (loc, args))
+        let (C.T cstr) = find_cstr cstrs sexp s in
+        Constructor_args_spec.convert cstr.args sexp args cstr.make
 
   let enum cstrs sexp =
     match sexp with
diff --git a/src/stdune/sexp.mli b/src/stdune/sexp.mli
index 8d3bf849..f4f826e5 100644
--- a/src/stdune/sexp.mli
+++ b/src/stdune/sexp.mli
@@ -133,6 +133,9 @@ module Of_sexp : sig
   (** Parse all remaining arguments using the following parser *)
   val rest : 'a t -> ('a list -> 'b, 'b) Constructor_args_spec.t
 
+  (** Parse all remaining arguments using the following record parser *)
+  val rest_as_record : 'a record_parser -> ('a -> 'b, 'b) Constructor_args_spec.t
+
   (** Capture the location of the constructor *)
   val cstr_loc
     :  ('a, 'b) Constructor_args_spec.t
@@ -159,10 +162,6 @@ module Of_sexp : sig
     -> ('a, 'b) Constructor_args_spec.t
     -> 'a
     -> 'b Constructor_spec.t
-  val cstr_record
-    :  string
-    -> 'a record_parser
-    -> 'a Constructor_spec.t
 
   val sum
     :  'a Constructor_spec.t list
diff --git a/src/workspace.ml b/src/workspace.ml
index a42d3c21..734f9545 100644
--- a/src/workspace.ml
+++ b/src/workspace.ml
@@ -63,10 +63,12 @@ module Context = struct
     | List (_, List _ :: _) as sexp -> Opam (record (Opam.t ~profile) sexp)
     | sexp ->
       sum
-        [ cstr_record "default"
-            (Default.t ~profile >>= fun x -> return (Default x))
-        ; cstr_record "opam"
-            (Opam.t ~profile >>= fun x -> return (Opam x))
+        [ cstr "default"
+            (rest_as_record (Default.t ~profile))
+            (fun x -> Default x)
+        ; cstr "opam"
+            (rest_as_record (Opam.t ~profile))
+            (fun x -> Opam x)
         ]
         sexp
 

From d600db2158c0bc3c654dac8ca598be92beee1856 Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <rudi.grinberg@gmail.com>
Date: Wed, 23 May 2018 23:47:56 +0700
Subject: [PATCH 04/11] Change Build_job to be set

The elements are unique and the order isn't well defined anyway

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
---
 bin/main.ml     | 3 ++-
 src/action.ml   | 1 -
 src/process.ml  | 3 ++-
 src/process.mli | 2 +-
 4 files changed, 5 insertions(+), 4 deletions(-)

diff --git a/bin/main.ml b/bin/main.ml
index e9d20176..60a0a046 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -1044,12 +1044,13 @@ let install_uninstall ~what =
        in
        Fiber.parallel_iter install_files_by_context
          ~f:(fun (context, install_files) ->
+           let install_files_set = Path.Set.of_list install_files in
            get_prefix context ~from_command_line:prefix_from_command_line
            >>= fun prefix ->
            get_libdir context ~libdir_from_command_line
            >>= fun libdir ->
            Fiber.parallel_iter install_files ~f:(fun path ->
-             let purpose = Process.Build_job install_files in
+             let purpose = Process.Build_job install_files_set in
              Process.run ~purpose ~env:setup.env Strict opam_installer
                ([ sprintf "-%c" what.[0]
                 ; Path.to_string path
diff --git a/src/action.ml b/src/action.ml
index dd0b02ef..88d993c1 100644
--- a/src/action.ml
+++ b/src/action.ml
@@ -929,7 +929,6 @@ let exec ~targets ~context t =
     | None   -> Env.initial
     | Some c -> c.env
   in
-  let targets = Path.Set.to_list targets in
   let purpose = Process.Build_job targets in
   let ectx = { purpose; context } in
   exec t ~ectx ~dir:Path.root ~env ~stdout_to:None ~stderr_to:None
diff --git a/src/process.ml b/src/process.ml
index 000d8364..6c59b2aa 100644
--- a/src/process.ml
+++ b/src/process.ml
@@ -46,7 +46,7 @@ and opened_file_desc =
 
 type purpose =
   | Internal_job
-  | Build_job of Path.t list
+  | Build_job of Path.Set.t
 
 module Temp = struct
   let tmp_files = ref Path.Set.empty
@@ -157,6 +157,7 @@ module Fancy = struct
             split_paths (("alias " ^ Path.to_string name) :: targets_acc)
               (add_ctx ctx ctxs_acc) rest
       in
+      let targets = Path.Set.to_list targets in
       let target_names, contexts = split_paths [] [] targets in
       let target_names_grouped_by_prefix =
         List.map target_names ~f:Filename.split_extension_after_dot
diff --git a/src/process.mli b/src/process.mli
index 9b16d3f0..2e6a2007 100644
--- a/src/process.mli
+++ b/src/process.mli
@@ -34,7 +34,7 @@ and opened_file_desc =
 (** Why a Fiber.t was run *)
 type purpose =
   | Internal_job
-  | Build_job of Path.t list
+  | Build_job of Path.Set.t
 
 (** [run ?dir ?stdout_to prog args] spawns a sub-process and wait for its termination *)
 val run

From 8e8cda01b20e7e2e506d75fb6caeb67dbb3c230a Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <rudi.grinberg@gmail.com>
Date: Thu, 24 May 2018 11:36:03 +0700
Subject: [PATCH 05/11] Replace dyn_paths with dyn_path_set

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
---
 src/build.ml         | 2 +-
 src/super_context.ml | 4 ++--
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/build.ml b/src/build.ml
index 4b5078c9..6a19d059 100644
--- a/src/build.ml
+++ b/src/build.ml
@@ -211,7 +211,7 @@ let prog_and_args ?(dir=Path.root) prog args =
   (get_prog prog &&&
    (arr (Arg_spec.expand ~dir args)
     >>>
-    dyn_paths (arr (fun (_args, deps) -> Path.Set.to_list deps))
+    dyn_path_set (arr (fun (_args, deps) -> deps))
     >>>
     arr fst))
 
diff --git a/src/super_context.ml b/src/super_context.ml
index 9d7c3782..141c6aa6 100644
--- a/src/super_context.ml
+++ b/src/super_context.ml
@@ -830,11 +830,11 @@ module Action = struct
           | Ok path    -> path
           | Error fail -> Action.Prog.Not_found.raise fail))
       >>>
-      Build.dyn_paths (Build.arr (fun action ->
+      Build.dyn_path_set (Build.arr (fun action ->
         let { Action.Infer.Outcome.deps; targets = _ } =
           Action.Infer.infer action
         in
-        Pset.to_list deps))
+        deps))
       >>>
       Build.action_dyn () ~dir ~targets
     in

From f838c89d740ce32a730bb5b430c241c84fde284e Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <rudi.grinberg@gmail.com>
Date: Thu, 24 May 2018 11:20:09 +0700
Subject: [PATCH 06/11] Remove aliases of Path.{Set,Map}

They save very little in terms of typing but grepping harder than it should be

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
---
 src/action.ml          |  27 +++---
 src/arg_spec.ml        |   8 +-
 src/build.ml           |  10 +--
 src/build_interpret.ml |  30 +++----
 src/build_system.ml    | 200 ++++++++++++++++++++---------------------
 src/super_context.ml   |  23 +++--
 src/utils.ml           |   5 +-
 7 files changed, 146 insertions(+), 157 deletions(-)

diff --git a/src/action.ml b/src/action.ml
index 88d993c1..add0fcd8 100644
--- a/src/action.ml
+++ b/src/action.ml
@@ -953,11 +953,10 @@ let sandbox t ~sandboxed ~deps ~targets =
     ]
 
 module Infer = struct
-  module S = Path.Set
   module Outcome = struct
     type t =
-      { deps    : S.t
-      ; targets : S.t
+      { deps    : Path.Set.t
+      ; targets : Path.Set.t
       }
   end
   open Outcome
@@ -1036,43 +1035,43 @@ module Infer = struct
       { deps = Pset.diff deps targets; targets }
   end [@@inline always]
 
-  include Make(Ast)(S)(Outcome)(struct
-      let ( +@ ) acc fn = { acc with targets = S.add acc.targets fn }
-      let ( +< ) acc fn = { acc with deps    = S.add acc.deps    fn }
+  include Make(Ast)(Path.Set)(Outcome)(struct
+      let ( +@ ) acc fn = { acc with targets = Path.Set.add acc.targets fn }
+      let ( +< ) acc fn = { acc with deps    = Path.Set.add acc.deps    fn }
       let ( +<! ) acc prog =
         match prog with
         | Ok p -> acc +< p
         | Error _ -> acc
     end)
 
-  module Partial = Make(Unexpanded.Partial.Past)(S)(Outcome)(struct
+  module Partial = Make(Unexpanded.Partial.Past)(Path.Set)(Outcome)(struct
       let ( +@ ) acc fn =
         match fn with
-        | Left  fn -> { acc with targets = S.add acc.targets fn }
+        | Left  fn -> { acc with targets = Path.Set.add acc.targets fn }
         | Right _  -> acc
       let ( +< ) acc fn =
         match fn with
-        | Left  fn -> { acc with deps    = S.add acc.deps fn }
+        | Left  fn -> { acc with deps    = Path.Set.add acc.deps fn }
         | Right _  -> acc
       let ( +<! ) acc fn =
         match (fn : Unexpanded.Partial.program) with
-        | Left  (This fn) -> { acc with deps = S.add acc.deps fn }
+        | Left  (This fn) -> { acc with deps = Path.Set.add acc.deps fn }
         | Left  (Search _) | Right _ -> acc
     end)
 
-  module Partial_with_all_targets = Make(Unexpanded.Partial.Past)(S)(Outcome)(struct
+  module Partial_with_all_targets = Make(Unexpanded.Partial.Past)(Path.Set)(Outcome)(struct
       let ( +@ ) acc fn =
         match fn with
-        | Left  fn -> { acc with targets = S.add acc.targets fn }
+        | Left  fn -> { acc with targets = Path.Set.add acc.targets fn }
         | Right sw ->
           Loc.fail (SW.loc sw) "Cannot determine this target statically."
       let ( +< ) acc fn =
         match fn with
-        | Left  fn -> { acc with deps    = S.add acc.deps fn }
+        | Left  fn -> { acc with deps    = Path.Set.add acc.deps fn }
         | Right _  -> acc
       let ( +<! ) acc fn =
         match (fn : Unexpanded.Partial.program) with
-        | Left  (This fn) -> { acc with deps = S.add acc.deps fn }
+        | Left  (This fn) -> { acc with deps = Path.Set.add acc.deps fn }
         | Left  (Search _) | Right _ -> acc
     end)
 
diff --git a/src/arg_spec.ml b/src/arg_spec.ml
index 59311f6b..f511a623 100644
--- a/src/arg_spec.ml
+++ b/src/arg_spec.ml
@@ -1,7 +1,5 @@
 open Import
 
-module Pset = Path.Set
-
 type 'a t =
   | A        of string
   | As       of string list
@@ -19,9 +17,9 @@ type 'a t =
 let rec add_deps ts set =
   List.fold_left ts ~init:set ~f:(fun set t ->
     match t with
-    | Dep fn -> Pset.add set fn
+    | Dep fn -> Path.Set.add set fn
     | Deps        fns
-    | Hidden_deps fns -> Pset.union set (Pset.of_list fns)
+    | Hidden_deps fns -> Path.Set.union set (Path.Set.of_list fns)
     | S ts
     | Concat (_, ts) -> add_deps ts set
     | _ -> set)
@@ -56,7 +54,7 @@ let expand ~dir ts x =
     | Target _ | Hidden_targets _ -> die "Target not allowed under Dyn"
     | Dyn _ -> assert false
     | Hidden_deps l ->
-      dyn_deps := Pset.union !dyn_deps (Pset.of_list l);
+      dyn_deps := Path.Set.union !dyn_deps (Path.Set.of_list l);
       []
   in
   let rec loop = function
diff --git a/src/build.ml b/src/build.ml
index 6a19d059..d30b712f 100644
--- a/src/build.ml
+++ b/src/build.ml
@@ -1,7 +1,5 @@
 open Import
 
-module Pset = Path.Set
-
 module Vspec = struct
   type 'a t = T : Path.t * 'a Vfile_kind.t -> 'a t
 end
@@ -26,7 +24,7 @@ module Repr = struct
     | Second : ('a, 'b) t -> ('c * 'a, 'c * 'b) t
     | Split : ('a, 'b) t * ('c, 'd) t -> ('a * 'c, 'b * 'd) t
     | Fanout : ('a, 'b) t * ('a, 'c) t -> ('a, 'b * 'c) t
-    | Paths : Pset.t -> ('a, 'a) t
+    | Paths : Path.Set.t -> ('a, 'a) t
     | Paths_for_rule : Path.Set.t -> ('a, 'a) t
     | Paths_glob : glob_state ref -> ('a, Path.t list) t
     (* The reference gets decided in Build_interpret.deps *)
@@ -134,8 +132,8 @@ let rec all = function
     >>>
     arr (fun (x, y) -> x :: y)
 
-let path p = Paths (Pset.singleton p)
-let paths ps = Paths (Pset.of_list ps)
+let path p = Paths (Path.Set.singleton p)
+let paths ps = Paths (Path.Set.of_list ps)
 let path_set ps = Paths ps
 let paths_glob ~loc ~dir re = Paths_glob (ref (G_unevaluated (loc, dir, re)))
 let vpath vp = Vpath vp
@@ -206,7 +204,7 @@ let get_prog = function
     >>> dyn_paths (arr (function Error _ -> [] | Ok x -> [x]))
 
 let prog_and_args ?(dir=Path.root) prog args =
-  Paths (Arg_spec.add_deps args Pset.empty)
+  Paths (Arg_spec.add_deps args Path.Set.empty)
   >>>
   (get_prog prog &&&
    (arr (Arg_spec.expand ~dir args)
diff --git a/src/build_interpret.ml b/src/build_interpret.ml
index 9bfff82e..2272c691 100644
--- a/src/build_interpret.ml
+++ b/src/build_interpret.ml
@@ -1,8 +1,6 @@
 open Import
 open Build.Repr
 
-module Pset = Path.Set
-module Pmap = Path.Map
 module Vspec = Build.Vspec
 
 module Target = struct
@@ -15,8 +13,8 @@ module Target = struct
     | Vfile (Vspec.T (p, _)) -> p
 
   let paths ts =
-    List.fold_left ts ~init:Pset.empty ~f:(fun acc t ->
-      Pset.add acc (path t))
+    List.fold_left ts ~init:Path.Set.empty ~f:(fun acc t ->
+      Path.Set.add acc (path t))
 end
 
 module Static_deps = struct
@@ -62,20 +60,20 @@ let static_deps t ~all_targets ~file_tree =
     | Second t -> loop t acc
     | Split (a, b) -> loop a (loop b acc)
     | Fanout (a, b) -> loop a (loop b acc)
-    | Paths fns -> { acc with action_deps = Pset.union fns acc.action_deps }
+    | Paths fns -> { acc with action_deps = Path.Set.union fns acc.action_deps }
     | Paths_for_rule fns ->
-      { acc with rule_deps = Pset.union fns acc.rule_deps }
+      { acc with rule_deps = Path.Set.union fns acc.rule_deps }
     | Paths_glob state -> begin
         match !state with
         | G_evaluated l ->
-          { acc with action_deps = Pset.union acc.action_deps (Pset.of_list l) }
+          { acc with action_deps = Path.Set.union acc.action_deps (Path.Set.of_list l) }
         | G_unevaluated (loc, dir, re) ->
           let targets = all_targets ~dir in
           let result =
-            Pset.filter targets ~f:(fun path ->
+            Path.Set.filter targets ~f:(fun path ->
               Re.execp re (Path.basename path))
           in
-          if Pset.is_empty result then begin
+          if Path.Set.is_empty result then begin
             match inspect_path file_tree dir with
             | None ->
               Loc.warn loc "Directory %s doesn't exist."
@@ -89,8 +87,8 @@ let static_deps t ~all_targets ~file_tree =
               (* diml: we should probably warn in this case as well *)
               ()
           end;
-          state := G_evaluated (Pset.to_list result);
-          let action_deps = Pset.union result acc.action_deps in
+          state := G_evaluated (Path.Set.to_list result);
+          let action_deps = Path.Set.union result acc.action_deps in
           { acc with action_deps }
       end
     | If_file_exists (p, state) -> begin
@@ -99,7 +97,7 @@ let static_deps t ~all_targets ~file_tree =
         | Undecided (then_, else_) ->
           let dir = Path.parent_exn p in
           let targets = all_targets ~dir in
-          if Pset.mem targets p then begin
+          if Path.Set.mem targets p then begin
             state := Decided (true, then_);
             loop then_ acc
           end else begin
@@ -108,15 +106,15 @@ let static_deps t ~all_targets ~file_tree =
           end
       end
     | Dyn_paths t -> loop t acc
-    | Vpath (Vspec.T (p, _)) -> { acc with rule_deps = Pset.add acc.rule_deps p }
-    | Contents p -> { acc with rule_deps = Pset.add acc.rule_deps p }
-    | Lines_of p -> { acc with rule_deps = Pset.add acc.rule_deps p }
+    | Vpath (Vspec.T (p, _)) -> { acc with rule_deps = Path.Set.add acc.rule_deps p }
+    | Contents p -> { acc with rule_deps = Path.Set.add acc.rule_deps p }
+    | Lines_of p -> { acc with rule_deps = Path.Set.add acc.rule_deps p }
     | Record_lib_deps _ -> acc
     | Fail _ -> acc
     | Memo m -> loop m.t acc
     | Catch (t, _) -> loop t acc
   in
-  loop (Build.repr t) { rule_deps = Pset.empty; action_deps = Pset.empty }
+  loop (Build.repr t) { rule_deps = Path.Set.empty; action_deps = Path.Set.empty }
 
 let lib_deps =
   let rec loop : type a b. (a, b) t -> Build.lib_deps -> Build.lib_deps
diff --git a/src/build_system.ml b/src/build_system.ml
index a70ae70e..8935c0c5 100644
--- a/src/build_system.ml
+++ b/src/build_system.ml
@@ -1,8 +1,6 @@
 open Import
 open Fiber.O
 
-module Pset  = Path.Set
-module Pmap  = Path.Map
 module Vspec = Build.Vspec
 
 (* Where we store stamp files for aliases *)
@@ -26,11 +24,11 @@ module Promoted_to_delete = struct
       []
 
   let dump () =
-    let db = Pset.union (Pset.of_list !db) (Pset.of_list (load ())) in
+    let db = Path.Set.union (Path.Set.of_list !db) (Path.Set.of_list (load ())) in
     if Path.build_dir_exists () then
       Io.write_file fn
         (String.concat ~sep:""
-           (List.map (Pset.to_list db) ~f:(fun p ->
+           (List.map (Path.Set.to_list db) ~f:(fun p ->
               Sexp.to_string (Path.sexp_of_t p) ^ "\n")))
 end
 
@@ -42,21 +40,21 @@ module Dependency_path = struct
     { (* Reason why this rule was visited *)
       requested_file : Path.t
     ; (* All targets of the rule *)
-      targets        : Pset.t
+      targets        : Path.Set.t
     }
 
   type t =
     { dependency_path : rule_info list
     ; (* Union of all [targets] fields in [dependency_path]. Depending on any of these
          means that there is a cycle. *)
-      targets_seen    : Pset.t
+      targets_seen    : Path.Set.t
     }
 
   let var = Fiber.Var.create ()
 
   let empty =
     { dependency_path = []
-    ; targets_seen    = Pset.empty
+    ; targets_seen    = Path.Set.empty
     }
 
   let dependency_cycle last dep_path =
@@ -64,7 +62,7 @@ module Dependency_path = struct
       match dep_path with
       | [] -> assert false
       |  { requested_file; targets } :: dep_path ->
-        if Pset.mem targets last then
+        if Path.Set.mem targets last then
           last :: acc
         else
           build_loop (requested_file :: acc) dep_path
@@ -77,14 +75,14 @@ module Dependency_path = struct
   let push requested_file ~targets ~f =
     Fiber.Var.get var >>= fun x ->
     let t = Option.value x ~default:empty in
-    if Pset.mem t.targets_seen requested_file then
+    if Path.Set.mem t.targets_seen requested_file then
       dependency_cycle requested_file t.dependency_path;
     let dependency_path =
       { requested_file; targets } :: t.dependency_path
     in
     let t =
       { dependency_path
-      ; targets_seen = Pset.union targets t.targets_seen
+      ; targets_seen = Path.Set.union targets t.targets_seen
       }
     in
     let on_error exn =
@@ -94,10 +92,10 @@ module Dependency_path = struct
 end
 
 module Exec_status = struct
-  type rule_evaluation = (Action.t * Pset.t) Fiber.Future.t
+  type rule_evaluation = (Action.t * Path.Set.t) Fiber.Future.t
   type rule_execution = unit Fiber.Future.t
 
-  type eval_rule = unit -> (Action.t * Pset.t) Fiber.t
+  type eval_rule = unit -> (Action.t * Path.Set.t) Fiber.t
   type exec_rule = rule_evaluation -> unit Fiber.t
 
   module Evaluating_rule = struct
@@ -166,9 +164,9 @@ module Internal_rule = struct
 
   type t =
     { id               : Id.t
-    ; rule_deps        : Pset.t
-    ; static_deps      : Pset.t
-    ; targets          : Pset.t
+    ; rule_deps        : Path.Set.t
+    ; static_deps      : Path.Set.t
+    ; targets          : Path.Set.t
     ; context          : Context.t option
     ; build            : (unit, Action.t) Build.t
     ; mode             : Jbuild.Rule.Mode.t
@@ -333,8 +331,8 @@ module Dir_status = struct
 
 
   type alias =
-    { mutable deps     : Pset.t
-    ; mutable dyn_deps : (unit, Pset.t) Build.t
+    { mutable deps     : Path.Set.t
+    ; mutable dyn_deps : (unit, Path.Set.t) Build.t
     ; mutable actions  : alias_action list
     }
 
@@ -346,7 +344,7 @@ module Dir_status = struct
 
   type t =
     | Collecting_rules of rules_collector
-    | Loaded  of Pset.t (* set of targets in the directory *)
+    | Loaded  of Path.Set.t (* set of targets in the directory *)
     | Forward of Path.t (* Load this directory first       *)
     | Failed_to_load
 end
@@ -391,7 +389,7 @@ type t =
   }
 
 let string_of_paths set =
-  Pset.to_list set
+  Path.Set.to_list set
   |> List.map ~f:(fun p -> sprintf "- %s"
                              (Path.to_string_maybe_quoted
                                 (Path.drop_optional_build_context p)))
@@ -407,19 +405,19 @@ let get_dir_status t ~dir =
       Dir_status.Loaded (File_tree.files_of t.file_tree dir)
     else if dir = Path.build_dir then
       (* Not allowed to look here *)
-      Dir_status.Loaded Pset.empty
+      Dir_status.Loaded Path.Set.empty
     else if not (Path.is_local dir) then
       Dir_status.Loaded
         (match Path.readdir dir with
          | exception _ -> Path.Set.empty
          | files ->
-           Pset.of_list (List.map files ~f:(Path.relative dir)))
+           Path.Set.of_list (List.map files ~f:(Path.relative dir)))
     else begin
       let (ctx, sub_dir) = Option.value_exn (Path.extract_build_context dir) in
       if ctx = ".aliases" then
         Forward (Path.(append build_dir) sub_dir)
       else if ctx <> "install" && not (String.Map.mem t.contexts ctx) then
-        Dir_status.Loaded Pset.empty
+        Dir_status.Loaded Path.Set.empty
       else
         Collecting_rules
           { rules   = []
@@ -457,7 +455,7 @@ module Build_exec = struct
 
   let exec bs t x =
     let rec exec
-      : type a b. Pset.t ref -> (a, b) t -> a -> b = fun dyn_deps t x ->
+      : type a b. Path.Set.t ref -> (a, b) t -> a -> b = fun dyn_deps t x ->
       match t with
       | Arr f -> f x
       | Targets _ -> x
@@ -492,7 +490,7 @@ module Build_exec = struct
         Option.value_exn file.data
       | Dyn_paths t ->
         let fns = exec dyn_deps t x in
-        dyn_deps := Pset.union !dyn_deps fns;
+        dyn_deps := Path.Set.union !dyn_deps fns;
         x
       | Record_lib_deps _ -> x
       | Fail { fail } -> fail ()
@@ -507,23 +505,23 @@ module Build_exec = struct
       | Memo m ->
         match m.state with
         | Evaluated (x, deps) ->
-          dyn_deps := Pset.union !dyn_deps deps;
+          dyn_deps := Path.Set.union !dyn_deps deps;
           x
         | Evaluating ->
           die "Dependency cycle evaluating memoized build arrow %s" m.name
         | Unevaluated ->
           m.state <- Evaluating;
-          let dyn_deps' = ref Pset.empty in
+          let dyn_deps' = ref Path.Set.empty in
           match exec dyn_deps' m.t x with
           | x ->
             m.state <- Evaluated (x, !dyn_deps');
-            dyn_deps := Pset.union !dyn_deps !dyn_deps';
+            dyn_deps := Path.Set.union !dyn_deps !dyn_deps';
             x
           | exception exn ->
             m.state <- Unevaluated;
             reraise exn
     in
-    let dyn_deps = ref Pset.empty in
+    let dyn_deps = ref Path.Set.empty in
     let result = exec dyn_deps (Build.repr t) x in
     (result, !dyn_deps)
 end
@@ -580,29 +578,29 @@ let create_file_specs t targets rule ~copy_source =
 
 (* This contains the targets of the actions that are being executed. On exit, we need to
    delete them as they might contain garbage *)
-let pending_targets = ref Pset.empty
+let pending_targets = ref Path.Set.empty
 
 let () =
   at_exit (fun () ->
     let fns = !pending_targets in
-    pending_targets := Pset.empty;
-    Pset.iter fns ~f:Path.unlink_no_err)
+    pending_targets := Path.Set.empty;
+    Path.Set.iter fns ~f:Path.unlink_no_err)
 
 let clear_targets_digests_after_rule_execution targets =
   let missing =
-    List.fold_left targets ~init:Pset.empty ~f:(fun acc fn ->
+    List.fold_left targets ~init:Path.Set.empty ~f:(fun acc fn ->
       match Unix.lstat (Path.to_string fn) with
-      | exception _ -> Pset.add acc fn
+      | exception _ -> Path.Set.add acc fn
       | (_ : Unix.stats) ->
         Utils.Cached_digest.remove fn;
         acc)
   in
-  if not (Pset.is_empty missing) then
+  if not (Path.Set.is_empty missing) then
     die "@{<error>Error@}: Rule failed to generate the following targets:\n%s"
       (string_of_paths missing)
 
 let make_local_dirs t paths =
-  Pset.iter paths ~f:(fun path ->
+  Path.Set.iter paths ~f:(fun path ->
     match Path.kind path with
     | Local path ->
       if not (Path.Local.Set.mem t.local_mkdirs path) then begin
@@ -612,7 +610,7 @@ let make_local_dirs t paths =
     | _ -> ())
 
 let make_local_parent_dirs t paths ~map_path =
-  Pset.iter paths ~f:(fun path ->
+  Path.Set.iter paths ~f:(fun path ->
     match Path.kind (map_path path) with
     | Local path when not (Path.Local.is_root path) ->
       let parent = Path.Local.parent path in
@@ -650,7 +648,7 @@ let remove_old_artifacts t ~dir ~subdirs_to_keep =
             | All -> ()
             | These set ->
               if String.Set.mem set fn ||
-                 Pset.mem t.build_dirs_to_keep path then
+                 Path.Set.mem t.build_dirs_to_keep path then
                 ()
               else
                 Path.rm_rf path
@@ -709,14 +707,14 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
          wait_for_deps t static_deps)
       (fun () ->
          Fiber.Future.wait rule_evaluation >>= fun (action, dyn_deps) ->
-         wait_for_deps t (Pset.diff dyn_deps static_deps)
+         wait_for_deps t (Path.Set.diff dyn_deps static_deps)
          >>| fun () ->
          (action, dyn_deps))
     >>= fun (action, dyn_deps) ->
     make_local_parent_dirs t targets ~map_path:(fun x -> x);
-    let all_deps = Pset.union static_deps dyn_deps in
-    let all_deps_as_list = Pset.to_list all_deps in
-    let targets_as_list  = Pset.to_list targets  in
+    let all_deps = Path.Set.union static_deps dyn_deps in
+    let all_deps_as_list = Path.Set.to_list all_deps in
+    let targets_as_list  = Path.Set.to_list targets  in
     let hash =
       let trace =
         (List.map all_deps_as_list ~f:(fun fn ->
@@ -756,7 +754,7 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
     begin
       if deps_or_rule_changed || targets_missing || force then begin
         List.iter targets_as_list ~f:Path.unlink_no_err;
-        pending_targets := Pset.union targets !pending_targets;
+        pending_targets := Path.Set.union targets !pending_targets;
         let action =
           match sandbox_dir with
           | Some sandbox_dir ->
@@ -781,7 +779,7 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
           Action.exec ~context ~targets action) >>| fun () ->
         Option.iter sandbox_dir ~f:Path.rm_rf;
         (* All went well, these targets are no longer pending *)
-        pending_targets := Pset.diff !pending_targets targets;
+        pending_targets := Path.Set.diff !pending_targets targets;
         clear_targets_digests_after_rule_execution targets_as_list
       end else
         Fiber.return ()
@@ -790,7 +788,7 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
       match mode with
       | Standard | Fallback | Not_a_rule_stanza | Ignore_source_files -> ()
       | Promote | Promote_but_delete_on_clean ->
-        Pset.iter targets ~f:(fun path ->
+        Path.Set.iter targets ~f:(fun path ->
           let in_source_tree = Option.value_exn (Path.drop_build_context path) in
           if not (Path.exists in_source_tree) ||
              (Utils.Cached_digest.file path <>
@@ -819,7 +817,7 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
   create_file_specs t target_specs rule ~copy_source
 
 and setup_copy_rules t ~ctx_dir ~non_target_source_files =
-  Pset.iter non_target_source_files ~f:(fun path ->
+  Path.Set.iter non_target_source_files ~f:(fun path ->
     let ctx_path = Path.append ctx_dir path in
     let build = Build.copy ~src:path ~dst:ctx_path in
     (* We temporarily allow overrides while setting up copy rules from
@@ -830,7 +828,7 @@ and setup_copy_rules t ~ctx_dir ~non_target_source_files =
        should allow it on a case-by-case basis though. *)
     compile_rule t (Pre_rule.make build ~context:None) ~copy_source:true)
 
-and load_dir   t ~dir = ignore (load_dir_and_get_targets t ~dir : Pset.t)
+and load_dir   t ~dir = ignore (load_dir_and_get_targets t ~dir : Path.Set.t)
 and targets_of t ~dir =         load_dir_and_get_targets t ~dir
 
 and load_dir_and_get_targets t ~dir =
@@ -894,7 +892,7 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators =
   let alias_dir = Path.append (Path.relative alias_dir context_name) sub_dir in
   let alias_rules, alias_stamp_files =
     let open Build.O in
-    String.Map.foldi collector.aliases ~init:([], Pset.empty)
+    String.Map.foldi collector.aliases ~init:([], Path.Set.empty)
       ~f:(fun name { Dir_status. deps; dyn_deps; actions } (rules, alias_stamp_files) ->
         let base_path = Path.relative alias_dir name in
         let rules, deps =
@@ -909,7 +907,7 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators =
                    Pre_rule.make ~locks ~context:(Some context)
                      (Build.progn [ action; Build.create_file path ])
                  in
-                 (rule :: rules, Pset.add deps path))
+                 (rule :: rules, Path.Set.add deps path))
         in
         let path = Path.extend_basename base_path ~suffix:Alias0.suffix in
         (Pre_rule.make
@@ -918,30 +916,30 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators =
             dyn_deps >>>
             Build.dyn_path_set (Build.arr (fun x -> x))
             >>^ (fun dyn_deps ->
-              let deps = Pset.union deps dyn_deps in
+              let deps = Path.Set.union deps dyn_deps in
               Action.with_stdout_to path
-                (Action.digest_files (Pset.to_list deps)))
+                (Action.digest_files (Path.Set.to_list deps)))
             >>>
             Build.action_dyn () ~targets:[path])
          :: rules,
-         Pset.add alias_stamp_files path))
+         Path.Set.add alias_stamp_files path))
   in
   Hashtbl.replace t.dirs ~key:alias_dir ~data:(Loaded alias_stamp_files);
 
   (* Compute the set of targets and the set of source files that must not be copied *)
   let user_rule_targets, source_files_to_ignore =
-    List.fold_left rules ~init:(Pset.empty, Pset.empty)
+    List.fold_left rules ~init:(Path.Set.empty, Path.Set.empty)
       ~f:(fun (acc_targets, acc_ignored) { Pre_rule.targets; mode; _ } ->
         let targets = Build_interpret.Target.paths targets in
-        (Pset.union targets acc_targets,
+        (Path.Set.union targets acc_targets,
          match mode with
          | Promote | Promote_but_delete_on_clean | Ignore_source_files ->
-           Pset.union targets acc_ignored
+           Path.Set.union targets acc_ignored
          | _ ->
            acc_ignored))
   in
   let source_files_to_ignore =
-    Pset.map source_files_to_ignore ~f:(fun p ->
+    Path.Set.map source_files_to_ignore ~f:(fun p ->
       Option.value_exn (Path.drop_build_context p))
   in
 
@@ -957,18 +955,18 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators =
       assert (String.Map.mem t.contexts ctx_name);
       let files, subdirs =
         match File_tree.find_dir t.file_tree sub_dir with
-        | None -> (Pset.empty, String.Set.empty)
+        | None -> (Path.Set.empty, String.Set.empty)
         | Some dir ->
           (File_tree.Dir.file_paths    dir,
            File_tree.Dir.sub_dir_names dir)
       in
-      let files = Pset.diff files source_files_to_ignore in
-      if Pset.is_empty files then
+      let files = Path.Set.diff files source_files_to_ignore in
+      if Path.Set.is_empty files then
         (user_rule_targets, None, subdirs)
       else
         let ctx_path = Path.(relative build_dir) context_name in
-        (Pset.union user_rule_targets
-           (Pset.map files ~f:(Path.append ctx_path)),
+        (Path.Set.union user_rule_targets
+           (Path.Set.map files ~f:(Path.append ctx_path)),
          Some (ctx_path, files),
          subdirs)
   in
@@ -992,9 +990,9 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators =
         | Not_a_rule_stanza | Ignore_source_files -> true
         | Fallback ->
           let source_files_for_targtes =
-            List.fold_left rule.targets ~init:Pset.empty
+            List.fold_left rule.targets ~init:Path.Set.empty
               ~f:(fun acc target ->
-                Pset.add acc
+                Path.Set.add acc
                   (Build_interpret.Target.path target
                    |> Path.drop_build_context
                    (* All targets are in [dir] and we know it
@@ -1003,19 +1001,19 @@ and load_dir_step2_exn t ~dir ~collector ~lazy_generators =
                       call can't fail. *)
                    |> Option.value_exn))
           in
-          if Pset.is_subset source_files_for_targtes ~of_:to_copy then
+          if Path.Set.is_subset source_files_for_targtes ~of_:to_copy then
             (* All targets are present *)
             false
           else begin
-            if Pset.is_empty (Pset.inter source_files_for_targtes to_copy) then
+            if Path.Set.is_empty (Path.Set.inter source_files_for_targtes to_copy) then
               (* No target is present *)
               true
             else begin
               let absent_targets =
-                Pset.diff source_files_for_targtes to_copy
+                Path.Set.diff source_files_for_targtes to_copy
               in
               let present_targets =
-                Pset.diff source_files_for_targtes absent_targets
+                Path.Set.diff source_files_for_targtes absent_targets
               in
               Loc.fail
                 (rule_loc
@@ -1098,7 +1096,7 @@ and wait_for_file_found fn (File_spec.T file) =
       Fiber.Future.wait rule_execution)
 
 and wait_for_deps t deps =
-  Fiber.parallel_iter (Pset.to_list deps) ~f:(wait_for_file t)
+  Fiber.parallel_iter (Path.Set.to_list deps) ~f:(wait_for_file t)
 
 let stamp_file_for_files_of t ~dir ~ext =
   let files_of_dir =
@@ -1142,8 +1140,8 @@ module Trace = struct
   let dump (trace : t) =
     let sexp =
       Sexp.List (
-        Hashtbl.foldi trace ~init:Pmap.empty ~f:(fun key data acc ->
-          Pmap.add acc key data)
+        Hashtbl.foldi trace ~init:Path.Map.empty ~f:(fun key data acc ->
+          Path.Map.add acc key data)
         |> Path.Map.to_list
         |> List.map ~f:(fun (path, hash) ->
                Sexp.List [ Path.sexp_of_t path;
@@ -1199,7 +1197,7 @@ let create ~contexts ~file_tree ~hook =
     ; file_tree
     ; gen_rules = String.Map.map contexts ~f:(fun _ ~dir:_ ->
         die "gen_rules called too early")
-    ; build_dirs_to_keep = Pset.empty
+    ; build_dirs_to_keep = Path.Set.empty
     ; files_of = Hashtbl.create 1024
     ; prefix = None
     ; hook
@@ -1217,7 +1215,7 @@ let eval_request t ~request ~process_target =
   in
 
   let process_targets ts =
-    Fiber.parallel_iter (Pset.to_list ts) ~f:process_target
+    Fiber.parallel_iter (Path.Set.to_list ts) ~f:process_target
   in
 
   Fiber.fork_and_join_unit
@@ -1226,7 +1224,7 @@ let eval_request t ~request ~process_target =
        wait_for_deps t rule_deps
        >>= fun () ->
        let result, dyn_deps = Build_exec.exec t request () in
-       process_targets (Pset.diff dyn_deps static_deps)
+       process_targets (Path.Set.diff dyn_deps static_deps)
        >>| fun () ->
        result)
 
@@ -1241,7 +1239,7 @@ let update_universe t =
     else
       0
   in
-  make_local_dirs t (Pset.singleton Path.build_dir);
+  make_local_dirs t (Path.Set.singleton Path.build_dir);
   Io.write_file universe_file (Sexp.to_string (Sexp.To_sexp.int n))
 
 let do_build t ~request =
@@ -1267,8 +1265,8 @@ let rules_for_targets t targets =
       ~key:(fun (r : Internal_rule.t) -> r.id)
       ~deps:(fun (r : Internal_rule.t) ->
         rules_for_files t
-          (Pset.to_list
-             (Pset.union
+          (Path.Set.to_list
+             (Path.Set.union
                 r.static_deps
                 r.rule_deps)))
   with
@@ -1277,7 +1275,7 @@ let rules_for_targets t targets =
     die "dependency cycle detected:\n   %s"
       (List.map cycle ~f:(fun rule ->
          Path.to_string (Option.value_exn
-                           (Pset.choose rule.Internal_rule.targets)))
+                           (Path.Set.choose rule.Internal_rule.targets)))
        |> String.concat ~sep:"\n-> ")
 
 let static_deps_of_request t request =
@@ -1287,22 +1285,22 @@ let static_deps_of_request t request =
       } = Build_interpret.static_deps request ~all_targets:(targets_of t)
             ~file_tree:t.file_tree
   in
-  Pset.to_list (Pset.union rule_deps action_deps)
+  Path.Set.to_list (Path.Set.union rule_deps action_deps)
 
 let all_lib_deps t ~request =
   let targets = static_deps_of_request t request in
-  List.fold_left (rules_for_targets t targets) ~init:Pmap.empty
+  List.fold_left (rules_for_targets t targets) ~init:Path.Map.empty
     ~f:(fun acc (rule : Internal_rule.t) ->
       let deps = Build_interpret.lib_deps rule.build in
       if String.Map.is_empty deps then
         acc
       else
         let deps =
-          match Pmap.find acc rule.dir with
+          match Path.Map.find acc rule.dir with
           | None -> deps
           | Some deps' -> Build.merge_lib_deps deps deps'
         in
-        Pmap.add acc rule.dir deps)
+        Path.Map.add acc rule.dir deps)
 
 let all_lib_deps_by_context t ~request =
   let targets = static_deps_of_request t request in
@@ -1339,7 +1337,7 @@ module Rule_set = Set.Make(Rule)
 
 let rules_for_files rules paths =
   List.fold_left paths ~init:Rule_set.empty ~f:(fun acc path ->
-    match Pmap.find rules path with
+    match Path.Map.find rules path with
     | None -> acc
     | Some rule -> Rule_set.add acc rule)
   |> Rule_set.to_list
@@ -1379,7 +1377,7 @@ let build_rules_internal ?(recursive=false) t ~request =
         >>| fun (action, dyn_deps) ->
         { Rule.
           id      = ir.id
-        ; deps    = Pset.union ir.static_deps dyn_deps
+        ; deps    = Path.Set.union ir.static_deps dyn_deps
         ; targets = ir.targets
         ; context = ir.context
         ; action  = action
@@ -1390,33 +1388,33 @@ let build_rules_internal ?(recursive=false) t ~request =
         Fiber.return ()
       else
         Fiber.Future.wait rule >>= fun rule ->
-        Fiber.parallel_iter (Pset.to_list rule.deps) ~f:loop
+        Fiber.parallel_iter (Path.Set.to_list rule.deps) ~f:loop
     end
   in
-  let targets = ref Pset.empty in
+  let targets = ref Path.Set.empty in
   eval_request t ~request ~process_target:(fun fn ->
-    targets := Pset.add !targets fn;
+    targets := Path.Set.add !targets fn;
     loop fn)
   >>= fun () ->
   Fiber.all (List.map !rules ~f:Fiber.Future.wait)
   >>| fun rules ->
   let rules =
-    List.fold_left rules ~init:Pmap.empty ~f:(fun acc (r : Rule.t) ->
-      Pset.fold r.targets ~init:acc ~f:(fun fn acc ->
-        Pmap.add acc fn r))
+    List.fold_left rules ~init:Path.Map.empty ~f:(fun acc (r : Rule.t) ->
+      Path.Set.fold r.targets ~init:acc ~f:(fun fn acc ->
+        Path.Map.add acc fn r))
   in
   match
     Rule.Id.Top_closure.top_closure
-      (rules_for_files rules (Pset.to_list !targets))
+      (rules_for_files rules (Path.Set.to_list !targets))
       ~key:(fun (r : Rule.t) -> r.id)
       ~deps:(fun (r : Rule.t) ->
-        rules_for_files rules (Pset.to_list r.deps))
+        rules_for_files rules (Path.Set.to_list r.deps))
   with
   | Ok l -> l
   | Error cycle ->
     die "dependency cycle detected:\n   %s"
       (List.map cycle ~f:(fun rule ->
-         Path.to_string (Option.value_exn (Pset.choose rule.Rule.targets)))
+         Path.to_string (Option.value_exn (Path.Set.choose rule.Rule.targets)))
        |> String.concat ~sep:"\n-> ")
 
 let build_rules ?recursive t ~request =
@@ -1454,22 +1452,22 @@ let package_deps t pkg files =
             Option.value_exn (Fiber.Future.peek rule_evaluation)
           | Not_started _ -> assert false
         in
-        Pset.fold (Pset.union ir.static_deps dyn_deps) ~init:acc ~f:loop
+        Path.Set.fold (Path.Set.union ir.static_deps dyn_deps) ~init:acc ~f:loop
       end
   in
   let open Build.O in
   Build.paths_for_rule files >>^ fun () ->
   (* We know that at this point of execution, all the relevant ivars
      have been filled *)
-  Pset.fold files ~init:Package.Name.Set.empty ~f:loop_deps
+  Path.Set.fold files ~init:Package.Name.Set.empty ~f:loop_deps
 
 (* +-----------------------------------------------------------------+
    | Adding rules to the system                                      |
    +-----------------------------------------------------------------+ *)
 
 let rec add_build_dir_to_keep t ~dir =
-  if not (Pset.mem t.build_dirs_to_keep dir) then begin
-    t.build_dirs_to_keep <- Pset.add t.build_dirs_to_keep dir;
+  if not (Path.Set.mem t.build_dirs_to_keep dir) then begin
+    t.build_dirs_to_keep <- Path.Set.add t.build_dirs_to_keep dir;
     Option.iter (Path.parent dir) ~f:(fun dir ->
       if not (Path.is_root dir) then
         add_build_dir_to_keep t ~dir)
@@ -1537,7 +1535,7 @@ let on_load_dir t ~dir ~f =
     p.lazy_generators <- f :: lazy_generators
 
 let eval_glob t ~dir re =
-  let targets = targets_of t ~dir |> Pset.to_list |> List.map ~f:Path.basename in
+  let targets = targets_of t ~dir |> Path.Set.to_list |> List.map ~f:Path.basename in
   let files =
     match File_tree.find_dir t.file_tree dir with
     | None -> targets
@@ -1556,8 +1554,8 @@ module Alias = struct
     | None ->
       let x =
         { Dir_status.
-          deps     = Pset.empty
-        ; dyn_deps = Build.return Pset.empty
+          deps     = Path.Set.empty
+        ; dyn_deps = Build.return Path.Set.empty
         ; actions  = []
         }
       in
@@ -1567,14 +1565,14 @@ module Alias = struct
 
   let add_deps build_system t ?dyn_deps deps =
     let def = get_alias_def build_system t in
-    def.deps <- Pset.union def.deps deps;
+    def.deps <- Path.Set.union def.deps deps;
     match dyn_deps with
     | None -> ()
     | Some build ->
       let open Build.O in
       def.dyn_deps <-
         Build.fanout def.dyn_deps build >>^ fun (a, b) ->
-        Pset.union a b
+        Path.Set.union a b
 
   let add_action build_system t ~context ?(locks=[]) ~stamp action =
     let def = get_alias_def build_system t in
@@ -1586,4 +1584,4 @@ module Alias = struct
 end
 
 let is_target t file =
-  Pset.mem (targets_of t ~dir:(Path.parent_exn file)) file
+  Path.Set.mem (targets_of t ~dir:(Path.parent_exn file)) file
diff --git a/src/super_context.ml b/src/super_context.ml
index 141c6aa6..01ab9de5 100644
--- a/src/super_context.ml
+++ b/src/super_context.ml
@@ -2,7 +2,6 @@ open Import
 open Jbuild
 
 module A = Action
-module Pset = Path.Set
 module Alias = Build_system.Alias
 
 module Dir_with_jbuild = struct
@@ -492,7 +491,7 @@ module Deps = struct
       let path = Path.relative ~error_loc:(String_with_vars.loc s)
                    dir (expand_vars t ~scope ~dir s) in
       Build.files_recursively_in ~dir:path ~file_tree:t.file_tree
-      >>^ Pset.to_list
+      >>^ Path.Set.to_list
     | Package p ->
       let pkg = Package.Name.of_string (expand_vars t ~scope ~dir p) in
       Alias.dep (Alias.package_install ~context:t.context ~pkg)
@@ -564,7 +563,7 @@ module Action = struct
     ; (* All "name" for ${lib:name:...}/${lib-available:name} forms *)
       mutable lib_deps  : Build.lib_deps
     ; (* Static deps from ${...} variables. For instance ${exe:...} *)
-      mutable sdeps     : Pset.t
+      mutable sdeps     : Path.Set.t
     ; (* Dynamic deps from ${...} variables. For instance ${read:...} *)
       mutable ddeps     : (unit, Action.Var_expansion.t) Build.t String.Map.t
     }
@@ -604,7 +603,7 @@ module Action = struct
     let acc =
       { failures  = []
       ; lib_deps  = String.Map.empty
-      ; sdeps     = Pset.empty
+      ; sdeps     = Path.Set.empty
       ; ddeps     = String.Map.empty
       }
     in
@@ -722,7 +721,7 @@ module Action = struct
             let exp = expand loc key var x in
             (match exp with
              | Some (Paths (ps, _)) ->
-               acc.sdeps <- Pset.union (Pset.of_list ps) acc.sdeps
+               acc.sdeps <- Path.Set.union (Path.Set.of_list ps) acc.sdeps
              | _ -> ());
             exp)
     in
@@ -768,7 +767,7 @@ module Action = struct
       match targets_written_by_user with
       | Infer -> Action.Infer.partial t ~all_targets:true
       | Static targets_written_by_user ->
-        let targets_written_by_user = Pset.of_list targets_written_by_user in
+        let targets_written_by_user = Path.Set.of_list targets_written_by_user in
         let { Action.Infer.Outcome. deps; targets } =
           Action.Infer.partial t ~all_targets:false
         in
@@ -780,23 +779,23 @@ module Action = struct
            so that it can report better errors.
 
            {[
-             let missing = Pset.diff targets targets_written_by_user in
-             if not (Pset.is_empty missing) then
+             let missing = Path.Set.diff targets targets_written_by_user in
+             if not (Path.Set.is_empty missing) then
                Loc.warn (Loc.in_file (Utils.jbuild_name_in ~dir))
                  "Missing targets in user action:\n%s"
-                 (List.map (Pset.elements missing) ~f:(fun target ->
+                 (List.map (Path.Set.elements missing) ~f:(fun target ->
                     sprintf "- %s" (Utils.describe_target target))
                   |> String.concat ~sep:"\n");
            ]}
         *)
-        { deps; targets = Pset.union targets targets_written_by_user }
+        { deps; targets = Path.Set.union targets targets_written_by_user }
       | Alias ->
         let { Action.Infer.Outcome. deps; targets = _ } =
           Action.Infer.partial t ~all_targets:false
         in
-        { deps; targets = Pset.empty }
+        { deps; targets = Path.Set.empty }
     in
-    let targets = Pset.to_list targets in
+    let targets = Path.Set.to_list targets in
     List.iter targets ~f:(fun target ->
       if Path.parent_exn target <> dir then
         Loc.fail loc
diff --git a/src/utils.ml b/src/utils.ml
index 8afc656f..af2020d7 100644
--- a/src/utils.ml
+++ b/src/utils.ml
@@ -184,11 +184,10 @@ module Cached_digest = struct
   let db_file = Path.relative Path.build_dir ".digest-db"
 
   let dump () =
-    let module Pmap = Path.Map in
     let sexp =
       Sexp.List (
-        Hashtbl.foldi cache ~init:Pmap.empty ~f:(fun key data acc ->
-          Pmap.add acc key data)
+        Hashtbl.foldi cache ~init:Path.Map.empty ~f:(fun key data acc ->
+          Path.Map.add acc key data)
         |> Path.Map.to_list
         |> List.map ~f:(fun (path, file) ->
           Sexp.List [ Quoted_string (Path.to_string path)

From 6b130e809c07d18e064fcb7204a8138bb74b0de5 Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <rudi.grinberg@gmail.com>
Date: Tue, 22 May 2018 17:57:39 +0700
Subject: [PATCH 07/11] Move int sets and maps to stdune

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
---
 src/configurator/v1.ml |  6 ++----
 src/fiber/fiber.ml     | 16 +++++++---------
 src/import.ml          |  3 ---
 src/interned.ml        |  8 +++++---
 src/lib.ml             | 18 +++++++++---------
 src/stdune/int.ml      | 23 +++++++++++++++--------
 src/stdune/int.mli     |  3 +++
 src/syntax.ml          | 10 +++++-----
 src/top_closure.ml     |  2 +-
 9 files changed, 47 insertions(+), 42 deletions(-)

diff --git a/src/configurator/v1.ml b/src/configurator/v1.ml
index d96e27ec..0f38eee2 100644
--- a/src/configurator/v1.ml
+++ b/src/configurator/v1.ml
@@ -7,8 +7,6 @@ let ( ^/ ) = Filename.concat
 
 exception Fatal_error of string
 
-module Int_map = Stdune.Map.Make(Stdune.Int)
-
 let die fmt =
   Printf.ksprintf (fun s ->
     raise (Fatal_error s);
@@ -363,12 +361,12 @@ const char *s%i = "BEGIN-%i-false-END";
   let extract_values obj_file vars =
     let values =
       Io.with_lexbuf_from_file obj_file ~f:(Extract_obj.extract [])
-      |> Int_map.of_list_exn
+      |> Int.Map.of_list_exn
     in
     List.mapi vars ~f:(fun i (name, t) ->
       let value =
         let raw_val =
-          match Int_map.find values i with
+          match Int.Map.find values i with
           | None -> die "Unable to get value for %s" name
           | Some v -> v in
         match t with
diff --git a/src/fiber/fiber.ml b/src/fiber/fiber.ml
index 10fd3252..424a539a 100644
--- a/src/fiber/fiber.ml
+++ b/src/fiber/fiber.ml
@@ -45,8 +45,6 @@ module Binding = struct
   type t = T : 'a Var0.t * 'a -> t
 end
 
-module Int_map = Map.Make(Int)
-
 module Execution_context : sig
   type t
 
@@ -68,14 +66,14 @@ module Execution_context : sig
     -> on_error:(exn -> unit)
     -> t
 
-  val vars : t -> Binding.t Int_map.t
-  val set_vars : t -> Binding.t Int_map.t -> t
+  val vars : t -> Binding.t Int.Map.t
+  val set_vars : t -> Binding.t Int.Map.t -> t
 end = struct
   type t =
     { on_error : exn -> unit (* This callback must never raise *)
     ; fibers   : int ref (* Number of fibers running in this execution
                             context *)
-    ; vars     : Binding.t Int_map.t
+    ; vars     : Binding.t Int.Map.t
     ; on_release : unit -> unit
     }
 
@@ -85,7 +83,7 @@ end = struct
   let create_initial () =
     { on_error   = reraise
     ; fibers     = ref 1
-    ; vars       = Int_map.empty
+    ; vars       = Int.Map.empty
     ; on_release = ignore
     }
 
@@ -274,14 +272,14 @@ module Var = struct
   include Var0
 
   let find ctx var =
-    match Int_map.find (EC.vars ctx) (id var) with
+    match Int.Map.find (EC.vars ctx) (id var) with
     | None -> None
     | Some (Binding.T (var', v)) ->
       let eq = eq var' var in
       Some (Eq.cast eq v)
 
   let find_exn ctx var =
-    match Int_map.find (EC.vars ctx) (id var) with
+    match Int.Map.find (EC.vars ctx) (id var) with
     | None -> failwith "Fiber.Var.find_exn"
     | Some (Binding.T (var', v)) ->
       let eq = eq var' var in
@@ -293,7 +291,7 @@ module Var = struct
   let set (type a) (var : a t) x fiber ctx k =
     let (module M) = var in
     let data = Binding.T (var, x) in
-    let ctx = EC.set_vars ctx (Int_map.add (EC.vars ctx) M.id data) in
+    let ctx = EC.set_vars ctx (Int.Map.add (EC.vars ctx) M.id data) in
     fiber ctx k
 end
 
diff --git a/src/import.ml b/src/import.ml
index ca2d0407..9e7e2718 100644
--- a/src/import.ml
+++ b/src/import.ml
@@ -18,9 +18,6 @@ module String_map = struct
     ) fmt (to_list t)
 end
 
-module Int_set = Set.Make(Int)
-module Int_map = Map.Make(Int)
-
 module Sys = struct
   include Sys
 
diff --git a/src/interned.ml b/src/interned.ml
index ac663573..efb57038 100644
--- a/src/interned.ml
+++ b/src/interned.ml
@@ -23,11 +23,13 @@ module type S = sig
 end
 
 module Make() = struct
-  include Int
+  type t = int
 
   let ids = Hashtbl.create 1024
   let next = ref 0
 
+  let compare = Int.compare
+
   module Table = struct
     type 'a t =
       { default_value : 'a
@@ -77,7 +79,7 @@ module Make() = struct
   let pp fmt t = Format.fprintf fmt "%S" (to_string t)
 
   module Set = struct
-    include Int_set
+    include Int.Set
 
     let make l =
       List.fold_left l ~init:empty ~f:(fun acc s -> add acc (make s))
@@ -85,5 +87,5 @@ module Make() = struct
     let pp fmt (t : t) = Fmt.ocaml_list pp fmt (to_list t)
   end
 
-  module Map = Int_map
+  module Map = Int.Map
 end
diff --git a/src/lib.ml b/src/lib.ml
index 22dfb567..18ce8b8b 100644
--- a/src/lib.ml
+++ b/src/lib.ml
@@ -436,12 +436,12 @@ module L = struct
       match l with
       | [] -> acc
       | x :: l ->
-        if Int_set.mem seen x.unique_id then
+        if Int.Set.mem seen x.unique_id then
           loop acc l seen
         else
-          loop (x :: acc) l (Int_set.add seen x.unique_id)
+          loop (x :: acc) l (Int.Set.add seen x.unique_id)
     in
-    loop [] l Int_set.empty
+    loop [] l Int.Set.empty
 end
 
 (* +-----------------------------------------------------------------+
@@ -523,12 +523,12 @@ let gen_unique_id =
 module Dep_stack = struct
   type t =
     { stack : Id.t list
-    ; seen  : Int_set.t
+    ; seen  : Int.Set.t
     }
 
   let empty =
     { stack = []
-    ; seen  = Int_set.empty
+    ; seen  = Int.Set.empty
     }
 
   let to_required_by t ~stop_at =
@@ -545,7 +545,7 @@ module Dep_stack = struct
     loop [] t.stack
 
   let dependency_cycle t (last : Id.t) =
-    assert (Int_set.mem t.seen last.unique_id);
+    assert (Int.Set.mem t.seen last.unique_id);
     let rec build_loop acc stack =
       match stack with
       | [] -> assert false
@@ -564,15 +564,15 @@ module Dep_stack = struct
     let init = { Id. unique_id; name; path } in
     (init,
      { stack = init :: t.stack
-     ; seen  = Int_set.add t.seen unique_id
+     ; seen  = Int.Set.add t.seen unique_id
      })
 
   let push t (x : Id.t) : (_, _) result =
-    if Int_set.mem t.seen x.unique_id then
+    if Int.Set.mem t.seen x.unique_id then
       Error (dependency_cycle t x)
     else
       Ok { stack = x :: t.stack
-         ; seen  = Int_set.add t.seen x.unique_id
+         ; seen  = Int.Set.add t.seen x.unique_id
          }
 end
 
diff --git a/src/stdune/int.ml b/src/stdune/int.ml
index 5668aa89..c11dc3da 100644
--- a/src/stdune/int.ml
+++ b/src/stdune/int.ml
@@ -1,8 +1,15 @@
-type t = int
-let compare (a : int) b : Ordering.t =
-  if a < b then
-    Lt
-  else if a = b then
-    Eq
-  else
-    Gt
+module T = struct
+  type t = int
+  let compare (a : int) b : Ordering.t =
+    if a < b then
+      Lt
+    else if a = b then
+      Eq
+    else
+      Gt
+end
+
+include T
+
+module Set = Set.Make(T)
+module Map = Map.Make(T)
diff --git a/src/stdune/int.mli b/src/stdune/int.mli
index 951b188c..e9ff5063 100644
--- a/src/stdune/int.mli
+++ b/src/stdune/int.mli
@@ -1,2 +1,5 @@
 type t = int
 val compare : t -> t -> Ordering.t
+
+module Set : Set.S with type elt = t
+module Map : Map.S with type key = t
diff --git a/src/syntax.ml b/src/syntax.ml
index 1141fd5f..81d123a9 100644
--- a/src/syntax.ml
+++ b/src/syntax.ml
@@ -22,14 +22,14 @@ module Version = struct
 end
 
 module Versioned_parser = struct
-  type 'a t = (int * 'a) Int_map.t
+  type 'a t = (int * 'a) Int.Map.t
 
   let make l =
     if List.is_empty l then
       Exn.code_error "Syntax.Versioned_parser.make got empty list" [];
     match
       List.map l ~f:(fun ((major, minor), p) -> (major, (minor, p)))
-      |> Int_map.of_list
+      |> Int.Map.of_list
     with
     | Ok x -> x
     | Error _ ->
@@ -38,12 +38,12 @@ module Versioned_parser = struct
         [ "versions", Sexp.To_sexp.list Version.sexp_of_t (List.map l ~f:fst) ]
 
   let last t =
-    let major, (minor, p) = Option.value_exn (Int_map.max_binding t) in
+    let major, (minor, p) = Option.value_exn (Int.Map.max_binding t) in
     ((major, minor), p)
 
   let find_exn t ~loc ~data_version:(major, minor) =
     match
-      Option.bind (Int_map.find t major) ~f:(fun (minor', p) ->
+      Option.bind (Int.Map.find t major) ~f:(fun (minor', p) ->
         Option.some_if (minor' >= minor) p)
     with
     | None ->
@@ -52,7 +52,7 @@ module Versioned_parser = struct
                     %s"
         (Version.to_string (major, minor))
         (String.concat ~sep:"\n"
-           (Int_map.to_list t |> List.map ~f:(fun (major, (minor, _)) ->
+           (Int.Map.to_list t |> List.map ~f:(fun (major, (minor, _)) ->
               sprintf "- %u.0 to %u.%u" major major minor)))
     | Some p -> p
 end
diff --git a/src/top_closure.ml b/src/top_closure.ml
index f7490947..cec04979 100644
--- a/src/top_closure.ml
+++ b/src/top_closure.ml
@@ -46,5 +46,5 @@ module Make(Keys : Keys) = struct
     | Error elts -> Error elts
 end
 
-module Int    = Make(Int_set)
+module Int    = Make(Int.Set)
 module String = Make(String.Set)

From 274bb7099491f3e7c1c54a36c59b9b694ec50cc6 Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <rudi.grinberg@gmail.com>
Date: Tue, 22 May 2018 19:58:45 +0700
Subject: [PATCH 08/11] Move fmt to stdune

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
---
 src/import.ml        | 56 --------------------------------------------
 src/stdune/fmt.ml    | 54 ++++++++++++++++++++++++++++++++++++++++++
 src/stdune/fmt.mli   | 24 +++++++++++++++++++
 src/stdune/stdune.ml |  1 +
 4 files changed, 79 insertions(+), 56 deletions(-)
 create mode 100644 src/stdune/fmt.ml
 create mode 100644 src/stdune/fmt.mli

diff --git a/src/import.ml b/src/import.ml
index 9e7e2718..2972d36d 100644
--- a/src/import.ml
+++ b/src/import.ml
@@ -96,62 +96,6 @@ module No_io = struct
   module Io = struct end
 end
 
-module Fmt = struct
-  (* CR-someday diml: we should define a GADT for this:
-
-     {[
-       type 'a t =
-         | Int : int t
-         | Box : ...
-         | Colored : ...
-     ]}
-
-     This way we could separate the creation of messages from the
-     actual rendering.
-  *)
-  type 'a t = Format.formatter -> 'a -> unit
-
-  let kstrf f fmt =
-    let buf = Buffer.create 17 in
-    let f fmt = Format.pp_print_flush fmt () ; f (Buffer.contents buf) in
-    Format.kfprintf f (Format.formatter_of_buffer buf) fmt
-
-  let failwith fmt = kstrf failwith fmt
-
-  let list = Format.pp_print_list
-  let string s ppf = Format.pp_print_string ppf s
-
-  let nl = Format.pp_print_newline
-
-  let prefix f g ppf x = f ppf; g ppf x
-
-  let ocaml_list pp fmt = function
-    | [] -> Format.pp_print_string fmt "[]"
-    | l ->
-      Format.fprintf fmt "@[<hv>[ %a@ ]@]"
-        (list ~pp_sep:(fun fmt () -> Format.fprintf fmt "@,; ")
-           pp) l
-
-  let quoted fmt = Format.fprintf fmt "%S"
-
-  let const
-    : 'a t -> 'a -> unit t
-    = fun pp a' fmt () -> pp fmt a'
-
-  let record fmt = function
-    | [] -> Format.pp_print_string fmt "{}"
-    | xs ->
-      let pp fmt (field, pp) =
-        Format.fprintf fmt "@[<hov 1>%s@ =@ %a@]"
-          field pp () in
-      let pp_sep fmt () = Format.fprintf fmt "@,; " in
-      Format.fprintf fmt "@[<hv>{ %a@ }@]"
-        (Format.pp_print_list ~pp_sep pp) xs
-
-  let tuple ppfa ppfb fmt (a, b) =
-    Format.fprintf fmt "@[<hv>(%a, %a)@]" ppfa a ppfb b
-end
-
 (* This is ugly *)
 let printer = ref (Printf.eprintf "%s%!")
 let print_to_console s = !printer s
diff --git a/src/stdune/fmt.ml b/src/stdune/fmt.ml
new file mode 100644
index 00000000..a0d26090
--- /dev/null
+++ b/src/stdune/fmt.ml
@@ -0,0 +1,54 @@
+
+(* CR-someday diml: we should define a GADT for this:
+
+   {[
+     type 'a t =
+       | Int : int t
+       | Box : ...
+           | Colored : ...
+   ]}
+
+   This way we could separate the creation of messages from the
+   actual rendering.
+*)
+type 'a t = Format.formatter -> 'a -> unit
+
+let kstrf f fmt =
+  let buf = Buffer.create 17 in
+  let f fmt = Format.pp_print_flush fmt () ; f (Buffer.contents buf) in
+  Format.kfprintf f (Format.formatter_of_buffer buf) fmt
+
+let failwith fmt = kstrf failwith fmt
+
+let list = Format.pp_print_list
+let string s ppf = Format.pp_print_string ppf s
+
+let nl = Format.pp_print_newline
+
+let prefix f g ppf x = f ppf; g ppf x
+
+let ocaml_list pp fmt = function
+  | [] -> Format.pp_print_string fmt "[]"
+  | l ->
+    Format.fprintf fmt "@[<hv>[ %a@ ]@]"
+      (list ~pp_sep:(fun fmt () -> Format.fprintf fmt "@,; ")
+         pp) l
+
+let quoted fmt = Format.fprintf fmt "%S"
+
+let const
+  : 'a t -> 'a -> unit t
+  = fun pp a' fmt () -> pp fmt a'
+
+let record fmt = function
+  | [] -> Format.pp_print_string fmt "{}"
+  | xs ->
+    let pp fmt (field, pp) =
+      Format.fprintf fmt "@[<hov 1>%s@ =@ %a@]"
+        field pp () in
+    let pp_sep fmt () = Format.fprintf fmt "@,; " in
+    Format.fprintf fmt "@[<hv>{ %a@ }@]"
+      (Format.pp_print_list ~pp_sep pp) xs
+
+let tuple ppfa ppfb fmt (a, b) =
+  Format.fprintf fmt "@[<hv>(%a, %a)@]" ppfa a ppfb b
diff --git a/src/stdune/fmt.mli b/src/stdune/fmt.mli
new file mode 100644
index 00000000..8681035e
--- /dev/null
+++ b/src/stdune/fmt.mli
@@ -0,0 +1,24 @@
+type 'a t = Format.formatter -> 'a -> unit
+
+val list : ?pp_sep:unit t -> 'a t -> 'a list t
+
+val failwith : ('a, Format.formatter, unit, 'b) format4 -> 'a
+
+val string : string -> Format.formatter -> unit
+
+val prefix
+  : (Format.formatter -> unit)
+  -> (Format.formatter -> 'b -> 'c)
+  -> (Format.formatter -> 'b -> 'c)
+
+val ocaml_list : 'a t -> 'a list t
+
+val quoted : string t
+
+val const : 'a t -> 'a -> unit t
+
+val record : (string * unit t) list t
+
+val tuple : 'a t -> 'b t -> ('a * 'b) t
+
+val nl : unit t
diff --git a/src/stdune/stdune.ml b/src/stdune/stdune.ml
index 4fc041f2..ef48991e 100644
--- a/src/stdune/stdune.ml
+++ b/src/stdune/stdune.ml
@@ -20,6 +20,7 @@ module String     = String
 module Char       = Char
 module Sexp       = Sexp
 module Path       = Path
+module Fmt        = Fmt
 
 external reraise : exn -> _ = "%reraise"
 

From 1aa62095842926959e947756b03e85299843ef2f Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <rudi.grinberg@gmail.com>
Date: Tue, 22 May 2018 20:13:08 +0700
Subject: [PATCH 09/11] Move interned to stdune

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
---
 src/{ => stdune}/interned.ml  | 2 --
 src/{ => stdune}/interned.mli | 2 --
 src/stdune/stdune.ml          | 1 +
 src/sub_system_name.ml        | 2 +-
 src/sub_system_name.mli       | 2 +-
 src/variant.ml                | 2 +-
 src/variant.mli               | 2 +-
 7 files changed, 5 insertions(+), 8 deletions(-)
 rename src/{ => stdune}/interned.ml (99%)
 rename src/{ => stdune}/interned.mli (98%)

diff --git a/src/interned.ml b/src/stdune/interned.ml
similarity index 99%
rename from src/interned.ml
rename to src/stdune/interned.ml
index efb57038..c00b9331 100644
--- a/src/interned.ml
+++ b/src/stdune/interned.ml
@@ -1,5 +1,3 @@
-open Import
-
 module type S = sig
   type t
   val compare : t -> t -> Ordering.t
diff --git a/src/interned.mli b/src/stdune/interned.mli
similarity index 98%
rename from src/interned.mli
rename to src/stdune/interned.mli
index 613020bc..b2ffa488 100644
--- a/src/interned.mli
+++ b/src/stdune/interned.mli
@@ -1,7 +1,5 @@
 (** Interned strings *)
 
-open! Import
-
 module type S = sig
   type t
   val compare : t -> t -> Ordering.t
diff --git a/src/stdune/stdune.ml b/src/stdune/stdune.ml
index ef48991e..e608c3d3 100644
--- a/src/stdune/stdune.ml
+++ b/src/stdune/stdune.ml
@@ -21,6 +21,7 @@ module Char       = Char
 module Sexp       = Sexp
 module Path       = Path
 module Fmt        = Fmt
+module Interned   = Interned
 
 external reraise : exn -> _ = "%reraise"
 
diff --git a/src/sub_system_name.ml b/src/sub_system_name.ml
index 1cb555bd..016ae847 100644
--- a/src/sub_system_name.ml
+++ b/src/sub_system_name.ml
@@ -1 +1 @@
-include Interned.Make ()
+include Stdune.Interned.Make ()
diff --git a/src/sub_system_name.mli b/src/sub_system_name.mli
index b4c0fbb5..30cd6fa7 100644
--- a/src/sub_system_name.mli
+++ b/src/sub_system_name.mli
@@ -1 +1 @@
-include Interned.S
+include Stdune.Interned.S
diff --git a/src/variant.ml b/src/variant.ml
index 0eab5f40..3071b3ae 100644
--- a/src/variant.ml
+++ b/src/variant.ml
@@ -1,4 +1,4 @@
-include Interned.Make()
+include Stdune.Interned.Make()
 
 let ppx_driver = make "ppx_driver"
 let mt         = make "mt"
diff --git a/src/variant.mli b/src/variant.mli
index 93f98488..c91f261c 100644
--- a/src/variant.mli
+++ b/src/variant.mli
@@ -6,7 +6,7 @@
     They are directly mapped to findlib predicates.
 *)
 
-include Interned.S
+include Stdune.Interned.S
 
 (** Well-known variants *)
 val ppx_driver : t

From cbf2727209dbfd96fea25224ca8ec1421a339b8f Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <rudi.grinberg@gmail.com>
Date: Thu, 24 May 2018 20:04:53 +0700
Subject: [PATCH 10/11] Add a resizing policy for Interned

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
---
 src/package.ml          |  2 +-
 src/stdune/interned.ml  | 14 +++++++++++---
 src/stdune/interned.mli |  4 +++-
 src/sub_system_name.ml  |  4 +++-
 src/variant.ml          |  4 +++-
 5 files changed, 21 insertions(+), 7 deletions(-)

diff --git a/src/package.ml b/src/package.ml
index 409fe9be..fb7788ae 100644
--- a/src/package.ml
+++ b/src/package.ml
@@ -1,7 +1,7 @@
 open Stdune
 
 module Name = struct
-  include Interned.Make()
+  include Interned.Make(struct let resize_policy = Interned.Conservative end)
 
   let of_string = make
 
diff --git a/src/stdune/interned.ml b/src/stdune/interned.ml
index c00b9331..af039be1 100644
--- a/src/stdune/interned.ml
+++ b/src/stdune/interned.ml
@@ -20,7 +20,15 @@ module type S = sig
   end with type key := t
 end
 
-module Make() = struct
+type resize_policy = Conservative | Greedy
+
+let new_size ~next ~size = function
+  | Conservative ->
+    let increment_size = 512 in
+    (next land (lnot (increment_size - 1))) + (increment_size * 2)
+  | Greedy -> size * 2
+
+module Make(R : sig val resize_policy : resize_policy end) = struct
   type t = int
 
   let ids = Hashtbl.create 1024
@@ -40,8 +48,8 @@ module Make() = struct
       }
 
     let resize t =
-      let increment_size = 512 in
-      let n = (!next land (lnot (increment_size - 1))) + (increment_size * 2) in
+      let n =
+        new_size ~next:!next ~size:(Array.length t.data) R.resize_policy in
       let old_data = t.data                       in
       let new_data = Array.make n t.default_value in
       t.data <- new_data;
diff --git a/src/stdune/interned.mli b/src/stdune/interned.mli
index b2ffa488..fec0493a 100644
--- a/src/stdune/interned.mli
+++ b/src/stdune/interned.mli
@@ -34,4 +34,6 @@ module type S = sig
   end with type key := t
 end
 
-module Make() : S
+type resize_policy = Conservative | Greedy
+
+module Make(R : sig val resize_policy : resize_policy end) : S
diff --git a/src/sub_system_name.ml b/src/sub_system_name.ml
index 016ae847..e44b598f 100644
--- a/src/sub_system_name.ml
+++ b/src/sub_system_name.ml
@@ -1 +1,3 @@
-include Stdune.Interned.Make ()
+open Stdune
+
+include Interned.Make(struct let resize_policy = Interned.Conservative end)
diff --git a/src/variant.ml b/src/variant.ml
index 3071b3ae..66d2c0de 100644
--- a/src/variant.ml
+++ b/src/variant.ml
@@ -1,4 +1,6 @@
-include Stdune.Interned.Make()
+open Stdune
+
+include Interned.Make(struct let resize_policy = Interned.Conservative end)
 
 let ppx_driver = make "ppx_driver"
 let mt         = make "mt"

From d3edc454acb1f07d666c9117517a367c4ec94e5c Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <rudi.grinberg@gmail.com>
Date: Thu, 24 May 2018 20:51:12 +0700
Subject: [PATCH 11/11] Add initial size to interned

Signed-off-by: Rudi Grinberg <rudi.grinberg@gmail.com>
---
 src/package.ml          | 5 ++++-
 src/stdune/interned.ml  | 8 ++++++--
 src/stdune/interned.mli | 5 ++++-
 src/sub_system_name.ml  | 5 ++++-
 src/variant.ml          | 5 ++++-
 5 files changed, 22 insertions(+), 6 deletions(-)

diff --git a/src/package.ml b/src/package.ml
index fb7788ae..1b2d1577 100644
--- a/src/package.ml
+++ b/src/package.ml
@@ -1,7 +1,10 @@
 open Stdune
 
 module Name = struct
-  include Interned.Make(struct let resize_policy = Interned.Conservative end)
+  include Interned.Make(struct
+      let initial_size = 16
+      let resize_policy = Interned.Conservative
+    end)
 
   let of_string = make
 
diff --git a/src/stdune/interned.ml b/src/stdune/interned.ml
index af039be1..e3cfc92f 100644
--- a/src/stdune/interned.ml
+++ b/src/stdune/interned.ml
@@ -28,7 +28,11 @@ let new_size ~next ~size = function
     (next land (lnot (increment_size - 1))) + (increment_size * 2)
   | Greedy -> size * 2
 
-module Make(R : sig val resize_policy : resize_policy end) = struct
+module Make(R : sig
+    val resize_policy : resize_policy
+    val initial_size  : int
+  end)
+= struct
   type t = int
 
   let ids = Hashtbl.create 1024
@@ -44,7 +48,7 @@ module Make(R : sig val resize_policy : resize_policy end) = struct
 
     let create ~default_value =
       { default_value
-      ; data = [||]
+      ; data = Array.make R.initial_size default_value
       }
 
     let resize t =
diff --git a/src/stdune/interned.mli b/src/stdune/interned.mli
index fec0493a..2b71006c 100644
--- a/src/stdune/interned.mli
+++ b/src/stdune/interned.mli
@@ -36,4 +36,7 @@ end
 
 type resize_policy = Conservative | Greedy
 
-module Make(R : sig val resize_policy : resize_policy end) : S
+module Make(R : sig
+    val initial_size : int
+    val resize_policy : resize_policy
+  end) : S
diff --git a/src/sub_system_name.ml b/src/sub_system_name.ml
index e44b598f..14397bbf 100644
--- a/src/sub_system_name.ml
+++ b/src/sub_system_name.ml
@@ -1,3 +1,6 @@
 open Stdune
 
-include Interned.Make(struct let resize_policy = Interned.Conservative end)
+include Interned.Make(struct
+    let initial_size = 16
+    let resize_policy = Interned.Conservative
+  end)
diff --git a/src/variant.ml b/src/variant.ml
index 66d2c0de..548b4855 100644
--- a/src/variant.ml
+++ b/src/variant.ml
@@ -1,6 +1,9 @@
 open Stdune
 
-include Interned.Make(struct let resize_policy = Interned.Conservative end)
+include Interned.Make(struct
+    let initial_size = 256
+    let resize_policy = Interned.Conservative
+  end)
 
 let ppx_driver = make "ppx_driver"
 let mt         = make "mt"