Remove Ptyp_class

Author: cristianoc

jscomp/frontend/bs_ast_mapper.ml

@@ -107,8 +107,7 @@ module T = struct
       constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
     | Ptyp_object (l, o) ->
       object_ ~loc ~attrs (List.map (object_field sub) l) o
-    | Ptyp_class (lid, tl) ->
-      class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
+    | Ptyp_class () -> assert false
     | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s
     | Ptyp_variant (rl, b, ll) ->
       variant ~loc ~attrs (List.map (row_field sub) rl) b ll

jscomp/ml/ast_helper.ml

@@ -54,7 +54,6 @@ module Typ = struct
   let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a)
   let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b))
   let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b))
-  let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b))
   let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b))
   let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c))
   let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b))
@@ -88,8 +87,7 @@ module Typ = struct
             Ptyp_constr(longident, List.map loop lst)
         | Ptyp_object (lst, o) ->
             Ptyp_object (List.map loop_object_field lst, o)
-        | Ptyp_class (longident, lst) ->
-            Ptyp_class (longident, List.map loop lst)
+        | Ptyp_class () -> assert false
         | Ptyp_alias(core_type, string) ->
             check_variable var_names t.ptyp_loc string;
             Ptyp_alias(loop core_type, string)

jscomp/ml/ast_helper.mli

@@ -62,7 +62,6 @@ module Typ :
     val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
     val object_: ?loc:loc -> ?attrs:attrs -> object_field list
                    -> closed_flag -> core_type
-    val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
     val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type
     val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag
                  -> label list option -> core_type

jscomp/ml/ast_invariants.ml

@@ -49,7 +49,7 @@ let iterator =
     let loc = ty.ptyp_loc in
     match ty.ptyp_desc with
     | Ptyp_tuple ([] | [_]) -> invalid_tuple loc
-    | Ptyp_class (id, _) -> simple_longident id
+    | Ptyp_class () -> ()
     | Ptyp_package (_, cstrs) ->
       List.iter (fun (id, _) -> simple_longident id) cstrs
     | _ -> ()

jscomp/ml/ast_iterator.ml

@@ -96,8 +96,7 @@ module T = struct
         iter_loc sub lid; List.iter (sub.typ sub) tl
     | Ptyp_object (ol, _o) ->
         List.iter (object_field sub) ol
-    | Ptyp_class (lid, tl) ->
-        iter_loc sub lid; List.iter (sub.typ sub) tl
+    | Ptyp_class () -> ()
     | Ptyp_alias (t, _) -> sub.typ sub t
     | Ptyp_variant (rl, _b, _ll) ->
         List.iter (row_field sub) rl

jscomp/ml/ast_mapper.ml

@@ -98,8 +98,7 @@ module T = struct
         constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
     | Ptyp_object (l, o) ->
         object_ ~loc ~attrs (List.map (object_field sub) l) o
-    | Ptyp_class (lid, tl) ->
-        class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
+    | Ptyp_class () -> assert false
     | Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s
     | Ptyp_variant (rl, b, ll) ->
         variant ~loc ~attrs (List.map (row_field sub) rl) b ll

jscomp/ml/depend.ml

@@ -108,7 +108,7 @@ let rec add_type bv ty =
       List.iter
        (function Otag (_, _, t) -> add_type bv t
          | Oinherit t -> add_type bv t) fl
-  | Ptyp_class(c, tl) -> add bv c; List.iter (add_type bv) tl
+  | Ptyp_class() -> ()
   | Ptyp_alias(t, _) -> add_type bv t
   | Ptyp_variant(fl, _, _) ->
       List.iter

jscomp/ml/parser.ml

@@ -10679,23 +10679,23 @@ let yyact = [|
     let _2 = (Parsing.peek_val __caml_parser_env 0 : 'class_longident) in
     Obj.repr(
 # 2049 "ml/parser.mly"
-      ( mktyp(Ptyp_class(mkrhs _2 2, [])) )
+      ( mktyp(Ptyp_class()) )
 # 10692 "ml/parser.ml"
                : 'simple_core_type2))
 ; (fun __caml_parser_env ->
     let _1 = (Parsing.peek_val __caml_parser_env 2 : 'simple_core_type2) in
     let _3 = (Parsing.peek_val __caml_parser_env 0 : 'class_longident) in
     Obj.repr(
 # 2051 "ml/parser.mly"
-      ( mktyp(Ptyp_class(mkrhs _3 3, [_1])) )
+      ( mktyp(Ptyp_class()) )
 # 10700 "ml/parser.ml"
                : 'simple_core_type2))
 ; (fun __caml_parser_env ->
     let _2 = (Parsing.peek_val __caml_parser_env 3 : 'core_type_comma_list) in
     let _5 = (Parsing.peek_val __caml_parser_env 0 : 'class_longident) in
     Obj.repr(
 # 2053 "ml/parser.mly"
-      ( mktyp(Ptyp_class(mkrhs _5 5, List.rev _2)) )
+      ( mktyp(Ptyp_class()) )
 # 10708 "ml/parser.ml"
                : 'simple_core_type2))
 ; (fun __caml_parser_env ->

jscomp/ml/parser.mly

@@ -2038,11 +2038,11 @@ simple_core_type2:
   | LESS GREATER
       { mktyp(Ptyp_object ([], Closed)) }
   | HASH class_longident
-      { mktyp(Ptyp_class(mkrhs $2 2, [])) }
+      { mktyp(Ptyp_class()) }
   | simple_core_type2 HASH class_longident
-      { mktyp(Ptyp_class(mkrhs $3 3, [$1])) }
+      { mktyp(Ptyp_class()) }
   | LPAREN core_type_comma_list RPAREN HASH class_longident
-      { mktyp(Ptyp_class(mkrhs $5 5, List.rev $2)) }
+      { mktyp(Ptyp_class()) }
   | LBRACKET tag_field RBRACKET
       { mktyp(Ptyp_variant([$2], Closed, None)) }
 /* PR#3835: this is not LR(1), would need lookahead=2

jscomp/ml/parsetree.ml

@@ -97,11 +97,8 @@ and core_type_desc =
         (* < l1:T1; ...; ln:Tn >     (flag = Closed)
            < l1:T1; ...; ln:Tn; .. > (flag = Open)
          *)
-  | Ptyp_class of Longident.t loc * core_type list
-        (* #tconstr
-           T #tconstr
-           (T1, ..., Tn) #tconstr
-         *)
+  | Ptyp_class of unit
+        (* dummy AST node *)
   | Ptyp_alias of core_type * string
         (* T as 'a *)
   | Ptyp_variant of row_field list * closed_flag * label list option

jscomp/ml/pprintast.ml

@@ -321,10 +321,7 @@ and core_type1 ctxt f x =
         in
         pp f "@[<hov2><@ %a%a@ > @]" (list core_field_type ~sep:";") l
           field_var o (* Cf #7200 *)
-    | Ptyp_class (li, l) ->   (*FIXME*)
-        pp f "@[<hov2>%a#%a@]"
-          (list (core_type ctxt) ~sep:"," ~first:"(" ~last:")") l
-          longident_loc li
+    | Ptyp_class () -> ()
     | Ptyp_package (lid, cstrs) ->
         let aux f (s, ct) =
           pp f "type %a@ =@ %a" longident_loc s (core_type ctxt) ct  in

jscomp/ml/printast.ml

@@ -168,9 +168,7 @@ let rec core_type i ppf x =
               line i ppf "Oinherit\n";
               core_type (i + 1) ppf ct
       ) l
-  | Ptyp_class (li, l) ->
-      line i ppf "Ptyp_class %a\n" fmt_longident_loc li;
-      list i core_type ppf l
+  | Ptyp_class () -> ()
   | Ptyp_alias (ct, s) ->
       line i ppf "Ptyp_alias \"%s\"\n" s;
       core_type i ppf ct;

jscomp/ml/printtyped.ml

@@ -195,9 +195,7 @@ let rec core_type i ppf x =
             line i ppf "OTinherit\n";
             core_type (i + 1) ppf ct
         ) l
-  | Ttyp_class (li, _, l) ->
-      line i ppf "Ttyp_class %a\n" fmt_path li;
-      list i core_type ppf l;
+  | Ttyp_class () -> ()
   | Ttyp_alias (ct, s) ->
       line i ppf "Ttyp_alias \"%s\"\n" s;
       core_type i ppf ct;

jscomp/ml/tast_mapper.ml

@@ -518,12 +518,7 @@ let typ sub x =
         Ttyp_constr (path, lid, List.map (sub.typ sub) list)
     | Ttyp_object (list, closed) ->
         Ttyp_object ((List.map (sub.object_field sub) list), closed)
-    | Ttyp_class (path, lid, list) ->
-        Ttyp_class
-          (path,
-           lid,
-           List.map (sub.typ sub) list
-          )
+    | Ttyp_class () -> Ttyp_class ()
     | Ttyp_alias (ct, s) ->
         Ttyp_alias (sub.typ sub ct, s)
     | Ttyp_variant (list, closed, labels) ->

jscomp/ml/typedtree.ml

@@ -324,7 +324,7 @@ and core_type_desc =
   | Ttyp_tuple of core_type list
   | Ttyp_constr of Path.t * Longident.t loc * core_type list
   | Ttyp_object of object_field list * closed_flag
-  | Ttyp_class of Path.t * Longident.t loc * core_type list
+  | Ttyp_class of unit (* dummy AST node *)
   | Ttyp_alias of core_type * string
   | Ttyp_variant of row_field list * closed_flag * label list option
   | Ttyp_poly of string list * core_type

jscomp/ml/typedtree.mli

@@ -441,7 +441,7 @@ and core_type_desc =
   | Ttyp_tuple of core_type list
   | Ttyp_constr of Path.t * Longident.t loc * core_type list
   | Ttyp_object of object_field list * closed_flag
-  | Ttyp_class of Path.t * Longident.t loc * core_type list
+  | Ttyp_class of unit (* dummy AST node *)
   | Ttyp_alias of core_type * string
   | Ttyp_variant of row_field list * closed_flag * label list option
   | Ttyp_poly of string list * core_type

jscomp/ml/typedtreeIter.ml

@@ -461,8 +461,7 @@ module MakeIterator(Iter : IteratorArgument) : sig
             List.iter iter_core_type list
         | Ttyp_object (list, _o) ->
             List.iter iter_object_field list
-        | Ttyp_class (_path, _, list) ->
-            List.iter iter_core_type list
+        | Ttyp_class () -> ()
         | Ttyp_alias (ct, _s) ->
             iter_core_type ct
         | Ttyp_variant (list, _bool, _labels) ->

jscomp/ml/typedtreeMap.ml

@@ -504,8 +504,8 @@ module MakeMap(Map : MapArgument) = struct
         | Ttyp_object (list, o) ->
           Ttyp_object
             (List.map map_object_field list, o)
-        | Ttyp_class (path, lid, list) ->
-          Ttyp_class (path, lid, List.map map_core_type list)
+        | Ttyp_class () ->
+          Ttyp_class ()
         | Ttyp_alias (ct, s) -> Ttyp_alias (map_core_type ct, s)
         | Ttyp_variant (list, bool, labels) ->
           Ttyp_variant (List.map map_row_field list, bool, labels)

jscomp/ml/typetexp.ml

@@ -18,7 +18,6 @@
 (* Typechecking of type expressions for the core language *)
 
 open Asttypes
-open Misc
 open Parsetree
 open Typedtree
 open Types
@@ -388,86 +387,7 @@ and transl_type_aux env policy styp =
   | Ptyp_object (fields, o) ->
       let ty, fields = transl_fields env policy o fields in
       ctyp (Ttyp_object (fields, o)) (newobj ty)
-  | Ptyp_class(lid, stl) ->
-      let (path, decl, _is_variant) =
-        try
-          let path = Env.lookup_type lid.txt env in
-          let decl = Env.find_type path env in
-          let rec check decl =
-            match decl.type_manifest with
-              None -> raise Not_found
-            | Some ty ->
-                match (repr ty).desc with
-                  Tvariant row when Btype.static_row row -> ()
-                | Tconstr (path, _, _) ->
-                    check (Env.find_type path env)
-                | _ -> raise Not_found
-          in check decl;
-          Location.deprecated styp.ptyp_loc
-            "old syntax for polymorphic variant type";
-          (path, decl,true)
-        with Not_found -> try
-          let lid2 =
-            match lid.txt with
-              Longident.Lident s     -> Longident.Lident ("#" ^ s)
-            | Longident.Ldot(r, s)   -> Longident.Ldot (r, "#" ^ s)
-            | Longident.Lapply(_, _) -> fatal_error "Typetexp.transl_type"
-          in
-          let path = Env.lookup_type lid2 env in
-          let decl = Env.find_type path env in
-          (path, decl, false)
-        with Not_found ->
-          ignore (find_class env lid.loc lid.txt); assert false
-      in
-      if List.length stl <> decl.type_arity then
-        raise(Error(styp.ptyp_loc, env,
-                    Type_arity_mismatch(lid.txt, decl.type_arity,
-                                        List.length stl)));
-      let args = List.map (transl_type env policy) stl in
-      let params = instance_list decl.type_params in
-      List.iter2
-        (fun (sty, cty) ty' ->
-           try unify_var env ty' cty.ctyp_type with Unify trace ->
-             raise (Error(sty.ptyp_loc, env, Type_mismatch (swap_list trace))))
-        (List.combine stl args) params;
-        let ty_args = List.map (fun ctyp -> ctyp.ctyp_type) args in
-      let ty =
-        try Ctype.expand_head env (newconstr path ty_args)
-        with Unify trace ->
-          raise (Error(styp.ptyp_loc, env, Type_mismatch trace))
-      in
-      let ty = match ty.desc with
-        Tvariant row ->
-          let row = Btype.row_repr row in
-          let fields =
-            List.map
-              (fun (l,f) -> l,
-                match Btype.row_field_repr f with
-                | Rpresent (Some ty) ->
-                    Reither(false, [ty], false, ref None)
-                | Rpresent None ->
-                    Reither (true, [], false, ref None)
-                | _ -> f)
-              row.row_fields
-          in
-          let row = { row_closed = true; row_fields = fields;
-                      row_bound = (); row_name = Some (path, ty_args);
-                      row_fixed = false; row_more = newvar () } in
-          let static = Btype.static_row row in
-          let row =
-            if static then { row with row_more = newty Tnil }
-            else if policy <> Univars then row
-            else { row with row_more = new_pre_univar () }
-          in
-          newty (Tvariant row)
-      | Tobject (fi, _) ->
-          let _, tv = flatten_fields fi in
-          if policy = Univars then pre_univars := tv :: !pre_univars;
-          ty
-      | _ ->
-          assert false
-      in
-      ctyp (Ttyp_class (path, lid, args)) ty
+  | Ptyp_class() -> assert false
   | Ptyp_alias(st, alias) ->
       let cty =
         try

jscomp/ml/untypeast.ml

@@ -585,8 +585,8 @@ let core_type sub ct =
     | Ttyp_object (list, o) ->
         Ptyp_object
           (List.map (sub.object_field sub) list, o)
-    | Ttyp_class (_path, lid, list) ->
-        Ptyp_class (map_loc sub lid, List.map (sub.typ sub) list)
+    | Ttyp_class () ->
+        Ptyp_class ()
     | Ttyp_alias (ct, s) ->
         Ptyp_alias (sub.typ sub ct, s)
     | Ttyp_variant (list, bool, labels) ->

jscomp/syntax/src/res_ast_debugger.ml

@@ -883,13 +883,7 @@ module SexpAst = struct
             closed_flag flag;
             Sexp.list (map_empty ~f:object_field fields);
           ]
-      | Ptyp_class (longident_loc, types) ->
-        Sexp.list
-          [
-            Sexp.atom "Ptyp_class";
-            longident longident_loc.Location.txt;
-            Sexp.list (map_empty ~f:core_type types);
-          ]
+      | Ptyp_class () -> assert false
       | Ptyp_variant (fields, flag, opt_labels) ->
         Sexp.list
           [