Remove str/sig class type from untyped and typed ast.

Sig and str class type cannot be generated by the .res parser.
Remove a bunch of code that deals with that.

Author: cristianoc

jscomp/frontend/bs_ast_mapper.ml

@@ -280,8 +280,7 @@ module MT = struct
     | Psig_open x -> open_ ~loc (sub.open_description sub x)
     | Psig_include x -> include_ ~loc (sub.include_description sub x)
     | Psig_class () -> assert false
-    | Psig_class_type l ->
-      class_type ~loc (List.map (sub.class_type_declaration sub) l)
+    | Psig_class_type () -> assert false
     | Psig_extension (x, attrs) ->
       extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs)
     | Psig_attribute x -> attribute ~loc (sub.attribute sub x)
@@ -336,8 +335,7 @@ module M = struct
     | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x)
     | Pstr_open x -> open_ ~loc (sub.open_description sub x)
     | Pstr_class () -> {pstr_loc = loc; pstr_desc = Pstr_class ()}
-    | Pstr_class_type l ->
-      class_type ~loc (List.map (sub.class_type_declaration sub) l)
+    | Pstr_class_type () -> {pstr_loc = loc; pstr_desc = Pstr_class_type ()}
     | Pstr_include x -> include_ ~loc (sub.include_declaration sub x)
     | Pstr_extension (x, attrs) ->
       extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs)

jscomp/ml/ast_helper.ml

@@ -240,7 +240,6 @@ module Sig = struct
   let open_ ?loc a = mk ?loc (Psig_open a)
   let include_ ?loc a = mk ?loc (Psig_include a)
 
-  let class_type ?loc a = mk ?loc (Psig_class_type a)
   let extension ?loc ?(attrs = []) a = mk ?loc (Psig_extension (a, attrs))
   let attribute ?loc a = mk ?loc (Psig_attribute a)
   let text txt =
@@ -263,7 +262,6 @@ module Str = struct
   let rec_module ?loc a = mk ?loc (Pstr_recmodule a)
   let modtype ?loc a = mk ?loc (Pstr_modtype a)
   let open_ ?loc a = mk ?loc (Pstr_open a)
-  let class_type ?loc a = mk ?loc (Pstr_class_type a)
   let include_ ?loc a = mk ?loc (Pstr_include a)
   let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs))
   let attribute ?loc a = mk ?loc (Pstr_attribute a)

jscomp/ml/ast_helper.mli

@@ -267,7 +267,6 @@ module Sig:
     val modtype: ?loc:loc -> module_type_declaration -> signature_item
     val open_: ?loc:loc -> open_description -> signature_item
     val include_: ?loc:loc -> include_description -> signature_item
-    val class_type: ?loc:loc -> class_type_declaration list -> signature_item
     val extension: ?loc:loc -> ?attrs:attrs -> extension -> signature_item
     val attribute: ?loc:loc -> attribute -> signature_item
     val text: text -> signature_item list
@@ -288,7 +287,6 @@ module Str:
     val rec_module: ?loc:loc -> module_binding list -> structure_item
     val modtype: ?loc:loc -> module_type_declaration -> structure_item
     val open_: ?loc:loc -> open_description -> structure_item
-    val class_type: ?loc:loc -> class_type_declaration list -> structure_item
     val include_: ?loc:loc -> include_declaration -> structure_item
     val extension: ?loc:loc -> ?attrs:attrs -> extension -> structure_item
     val attribute: ?loc:loc -> attribute -> structure_item

jscomp/ml/ast_iterator.ml

@@ -249,8 +249,7 @@ module MT = struct
     | Psig_open x -> sub.open_description sub x
     | Psig_include x -> sub.include_description sub x
     | Psig_class () -> ()
-    | Psig_class_type l ->
-        List.iter (sub.class_type_declaration sub) l
+    | Psig_class_type () -> ()
     | Psig_extension (x, attrs) ->
         sub.extension sub x; sub.attributes sub attrs
     | Psig_attribute x -> sub.attribute sub x
@@ -292,8 +291,7 @@ module M = struct
     | Pstr_modtype x -> sub.module_type_declaration sub x
     | Pstr_open x -> sub.open_description sub x
     | Pstr_class () -> ()
-    | Pstr_class_type l ->
-        List.iter (sub.class_type_declaration sub) l
+    | Pstr_class_type () -> ()
     | Pstr_include x -> sub.include_declaration sub x
     | Pstr_extension (x, attrs) ->
         sub.extension sub x; sub.attributes sub attrs

jscomp/ml/ast_mapper.ml

@@ -264,8 +264,7 @@ module MT = struct
     | Psig_open x -> open_ ~loc (sub.open_description sub x)
     | Psig_include x -> include_ ~loc (sub.include_description sub x)
     | Psig_class _ -> assert false
-    | Psig_class_type l ->
-        class_type ~loc (List.map (sub.class_type_declaration sub) l)
+    | Psig_class_type _ -> assert false
     | Psig_extension (x, attrs) ->
         extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs)
     | Psig_attribute x -> attribute ~loc (sub.attribute sub x)
@@ -310,8 +309,7 @@ module M = struct
     | Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x)
     | Pstr_open x -> open_ ~loc (sub.open_description sub x)
     | Pstr_class () -> {pstr_loc = loc ; pstr_desc = Pstr_class ()}
-    | Pstr_class_type l ->
-        class_type ~loc (List.map (sub.class_type_declaration sub) l)
+    | Pstr_class_type () -> {pstr_loc = loc ; pstr_desc = Pstr_class_type ()}
     | Pstr_include x -> include_ ~loc (sub.include_declaration sub x)
     | Pstr_extension (x, attrs) ->
         extension ~loc (sub.extension sub x) ~attrs:(sub.attributes sub attrs)

jscomp/ml/depend.ml

@@ -160,33 +160,6 @@ let add_type_extension bv te =
   add bv te.ptyext_path;
   List.iter (add_extension_constructor bv) te.ptyext_constructors
 
-let rec add_class_type bv cty =
-  match cty.pcty_desc with
-    Pcty_constr(l, tyl) ->
-      add bv l; List.iter (add_type bv) tyl
-  | Pcty_signature { pcsig_self = ty; pcsig_fields = fieldl } ->
-      add_type bv ty;
-      List.iter (add_class_type_field bv) fieldl
-  | Pcty_arrow(_, ty1, cty2) ->
-      add_type bv ty1; add_class_type bv cty2
-  | Pcty_extension e -> handle_extension e
-  | Pcty_open (_ovf, m, e) ->
-      let bv = open_module bv m.txt in add_class_type bv e
-
-and add_class_type_field bv pctf =
-  match pctf.pctf_desc with
-    Pctf_inherit cty -> add_class_type bv cty
-  | Pctf_val(_, _, _, ty) -> add_type bv ty
-  | Pctf_method(_, _, _, ty) -> add_type bv ty
-  | Pctf_constraint(ty1, ty2) -> add_type bv ty1; add_type bv ty2
-  | Pctf_attribute _ -> ()
-  | Pctf_extension e -> handle_extension e
-
-let add_class_description bv infos =
-  add_class_type bv infos.pci_expr
-
-let add_class_type_declaration = add_class_description
-
 let pattern_bv = ref StringMap.empty
 
 let rec add_pattern bv pat =
@@ -378,8 +351,8 @@ and add_sig_item (bv, m) item =
       (add bv, add m)
   | Psig_class () ->
       (bv, m)
-  | Psig_class_type cdtl ->
-      List.iter (add_class_type_declaration bv) cdtl; (bv, m)
+  | Psig_class_type () ->
+      (bv, m)
   | Psig_attribute _ -> (bv, m)
   | Psig_extension (e, _) ->
       handle_extension e;
@@ -464,8 +437,8 @@ and add_struct_item (bv, m) item : _ StringMap.t * _ StringMap.t =
       (open_module bv od.popen_lid.txt, m)
   | Pstr_class () ->
       (bv,m)
-  | Pstr_class_type cdtl ->
-      List.iter (add_class_type_declaration bv) cdtl; (bv, m)
+  | Pstr_class_type () ->
+      (bv, m)
   | Pstr_include incl ->
       let Node (s, m') = add_module_binding bv incl.pincl_mod in
       add_names s;

jscomp/ml/parser.ml

@@ -6710,7 +6710,7 @@ let yyact = [|
     let _1 = (Parsing.peek_val __caml_parser_env 0 : 'class_type_declarations) in
     Obj.repr(
 # 697 "ml/parser.mly"
-      ( let (l, ext) = _1 in mkstr_ext (Pstr_class_type (List.rev l)) ext )
+      ( let (_l, ext) = _1 in mkstr_ext (Pstr_class_type ()) ext )
 # 6715 "ml/parser.ml"
                : 'structure_item))
 ; (fun __caml_parser_env ->
@@ -7014,7 +7014,7 @@ let yyact = [|
     let _1 = (Parsing.peek_val __caml_parser_env 0 : 'class_type_declarations) in
     Obj.repr(
 # 809 "ml/parser.mly"
-      ( let (l, ext) = _1 in mksig_ext (Psig_class_type (List.rev l)) ext )
+      ( let (_l, ext) = _1 in mksig_ext (Psig_class_type ()) ext )
 # 7019 "ml/parser.ml"
                : 'signature_item))
 ; (fun __caml_parser_env ->

jscomp/ml/parser.mly

@@ -694,7 +694,7 @@ structure_item:
   | open_statement
       { let (body, ext) = $1 in mkstr_ext (Pstr_open body) ext }
   | class_type_declarations
-      { let (l, ext) = $1 in mkstr_ext (Pstr_class_type (List.rev l)) ext }
+      { let (_l, ext) = $1 in mkstr_ext (Pstr_class_type ()) ext }
   | str_include_statement
       { let (body, ext) = $1 in mkstr_ext (Pstr_include body) ext }
   | item_extension post_item_attributes
@@ -806,7 +806,7 @@ signature_item:
   | sig_include_statement
       { let (body, ext) = $1 in mksig_ext (Psig_include body) ext }
   | class_type_declarations
-      { let (l, ext) = $1 in mksig_ext (Psig_class_type (List.rev l)) ext }
+      { let (l, ext) = $1 in mksig_ext (Psig_class_type ()) ext }
   | item_extension post_item_attributes
       { mksig(Psig_extension ($1, (add_docs_attrs (symbol_docs ()) $2))) }
   | floating_attribute

jscomp/ml/parsetree.ml

@@ -706,9 +706,9 @@ and signature_item_desc =
   | Psig_include of include_description
         (* include MT *)
   | Psig_class of unit
-        (* class c1 : ... and ... and cn : ... *)
-  | Psig_class_type of class_type_declaration list
-        (* class type ct1 = ... and ... and ctn = ... *)
+        (* Dummy AST node *)
+  | Psig_class_type of unit
+        (* Dummy AST node *)
   | Psig_attribute of attribute
         (* [@@@id] *)
   | Psig_extension of extension * attributes
@@ -832,8 +832,8 @@ and structure_item_desc =
         (* open X *)
   | Pstr_class of unit
         (* Dummy AST node *)
-  | Pstr_class_type of class_type_declaration list
-        (* class type ct1 = ... and ... and ctn = ... *)
+  | Pstr_class_type of unit
+        (* Dummy AST node *)
   | Pstr_include of include_declaration
         (* include ME *)
   | Pstr_attribute of attribute

jscomp/ml/pprintast.ml

@@ -208,9 +208,6 @@ let constant f = function
 let mutable_flag f = function
   | Immutable -> ()
   | Mutable -> pp f "mutable@;"
-let virtual_flag f  = function
-  | Concrete -> ()
-  | Virtual -> pp f "virtual@;"
 
 (* trailing space added *)
 let rec_flag f rf =
@@ -233,14 +230,8 @@ let tyvar f str = pp f "'%s" str
 let tyvar_loc f str = pp f "'%s" str.txt
 let string_quot f x = pp f "`%s" x
 
-(* c ['a,'b] *)
-let rec class_params_def ctxt f =  function
-  | [] -> ()
-  | l ->
-      pp f "[%a] " (* space *)
-        (list (type_param ctxt) ~sep:",") l
 
-and type_with_label ctxt f (label, c) =
+let rec type_with_label ctxt f (label, c) =
   match label with
   | Nolabel    -> core_type1 ctxt f c (* otherwise parenthesize *)
   | Labelled s -> pp f "%s:%a" s (core_type1 ctxt) c
@@ -797,76 +788,6 @@ and item_extension ctxt f (s, e) =
 and exception_declaration ctxt f ext =
   pp f "@[<hov2>exception@ %a@]" (extension_constructor ctxt) ext
 
-and class_signature ctxt f { pcsig_self = ct; pcsig_fields = l ;_} =
-  let class_type_field f x =
-    match x.pctf_desc with
-    | Pctf_inherit (ct) ->
-        pp f "@[<2>inherit@ %a@]%a" (class_type ctxt) ct
-          (item_attributes ctxt) x.pctf_attributes
-    | Pctf_val (s, mf, vf, ct) ->
-        pp f "@[<2>val @ %a%a%s@ :@ %a@]%a"
-          mutable_flag mf virtual_flag vf s.txt (core_type ctxt) ct
-          (item_attributes ctxt) x.pctf_attributes
-    | Pctf_method (s, pf, vf, ct) ->
-        pp f "@[<2>method %a %a%s :@;%a@]%a"
-          private_flag pf virtual_flag vf s.txt (core_type ctxt) ct
-          (item_attributes ctxt) x.pctf_attributes
-    | Pctf_constraint (ct1, ct2) ->
-        pp f "@[<2>constraint@ %a@ =@ %a@]%a"
-          (core_type ctxt) ct1 (core_type ctxt) ct2
-          (item_attributes ctxt) x.pctf_attributes
-    | Pctf_attribute a -> floating_attribute ctxt f a
-    | Pctf_extension e ->
-        item_extension ctxt f e;
-        item_attributes ctxt f x.pctf_attributes
-  in
-  pp f "@[<hv0>@[<hv2>object@[<1>%a@]@ %a@]@ end@]"
-    (fun f -> function
-         {ptyp_desc=Ptyp_any; ptyp_attributes=[]; _} -> ()
-       | ct -> pp f " (%a)" (core_type ctxt) ct) ct
-    (list class_type_field ~sep:"@;") l
-
-(* call [class_signature] called by [class_signature] *)
-and class_type ctxt f x =
-  match x.pcty_desc with
-  | Pcty_signature cs ->
-      class_signature ctxt f cs;
-      attributes ctxt f x.pcty_attributes
-  | Pcty_constr (li, l) ->
-      pp f "%a%a%a"
-        (fun f l -> match l with
-           | [] -> ()
-           | _  -> pp f "[%a]@ " (list (core_type ctxt) ~sep:"," ) l) l
-        longident_loc li
-        (attributes ctxt) x.pcty_attributes
-  | Pcty_arrow (l, co, cl) ->
-      pp f "@[<2>%a@;->@;%a@]" (* FIXME remove parens later *)
-        (type_with_label ctxt) (l,co)
-        (class_type ctxt) cl
-  | Pcty_extension e ->
-      extension ctxt f e;
-      attributes ctxt f x.pcty_attributes
-  | Pcty_open (ovf, lid, e) ->
-      pp f "@[<2>let open%s %a in@;%a@]" (override ovf) longident_loc lid
-        (class_type ctxt) e
-
-(* [class type a = object end] *)
-and class_type_declaration_list ctxt f l =
-  let class_type_declaration kwd f x =
-    let { pci_params=ls; pci_name={ txt; _ }; _ } = x in
-    pp f "@[<2>%s %a%a%s@ =@ %a@]%a" kwd
-      virtual_flag x.pci_virt
-      (class_params_def ctxt) ls txt
-      (class_type ctxt) x.pci_expr
-      (item_attributes ctxt) x.pci_attributes
-  in
-  match l with
-  | [] -> ()
-  | [x] -> class_type_declaration "class type" f x
-  | x :: xs ->
-      pp f "@[<v>%a@,%a@]"
-        (class_type_declaration "class type") x
-        (list ~sep:"@," (class_type_declaration "and")) xs
 
 and class_field ctxt f x =
   match x.pcf_desc with
@@ -1023,7 +944,7 @@ and signature_item ctxt f x : unit =
                pp f "@ =@ %a" (module_type ctxt) mt
         ) md
         (item_attributes ctxt) attrs
-  | Psig_class_type (l) -> class_type_declaration_list ctxt f l
+  | Psig_class_type () -> ()
   | Psig_recmodule decls ->
       let rec  string_x_module_type_list f ?(first=true) l =
         match l with
@@ -1222,7 +1143,7 @@ and structure_item ctxt f x =
         ) md
         (item_attributes ctxt) attrs
   | Pstr_class () -> ()
-  | Pstr_class_type l -> class_type_declaration_list ctxt f l
+  | Pstr_class_type () -> ()
   | Pstr_primitive vd ->
       pp f "@[<hov2>external@ %a@ :@ %a@]%a"
         protect_ident vd.pval_name.txt