No extensible type for types.

src/core/builtins/builtins_settings.ml

@@ -24,13 +24,10 @@ exception Found of (Lang.value * Lang.value option)
 
 let settings = ref Lang.null
 
-type Type.constr_t += Dtools
-
 let dtools_constr =
   let open Liquidsoap_lang in
   let open Type in
   {
-    t = Dtools;
     constr_descr = "unit, bool, int, float, string or [string]";
     univ_descr = None;
     satisfied =

src/core/builtins/builtins_sqlite.ml

@@ -29,12 +29,9 @@ let escape =
   let rex = Pcre.regexp "'" in
   fun s -> "'" ^ Pcre.substitute ~rex ~subst:(fun _ -> "''") s ^ "'"
 
-type Type.constr_t += Insert_value | Insert_record
-
 let insert_value_constr =
   let open Type in
   {
-    t = Insert_value;
     constr_descr = "int, float, string or null.";
     univ_descr = None;
     satisfied =
@@ -55,7 +52,6 @@ let insert_value_constr =
 let insert_record_constr =
   let open Type in
   {
-    t = Insert_record;
     constr_descr = "a record with int, float, string or null methods.";
     univ_descr = None;
     satisfied =

src/core/types/format_type.ml

@@ -22,14 +22,6 @@
 
 type Type.custom += Kind of (Content_base.kind * Type.t)
 type Type.custom += Format of Content_base.format
-
-type Type.constr_t +=
-  | PcmAudio
-  | Track
-  | MuxedTracks
-  | InternalTrack
-  | InternalTracks
-
 type descr = [ `Format of Content_base.format | `Kind of Content_base.kind ]
 
 let get_format = function Format f -> f | _ -> assert false
@@ -197,10 +189,9 @@ let is_format f m =
   let module Content = (val m : Content) in
   Content.is_format f
 
-let check_track ?univ_descr ~t modules =
+let check_track ?univ_descr modules =
   {
-    Type.t;
-    constr_descr =
+    Type.constr_descr =
       Printf.sprintf "a track of type: %s"
         (Utils.concat_with_last ~last:"or" ", "
            (List.map string_of_kind modules));
@@ -220,13 +211,12 @@ let check_track ?univ_descr ~t modules =
           | _ -> raise Type.Unsatisfied_constraint);
   }
 
-let pcm_audio = check_track ~univ_descr:"pcm*" ~t:PcmAudio pcm_modules
-let internal_track = check_track ~t:InternalTrack internal_modules
+let pcm_audio = check_track ~univ_descr:"pcm*" pcm_modules
+let internal_track = check_track internal_modules
 
 let internal_tracks =
   {
-    Type.t = InternalTracks;
-    constr_descr = "a set of internal tracks";
+    Type.constr_descr = "a set of internal tracks";
     univ_descr = None;
     satisfied =
       (fun ~subtype:_ ~satisfies b ->
@@ -254,8 +244,7 @@ let internal_tracks =
 
 let track =
   {
-    Type.t = Track;
-    constr_descr = "a track";
+    Type.constr_descr = "a track";
     univ_descr = None;
     satisfied =
       (fun ~subtype:_ ~satisfies b ->
@@ -271,8 +260,7 @@ let track =
 
 let muxed_tracks =
   {
-    Type.t = MuxedTracks;
-    constr_descr = "a set of tracks to be muxed into a source";
+    Type.constr_descr = "a set of tracks to be muxed into a source";
     univ_descr = None;
     satisfied =
       (fun ~subtype:_ ~satisfies b ->

src/lang/dune

@@ -138,6 +138,7 @@
   term_reducer
   type
   type_base
+  type_constraints
   typechecking
   typing
   unifier

src/lang/repr.ml

@@ -31,6 +31,8 @@ let global_evar_names = ref false
 open Type_base
 include R
 
+type t = Type_base.constr R.t
+
 (** Given a position, find the relevant excerpt. *)
 let excerpt (start, stop) =
   try
@@ -197,8 +199,7 @@ let make ?(filter_out = fun _ -> false) ?(generalized = []) t : t =
         | Var { contents = Link (`Covariant, t) } when !debug || !debug_variance
           ->
             `Debug ("[>", repr g t, "]")
-        | Var { contents = Link (_, t) } -> repr g t
-        | _ -> raise NotImplemented)
+        | Var { contents = Link (_, t) } -> repr g t)
   in
   repr generalized t
 

src/lang/type.ml

@@ -26,7 +26,6 @@ module Ground = Ground_type
 
 let record_constr =
   {
-    t = Record;
     constr_descr = "a record type";
     univ_descr = None;
     satisfied =
@@ -41,7 +40,6 @@ let record_constr =
 
 let num_constr =
   {
-    t = Num;
     constr_descr = "a number type";
     univ_descr = None;
     satisfied =
@@ -58,7 +56,6 @@ let num_constr =
 
 let ord_constr =
   {
-    t = Ord;
     constr_descr = "an orderable type";
     univ_descr = None;
     satisfied =

src/lang/type.mli

@@ -26,14 +26,23 @@ val debug_variance : bool ref
 
 (** {2 Types} *)
 
+open Type_base
+
 type variance = [ `Covariant | `Invariant ]
-type descr = Type_base.descr = ..
 type t = Type_base.t = private { pos : Pos.Option.t; descr : descr }
-type constr_t = Type_base.constr_t = ..
-type constr_t += Num | Ord
+
+type descr = Type_base.descr =
+  | Custom of custom_handler
+  | Constr of constructed
+  | Getter of t  (** a getter: something that is either a t or () -> t *)
+  | List of repr_t
+  | Tuple of t list
+  | Nullable of t  (** something that is either t or null *)
+  | Meth of meth * t  (** t with a method added *)
+  | Arrow of t argument list * t  (** a function *)
+  | Var of invar ref  (** a type variable *)
 
 type constr = Type_base.constr = {
-  t : constr_t;
   constr_descr : string;
   univ_descr : string option;
   satisfied : subtype:(t -> t -> unit) -> satisfies:(t -> unit) -> t -> unit;
@@ -52,7 +61,7 @@ type var = Type_base.var = {
   mutable constraints : Constraints.t;
 }
 
-type invar = Free of var | Link of variance * t
+type invar = Type_base.invar = Free of var | Link of variance * t
 type scheme = var list * t
 
 type meth = Type_base.meth = {
@@ -87,17 +96,6 @@ type custom_handler = Type_base.custom_handler = {
 
 type 'a argument = bool * string * 'a
 
-type descr +=
-  | Custom of custom_handler
-  | Constr of constructed
-  | Getter of t
-  | List of repr_t
-  | Tuple of t list
-  | Nullable of t
-  | Meth of meth * t
-  | Arrow of t argument list * t
-  | Var of invar ref
-
 exception NotImplemented
 exception Exists of Pos.Option.t * string
 exception Unsatisfied_constraint

src/lang/types/type_base.ml

@@ -46,113 +46,88 @@ let debug_variance = ref false
 
 (** {2 Types} *)
 
+(** Type description *)
+
 type variance = [ `Covariant | `Invariant ]
+type 'a argument = bool * string * 'a
 
-(** Type description *)
-type descr = ..
+module R = struct
+  type 'a meth = {
+    name : string;
+    optional : bool;
+    scheme : 'a var list * 'a t;
+    json_name : string option;
+  }
 
-(** A type *)
-type t = { pos : Pos.Option.t; descr : descr }
+  and 'a t =
+    [ `Constr of string * (variance * 'a t) list
+    | `List of 'a t * [ `Object | `Tuple ]
+    | `Tuple of 'a t list
+    | `Nullable of 'a t
+    | `Meth of 'a meth * 'a t (* label, type scheme, JSON name, base type *)
+    | `Arrow of 'a t argument list * 'a t
+    | `Getter of 'a t
+    | `EVar of 'a var (* existential variable *)
+    | `UVar of 'a var (* universal variable *)
+    | `Ellipsis (* omitted sub-term *)
+    | `Range_Ellipsis (* omitted sub-terms (in a list, e.g. list of args) *)
+    | `Debug of
+      string * 'a t * string
+      (* add annotations before / after, mostly used for debugging *) ]
 
-(** Constraint type *)
-type constr_t = ..
+  and 'a var = string * 'a Type_constraints.t
+end
 
-type constr_t += Num | Ord | Record
+type custom = ..
+
+type t = { pos : Pos.Option.t; descr : descr }
 
-type constr = {
-  t : constr_t;
+and constr = {
   constr_descr : string;
   univ_descr : string option;
   satisfied : subtype:(t -> t -> unit) -> satisfies:(t -> unit) -> t -> unit;
 }
 
-module Constraints = Set.Make (struct
-  type t = constr
-
-  let compare { t } { t = t' } = Stdlib.compare t t'
-end)
-
 (** A type constructor applied to arguments (e.g. source). *)
-type constructed = { constructor : string; params : (variance * t) list }
+and constructed = { constructor : string; params : (variance * t) list }
 
 (** Contents of a variable. *)
-type var = {
+and var = {
   name : int;
   mutable level : int;
-  mutable constraints : Constraints.t;
+  mutable constraints : constr Type_constraints.t;
 }
 
-type invar =
+and invar =
   | Free of var  (** the variable is free *)
   | Link of variance * t  (** the variable has bee substituted *)
 
 (** A type scheme (i.e. a type with universally quantified variables). *)
-type scheme = var list * t
+and scheme = var list * t
 
 (** A method. *)
-type meth = {
+and meth = {
   meth : string;  (** name of the method *)
   optional : bool;  (** is the method optional? *)
   scheme : scheme;  (** type scheme *)
   doc : string;  (** documentation *)
   json_name : string option;  (** name when represented as JSON *)
 }
 
-type repr_t = { t : t; json_repr : [ `Tuple | `Object ] }
-
-(** Sets of type descriptions. *)
-module DS = Set.Make (struct
-  type t = string * Constraints.t
-
-  let compare (s, v) (s', v') =
-    match Stdlib.compare s s' with 0 -> Constraints.compare v v' | x -> x
-end)
-
-let string_of_constr c = c.constr_descr
+and repr_t = { t : t; json_repr : [ `Tuple | `Object ] }
 
-type 'a argument = bool * string * 'a
-
-module R = struct
-  type meth = {
-    name : string;
-    optional : bool;
-    scheme : var list * t;
-    json_name : string option;
-  }
-
-  and t =
-    [ `Constr of string * (variance * t) list
-    | `List of t * [ `Object | `Tuple ]
-    | `Tuple of t list
-    | `Nullable of t
-    | `Meth of meth * t (* label, type scheme, JSON name, base type *)
-    | `Arrow of t argument list * t
-    | `Getter of t
-    | `EVar of var (* existential variable *)
-    | `UVar of var (* universal variable *)
-    | `Ellipsis (* omitted sub-term *)
-    | `Range_Ellipsis (* omitted sub-terms (in a list, e.g. list of args) *)
-    | `Debug of
-      string * t * string
-      (* add annotations before / after, mostly used for debugging *) ]
-
-  and var = string * Constraints.t
-end
-
-type custom = ..
-
-type custom_handler = {
+and custom_handler = {
   typ : custom;
   copy_with : (t -> t) -> custom -> custom;
   occur_check : (t -> unit) -> custom -> unit;
   filter_vars : (var list -> t -> var list) -> var list -> custom -> var list;
-  repr : (var list -> t -> R.t) -> var list -> custom -> R.t;
+  repr : (var list -> t -> constr R.t) -> var list -> custom -> constr R.t;
   subtype : (t -> t -> unit) -> custom -> custom -> unit;
   sup : (t -> t -> t) -> custom -> custom -> custom;
   to_string : custom -> string;
 }
 
-type descr +=
+and descr =
   | Custom of custom_handler
   | Constr of constructed
   | Getter of t  (** a getter: something that is either a t or () -> t *)
@@ -163,6 +138,21 @@ type descr +=
   | Arrow of t argument list * t  (** a function *)
   | Var of invar ref  (** a type variable *)
 
+module Constraints = struct
+  include Type_constraints
+
+  type nonrec t = constr Type_constraints.t
+end
+
+module DS = Set.Make (struct
+  type nonrec t = string * Constraints.t
+
+  let compare (s, v) (s', v') =
+    match Stdlib.compare s s' with 0 -> Constraints.compare v v' | x -> x
+end)
+
+let string_of_constr c = c.constr_descr
+
 exception NotImplemented
 exception Exists of Pos.Option.t * string
 exception Unsatisfied_constraint
@@ -372,7 +362,6 @@ module Fresh = struct
                  let new_link = { contents = Free (map_var var) } in
                  Hashtbl.replace link_maps link new_link;
                  new_link)
-      | _ -> assert false
     in
     let rec map { descr } = { pos = None; descr = map_descr map descr } in
     map t