diff options
Diffstat (limited to 'typing/env.ml')
| -rw-r--r-- | typing/env.ml | 58 |
1 files changed, 4 insertions, 54 deletions
diff --git a/typing/env.ml b/typing/env.ml index 3418a4f92..b970a235f 100644 --- a/typing/env.ml +++ b/typing/env.ml @@ -196,65 +196,15 @@ let rec scrape_modtype mty env = let constructors_of_type ty_path decl = match decl.type_kind with Type_variant cstrs -> - let ty_res = Tconstr(ty_path, decl.type_params) in - let num_consts = ref 0 and num_nonconsts = ref 0 in - List.iter - (function (name, []) -> incr num_consts - | (name, _) -> incr num_nonconsts) - cstrs; - let rec describe_constructors idx_const idx_nonconst = function - [] -> [] - | (name, ty_args) :: rem -> - let (tag, descr_rem) = - match ty_args with - [] -> (Cstr_constant idx_const, - describe_constructors (idx_const+1) idx_nonconst rem) - | _ -> (Cstr_block idx_nonconst, - describe_constructors idx_const (idx_nonconst+1) rem) in - let cstr = - { cstr_res = ty_res; - cstr_args = ty_args; - cstr_arity = List.length ty_args; - cstr_tag = tag; - cstr_consts = !num_consts; - cstr_nonconsts = !num_nonconsts } in - (name, cstr) :: descr_rem in - describe_constructors 0 0 cstrs + Datarepr.constructor_descrs (Tconstr(ty_path, decl.type_params)) cstrs | _ -> [] -(* Compute a constructor description for an exception *) - -let constructor_exception path_exc decl = - { cstr_res = Predef.type_exn; - cstr_args = decl; - cstr_arity = List.length decl; - cstr_tag = Cstr_exception path_exc; - cstr_consts = -1; - cstr_nonconsts = -1 } - (* Compute label descriptions *) -let dummy_label = - { lbl_res = Ttuple []; lbl_arg = Ttuple []; lbl_mut = Immutable; - lbl_pos = (-1); lbl_all = [||] } - let labels_of_type ty_path decl = match decl.type_kind with Type_record labels -> - let ty_res = Tconstr(ty_path, decl.type_params) in - let all_labels = Array.new (List.length labels) dummy_label in - let rec describe_labels num = function - [] -> [] - | (name, mut_flag, ty_arg) :: rest -> - let lbl = - { lbl_res = ty_res; - lbl_arg = ty_arg; - lbl_mut = mut_flag; - lbl_pos = num; - lbl_all = all_labels } in - all_labels.(num) <- lbl; - (name, lbl) :: describe_labels (num+1) rest in - describe_labels 0 labels + Datarepr.label_descrs (Tconstr(ty_path, decl.type_params)) labels | _ -> [] (* Given a signature and a root path, prefix all idents in the signature @@ -321,7 +271,7 @@ let rec components_of_module env path mty = (labels_of_type path decl') | Tsig_exception(id, decl) -> let decl' = Subst.exception_declaration sub decl in - let cstr = constructor_exception path decl' in + let cstr = Datarepr.exception_descr path decl' in c.comp_constrs <- Tbl.add (Ident.name id) (cstr, !pos) c.comp_constrs; incr pos @@ -376,7 +326,7 @@ and store_type id path info env = and store_exception id path decl env = { values = env.values; - constrs = Ident.add id (constructor_exception path decl) env.constrs; + constrs = Ident.add id (Datarepr.exception_descr path decl) env.constrs; labels = env.labels; types = env.types; modules = env.modules; |