%---------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %---------------------------------------------------------------------------% % Copyright (C) 1996-2012 The University of Melbourne. % Copyright (C) 2014-2018 The Mercury team. % This file may only be copied under the terms of the GNU General % Public License - see the file COPYING in the Mercury distribution. %---------------------------------------------------------------------------% % % File: prog_data.m. % Main author: fjh. % % This module defines the types that represent the most frequently used parts % of the parse trees of Mercury programs. % % The other prog_data_*.m modules define the other parts of the parse tree % that are needed after the creation of the HLDS. prog_item.m defines % the parts of the tree that are needed *only until* the creation of the HLDS. % %---------------------------------------------------------------------------% :- module parse_tree.prog_data. :- interface. :- import_module mdbcomp. :- import_module mdbcomp.prim_data. :- import_module mdbcomp.sym_name. :- import_module parse_tree.prog_item. :- import_module char. :- import_module list. :- import_module map. :- import_module maybe. :- import_module set. :- import_module term. :- import_module varset. %---------------------------------------------------------------------------% % % Cons ids. % :- interface. % The representation of cons_ids below is a compromise. The cons_id % type must be defined here, in a submodule of parse_tree.m, because % it is a component of insts. However, after the program has been read % in, the cons_ids cons, int_const, string_const and float_const, % which can appear in user programs, may also be augmented by the other % cons_ids, which can only be generated by the compiler. % % The problem is that some of these compiler generated cons_ids % refer to procedures, and the natural method of identifying % procedures requires the types pred_id and proc_id, defined % in hlds_pred.m, which we don't want to import here. % % We could try to avoid this problem using two different types % for cons_ids, one defined here for use in the parse tree and one % defined in hlds_data.m for use in the HLDS. We could distinguish % the two by having the HLDS cons_id have a definition such as % cons_id ---> parse_cons_id(parse_cons_id) ; ... % or, alternatively, by making cons_id parametric in the type of % constants, and substitute different constant types (since all the % cons_ids that refer to HLDS concepts are constants). % % Using two different types requires a translation from one to the % other. While the runtime cost would be acceptable, the cost in code % complexity isn't, since the translation isn't confined to % make_hlds.m. (I found this out the hard way.) This is especially so % if we want to use in each case only the tightest possible type. % For example, while construct goals can involve all cons_ids, % deconstruct goals and switches can currently involve only the % cons_ids that can appear in parse trees. % % The solution we have chosen is to exploit the fact that pred_ids % and proc_ids are integers. Those types are private to hlds_pred.m, % but hlds_pred.m also contains functions for translating them to and % from the shrouded versions defined below. The next three types are % designed to be used in only two ways: for translation to their HLDS % equivalents by the unshroud functions in hlds_pred.m, and for % printing for diagnostics. % :- type shrouded_pred_id ---> shrouded_pred_id(int). :- type shrouded_proc_id ---> shrouded_proc_id(int). :- type shrouded_pred_proc_id ---> shrouded_pred_proc_id(int, int). :- type cons_id ---> cons(sym_name, arity, type_ctor) % Before post-typecheck, the type_ctor field is not meaningful. % % Before post-typecheck, tuples and characters have this cons_id. % For tuples, this will be of the form % `cons(unqualified("{}"), Arity, _)', % while for characters, this will be of the form % `cons(unqualified(Str), 0, _)' % where Str = term_io.quoted_char(Char). ; tuple_cons(arity) ; closure_cons(shrouded_pred_proc_id, lambda_eval_method) % Note that a closure_cons represents a closure, not just % a code address. % XXX We should have a pred_or_func field as well. ; int_const(int) ; uint_const(uint) ; int8_const(int8) ; uint8_const(uint8) ; int16_const(int16) ; uint16_const(uint16) ; int32_const(int32) ; uint32_const(uint32) ; int64_const(int64) ; uint64_const(uint64) ; float_const(float) ; char_const(char) ; string_const(string) ; impl_defined_const(string) ; type_ctor_info_const( module_name, string, % Name of the type constructor. int % Its arity. ) ; base_typeclass_info_const( module_name, % Module name of instance declaration (not filled in % so that link errors result from overlapping instances). class_id, % Class name and arity. int, % Class instance. string % Encodes the type names and arities of the arguments % of the instance declaration. ) ; type_info_cell_constructor(type_ctor) ; typeclass_info_cell_constructor ; type_info_const(int) ; typeclass_info_const(int) ; ground_term_const(int, cons_id) ; tabling_info_const(shrouded_pred_proc_id) % The address of the static structure that holds information % about the table that implements memoization, loop checking % or the minimal model semantics for the given procedure. ; table_io_entry_desc(shrouded_pred_proc_id) % The address of a structure that describes the layout of the % answer block used by I/O tabling for declarative debugging. ; deep_profiling_proc_layout(shrouded_pred_proc_id). % The Proc_Layout structure of a procedure. Its proc_static field % is used by deep profiling, as documented in the deep profiling % paper. % Describe how a lambda expression is to be evaluated. % % `normal' is the top-down Mercury execution algorithm. % :- type lambda_eval_method ---> lambda_normal. :- func cons_id_dummy_type_ctor = type_ctor. % Are the two cons_ids equivalent, modulo any module qualifications? % :- pred equivalent_cons_ids(cons_id::in, cons_id::in) is semidet. :- pred cons_id_is_const_struct(cons_id::in, int::out) is semidet. :- implementation. cons_id_dummy_type_ctor = type_ctor(unqualified(""), -1). equivalent_cons_ids(ConsIdA, ConsIdB) :- ( if ConsIdA = cons(SymNameA, ArityA, _), ConsIdB = cons(SymNameB, ArityB, _) then ArityA = ArityB, ( SymNameA = unqualified(Name), SymNameB = unqualified(Name) ; SymNameA = unqualified(Name), SymNameB = qualified(_, Name) ; SymNameA = qualified(_, Name), SymNameB = unqualified(Name) ; SymNameA = qualified(Qualifier, Name), SymNameB = qualified(Qualifier, Name) ) else if ConsIdA = cons(SymNameA, ArityA, _), ConsIdB = tuple_cons(ArityB) then ArityA = ArityB, SymNameA = unqualified("{}") else if ConsIdA = tuple_cons(ArityA), ConsIdB = cons(SymNameB, ArityB, _) then ArityA = ArityB, SymNameB = unqualified("{}") else ConsIdA = ConsIdB ). cons_id_is_const_struct(ConsId, ConstNum) :- require_complete_switch [ConsId] ( ConsId = type_info_const(ConstNum) ; ConsId = typeclass_info_const(ConstNum) ; ConsId = ground_term_const(ConstNum, _) ; ( ConsId = cons(_, _, _) ; ConsId = tuple_cons(_) ; ConsId = closure_cons(_, _) ; ConsId = int_const(_) ; ConsId = uint_const(_) ; ConsId = int8_const(_) ; ConsId = uint8_const(_) ; ConsId = int16_const(_) ; ConsId = uint16_const(_) ; ConsId = int32_const(_) ; ConsId = uint32_const(_) ; ConsId = int64_const(_) ; ConsId = uint64_const(_) ; ConsId = float_const(_) ; ConsId = char_const(_) ; ConsId = string_const(_) ; ConsId = impl_defined_const(_) ; ConsId = type_ctor_info_const(_, _, _) ; ConsId = base_typeclass_info_const(_, _, _, _) ; ConsId = type_info_cell_constructor(_) ; ConsId = typeclass_info_cell_constructor ; ConsId = tabling_info_const(_) ; ConsId = table_io_entry_desc(_) ; ConsId = deep_profiling_proc_layout(_) ), fail ). %---------------------------------------------------------------------------% % % Types. % :- interface. % This is how types are represented. % % One day we might allow types to take value parameters, as well as % type parameters. % :- type type_defn ---> parse_tree_du_type(type_details_du) ; parse_tree_eqv_type(type_details_eqv) ; parse_tree_solver_type(type_details_solver) ; parse_tree_abstract_type(type_details_abstract) ; parse_tree_foreign_type(type_details_foreign). :- type type_details_du ---> type_details_du( % The list of data constructors (function symbols) defined % by the type constructor. du_ctors :: list(constructor), % Does the type constructor definition specify % a unification and/or comparison predicate for its instances? du_canonical :: maybe_canonical, % Is any of the data constructors in du_ctors using the % direct_arg optimization, in which its representation is a % tagged pointer to a representation of its single argument % (which must be a *non*-tagged pointer to a heap cell)? % XXX TYPE_REPN This information should NOT be in type_defn % items, but in separate type_representation items. du_direct_arg :: maybe(list(sym_name_and_arity)) ). :- type type_details_eqv ---> type_details_eqv( eqv_type :: mer_type ). :- type type_details_abstract ---> abstract_type_general ; abstract_type_fits_in_n_bits(int) % The abstract type is an enumeration type, requiring % the given number of bits to represent. % XXX TYPE_REPN The part about "is an enumeration type" % is a temporary limitation. In the future, we will also use this % for the abstract versions of other types that can fit in less % then one word, including builtin types such as int8. ; abstract_dummy_type % The abstract type is a dummy type. ; abstract_notag_type % The abstract type is a no_tag type. ; abstract_solver_type. % An abstract solver type. :- type type_details_solver ---> type_details_solver( solver_details :: solver_type_details, solver_canonical :: maybe_canonical ). :- type type_details_foreign ---> type_details_foreign( foreign_lang_type :: foreign_language_type, foreign_canonical :: maybe_canonical, foreign_assertions :: foreign_type_assertions ). % The `is_solver_type' type specifies whether a type is a "solver" type, % for which `any' insts are interpreted as "don't know", or a non-solver % type for which `any' is the same as `bound(...)'. % :- type is_solver_type ---> non_solver_type % The inst `any' is always `bound' for this type. ; solver_type. % The inst `any' is not always `bound' for this type % (i.e. the type was declared with `:- solver type ...'). % A foreign_language_type represents a type that is defined in a % foreign language and accessed in Mercury (most likely through % `pragma foreign_type'). % :- type foreign_language_type ---> c(c_foreign_type) ; java(java_foreign_type) ; csharp(csharp_foreign_type) ; erlang(erlang_foreign_type). :- type c_foreign_type ---> c_type( string % The C type name ). :- type java_foreign_type ---> java_type( string % The Java type name ). :- type csharp_foreign_type ---> csharp_type( string % The C# type name ). :- type erlang_foreign_type ---> erlang_type. % Erlang is untyped. :- type foreign_type_assertions ---> foreign_type_assertions(set(foreign_type_assertion)). :- type foreign_type_assertion ---> foreign_type_can_pass_as_mercury_type ; foreign_type_stable ; foreign_type_word_aligned_pointer. :- type constructor ---> ctor( % The ordinal number of the functor. The first functor % in a type definition has ordinal number 0. cons_ordinal :: int, % Existential constraints, if any. cons_maybe_exist :: maybe_cons_exist_constraints, % The cons_id should be cons(SymName, Arity, TypeCtor) % for user-defined types, and tuple_cons(Arity) for the % system-defined tuple types. cons_name :: sym_name, cons_args :: list(constructor_arg), % We precompute the number of arguments once, to save having % to recompute it many times later. cons_num_args :: int, cons_context :: prog_context ). :- type maybe_cons_exist_constraints ---> no_exist_constraints ; exist_constraints(cons_exist_constraints). :- type cons_exist_constraints ---> cons_exist_constraints( % Neither list may be empty. cons_existq_tvars :: existq_tvars, cons_constraints :: list(prog_constraint), % The unconstrained type variables in cons_existq_tvars % i.e. those tvars that do not appear in any constraint % in cons_constraints. These are in the same order % as they are in cons_existq_tvars. cons_unconstrained :: existq_tvars, % The constrained type variables in cons_existq_tvars % i.e. those tvars that appear in at least one constraint % in cons_constraints. These are in the same order % as they are in cons_existq_tvars. cons_constrained :: existq_tvars ). :- type constructor_arg ---> ctor_arg( arg_field_name :: maybe(ctor_field_name), arg_type :: mer_type, arg_context :: prog_context ). :- type ctor_field_name ---> ctor_field_name( sym_name, % The name of the field. prog_context % The context of the name in the source. ). % The arg_pos_width type and its components specify how much space % does a constructor argument occupy in the memory that represents % a term with that constructor, and where. This memory will usually be % in a heap cell, so this is what the discussion below assumes, % but see below for an exception. % % XXX ARG_PACK document the CellOffset fields. % `apw_full(ArgOnlyOffset)' indicates that the argument fully occupies % a single word, and this word is ArgOnlyOffset words after the first word % of the memory cell cell that starts storing visible arguments. % This means that e.g. if the first argument takes up a full word, % it will be at ArgOnlyOffset=0, even though the memory cell of the term % may contain a remote secondary tag, and type_infos and/or typeclass_infos % added by polymophism.m, before it. (This is the meaning of "arg only" % offsets.) % % `apw_double(ArgOnlyOffset)' indicates that the argument occupies % two words, at arg only offsets ArgOnlyOffset and ArgOnlyOffset+1. % Currently, by default only double-precision floats may take two words, % but int64 and uint64 values may do so as well if the option % allow_double_word_ints is set. % % `apw_partial_first(ArgOnlyOffset, NumBits, Mask, Fill)' indicates % that the argument is the first of two or more sub-word-sized arguments % which share the same word at the offset ArgOnlyOffset. This argument % occupies the lowest NumBits bits in the word so no shifting is required % to access it. The other arguments can be masked out with the bit-mask % `Mask'. Mask will always have the least significant NumBits bits set % and all other bits clear. Fill indicates whether the argument should be % treated as an unsigned value (filled with zeroes) or as a signed value % (having the rest of the word filled with the sign bit when extracted). % % `apw_partial_shifted(ArgOnlyOffset, Shift, NumBits, Mask, Fill)' % indicates that the argument is one of two or more sub-word-size arguments % which share the same word at the offset ArgOnlyOffset, but it is % *not* the first, so Shift will be the non-zero number of bits % that the argument value is left-shifted by. The other fields have % the same meaning as for apw_partial_first. % % `apw_none_nowhere' and `apw_none_shifted(ArgOnlyOffset)' each represent % an argument whose type is a dummy type. % % Given a run of one or more consecutive dummy arguments, all arguments % in the run will have the same representation. If the run's immediate % neighbours on both sides are sub-word-sized, then the arguments % in the run will be all be apw_none_shifted; if either neighbouring % argument is missing, or if either is full word sized or larger, % then the arguments in the run will all be apw_none_nowhere. % % The exception mentioned above is that if a function symbol only has % a small number of small (subword-sized) arguments, then we try to fit % the representation of all the arguments next to the primary and local % secondary tags, *without* using a heap cell. In this case, all these % arguments will be represented by apw_partial_shifted with -1 as the % offset (both kinds), unless they are of a dummy type, in which case % their representation will be apw_none_shifted, also with -1 as offset. % % The EBNF grammar of possible sequences of representations of nonconstant % terms is: % % repn: % : ptag ptr_to_heap_cell % | ptag local_sectag (apw_none_shifted | apw_partial_shifted)+ % % heap_cell % : remote_sectag_word? integral_cell_word_unit* % % integral_cell_word_unit % : apw_none_nowhere % | apw_full % | apw_double % | apw_partial_first (apw_none_shifted* apw_partial_shifted)+ % % We wrap function symbols around the integer arguments mentioned above % to make the different integers harder to confuse with each other. :- type fill_kind ---> fill_enum ; fill_int8 ; fill_int16 ; fill_int32 ; fill_uint8 ; fill_uint16 ; fill_uint32 ; fill_char21. :- type double_word_kind ---> dw_float ; dw_int64 ; dw_uint64. :- type arg_only_offset ---> arg_only_offset(int). % The offset of the word from the first part of the memory cell % that contains arguments. In other words, the first argument word % is at offset 0, even if it is preceded in the memory cell % by a remote secondary tag, or by type_infos and/or % typeclass_infos added by polymorphism. % % The arg_only_offsets of any remote secondary tags and of any % type_infos and/or typeclass_infos added by polymorphism are % not meaningful. They can be anything, because the % arg_only_offset is used only for the creation of RTTI data, % and that task takes as its input the arg_only_offsets of % only the actual arguments. % XXX The RTTI data would probably be more useful to the runtime % if it included cell_offsets instead of arg_only_offsets, since % for most purposes, the runtime actually needs the cell_offset, % and having it directly available would avoid the need to compute % *at runtime* the cell_offset from the arg_only_offset, the % absence/presence of a remote secondary tag and the number of % type_infos and/or typeclass_infos. However, changing this % would require nontrivial bootstrapping. :- type cell_offset ---> cell_offset(int). % The offset of the word from the start of the memory cell. % If the cell starts with N words containing remote secondary % tags, type_infos and/or typeclass_infos, then the first % actual argument will be at cell_offset N. :- type arg_shift ---> arg_shift(int). :- type arg_num_bits ---> arg_num_bits(int). :- type arg_mask ---> arg_mask(int). % The mask is always set to be (2 ^ num_bits) - 1. :- type arg_pos_width ---> apw_full( awf_ao_offset :: arg_only_offset, awf_cell_offset :: cell_offset ) ; apw_double( awd_ao_offset_start :: arg_only_offset, awd_cell_offset :: cell_offset, awd_kind :: double_word_kind ) ; apw_partial_first( % The word this starts may contain apw_partial_shifted % *and* apw_none_shifted. awpf_ao_offset :: arg_only_offset, awpf_cell_offset :: cell_offset, awpf_shift :: arg_shift, awpf_num_bits :: arg_num_bits, awpf_mask :: arg_mask, awpf_fill :: fill_kind ) ; apw_partial_shifted( awps_ao_offset :: arg_only_offset, awps_cell_offset :: cell_offset, awps_shift :: arg_shift, awps_num_bits :: arg_num_bits, awps_mask :: arg_mask, awps_fill :: fill_kind ) ; apw_none_shifted( % Like apw_partial_shifted, but this arg is of a dummy type. awns_ao_offset :: arg_only_offset, awns_cell_offset :: cell_offset ) ; apw_none_nowhere. % This arg is of a dummy type. It is not packed together % with any other argument, and occupies no space at all. :- type arg_width ---> aw_none ; aw_partial_word ; aw_full_word ; aw_double_word. :- func arg_pos_width_to_width_only(arg_pos_width) = arg_width. % The noncanon functor gives the user-defined unification and/or comparison % predicates for a noncanonical type, if they are known. The value % noncanon_abstract represents a type whose definition uses the syntax % `where type_is_abstract_noncanonical' and has been read from an % .int2 file. This means we know that the type has a noncanonical % representation, but we don't know what the unification or comparison % predicates are. % :- type maybe_canonical ---> canon ; noncanon(noncanonical). :- type noncanonical ---> noncanon_uni_cmp(equality_pred, comparison_pred) ; noncanon_uni_only(equality_pred) ; noncanon_cmp_only(comparison_pred) ; noncanon_abstract(is_solver_type). % The `where' attributes of a solver type definition must begin % with % representation is <>, % ground is <>, % any is <>, % constraint_store is <> % :- type solver_type_details ---> solver_type_details( std_representation_type :: mer_type, std_ground_inst :: mer_inst, std_any_inst :: mer_inst, std_mutable_items :: list(item_mutable_info) ). % An init_pred specifies the name of an impure user-defined predicate % used to initialise solver type values (the compiler will insert calls % to this predicate to convert free solver type variables to inst any % variables where necessary.) % :- type init_pred == sym_name. % An equality_pred specifies the name of a user-defined predicate % used for equality on a type. See the chapter on them in the % Mercury Language Reference Manual. % :- type equality_pred == sym_name. % The name of a user-defined comparison predicate. % :- type comparison_pred == sym_name. % Parameters of type definitions. % :- type type_param == tvar. % Use prog_type.type_to_ctor_and_args to convert a type to a qualified % type_ctor and a list of arguments. Use prog_type.construct_type to % construct a type from a type_ctor and a list of arguments. % :- type mer_type ---> type_variable(tvar, kind) % A type variable. ; defined_type(sym_name, list(mer_type), kind) % A type using a user defined type constructor. ; builtin_type(builtin_type) % These are all known to have kind `star'. % The above three functors should be kept as the first three, since % they will be the most commonly used and therefore we want them to % get the primary tags on a 32-bit machine. ; tuple_type(list(mer_type), kind) % Tuple types. ; higher_order_type( % A type for higher-order values. The kind is always `star'. % For functions the return type is at the end of the list % of argument types. pred_or_func, list(mer_type), ho_inst_info, purity, lambda_eval_method ) ; apply_n_type(tvar, list(mer_type), kind) % An apply/N expression. `apply_n(V, [T1, ...], K)' % would be the representation of type `V(T1, ...)' with kind K. % The list must be non-empty. ; kinded_type(mer_type, kind). % A type expression with an explicit kind annotation. % (These are not yet used.) % This type enumerates all of the builtin primitive types in Mercury. % If you add a new alternative then you may also need to update the % following predicates: % % - parse_type_name.is_known_type_name_args/3 % - inst_check.check_inst_defn_has_matching_type/7 % - llds_out_data.output_type_ctor_addr/5 % - type_util.classify_type_ctor/2 % :- type builtin_type ---> builtin_type_int(int_type) ; builtin_type_float ; builtin_type_string ; builtin_type_char. :- type int_type ---> int_type_int ; int_type_uint ; int_type_int8 ; int_type_uint8 ; int_type_int16 ; int_type_uint16 ; int_type_int32 ; int_type_uint32 ; int_type_int64 ; int_type_uint64. :- pred is_builtin_type_sym_name(sym_name::in) is semidet. :- pred is_builtin_type_name(string::in) is semidet. :- pred builtin_type_to_string(builtin_type, string). :- mode builtin_type_to_string(in, out) is det. :- mode builtin_type_to_string(out, in) is semidet. :- pred int_type_to_string(int_type, string). :- mode int_type_to_string(in, out) is det. :- mode int_type_to_string(out, in) is semidet. :- type type_term == term(tvar_type). :- type tvar_type ---> type_var. % "tvar" is short for "type variable". :- type tvar == var(tvar_type). % A set of type variables. :- type tvarset == varset(tvar_type). % A renaming or a substitution on type variables. :- type tvar_renaming == map(tvar, tvar). :- type tsubst == map(tvar, mer_type). :- type type_ctor ---> type_ctor(sym_name, arity). :- type tvar_name_map == map(string, tvar). % existq_tvars is used to record the set of type variables which are % existentially quantified % :- type existq_tvars == list(tvar). % Similar to varset.merge_subst but produces a tvar_renaming % instead of a substitution, which is more suitable for types. % :- pred tvarset_merge_renaming(tvarset::in, tvarset::in, tvarset::out, tvar_renaming::out) is det. % As above, but behaves like varset.merge_subst_without_names. % :- pred tvarset_merge_renaming_without_names(tvarset::in, tvarset::in, tvarset::out, tvar_renaming::out) is det. :- implementation. arg_pos_width_to_width_only(ArgPosWidth) = ArgWidth :- ( ArgPosWidth = apw_full(_, _), ArgWidth = aw_full_word ; ArgPosWidth = apw_double(_, _, _), ArgWidth = aw_double_word ; ( ArgPosWidth = apw_partial_first(_, _, _, _, _, _) ; ArgPosWidth = apw_partial_shifted(_, _, _, _, _, _) ), ArgWidth = aw_partial_word ; ( ArgPosWidth = apw_none_nowhere ; ArgPosWidth = apw_none_shifted(_, _) ), ArgWidth = aw_none ). is_builtin_type_sym_name(SymName) :- SymName = unqualified(Name), builtin_type_to_string(_, Name). is_builtin_type_name(Name) :- builtin_type_to_string(_, Name). % Please keep this code in sync with int_type_to_string and % classify_type_ctor_if_special. builtin_type_to_string(builtin_type_int(int_type_int), "int"). builtin_type_to_string(builtin_type_int(int_type_uint), "uint"). builtin_type_to_string(builtin_type_int(int_type_int8), "int8"). builtin_type_to_string(builtin_type_int(int_type_uint8), "uint8"). builtin_type_to_string(builtin_type_int(int_type_int16), "int16"). builtin_type_to_string(builtin_type_int(int_type_uint16), "uint16"). builtin_type_to_string(builtin_type_int(int_type_int32), "int32"). builtin_type_to_string(builtin_type_int(int_type_uint32), "uint32"). builtin_type_to_string(builtin_type_int(int_type_int64), "int64"). builtin_type_to_string(builtin_type_int(int_type_uint64), "uint64"). builtin_type_to_string(builtin_type_float, "float"). builtin_type_to_string(builtin_type_string, "string"). builtin_type_to_string(builtin_type_char, "character"). % Please keep this code in sync with builtin_type_to_string and % classify_type_ctor_if_special. int_type_to_string(int_type_int, "int"). int_type_to_string(int_type_uint, "uint"). int_type_to_string(int_type_int8, "int8"). int_type_to_string(int_type_uint8, "uint8"). int_type_to_string(int_type_int16, "int16"). int_type_to_string(int_type_uint16, "uint16"). int_type_to_string(int_type_int32, "int32"). int_type_to_string(int_type_uint32, "uint32"). int_type_to_string(int_type_int64, "int64"). int_type_to_string(int_type_uint64, "uint64"). tvarset_merge_renaming(TVarSetA, TVarSetB, TVarSet, Renaming) :- varset.merge_renaming(TVarSetA, TVarSetB, TVarSet, Renaming). tvarset_merge_renaming_without_names(TVarSetA, TVarSetB, TVarSet, Renaming) :- varset.merge_renaming_without_names(TVarSetA, TVarSetB, TVarSet, Renaming). %---------------------------------------------------------------------------% % % Kinds. % :- interface. % Note that we don't support any kind other than `star' at the moment. % The other kinds are intended for the implementation of constructor % classes. % :- type kind ---> kind_star % An ordinary type. ; kind_arrow(kind, kind) % A type with kind `A' applied to a type with kind `arrow(A, B)' % will have kind `B'. ; kind_variable(kvar). % A kind variable. These can be used during kind inference; % after kind inference, all remaining kind variables will be % bound to `star'. :- type kvar_type ---> kind_var. :- type kvar == var(kvar_type). % The kinds of type variables. For efficiency, we only have entries % for type variables that have a kind other than `star'. Any type variable % not appearing in this map, which will usually be the majority of type % variables, can be assumed to have kind `star'. % :- type tvar_kind_map == map(tvar, kind). :- pred get_tvar_kind(tvar_kind_map::in, tvar::in, kind::out) is det. % Return the kind of a type. % :- func get_type_kind(mer_type) = kind. :- implementation. get_tvar_kind(Map, TVar, Kind) :- ( if map.search(Map, TVar, Kind0) then Kind = Kind0 else Kind = kind_star ). get_type_kind(type_variable(_, Kind)) = Kind. get_type_kind(defined_type(_, _, Kind)) = Kind. get_type_kind(builtin_type(_)) = kind_star. get_type_kind(higher_order_type(_, _, _, _, _)) = kind_star. get_type_kind(tuple_type(_, Kind)) = Kind. get_type_kind(apply_n_type(_, _, Kind)) = Kind. get_type_kind(kinded_type(_, Kind)) = Kind. %---------------------------------------------------------------------------% % % Type classes. % :- interface. % A class constraint represents a constraint that a given list of types % is a member of the specified type class. It is an invariant of this data % structure that the types in a class constraint do not contain any % information in their prog_context fields. This invariant is needed % to ensure that we can do unifications, map.lookups, etc., and get the % expected semantics. (This invariant now applies to all types, but is % especially important here.) % % Values of type prog_constraint are used as keys in several maps; % currently (december 2014) these are represented by the types % ancestor_constraints, constraint_proof_map and typeclass_info_varmap. % We cannot store the context of each constraint in here, since after % we have put a constraint into one of these maps with one context, % we wouldn't find it if searching for it with another context, which % would thus defeat the purpose of those maps (to find common uses % of the same constraint). % :- type prog_constraint ---> constraint( constraint_class :: class_name, constraint_arg_types :: list(mer_type) ). :- type prog_constraints ---> constraints( univ_constraints :: list(prog_constraint), % Universally quantified constraints. exist_constraints :: list(prog_constraint) % Existentially quantified constraints. ). % A functional dependency on the variables in the head of a class % declaration. This asserts that, given the complete set of instances % of this class, the binding of the range variables can be uniquely % determined from the binding of the domain variables. % % XXX Both lists should be one_or_more(tvar). % :- type prog_fundep ---> fundep( domain :: list(tvar), range :: list(tvar) ). :- type class_name == sym_name. :- type class_id ---> class_id(class_name, arity). :- type class_interface ---> class_interface_abstract ; class_interface_concrete(list(class_method)). :- type instance_method ---> instance_method( instance_method_p_or_f :: pred_or_func, instance_method_name :: sym_name, instance_method_proc_def :: instance_proc_def, instance_method_arity :: arity, instance_method_decl_context :: prog_context % The context of the instance declaration. ). :- type instance_proc_def ---> instance_proc_def_name( % defined using the `pred(...) is ' syntax sym_name ) ; instance_proc_def_clauses( % defined using clauses list(item_clause_info) ). :- type instance_body ---> instance_body_abstract ; instance_body_concrete(list(instance_method)). :- func prog_constraint_get_class(prog_constraint) = class_name. :- func prog_constraint_get_arg_types(prog_constraint) = list(mer_type). :- type maybe_class_method ---> is_not_a_class_method ; is_a_class_method. :- implementation. prog_constraint_get_class(Constraint) = Constraint ^ constraint_class. prog_constraint_get_arg_types(Constraint) = Constraint ^ constraint_arg_types. %---------------------------------------------------------------------------% % % Insts and modes. % :- interface. % This is how instantiatednesses and modes are represented. % :- type mer_inst ---> free ; free(mer_type) ; any(uniqueness, ho_inst_info) % The ho_inst_info holds extra information % about higher-order values. ; bound(uniqueness, inst_test_results, list(bound_inst)) % The list(bound_inst) must be sorted. ; ground(uniqueness, ho_inst_info) % The ho_inst_info holds extra information % about higher-order values. ; not_reached ; inst_var(inst_var) ; constrained_inst_vars(set(inst_var), mer_inst) % Constrained_inst_vars is a set of inst variables that are % constrained to have the same uniqueness as and to match_final % the specified inst. ; defined_inst(inst_name) % A defined_inst is possibly recursive inst whose value is % stored in the inst_table. This is used both for user-defined % insts and for compiler-generated insts. ; abstract_inst(sym_name, list(mer_inst)). % An abstract inst is a defined inst which has been declared % but not actually been defined (yet). :- inst mer_inst_is_bound for mer_inst/0 ---> bound(ground, ground, ground). % Values of this type give the outcome of various tests on an inst, % if that information is available when the inst is constructed. % The purpose is to allow those tests to work in constant time, % not time that is linear, quadratic or worse in the size of the inst. % % We attach this information to bound insts, since the only practical % way to make an inst big is to use bound insts. % % We could extend the number of tests whose results we can record, % but we should do so only when we have a demonstrated need, and I (zs) % don't yet see the need for them. However, here is a list of the tests % whose results we can consider adding, together with the names of the % predicates that could use them. % % Does the inst contain a nondefault func mode? % inst_contains_nondefault_func_mode % % Does the inst contain any part that is uniq or mostly_uniq? % make_shared_inst % :- type inst_test_results ---> inst_test_results( inst_result_groundness, inst_result_contains_any, inst_result_contains_inst_names, inst_result_contains_inst_vars, inst_result_contains_types, inst_result_type_ctor_propagated ) ; inst_test_no_results % Implies % inst_result_groundness_unknown % inst_result_contains_any_unknown % inst_result_contains_inst_names_unknown % inst_result_contains_inst_vars_unknown % inst_result_contains_types_unknown % inst_result_no_type_ctor_propagated ; inst_test_results_fgtc. % Implies % inst_result_is_ground % inst_result_does_not_contain_any % inst_result_contains_inst_names_known(set.init) % inst_result_contains_inst_vars_known(set.init) % inst_result_contains_types_known(set.init) % inst_result_no_type_ctor_propagated % It also implies that the inst does not contain any % typed insts, constrained insts or higher order type insts, % and that no part of it is unique or mostly_unique. % Does the inst represent a ground term? :- type inst_result_groundness ---> inst_result_is_not_ground ; inst_result_is_ground ; inst_result_groundness_unknown. % Does "any" appear anywhere inside the inst? :- type inst_result_contains_any ---> inst_result_does_not_contain_any ; inst_result_does_contain_any ; inst_result_contains_any_unknown. :- type inst_result_contains_inst_names ---> inst_result_contains_inst_names_known(set(inst_name)) % All the inst_names inside the inst are given in the set. % This is not a guarantee that all the inst_names in the set % appear in the inst, but it is a guarantee that an inst_name % that appears in the inst will appear in the set. ; inst_result_contains_inst_names_unknown. :- type inst_result_contains_inst_vars ---> inst_result_contains_inst_vars_known(set(inst_var)) % All the inst_vars inside the inst are given in the set. % This is not a guarantee that all the inst_vars in the set % appear in the inst, but it is a guarantee that an inst_var % that appears in the inst will appear in the set. ; inst_result_contains_inst_vars_unknown. :- type inst_result_contains_types ---> inst_result_contains_types_known(set(type_ctor)) % All the type_ctors inside typed_inst nodes of the inst % are given in the set. This is not a guarantee that all the % type_ctors in the set appear in the inst, but it is a guarantee % that a type_ctor that appears in the inst will appear in the set. ; inst_result_contains_types_unknown. :- type inst_result_type_ctor_propagated ---> inst_result_no_type_ctor_propagated % The inst is not known to have had a type_ctor propagated % into it. ; inst_result_type_ctor_propagated(type_ctor). % The inst has had the given type_ctor propagated into it. % The type_ctor must have arity 0, since otherwise the propagation % code wouldn't know what type to propagate into the arguments. % (We could record a full type being propagated into the inst, % complete with type_ctor arguments, but that couldn't be % pre-propagated in inst_user.m in vast majority of cases % in which the argument types are not available.) :- type uniqueness ---> shared % There might be other references. ; unique % There is only one reference. ; mostly_unique % There is only one reference, but there might be more % on backtracking. ; clobbered % This was the only reference, but the data has % already been reused. ; mostly_clobbered. % This was the only reference, but the data has already % been reused; however, there may be more references % on backtracking, so we will need to restore the old value % on backtracking. % Was the lambda goal created with pred/func or any_pred/any_func? % :- type ho_groundness ---> ho_ground ; ho_any. % The ho_inst_info type gives extra information about `ground' and `any' % insts relating to higher-order values. % :- type ho_inst_info ---> higher_order(pred_inst_info) % The inst is higher-order, and we have mode/determinism % information for the value. ; none_or_default_func. % No extra information is available, or the inst is function % with the default mode. % higher-order predicate terms are given the inst % `ground(shared, higher_order(PredInstInfo))' or % `any(shared, higher_order(PredInstInfo))' % where the PredInstInfo contains the extra modes and the determinism % for the predicate. The higher-order predicate term itself cannot be free. % If it contains non-local variables with inst `any' then it must be % in the latter form, otherwise it may be in the former. % % Note that calling/applying a higher-order value that has the `any' % inst may bind that variable further, hence these values cannot safely % be called/applied in a negated context. % :- type pred_inst_info ---> pred_inst_info( % Is this a higher-order func mode or a higher-order pred mode? pred_or_func, % The modes of the additional (i.e. not-yet-supplied) arguments % of the pred; for a function, this includes the mode of the % return value as the last element of the list. list(mer_mode), % The register type to use for each of the additional arguments % of the pred. This field is only needed when float registers % exist, and is only set after the float reg wrappers pass. arg_reg_type_info, % The determinism of the predicate or function. determinism ). :- type arg_reg_type_info ---> arg_reg_types_unset % Unneeded or simply unset yet. ; arg_reg_types(list(ho_arg_reg)). :- type ho_arg_reg ---> ho_arg_reg_r ; ho_arg_reg_f. :- type inst_id ---> inst_id(sym_name, arity). :- type bound_inst ---> bound_functor(cons_id, list(mer_inst)). :- type inst_var_type ---> inst_var_type. :- type inst_var == var(inst_var_type). :- type inst_term == term(inst_var_type). :- type inst_varset == varset(inst_var_type). :- type head_inst_vars == map(inst_var, mer_inst). :- type inst_var_sub == map(inst_var, mer_inst). % inst_defn/5 is defined in prog_item.m. :- type inst_defn ---> eqv_inst(mer_inst) ; abstract_inst. % An `inst_name' is used as a key for the inst_table. % It is either a user-defined inst `user_inst(Name, Args)', % or some sort of compiler-generated inst, whose name % is a representation of its meaning. % % For example, `merge_inst(InstA, InstB)' is the name used for the % inst that results from merging InstA and InstB using `merge_inst'. % Similarly `unify_inst(IsLive, InstA, InstB, IsReal)' is % the name for the inst that results from a call to % `abstractly_unify_inst(IsLive, InstA, InstB, IsReal)'. % And `ground_inst' and `any_inst' are insts that result % from unifying an inst with `ground' or `any', respectively. % `typed_inst' is an inst with added type information. % `typed_ground(Uniq, Type)' a equivalent to % `typed_inst(ground(Uniq, no), Type)'. % Note that `typed_ground' is a special case of `typed_inst', % and `ground_inst' and `any_inst' are special cases of `unify_inst'. % The reason for having the special cases is efficiency. % :- type inst_name ---> user_inst(sym_name, list(mer_inst)) ; unify_inst(is_live, unify_is_real, mer_inst, mer_inst) ; merge_inst(mer_inst, mer_inst) ; ground_inst(inst_name, uniqueness, is_live, unify_is_real) ; any_inst(inst_name, uniqueness, is_live, unify_is_real) ; shared_inst(inst_name) ; mostly_uniq_inst(inst_name) ; typed_ground(uniqueness, mer_type) ; typed_inst(mer_type, inst_name). :- type unify_inst_info ---> unify_inst_info(is_live, unify_is_real, mer_inst, mer_inst). :- type merge_inst_info ---> merge_inst_info(mer_inst, mer_inst). :- type ground_inst_info ---> ground_inst_info(inst_name, uniqueness, is_live, unify_is_real). :- type any_inst_info ---> any_inst_info(inst_name, uniqueness, is_live, unify_is_real). % NOTE: `is_live' records liveness in the sense used by mode analysis. % This is not the same thing as the notion of liveness used by code % generation. See compiler/notes/glossary.html. % :- type is_live ---> is_live ; is_dead. % Unifications of insts fall into two categories, "real" and "fake". % The "real" inst unifications correspond to real unifications, % and are not allowed to unify with `clobbered' insts (unless % the unification would be `det'). % Any inst unification which is associated with some code that % will actually examine the contents of the variables in question % must be "real". Inst unifications that are not associated with % some real code that examines the variables' values are "fake". % "Fake" inst unifications are used for procedure calls in implied % modes, where the final inst of the var must be computed by % unifying its initial inst with the procedure's final inst, % so that if you pass a ground var to a procedure whose mode % is `free -> list_skeleton', the result is ground, not list_skeleton. % But these fake unifications must be allowed to unify with `clobbered' % insts. Hence we pass down a flag to `abstractly_unify_inst' which % specifies whether or not to allow unifications with clobbered values. % :- type unify_is_real ---> real_unify ; fake_unify. :- type mode_id ---> mode_id(sym_name, arity). :- type mode_defn ---> eqv_mode(mer_mode). :- type mer_mode ---> from_to_mode(mer_inst, mer_inst) ; user_defined_mode(sym_name, list(mer_inst)). :- type from_to_insts ---> from_to_insts(mer_inst, mer_inst). %---------------------------------------------------------------------------% % % Determinism. % :- interface. % The `determinism' type specifies how many solutions a given procedure % may have. % :- type determinism ---> detism_det ; detism_semi ; detism_multi ; detism_non ; detism_cc_multi ; detism_cc_non ; detism_erroneous ; detism_failure. :- type can_fail ---> can_fail ; cannot_fail. :- type soln_count ---> at_most_zero ; at_most_one ; at_most_many_cc % "_cc" means "committed-choice": there is more than one logical % solution, but the pred or goal is being used in a context where % we are only looking for the first solution. ; at_most_many. :- pred determinism_components(determinism, can_fail, soln_count). :- mode determinism_components(in, out, out) is det. :- mode determinism_components(out, in, in) is det. :- implementation. determinism_components(detism_det, cannot_fail, at_most_one). determinism_components(detism_semi, can_fail, at_most_one). determinism_components(detism_multi, cannot_fail, at_most_many). determinism_components(detism_non, can_fail, at_most_many). determinism_components(detism_cc_multi, cannot_fail, at_most_many_cc). determinism_components(detism_cc_non, can_fail, at_most_many_cc). determinism_components(detism_erroneous, cannot_fail, at_most_zero). determinism_components(detism_failure, can_fail, at_most_zero). %---------------------------------------------------------------------------% % % Purity. % :- interface. % Purity indicates whether a goal can have side effects or can depend on % global state. See purity.m and the "Purity" section of the Mercury % language reference manual. :- type purity ---> purity_pure ; purity_semipure ; purity_impure. % Compare two purities. % :- pred less_pure(purity::in, purity::in) is semidet. % Sort of a "maximum" for impurity. % :- func worst_purity(purity, purity) = purity. % Sort of a "minimum" for impurity. % :- func best_purity(purity, purity) = purity. :- implementation. less_pure(P1, P2) :- worst_purity(P1, P2) \= P2. % worst_purity/3 could be written more compactly, but this definition % guarantees us a determinism error if we add to type `purity'. We also % define less_pure/2 in terms of worst_purity/3 rather than the other way % around for the same reason. % worst_purity(purity_pure, purity_pure) = purity_pure. worst_purity(purity_pure, purity_semipure) = purity_semipure. worst_purity(purity_pure, purity_impure) = purity_impure. worst_purity(purity_semipure, purity_pure) = purity_semipure. worst_purity(purity_semipure, purity_semipure) = purity_semipure. worst_purity(purity_semipure, purity_impure) = purity_impure. worst_purity(purity_impure, purity_pure) = purity_impure. worst_purity(purity_impure, purity_semipure) = purity_impure. worst_purity(purity_impure, purity_impure) = purity_impure. % best_purity/3 is written as a switch for the same reason as % worst_purity/3. % best_purity(purity_pure, purity_pure) = purity_pure. best_purity(purity_pure, purity_semipure) = purity_pure. best_purity(purity_pure, purity_impure) = purity_pure. best_purity(purity_semipure, purity_pure) = purity_pure. best_purity(purity_semipure, purity_semipure) = purity_semipure. best_purity(purity_semipure, purity_impure) = purity_semipure. best_purity(purity_impure, purity_pure) = purity_pure. best_purity(purity_impure, purity_semipure) = purity_semipure. best_purity(purity_impure, purity_impure) = purity_impure. %---------------------------------------------------------------------------% % % Goals. % % % NOTE The representation of goals in the parse tree is defined in % prog_item.m, because goals in the parse tree don't *themselves* survive % being translated into HLDS. However, some of their *components* do survive. % The following types define these components. % :- interface. % These type equivalences are for the types of program variables % and associated structures. % :- type prog_var_type ---> prog_var_type. :- type prog_var == var(prog_var_type). :- type prog_varset == varset(prog_var_type). :- type prog_substitution == substitution(prog_var_type). :- type prog_var_renaming == map(prog_var, prog_var). :- type prog_term == term(prog_var_type). :- type prog_vars == list(prog_var). % What to print when printing variable names. % You can get the effect of printing variable numbers only % by passing an empty varset, which effectively makes *all* variables % unnamed, but having an explicit option for this is more readable. :- type var_name_print ---> print_name_only ; print_name_and_num ; print_num_only. :- type prog_context == term.context. :- type trace_expr(Base) ---> trace_base(Base) ; trace_not(trace_expr(Base)) ; trace_op(trace_op, trace_expr(Base), trace_expr(Base)). :- type trace_op ---> trace_or ; trace_and. :- type trace_compiletime ---> trace_flag(string) ; trace_grade(trace_grade) ; trace_trace_level(trace_trace_level). :- type trace_grade ---> trace_grade_debug ; trace_grade_ssdebug ; trace_grade_prof ; trace_grade_profdeep ; trace_grade_par ; trace_grade_trail ; trace_grade_rbmm ; trace_grade_llds ; trace_grade_mlds ; trace_grade_c ; trace_grade_csharp ; trace_grade_java ; trace_grade_erlang. :- type trace_trace_level ---> trace_level_shallow ; trace_level_deep. :- type trace_runtime ---> trace_envvar(string). :- type trace_mutable_var ---> trace_mutable_var( trace_mutable_name :: string, trace_state_var :: prog_var ). :- type atomic_component_state ---> atomic_state_var(prog_var) ; atomic_var_pair(prog_var, prog_var). :- pred parse_trace_grade_name(string, trace_grade). :- mode parse_trace_grade_name(in, out) is semidet. :- mode parse_trace_grade_name(out, in) is det. :- mode parse_trace_grade_name(out, out) is multi. :- pred valid_trace_grade_name(string::out) is multi. % Values of this type are part of the representation % of the disable_warnings scope. :- type goal_warning ---> goal_warning_singleton_vars ; goal_warning_non_tail_recursive_calls. :- implementation. % If you update this, you also need to update the corresponding section % of doc/reference_manual.texi. parse_trace_grade_name("debug", trace_grade_debug). parse_trace_grade_name("ssdebug", trace_grade_ssdebug). parse_trace_grade_name("prof", trace_grade_prof). parse_trace_grade_name("profdeep", trace_grade_profdeep). parse_trace_grade_name("par", trace_grade_par). parse_trace_grade_name("trail", trace_grade_trail). parse_trace_grade_name("rbmm", trace_grade_rbmm). parse_trace_grade_name("llds", trace_grade_llds). parse_trace_grade_name("mlds", trace_grade_mlds). parse_trace_grade_name("c", trace_grade_c). parse_trace_grade_name("csharp", trace_grade_csharp). parse_trace_grade_name("java", trace_grade_java). parse_trace_grade_name("erlang", trace_grade_erlang). valid_trace_grade_name(GradeName) :- parse_trace_grade_name(GradeName, _). %---------------------------------------------------------------------------% % % Trailing and minimal model tabling analysis. % :- interface. :- type trailing_status ---> trail_may_modify ; trail_will_not_modify ; trail_conditional. :- type mm_tabling_status ---> mm_tabled_may_call ; mm_tabled_will_not_call ; mm_tabled_conditional. %---------------------------------------------------------------------------% % % Parts of items that are needed beyond the construction of the HLDS. % :- interface. % What kind of promise does a promise item contain? % :- type promise_type ---> promise_type_exclusive % Two disjunct cannot be true at once. ; promise_type_exhaustive % At least one disjunct will be true. ; promise_type_exclusive_exhaustive % Both of the above assertions, which means that % *exactly* one disjunct will be true. ; promise_type_true. % Promise that the given goal is true. % A predicate or function declaration may either give (a) only the types % of the arguments, or (b) both their types and modes. :- type type_and_mode ---> type_only(mer_type) ; type_and_mode(mer_type, mer_mode). %---------------------------------------------------------------------------% % % Module system. % :- interface. :- type sym_name_specifier ---> sym_name_specifier_name(sym_name) ; sym_name_specifier_name_arity(sym_name, arity). :- type sym_name_and_arity ---> sym_name_arity(sym_name, arity). :- type simple_call_id ---> simple_call_id(pred_or_func, sym_name, arity). :- type arity == int. % Describes whether an item can be used without an explicit module % qualifier. % :- type need_qualifier ---> must_be_qualified ; may_be_unqualified. % Does a module contain the predicate main/2? % :- type has_main ---> has_main ; no_main. %---------------------------------------------------------------------------% :- end_module parse_tree.prog_data. %---------------------------------------------------------------------------%