Merge pull request #862 from rgrinberg/intern-order

Add an intern option to control ordering

src/package.ml

@@ -4,6 +4,7 @@ module Name = struct
   include Interned.Make(struct
       let initial_size = 16
       let resize_policy = Interned.Conservative
+      let order = Interned.Natural
     end)()
 
   let of_string = make

src/stdune/interned.ml

@@ -22,24 +22,26 @@ end
 
 type resize_policy = Conservative | Greedy
 
+type order = Natural | Fast
+
 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
-    val initial_size  : int
-  end)()
+module type Settings = sig
+  val initial_size : int
+  val resize_policy : resize_policy
+  val order : order
+end
+
+module Make(R : Settings)()
 = struct
-  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
@@ -86,10 +88,21 @@ module Make(R : sig
 
   let to_string t = Table.get names t
 
+  module T = struct
+    type nonrec t = int
+
+    let compare =
+      match R.order with
+      | Fast -> Int.compare
+      | Natural -> fun x y -> String.compare (to_string x) (to_string y)
+  end
+
+  include T
+
   let pp fmt t = Format.fprintf fmt "%S" (to_string t)
 
   module Set = struct
-    include Int.Set
+    include Set.Make(T)
 
     let make l =
       List.fold_left l ~init:empty ~f:(fun acc s -> add acc (make s))
@@ -97,12 +110,7 @@ module Make(R : sig
     let pp fmt (t : t) = Fmt.ocaml_list pp fmt (to_list t)
   end
 
-  module Map = Int.Map
-end
-
-module type Settings = sig
-  val initial_size : int
-  val resize_policy : resize_policy
+  module Map = Map.Make(T)
 end
 
 module No_interning(R : Settings)() = struct

src/stdune/interned.mli

@@ -36,9 +36,12 @@ end
 
 type resize_policy = Conservative | Greedy
 
+type order = Natural | Fast
+
 module type Settings = sig
   val initial_size : int
   val resize_policy : resize_policy
+  val order : order
 end
 
 module Make(R : Settings)() : S

src/stdune/path.ml

@@ -51,6 +51,7 @@ end = struct
   include Interned.No_interning(struct
       let initial_size = 512
       let resize_policy = Interned.Greedy
+      let order = Interned.Natural
     end)()
 
   let compare_val x y = String.compare (to_string x) (to_string y)
@@ -157,6 +158,7 @@ end = struct
   include Interned.No_interning(struct
       let initial_size = 512
       let resize_policy = Interned.Greedy
+      let order = Interned.Natural
     end)()
 
   let compare_val x y = String.compare (to_string x) (to_string y)

src/sub_system_name.ml

@@ -3,4 +3,5 @@ open Stdune
 include Interned.Make(struct
     let initial_size = 16
     let resize_policy = Interned.Conservative
+    let order = Interned.Natural
   end)()

src/variant.ml

@@ -3,6 +3,7 @@ open Stdune
 include Interned.Make(struct
     let initial_size = 256
     let resize_policy = Interned.Conservative
+    let order = Interned.Fast
   end)()
 
 let ppx_driver = make "ppx_driver"