diff options
Diffstat (limited to 'typing/predef.ml')
| -rw-r--r-- | typing/predef.ml | 148 |
1 files changed, 72 insertions, 76 deletions
diff --git a/typing/predef.ml b/typing/predef.ml index 5399656d54..9cbd889e06 100644 --- a/typing/predef.ml +++ b/typing/predef.ml @@ -116,23 +116,6 @@ let path_match_failure = Pident ident_match_failure and path_assert_failure = Pident ident_assert_failure and path_undefined_recursive_module = Pident ident_undefined_recursive_module -let decl_abstr = - {type_params = []; - type_arity = 0; - type_kind = Type_abstract; - type_loc = Location.none; - type_private = Asttypes.Public; - type_manifest = None; - type_variance = []; - type_is_newtype = false; - type_expansion_scope = lowest_level; - type_attributes = []; - type_immediate = false; - type_unboxed = unboxed_false_default_false; - } - -let decl_abstr_imm = {decl_abstr with type_immediate = true} - let cstr id args = { cd_id = id; @@ -140,6 +123,7 @@ let cstr id args = cd_res = None; cd_loc = Location.none; cd_attributes = []; + cd_uid = Uid.of_predef_id id; } let ident_false = ident_create "false" @@ -149,47 +133,49 @@ and ident_nil = ident_create "[]" and ident_cons = ident_create "::" and ident_none = ident_create "None" and ident_some = ident_create "Some" -let common_initial_env add_type add_extension empty_env = - let decl_bool = - {decl_abstr with - type_kind = Type_variant([cstr ident_false []; cstr ident_true []]); - type_immediate = true} - and decl_unit = - {decl_abstr with - type_kind = Type_variant([cstr ident_void []]); - type_immediate = true} - and decl_exn = - {decl_abstr with - type_kind = Type_open} - and decl_array = - let tvar = newgenvar() in - {decl_abstr with - type_params = [tvar]; - type_arity = 1; - type_variance = [Variance.full]} - and decl_list = - let tvar = newgenvar() in - {decl_abstr with - type_params = [tvar]; - type_arity = 1; - type_kind = - Type_variant([cstr ident_nil []; cstr ident_cons [tvar; type_list tvar]]); - type_variance = [Variance.covariant]} - and decl_option = - let tvar = newgenvar() in - {decl_abstr with - type_params = [tvar]; - type_arity = 1; - type_kind = Type_variant([cstr ident_none []; cstr ident_some [tvar]]); - type_variance = [Variance.covariant]} - and decl_lazy_t = - let tvar = newgenvar() in - {decl_abstr with - type_params = [tvar]; - type_arity = 1; - type_variance = [Variance.covariant]} + +let mk_add_type add_type type_ident + ?manifest ?(immediate=false) ?(kind=Type_abstract) env = + let decl = + {type_params = []; + type_arity = 0; + type_kind = kind; + type_loc = Location.none; + type_private = Asttypes.Public; + type_manifest = manifest; + type_variance = []; + type_is_newtype = false; + type_expansion_scope = lowest_level; + type_attributes = []; + type_immediate = immediate; + type_unboxed = unboxed_false_default_false; + type_uid = Uid.of_predef_id type_ident; + } in + add_type type_ident decl env +let common_initial_env add_type add_extension empty_env = + let add_type = mk_add_type add_type + and add_type1 type_ident ~variance ?(kind=fun _ -> Type_abstract) env = + let param = newgenvar () in + let decl = + {type_params = [param]; + type_arity = 1; + type_kind = kind param; + type_loc = Location.none; + type_private = Asttypes.Public; + type_manifest = None; + type_variance = [variance]; + type_is_newtype = false; + type_expansion_scope = lowest_level; + type_attributes = []; + type_immediate = false; + type_unboxed = unboxed_false_default_false; + type_uid = Uid.of_predef_id type_ident; + } + in + add_type type_ident decl env + in let add_extension id l = add_extension id { ext_type_path = path_exn; @@ -200,7 +186,9 @@ let common_initial_env add_type add_extension empty_env = ext_loc = Location.none; ext_attributes = [Ast_helper.Attr.mk (Location.mknoloc "ocaml.warn_on_literal_pattern") - (Parsetree.PStr [])] } + (Parsetree.PStr [])]; + ext_uid = Uid.of_predef_id id; + } in add_extension ident_match_failure [newgenty (Ttuple[type_string; type_int; type_int])] ( @@ -217,29 +205,37 @@ let common_initial_env add_type add_extension empty_env = [newgenty (Ttuple[type_string; type_int; type_int])] ( add_extension ident_undefined_recursive_module [newgenty (Ttuple[type_string; type_int; type_int])] ( - add_type ident_int64 decl_abstr ( - add_type ident_int32 decl_abstr ( - add_type ident_nativeint decl_abstr ( - add_type ident_lazy_t decl_lazy_t ( - add_type ident_option decl_option ( - add_type ident_list decl_list ( - add_type ident_array decl_array ( - add_type ident_exn decl_exn ( - add_type ident_unit decl_unit ( - add_type ident_bool decl_bool ( - add_type ident_float decl_abstr ( - add_type ident_string decl_abstr ( - add_type ident_char decl_abstr_imm ( - add_type ident_int decl_abstr_imm ( - add_type ident_extension_constructor decl_abstr ( - add_type ident_floatarray decl_abstr ( + add_type ident_int64 ( + add_type ident_int32 ( + add_type ident_nativeint ( + add_type1 ident_lazy_t ~variance:Variance.covariant ( + add_type1 ident_option ~variance:Variance.covariant + ~kind:(fun tvar -> + Type_variant([cstr ident_none []; cstr ident_some [tvar]]) + ) ( + add_type1 ident_list ~variance:Variance.covariant + ~kind:(fun tvar -> + Type_variant([cstr ident_nil []; cstr ident_cons [tvar; type_list tvar]]) + ) ( + add_type1 ident_array ~variance:Variance.full ( + add_type ident_exn ~kind:Type_open ( + add_type ident_unit ~immediate:true + ~kind:(Type_variant([cstr ident_void []])) ( + add_type ident_bool ~immediate:true + ~kind:(Type_variant([cstr ident_false []; cstr ident_true []])) ( + add_type ident_float ( + add_type ident_string ( + add_type ident_char ~immediate:true ( + add_type ident_int ~immediate:true ( + add_type ident_extension_constructor ( + add_type ident_floatarray ( empty_env)))))))))))))))))))))))))))) let build_initial_env add_type add_exception empty_env = let common = common_initial_env add_type add_exception empty_env in - let safe_string = add_type ident_bytes decl_abstr common in - let decl_bytes_unsafe = {decl_abstr with type_manifest = Some type_string} in - let unsafe_string = add_type ident_bytes decl_bytes_unsafe common in + let add_type = mk_add_type add_type in + let safe_string = add_type ident_bytes common in + let unsafe_string = add_type ident_bytes ~manifest:type_string common in (safe_string, unsafe_string) let builtin_values = |