%-----------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %-----------------------------------------------------------------------------% % Copyright (C) 1994-2006 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: unify_proc.m. % % This module encapsulates access to the proc_requests table, and constructs % the clauses for out-of-line complicated unification procedures. % It also generates the code for other compiler-generated type-specific % predicates such as compare/3. % % During mode analysis, we notice each different complicated unification % that occurs. For each one we add a new mode to the out-of-line % unification predicate for that type, and we record in the `proc_requests' % table that we need to eventually modecheck that mode of the unification % procedure. % % After we've done mode analysis for all the ordinary predicates, we then % do mode analysis for the out-of-line unification procedures. Note that % unification procedures may call other unification procedures which have % not yet been encountered, causing new entries to be added to the % proc_requests table. We store the entries in a queue and continue the % process until the queue is empty. % % The same queuing mechanism is also used for procedures created by % mode inference during mode analysis and unique mode analysis. % % Currently if the same complicated unification procedure is called by % different modules, each module will end up with a copy of the code for % that procedure. In the long run it would be desireable to either delay % generation of complicated unification procedures until link time (like % Cfront does with C++ templates) or to have a smart linker which could % merge duplicate definitions (like Borland C++). However the amount of % code duplication involved is probably very small, so it's definitely not % worth worrying about right now. % XXX What about complicated unification of an abstract type in a partially % instantiated mode? Currently we don't implement it correctly. Probably % it should be disallowed, but we should issue a proper error message. %-----------------------------------------------------------------------------% :- module check_hlds.unify_proc. :- interface. :- import_module check_hlds.mode_info. :- import_module hlds.hlds_clauses. :- import_module hlds.hlds_data. :- import_module hlds.hlds_goal. :- import_module hlds.hlds_module. :- import_module hlds.hlds_pred. :- import_module hlds.pred_table. :- import_module mdbcomp.prim_data. :- import_module parse_tree.prog_data. :- import_module bool. :- import_module io. :- import_module list. :- import_module maybe. :- import_module pair. %-----------------------------------------------------------------------------% :- type proc_requests. :- type unify_proc_id == pair(type_ctor, uni_mode). % Initialize the proc_requests table. % :- pred init_requests(proc_requests::out) is det. % Add a new request for a unification procedure to the proc_requests table. % :- pred request_unify(unify_proc_id::in, inst_varset::in, determinism::in, prog_context::in, module_info::in, module_info::out) is det. % Add a new request for a procedure (not necessarily a unification) % to the request queue. Return the procedure's newly allocated proc_id. % (This is used by unique_modes.m.) % :- pred request_proc(pred_id::in, list(mer_mode)::in, inst_varset::in, maybe(list(is_live))::in, maybe(determinism)::in, prog_context::in, proc_id::out, module_info::in, module_info::out) is det. % add_lazily_generated_unify_pred(TypeCtor, UnifyPredId_for_Type, % !ModuleInfo): % % For most imported unification procedures, we delay generating % declarations and clauses until we know whether they are actually needed % because there is a complicated unification involving the type. % This predicate is exported for use by higher_order.m when it is % specializing calls to unify/2. % :- pred add_lazily_generated_unify_pred(type_ctor::in, pred_id::out, module_info::in, module_info::out) is det. % add_lazily_generated_compare_pred_decl(TypeCtor, ComparePredId_for_Type, % !ModuleInfo): % % Add declarations, but not clauses, for a compare or index predicate. % :- pred add_lazily_generated_compare_pred_decl(type_ctor::in, pred_id::out, module_info::in, module_info::out) is det. % Do mode analysis of the queued procedures. If the first argument is % `unique_mode_check', then also go on and do full determinism analysis % and unique mode analysis on them as well. The pred_table arguments % are used to store copies of the procedure bodies before unique mode % analysis, so that we can restore them before doing the next analysis % pass. % :- pred modecheck_queued_procs(how_to_check_goal::in, pred_table::in, pred_table::out, module_info::in, module_info::out, bool::out, io::di, io::uo) is det. % Given the type and mode of a unification, look up the mode number % for the unification proc. % :- pred lookup_mode_num(module_info::in, type_ctor::in, uni_mode::in, determinism::in, proc_id::out) is det. % Generate the clauses for one of the compiler-generated special predicates % (compare/3, index/3, unify/2, etc.) % :- pred generate_clause_info(special_pred_id::in, mer_type::in, hlds_type_body::in, prog_context::in, module_info::in, clauses_info::out) is det. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module check_hlds.clause_to_proc. :- import_module check_hlds.cse_detection. :- import_module check_hlds.det_analysis. :- import_module check_hlds.inst_match. :- import_module check_hlds.modes. :- import_module check_hlds.mode_util. :- import_module check_hlds.polymorphism. :- import_module check_hlds.post_typecheck. :- import_module check_hlds.switch_detection. :- import_module check_hlds.type_util. :- import_module check_hlds.unique_modes. :- import_module hlds.goal_util. :- import_module hlds.hlds_out. :- import_module hlds.instmap. :- import_module hlds.make_hlds. :- import_module hlds.quantification. :- import_module hlds.hlds_rtti. :- import_module hlds.special_pred. :- import_module libs.compiler_util. :- import_module libs.globals. :- import_module libs.options. :- import_module libs.tree. :- import_module mdbcomp.prim_data. :- import_module parse_tree.mercury_to_mercury. :- import_module parse_tree.prog_mode. :- import_module parse_tree.prog_out. :- import_module parse_tree.prog_type. :- import_module parse_tree.prog_util. :- import_module recompilation. :- import_module assoc_list. :- import_module int. :- import_module map. :- import_module queue. :- import_module set. :- import_module string. :- import_module term. :- import_module varset. %-----------------------------------------------------------------------------% % We keep track of all the complicated unification procs we need % by storing them in the proc_requests structure. % For each unify_proc_id (i.e. type & mode), we store the proc_id % (mode number) of the unification procedure which corresponds to % that mode. % :- type unify_req_map == map(unify_proc_id, proc_id). :- type req_queue == queue(pred_proc_id). :- type proc_requests ---> proc_requests( unify_req_map :: unify_req_map, % The assignment of proc_id numbers to % unify_proc_ids. req_queue :: req_queue % The queue of procs we still to generate code % for. ). %-----------------------------------------------------------------------------% init_requests(Requests) :- map.init(UnifyReqMap), queue.init(ReqQueue), Requests = proc_requests(UnifyReqMap, ReqQueue). %-----------------------------------------------------------------------------% % Boring access predicates :- pred get_unify_req_map(proc_requests::in, unify_req_map::out) is det. :- pred get_req_queue(proc_requests::in, req_queue::out) is det. :- pred set_unify_req_map(unify_req_map::in, proc_requests::in, proc_requests::out) is det. :- pred set_req_queue(req_queue::in, proc_requests::in, proc_requests::out) is det. get_unify_req_map(PR, PR ^ unify_req_map). get_req_queue(PR, PR ^ req_queue). set_unify_req_map(UnifyReqMap, PR, PR ^ unify_req_map := UnifyReqMap). set_req_queue(ReqQueue, PR, PR ^ req_queue := ReqQueue). %-----------------------------------------------------------------------------% lookup_mode_num(ModuleInfo, TypeCtor, UniMode, Det, Num) :- ( search_mode_num(ModuleInfo, TypeCtor, UniMode, Det, Num1) -> Num = Num1 ; unexpected(this_file, "search_num failed") ). :- pred search_mode_num(module_info::in, type_ctor::in, uni_mode::in, determinism::in, proc_id::out) is semidet. % Given the type, mode, and determinism of a unification, look up the % mode number for the unification proc. % We handle semidet unifications with mode (in, in) specially - they % are always mode zero. Similarly for unifications of `any' insts. % (It should be safe to use the `in, in' mode for any insts, since % we assume that `ground' and `any' have the same representation.) % For unreachable unifications, we also use mode zero. % search_mode_num(ModuleInfo, TypeCtor, UniMode, Determinism, ProcId) :- UniMode = (XInitial - YInitial -> _Final), ( Determinism = semidet, inst_is_ground_or_any(ModuleInfo, XInitial), inst_is_ground_or_any(ModuleInfo, YInitial) -> hlds_pred.in_in_unification_proc_id(ProcId) ; XInitial = not_reached -> hlds_pred.in_in_unification_proc_id(ProcId) ; YInitial = not_reached -> hlds_pred.in_in_unification_proc_id(ProcId) ; module_info_get_proc_requests(ModuleInfo, Requests), get_unify_req_map(Requests, UnifyReqMap), map.search(UnifyReqMap, TypeCtor - UniMode, ProcId) ). %-----------------------------------------------------------------------------% request_unify(UnifyId, InstVarSet, Determinism, Context, !ModuleInfo) :- UnifyId = TypeCtor - UnifyMode, % Generating a unification procedure for a type uses its body. module_info_get_maybe_recompilation_info(!.ModuleInfo, MaybeRecompInfo0), ( MaybeRecompInfo0 = yes(RecompInfo0), recompilation.record_used_item(type_body_item, TypeCtor, TypeCtor, RecompInfo0, RecompInfo), module_info_set_maybe_recompilation_info(yes(RecompInfo), !ModuleInfo) ; MaybeRecompInfo0 = no ), % Check if this unification has already been requested, or % if the proc is hand defined. ( ( search_mode_num(!.ModuleInfo, TypeCtor, UnifyMode, Determinism, _) ; module_info_get_type_table(!.ModuleInfo, TypeTable), map.search(TypeTable, TypeCtor, TypeDefn), hlds_data.get_type_defn_body(TypeDefn, TypeBody), ( TypeCtor = TypeName - _TypeArity, TypeName = qualified(TypeModuleName, _), module_info_get_name(!.ModuleInfo, ModuleName), ModuleName = TypeModuleName, TypeBody = abstract_type(_) ; type_ctor_has_hand_defined_rtti(TypeCtor, TypeBody) ) ) -> true ; % Lookup the pred_id for the unification procedure that we are % going to generate. module_info_get_special_pred_map(!.ModuleInfo, SpecialPredMap), ( map.search(SpecialPredMap, spec_pred_unify - TypeCtor, PredId0) -> PredId = PredId0 ; % We generate unification predicates for most imported types % lazily, so add the declarations and clauses now. add_lazily_generated_unify_pred(TypeCtor, PredId, !ModuleInfo) ), % Convert from `uni_mode' to `list(mer_mode)'. UnifyMode = ((X_Initial - Y_Initial) -> (X_Final - Y_Final)), ArgModes0 = [(X_Initial -> X_Final), (Y_Initial -> Y_Final)], % For polymorphic types, add extra modes for the type_infos. in_mode(InMode), TypeCtor = _ - TypeArity, list.duplicate(TypeArity, InMode, TypeInfoModes), list.append(TypeInfoModes, ArgModes0, ArgModes), ArgLives = no, % XXX ArgLives should be part of the UnifyId request_proc(PredId, ArgModes, InstVarSet, ArgLives, yes(Determinism), Context, ProcId, !ModuleInfo), % Save the proc_id for this unify_proc_id. module_info_get_proc_requests(!.ModuleInfo, Requests0), get_unify_req_map(Requests0, UnifyReqMap0), map.set(UnifyReqMap0, UnifyId, ProcId, UnifyReqMap), set_unify_req_map(UnifyReqMap, Requests0, Requests), module_info_set_proc_requests(Requests, !ModuleInfo) ). request_proc(PredId, ArgModes, InstVarSet, ArgLives, MaybeDet, Context, ProcId, !ModuleInfo) :- % Create a new proc_info for this procedure. module_info_preds(!.ModuleInfo, Preds0), map.lookup(Preds0, PredId, PredInfo0), list.length(ArgModes, Arity), DeclaredArgModes = no, add_new_proc(InstVarSet, Arity, ArgModes, DeclaredArgModes, ArgLives, MaybeDet, Context, address_is_not_taken, PredInfo0, PredInfo1, ProcId), % Copy the clauses for the procedure from the pred_info to the proc_info, % and mark the procedure as one that cannot be processed yet. pred_info_get_procedures(PredInfo1, Procs1), pred_info_clauses_info(PredInfo1, ClausesInfo), map.lookup(Procs1, ProcId, ProcInfo0), proc_info_set_can_process(no, ProcInfo0, ProcInfo1), copy_clauses_to_proc(ProcId, ClausesInfo, ProcInfo1, ProcInfo2), proc_info_get_goal(ProcInfo2, Goal0), set_goal_contexts(Context, Goal0, Goal), proc_info_set_goal(Goal, ProcInfo2, ProcInfo), map.det_update(Procs1, ProcId, ProcInfo, Procs2), pred_info_set_procedures(Procs2, PredInfo1, PredInfo2), map.det_update(Preds0, PredId, PredInfo2, Preds2), module_info_set_preds(Preds2, !ModuleInfo), % Insert the pred_proc_id into the request queue. module_info_get_proc_requests(!.ModuleInfo, Requests0), get_req_queue(Requests0, ReqQueue0), queue.put(ReqQueue0, proc(PredId, ProcId), ReqQueue), set_req_queue(ReqQueue, Requests0, Requests), module_info_set_proc_requests(Requests, !ModuleInfo). %-----------------------------------------------------------------------------% % XXX these belong in modes.m modecheck_queued_procs(HowToCheckGoal, !OldPredTable, !ModuleInfo, Changed, !IO) :- module_info_get_proc_requests(!.ModuleInfo, Requests0), get_req_queue(Requests0, RequestQueue0), ( queue.get(RequestQueue0, PredProcId, RequestQueue1) -> set_req_queue(RequestQueue1, Requests0, Requests1), module_info_set_proc_requests(Requests1, !ModuleInfo), % % Check that the procedure is valid (i.e. type-correct), before % we attempt to do mode analysis on it. This check is necessary % to avoid internal errors caused by doing mode analysis on % type-incorrect code. % XXX inefficient! This is O(N*M). % PredProcId = proc(PredId, _ProcId), module_info_predids(!.ModuleInfo, ValidPredIds), ( list.member(PredId, ValidPredIds) -> queued_proc_progress_message(PredProcId, HowToCheckGoal, !.ModuleInfo, !IO), modecheck_queued_proc(HowToCheckGoal, PredProcId, !OldPredTable, !ModuleInfo, Changed1, !IO) ; Changed1 = no ), modecheck_queued_procs(HowToCheckGoal, !OldPredTable, !ModuleInfo, Changed2, !IO), bool.or(Changed1, Changed2, Changed) ; Changed = no ). :- pred queued_proc_progress_message(pred_proc_id::in, how_to_check_goal::in, module_info::in, io::di, io::uo) is det. queued_proc_progress_message(PredProcId, HowToCheckGoal, ModuleInfo, !IO) :- globals.io_lookup_bool_option(very_verbose, VeryVerbose, !IO), ( VeryVerbose = yes, ( HowToCheckGoal = check_unique_modes -> io.write_string("% Analyzing modes, determinism, " ++ "and unique-modes for\n% ", !IO) ; io.write_string("% Mode-analyzing ", !IO) ), PredProcId = proc(PredId, ProcId), hlds_out.write_pred_proc_id(ModuleInfo, PredId, ProcId, !IO), io.write_string("\n", !IO) % /***** % mode_list_get_initial_insts(Modes, ModuleInfo1, % InitialInsts), % io.write_string("% Initial insts: `", !IO), % varset.init(InstVarSet), % mercury_output_inst_list(InitialInsts, InstVarSet, !IO), % io.write_string("'\n", !IO) % *****/ ; VeryVerbose = no ). :- pred modecheck_queued_proc(how_to_check_goal::in, pred_proc_id::in, pred_table::in, pred_table::out, module_info::in, module_info::out, bool::out, io::di, io::uo) is det. modecheck_queued_proc(HowToCheckGoal, PredProcId, !OldPredTable, !ModuleInfo, Changed, !IO) :- % Mark the procedure as ready to be processed. PredProcId = proc(PredId, ProcId), module_info_preds(!.ModuleInfo, Preds0), map.lookup(Preds0, PredId, PredInfo0), pred_info_get_procedures(PredInfo0, Procs0), map.lookup(Procs0, ProcId, ProcInfo0), proc_info_set_can_process(yes, ProcInfo0, ProcInfo1), map.det_update(Procs0, ProcId, ProcInfo1, Procs1), pred_info_set_procedures(Procs1, PredInfo0, PredInfo1), map.det_update(Preds0, PredId, PredInfo1, Preds1), module_info_set_preds(Preds1, !ModuleInfo), % Modecheck the procedure. modecheck_proc(ProcId, PredId, !ModuleInfo, NumErrors, Changed1, !IO), ( NumErrors \= 0 -> io.set_exit_status(1, !IO), module_info_remove_predid(PredId, !ModuleInfo), Changed = Changed1 ; ( HowToCheckGoal = check_unique_modes -> detect_switches_in_proc(ProcId, PredId, !ModuleInfo), detect_cse_in_proc(ProcId, PredId, !ModuleInfo, !IO), determinism_check_proc(ProcId, PredId, !ModuleInfo, !IO), save_proc_info(ProcId, PredId, !.ModuleInfo, !OldPredTable), unique_modes.check_proc(ProcId, PredId, !ModuleInfo, Changed2, !IO), bool.or(Changed1, Changed2, Changed) ; Changed = Changed1 ) ). % Save a copy of the proc info for the specified procedure in % !OldProcTable. % :- pred save_proc_info(proc_id::in, pred_id::in, module_info::in, pred_table::in, pred_table::out) is det. save_proc_info(ProcId, PredId, ModuleInfo, !OldPredTable) :- module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _PredInfo, ProcInfo), map.lookup(!.OldPredTable, PredId, OldPredInfo0), pred_info_get_procedures(OldPredInfo0, OldProcTable0), map.set(OldProcTable0, ProcId, ProcInfo, OldProcTable), pred_info_set_procedures(OldProcTable, OldPredInfo0, OldPredInfo), map.det_update(!.OldPredTable, PredId, OldPredInfo, !:OldPredTable). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% add_lazily_generated_unify_pred(TypeCtor, PredId, !ModuleInfo) :- ( type_ctor_is_tuple(TypeCtor) -> TypeCtor = _ - TupleArity, % Build a hlds_type_body for the tuple constructor, which will % be used by generate_clause_info. varset.init(TVarSet0), varset.new_vars(TVarSet0, TupleArity, TupleArgTVars, TVarSet), prog_type.var_list_to_type_list(map.init, TupleArgTVars, TupleArgTypes), % Tuple constructors can't be existentially quantified. ExistQVars = [], ClassConstraints = [], MakeUnamedField = (func(ArgType) = no - ArgType), CtorArgs = list.map(MakeUnamedField, TupleArgTypes), Ctor = ctor(ExistQVars, ClassConstraints, CtorSymName, CtorArgs), CtorSymName = unqualified("{}"), ConsId = cons(CtorSymName, TupleArity), map.from_assoc_list([ConsId - single_functor], ConsTagValues), UnifyPred = no, IsEnum = not_enum_or_dummy, IsForeign = no, ReservedTag = no, IsForeign = no, TypeBody = du_type([Ctor], ConsTagValues, IsEnum, UnifyPred, ReservedTag, IsForeign), construct_type(TypeCtor, TupleArgTypes, Type), term.context_init(Context) ; collect_type_defn(!.ModuleInfo, TypeCtor, Type, TVarSet, TypeBody, Context) ), ( can_generate_special_pred_clauses_for_type(!.ModuleInfo, TypeCtor, TypeBody) -> % If the unification predicate has another status it should % already have been generated. UnifyPredStatus = pseudo_imported, Item = clauses ; UnifyPredStatus = imported(implementation), Item = declaration ), add_lazily_generated_special_pred(spec_pred_unify, Item, TVarSet, Type, TypeCtor, TypeBody, Context, UnifyPredStatus, PredId, !ModuleInfo). add_lazily_generated_compare_pred_decl(TypeCtor, PredId, !ModuleInfo) :- collect_type_defn(!.ModuleInfo, TypeCtor, Type, TVarSet, TypeBody, Context), % If the compare predicate has another status, it should already have been % generated. ImportStatus = imported(implementation), add_lazily_generated_special_pred(spec_pred_compare, declaration, TVarSet, Type, TypeCtor, TypeBody, Context, ImportStatus, PredId, !ModuleInfo). :- pred add_lazily_generated_special_pred(special_pred_id::in, unify_pred_item::in, tvarset::in, mer_type::in, type_ctor::in, hlds_type_body::in, context::in, import_status::in, pred_id::out, module_info::in, module_info::out) is det. add_lazily_generated_special_pred(SpecialId, Item, TVarSet, Type, TypeCtor, TypeBody, Context, PredStatus, PredId, !ModuleInfo) :- % Add the declaration and maybe clauses. ( Item = clauses, add_special_pred_for_real(SpecialId, TVarSet, Type, TypeCtor, TypeBody, Context, PredStatus, !ModuleInfo) ; Item = declaration, add_special_pred_decl_for_real(SpecialId, TVarSet, Type, TypeCtor, Context, PredStatus, !ModuleInfo) ), module_info_get_special_pred_map(!.ModuleInfo, SpecialPredMap), map.lookup(SpecialPredMap, SpecialId - TypeCtor, PredId), module_info_pred_info(!.ModuleInfo, PredId, PredInfo0), % The clauses are generated with all type information computed, % so just go on to post_typecheck. ( Item = clauses, post_typecheck.finish_pred_no_io(!.ModuleInfo, ErrorProcs, PredInfo0, PredInfo) ; Item = declaration, post_typecheck.finish_imported_pred_no_io(!.ModuleInfo, ErrorProcs, PredInfo0, PredInfo) ), expect(unify(ErrorProcs, []), this_file, "add_lazily_generated_special_pred: error in post_typecheck"), % Call polymorphism to introduce type_info arguments % for polymorphic types. module_info_set_pred_info(PredId, PredInfo, !ModuleInfo), % Note that this will not work if the generated clauses call % a polymorphic predicate which requires type_infos to be added. % Such calls can be generated by generate_clause_info, % but unification predicates which contain such calls are never % generated lazily. polymorphism.process_generated_pred(PredId, !ModuleInfo). :- type unify_pred_item ---> declaration ; clauses. :- pred collect_type_defn(module_info::in, type_ctor::in, mer_type::out, tvarset::out, hlds_type_body::out, prog_context::out) is det. collect_type_defn(ModuleInfo, TypeCtor, Type, TVarSet, TypeBody, Context) :- module_info_get_type_table(ModuleInfo, Types), map.lookup(Types, TypeCtor, TypeDefn), hlds_data.get_type_defn_tvarset(TypeDefn, TVarSet), hlds_data.get_type_defn_tparams(TypeDefn, TypeParams), hlds_data.get_type_defn_kind_map(TypeDefn, KindMap), hlds_data.get_type_defn_body(TypeDefn, TypeBody), hlds_data.get_type_defn_status(TypeDefn, TypeStatus), hlds_data.get_type_defn_context(TypeDefn, Context), expect(special_pred_is_generated_lazily(ModuleInfo, TypeCtor, TypeBody, TypeStatus), this_file, "add_lazily_generated_unify_pred"), prog_type.var_list_to_type_list(KindMap, TypeParams, TypeArgs), construct_type(TypeCtor, TypeArgs, Type). %-----------------------------------------------------------------------------% generate_clause_info(SpecialPredId, Type, TypeBody, Context, ModuleInfo, ClauseInfo) :- special_pred_interface(SpecialPredId, Type, ArgTypes, _Modes, _Det), some [!Info] ( info_init(ModuleInfo, !:Info), make_fresh_named_vars_from_types(ArgTypes, "HeadVar__", 1, Args, !Info), ( SpecialPredId = spec_pred_unify, ( Args = [H1, H2] -> generate_unify_clauses(Type, TypeBody, H1, H2, Context, Clauses, !Info) ; unexpected(this_file, "generate_clause_info: bad unify args") ) ; SpecialPredId = spec_pred_index, ( Args = [X, Index] -> generate_index_clauses(TypeBody, X, Index, Context, Clauses, !Info) ; unexpected(this_file, "generate_clause_info: bad index args") ) ; SpecialPredId = spec_pred_compare, ( Args = [Res, X, Y] -> generate_compare_clauses(Type, TypeBody, Res, X, Y, Context, Clauses, !Info) ; unexpected(this_file, "generate_clause_info: bad compare args") ) ; SpecialPredId = spec_pred_init, ( Args = [X] -> generate_initialise_clauses(Type, TypeBody, X, Context, Clauses, !Info) ; unexpected(this_file, "generate_clause_info: bad init args") ) ), info_extract(!.Info, VarSet, Types) ), map.init(TVarNameMap), rtti_varmaps_init(RttiVarMaps), set_clause_list(Clauses, ClausesRep), HasForeignClauses = yes, ClauseInfo = clauses_info(VarSet, Types, TVarNameMap, Types, Args, ClausesRep, RttiVarMaps, HasForeignClauses). :- pred generate_initialise_clauses(mer_type::in, hlds_type_body::in, prog_var::in, prog_context::in, list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det. generate_initialise_clauses(_Type, TypeBody, X, Context, Clauses, !Info) :- info_get_module_info(!.Info, ModuleInfo), ( type_util.type_body_has_solver_type_details(ModuleInfo, TypeBody, SolverTypeDetails) -> % Just generate a call to the specified predicate, which is % the user-defined equality pred for this type. % (The pred_id and proc_id will be figured % out by type checking and mode analysis.) % InitPred = SolverTypeDetails ^ init_pred, PredId = invalid_pred_id, ModeId = invalid_proc_id, Call = call(PredId, ModeId, [X], not_builtin, no, InitPred), goal_info_init(Context, GoalInfo), Goal = Call - GoalInfo, quantify_clauses_body([X], Goal, Context, Clauses, !Info) ; % If this is an equivalence type then we just generate a call % to the initialisation pred of the type on the RHS of the equivalence % and cast the result back to the type on the LHS of the equivalence. TypeBody = eqv_type(EqvType) -> goal_info_init(Context, GoalInfo), make_fresh_named_var_from_type(EqvType, "PreCast_HeadVar", 1, X0, !Info), ( type_to_ctor_and_args(EqvType, TypeCtor0, _TypeArgs) -> TypeCtor = TypeCtor0 ; unexpected(this_file, "generate_initialise_clauses: type_to_ctor_and_args failed") ), PredName = special_pred.special_pred_name(spec_pred_init, TypeCtor), hlds_module.module_info_get_name(ModuleInfo, ModuleName), TypeCtor = TypeSymName - _TypeArity, sym_name_get_module_name(TypeSymName, ModuleName, TypeModuleName), InitPred = qualified(TypeModuleName, PredName), PredId = invalid_pred_id, ModeId = invalid_proc_id, InitCall = call(PredId, ModeId, [X0], not_builtin, no, InitPred), InitGoal = InitCall - GoalInfo, Any = any(shared), generate_cast(equiv_type_cast, X0, X, Any, Any, Context, CastGoal), Goal = conj(plain_conj, [InitGoal, CastGoal]) - GoalInfo, quantify_clauses_body([X], Goal, Context, Clauses, !Info) ; unexpected(this_file, "generate_initialise_clauses: " ++ "trying to create initialisation proc for type " ++ "that has no solver_type_details") ). :- pred generate_unify_clauses(mer_type::in, hlds_type_body::in, prog_var::in, prog_var::in, prog_context::in, list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det. generate_unify_clauses(Type, TypeBody, H1, H2, Context, Clauses, !Info) :- info_get_module_info(!.Info, ModuleInfo), ( type_body_has_user_defined_equality_pred(ModuleInfo, TypeBody, UserEqComp) -> generate_user_defined_unify_clauses(UserEqComp, H1, H2, Context, Clauses, !Info) ; ( Ctors = TypeBody ^ du_type_ctors, EnumDummy = TypeBody ^ du_type_is_enum, ( EnumDummy = is_enum, make_simple_test(H1, H2, explicit, [], Goal), quantify_clauses_body([H1, H2], Goal, Context, Clauses, !Info) ; EnumDummy = is_dummy, Goal = true_goal_with_context(Context), % XXX check me quantify_clauses_body([H1, H2], Goal, Context, Clauses, !Info) ; EnumDummy = not_enum_or_dummy, generate_du_unify_clauses(Ctors, H1, H2, Context, Clauses, !Info) ) ; TypeBody = eqv_type(EqvType), generate_unify_clauses_eqv_type(EqvType, H1, H2, Context, Clauses, !Info) ; TypeBody = solver_type(_, _), % If no user defined equality predicate is given, % we treat solver types as if they were an equivalent % to the builtin type c_pointer. generate_unify_clauses_eqv_type(c_pointer_type, H1, H2, Context, Clauses, !Info) ; TypeBody = foreign_type(_), % If no user defined equality predicate is given, % we treat foreign_type as if they were an equivalent % to the builtin type c_pointer. generate_unify_clauses_eqv_type(c_pointer_type, H1, H2, Context, Clauses, !Info) ; TypeBody = abstract_type(_), ( compiler_generated_rtti_for_builtins(ModuleInfo) -> TypeCategory = classify_type(ModuleInfo, Type), generate_builtin_unify(TypeCategory, H1, H2, Context, Clauses, !Info) ; unexpected(this_file, "trying to create unify proc for abstract type") ) ) ). :- pred generate_builtin_unify((type_category)::in, prog_var::in, prog_var::in, prog_context::in, list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det. generate_builtin_unify(TypeCategory, H1, H2, Context, Clauses, !Info) :- ArgVars = [H1, H2], % can_generate_special_pred_clauses_for_type ensures the unexpected % cases can never occur. ( TypeCategory = type_cat_int, Name = "builtin_unify_int" ; TypeCategory = type_cat_char, Name = "builtin_unify_character" ; TypeCategory = type_cat_string, Name = "builtin_unify_string" ; TypeCategory = type_cat_float, Name = "builtin_unify_float" ; TypeCategory = type_cat_higher_order, Name = "builtin_unify_pred" ; TypeCategory = type_cat_tuple, unexpected(this_file, "generate_builtin_unify: tuple") ; TypeCategory = type_cat_enum, unexpected(this_file, "generate_builtin_unify: enum") ; TypeCategory = type_cat_dummy, unexpected(this_file, "generate_builtin_unify: enum") ; TypeCategory = type_cat_variable, unexpected(this_file, "generate_builtin_unify: variable type") ; TypeCategory = type_cat_type_info, unexpected(this_file, "generate_builtin_unify: type_info type") ; TypeCategory = type_cat_type_ctor_info, unexpected(this_file, "generate_builtin_unify: type_ctor_info type") ; TypeCategory = type_cat_typeclass_info, unexpected(this_file, "generate_builtin_unify: typeclass_info type") ; TypeCategory = type_cat_base_typeclass_info, unexpected(this_file, "generate_builtin_unify: base_typeclass_info type") ; TypeCategory = type_cat_void, unexpected(this_file, "generate_builtin_unify: void type") ; TypeCategory = type_cat_user_ctor, unexpected(this_file, "generate_builtin_unify: user_ctor type") ), build_call(Name, ArgVars, Context, UnifyGoal, !Info), quantify_clauses_body(ArgVars, UnifyGoal, Context, Clauses, !Info). :- pred generate_user_defined_unify_clauses(unify_compare::in, prog_var::in, prog_var::in, prog_context::in, list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det. generate_user_defined_unify_clauses(abstract_noncanonical_type(_IsSolverType), _, _, _, _, !Info) :- unexpected(this_file, "trying to create unify proc for abstract noncanonical type"). generate_user_defined_unify_clauses(UserEqCompare, H1, H2, Context, Clauses, !Info) :- UserEqCompare = unify_compare(MaybeUnify, MaybeCompare), ( MaybeUnify = yes(UnifyPredName) -> % Just generate a call to the specified predicate, which is the % user-defined equality pred for this type. (The pred_id and proc_id % will be figured out by type checking and mode analysis.) PredId = invalid_pred_id, ModeId = invalid_proc_id, Call = call(PredId, ModeId, [H1, H2], not_builtin, no, UnifyPredName), goal_info_init(Context, GoalInfo), Goal = Call - GoalInfo ; MaybeCompare = yes(ComparePredName) -> % Just generate a call to the specified predicate, which is the % user-defined comparison pred for this type, and unify the result % with `='. (The pred_id and proc_id will be figured out by type % checking and mode analysis.) info_new_var(comparison_result_type, ResultVar, !Info), PredId = invalid_pred_id, ModeId = invalid_proc_id, Call = call(PredId, ModeId, [ResultVar, H1, H2], not_builtin, no, ComparePredName), goal_info_init(Context, GoalInfo), CallGoal = Call - GoalInfo, create_atomic_complicated_unification(ResultVar, equal_functor, Context, explicit, [], UnifyGoal), Goal = conj(plain_conj, [CallGoal, UnifyGoal]) - GoalInfo ; unexpected(this_file, "generate_user_defined_unify_clauses") ), quantify_clauses_body([H1, H2], Goal, Context, Clauses, !Info). :- pred generate_unify_clauses_eqv_type(mer_type::in, prog_var::in, prog_var::in, prog_context::in, list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det. generate_unify_clauses_eqv_type(EqvType, H1, H2, Context, Clauses, !Info) :- % We should check whether EqvType is a type variable, % an abstract type or a concrete type. % If it is type variable, then we should generate the same code % we generate now. If it is an abstract type, we should call % its unification procedure directly; if it is a concrete type, % we should generate the body of its unification procedure % inline here. make_fresh_named_var_from_type(EqvType, "Cast_HeadVar", 1, CastVar1, !Info), make_fresh_named_var_from_type(EqvType, "Cast_HeadVar", 2, CastVar2, !Info), generate_cast(equiv_type_cast, H1, CastVar1, Context, Cast1Goal), generate_cast(equiv_type_cast, H2, CastVar2, Context, Cast2Goal), create_atomic_complicated_unification(CastVar1, var(CastVar2), Context, explicit, [], UnifyGoal), goal_info_init(GoalInfo0), goal_info_set_context(Context, GoalInfo0, GoalInfo), conj_list_to_goal([Cast1Goal, Cast2Goal, UnifyGoal], GoalInfo, Goal), quantify_clauses_body([H1, H2], Goal, Context, Clauses, !Info). % This predicate generates the bodies of index predicates for the % types that need index predicates. % % add_special_preds in make_hlds.m should include index in the list % of special preds to define only for the kinds of types which do not % lead this predicate to abort. % :- pred generate_index_clauses(hlds_type_body::in, prog_var::in, prog_var::in, prog_context::in, list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det. generate_index_clauses(TypeBody, X, Index, Context, Clauses, !Info) :- info_get_module_info(!.Info, ModuleInfo), ( type_body_has_user_defined_equality_pred(ModuleInfo, TypeBody, _) -> % For non-canonical types, the generated comparison predicate either % calls a user-specified comparison predicate or returns an error, % and does not call the type's index predicate, so do not generate % an index predicate for such types. unexpected(this_file, "trying to create index proc for non-canonical type") ; ( Ctors = TypeBody ^ du_type_ctors, EnumDummy = TypeBody ^ du_type_is_enum, ( % For enum types, the generated comparison predicate performs % an integer comparison, and does not call the type's index % predicate, so do not generate an index predicate for such % types. EnumDummy = is_enum, unexpected(this_file, "trying to create index proc for enum type") ; EnumDummy = is_dummy, unexpected(this_file, "trying to create index proc for dummy type") ; EnumDummy = not_enum_or_dummy, generate_du_index_clauses(Ctors, X, Index, Context, 0, Clauses, !Info) ) ; TypeBody = eqv_type(_Type), % The only place that the index predicate for a type % can ever be called from is the compare predicate % for that type. However, the compare predicate for % an equivalence type never calls the index predicate % for that type; it calls the compare predicate of % the expanded type instead. Therefore the clause body % we are generating should never be invoked. unexpected(this_file, "trying to create index proc for eqv type") ; TypeBody = foreign_type(_), unexpected(this_file, "trying to create index proc for a foreign type") ; TypeBody = solver_type(_, _), unexpected(this_file, "trying to create index proc for a solver type") ; TypeBody = abstract_type(_), unexpected(this_file, "trying to create index proc for abstract type") ) ). :- pred generate_compare_clauses(mer_type::in, hlds_type_body::in, prog_var::in, prog_var::in, prog_var::in, prog_context::in, list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det. generate_compare_clauses(Type, TypeBody, Res, H1, H2, Context, Clauses, !Info) :- info_get_module_info(!.Info, ModuleInfo), ( type_body_has_user_defined_equality_pred(ModuleInfo, TypeBody, UserEqComp) -> generate_user_defined_compare_clauses(UserEqComp, Res, H1, H2, Context, Clauses, !Info) ; ( Ctors = TypeBody ^ du_type_ctors, EnumDummy = TypeBody ^ du_type_is_enum, ( EnumDummy = is_enum, generate_enum_compare_clauses(Res, H1, H2, Context, Clauses, !Info) ; EnumDummy = is_dummy, generate_dummy_compare_clauses(Res, H1, H2, Context, Clauses, !Info) ; EnumDummy = not_enum_or_dummy, generate_du_compare_clauses(Type, Ctors, Res, H1, H2, Context, Clauses, !Info) ) ; TypeBody = eqv_type(EqvType), generate_compare_clauses_eqv_type(EqvType, Res, H1, H2, Context, Clauses, !Info) ; TypeBody = foreign_type(_), generate_compare_clauses_eqv_type(c_pointer_type, Res, H1, H2, Context, Clauses, !Info) ; TypeBody = solver_type(_, _), generate_compare_clauses_eqv_type(c_pointer_type, Res, H1, H2, Context, Clauses, !Info) ; TypeBody = abstract_type(_), ( compiler_generated_rtti_for_builtins(ModuleInfo) -> TypeCategory = classify_type(ModuleInfo, Type), generate_builtin_compare(TypeCategory, Res, H1, H2, Context, Clauses, !Info) ; unexpected(this_file, "trying to create compare proc for abstract type") ) ) ). :- pred generate_enum_compare_clauses(prog_var::in, prog_var::in, prog_var::in, prog_context::in, list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det. generate_enum_compare_clauses(Res, H1, H2, Context, Clauses, !Info) :- IntType = int_type, make_fresh_named_var_from_type(IntType, "Cast_HeadVar", 1, CastVar1, !Info), make_fresh_named_var_from_type(IntType, "Cast_HeadVar", 2, CastVar2, !Info), generate_cast(unsafe_type_cast, H1, CastVar1, Context, Cast1Goal), generate_cast(unsafe_type_cast, H2, CastVar2, Context, Cast2Goal), build_call("builtin_compare_int", [Res, CastVar1, CastVar2], Context, CompareGoal, !Info), goal_info_init(GoalInfo0), goal_info_set_context(Context, GoalInfo0, GoalInfo), conj_list_to_goal([Cast1Goal, Cast2Goal, CompareGoal], GoalInfo, Goal), quantify_clauses_body([Res, H1, H2], Goal, Context, Clauses, !Info). :- pred generate_dummy_compare_clauses(prog_var::in, prog_var::in, prog_var::in, prog_context::in, list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det. generate_dummy_compare_clauses(Res, H1, H2, Context, Clauses, !Info) :- generate_return_equal(Res, Context, Goal), % XXX check me quantify_clauses_body([Res, H1, H2], Goal, Context, Clauses, !Info). :- pred generate_builtin_compare(type_category::in, prog_var::in, prog_var::in, prog_var::in, prog_context::in, list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det. generate_builtin_compare(TypeCategory, Res, H1, H2, Context, Clauses, !Info) :- ArgVars = [Res, H1, H2], % can_generate_special_pred_clauses_for_type ensures the unexpected % cases can never occur. ( TypeCategory = type_cat_int, Name = "builtin_compare_int" ; TypeCategory = type_cat_char, Name = "builtin_compare_character" ; TypeCategory = type_cat_string, Name = "builtin_compare_string" ; TypeCategory = type_cat_float, Name = "builtin_compare_float" ; TypeCategory = type_cat_higher_order, Name = "builtin_compare_pred" ; TypeCategory = type_cat_tuple, unexpected(this_file, "generate_builtin_compare: tuple type") ; TypeCategory = type_cat_enum, unexpected(this_file, "generate_builtin_compare: enum type") ; TypeCategory = type_cat_dummy, unexpected(this_file, "generate_builtin_compare: dummy type") ; TypeCategory = type_cat_variable, unexpected(this_file, "generate_builtin_compare: variable type") ; TypeCategory = type_cat_type_info, unexpected(this_file, "generate_builtin_compare: type_info type") ; TypeCategory = type_cat_type_ctor_info, unexpected(this_file, "generate_builtin_compare: type_ctor_info type") ; TypeCategory = type_cat_typeclass_info, unexpected(this_file, "generate_builtin_compare: typeclass_info type") ; TypeCategory = type_cat_base_typeclass_info, unexpected(this_file, "generate_builtin_compare: base_typeclass_info type") ; TypeCategory = type_cat_void, unexpected(this_file, "generate_builtin_compare: void type") ; TypeCategory = type_cat_user_ctor, unexpected(this_file, "generate_builtin_compare: user_ctor type") ), build_call(Name, ArgVars, Context, CompareGoal, !Info), quantify_clauses_body(ArgVars, CompareGoal, Context, Clauses, !Info). :- pred generate_user_defined_compare_clauses(unify_compare::in, prog_var::in, prog_var::in, prog_var::in, prog_context::in, list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det. generate_user_defined_compare_clauses(abstract_noncanonical_type(_), _, _, _, _, _, !Info) :- unexpected(this_file, "trying to create compare proc for abstract noncanonical type"). generate_user_defined_compare_clauses(unify_compare(_, MaybeCompare), Res, H1, H2, Context, Clauses, !Info) :- ArgVars = [Res, H1, H2], ( MaybeCompare = yes(ComparePredName), % % Just generate a call to the specified predicate, which is the % user-defined comparison pred for this type. (The pred_id and proc_id % will be figured out by type checking and mode analysis.) % PredId = invalid_pred_id, ModeId = invalid_proc_id, Call = call(PredId, ModeId, ArgVars, not_builtin, no, ComparePredName), goal_info_init(Context, GoalInfo), Goal = Call - GoalInfo ; MaybeCompare = no, % Just generate code that will call error/1. build_call("builtin_compare_non_canonical_type", ArgVars, Context, Goal, !Info) ), quantify_clauses_body(ArgVars, Goal, Context, Clauses, !Info). :- pred generate_compare_clauses_eqv_type(mer_type::in, prog_var::in, prog_var::in, prog_var::in, prog_context::in, list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det. generate_compare_clauses_eqv_type(EqvType, Res, H1, H2, Context, Clauses, !Info) :- % We should check whether EqvType is a type variable, an abstract type % or a concrete type. If it is type variable, then we should generate % the same code we generate now. If it is an abstract type, we should call % its comparison procedure directly; if it is a concrete type, we should % generate the body of its comparison procedure inline here. make_fresh_named_var_from_type(EqvType, "Cast_HeadVar", 1, CastVar1, !Info), make_fresh_named_var_from_type(EqvType, "Cast_HeadVar", 2, CastVar2, !Info), generate_cast(equiv_type_cast, H1, CastVar1, Context, Cast1Goal), generate_cast(equiv_type_cast, H2, CastVar2, Context, Cast2Goal), build_call("compare", [Res, CastVar1, CastVar2], Context, CompareGoal, !Info), goal_info_init(GoalInfo0), goal_info_set_context(Context, GoalInfo0, GoalInfo), conj_list_to_goal([Cast1Goal, Cast2Goal, CompareGoal], GoalInfo, Goal), quantify_clauses_body([Res, H1, H2], Goal, Context, Clauses, !Info). :- pred quantify_clauses_body(list(prog_var)::in, hlds_goal::in, prog_context::in, list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det. quantify_clauses_body(HeadVars, Goal, Context, Clauses, !Info) :- quantify_clause_body(HeadVars, Goal, Context, Clause, !Info), Clauses = [Clause]. :- pred quantify_clause_body(list(prog_var)::in, hlds_goal::in, prog_context::in, clause::out, unify_proc_info::in, unify_proc_info::out) is det. quantify_clause_body(HeadVars, Goal0, Context, Clause, !Info) :- info_get_varset(!.Info, Varset0), info_get_types(!.Info, Types0), implicitly_quantify_clause_body(HeadVars, _Warnings, Goal0, Goal, Varset0, Varset, Types0, Types), info_set_varset(Varset, !Info), info_set_types(Types, !Info), Clause = clause([], Goal, mercury, Context). %-----------------------------------------------------------------------------% % For a type such as % % type t ---> a1 ; a2 ; b(int) ; c(float); d(int, string, t). % % we want to generate the code % % __Unify__(X, Y) :- % ( % X = a1, % Y = X % % Actually, to avoid infinite recursion, % % the above unification is done as type int: % % CastX = unsafe_cast(X) `with_type` int, % % CastY = unsafe_cast(Y) `with_type` int, % % CastX = CastY % ; % X = a2, % Y = X % Likewise, done as type int % ; % X = b(X1), % Y = b(Y2), % X1 = Y2, % ; % X = c(X1), % Y = c(Y1), % X1 = X2, % ; % X = d(X1, X2, X3), % Y = c(Y1, Y2, Y3), % X1 = y1, % X2 = Y2, % X3 = Y3 % ). % % Note that in the disjuncts handling constants, we want to unify Y with % X, not with the constant. Doing this allows dupelim to take the code % fragments implementing the switch arms for constants and eliminate all % but one of them. This can be a significant code size saving for types % with lots of constants which can lead to significant reductions in C % compilation time. The keep_constant_binding feature on the cast goals is % there to ask mode analysis to copy any known bound inst on the cast-from % variable to the cast-to variable. This is necessary to keep determinism % analysis working for modes in which the inputs of the unify predicate % are known to be bound to the same constant, modes whose determinism % should therefore be inferred to be det. % (tests/general/det_complicated_unify2.m tests this case.) % :- pred generate_du_unify_clauses(list(constructor)::in, prog_var::in, prog_var::in, prog_context::in, list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det. generate_du_unify_clauses([], _X, _Y, _Context, [], !Info). generate_du_unify_clauses([Ctor | Ctors], X, Y, Context, [Clause | Clauses], !Info) :- Ctor = ctor(ExistQTVars, _Constraints, FunctorName, ArgTypes), list.length(ArgTypes, FunctorArity), FunctorConsId = cons(FunctorName, FunctorArity), ( ArgTypes = [], can_compare_constants_as_ints(!.Info) = yes -> create_atomic_complicated_unification(X, functor(FunctorConsId, no, []), Context, explicit, [], UnifyX_Goal), info_new_named_var(int_type, "CastX", CastX, !Info), info_new_named_var(int_type, "CastY", CastY, !Info), generate_cast(unsafe_type_cast, X, CastX, Context, CastXGoal0), generate_cast(unsafe_type_cast, Y, CastY, Context, CastYGoal0), goal_add_feature(keep_constant_binding, CastXGoal0, CastXGoal), goal_add_feature(keep_constant_binding, CastYGoal0, CastYGoal), create_atomic_complicated_unification(CastY, var(CastX), Context, explicit, [], UnifyY_Goal), GoalList = [UnifyX_Goal, CastXGoal, CastYGoal, UnifyY_Goal] ; make_fresh_vars(ArgTypes, ExistQTVars, Vars1, !Info), make_fresh_vars(ArgTypes, ExistQTVars, Vars2, !Info), create_atomic_complicated_unification(X, functor(FunctorConsId, no, Vars1), Context, explicit, [], UnifyX_Goal), create_atomic_complicated_unification(Y, functor(FunctorConsId, no, Vars2), Context, explicit, [], UnifyY_Goal), unify_var_lists(ArgTypes, ExistQTVars, Vars1, Vars2, UnifyArgs_Goals, !Info), GoalList = [UnifyX_Goal, UnifyY_Goal | UnifyArgs_Goals] ), goal_info_init(GoalInfo0), goal_info_set_context(Context, GoalInfo0, GoalInfo), conj_list_to_goal(GoalList, GoalInfo, Goal), quantify_clause_body([X, Y], Goal, Context, Clause, !Info), generate_du_unify_clauses(Ctors, X, Y, Context, Clauses, !Info). % Succeed iff the target back end guarantees that comparing two constants % for equality can be done by casting them both to integers and comparing % the integers for equality. % :- func can_compare_constants_as_ints(unify_proc_info) = bool. can_compare_constants_as_ints(Info) = CanCompareAsInt :- ModuleInfo = Info ^ module_info, module_info_get_globals(ModuleInfo, Globals), lookup_bool_option(Globals, can_compare_constants_as_ints, CanCompareAsInt). %-----------------------------------------------------------------------------% % For a type such as % % :- type foo ---> f ; g(a, b, c) ; h(foo). % % we want to generate the code % % index(X, Index) :- % ( % X = f, % Index = 0 % ; % X = g(_, _, _), % Index = 1 % ; % X = h(_), % Index = 2 % ). :- pred generate_du_index_clauses(list(constructor)::in, prog_var::in, prog_var::in, prog_context::in, int::in, list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det. generate_du_index_clauses([], _X, _Index, _Context, _N, [], !Info). generate_du_index_clauses([Ctor | Ctors], X, Index, Context, N, [Clause | Clauses], !Info) :- Ctor = ctor(ExistQTVars, _Constraints, FunctorName, ArgTypes), list.length(ArgTypes, FunctorArity), FunctorConsId = cons(FunctorName, FunctorArity), make_fresh_vars(ArgTypes, ExistQTVars, ArgVars, !Info), create_atomic_complicated_unification(X, functor(FunctorConsId, no, ArgVars), Context, explicit, [], UnifyX_Goal), make_int_const_construction(Index, N, UnifyIndex_Goal), GoalList = [UnifyX_Goal, UnifyIndex_Goal], goal_info_init(GoalInfo0), goal_info_set_context(Context, GoalInfo0, GoalInfo), conj_list_to_goal(GoalList, GoalInfo, Goal), quantify_clause_body([X, Index], Goal, Context, Clause, !Info), generate_du_index_clauses(Ctors, X, Index, Context, N + 1, Clauses, !Info). %-----------------------------------------------------------------------------% :- pred generate_du_compare_clauses(mer_type::in, list(constructor)::in, prog_var::in, prog_var::in, prog_var::in, prog_context::in, list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det. generate_du_compare_clauses(Type, Ctors, Res, H1, H2, Context, Clauses, !Info) :- ( Ctors = [], unexpected(this_file, "compare for type with no functors") ; Ctors = [_ | _], info_get_module_info(!.Info, ModuleInfo), module_info_get_globals(ModuleInfo, Globals), globals.lookup_int_option(Globals, compare_specialization, CompareSpec), list.length(Ctors, NumCtors), ( NumCtors =< CompareSpec -> generate_du_quad_compare_clauses( Ctors, Res, H1, H2, Context, Clauses, !Info) ; generate_du_linear_compare_clauses(Type, Ctors, Res, H1, H2, Context, Clauses, !Info) ) ). %-----------------------------------------------------------------------------% % For a du type, such as % % :- type foo ---> f(a) ; g(a, b, c) ; h. % % the quadratic code we want to generate is % % compare(Res, X, Y) :- % ( % X = f(X1), % Y = f(Y1), % compare(R, X1, Y1) % ; % X = f(_), % Y = g(_, _, _), % R = (<) % ; % X = f(_), % Y = h, % R = (<) % ; % X = g(_, _, _), % Y = f(_), % R = (>) % ; % X = g(X1, X2, X3), % Y = g(Y1, Y2, Y3), % ( compare(R1, X1, Y1), R1 \= (=) -> % R = R1 % ; compare(R2, X2, Y2), R2 \= (=) -> % R = R2 % ; % compare(R, X3, Y3) % ) % ; % X = g(_, _, _), % Y = h, % R = (<) % ; % X = f(_), % Y = h, % R = (<) % ; % X = g(_, _, _), % Y = h, % R = (<) % ; % X = h, % Y = h, % R = (<) % ). % % Note that in the clauses handling two copies of the same constant, % we unify Y with the constant, not with X. This is required to get % switch_detection and det_analysis to recognize the determinism of the % predicate. % :- pred generate_du_quad_compare_clauses(list(constructor)::in, prog_var::in, prog_var::in, prog_var::in, prog_context::in, list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det. generate_du_quad_compare_clauses(Ctors, R, X, Y, Context, Clauses, !Info) :- generate_du_quad_compare_clauses_1(Ctors, Ctors, R, X, Y, Context, [], Cases, !Info), goal_info_init(GoalInfo0), goal_info_set_context(Context, GoalInfo0, GoalInfo), disj_list_to_goal(Cases, GoalInfo, Goal), HeadVars = [R, X, Y], quantify_clauses_body(HeadVars, Goal, Context, Clauses, !Info). :- pred generate_du_quad_compare_clauses_1( list(constructor)::in, list(constructor)::in, prog_var::in, prog_var::in, prog_var::in, prog_context::in, list(hlds_goal)::in, list(hlds_goal)::out, unify_proc_info::in, unify_proc_info::out) is det. generate_du_quad_compare_clauses_1([], _RightCtors, _R, _X, _Y, _Context, !Cases, !Info). generate_du_quad_compare_clauses_1([LeftCtor | LeftCtors], RightCtors, R, X, Y, Context, !Cases, !Info) :- generate_du_quad_compare_clauses_2(LeftCtor, RightCtors, ">", R, X, Y, Context, !Cases, !Info), generate_du_quad_compare_clauses_1(LeftCtors, RightCtors, R, X, Y, Context, !Cases, !Info). :- pred generate_du_quad_compare_clauses_2( constructor::in, list(constructor)::in, string::in, prog_var::in, prog_var::in, prog_var::in, prog_context::in, list(hlds_goal)::in, list(hlds_goal)::out, unify_proc_info::in, unify_proc_info::out) is det. generate_du_quad_compare_clauses_2(_LeftCtor, [], _Cmp, _R, _X, _Y, _Context, !Cases, !Info). generate_du_quad_compare_clauses_2(LeftCtor, [RightCtor | RightCtors], Cmp0, R, X, Y, Context, !Cases, !Info) :- ( LeftCtor = RightCtor -> generate_compare_case(LeftCtor, R, X, Y, Context, quad, Case, !Info), Cmp1 = "<" ; generate_asymmetric_compare_case(LeftCtor, RightCtor, Cmp0, R, X, Y, Context, Case, !Info), Cmp1 = Cmp0 ), generate_du_quad_compare_clauses_2(LeftCtor, RightCtors, Cmp1, R, X, Y, Context, [Case | !.Cases], !:Cases, !Info). %-----------------------------------------------------------------------------% % For a du type, such as % % :- type foo ---> f ; g(a) ; h(b, foo). % % the linear code we want to generate is % % compare(Res, X, Y) :- % __Index__(X, X_Index), % Call_X_Index % __Index__(Y, Y_Index), % Call_Y_Index % ( X_Index < Y_Index -> % Call_Less_Than % Res = (<) % Return_Less_Than % ; X_Index > Y_Index -> % Call_Greater_Than % Res = (>) % Return_Greater_Than % ; % % This disjunction is generated by generate_compare_cases, % % below. % ( % X = f % R = (=) % ; % X = g(X1), % Y = g(Y1), % compare(R, X1, Y1) % ; % X = h(X1, X2), % Y = h(Y1, Y2), % ( compare(R1, X1, Y1), R1 \= (=) -> % R = R1 % ; % compare(R, X2, Y2) % ) % ) % -> % Res = R % Return_R % ; % compare_error % Abort % ). % % Note that disjuncts covering constants do not test Y, since for constants % X_Index = Y_Index implies X = Y. % :- pred generate_du_linear_compare_clauses(mer_type::in, list(constructor)::in, prog_var::in, prog_var::in, prog_var::in, prog_context::in, list(clause)::out, unify_proc_info::in, unify_proc_info::out) is det. generate_du_linear_compare_clauses(Type, Ctors, Res, X, Y, Context, [Clause], !Info) :- generate_du_linear_compare_clauses_2(Type, Ctors, Res, X, Y, Context, Goal, !Info), HeadVars = [Res, X, Y], quantify_clause_body(HeadVars, Goal, Context, Clause, !Info). :- pred generate_du_linear_compare_clauses_2(mer_type::in, list(constructor)::in, prog_var::in, prog_var::in, prog_var::in, prog_context::in, hlds_goal::out, unify_proc_info::in, unify_proc_info::out) is det. generate_du_linear_compare_clauses_2(Type, Ctors, Res, X, Y, Context, Goal, !Info) :- IntType = int_type, info_new_var(IntType, X_Index, !Info), info_new_var(IntType, Y_Index, !Info), info_new_var(comparison_result_type, R, !Info), goal_info_init(GoalInfo0), goal_info_set_context(Context, GoalInfo0, GoalInfo), instmap_delta_from_assoc_list([X_Index - ground(shared, none)], X_InstmapDelta), build_specific_call(Type, spec_pred_index, [X, X_Index], X_InstmapDelta, det, Context, Call_X_Index, !Info), instmap_delta_from_assoc_list([Y_Index - ground(shared, none)], Y_InstmapDelta), build_specific_call(Type, spec_pred_index, [Y, Y_Index], Y_InstmapDelta, det, Context, Call_Y_Index, !Info), build_call("builtin_int_lt", [X_Index, Y_Index], Context, Call_Less_Than, !Info), build_call("builtin_int_gt", [X_Index, Y_Index], Context, Call_Greater_Than, !Info), mercury_public_builtin_module(Builtin), make_const_construction(Res, cons(qualified(Builtin, "<"), 0), Return_Less_Than), make_const_construction(Res, cons(qualified(Builtin, ">"), 0), Return_Greater_Than), create_atomic_complicated_unification(Res, var(R), Context, explicit, [], Return_R), generate_compare_cases(Ctors, R, X, Y, Context, Cases, !Info), CasesGoal = disj(Cases) - GoalInfo, build_call("compare_error", [], Context, Abort, !Info), Goal = conj(plain_conj, [ Call_X_Index, Call_Y_Index, if_then_else([], Call_Less_Than, Return_Less_Than, if_then_else([], Call_Greater_Than, Return_Greater_Than, if_then_else([], CasesGoal, Return_R, Abort) - GoalInfo) - GoalInfo) - GoalInfo ]) - GoalInfo. % generate_compare_cases: for a type such as % % :- type foo ---> f ; g(a) ; h(b, foo). % % we want to generate code % % ( % X = f, % UnifyX_Goal % Y = X, % UnifyY_Goal % R = (=) % CompareArgs_Goal % ; % X = g(X1), % Y = g(Y1), % compare(R, X1, Y1) % ; % X = h(X1, X2), % Y = h(Y1, Y2), % ( compare(R1, X1, Y1), R1 \= (=) -> % R = R1 % ; % compare(R, X2, Y2) % ) % ) % % Note that in the clauses for constants, we unify Y with X, not with % the constant. This is to allow dupelim to eliminate all but one of % the code fragments implementing such switch arms. % :- pred generate_compare_cases(list(constructor)::in, prog_var::in, prog_var::in, prog_var::in, prog_context::in, list(hlds_goal)::out, unify_proc_info::in, unify_proc_info::out) is det. generate_compare_cases([], _R, _X, _Y, _Context, [], !Info). generate_compare_cases([Ctor | Ctors], R, X, Y, Context, [Case | Cases], !Info) :- generate_compare_case(Ctor, R, X, Y, Context, linear, Case, !Info), generate_compare_cases(Ctors, R, X, Y, Context, Cases, !Info). :- type linear_or_quad ---> linear ; quad. :- pred generate_compare_case(constructor::in, prog_var::in, prog_var::in, prog_var::in, prog_context::in, linear_or_quad::in, hlds_goal::out, unify_proc_info::in, unify_proc_info::out) is det. generate_compare_case(Ctor, R, X, Y, Context, Kind, Case, !Info) :- Ctor = ctor(ExistQTVars, _Constraints, FunctorName, ArgTypes), list.length(ArgTypes, FunctorArity), FunctorConsId = cons(FunctorName, FunctorArity), ( ArgTypes = [], create_atomic_complicated_unification(X, functor(FunctorConsId, no, []), Context, explicit, [], UnifyX_Goal), generate_return_equal(R, Context, EqualGoal), ( Kind = linear, % The disjunct we are generating is executed only if the index % values of X and Y are the same, so if X is bound to a constant, % Y must also be bound to that same constant. GoalList = [UnifyX_Goal, EqualGoal] ; Kind = quad, create_atomic_complicated_unification(Y, functor(FunctorConsId, no, []), Context, explicit, [], UnifyY_Goal), GoalList = [UnifyX_Goal, UnifyY_Goal, EqualGoal] ) ; ArgTypes = [_ | _], make_fresh_vars(ArgTypes, ExistQTVars, Vars1, !Info), make_fresh_vars(ArgTypes, ExistQTVars, Vars2, !Info), create_atomic_complicated_unification(X, functor(FunctorConsId, no, Vars1), Context, explicit, [], UnifyX_Goal), create_atomic_complicated_unification(Y, functor(FunctorConsId, no, Vars2), Context, explicit, [], UnifyY_Goal), compare_args(ArgTypes, ExistQTVars, Vars1, Vars2, R, Context, CompareArgs_Goal, !Info), GoalList = [UnifyX_Goal, UnifyY_Goal, CompareArgs_Goal] ), goal_info_init(GoalInfo0), goal_info_set_context(Context, GoalInfo0, GoalInfo), conj_list_to_goal(GoalList, GoalInfo, Case). :- pred generate_asymmetric_compare_case(constructor::in, constructor::in, string::in, prog_var::in, prog_var::in, prog_var::in, prog_context::in, hlds_goal::out, unify_proc_info::in, unify_proc_info::out) is det. generate_asymmetric_compare_case(Ctor1, Ctor2, CompareOp, R, X, Y, Context, Case, !Info) :- Ctor1 = ctor(ExistQTVars1, _Constraints1, FunctorName1, ArgTypes1), Ctor2 = ctor(ExistQTVars2, _Constraints2, FunctorName2, ArgTypes2), list.length(ArgTypes1, FunctorArity1), list.length(ArgTypes2, FunctorArity2), FunctorConsId1 = cons(FunctorName1, FunctorArity1), FunctorConsId2 = cons(FunctorName2, FunctorArity2), make_fresh_vars(ArgTypes1, ExistQTVars1, Vars1, !Info), make_fresh_vars(ArgTypes2, ExistQTVars2, Vars2, !Info), create_atomic_complicated_unification(X, functor(FunctorConsId1, no, Vars1), Context, explicit, [], UnifyX_Goal), create_atomic_complicated_unification(Y, functor(FunctorConsId2, no, Vars2), Context, explicit, [], UnifyY_Goal), mercury_public_builtin_module(Builtin), make_const_construction(R, cons(qualified(Builtin, CompareOp), 0), ReturnResult), GoalList = [UnifyX_Goal, UnifyY_Goal, ReturnResult], goal_info_init(GoalInfo0), goal_info_set_context(Context, GoalInfo0, GoalInfo), conj_list_to_goal(GoalList, GoalInfo, Case). % compare_args: for a constructor such as % % h(list(int), foo, string) % % we want to generate code % % ( % compare(R1, X1, Y1), % Do_Comparison % R1 \= (=) % Check_Not_Equal % -> % R = R1 % Return_R1 % ; % compare(R2, X2, Y2), % R2 \= (=) % -> % R = R2 % ; % compare(R, X3, Y3) % Return_Comparison % ) % % For a constructor with no arguments, we want to generate code % % R = (=) % Return_Equal % :- pred compare_args(list(constructor_arg)::in, existq_tvars::in, list(prog_var)::in, list(prog_var)::in, prog_var::in, prog_context::in, hlds_goal::out, unify_proc_info::in, unify_proc_info::out) is det. compare_args(ArgTypes, ExistQTVars, Xs, Ys, R, Context, Goal, !Info) :- ( compare_args_2(ArgTypes, ExistQTVars, Xs, Ys, R, Context, Goal0, !Info) -> Goal = Goal0 ; unexpected(this_file, "compare_args: length mismatch") ). :- pred compare_args_2(list(constructor_arg)::in, existq_tvars::in, list(prog_var)::in, list(prog_var)::in, prog_var::in, prog_context::in, hlds_goal::out, unify_proc_info::in, unify_proc_info::out) is semidet. compare_args_2([], _, [], [], R, Context, Return_Equal, !Info) :- generate_return_equal(R, Context, Return_Equal). compare_args_2([_Name - Type | ArgTypes], ExistQTVars, [X | Xs], [Y | Ys], R, Context, Goal, !Info) :- goal_info_init(GoalInfo0), goal_info_set_context(Context, GoalInfo0, GoalInfo), % When comparing existentially typed arguments, the arguments may have % different types; in that case, rather than just comparing them, % which would be a type error, we call `typed_compare', which is a builtin % that first compares their types and then compares their values. ( list.member(ExistQTVar, ExistQTVars), type_contains_var(Type, ExistQTVar) -> ComparePred = "typed_compare" ; ComparePred = "compare" ), ( info_get_module_info(!.Info, ModuleInfo), is_dummy_argument_type(ModuleInfo, Type) -> % X and Y contain dummy values, so there is nothing to compare. compare_args_2(ArgTypes, ExistQTVars, Xs, Ys, R, Context, Goal, !Info) ; Xs = [], Ys = [] -> build_call(ComparePred, [R, X, Y], Context, Goal, !Info) ; info_new_var(comparison_result_type, R1, !Info), build_call(ComparePred, [R1, X, Y], Context, Do_Comparison, !Info), make_const_construction(R1, equal_cons_id, Check_Equal), Check_Not_Equal = not(Check_Equal) - GoalInfo, create_atomic_complicated_unification(R, var(R1), Context, explicit, [], Return_R1), Condition = conj(plain_conj, [Do_Comparison, Check_Not_Equal]) - GoalInfo, compare_args_2(ArgTypes, ExistQTVars, Xs, Ys, R, Context, ElseCase, !Info), Goal = if_then_else([], Condition, Return_R1, ElseCase) - GoalInfo ). :- pred generate_return_equal(prog_var::in, prog_context::in, hlds_goal::out) is det. generate_return_equal(ResultVar, Context, Goal) :- make_const_construction(ResultVar, equal_cons_id, Goal0), goal_set_context(Context, Goal0, Goal). %-----------------------------------------------------------------------------% :- pred build_call(string::in, list(prog_var)::in, prog_context::in, hlds_goal::out, unify_proc_info::in, unify_proc_info::out) is det. build_call(Name, ArgVars, Context, Goal, !Info) :- info_get_module_info(!.Info, ModuleInfo), list.length(ArgVars, Arity), % % We assume that the special preds compare/3, index/2, and unify/2 % are the only public builtins called by code generated by this module. % ( special_pred_name_arity(_, Name, _, Arity) -> MercuryBuiltin = mercury_public_builtin_module ; MercuryBuiltin = mercury_private_builtin_module ), goal_util.generate_simple_call(MercuryBuiltin, Name, predicate, mode_no(0), erroneous, ArgVars, [], [], ModuleInfo, Context, Goal). :- pred build_specific_call(mer_type::in, special_pred_id::in, list(prog_var)::in, instmap_delta::in, determinism::in, prog_context::in, hlds_goal::out, unify_proc_info::in, unify_proc_info::out) is det. build_specific_call(Type, SpecialPredId, ArgVars, InstmapDelta, Detism, Context, Goal, !Info) :- info_get_module_info(!.Info, ModuleInfo), ( polymorphism.get_special_proc(Type, SpecialPredId, ModuleInfo, PredName, PredId, ProcId) -> GoalExpr = call(PredId, ProcId, ArgVars, not_builtin, no, PredName), set.list_to_set(ArgVars, NonLocals), goal_info_init(NonLocals, InstmapDelta, Detism, purity_pure, GoalInfo0), goal_info_set_context(Context, GoalInfo0, GoalInfo), Goal = GoalExpr - GoalInfo ; % build_specific_call is only ever used to build calls % to special preds for a type in the bodies of other special preds % for that same type. If the special preds for a type are built in the % right order (index before compare), the lookup should never fail. unexpected(this_file, "build_specific_call: lookup failed") ). %-----------------------------------------------------------------------------% :- pred make_fresh_named_var_from_type(mer_type::in, string::in, int::in, prog_var::out, unify_proc_info::in, unify_proc_info::out) is det. make_fresh_named_var_from_type(Type, BaseName, Num, Var, !Info) :- string.int_to_string(Num, NumStr), string.append(BaseName, NumStr, Name), info_new_named_var(Type, Name, Var, !Info). :- pred make_fresh_named_vars_from_types(list(mer_type)::in, string::in, int::in, list(prog_var)::out, unify_proc_info::in, unify_proc_info::out) is det. make_fresh_named_vars_from_types([], _, _, [], !Info). make_fresh_named_vars_from_types([Type | Types], BaseName, Num, [Var | Vars], !Info) :- make_fresh_named_var_from_type(Type, BaseName, Num, Var, !Info), make_fresh_named_vars_from_types(Types, BaseName, Num + 1, Vars, !Info). :- pred make_fresh_vars_from_types(list(mer_type)::in, list(prog_var)::out, unify_proc_info::in, unify_proc_info::out) is det. make_fresh_vars_from_types([], [], !Info). make_fresh_vars_from_types([Type | Types], [Var | Vars], !Info) :- info_new_var(Type, Var, !Info), make_fresh_vars_from_types(Types, Vars, !Info). :- pred make_fresh_vars(list(constructor_arg)::in, existq_tvars::in, list(prog_var)::out, unify_proc_info::in, unify_proc_info::out) is det. make_fresh_vars(CtorArgs, ExistQTVars, Vars, !Info) :- ( ExistQTVars = [], assoc_list.values(CtorArgs, ArgTypes), make_fresh_vars_from_types(ArgTypes, Vars, !Info) ; ExistQTVars = [_ | _], % % If there are existential types involved, then it's too hard to get % the types right here (it would require allocating new type variables) % -- instead, typecheck.m will typecheck the clause to figure out % the correct types. So we just allocate the variables and leave it % up to typecheck.m to infer their types. % info_get_varset(!.Info, VarSet0), list.length(CtorArgs, NumVars), varset.new_vars(VarSet0, NumVars, Vars, VarSet), info_set_varset(VarSet, !Info) ). :- pred unify_var_lists(list(constructor_arg)::in, existq_tvars::in, list(prog_var)::in, list(prog_var)::in, list(hlds_goal)::out, unify_proc_info::in, unify_proc_info::out) is det. unify_var_lists(ArgTypes, ExistQVars, Vars1, Vars2, Goal, !Info) :- ( unify_var_lists_2(ArgTypes, ExistQVars, Vars1, Vars2, Goal0, !Info) -> Goal = Goal0 ; unexpected(this_file, "unify_var_lists: length mismatch") ). :- pred unify_var_lists_2(list(constructor_arg)::in, existq_tvars::in, list(prog_var)::in, list(prog_var)::in, list(hlds_goal)::out, unify_proc_info::in, unify_proc_info::out) is semidet. unify_var_lists_2([], _, [], [], [], !Info). unify_var_lists_2([_Name - Type | ArgTypes], ExistQTVars, [X | Xs], [Y | Ys], [Goal | Goals], !Info) :- term.context_init(Context), ( info_get_module_info(!.Info, ModuleInfo), is_dummy_argument_type(ModuleInfo, Type) -> Goal = true_goal ; % When unifying existentially typed arguments, the arguments may have % different types; in that case, rather than just unifying them, % which would be a type error, we call `typed_unify', which is % a builtin that first checks that their types are equal and then % unifies the values. list.member(ExistQTVar, ExistQTVars), type_contains_var(Type, ExistQTVar) -> build_call("typed_unify", [X, Y], Context, Goal, !Info) ; create_atomic_complicated_unification(X, var(Y), Context, explicit, [], Goal) ), unify_var_lists_2(ArgTypes, ExistQTVars, Xs, Ys, Goals, !Info). %-----------------------------------------------------------------------------% :- func equal_cons_id = cons_id. equal_cons_id = cons(qualified(mercury_public_builtin_module, "="), 0). :- func equal_functor = unify_rhs. equal_functor = functor(equal_cons_id, no, []). %-----------------------------------------------------------------------------% :- type unify_proc_info. :- pred info_init(module_info::in, unify_proc_info::out) is det. :- pred info_new_var(mer_type::in, prog_var::out, unify_proc_info::in, unify_proc_info::out) is det. :- pred info_new_named_var(mer_type::in, string::in, prog_var::out, unify_proc_info::in, unify_proc_info::out) is det. :- pred info_extract(unify_proc_info::in, prog_varset::out, vartypes::out) is det. :- pred info_get_varset(unify_proc_info::in, prog_varset::out) is det. :- pred info_get_types(unify_proc_info::in, vartypes::out) is det. :- pred info_get_rtti_varmaps(unify_proc_info::in, rtti_varmaps::out) is det. :- pred info_get_module_info(unify_proc_info::in, module_info::out) is det. :- pred info_set_varset(prog_varset::in, unify_proc_info::in, unify_proc_info::out) is det. :- pred info_set_types(vartypes::in, unify_proc_info::in, unify_proc_info::out) is det. %-----------------------------------------------------------------------------% :- type unify_proc_info ---> unify_proc_info( varset :: prog_varset, vartypes :: vartypes, rtti_varmaps :: rtti_varmaps, module_info :: module_info ). info_init(ModuleInfo, UPI) :- varset.init(VarSet), map.init(Types), rtti_varmaps_init(RttiVarMaps), UPI = unify_proc_info(VarSet, Types, RttiVarMaps, ModuleInfo). info_new_var(Type, Var, !UPI) :- varset.new_var(!.UPI ^ varset, Var, VarSet), map.det_insert(!.UPI ^ vartypes, Var, Type, VarTypes), !:UPI = !.UPI ^ varset := VarSet, !:UPI = !.UPI ^ vartypes := VarTypes. info_new_named_var(Type, Name, Var, !UPI) :- varset.new_named_var(!.UPI ^ varset, Name, Var, VarSet), map.det_insert(!.UPI ^ vartypes, Var, Type, VarTypes), !:UPI = !.UPI ^ varset := VarSet, !:UPI = !.UPI ^ vartypes := VarTypes. info_extract(UPI, UPI ^ varset, UPI ^ vartypes). info_get_varset(UPI, UPI ^ varset). info_get_types(UPI, UPI ^ vartypes). info_get_rtti_varmaps(UPI, UPI ^ rtti_varmaps). info_get_module_info(UPI, UPI ^ module_info). info_set_varset(VarSet, UPI, UPI ^ varset := VarSet). info_set_types(Types, UPI, UPI ^ vartypes := Types). %-----------------------------------------------------------------------------% :- func this_file = string. this_file = "unify_proc.m". %-----------------------------------------------------------------------------% :- end_module unify_proc. %-----------------------------------------------------------------------------%