%---------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %---------------------------------------------------------------------------% % Copyright (C) 1999-2012 The University of Melbourne. % Copyright (C) 2013-2025 The Mercury team. % This file may only be copied under the terms of the GNU General % Public License - see the file COPYING in the Mercury distribution. %---------------------------------------------------------------------------% % % File: 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. :- import_module backend_libs.builtin_ops. :- import_module hlds. :- import_module hlds.code_model. :- import_module hlds.hlds_data. :- import_module hlds.hlds_goal. :- import_module hlds.hlds_module. :- import_module hlds.hlds_pred. :- import_module hlds.hlds_rtti. :- import_module mdbcomp. :- import_module mdbcomp.sym_name. :- import_module ml_backend.ml_gen_info. :- import_module ml_backend.ml_global_data. :- import_module ml_backend.mlds. :- import_module parse_tree. :- import_module parse_tree.prog_data. :- import_module parse_tree.prog_data_foreign. :- import_module parse_tree.var_table. :- import_module assoc_list. :- 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) = mlds_stmt. % 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_local_var_defn), list(mlds_function_defn), list(mlds_stmt), prog_context) = mlds_stmt. :- type gen_pred == pred(list(mlds_local_var_defn), list(mlds_function_defn), list(mlds_stmt), ml_gen_info, ml_gen_info). :- inst gen_pred == (pred(out, 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_local_var_defn)::out, list(mlds_function_defn)::out, list(mlds_stmt)::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_function_defn % which defines that function. % :- pred ml_gen_nondet_label_func(ml_gen_info::in, mlds_maybe_aux_func_id::in, mlds_func_source::in, prog_context::in, mlds_stmt::in, mlds_function_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_function_defn which defines that function. % :- pred ml_gen_label_func(ml_gen_info::in, mlds_maybe_aux_func_id::in, mlds_func_source::in, mlds_func_params::in, prog_context::in, mlds_stmt::in, mlds_function_defn::out) is det. %---------------------------------------------------------------------------% % % Routines for generating expressions. % :- func ml_int_tag_to_rval_const(int_tag, mer_type, mlds_type) = mlds_rval. %---------------------------------------------------------------------------% % % Routines for generating types. % :- func var_table_entry_to_mlds_type(module_info, var_table_entry) = mlds_type. % Convert a Mercury type to an MLDS type. % :- pred ml_gen_mlds_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. % Allocate one or several 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_type = mer_type. :- func ml_make_boxed_types(arity) = list(mer_type). % Return the interface id corresponding to the % `jmercury.runtime.MercuryType' interface. % :- func ml_java_mercury_type_interface = mlds_interface_id. % Return the class id corresponding to the % `jmercury.runtime.MercuryEnum' class. % :- func ml_java_mercury_enum_class = mlds_class_id. %---------------------------------------------------------------------------% % % Routines for generating labels and entity names. % % Generate the mlds_function_name and module name for the entry point % function corresponding to a given procedure. % :- pred ml_gen_proc_label(module_info::in, pred_proc_id::in, mlds_module_name::out, mlds_plain_func_name::out) is det. % Generate an mlds_function_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_proc_id, mlds_maybe_aux_func_id) = mlds_plain_func_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, mlds_maybe_aux_func_id::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_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_direct_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_direct(ml_gen_info::in, prog_var::in, mlds_lval::out) is det. :- pred ml_gen_var(ml_gen_info::in, prog_var::in, var_table_entry::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 type of a variable. % :- pred ml_variable_type_direct(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_local_var_names(var_table::in, list(prog_var)::in) = (list(mlds_local_var_name)::out(list_skel(lvn_prog_var))) is det. % Generate the MLDS variable name for a variable. % :- func ml_gen_local_var_name(prog_var::in, var_table_entry::in) = (mlds_local_var_name::out(lvn_prog_var)) is det. % Generate a declaration for an MLDS variable, given its HLDS type. % :- pred ml_gen_local_var_decl(mlds_local_var_name::in, mer_type::in, prog_context::in, mlds_local_var_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_local_var_name, mlds_type, mlds_gc_statement, prog_context) = mlds_local_var_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_local_var_name, mlds_type, mlds_initializer, mlds_gc_statement, prog_context) = mlds_local_var_defn. % 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_field_var_decl_flags. %---------------------------------------------------------------------------% % % Routines for dealing with fields. % % ml_gen_hld_field_name(MaybeFieldName, MaybeBaseCtorArg, ArgNum) = % FieldName: % % Generate an MLDS field name for the target language type that represents % the function symbol's cell when we are generating code with % --high-level-data. % % MaybeFieldName is the user-specified field name (if any). % MaybeBaseCtorArg says whether this is a field in a subtype, and if so, % the field name (if any) of the corresponding constructor argument in the % base type. % ArgNum is the argument number (starting from one). % :- func ml_gen_hld_field_name(maybe(ctor_field_name), maybe_base_ctor_arg, int) = mlds_field_var_name. % 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. % :- 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, arg_width::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, by boxing or unboxing it, % possibly with an additional cast. % % The second version assumes that the box_policy is bp_native_if_possible. % (Only one caller calls the general version; all the others call % the second version.) % :- 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. :- pred ml_gen_box_or_unbox_rval_native(module_info::in, mer_type::in, mer_type::in, mlds_rval::in, mlds_rval::out) is det. % ml_gen_box_or_unbox_lval(CallerType, CalleeType, VarLval, VarName, % Context, ForClosureWrapper, ArgNum, % ArgLval, ConvDecls, ConvInputStmts, ConvOutputStmts): % % 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_local_var_name::in, prog_context::in, bool::in, int::in, mlds_lval::out, list(mlds_local_var_defn)::out, list(mlds_stmt)::out, list(mlds_stmt)::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_local_var_name::in, mer_type::in, int::in, prog_context::in, mlds_local_var_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(mlds_stmt)::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(mlds_stmt)::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(prog_context) = mlds_local_var_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(mlds_lval::out, ml_gen_info::in, ml_gen_info::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(mlds_rval::out, ml_gen_info::in, ml_gen_info::out) is det. % Generate code to set the `succeeded' flag to the specified truth value. % :- pred ml_gen_set_success(mlds_rval::in, prog_context::in, mlds_stmt::out, ml_gen_info::in, ml_gen_info::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, prog_context) = mlds_local_var_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(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(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(cond_seq::in, mlds_rval::in, prog_context::in, mlds_stmt::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 are 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, assoc_list(mlds_lval, 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(ml_gen_info::in, prog_context::in, mlds_stmt::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(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 semidet. :- 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 semidet. :- 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, prog_context::in, mlds_stmt::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, prog_context::in, list(mlds_stmt)::out, ml_gen_info::in, ml_gen_info::out) is det. %---------------------------------------------------------------------------% % % Miscellaneous routines. % % 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 hlds.pred_name. :- import_module hlds.type_util. :- import_module libs. :- import_module libs.globals. :- import_module libs.options. :- import_module mdbcomp.builtin_modules. :- import_module mdbcomp.prim_data. :- import_module ml_backend.ml_accurate_gc. :- 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_type. :- import_module parse_tree.prog_type_test. :- import_module parse_tree.prog_type_unify. :- import_module parse_tree.set_of_var. :- 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) = Stmt :- Assign = assign(Lval, Rval), Stmt = ml_stmt_atomic(Assign, Context). ml_gen_block(LocalVarDefns, FuncDefns, Stmts, Context) = Block :- ( if LocalVarDefns = [], FuncDefns = [], Stmts = [SingleStmt] then Block = SingleStmt else Block = ml_stmt_block(LocalVarDefns, FuncDefns, Stmts, Context) ). ml_combine_conj(FirstCodeModel, Context, DoGenFirst, DoGenRest, LocalVarDefns, FuncDefns, Stmts, !Info) :- ( % model_det goal: % % ===> % % % FirstCodeModel = model_det, DoGenFirst(FirstLocalVarDefns, FirstFuncDefns, FirstStmts, !Info), DoGenRest(RestLocalVarDefns, RestFuncDefns, RestStmts, !Info), LocalVarDefns = FirstLocalVarDefns ++ RestLocalVarDefns, FuncDefns = FirstFuncDefns ++ RestFuncDefns, Stmts = FirstStmts ++ RestStmts ; % 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). % XXX We haven't put static consts into blocks for a long time; % they are now in the global data field in !Info. FirstCodeModel = model_semi, DoGenFirst(FirstLocalVarDefns, FirstFuncDefns, FirstStmts, !Info), ml_gen_test_success(Succeeded, !Info), DoGenRest(RestLocalVarDefns, RestFuncDefns, RestStmts, !Info), ThenStmt = ml_gen_block([], [], RestStmts, Context), ITEStmt = ml_stmt_if_then_else(Succeeded, ThenStmt, no, Context), LocalVarDefns = FirstLocalVarDefns ++ RestLocalVarDefns, FuncDefns = FirstFuncDefns ++ RestFuncDefns, Stmts = FirstStmts ++ [ITEStmt] ; % model_non goal: % % ===> % succ_func() { % ; % } % % ; % % except that we hoist any 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. % % 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(EnvPtrRval), SuccessCont = success_cont(RestFuncLabelRval, EnvPtrRval, []), ml_gen_info_push_success_cont(SuccessCont, !Info), DoGenFirst(FirstLocalVarDefns, FirstFuncDefns, FirstStmts, !Info), ml_gen_info_pop_success_cont(!Info), % Generate the `succ_func'. % Do not take any information about packed args into the new function % depth, since that may cause dangling cross-function references % when the new function depth is flattened out. ml_gen_info_set_packed_word_map(map.init, !Info), ml_gen_info_increment_func_nest_depth(!Info), DoGenRest(RestLocalVarDefns, RestFuncDefns, RestStmts, !Info), ml_gen_info_decrement_func_nest_depth(!Info), % Do not take any information about packed args out of the new function % depth, for the same reason. ml_gen_info_set_packed_word_map(map.init, !Info), RestStmt = ml_gen_block(RestLocalVarDefns, RestFuncDefns, RestStmts, Context), ml_gen_nondet_label_func(!.Info, RestFuncLabel, mlds_func_source_continuation, Context, RestStmt, RestFunc), LocalVarDefns = FirstLocalVarDefns, FuncDefns = FirstFuncDefns ++ [RestFunc], Stmts = FirstStmts ). ml_gen_nondet_label_func(Info, MaybeAux, Source, Context, Stmt, Func) :- ml_declare_env_ptr_arg(EnvPtrArg), FuncParams = mlds_func_params([EnvPtrArg], []), ml_gen_label_func(Info, MaybeAux, Source, FuncParams, Context, Stmt, Func). ml_gen_label_func(Info, MaybeAux, Source, FuncParams, Context, Stmt, Func) :- % Compute the function name. ml_gen_info_get_module_info(Info, ModuleInfo), ml_gen_info_get_pred_proc_id(Info, PredProcId), FuncName = ml_gen_nondet_label(ModuleInfo, PredProcId, MaybeAux), % Compute the function definition. DeclFlags = mlds_function_decl_flags(func_private, per_instance), Body = body_defined_here(Stmt), EnvVarNames = set.init, Func = mlds_function_defn(mlds_function_name(FuncName), Context, DeclFlags, Source, FuncParams, Body, EnvVarNames, no). %---------------------------------------------------------------------------% % % Code for generating expressions. % ml_int_tag_to_rval_const(IntTag, MerType, MLDS_Type) = Rval :- % Keep this code in sync with ml_generate_test_rval_is_int_tag % in ml_unify_gen_test.m. ( IntTag = int_tag_int(Int), ( if MerType = int_type then Const = mlconst_int(Int) else if MerType = char_type then Const = mlconst_char(Int) else Const = mlconst_enum(Int, MLDS_Type) ) ; IntTag = int_tag_uint(UInt), Const = mlconst_uint(UInt) ; IntTag = int_tag_int8(Int8), Const = mlconst_int8(Int8) ; IntTag = int_tag_uint8(UInt8), Const = mlconst_uint8(UInt8) ; IntTag = int_tag_int16(Int16), Const = mlconst_int16(Int16) ; IntTag = int_tag_uint16(UInt16), Const = mlconst_uint16(UInt16) ; IntTag = int_tag_int32(Int32), Const = mlconst_int32(Int32) ; IntTag = int_tag_uint32(UInt32), Const = mlconst_uint32(UInt32) ; IntTag = int_tag_int64(Int64), Const = mlconst_int64(Int64) ; IntTag = int_tag_uint64(UInt64), Const = mlconst_uint64(UInt64) ), Rval = ml_const(Const). %---------------------------------------------------------------------------% % % Code for generating types. % var_table_entry_to_mlds_type(ModuleInfo, Entry) = MLDSType :- MLDSType = mercury_type_to_mlds_type(ModuleInfo, Entry ^ vte_type). ml_gen_mlds_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($pred, "struct") ). :- func ml_gen_scalar_array_elem_type(scalar_array_elem_type) = mlds_type. ml_gen_scalar_array_elem_type(scalar_elem_string) = mlds_builtin_type_string. ml_gen_scalar_array_elem_type(scalar_elem_int) = mlds_builtin_type_int(int_type_int). ml_gen_scalar_array_elem_type(scalar_elem_generic) = mlds_generic_type. ml_make_boxed_type = BoxedType :- varset.init(TypeVarSet0), varset.new_var(BoxedTypeVar, TypeVarSet0, _TypeVarSet), prog_type.var_to_type(map.init, BoxedTypeVar, BoxedType). 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), TypeInterfaceDefn = mlds_interface_id(InterfaceModuleName, "MercuryType"). ml_java_mercury_enum_class = EnumClassId :- InterfaceModuleName = mercury_module_name_to_mlds(java_mercury_runtime_package_name), EnumClass = qual_class_name(InterfaceModuleName, module_qual, "MercuryEnum"), EnumClassId = mlds_class_id(EnumClass, 0). %---------------------------------------------------------------------------% % % Code for generating mlds_function_names. % ml_gen_proc_label(ModuleInfo, PredProcId, MLDS_ModuleName, MLDS_Name) :- ml_gen_func_label(ModuleInfo, PredProcId, proc_func, MLDS_ModuleName, MLDS_Name). ml_gen_nondet_label(ModuleInfo, PredProcId, MaybeAux) = MLDS_Name :- ml_gen_func_label(ModuleInfo, PredProcId, MaybeAux, _MLDS_ModuleName, MLDS_Name). :- pred ml_gen_func_label(module_info::in, pred_proc_id::in, mlds_maybe_aux_func_id::in, mlds_module_name::out, mlds_plain_func_name::out) is det. ml_gen_func_label(ModuleInfo, PredProcId, MaybeAux, ModuleName, FuncName) :- ml_gen_pred_label(ModuleInfo, PredProcId, PredLabel, ModuleName), PredProcId = proc(PredId, ProcId), ProcLabel = mlds_proc_label(PredLabel, ProcId), FuncLabel = mlds_func_label(ProcLabel, MaybeAux), FuncName = mlds_plain_func_name(FuncLabel, PredId). ml_gen_new_func_label(MaybeParams, MaybeAux, FuncLabelRval, !Info) :- ml_gen_info_new_aux_func_id(MaybeAux, !Info), ml_gen_info_get_module_info(!.Info, ModuleInfo), ml_gen_info_get_pred_proc_id(!.Info, PredProcId), ml_gen_pred_label(ModuleInfo, PredProcId, PredLabel, PredModule), ( MaybeParams = yes(Params), Signature = mlds_get_func_signature(Params) ; MaybeParams = no, ArgTypes = [mlds_generic_env_ptr_type], Signature = mlds_func_signature(ArgTypes, []) ), PredProcId = proc(_PredId, ProcId), ProcLabel = mlds_proc_label(PredLabel, ProcId), FuncLabel = mlds_func_label(ProcLabel, MaybeAux), QualFuncLabel = qual_func_label(PredModule, FuncLabel), FuncLabelRval = ml_const(mlconst_code_addr( mlds_code_addr(QualFuncLabel, Signature))). ml_gen_pred_label(ModuleInfo, PredProcId, MLDS_PredLabel, MLDS_Module) :- PredProcId = proc(PredId, ProcId), 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, PredFormArity, _ArgTypes, _PredId, ProcId, _HeadVarsWithNames, _TopFunctorModes, _Detism, PredIsImported, _PredIsPseudoImported, Origin, _ProcIsExported, _ProcIsImported), ( if Origin = origin_compiler(made_for_uci(SpecialPred, TypeCtor)) then ( if % 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) ) then ( if ThisModule \= TypeModule, SpecialPred = spec_pred_unify, not hlds_pred.in_in_unification_proc_id(ProcId) then % This is a locally-defined instance of a unification procedure % for a type defined in some other module. DefiningModule = ThisModule, MaybeDeclaringModule = yes(TypeModule) else % 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) else unexpected($pred, "cannot make label for special pred `" ++ PredName ++ "'") ) else ( if % Work out which module supplies the code for the predicate. ThisModule \= PredModule, PredIsImported = no then % This predicate is a specialized version of a pred from a % `.opt' file. DefiningModule = ThisModule, MaybeDeclaringModule = yes(PredModule) else % The predicate was declared in the same module that it is % defined in DefiningModule = PredModule, MaybeDeclaringModule = no ), MLDS_PredLabel = mlds_user_pred_label(PredOrFunc, MaybeDeclaringModule, PredName, PredFormArity) ), MLDS_Module = mercury_module_name_to_mlds(DefiningModule). ml_gen_new_label(Label, !Info) :- ml_gen_info_new_label(LabelNum, !Info), Label = mlds_label("label_" ++ string.int_to_string(LabelNum)). %---------------------------------------------------------------------------% % % Code for dealing with variables. % ml_gen_var_direct_list(_Info, [], []). ml_gen_var_direct_list(Info, [Var | Vars], [Lval | Lvals]) :- ml_gen_var_direct(Info, Var, Lval), ml_gen_var_direct_list(Info, Vars, Lvals). ml_gen_var_direct(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), ( if map.search(VarLvals, Var, VarLval) then Lval = VarLval else % Otherwise just look up the variable's type and generate an lval % for it using the ordinary algorithm. ml_gen_info_get_var_table(Info, VarTable), lookup_var_entry(VarTable, Var, Entry), do_gen_var(Info, Var, Entry, Lval) ). ml_gen_var(Info, Var, Entry, 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), ( if map.search(VarLvals, Var, VarLval) then Lval = VarLval else % Otherwise just look up the variable's type and generate an lval % for it using the ordinary algorithm. do_gen_var(Info, Var, Entry, Lval) ). :- pred do_gen_var(ml_gen_info::in, prog_var::in, var_table_entry::in, mlds_lval::out) is det. do_gen_var(Info, Var, Entry, Lval) :- Entry = vte(_, Type, IsDummy), ml_gen_mlds_type(Info, Type, MLDS_Type), ( IsDummy = is_dummy_type, % The variable won't have been declared, so we need to generate % a dummy lval for this variable. Lval = ml_global_var(global_dummy_var, MLDS_Type) ; IsDummy = is_not_dummy_type, VarName = ml_gen_local_var_name(Var, Entry), VarLval = ml_local_var(VarName, MLDS_Type), % Output variables may be passed by reference... ml_gen_info_get_byref_output_vars(Info, ByRefOutputVars), ( if set_of_var.member(ByRefOutputVars, Var) then Lval = ml_mem_ref(ml_lval(VarLval), MLDS_Type) else Lval = VarLval ) ). ml_gen_var_with_type(Info, Var, Type, Lval) :- % NOTE The value of Type here may *differ* from the type recorded % for Var in the var_table field of !.Info. Out of an abundance of caution, % we recompute IsDummy for it as well. ml_gen_info_get_module_info(Info, ModuleInfo), IsDummy = is_type_a_dummy(ModuleInfo, Type), ml_gen_mlds_type(Info, Type, MLDS_Type), ( IsDummy = is_dummy_type, % The variable won't have been declared, so we need to generate % a dummy lval for this variable. Lval = ml_global_var(global_dummy_var, MLDS_Type) ; IsDummy = is_not_dummy_type, % The name part of the var table entry for var does not depend % on which form of the var's type we are after. ml_gen_info_get_var_table(Info, VarTable), lookup_var_entry(VarTable, Var, Entry), VarName = ml_gen_local_var_name(Var, Entry), VarLval = ml_local_var(VarName, MLDS_Type), % Output variables may be passed by reference... ml_gen_info_get_byref_output_vars(Info, ByRefOutputVars), ( if set_of_var.member(ByRefOutputVars, Var) then Lval = ml_mem_ref(ml_lval(VarLval), MLDS_Type) else Lval = VarLval ) ). ml_variable_type_direct(Info, Var, Type) :- ml_gen_info_get_var_table(Info, VarTable), lookup_var_entry(VarTable, Var, Entry), Type = Entry ^ vte_type. ml_gen_local_var_names(_, []) = []. ml_gen_local_var_names(VarTable, [Var | Vars]) = [MLDSVarName | MLDSVarNames] :- lookup_var_entry(VarTable, Var, VarEntry), MLDSVarName = ml_gen_local_var_name(Var, VarEntry), MLDSVarNames = ml_gen_local_var_names(VarTable, Vars). ml_gen_local_var_name(Var, Entry) = MLDSVarName :- VarName = Entry ^ vte_name, term.var_to_int(Var, VarNumber), MLDSVarName = lvn_prog_var(VarName, VarNumber). ml_gen_local_var_decl(VarName, Type, Context, Defn, !Info) :- ml_gen_info_get_module_info(!.Info, ModuleInfo), ml_gen_gc_statement(VarName, Type, Context, GCStmt, !Info), Defn = ml_gen_mlds_var_decl(VarName, mercury_type_to_mlds_type(ModuleInfo, Type), GCStmt, Context). ml_gen_mlds_var_decl(DataName, MLDS_Type, GCStmt, Context) = ml_gen_mlds_var_decl_init(DataName, MLDS_Type, no_initializer, GCStmt, Context). ml_gen_mlds_var_decl_init(DataName, MLDS_Type, Initializer, GCStmt, Context) = mlds_local_var_defn(DataName, Context, MLDS_Type, Initializer, GCStmt). ml_gen_public_field_decl_flags = mlds_field_var_decl_flags(per_instance, modifiable). %---------------------------------------------------------------------------% % % Code for dealing with fields. % ml_gen_hld_field_name(MaybeFieldName, MaybeBaseCtorArg, ArgNum) = FieldVarName :- % Subtypes share the data representation with their base types. % If this is the field of a subtype, we must translate the reference to the % corresponding constructor arg in the base type (which may or may not % have a field name). ( MaybeBaseCtorArg = no_base_ctor_arg, FieldNameToUse = MaybeFieldName ; MaybeBaseCtorArg = base_ctor_arg(MaybeBaseFieldName), FieldNameToUse = MaybeBaseFieldName ), % Use the field name if we have one, otherwise we just use `F' followed by % the field number. ( FieldNameToUse = yes(ctor_field_name(QualifiedFieldName, _FieldNameCtxt)), FieldName = unqualify_name(QualifiedFieldName) ; FieldNameToUse = no, FieldName = "F" ++ string.int_to_string(ArgNum) ), FieldVarName = fvn_du_ctor_field_hld(FieldName). ml_must_box_field_type(ModuleInfo, Type, Width) :- module_info_get_globals(ModuleInfo, Globals), globals.get_target(Globals, Target), ( ( Target = target_c ; Target = target_csharp ), classify_type(ModuleInfo, Type) = Category, globals.lookup_bool_option(Globals, unboxed_float, UnboxedFloat), globals.lookup_bool_option(Globals, unboxed_int64s, UnboxedInt64s), MustBox = ml_must_box_field_type_category(Category, UnboxedFloat, UnboxedInt64s, Width) ; Target = target_java, MustBox = no ), MustBox = yes. :- func ml_must_box_field_type_category(type_ctor_category, bool, bool, arg_width) = bool. ml_must_box_field_type_category(CtorCat, UnboxedFloat, UnboxedInt64s, Width) = MustBox :- ( CtorCat = ctor_cat_builtin(cat_builtin_int(IntType)), ( ( IntType = int_type_int ; IntType = int_type_uint ; IntType = int_type_int8 ; IntType = int_type_uint8 ; IntType = int_type_int16 ; IntType = int_type_uint16 ; IntType = int_type_int32 ; IntType = int_type_uint32 ), MustBox = no ; ( IntType = int_type_int64 ; IntType = int_type_uint64 ), ( UnboxedInt64s = yes, MustBox = no ; UnboxedInt64s = no, ( Width = aw_full_word, MustBox = yes ; Width = aw_double_word, unexpected($pred, "double word for 64-bit integer") ; Width = aw_partial_word, unexpected($pred, "partial word for 64-bit integer") ; Width = aw_none, unexpected($pred, "none for 64-bit integer") ) ) ) ; ( 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 = aw_full_word, MustBox = yes ; Width = aw_double_word, MustBox = no ; Width = aw_partial_word, unexpected($pred, "partial word for float") ; Width = aw_none, unexpected($pred, "none for float") ) ) ). %---------------------------------------------------------------------------% ml_gen_box_const_rval(ModuleInfo, Context, MLDS_Type, Width, Rval, BoxedRval, !GlobalData) :- ( if ( MLDS_Type = mercury_nb_type(type_variable(_, _), _) ; MLDS_Type = mlds_generic_type ) then BoxedRval = Rval else if % For the MLDS->C back-end, we need to handle constant floats, % int64s and uint64s specially. Boxed floats, int64s and uint64s % 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 = mlds_builtin_type_float, ConstVarKind = mgcv_float ; MLDS_Type = mlds_builtin_type_int(IntType), ( IntType = int_type_int64, ConstVarKind = mgcv_int64 ; IntType = int_type_uint64, ConstVarKind = mgcv_uint64 ) ), ml_global_data_get_target(!.GlobalData, ml_target_c) then ( if ( ConstVarKind = mgcv_float, ml_global_data_have_unboxed_floats(!.GlobalData, do_not_have_unboxed_floats) ; ( ConstVarKind = mgcv_int64 ; ConstVarKind = mgcv_uint64 ), ml_global_data_have_unboxed_int64s(!.GlobalData, do_not_have_unboxed_int64s) ), arg_width_is_double(Width, no) then % Generate a local static constant for this float, int64 or uint64. 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, ConstVarKind, MLDS_Type, Initializer, Context, ConstAddrRval, !GlobalData), % Return as the boxed rval the address of that constant, % cast to mlds_generic_type. BoxedRval = ml_cast(mlds_generic_type, ConstAddrRval) else % This is not a real box, but a cast. The "box" is required as it % may be further cast to pointer types. BoxedRval = ml_box(MLDS_Type, Rval) ) else BoxedRval = ml_box(MLDS_Type, Rval) ). :- pred arg_width_is_double(arg_width::in, bool::out) is det. arg_width_is_double(ArgWidth, DoubleWidth) :- ( ArgWidth = aw_double_word, DoubleWidth = yes ; ( ArgWidth = aw_full_word ; ArgWidth = aw_partial_word ; ArgWidth = aw_none ), DoubleWidth = no ). %---------------------------------------------------------------------------% ml_gen_box_or_unbox_rval(ModuleInfo, SourceType, DestType, BoxPolicy, VarRval, ArgRval) :- % Convert VarRval, of type SourceType, to ArgRval, of type DestType. ( BoxPolicy = bp_always_boxed, ArgRval = VarRval ; BoxPolicy = bp_native_if_possible, ml_gen_box_or_unbox_rval_native(ModuleInfo, SourceType, DestType, VarRval, ArgRval) ). ml_gen_box_or_unbox_rval_native(ModuleInfo, SourceType, DestType, VarRval, ArgRval) :- % We have special box/unbox rules for 2x2=4 situations: % % 1a convert from a type variable to something else % 1b convert to a type variable from something else % 2a convert from int64/uint64/float to something else % 2b convert to int64/uint64/float from something else % % By the definition of "something else", it is not possible for % the SourceType/DestType combination to match both 1a and 1b. % % It is possible for the SourceType/DestType combination to match % both 1a and 2b, or 1b and 2a. In these cases, the 1a or 2a rule has % precedence. This is the reason for the second test of DestType % in the code handling 2a below. % % It is not possible for the SourceType/DestType combination to match % both 2a and 2b, because any such change of type is beyond the scope % of a box or unbox operation. ( if ( SourceType = type_variable(_, _), DestType \= type_variable(_, _), % Converting from polymorphic type to concrete type: unbox. MLDS_DestType = mercury_type_to_mlds_type(ModuleInfo, DestType), ArgRvalPrime = ml_unbox(MLDS_DestType, VarRval) ; SourceType = builtin_type(SourceBuiltinType), ( SourceBuiltinType = builtin_type_int(IntType), ( IntType = int_type_int64 ; IntType = int_type_uint64 ) ; SourceBuiltinType = builtin_type_float ), DestType \= builtin_type(SourceBuiltinType), % Leave this to the DestType = type_variable(_, _) code below. DestType \= type_variable(_, _), % Converting from int64/uint64/float: box, then cast the result. MLDS_SourceType = mercury_type_to_mlds_type(ModuleInfo, SourceType), MLDS_DestType = mercury_type_to_mlds_type(ModuleInfo, DestType), ArgRvalPrime = ml_cast(MLDS_DestType, ml_box(MLDS_SourceType, VarRval)) ) then ArgRvalPrime = ArgRval else if ( DestType = type_variable(_, _), SourceType \= type_variable(_, _), % Converting from concrete type to polymorphic type: box. MLDS_SourceType = mercury_type_to_mlds_type(ModuleInfo, SourceType), ArgRvalPrime = ml_box(MLDS_SourceType, VarRval) ; DestType = builtin_type(DestBuiltinType), ( DestBuiltinType = builtin_type_int(IntType), ( IntType = int_type_int64 ; IntType = int_type_uint64 ) ; DestBuiltinType = builtin_type_float ), SourceType \= builtin_type(DestBuiltinType), % We have already tested for SourceType = type_variable(_, _). % Converting to int64/uint64/float: cast to mlds_generic_type, % and then unbox. MLDS_DestType = mercury_type_to_mlds_type(ModuleInfo, DestType), ArgRvalPrime = ml_unbox(MLDS_DestType, ml_cast(mlds_generic_type, VarRval)) ) then ArgRvalPrime = ArgRval else ml_gen_box_or_unbox_rval_native_std(ModuleInfo, SourceType, DestType, VarRval, ArgRval) ). :- pred ml_gen_box_or_unbox_rval_native_std(module_info::in, mer_type::in, mer_type::in, mlds_rval::in, mlds_rval::out) is det. :- pragma inline(pred(ml_gen_box_or_unbox_rval_native_std/5)). ml_gen_box_or_unbox_rval_native_std(ModuleInfo, SourceType, DestType, VarRval, ArgRval) :- ( if type_unify(SourceType, DestType, [], map.init, _), not unifiable_types_still_need_cast(SourceType, DestType) then % If converting from one concrete type to the same type, % leave the rval unchanged. ArgRval = VarRval else % If converting from one concrete type to a different one, then cast. % This is needed to handle construction/deconstruction unifications % for no_tag types. MLDS_DestType = mercury_type_to_mlds_type(ModuleInfo, DestType), ArgRval = ml_cast(MLDS_DestType, VarRval) ). :- pred unifiable_types_still_need_cast(mer_type::in, mer_type::in) is semidet. :- pragma inline(pred(unifiable_types_still_need_cast/2)). unifiable_types_still_need_cast(SourceType, DestType) :- % XXX This exception from the "unifiable types do not need a cast" % path above was part of the implementation of arrays for .NET % added by trd in commit d4965acd721e480a31d618dadc95818cb4516df7. % A bootcheck in hlc.gc works just fine without this exception, % but the exception is still needed in java and csharp grades. % % Tyson's original comment, which was probably talking only about % the .NET backend, was: % 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. %---------------------------------------------------------------------------% ml_gen_box_or_unbox_lval(CallerType, CalleeType, BoxPolicy, VarLval, VarName, Context, ForClosureWrapper, ArgNum, ArgLval, ConvDecls, ConvInputStmts, ConvOutputStmts, !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), ( if BoxedRval = ml_lval(VarLval) then ArgLval = VarLval, ConvDecls = [], ConvInputStmts = [], ConvOutputStmts = [] else % 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), ConvVarSeq = conv_seq(ConvVarNum), ( if VarName = lvn_prog_var(ProgVarName, ProgVarNum) then ArgVarName = lvn_prog_var_conv(ConvVarNum, ProgVarName, ProgVarNum) else VarNameStr = ml_local_var_name_to_string(VarName), ArgVarName = lvn_comp_var(lvnc_non_prog_var_conv(ConvVarNum, VarNameStr)) ), ml_gen_mlds_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. ( if CallerType = type_variable(_, _) then ml_gen_local_for_output_arg(ArgVarName, CalleeType, ArgNum, Context, ArgVarDecl, !Info) else unexpected($pred, "invalid CalleeType for closure wrapper") ) ; ForClosureWrapper = no, ml_gen_gc_statement_poly(ArgVarName, CalleeType, CallerType, Context, GC_Stmts, !Info), ArgVarDecl = ml_gen_mlds_var_decl(ArgVarName, MLDS_CalleeType, GC_Stmts, Context) ), ConvDecls = [ArgVarDecl], % Create the lval for the variable and use it for the argument lval. ArgLval = ml_local_var(ArgVarName, MLDS_CalleeType), CallerIsDummy = is_type_a_dummy(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. ConvInputStmts = [], ConvOutputStmts = [] ; 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), AssignInputStmt = ml_gen_assign(ArgLval, ConvertedVarRval, Context), ConvInputStmts = [AssignInputStmt], % Assign from the freshly generated arg variable. ml_gen_box_or_unbox_rval(ModuleInfo, CalleeType, CallerType, BoxPolicy, ml_lval(ArgLval), ConvertedArgRval), AssignOutputStmt = ml_gen_assign(VarLval, ConvertedArgRval, Context), ConvOutputStmts = [AssignOutputStmt] ) ). %---------------------------------------------------------------------------% 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); % ClosureLayoutPtrName = lvn_comp_var(lvnc_closure_layout_ptr), % This type is really `const MR_Closure_Layout *', but there is no easy % way to represent that in the MLDS; using MR_Box instead works fine. ClosureLayoutPtrType = mlds_generic_type, ClosureLayoutPtrLval = ml_local_var(ClosureLayoutPtrName, ClosureLayoutPtrType), TypeParamsName = lvn_comp_var(lvnc_type_params), % 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, TypeParamsLval = ml_local_var(TypeParamsName, TypeParamsType), TypeInfoName = lvn_comp_var(lvnc_type_info), % 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), TypeInfoLval = ml_local_var(TypeInfoName, TypeInfoType), TypeInfoDecl = ml_gen_mlds_var_decl(TypeInfoName, TypeInfoType, gc_no_stmt, Context), ml_gen_gc_statement_with_typeinfo(VarName, Type, ml_lval(TypeInfoLval), Context, GCStmt0, !Info), ( ( GCStmt0 = gc_trace_code(CallTraceFuncCode) ; GCStmt0 = gc_initialiser(CallTraceFuncCode) ), MakeTypeInfoCodeC = 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)])) ]), MakeTypeInfoCode = ml_stmt_atomic(MakeTypeInfoCodeC, Context), DeallocateCodeC = inline_target_code(ml_target_c, [ raw_target_code("MR_deallocate(allocated_mem);\n"), raw_target_code("}\n") ]), DeallocateCode = ml_stmt_atomic(DeallocateCodeC, Context), % XXX MLDS_DEFN GCTraceCode = ml_stmt_block([TypeInfoDecl], [], [MakeTypeInfoCode, CallTraceFuncCode, DeallocateCode], Context), GCStmt = gc_trace_code(GCTraceCode) ; GCStmt0 = gc_no_stmt, GCStmt = GCStmt0 ), LocalVarDefn = ml_gen_mlds_var_decl(VarName, mercury_type_to_mlds_type(ModuleInfo, Type), GCStmt, Context). %---------------------------------------------------------------------------% % % Code for handling success and failure. % ml_gen_success(CodeModel, Context, Stmts, !Info) :- ( CodeModel = model_det, % % det succeed: % % ===> % /* just fall through */ % Stmts = [] ; CodeModel = model_semi, % % semidet succeed: % % ===> % succeeded = MR_TRUE; % ml_gen_set_success(ml_const(mlconst_true), Context, SetSuccessTrue, !Info), Stmts = [SetSuccessTrue] ; CodeModel = model_non, % % nondet succeed: % % ===> % SUCCEED() % ml_gen_call_current_success_cont(!.Info, Context, CallCont), Stmts = [CallCont] ). ml_gen_failure(CodeModel, Context, Stmts, !Info) :- ( CodeModel = model_det, unexpected($pred, "`fail' has determinism `det'") ; CodeModel = model_semi, % % semidet fail: % % ===> % succeeded = MR_FALSE; % ml_gen_set_success(ml_const(mlconst_false), Context, SetSuccessFalse, !Info), Stmts = [SetSuccessFalse] ; CodeModel = model_non, % % nondet fail: % % ===> % /* just fall through */ % Stmts = [] ). %---------------------------------------------------------------------------% ml_gen_succeeded_var_decl(Context) = ml_gen_mlds_var_decl(lvn_comp_var(lvnc_succeeded), mlds_native_bool_type, gc_no_stmt, Context). ml_success_lval(SucceededLval, !Info) :- SucceededLval = ml_local_var(lvn_comp_var(lvnc_succeeded), mlds_native_bool_type), ml_gen_info_set_used_succeeded_var(yes, !Info). ml_gen_test_success(SucceededRval, !Info) :- ml_success_lval(SucceededLval, !Info), SucceededRval = ml_lval(SucceededLval). ml_gen_set_success(Value, Context, Stmt, !Info) :- ml_success_lval(Succeeded, !Info), Stmt = ml_gen_assign(Succeeded, Value, Context). %---------------------------------------------------------------------------% % Generate the name for the specified `cond_' variable. % :- func ml_gen_cond_var_name(cond_seq) = mlds_local_var_name. ml_gen_cond_var_name(CondSeq) = VarName :- CondSeq = cond_seq(CondNum), VarName = lvn_comp_var(lvnc_cond(CondNum)). ml_gen_cond_var_decl(CondSeq, Context) = ml_gen_mlds_var_decl(ml_gen_cond_var_name(CondSeq), mlds_native_bool_type, gc_no_stmt, Context). ml_cond_var_lval(CondSeq, CondVarLval) :- CondVarLval = ml_local_var(ml_gen_cond_var_name(CondSeq), mlds_native_bool_type). ml_gen_test_cond_var(CondVar, CondVarRval) :- ml_cond_var_lval(CondVar, CondVarLval), CondVarRval = ml_lval(CondVarLval). ml_gen_set_cond_var(CondVar, Value, Context, Stmt) :- ml_cond_var_lval(CondVar, CondVarLval), Stmt = ml_gen_assign(CondVarLval, Value, Context). %---------------------------------------------------------------------------% ml_initial_cont(Info, OutputVarLvalsTypes, Cont) :- % We expect OutputVarLvalsTypes to be empty if `--nondet-copy-out' % is not enabled. ml_gen_info_get_module_info(Info, ModuleInfo), ml_skip_dummy_argument_types(ModuleInfo, OutputVarLvalsTypes, OutputVarLvalsMLDSTypes), assoc_list.values(OutputVarLvalsMLDSTypes, OutputVarMLDSTypes), ContLval = ml_local_var(lvn_comp_var(lvnc_cont), mlds_cont_type(OutputVarMLDSTypes)), ContEnvLval = ml_local_var(lvn_comp_var(lvnc_cont_env_ptr), mlds_generic_env_ptr_type), Cont = success_cont(ml_lval(ContLval), ml_lval(ContEnvLval), OutputVarLvalsMLDSTypes). :- pred ml_skip_dummy_argument_types(module_info::in, assoc_list(mlds_lval, mer_type)::in, assoc_list(mlds_lval, mlds_type)::out) is det. ml_skip_dummy_argument_types(_, [], []). ml_skip_dummy_argument_types(ModuleInfo, [Lval - Type | LvalsTypes], LvalsMLDSTypes) :- ml_skip_dummy_argument_types(ModuleInfo, LvalsTypes, TailLvalsMLDSTypes), IsDummy = is_type_a_dummy(ModuleInfo, Type), ( IsDummy = is_dummy_type, LvalsMLDSTypes = TailLvalsMLDSTypes ; IsDummy = is_not_dummy_type, MLDSType = mercury_type_to_mlds_type(ModuleInfo, Type), LvalsMLDSTypes = [Lval - MLDSType | TailLvalsMLDSTypes] ). ml_gen_call_current_success_cont(Info, Context, Stmt) :- ml_gen_info_current_success_cont(Info, SuccCont), SuccCont = success_cont(FuncRval, EnvPtrRval, ArgTypesLvals0), assoc_list.keys_and_values(ArgTypesLvals0, ArgLvals0, ArgTypes0), ArgRvals0 = list.map(func(Lval) = ml_lval(Lval), ArgLvals0), ArgRvals = ArgRvals0 ++ [EnvPtrRval], RetLvals = [], ArgTypes = ArgTypes0 ++ [mlds_generic_env_ptr_type], RetTypes = [], Signature = mlds_func_signature(ArgTypes, RetTypes), CallKind = ordinary_call, Stmt = ml_stmt_call(Signature, FuncRval, ArgRvals, RetLvals, CallKind, Context). %---------------------------------------------------------------------------% % % Routines for dealing with the environment pointer used for nested functions. % ml_get_env_ptr(ml_lval(EnvPtrLval)) :- EnvPtrLval = ml_local_var(lvn_comp_var(lvnc_env_ptr), mlds_unknown_type). ml_declare_env_ptr_arg(Arg) :- VarName = lvn_comp_var(lvnc_env_ptr_arg), Type = mlds_generic_env_ptr_type, % When targeting C, we always allocate continuation environments % on the stack, where our accurage GC does not need to trace it. % When targeting C# or Java, we use the target's builtin GC, % so again, there is no need for any info meant for our own % accurate GC system. GCStatement = gc_no_stmt, Arg = mlds_argument(VarName, Type, GCStatement). %---------------------------------------------------------------------------% % 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, _LocalVarDefns, _FuncDefns, _Stmts, !Info), ml_gen_info_get_const_var_map(!.Info, FinalConstVarMap), list.map(search_ground_rval(FinalConstVarMap), Vars, Soln), ml_gen_info_set_const_var_map(InitConstVarMap, !Info). :- pred search_ground_rval(ml_ground_term_map::in, prog_var::in, mlds_rval::out) is semidet. search_ground_rval(FinalConstVarMap, Var, Rval) :- map.search(FinalConstVarMap, Var, GroundTerm), GroundTerm = ml_ground_term(Rval, _, _). ml_generate_field_assign(OutVarLval, FieldType, FieldId, VectorCommon, StructType, IndexRval, Context, Stmt) :- BaseRval = ml_vector_common_row_addr(VectorCommon, IndexRval), FieldLval = ml_field(yes(ptag(0u8)), BaseRval, StructType, FieldId, FieldType), AtomicStmt = assign(OutVarLval, ml_lval(FieldLval)), Stmt = ml_stmt_atomic(AtomicStmt, Context). ml_generate_field_assigns(OutVars, FieldTypes, FieldIds, VectorCommon, StructType, IndexRval, Context, Stmts, !Info) :- ( if OutVars = [], FieldTypes = [], FieldIds = [] then Stmts = [] else if OutVars = [HeadOutVar | TailOutVars], FieldTypes = [HeadFieldType | TailFieldTypes], FieldIds = [HeadFieldId | TailFieldIds] then ml_gen_var_direct(!.Info, HeadOutVar, HeadOutVarLval), ml_generate_field_assign(HeadOutVarLval, HeadFieldType, HeadFieldId, VectorCommon, StructType, IndexRval, Context, HeadStmt), ml_generate_field_assigns(TailOutVars, TailFieldTypes, TailFieldIds, VectorCommon, StructType, IndexRval, Context, TailStmts, !Info), Stmts = [HeadStmt | TailStmts] else unexpected($pred, "mismatched lists") ). %---------------------------------------------------------------------------% % % Miscellaneous routines. % fixup_builtin_module(ModuleName0) = ModuleName :- ( if ModuleName0 = unqualified("") then ModuleName = mercury_public_builtin_module else ModuleName = ModuleName0 ). %---------------------------------------------------------------------------% :- end_module ml_backend.ml_code_util. %---------------------------------------------------------------------------%