flambda-backend: Revert "Instance compilation units" (#1175)

Revert "Instance compilation units (#1113)"

This reverts commit 3bdccca.

Author: lukemaurer

utils/compilation_unit.ml

@@ -23,8 +23,6 @@ module String = Misc.Stdlib.String
 type error =
   | Invalid_character of char * string
   | Bad_compilation_unit_name of string
-  | Child_of_instance of { child_name : string }
-  | Packed_instance of { name : string }
 
 exception Error of error
 
@@ -172,56 +170,46 @@ end = struct
 end
 
 module T0 : sig
-  type descr = private
-    { name : Name.t;
-      for_pack_prefix : Prefix.t;
-      arguments : (Name.t * t) list
-    }
-
-  and t
+  type t
 
-  val descr : t -> descr
+  val for_pack_prefix_and_name : t -> Prefix.t * Name.t
 
   val name : t -> Name.t
 
   val for_pack_prefix : t -> Prefix.t
 
-  val arguments : t -> (Name.t * t) list
-
-  val create_full : Prefix.t -> Name.t -> (Name.t * t) list -> t
+  val create : Prefix.t -> Name.t -> t
 end = struct
-  (* As with [Name.t], changing [descr] or [t] requires bumping magic
+  (* As with [Name.t], changing [with_prefix] or [t] requires bumping magic
      numbers. *)
-  type descr =
+  type with_prefix =
     { name : Name.t;
-      for_pack_prefix : Prefix.t;
-      arguments : (Name.t * t) list
+      for_pack_prefix : Prefix.t
     }
 
-  (* type t = Simple of Name.t [@@unboxed] | Full of descr *)
-  and t = Obj.t
+  (* type t = Without_prefix of Name.t [@@unboxed] | With_prefix of
+     with_prefix *)
+  type t = Obj.t
 
   (* Some manual inlining is done here to ensure good performance under
      Closure. *)
 
-  let descr t =
+  let for_pack_prefix_and_name t =
     let tag = Obj.tag t in
     assert (tag = 0 || tag = Obj.string_tag);
     if tag <> 0
-    then
-      { name = Sys.opaque_identity (Obj.obj t : Name.t);
-        for_pack_prefix = Prefix.empty;
-        arguments = []
-      }
-    else Sys.opaque_identity (Obj.obj t : descr)
+    then Prefix.empty, Sys.opaque_identity (Obj.obj t : Name.t)
+    else
+      let with_prefix = Sys.opaque_identity (Obj.obj t : with_prefix) in
+      with_prefix.for_pack_prefix, with_prefix.name
 
   let name t =
     let tag = Obj.tag t in
     assert (tag = 0 || tag = Obj.string_tag);
     if tag <> 0
     then Sys.opaque_identity (Obj.obj t : Name.t)
     else
-      let with_prefix = Sys.opaque_identity (Obj.obj t : descr) in
+      let with_prefix = Sys.opaque_identity (Obj.obj t : with_prefix) in
       with_prefix.name
 
   let for_pack_prefix t =
@@ -230,55 +218,26 @@ end = struct
     if tag <> 0
     then Prefix.empty
     else
-      let descr = Sys.opaque_identity (Obj.obj t : descr) in
-      descr.for_pack_prefix
-
-  let arguments t =
-    let tag = Obj.tag t in
-    assert (tag = 0 || tag = Obj.string_tag);
-    if tag <> 0
-    then []
-    else
-      let descr = Sys.opaque_identity (Obj.obj t : descr) in
-      descr.arguments
+      let with_prefix = Sys.opaque_identity (Obj.obj t : with_prefix) in
+      with_prefix.for_pack_prefix
 
-  let create_full for_pack_prefix name arguments =
+  let create for_pack_prefix name =
     let empty_prefix = Prefix.is_empty for_pack_prefix in
-    let empty_arguments = match arguments with [] -> true | _ -> false in
     let () =
       if not empty_prefix
       then (
-        let () =
-          if not empty_arguments
-          then
-            (* CR-someday lmaurer: [for_pack_prefix] and [arguments] would make
-               for better output but it doesn't seem worth moving both [error]
-               and [print] to before this point *)
-            raise (Error (Packed_instance { name = name |> Name.to_string }))
-        in
         Name.check_as_path_component name;
         ListLabels.iter ~f:Name.check_as_path_component
           (for_pack_prefix |> Prefix.to_list))
     in
-    let arguments =
-      ListLabels.sort
-        ~cmp:(fun (p1, _v1) (p2, _v2) -> Name.compare p1 p2)
-        arguments
-    in
-    if empty_prefix && empty_arguments
+    if empty_prefix
     then Sys.opaque_identity (Obj.repr name)
-    else Sys.opaque_identity (Obj.repr { for_pack_prefix; name; arguments })
+    else Sys.opaque_identity (Obj.repr { for_pack_prefix; name })
 end
 
 include T0
 
-let create prefix name = create_full prefix name []
-
 let create_child parent name_ =
-  if not (Prefix.is_empty (for_pack_prefix parent))
-  then
-    (* CR-someday lmaurer: Same as for [create_full] *)
-    raise (Error (Child_of_instance { child_name = name_ |> Name.to_string }));
   let prefix =
     (for_pack_prefix parent |> Prefix.to_list) @ [name parent] |> Prefix.of_list
   in
@@ -294,10 +253,6 @@ let of_string str =
       Prefix.empty, Name.of_string str
     | Some _ -> Misc.fatal_errorf "[of_string] does not parse qualified names"
   in
-  let () =
-    if String.contains str '['
-    then Misc.fatal_error "[of_string] does not parse instances"
-  in
   create for_pack_prefix name
 
 let dummy = create Prefix.empty (Name.of_string "*none*")
@@ -313,67 +268,30 @@ let is_packed t = not (Prefix.is_empty (for_pack_prefix t))
 include Identifiable.Make (struct
   type nonrec t = t
 
-  let rec compare t1 t2 =
+  let compare t1 t2 =
     if t1 == t2
     then 0
     else
-      let { for_pack_prefix = for_pack_prefix1;
-            name = name1;
-            arguments = args1
-          } =
-        descr t1
-      in
-      let { for_pack_prefix = for_pack_prefix2;
-            name = name2;
-            arguments = args2
-          } =
-        descr t2
-      in
+      let for_pack_prefix1, name1 = for_pack_prefix_and_name t1 in
+      let for_pack_prefix2, name2 = for_pack_prefix_and_name t2 in
       let c = Name.compare name1 name2 in
-      if c <> 0
-      then c
-      else
-        let c = Prefix.compare for_pack_prefix1 for_pack_prefix2 in
-        if c <> 0 then c else List.compare compare_args args1 args2
-
-  and compare_args (param1, value1) (param2, value2) =
-    let c = Name.compare param1 param2 in
-    if c <> 0 then c else compare value1 value2
+      if c <> 0 then c else Prefix.compare for_pack_prefix1 for_pack_prefix2
 
   let equal x y = if x == y then true else compare x y = 0
 
-  let rec print fmt t =
-    let { for_pack_prefix; name; arguments } = descr t in
-    let () =
-      if Prefix.is_empty for_pack_prefix
-      then Format.fprintf fmt "%a" Name.print name
-      else
-        Format.fprintf fmt "%a.%a" Prefix.print for_pack_prefix Name.print name
-    in
-    ListLabels.iter ~f:(print_arg fmt) arguments
-
-  and print_arg fmt (param, value) =
-    Format.fprintf fmt "[%a:%a]" Name.print param print value
+  let print fmt t =
+    let for_pack_prefix, name = for_pack_prefix_and_name t in
+    if Prefix.is_empty for_pack_prefix
+    then Format.fprintf fmt "%a" Name.print name
+    else Format.fprintf fmt "%a.%a" Prefix.print for_pack_prefix Name.print name
 
   let output = output_of_print print
 
-  let rec hash t =
-    let { for_pack_prefix; name; arguments } = descr t in
-    Hashtbl.hash
-      ( Name.hash name,
-        Prefix.hash for_pack_prefix,
-        ListLabels.map ~f:hash_arg arguments )
-
-  and hash_arg (param, value) = Hashtbl.hash (param, hash value)
+  let hash t =
+    let for_pack_prefix, name = for_pack_prefix_and_name t in
+    Hashtbl.hash (Name.hash name, Prefix.hash for_pack_prefix)
 end)
 
-let is_instance t = match arguments t with [] -> false | _ :: _ -> true
-
-let create_instance t args =
-  if is_instance t
-  then Misc.fatal_errorf "@[<hov 1>Already an instance:@ %a@]" print t;
-  create_full (for_pack_prefix t) (name t) args
-
 let full_path t = Prefix.to_list (for_pack_prefix t) @ [name t]
 
 let is_parent t ~child =

utils/compilation_unit.mli

@@ -95,11 +95,6 @@ val create : Prefix.t -> Name.t -> t
     parent compilation unit as the prefix. *)
 val create_child : t -> Name.t -> t
 
-(** Create a compilation unit that's an instantiation of another unit with
-    given arguments. The arguments will be sorted alphabetically by
-    parameter name. *)
-val create_instance : t -> (Name.t * t) list -> t
-
 (** Create a compilation unit from the given [name]. No prefix is allowed;
     throws a fatal error if there is a "." in the name. (As a special case,
     a "." is allowed as the first character, to handle compilation units
@@ -195,19 +190,9 @@ val full_path : t -> Name.t list
     usual conventions. *)
 val full_path_as_string : t -> string
 
-(** Returns the arguments in the compilation unit, if it is an instance, or
-    the empty list otherwise. *)
-val arguments : t -> (Name.t * t) list
-
-(** Returns [true] iff the given compilation unit is an instance (equivalent
-    to [arguments t <> []]). *)
-val is_instance : t -> bool
-
 type error = private
   | Invalid_character of char * string
   | Bad_compilation_unit_name of string
-  | Child_of_instance of { child_name : string }
-  | Packed_instance of { name : string }
 
 (** The exception raised by conversion functions in this module. *)
 exception Error of error