%-----------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %-----------------------------------------------------------------------------% % Copyright (C) 1999-2012 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 contains utility % predicates. % %-----------------------------------------------------------------------------% :- module ml_backend.ml_code_util. :- interface. :- import_module backend_libs.builtin_ops. :- import_module hlds.code_model. :- import_module hlds.hlds_goal. :- import_module hlds.hlds_module. :- import_module hlds.hlds_pred. :- import_module hlds.hlds_rtti. :- import_module libs.globals. :- import_module mdbcomp.prim_data. :- import_module ml_backend.ml_gen_info. :- import_module ml_backend.ml_global_data. :- import_module ml_backend.mlds. :- import_module parse_tree.prog_data. :- import_module bool. :- import_module list. :- import_module maybe. %-----------------------------------------------------------------------------% % % 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, list(statement)::in, list(statement)::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(list(mlds_defn), list(statement), prog_context) = statement. :- func ml_gen_block_mlds(list(mlds_defn), list(statement), mlds_context) = statement. :- type gen_pred == pred(list(mlds_defn), list(statement), 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), list(mlds_defn)::out, list(statement)::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(array_elem_type) = mlds_type. % Return the MLDS type corresponding to a Mercury string type. % :- func ml_string_type = mlds_type. % Return the MLDS type corresponding to a Mercury int type. % :- func ml_int_type = mlds_type. % Return the MLDS type corresponding to a Mercury char type. % :- func ml_char_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). % Return the MLDS type corresponding to the `jmercury.runtime.MercuryType' % interface. % :- func ml_java_mercury_type_interface = mlds_type. % Return the MLDS type corresponding to the `jmercury.runtime.MercuryEnum' % class. % :- func ml_java_mercury_enum_class = mlds_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. %-----------------------------------------------------------------------------% % % 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(mlds_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, mlds_gc_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_init(mlds_data_name, mlds_type, mlds_initializer, mlds_gc_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. %-----------------------------------------------------------------------------% % % 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. % Succeeds iff the specified type must be boxed when used as a field. % :- pred ml_must_box_field_type(module_info::in, mer_type::in, arg_width::in) is semidet. :- pred ml_gen_box_const_rval(module_info::in, prog_context::in, mlds_type::in, bool::in, mlds_rval::in, mlds_rval::out, ml_global_data::in, ml_global_data::out) is det. % Given a source type and a destination type, and given an source rval % holding a value of the source type, produce an rval that converts % the source rval to the destination type. % :- pred ml_gen_box_or_unbox_rval(module_info::in, mer_type::in, mer_type::in, box_policy::in, mlds_rval::in, mlds_rval::out) is det. % ml_gen_box_or_unbox_lval(CallerType, CalleeType, VarLval, VarName, % Context, ForClosureWrapper, ArgNum, % ArgLval, ConvDecls, ConvInputStatements, ConvOutputStatements): % % This is like `ml_gen_box_or_unbox_rval', except that it works on lvals % rather than rvals. Given a source type and a destination type, % a source lval holding a value of the source type, and a name to base % the name of the local temporary variable on, this procedure produces % an lval of the destination type, the declaration for the local temporary % used (if any), code to assign from the source lval (suitable converted) % to the destination lval, and code to assign from the destination lval % (suitable converted) to the source lval. % % If ForClosureWrapper = yes, then the type_info for type variables % in CallerType may not be available in the current procedure, so the GC % tracing code for the ConvDecls (if any) should obtain the type_info % from the ArgNum-th entry in the `type_params' local. % (If ForClosureWrapper = no, then ArgNum is unused.) % :- pred ml_gen_box_or_unbox_lval(mer_type::in, mer_type::in, box_policy::in, mlds_lval::in, mlds_var_name::in, prog_context::in, bool::in, int::in, mlds_lval::out, list(mlds_defn)::out, list(statement)::out, list(statement)::out, ml_gen_info::in, ml_gen_info::out) is det. % ml_gen_local_for_output_arg(VarName, Type, ArgNum, Context, % LocalVarDefn): % % Generate a declaration for a local variable with the specified % VarName and Type. However, don't use the normal GC tracing code; % instead, generate GC tracing code that gets the typeinfo from % the ArgNum-th entry in `type_params'. % :- pred ml_gen_local_for_output_arg(mlds_var_name::in, mer_type::in, int::in, prog_context::in, mlds_defn::out, ml_gen_info::in, ml_gen_info::out) is det. %-----------------------------------------------------------------------------% % % 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, list(statement)::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, list(statement)::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. %-----------------------------------------------------------------------------% % % 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. %-----------------------------------------------------------------------------% % % Routines for dealing with lookup tables. % :- pred ml_generate_constants_for_arms(list(prog_var)::in, list(hlds_goal)::in, list(list(mlds_rval))::out, ml_gen_info::in, ml_gen_info::out) is det. :- pred ml_generate_constants_for_arm(list(prog_var)::in, hlds_goal::in, list(mlds_rval)::out, ml_gen_info::in, ml_gen_info::out) is det. :- pred ml_generate_field_assign(mlds_lval::in, mlds_type::in, mlds_field_id::in, mlds_vector_common::in, mlds_type::in, mlds_rval::in, mlds_context::in, statement::out, ml_gen_info::in, ml_gen_info::out) is det. :- pred ml_generate_field_assigns(list(prog_var)::in, list(mlds_type)::in, list(mlds_field_id)::in, mlds_vector_common::in, mlds_type::in, mlds_rval::in, mlds_context::in, list(statement)::out, ml_gen_info::in, ml_gen_info::out) is det. %-----------------------------------------------------------------------------% % % 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. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module backend_libs.foreign. :- import_module check_hlds.mode_util. :- import_module check_hlds.type_util. :- import_module libs.globals. :- import_module libs.options. :- import_module mdbcomp.program_representation. :- import_module ml_backend.ml_accurate_gc. :- import_module ml_backend.ml_call_gen. :- import_module ml_backend.ml_code_gen. :- import_module parse_tree.builtin_lib_types. :- import_module parse_tree.java_names. :- import_module parse_tree.prog_data. :- import_module parse_tree.prog_type. :- import_module parse_tree.prog_util. :- import_module map. :- import_module pair. :- import_module require. :- import_module set. :- 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 = ml_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) = ml_lval(Lval), CopiedOutputVarLvals), ReturnStmt = ml_stmt_return([Succeeded | CopiedOutputVarRvals]), ReturnStatement = statement(ReturnStmt, mlds_make_context(Context)), !:Statements = !.Statements ++ [ReturnStatement] ; CodeModel = model_det, ( CopiedOutputVarLvals = [_ | _], CopiedOutputVarRvals = list.map(func(Lval) = ml_lval(Lval), CopiedOutputVarLvals), ReturnStmt = ml_stmt_return(CopiedOutputVarRvals), ReturnStatement = statement(ReturnStmt, mlds_make_context(Context)), !:Statements = !.Statements ++ [ReturnStatement] ; CopiedOutputVarLvals = [] ) ; CodeModel = model_non ). ml_gen_block(VarDecls, Statements, Context) = Block :- ( VarDecls = [], Statements = [SingleStatement] -> Block = SingleStatement ; Block = statement(ml_stmt_block(VarDecls, Statements), mlds_make_context(Context)) ). ml_gen_block_mlds(VarDecls, Statements, Context) = Block :- ( VarDecls = [], Statements = [SingleStatement] -> Block = SingleStatement ; Block = statement(ml_stmt_block(VarDecls, Statements), Context) ). ml_combine_conj(FirstCodeModel, Context, DoGenFirst, DoGenRest, Decls, Statements, !Info) :- ( % model_det goal: % % ===> % % % FirstCodeModel = model_det, DoGenFirst(FirstDecls, FirstStatements, !Info), DoGenRest(RestDecls, RestStatements, !Info), Decls = FirstDecls ++ RestDecls, Statements = FirstStatements ++ RestStatements ; % 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 = ml_stmt_if_then_else(Succeeded, IfBody, no), IfStatement = statement(IfStmt, mlds_make_context(Context)), Decls = FirstDecls ++ RestDecls, Statements = 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), RestStatement = ml_gen_block(RestDecls, RestStatements, Context), % pop nesting level ml_gen_nondet_label_func(!.Info, RestFuncLabel, Context, RestStatement, RestFunc), Decls = FirstDecls ++ [RestFunc], Statements = FirstStatements ). 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 = [], EnvVarNames = set.init, FuncDefn = mlds_function(MaybePredProcId, FuncParams, body_defined_here(Statement), Attributes, EnvVarNames), 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 = acc_local, PerInstance = per_instance, Virtuality = non_virtual, Overridability = overridable, Constness = modifiable, Abstractness = concrete, DeclFlags = init_decl_flags(Access, PerInstance, Virtuality, Overridability, Constness, Abstractness). %-----------------------------------------------------------------------------% % % Code for generating expressions. % ml_gen_and(X, Y) = ( X = ml_const(mlconst_true) -> Y ; Y = ml_const(mlconst_true) -> X ; ml_binop(logical_and, X, Y) ). ml_gen_not(X) = ml_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(ElemType) = MLDS_Type :- ( ElemType = array_elem_scalar(ScalarElem), MLDS_Type = ml_gen_scalar_array_elem_type(ScalarElem) ; ElemType = array_elem_struct(_ScalarElems), unexpected($module, $pred, "struct") ). :- func ml_gen_scalar_array_elem_type(scalar_array_elem_type) = mlds_type. ml_gen_scalar_array_elem_type(scalar_elem_string) = ml_string_type. ml_gen_scalar_array_elem_type(scalar_elem_int) = mlds_native_int_type. ml_gen_scalar_array_elem_type(scalar_elem_generic) = mlds_generic_type. ml_string_type = mercury_type(string_type, ctor_cat_builtin(cat_builtin_string), non_foreign_type(string_type)). ml_int_type = mercury_type(int_type, ctor_cat_builtin(cat_builtin_int), non_foreign_type(int_type)). ml_char_type = mercury_type(char_type, ctor_cat_builtin(cat_builtin_char), non_foreign_type(char_type)). ml_make_boxed_types(Arity) = BoxedTypes :- varset.init(TypeVarSet0), varset.new_vars(Arity, BoxedTypeVars, TypeVarSet0, _TypeVarSet), prog_type.var_list_to_type_list(map.init, BoxedTypeVars, BoxedTypes). ml_java_mercury_type_interface = TypeInterfaceDefn :- InterfaceModuleName = mercury_module_name_to_mlds( java_mercury_runtime_package_name), TypeInterface = qual(InterfaceModuleName, module_qual, "MercuryType"), TypeInterfaceDefn = mlds_class_type(TypeInterface, 0, mlds_interface). ml_java_mercury_enum_class = EnumClassDefn :- InterfaceModuleName = mercury_module_name_to_mlds( java_mercury_runtime_package_name), EnumClass = qual(InterfaceModuleName, module_qual, "MercuryEnum"), EnumClassDefn = mlds_class_type(EnumClass, 0, mlds_class). %-----------------------------------------------------------------------------% % % 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_get_varset(ProcInfo, VarSet), proc_info_get_headvars(ProcInfo, HeadVars), PredOrFunc = pred_info_is_pred_or_func(PredInfo), pred_info_get_arg_types(PredInfo, HeadTypes), proc_info_get_argmodes(ProcInfo, HeadModes), CodeModel = proc_info_interface_code_model(ProcInfo), 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) :- ml_gen_info_get_module_info(!.Info, ModuleInfo), module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo, ProcInfo), proc_info_get_varset(ProcInfo, VarSet), proc_info_get_headvars(ProcInfo, HeadVars), PredOrFunc = pred_info_is_pred_or_func(PredInfo), pred_info_get_arg_types(PredInfo, HeadTypes), proc_info_get_argmodes(ProcInfo, HeadModes), CodeModel = proc_info_interface_code_model(ProcInfo), 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 ^ rpl_proc_headvars, ArgTypes = RttiProcId ^ rpl_proc_arg_types, ArgModes = RttiProcId ^ rpl_proc_arg_modes, PredOrFunc = RttiProcId ^ rpl_pred_or_func, Detism = RttiProcId ^ rpl_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) :- ml_gen_info_get_module_info(!.Info, ModuleInfo), 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($module, $pred, "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 = pf_function, pred_args_to_func_args(HeadModes, _, ResultMode), ResultMode = top_out, pred_args_to_func_args(HeadTypes, _, ResultType), check_dummy_type(ModuleInfo, ResultType) = is_not_dummy_type -> pred_args_to_func_args(FuncArgs0, FuncArgs, RetArg), RetArg = mlds_argument(_RetArgName, RetTypePtr, _GCStatement), ( RetTypePtr = mlds_ptr_type(RetType) -> RetTypes = [RetType] ; unexpected($module, $pred, "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 = entity_data(mlds_data_var(mlds_var_name("cont", no))), % The cont variable always points to code, not to the heap, % so the GC never needs to trace it. ContGCStatement = gc_no_stmt, ContArg = mlds_argument(ContName, ContType, ContGCStatement), ContEnvType = mlds_generic_env_ptr_type, ContEnvName = entity_data( mlds_data_var(mlds_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. ContEnvGCStatement = gc_no_stmt, ContEnvArg = mlds_argument(ContEnvName, ContEnvType, ContEnvGCStatement), 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'. ( check_dummy_type(ModuleInfo, Type) = is_dummy_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($module, $pred, "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, mlds_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 ; ( ArgMode = top_out ; ArgMode = top_unused ), MLDS_ArgType = mlds_ptr_type(MLDS_Type) ), Name = entity_data(mlds_data_var(Var)), ( !.MaybeInfo = yes(Info0), % XXX We should fill in this Context properly. term.context_init(Context), ml_gen_gc_statement(Var, Type, Context, GCStatement, Info0, Info), !:MaybeInfo = yes(Info) ; !.MaybeInfo = no, GCStatement = gc_no_stmt, !:MaybeInfo = no ), FuncArg = mlds_argument(Name, MLDS_ArgType, GCStatement). 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) = pf_function, proc_info_interface_code_model(ProcInfo) = model_det, proc_info_get_argmodes(ProcInfo, Modes), pred_info_get_arg_types(PredInfo, ArgTypes), proc_info_get_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, check_dummy_type(ModuleInfo, RetArgType) = is_not_dummy_type. %-----------------------------------------------------------------------------% % % 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 = entity_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 = mlds_proc_label(PredLabel, ProcId), QualProcLabel = qual(PredModule, module_qual, ProcLabel), FuncLabelRval = ml_const( mlconst_code_addr(code_addr_internal(QualProcLabel, 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 = 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 = 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 = type_ctor(TypeCtorSymName, TypeArity), ( TypeCtorSymName = unqualified(TypeName), type_ctor_is_tuple(TypeCtor), TypeModule = mercury_public_builtin_module ; TypeCtorSymName = qualified(TypeModule, TypeName) ) -> ( 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 = mlds_special_pred_label(PredName, MaybeDeclaringModule, TypeName, TypeArity) ; unexpected($module, $pred, "cannot make label for special pred `" ++ PredName ++ "'") ) ; ( % 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 = pf_function, \+ ml_is_output_det_function(ModuleInfo, PredId, ProcId, _) -> NonOutputFunc = yes ; NonOutputFunc = no ), determinism_to_code_model(Detism, CodeModel), MLDS_PredLabel = mlds_user_pred_label(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), Label = "label_" ++ string.int_to_string(LabelNum). %-----------------------------------------------------------------------------% % % 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), IsDummy = check_dummy_type(ModuleInfo, Type), ( IsDummy = is_dummy_type, % The variable won't have been declared, so we need to generate % a dummy lval for this variable. PrivateBuiltin = mercury_private_builtin_module, MLDS_Module = mercury_module_name_to_mlds(PrivateBuiltin), ml_gen_type(Info, Type, MLDS_Type), Lval = ml_var(qual(MLDS_Module, module_qual, mlds_var_name("dummy_var", no)), MLDS_Type) ; IsDummy = is_not_dummy_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 = ml_mem_ref(ml_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), lookup_var_type(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 = "obj_" ++ CtorName ++ "_" ++ string.int_to_string(CtorArity), ReservedObjName = mlds_var_name(Name, no). ml_gen_var_lval(Info, VarName, VarType, QualifiedVarLval) :- ml_gen_info_get_module_name(Info, ModuleName), MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName), MLDS_Var = qual(MLDS_ModuleName, module_qual, VarName), QualifiedVarLval = ml_var(MLDS_Var, VarType). ml_gen_var_decl(VarName, Type, Context, Defn, !Info) :- ml_gen_info_get_module_info(!.Info, ModuleInfo), ml_gen_gc_statement(VarName, Type, Context, GCStatement, !Info), Defn = ml_gen_mlds_var_decl(mlds_data_var(VarName), mercury_type_to_mlds_type(ModuleInfo, Type), GCStatement, mlds_make_context(Context)). ml_gen_mlds_var_decl(DataName, MLDS_Type, GCStatement, Context) = ml_gen_mlds_var_decl_init(DataName, MLDS_Type, no_initializer, GCStatement, Context). ml_gen_mlds_var_decl_init(DataName, MLDS_Type, Initializer, GCStatement, Context) = Defn :- Name = entity_data(DataName), EntityDefn = mlds_data(MLDS_Type, Initializer, GCStatement), DeclFlags = ml_gen_local_var_decl_flags, Defn = mlds_defn(Name, Context, DeclFlags, EntityDefn). ml_gen_public_field_decl_flags = DeclFlags :- Access = acc_public, PerInstance = per_instance, Virtuality = non_virtual, Overridability = overridable, Constness = modifiable, Abstractness = concrete, DeclFlags = init_decl_flags(Access, PerInstance, Virtuality, Overridability, Constness, Abstractness). ml_gen_local_var_decl_flags = DeclFlags :- Access = acc_local, PerInstance = per_instance, Virtuality = non_virtual, Overridability = overridable, Constness = modifiable, Abstractness = concrete, DeclFlags = init_decl_flags(Access, PerInstance, Virtuality, Overridability, Constness, Abstractness). ml_var_name_to_string(mlds_var_name(Var, yes(Num))) = Var ++ "_" ++ string.int_to_string(Num). ml_var_name_to_string(mlds_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), FieldName = unqualify_name(QualifiedFieldName) ; MaybeFieldName = no, FieldName = "F" ++ string.int_to_string(ArgNum) ). % Succeed iff the specified type must be boxed when used as a field. % XXX Currently we box such types even for the other MLDS based back-ends % that don't need it, e.g. the .NET back-end. % ml_must_box_field_type(ModuleInfo, Type, Width) :- module_info_get_globals(ModuleInfo, Globals), globals.get_target(Globals, Target), globals.lookup_bool_option(Globals, unboxed_float, UnboxedFloat), ( ( Target = target_c ; Target = target_csharp ; Target = target_il ; Target = target_asm ; Target = target_x86_64 ; Target = target_erlang ), classify_type(ModuleInfo, Type) = Category, MustBox = ml_must_box_field_type_category(Category, UnboxedFloat, Width) ; Target = target_java, MustBox = no ), MustBox = yes. :- func ml_must_box_field_type_category(type_ctor_category, bool, arg_width) = bool. ml_must_box_field_type_category(CtorCat, UnboxedFloat, Width) = MustBox :- ( ( CtorCat = ctor_cat_builtin(cat_builtin_int) ; CtorCat = ctor_cat_builtin(cat_builtin_string) ; CtorCat = ctor_cat_builtin_dummy ; CtorCat = ctor_cat_higher_order ; CtorCat = ctor_cat_tuple ; CtorCat = ctor_cat_enum(_) ; CtorCat = ctor_cat_system(_) ; CtorCat = ctor_cat_variable ; CtorCat = ctor_cat_void ; CtorCat = ctor_cat_user(_) ), MustBox = no ; CtorCat = ctor_cat_builtin(cat_builtin_char), MustBox = yes ; CtorCat = ctor_cat_builtin(cat_builtin_float), ( UnboxedFloat = yes, MustBox = no ; UnboxedFloat = no, ( Width = full_word, MustBox = yes ; Width = double_word, MustBox = no ; ( Width = partial_word_first(_) ; Width = partial_word_shifted(_, _) ), unexpected($module, $pred, "partial word for float") ) ) ). ml_gen_box_const_rval(ModuleInfo, Context, MLDS_Type, DoubleWidth, Rval, BoxedRval, !GlobalData) :- ( ( MLDS_Type = mercury_type(type_variable(_, _), _, _) ; MLDS_Type = mlds_generic_type ) -> BoxedRval = Rval ; % For the MLDS->C and MLDS->asm back-ends, we need to handle constant % floats specially. Boxed floats normally get heap allocated, whereas % for other types boxing is just a cast (casts are OK in static % initializers, but calls to malloc() are not). ( MLDS_Type = mercury_type(builtin_type(builtin_type_float), _, _) ; MLDS_Type = mlds_native_float_type ), module_info_get_globals(ModuleInfo, Globals), globals.get_target(Globals, Target), ( Target = target_c ; Target = target_asm ; Target = target_x86_64 ) -> HaveUnboxedFloats = ml_global_data_have_unboxed_floats(!.GlobalData), ( HaveUnboxedFloats = do_not_have_unboxed_floats, DoubleWidth = no -> % Generate a local static constant for this float. module_info_get_name(ModuleInfo, ModuleName), MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName), Initializer = init_obj(Rval), ml_gen_static_scalar_const_addr(MLDS_ModuleName, "float", MLDS_Type, Initializer, Context, ConstAddrRval, !GlobalData), % Return as the boxed rval the address of that constant, % cast to mlds_generic_type. BoxedRval = ml_unop(cast(mlds_generic_type), ConstAddrRval) ; % This is not a real box, but a cast. The "box" is required as it % may be further cast to pointer types. BoxedRval = ml_unop(box(MLDS_Type), Rval) ) ; BoxedRval = ml_unop(box(MLDS_Type), Rval) ). ml_gen_box_or_unbox_rval(ModuleInfo, SourceType, DestType, BoxPolicy, VarRval, ArgRval) :- % Convert VarRval, of type SourceType, to ArgRval, of type DestType. ( BoxPolicy = always_boxed, ArgRval = VarRval ; BoxPolicy = native_if_possible, ( % If converting from polymorphic type to concrete type, then unbox. SourceType = type_variable(_, _), DestType \= type_variable(_, _) -> MLDS_DestType = mercury_type_to_mlds_type(ModuleInfo, DestType), ArgRval = ml_unop(unbox(MLDS_DestType), VarRval) ; % If converting from concrete type to polymorphic type, then box. SourceType \= type_variable(_, _), DestType = type_variable(_, _) -> MLDS_SourceType = mercury_type_to_mlds_type(ModuleInfo, SourceType), ArgRval = ml_unop(box(MLDS_SourceType), VarRval) ; % If converting to float, cast to mlds_generic_type and then unbox. DestType = builtin_type(builtin_type_float), SourceType \= builtin_type(builtin_type_float) -> MLDS_DestType = mercury_type_to_mlds_type(ModuleInfo, DestType), ArgRval = ml_unop(unbox(MLDS_DestType), ml_unop(cast(mlds_generic_type), VarRval)) ; % If converting from float, box and then cast the result. SourceType = builtin_type(builtin_type_float), DestType \= builtin_type(builtin_type_float) -> MLDS_SourceType = mercury_type_to_mlds_type(ModuleInfo, SourceType), MLDS_DestType = mercury_type_to_mlds_type(ModuleInfo, DestType), ArgRval = ml_unop(cast(MLDS_DestType), ml_unop(box(MLDS_SourceType), VarRval)) ; % If converting from an array(T) to array(X) where X is a concrete % instance, we should insert a cast to the concrete instance. % Also when converting to array(T) from array(X) we should cast % to array(T). type_to_ctor_and_args(SourceType, SourceTypeCtor, SourceTypeArgs), type_to_ctor_and_args(DestType, DestTypeCtor, DestTypeArgs), ( type_ctor_is_array(SourceTypeCtor), SourceTypeArgs = [type_variable(_, _)] ; type_ctor_is_array(DestTypeCtor), DestTypeArgs = [type_variable(_, _)] ), % Don't insert redundant casts if the types are the same, since % the extra assignments introduced can inhibit tail call % optimisation. SourceType \= DestType -> MLDS_DestType = mercury_type_to_mlds_type(ModuleInfo, DestType), ArgRval = ml_unop(cast(MLDS_DestType), VarRval) ; % If converting from one concrete type to a different one, then % cast. This is needed to handle construction/deconstruction % unifications for no_tag types. % \+ type_unify(SourceType, DestType, [], map.init, _) -> MLDS_DestType = mercury_type_to_mlds_type(ModuleInfo, DestType), ArgRval = ml_unop(cast(MLDS_DestType), VarRval) ; % Otherwise leave unchanged. ArgRval = VarRval ) ). ml_gen_box_or_unbox_lval(CallerType, CalleeType, BoxPolicy, VarLval, VarName, Context, ForClosureWrapper, ArgNum, ArgLval, ConvDecls, ConvInputStatements, ConvOutputStatements, !Info) :- % First see if we can just convert the lval as an rval; % if no boxing/unboxing is required, then ml_box_or_unbox_rval % will return its argument unchanged, and so we are done. ml_gen_info_get_module_info(!.Info, ModuleInfo), ml_gen_box_or_unbox_rval(ModuleInfo, CalleeType, CallerType, BoxPolicy, ml_lval(VarLval), BoxedRval), ( BoxedRval = ml_lval(VarLval) -> ArgLval = VarLval, ConvDecls = [], ConvInputStatements = [], ConvOutputStatements = [] ; % If that didn't work, then we need to declare a fresh variable % to use as the arg, and to generate statements to box/unbox % that fresh arg variable and assign it to/from the output % argument whose address we were passed. % Generate a declaration for the fresh variable. % % Note that generating accurate GC tracing code for this variable % requires some care, because CalleeType might be a type variable % from the callee, not from the caller, and we can't generate % type_infos for type variables from the callee. Hence we need to call % the version of ml_gen_gc_statement which takes two types: % the CalleeType is used to determine the type for the temporary % variable declaration, but the CallerType is used to construct % the type_info. ml_gen_info_new_conv_var(ConvVarSeq, !Info), VarName = mlds_var_name(VarNameStr, MaybeNum), ConvVarSeq = conv_seq(ConvVarNum), string.format("conv%d_%s", [i(ConvVarNum), s(VarNameStr)], ConvVarName), ArgVarName = mlds_var_name(ConvVarName, MaybeNum), ml_gen_type(!.Info, CalleeType, MLDS_CalleeType), ( ForClosureWrapper = yes, % For closure wrappers, the argument type_infos are stored in % the `type_params' local, so we need to handle the GC tracing % code specially. ( CallerType = type_variable(_, _) -> ml_gen_local_for_output_arg(ArgVarName, CalleeType, ArgNum, Context, ArgVarDecl, !Info) ; unexpected($module, $pred, "invalid CalleeType for closure wrapper") ) ; ForClosureWrapper = no, ml_gen_gc_statement_poly(ArgVarName, CalleeType, CallerType, Context, GC_Statements, !Info), ArgVarDecl = ml_gen_mlds_var_decl(mlds_data_var(ArgVarName), MLDS_CalleeType, GC_Statements, mlds_make_context(Context)) ), ConvDecls = [ArgVarDecl], % Create the lval for the variable and use it for the argument lval. ml_gen_var_lval(!.Info, ArgVarName, MLDS_CalleeType, ArgLval), CallerIsDummy = check_dummy_type(ModuleInfo, CallerType), ( CallerIsDummy = is_dummy_type, % If it is a dummy argument type (e.g. io.state), % then we don't need to bother assigning it. ConvInputStatements = [], ConvOutputStatements = [] ; CallerIsDummy = is_not_dummy_type, % Generate statements to box/unbox the fresh variable and assign it % to/from the output argument whose address we were passed. % Assign to the freshly generated arg variable. ml_gen_box_or_unbox_rval(ModuleInfo, CallerType, CalleeType, BoxPolicy, ml_lval(VarLval), ConvertedVarRval), AssignInputStatement = ml_gen_assign(ArgLval, ConvertedVarRval, Context), ConvInputStatements = [AssignInputStatement], % Assign from the freshly generated arg variable. ml_gen_box_or_unbox_rval(ModuleInfo, CalleeType, CallerType, BoxPolicy, ml_lval(ArgLval), ConvertedArgRval), AssignOutputStatement = ml_gen_assign(VarLval, ConvertedArgRval, Context), ConvOutputStatements = [AssignOutputStatement] ) ). ml_gen_local_for_output_arg(VarName, Type, ArgNum, Context, LocalVarDefn, !Info) :- % Generate a declaration for a corresponding local variable. % However, don't use the normal GC tracing code; instead, we need to get % the typeinfo from `type_params', using the following code: % % MR_TypeInfo type_info; % MR_MemoryList allocated_memory_cells = NULL; % type_info = MR_make_type_info_maybe_existq(type_params, % closure_layout->MR_closure_arg_pseudo_type_info[ - 1], % NULL, NULL, &allocated_memory_cells); % % private_builtin__gc_trace_1_0(type_info, &); % % MR_deallocate(allocated_memory_cells); % MLDS_Context = mlds_make_context(Context), ClosureLayoutPtrName = mlds_var_name("closure_layout_ptr", no), % This type is really `const MR_Closure_Layout *', but there's no easy % way to represent that in the MLDS; using MR_Box instead works fine. ClosureLayoutPtrType = mlds_generic_type, ml_gen_var_lval(!.Info, ClosureLayoutPtrName, ClosureLayoutPtrType, ClosureLayoutPtrLval), TypeParamsName = mlds_var_name("type_params", no), % This type is really MR_TypeInfoParams, but there is no easy way to % represent that in the MLDS; using MR_Box instead works fine. TypeParamsType = mlds_generic_type, ml_gen_var_lval(!.Info, TypeParamsName, TypeParamsType, TypeParamsLval), TypeInfoName = mlds_var_name("type_info", no), % The type for this should match the type of the first argument % of private_builtin.gc_trace/1, i.e. `mutvar(T)', which is a no_tag type % whose representation is c_pointer. ml_gen_info_get_module_info(!.Info, ModuleInfo), TypeInfoMercuryType = c_pointer_type, TypeInfoType = mercury_type_to_mlds_type(ModuleInfo, TypeInfoMercuryType), ml_gen_var_lval(!.Info, TypeInfoName, TypeInfoType, TypeInfoLval), TypeInfoDecl = ml_gen_mlds_var_decl(mlds_data_var(TypeInfoName), TypeInfoType, gc_no_stmt, MLDS_Context), ml_gen_gc_statement_with_typeinfo(VarName, Type, ml_lval(TypeInfoLval), Context, GCStatement0, !Info), ( ( GCStatement0 = gc_trace_code(CallTraceFuncCode) ; GCStatement0 = gc_initialiser(CallTraceFuncCode) ), MakeTypeInfoCode = ml_stmt_atomic(inline_target_code(ml_target_c, [ raw_target_code("{\n", []), raw_target_code("MR_MemoryList allocated_mem = NULL;\n", []), target_code_output(TypeInfoLval), raw_target_code(" = (MR_C_Pointer) " ++ "MR_make_type_info_maybe_existq(\n\t", []), target_code_input(ml_lval(TypeParamsLval)), raw_target_code(", ((MR_Closure_Layout *)\n\t", []), target_code_input(ml_lval(ClosureLayoutPtrLval)), raw_target_code(string.format(")->" ++ "MR_closure_arg_pseudo_type_info[%d - 1],\n\t" ++ "NULL, NULL, &allocated_mem);\n", [i(ArgNum)]), []) ])), DeallocateCode = ml_stmt_atomic(inline_target_code(ml_target_c, [ raw_target_code("MR_deallocate(allocated_mem);\n", []), raw_target_code("}\n", []) ])), GCTraceCode = ml_stmt_block([TypeInfoDecl], [ statement(MakeTypeInfoCode, MLDS_Context), CallTraceFuncCode, statement(DeallocateCode, MLDS_Context) ]), GCStatement = gc_trace_code(statement(GCTraceCode, MLDS_Context)) ; GCStatement0 = gc_no_stmt, GCStatement = GCStatement0 ), LocalVarDefn = ml_gen_mlds_var_decl(mlds_data_var(VarName), mercury_type_to_mlds_type(ModuleInfo, Type), GCStatement, MLDS_Context). %-----------------------------------------------------------------------------% % % 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, ml_const(mlconst_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($module, $pred, "`fail' has determinism `det'"). ml_gen_failure(model_semi, Context, [SetSuccessFalse], !Info) :- % % semidet fail: % % ===> % succeeded = MR_FALSE; % ml_gen_set_success(!.Info, ml_const(mlconst_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(mlds_data_var(mlds_var_name("succeeded", no)), mlds_native_bool_type, gc_no_stmt, Context). ml_success_lval(Info, SucceededLval) :- ml_gen_var_lval(Info, mlds_var_name("succeeded", no), mlds_native_bool_type, SucceededLval). ml_gen_test_success(Info, SucceededRval) :- ml_success_lval(Info, SucceededLval), SucceededRval = ml_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) = VarName :- CondVar = cond_seq(CondNum), CondName = string.append("cond_", string.int_to_string(CondNum)), VarName = mlds_var_name(CondName, no). ml_gen_cond_var_decl(CondVar, Context) = ml_gen_mlds_var_decl(mlds_data_var(ml_gen_cond_var_name(CondVar)), mlds_native_bool_type, gc_no_stmt, 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 = ml_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(ml_lval(ContLval), ml_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), IsDummy = check_dummy_type(ModuleInfo, Type), ( IsDummy = is_dummy_type, Types = Types1, Vars = Vars1 ; IsDummy = is_not_dummy_type, Types = [Type | Types1], Vars = [Var | Vars1] ). ml_skip_dummy_argument_types([_ | _], [], _, _, _) :- unexpected($module, $pred, "length mismatch"). ml_skip_dummy_argument_types([], [_ | _], _, _, _) :- unexpected($module, $pred, "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) = ml_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 = ml_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) = ml_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_statement % 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 = mlds_func_params(InnerArgs0, Rets), InnerArgRvals = list.map( (func(mlds_argument(Data, Type, _GC) ) = Lval :- ( Data = entity_data(mlds_data_var(VarName)) -> Lval = ml_lval(ml_var(qual(MLDS_Module, module_qual, VarName), Type)) ; unexpected($module, $pred, "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. PassedContGCStatement = gc_no_stmt, PassedContArg = mlds_argument( entity_data(mlds_data_var(PassedContVarName)), InnerFuncArgType, PassedContGCStatement), InnerFuncRval = ml_lval(ml_var(qual(MLDS_Module, module_qual, PassedContVarName), InnerFuncArgType)), InnerFuncParams = mlds_func_params([PassedContArg | InnerArgs0], Rets), InnerStmt = ml_stmt_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(EntityName, _, _, EntityDefn), EntityName = entity_function(PredLabel, ProcId, yes(SeqNum), _), EntityDefn = mlds_function(_, _, body_defined_here(_), _, _) -> % We call the proxy function. ProcLabel = mlds_proc_label(PredLabel, ProcId), QualProcLabel = qual(MLDS_Module, module_qual, ProcLabel), ProxyFuncRval = ml_const(mlconst_code_addr( code_addr_internal(QualProcLabel, SeqNum, ProxySignature))), % Put it inside a block where we call it. Stmt = ml_stmt_call(ProxySignature, ProxyFuncRval, ObjectRval, ProxyArgRvals, RetLvals, CallKind), BlockStmt = ml_stmt_block([Defn], [statement(Stmt, MLDS_Context)]), Statement = statement(BlockStmt, MLDS_Context) ; unexpected($module, $pred, "success continuation generated was not a function") ). %-----------------------------------------------------------------------------% % % Routines for dealing with the environment pointer used for nested functions. % ml_get_env_ptr(Info, ml_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, GCStatement)) :- Name = entity_data(mlds_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. GCStatement = gc_no_stmt. %-----------------------------------------------------------------------------% % 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. %-----------------------------------------------------------------------------% % % Routines for dealing with lookup tables. % ml_generate_constants_for_arms(_Vars, [], [], !Info). ml_generate_constants_for_arms(Vars, [Goal | Goals], [Soln | Solns], !Info) :- ml_generate_constants_for_arm(Vars, Goal, Soln, !Info), ml_generate_constants_for_arms(Vars, Goals, Solns, !Info). ml_generate_constants_for_arm(Vars, Goal, Soln, !Info) :- ml_gen_info_get_const_var_map(!.Info, InitConstVarMap), ml_gen_goal(model_det, Goal, _Decls, _Statements, !Info), ml_gen_info_get_const_var_map(!.Info, FinalConstVarMap), list.map(lookup_ground_rval(FinalConstVarMap), Vars, Soln), ml_gen_info_set_const_var_map(InitConstVarMap, !Info). :- pred lookup_ground_rval(ml_ground_term_map::in, prog_var::in, mlds_rval::out) is det. lookup_ground_rval(FinalConstVarMap, Var, Rval) :- % We can do a map.lookup instead of a map.search here because % - we execute this code only if we have already determined that % goal_is_conj_of_unify succeeds for this arm, % - we don't even start looking for lookup switches unless we know % that the mark_static_terms pass has been run, and % - for every arm on which goal_is_conj_of_unify succeeds, % mark_static_terms will mark all the variables to which Var % may be bound as being constructed statically. (There can be no need % to construct them dynamically, since all the arm's nonlocals are % output, which means none of them can be input.) map.lookup(FinalConstVarMap, Var, GroundTerm), GroundTerm = ml_ground_term(Rval, _, _). ml_generate_field_assign(OutVarLval, FieldType, FieldId, VectorCommon, StructType, IndexRval, Context, Statement, !Info) :- BaseRval = ml_vector_common_row(VectorCommon, IndexRval), FieldLval = ml_field(yes(0), BaseRval, FieldId, FieldType, StructType), AtomicStmt = assign(OutVarLval, ml_lval(FieldLval)), Stmt = ml_stmt_atomic(AtomicStmt), Statement = statement(Stmt, Context). ml_generate_field_assigns(OutVars, FieldTypes, FieldIds, VectorCommon, StructType, IndexRval, Context, Statements, !Info) :- ( OutVars = [], FieldTypes = [], FieldIds = [] -> Statements = [] ; OutVars = [HeadOutVar | TailOutVars], FieldTypes = [HeadFieldType | TailFieldTypes], FieldIds = [HeadFieldId | TailFieldIds] -> ml_gen_var(!.Info, HeadOutVar, HeadOutVarLval), ml_generate_field_assign(HeadOutVarLval, HeadFieldType, HeadFieldId, VectorCommon, StructType, IndexRval, Context, HeadStatement, !Info), ml_generate_field_assigns(TailOutVars, TailFieldTypes, TailFieldIds, VectorCommon, StructType, IndexRval, Context, TailStatements, !Info), Statements = [HeadStatement | TailStatements] ; unexpected($module, $pred, "mismatched lists") ). %-----------------------------------------------------------------------------% % % Miscellaneous routines. % get_copy_out_option(Globals, CodeModel) = CopyOut :- ( CodeModel = model_non, globals.lookup_bool_option(Globals, nondet_copy_out, CopyOut) ; ( CodeModel = model_det ; CodeModel = model_semi ), globals.lookup_bool_option(Globals, det_copy_out, CopyOut) ). fixup_builtin_module(ModuleName0) = ModuleName :- ( ModuleName0 = unqualified("") -> ModuleName = mercury_public_builtin_module ; ModuleName = ModuleName0 ). %-----------------------------------------------------------------------------% :- end_module ml_backend.ml_code_util. %-----------------------------------------------------------------------------%