%-----------------------------------------------------------------------------% % Copyright (C) 1994-2003 The University of Melbourne. % This file may only be copied under the terms of the GNU General % Public License - see the file COPYING in the Mercury distribution. %-----------------------------------------------------------------------------% % File: type_util.m. % Main author: fjh. % This file provides some utility predicates which operate on types. % It is used by various stages of the compilation after type-checking, % include the mode checker and the code generator. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- module check_hlds__type_util. :- interface. :- import_module hlds__hlds_data. :- import_module hlds__hlds_module. :- import_module hlds__hlds_pred. :- import_module libs__globals. :- import_module parse_tree__prog_data. :- import_module term. :- import_module bool, std_util, list, map. %-----------------------------------------------------------------------------% % Succeed iff type is an "atomic" type - one which can be % unified using a simple_test rather than a complicated_unify. :- pred type_is_atomic(type, module_info). :- mode type_is_atomic(in, in) is semidet. :- pred type_ctor_is_atomic(type_ctor, module_info). :- mode type_ctor_is_atomic(in, in) is semidet. % type_is_higher_order(Type, Purity, PredOrFunc, ArgTypes, EvalMeth): % succeeds iff Type is a higher-order predicate or function type with % the specified argument types (for functions, the return type is % appended to the end of the argument types), purity, and % evaluation method. :- pred type_is_higher_order(type, purity, pred_or_func, lambda_eval_method, list(type)). :- mode type_is_higher_order(in, out, out, out, out) is semidet. % Succeed if the given type is a tuple type, returning % the argument types. :- pred type_is_tuple(type, list(type)). :- mode type_is_tuple(in, out) is semidet. % type_has_variable_arity_ctor(Type, TypeCtor, TypeArgs) % Check if the principal type constructor of Type is of variable arity. % If yes, return the type constructor as TypeCtor and its args as % TypeArgs. If not, fail. :- pred type_has_variable_arity_ctor((type)::in, type_ctor::out, list(type)::out) is semidet. % type_ctor_is_higher_order(TypeCtor, PredOrFunc) succeeds iff % TypeCtor is a higher-order predicate or function type. :- pred type_ctor_is_higher_order(type_ctor, purity, pred_or_func, lambda_eval_method). :- mode type_ctor_is_higher_order(in, out, out, out) is semidet. % type_ctor_is_tuple(TypeCtor) succeeds iff TypeCtor is a tuple type. :- pred type_ctor_is_tuple(type_ctor). :- mode type_ctor_is_tuple(in) is semidet. % The list of type_ctors which are builtins which do not have a % hlds_type_defn. :- func builtin_type_ctors_with_no_hlds_type_defn = list(type_ctor). % Succeed iff there was either a `where equality is ' or a % `where comparison is ' declaration for the principal type % constructor of the specified type, and return the ids of the declared % unify and/or comparison predicates. Note that even if the type % constructor has only a `where comparison is' clause, it effectively % has user-defined equality, two values being equal only if the % compare pred returns equal. % % If the type is a type variable and thus has no principal type % constructor, fail. :- pred type_has_user_defined_equality_pred(module_info, (type), unify_compare). :- mode type_has_user_defined_equality_pred(in, in, out) is semidet. :- pred type_body_has_user_defined_equality_pred(module_info::in, hlds_type_body::in, unify_compare::out) is semidet. % Succeed if the inst `any' can be considered `bound' for this type. :- pred type_util__is_solver_type(module_info, (type)). :- mode type_util__is_solver_type(in, in) is semidet. :- pred type_body_is_solver_type(module_info, hlds_type_body). :- mode type_body_is_solver_type(in, in) is semidet. % Certain types, e.g. io__state and store__store(S), % are just dummy types used to ensure logical semantics; % there is no need to actually pass them, and so when % importing or exporting procedures to/from C, we don't % include arguments with these types. :- pred type_util__is_dummy_argument_type(type). :- mode type_util__is_dummy_argument_type(in) is semidet. :- pred type_util__constructors_are_dummy_argument_type(list(constructor)). :- mode type_util__constructors_are_dummy_argument_type(in) is semidet. :- pred type_is_io_state(type). :- mode type_is_io_state(in) is semidet. :- pred type_is_aditi_state(type). :- mode type_is_aditi_state(in) is semidet. :- pred type_ctor_is_array(type_ctor). :- mode type_ctor_is_array(in) is semidet. % Remove an `aditi:state' from the given list if one is present. :- pred type_util__remove_aditi_state(list(type), list(T), list(T)). :- mode type_util__remove_aditi_state(in, in, out) is det. % A test for types that are defined in Mercury, but whose definitions % are `lies', i.e. they are not sufficiently accurate for RTTI % structures describing the types. Since the RTTI will be hand defined, % the compiler shouldn't generate RTTI for these types. :- pred type_ctor_has_hand_defined_rtti(type_ctor, hlds_type_body). :- mode type_ctor_has_hand_defined_rtti(in, in) is semidet. % A test for type_info-related types that are introduced by % polymorphism.m. These need to be handled specially in certain % places. For example, mode inference never infers unique modes % for these types, since it would not be useful, and since we % want to minimize the number of different modes that we infer. :- pred is_introduced_type_info_type(type). :- mode is_introduced_type_info_type(in) is semidet. :- pred is_introduced_type_info_type_ctor(type_ctor). :- mode is_introduced_type_info_type_ctor(in) is semidet. :- func is_introduced_type_info_type_category(type_category) = bool. % Given a list of variables, return the permutation % of that list which has all the type_info-related variables % preceding the non-type_info-related variables (with the relative % order of variables within each group being the same as in the % original list). :- func put_typeinfo_vars_first(list(prog_var), vartypes) = list(prog_var). % In the forwards mode, this predicate checks for a "new " prefix % at the start of the functor name, and removes it if present; % it fails if there is no such prefix. % In the reverse mode, this predicate prepends such a prefix. % (These prefixes are used for construction unifications % with existentially typed functors.) :- pred remove_new_prefix(sym_name, sym_name). :- mode remove_new_prefix(in, out) is semidet. :- mode remove_new_prefix(out, in) is det. % Given a type, determine what category its principal constructor % falls into. :- func classify_type(module_info, type) = type_category. % Given a type_ctor, determine what sort it is. :- func classify_type_ctor(module_info, type_ctor) = type_category. :- type type_category ---> int_type ; char_type ; str_type ; float_type ; higher_order_type ; tuple_type ; enum_type ; variable_type ; type_info_type ; type_ctor_info_type ; typeclass_info_type ; base_typeclass_info_type ; void_type ; user_ctor_type. % Given a non-variable type, return its type-id and argument types. :- pred type_to_ctor_and_args(type, type_ctor, list(type)). :- mode type_to_ctor_and_args(in, out, out) is semidet. % Given a variable type, return its type variable. :- pred type_util__var(type, tvar). :- mode type_util__var(in, out) is semidet. :- mode type_util__var(out, in) is det. :- pred canonicalize_type_args(type_ctor::in, list(type)::in, list(type)::out) is det. % Given a type_ctor and a list of argument types, % construct a type. :- pred construct_type(type_ctor, list(type), (type)). :- mode construct_type(in, in, out) is det. :- pred construct_higher_order_type(purity, pred_or_func, lambda_eval_method, list(type), (type)). :- mode construct_higher_order_type(in, in, in, in, out) is det. :- pred construct_higher_order_pred_type(purity, lambda_eval_method, list(type), (type)). :- mode construct_higher_order_pred_type(in, in, in, out) is det. :- pred construct_higher_order_func_type(purity, lambda_eval_method, list(type), (type), (type)). :- mode construct_higher_order_func_type(in, in, in, in, out) is det. % Construct builtin types. :- func int_type = (type). :- func string_type = (type). :- func float_type = (type). :- func char_type = (type). :- func void_type = (type). :- func c_pointer_type = (type). :- func heap_pointer_type = (type). :- func sample_type_info_type = (type). :- func sample_typeclass_info_type = (type). :- func comparison_result_type = (type). :- func aditi_state_type = (type). % Construct type_infos and type_ctor_infos for the given types. :- func type_info_type(type) = (type). :- func type_ctor_info_type(type) = (type). % Given a constant and an arity, return a type_ctor. % Fails if the constant is not an atom. :- pred make_type_ctor(const, int, type_ctor). :- mode make_type_ctor(in, in, out) is semidet. % Given a type_ctor, look up its module/name/arity :- pred type_util__type_ctor_module(module_info, type_ctor, module_name). :- mode type_util__type_ctor_module(in, in, out) is det. :- pred type_util__type_ctor_name(module_info, type_ctor, string). :- mode type_util__type_ctor_name(in, in, out) is det. :- pred type_util__type_ctor_arity(module_info, type_ctor, arity). :- mode type_util__type_ctor_arity(in, in, out) is det. % If the type is a du type or a tuple type, % return the list of its constructors. :- pred type_constructors(type, module_info, list(constructor)). :- mode type_constructors(in, in, out) is semidet. % Given a type on which it is possible to have a complete switch, % return the number of alternatives. (It is possible to have a complete % switch on any du type and on the builtin type character. It is not % feasible to have a complete switch on the builtin types integer, % float, and switch. One cannot have a switch on an abstract type, % and equivalence types will have been expanded out by the time % we consider switches.) :- pred type_util__switch_type_num_functors(module_info::in, (type)::in, int::out) is semidet. % Work out the types of the arguments of a functor, % given the cons_id and type of the functor. % Aborts if the functor is existentially typed. % Note that this will substitute appropriate values for % any type variables in the functor's argument types, % to match their bindings in the functor's type. :- pred type_util__get_cons_id_arg_types(module_info::in, (type)::in, cons_id::in, list(type)::out) is det. % The same as type_util__get_cons_id_arg_types except that it % fails rather than aborting if the functor is existentially % typed. :- pred type_util__get_cons_id_non_existential_arg_types(module_info::in, (type)::in, cons_id::in, list(type)::out) is semidet. % The same as type_util__get_cons_id_arg_types except that the % cons_id is output non-deterministically. % The cons_id is not module-qualified. :- pred type_util__cons_id_arg_types(module_info::in, (type)::in, cons_id::out, list(type)::out) is nondet. % Given a type and a cons_id, look up the definitions of that % type and constructor. Aborts if the cons_id is not user-defined. % Note that this will NOT bind type variables in the % functor's argument types; they will be left unbound, % so the caller can find out the original types from the constructor % definition. The caller must do that sustitution itself if required. :- pred type_util__get_type_and_cons_defn(module_info, (type), cons_id, hlds_type_defn, hlds_cons_defn). :- mode type_util__get_type_and_cons_defn(in, in, in, out, out) is det. % Like type_util__get_type_and_cons_defn (above), except that it % only returns the definition of the constructor, not the type. :- pred type_util__get_cons_defn(module_info::in, type_ctor::in, cons_id::in, hlds_cons_defn::out) is semidet. % Module-qualify the cons_id using module information from the type. % The second output value is the cons_id required for use in insts which % can be different from that used in types for typeclass_info and % type_info. % The list(prog_var) is the list of arguments to the cons_id and is just % used for obtaining the arity for typeclass_info and type_info % cons_ids. :- pred qualify_cons_id((type)::in, list(prog_var)::in, cons_id::in, cons_id::out, cons_id::out) is det. % Given a type and a cons_id, look up the definition of that % constructor; if it is existentially typed, return its definition, % otherwise fail. % Note that this will NOT bind type variables in the % functor's argument types; they will be left unbound, % so the caller can find out the original types from the constructor % definition. The caller must do that sustitution itself if required. :- pred type_util__get_existq_cons_defn(module_info::in, (type)::in, cons_id::in, ctor_defn::out) is semidet. :- pred type_util__is_existq_cons(module_info::in, (type)::in, cons_id::in) is semidet. % This type is used to return information about a constructor % definition, extracted from the hlds_type_defn and hlds_cons_defn % data types. :- type ctor_defn ---> ctor_defn( tvarset, existq_tvars, list(class_constraint), % existential constraints list(type), % functor argument types (type) % functor result type ). % Check whether a type is a no_tag type % (i.e. one with only one constructor, and % whose one constructor has only one argument), % and if so, return its constructor symbol and argument type. :- pred type_is_no_tag_type(module_info, type, sym_name, type). :- mode type_is_no_tag_type(in, in, out, out) is semidet. % Check whether some constructors are a no_tag type % (i.e. one with only one constructor, and % whose one constructor has only one argument), % and if so, return its constructor symbol, argument type, % and the argument's name (if it has one). % % This doesn't do any checks for options that might be set % (such as turning off no_tag_types). If you want those checks % you should use type_is_no_tag_type/4, or if you really know % what you are doing, perform the checks yourself. :- pred type_constructors_are_no_tag_type(list(constructor), sym_name, type, maybe(string)). :- mode type_constructors_are_no_tag_type(in, out, out, out) is semidet. % Given a list of constructors for a type, check whether that % type is a private_builtin:type_info/n or similar type. :- pred type_constructors_are_type_info(list(constructor)). :- mode type_constructors_are_type_info(in) is semidet. % type_constructors_should_be_no_tag(Ctors, ReservedTag, Globals, % FunctorName, FunctorArgType, MaybeFunctorArgName): % Check whether some constructors are a no_tag type, and that this % is compatible with the ReservedTag setting for this type and % the grade options set in the globals. :- pred type_constructors_should_be_no_tag(list(constructor), bool, globals, sym_name, type, maybe(string)). :- mode type_constructors_should_be_no_tag(in, in, in, out, out, out) is semidet. % Unify (with occurs check) two types with respect to a type % substitution and update the type bindings. % The third argument is a list of type variables which cannot % be bound (i.e. head type variables). :- pred type_unify(type, type, list(tvar), tsubst, tsubst). :- mode type_unify(in, in, in, in, out) is semidet. :- pred type_unify_list(list(type), list(type), list(tvar), tsubst, tsubst). :- mode type_unify_list(in, in, in, in, out) is semidet. % Return a list of the type variables of a type. :- pred type_util__vars(type, list(tvar)). :- mode type_util__vars(in, out) is det. % Return a list of the type variables of a type, % ignoring any type variables if the variable in % question is a type-info :- pred type_util__real_vars(type, list(tvar)). :- mode type_util__real_vars(in, out) is det. % type_list_subsumes(TypesA, TypesB, Subst) succeeds iff the list % TypesA subsumes (is more general than) TypesB, producing a % type substitution which when applied to TypesA will give TypesB. :- pred type_list_subsumes(list(type), list(type), tsubst). :- mode type_list_subsumes(in, in, out) is semidet. % This does the same as type_list_subsumes, but aborts instead of % failing. :- pred type_list_subsumes_det(list(type), list(type), tsubst). :- mode type_list_subsumes_det(in, in, out) is det. % arg_type_list_subsumes(TVarSet, ArgTypes, % CalleeTVarSet, CalleeExistQVars, CalleeArgTypes). % % Check that the argument types of the called predicate, % function or constructor subsume the types of the % arguments of the call. This checks that none % of the existentially quantified type variables of % the callee are bound. :- pred arg_type_list_subsumes(tvarset, list(type), tvarset, existq_tvars, list(type)). :- mode arg_type_list_subsumes(in, in, in, in, in) is semidet. % apply a type substitution (i.e. map from tvar -> type) % to all the types in a variable typing (i.e. map from var -> type). :- pred apply_substitution_to_type_map(map(prog_var, type), tsubst, map(prog_var, type)). :- mode apply_substitution_to_type_map(in, in, out) is det. % same thing as above, except for a recursive substitution % (i.e. we keep applying the substitution recursively until % there are no more changes). :- pred apply_rec_substitution_to_type_map(map(prog_var, type), tsubst, map(prog_var, type)). :- mode apply_rec_substitution_to_type_map(in, in, out) is det. % Update a map from tvar to type_info_locn, using the type renaming % and substitution to rename tvars and a variable substitution to % rename vars. The type renaming is applied before the type % substitution. % % If tvar maps to a another type variable, we keep the new % variable, if it maps to a type, we remove it from the map. :- pred apply_substitutions_to_var_map(map(tvar, type_info_locn), tsubst, map(tvar, type), map(prog_var, prog_var), map(tvar, type_info_locn)). :- mode apply_substitutions_to_var_map(in, in, in, in, out) is det. % Update a map from class_constraint to var, using the type renaming % and substitution to rename tvars and a variable substition to % rename vars. The type renaming is applied before the type % substitution. :- pred apply_substitutions_to_typeclass_var_map( map(class_constraint, prog_var), tsubst, map(tvar, type), map(prog_var, prog_var), map(class_constraint, prog_var)). :- mode apply_substitutions_to_typeclass_var_map(in, in, in, in, out) is det. :- pred apply_rec_subst_to_constraints(tsubst, class_constraints, class_constraints). :- mode apply_rec_subst_to_constraints(in, in, out) is det. :- pred apply_rec_subst_to_constraint_list(tsubst, list(class_constraint), list(class_constraint)). :- mode apply_rec_subst_to_constraint_list(in, in, out) is det. :- pred apply_rec_subst_to_constraint(tsubst, class_constraint, class_constraint). :- mode apply_rec_subst_to_constraint(in, in, out) is det. :- pred apply_subst_to_constraints(tsubst, class_constraints, class_constraints). :- mode apply_subst_to_constraints(in, in, out) is det. :- pred apply_subst_to_constraint_list(tsubst, list(class_constraint), list(class_constraint)). :- mode apply_subst_to_constraint_list(in, in, out) is det. :- pred apply_subst_to_constraint(tsubst, class_constraint, class_constraint). :- mode apply_subst_to_constraint(in, in, out) is det. :- pred apply_subst_to_constraint_proofs(tsubst, map(class_constraint, constraint_proof), map(class_constraint, constraint_proof)). :- mode apply_subst_to_constraint_proofs(in, in, out) is det. :- pred apply_rec_subst_to_constraint_proofs(tsubst, map(class_constraint, constraint_proof), map(class_constraint, constraint_proof)). :- mode apply_rec_subst_to_constraint_proofs(in, in, out) is det. :- pred apply_variable_renaming_to_type_map(map(tvar, tvar), vartypes, vartypes). :- mode apply_variable_renaming_to_type_map(in, in, out) is det. :- pred apply_variable_renaming_to_constraints(map(tvar, tvar), class_constraints, class_constraints). :- mode apply_variable_renaming_to_constraints(in, in, out) is det. :- pred apply_variable_renaming_to_constraint_list(map(tvar, tvar), list(class_constraint), list(class_constraint)). :- mode apply_variable_renaming_to_constraint_list(in, in, out) is det. :- pred apply_variable_renaming_to_constraint(map(tvar, tvar), class_constraint, class_constraint). :- mode apply_variable_renaming_to_constraint(in, in, out) is det. % Apply a renaming (partial map) to a list. % Useful for applying a variable renaming to a list of variables. :- pred apply_partial_map_to_list(list(T), map(T, T), list(T)). :- mode apply_partial_map_to_list(in, in, out) is det. % cons_id_adjusted_arity(ModuleInfo, Type, ConsId): % Returns the number of arguments of specified constructor id, % adjusted to include the extra typeclassinfo and typeinfo % arguments inserted by polymorphism.m for existentially % typed constructors. % :- func cons_id_adjusted_arity(module_info, type, cons_id) = int. % constraint_list_get_tvars(Constraints, TVars): % return the list of type variables contained in a % list of constraints % :- pred constraint_list_get_tvars(list(class_constraint), list(tvar)). :- mode constraint_list_get_tvars(in, out) is det. % constraint_list_get_tvars(Constraint, TVars): % return the list of type variables contained in a constraint. :- pred constraint_get_tvars(class_constraint, list(tvar)). :- mode constraint_get_tvars(in, out) is det. :- pred get_unconstrained_tvars(list(tvar), list(class_constraint), list(tvar)). :- mode get_unconstrained_tvars(in, in, out) is det. %-----------------------------------------------------------------------------% % If possible, get the argument types for the cons_id. % We need to pass in the arity rather than using the arity % from the cons_id because the arity in the cons_id will not % include any extra type_info arguments for existentially % quantified types. :- pred maybe_get_cons_id_arg_types(module_info, maybe(type), cons_id, arity, list(maybe(type))). :- mode maybe_get_cons_id_arg_types(in, in, in, in, out) is det. :- pred maybe_get_higher_order_arg_types(maybe(type), arity, list(maybe(type))). :- mode maybe_get_higher_order_arg_types(in, in, out) is det. :- type polymorphism_cell ---> type_info_cell(type_ctor) ; typeclass_info_cell. :- func cell_cons_id(polymorphism_cell) = cons_id. :- func cell_inst_cons_id(polymorphism_cell, int) = cons_id. :- func cell_type_name(polymorphism_cell) = string. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module backend_libs__foreign. :- import_module check_hlds__purity. :- import_module hlds__hlds_out. :- import_module libs__globals. :- import_module libs__options. :- import_module parse_tree__prog_io. :- import_module parse_tree__prog_io_goal. :- import_module parse_tree__prog_util. :- import_module bool, char, int, string. :- import_module assoc_list, require, varset. type_util__type_ctor_module(_ModuleInfo, TypeName - _Arity, ModuleName) :- sym_name_get_module_name(TypeName, unqualified(""), ModuleName). type_util__type_ctor_name(_ModuleInfo, Name0 - _Arity, Name) :- unqualify_name(Name0, Name). type_util__type_ctor_arity(_ModuleInfo, _Name - Arity, Arity). type_is_atomic(Type, ModuleInfo) :- type_to_ctor_and_args(Type, TypeCtor, _), type_ctor_is_atomic(TypeCtor, ModuleInfo). type_ctor_is_atomic(TypeCtor, ModuleInfo) :- TypeCategory = classify_type_ctor(ModuleInfo, TypeCtor), type_category_is_atomic(TypeCategory) = yes. :- func type_category_is_atomic(type_category) = bool. type_category_is_atomic(int_type) = yes. type_category_is_atomic(char_type) = yes. type_category_is_atomic(str_type) = yes. type_category_is_atomic(float_type) = yes. type_category_is_atomic(higher_order_type) = no. type_category_is_atomic(tuple_type) = no. type_category_is_atomic(enum_type) = yes. type_category_is_atomic(variable_type) = no. type_category_is_atomic(type_info_type) = no. type_category_is_atomic(type_ctor_info_type) = no. type_category_is_atomic(typeclass_info_type) = no. type_category_is_atomic(base_typeclass_info_type) = no. type_category_is_atomic(void_type) = yes. type_category_is_atomic(user_ctor_type) = no. type_ctor_is_array(qualified(unqualified("array"), "array") - 1). type_util__var(term__variable(Var), Var). type_ctor_has_hand_defined_rtti(Type, Body) :- Type = qualified(mercury_private_builtin_module, Name) - 1, ( Name = "type_info" ; Name = "type_ctor_info" ; Name = "typeclass_info" ; Name = "base_typeclass_info" ), \+ ( Body = du_type(_, _, _, _, _, _, yes(_)) ; Body = foreign_type(_, _) ). is_introduced_type_info_type(Type) :- type_to_ctor_and_args(Type, TypeCtor, _), is_introduced_type_info_type_ctor(TypeCtor). is_introduced_type_info_type_ctor(TypeCtor) :- TypeCtor = qualified(PrivateBuiltin, Name) - 1, mercury_private_builtin_module(PrivateBuiltin), ( Name = "type_info" ; Name = "type_ctor_info" ; Name = "typeclass_info" ; Name = "base_typeclass_info" ). is_introduced_type_info_type_category(int_type) = no. is_introduced_type_info_type_category(char_type) = no. is_introduced_type_info_type_category(str_type) = no. is_introduced_type_info_type_category(float_type) = no. is_introduced_type_info_type_category(higher_order_type) = no. is_introduced_type_info_type_category(tuple_type) = no. is_introduced_type_info_type_category(enum_type) = no. is_introduced_type_info_type_category(variable_type) = no. is_introduced_type_info_type_category(type_info_type) = yes. is_introduced_type_info_type_category(type_ctor_info_type) = yes. is_introduced_type_info_type_category(typeclass_info_type) = yes. is_introduced_type_info_type_category(base_typeclass_info_type) = yes. is_introduced_type_info_type_category(void_type) = no. is_introduced_type_info_type_category(user_ctor_type) = no. put_typeinfo_vars_first(VarsList, VarTypes) = TypeInfoVarsList ++ NonTypeInfoVarsList :- list__filter((pred(Var::in) is semidet :- Type = map__lookup(VarTypes, Var), is_introduced_type_info_type(Type)), VarsList, TypeInfoVarsList, NonTypeInfoVarsList). remove_new_prefix(unqualified(Name0), unqualified(Name)) :- string__append("new ", Name, Name0). remove_new_prefix(qualified(Module, Name0), qualified(Module, Name)) :- string__append("new ", Name, Name0). %-----------------------------------------------------------------------------% % Given a type, determine what sort of type it is. classify_type(ModuleInfo, VarType) = TypeCategory :- ( type_to_ctor_and_args(VarType, TypeCtor, _) -> TypeCategory = classify_type_ctor(ModuleInfo, TypeCtor) ; TypeCategory = variable_type ). classify_type_ctor(ModuleInfo, TypeCtor) = TypeCategory :- PrivateBuiltin = mercury_private_builtin_module, ( TypeCtor = unqualified("character") - 0 -> TypeCategory = char_type ; TypeCtor = unqualified("int") - 0 -> TypeCategory = int_type ; TypeCtor = unqualified("float") - 0 -> TypeCategory = float_type ; TypeCtor = unqualified("string") - 0 -> TypeCategory = str_type ; TypeCtor = unqualified("void") - 0 -> TypeCategory = void_type ; TypeCtor = qualified(PrivateBuiltin, "type_info") - 1 -> TypeCategory = type_info_type ; TypeCtor = qualified(PrivateBuiltin, "type_ctor_info") - 1 -> TypeCategory = type_ctor_info_type ; TypeCtor = qualified(PrivateBuiltin, "typeclass_info") - 1 -> TypeCategory = typeclass_info_type ; TypeCtor = qualified(PrivateBuiltin, "base_typeclass_info") - 1 -> TypeCategory = base_typeclass_info_type ; type_ctor_is_higher_order(TypeCtor, _, _, _) -> TypeCategory = higher_order_type ; type_ctor_is_tuple(TypeCtor) -> TypeCategory = tuple_type ; type_ctor_is_enumeration(TypeCtor, ModuleInfo) -> TypeCategory = enum_type ; TypeCategory = user_ctor_type ). type_is_higher_order(Type, Purity, PredOrFunc, EvalMethod, PredArgTypes) :- ( Type = term__functor(term__atom(PurityName), [BaseType], _), purity_name(Purity0, PurityName), type_is_higher_order_2(BaseType, PredOrFunc0, EvalMethod0, PredArgTypes0) -> Purity = Purity0, PredOrFunc = PredOrFunc0, EvalMethod = EvalMethod0, PredArgTypes = PredArgTypes0 ; Purity = (pure), type_is_higher_order_2(Type, PredOrFunc, EvalMethod, PredArgTypes) ). % This parses a higher-order type without any purity indicator. :- pred type_is_higher_order_2(type, pred_or_func, lambda_eval_method, list(type)). :- mode type_is_higher_order_2(in, out, out, out) is semidet. type_is_higher_order_2(Type, PredOrFunc, EvalMethod, PredArgTypes) :- ( Type = term__functor(term__atom("="), [FuncEvalAndArgs, FuncRetType], _) -> get_lambda_eval_method_and_args("func", FuncEvalAndArgs, EvalMethod, FuncArgTypes), list__append(FuncArgTypes, [FuncRetType], PredArgTypes), PredOrFunc = function ; get_lambda_eval_method_and_args("pred", Type, EvalMethod, PredArgTypes), PredOrFunc = predicate ). % From the type of a lambda expression, work out how it should % be evaluated and extract the argument types. :- pred get_lambda_eval_method_and_args(string, (type), lambda_eval_method, list(type)) is det. :- mode get_lambda_eval_method_and_args(in, in, out, out) is semidet. get_lambda_eval_method_and_args(PorFStr, Type0, EvalMethod, ArgTypes) :- Type0 = term__functor(term__atom(Functor), Args, _), ( Functor = PorFStr -> EvalMethod = normal, ArgTypes = Args ; Args = [Type1], Type1 = term__functor(term__atom(PorFStr), ArgTypes, _), Functor = "aditi_bottom_up", EvalMethod = (aditi_bottom_up) ). type_has_variable_arity_ctor(Type, TypeCtor, TypeArgs) :- ( type_is_higher_order(Type, _Purity, PredOrFunc, _, TypeArgs0) -> TypeArgs = TypeArgs0, hlds_out__pred_or_func_to_str(PredOrFunc, PredOrFuncStr), TypeCtor = unqualified(PredOrFuncStr) - 0 ; type_is_tuple(Type, TypeArgs1) -> TypeArgs = TypeArgs1, TypeCtor = unqualified("tuple") - 0 ; fail ). type_ctor_is_higher_order(SymName - _Arity, Purity, PredOrFunc, EvalMethod) :- get_purity_and_eval_method(SymName, Purity, EvalMethod, PorFStr), ( PorFStr = "pred", PredOrFunc = predicate ; PorFStr = "func", PredOrFunc = function ). :- pred get_purity_and_eval_method(sym_name::in, purity::out, lambda_eval_method::out, string::out) is semidet. get_purity_and_eval_method(SymName, Purity, EvalMethod, PorFStr) :- ( SymName = qualified(unqualified(Qualifier), PorFStr), ( Qualifier = "aditi_bottom_up", EvalMethod = (aditi_bottom_up), Purity = (pure) ; Qualifier = "impure", Purity = (impure), EvalMethod = normal ; Qualifier = "semipure", Purity = (semipure), EvalMethod = normal ) ; SymName = unqualified(PorFStr), EvalMethod = normal, Purity = (pure) ). type_is_tuple(Type, ArgTypes) :- type_to_ctor_and_args(Type, TypeCtor, ArgTypes), type_ctor_is_tuple(TypeCtor). type_ctor_is_tuple(unqualified("{}") - _). type_has_user_defined_equality_pred(ModuleInfo, Type, UserEqComp) :- module_info_types(ModuleInfo, TypeTable), type_to_ctor_and_args(Type, TypeCtor, _TypeArgs), map__search(TypeTable, TypeCtor, TypeDefn), hlds_data__get_type_defn_body(TypeDefn, TypeBody), type_body_has_user_defined_equality_pred(ModuleInfo, TypeBody, UserEqComp). type_body_has_user_defined_equality_pred(ModuleInfo, TypeBody, UserEqComp) :- module_info_globals(ModuleInfo, Globals), globals__get_target(Globals, Target), ( TypeBody = du_type(_, _, _, _, _, _, _), ( TypeBody ^ du_type_is_foreign_type = yes(ForeignTypeBody), have_foreign_type_for_backend(Target, ForeignTypeBody, yes) -> UserEqComp = foreign_type_body_has_user_defined_equality_pred( ModuleInfo, ForeignTypeBody) ; TypeBody ^ du_type_usereq = yes(UserEqComp) ) ; TypeBody = foreign_type(ForeignTypeBody, _), UserEqComp = foreign_type_body_has_user_defined_equality_pred( ModuleInfo, ForeignTypeBody) ). type_util__is_solver_type(ModuleInfo, Type) :- module_info_types(ModuleInfo, TypeTable), ( type_to_ctor_and_args(Type, TypeCtor, _TypeArgs) -> map__search(TypeTable, TypeCtor, TypeDefn), % Type table search will fail for builtin types such as % `int/0'. Such types are not solver types so % type_util__is_solver_type fails too. hlds_data__get_type_defn_body(TypeDefn, TypeBody), type_body_is_solver_type(ModuleInfo, TypeBody) ; % type_to_ctor_and_args will fail for type variables. In that % case we assume that the type may be a solver type. true ). % Return the `is_solver_type' field for the type body. type_body_is_solver_type(ModuleInfo, TypeBody) :- ( TypeBody ^ du_type_is_solver_type = solver_type ; TypeBody = eqv_type(Type), type_util__is_solver_type(ModuleInfo, Type) ; TypeBody = foreign_type(_, solver_type) ; TypeBody = abstract_type(solver_type) ). % Certain types, e.g. io__state and store__store(S), % are just dummy types used to ensure logical semantics; % there is no need to actually pass them, and so when % importing or exporting procedures to/from C, we don't % include arguments with these types. type_util__is_dummy_argument_type(Type) :- Type = term__functor(term__atom(FunctorName), [ term__functor(term__atom(ModuleName), [], _), term__functor(term__atom(TypeName), TypeArgs, _) ], _), ( FunctorName = "." ; FunctorName = ":" ), list__length(TypeArgs, TypeArity), type_util__is_dummy_argument_type_2(ModuleName, TypeName, TypeArity). :- pred type_util__is_dummy_argument_type_2(string::in, string::in, arity::in) is semidet. % XXX should we include aditi:state/0 in this list? type_util__is_dummy_argument_type_2("io", "state", 0). % io:state/0 type_util__is_dummy_argument_type_2("store", "store", 1). % store:store/1. type_util__constructors_are_dummy_argument_type([Ctor]) :- Ctor = ctor([], [], qualified(unqualified("io"), "state"), [_]). type_util__constructors_are_dummy_argument_type([Ctor]) :- Ctor = ctor([], [], qualified(unqualified("store"), "store"), [_]). type_is_io_state(Type) :- type_to_ctor_and_args(Type, TypeCtor, []), TypeCtor = qualified(unqualified("io"), "state") - 0. type_is_aditi_state(Type) :- type_to_ctor_and_args(Type, TypeCtor, []), TypeCtor = qualified(unqualified("aditi"), "state") - 0. type_util__remove_aditi_state([], [], []). type_util__remove_aditi_state([], [_|_], _) :- error("type_util__remove_aditi_state"). type_util__remove_aditi_state([_|_], [], _) :- error("type_util__remove_aditi_state"). type_util__remove_aditi_state([Type | Types], [Arg | Args0], Args) :- ( type_is_aditi_state(Type) -> type_util__remove_aditi_state(Types, Args0, Args) ; type_util__remove_aditi_state(Types, Args0, Args1), Args = [Arg | Args1] ). :- pred type_ctor_is_enumeration(type_ctor, module_info). :- mode type_ctor_is_enumeration(in, in) is semidet. type_ctor_is_enumeration(TypeCtor, ModuleInfo) :- module_info_types(ModuleInfo, TypeDefnTable), map__search(TypeDefnTable, TypeCtor, TypeDefn), hlds_data__get_type_defn_body(TypeDefn, TypeBody), TypeBody ^ du_type_is_enum = yes. type_to_ctor_and_args(Type, SymName - Arity, Args) :- Type \= term__variable(_), % higher order types may have representations where % their arguments don't directly correspond to the % arguments of the term. ( type_is_higher_order(Type, Purity, PredOrFunc, EvalMethod, PredArgTypes) -> Args = PredArgTypes, list__length(Args, Arity0), adjust_func_arity(PredOrFunc, Arity, Arity0), ( PredOrFunc = predicate, PorFStr = "pred" ; PredOrFunc = function, PorFStr = "func" ), SymName0 = unqualified(PorFStr), ( EvalMethod = (aditi_bottom_up), insert_module_qualifier("aditi_bottom_up", SymName0, SymName1) ; EvalMethod = normal, SymName1 = SymName0 ), ( Purity = (pure), SymName = SymName1 ; Purity = (semipure), insert_module_qualifier("semipure", SymName1, SymName) ; Purity = (impure), insert_module_qualifier("impure", SymName1, SymName) ) ; sym_name_and_args(Type, SymName, Args), % `private_builtin:constraint' is introduced by polymorphism, % and should only appear as the argument of a % `typeclass:info/1' type. % It behaves sort of like a type variable, so according to the % specification of `type_to_ctor_and_args', it should % cause failure. There isn't a definition in the type table. \+ ( SymName = qualified(ModuleName, UnqualName), UnqualName = "constraint", mercury_private_builtin_module(PrivateBuiltin), ModuleName = PrivateBuiltin ), list__length(Args, Arity) ). canonicalize_type_args(TypeCtor, TypeArgs0, TypeArgs) :- ( % The arguments of typeclass_info/base_typeclass_info types % are not a type - they encode class constraints. % The arguments of type_ctor_info types are not types; % they are type constructors. % The arguments of type_info types are not true arguments: % they specify the type the type_info represents. % So we replace all these arguments with type `void'. is_introduced_type_info_type_ctor(TypeCtor) -> TypeArgs = [void_type] ; TypeArgs = TypeArgs0 ). construct_type(TypeCtor, Args, Type) :- ( type_ctor_is_higher_order(TypeCtor, Purity, PredOrFunc, EvalMethod) -> construct_higher_order_type(Purity, PredOrFunc, EvalMethod, Args, Type) ; TypeCtor = SymName - _, construct_qualified_term(SymName, Args, Type) ). construct_higher_order_type(Purity, PredOrFunc, EvalMethod, ArgTypes, Type) :- ( PredOrFunc = predicate, construct_higher_order_pred_type(Purity, EvalMethod, ArgTypes, Type) ; PredOrFunc = function, pred_args_to_func_args(ArgTypes, FuncArgTypes, FuncRetType), construct_higher_order_func_type(Purity, EvalMethod, FuncArgTypes, FuncRetType, Type) ). construct_higher_order_pred_type(Purity, EvalMethod, ArgTypes, Type) :- construct_qualified_term(unqualified("pred"), ArgTypes, Type0), qualify_higher_order_type(EvalMethod, Type0, Type1), Type = add_purity_annotation(Purity, Type1). construct_higher_order_func_type(Purity, EvalMethod, ArgTypes, RetType, Type) :- construct_qualified_term(unqualified("func"), ArgTypes, Type0), qualify_higher_order_type(EvalMethod, Type0, Type1), Type2 = term__functor(term__atom("="), [Type1, RetType], term__context_init), Type = add_purity_annotation(Purity, Type2). :- func add_purity_annotation(purity, (type)) = (type). add_purity_annotation(Purity, Type0) = Type :- ( Purity = (pure), Type = Type0 ; Purity = (semipure), Type = term__functor(term__atom("semipure"), [Type0], term__context_init) ; Purity = (impure), Type = term__functor(term__atom("impure"), [Type0], term__context_init) ). :- pred qualify_higher_order_type(lambda_eval_method, (type), (type)). :- mode qualify_higher_order_type(in, in, out) is det. qualify_higher_order_type(normal, Type, Type). qualify_higher_order_type((aditi_bottom_up), Type0, term__functor(term__atom("aditi_bottom_up"), [Type0], Context)) :- term__context_init(Context). int_type = Type :- construct_type(unqualified("int") - 0, [], Type). string_type = Type :- construct_type(unqualified("string") - 0, [], Type). float_type = Type :- construct_type(unqualified("float") - 0, [], Type). char_type = Type :- construct_type(unqualified("character") - 0, [], Type). void_type = Type :- construct_type(unqualified("void") - 0, [], Type). c_pointer_type = Type :- mercury_public_builtin_module(BuiltinModule), construct_type(qualified(BuiltinModule, "c_pointer") - 0, [], Type). heap_pointer_type = Type :- mercury_private_builtin_module(BuiltinModule), construct_type(qualified(BuiltinModule, "heap_pointer") - 0, [], Type). sample_type_info_type = Type :- mercury_private_builtin_module(BuiltinModule), construct_type(qualified(BuiltinModule, "sample_type_info") - 0, [], Type). sample_typeclass_info_type = Type :- mercury_private_builtin_module(BuiltinModule), construct_type(qualified(BuiltinModule, "sample_typeclass_info") - 0, [], Type). comparison_result_type = Type :- mercury_public_builtin_module(BuiltinModule), construct_type(qualified(BuiltinModule, "comparison_result") - 0, [], Type). type_info_type(ForType) = Type :- mercury_private_builtin_module(BuiltinModule), construct_type(qualified(BuiltinModule, "type_info") - 1, [ForType], Type). type_ctor_info_type(ForType) = Type :- mercury_private_builtin_module(BuiltinModule), construct_type(qualified(BuiltinModule, "type_ctor_info") - 1, [ForType], Type). aditi_state_type = Type :- aditi_public_builtin_module(BuiltinModule), construct_type(qualified(BuiltinModule, "state") - 0, [], Type). %-----------------------------------------------------------------------------% % Given a constant and an arity, return a type_ctor. % This really ought to take a name and an arity - % use of integers/floats/strings as type names should % be rejected by the parser in prog_io.m, not in module_qual.m. make_type_ctor(term__atom(Name), Arity, unqualified(Name) - Arity). %-----------------------------------------------------------------------------% % If the type is a du type, return the list of its constructors. type_constructors(Type, ModuleInfo, Constructors) :- type_to_ctor_and_args(Type, TypeCtor, TypeArgs), ( type_ctor_is_tuple(TypeCtor) -> % Tuples are never existentially typed. ExistQVars = [], ClassConstraints = [], CtorArgs = list__map((func(ArgType) = no - ArgType), TypeArgs), Constructors = [ctor(ExistQVars, ClassConstraints, unqualified("{}"), CtorArgs)] ; module_info_types(ModuleInfo, TypeTable), map__search(TypeTable, TypeCtor, TypeDefn), hlds_data__get_type_defn_tparams(TypeDefn, TypeParams), hlds_data__get_type_defn_body(TypeDefn, TypeBody), substitute_type_args(TypeParams, TypeArgs, TypeBody ^ du_type_ctors, Constructors) ). %-----------------------------------------------------------------------------% type_util__switch_type_num_functors(ModuleInfo, Type, NumFunctors) :- type_to_ctor_and_args(Type, TypeCtor, _), ( TypeCtor = unqualified("character") - 0 -> % XXX the following code uses the source machine's character % size, not the target's, so it won't work if cross-compiling % to a machine with a different size character. char__max_char_value(MaxChar), char__min_char_value(MinChar), NumFunctors = MaxChar - MinChar + 1 ; type_ctor_is_tuple(TypeCtor) -> NumFunctors = 1 ; module_info_types(ModuleInfo, TypeTable), map__search(TypeTable, TypeCtor, TypeDefn), hlds_data__get_type_defn_body(TypeDefn, TypeBody), map__count(TypeBody ^ du_type_cons_tag_values, NumFunctors) ). %-----------------------------------------------------------------------------% type_util__get_cons_id_arg_types(ModuleInfo, Type, ConsId, ArgTypes) :- type_util__get_cons_id_arg_types_2(abort_on_exist_qvar, ModuleInfo, Type, ConsId, ArgTypes). type_util__get_cons_id_non_existential_arg_types(ModuleInfo, Type, ConsId, ArgTypes) :- type_util__get_cons_id_arg_types_2(fail_on_exist_qvar, ModuleInfo, Type, ConsId, ArgTypes). :- type exist_qvar_action ---> fail_on_exist_qvar ; abort_on_exist_qvar. :- pred type_util__get_cons_id_arg_types_2(exist_qvar_action, module_info, (type), cons_id, list(type)). :- mode type_util__get_cons_id_arg_types_2(in(bound(fail_on_exist_qvar)), in, in, in, out) is semidet. :- mode type_util__get_cons_id_arg_types_2(in(bound(abort_on_exist_qvar)), in, in, in, out) is det. type_util__get_cons_id_arg_types_2(EQVarAction, ModuleInfo, VarType, ConsId, ArgTypes) :- ( type_to_ctor_and_args(VarType, TypeCtor, TypeArgs) -> ( % The argument types of a tuple cons_id are the % arguments of the tuple type. type_ctor_is_tuple(TypeCtor) -> ArgTypes = TypeArgs ; type_util__do_get_type_and_cons_defn(ModuleInfo, TypeCtor, ConsId, TypeDefn, ConsDefn), ConsDefn = hlds_cons_defn(ExistQVars0, _Constraints0, Args, _, _), Args \= [] -> hlds_data__get_type_defn_tparams(TypeDefn, TypeDefnParams), term__term_list_to_var_list(TypeDefnParams, TypeDefnVars), % XXX handle ExistQVars ( ExistQVars0 = [] -> true ; ( EQVarAction = abort_on_exist_qvar, error("type_util__get_cons_id_arg_types: existentially typed cons_id") ; EQVarAction = fail_on_exist_qvar, fail ) ), map__from_corresponding_lists(TypeDefnVars, TypeArgs, TSubst), assoc_list__values(Args, ArgTypes0), term__apply_substitution_to_list(ArgTypes0, TSubst, ArgTypes) ; ArgTypes = [] ) ; ArgTypes = [] ). type_util__cons_id_arg_types(ModuleInfo, VarType, ConsId, ArgTypes) :- type_to_ctor_and_args(VarType, TypeCtor, TypeArgs), module_info_types(ModuleInfo, Types), map__search(Types, TypeCtor, TypeDefn), hlds_data__get_type_defn_body(TypeDefn, TypeDefnBody), map__member(TypeDefnBody ^ du_type_cons_tag_values, ConsId, _), module_info_ctors(ModuleInfo, Ctors), map__lookup(Ctors, ConsId, ConsDefns), list__member(ConsDefn, ConsDefns), ConsDefn = hlds_cons_defn(ExistQVars0, _, Args, TypeCtor, _), % XXX handle ExistQVars ExistQVars0 = [], hlds_data__get_type_defn_tparams(TypeDefn, TypeDefnParams), term__term_list_to_var_list(TypeDefnParams, TypeDefnVars), map__from_corresponding_lists(TypeDefnVars, TypeArgs, TSubst), assoc_list__values(Args, ArgTypes0), term__apply_substitution_to_list(ArgTypes0, TSubst, ArgTypes). type_util__is_existq_cons(ModuleInfo, VarType, ConsId) :- type_util__is_existq_cons(ModuleInfo, VarType, ConsId, _). :- pred type_util__is_existq_cons(module_info::in, (type)::in, cons_id::in, hlds_cons_defn::out) is semidet. type_util__is_existq_cons(ModuleInfo, VarType, ConsId, ConsDefn) :- type_to_ctor_and_args(VarType, TypeCtor, _), type_util__get_cons_defn(ModuleInfo, TypeCtor, ConsId, ConsDefn), ConsDefn = hlds_cons_defn(ExistQVars, _, _, _, _), ExistQVars \= []. % Given a type and a cons_id, look up the definition of that % constructor; if it is existentially typed, return its definition, % otherwise fail. type_util__get_existq_cons_defn(ModuleInfo, VarType, ConsId, CtorDefn) :- type_util__is_existq_cons(ModuleInfo, VarType, ConsId, ConsDefn), ConsDefn = hlds_cons_defn(ExistQVars, Constraints, Args, _, _), assoc_list__values(Args, ArgTypes), module_info_types(ModuleInfo, Types), type_to_ctor_and_args(VarType, TypeCtor, _), map__lookup(Types, TypeCtor, TypeDefn), hlds_data__get_type_defn_tvarset(TypeDefn, TypeVarSet), hlds_data__get_type_defn_tparams(TypeDefn, TypeDefnParams), type_to_ctor_and_args(VarType, TypeCtor, _), construct_type(TypeCtor, TypeDefnParams, RetType), CtorDefn = ctor_defn(TypeVarSet, ExistQVars, Constraints, ArgTypes, RetType). type_util__get_type_and_cons_defn(ModuleInfo, Type, ConsId, TypeDefn, ConsDefn) :- ( type_to_ctor_and_args(Type, TypeCtor, _), type_util__do_get_type_and_cons_defn(ModuleInfo, TypeCtor, ConsId, TypeDefn0, ConsDefn0) -> TypeDefn = TypeDefn0, ConsDefn = ConsDefn0 ; error("type_util__get_type_and_cons_defn") ). :- pred type_util__do_get_type_and_cons_defn(module_info::in, type_ctor::in, cons_id::in, hlds_type_defn::out, hlds_cons_defn::out) is semidet. type_util__do_get_type_and_cons_defn(ModuleInfo, TypeCtor, ConsId, TypeDefn, ConsDefn) :- type_util__get_cons_defn(ModuleInfo, TypeCtor, ConsId, ConsDefn), module_info_types(ModuleInfo, Types), map__lookup(Types, TypeCtor, TypeDefn). type_util__get_cons_defn(ModuleInfo, TypeCtor, ConsId, ConsDefn) :- module_info_ctors(ModuleInfo, Ctors), % will fail for builtin cons_ids. map__search(Ctors, ConsId, ConsDefns), MatchingCons = (pred(ThisConsDefn::in) is semidet :- ThisConsDefn = hlds_cons_defn(_, _, _, TypeCtor, _) ), list__filter(MatchingCons, ConsDefns, [ConsDefn]). %-----------------------------------------------------------------------------% qualify_cons_id(Type, Args, ConsId0, ConsId, InstConsId) :- ( ConsId0 = cons(Name0, OrigArity), type_to_ctor_and_args(Type, TypeCtor, _), TypeCtor = qualified(TypeModule, _) - _ -> unqualify_name(Name0, UnqualName), Name = qualified(TypeModule, UnqualName), ConsId = cons(Name, OrigArity), InstConsId = ConsId ; ConsId0 = type_info_cell_constructor(CellCtor) -> ConsId = ConsId0, InstConsId = cell_inst_cons_id(type_info_cell(CellCtor), list__length(Args)) ; ConsId0 = typeclass_info_cell_constructor -> ConsId = typeclass_info_cell_constructor, InstConsId = cell_inst_cons_id(typeclass_info_cell, list__length(Args)) ; ConsId = ConsId0, InstConsId = ConsId ). %-----------------------------------------------------------------------------% type_is_no_tag_type(ModuleInfo, Type, Ctor, ArgType) :- type_to_ctor_and_args(Type, TypeCtor, TypeArgs), module_info_no_tag_types(ModuleInfo, NoTagTypes), map__search(NoTagTypes, TypeCtor, NoTagType), NoTagType = no_tag_type(TypeParams0, Ctor, ArgType0), ( TypeParams0 = [] -> ArgType = ArgType0 ; term__term_list_to_var_list(TypeParams0, TypeParams), map__from_corresponding_lists(TypeParams, TypeArgs, Subn), term__apply_substitution(ArgType0, Subn, ArgType) ). type_constructors_are_no_tag_type(Ctors, Ctor, ArgType, MaybeArgName) :- type_is_single_ctor_single_arg(Ctors, Ctor, MaybeArgName0, ArgType), % We don't handle unary tuples as no_tag types -- % they are rare enough that it's not worth % the implementation effort. Ctor \= unqualified("{}"), map_maybe(unqualify_name, MaybeArgName0, MaybeArgName). type_constructors_are_type_info(Ctors) :- type_is_single_ctor_single_arg(Ctors, Ctor, _, _), ctor_is_type_info(Ctor). :- pred ctor_is_type_info(sym_name). :- mode ctor_is_type_info(in) is semidet. ctor_is_type_info(Ctor) :- unqualify_private_builtin(Ctor, Name), name_is_type_info(Name). :- pred name_is_type_info(string). :- mode name_is_type_info(in) is semidet. name_is_type_info("type_info"). name_is_type_info("type_ctor_info"). name_is_type_info("typeclass_info"). name_is_type_info("base_typeclass_info"). % If the sym_name is in the private_builtin module, unqualify it, % otherwise fail. % All, user-defined types should be module-qualified by the % time this predicate is called, so we assume that any % unqualified names are in private_builtin. :- pred unqualify_private_builtin(sym_name, string). :- mode unqualify_private_builtin(in, out) is semidet. unqualify_private_builtin(unqualified(Name), Name). unqualify_private_builtin(qualified(ModuleName, Name), Name) :- mercury_private_builtin_module(ModuleName). :- pred type_is_single_ctor_single_arg(list(constructor), sym_name, maybe(ctor_field_name), type). :- mode type_is_single_ctor_single_arg(in, out, out, out) is semidet. type_is_single_ctor_single_arg(Ctors, Ctor, MaybeArgName, ArgType) :- Ctors = [SingleCtor], SingleCtor = ctor(ExistQVars, _Constraints, Ctor, [MaybeArgName - ArgType]), ExistQVars = []. %-----------------------------------------------------------------------------% % assign single functor of arity one a `no_tag' tag % (unless it is type_info/1 or we are reserving a tag, % or if it is one of the dummy types) type_constructors_should_be_no_tag(Ctors, ReserveTagPragma, Globals, SingleFunc, SingleArg, MaybeArgName) :- type_constructors_are_no_tag_type(Ctors, SingleFunc, SingleArg, MaybeArgName), ( ReserveTagPragma = no, globals__lookup_bool_option(Globals, reserve_tag, no), globals__lookup_bool_option(Globals, unboxed_no_tag_types, yes) ; % Dummy types always need to be treated as no-tag types % as the low-level C back end just passes around % rubbish for them. When eg. using the debugger, it is % crucial that these values are treated as unboxed % c_pointers, not as tagged pointers to c_pointers % (otherwise the system winds up following a bogus % pointer). constructors_are_dummy_argument_type(Ctors) ). %-----------------------------------------------------------------------------% % Substitute the actual values of the type parameters % in list of constructors, for a particular instance of % a polymorphic type. :- pred substitute_type_args(list(type_param), list(type), list(constructor), list(constructor)). :- mode substitute_type_args(in, in, in, out) is det. substitute_type_args(TypeParams0, TypeArgs, Constructors0, Constructors) :- ( TypeParams0 = [] -> Constructors = Constructors0 ; term__term_list_to_var_list(TypeParams0, TypeParams), map__from_corresponding_lists(TypeParams, TypeArgs, Subst), substitute_type_args_2(Constructors0, Subst, Constructors) ). :- pred substitute_type_args_2(list(constructor), tsubst, list(constructor)). :- mode substitute_type_args_2(in, in, out) is det. substitute_type_args_2([], _, []). substitute_type_args_2([Ctor0| Ctors0], Subst, [Ctor | Ctors]) :- % Note: prog_io.m ensures that the existentially quantified % variables, if any, are distinct from the parameters, % and that the (existential) constraints can only contain % existentially quantified variables, so there's % no need to worry about applying the substitution to % ExistQVars or Constraints Ctor0 = ctor(ExistQVars, Constraints, Name, Args0), Ctor = ctor(ExistQVars, Constraints, Name, Args), substitute_type_args_3(Args0, Subst, Args), substitute_type_args_2(Ctors0, Subst, Ctors). :- pred substitute_type_args_3(list(constructor_arg), tsubst, list(constructor_arg)). :- mode substitute_type_args_3(in, in, out) is det. substitute_type_args_3([], _, []). substitute_type_args_3([Name - Arg0 | Args0], Subst, [Name - Arg | Args]) :- term__apply_substitution(Arg0, Subst, Arg), substitute_type_args_3(Args0, Subst, Args). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% % Check whether TypesA subsumes TypesB, and if so return % a type substitution that will map from TypesA to TypesB. type_list_subsumes(TypesA, TypesB, TypeSubst) :- % % TypesA subsumes TypesB iff TypesA can be unified with TypesB % without binding any of the type variables in TypesB. % term__vars_list(TypesB, TypesBVars), map__init(TypeSubst0), type_unify_list(TypesA, TypesB, TypesBVars, TypeSubst0, TypeSubst). type_list_subsumes_det(TypesA, TypesB, TypeSubst) :- ( type_list_subsumes(TypesA, TypesB, TypeSubstPrime) -> TypeSubst = TypeSubstPrime ; error("type_list_subsumes_det: type_list_subsumes failed") ). arg_type_list_subsumes(TVarSet, ArgTypes, CalleeTVarSet, CalleeExistQVars0, CalleeArgTypes0) :- % % rename the type variables in the callee's argument types. % varset__merge_subst(TVarSet, CalleeTVarSet, _TVarSet1, Subst), term__apply_substitution_to_list(CalleeArgTypes0, Subst, CalleeArgTypes), map__apply_to_list(CalleeExistQVars0, Subst, CalleeExistQTypes0), % % check that the types of the candidate predicate/function % subsume the actual argument types % [This is the right thing to do even for calls to % existentially typed preds, because we're using the % type variables from the callee's pred decl (obtained % from the pred_info via pred_info_arg_types) not the types % inferred from the callee's clauses (and stored in the % clauses_info and proc_info) -- the latter % might not subsume the actual argument types.] % type_list_subsumes(CalleeArgTypes, ArgTypes, TypeSubst), % % check that the type substitution did not bind any % existentially typed variables to non-ground types % ( CalleeExistQTypes0 = [] -> % optimize common case true ; term__apply_rec_substitution_to_list(CalleeExistQTypes0, TypeSubst, CalleeExistQTypes), all [T] (list__member(T, CalleeExistQTypes) => type_util__var(T, _)) % it might make sense to also check that % the type substitution did not bind any % existentially typed variables to universally % quantified type variables in the caller's % argument types ). %-----------------------------------------------------------------------------% % Types are represented as terms, but we can't just use term__unify % because we need to avoid binding any of the "head type params" % (the type variables that occur in the head of the clause), % and because one day we might want to handle equivalent types. type_unify(term__variable(X), term__variable(Y), HeadTypeParams, Bindings0, Bindings) :- ( list__member(Y, HeadTypeParams) -> type_unify_head_type_param(X, Y, HeadTypeParams, Bindings0, Bindings) ; list__member(X, HeadTypeParams) -> type_unify_head_type_param(Y, X, HeadTypeParams, Bindings0, Bindings) ; map__search(Bindings0, X, BindingOfX) -> ( map__search(Bindings0, Y, BindingOfY) -> % both X and Y already have bindings - just % unify the types they are bound to type_unify(BindingOfX, BindingOfY, HeadTypeParams, Bindings0, Bindings) ; term__apply_rec_substitution(BindingOfX, Bindings0, SubstBindingOfX), % Y is a type variable which hasn't been bound yet ( SubstBindingOfX = term__variable(Y) -> Bindings = Bindings0 ; \+ term__occurs(SubstBindingOfX, Y, Bindings0), map__det_insert(Bindings0, Y, SubstBindingOfX, Bindings) ) ) ; ( map__search(Bindings0, Y, BindingOfY) -> term__apply_rec_substitution(BindingOfY, Bindings0, SubstBindingOfY), % X is a type variable which hasn't been bound yet ( SubstBindingOfY = term__variable(X) -> Bindings = Bindings0 ; \+ term__occurs(SubstBindingOfY, X, Bindings0), map__det_insert(Bindings0, X, SubstBindingOfY, Bindings) ) ; % both X and Y are unbound type variables - % bind one to the other ( X = Y -> Bindings = Bindings0 ; map__det_insert(Bindings0, X, term__variable(Y), Bindings) ) ) ). type_unify(term__variable(X), term__functor(F, As, C), HeadTypeParams, Bindings0, Bindings) :- ( map__search(Bindings0, X, BindingOfX) -> type_unify(BindingOfX, term__functor(F, As, C), HeadTypeParams, Bindings0, Bindings) ; \+ term__occurs_list(As, X, Bindings0), \+ list__member(X, HeadTypeParams), map__det_insert(Bindings0, X, term__functor(F, As, C), Bindings) ). type_unify(term__functor(F, As, C), term__variable(X), HeadTypeParams, Bindings0, Bindings) :- ( map__search(Bindings0, X, BindingOfX) -> type_unify(term__functor(F, As, C), BindingOfX, HeadTypeParams, Bindings0, Bindings) ; \+ term__occurs_list(As, X, Bindings0), \+ list__member(X, HeadTypeParams), map__det_insert(Bindings0, X, term__functor(F, As, C), Bindings) ). type_unify(term__functor(FX, AsX, _CX), term__functor(FY, AsY, _CY), HeadTypeParams, Bindings0, Bindings) :- list__length(AsX, ArityX), list__length(AsY, ArityY), ( FX = FY, ArityX = ArityY -> type_unify_list(AsX, AsY, HeadTypeParams, Bindings0, Bindings) ; fail ). % XXX Instead of just failing if the functors' name/arity is different, % we should check here if these types have been defined % to be equivalent using equivalence types. But this % is difficult because the relevant variable % TypeTable hasn't been passed in to here. /******* ... ; replace_eqv_type(FX, ArityX, AsX, EqvType) -> type_unify(EqvType, term__functor(FY, AsY, CY), HeadTypeParams, Bindings0, Bindings) ; replace_eqv_type(FY, ArityY, AsY, EqvType) -> type_unify(term__functor(FX, AsX, CX), EqvType, HeadTypeParams, Bindings0, Bindings) ; fail ). :- pred replace_eqv_type(const, int, list(type), type). :- mode replace_eqv_type(in, in, in, out) is semidet. replace_eqv_type(Functor, Arity, Args, EqvType) :- % XXX magically_obtain(TypeTable) make_type_ctor(Functor, Arity, TypeCtor), map__search(TypeTable, TypeCtor, TypeDefn), get_type_defn_body(TypeDefn, TypeBody), TypeBody = eqv_type(EqvType0), get_type_defn_tparams(TypeDefn, TypeParams0), type_param_to_var_list(TypeParams0, TypeParams), term__substitute_corresponding(EqvType0, TypeParams, AsX, EqvType). ******/ type_unify_list([], [], _) --> []. type_unify_list([X | Xs], [Y | Ys], HeadTypeParams) --> type_unify(X, Y, HeadTypeParams), type_unify_list(Xs, Ys, HeadTypeParams). :- pred type_unify_head_type_param(tvar, tvar, list(tvar), tsubst, tsubst). :- mode type_unify_head_type_param(in, in, in, in, out) is semidet. type_unify_head_type_param(Var, HeadVar, HeadTypeParams, Bindings0, Bindings) :- ( map__search(Bindings0, Var, BindingOfVar) -> BindingOfVar = term__variable(Var2), type_unify_head_type_param(Var2, HeadVar, HeadTypeParams, Bindings0, Bindings) ; ( Var = HeadVar -> Bindings = Bindings0 ; \+ list__member(Var, HeadTypeParams), map__det_insert(Bindings0, Var, term__variable(HeadVar), Bindings) ) ). %-----------------------------------------------------------------------------% type_util__vars(Type, Tvars) :- term__vars(Type, Tvars). type_util__real_vars(Type, Tvars) :- ( is_introduced_type_info_type(Type) -> % for these types, we don't add the type parameters Tvars = [] ; type_util__vars(Type, Tvars) ). %-----------------------------------------------------------------------------% apply_substitution_to_type_map(VarTypes0, Subst, VarTypes) :- % optimize the common case of an empty type substitution ( map__is_empty(Subst) -> VarTypes = VarTypes0 ; map__keys(VarTypes0, Vars), apply_substitution_to_type_map_2(Vars, VarTypes0, Subst, VarTypes) ). :- pred apply_substitution_to_type_map_2(list(prog_var)::in, map(prog_var, type)::in, tsubst::in, map(prog_var, type)::out) is det. apply_substitution_to_type_map_2([], VarTypes, _Subst, VarTypes). apply_substitution_to_type_map_2([Var | Vars], VarTypes0, Subst, VarTypes) :- map__lookup(VarTypes0, Var, VarType0), term__apply_substitution(VarType0, Subst, VarType), map__det_update(VarTypes0, Var, VarType, VarTypes1), apply_substitution_to_type_map_2(Vars, VarTypes1, Subst, VarTypes). %-----------------------------------------------------------------------------% apply_rec_substitution_to_type_map(VarTypes0, Subst, VarTypes) :- % optimize the common case of an empty type substitution ( map__is_empty(Subst) -> VarTypes = VarTypes0 ; map__keys(VarTypes0, Vars), apply_rec_substitution_to_type_map_2(Vars, VarTypes0, Subst, VarTypes) ). :- pred apply_rec_substitution_to_type_map_2(list(prog_var)::in, map(prog_var, type)::in, tsubst::in, map(prog_var, type)::out) is det. apply_rec_substitution_to_type_map_2([], VarTypes, _Subst, VarTypes). apply_rec_substitution_to_type_map_2([Var | Vars], VarTypes0, Subst, VarTypes) :- map__lookup(VarTypes0, Var, VarType0), term__apply_rec_substitution(VarType0, Subst, VarType), map__det_update(VarTypes0, Var, VarType, VarTypes1), apply_rec_substitution_to_type_map_2(Vars, VarTypes1, Subst, VarTypes). %-----------------------------------------------------------------------------% apply_substitutions_to_var_map(VarMap0, TRenaming, TSubst, Subst, VarMap) :- % optimize the common case of empty substitutions ( map__is_empty(Subst), map__is_empty(TSubst), map__is_empty(TRenaming) -> VarMap = VarMap0 ; map__keys(VarMap0, TVars), map__init(NewVarMap), apply_substitutions_to_var_map_2(TVars, VarMap0, TRenaming, TSubst, Subst, NewVarMap, VarMap) ). :- pred apply_substitutions_to_var_map_2(list(tvar)::in, map(tvar, type_info_locn)::in, tsubst::in, map(tvar, type)::in, map(prog_var, prog_var)::in, map(tvar, type_info_locn)::in, map(tvar, type_info_locn)::out) is det. apply_substitutions_to_var_map_2([], _VarMap0, _, _, _, NewVarMap, NewVarMap). apply_substitutions_to_var_map_2([TVar | TVars], VarMap0, TRenaming, TSubst, VarSubst, NewVarMap0, NewVarMap) :- map__lookup(VarMap0, TVar, Locn), type_info_locn_var(Locn, Var), % find the new var, if there is one ( map__search(VarSubst, Var, NewVar0) -> NewVar = NewVar0 ; NewVar = Var ), type_info_locn_set_var(NewVar, Locn, NewLocn), % find the new tvar, if there is one, otherwise just % create the old var as a type variable. ( map__search(TRenaming, TVar, NewTVar0) -> ( NewTVar0 = term__variable(NewTVar1) -> NewTVar2 = NewTVar1 ; % varset__merge_subst only returns var->var mappings, % never var->term. error( "apply_substitution_to_var_map_2: weird type renaming") ) ; % The variable wasn't renamed. NewTVar2 = TVar ), term__apply_rec_substitution(term__variable(NewTVar2), TSubst, NewType), % if the tvar is still a variable, insert it into the % map with the new var. ( type_util__var(NewType, NewTVar) -> % Don't abort if two old type variables % map to the same new type variable. map__set(NewVarMap0, NewTVar, NewLocn, NewVarMap1) ; NewVarMap1 = NewVarMap0 ), apply_substitutions_to_var_map_2(TVars, VarMap0, TRenaming, TSubst, VarSubst, NewVarMap1, NewVarMap). %-----------------------------------------------------------------------------% apply_substitutions_to_typeclass_var_map(VarMap0, TRenaming, TSubst, Subst, VarMap) :- map__to_assoc_list(VarMap0, VarAL0), list__map(apply_substitutions_to_typeclass_var_map_2(TRenaming, TSubst, Subst), VarAL0, VarAL), map__from_assoc_list(VarAL, VarMap). :- pred apply_substitutions_to_typeclass_var_map_2(tsubst, map(tvar, type), map(prog_var, prog_var), pair(class_constraint, prog_var), pair(class_constraint, prog_var)). :- mode apply_substitutions_to_typeclass_var_map_2(in, in, in, in, out) is det. apply_substitutions_to_typeclass_var_map_2(TRenaming, TSubst, VarRenaming, Constraint0 - Var0, Constraint - Var) :- apply_subst_to_constraint(TRenaming, Constraint0, Constraint1), apply_rec_subst_to_constraint(TSubst, Constraint1, Constraint), ( map__search(VarRenaming, Var0, Var1) -> Var = Var1 ; Var = Var0 ). %-----------------------------------------------------------------------------% apply_rec_subst_to_constraints(Subst, Constraints0, Constraints) :- Constraints0 = constraints(UnivCs0, ExistCs0), apply_rec_subst_to_constraint_list(Subst, UnivCs0, UnivCs), apply_rec_subst_to_constraint_list(Subst, ExistCs0, ExistCs), Constraints = constraints(UnivCs, ExistCs). apply_rec_subst_to_constraint_list(Subst, Constraints0, Constraints) :- list__map(apply_rec_subst_to_constraint(Subst), Constraints0, Constraints). apply_rec_subst_to_constraint(Subst, Constraint0, Constraint) :- Constraint0 = constraint(ClassName, Types0), term__apply_rec_substitution_to_list(Types0, Subst, Types), Constraint = constraint(ClassName, Types). apply_subst_to_constraints(Subst, constraints(UniversalCs0, ExistentialCs0), constraints(UniversalCs, ExistentialCs)) :- apply_subst_to_constraint_list(Subst, UniversalCs0, UniversalCs), apply_subst_to_constraint_list(Subst, ExistentialCs0, ExistentialCs). apply_subst_to_constraint_list(Subst, Constraints0, Constraints) :- list__map(apply_subst_to_constraint(Subst), Constraints0, Constraints). apply_subst_to_constraint(Subst, Constraint0, Constraint) :- Constraint0 = constraint(ClassName, Types0), term__apply_substitution_to_list(Types0, Subst, Types), Constraint = constraint(ClassName, Types). apply_subst_to_constraint_proofs(Subst, Proofs0, Proofs) :- map__init(Empty), map__foldl((pred(Constraint0::in, Proof0::in, Map0::in, Map::out) is det :- apply_subst_to_constraint(Subst, Constraint0, Constraint), ( Proof0 = apply_instance(_), Proof = Proof0 ; Proof0 = superclass(Super0), apply_subst_to_constraint(Subst, Super0, Super), Proof = superclass(Super) ), map__set(Map0, Constraint, Proof, Map) ), Proofs0, Empty, Proofs). apply_rec_subst_to_constraint_proofs(Subst, Proofs0, Proofs) :- map__init(Empty), map__foldl((pred(Constraint0::in, Proof0::in, Map0::in, Map::out) is det :- apply_rec_subst_to_constraint(Subst, Constraint0, Constraint), ( Proof0 = apply_instance(_), Proof = Proof0 ; Proof0 = superclass(Super0), apply_rec_subst_to_constraint(Subst, Super0, Super), Proof = superclass(Super) ), map__set(Map0, Constraint, Proof, Map) ), Proofs0, Empty, Proofs). apply_variable_renaming_to_type_map(Renaming, Map0, Map) :- map__map_values( (pred(_::in, Type0::in, Type::out) is det :- term__apply_variable_renaming(Type0, Renaming, Type) ), Map0, Map). apply_variable_renaming_to_constraints(Renaming, constraints(UniversalCs0, ExistentialCs0), constraints(UniversalCs, ExistentialCs)) :- apply_variable_renaming_to_constraint_list(Renaming, UniversalCs0, UniversalCs), apply_variable_renaming_to_constraint_list(Renaming, ExistentialCs0, ExistentialCs). apply_variable_renaming_to_constraint_list(Renaming, Constraints0, Constraints) :- list__map(apply_variable_renaming_to_constraint(Renaming), Constraints0, Constraints). apply_variable_renaming_to_constraint(Renaming, Constraint0, Constraint) :- Constraint0 = constraint(ClassName, ClassArgTypes0), term__apply_variable_renaming_to_list(ClassArgTypes0, Renaming, ClassArgTypes), Constraint = constraint(ClassName, ClassArgTypes). %-----------------------------------------------------------------------------% apply_partial_map_to_list([], _PartialMap, []). apply_partial_map_to_list([X|Xs], PartialMap, [Y|Ys]) :- ( map__search(PartialMap, X, Y0) -> Y = Y0 ; Y = X ), apply_partial_map_to_list(Xs, PartialMap, Ys). %-----------------------------------------------------------------------------% cons_id_adjusted_arity(ModuleInfo, Type, ConsId) = AdjustedArity :- % figure out the arity of this constructor, % _including_ any type-infos or typeclass-infos % inserted for existential data types. cons_id_arity(ConsId, ConsArity), ( type_util__get_existq_cons_defn(ModuleInfo, Type, ConsId, ConsDefn) -> ConsDefn = ctor_defn(_TVarSet, ExistQTVars, Constraints, _ArgTypes, _ResultType), list__length(Constraints, NumTypeClassInfos), constraint_list_get_tvars(Constraints, ConstrainedTVars), list__delete_elems(ExistQTVars, ConstrainedTVars, UnconstrainedExistQTVars), list__length(UnconstrainedExistQTVars, NumTypeInfos), AdjustedArity = ConsArity + NumTypeClassInfos + NumTypeInfos ; AdjustedArity = ConsArity ). %-----------------------------------------------------------------------------% constraint_list_get_tvars(Constraints, TVars) :- list__map(constraint_get_tvars, Constraints, TVarsList), list__condense(TVarsList, TVars). constraint_get_tvars(constraint(_Name, Args), TVars) :- term__vars_list(Args, TVars). get_unconstrained_tvars(Tvars, Constraints, Unconstrained) :- constraint_list_get_tvars(Constraints, ConstrainedTvars), list__delete_elems(Tvars, ConstrainedTvars, Unconstrained0), list__remove_dups(Unconstrained0, Unconstrained). %-----------------------------------------------------------------------------% maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, ConsId0, Arity, MaybeTypes) :- ( ConsId0 = cons(_SymName, _) -> ConsId = ConsId0, ( MaybeType = yes(Type), % XXX get_cons_id_non_existential_arg_types will fail % for ConsIds with existentially typed arguments. get_cons_id_non_existential_arg_types(ModuleInfo, Type, ConsId, Types), list__length(Types, Arity) -> MaybeTypes = list__map(func(T) = yes(T), Types) ; list__duplicate(Arity, no, MaybeTypes) ) ; MaybeTypes = [] ). maybe_get_higher_order_arg_types(MaybeType, Arity, MaybeTypes) :- ( MaybeType = yes(Type), type_is_higher_order(Type, _, _, _, Types) -> MaybeTypes = list__map(func(T) = yes(T), Types) ; list__duplicate(Arity, no, MaybeTypes) ). %-----------------------------------------------------------------------------% cell_cons_id(type_info_cell(Ctor)) = type_info_cell_constructor(Ctor). cell_cons_id(typeclass_info_cell) = typeclass_info_cell_constructor. cell_inst_cons_id(Which, Arity) = InstConsId :- % Soon neither of these function symbols will exist, % even with fake arity, but they do not need to. ( Which = type_info_cell(_), Symbol = "type_info" ; Which = typeclass_info_cell, Symbol = "typeclass_info" ), PrivateBuiltin = mercury_private_builtin_module, InstConsId = cons(qualified(PrivateBuiltin, Symbol), Arity). cell_type_name(type_info_cell(_)) = "type_info". cell_type_name(typeclass_info_cell) = "typeclass_info". %-----------------------------------------------------------------------------% builtin_type_ctors_with_no_hlds_type_defn = [ qualified(mercury_public_builtin_module, "int") - 0, qualified(mercury_public_builtin_module, "string") - 0, qualified(mercury_public_builtin_module, "character") - 0, qualified(mercury_public_builtin_module, "float") - 0, qualified(mercury_public_builtin_module, "pred") - 0, qualified(mercury_public_builtin_module, "func") - 0, qualified(mercury_public_builtin_module, "void") - 0, qualified(mercury_public_builtin_module, "tuple") - 0 ]. %-----------------------------------------------------------------------------%