Skip to content

Commit 0bbad1d

Browse files
cristianoccristianoc
committed
Remove Ptyp_class
1 parent dda9693 commit 0bbad1d

21 files changed

+27
-135
lines changed

‎jscomp/frontend/bs_ast_mapper.ml

+1-2
Original file line numberDiff line numberDiff line change
@@ -107,8 +107,7 @@ module T = struct
107107
constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
108108
| Ptyp_object (l, o) ->
109109
object_ ~loc ~attrs (List.map (object_field sub) l) o
110-
| Ptyp_class (lid, tl) ->
111-
class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
110+
| Ptyp_class () -> assert false
112111
| Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s
113112
| Ptyp_variant (rl, b, ll) ->
114113
variant ~loc ~attrs (List.map (row_field sub) rl) b ll

‎jscomp/ml/ast_helper.ml

+1-3
Original file line numberDiff line numberDiff line change
@@ -54,7 +54,6 @@ module Typ = struct
5454
let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a)
5555
let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b))
5656
let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b))
57-
let class_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_class (a, b))
5857
let alias ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_alias (a, b))
5958
let variant ?loc ?attrs a b c = mk ?loc ?attrs (Ptyp_variant (a, b, c))
6059
let poly ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_poly (a, b))
@@ -88,8 +87,7 @@ module Typ = struct
8887
Ptyp_constr(longident, List.map loop lst)
8988
| Ptyp_object (lst, o) ->
9089
Ptyp_object (List.map loop_object_field lst, o)
91-
| Ptyp_class (longident, lst) ->
92-
Ptyp_class (longident, List.map loop lst)
90+
| Ptyp_class () -> assert false
9391
| Ptyp_alias(core_type, string) ->
9492
check_variable var_names t.ptyp_loc string;
9593
Ptyp_alias(loop core_type, string)

‎jscomp/ml/ast_helper.mli

-1
Original file line numberDiff line numberDiff line change
@@ -62,7 +62,6 @@ module Typ :
6262
val constr: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
6363
val object_: ?loc:loc -> ?attrs:attrs -> object_field list
6464
-> closed_flag -> core_type
65-
val class_: ?loc:loc -> ?attrs:attrs -> lid -> core_type list -> core_type
6665
val alias: ?loc:loc -> ?attrs:attrs -> core_type -> string -> core_type
6766
val variant: ?loc:loc -> ?attrs:attrs -> row_field list -> closed_flag
6867
-> label list option -> core_type

‎jscomp/ml/ast_invariants.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -49,7 +49,7 @@ let iterator =
4949
let loc = ty.ptyp_loc in
5050
match ty.ptyp_desc with
5151
| Ptyp_tuple ([] | [_]) -> invalid_tuple loc
52-
| Ptyp_class (id, _) -> simple_longident id
52+
| Ptyp_class () -> ()
5353
| Ptyp_package (_, cstrs) ->
5454
List.iter (fun (id, _) -> simple_longident id) cstrs
5555
| _ -> ()

‎jscomp/ml/ast_iterator.ml

+1-2
Original file line numberDiff line numberDiff line change
@@ -96,8 +96,7 @@ module T = struct
9696
iter_loc sub lid; List.iter (sub.typ sub) tl
9797
| Ptyp_object (ol, _o) ->
9898
List.iter (object_field sub) ol
99-
| Ptyp_class (lid, tl) ->
100-
iter_loc sub lid; List.iter (sub.typ sub) tl
99+
| Ptyp_class () -> ()
101100
| Ptyp_alias (t, _) -> sub.typ sub t
102101
| Ptyp_variant (rl, _b, _ll) ->
103102
List.iter (row_field sub) rl

‎jscomp/ml/ast_mapper.ml

+1-2
Original file line numberDiff line numberDiff line change
@@ -98,8 +98,7 @@ module T = struct
9898
constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
9999
| Ptyp_object (l, o) ->
100100
object_ ~loc ~attrs (List.map (object_field sub) l) o
101-
| Ptyp_class (lid, tl) ->
102-
class_ ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl)
101+
| Ptyp_class () -> assert false
103102
| Ptyp_alias (t, s) -> alias ~loc ~attrs (sub.typ sub t) s
104103
| Ptyp_variant (rl, b, ll) ->
105104
variant ~loc ~attrs (List.map (row_field sub) rl) b ll

‎jscomp/ml/depend.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -108,7 +108,7 @@ let rec add_type bv ty =
108108
List.iter
109109
(function Otag (_, _, t) -> add_type bv t
110110
| Oinherit t -> add_type bv t) fl
111-
| Ptyp_class(c, tl) -> add bv c; List.iter (add_type bv) tl
111+
| Ptyp_class() -> ()
112112
| Ptyp_alias(t, _) -> add_type bv t
113113
| Ptyp_variant(fl, _, _) ->
114114
List.iter

‎jscomp/ml/parser.ml

+3-3
Original file line numberDiff line numberDiff line change
@@ -10679,23 +10679,23 @@ let yyact = [|
1067910679
let _2 = (Parsing.peek_val __caml_parser_env 0 : 'class_longident) in
1068010680
Obj.repr(
1068110681
# 2049 "ml/parser.mly"
10682-
( mktyp(Ptyp_class(mkrhs _2 2, [])) )
10682+
( mktyp(Ptyp_class()) )
1068310683
# 10692 "ml/parser.ml"
1068410684
: 'simple_core_type2))
1068510685
; (fun __caml_parser_env ->
1068610686
let _1 = (Parsing.peek_val __caml_parser_env 2 : 'simple_core_type2) in
1068710687
let _3 = (Parsing.peek_val __caml_parser_env 0 : 'class_longident) in
1068810688
Obj.repr(
1068910689
# 2051 "ml/parser.mly"
10690-
( mktyp(Ptyp_class(mkrhs _3 3, [_1])) )
10690+
( mktyp(Ptyp_class()) )
1069110691
# 10700 "ml/parser.ml"
1069210692
: 'simple_core_type2))
1069310693
; (fun __caml_parser_env ->
1069410694
let _2 = (Parsing.peek_val __caml_parser_env 3 : 'core_type_comma_list) in
1069510695
let _5 = (Parsing.peek_val __caml_parser_env 0 : 'class_longident) in
1069610696
Obj.repr(
1069710697
# 2053 "ml/parser.mly"
10698-
( mktyp(Ptyp_class(mkrhs _5 5, List.rev _2)) )
10698+
( mktyp(Ptyp_class()) )
1069910699
# 10708 "ml/parser.ml"
1070010700
: 'simple_core_type2))
1070110701
; (fun __caml_parser_env ->

‎jscomp/ml/parser.mly

+3-3
Original file line numberDiff line numberDiff line change
@@ -2038,11 +2038,11 @@ simple_core_type2:
20382038
| LESS GREATER
20392039
{ mktyp(Ptyp_object ([], Closed)) }
20402040
| HASH class_longident
2041-
{ mktyp(Ptyp_class(mkrhs $2 2, [])) }
2041+
{ mktyp(Ptyp_class()) }
20422042
| simple_core_type2 HASH class_longident
2043-
{ mktyp(Ptyp_class(mkrhs $3 3, [$1])) }
2043+
{ mktyp(Ptyp_class()) }
20442044
| LPAREN core_type_comma_list RPAREN HASH class_longident
2045-
{ mktyp(Ptyp_class(mkrhs $5 5, List.rev $2)) }
2045+
{ mktyp(Ptyp_class()) }
20462046
| LBRACKET tag_field RBRACKET
20472047
{ mktyp(Ptyp_variant([$2], Closed, None)) }
20482048
/* PR#3835: this is not LR(1), would need lookahead=2

‎jscomp/ml/parsetree.ml

+2-5
Original file line numberDiff line numberDiff line change
@@ -97,11 +97,8 @@ and core_type_desc =
9797
(* < l1:T1; ...; ln:Tn > (flag = Closed)
9898
< l1:T1; ...; ln:Tn; .. > (flag = Open)
9999
*)
100-
| Ptyp_class of Longident.t loc * core_type list
101-
(* #tconstr
102-
T #tconstr
103-
(T1, ..., Tn) #tconstr
104-
*)
100+
| Ptyp_class of unit
101+
(* dummy AST node *)
105102
| Ptyp_alias of core_type * string
106103
(* T as 'a *)
107104
| Ptyp_variant of row_field list * closed_flag * label list option

‎jscomp/ml/pprintast.ml

+1-4
Original file line numberDiff line numberDiff line change
@@ -321,10 +321,7 @@ and core_type1 ctxt f x =
321321
in
322322
pp f "@[<hov2><@ %a%a@ > @]" (list core_field_type ~sep:";") l
323323
field_var o (* Cf #7200 *)
324-
| Ptyp_class (li, l) -> (*FIXME*)
325-
pp f "@[<hov2>%a#%a@]"
326-
(list (core_type ctxt) ~sep:"," ~first:"(" ~last:")") l
327-
longident_loc li
324+
| Ptyp_class () -> ()
328325
| Ptyp_package (lid, cstrs) ->
329326
let aux f (s, ct) =
330327
pp f "type %a@ =@ %a" longident_loc s (core_type ctxt) ct in

‎jscomp/ml/printast.ml

+1-3
Original file line numberDiff line numberDiff line change
@@ -168,9 +168,7 @@ let rec core_type i ppf x =
168168
line i ppf "Oinherit\n";
169169
core_type (i + 1) ppf ct
170170
) l
171-
| Ptyp_class (li, l) ->
172-
line i ppf "Ptyp_class %a\n" fmt_longident_loc li;
173-
list i core_type ppf l
171+
| Ptyp_class () -> ()
174172
| Ptyp_alias (ct, s) ->
175173
line i ppf "Ptyp_alias \"%s\"\n" s;
176174
core_type i ppf ct;

‎jscomp/ml/printtyped.ml

+1-3
Original file line numberDiff line numberDiff line change
@@ -195,9 +195,7 @@ let rec core_type i ppf x =
195195
line i ppf "OTinherit\n";
196196
core_type (i + 1) ppf ct
197197
) l
198-
| Ttyp_class (li, _, l) ->
199-
line i ppf "Ttyp_class %a\n" fmt_path li;
200-
list i core_type ppf l;
198+
| Ttyp_class () -> ()
201199
| Ttyp_alias (ct, s) ->
202200
line i ppf "Ttyp_alias \"%s\"\n" s;
203201
core_type i ppf ct;

‎jscomp/ml/tast_mapper.ml

+1-6
Original file line numberDiff line numberDiff line change
@@ -518,12 +518,7 @@ let typ sub x =
518518
Ttyp_constr (path, lid, List.map (sub.typ sub) list)
519519
| Ttyp_object (list, closed) ->
520520
Ttyp_object ((List.map (sub.object_field sub) list), closed)
521-
| Ttyp_class (path, lid, list) ->
522-
Ttyp_class
523-
(path,
524-
lid,
525-
List.map (sub.typ sub) list
526-
)
521+
| Ttyp_class () -> Ttyp_class ()
527522
| Ttyp_alias (ct, s) ->
528523
Ttyp_alias (sub.typ sub ct, s)
529524
| Ttyp_variant (list, closed, labels) ->

‎jscomp/ml/typedtree.ml

+1-1
Original file line numberDiff line numberDiff line change
@@ -324,7 +324,7 @@ and core_type_desc =
324324
| Ttyp_tuple of core_type list
325325
| Ttyp_constr of Path.t * Longident.t loc * core_type list
326326
| Ttyp_object of object_field list * closed_flag
327-
| Ttyp_class of Path.t * Longident.t loc * core_type list
327+
| Ttyp_class of unit (* dummy AST node *)
328328
| Ttyp_alias of core_type * string
329329
| Ttyp_variant of row_field list * closed_flag * label list option
330330
| Ttyp_poly of string list * core_type

‎jscomp/ml/typedtree.mli

+1-1
Original file line numberDiff line numberDiff line change
@@ -441,7 +441,7 @@ and core_type_desc =
441441
| Ttyp_tuple of core_type list
442442
| Ttyp_constr of Path.t * Longident.t loc * core_type list
443443
| Ttyp_object of object_field list * closed_flag
444-
| Ttyp_class of Path.t * Longident.t loc * core_type list
444+
| Ttyp_class of unit (* dummy AST node *)
445445
| Ttyp_alias of core_type * string
446446
| Ttyp_variant of row_field list * closed_flag * label list option
447447
| Ttyp_poly of string list * core_type

‎jscomp/ml/typedtreeIter.ml

+1-2
Original file line numberDiff line numberDiff line change
@@ -461,8 +461,7 @@ module MakeIterator(Iter : IteratorArgument) : sig
461461
List.iter iter_core_type list
462462
| Ttyp_object (list, _o) ->
463463
List.iter iter_object_field list
464-
| Ttyp_class (_path, _, list) ->
465-
List.iter iter_core_type list
464+
| Ttyp_class () -> ()
466465
| Ttyp_alias (ct, _s) ->
467466
iter_core_type ct
468467
| Ttyp_variant (list, _bool, _labels) ->

‎jscomp/ml/typedtreeMap.ml

+2-2
Original file line numberDiff line numberDiff line change
@@ -504,8 +504,8 @@ module MakeMap(Map : MapArgument) = struct
504504
| Ttyp_object (list, o) ->
505505
Ttyp_object
506506
(List.map map_object_field list, o)
507-
| Ttyp_class (path, lid, list) ->
508-
Ttyp_class (path, lid, List.map map_core_type list)
507+
| Ttyp_class () ->
508+
Ttyp_class ()
509509
| Ttyp_alias (ct, s) -> Ttyp_alias (map_core_type ct, s)
510510
| Ttyp_variant (list, bool, labels) ->
511511
Ttyp_variant (List.map map_row_field list, bool, labels)

‎jscomp/ml/typetexp.ml

+1-81
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,6 @@
1818
(* Typechecking of type expressions for the core language *)
1919

2020
open Asttypes
21-
open Misc
2221
open Parsetree
2322
open Typedtree
2423
open Types
@@ -388,86 +387,7 @@ and transl_type_aux env policy styp =
388387
| Ptyp_object (fields, o) ->
389388
let ty, fields = transl_fields env policy o fields in
390389
ctyp (Ttyp_object (fields, o)) (newobj ty)
391-
| Ptyp_class(lid, stl) ->
392-
let (path, decl, _is_variant) =
393-
try
394-
let path = Env.lookup_type lid.txt env in
395-
let decl = Env.find_type path env in
396-
let rec check decl =
397-
match decl.type_manifest with
398-
None -> raise Not_found
399-
| Some ty ->
400-
match (repr ty).desc with
401-
Tvariant row when Btype.static_row row -> ()
402-
| Tconstr (path, _, _) ->
403-
check (Env.find_type path env)
404-
| _ -> raise Not_found
405-
in check decl;
406-
Location.deprecated styp.ptyp_loc
407-
"old syntax for polymorphic variant type";
408-
(path, decl,true)
409-
with Not_found -> try
410-
let lid2 =
411-
match lid.txt with
412-
Longident.Lident s -> Longident.Lident ("#" ^ s)
413-
| Longident.Ldot(r, s) -> Longident.Ldot (r, "#" ^ s)
414-
| Longident.Lapply(_, _) -> fatal_error "Typetexp.transl_type"
415-
in
416-
let path = Env.lookup_type lid2 env in
417-
let decl = Env.find_type path env in
418-
(path, decl, false)
419-
with Not_found ->
420-
ignore (find_class env lid.loc lid.txt); assert false
421-
in
422-
if List.length stl <> decl.type_arity then
423-
raise(Error(styp.ptyp_loc, env,
424-
Type_arity_mismatch(lid.txt, decl.type_arity,
425-
List.length stl)));
426-
let args = List.map (transl_type env policy) stl in
427-
let params = instance_list decl.type_params in
428-
List.iter2
429-
(fun (sty, cty) ty' ->
430-
try unify_var env ty' cty.ctyp_type with Unify trace ->
431-
raise (Error(sty.ptyp_loc, env, Type_mismatch (swap_list trace))))
432-
(List.combine stl args) params;
433-
let ty_args = List.map (fun ctyp -> ctyp.ctyp_type) args in
434-
let ty =
435-
try Ctype.expand_head env (newconstr path ty_args)
436-
with Unify trace ->
437-
raise (Error(styp.ptyp_loc, env, Type_mismatch trace))
438-
in
439-
let ty = match ty.desc with
440-
Tvariant row ->
441-
let row = Btype.row_repr row in
442-
let fields =
443-
List.map
444-
(fun (l,f) -> l,
445-
match Btype.row_field_repr f with
446-
| Rpresent (Some ty) ->
447-
Reither(false, [ty], false, ref None)
448-
| Rpresent None ->
449-
Reither (true, [], false, ref None)
450-
| _ -> f)
451-
row.row_fields
452-
in
453-
let row = { row_closed = true; row_fields = fields;
454-
row_bound = (); row_name = Some (path, ty_args);
455-
row_fixed = false; row_more = newvar () } in
456-
let static = Btype.static_row row in
457-
let row =
458-
if static then { row with row_more = newty Tnil }
459-
else if policy <> Univars then row
460-
else { row with row_more = new_pre_univar () }
461-
in
462-
newty (Tvariant row)
463-
| Tobject (fi, _) ->
464-
let _, tv = flatten_fields fi in
465-
if policy = Univars then pre_univars := tv :: !pre_univars;
466-
ty
467-
| _ ->
468-
assert false
469-
in
470-
ctyp (Ttyp_class (path, lid, args)) ty
390+
| Ptyp_class() -> assert false
471391
| Ptyp_alias(st, alias) ->
472392
let cty =
473393
try

‎jscomp/ml/untypeast.ml

+2-2
Original file line numberDiff line numberDiff line change
@@ -585,8 +585,8 @@ let core_type sub ct =
585585
| Ttyp_object (list, o) ->
586586
Ptyp_object
587587
(List.map (sub.object_field sub) list, o)
588-
| Ttyp_class (_path, lid, list) ->
589-
Ptyp_class (map_loc sub lid, List.map (sub.typ sub) list)
588+
| Ttyp_class () ->
589+
Ptyp_class ()
590590
| Ttyp_alias (ct, s) ->
591591
Ptyp_alias (sub.typ sub ct, s)
592592
| Ttyp_variant (list, bool, labels) ->

‎jscomp/syntax/src/res_ast_debugger.ml

+1-7
Original file line numberDiff line numberDiff line change
@@ -883,13 +883,7 @@ module SexpAst = struct
883883
closed_flag flag;
884884
Sexp.list (map_empty ~f:object_field fields);
885885
]
886-
| Ptyp_class (longident_loc, types) ->
887-
Sexp.list
888-
[
889-
Sexp.atom "Ptyp_class";
890-
longident longident_loc.Location.txt;
891-
Sexp.list (map_empty ~f:core_type types);
892-
]
886+
| Ptyp_class () -> assert false
893887
| Ptyp_variant (fields, flag, opt_labels) ->
894888
Sexp.list
895889
[

0 commit comments

Comments
 (0)