diff options
| author | Alain Frisch <alain@frisch.fr> | 2014-10-03 12:13:36 +0000 |
|---|---|---|
| committer | Alain Frisch <alain@frisch.fr> | 2014-10-03 12:13:36 +0000 |
| commit | f7506d81dfc25ba54d2ec2dd8b53a4607e96b6aa (patch) | |
| tree | 722fdbd41881fc601aea2fee254726d8e8e33bf4 /typing | |
| parent | cb01d1c89f0c0a50237e49c674a945723f7fae85 (diff) | |
Factorize.
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@15441 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
Diffstat (limited to 'typing')
| -rw-r--r-- | typing/ctype.ml | 61 |
1 files changed, 22 insertions, 39 deletions
diff --git a/typing/ctype.ml b/typing/ctype.ml index 04d456b85..a7d31e7c8 100644 --- a/typing/ctype.ml +++ b/typing/ctype.ml @@ -1185,26 +1185,31 @@ let instance_parameterized_type_2 sch_args sch_lst sch = cleanup_types (); (ty_args, ty_lst, ty) +let map_kind f = function + | Type_abstract -> Type_abstract + | Type_open -> Type_open + | Type_variant cl -> + Type_variant ( + List.map + (fun c -> + {c with + cd_args = List.map f c.cd_args; + cd_res = may_map f c.cd_res + }) + cl) + | Type_record (fl, rr) -> + Type_record ( + List.map + (fun l -> + {l with ld_type = f l.ld_type} + ) fl, rr) + + let instance_declaration decl = let decl = {decl with type_params = List.map simple_copy decl.type_params; type_manifest = may_map simple_copy decl.type_manifest; - type_kind = match decl.type_kind with - | Type_abstract -> Type_abstract - | Type_variant cl -> - Type_variant ( - List.map - (fun c -> - {c with cd_args=List.map simple_copy c.cd_args; - cd_res=may_map simple_copy c.cd_res}) - cl) - | Type_record (fl, rr) -> - Type_record ( - List.map - (fun l -> - {l with ld_type = copy l.ld_type} - ) fl, rr) - | Type_open -> Type_open + type_kind = map_kind simple_copy decl.type_kind; } in cleanup_types (); @@ -4325,29 +4330,7 @@ let nondep_type_decl env mid id is_covariant decl = try let params = List.map (nondep_type_rec env mid) decl.type_params in let tk = - try match decl.type_kind with - Type_abstract -> - Type_abstract - | Type_variant cstrs -> - Type_variant - (List.map - (fun c -> - {c with - cd_args = List.map (nondep_type_rec env mid) c.cd_args; - cd_res = may_map (nondep_type_rec env mid) c.cd_res; - } - ) - cstrs) - | Type_record(lbls, rep) -> - Type_record - (List.map - (fun l -> - {l with ld_type = nondep_type_rec env mid l.ld_type} - ) - lbls, - rep) - | Type_open -> - Type_open + try map_kind (nondep_type_rec env mid) decl.type_kind with Not_found when is_covariant -> Type_abstract and tm = try match decl.type_manifest with |