@@ -29,14 +29,6 @@ type mapper = {
29
29
attributes : mapper -> attribute list -> attribute list ;
30
30
case : mapper -> case -> case ;
31
31
cases : mapper -> case list -> case list ;
32
- class_expr : mapper -> class_expr -> class_expr ;
33
- class_field : mapper -> class_field -> class_field ;
34
- class_signature : mapper -> class_signature -> class_signature ;
35
- class_structure : mapper -> class_structure -> class_structure ;
36
- class_type : mapper -> class_type -> class_type ;
37
- class_type_declaration :
38
- mapper -> class_type_declaration -> class_type_declaration ;
39
- class_type_field : mapper -> class_type_field -> class_type_field ;
40
32
constructor_declaration :
41
33
mapper -> constructor_declaration -> constructor_declaration ;
42
34
expr : mapper -> expression -> expression ;
@@ -115,8 +107,7 @@ module T = struct
115
107
constr ~loc ~attrs (map_loc sub lid) (List. map (sub.typ sub) tl)
116
108
| Ptyp_object (l , o ) ->
117
109
object_ ~loc ~attrs (List. map (object_field sub) l) o
118
- | Ptyp_class (lid , tl ) ->
119
- class_ ~loc ~attrs (map_loc sub lid) (List. map (sub.typ sub) tl)
110
+ | Ptyp_class () -> assert false
120
111
| Ptyp_alias (t , s ) -> alias ~loc ~attrs (sub.typ sub t) s
121
112
| Ptyp_variant (rl , b , ll ) ->
122
113
variant ~loc ~attrs (List. map (row_field sub) rl) b ll
@@ -192,44 +183,6 @@ module T = struct
192
183
~attrs: (sub.attributes sub pext_attributes)
193
184
end
194
185
195
- module CT = struct
196
- (* Type expressions for the class language *)
197
-
198
- let map sub {pcty_loc = loc ; pcty_desc = desc ; pcty_attributes = attrs } =
199
- let open Cty in
200
- let loc = sub.location sub loc in
201
- let attrs = sub.attributes sub attrs in
202
- match desc with
203
- | Pcty_constr (lid , tys ) ->
204
- constr ~loc ~attrs (map_loc sub lid) (List. map (sub.typ sub) tys)
205
- | Pcty_signature x -> signature ~loc ~attrs (sub.class_signature sub x)
206
- | Pcty_arrow (lab , t , ct ) ->
207
- arrow ~loc ~attrs lab (sub.typ sub t) (sub.class_type sub ct)
208
- | Pcty_extension x -> extension ~loc ~attrs (sub.extension sub x)
209
- | Pcty_open (ovf , lid , ct ) ->
210
- open_ ~loc ~attrs ovf (map_loc sub lid) (sub.class_type sub ct)
211
-
212
- let map_field sub {pctf_desc = desc ; pctf_loc = loc ; pctf_attributes = attrs }
213
- =
214
- let open Ctf in
215
- let loc = sub.location sub loc in
216
- let attrs = sub.attributes sub attrs in
217
- match desc with
218
- | Pctf_inherit ct -> inherit_ ~loc ~attrs (sub.class_type sub ct)
219
- | Pctf_val (s , m , v , t ) ->
220
- val_ ~loc ~attrs (map_loc sub s) m v (sub.typ sub t)
221
- | Pctf_method (s , p , v , t ) ->
222
- method_ ~loc ~attrs (map_loc sub s) p v (sub.typ sub t)
223
- | Pctf_constraint (t1 , t2 ) ->
224
- constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2)
225
- | Pctf_attribute x -> attribute ~loc (sub.attribute sub x)
226
- | Pctf_extension x -> extension ~loc ~attrs (sub.extension sub x)
227
-
228
- let map_signature sub {pcsig_self; pcsig_fields} =
229
- Csig. mk (sub.typ sub pcsig_self)
230
- (List. map (sub.class_type_field sub) pcsig_fields)
231
- end
232
-
233
186
module MT = struct
234
187
(* Type expressions for the module language *)
235
188
@@ -280,8 +233,7 @@ module MT = struct
280
233
| Psig_open x -> open_ ~loc (sub.open_description sub x)
281
234
| Psig_include x -> include_ ~loc (sub.include_description sub x)
282
235
| Psig_class () -> assert false
283
- | Psig_class_type l ->
284
- class_type ~loc (List. map (sub.class_type_declaration sub) l)
236
+ | Psig_class_type () -> assert false
285
237
| Psig_extension (x , attrs ) ->
286
238
extension ~loc (sub.extension sub x) ~attrs: (sub.attributes sub attrs)
287
239
| Psig_attribute x -> attribute ~loc (sub.attribute sub x)
@@ -336,8 +288,7 @@ module M = struct
336
288
| Pstr_modtype x -> modtype ~loc (sub.module_type_declaration sub x)
337
289
| Pstr_open x -> open_ ~loc (sub.open_description sub x)
338
290
| Pstr_class () -> {pstr_loc = loc; pstr_desc = Pstr_class () }
339
- | Pstr_class_type l ->
340
- class_type ~loc (List. map (sub.class_type_declaration sub) l)
291
+ | Pstr_class_type () -> {pstr_loc = loc; pstr_desc = Pstr_class_type () }
341
292
| Pstr_include x -> include_ ~loc (sub.include_declaration sub x)
342
293
| Pstr_extension (x , attrs ) ->
343
294
extension ~loc (sub.extension sub x) ~attrs: (sub.attributes sub attrs)
@@ -422,7 +373,7 @@ module E = struct
422
373
| Pexp_lazy e -> lazy_ ~loc ~attrs (sub.expr sub e)
423
374
| Pexp_poly (e , t ) ->
424
375
poly ~loc ~attrs (sub.expr sub e) (map_opt (sub.typ sub) t)
425
- | Pexp_object cls -> object_ ~loc ~attrs (sub.class_structure sub cls)
376
+ | Pexp_object () -> assert false
426
377
| Pexp_newtype (s , e ) ->
427
378
newtype ~loc ~attrs (map_loc sub s) (sub.expr sub e)
428
379
| Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me)
@@ -465,73 +416,6 @@ module P = struct
465
416
| Ppat_extension x -> extension ~loc ~attrs (sub.extension sub x)
466
417
end
467
418
468
- module CE = struct
469
- (* Value expressions for the class language *)
470
-
471
- let map sub {pcl_loc = loc ; pcl_desc = desc ; pcl_attributes = attrs } =
472
- let open Cl in
473
- let loc = sub.location sub loc in
474
- let attrs = sub.attributes sub attrs in
475
- match desc with
476
- | Pcl_constr (lid , tys ) ->
477
- constr ~loc ~attrs (map_loc sub lid) (List. map (sub.typ sub) tys)
478
- | Pcl_structure s -> structure ~loc ~attrs (sub.class_structure sub s)
479
- | Pcl_fun (lab , e , p , ce ) ->
480
- fun_ ~loc ~attrs lab
481
- (map_opt (sub.expr sub) e)
482
- (sub.pat sub p) (sub.class_expr sub ce)
483
- | Pcl_apply (ce , l ) ->
484
- apply ~loc ~attrs (sub.class_expr sub ce)
485
- (List. map (map_snd (sub.expr sub)) l)
486
- | Pcl_let (r , vbs , ce ) ->
487
- (* #if false then
488
- let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs)
489
- (sub.class_expr sub ce)
490
- #else *)
491
- let_ ~loc ~attrs r
492
- ((if r = Recursive then sub.value_bindings_rec else sub.value_bindings)
493
- sub vbs)
494
- (sub.class_expr sub ce)
495
- (* #end *)
496
- | Pcl_constraint (ce , ct ) ->
497
- constraint_ ~loc ~attrs (sub.class_expr sub ce) (sub.class_type sub ct)
498
- | Pcl_extension x -> extension ~loc ~attrs (sub.extension sub x)
499
- | Pcl_open (ovf , lid , ce ) ->
500
- open_ ~loc ~attrs ovf (map_loc sub lid) (sub.class_expr sub ce)
501
-
502
- let map_kind sub = function
503
- | Cfk_concrete (o , e ) -> Cfk_concrete (o, sub.expr sub e)
504
- | Cfk_virtual t -> Cfk_virtual (sub.typ sub t)
505
-
506
- let map_field sub {pcf_desc = desc ; pcf_loc = loc ; pcf_attributes = attrs } =
507
- let open Cf in
508
- let loc = sub.location sub loc in
509
- let attrs = sub.attributes sub attrs in
510
- match desc with
511
- | Pcf_inherit () -> {pcf_loc = loc; pcf_attributes = attrs; pcf_desc = desc}
512
- | Pcf_val (s , m , k ) -> val_ ~loc ~attrs (map_loc sub s) m (map_kind sub k)
513
- | Pcf_method (s , p , k ) ->
514
- method_ ~loc ~attrs (map_loc sub s) p (map_kind sub k)
515
- | Pcf_constraint (t1 , t2 ) ->
516
- constraint_ ~loc ~attrs (sub.typ sub t1) (sub.typ sub t2)
517
- | Pcf_initializer e -> initializer_ ~loc ~attrs (sub.expr sub e)
518
- | Pcf_attribute x -> attribute ~loc (sub.attribute sub x)
519
- | Pcf_extension x -> extension ~loc ~attrs (sub.extension sub x)
520
-
521
- let map_structure sub {pcstr_self; pcstr_fields} =
522
- {
523
- pcstr_self = sub.pat sub pcstr_self;
524
- pcstr_fields = List. map (sub.class_field sub) pcstr_fields;
525
- }
526
-
527
- let class_infos sub f
528
- {pci_virt; pci_params = pl ; pci_name; pci_expr; pci_loc; pci_attributes} =
529
- Ci. mk ~virt: pci_virt
530
- ~params: (List. map (map_fst (sub.typ sub)) pl)
531
- (map_loc sub pci_name) (f pci_expr) ~loc: (sub.location sub pci_loc)
532
- ~attrs: (sub.attributes sub pci_attributes)
533
- end
534
-
535
419
(* Now, a generic AST mapper, to be extended to cover all kinds and
536
420
cases of the OCaml grammar. The default behavior of the mapper is
537
421
the identity. *)
@@ -545,14 +429,6 @@ let default_mapper =
545
429
signature_item = MT. map_signature_item;
546
430
module_type = MT. map;
547
431
with_constraint = MT. map_with_constraint;
548
- class_expr = CE. map;
549
- class_field = CE. map_field;
550
- class_structure = CE. map_structure;
551
- class_type = CT. map;
552
- class_type_field = CT. map_field;
553
- class_signature = CT. map_signature;
554
- class_type_declaration =
555
- (fun this -> CE. class_infos this (this.class_type this));
556
432
type_declaration = T. map_type_declaration;
557
433
(* #if true then *)
558
434
type_declaration_list = T. map_type_declaration_list;
0 commit comments