%-----------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %-----------------------------------------------------------------------------% % Copyright (C) 1999-2005 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: ml_code_util.m. % Main author: fjh. % This module is part of the MLDS code generator. % It defines the ml_gen_info type and its access routines. %-----------------------------------------------------------------------------% :- module ml_backend__ml_code_util. :- interface. :- import_module backend_libs.builtin_ops. :- import_module hlds.code_model. :- import_module hlds.hlds_module. :- import_module hlds.hlds_pred. :- import_module libs.globals. :- import_module mdbcomp.prim_data. :- import_module ml_backend.mlds. :- import_module parse_tree.prog_data. :- import_module bool. :- import_module int. :- import_module list. :- import_module map. :- import_module std_util. %-----------------------------------------------------------------------------% % % Various utility routines used for MLDS code generation % % Generate an MLDS assignment statement. % :- func ml_gen_assign(mlds_lval, mlds_rval, prog_context) = statement. % Append an appropriate `return' statement for the given code_model % and returning the given lvals, if needed. % :- pred ml_append_return_statement(ml_gen_info::in, code_model::in, list(mlds_lval)::in, prog_context::in, statements::in, statements::out) is det. % Generate a block statement, i.e. `{ ; ; }'. % But if the block consists only of a single statement with no % declarations, then just return that statement. % :- func ml_gen_block(mlds__defns, statements, prog_context) = statement. % Join two statement lists and their corresponding declaration lists % in sequence. % % If the statements have no declarations in common, then their % corresponding declaration lists will be concatenated together into % a single list of declarations. But if they have any declarations % in common, then we put each statement list and its declarations into % a block, so that the declarations remain local to each statement list. % :- pred ml_join_decls(mlds__defns::in, statements::in, mlds__defns::in, statements::in, prog_context::in, mlds__defns::out, statements::out) is det. :- type gen_pred == pred(mlds__defns, statements, ml_gen_info, ml_gen_info). :- inst gen_pred == (pred(out, out, in, out) is det). % Given closures to generate code for two conjuncts, generate code % for their conjunction. % :- pred ml_combine_conj(code_model::in, prog_context::in, gen_pred::in(gen_pred), gen_pred::in(gen_pred), mlds__defns::out, statements::out, ml_gen_info::in, ml_gen_info::out) is det. % Given a function label and the statement which will comprise % the function body for that function, generate an mlds__defn % which defines that function. % :- pred ml_gen_nondet_label_func(ml_gen_info::in, ml_label_func::in, prog_context::in, statement::in, mlds__defn::out) is det. % Given a function label, the function parameters, and the statement % which will comprise the function body for that function, % generate an mlds__defn which defines that function. % :- pred ml_gen_label_func(ml_gen_info::in, ml_label_func::in, mlds__func_params::in, prog_context::in, statement::in, mlds__defn::out) is det. % Test to see if the procedure is a model_det function whose function % result has an output mode (whose type is not a dummy argument type % like io__state), and if so, bind RetVar to the procedure's return value. % These procedures need to handled specially: for such functions, % we map the Mercury function result to an MLDS return value. % :- pred ml_is_output_det_function(module_info::in, pred_id::in, proc_id::in, prog_var::out) is semidet. %-----------------------------------------------------------------------------% % % Routines for generating expressions % % conjunction: ml_gen_and(X,Y) = binop((and), X, Y), % except that it does some constant folding on the result. % :- func ml_gen_and(mlds_rval, mlds_rval) = mlds_rval. % negation: ml_gen_not(X) = unop(std_unop(not), X), :- func ml_gen_not(mlds_rval) = mlds_rval. %-----------------------------------------------------------------------------% % % Routines for generating types % % Convert a Mercury type to an MLDS type. % :- pred ml_gen_type(ml_gen_info::in, mer_type::in, mlds_type::out) is det. % Convert the element type for an array_index operator to an MLDS type. % :- func ml_gen_array_elem_type(builtin_ops__array_elem_type) = mlds_type. % Return the MLDS type corresponding to a Mercury string type. % :- func ml_string_type = mlds_type. % Allocate some fresh type variables, with kind `star', to use as % the Mercury types of boxed objects (e.g. to get the argument types % for tuple constructors or closure constructors). Note that this % should only be used in cases where the tvarset doesn't matter. % :- func ml_make_boxed_types(arity) = list(mer_type). %-----------------------------------------------------------------------------% % % Routines for generating function declarations (i.e. mlds__func_params). % % Note that when generating function *definitions*, the versions that take % an ml_gen_info pair should be used, since those are the only ones that will % generate the correct GC tracing code for the parameters. % Generate the function prototype for a given procedure. % :- func ml_gen_proc_params(module_info, pred_id, proc_id) = mlds__func_params. :- pred ml_gen_proc_params(pred_id::in, proc_id::in, mlds__func_params::out, ml_gen_info::in, ml_gen_info::out) is det. % As above, but from the rtti_proc_id rather than from the module_info, % pred_id, and proc_id. % :- func ml_gen_proc_params_from_rtti(module_info, rtti_proc_label) = mlds__func_params. % Generate the function prototype for a procedure with the % given argument types, modes, and code model. % :- func ml_gen_params(module_info, list(mlds__var_name), list(mer_type), list(mer_mode), pred_or_func, code_model) = mlds__func_params. :- pred ml_gen_params(list(mlds__var_name)::in, list(mer_type)::in, list(mer_mode)::in, pred_or_func::in, code_model::in, mlds__func_params::out, ml_gen_info::in, ml_gen_info::out) is det. % Given a list of variables and their corresponding modes, % return a list containing only those variables which have an output mode. % :- func select_output_vars(module_info, list(Var), list(mer_mode), map(Var, mer_type)) = list(Var). %-----------------------------------------------------------------------------% % % Routines for generating labels and entity names % % Generate the mlds__entity_name and module name for the entry point % function corresponding to a given procedure. % :- pred ml_gen_proc_label(module_info::in, pred_id::in, proc_id::in, mlds__entity_name::out, mlds_module_name::out) is det. % Generate an mlds__entity_name for a continuation function with the % given sequence number. The pred_id and proc_id specify the procedure % that this continuation function is part of. % :- func ml_gen_nondet_label(module_info, pred_id, proc_id, ml_label_func) = mlds__entity_name. % Allocate a new function label and return an rval containing the % function's address. If parameters are not given, we assume it is % a continuation function, and give it the appropriate arguments % (depending on whether we are doing nested functions or not). % :- pred ml_gen_new_func_label(maybe(mlds__func_params)::in, ml_label_func::out, mlds_rval::out, ml_gen_info::in, ml_gen_info::out) is det. % Generate the mlds__pred_label and module name for a given procedure. % :- pred ml_gen_pred_label(module_info::in, pred_id::in, proc_id::in, mlds__pred_label::out, mlds_module_name::out) is det. :- pred ml_gen_pred_label_from_rtti(module_info::in, rtti_proc_label::in, mlds__pred_label::out, mlds_module_name::out) is det. % Allocate a new label name, for use in label statements. % :- pred ml_gen_new_label(mlds__label::out, ml_gen_info::in, ml_gen_info::out) is det. %-----------------------------------------------------------------------------% % % Routines for dealing with variables % % Generate a list of the mlds_lvals corresponding to a given list % of prog_vars. % :- pred ml_gen_var_list(ml_gen_info::in, list(prog_var)::in, list(mlds_lval)::out) is det. % Generate the mlds_lval corresponding to a given prog_var. % :- pred ml_gen_var(ml_gen_info::in, prog_var::in, mlds_lval::out) is det. % Generate the mlds_lval corresponding to a given prog_var, % with a given type. % :- pred ml_gen_var_with_type(ml_gen_info::in, prog_var::in, mer_type::in, mlds_lval::out) is det. % Lookup the types of a list of variables. % :- pred ml_variable_types(ml_gen_info::in, list(prog_var)::in, list(mer_type)::out) is det. % Lookup the type of a variable. % :- pred ml_variable_type(ml_gen_info::in, prog_var::in, mer_type::out) is det. % Generate the MLDS variable names for a list of variables. % :- func ml_gen_var_names(prog_varset, list(prog_var)) = list(mlds__var_name). % Generate the MLDS variable name for a variable. % :- func ml_gen_var_name(prog_varset, prog_var) = mlds__var_name. % Generate an lval from the variable name and type. The variable % name will be qualified with the current module name. % :- pred ml_gen_var_lval(ml_gen_info::in, mlds__var_name::in, mlds_type::in, mlds_lval::out) is det. % Generate a declaration for an MLDS variable, given its HLDS type. % :- pred ml_gen_var_decl(var_name::in, mer_type::in, prog_context::in, mlds__defn::out, ml_gen_info::in, ml_gen_info::out) is det. % Generate a declaration for an MLDS variable, given its MLDS type % and the code to trace it for accurate GC (if needed). % :- func ml_gen_mlds_var_decl(mlds__data_name, mlds_type, maybe(statement), mlds__context) = mlds__defn. % Generate a declaration for an MLDS variable, given its MLDS type % and initializer, and given the code to trace it for accurate GC % (if needed). % :- func ml_gen_mlds_var_decl(mlds__data_name, mlds_type, mlds__initializer, maybe(statement), mlds__context) = mlds__defn. % Generate declaration flags for a local variable. % :- func ml_gen_local_var_decl_flags = mlds__decl_flags. % Return the declaration flags appropriate for a public field % in the derived constructor class of a discriminated union. % :- func ml_gen_public_field_decl_flags = mlds__decl_flags. % Apply the usual %s_%d formatting to a MLDS variable name. :- func ml_var_name_to_string(mlds__var_name) = string. %-----------------------------------------------------------------------------% % % Routines for dealing with static constants % % ml_format_reserved_object_name(CtorName, CtorArity, ReservedObjName): % % Generate a name for a specially reserved global variable % (or static member variable) whose address is used to represent % the specified constructor. % :- func ml_format_reserved_object_name(string, arity) = mlds__var_name. % Generate a name for a local static constant. % :- pred ml_format_static_const_name(ml_gen_info::in, string::in, const_seq::in, mlds__var_name::out) is det. % Generate a definition of a static constant, given the constant's name, % type, accessibility, and initializer. % :- func ml_gen_static_const_defn(mlds__var_name, mlds_type, mlds__access, mlds__initializer, prog_context) = mlds__defn. % Return the declaration flags appropriate for an initialized % local static constant. % :- func ml_static_const_decl_flags = mlds__decl_flags. % Succeed iff the specified mlds__defn defines a local static constant. % :- pred ml_decl_is_static_const(mlds__defn::in) is semidet. %-----------------------------------------------------------------------------% % % Routines for dealing with fields % % Given the user-specified field name, if any, and the argument number % (starting from one), generate an MLDS field name. % :- func ml_gen_field_name(maybe(ctor_field_name), int) = mlds__field_name. % Succeed iff the specified type must be boxed when used as a field. % For the MLDS->C and MLDS->asm back-ends, we need to box types that % are not word-sized, because the code % for `arg' etc. in std_util.m % rely on all arguments being word-sized. % :- pred ml_must_box_field_type(mer_type::in, module_info::in) is semidet. %-----------------------------------------------------------------------------% % % Routines for handling success and failure % % Generate code to succeed in the given code_model. % :- pred ml_gen_success(code_model::in, prog_context::in, statements::out, ml_gen_info::in, ml_gen_info::out) is det. % Generate code to fail in the given code_model. % :- pred ml_gen_failure(code_model::in, prog_context::in, statements::out, ml_gen_info::in, ml_gen_info::out) is det. % Generate the declaration for the built-in `succeeded' flag. % (`succeeded' is a boolean variable used to record % the success or failure of model_semi procedures.) % :- func ml_gen_succeeded_var_decl(mlds__context) = mlds__defn. % Return the lval for the `succeeded' flag. % (`succeeded' is a boolean variable used to record % the success or failure of model_semi procedures.) % :- pred ml_success_lval(ml_gen_info::in, mlds_lval::out) is det. % Return an rval which will test the value of the `succeeded' flag. % (`succeeded' is a boolean variable used to record % the success or failure of model_semi procedures.) % :- pred ml_gen_test_success(ml_gen_info::in, mlds_rval::out) is det. % Generate code to set the `succeeded' flag to the specified truth value. % :- pred ml_gen_set_success(ml_gen_info::in, mlds_rval::in, prog_context::in, statement::out) is det. % Generate the declaration for the specified `cond' variable. % (`cond' variables are boolean variables used to record % the success or failure of model_non conditions of if-then-elses.) % :- func ml_gen_cond_var_decl(cond_seq, mlds__context) = mlds__defn. % Return the lval for the specified `cond' flag. % (`cond' variables are boolean variables used to record % the success or failure of model_non conditions of if-then-elses.) % :- pred ml_cond_var_lval(ml_gen_info::in, cond_seq::in, mlds_lval::out) is det. % Return an rval which will test the value of the specified `cond' % variable. (`cond' variables are boolean variables used to record % the success or failure of model_non conditions of if-then-elses.) % :- pred ml_gen_test_cond_var(ml_gen_info::in, cond_seq::in, mlds_rval::out) is det. % Generate code to set the specified `cond' variable to the % specified truth value. % :- pred ml_gen_set_cond_var(ml_gen_info::in, cond_seq::in, mlds_rval::in, prog_context::in, statement::out) is det. % Return the success continuation that was passed as the current function's % argument(s). The success continuation consists of two parts, the `cont' % argument, and the `cont_env' argument. The `cont' argument is a % continuation function that will be called when a model_non goal succeeds. % The `cont_env' argument is a pointer to the environment (set of local % variables in the containing procedure) for the continuation function. % (If we're using gcc nested function, the `cont_env' is not used.) % The output variable lvals and types need to be supplied when generating % a continuation using --nondet-copy-out, otherwise they should be empty. % :- pred ml_initial_cont(ml_gen_info::in, list(mlds_lval)::in, list(mer_type)::in, success_cont::out) is det. % Generate code to call the current success continuation. % This is used for generating success when in a model_non context. % :- pred ml_gen_call_current_success_cont(prog_context::in, statement::out, ml_gen_info::in, ml_gen_info::out) is det. % Generate code to call the current success continuation, using % a local function as a proxy. % This is used for generating success when in a model_non context % from within pragma C code (currently only in IL). % :- pred ml_gen_call_current_success_cont_indirectly(prog_context::in, statement::out, ml_gen_info::in, ml_gen_info::out) is det. %-----------------------------------------------------------------------------% % % Routines for dealing with the environment pointer used for nested functions % % Return an rval for a pointer to the current environment (the set of local % variables in the containing procedure). Note that we generate this % as a dangling reference. The ml_elim_nested pass will insert the % declaration of the env_ptr variable. At this point, the type of these % rvals is `mlds__unknown_type'. % :- pred ml_get_env_ptr(ml_gen_info::in, mlds_rval::out) is det. % Return an mlds__argument for a pointer to the current environment % (the set of local variables in the containing procedure). % :- pred ml_declare_env_ptr_arg(mlds__argument::out) is det. %-----------------------------------------------------------------------------% % % Code to handle accurate GC % % ml_gen_maybe_gc_trace_code(Var, Type, Context, Code): % % If accurate GC is enabled, and the specified variable might contain % pointers, generate code to call `private_builtin__gc_trace' to trace % the variable. % :- pred ml_gen_maybe_gc_trace_code(var_name::in, mer_type::in, prog_context::in, maybe(statement)::out, ml_gen_info::in, ml_gen_info::out) is det. % ml_gen_maybe_gc_trace_code(Var, DeclType, ActualType, Context, Code): % % This is the same as the //4 version (above), except that it takes two % type arguments, rather than one. The first (DeclType) is the type that % the variable was declared with, while the second (ActualType) is that % type that the variable is known to have. This is used to generate GC % tracing code for the temporaries variables used when calling procedures % with polymorphically-typed output arguments. In that case, DeclType % may be a type variable from the callee's type declaration, but ActualType % will be the type from the caller. % % We can't just use DeclType to generate the GC trace code, because there's % no way to compute the type_info for type variables that come from the % callee rather than the current procedure. And we can't just use % ActualType, since DeclType may contain pointers even when ActualType % doesn't (e.g. because DeclType may be a boxed float). So we need to pass % both. % :- pred ml_gen_maybe_gc_trace_code(var_name::in, mer_type::in, mer_type::in, prog_context::in, maybe(statement)::out, ml_gen_info::in, ml_gen_info::out) is det. % ml_gen_maybe_gc_trace_code_with_typeinfo(Var, DeclType, TypeInfoRval, % Context, Code): % % This is the same as ml_gen_maybe_gc_trace_code//5, except that rather % than passing ActualType, the caller constructs the type-info itself, % and just passes the rval for it to this routine. % % This is used by ml_closure_gen.m to generate GC tracing code % for the the local variables in closure wrapper functions. % :- pred ml_gen_maybe_gc_trace_code_with_typeinfo(var_name::in, mer_type::in, mlds_rval::in, prog_context::in, maybe(statement)::out, ml_gen_info::in, ml_gen_info::out) is det. %-----------------------------------------------------------------------------% % % Magic numbers relating to the representation of % typeclass_infos, base_typeclass_infos, and closures. % % This function returns the offset to add to the argument number % of a closure arg to get its field number. % :- func ml_closure_arg_offset = int. % This function returns the offset to add to the argument number % of a typeclass_info arg to get its field number. % :- func ml_typeclass_info_arg_offset = int. % This function returns the offset to add to the method number for a type % class method to get its field number within the base_typeclass_info. % :- func ml_base_typeclass_info_method_offset = int. %-----------------------------------------------------------------------------% % % Miscellaneous routines % % Get the value of the appropriate --det-copy-out or --nondet-copy-out % option, depending on the code model. % :- func get_copy_out_option(globals, code_model) = bool. % Add the qualifier `builtin' to any unqualified name. % Although the builtin types `int', `float', etc. are treated as part % of the `builtin' module, for historical reasons they don't have % any qualifiers in the HLDS, so we need to add the `builtin' % qualifier before converting such names to MLDS. % :- func fixup_builtin_module(module_name) = module_name. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% % % The `ml_gen_info' ADT. % % The `ml_gen_info' type holds information used during % MLDS code generation for a given procedure. % :- type ml_gen_info. % Initialize the ml_gen_info, so that it is ready for generating code % for the given procedure. % :- func ml_gen_info_init(module_info, pred_id, proc_id) = ml_gen_info. :- pred ml_gen_info_get_module_info(ml_gen_info::in, module_info::out) is det. :- pred ml_gen_info_get_module_name(ml_gen_info::in, mercury_module_name::out) is det. :- pred ml_gen_info_get_pred_id(ml_gen_info::in, pred_id::out) is det. :- pred ml_gen_info_get_proc_id(ml_gen_info::in, proc_id::out) is det. :- pred ml_gen_info_get_varset(ml_gen_info::in, prog_varset::out) is det. :- pred ml_gen_info_get_var_types(ml_gen_info::in, vartypes::out) is det. :- pred ml_gen_info_get_byref_output_vars(ml_gen_info::in, list(prog_var)::out) is det. :- pred ml_gen_info_get_value_output_vars(ml_gen_info::in, list(prog_var)::out) is det. :- pred ml_gen_info_get_globals(ml_gen_info::in, globals::out) is det. :- pred ml_gen_info_set_byref_output_vars(list(prog_var)::in, ml_gen_info::in, ml_gen_info::out) is det. :- pred ml_gen_info_set_value_output_vars(list(prog_var)::in, ml_gen_info::in, ml_gen_info::out) is det. % Lookup the --gcc-nested-functions option. % :- pred ml_gen_info_use_gcc_nested_functions(ml_gen_info::in, bool::out) is det. % Lookup the --put-commit-in-nested-func option. % :- pred ml_gen_info_put_commit_in_own_func(ml_gen_info::in, bool::out) is det. % Generate a new label number for use in label statements. % This is used to give unique names to the case labels generated % for dense switch statements. % :- type label_num == int. :- pred ml_gen_info_new_label(label_num::out, ml_gen_info::in, ml_gen_info::out) is det. % A number corresponding to an MLDS nested function which serves as a % label (i.e. a continuation function). % :- type ml_label_func == mlds__func_sequence_num. % Generate a new function label number. This is used to give unique names % to the nested functions used when generating code for nondet procedures. % :- pred ml_gen_info_new_func_label(ml_label_func::out, ml_gen_info::in, ml_gen_info::out) is det. % Increase the function label and const sequence number counters by some % amount which is presumed to be sufficient to ensure that if we start % again with a fresh ml_gen_info and then call this function, we won't % encounter any already-used function labels or constants. (This is used % when generating wrapper functions for type class methods.) % :- pred ml_gen_info_bump_counters(ml_gen_info::in, ml_gen_info::out) is det. % Generate a new commit label number. This is used to give unique names % to the labels used when generating code for commits. % :- type commit_sequence_num == int. :- pred ml_gen_info_new_commit_label(commit_sequence_num::out, ml_gen_info::in, ml_gen_info::out) is det. % Generate a new `cond' variable number. This is used to give unique names % to the local variables used to hold the results of nondet conditions % of if-then-elses. % :- type cond_seq == int. :- pred ml_gen_info_new_cond_var(cond_seq::out, ml_gen_info::in, ml_gen_info::out) is det. % Generate a new `conv' variable number. This is used to give unique names % to the local variables generated by ml_gen_box_or_unbox_lval, which are % used to handle boxing/unboxing argument conversions. % :- type conv_seq == int. :- pred ml_gen_info_new_conv_var(conv_seq::out, ml_gen_info::in, ml_gen_info::out) is det. % Generate a new `const' sequence number. This is used to give unique names % to the local constants generated for --static-ground-terms, closure % layouts, string switch hash tables, etc. % :- type const_seq == int. :- pred ml_gen_info_new_const(const_seq::out, ml_gen_info::in, ml_gen_info::out) is det. % Set the `const' variable name corresponding to the given HLDS variable. % :- pred ml_gen_info_set_const_var_name(prog_var::in, mlds__var_name::in, ml_gen_info::in, ml_gen_info::out) is det. % Lookup the `const' sequence number corresponding to a given HLDS % variable. % :- pred ml_gen_info_lookup_const_var_name(ml_gen_info::in, prog_var::in, mlds__var_name::out) is det. :- pred ml_gen_info_search_const_var_name(ml_gen_info::in, prog_var::in, mlds__var_name::out) is semidet. % A success continuation specifies the (rval for the variable holding % the address of the) function that a nondet procedure should call % if it succeeds, and possibly also the (rval for the variable holding) % the environment pointer for that function, and possibly also the % (list of rvals for the) arguments to the continuation. :- type success_cont ---> success_cont( mlds_rval, % function pointer mlds_rval, % environment pointer % note that if we're using nested % functions then the environment % pointer will not be used list(mlds_type), % argument types, if any list(mlds_lval) % arguments, if any % The arguments will only be non-empty % if the --nondet-copy-out option is % enabled. They do not include the % environment pointer. ). % The ml_gen_info contains a stack of success continuations. % The following routines provide access to that stack. :- pred ml_gen_info_push_success_cont(success_cont::in, ml_gen_info::in, ml_gen_info::out) is det. :- pred ml_gen_info_pop_success_cont(ml_gen_info::in, ml_gen_info::out) is det. :- pred ml_gen_info_current_success_cont(ml_gen_info::in, success_cont::out) is det. % We keep a partial mapping from vars to lvals. This is used in special % cases to override the normal lval for a variable. ml_gen_var will check % this map first, and if the variable is not in this map, then it will go % ahead and generate an lval for it as usual. % Set the lval for a variable. % :- pred ml_gen_info_set_var_lval(prog_var::in, mlds_lval::in, ml_gen_info::in, ml_gen_info::out) is det. % Get the partial mapping from variables to lvals. % :- pred ml_gen_info_get_var_lvals(ml_gen_info::in, map(prog_var, mlds_lval)::out) is det. % Set the partial mapping from variables to lvals. % :- pred ml_gen_info_set_var_lvals(map(prog_var, mlds_lval)::in, ml_gen_info::in, ml_gen_info::out) is det. % The ml_gen_info contains a list of extra definitions of functions or % global constants which should be inserted before the definition of the % function for the current procedure. This is used for the definitions % of the wrapper functions needed for closures. When generating code % for a procedure that creates a closure, we insert the definition of % the wrapper function used for that closure into this list. % Insert an extra definition at the start of the list of extra % definitions. % :- pred ml_gen_info_add_extra_defn(mlds__defn::in, ml_gen_info::in, ml_gen_info::out) is det. % Get the list of extra definitions. % :- pred ml_gen_info_get_extra_defns(ml_gen_info::in, mlds__defns::out) is det. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module backend_libs.foreign. :- import_module backend_libs.rtti. :- import_module check_hlds.mode_util. :- import_module check_hlds.polymorphism. :- import_module check_hlds.type_util. :- import_module hlds.hlds_goal. :- import_module hlds.instmap. :- import_module hlds.special_pred. :- import_module libs.compiler_util. :- import_module libs.globals. :- import_module libs.options. :- import_module ml_backend.ml_call_gen. :- import_module ml_backend.ml_code_gen. :- import_module parse_tree.prog_data. :- import_module parse_tree.prog_io. :- import_module parse_tree.prog_type. :- import_module parse_tree.prog_util. :- import_module counter. :- import_module set. :- import_module stack. :- import_module string. :- import_module term. :- import_module varset. %-----------------------------------------------------------------------------% % % Code for various utility routines % ml_gen_assign(Lval, Rval, Context) = Statement :- Assign = assign(Lval, Rval), Stmt = atomic(Assign), Statement = statement(Stmt, mlds__make_context(Context)). ml_append_return_statement(Info, CodeModel, CopiedOutputVarLvals, Context, !Statements) :- ( CodeModel = model_semi -> ml_gen_test_success(Info, Succeeded), CopiedOutputVarRvals = list__map(func(Lval) = lval(Lval), CopiedOutputVarLvals), ReturnStmt = return([Succeeded | CopiedOutputVarRvals]), ReturnStatement = statement(ReturnStmt, mlds__make_context(Context)), !:Statements = list__append(!.Statements, [ReturnStatement]) ; CodeModel \= model_non, CopiedOutputVarLvals = [_ | _] -> CopiedOutputVarRvals = list__map(func(Lval) = lval(Lval), CopiedOutputVarLvals), ReturnStmt = return(CopiedOutputVarRvals), ReturnStatement = statement(ReturnStmt, mlds__make_context(Context)), !:Statements = list__append(!.Statements, [ReturnStatement]) ; true ). ml_gen_block(VarDecls, Statements, Context) = ( VarDecls = [], Statements = [SingleStatement] -> SingleStatement ; statement(block(VarDecls, Statements), mlds__make_context(Context)) ). ml_join_decls(FirstDecls, FirstStatements, RestDecls, RestStatements, Context, Decls, Statements) :- ( list__member(mlds__defn(Name, _, _, _), FirstDecls), list__member(mlds__defn(Name, _, _, _), RestDecls) -> First = ml_gen_block(FirstDecls, FirstStatements, Context), Rest = ml_gen_block(RestDecls, RestStatements, Context), Decls = [], Statements = [First, Rest] ; Decls = list__append(FirstDecls, RestDecls), Statements = list__append(FirstStatements, RestStatements) ). ml_combine_conj(FirstCodeModel, Context, DoGenFirst, DoGenRest, Decls, Statements, !Info) :- ( % model_det goal: % % ===> % % % FirstCodeModel = model_det, DoGenFirst(FirstDecls, FirstStatements, !Info), DoGenRest(RestDecls, RestStatements, !Info), ml_join_decls(FirstDecls, FirstStatements, RestDecls, RestStatements, Context, Decls, Statements) ; % model_semi goal: % % ===> % MR_bool succeeded; % % ; % if (succeeded) { % ; % } % except that we hoist any declarations generated for % to the outer scope, rather than inside the `if', so that they remain % in scope for any later goals which follow this (this is needed for % declarations of static consts). FirstCodeModel = model_semi, DoGenFirst(FirstDecls, FirstStatements, !Info), ml_gen_test_success(!.Info, Succeeded), DoGenRest(RestDecls, RestStatements, !Info), IfBody = ml_gen_block([], RestStatements, Context), IfStmt = if_then_else(Succeeded, IfBody, no), IfStatement = statement(IfStmt, mlds__make_context(Context)), Decls = list__append(FirstDecls, RestDecls), Statements = list__append(FirstStatements, [IfStatement]) ; % model_non goal: % % ===> % succ_func() { % ; % } % % ; % % except that we hoist any declarations generated for and % any _static_ declarations generated for to the top of the % scope, rather than inside or after the succ_func(), so that they % remain in scope for any code following them (this is needed for % declarations of static consts). % % We take care to only hoist _static_ declarations outside nested % functions, since access to non-local variables is less efficient. % % XXX The pattern above leads to deep nesting for long conjunctions; % we should avoid that. % FirstCodeModel = model_non, % allocate a name for the `succ_func' ml_gen_new_func_label(no, RestFuncLabel, RestFuncLabelRval, !Info), % generate ml_get_env_ptr(!.Info, EnvPtrRval), SuccessCont = success_cont(RestFuncLabelRval, EnvPtrRval, [], []), ml_gen_info_push_success_cont(SuccessCont, !Info), DoGenFirst(FirstDecls, FirstStatements, !Info), ml_gen_info_pop_success_cont(!Info), % generate the `succ_func' % push nesting level DoGenRest(RestDecls, RestStatements, !Info), list__filter(ml_decl_is_static_const, RestDecls, RestStaticDecls, RestOtherDecls), RestStatement = ml_gen_block(RestOtherDecls, RestStatements, Context), % pop nesting level ml_gen_nondet_label_func(!.Info, RestFuncLabel, Context, RestStatement, RestFunc), Decls = list__condense([FirstDecls, RestStaticDecls, [RestFunc]]), Statements = FirstStatements ). ml_decl_is_static_const(Defn) :- Defn = mlds__defn(Name, _Context, Flags, _DefnBody), Name = data(_), Flags = ml_static_const_decl_flags. ml_gen_nondet_label_func(Info, FuncLabel, Context, Statement, Func) :- ml_gen_info_use_gcc_nested_functions(Info, UseNested), ( UseNested = yes, FuncParams = mlds__func_params([], []) ; UseNested = no, ml_declare_env_ptr_arg(EnvPtrArg), FuncParams = mlds__func_params([EnvPtrArg], []) ), ml_gen_label_func(Info, FuncLabel, FuncParams, Context, Statement, Func). ml_gen_label_func(Info, FuncLabel, FuncParams, Context, Statement, Func) :- % Compute the function name. ml_gen_info_get_module_info(Info, ModuleInfo), ml_gen_info_get_pred_id(Info, PredId), ml_gen_info_get_proc_id(Info, ProcId), FuncName = ml_gen_nondet_label(ModuleInfo, PredId, ProcId, FuncLabel), % Compute the function definition. DeclFlags = ml_gen_label_func_decl_flags, MaybePredProcId = no, Attributes = [], FuncDefn = function(MaybePredProcId, FuncParams, defined_here(Statement), Attributes), Func = mlds__defn(FuncName, mlds__make_context(Context), DeclFlags, FuncDefn). % Return the declaration flags appropriate for a label func (a label func % is a function used as a continuation when generating nondet code). % :- func ml_gen_label_func_decl_flags = mlds__decl_flags. ml_gen_label_func_decl_flags = DeclFlags :- Access = local, PerInstance = per_instance, Virtuality = non_virtual, Finality = overridable, Constness = modifiable, Abstractness = concrete, DeclFlags = init_decl_flags(Access, PerInstance, Virtuality, Finality, Constness, Abstractness). %-----------------------------------------------------------------------------% % % Code for generating expressions. % ml_gen_and(X, Y) = ( X = const(true) -> Y ; Y = const(true) -> X ; binop(logical_and, X, Y) ). ml_gen_not(X) = unop(std_unop(logical_not), X). %-----------------------------------------------------------------------------% % % Code for generating types. % ml_gen_type(Info, Type, MLDS_Type) :- ml_gen_info_get_module_info(Info, ModuleInfo), MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type). ml_gen_array_elem_type(elem_type_string) = ml_string_type. ml_gen_array_elem_type(elem_type_int) = mlds__native_int_type. ml_gen_array_elem_type(elem_type_generic) = mlds__generic_type. ml_string_type = mercury_type(string_type, type_cat_string, non_foreign_type(string_type)). ml_make_boxed_types(Arity) = BoxedTypes :- varset__init(TypeVarSet0), varset__new_vars(TypeVarSet0, Arity, BoxedTypeVars, _TypeVarSet), prog_type.var_list_to_type_list(map__init, BoxedTypeVars, BoxedTypes). %-----------------------------------------------------------------------------% % % Code for generating function declarations (i.e. mlds__func_params). % ml_gen_proc_params(ModuleInfo, PredId, ProcId) = FuncParams :- module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo), proc_info_varset(ProcInfo, VarSet), proc_info_headvars(ProcInfo, HeadVars), PredOrFunc = pred_info_is_pred_or_func(PredInfo), pred_info_arg_types(PredInfo, HeadTypes), proc_info_argmodes(ProcInfo, HeadModes), proc_info_interface_code_model(ProcInfo, CodeModel), HeadVarNames = ml_gen_var_names(VarSet, HeadVars), FuncParams = ml_gen_params(ModuleInfo, HeadVarNames, HeadTypes, HeadModes, PredOrFunc, CodeModel). ml_gen_proc_params(PredId, ProcId, FuncParams, !Info) :- ModuleInfo = !.Info ^ module_info, module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo), proc_info_varset(ProcInfo, VarSet), proc_info_headvars(ProcInfo, HeadVars), PredOrFunc = pred_info_is_pred_or_func(PredInfo), pred_info_arg_types(PredInfo, HeadTypes), proc_info_argmodes(ProcInfo, HeadModes), proc_info_interface_code_model(ProcInfo, CodeModel), HeadVarNames = ml_gen_var_names(VarSet, HeadVars), % We must not generate GC tracing code for no_type_info_builtin % procedures, because the generated GC tracing code would refer % to type_infos that don't get passed. PredModule = pred_info_module(PredInfo), PredName = pred_info_name(PredInfo), PredArity = pred_info_orig_arity(PredInfo), ( no_type_info_builtin(PredModule, PredName, PredArity) -> FuncParams = ml_gen_params(ModuleInfo, HeadVarNames, HeadTypes, HeadModes, PredOrFunc, CodeModel) ; ml_gen_params(HeadVarNames, HeadTypes, HeadModes, PredOrFunc, CodeModel, FuncParams, !Info) ). ml_gen_proc_params_from_rtti(ModuleInfo, RttiProcId) = FuncParams :- HeadVars = RttiProcId ^ proc_headvars, ArgTypes = RttiProcId ^ proc_arg_types, ArgModes = RttiProcId ^ proc_arg_modes, PredOrFunc = RttiProcId^pred_or_func, Detism = RttiProcId^proc_interface_detism, determinism_to_code_model(Detism, CodeModel), HeadVarNames = list__map((func(Var - Name) = Result :- term__var_to_int(Var, N), Result = mlds__var_name(Name, yes(N)) ), HeadVars), ml_gen_params_base(ModuleInfo, HeadVarNames, ArgTypes, ArgModes, PredOrFunc, CodeModel, FuncParams, no, _). ml_gen_params(ModuleInfo, HeadVarNames, HeadTypes, HeadModes, PredOrFunc, CodeModel) = FuncParams :- modes_to_arg_modes(ModuleInfo, HeadModes, HeadTypes, ArgModes), ml_gen_params_base(ModuleInfo, HeadVarNames, HeadTypes, ArgModes, PredOrFunc, CodeModel, FuncParams, no, _). ml_gen_params(HeadVarNames, HeadTypes, HeadModes, PredOrFunc, CodeModel, FuncParams, !Info) :- ModuleInfo = !.Info ^ module_info, modes_to_arg_modes(ModuleInfo, HeadModes, HeadTypes, ArgModes), ml_gen_params_base(ModuleInfo, HeadVarNames, HeadTypes, ArgModes, PredOrFunc, CodeModel, FuncParams, yes(!.Info), MaybeInfo), ( MaybeInfo = yes(Info), !:Info = Info ; MaybeInfo = no, unexpected(this_file, "ml_gen_params: missing ml_gen_info") ). :- pred ml_gen_params_base(module_info::in, list(mlds__var_name)::in, list(mer_type)::in, list(arg_mode)::in, pred_or_func::in, code_model::in, mlds__func_params::out, maybe(ml_gen_info)::in, maybe(ml_gen_info)::out) is det. ml_gen_params_base(ModuleInfo, HeadVarNames, HeadTypes, HeadModes, PredOrFunc, CodeModel, FuncParams, !MaybeInfo) :- module_info_get_globals(ModuleInfo, Globals), CopyOut = get_copy_out_option(Globals, CodeModel), ml_gen_arg_decls(ModuleInfo, HeadVarNames, HeadTypes, HeadModes, CopyOut, FuncArgs0, RetTypes0, !MaybeInfo), ( CodeModel = model_det, % For model_det Mercury functions whose result argument has an % output mode, make the result into the MLDS return type. ( RetTypes0 = [], PredOrFunc = function, pred_args_to_func_args(HeadModes, _, ResultMode), ResultMode = top_out, pred_args_to_func_args(HeadTypes, _, ResultType), \+ is_dummy_argument_type(ModuleInfo, ResultType) -> pred_args_to_func_args(FuncArgs0, FuncArgs, RetArg), RetArg = mlds__argument(_RetArgName, RetTypePtr, _GC_TraceCode), ( RetTypePtr = mlds__ptr_type(RetType) -> RetTypes = [RetType] ; unexpected(this_file, "output mode function result " ++ "doesn't have pointer type") ) ; FuncArgs = FuncArgs0, RetTypes = RetTypes0 ) ; CodeModel = model_semi, % For model_semi procedures, return a bool. FuncArgs = FuncArgs0, RetTypes = [mlds__native_bool_type | RetTypes0] ; CodeModel = model_non, % For model_non procedures, we return values by passing them % to the continuation. ( CopyOut = yes, ContType = mlds__cont_type(RetTypes0), RetTypes = [] ; CopyOut = no, ContType = mlds__cont_type([]), RetTypes = RetTypes0 ), ContName = data(var(var_name("cont", no))), % The cont variable always points to code, not to the heap, % so the GC never needs to trace it. ContGCTraceCode = no, ContArg = mlds__argument(ContName, ContType, ContGCTraceCode), ContEnvType = mlds__generic_env_ptr_type, ContEnvName = data(var(var_name("cont_env_ptr", no))), % The cont_env_ptr always points to the stack, since continuation % environments are always allocated on the stack (unless % put_nondet_env_on_heap is true, which won't be the case when doing % our own GC -- this is enforced in handle_options.m). % So the GC doesn't need to trace it. ContEnvGCTraceCode = no, ContEnvArg = mlds__argument(ContEnvName, ContEnvType, ContEnvGCTraceCode), globals__lookup_bool_option(Globals, gcc_nested_functions, NestedFunctions), ( NestedFunctions = yes, FuncArgs = FuncArgs0 ++ [ContArg] ; NestedFunctions = no, FuncArgs = FuncArgs0 ++ [ContArg, ContEnvArg] ) ), FuncParams = mlds__func_params(FuncArgs, RetTypes). % Given the argument variable names, and corresponding lists of their % types and modes, generate the MLDS argument declarations % and return types. % :- pred ml_gen_arg_decls(module_info::in, list(mlds__var_name)::in, list(mer_type)::in, list(arg_mode)::in, bool::in, mlds__arguments::out, mlds__return_types::out, maybe(ml_gen_info)::in, maybe(ml_gen_info)::out) is det. ml_gen_arg_decls(ModuleInfo, HeadVars, HeadTypes, HeadModes, CopyOut, FuncArgs, RetTypes, !MaybeInfo) :- ( HeadVars = [], HeadTypes = [], HeadModes = [] -> FuncArgs = [], RetTypes = [] ; HeadVars = [Var | Vars], HeadTypes = [Type | Types], HeadModes = [Mode | Modes] -> ml_gen_arg_decls(ModuleInfo, Vars, Types, Modes, CopyOut, FuncArgs0, RetTypes0, !MaybeInfo), ( % Exclude types such as io__state, etc. % Also exclude values with arg_mode `top_unused'. ( is_dummy_argument_type(ModuleInfo, Type) ; Mode = top_unused ) -> FuncArgs = FuncArgs0, RetTypes = RetTypes0 ; % For by-value outputs, generate a return type. Mode = top_out, CopyOut = yes -> RetType = mercury_type_to_mlds_type(ModuleInfo, Type), RetTypes = [RetType | RetTypes0], FuncArgs = FuncArgs0 ; % For inputs and by-reference outputs, generate argument. ml_gen_arg_decl(ModuleInfo, Var, Type, Mode, FuncArg, !MaybeInfo), FuncArgs = [FuncArg | FuncArgs0], RetTypes = RetTypes0 ) ; unexpected(this_file, "ml_gen_arg_decls: length mismatch") ). % Given an argument variable, and its type and mode, % generate an MLDS argument declaration for it. % :- pred ml_gen_arg_decl(module_info::in, var_name::in, mer_type::in, arg_mode::in, mlds__argument::out, maybe(ml_gen_info)::in, maybe(ml_gen_info)::out) is det. ml_gen_arg_decl(ModuleInfo, Var, Type, ArgMode, FuncArg, !MaybeInfo) :- MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type), ( ArgMode = top_in -> MLDS_ArgType = MLDS_Type ; MLDS_ArgType = mlds__ptr_type(MLDS_Type) ), Name = data(var(Var)), ( !.MaybeInfo = yes(Info0), % XXX We should fill in this Context properly. term__context_init(Context), ml_gen_maybe_gc_trace_code(Var, Type, Context, Maybe_GC_TraceCode, Info0, Info), !:MaybeInfo = yes(Info) ; !.MaybeInfo = no, Maybe_GC_TraceCode = no, !:MaybeInfo = no ), FuncArg = mlds__argument(Name, MLDS_ArgType, Maybe_GC_TraceCode). ml_is_output_det_function(ModuleInfo, PredId, ProcId, RetArgVar) :- module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo), pred_info_is_pred_or_func(PredInfo) = function, proc_info_interface_code_model(ProcInfo, model_det), proc_info_argmodes(ProcInfo, Modes), pred_info_arg_types(PredInfo, ArgTypes), proc_info_headvars(ProcInfo, ArgVars), modes_to_arg_modes(ModuleInfo, Modes, ArgTypes, ArgModes), pred_args_to_func_args(ArgModes, _InputArgModes, RetArgMode), pred_args_to_func_args(ArgTypes, _InputArgTypes, RetArgType), pred_args_to_func_args(ArgVars, _InputArgVars, RetArgVar), RetArgMode = top_out, \+ is_dummy_argument_type(ModuleInfo, RetArgType). %-----------------------------------------------------------------------------% % % Code for generating mlds__entity_names. % % Generate the mlds__entity_name and module name for the entry point % function corresponding to a given procedure. % ml_gen_proc_label(ModuleInfo, PredId, ProcId, MLDS_Name, MLDS_ModuleName) :- ml_gen_func_label(ModuleInfo, PredId, ProcId, no, MLDS_Name, MLDS_ModuleName). % Generate an mlds__entity_name for a continuation function with the given % sequence number. The pred_id and proc_id specify the procedure that this % continuation function is part of. % ml_gen_nondet_label(ModuleInfo, PredId, ProcId, SeqNum) = MLDS_Name :- ml_gen_func_label(ModuleInfo, PredId, ProcId, yes(SeqNum), MLDS_Name, _MLDS_ModuleName). :- pred ml_gen_func_label(module_info::in, pred_id::in, proc_id::in, maybe(ml_label_func)::in, mlds__entity_name::out, mlds_module_name::out) is det. ml_gen_func_label(ModuleInfo, PredId, ProcId, MaybeSeqNum, MLDS_Name, MLDS_ModuleName) :- ml_gen_pred_label(ModuleInfo, PredId, ProcId, MLDS_PredLabel, MLDS_ModuleName), MLDS_Name = function(MLDS_PredLabel, ProcId, MaybeSeqNum, PredId). % Allocate a new function label and return an rval containing % the function's address. % ml_gen_new_func_label(MaybeParams, FuncLabel, FuncLabelRval, !Info) :- ml_gen_info_new_func_label(FuncLabel, !Info), ml_gen_info_get_module_info(!.Info, ModuleInfo), ml_gen_info_get_pred_id(!.Info, PredId), ml_gen_info_get_proc_id(!.Info, ProcId), ml_gen_pred_label(ModuleInfo, PredId, ProcId, PredLabel, PredModule), ml_gen_info_use_gcc_nested_functions(!.Info, UseNestedFuncs), ( MaybeParams = yes(Params), Signature = mlds__get_func_signature(Params) ; MaybeParams = no, ( UseNestedFuncs = yes, ArgTypes = [] ; UseNestedFuncs = no, ArgTypes = [mlds__generic_env_ptr_type] ), Signature = mlds__func_signature(ArgTypes, []) ), ProcLabel = qual(PredModule, module_qual, PredLabel - ProcId), FuncLabelRval = const(code_addr_const(internal(ProcLabel, FuncLabel, Signature))). % Generate the mlds__pred_label and module name for a given procedure. % ml_gen_pred_label(ModuleInfo, PredId, ProcId, MLDS_PredLabel, MLDS_Module) :- RttiProcLabel = rtti__make_rtti_proc_label(ModuleInfo, PredId, ProcId), ml_gen_pred_label_from_rtti(ModuleInfo, RttiProcLabel, MLDS_PredLabel, MLDS_Module). ml_gen_pred_label_from_rtti(ModuleInfo, RttiProcLabel, MLDS_PredLabel, MLDS_Module) :- RttiProcLabel = rtti_proc_label(PredOrFunc, ThisModule, PredModule, PredName, PredArity, _ArgTypes, PredId, ProcId, _HeadVarsWithNames, _ArgModes, Detism, PredIsImported, _PredIsPseudoImported, Origin, _ProcIsExported, _ProcIsImported), ( Origin = special_pred(SpecialPred - TypeCtor) -> ( % All type_ctors other than tuples here should be % module qualified, since builtin types are handled % separately in polymorphism.m. ( TypeCtor = unqualified(TypeName) - TypeArity, type_ctor_is_tuple(TypeCtor), mercury_public_builtin_module(TypeModule) ; TypeCtor = qualified(TypeModule, TypeName) - TypeArity ) -> ( ThisModule \= TypeModule, SpecialPred = spec_pred_unify, \+ hlds_pred__in_in_unification_proc_id(ProcId) -> % This is a locally-defined instance of a unification procedure % for a type defined in some other module. DefiningModule = ThisModule, MaybeDeclaringModule = yes(TypeModule) ; % The module declaring the type is the same as the module % defining this special pred. DefiningModule = TypeModule, MaybeDeclaringModule = no ), MLDS_PredLabel = special_pred(PredName, MaybeDeclaringModule, TypeName, TypeArity) ; string__append_list(["ml_gen_pred_label:\n", "cannot make label for special pred `", PredName, "'"], ErrorMessage), unexpected(this_file, ErrorMessage) ) ; ( % Work out which module supplies the code for the predicate. ThisModule \= PredModule, PredIsImported = no -> % This predicate is a specialized version of a pred from a % `.opt' file. DefiningModule = ThisModule, MaybeDeclaringModule = yes(PredModule) ; % The predicate was declared in the same module that it is % defined in DefiningModule = PredModule, MaybeDeclaringModule = no ), ( PredOrFunc = function, \+ ml_is_output_det_function(ModuleInfo, PredId, ProcId, _) -> NonOutputFunc = yes ; NonOutputFunc = no ), determinism_to_code_model(Detism, CodeModel), MLDS_PredLabel = pred(PredOrFunc, MaybeDeclaringModule, PredName, PredArity, CodeModel, NonOutputFunc) ), MLDS_Module = mercury_module_name_to_mlds(DefiningModule). ml_gen_new_label(Label, !Info) :- ml_gen_info_new_label(LabelNum, !Info), string__format("label_%d", [i(LabelNum)], Label). %-----------------------------------------------------------------------------% % % Code for dealing with variables % ml_gen_var_list(_Info, [], []). ml_gen_var_list(Info, [Var | Vars], [Lval | Lvals]) :- ml_gen_var(Info, Var, Lval), ml_gen_var_list(Info, Vars, Lvals). ml_gen_var(Info, Var, Lval) :- % First check the var_lvals override mapping; if an lval has been set % for this variable, use it. ml_gen_info_get_var_lvals(Info, VarLvals), ( map__search(VarLvals, Var, VarLval) -> Lval = VarLval ; % Otherwise just look up the variable's type and generate an lval % for it using the ordinary algorithm. ml_variable_type(Info, Var, Type), ml_gen_var_with_type(Info, Var, Type, Lval) ). ml_gen_var_with_type(Info, Var, Type, Lval) :- ml_gen_info_get_module_info(Info, ModuleInfo), ( is_dummy_argument_type(ModuleInfo, Type) -> % The variable won't have been declared, so we need to generate % a dummy lval for this variable. mercury_private_builtin_module(PrivateBuiltin), MLDS_Module = mercury_module_name_to_mlds(PrivateBuiltin), ml_gen_type(Info, Type, MLDS_Type), Lval = var(qual(MLDS_Module, module_qual, var_name("dummy_var", no)), MLDS_Type) ; ml_gen_info_get_varset(Info, VarSet), VarName = ml_gen_var_name(VarSet, Var), ml_gen_type(Info, Type, MLDS_Type), ml_gen_var_lval(Info, VarName, MLDS_Type, VarLval), % Output variables may be passed by reference... ml_gen_info_get_byref_output_vars(Info, OutputVars), ( list__member(Var, OutputVars) -> Lval = mem_ref(lval(VarLval), MLDS_Type) ; Lval = VarLval ) ). ml_variable_types(_Info, [], []). ml_variable_types(Info, [Var | Vars], [Type | Types]) :- ml_variable_type(Info, Var, Type), ml_variable_types(Info, Vars, Types). ml_variable_type(Info, Var, Type) :- ml_gen_info_get_var_types(Info, VarTypes), map__lookup(VarTypes, Var, Type). ml_gen_var_names(VarSet, Vars) = list__map(ml_gen_var_name(VarSet), Vars). ml_gen_var_name(VarSet, Var) = UniqueVarName :- varset__lookup_name(VarSet, Var, VarName), term__var_to_int(Var, VarNumber), UniqueVarName = mlds__var_name(VarName, yes(VarNumber)). ml_format_reserved_object_name(CtorName, CtorArity) = ReservedObjName :- % We add the "obj_" prefix to avoid any potential name clashes. Name = string__format("obj_%s_%d", [s(CtorName), i(CtorArity)]), ReservedObjName = var_name(Name, no). ml_format_static_const_name(Info, BaseName, SequenceNum, ConstName) :- % To ensure that the names are unique, we qualify them with the pred_id % and proc_id numbers, as well as a sequence number. This is needed to % allow ml_elim_nested.m to hoist such constants out to top level. ml_gen_info_get_pred_id(Info, PredId), ml_gen_info_get_proc_id(Info, ProcId), pred_id_to_int(PredId, PredIdNum), proc_id_to_int(ProcId, ProcIdNum), ConstName = mlds__var_name( string__format("const_%d_%d_%d_%s", [i(PredIdNum), i(ProcIdNum), i(SequenceNum), s(BaseName)]), no). ml_gen_var_lval(Info, VarName, VarType, QualifiedVarLval) :- ml_gen_info_get_module_name(Info, ModuleName), MLDS_Module = mercury_module_name_to_mlds(ModuleName), QualifiedVarLval = var(qual(MLDS_Module, module_qual, VarName), VarType). ml_gen_var_decl(VarName, Type, Context, Defn, !Info) :- ml_gen_info_get_module_info(!.Info, ModuleInfo), ml_gen_maybe_gc_trace_code(VarName, Type, Context, GC_TraceCode, !Info), Defn = ml_gen_mlds_var_decl(var(VarName), mercury_type_to_mlds_type(ModuleInfo, Type), GC_TraceCode, mlds__make_context(Context)). ml_gen_mlds_var_decl(DataName, MLDS_Type, GC_TraceCode, Context) = ml_gen_mlds_var_decl(DataName, MLDS_Type, no_initializer, GC_TraceCode, Context). ml_gen_mlds_var_decl(DataName, MLDS_Type, Initializer, GC_TraceCode, Context) = MLDS_Defn :- Name = data(DataName), Defn = data(MLDS_Type, Initializer, GC_TraceCode), DeclFlags = ml_gen_local_var_decl_flags, MLDS_Defn = mlds__defn(Name, Context, DeclFlags, Defn). ml_gen_static_const_defn(ConstName, ConstType, Access, Initializer, Context) = MLDS_Defn :- Name = data(var(ConstName)), % The GC never needs to trace static constants, % because they can never point into the heap % (only to other static constants). GC_TraceCode = no, Defn = data(ConstType, Initializer, GC_TraceCode), DeclFlags = mlds__set_access(ml_static_const_decl_flags, Access), MLDS_Context = mlds__make_context(Context), MLDS_Defn = mlds__defn(Name, MLDS_Context, DeclFlags, Defn). ml_gen_public_field_decl_flags = DeclFlags :- Access = public, PerInstance = per_instance, Virtuality = non_virtual, Finality = overridable, Constness = modifiable, Abstractness = concrete, DeclFlags = init_decl_flags(Access, PerInstance, Virtuality, Finality, Constness, Abstractness). ml_gen_local_var_decl_flags = DeclFlags :- Access = local, PerInstance = per_instance, Virtuality = non_virtual, Finality = overridable, Constness = modifiable, Abstractness = concrete, DeclFlags = init_decl_flags(Access, PerInstance, Virtuality, Finality, Constness, Abstractness). ml_static_const_decl_flags = DeclFlags :- % Note that rtti_decl_flags, in rtti_to_mlds.m, % must be the same as this apart from the access. Access = local, PerInstance = one_copy, Virtuality = non_virtual, Finality = final, Constness = const, Abstractness = concrete, DeclFlags = init_decl_flags(Access, PerInstance, Virtuality, Finality, Constness, Abstractness). ml_var_name_to_string(var_name(Var, yes(Num))) = string__format("%s_%d", [s(Var), i(Num)]). ml_var_name_to_string(var_name(Var, no)) = Var. %-----------------------------------------------------------------------------% % % Code for dealing with fields % % Given the user-specified field name, if any, and the argument number % (starting from one), generate an MLDS field name. % ml_gen_field_name(MaybeFieldName, ArgNum) = FieldName :- % If the programmer specified a field name, we use that, % otherwise we just use `F' followed by the field number. ( MaybeFieldName = yes(QualifiedFieldName), unqualify_name(QualifiedFieldName, FieldName) ; MaybeFieldName = no, FieldName = string__format("F%d", [i(ArgNum)]) ). % Succeed iff the specified type must be boxed when used as a field. % For the MLDS->C and MLDS->asm back-ends, we need to box types that are % not word-sized, because the code for `arg' etc. in std_util.m rely % on all arguments being word-sized. % XXX Currently we box such types even for the other MLDS based back-ends % that don't need it, e.g. the .NET and Java back-ends. This routine should % be modified to check the target. % ml_must_box_field_type(Type, ModuleInfo) :- classify_type(ModuleInfo, Type) = Category, ml_must_box_field_type_category(Category) = yes. :- func ml_must_box_field_type_category(type_category) = bool. ml_must_box_field_type_category(type_cat_int) = no. ml_must_box_field_type_category(type_cat_char) = yes. ml_must_box_field_type_category(type_cat_string) = no. ml_must_box_field_type_category(type_cat_float) = yes. ml_must_box_field_type_category(type_cat_higher_order) = no. ml_must_box_field_type_category(type_cat_tuple) = no. ml_must_box_field_type_category(type_cat_enum) = no. ml_must_box_field_type_category(type_cat_dummy) = no. ml_must_box_field_type_category(type_cat_variable) = no. ml_must_box_field_type_category(type_cat_type_info) = no. ml_must_box_field_type_category(type_cat_type_ctor_info) = no. ml_must_box_field_type_category(type_cat_typeclass_info) = no. ml_must_box_field_type_category(type_cat_base_typeclass_info) = no. ml_must_box_field_type_category(type_cat_void) = no. ml_must_box_field_type_category(type_cat_user_ctor) = no. %-----------------------------------------------------------------------------% % % Code for handling success and failure % ml_gen_success(model_det, _, Statements, !Info) :- % % det succeed: % % ===> % /* just fall through */ % Statements = []. ml_gen_success(model_semi, Context, [SetSuccessTrue], !Info) :- % % semidet succeed: % % ===> % succeeded = MR_TRUE; % ml_gen_set_success(!.Info, const(true), Context, SetSuccessTrue). ml_gen_success(model_non, Context, [CallCont], !Info) :- % % nondet succeed: % % ===> % SUCCEED() % ml_gen_call_current_success_cont(Context, CallCont, !Info). ml_gen_failure(model_det, _, _, !Info) :- unexpected(this_file, "ml_gen_failure: `fail' has determinism `det'"). ml_gen_failure(model_semi, Context, [SetSuccessFalse], !Info) :- % % semidet fail: % % ===> % succeeded = MR_FALSE; % ml_gen_set_success(!.Info, const(false), Context, SetSuccessFalse). ml_gen_failure(model_non, _, Statements, !Info) :- % % nondet fail: % % ===> % /* just fall through */ % Statements = []. %-----------------------------------------------------------------------------% ml_gen_succeeded_var_decl(Context) = ml_gen_mlds_var_decl(var(var_name("succeeded", no)), mlds__native_bool_type, no, Context). ml_success_lval(Info, SucceededLval) :- ml_gen_var_lval(Info, var_name("succeeded", no), mlds__native_bool_type, SucceededLval). ml_gen_test_success(Info, SucceededRval) :- ml_success_lval(Info, SucceededLval), SucceededRval = lval(SucceededLval). ml_gen_set_success(Info, Value, Context, Statement) :- ml_success_lval(Info, Succeeded), Statement = ml_gen_assign(Succeeded, Value, Context). %-----------------------------------------------------------------------------% % Generate the name for the specified `cond_' variable. % :- func ml_gen_cond_var_name(cond_seq) = mlds__var_name. ml_gen_cond_var_name(CondVar) = mlds__var_name(string__append("cond_", string__int_to_string(CondVar)), no). ml_gen_cond_var_decl(CondVar, Context) = ml_gen_mlds_var_decl(var(ml_gen_cond_var_name(CondVar)), mlds__native_bool_type, no, Context). ml_cond_var_lval(Info, CondVar, CondVarLval) :- ml_gen_var_lval(Info, ml_gen_cond_var_name(CondVar), mlds__native_bool_type, CondVarLval). ml_gen_test_cond_var(Info, CondVar, CondVarRval) :- ml_cond_var_lval(Info, CondVar, CondVarLval), CondVarRval = lval(CondVarLval). ml_gen_set_cond_var(Info, CondVar, Value, Context, Statement) :- ml_cond_var_lval(Info, CondVar, CondVarLval), Statement = ml_gen_assign(CondVarLval, Value, Context). %-----------------------------------------------------------------------------% ml_initial_cont(Info, OutputVarLvals0, OutputVarTypes0, Cont) :- ml_gen_info_get_module_info(Info, ModuleInfo), ml_skip_dummy_argument_types(OutputVarTypes0, OutputVarLvals0, ModuleInfo, OutputVarTypes, OutputVarLvals), list__map(ml_gen_type(Info), OutputVarTypes, MLDS_OutputVarTypes), % We expect OutputVarlvals0 and OutputVarTypes0 to be empty if % `--nondet-copy-out' is not enabled. ml_gen_var_lval(Info, mlds__var_name("cont", no), mlds__cont_type(MLDS_OutputVarTypes), ContLval), ml_gen_var_lval(Info, mlds__var_name("cont_env_ptr", no), mlds__generic_env_ptr_type, ContEnvLval), Cont = success_cont(lval(ContLval), lval(ContEnvLval), MLDS_OutputVarTypes, OutputVarLvals). :- pred ml_skip_dummy_argument_types(list(mer_type)::in, list(T)::in, module_info::in, list(mer_type)::out, list(T)::out) is det. ml_skip_dummy_argument_types([], [], _, [], []). ml_skip_dummy_argument_types([Type | Types0], [Var | Vars0], ModuleInfo, Types, Vars) :- ml_skip_dummy_argument_types(Types0, Vars0, ModuleInfo, Types1, Vars1), ( is_dummy_argument_type(ModuleInfo, Type) -> Types = Types1, Vars = Vars1 ; Types = [Type | Types1], Vars = [Var | Vars1] ). ml_skip_dummy_argument_types([_ | _], [], _, _, _) :- unexpected(this_file, "ml_skip_dummy_argument_types: length mismatch"). ml_skip_dummy_argument_types([], [_ | _], _, _, _) :- unexpected(this_file, "ml_skip_dummy_argument_types: length mismatch"). ml_gen_call_current_success_cont(Context, Statement, !Info) :- ml_gen_info_current_success_cont(!.Info, SuccCont), SuccCont = success_cont(FuncRval, EnvPtrRval, ArgTypes0, ArgLvals0), ArgRvals0 = list__map(func(Lval) = lval(Lval), ArgLvals0), ml_gen_info_use_gcc_nested_functions(!.Info, UseNestedFuncs), ( UseNestedFuncs = yes, ArgTypes = ArgTypes0, ArgRvals = ArgRvals0 ; UseNestedFuncs = no, ArgTypes = ArgTypes0 ++ [mlds__generic_env_ptr_type], ArgRvals =ArgRvals0 ++ [EnvPtrRval] ), RetTypes = [], Signature = mlds__func_signature(ArgTypes, RetTypes), ObjectRval = no, RetLvals = [], CallKind = ordinary_call, Stmt = call(Signature, FuncRval, ObjectRval, ArgRvals, RetLvals, CallKind), Statement = statement(Stmt, mlds__make_context(Context)). ml_gen_call_current_success_cont_indirectly(Context, Statement, !Info) :- % XXX this code is quite similar to some of the existing code % for calling continuations when doing copy-in/copy-out. % Sharing code should be investigated. % We generate a call to the success continuation, just as usual. ml_gen_info_current_success_cont(!.Info, SuccCont), SuccCont = success_cont(ContinuationFuncRval, EnvPtrRval, ArgTypes0, ArgLvals0), ArgRvals0 = list__map(func(Lval) = lval(Lval), ArgLvals0), ml_gen_info_use_gcc_nested_functions(!.Info, UseNestedFuncs), ( UseNestedFuncs = yes, ArgTypes = ArgTypes0, ArgRvals = ArgRvals0 ; UseNestedFuncs = no, ArgTypes = ArgTypes0 ++ [mlds__generic_env_ptr_type], ArgRvals = ArgRvals0 ++ [EnvPtrRval] ), RetTypes = [], Signature = mlds__func_signature(ArgTypes, RetTypes), ObjectRval = no, RetLvals = [], CallKind = ordinary_call, MLDS_Context = mlds__make_context(Context), ml_gen_info_get_module_name(!.Info, PredModule), MLDS_Module = mercury_module_name_to_mlds(PredModule), % We generate a nested function that does the real call to the % continuation. % % All we do is change the call rvals to be the input variables, and the % func rval to be the input variable for the continuation. % % Note that ml_gen_cont_params does not fill in the gc_trace_code % for the parameters. This is OK, because the parameters will not be used % again after the call. (Also currently this is only used for IL, for which % GC is the .NET CLR implementation's problem, not ours.) % ml_gen_cont_params(ArgTypes0, InnerFuncParams0, !Info), InnerFuncParams0 = func_params(InnerArgs0, Rets), InnerArgRvals = list__map( (func(mlds__argument(Data, Type, _GC) ) = lval(var(qual(MLDS_Module, module_qual, VarName), Type)) :- ( Data = data(var(VarName0)) -> VarName = VarName0 ; unexpected(this_file, "expected variable name in continuation parameters") ) ), InnerArgs0), InnerFuncArgType = mlds__cont_type(ArgTypes0), PassedContVarName = mlds__var_name("passed_cont", no), % The passed_cont variable always points to code, not to heap, % so the GC never needs to trace it. PassedContGCTraceCode = no, PassedContArg = mlds__argument(data(var(PassedContVarName)), InnerFuncArgType, PassedContGCTraceCode), InnerFuncRval = lval(var(qual(MLDS_Module, module_qual, PassedContVarName), InnerFuncArgType)), InnerFuncParams = func_params([PassedContArg | InnerArgs0], Rets), InnerStmt = call(Signature, InnerFuncRval, ObjectRval, InnerArgRvals, RetLvals, CallKind), InnerStatement = statement(InnerStmt, MLDS_Context), ml_gen_label_func(!.Info, 1, InnerFuncParams, Context, InnerStatement, Defn), ProxySignature = mlds__func_signature([InnerFuncArgType | ArgTypes], RetTypes), ProxyArgRvals = [ContinuationFuncRval | ArgRvals], ( Defn = mlds__defn(function(PredLabel, ProcId, yes(SeqNum), _), _, _, function(_, _, defined_here(_), _)) -> % We call the proxy function. QualProcLabel = qual(MLDS_Module, module_qual, PredLabel - ProcId), ProxyFuncRval = const(code_addr_const( internal(QualProcLabel, SeqNum, ProxySignature))), % Put it inside a block where we call it. Stmt = call(ProxySignature, ProxyFuncRval, ObjectRval, ProxyArgRvals, RetLvals, CallKind), Statement = statement( block([Defn], [statement(Stmt, MLDS_Context)]), MLDS_Context) ; unexpected(this_file, "success continuation generated was not a function") ). %-----------------------------------------------------------------------------% % % Routines for dealing with the environment pointer % used for nested functions. % ml_get_env_ptr(Info, lval(EnvPtrLval)) :- ml_gen_var_lval(Info, mlds__var_name("env_ptr", no), mlds__unknown_type, EnvPtrLval). ml_declare_env_ptr_arg(mlds__argument(Name, Type, GC_TraceCode)) :- Name = data(var(mlds__var_name("env_ptr_arg", no))), Type = mlds__generic_env_ptr_type, % The env_ptr_arg always points to the stack, since continuation % environments are always allocated on the stack (unless % put_nondet_env_on_heap is true, which won't be the case when % doing our own GC -- this is enforced in handle_options.m). % So the GC doesn't need to trace it. GC_TraceCode = no. %-----------------------------------------------------------------------------% % % Code to handle accurate GC % ml_gen_maybe_gc_trace_code(VarName, Type, Context, Maybe_GC_TraceCode, !Info) :- ml_gen_maybe_gc_trace_code(VarName, Type, Type, Context, Maybe_GC_TraceCode, !Info). ml_gen_maybe_gc_trace_code(VarName, DeclType, ActualType, Context, Maybe_GC_TraceCode, !Info) :- HowToGetTypeInfo = construct_from_type(ActualType), ml_gen_maybe_gc_trace_code_2(VarName, DeclType, HowToGetTypeInfo, Context, Maybe_GC_TraceCode, !Info). ml_gen_maybe_gc_trace_code_with_typeinfo(VarName, DeclType, TypeInfoRval, Context, Maybe_GC_TraceCode, !Info) :- HowToGetTypeInfo = already_provided(TypeInfoRval), ml_gen_maybe_gc_trace_code_2(VarName, DeclType, HowToGetTypeInfo, Context, Maybe_GC_TraceCode, !Info). :- type how_to_get_type_info ---> construct_from_type(mer_type) ; already_provided(mlds_rval). :- pred ml_gen_maybe_gc_trace_code_2(var_name::in, mer_type::in, how_to_get_type_info::in, prog_context::in, maybe(statement)::out, ml_gen_info::in, ml_gen_info::out) is det. ml_gen_maybe_gc_trace_code_2(VarName, DeclType, HowToGetTypeInfo, Context, Maybe_GC_TraceCode, !Info) :- ml_gen_info_get_module_info(!.Info, ModuleInfo), module_info_get_globals(ModuleInfo, Globals), globals__get_gc_method(Globals, GC), ( GC = accurate, MLDS_DeclType = mercury_type_to_mlds_type(ModuleInfo, DeclType), ml_type_might_contain_pointers(MLDS_DeclType) = yes, % don't generate GC tracing code in no_type_info_builtins ml_gen_info_get_pred_id(!.Info, PredId), predicate_id(ModuleInfo, PredId, PredModule, PredName, PredArity), \+ no_type_info_builtin(PredModule, PredName, PredArity) -> ( HowToGetTypeInfo = construct_from_type(ActualType0), % We need to handle type_info/1 and typeclass_info/1 % types specially, to avoid infinite recursion here... ( trace_type_info_type(ActualType0, ActualType1) -> ActualType = ActualType1 ; ActualType = ActualType0 ), ml_gen_gc_trace_code(VarName, DeclType, ActualType, Context, GC_TraceCode, !Info) ; HowToGetTypeInfo = already_provided(TypeInfoRval), ml_gen_trace_var(!.Info, VarName, DeclType, TypeInfoRval, Context, GC_TraceCode) ), Maybe_GC_TraceCode = yes(GC_TraceCode) ; Maybe_GC_TraceCode = no ). % Return `yes' if the type needs to be traced by the accurate garbage % collector, i.e. if it might contain pointers. % % Any type for which we return `yes' here must be word-sized, because % we will call private_builtin__gc_trace with its address, and that % procedure assumes that its argument is an `MR_Word *'. % % For floats, we can (and must) return `no' even though they might % get boxed in some circumstances, because if they are boxed then they will % be represented as mlds__generic_type. % % Note that with --gcc-nested-functions, cont_type will be a function % pointer that may point to a trampoline function, which might in fact % contain pointers. But the pointers will only be pointers to code and % pointers to the stack, not pointers to the heap, so we don't need to % trace them for accurate GC. Hence we can return `no' here for % mlds__cont_type. % % Similarly, the only pointers in type_ctor_infos and base_typeclass_infos % are to static code and/or static data, which do not need to be traced. % :- func ml_type_might_contain_pointers(mlds_type) = bool. ml_type_might_contain_pointers(mercury_type(_Type, TypeCategory, _)) = ml_type_category_might_contain_pointers(TypeCategory). ml_type_might_contain_pointers(mercury_array_type(_)) = yes. ml_type_might_contain_pointers(mlds__native_int_type) = no. ml_type_might_contain_pointers(mlds__native_float_type) = no. ml_type_might_contain_pointers(mlds__native_bool_type) = no. ml_type_might_contain_pointers(mlds__native_char_type) = no. ml_type_might_contain_pointers(mlds__foreign_type(_)) = no. % We assume that foreign types are not allowed to contain pointers % to the Mercury heap. XXX is this requirement too strict? ml_type_might_contain_pointers(mlds__class_type(_, _, Category)) = (if Category = mlds__enum then no else yes). ml_type_might_contain_pointers(mlds__ptr_type(_)) = yes. ml_type_might_contain_pointers(mlds__array_type(_)) = yes. ml_type_might_contain_pointers(mlds__func_type(_)) = no. ml_type_might_contain_pointers(mlds__generic_type) = yes. ml_type_might_contain_pointers(mlds__generic_env_ptr_type) = yes. ml_type_might_contain_pointers(mlds__type_info_type) = yes. ml_type_might_contain_pointers(mlds__pseudo_type_info_type) = yes. ml_type_might_contain_pointers(mlds__cont_type(_)) = no. ml_type_might_contain_pointers(mlds__commit_type) = no. ml_type_might_contain_pointers(mlds__rtti_type(_)) = yes. ml_type_might_contain_pointers(mlds__unknown_type) = yes. :- func ml_type_category_might_contain_pointers(type_category) = bool. ml_type_category_might_contain_pointers(type_cat_int) = no. ml_type_category_might_contain_pointers(type_cat_char) = no. ml_type_category_might_contain_pointers(type_cat_string) = yes. ml_type_category_might_contain_pointers(type_cat_float) = no. ml_type_category_might_contain_pointers(type_cat_void) = no. ml_type_category_might_contain_pointers(type_cat_type_info) = yes. ml_type_category_might_contain_pointers(type_cat_type_ctor_info) = no. ml_type_category_might_contain_pointers(type_cat_typeclass_info) = yes. ml_type_category_might_contain_pointers(type_cat_base_typeclass_info) = no. ml_type_category_might_contain_pointers(type_cat_higher_order) = yes. ml_type_category_might_contain_pointers(type_cat_tuple) = yes. ml_type_category_might_contain_pointers(type_cat_enum) = no. ml_type_category_might_contain_pointers(type_cat_dummy) = no. ml_type_category_might_contain_pointers(type_cat_variable) = yes. ml_type_category_might_contain_pointers(type_cat_user_ctor) = yes. % trace_type_info_type(Type, RealType): % % Succeed iff Type is a type_info-related type which needs to be copied % as if it were some other type, binding RealType to that other type. % :- pred trace_type_info_type(mer_type::in, mer_type::out) is semidet. trace_type_info_type(Type, RealType) :- Type = defined(TypeName, _, _), TypeName = qualified(PrivateBuiltin, Name), mercury_private_builtin_module(PrivateBuiltin), ( Name = "type_info", RealType = sample_type_info_type ; Name = "type_ctor_info", RealType = c_pointer_type ; Name = "typeclass_info", RealType = sample_typeclass_info_type ; Name = "base_typeclass_info", RealType = c_pointer_type ; Name = "zero_type_info", RealType = sample_type_info_type ; Name = "zero_type_ctor_info", RealType = c_pointer_type ; Name = "zero_typeclass_info", RealType = sample_typeclass_info_type ; Name = "zero_base_typeclass_info", RealType = c_pointer_type ). % Generate code to call to `private_builtin__gc_trace' % to trace the specified variable. % :- pred ml_gen_gc_trace_code(var_name::in, mer_type::in, mer_type::in, prog_context::in, statement::out, ml_gen_info::in, ml_gen_info::out) is det. ml_gen_gc_trace_code(VarName, DeclType, ActualType, Context, GC_TraceCode, !Info) :- % Build HLDS code to construct the type_info for this type. ml_gen_make_type_info_var(ActualType, Context, TypeInfoVar, HLDS_TypeInfoGoals, !Info), NonLocalsList = list__map( (func(_G - GI) = NL :- goal_info_get_nonlocals(GI, NL)), HLDS_TypeInfoGoals), NonLocals = set__union_list(NonLocalsList), instmap_delta_from_assoc_list([TypeInfoVar - ground(shared, none)], InstMapDelta), goal_info_init(NonLocals, InstMapDelta, det, purity_impure, GoalInfo), conj_list_to_goal(HLDS_TypeInfoGoals, GoalInfo, Conj), % Convert this HLDS code to MLDS. ml_gen_goal(model_det, Conj, MLDS_TypeInfoStatement0, !Info), % Replace all heap allocation (new_object instructions) with stack % allocation (local variable declarations) in the code to construct % type_infos. This is safe because those type_infos will only be used % in the immediately following call to gc_trace/1. ml_gen_info_get_module_info(!.Info, ModuleInfo), module_info_get_name(ModuleInfo, ModuleName), fixup_newobj(MLDS_TypeInfoStatement0, mercury_module_name_to_mlds(ModuleName), MLDS_TypeInfoStatement, MLDS_NewobjLocals), % Build MLDS code to trace the variable. ml_gen_var(!.Info, TypeInfoVar, TypeInfoLval), ml_gen_trace_var(!.Info, VarName, DeclType, lval(TypeInfoLval), Context, MLDS_TraceStatement), % Generate declarations for any type_info variables used. % % Note: this will generate local declarations even for type_info variables % which are not local to this goal. However, fortunately ml_elim_nested.m % will transform the GC code to use the original definitions, which will % get put in the GC frame, rather than these declarations, which will get % ignored. % XXX This is not a very robust way of doing things... ml_gen_info_get_varset(!.Info, VarSet), ml_gen_info_get_var_types(!.Info, VarTypes), MLDS_Context = mlds__make_context(Context), GenLocalVarDecl = (func(Var) = MLDS_Defn :- LocalVarName = ml_gen_var_name(VarSet, Var), map__lookup(VarTypes, Var, LocalVarType), MLDS_Defn = ml_gen_mlds_var_decl(var(LocalVarName), mercury_type_to_mlds_type(ModuleInfo, LocalVarType), no, MLDS_Context) ), set__to_sorted_list(NonLocals, NonLocalVarList), MLDS_NonLocalVarDecls = list__map(GenLocalVarDecl, NonLocalVarList), % Combine the MLDS code fragments together. GC_TraceCode = ml_gen_block(MLDS_NewobjLocals ++ MLDS_NonLocalVarDecls, [MLDS_TypeInfoStatement] ++ [MLDS_TraceStatement], Context). % ml_gen_trace_var(VarName, DeclType, TypeInfo, Context, Code): % Generate a call to `private_builtin__gc_trace' % for the specified variable, given the variable's name, type, % and the already-constructed type_info for that type. % :- pred ml_gen_trace_var(ml_gen_info::in, var_name::in, mer_type::in, mlds_rval::in, prog_context::in, statement::out) is det. ml_gen_trace_var(Info, VarName, Type, TypeInfoRval, Context, TraceStatement) :- % Generate the lval for Var. ml_gen_info_get_module_info(Info, ModuleInfo), MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type), ml_gen_var_lval(Info, VarName, MLDS_Type, VarLval), % Generate the address of `private_builtin__gc_trace/1#0'. PredName = "gc_trace", PredOrigArity = 1, Pred = pred((predicate), no, PredName, PredOrigArity, model_det, no), ProcId = hlds_pred__initial_proc_id, mercury_private_builtin_module(PredModule), MLDS_Module = mercury_module_name_to_mlds(PredModule), Proc = qual(MLDS_Module, module_qual, Pred - ProcId), CPointerType = mercury_type(c_pointer_type, type_cat_user_ctor, non_foreign_type(c_pointer_type)), ArgTypes = [mlds__pseudo_type_info_type, CPointerType], Signature = mlds__func_signature(ArgTypes, []), FuncAddr = const(code_addr_const(proc(Proc, Signature))), % Generate the call % `private_builtin__gc_trace(TypeInfo, (MR_C_Pointer) &Var);'. CastVarAddr = unop(cast(CPointerType), mem_addr(VarLval)), TraceStatement = statement( call(Signature, FuncAddr, no, [TypeInfoRval, CastVarAddr], [], ordinary_call ), mlds__make_context(Context)). % Generate HLDS code to construct the type_info for this type. % :- pred ml_gen_make_type_info_var(mer_type::in, prog_context::in, prog_var::out, hlds_goals::out, ml_gen_info::in, ml_gen_info::out) is det. ml_gen_make_type_info_var(Type, Context, TypeInfoVar, TypeInfoGoals, !Info) :- ModuleInfo0 = !.Info ^ module_info, PredId = !.Info ^ pred_id, ProcId = !.Info ^ proc_id, module_info_pred_proc_info(ModuleInfo0, PredId, ProcId, PredInfo0, ProcInfo0), % Call polymorphism.m to generate the HLDS code to create the type_infos. create_poly_info(ModuleInfo0, PredInfo0, ProcInfo0, PolyInfo0), polymorphism__make_type_info_var(Type, Context, TypeInfoVar, TypeInfoGoals, PolyInfo0, PolyInfo), poly_info_extract(PolyInfo, PredInfo0, PredInfo, ProcInfo0, ProcInfo, ModuleInfo1), % Save the new information back in the ml_gen_info. module_info_set_pred_proc_info(PredId, ProcId, PredInfo, ProcInfo, ModuleInfo1, ModuleInfo), proc_info_varset(ProcInfo, VarSet), proc_info_vartypes(ProcInfo, VarTypes), !:Info = !.Info ^ module_info := ModuleInfo, !:Info = !.Info ^ varset := VarSet, !:Info = !.Info ^ var_types := VarTypes. %-----------------------------------------------------------------------------% :- type fixup_newobj_info ---> fixup_newobj_info( module_name :: mlds_module_name, % the current module context :: mlds__context, % the current context locals :: mlds__defns, % the local variable declarations % accumulated so far next_id :: counter % a counter used to allocate % variable names ). % Replace all heap allocation (new_object instructions) with stack % allocation (local variable declarations) in the specified statement, % returning the local variable declarations needed for the stack % allocation. % :- pred fixup_newobj(statement::in, mlds_module_name::in, statement::out, mlds__defns::out) is det. fixup_newobj(Statement0, ModuleName, Statement, Defns) :- Statement0 = statement(Stmt0, Context), Info0 = fixup_newobj_info(ModuleName, Context, [], counter__init(0)), fixup_newobj_in_stmt(Stmt0, Stmt, Info0, Info), Statement = statement(Stmt, Context), Defns = Info ^ locals. :- pred fixup_newobj_in_statement(statement::in, statement::out, fixup_newobj_info::in, fixup_newobj_info::out) is det. fixup_newobj_in_statement(Statement0, Statement, !Info) :- Statement0 = statement(Stmt0, Context), !:Info = !.Info ^ context := Context, fixup_newobj_in_stmt(Stmt0, Stmt, !Info), Statement = statement(Stmt, Context). :- pred fixup_newobj_in_stmt(mlds__stmt::in, mlds__stmt::out, fixup_newobj_info::in, fixup_newobj_info::out) is det. fixup_newobj_in_stmt(Stmt0, Stmt, !Fixup) :- ( Stmt0 = block(Defns, Statements0), list__map_foldl(fixup_newobj_in_statement, Statements0, Statements, !Fixup), Stmt = block(Defns, Statements) ; Stmt0 = while(Rval, Statement0, Once), fixup_newobj_in_statement(Statement0, Statement, !Fixup), Stmt = while(Rval, Statement, Once) ; Stmt0 = if_then_else(Cond, Then0, MaybeElse0), fixup_newobj_in_statement(Then0, Then, !Fixup), fixup_newobj_in_maybe_statement(MaybeElse0, MaybeElse, !Fixup), Stmt = if_then_else(Cond, Then, MaybeElse) ; Stmt0 = switch(Type, Val, Range, Cases0, Default0), list__map_foldl(fixup_newobj_in_case, Cases0, Cases, !Fixup), fixup_newobj_in_default(Default0, Default, !Fixup), Stmt = switch(Type, Val, Range, Cases, Default) ; Stmt0 = label(_), Stmt = Stmt0 ; Stmt0 = goto(_), Stmt = Stmt0 ; Stmt0 = computed_goto(Rval, Labels), Stmt = computed_goto(Rval, Labels) ; Stmt0 = call(_Sig, _Func, _Obj, _Args, _RetLvals, _TailCall), Stmt = Stmt0 ; Stmt0 = return(_Rvals), Stmt = Stmt0 ; Stmt0 = do_commit(_Ref), Stmt = Stmt0 ; Stmt0 = try_commit(Ref, Statement0, Handler0), fixup_newobj_in_statement(Statement0, Statement, !Fixup), fixup_newobj_in_statement(Handler0, Handler, !Fixup), Stmt = try_commit(Ref, Statement, Handler) ; Stmt0 = atomic(AtomicStmt0), fixup_newobj_in_atomic_statement(AtomicStmt0, Stmt, !Fixup) ). :- pred fixup_newobj_in_case(mlds__switch_case::in, mlds__switch_case::out, fixup_newobj_info::in, fixup_newobj_info::out) is det. fixup_newobj_in_case(Conds - Statement0, Conds - Statement, !Fixup) :- fixup_newobj_in_statement(Statement0, Statement, !Fixup). :- pred fixup_newobj_in_maybe_statement(maybe(statement)::in, maybe(statement)::out, fixup_newobj_info::in, fixup_newobj_info::out) is det. fixup_newobj_in_maybe_statement(no, no, !Fixup). fixup_newobj_in_maybe_statement(yes(Statement0), yes(Statement), !Fixup) :- fixup_newobj_in_statement(Statement0, Statement, !Fixup). :- pred fixup_newobj_in_default(mlds__switch_default::in, mlds__switch_default::out, fixup_newobj_info::in, fixup_newobj_info::out) is det. fixup_newobj_in_default(default_is_unreachable, default_is_unreachable, !Fixup). fixup_newobj_in_default(default_do_nothing, default_do_nothing, !Fixup). fixup_newobj_in_default(default_case(Statement0), default_case(Statement), !Fixup) :- fixup_newobj_in_statement(Statement0, Statement, !Fixup). :- pred fixup_newobj_in_atomic_statement(mlds__atomic_statement::in, mlds__stmt::out, fixup_newobj_info::in, fixup_newobj_info::out) is det. fixup_newobj_in_atomic_statement(AtomicStatement0, Stmt, !Fixup) :- ( AtomicStatement0 = new_object(Lval, MaybeTag, _HasSecTag, PointerType, _MaybeSizeInWordsRval, _MaybeCtorName, ArgRvals, _ArgTypes) -> % Generate the declaration of the new local variable. % % XXX Using array(generic_type) is wrong for --high-level-data. % % We need to specify an initializer to tell the C back-end what the % length of the array is. We initialize it with null pointers and then % later generate assignment statements to fill in the values properly % (see below). counter__allocate(Id, !.Fixup ^ next_id, NextId), VarName = var_name("new_obj", yes(Id)), VarType = mlds__array_type(mlds__generic_type), NullPointers = list__duplicate(list__length(ArgRvals), init_obj(const(mlds__null(mlds__generic_type)))), Initializer = init_array(NullPointers), % This is used for the type_infos allocated during tracing, % and we don't need to trace them. MaybeGCTraceCode = no, Context = !.Fixup ^ context, VarDecl = ml_gen_mlds_var_decl(var(VarName), VarType, Initializer, MaybeGCTraceCode, Context), !:Fixup = !.Fixup ^ next_id := NextId, !:Fixup= !.Fixup ^ locals := !.Fixup ^ locals ++ [VarDecl], % Generate code to initialize the variable. % % Note that we need to use assignment statements, rather than an % initializer, to initialize the local variable, because the % initialization code needs to occur at exactly the point where the % atomic_statement occurs, rather than at the local variable % declaration. VarLval = mlds__var(qual(!.Fixup ^ module_name, module_qual, VarName), VarType), PtrRval = mlds__unop(cast(PointerType), mem_addr(VarLval)), list__map_foldl( init_field_n(PointerType, PtrRval, Context), ArgRvals, ArgInitStatements, 0, _NumFields), % Generate code to assign the address of the new local variable % to the Lval. TaggedPtrRval = maybe_tag_rval(MaybeTag, PointerType, PtrRval), AssignStmt = atomic(assign(Lval, TaggedPtrRval)), AssignStatement = statement(AssignStmt, Context), Stmt = block([], ArgInitStatements ++ [AssignStatement]) ; Stmt = atomic(AtomicStatement0) ). :- pred init_field_n(mlds_type::in, mlds_rval::in, mlds__context::in, mlds_rval::in, statement::out, int::in, int::out) is det. init_field_n(PointerType, PointerRval, Context, ArgRval, Statement, FieldNum, FieldNum + 1) :- FieldId = offset(const(int_const(FieldNum))), % XXX FieldType is wrong for --high-level-data FieldType = mlds__generic_type, MaybeTag = yes(0), Field = field(MaybeTag, PointerRval, FieldId, FieldType, PointerType), AssignStmt = atomic(assign(Field, ArgRval)), Statement = statement(AssignStmt, Context). :- func maybe_tag_rval(maybe(mlds_tag), mlds_type, mlds_rval) = mlds_rval. maybe_tag_rval(no, _Type, Rval) = Rval. maybe_tag_rval(yes(Tag), Type, Rval) = unop(cast(Type), mkword(Tag, Rval)). %-----------------------------------------------------------------------------% % % The definition of the `ml_gen_info' ADT. % % The `ml_gen_info' type holds information used during MLDS code generation % for a given procedure. % % Only the `func_label', `commit_label', `cond_var', `conv_var', `const_num', % `var_lvals', `success_cont_stack', and `extra_defns' fields are mutable; % the others are set when the `ml_gen_info' is created and then never % modified. :- type ml_gen_info ---> ml_gen_info( % These fields remain constant for each procedure % (unless accurate GC is enabled, in which case the % varset and var_types may get updated if we create % fresh variables for type_info variables needed % for calls to private_builtin__gc_trace). module_info :: module_info, pred_id :: pred_id, proc_id :: proc_id, varset :: prog_varset, var_types :: vartypes, byref_output_vars :: list(prog_var), % output arguments that are passed by % reference value_output_vars :: list(prog_var), % output arguments that are returned % as values % These fields get updated as we traverse each procedure. func_label :: counter, commit_label :: counter, label :: counter, cond_var :: counter, conv_var :: counter, const_num :: counter, const_var_name_map :: map(prog_var, mlds__var_name), success_cont_stack :: stack(success_cont), % A partial mapping from vars to lvals, % used to override the normal lval % that we use for a variable. var_lvals :: map(prog_var, mlds_lval), % Definitions of functions or global % constants which should be inserted % before the definition of the function % for the current procedure. extra_defns :: mlds__defns ). ml_gen_info_init(ModuleInfo, PredId, ProcId) = Info :- module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _PredInfo, ProcInfo), proc_info_headvars(ProcInfo, HeadVars), proc_info_varset(ProcInfo, VarSet), proc_info_vartypes(ProcInfo, VarTypes), proc_info_argmodes(ProcInfo, HeadModes), ByRefOutputVars = select_output_vars(ModuleInfo, HeadVars, HeadModes, VarTypes), ValueOutputVars = [], % XXX This needs to start at 1 rather than 0 otherwise the % transformation for adding the shadow stack for accurate garbage % collection does not work properly and we will end up generating % two C functions with the same name. % % ( See ml_elim_nested.gen_gc_trace_func/8 for details). % counter__init(1, FuncLabelCounter), counter__init(0, CommitLabelCounter), counter__init(0, LabelCounter), counter__init(0, CondVarCounter), counter__init(0, ConvVarCounter), counter__init(0, ConstCounter), map__init(ConstNumMap), stack__init(SuccContStack), map__init(VarLvals), ExtraDefns = [], Info = ml_gen_info( ModuleInfo, PredId, ProcId, VarSet, VarTypes, ByRefOutputVars, ValueOutputVars, FuncLabelCounter, CommitLabelCounter, LabelCounter, CondVarCounter, ConvVarCounter, ConstCounter, ConstNumMap, SuccContStack, VarLvals, ExtraDefns ). ml_gen_info_get_module_info(Info, Info ^ module_info). ml_gen_info_get_module_name(Info, ModuleName) :- ml_gen_info_get_module_info(Info, ModuleInfo), module_info_get_name(ModuleInfo, ModuleName). ml_gen_info_get_pred_id(Info, Info ^ pred_id). ml_gen_info_get_proc_id(Info, Info ^ proc_id). ml_gen_info_get_varset(Info, Info ^ varset). ml_gen_info_get_var_types(Info, Info ^ var_types). ml_gen_info_get_byref_output_vars(Info, Info ^ byref_output_vars). ml_gen_info_get_value_output_vars(Info, Info ^ value_output_vars). ml_gen_info_set_byref_output_vars(OutputVars, Info, Info ^ byref_output_vars := OutputVars). ml_gen_info_set_value_output_vars(OutputVars, Info, Info ^ value_output_vars := OutputVars). ml_gen_info_use_gcc_nested_functions(Info, UseNestedFuncs) :- ml_gen_info_get_globals(Info, Globals), globals__lookup_bool_option(Globals, gcc_nested_functions, UseNestedFuncs). ml_gen_info_put_commit_in_own_func(Info, PutCommitInNestedFunc) :- ml_gen_info_get_globals(Info, Globals), globals__lookup_bool_option(Globals, put_commit_in_own_func, PutCommitInNestedFunc). ml_gen_info_get_globals(Info, Globals) :- ml_gen_info_get_module_info(Info, ModuleInfo), module_info_get_globals(ModuleInfo, Globals). ml_gen_info_new_label(Label, !Info) :- Counter0 = !.Info ^ label, counter__allocate(Label, Counter0, Counter), !:Info = !.Info ^ label := Counter. ml_gen_info_new_func_label(Label, !Info) :- Counter0 = !.Info ^ func_label, counter__allocate(Label, Counter0, Counter), !:Info = !.Info ^ func_label := Counter. ml_gen_info_bump_counters(!Info) :- FuncLabelCounter0 = !.Info ^ func_label, ConstNumCounter0 = !.Info ^ const_num, counter__allocate(FuncLabel, FuncLabelCounter0, _), counter__allocate(ConstNum, ConstNumCounter0, _), FuncLabelCounter = counter__init(FuncLabel + 10000), ConstNumCounter = counter__init(ConstNum + 10000), !:Info = !.Info ^ func_label := FuncLabelCounter, !:Info = !.Info ^ const_num := ConstNumCounter. ml_gen_info_new_commit_label(CommitLabel, !Info) :- Counter0 = !.Info ^ commit_label, counter__allocate(CommitLabel, Counter0, Counter), !:Info = !.Info ^ commit_label := Counter. ml_gen_info_new_cond_var(CondVar, !Info) :- Counter0 = !.Info ^ cond_var, counter__allocate(CondVar, Counter0, Counter), !:Info = !.Info ^ cond_var := Counter. ml_gen_info_new_conv_var(ConvVar, !Info) :- Counter0 = !.Info ^ conv_var, counter__allocate(ConvVar, Counter0, Counter), !:Info = !.Info ^ conv_var := Counter. ml_gen_info_new_const(ConstVar, !Info) :- Counter0 = !.Info ^ const_num, counter__allocate(ConstVar, Counter0, Counter), !:Info = !.Info ^ const_num := Counter. ml_gen_info_set_const_var_name(Var, Name, !Info) :- !:Info = !.Info ^ const_var_name_map := map__set(!.Info ^ const_var_name_map, Var, Name). ml_gen_info_lookup_const_var_name(Info, Var, Name) :- Name = map__lookup(Info ^ const_var_name_map, Var). ml_gen_info_search_const_var_name(Info, Var, Name) :- Name = map__search(Info ^ const_var_name_map, Var). ml_gen_info_push_success_cont(SuccCont, !Info) :- !:Info = !.Info ^ success_cont_stack := stack__push(!.Info ^ success_cont_stack, SuccCont). ml_gen_info_pop_success_cont(!Info) :- Stack0 = !.Info ^ success_cont_stack, stack__pop_det(Stack0, _SuccCont, Stack), !:Info = !.Info ^ success_cont_stack := Stack. ml_gen_info_current_success_cont(Info, SuccCont) :- stack__top_det(Info ^ success_cont_stack, SuccCont). ml_gen_info_set_var_lval(Var, Lval, !Info) :- !:Info = !.Info ^ var_lvals := map__set(!.Info ^ var_lvals, Var, Lval). ml_gen_info_get_var_lvals(Info, Info ^ var_lvals). ml_gen_info_set_var_lvals(VarLvals, !Info) :- !:Info = !.Info ^ var_lvals := VarLvals. ml_gen_info_add_extra_defn(ExtraDefn, !Info) :- !:Info = !.Info ^ extra_defns := [ExtraDefn | !.Info ^ extra_defns]. ml_gen_info_get_extra_defns(Info, Info ^ extra_defns). %-----------------------------------------------------------------------------% select_output_vars(ModuleInfo, HeadVars, HeadModes, VarTypes) = OutputVars :- ( HeadVars = [], HeadModes = [], OutputVars = [] ; HeadVars = [Var | Vars], HeadModes = [Mode | Modes], map__lookup(VarTypes, Var, VarType), ( mode_to_arg_mode(ModuleInfo, Mode, VarType, top_out) -> OutputVars1 = select_output_vars(ModuleInfo, Vars, Modes, VarTypes), OutputVars = [Var | OutputVars1] ; OutputVars = select_output_vars(ModuleInfo, Vars, Modes, VarTypes) ) ; HeadVars = [], HeadModes = [_ | _], unexpected(this_file, "select_output_vars: length mismatch") ; HeadVars = [_ | _], HeadModes = [], unexpected(this_file, "select_output_vars: length mismatch") ). %-----------------------------------------------------------------------------% % This function returns the offset to add to the argument % number of a closure arg to get its field number. % field 0 is the closure layout % field 1 is the closure address % field 2 is the number of arguments % field 3 is the 1st argument field % field 4 is the 2nd argument field, % etc. % Hence the offset to add to the argument number % to get the field number is 2. % ml_closure_arg_offset = 2. % This function returns the offset to add to the argument % number of a typeclass_info arg to get its field number. % The Nth extra argument to pass to the method is % in field N of the typeclass_info, so the offset is zero. % ml_typeclass_info_arg_offset = 0. % This function returns the offset to add to the method number % for a type class method to get its field number within the % base_typeclass_info. % field 0 is num_extra % field 1 is num_constraints % field 2 is num_superclasses % field 3 is class_arity % field 4 is num_methods % field 5 is the 1st method % field 6 is the 2nd method % etc. % (See the base_typeclass_info type in rtti.m or the % description in notes/type_class_transformation.html for % more information about the layout of base_typeclass_infos.) % Hence the offset is 4. % ml_base_typeclass_info_method_offset = 4. %-----------------------------------------------------------------------------% % % Miscellaneous routines % get_copy_out_option(Globals, CodeModel) = CopyOut :- ( CodeModel = model_non -> globals__lookup_bool_option(Globals, nondet_copy_out, CopyOut) ; globals__lookup_bool_option(Globals, det_copy_out, CopyOut) ). fixup_builtin_module(ModuleName0) = ModuleName :- ( ModuleName0 = unqualified("") -> mercury_public_builtin_module(ModuleName) ; ModuleName = ModuleName0 ). %-----------------------------------------------------------------------------% :- func this_file = string. this_file = "ml_code_util.m". %-----------------------------------------------------------------------------% :- end_module ml_code_util. %-----------------------------------------------------------------------------%