From 82378c381b24e7decdaa7f76bb4b13649093e708 Mon Sep 17 00:00:00 2001 From: David Overton Date: Fri, 13 Oct 2000 13:56:17 +0000 Subject: [PATCH] Allow polymorphic ground insts. This change assumes that all inst Estimated hours taken: 80 Allow polymorphic ground insts. This change assumes that all inst parameters in the mode declaration for a predicate or function are constrained to be ground-shared. This is a temporary measure until we work out a nice syntax to allow the programmer to tell the compiler that certain inst parameters may be treated as ground insts. Since we don't currently support unconstrained inst parameters anyway, this shouldn't cause a problem. TODO: - Add syntax, something like `:- mode p(in(I)) <= ground(I).', to specify that an inst parameter represents a ground inst. - Allow abstract ground insts that are treated in a similar way to what we've done here with ground inst parameters. - Make mode checking more efficient (i.e. rewrite the mode system). compiler/inst.m: Add a new alternative for ground insts: `constrained_inst_var(inst_var)'. Define the type `inst_var_sub'. compiler/inst_match.m: Change inst_matches_initial so that it: - handles constrained_inst_vars correctly; - returns the inst_var substitutions necessary for the call; - handles inst_matches_initial(ground(...), bound(...), ...) properly (this requires knowing the type of the variable). The last change has also been made for inst_matches_final and inst_matches_binding. However, the check is disabled for now because, without alias tracking, the mode checker becomes too conservative. compiler/hlds_pred.m: compiler/mode_info.m: compiler/simplify.m: compiler/det_util.m: Include the inst_varset in the proc_info, mode_info and simplify_info. Add a vartypes field to the det_info. Remove the vartypes field from the simplify_info since it is now in the det_info. Use record syntax for these data structures and their access predicates to make future changes easier. compiler/prog_io.m: When processing pred and func mode declarations, convert all inst_var(V) insts to ground(shared, constrained_inst_var(V)). compiler/prog_data.m: compiler/hlds_data.m: compiler/make_hlds.m: compiler/mode_util.m: Use inst_vars instead of inst_params. compiler/modes.m: compiler/modecheck_call.m: compiler/unique_modes.m: compiler/mode_util.m: When checking or recomputing initial insts of a call, build up an inst_var substitution (using the modified inst_matches_initial) and apply this to the final insts of the called procedure before checking/recomputing them. compiler/mode_util.m: Make sure that recompute_instmap_delta recomputes the instmap_deltas for lambda_goals even when RecomputeAtomic = no. compiler/type_util.m: Add a new predicate, type_util__cons_id_arg_types which nondeterministically returns the cons_ids and argument types for a given type. Add a new predicate type_util__get_consid_non_existential_arg_types which is the same as type_util__get_existential_arg_types except that it fails rather than aborting for existenially typed arguments. compiler/accumulator.m: compiler/check_typeclass.m: compiler/clause_to_proc.m: compiler/common.m: compiler/continuation_info.m: compiler/deforest.m: compiler/det_analysis.m: compiler/det_report.m: compiler/det_util.m: compiler/dnf.m: compiler/follow_code.m: compiler/goal_store.m: compiler/goal_util.m: compiler/higher_order.m: compiler/inst_util.m: compiler/instmap.m: compiler/lambda.m: compiler/magic.m: compiler/magic_util.m: compiler/mercury_to_mercury.m: compiler/modecheck_unify.m: compiler/module_qual.m: compiler/pd_info.m: compiler/pd_util.m: compiler/polymorphism.m: compiler/post_typecheck.m: compiler/prog_io_util.m: compiler/prog_rep.m: compiler/saved_vars.m: compiler/stack_layout.m: compiler/table_gen.m: compiler/unify_proc.m: compiler/unneeded_code.m: compiler/unused_args.m: Pass inst_varsets and types where needed. Changes to reflect change in definition of the inst data type. compiler/inlining.m: Recompute the instmap deltas for a procedure after inlining. This bug showed up compiling tests/hard_coded/lp.m with inlining and deforestation turned on: deforestation was getting incorrect instmap deltas from inlining, causing the transformation to break mode-correctness. It has only just shown up because of the added call to `inst_matches_initial' from within `recompute_instmap_delta'. tests/invalid/Mmakefile: tests/invalid/unbound_inst_var.m: tests/invalid/unbound_inst_var.err_exp: tests/valid/Mmakefile: tests/valid/unbound_inst_var.m: Move the `unbound_inst_var' test case from `invalid' to `valid' and extend its coverage a bit. --- compiler/accumulator.m | 141 ++-- compiler/check_typeclass.m | 15 +- compiler/clause_to_proc.m | 6 +- compiler/code_gen.m | 3 +- compiler/common.m | 29 +- compiler/continuation_info.m | 1 + compiler/deforest.m | 5 +- compiler/det_analysis.m | 3 +- compiler/det_report.m | 15 +- compiler/det_util.m | 51 +- compiler/dnf.m | 8 +- compiler/follow_code.m | 5 +- compiler/goal_store.m | 50 +- compiler/goal_util.m | 21 +- compiler/higher_order.m | 21 +- compiler/hlds_data.m | 4 +- compiler/hlds_pred.m | 93 ++- compiler/inlining.m | 33 +- compiler/inst.m | 24 +- compiler/inst_match.m | 853 +++++++++++++------- compiler/inst_util.m | 128 ++- compiler/instmap.m | 51 +- compiler/lambda.m | 18 +- compiler/magic.m | 23 +- compiler/magic_util.m | 10 +- compiler/make_hlds.m | 42 +- compiler/mercury_to_mercury.m | 35 +- compiler/mode_info.m | 15 +- compiler/mode_util.m | 570 ++++++++----- compiler/modecheck_call.m | 161 ++-- compiler/modecheck_unify.m | 23 +- compiler/modes.m | 103 ++- compiler/module_qual.m | 15 +- compiler/pd_info.m | 25 +- compiler/pd_util.m | 14 +- compiler/polymorphism.m | 34 +- compiler/post_typecheck.m | 4 +- compiler/prog_data.m | 9 +- compiler/prog_io.m | 245 +++--- compiler/prog_io_util.m | 18 +- compiler/prog_rep.m | 109 +-- compiler/saved_vars.m | 3 +- compiler/simplify.m | 42 +- compiler/special_pred.m | 5 + compiler/stack_layout.m | 35 +- compiler/table_gen.m | 20 +- compiler/type_util.m | 75 +- compiler/unify_proc.m | 30 +- compiler/unique_modes.m | 9 +- compiler/unneeded_code.m | 134 +-- compiler/unused_args.m | 83 +- tests/invalid/Mmakefile | 1 - tests/invalid/unbound_inst_var.err_exp | 5 - tests/valid/Mmakefile | 1 + tests/{invalid => valid}/unbound_inst_var.m | 19 +- 55 files changed, 2187 insertions(+), 1308 deletions(-) delete mode 100644 tests/invalid/unbound_inst_var.err_exp rename tests/{invalid => valid}/unbound_inst_var.m (52%) diff --git a/compiler/accumulator.m b/compiler/accumulator.m index 3b09f8d78..aa3d85719 100644 --- a/compiler/accumulator.m +++ b/compiler/accumulator.m @@ -376,11 +376,13 @@ attempt_transform_2([Id | Ids], C, M, Rec, HeadVars, InitialInstMap, TopLevel, DoLCO, FullyStrict, PredInfo, ProcInfo0, ModuleInfo0, Warnings, ProcInfo, ModuleInfo) :- ( + proc_info_vartypes(ProcInfo0, VarTypes0), identify_out_and_out_prime(Id, Rec, HeadVars, - InitialInstMap, ModuleInfo0, Out, OutPrime, - HeadToCallSubst, CallToHeadSubst), + InitialInstMap, VarTypes0, ModuleInfo0, Out, + OutPrime, HeadToCallSubst, CallToHeadSubst), - stage1(Id, M, C, DoLCO, FullyStrict, ModuleInfo0, Sets), + stage1(Id, M, C, DoLCO, FullyStrict, VarTypes0, ModuleInfo0, + Sets), stage2(Id, C, Sets, OutPrime, Out, ModuleInfo0, ProcInfo0, VarSet - VarTypes, Accs, BaseCase, BasePairs, @@ -624,11 +626,11 @@ identify_recursive_calls(PredId, ProcId, GoalStore, Ids) :- % variables which are produced prior to the recursive call. % :- pred identify_out_and_out_prime(goal_id::in, hlds_goals::in, prog_vars::in, - instmap::in, module_info::in, prog_vars::out, + instmap::in, vartypes::in, module_info::in, prog_vars::out, prog_vars::out, subst::out, subst::out) is det. -identify_out_and_out_prime(_N - K, Rec, HeadVars, InitialInstMap, ModuleInfo, - Out, OutPrime, HeadToCallSubst, CallToHeadSubst) :- +identify_out_and_out_prime(_N - K, Rec, HeadVars, InitialInstMap, VarTypes, + ModuleInfo, Out, OutPrime, HeadToCallSubst, CallToHeadSubst) :- ( list__take(K, Rec, InitialGoals), list__drop(K-1, Rec, FinalGoals), @@ -643,8 +645,8 @@ identify_out_and_out_prime(_N - K, Rec, HeadVars, InitialInstMap, ModuleInfo, instmap__apply_instmap_delta(InstMapBeforeRest, InstMapDelta, InstMapAfterRest), - instmap_changed_vars(InstMapBeforeRest, - InstMapAfterRest, ModuleInfo, ChangedVars), + instmap_changed_vars(InstMapBeforeRest, InstMapAfterRest, + VarTypes, ModuleInfo, ChangedVars), assoc_list__from_corresponding_lists(HeadVars, Args, HeadArg0), @@ -690,11 +692,11 @@ identify_out_and_out_prime(_N - K, Rec, HeadVars, InitialInstMap, ModuleInfo, % so on. % :- pred stage1(goal_id::in, int::in, goal_store::in, bool::in, bool::in, - module_info::in, sets::out) is semidet. + vartypes::in, module_info::in, sets::out) is semidet. -stage1(N - K, M, GoalStore, DoLCO, FullyStrict, ModuleInfo, Sets) :- +stage1(N - K, M, GoalStore, DoLCO, FullyStrict, VarTypes, ModuleInfo, Sets) :- sets_init(Sets0), - stage1_2(N - (K+1), K, M, GoalStore, FullyStrict, ModuleInfo, + stage1_2(N - (K+1), K, M, GoalStore, FullyStrict, VarTypes, ModuleInfo, Sets0, Sets1), Sets1 = sets(Before, Assoc, ConstructAssoc, Construct, Update, Reject), Sets = sets(Before `set__union` set_upto(N, (K-1)), Assoc, @@ -728,9 +730,10 @@ stage1(N - K, M, GoalStore, DoLCO, FullyStrict, ModuleInfo, Sets) :- % goal belongs to. % :- pred stage1_2(goal_id::in, int::in, int::in, goal_store::in, - bool::in, module_info::in, sets::in, sets::out) is det. + bool::in, vartypes::in, module_info::in, sets::in, sets::out) is det. -stage1_2(N - I, K, M, GoalStore, FullyStrict, ModuleInfo, Sets0, Sets) :- +stage1_2(N - I, K, M, GoalStore, FullyStrict, VarTypes, ModuleInfo, + Sets0, Sets) :- ( I > M -> @@ -738,46 +741,46 @@ stage1_2(N - I, K, M, GoalStore, FullyStrict, ModuleInfo, Sets0, Sets) :- ; ( before(N - I, K, GoalStore, Sets0, - FullyStrict, ModuleInfo) + FullyStrict, VarTypes, ModuleInfo) -> stage1_2(N - (I+1), K, M, GoalStore, - FullyStrict, ModuleInfo, + FullyStrict, VarTypes, ModuleInfo, Sets0^before := set__insert(Sets0^before, N - I), Sets) ; assoc(N - I, K, GoalStore, Sets0, - FullyStrict, ModuleInfo) + FullyStrict, VarTypes, ModuleInfo) -> stage1_2(N - (I+1), K, M, GoalStore, - FullyStrict, ModuleInfo, + FullyStrict, VarTypes, ModuleInfo, Sets0^assoc := set__insert(Sets0^assoc, N - I), Sets) ; construct(N - I, K, GoalStore, Sets0, - FullyStrict, ModuleInfo) + FullyStrict, VarTypes, ModuleInfo) -> stage1_2(N - (I+1), K, M, GoalStore, - FullyStrict, ModuleInfo, + FullyStrict, VarTypes, ModuleInfo, Sets0^construct := set__insert(Sets0^construct, N - I), Sets) ; construct_assoc(N - I, K, GoalStore, Sets0, - FullyStrict, ModuleInfo) + FullyStrict, VarTypes, ModuleInfo) -> stage1_2(N - (I+1), K, M, GoalStore, - FullyStrict, ModuleInfo, + FullyStrict, VarTypes, ModuleInfo, Sets0^construct_assoc := set__insert(Sets0^construct_assoc, N-I), Sets) ; update(N - I, K, GoalStore, Sets0, - FullyStrict, ModuleInfo) + FullyStrict, VarTypes, ModuleInfo) -> stage1_2(N - (I+1), K, M, GoalStore, - FullyStrict, ModuleInfo, + FullyStrict, VarTypes, ModuleInfo, Sets0^update := set__insert(Sets0^update, N - I), Sets) @@ -824,17 +827,17 @@ set_upto(N, K) = Set :- % before the recursive call (member of the before set). % :- pred before(goal_id::in, int::in, goal_store::in, sets::in, - bool::in, module_info::in) is semidet. + bool::in, vartypes::in, module_info::in) is semidet. before(N - I, K, GoalStore, sets(Before, _, _, _, _, _), - FullyStrict, ModuleInfo) :- + FullyStrict, VarTypes, ModuleInfo) :- goal_store__lookup(GoalStore, N - I, LaterGoal - LaterInstMap), ( member_lessthan_goalid(GoalStore, N - I, N - J, EarlierGoal - EarlierInstMap), - not goal_util__can_reorder_goals(ModuleInfo, FullyStrict, - EarlierInstMap, EarlierGoal, - LaterInstMap, LaterGoal) + not goal_util__can_reorder_goals(ModuleInfo, VarTypes, + FullyStrict, EarlierInstMap, EarlierGoal, + LaterInstMap, LaterGoal) ) => ( @@ -848,19 +851,19 @@ before(N - I, K, GoalStore, sets(Before, _, _, _, _, _), % set) AND the goal is associative. % :- pred assoc(goal_id::in, int::in, goal_store::in, sets::in, bool::in, - module_info::in) is semidet. + vartypes::in, module_info::in) is semidet. assoc(N - I, K, GoalStore, sets(Before, _, _, _, _, _), - FullyStrict, ModuleInfo) :- + FullyStrict, VarTypes, ModuleInfo) :- goal_store__lookup(GoalStore, N - I, LaterGoal - LaterInstMap), LaterGoal = call(PredId, ProcId, Args, _, _, _) - _, is_associative(PredId, ProcId, ModuleInfo, Args, _), ( member_lessthan_goalid(GoalStore, N - I, _N - J, EarlierGoal - EarlierInstMap), - not goal_util__can_reorder_goals(ModuleInfo, FullyStrict, - EarlierInstMap, EarlierGoal, - LaterInstMap, LaterGoal) + not goal_util__can_reorder_goals(ModuleInfo, VarTypes, + FullyStrict, EarlierInstMap, EarlierGoal, + LaterInstMap, LaterGoal) ) => ( @@ -874,19 +877,19 @@ assoc(N - I, K, GoalStore, sets(Before, _, _, _, _, _), % set) AND the goal is construction unification. % :- pred construct(goal_id::in, int::in, goal_store::in, sets::in, - bool::in, module_info::in) is semidet. + bool::in, vartypes::in, module_info::in) is semidet. construct(N - I, K, GoalStore, sets(Before, _, _, Construct, _, _), - FullyStrict, ModuleInfo) :- + FullyStrict, VarTypes, ModuleInfo) :- goal_store__lookup(GoalStore, N - I, LaterGoal - LaterInstMap), LaterGoal = unify(_, _, _, Unify, _) - _GoalInfo, Unify = construct(_, _, _, _, _, _, _), ( member_lessthan_goalid(GoalStore, N - I, _N - J, EarlierGoal - EarlierInstMap), - not goal_util__can_reorder_goals(ModuleInfo, FullyStrict, - EarlierInstMap, EarlierGoal, - LaterInstMap, LaterGoal) + not goal_util__can_reorder_goals(ModuleInfo, VarTypes, + FullyStrict, EarlierInstMap, EarlierGoal, + LaterInstMap, LaterGoal) ) => ( @@ -906,16 +909,16 @@ construct(N - I, K, GoalStore, sets(Before, _, _, Construct, _, _), % construction unification depends on. % :- pred construct_assoc(goal_id::in, int::in, goal_store::in, sets::in, - bool::in, module_info::in) is semidet. + bool::in, vartypes::in, module_info::in) is semidet. construct_assoc(N - I, K, GoalStore, sets(Before, Assoc, ConstructAssoc, - _, _, _), FullyStrict, ModuleInfo) :- + _, _, _), FullyStrict, VarTypes, ModuleInfo) :- goal_store__lookup(GoalStore, N - I, LaterGoal - LaterInstMap), LaterGoal = unify(_, _, _, Unify, _) - _GoalInfo, Unify = construct(_, ConsId, _, _, _, _, _), - goal_store__all_ancestors(GoalStore, N - I, ModuleInfo, FullyStrict, - Ancestors), + goal_store__all_ancestors(GoalStore, N - I, VarTypes, ModuleInfo, + FullyStrict, Ancestors), set__singleton_set(Assoc `intersect` Ancestors, AssocId), goal_store__lookup(GoalStore, AssocId, AssocGoal - _AssocInstMap), @@ -925,9 +928,9 @@ construct_assoc(N - I, K, GoalStore, sets(Before, Assoc, ConstructAssoc, ( member_lessthan_goalid(GoalStore, N - I, _N - J, EarlierGoal - EarlierInstMap), - not goal_util__can_reorder_goals(ModuleInfo, FullyStrict, - EarlierInstMap, EarlierGoal, - LaterInstMap, LaterGoal) + not goal_util__can_reorder_goals(ModuleInfo, VarTypes, + FullyStrict, EarlierInstMap, EarlierGoal, + LaterInstMap, LaterGoal) ) => ( @@ -942,19 +945,19 @@ construct_assoc(N - I, K, GoalStore, sets(Before, Assoc, ConstructAssoc, % set) AND the goal updates some state. % :- pred update(goal_id::in, int::in, goal_store::in, sets::in, bool::in, - module_info::in) is semidet. + vartypes::in, module_info::in) is semidet. update(N - I, K, GoalStore, sets(Before, _, _, _, _, _), - FullyStrict, ModuleInfo) :- + FullyStrict, VarTypes, ModuleInfo) :- goal_store__lookup(GoalStore, N - I, LaterGoal - LaterInstMap), LaterGoal = call(PredId, ProcId, Args, _, _, _) - _, is_update(PredId, ProcId, ModuleInfo, Args, _), ( member_lessthan_goalid(GoalStore, N - I, _N - J, EarlierGoal - EarlierInstMap), - not goal_util__can_reorder_goals(ModuleInfo, FullyStrict, - EarlierInstMap, EarlierGoal, - LaterInstMap, LaterGoal) + not goal_util__can_reorder_goals(ModuleInfo, VarTypes, + FullyStrict, EarlierInstMap, EarlierGoal, + LaterInstMap, LaterGoal) ) => ( @@ -1189,7 +1192,8 @@ stage2(N - K, GoalStore, Sets, OutPrime, Out, ModuleInfo, ProcInfo0, Accs = set__to_sorted_list(InitAccs) `append` UpdateAccOut, - divide_base_case(UpdateOut, Out, GoalStore, ModuleInfo, + VarSetVarTypesPair = _ - VarTypes, + divide_base_case(UpdateOut, Out, GoalStore, VarTypes, ModuleInfo, UpdateBase, AssocBase, OtherBase), BaseCase = base(UpdateBase, AssocBase, OtherBase). @@ -1430,15 +1434,15 @@ process_update_set([Id | Ids], GS, OutPrime, ModuleInfo, Substs0, Types0, % and A will contain the same goal_id. % :- pred divide_base_case(prog_vars::in, prog_vars::in, goal_store::in, - module_info::in, set(goal_id)::out, + vartypes::in, module_info::in, set(goal_id)::out, set(goal_id)::out, set(goal_id)::out) is det. -divide_base_case(UpdateOut, Out, C, ModuleInfo, +divide_base_case(UpdateOut, Out, C, VarTypes, ModuleInfo, UpdateBase, AssocBase, OtherBase) :- list__delete_elems(Out, UpdateOut, AssocOut), - list__map(related(C, ModuleInfo), UpdateOut, UpdateBaseList), - list__map(related(C, ModuleInfo), AssocOut, AssocBaseList), + list__map(related(C, VarTypes, ModuleInfo), UpdateOut, UpdateBaseList), + list__map(related(C, VarTypes, ModuleInfo), AssocOut, AssocBaseList), UpdateBase = set__power_union(set__list_to_set(UpdateBaseList)), AssocBase = set__power_union(set__list_to_set(AssocBaseList)), @@ -1446,8 +1450,8 @@ divide_base_case(UpdateOut, Out, C, ModuleInfo, set__to_sorted_list(Set, List), list__map((pred(GoalId::in, Ancestors::out) is det :- - goal_store__all_ancestors(C, GoalId, ModuleInfo, - no, Ancestors) + goal_store__all_ancestors(C, GoalId, VarTypes, + ModuleInfo, no, Ancestors) ), List, OtherBaseList), OtherBase = set__list_to_set(List) `union` @@ -1460,24 +1464,25 @@ divide_base_case(UpdateOut, Out, C, ModuleInfo, % Return all the goal_ids, Ids, which are needed to initialize % the variable, V, from the goal store, GS. % -:- pred related(goal_store::in, module_info::in, prog_var::in, +:- pred related(goal_store::in, vartypes::in, module_info::in, prog_var::in, set(goal_id)::out) is det. -related(GS, ModuleInfo, Var, Related) :- +related(GS, VarTypes, ModuleInfo, Var, Related) :- solutions((pred(Key::out) is nondet :- goal_store__member(GS, Key, Goal - InstMap0), Key = base - _, Goal = _GoalExpr - GoalInfo, goal_info_get_instmap_delta(GoalInfo, InstMapDelta), apply_instmap_delta(InstMap0, InstMapDelta, InstMap), - instmap_changed_vars(InstMap0, InstMap, ModuleInfo, - ChangedVars), + instmap_changed_vars(InstMap0, InstMap, VarTypes, + ModuleInfo, ChangedVars), set__singleton_set(ChangedVars, Var) ), Ids), ( Ids = [Id] -> - goal_store__all_ancestors(GS, Id, ModuleInfo, no, Ancestors), + goal_store__all_ancestors(GS, Id, VarTypes, ModuleInfo, no, + Ancestors), list__filter((pred((base - _)::in) is semidet), set__to_sorted_list(set__insert(Ancestors, Id)), RelatedList), @@ -1577,6 +1582,7 @@ acc_proc_info(Accs0, VarSet, VarTypes, Substs, proc_info_headvars(OrigProcInfo, HeadVars0), proc_info_argmodes(OrigProcInfo, HeadModes0), + proc_info_inst_varset(OrigProcInfo, InstVarSet), proc_info_inferred_determinism(OrigProcInfo, Detism), proc_info_goal(OrigProcInfo, Goal), proc_info_context(OrigProcInfo, Context), @@ -1600,16 +1606,16 @@ acc_proc_info(Accs0, VarSet, VarTypes, Substs, % when it should be any integer. % However this will no longer handle partially % instantiated data structures. - Inst = ground(shared, no), + Inst = ground(shared, none), inst_lists_to_mode_list([Inst], [Inst], Mode), list__duplicate(list__length(Accs), list__det_head(Mode), AccModes), HeadModes = AccModes `append` HeadModes0, list__map(map__lookup(VarTypes), Accs, AccTypes), - proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, Detism, Goal, - Context, TVarMap, TCVarsMap, IsAddressTaken, - AccProcInfo). + proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, InstVarSet, + Detism, Goal, Context, TVarMap, TCVarsMap, IsAddressTaken, + AccProcInfo). %-----------------------------------------------------------------------------% @@ -1843,7 +1849,8 @@ acc_unification(Out - Acc, Goal) :- Context = unify_context(explicit, []), Expr = unify(Out, var(Acc), UniMode, assign(Out,Acc), Context), set__list_to_set([Out,Acc], NonLocalVars), - instmap_delta_from_assoc_list([Out - ground(shared, no)], InstMapDelta), + instmap_delta_from_assoc_list([Out - ground(shared, none)], + InstMapDelta), goal_info_init(NonLocalVars, InstMapDelta, det, Info), diff --git a/compiler/check_typeclass.m b/compiler/check_typeclass.m index 8f3535066..ff4dfe0b4 100644 --- a/compiler/check_typeclass.m +++ b/compiler/check_typeclass.m @@ -329,7 +329,7 @@ format_method_name(Method) = StringName :- % arguments. class_constraints, % Constraints from % class method. - list(pair(list(mode), determinism)), % Modes and + list(modes_and_detism), % Modes and % determinisms of the % required procs. error_messages, % Error messages @@ -396,7 +396,9 @@ check_instance_pred(ClassId, ClassVars, ClassInterface, PredId, proc_info_argmodes(ProcInfo, Modes), proc_info_interface_determinism(ProcInfo, Detism), - ModesAndDetism = Modes - Detism + proc_info_inst_varset(ProcInfo, InstVarSet), + ModesAndDetism = modes_and_detism(Modes, + InstVarSet, Detism) )), ProcIds, ArgModes), @@ -424,6 +426,9 @@ check_instance_pred(ClassId, ClassVars, ClassInterface, PredId, InstanceCheckInfo = instance_check_info(InstanceDefn, OrderedMethods, Errors, ModuleInfo, QualInfo). +:- type modes_and_detism + ---> modes_and_detism(list(mode), inst_varset, determinism). + :- pred check_instance_pred_procs(class_id, list(tvar), sym_name, pred_markers, hlds_instance_defn, hlds_instance_defn, instance_methods, instance_methods, @@ -683,9 +688,9 @@ produce_auxiliary_procs(ClassVars, Markers0, AddProc = lambda([ModeAndDet::in, NewProcId::out, OldPredInfo::in, NewPredInfo::out] is det, ( - ModeAndDet = Modes - Det, - add_new_proc(OldPredInfo, PredArity, Modes, yes(Modes), no, - yes(Det), Context, address_is_taken, + ModeAndDet = modes_and_detism(Modes, InstVarSet, Det), + add_new_proc(OldPredInfo, InstVarSet, PredArity, Modes, + yes(Modes), no, yes(Det), Context, address_is_taken, NewPredInfo, NewProcId) )), list__map_foldl(AddProc, ArgModes, InstanceProcIds, diff --git a/compiler/clause_to_proc.m b/compiler/clause_to_proc.m index 8d2b9eb62..f70912ec5 100644 --- a/compiler/clause_to_proc.m +++ b/compiler/clause_to_proc.m @@ -50,7 +50,7 @@ :- import_module hlds_goal, hlds_data, prog_data, mode_util, make_hlds, purity. :- import_module globals. -:- import_module bool, int, set, map. +:- import_module bool, int, set, map, varset. maybe_add_default_func_modes([], Preds, Preds). maybe_add_default_func_modes([PredId | PredIds], Preds0, Preds) :- @@ -87,7 +87,9 @@ maybe_add_default_func_mode(PredInfo0, PredInfo, MaybeProcId) :- Determinism = det, pred_info_context(PredInfo0, Context), MaybePredArgLives = no, - add_new_proc(PredInfo0, PredArity, PredArgModes, + varset__init(InstVarSet), + % No inst_vars in default func mode. + add_new_proc(PredInfo0, InstVarSet, PredArity, PredArgModes, yes(PredArgModes), MaybePredArgLives, yes(Determinism), Context, address_is_not_taken, PredInfo, ProcId), MaybeProcId = yes(ProcId) diff --git a/compiler/code_gen.m b/compiler/code_gen.m index d1d999b3e..84056762d 100644 --- a/compiler/code_gen.m +++ b/compiler/code_gen.m @@ -307,10 +307,11 @@ generate_proc_code(PredInfo, ProcInfo, ProcId, PredId, ModuleInfo, proc_info_eval_method(ProcInfo, EvalMethod), proc_info_get_initial_instmap(ProcInfo, ModuleInfo, InstMap0), proc_info_varset(ProcInfo, VarSet), + proc_info_vartypes(ProcInfo, VarTypes), ProcLayout = proc_layout_info(EntryLabel, Detism, TotalSlots, MaybeSuccipSlot, EvalMethod, MaybeTraceCallLabel, MaxTraceReg, Goal, InstMap0, TraceSlotInfo, - ForceProcId, VarSet, InternalMap), + ForceProcId, VarSet, VarTypes, InternalMap), global_data_add_new_proc_layout(GlobalData0, proc(PredId, ProcId), ProcLayout, GlobalData1) ; diff --git a/compiler/common.m b/compiler/common.m index 2639e9fcc..a4c9b70e0 100644 --- a/compiler/common.m +++ b/compiler/common.m @@ -403,12 +403,13 @@ common__optimise_call(PredId, ProcId, Args, Goal0, ( goal_info_get_determinism(GoalInfo, Det), common__check_call_detism(Det), + simplify_info_get_var_types(Info0, VarTypes), simplify_info_get_module_info(Info0, ModuleInfo), module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo), proc_info_argmodes(ProcInfo, ArgModes), - common__partition_call_args(ModuleInfo, ArgModes, Args, - InputArgs, OutputArgs, OutputModes) + common__partition_call_args(VarTypes, ModuleInfo, ArgModes, + Args, InputArgs, OutputArgs, OutputModes) -> common__optimise_call_2(seen_call(PredId, ProcId), InputArgs, OutputArgs, OutputModes, Goal0, GoalInfo, Goal, @@ -422,8 +423,9 @@ common__optimise_higher_order_call(Closure, Args, Modes, Det, Goal0, GoalInfo, Goal, Info0, Info) :- ( common__check_call_detism(Det), + simplify_info_get_var_types(Info0, VarTypes), simplify_info_get_module_info(Info0, ModuleInfo), - common__partition_call_args(ModuleInfo, Modes, Args, + common__partition_call_args(VarTypes, ModuleInfo, Modes, Args, InputArgs, OutputArgs, OutputModes) -> common__optimise_call_2(higher_order_call, @@ -517,21 +519,22 @@ common__optimise_call_2(SeenCall, InputArgs, OutputArgs, Modes, Goal0, % Partition the arguments of a call into inputs and outputs, % failing if any of the outputs have a unique component % or if any of the outputs contain any `any' insts. -:- pred common__partition_call_args(module_info::in, list(mode)::in, - list(prog_var)::in, list(prog_var)::out, +:- pred common__partition_call_args(vartypes::in, module_info::in, + list(mode)::in, list(prog_var)::in, list(prog_var)::out, list(prog_var)::out, list(mode)::out) is semidet. -common__partition_call_args(_, [], [_ | _], _, _, _) :- +common__partition_call_args(_, _, [], [_ | _], _, _, _) :- error("common__partition_call_args"). -common__partition_call_args(_, [_ | _], [], _, _, _) :- +common__partition_call_args(_, _, [_ | _], [], _, _, _) :- error("common__partition_call_args"). -common__partition_call_args(_, [], [], [], [], []). -common__partition_call_args(ModuleInfo, [ArgMode | ArgModes], [Arg | Args], - InputArgs, OutputArgs, OutputModes) :- - common__partition_call_args(ModuleInfo, ArgModes, Args, +common__partition_call_args(_, _, [], [], [], [], []). +common__partition_call_args(VarTypes, ModuleInfo, [ArgMode | ArgModes], + [Arg | Args], InputArgs, OutputArgs, OutputModes) :- + common__partition_call_args(VarTypes, ModuleInfo, ArgModes, Args, InputArgs1, OutputArgs1, OutputModes1), mode_get_insts(ModuleInfo, ArgMode, InitialInst, FinalInst), - ( inst_matches_binding(InitialInst, FinalInst, ModuleInfo) -> + map__lookup(VarTypes, Arg, Type), + ( inst_matches_binding(InitialInst, FinalInst, Type, ModuleInfo) -> InputArgs = [Arg | InputArgs1], OutputArgs = OutputArgs1, OutputModes = OutputModes1 @@ -545,7 +548,7 @@ common__partition_call_args(ModuleInfo, [ArgMode | ArgModes], [Arg | Args], % between the different variables. % (inst_matches_binding applied to identical insts % fails only for `any' insts.) - inst_matches_binding(FinalInst, FinalInst, ModuleInfo), + inst_matches_binding(FinalInst, FinalInst, Type, ModuleInfo), % Don't optimize calls where a partially instantiated % variable is further instantiated. That case is difficult diff --git a/compiler/continuation_info.m b/compiler/continuation_info.m index 317e7b0fe..91842b522 100644 --- a/compiler/continuation_info.m +++ b/compiler/continuation_info.m @@ -103,6 +103,7 @@ % procid_stack_layout is not set? varset :: prog_varset, % The names of all the variables. + vartypes :: vartypes, internal_map :: proc_label_layout_info % Info for each internal label, % needed for basic_stack_layouts. diff --git a/compiler/deforest.m b/compiler/deforest.m index 35575d2ca..881ef9d7f 100644 --- a/compiler/deforest.m +++ b/compiler/deforest.m @@ -122,8 +122,9 @@ deforest__proc(proc(PredId, ProcId), CostDelta, SizeDelta) --> { proc_info_get_initial_instmap(ProcInfo3, ModuleInfo2, InstMap0) }, { proc_info_vartypes(ProcInfo3, VarTypes) }, - { recompute_instmap_delta(yes, Goal3, Goal, - VarTypes, InstMap0, ModuleInfo2, ModuleInfo3) }, + { proc_info_inst_varset(ProcInfo3, InstVarSet) }, + { recompute_instmap_delta(yes, Goal3, Goal, VarTypes, + InstVarSet, InstMap0, ModuleInfo2, ModuleInfo3) }, pd_info_set_module_info(ModuleInfo3), pd_info_get_pred_info(PredInfo), diff --git a/compiler/det_analysis.m b/compiler/det_analysis.m index 284a63af4..1c5701333 100644 --- a/compiler/det_analysis.m +++ b/compiler/det_analysis.m @@ -257,7 +257,8 @@ det_infer_proc(PredId, ProcId, ModuleInfo0, ModuleInfo, Globals, % Infer the determinism of the goal proc_info_goal(Proc0, Goal0), proc_info_get_initial_instmap(Proc0, ModuleInfo0, InstMap0), - det_info_init(ModuleInfo0, PredId, ProcId, Globals, DetInfo), + proc_info_vartypes(Proc0, VarTypes), + det_info_init(ModuleInfo0, VarTypes, PredId, ProcId, Globals, DetInfo), det_infer_goal(Goal0, InstMap0, SolnContext, DetInfo, Goal, Detism1, Msgs), diff --git a/compiler/det_report.m b/compiler/det_report.m index a6049a9ab..3c3f03549 100644 --- a/compiler/det_report.m +++ b/compiler/det_report.m @@ -179,9 +179,10 @@ check_determinism(PredId, ProcId, PredInfo0, ProcInfo0, ProcId, ModuleInfo1, Message, DeclaredDetism, InferredDetism), { proc_info_goal(ProcInfo0, Goal) }, + { proc_info_vartypes(ProcInfo0, VarTypes) }, globals__io_get_globals(Globals), - { det_info_init(ModuleInfo1, PredId, ProcId, Globals, - DetInfo) }, + { det_info_init(ModuleInfo1, VarTypes, PredId, ProcId, + Globals, DetInfo) }, det_diagnose_goal(Goal, DeclaredDetism, [], DetInfo, _) % XXX with the right verbosity options, we want to % call report_determinism_problem only if diagnose @@ -1257,7 +1258,10 @@ det_report_msg(error_in_lambda(DeclaredDetism, InferredDetism, Goal, GoalInfo, hlds_out__write_determinism(InferredDetism), io__write_string("'.\n"), globals__io_get_globals(Globals), - { det_info_init(ModuleInfo, PredId, ProcId, Globals, DetInfo) }, + { module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo) }, + { proc_info_vartypes(ProcInfo, VarTypes) }, + { det_info_init(ModuleInfo, VarTypes, PredId, ProcId, Globals, + DetInfo) }, det_diagnose_goal(Goal, DeclaredDetism, [], DetInfo, _), io__set_exit_status(1). det_report_msg(par_conj_not_det(InferredDetism, PredId, @@ -1284,7 +1288,10 @@ det_report_msg(par_conj_not_det(InferredDetism, PredId, prog_out__write_context(Context), io__write_string(" non-failing parallel conjunctions.\n"), globals__io_get_globals(Globals), - { det_info_init(ModuleInfo, PredId, ProcId, Globals, DetInfo) }, + { module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo) }, + { proc_info_vartypes(ProcInfo, VarTypes) }, + { det_info_init(ModuleInfo, VarTypes, PredId, ProcId, Globals, + DetInfo) }, det_diagnose_conj(Goals, det, [], DetInfo, _), io__set_exit_status(1). det_report_msg(pragma_c_code_without_det_decl(PredId, ProcId), diff --git a/compiler/det_util.m b/compiler/det_util.m index 034269161..45c944c00 100644 --- a/compiler/det_util.m +++ b/compiler/det_util.m @@ -1,5 +1,5 @@ %-----------------------------------------------------------------------------% -% Copyright (C) 1996-1999 The University of Melbourne. +% Copyright (C) 1996-2000 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. %-----------------------------------------------------------------------------% @@ -61,8 +61,9 @@ :- pred det_no_output_vars(set(prog_var), instmap, instmap_delta, det_info). :- mode det_no_output_vars(in, in, in, in) is semidet. -:- pred det_info_init(module_info, pred_id, proc_id, globals, det_info). -:- mode det_info_init(in, in, in, in, out) is det. +:- pred det_info_init(module_info, vartypes, pred_id, proc_id, globals, + det_info). +:- mode det_info_init(in, in, in, in, in, out) is det. :- pred det_info_get_module_info(det_info, module_info). :- mode det_info_get_module_info(in, out) is det. @@ -85,6 +86,9 @@ :- pred det_info_set_module_info(det_info, module_info, det_info). :- mode det_info_set_module_info(in, in, out) is det. +:- func vartypes(det_info) = vartypes. +:- func 'vartypes:='(det_info, vartypes) = det_info. + %-----------------------------------------------------------------------------% :- implementation. @@ -152,32 +156,35 @@ det_lookup_var_type(ModuleInfo, ProcInfo, Var, TypeDefn) :- det_no_output_vars(Vars, InstMap, InstMapDelta, DetInfo) :- det_info_get_module_info(DetInfo, ModuleInfo), - instmap__no_output_vars(InstMap, InstMapDelta, Vars, ModuleInfo). + instmap__no_output_vars(InstMap, InstMapDelta, Vars, DetInfo^vartypes, + ModuleInfo). %-----------------------------------------------------------------------------% -:- type det_info ---> det_info( - module_info, - pred_id, % the id of the proc - proc_id, % currently processed - bool, % --reorder-conj - bool, % --reorder-disj - bool % --fully-strict - ). +:- type det_info + ---> det_info( + module_info :: module_info, + vartypes :: vartypes, + pred_id :: pred_id, % the id of the proc + proc_id :: proc_id, % currently processed + reorder_conj :: bool, % --reorder-conj + reorder_disj :: bool, % --reorder-disj + fully_strict :: bool % --fully-strict + ). -det_info_init(ModuleInfo, PredId, ProcId, Globals, DetInfo) :- +det_info_init(ModuleInfo, VarTypes, PredId, ProcId, Globals, DetInfo) :- globals__lookup_bool_option(Globals, reorder_conj, ReorderConj), globals__lookup_bool_option(Globals, reorder_disj, ReorderDisj), globals__lookup_bool_option(Globals, fully_strict, FullyStrict), - DetInfo = det_info(ModuleInfo, PredId, ProcId, + DetInfo = det_info(ModuleInfo, VarTypes, PredId, ProcId, ReorderConj, ReorderDisj, FullyStrict). -det_info_get_module_info(det_info(ModuleInfo, _, _, _, _, _), ModuleInfo). -det_info_get_pred_id(det_info(_, PredId, _, _, _, _), PredId). -det_info_get_proc_id(det_info(_, _, ProcId, _, _, _), ProcId). -det_info_get_reorder_conj(det_info(_, _, _, ReorderConj, _, _), ReorderConj). -det_info_get_reorder_disj(det_info(_, _, _, _, ReorderDisj, _), ReorderDisj). -det_info_get_fully_strict(det_info(_, _, _, _, _, FullyStrict), FullyStrict). +det_info_get_module_info(DetInfo, DetInfo^module_info). +det_info_get_pred_id(DetInfo, DetInfo^pred_id). +det_info_get_proc_id(DetInfo, DetInfo^proc_id). +det_info_get_reorder_conj(DetInfo, DetInfo^reorder_conj). +det_info_get_reorder_disj(DetInfo, DetInfo^reorder_disj). +det_info_get_fully_strict(DetInfo, DetInfo^fully_strict). -det_info_set_module_info(det_info(_, B, C, D, E, F), ModuleInfo, - det_info(ModuleInfo, B, C, D, E, F)). +det_info_set_module_info(DetInfo, ModuleInfo, + DetInfo^module_info := ModuleInfo). diff --git a/compiler/dnf.m b/compiler/dnf.m index 5630d64f5..b74dcee95 100644 --- a/compiler/dnf.m +++ b/compiler/dnf.m @@ -147,11 +147,12 @@ dnf__transform_proc(ProcInfo0, PredInfo0, MaybeNonAtomic, pred_info_get_aditi_owner(PredInfo0, Owner), proc_info_goal(ProcInfo0, Goal0), proc_info_varset(ProcInfo0, VarSet), + proc_info_inst_varset(ProcInfo0, InstVarSet), proc_info_vartypes(ProcInfo0, VarTypes), proc_info_typeinfo_varmap(ProcInfo0, TVarMap), proc_info_typeclass_info_varmap(ProcInfo0, TCVarMap), DnfInfo = dnf_info(TVarSet, VarTypes, ClassContext, - VarSet, Markers, TVarMap, TCVarMap, Owner), + VarSet, InstVarSet, Markers, TVarMap, TCVarMap, Owner), proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InstMap), dnf__transform_goal(Goal0, InstMap, MaybeNonAtomic, @@ -166,6 +167,7 @@ dnf__transform_proc(ProcInfo0, PredInfo0, MaybeNonAtomic, map(prog_var, type), class_constraints, prog_varset, + inst_varset, pred_markers, map(tvar, type_info_locn), map(class_constraint, prog_var), @@ -389,7 +391,7 @@ dnf__get_new_pred_name(PredTable, Base, Name, N0, N) :- dnf__define_new_pred(Goal0, Goal, InstMap0, PredName, DnfInfo, ModuleInfo0, ModuleInfo, PredId) :- DnfInfo = dnf_info(TVarSet, VarTypes, ClassContext, - VarSet, Markers, TVarMap, TCVarMap, Owner), + VarSet, InstVarSet, Markers, TVarMap, TCVarMap, Owner), Goal0 = _GoalExpr - GoalInfo, goal_info_get_nonlocals(GoalInfo, NonLocals), set__to_sorted_list(NonLocals, ArgVars), @@ -398,7 +400,7 @@ dnf__define_new_pred(Goal0, Goal, InstMap0, PredName, DnfInfo, % that are not part of the goal. hlds_pred__define_new_pred(Goal0, Goal, ArgVars, _, InstMap0, PredName, TVarSet, VarTypes, ClassContext, TVarMap, TCVarMap, - VarSet, Markers, Owner, address_is_not_taken, + VarSet, InstVarSet, Markers, Owner, address_is_not_taken, ModuleInfo0, ModuleInfo, PredProcId), PredProcId = proc(PredId, _). diff --git a/compiler/follow_code.m b/compiler/follow_code.m index baa09eb0f..f686587ea 100644 --- a/compiler/follow_code.m +++ b/compiler/follow_code.m @@ -56,8 +56,9 @@ move_follow_code_in_proc(_PredInfo, ProcInfo0, ProcInfo, Goal2, Varset, VarTypes, _Warnings), proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InstMap0), - recompute_instmap_delta(no, Goal2, Goal, VarTypes, InstMap0, - ModuleInfo0, ModuleInfo) + proc_info_inst_varset(ProcInfo0, InstVarSet), + recompute_instmap_delta(no, Goal2, Goal, VarTypes, InstVarSet, + InstMap0, ModuleInfo0, ModuleInfo) ; Goal = Goal0, Varset = Varset0, diff --git a/compiler/goal_store.m b/compiler/goal_store.m index ad48c52ac..1c43625fc 100644 --- a/compiler/goal_store.m +++ b/compiler/goal_store.m @@ -18,7 +18,7 @@ :- interface. -:- import_module hlds_goal, hlds_module, instmap. +:- import_module hlds_goal, hlds_module, hlds_pred, instmap. :- import_module bool, set, std_util. %-----------------------------------------------------------------------------% @@ -36,8 +36,8 @@ :- pred goal_store__member(goal_store(T)::in, T::out, goal::out) is nondet. -:- pred goal_store__all_ancestors(goal_store(T)::in, T::in, module_info::in, - bool::in, set(T)::out) is det. +:- pred goal_store__all_ancestors(goal_store(T)::in, T::in, vartypes::in, + module_info::in, bool::in, set(T)::out) is det. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% @@ -66,48 +66,50 @@ goal_store__lookup(GS, Id, Goal) :- goal_store__member(GoalStore, Key, Goal) :- map__member(GoalStore, Key, Goal). -goal_store__all_ancestors(GoalStore, StartId, ModuleInfo, FullyStrict, +goal_store__all_ancestors(GoalStore, StartId, VarTypes, ModuleInfo, FullyStrict, AncestorIds) :- AncestorIds = ancestors_2(GoalStore, [StartId], set__init, - ModuleInfo, FullyStrict). + VarTypes, ModuleInfo, FullyStrict). -:- func ancestors_2(goal_store(T), list(T), set(T), module_info, bool) = set(T). +:- func ancestors_2(goal_store(T), list(T), set(T), vartypes, module_info, + bool) = set(T). -ancestors_2(_GoalStore, [], _VisitedIds, _ModuleInfo, _FullyStrict) = set__init. -ancestors_2(GoalStore, [Id|Ids], VisitedIds, ModuleInfo, FullyStrict) +ancestors_2(_GoalStore, [], _VisitedIds, _VarTypes, _ModuleInfo, _FullyStrict) + = set__init. +ancestors_2(GoalStore, [Id|Ids], VisitedIds, VarTypes, ModuleInfo, FullyStrict) = AncestorIds :- ( set__member(Id, VisitedIds) -> AncestorIds = ancestors_2(GoalStore, Ids, VisitedIds, - ModuleInfo, FullyStrict) + VarTypes, ModuleInfo, FullyStrict) ; - Ancestors = direct_ancestors(GoalStore, Id, ModuleInfo, - FullyStrict), + Ancestors = direct_ancestors(GoalStore, Id, VarTypes, + ModuleInfo, FullyStrict), AncestorIds = set__list_to_set(Ancestors) `union` - ancestors_2( - GoalStore, - Ancestors `append` Ids, - set__insert(VisitedIds, Id), - ModuleInfo, FullyStrict) + ancestors_2(GoalStore, Ancestors `append` Ids, + set__insert(VisitedIds, Id), + VarTypes, ModuleInfo, FullyStrict) ). -:- func direct_ancestors(goal_store(T), T, module_info, bool) = list(T). +:- func direct_ancestors(goal_store(T), T, vartypes, module_info, bool) + = list(T). -direct_ancestors(GoalStore, StartId, ModuleInfo, FullyStrict) +direct_ancestors(GoalStore, StartId, VarTypes, ModuleInfo, FullyStrict) = Ancestors :- - solutions(direct_ancestor(GoalStore, StartId, ModuleInfo, - FullyStrict), Ancestors). + solutions(direct_ancestor(GoalStore, StartId, VarTypes, + ModuleInfo, FullyStrict), Ancestors). -:- pred direct_ancestor(goal_store(T)::in, T::in, module_info::in, - bool::in, T::out) is nondet. +:- pred direct_ancestor(goal_store(T)::in, T::in, vartypes::in, + module_info::in, bool::in, T::out) is nondet. -direct_ancestor(GoalStore, StartId, ModuleInfo, FullyStrict, EarlierId) :- +direct_ancestor(GoalStore, StartId, VarTypes, ModuleInfo, FullyStrict, + EarlierId) :- goal_store__lookup(GoalStore, StartId, LaterGoal - LaterInstMap), goal_store__member(GoalStore, EarlierId, EarlierGoal - EarlierInstMap), compare((<), EarlierId, StartId), - not goal_util__can_reorder_goals(ModuleInfo, FullyStrict, + not goal_util__can_reorder_goals(ModuleInfo, VarTypes, FullyStrict, EarlierInstMap, EarlierGoal, LaterInstMap, LaterGoal). diff --git a/compiler/goal_util.m b/compiler/goal_util.m index 3b4c4928a..cc962bd2d 100644 --- a/compiler/goal_util.m +++ b/compiler/goal_util.m @@ -184,8 +184,8 @@ % - any possible change in termination behaviour is allowed % according to the semantics options. % -:- pred goal_util__can_reorder_goals(module_info::in, bool::in, instmap::in, - hlds_goal::in, instmap::in, hlds_goal::in) is semidet. +:- pred goal_util__can_reorder_goals(module_info::in, vartypes::in, bool::in, + instmap::in, hlds_goal::in, instmap::in, hlds_goal::in) is semidet. % goal_util__reordering_maintains_termination(ModuleInfo, % FullyStrict, Goal1, Goal2) @@ -1092,8 +1092,9 @@ goal_util__compute_disjunct_goal_info(Goal1, Goal2, GoalInfo, CombinedInfo) :- %-----------------------------------------------------------------------------% -goal_util__can_reorder_goals(ModuleInfo, FullyStrict, InstmapBeforeEarlierGoal, - EarlierGoal, InstmapBeforeLaterGoal, LaterGoal) :- +goal_util__can_reorder_goals(ModuleInfo, VarTypes, FullyStrict, + InstmapBeforeEarlierGoal, EarlierGoal, InstmapBeforeLaterGoal, + LaterGoal) :- EarlierGoal = _ - EarlierGoalInfo, LaterGoal = _ - LaterGoalInfo, @@ -1110,7 +1111,7 @@ goal_util__can_reorder_goals(ModuleInfo, FullyStrict, InstmapBeforeEarlierGoal, % on the outputs of the current goal. % \+ goal_depends_on_earlier_goal(LaterGoal, EarlierGoal, - InstmapBeforeEarlierGoal, ModuleInfo), + InstmapBeforeEarlierGoal, VarTypes, ModuleInfo), % % Don't reorder the goals if the later goal changes the @@ -1120,7 +1121,7 @@ goal_util__can_reorder_goals(ModuleInfo, FullyStrict, InstmapBeforeEarlierGoal, % full mode analysis in other cases. % \+ goal_depends_on_earlier_goal(EarlierGoal, LaterGoal, - InstmapBeforeLaterGoal, ModuleInfo). + InstmapBeforeLaterGoal, VarTypes, ModuleInfo). goal_util__reordering_maintains_termination(ModuleInfo, FullyStrict, @@ -1159,17 +1160,17 @@ goal_util__reordering_maintains_termination(ModuleInfo, FullyStrict, % % This code does work on the alias branch. % -:- pred goal_depends_on_earlier_goal(hlds_goal::in, - hlds_goal::in, instmap::in, module_info::in) is semidet. +:- pred goal_depends_on_earlier_goal(hlds_goal::in, hlds_goal::in, instmap::in, + vartypes::in, module_info::in) is semidet. goal_depends_on_earlier_goal(_ - LaterGoalInfo, _ - EarlierGoalInfo, - InstMapBeforeEarlierGoal, ModuleInfo) :- + InstMapBeforeEarlierGoal, VarTypes, ModuleInfo) :- goal_info_get_instmap_delta(EarlierGoalInfo, EarlierInstMapDelta), instmap__apply_instmap_delta(InstMapBeforeEarlierGoal, EarlierInstMapDelta, InstMapAfterEarlierGoal), instmap_changed_vars(InstMapBeforeEarlierGoal, InstMapAfterEarlierGoal, - ModuleInfo, EarlierChangedVars), + VarTypes, ModuleInfo, EarlierChangedVars), goal_info_get_nonlocals(LaterGoalInfo, LaterGoalNonLocals), set__intersect(EarlierChangedVars, LaterGoalNonLocals, Intersection), diff --git a/compiler/higher_order.m b/compiler/higher_order.m index 38ea642cd..98b246fc4 100644 --- a/compiler/higher_order.m +++ b/compiler/higher_order.m @@ -418,9 +418,9 @@ fixup_proc_info(MustRecompute, Goal0, Info0, Info) :- RecomputeAtomic = no, proc_info_get_initial_instmap(ProcInfo2, ModuleInfo0, InstMap), proc_info_vartypes(ProcInfo2, VarTypes), - recompute_instmap_delta(RecomputeAtomic, - Goal2, Goal3, VarTypes, InstMap, - ModuleInfo0, ModuleInfo), + proc_info_inst_varset(ProcInfo2, InstVarSet), + recompute_instmap_delta(RecomputeAtomic, Goal2, Goal3, + VarTypes, InstVarSet, InstMap, ModuleInfo0, ModuleInfo), proc_info_set_goal(ProcInfo2, Goal3, ProcInfo), Info = info(A, B, C, D, E, ProcInfo, ModuleInfo, H, Changed) @@ -982,7 +982,7 @@ get_typeclass_info_args_2(TypeClassInfoVar, PredId, ProcId, SymName, set__list_to_set(CallArgs, NonLocals), instmap_delta_init_reachable(InstMapDelta0), instmap_delta_insert(InstMapDelta0, ResultVar, - ground(shared, no), InstMapDelta), + ground(shared, none), InstMapDelta), goal_info_init(NonLocals, InstMapDelta, det, GoalInfo), CallGoal = call(PredId, ProcId, CallArgs, not_builtin, MaybeContext, SymName) - GoalInfo, @@ -1805,7 +1805,8 @@ specialize_special_pred(CalledPred, CalledProc, Args, set__list_to_set([ComparisonResult, Arg1, Arg2], NonLocals), instmap_delta_from_assoc_list( - [ComparisonResult - ground(shared,no)], + [ComparisonResult - + ground(shared,none)], InstMapDelta), Detism = det, goal_info_init(NonLocals, InstMapDelta, @@ -1870,7 +1871,7 @@ specialize_special_pred(CalledPred, CalledProc, Args, SpecialPredArgs = [ComparisonResult, _, _], set__insert(NonLocals0, ComparisonResult, NonLocals), instmap_delta_from_assoc_list( - [ComparisonResult - ground(shared, no)], + [ComparisonResult - ground(shared, none)], InstMapDelta), Detism = det, % Build a new call with the unwrapped arguments. @@ -2054,7 +2055,7 @@ generate_unsafe_type_cast(ModuleInfo, ToType, Arg, CastArg, Goal, hlds_pred__initial_proc_id(ProcId), proc_info_create_var_from_type(ProcInfo0, ToType, CastArg, ProcInfo), set__list_to_set([Arg, CastArg], NonLocals), - instmap_delta_from_assoc_list([CastArg - ground(shared, no)], + instmap_delta_from_assoc_list([CastArg - ground(shared, none)], InstMapDelta), goal_info_init(NonLocals, InstMapDelta, det, GoalInfo), Goal = call(PredId, ProcId, [Arg, CastArg], not_builtin, @@ -2068,13 +2069,13 @@ unwrap_no_tag_arg(WrappedType, Constructor, Arg, UnwrappedArg, proc_info_create_var_from_type(ProcInfo0, WrappedType, UnwrappedArg, ProcInfo), ConsId = cons(Constructor, 1), - UniModes = [(ground(shared, no) - free) -> - (ground(shared, no) - ground(shared, no))], + UniModes = [(ground(shared, none) - free) -> + (ground(shared, none) - ground(shared, none))], in_mode(In), out_mode(Out), set__list_to_set([Arg, UnwrappedArg], NonLocals), % This will be recomputed later. - instmap_delta_from_assoc_list([UnwrappedArg - ground(shared, no)], + instmap_delta_from_assoc_list([UnwrappedArg - ground(shared, none)], InstMapDelta), goal_info_init(NonLocals, InstMapDelta, det, GoalInfo), Goal = unify(Arg, functor(ConsId, [UnwrappedArg]), In - Out, diff --git a/compiler/hlds_data.m b/compiler/hlds_data.m index 89aef555f..87a15bd4a 100644 --- a/compiler/hlds_data.m +++ b/compiler/hlds_data.m @@ -454,7 +454,7 @@ hlds_data__set_type_defn_status(hlds_type_defn(A, B, C, _, E), Status, ---> hlds_inst_defn( inst_varset, % The names of the inst % parameters (if any). - list(inst_param), % The inst parameters (if any). + list(inst_var), % The inst parameters (if any). % ([I] in the above example.) hlds_inst_body, % The definition of this inst. condition, % Unused (reserved for @@ -651,7 +651,7 @@ user_inst_table_optimize(user_inst_table(InstDefns0, InstIds0), ---> hlds_mode_defn( inst_varset, % The names of the inst % parameters (if any). - list(inst_param), % The list of the inst + list(inst_var), % The list of the inst % parameters (if any). % (e.g. [I] for the second % example above.) diff --git a/compiler/hlds_pred.m b/compiler/hlds_pred.m index 76319c298..3528f5fca 100644 --- a/compiler/hlds_pred.m +++ b/compiler/hlds_pred.m @@ -468,10 +468,10 @@ :- pred hlds_pred__define_new_pred(hlds_goal, hlds_goal, list(prog_var), list(prog_var), instmap, string, tvarset, vartypes, class_constraints, type_info_varmap, typeclass_info_varmap, - prog_varset, pred_markers, aditi_owner, is_address_taken, - module_info, module_info, pred_proc_id). + prog_varset, inst_varset, pred_markers, aditi_owner, + is_address_taken, module_info, module_info, pred_proc_id). :- mode hlds_pred__define_new_pred(in, out, in, out, in, in, in, in, in, - in, in, in, in, in, in, in, out, out) is det. + in, in, in, in, in, in, in, in, out, out) is det. % Various predicates for accessing the information stored in the % pred_id and pred_info data structures. @@ -1132,7 +1132,7 @@ clauses_info_set_typeclass_info_varmap(CI, X, hlds_pred__define_new_pred(Goal0, Goal, ArgVars0, ExtraTypeInfos, InstMap0, PredName, TVarSet, VarTypes0, ClassContext, TVarMap, TCVarMap, - VarSet0, Markers, Owner, IsAddressTaken, + VarSet0, InstVarSet, Markers, Owner, IsAddressTaken, ModuleInfo0, ModuleInfo, PredProcId) :- Goal0 = _GoalExpr - GoalInfo, goal_info_get_instmap_delta(GoalInfo, InstMapDelta), @@ -1184,8 +1184,9 @@ hlds_pred__define_new_pred(Goal0, Goal, ArgVars0, ExtraTypeInfos, InstMap0, TermInfo = no ), - proc_info_create(VarSet, VarTypes, ArgVars, ArgModes, Detism, Goal0, - Context, TVarMap, TCVarMap, IsAddressTaken, ProcInfo0), + proc_info_create(VarSet, VarTypes, ArgVars, ArgModes, InstVarSet, + Detism, Goal0, Context, TVarMap, TCVarMap, IsAddressTaken, + ProcInfo0), proc_info_set_maybe_termination_info(ProcInfo0, TermInfo, ProcInfo), set__init(Assertions), @@ -1234,18 +1235,19 @@ compute_arg_types_modes([Var | Vars], VarTypes, InstMap0, InstMap, :- mode proc_info_init(in, in, in, in, in, in, in, in, out) is det. :- pred proc_info_set(maybe(determinism), prog_varset, vartypes, - list(prog_var), list(mode), maybe(list(is_live)), hlds_goal, - prog_context, stack_slots, determinism, bool, list(arg_info), - liveness_info, type_info_varmap, typeclass_info_varmap, - maybe(arg_size_info), maybe(termination_info), is_address_taken, - proc_info). -:- mode proc_info_set(in, in, in, in, in, in, in, in, in, in, in, in, in, in, - in, in, in, in, out) is det. + list(prog_var), list(mode), inst_varset, maybe(list(is_live)), + hlds_goal, prog_context, stack_slots, determinism, bool, + list(arg_info), liveness_info, type_info_varmap, + typeclass_info_varmap, maybe(arg_size_info), + maybe(termination_info), is_address_taken, proc_info). +:- mode proc_info_set(in, in, in, in, in, in, in, in, in, in, in, in, + in, in, in, in, in, in, in, out) is det. :- pred proc_info_create(prog_varset, vartypes, list(prog_var), - list(mode), determinism, hlds_goal, prog_context, + list(mode), inst_varset, determinism, hlds_goal, prog_context, type_info_varmap, typeclass_info_varmap, is_address_taken, proc_info). -:- mode proc_info_create(in, in, in, in, in, in, in, in, in, in, out) is det. +:- mode proc_info_create(in, in, in, in, in, in, in, in, in, in, in, out) + is det. :- pred proc_info_set_body(proc_info, prog_varset, vartypes, list(prog_var), hlds_goal, type_info_varmap, @@ -1295,6 +1297,12 @@ compute_arg_types_modes([Var | Vars], VarTypes, InstMap0, InstMap, :- pred proc_info_set_argmodes(proc_info, list(mode), proc_info). :- mode proc_info_set_argmodes(in, in, out) is det. +:- pred proc_info_inst_varset(proc_info, inst_varset). +:- mode proc_info_inst_varset(in, out) is det. + +:- pred proc_info_set_inst_varset(proc_info, inst_varset, proc_info). +:- mode proc_info_set_inst_varset(in, in, out) is det. + :- pred proc_info_arglives(proc_info, module_info, list(is_live)). :- mode proc_info_arglives(in, in, out) is det. @@ -1492,13 +1500,11 @@ compute_arg_types_modes([Var | Vars], VarTypes, InstMap0, InstMap, :- type proc_info ---> procedure( - declared_detism :: maybe(determinism), - % _declared_ determinism - % or `no' if there was no detism decl prog_varset :: prog_varset, var_types :: vartypes, head_vars :: list(prog_var), actual_head_modes :: list(mode), + inst_varset :: inst_varset, head_var_caller_liveness :: maybe(list(is_live)), % Liveness (in the mode analysis sense) % of the arguments in the caller; says @@ -1511,6 +1517,9 @@ compute_arg_types_modes([Var | Vars], VarTypes, InstMap0, InstMap, % if there was no mode declaration). stack_slots :: stack_slots, % stack allocations + declared_detism :: maybe(determinism), + % _declared_ determinism + % or `no' if there was no detism decl inferred_detism :: determinism, can_process :: bool, % no if we must not process this @@ -1619,6 +1628,7 @@ proc_info_init(Arity, Types, Modes, DeclaredModes, MaybeArgLives, varset__init(BodyVarSet0), make_n_fresh_vars("HeadVar__", Arity, BodyVarSet0, HeadVars, BodyVarSet), + varset__init(InstVarSet), map__from_corresponding_lists(HeadVars, Types, BodyTypes), InferredDet = erroneous, map__init(StackSlots), @@ -1631,33 +1641,36 @@ proc_info_init(Arity, Types, Modes, DeclaredModes, MaybeArgLives, map__init(TCVarsMap), RLExprn = no, NewProc = procedure( - MaybeDet, BodyVarSet, BodyTypes, HeadVars, Modes, MaybeArgLives, - ClauseBody, MContext, StackSlots, InferredDet, CanProcess, - ArgInfo, InitialLiveness, TVarsMap, TCVarsMap, eval_normal, - no, no, DeclaredModes, IsAddressTaken, RLExprn, no, no + BodyVarSet, BodyTypes, HeadVars, Modes, InstVarSet, + MaybeArgLives, ClauseBody, MContext, StackSlots, MaybeDet, + InferredDet, CanProcess, ArgInfo, InitialLiveness, TVarsMap, + TCVarsMap, eval_normal, no, no, DeclaredModes, IsAddressTaken, + RLExprn, no, no ). proc_info_set(DeclaredDetism, BodyVarSet, BodyTypes, HeadVars, HeadModes, - HeadLives, Goal, Context, StackSlots, InferredDetism, - CanProcess, ArgInfo, Liveness, TVarMap, TCVarsMap, ArgSizes, - Termination, IsAddressTaken, ProcInfo) :- + InstVarSet, HeadLives, Goal, Context, StackSlots, + InferredDetism, CanProcess, ArgInfo, Liveness, TVarMap, + TCVarsMap, ArgSizes, Termination, IsAddressTaken, + ProcInfo) :- RLExprn = no, ProcInfo = procedure( - DeclaredDetism, BodyVarSet, BodyTypes, HeadVars, HeadModes, - HeadLives, Goal, Context, StackSlots, InferredDetism, - CanProcess, ArgInfo, Liveness, TVarMap, TCVarsMap, eval_normal, - ArgSizes, Termination, no, IsAddressTaken, RLExprn, no, no). + BodyVarSet, BodyTypes, HeadVars, + HeadModes, InstVarSet, HeadLives, Goal, Context, + StackSlots, DeclaredDetism, InferredDetism, CanProcess, ArgInfo, + Liveness, TVarMap, TCVarsMap, eval_normal, ArgSizes, + Termination, no, IsAddressTaken, RLExprn, no, no). -proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, Detism, Goal, - Context, TVarMap, TCVarsMap, IsAddressTaken, ProcInfo) :- +proc_info_create(VarSet, VarTypes, HeadVars, HeadModes, InstVarSet, Detism, + Goal, Context, TVarMap, TCVarsMap, IsAddressTaken, ProcInfo) :- map__init(StackSlots), set__init(Liveness), MaybeHeadLives = no, RLExprn = no, - ProcInfo = procedure(yes(Detism), VarSet, VarTypes, HeadVars, HeadModes, - MaybeHeadLives, Goal, Context, StackSlots, Detism, yes, [], - Liveness, TVarMap, TCVarsMap, eval_normal, no, no, no, - IsAddressTaken, RLExprn, no, no). + ProcInfo = procedure(VarSet, VarTypes, HeadVars, HeadModes, + InstVarSet, MaybeHeadLives, Goal, Context, StackSlots, + yes(Detism), Detism, yes, [], Liveness, TVarMap, TCVarsMap, + eval_normal, no, no, no, IsAddressTaken, RLExprn, no, no). proc_info_set_body(ProcInfo0, VarSet, VarTypes, HeadVars, Goal, TI_VarMap, TCI_VarMap, ProcInfo) :- @@ -1727,6 +1740,7 @@ proc_info_varset(ProcInfo, ProcInfo^prog_varset). proc_info_vartypes(ProcInfo, ProcInfo^var_types). proc_info_headvars(ProcInfo, ProcInfo^head_vars). proc_info_argmodes(ProcInfo, ProcInfo^actual_head_modes). +proc_info_inst_varset(ProcInfo, ProcInfo^inst_varset). proc_info_maybe_arglives(ProcInfo, ProcInfo^head_var_caller_liveness). proc_info_goal(ProcInfo, ProcInfo^body). proc_info_context(ProcInfo, ProcInfo^proc_context). @@ -1750,6 +1764,7 @@ proc_info_set_varset(ProcInfo, VS, ProcInfo^prog_varset := VS). proc_info_set_vartypes(ProcInfo, VT, ProcInfo^var_types := VT). proc_info_set_headvars(ProcInfo, HV, ProcInfo^head_vars := HV). proc_info_set_argmodes(ProcInfo, AM, ProcInfo^actual_head_modes := AM). +proc_info_set_inst_varset(ProcInfo, IV, ProcInfo^inst_varset := IV). proc_info_set_maybe_arglives(ProcInfo, CL, ProcInfo^head_var_caller_liveness := CL). proc_info_set_goal(ProcInfo, G, ProcInfo^body := G). @@ -1860,11 +1875,13 @@ proc_info_create_vars_from_types(ProcInfo0, Types, NewVars, ProcInfo) :- proc_info_instantiated_head_vars(ModuleInfo, ProcInfo, ChangedInstHeadVars) :- proc_info_headvars(ProcInfo, HeadVars), proc_info_argmodes(ProcInfo, ArgModes), + proc_info_vartypes(ProcInfo, VarTypes), assoc_list__from_corresponding_lists(HeadVars, ArgModes, HeadVarModes), IsInstChanged = lambda([VarMode::in, Var::out] is semidet, ( VarMode = Var - Mode, + map__lookup(VarTypes, Var, Type), mode_get_insts(ModuleInfo, Mode, Inst1, Inst2), - \+ inst_matches_binding(Inst1, Inst2, ModuleInfo) + \+ inst_matches_binding(Inst1, Inst2, Type, ModuleInfo) )), list__filter_map(IsInstChanged, HeadVarModes, ChangedInstHeadVars). @@ -1872,11 +1889,13 @@ proc_info_uninstantiated_head_vars(ModuleInfo, ProcInfo, UnchangedInstHeadVars) :- proc_info_headvars(ProcInfo, HeadVars), proc_info_argmodes(ProcInfo, ArgModes), + proc_info_vartypes(ProcInfo, VarTypes), assoc_list__from_corresponding_lists(HeadVars, ArgModes, HeadVarModes), IsInstUnchanged = lambda([VarMode::in, Var::out] is semidet, ( VarMode = Var - Mode, + map__lookup(VarTypes, Var, Type), mode_get_insts(ModuleInfo, Mode, Inst1, Inst2), - inst_matches_binding(Inst1, Inst2, ModuleInfo) + inst_matches_binding(Inst1, Inst2, Type, ModuleInfo) )), list__filter_map(IsInstUnchanged, HeadVarModes, UnchangedInstHeadVars). diff --git a/compiler/inlining.m b/compiler/inlining.m index a5b333e37..6f79d4bdd 100644 --- a/compiler/inlining.m +++ b/compiler/inlining.m @@ -388,6 +388,7 @@ inlining__mark_proc_as_inlined(proc(PredId, ProcId), ModuleInfo, % type variables to variables % where their type_info is % stored. + bool, % Did we do any inlining in the proc? bool, % Does the goal need to be % requantified? bool % Did we change the determinism @@ -419,18 +420,20 @@ inlining__in_predproc(PredProcId, InlinedProcs, Params, proc_info_vartypes(ProcInfo0, VarTypes0), proc_info_typeinfo_varmap(ProcInfo0, TypeInfoVarMap0), + DidInlining0 = no, Requantify0 = no, DetChanged0 = no, InlineInfo0 = inline_info(VarThresh, HighLevelCode, InlinedProcs, ModuleInfo0, UnivQTVars, Markers, VarSet0, VarTypes0, TypeVarSet0, TypeInfoVarMap0, - Requantify0, DetChanged0), + DidInlining0, Requantify0, DetChanged0), inlining__inlining_in_goal(Goal0, Goal, InlineInfo0, InlineInfo), InlineInfo = inline_info(_, _, _, _, _, _, VarSet, VarTypes, - TypeVarSet, TypeInfoVarMap, Requantify, DetChanged), + TypeVarSet, TypeInfoVarMap, DidInlining, Requantify, + DetChanged), pred_info_set_typevarset(PredInfo0, TypeVarSet, PredInfo1), @@ -439,19 +442,29 @@ inlining__in_predproc(PredProcId, InlinedProcs, Params, proc_info_set_typeinfo_varmap(ProcInfo2, TypeInfoVarMap, ProcInfo3), proc_info_set_goal(ProcInfo3, Goal, ProcInfo4), + ( + DidInlining = yes, + recompute_instmap_delta_proc(yes, ProcInfo4, ProcInfo5, + ModuleInfo0, ModuleInfo1) + ; + DidInlining = no, + ProcInfo5 = ProcInfo4, + ModuleInfo1 = ModuleInfo0 + ), + globals__io_get_globals(Globals, IoState0, IoState), ( Requantify = yes, - requantify_proc(ProcInfo4, ProcInfo) + requantify_proc(ProcInfo5, ProcInfo) ; Requantify = no, - ProcInfo = ProcInfo4 + ProcInfo = ProcInfo5 ), map__det_update(ProcTable0, ProcId, ProcInfo, ProcTable), pred_info_set_procedures(PredInfo1, ProcTable, PredInfo), map__det_update(PredTable0, PredId, PredInfo, PredTable), - module_info_set_preds(ModuleInfo0, PredTable, ModuleInfo1), + module_info_set_preds(ModuleInfo1, PredTable, ModuleInfo2), % If the determinism of some sub-goals has changed, % then we re-run determinism analysis, because @@ -459,11 +472,11 @@ inlining__in_predproc(PredProcId, InlinedProcs, Params, % the procedure may lead to more efficient code. ( DetChanged = yes, - det_infer_proc(PredId, ProcId, ModuleInfo1, ModuleInfo, + det_infer_proc(PredId, ProcId, ModuleInfo2, ModuleInfo, Globals, _, _, _) ; DetChanged = no, - ModuleInfo = ModuleInfo1 + ModuleInfo = ModuleInfo2 ). %-----------------------------------------------------------------------------% @@ -507,7 +520,7 @@ inlining__inlining_in_goal(call(PredId, ProcId, ArgVars, Builtin, Context, InlineInfo0 = inline_info(VarThresh, HighLevelCode, InlinedProcs, ModuleInfo, HeadTypeParams, Markers, VarSet0, VarTypes0, TypeVarSet0, TypeInfoVarMap0, - Requantify0, DetChanged0), + DidInlining0, Requantify0, DetChanged0), % should we inline this call? ( @@ -549,6 +562,7 @@ inlining__inlining_in_goal(call(PredId, ProcId, ArgVars, Builtin, Context, % on this proc. goal_info_get_determinism(GoalInfo0, Determinism0), goal_info_get_determinism(GoalInfo, Determinism), + DidInlining = yes, ( Determinism0 = Determinism -> DetChanged = DetChanged0 ; @@ -561,12 +575,13 @@ inlining__inlining_in_goal(call(PredId, ProcId, ArgVars, Builtin, Context, VarTypes = VarTypes0, TypeVarSet = TypeVarSet0, TypeInfoVarMap = TypeInfoVarMap0, + DidInlining = DidInlining0, Requantify = Requantify0, DetChanged = DetChanged0 ), InlineInfo = inline_info(VarThresh, HighLevelCode, InlinedProcs, ModuleInfo, HeadTypeParams, Markers, - VarSet, VarTypes, TypeVarSet, TypeInfoVarMap, + VarSet, VarTypes, TypeVarSet, TypeInfoVarMap, DidInlining, Requantify, DetChanged). inlining__inlining_in_goal(generic_call(A, B, C, D) - GoalInfo, diff --git a/compiler/inst.m b/compiler/inst.m index b323aae39..d7835c6de 100644 --- a/compiler/inst.m +++ b/compiler/inst.m @@ -1,5 +1,5 @@ %-----------------------------------------------------------------------------% -% Copyright (C) 1997, 1999 The University of Melbourne. +% Copyright (C) 1997, 1999-2000 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. %-----------------------------------------------------------------------------% @@ -23,7 +23,7 @@ % `abstract_cons_id' and use that here instead of `cons_id'. :- import_module prog_data, hlds_data. -:- import_module list, std_util. +:- import_module list, map. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% @@ -34,9 +34,9 @@ ; free(type) ; bound(uniqueness, list(bound_inst)) % The list(bound_inst) must be sorted - ; ground(uniqueness, maybe(pred_inst_info)) - % The pred_inst_info is used for - % higher-order pred modes + ; ground(uniqueness, ground_inst_info) + % The ground_inst_info holds extra information + % about the ground inst. ; not_reached ; inst_var(inst_var) % A defined_inst is possibly recursive @@ -65,8 +65,18 @@ % on backtracking, so we will need to % restore the old value on backtracking + % The ground_inst_info type gives extra information about ground insts. +:- type ground_inst_info + ---> higher_order(pred_inst_info) + % The ground inst is higher-order. + ; constrained_inst_var(inst_var) + % The ground inst is an inst variable that is + % constrained to be ground. + ; none. + % No extra information is available. + % higher-order predicate terms are given the inst - % `ground(shared, yes(PredInstInfo))' + % `ground(shared, higher_order(PredInstInfo))' % where the PredInstInfo contains the extra modes and the determinism % for the predicate. Note that the higher-order predicate term % itself must be ground. @@ -89,6 +99,8 @@ :- type bound_inst ---> functor(cons_id, list(inst)). +:- type inst_var_sub == map(inst_var, inst). + %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% diff --git a/compiler/inst_match.m b/compiler/inst_match.m index ddfbe2e8f..3c06b59da 100644 --- a/compiler/inst_match.m +++ b/compiler/inst_match.m @@ -53,11 +53,15 @@ mode system to distinguish between different representations. %-----------------------------------------------------------------------------% -:- pred inst_matches_initial(inst, inst, module_info). -:- mode inst_matches_initial(in, in, in) is semidet. +:- pred inst_matches_initial(inst, inst, type, module_info). +:- mode inst_matches_initial(in, in, in, in) is semidet. -:- pred inst_matches_final(inst, inst, module_info). -:- mode inst_matches_final(in, in, in) is semidet. +:- pred inst_matches_initial(inst, inst, type, module_info, module_info, + inst_var_sub, inst_var_sub). +:- mode inst_matches_initial(in, in, in, in, out, in, out) is semidet. + +:- pred inst_matches_final(inst, inst, type, module_info). +:- mode inst_matches_final(in, in, in, in) is semidet. % inst_matches_initial(InstA, InstB, ModuleInfo): % Succeed iff `InstA' specifies at least as much @@ -108,8 +112,8 @@ mode system to distinguish between different representations. % unique_matches_final(A, B) succeeds if A >= B in the ordering % clobbered < mostly_clobbered < shared < mostly_unique < unique -:- pred inst_matches_binding(inst, inst, module_info). -:- mode inst_matches_binding(in, in, in) is semidet. +:- pred inst_matches_binding(inst, inst, type, module_info). +:- mode inst_matches_binding(in, in, in, in) is semidet. % inst_matches_binding(InstA, InstB, ModuleInfo): % Succeed iff the binding of InstA is definitely exactly the @@ -255,120 +259,338 @@ mode system to distinguish between different representations. %-----------------------------------------------------------------------------% :- implementation. -:- import_module hlds_data, mode_util, prog_data, inst_util. +:- import_module hlds_data, mode_util, prog_data, inst_util, type_util. :- import_module list, set, map, term, std_util, require, bool. -inst_matches_initial(InstA, InstB, ModuleInfo) :- - set__init(Expansions0), - inst_matches_initial_2(InstA, InstB, ModuleInfo, - Expansions0, _Expansions). +inst_matches_initial(InstA, InstB, Type, ModuleInfo) :- + inst_matches_initial_1(InstA, InstB, Type, ModuleInfo, _, no, _). + +inst_matches_initial(InstA, InstB, Type, ModuleInfo0, ModuleInfo, Sub0, Sub) :- + inst_matches_initial_1(InstA, InstB, Type, ModuleInfo0, ModuleInfo, + yes(Sub0), MaybeSub), + ( + MaybeSub = yes(Sub) + ; + MaybeSub = no, + error("inst_matches_initial: missing inst_var_sub") + ). + +:- pred inst_matches_initial_1(inst, inst, type, module_info, module_info, + maybe(inst_var_sub), maybe(inst_var_sub)). +:- mode inst_matches_initial_1(in, in, in, in, out, in, out) is semidet. + +inst_matches_initial_1(InstA, InstB, Type, ModuleInfo0, ModuleInfo, + MaybeSub0, MaybeSub) :- + Info0 = init_inst_match_info(ModuleInfo0)^sub := MaybeSub0, + inst_matches_initial_2(InstA, InstB, yes(Type), Info0, Info), + ModuleInfo = Info^module_info, + MaybeSub = Info^sub. :- type expansions == set(pair(inst)). -:- pred inst_matches_initial_2(inst, inst, module_info, - expansions, expansions). +:- type inst_match_info + ---> inst_match_info( + module_info :: module_info, + expansions :: expansions, + sub :: maybe(inst_var_sub) + ). + +:- func init_inst_match_info(module_info) = inst_match_info. + +init_inst_match_info(ModuleInfo) = inst_match_info(ModuleInfo, Exp, no) :- + set__init(Exp). + +:- pred inst_matches_initial_2(inst, inst, maybe(type), + inst_match_info, inst_match_info). :- mode inst_matches_initial_2(in, in, in, in, out) is semidet. -inst_matches_initial_2(InstA, InstB, ModuleInfo, Expansions0, Expansions) :- +inst_matches_initial_2(InstA, InstB, Type, Info0, Info) :- ThisExpansion = InstA - InstB, - ( set__member(ThisExpansion, Expansions0) -> - Expansions = Expansions0 -/********* - % does this test improve efficiency?? - ; InstA = InstB -> - Expansions = Expansions0 -**********/ + ( set__member(ThisExpansion, Info0^expansions) -> + Info = Info0 + ; - inst_expand(ModuleInfo, InstA, InstA2), - inst_expand(ModuleInfo, InstB, InstB2), - set__insert(Expansions0, ThisExpansion, Expansions1), - inst_matches_initial_3(InstA2, InstB2, ModuleInfo, - Expansions1, Expansions) + inst_expand(Info0^module_info, InstA, InstA2), + inst_expand(Info0^module_info, InstB, InstB2), + set__insert(Info0^expansions, ThisExpansion, Expansions1), + inst_matches_initial_3(InstA2, InstB2, Type, + Info0^expansions := Expansions1, Info) ). -:- pred inst_matches_initial_3(inst, inst, module_info, expansions, expansions). +:- pred inst_matches_initial_3(inst, inst, maybe(type), + inst_match_info, inst_match_info). :- mode inst_matches_initial_3(in, in, in, in, out) is semidet. % To avoid infinite regress, we assume that % inst_matches_initial is true for any pairs of insts which % occur in `Expansions'. -inst_matches_initial_3(any(UniqA), any(UniqB), _, Expansions, Expansions) :- +inst_matches_initial_3(any(UniqA), any(UniqB), _, I, I) :- unique_matches_initial(UniqA, UniqB). -inst_matches_initial_3(any(_), free, _, Expansions, Expansions). -inst_matches_initial_3(free, any(_), _, Expansions, Expansions). -inst_matches_initial_3(free, free, _, Expansions, Expansions). -inst_matches_initial_3(bound(UniqA, ListA), any(UniqB), ModuleInfo, - Expansions, Expansions) :- +inst_matches_initial_3(any(_), free, _, I, I). +inst_matches_initial_3(free, any(_), _, I, I). +inst_matches_initial_3(free, free, _, I, I). +inst_matches_initial_3(bound(UniqA, ListA), any(UniqB), _, Info, Info) :- unique_matches_initial(UniqA, UniqB), - bound_inst_list_matches_uniq(ListA, UniqB, ModuleInfo). -inst_matches_initial_3(bound(_Uniq, _List), free, _, Expansions, Expansions). -inst_matches_initial_3(bound(UniqA, ListA), bound(UniqB, ListB), ModuleInfo, - Expansions0, Expansions) :- + bound_inst_list_matches_uniq(ListA, UniqB, Info^module_info). +inst_matches_initial_3(bound(_Uniq, _List), free, _, I, I). +inst_matches_initial_3(bound(UniqA, ListA), bound(UniqB, ListB), Type, + Info0, Info) :- unique_matches_initial(UniqA, UniqB), - bound_inst_list_matches_initial(ListA, ListB, ModuleInfo, - Expansions0, Expansions). -inst_matches_initial_3(bound(UniqA, ListA), ground(UniqB, no), ModuleInfo, - Expansions, Expansions) :- + bound_inst_list_matches_initial(ListA, ListB, Type, Info0, Info). +inst_matches_initial_3(bound(UniqA, ListA), ground(UniqB, none), _, + Info, Info) :- unique_matches_initial(UniqA, UniqB), - bound_inst_list_is_ground(ListA, ModuleInfo), - bound_inst_list_matches_uniq(ListA, UniqB, ModuleInfo). -inst_matches_initial_3(bound(Uniq, List), abstract_inst(_,_), ModuleInfo, - Expansions, Expansions) :- + bound_inst_list_is_ground(ListA, Info^module_info), + bound_inst_list_matches_uniq(ListA, UniqB, Info^module_info). +inst_matches_initial_3(bound(UniqA, ListA), + ground(UniqB, constrained_inst_var(InstVarB)), _, + Info0, Info) :- + unique_matches_initial(UniqA, UniqB), + ModuleInfo0 = Info0^module_info, + Sub0 = Info0^sub, + bound_inst_list_is_ground(ListA, ModuleInfo0), + bound_inst_list_matches_uniq(ListA, UniqB, ModuleInfo0), + + % Call abstractly_unify_inst to calculate the uniqueness of the + % bound_inst arguments. We pass `Live = dead' because we want + % abstractly_unify(unique, unique) = unique, not shared. + Live = dead, + abstractly_unify_inst(Live, bound(UniqA, ListA), ground(UniqB, none), + fake_unify, ModuleInfo0, Inst, _Det, ModuleInfo1), + update_inst_var_sub(InstVarB, Inst, ModuleInfo1, ModuleInfo, Sub0, Sub), + Info = (Info0^module_info := ModuleInfo) + ^sub := Sub. +inst_matches_initial_3(bound(Uniq, List), abstract_inst(_,_), _, Info, Info) :- Uniq = unique, - bound_inst_list_is_ground(List, ModuleInfo), - bound_inst_list_is_unique(List, ModuleInfo). -inst_matches_initial_3(bound(Uniq, List), abstract_inst(_,_), ModuleInfo, - Expansions, Expansions) :- + bound_inst_list_is_ground(List, Info^module_info), + bound_inst_list_is_unique(List, Info^module_info). +inst_matches_initial_3(bound(Uniq, List), abstract_inst(_,_), _, Info, Info) :- Uniq = mostly_unique, - bound_inst_list_is_ground(List, ModuleInfo), - bound_inst_list_is_mostly_unique(List, ModuleInfo). -inst_matches_initial_3(ground(UniqA, _PredInst), any(UniqB), _, - Expansions, Expansions) :- + bound_inst_list_is_ground(List, Info^module_info), + bound_inst_list_is_mostly_unique(List, Info^module_info). +inst_matches_initial_3(ground(UniqA, _PredInst), any(UniqB), _, I, I) :- unique_matches_initial(UniqA, UniqB). -inst_matches_initial_3(ground(_Uniq, _PredInst), free, _, - Expansions, Expansions). -inst_matches_initial_3(ground(UniqA, _), bound(UniqB, List), ModuleInfo, - Expansions, Expansions) :- +inst_matches_initial_3(ground(_Uniq, _PredInst), free, _, I, I). +inst_matches_initial_3(ground(UniqA, GII_A), bound(UniqB, ListB), MaybeType, + Info0, Info) :- + MaybeType = yes(Type), + % We can only check this case properly if the type is known. + GII_A \= constrained_inst_var(_), + % Don't overly constrain the inst_var. unique_matches_initial(UniqA, UniqB), - uniq_matches_bound_inst_list(UniqA, List, ModuleInfo), - fail. % XXX BUG! should fail only if - % List does not include all the constructors for the type, - % or if List contains some not_reached insts. - % Should succeed if List contains all the constructors - % for the type. Problem is we don't know what the type was :-( -inst_matches_initial_3(ground(UniqA, PredInstA), ground(UniqB, PredInstB), - ModuleInfo, Expansions, Expansions) :- - maybe_pred_inst_matches_initial(PredInstA, PredInstB, ModuleInfo), - unique_matches_initial(UniqA, UniqB). -inst_matches_initial_3(ground(_UniqA, no), abstract_inst(_,_), _, _, _) :- + bound_inst_list_is_complete_for_type(set__init, Info0^module_info, + ListB, Type), + ground_matches_initial_bound_inst_list(UniqA, ListB, yes(Type), + Info0, Info). +inst_matches_initial_3(ground(UniqA, GroundInstInfoA), + ground(UniqB, GroundInstInfoB), Type, Info0, Info) :- + unique_matches_initial(UniqA, UniqB), + ground_inst_info_matches_initial(GroundInstInfoA, GroundInstInfoB, + UniqB, Type, Info0, Info). +inst_matches_initial_3(ground(_UniqA, none), abstract_inst(_,_),_,_,_) :- % I don't know what this should do. % Abstract insts aren't really supported. error("inst_matches_initial(ground, abstract_inst) == ??"). -inst_matches_initial_3(abstract_inst(_,_), any(shared), _, - Expansions, Expansions). -inst_matches_initial_3(abstract_inst(_,_), free, _, Expansions, Expansions). +inst_matches_initial_3(abstract_inst(_,_), any(shared), _, I, I). +inst_matches_initial_3(abstract_inst(_,_), free, _, I, I). inst_matches_initial_3(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB), - ModuleInfo, Expansions0, Expansions) :- - inst_list_matches_initial(ArgsA, ArgsB, ModuleInfo, - Expansions0, Expansions). -inst_matches_initial_3(not_reached, _, _, Expansions, Expansions). + _Type, Info0, Info) :- + list__duplicate(length(ArgsA), no, MaybeTypes), + % XXX how do we get the argument types for an abstract inst? + inst_list_matches_initial(ArgsA, ArgsB, MaybeTypes, Info0, Info). +inst_matches_initial_3(not_reached, _, _, I, I). %-----------------------------------------------------------------------------% -:- pred maybe_pred_inst_matches_initial(maybe(pred_inst_info), - maybe(pred_inst_info), module_info). -:- mode maybe_pred_inst_matches_initial(in, in, in) is semidet. + % This predicate assumes that the check of + % `bound_inst_list_is_complete_for_type' is done by the caller. +:- pred ground_matches_initial_bound_inst_list(uniqueness, list(bound_inst), + maybe(type), inst_match_info, inst_match_info). +:- mode ground_matches_initial_bound_inst_list(in, in, in, in, out) is semidet. -maybe_pred_inst_matches_initial(no, no, _). -maybe_pred_inst_matches_initial(yes(_), no, _). -maybe_pred_inst_matches_initial(yes(PredInstA), yes(PredInstB), ModuleInfo) :- - pred_inst_matches(PredInstA, PredInstB, ModuleInfo). +ground_matches_initial_bound_inst_list(_, [], _) --> []. +ground_matches_initial_bound_inst_list(Uniq, [functor(ConsId, Args) | List], + MaybeType) --> + ModuleInfo0 =^ module_info, + { maybe_get_cons_id_arg_types(ModuleInfo0, MaybeType, ConsId, + list__length(Args), MaybeTypes) }, + ground_matches_initial_inst_list(Uniq, Args, MaybeTypes), + ground_matches_initial_bound_inst_list(Uniq, List, MaybeType). + +:- pred ground_matches_initial_inst_list(uniqueness, list(inst), + list(maybe(type)), inst_match_info, inst_match_info). +:- mode ground_matches_initial_inst_list(in, in, in, in, out) is semidet. + +ground_matches_initial_inst_list(_, [], []) --> []. +ground_matches_initial_inst_list(Uniq, [Inst | Insts], [Type | Types]) --> + inst_matches_initial_2(ground(Uniq, none), Inst, Type), + ground_matches_initial_inst_list(Uniq, Insts, Types). + +%-----------------------------------------------------------------------------% + + % A list(bound_inst) is ``complete'' for a given type iff it + % includes each functor of the type and each argument of each + % functor is also ``complete'' for the type. +:- pred bound_inst_list_is_complete_for_type(set(inst_name), module_info, + list(bound_inst), type). +:- mode bound_inst_list_is_complete_for_type(in, in, in, in) is semidet. + +bound_inst_list_is_complete_for_type(Expansions, ModuleInfo, BoundInsts, Type) + :- + % Is this a type for which cons_ids are recorded in the type_table? + type_util__cons_id_arg_types(ModuleInfo, Type, _, _), + + % Is there a bound_inst for each cons_id in the type_table? + all [ConsId, ArgTypes] ( + type_util__cons_id_arg_types(ModuleInfo, Type, ConsId, + ArgTypes) + => + ( + list__member(functor(ConsId0, ArgInsts), BoundInsts), + % Cons_ids returned from type_util__cons_id_arg_types + % are not module-qualified so we need to call + % equivalent_cons_ids instead of just using `=/2'. + equivalent_cons_ids(ConsId0, ConsId), + list__map(inst_is_complete_for_type(Expansions, + ModuleInfo), ArgInsts, ArgTypes) + ) + ). + +:- pred inst_is_complete_for_type(set(inst_name), module_info, inst, type). +:- mode inst_is_complete_for_type(in, in, in, in) is semidet. + +inst_is_complete_for_type(Expansions, ModuleInfo, Inst, Type) :- + ( Inst = defined_inst(Name) -> + ( set__member(Name, Expansions) -> + true + ; + inst_lookup(ModuleInfo, Name, ExpandedInst), + inst_is_complete_for_type(Expansions `set__insert` Name, + ModuleInfo, ExpandedInst, Type) + ) + ; Inst = bound(_, List) -> + bound_inst_list_is_complete_for_type(Expansions, ModuleInfo, + List, Type) + ; + Inst \= not_reached + ). + + % Check that two cons_ids are the same, except that one may be less + % module qualified than the other. +:- pred equivalent_cons_ids(cons_id, cons_id). +:- mode equivalent_cons_ids(in, in) is semidet. + +equivalent_cons_ids(ConsIdA, ConsIdB) :- + ( + ConsIdA = cons(NameA, ArityA), + ConsIdB = cons(NameB, ArityB) + -> + ArityA = ArityB, + equivalent_sym_names(NameA, NameB) + ; + ConsIdA = ConsIdB + ). + +:- pred equivalent_sym_names(sym_name, sym_name). +:- mode equivalent_sym_names(in, in) is semidet. + +equivalent_sym_names(unqualified(S), unqualified(S)). +equivalent_sym_names(qualified(_, S), unqualified(S)). +equivalent_sym_names(unqualified(S), qualified(_, S)). +equivalent_sym_names(qualified(QualA, S), qualified(QualB, S)) :- + equivalent_sym_names(QualA, QualB). + +%-----------------------------------------------------------------------------% + + % Update the inst_var_sub that is computed by inst_matches_initial. + % The inst_var_sub records what inst should be substituted for each + % inst_var that occurs in the called procedure's argument modes. +:- pred update_inst_var_sub(inst_var, inst, module_info, module_info, + maybe(inst_var_sub), maybe(inst_var_sub)). +:- mode update_inst_var_sub(in, in, in, out, in, out) is semidet. + +update_inst_var_sub(_, _, ModuleInfo, ModuleInfo, no, no). +update_inst_var_sub(InstVar, InstA, ModuleInfo0, ModuleInfo, + yes(Sub0), yes(Sub)) :- + ( map__search(Sub0, InstVar, InstB) -> + % If InstVar already has an inst associated with it, + % merge the old inst and the new inst. Fail if this merge + % is not possible. + inst_merge(InstA, InstB, ModuleInfo0, Inst, ModuleInfo), + map__det_update(Sub0, InstVar, Inst, Sub) + ; + ModuleInfo = ModuleInfo0, + map__det_insert(Sub0, InstVar, InstA, Sub) + ). + +%-----------------------------------------------------------------------------% + + % This predicate checks if two ground_inst_infos match_initial. + % It does not check uniqueness. +:- pred ground_inst_info_matches_initial(ground_inst_info, ground_inst_info, + uniqueness, maybe(type), inst_match_info, inst_match_info). +:- mode ground_inst_info_matches_initial(in, in, in, in, in, out) is semidet. + +ground_inst_info_matches_initial(_, none, _, _) --> []. +ground_inst_info_matches_initial(higher_order(PredInstA), + higher_order(PredInstB), _, Type) --> + pred_inst_matches_initial(PredInstA, PredInstB, Type). +ground_inst_info_matches_initial(GroundInstInfoA, + constrained_inst_var(InstVarB), UniqB, _) --> + { Inst = ground(UniqB, GroundInstInfoA) }, + ModuleInfo0 =^ module_info, + Sub0 =^ sub, + { update_inst_var_sub(InstVarB, Inst, ModuleInfo0, ModuleInfo, + Sub0, Sub) }, + ^module_info := ModuleInfo, + ^sub := Sub. + +:- pred pred_inst_matches_initial(pred_inst_info, pred_inst_info, maybe(type), + inst_match_info, inst_match_info). +:- mode pred_inst_matches_initial(in, in, in, in, out) is semidet. + +pred_inst_matches_initial(pred_inst_info(PredOrFunc, ModesA, Det), + pred_inst_info(PredOrFunc, ModesB, Det), MaybeType) --> + { maybe_get_higher_order_arg_types(MaybeType, length(ModesA), + MaybeTypes) }, + pred_inst_argmodes_matches_initial(ModesA, ModesB, MaybeTypes), + MaybeSub =^ sub, + { + MaybeSub = yes(Sub) + -> + mode_list_apply_substitution(ModesA, Sub, ModesASub), + mode_list_apply_substitution(ModesB, Sub, ModesBSub) + ; + ModesASub = ModesA, + ModesBSub = ModesB + }, + pred_inst_argmodes_matches(ModesASub, ModesBSub, MaybeTypes). + +:- pred pred_inst_argmodes_matches_initial(list(mode), list(mode), + list(maybe(type)), inst_match_info, inst_match_info). +:- mode pred_inst_argmodes_matches_initial(in, in, in, in, out) is semidet. + +pred_inst_argmodes_matches_initial([], [], []) --> []. +pred_inst_argmodes_matches_initial([ModeA|ModeAs], [ModeB|ModeBs], + [Type|Types]) --> + ModuleInfo0 =^ module_info, + { mode_get_insts(ModuleInfo0, ModeA, InitialA, FinalA) }, + { mode_get_insts(ModuleInfo0, ModeB, InitialB, FinalB) }, + inst_matches_initial_2(InitialA, InitialB, Type), + inst_matches_initial_2(FinalA, FinalB, Type), + pred_inst_argmodes_matches_initial(ModeAs, ModeBs, Types). pred_inst_matches(PredInstA, PredInstB, ModuleInfo) :- - set__init(Expansions0), - pred_inst_matches_2(PredInstA, PredInstB, ModuleInfo, - Expansions0, _). + pred_inst_matches_1(PredInstA, PredInstB, no, ModuleInfo). + +:- pred pred_inst_matches_1(pred_inst_info, pred_inst_info, maybe(type), + module_info). +:- mode pred_inst_matches_1(in, in, in, in) is semidet. + +pred_inst_matches_1(PredInstA, PredInstB, MaybeType, ModuleInfo) :- + Info0 = init_inst_match_info(ModuleInfo), + pred_inst_matches_2(PredInstA, PredInstB, MaybeType, Info0, _). % pred_inst_matches_2(PredInstA, PredInstB, ModuleInfo, Expansions) % Same as pred_inst_matches/3, except that inst pairs in @@ -376,32 +598,17 @@ pred_inst_matches(PredInstA, PredInstB, ModuleInfo) :- % (This avoids infinite loops when calling inst_matches_final % on higher-order recursive insts.) % -:- pred pred_inst_matches_2(pred_inst_info, pred_inst_info, module_info, - expansions, expansions). +:- pred pred_inst_matches_2(pred_inst_info, pred_inst_info, maybe(type), + inst_match_info, inst_match_info). :- mode pred_inst_matches_2(in, in, in, in, out) is semidet. pred_inst_matches_2(pred_inst_info(PredOrFunc, ModesA, Det), pred_inst_info(PredOrFunc, ModesB, Det), - ModuleInfo, Expansions0, Expansions) :- - pred_inst_argmodes_matches(ModesA, ModesB, ModuleInfo, Expansions0, - Expansions). + MaybeType) --> + { maybe_get_higher_order_arg_types(MaybeType, length(ModesA), + MaybeTypes) }, + pred_inst_argmodes_matches(ModesA, ModesB, MaybeTypes). -:- pred pred_inst_matches_2(pred_inst_info, pred_inst_info, - module_info, expansions). -:- mode pred_inst_matches_2(in, in, in, in) is semidet. - -pred_inst_matches_2(PredInstInfoA, PredInstInfoB, ModuleInfo, Expansions) :- - pred_inst_matches_2(PredInstInfoA, PredInstInfoB, ModuleInfo, - Expansions, _). - -:- pred pred_inst_argmodes_matches(list(mode), list(mode), - module_info, expansions). -:- mode pred_inst_argmodes_matches(in, in, in, in) is semidet. - -pred_inst_argmodes_matches(ModesA, ModesB, ModuleInfo, Expansions) :- - pred_inst_argmodes_matches(ModesA, ModesB, ModuleInfo, - Expansions, _). - % pred_inst_matches_argmodes(ModesA, ModesB, ModuleInfo, Expansions): % succeeds if the initial insts of ModesB specify at least as % much information as, and the same binding as, the initial @@ -410,21 +617,19 @@ pred_inst_argmodes_matches(ModesA, ModesB, ModuleInfo, Expansions) :- % final insts of ModesB. Any inst pairs in Expansions are assumed % to match_final each other. % -:- pred pred_inst_argmodes_matches(list(mode), list(mode), - module_info, expansions, expansions). +:- pred pred_inst_argmodes_matches(list(mode), list(mode), list(maybe(type)), + inst_match_info, inst_match_info). :- mode pred_inst_argmodes_matches(in, in, in, in, out) is semidet. -pred_inst_argmodes_matches([], [], _, Expansions, Expansions). +pred_inst_argmodes_matches([], [], []) --> []. pred_inst_argmodes_matches([ModeA|ModeAs], [ModeB|ModeBs], - ModuleInfo, Expansions0, Expansions) :- - mode_get_insts(ModuleInfo, ModeA, InitialA, FinalA), - mode_get_insts(ModuleInfo, ModeB, InitialB, FinalB), - inst_matches_final_2(InitialB, InitialA, ModuleInfo, - Expansions0, Expansions1), - inst_matches_final_2(FinalA, FinalB, ModuleInfo, - Expansions1, Expansions2), - pred_inst_argmodes_matches(ModeAs, ModeBs, ModuleInfo, - Expansions2, Expansions). + [MaybeType | MaybeTypes]) --> + ModuleInfo =^ module_info, + { mode_get_insts(ModuleInfo, ModeA, InitialA, FinalA) }, + { mode_get_insts(ModuleInfo, ModeB, InitialB, FinalB) }, + inst_matches_final_2(InitialB, InitialA, MaybeType), + inst_matches_final_2(FinalA, FinalB, MaybeType), + pred_inst_argmodes_matches(ModeAs, ModeBs, MaybeTypes). %-----------------------------------------------------------------------------% @@ -483,39 +688,87 @@ uniq_matches_bound_inst_list(Uniq, List, ModuleInfo) :- % are sorted. :- pred bound_inst_list_matches_initial(list(bound_inst), list(bound_inst), - module_info, expansions, expansions). + maybe(type), inst_match_info, inst_match_info). :- mode bound_inst_list_matches_initial(in, in, in, in, out) is semidet. -bound_inst_list_matches_initial([], _, _, Expansions, Expansions). -bound_inst_list_matches_initial([X|Xs], [Y|Ys], ModuleInfo, - Expansions0, Expansions) :- - X = functor(ConsIdX, ArgsX), - Y = functor(ConsIdY, ArgsY), - ( ConsIdX = ConsIdY -> - inst_list_matches_initial(ArgsX, ArgsY, ModuleInfo, - Expansions0, Expansions1), - bound_inst_list_matches_initial(Xs, Ys, ModuleInfo, - Expansions1, Expansions) +bound_inst_list_matches_initial([], _, _) --> []. +bound_inst_list_matches_initial([X|Xs], [Y|Ys], MaybeType) --> + { X = functor(ConsIdX, ArgsX) }, + { Y = functor(ConsIdY, ArgsY) }, + ( { ConsIdX = ConsIdY } -> + ModuleInfo =^ module_info, + { maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, ConsIdX, + list__length(ArgsX), MaybeTypes) }, + inst_list_matches_initial(ArgsX, ArgsY, MaybeTypes), + bound_inst_list_matches_initial(Xs, Ys, MaybeType) ; - compare(>, ConsIdX, ConsIdY), + { compare(>, ConsIdX, ConsIdY) }, % ConsIdY does not occur in [X|Xs]. % Hence [X|Xs] implicitly specifies `not_reached' % for the args of ConsIdY, and hence % automatically matches_initial Y. We just need to % check that [X|Xs] matches_initial Ys. - bound_inst_list_matches_initial([X|Xs], Ys, ModuleInfo, - Expansions0, Expansions) + bound_inst_list_matches_initial([X|Xs], Ys, MaybeType) ). -:- pred inst_list_matches_initial(list(inst), list(inst), module_info, - expansions, expansions). +:- pred inst_list_matches_initial(list(inst), list(inst), list(maybe(type)), + inst_match_info, inst_match_info). :- mode inst_list_matches_initial(in, in, in, in, out) is semidet. -inst_list_matches_initial([], [], _, Expansions, Expansions). -inst_list_matches_initial([X|Xs], [Y|Ys], ModuleInfo, - Expansions0, Expansions) :- - inst_matches_initial_2(X, Y, ModuleInfo, Expansions0, Expansions1), - inst_list_matches_initial(Xs, Ys, ModuleInfo, Expansions1, Expansions). +inst_list_matches_initial([], [], []) --> []. +inst_list_matches_initial([X|Xs], [Y|Ys], [Type | Types]) --> + inst_matches_initial_2(X, Y, Type), + inst_list_matches_initial(Xs, Ys, Types). + + % If possible, get the argument types for the cons_id. + % We need to pass in the arity rather than using the arity + % from the cons_id because the arity in the cons_id will not + % include any extra type_info arguments for existentially + % quantified types. +:- pred maybe_get_cons_id_arg_types(module_info, maybe(type), cons_id, + arity, list(maybe(type))). +:- mode maybe_get_cons_id_arg_types(in, in, in, in, out) is det. + +maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, ConsId0, Arity, MaybeTypes) + :- + ( ConsId0 = cons(SymName, _) -> + ( SymName = qualified(_, Name) -> + % get_cons_id_non_existential_arg_types + % expects an unqualified cons_id. + ConsId = cons(unqualified(Name), Arity) + ; + ConsId = ConsId0 + ), + ( + MaybeType = yes(Type), + + % XXX get_cons_id_non_existential_arg_types will fail + % for ConsIds with existentially typed arguments. + get_cons_id_non_existential_arg_types(ModuleInfo, Type, + ConsId, Types), + list__length(Types, Arity) + -> + list__map(pred(T::in, yes(T)::out) is det, Types, + MaybeTypes) + ; + list__duplicate(Arity, no, MaybeTypes) + ) + ; + MaybeTypes = [] + ). + +:- pred maybe_get_higher_order_arg_types(maybe(type), arity, list(maybe(type))). +:- mode maybe_get_higher_order_arg_types(in, in, out) is det. + +maybe_get_higher_order_arg_types(MaybeType, Arity, MaybeTypes) :- + ( + MaybeType = yes(Type), + type_is_higher_order(Type, _, _, Types) + -> + list__map(pred(T::in, yes(T)::out) is det, Types, MaybeTypes) + ; + list__duplicate(Arity, no, MaybeTypes) + ). %-----------------------------------------------------------------------------% @@ -529,105 +782,108 @@ inst_expand(ModuleInfo, Inst0, Inst) :- %-----------------------------------------------------------------------------% -inst_matches_final(InstA, InstB, ModuleInfo) :- - set__init(Expansions0), - inst_matches_final_2(InstA, InstB, ModuleInfo, - Expansions0, _Expansions). +inst_matches_final(InstA, InstB, Type, ModuleInfo) :- + Info0 = init_inst_match_info(ModuleInfo), + inst_matches_final_2(InstA, InstB, yes(Type), Info0, _). -:- pred inst_matches_final_2(inst, inst, module_info, expansions, expansions). +:- pred inst_matches_final_2(inst, inst, maybe(type), + inst_match_info, inst_match_info). :- mode inst_matches_final_2(in, in, in, in, out) is semidet. -inst_matches_final_2(InstA, InstB, ModuleInfo, Expansions0, Expansions) :- +inst_matches_final_2(InstA, InstB, MaybeType, Info0, Info) :- ThisExpansion = InstA - InstB, - ( set__member(ThisExpansion, Expansions0) -> - Expansions = Expansions0 + ( set__member(ThisExpansion, Info0^expansions) -> + Info = Info0 ; InstA = InstB -> - Expansions = Expansions0 + Info = Info0 ; - inst_expand(ModuleInfo, InstA, InstA2), - inst_expand(ModuleInfo, InstB, InstB2), - set__insert(Expansions0, ThisExpansion, Expansions1), - inst_matches_final_3(InstA2, InstB2, ModuleInfo, - Expansions1, Expansions) + inst_expand(Info0^module_info, InstA, InstA2), + inst_expand(Info0^module_info, InstB, InstB2), + set__insert(Info0^expansions, ThisExpansion, Expansions1), + inst_matches_final_3(InstA2, InstB2, MaybeType, + Info0^expansions := Expansions1, Info) ). -:- pred inst_matches_final_3(inst, inst, module_info, expansions, expansions). +:- pred inst_matches_final_3(inst, inst, maybe(type), + inst_match_info, inst_match_info). :- mode inst_matches_final_3(in, in, in, in, out) is semidet. -inst_matches_final_3(any(UniqA), any(UniqB), _, Expansions, Expansions) :- +inst_matches_final_3(any(UniqA), any(UniqB), _, I, I) :- unique_matches_final(UniqA, UniqB). -inst_matches_final_3(free, any(Uniq), _, Expansions, Expansions) :- +inst_matches_final_3(free, any(Uniq), _, I, I) :- % We do not yet allow `free' to match `any', % unless the `any' is `clobbered_any' or `mostly_clobbered_any'. % Among other things, changing this would break compare_inst % in modecheck_call.m. ( Uniq = clobbered ; Uniq = mostly_clobbered ). -inst_matches_final_3(free, free, _, Expansions, Expansions). -inst_matches_final_3(bound(UniqA, ListA), any(UniqB), ModuleInfo, - Expansions, Expansions) :- +inst_matches_final_3(free, free, _, I, I). +inst_matches_final_3(bound(UniqA, ListA), any(UniqB), _, Info, Info) :- unique_matches_final(UniqA, UniqB), - bound_inst_list_matches_uniq(ListA, UniqB, ModuleInfo), + bound_inst_list_matches_uniq(ListA, UniqB, Info^module_info), % We do not yet allow `free' to match `any'. % Among other things, changing this would break compare_inst % in modecheck_call.m. - bound_inst_list_is_ground_or_any(ListA, ModuleInfo). -inst_matches_final_3(bound(UniqA, ListA), bound(UniqB, ListB), ModuleInfo, - Expansions0, Expansions) :- + bound_inst_list_is_ground_or_any(ListA, Info^module_info). +inst_matches_final_3(bound(UniqA, ListA), bound(UniqB, ListB), MaybeType, + Info0, Info) :- unique_matches_final(UniqA, UniqB), - bound_inst_list_matches_final(ListA, ListB, ModuleInfo, - Expansions0, Expansions). -inst_matches_final_3(bound(UniqA, ListA), ground(UniqB, no), ModuleInfo, - Expansions, Expansions) :- + bound_inst_list_matches_final(ListA, ListB, MaybeType, Info0, Info). +inst_matches_final_3(bound(UniqA, ListA), ground(UniqB, none), _, + Info, Info) :- unique_matches_final(UniqA, UniqB), - bound_inst_list_is_ground(ListA, ModuleInfo), - bound_inst_list_matches_uniq(ListA, UniqB, ModuleInfo). -inst_matches_final_3(ground(UniqA, _), any(UniqB), _ModuleInfo, - Expansions, Expansions) :- + bound_inst_list_is_ground(ListA, Info^module_info), + bound_inst_list_matches_uniq(ListA, UniqB, Info^module_info). +inst_matches_final_3(ground(UniqA, _), any(UniqB), _, I, I) :- unique_matches_final(UniqA, UniqB). -inst_matches_final_3(ground(UniqA, _), bound(UniqB, ListB), ModuleInfo, - Expansions, Expansions) :- +inst_matches_final_3(ground(UniqA, _), bound(UniqB, ListB), MaybeType, + Info, Info) :- unique_matches_final(UniqA, UniqB), - bound_inst_list_is_ground(ListB, ModuleInfo), - uniq_matches_bound_inst_list(UniqA, ListB, ModuleInfo). - % XXX BUG! Should fail if there are not_reached - % insts in ListB, or if ListB does not contain a complete list - % of all the constructors for the type in question. - %%% error("not implemented: `ground' matches_final `bound(...)'"). -inst_matches_final_3(ground(UniqA, PredInstA), ground(UniqB, PredInstB), - ModuleInfo, Expansions0, Expansions) :- - maybe_pred_inst_matches_final(PredInstA, PredInstB, - ModuleInfo, Expansions0, Expansions), + bound_inst_list_is_ground(ListB, Info^module_info), + uniq_matches_bound_inst_list(UniqA, ListB, Info^module_info), + ( + MaybeType = yes(Type), + % We can only do this check if the type is known. + bound_inst_list_is_complete_for_type(set__init, + Info^module_info, ListB, Type) + ; + true + % XXX enabling the check for bound_inst_list_is_complete + % for type makes the mode checker too conservative in + % the absence of alias tracking, so we currently always + % succeed, even if this check fails. + ). +inst_matches_final_3(ground(UniqA, GroundInstInfoA), + ground(UniqB, GroundInstInfoB), MaybeType, Info0, Info) :- + ground_inst_info_matches_final(GroundInstInfoA, GroundInstInfoB, + MaybeType, Info0, Info), unique_matches_final(UniqA, UniqB). -inst_matches_final_3(abstract_inst(_, _), any(shared), _, - Expansions, Expansions). +inst_matches_final_3(abstract_inst(_, _), any(shared), _, I, I). inst_matches_final_3(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB), - ModuleInfo, Expansions0, Expansions) :- - inst_list_matches_final(ArgsA, ArgsB, ModuleInfo, - Expansions0, Expansions). -inst_matches_final_3(not_reached, _, _, Expansions, Expansions). + _MaybeType, Info0, Info) :- + list__duplicate(length(ArgsA), no, MaybeTypes), + % XXX how do we get the argument types for an abstract inst? + inst_list_matches_final(ArgsA, ArgsB, MaybeTypes, Info0, Info). +inst_matches_final_3(not_reached, _, _, I, I). -:- pred maybe_pred_inst_matches_final(maybe(pred_inst_info), - maybe(pred_inst_info), module_info, expansions, expansions). -:- mode maybe_pred_inst_matches_final(in, in, in, in, out) is semidet. +:- pred ground_inst_info_matches_final(ground_inst_info, ground_inst_info, + maybe(type), inst_match_info, inst_match_info). +:- mode ground_inst_info_matches_final(in, in, in, in, out) is semidet. -maybe_pred_inst_matches_final(no, no, _, Expansions, Expansions). -maybe_pred_inst_matches_final(yes(_), no, _, Expansions, Expansions). -maybe_pred_inst_matches_final(yes(PredInstA), yes(PredInstB), - ModuleInfo, Expansions0, Expansions) :- - pred_inst_matches_2(PredInstA, PredInstB, ModuleInfo, - Expansions0, Expansions). +ground_inst_info_matches_final(_, none, _) --> []. +ground_inst_info_matches_final(higher_order(PredInstA), + higher_order(PredInstB), MaybeType) --> + pred_inst_matches_2(PredInstA, PredInstB, MaybeType). +ground_inst_info_matches_final(constrained_inst_var(InstVar), + constrained_inst_var(InstVar), _) --> []. -:- pred inst_list_matches_final(list(inst), list(inst), module_info, - expansions, expansions). +:- pred inst_list_matches_final(list(inst), list(inst), list(maybe(type)), + inst_match_info, inst_match_info). :- mode inst_list_matches_final(in, in, in, in, out) is semidet. -inst_list_matches_final([], [], _ModuleInfo, Expansions, Expansions). -inst_list_matches_final([ArgA | ArgsA], [ArgB | ArgsB], ModuleInfo, - Expansions0, Expansions) :- - inst_matches_final_2(ArgA, ArgB, ModuleInfo, - Expansions0, Expansions1), - inst_list_matches_final(ArgsA, ArgsB, ModuleInfo, - Expansions1, Expansions). +inst_list_matches_final([], [], []) --> []. +inst_list_matches_final([ArgA | ArgsA], [ArgB | ArgsB], [Type | Types]) --> + inst_matches_final_2(ArgA, ArgB, Type), + inst_list_matches_final(ArgsA, ArgsB, Types). % Here we check that the functors in the first list are a % subset of the functors in the second list. @@ -639,98 +895,110 @@ inst_list_matches_final([ArgA | ArgsA], [ArgB | ArgsB], ModuleInfo, % are sorted. :- pred bound_inst_list_matches_final(list(bound_inst), list(bound_inst), - module_info, expansions, expansions). + maybe(type), inst_match_info, inst_match_info). :- mode bound_inst_list_matches_final(in, in, in, in, out) is semidet. -bound_inst_list_matches_final([], _, _, Expansions, Expansions). -bound_inst_list_matches_final([X|Xs], [Y|Ys], ModuleInfo, - Expansions0, Expansions) :- - X = functor(ConsIdX, ArgsX), - Y = functor(ConsIdY, ArgsY), - ( ConsIdX = ConsIdY -> - inst_list_matches_final(ArgsX, ArgsY, ModuleInfo, - Expansions0, Expansions1), - bound_inst_list_matches_final(Xs, Ys, ModuleInfo, - Expansions1, Expansions) +bound_inst_list_matches_final([], _, _) --> []. +bound_inst_list_matches_final([X|Xs], [Y|Ys], MaybeType) --> + { X = functor(ConsIdX, ArgsX) }, + { Y = functor(ConsIdY, ArgsY) }, + ( { ConsIdX = ConsIdY } -> + ModuleInfo =^ module_info, + { maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, ConsIdX, + list__length(ArgsX), MaybeTypes) }, + inst_list_matches_final(ArgsX, ArgsY, MaybeTypes), + bound_inst_list_matches_final(Xs, Ys, MaybeType) ; - compare(>, ConsIdX, ConsIdY), + { compare(>, ConsIdX, ConsIdY) }, % ConsIdY does not occur in [X|Xs]. % Hence [X|Xs] implicitly specifies `not_reached' % for the args of ConsIdY, and hence % automatically matches_final Y. We just need to % check that [X|Xs] matches_final Ys. - bound_inst_list_matches_final([X|Xs], Ys, ModuleInfo, - Expansions0, Expansions) + bound_inst_list_matches_final([X|Xs], Ys, MaybeType) ). -inst_matches_binding(InstA, InstB, ModuleInfo) :- - set__init(Expansions0), - inst_matches_binding_2(InstA, InstB, ModuleInfo, - Expansions0, _Expansions). +inst_matches_binding(InstA, InstB, Type, ModuleInfo) :- + Info0 = init_inst_match_info(ModuleInfo), + inst_matches_binding_2(InstA, InstB, yes(Type), Info0, _). -:- pred inst_matches_binding_2(inst, inst, module_info, expansions, expansions). +:- pred inst_matches_binding_2(inst, inst, maybe(type), inst_match_info, + inst_match_info). :- mode inst_matches_binding_2(in, in, in, in, out) is semidet. -inst_matches_binding_2(InstA, InstB, ModuleInfo, Expansions0, Expansions) :- +inst_matches_binding_2(InstA, InstB, MaybeType, Info0, Info) :- ThisExpansion = InstA - InstB, - ( set__member(ThisExpansion, Expansions0) -> - Expansions = Expansions0 + ( set__member(ThisExpansion, Info0^expansions) -> + Info = Info0 ; - inst_expand(ModuleInfo, InstA, InstA2), - inst_expand(ModuleInfo, InstB, InstB2), - set__insert(Expansions0, ThisExpansion, Expansions1), - inst_matches_binding_3(InstA2, InstB2, ModuleInfo, - Expansions1, Expansions) + inst_expand(Info0^module_info, InstA, InstA2), + inst_expand(Info0^module_info, InstB, InstB2), + set__insert(Info0^expansions, ThisExpansion, Expansions1), + inst_matches_binding_3(InstA2, InstB2, MaybeType, + Info0^expansions := Expansions1, Info) ). -:- pred inst_matches_binding_3(inst, inst, module_info, expansions, expansions). +:- pred inst_matches_binding_3(inst, inst, maybe(type), inst_match_info, + inst_match_info). :- mode inst_matches_binding_3(in, in, in, in, out) is semidet. % Note that `any' is *not* considered to match `any'. -inst_matches_binding_3(free, free, _, Expansions, Expansions). -inst_matches_binding_3(bound(_UniqA, ListA), bound(_UniqB, ListB), ModuleInfo, - Expansions0, Expansions) :- - bound_inst_list_matches_binding(ListA, ListB, ModuleInfo, - Expansions0, Expansions). -inst_matches_binding_3(bound(_UniqA, ListA), ground(_UniqB, no), ModuleInfo, - Expansions, Expansions) :- - bound_inst_list_is_ground(ListA, ModuleInfo). -inst_matches_binding_3(ground(_UniqA, _), bound(_UniqB, ListB), ModuleInfo, - Expansions, Expansions) :- - bound_inst_list_is_ground(ListB, ModuleInfo). - % XXX BUG! Should fail if there are not_reached - % insts in ListB, or if ListB does not contain a complete list - % of all the constructors for the type in question. - %%% error("not implemented: `ground' matches_binding `bound(...)'"). -inst_matches_binding_3(ground(_UniqA, PredInstA), ground(_UniqB, PredInstB), - ModuleInfo, Expansions, Expansions) :- - pred_inst_matches_binding(PredInstA, PredInstB, ModuleInfo). +inst_matches_binding_3(free, free, _, I, I). +inst_matches_binding_3(bound(_UniqA, ListA), bound(_UniqB, ListB), MaybeType, + Info0, Info) :- + bound_inst_list_matches_binding(ListA, ListB, MaybeType, Info0, Info). +inst_matches_binding_3(bound(_UniqA, ListA), ground(_UniqB, none), _, + Info, Info) :- + bound_inst_list_is_ground(ListA, Info^module_info). +inst_matches_binding_3(bound(_UniqA, ListA), + ground(_UniqB, constrained_inst_var(_)), _, Info, Info) :- + bound_inst_list_is_ground(ListA, Info^module_info). +inst_matches_binding_3(ground(_UniqA, _), bound(_UniqB, ListB), MaybeType, + Info, Info) :- + bound_inst_list_is_ground(ListB, Info^module_info), + ( + MaybeType = yes(Type), + % We can only do this check if the type is known. + bound_inst_list_is_complete_for_type(set__init, + Info^module_info, ListB, Type) + ; + true + % XXX enabling the check for bound_inst_list_is_complete + % for type makes the mode checker too conservative in + % the absence of alias tracking, so we currently always + % succeed, even if this check fails. + ). +inst_matches_binding_3(ground(_UniqA, GroundInstInfoA), + ground(_UniqB, GroundInstInfoB), MaybeType, Info, Info) :- + ground_inst_info_matches_binding(GroundInstInfoA, GroundInstInfoB, + MaybeType, Info^module_info). inst_matches_binding_3(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB), - ModuleInfo, Expansions0, Expansions) :- - inst_list_matches_binding(ArgsA, ArgsB, ModuleInfo, - Expansions0, Expansions). -inst_matches_binding_3(not_reached, _, _, Expansions, Expansions). + _MaybeType, Info0, Info) :- + list__duplicate(length(ArgsA), no, MaybeTypes), + % XXX how do we get the argument types for an abstract inst? + inst_list_matches_binding(ArgsA, ArgsB, MaybeTypes, Info0, Info). +inst_matches_binding_3(not_reached, _, _, I, I). -:- pred pred_inst_matches_binding(maybe(pred_inst_info), maybe(pred_inst_info), - module_info). -:- mode pred_inst_matches_binding(in, in, in) is semidet. +:- pred ground_inst_info_matches_binding(ground_inst_info, ground_inst_info, + maybe(type), module_info). +:- mode ground_inst_info_matches_binding(in, in, in, in) is semidet. -pred_inst_matches_binding(no, no, _). -pred_inst_matches_binding(yes(_), no, _). -pred_inst_matches_binding(yes(PredInstA), yes(PredInstB), ModuleInfo) :- - pred_inst_matches(PredInstA, PredInstB, ModuleInfo). +ground_inst_info_matches_binding(_, none, _, _). +ground_inst_info_matches_binding(higher_order(PredInstA), + higher_order(PredInstB), MaybeType, ModuleInfo) :- + pred_inst_matches_1(PredInstA, PredInstB, MaybeType, ModuleInfo). +ground_inst_info_matches_binding(constrained_inst_var(InstVar), + constrained_inst_var(InstVar), _, _). -:- pred inst_list_matches_binding(list(inst), list(inst), module_info, - expansions, expansions). +:- pred inst_list_matches_binding(list(inst), list(inst), list(maybe(type)), + inst_match_info, inst_match_info). :- mode inst_list_matches_binding(in, in, in, in, out) is semidet. -inst_list_matches_binding([], [], _ModuleInfo, Expansions, Expansions). -inst_list_matches_binding([ArgA | ArgsA], [ArgB | ArgsB], ModuleInfo, - Expansions0, Expansions) :- - inst_matches_binding_2(ArgA, ArgB, ModuleInfo, - Expansions0, Expansions1), - inst_list_matches_binding(ArgsA, ArgsB, ModuleInfo, - Expansions1, Expansions). +inst_list_matches_binding([], [], []) --> []. +inst_list_matches_binding([ArgA | ArgsA], [ArgB | ArgsB], + [MaybeType | MaybeTypes]) --> + inst_matches_binding_2(ArgA, ArgB, MaybeType), + inst_list_matches_binding(ArgsA, ArgsB, MaybeTypes). % Here we check that the functors in the first list are a % subset of the functors in the second list. @@ -742,28 +1010,27 @@ inst_list_matches_binding([ArgA | ArgsA], [ArgB | ArgsB], ModuleInfo, % are sorted. :- pred bound_inst_list_matches_binding(list(bound_inst), list(bound_inst), - module_info, expansions, expansions). + maybe(type), inst_match_info, inst_match_info). :- mode bound_inst_list_matches_binding(in, in, in, in, out) is semidet. -bound_inst_list_matches_binding([], _, _, Expansions, Expansions). -bound_inst_list_matches_binding([X|Xs], [Y|Ys], ModuleInfo, - Expansions0, Expansions) :- - X = functor(ConsIdX, ArgsX), - Y = functor(ConsIdY, ArgsY), - ( ConsIdX = ConsIdY -> - inst_list_matches_binding(ArgsX, ArgsY, ModuleInfo, - Expansions0, Expansions1), - bound_inst_list_matches_binding(Xs, Ys, ModuleInfo, - Expansions1, Expansions) +bound_inst_list_matches_binding([], _, _) --> []. +bound_inst_list_matches_binding([X|Xs], [Y|Ys], MaybeType) --> + { X = functor(ConsIdX, ArgsX) }, + { Y = functor(ConsIdY, ArgsY) }, + ( { ConsIdX = ConsIdY } -> + ModuleInfo =^ module_info, + { maybe_get_cons_id_arg_types(ModuleInfo, MaybeType, ConsIdX, + list__length(ArgsX), MaybeTypes) }, + inst_list_matches_binding(ArgsX, ArgsY, MaybeTypes), + bound_inst_list_matches_binding(Xs, Ys, MaybeType) ; - compare(>, ConsIdX, ConsIdY), + { compare(>, ConsIdX, ConsIdY) }, % ConsIdX does not occur in [X|Xs]. % Hence [X|Xs] implicitly specifies `not_reached' % for the args of ConsIdY, and hence % automatically matches_binding Y. We just need to % check that [X|Xs] matches_binding Ys. - bound_inst_list_matches_binding([X|Xs], Ys, ModuleInfo, - Expansions0, Expansions) + bound_inst_list_matches_binding([X|Xs], Ys, MaybeType) ). %-----------------------------------------------------------------------------% @@ -1283,8 +1550,10 @@ inst_contains_instname(Inst, ModuleInfo, InstName) :- inst_contains_instname_2(Inst, ModuleInfo, InstName, yes, Expansions0, _Expansions). +:- type inst_names == set(inst_name). + :- pred inst_contains_instname_2(inst, module_info, inst_name, bool, - set(inst_name), set(inst_name)). + inst_names, inst_names). :- mode inst_contains_instname_2(in, in, in, out, in, out) is det. inst_contains_instname_2(abstract_inst(_, _), _, _, no, Expns, Expns). @@ -1316,7 +1585,7 @@ inst_contains_instname_2(bound(_Uniq, ArgInsts), ModuleInfo, InstName, Result, Expansions0, Expansions). :- pred bound_inst_list_contains_instname(list(bound_inst), module_info, - inst_name, bool, set(inst_name), set(inst_name)). + inst_name, bool, inst_names, inst_names). :- mode bound_inst_list_contains_instname(in, in, in, out, in, out) is det. bound_inst_list_contains_instname([], _ModuleInfo, @@ -1335,7 +1604,7 @@ bound_inst_list_contains_instname([BoundInst|BoundInsts], ModuleInfo, ). :- pred inst_list_contains_instname(list(inst), module_info, inst_name, bool, - set(inst_name), set(inst_name)). + inst_names, inst_names). :- mode inst_list_contains_instname(in, in, in, out, in, out) is det. inst_list_contains_instname([], _ModuleInfo, _InstName, no, @@ -1388,8 +1657,8 @@ inst_contains_inst_var(defined_inst(InstName), InstVar) :- inst_name_contains_inst_var(InstName, InstVar). inst_contains_inst_var(bound(_Uniq, ArgInsts), InstVar) :- bound_inst_list_contains_inst_var(ArgInsts, InstVar). -inst_contains_inst_var(ground(_Uniq, PredInstInfo), InstVar) :- - PredInstInfo = yes(pred_inst_info(_PredOrFunc, Modes, _Det)), +inst_contains_inst_var(ground(_Uniq, GroundInstInfo), InstVar) :- + GroundInstInfo = higher_order(pred_inst_info(_PredOrFunc, Modes, _Det)), mode_list_contains_inst_var(Modes, InstVar). inst_contains_inst_var(abstract_inst(_Name, ArgInsts), InstVar) :- inst_list_contains_inst_var(ArgInsts, InstVar). diff --git a/compiler/inst_util.m b/compiler/inst_util.m index 2f0fe2709..e583173ac 100644 --- a/compiler/inst_util.m +++ b/compiler/inst_util.m @@ -256,42 +256,65 @@ abstractly_unify_inst_3(live, bound(Uniq, List), abstract_inst(_,_), Real, M, bound_inst_list_is_ground(List, M). ***/ -abstractly_unify_inst_3(live, ground(UniqX, yes(PredInst)), any(UniqY), Real, M, - ground(Uniq, yes(PredInst)), semidet, M) :- +abstractly_unify_inst_3(live, ground(UniqX, higher_order(PredInst)), + any(UniqY), Real, M, ground(Uniq, higher_order(PredInst)), + semidet, M) :- Real = fake_unify, unify_uniq(live, Real, det, UniqX, UniqY, Uniq). -abstractly_unify_inst_3(live, ground(Uniq0, yes(PredInst)), free, Real, M, - ground(Uniq, yes(PredInst)), det, M) :- +abstractly_unify_inst_3(live, ground(Uniq0, higher_order(PredInst)), free, + Real, M, ground(Uniq, higher_order(PredInst)), det, M) :- unify_uniq(live, Real, det, unique, Uniq0, Uniq). -abstractly_unify_inst_3(live, ground(UniqX, yes(_)), bound(UniqY, BoundInsts0), - Real, M0, bound(Uniq, BoundInsts), Det, M) :- +abstractly_unify_inst_3(live, ground(UniqX, higher_order(_)), + bound(UniqY, BoundInsts0), Real, M0, bound(Uniq, BoundInsts), + Det, M) :- % check `Real = fake_unify' ? unify_uniq(live, Real, semidet, UniqX, UniqY, Uniq), make_ground_bound_inst_list(BoundInsts0, live, UniqX, Real, M0, BoundInsts, Det1, M), det_par_conjunction_detism(Det1, semidet, Det). -abstractly_unify_inst_3(live, ground(UniqA, yes(PredInstA)), - ground(UniqB, _MaybePredInstB), Real, M, - ground(Uniq, PredInst), semidet, M) :- +abstractly_unify_inst_3(live, ground(UniqA, higher_order(PredInstA)), + ground(UniqB, _GroundInstInfoB), Real, M, + ground(Uniq, GroundInstInfo), semidet, M) :- % It is an error to unify higher-order preds, % so if Real \= fake_unify, then we must fail. Real = fake_unify, % In theory we should choose take the union of the - % information specified by PredInstA and _MaybePredInstB. + % information specified by PredInstA and _GroundInstInfoB. % However, since our data representation provides no % way of doing that, and since this will only happen % for fake_unifys, for which it shouldn't make any difference, % we just choose the information specified by PredInstA. - PredInst = yes(PredInstA), + GroundInstInfo = higher_order(PredInstA), unify_uniq(live, Real, semidet, UniqA, UniqB, Uniq). -abstractly_unify_inst_3(live, ground(Uniq, no), Inst0, Real, M0, +abstractly_unify_inst_3(live, ground(Uniq, none), Inst0, Real, M0, Inst, Det, M) :- make_ground_inst(Inst0, live, Uniq, Real, M0, Inst, Det, M). +abstractly_unify_inst_3(live, ground(UniqX, constrained_inst_var(Var)), + any(UniqY), Real, M, ground(Uniq, constrained_inst_var(Var)), + semidet, M) :- + unify_uniq(live, Real, det, UniqX, UniqY, Uniq). + +abstractly_unify_inst_3(live, ground(Uniq0, constrained_inst_var(Var)), free, + Real, M, ground(Uniq, constrained_inst_var(Var)), det, M) :- + unify_uniq(live, Real, det, unique, Uniq0, Uniq). + +abstractly_unify_inst_3(live, ground(UniqX, constrained_inst_var(_)), + bound(UniqY, BoundInsts0), Real, M0, bound(Uniq, BoundInsts), + Det, M) :- + unify_uniq(live, Real, semidet, UniqX, UniqY, Uniq), + make_ground_bound_inst_list(BoundInsts0, live, UniqX, Real, M0, + BoundInsts, Det1, M), + det_par_conjunction_detism(Det1, semidet, Det). + +abstractly_unify_inst_3(live, ground(UniqA, constrained_inst_var(_V)), + ground(UniqB, GII), Real, M, ground(Uniq, GII), semidet, M) :- + unify_uniq(live, Real, semidet, UniqA, UniqB, Uniq). + % abstractly_unify_inst_3(live, abstract_inst(_,_), free, _, _, _, _, _) % :- fail. @@ -358,32 +381,56 @@ abstractly_unify_inst_3(dead, bound(Uniq, List), abstract_inst(N,As), ). *****/ -abstractly_unify_inst_3(dead, ground(UniqX, yes(PredInst)), any(UniqY), Real, M, - ground(Uniq, yes(PredInst)), semidet, M) :- +abstractly_unify_inst_3(dead, ground(UniqX, higher_order(PredInst)), + any(UniqY), Real, M, ground(Uniq, higher_order(PredInst)), + semidet, M) :- allow_unify_bound_any(Real), unify_uniq(dead, Real, semidet, UniqX, UniqY, Uniq). -abstractly_unify_inst_3(dead, ground(Uniq, yes(PredInst)), free, _Real, M, - ground(Uniq, yes(PredInst)), det, M). +abstractly_unify_inst_3(dead, ground(Uniq, higher_order(PredInst)), free, + _Real, M, ground(Uniq, higher_order(PredInst)), det, M). -abstractly_unify_inst_3(dead, ground(UniqA, yes(_)), bound(UniqB, BoundInsts0), - Real, M0, bound(Uniq, BoundInsts), Det, M) :- +abstractly_unify_inst_3(dead, ground(UniqA, higher_order(_)), + bound(UniqB, BoundInsts0), Real, M0, bound(Uniq, BoundInsts), + Det, M) :- unify_uniq(dead, Real, semidet, UniqA, UniqB, Uniq), make_ground_bound_inst_list(BoundInsts0, dead, UniqA, Real, M0, BoundInsts, Det1, M), det_par_conjunction_detism(Det1, semidet, Det). -abstractly_unify_inst_3(dead, ground(UniqA, yes(PredInstA)), - ground(UniqB, _MaybePredInstB), Real, M, - ground(Uniq, PredInst), det, M) :- +abstractly_unify_inst_3(dead, ground(UniqA, higher_order(PredInstA)), + ground(UniqB, _GroundInstInfoB), Real, M, + ground(Uniq, GroundInstInfo), det, M) :- Real = fake_unify, - PredInst = yes(PredInstA), + GroundInstInfo = higher_order(PredInstA), unify_uniq(dead, Real, det, UniqA, UniqB, Uniq). -abstractly_unify_inst_3(dead, ground(Uniq, no), Inst0, Real, M0, +abstractly_unify_inst_3(dead, ground(Uniq, none), Inst0, Real, M0, Inst, Det, M) :- make_ground_inst(Inst0, dead, Uniq, Real, M0, Inst, Det, M). +abstractly_unify_inst_3(dead, ground(UniqX, constrained_inst_var(Var)), + any(UniqY), Real, M, ground(Uniq, constrained_inst_var(Var)), + semidet, M) :- + allow_unify_bound_any(Real), + unify_uniq(dead, Real, semidet, UniqX, UniqY, Uniq). + +abstractly_unify_inst_3(dead, ground(Uniq, constrained_inst_var(Var)), free, + _Real, M, ground(Uniq, constrained_inst_var(Var)), det, M). + +abstractly_unify_inst_3(dead, ground(UniqA, constrained_inst_var(_)), + bound(UniqB, BoundInsts0), Real, M0, bound(Uniq, BoundInsts), + Det, M) :- + unify_uniq(dead, Real, semidet, UniqA, UniqB, Uniq), + make_ground_bound_inst_list(BoundInsts0, dead, UniqA, Real, M0, + BoundInsts, Det1, M), + det_par_conjunction_detism(Det1, semidet, Det). + +abstractly_unify_inst_3(dead, ground(UniqA, constrained_inst_var(_Var)), + ground(UniqB, GroundInstInfo), Real, M, + ground(Uniq, GroundInstInfo), det, M) :- + unify_uniq(dead, Real, det, UniqA, UniqB, Uniq). + /***** abstract insts aren't really supported abstractly_unify_inst_3(dead, abstract_inst(N,As), bound(List), Real, ModuleInfo, Result, Det, ModuleInfo) :- @@ -756,10 +803,10 @@ make_ground_inst_list([Inst0 | Insts0], Live, Uniq, Real, ModuleInfo0, :- mode make_ground_inst(in, in, in, in, in, out, out, out) is semidet. make_ground_inst(not_reached, _, _, _, M, not_reached, erroneous, M). -make_ground_inst(any(Uniq0), IsLive, Uniq1, Real, M, ground(Uniq, no), +make_ground_inst(any(Uniq0), IsLive, Uniq1, Real, M, ground(Uniq, none), semidet, M) :- unify_uniq(IsLive, Real, semidet, Uniq0, Uniq1, Uniq). -make_ground_inst(free, IsLive, Uniq0, Real, M, ground(Uniq, no), det, M) :- +make_ground_inst(free, IsLive, Uniq0, Real, M, ground(Uniq, none), det, M) :- unify_uniq(IsLive, Real, det, unique, Uniq0, Uniq). make_ground_inst(free(T), IsLive, Uniq0, Real, M, defined_inst(typed_ground(Uniq, T)), det, M) :- @@ -770,12 +817,12 @@ make_ground_inst(bound(Uniq0, BoundInsts0), IsLive, Uniq1, Real, M0, make_ground_bound_inst_list(BoundInsts0, IsLive, Uniq1, Real, M0, BoundInsts, Det1, M), det_par_conjunction_detism(Det1, semidet, Det). -make_ground_inst(ground(Uniq0, _PredInst), IsLive, Uniq1, Real, M, - ground(Uniq, no), semidet, M) :- +make_ground_inst(ground(Uniq0, _GII0), IsLive, Uniq1, Real, M, + ground(Uniq, none), semidet, M) :- unify_uniq(IsLive, Real, semidet, Uniq0, Uniq1, Uniq). make_ground_inst(inst_var(_), _, _, _, _, _, _, _) :- error("free inst var"). -make_ground_inst(abstract_inst(_,_), _, _, _, M, ground(shared, no), +make_ground_inst(abstract_inst(_,_), _, _, _, M, ground(shared, none), semidet, M). make_ground_inst(defined_inst(InstName), IsLive, Uniq, Real, ModuleInfo0, Inst, Det, ModuleInfo) :- @@ -1335,31 +1382,36 @@ inst_merge_3(bound(UniqA, ListA), bound(UniqB, ListB), ModuleInfo0, merge_uniq(UniqA, UniqB, Uniq), bound_inst_list_merge(ListA, ListB, ModuleInfo0, List, ModuleInfo). inst_merge_3(bound(UniqA, ListA), ground(UniqB, _), ModuleInfo, - ground(Uniq, no), ModuleInfo) :- + ground(Uniq, none), ModuleInfo) :- merge_uniq_bound(UniqB, UniqA, ListA, ModuleInfo, Uniq), bound_inst_list_is_ground(ListA, ModuleInfo). inst_merge_3(ground(UniqA, _), bound(UniqB, ListB), ModuleInfo, - ground(Uniq, no), ModuleInfo) :- + ground(Uniq, none), ModuleInfo) :- merge_uniq_bound(UniqA, UniqB, ListB, ModuleInfo, Uniq), bound_inst_list_is_ground(ListB, ModuleInfo). -inst_merge_3(ground(UniqA, MaybePredA), ground(UniqB, MaybePredB), ModuleInfo, - ground(Uniq, MaybePred), ModuleInfo) :- +inst_merge_3(ground(UniqA, GroundInstInfoA), ground(UniqB, GroundInstInfoB), + ModuleInfo, ground(Uniq, GroundInstInfo), ModuleInfo) :- ( - MaybePredA = yes(PredA), - MaybePredB = yes(PredB) + GroundInstInfoA = higher_order(PredA), + GroundInstInfoB = higher_order(PredB) -> % if they specify matching pred insts, but one is more % precise (specifies more info) than the other, % then we want to choose the least precise one ( pred_inst_matches(PredA, PredB, ModuleInfo) -> - MaybePred = yes(PredB) + GroundInstInfo = higher_order(PredB) ; pred_inst_matches(PredB, PredA, ModuleInfo) -> - MaybePred = yes(PredA) + GroundInstInfo = higher_order(PredA) ; - MaybePred = no + GroundInstInfo = none ) ; - MaybePred = no + GroundInstInfoA = constrained_inst_var(V), + GroundInstInfoB = constrained_inst_var(V) + -> + GroundInstInfo = constrained_inst_var(V) + ; + GroundInstInfo = none ), merge_uniq(UniqA, UniqB, Uniq). inst_merge_3(abstract_inst(Name, ArgsA), abstract_inst(Name, ArgsB), diff --git a/compiler/instmap.m b/compiler/instmap.m index 463df1f81..9b1501171 100644 --- a/compiler/instmap.m +++ b/compiler/instmap.m @@ -20,7 +20,7 @@ :- interface. :- import_module hlds_module, prog_data, mode_info, (inst), mode_errors. -:- import_module hlds_data. +:- import_module hlds_data, hlds_pred. :- import_module map, bool, set, list, assoc_list, std_util. @@ -120,8 +120,8 @@ % the one to take IMA to IMB. However this predicate should % transform more easily to the alias branch. % -:- pred instmap_changed_vars(instmap::in, instmap::in, module_info::in, - set(prog_var)::out) is det. +:- pred instmap_changed_vars(instmap::in, instmap::in, vartypes::in, + module_info::in, set(prog_var)::out) is det. %-----------------------------------------------------------------------------% @@ -250,8 +250,8 @@ % is true if none of the vars in the set Vars could have become more % instantiated when InstmapDelta is applied to Instmap. :- pred instmap__no_output_vars(instmap, instmap_delta, set(prog_var), - module_info). -:- mode instmap__no_output_vars(in, in, in, in) is semidet. + vartypes, module_info). +:- mode instmap__no_output_vars(in, in, in, in, in) is semidet. % merge_instmap_delta(InitialInstMap, NonLocals, % InstMapDeltaA, InstMapDeltaB, ModuleInfo0, ModuleInfo) @@ -396,23 +396,27 @@ instmap_delta_changed_vars(reachable(InstMapping), ChangedVars) :- %-----------------------------------------------------------------------------% -instmap_changed_vars(InstMapA, InstMapB, ModuleInfo, ChangedVars) :- +instmap_changed_vars(InstMapA, InstMapB, VarTypes, ModuleInfo, ChangedVars) :- instmap__vars_list(InstMapB, VarsB), - changed_vars_2(VarsB, InstMapA, InstMapB, ModuleInfo, ChangedVars). + changed_vars_2(VarsB, InstMapA, InstMapB, VarTypes, ModuleInfo, + ChangedVars). -:- pred changed_vars_2(prog_vars::in, instmap::in, - instmap::in, module_info::in, set(prog_var)::out) is det. +:- pred changed_vars_2(prog_vars::in, instmap::in, instmap::in, vartypes::in, + module_info::in, set(prog_var)::out) is det. -changed_vars_2([], _InstMapA, _InstMapB, _ModuleInfo, ChangedVars) :- +changed_vars_2([], _InstMapA, _InstMapB, _Types, _ModuleInfo, ChangedVars) :- set__init(ChangedVars). -changed_vars_2([VarB|VarBs], InstMapA, InstMapB, ModuleInfo, ChangedVars) :- - changed_vars_2(VarBs, InstMapA, InstMapB, ModuleInfo, ChangedVars0), +changed_vars_2([VarB|VarBs], InstMapA, InstMapB, VarTypes, ModuleInfo, + ChangedVars) :- + changed_vars_2(VarBs, InstMapA, InstMapB, VarTypes, ModuleInfo, + ChangedVars0), instmap__lookup_var(InstMapA, VarB, InitialInst), instmap__lookup_var(InstMapB, VarB, FinalInst), + map__lookup(VarTypes, VarB, Type), ( - inst_matches_final(InitialInst, FinalInst, ModuleInfo) + inst_matches_final(InitialInst, FinalInst, Type, ModuleInfo) -> ChangedVars = ChangedVars0 ; @@ -872,17 +876,18 @@ compute_instmap_delta_2([Var | Vars], InstMapA, InstMapB, AssocList) :- %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% -instmap__no_output_vars(_, unreachable, _, _). -instmap__no_output_vars(InstMap0, reachable(InstMapDelta), Vars, M) :- +instmap__no_output_vars(_, unreachable, _, _, _). +instmap__no_output_vars(InstMap0, reachable(InstMapDelta), Vars, VT, M) :- set__to_sorted_list(Vars, VarList), - instmap__no_output_vars_2(VarList, InstMap0, InstMapDelta, M). + instmap__no_output_vars_2(VarList, InstMap0, InstMapDelta, VT, M). :- pred instmap__no_output_vars_2(list(prog_var), instmap, instmapping, - module_info). -:- mode instmap__no_output_vars_2(in, in, in, in) is semidet. + vartypes, module_info). +:- mode instmap__no_output_vars_2(in, in, in, in, in) is semidet. -instmap__no_output_vars_2([], _, _, _). -instmap__no_output_vars_2([Var | Vars], InstMap0, InstMapDelta, ModuleInfo) :- +instmap__no_output_vars_2([], _, _, _, _). +instmap__no_output_vars_2([Var | Vars], InstMap0, InstMapDelta, VarTypes, + ModuleInfo) :- % We use `inst_matches_binding' to check that the new inst % has only added information or lost uniqueness, % not bound anything. @@ -897,8 +902,10 @@ instmap__no_output_vars_2([Var | Vars], InstMap0, InstMapDelta, ModuleInfo) :- ; Inst = Inst0 ), - inst_matches_binding(Inst, Inst0, ModuleInfo), - instmap__no_output_vars_2(Vars, InstMap0, InstMapDelta, ModuleInfo). + map__lookup(VarTypes, Var, Type), + inst_matches_binding(Inst, Inst0, Type, ModuleInfo), + instmap__no_output_vars_2(Vars, InstMap0, InstMapDelta, VarTypes, + ModuleInfo). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% diff --git a/compiler/lambda.m b/compiler/lambda.m index a73bf06a1..ec45784e9 100644 --- a/compiler/lambda.m +++ b/compiler/lambda.m @@ -95,6 +95,7 @@ map(prog_var, type), % from the proc_info class_constraints, % from the pred_info tvarset, % from the proc_info + inst_varset, % from the proc_info map(tvar, type_info_locn), % from the proc_info % (typeinfos) @@ -178,15 +179,16 @@ lambda__process_proc_2(ProcInfo0, PredInfo0, ModuleInfo0, proc_info_goal(ProcInfo0, Goal0), proc_info_typeinfo_varmap(ProcInfo0, TVarMap0), proc_info_typeclass_info_varmap(ProcInfo0, TCVarMap0), + proc_info_inst_varset(ProcInfo0, InstVarSet0), MustRecomputeNonLocals0 = no, % process the goal Info0 = lambda_info(VarSet0, VarTypes0, Constraints0, TypeVarSet0, - TVarMap0, TCVarMap0, Markers, PredOrFunc, + InstVarSet0, TVarMap0, TCVarMap0, Markers, PredOrFunc, PredName, Owner, ModuleInfo0, MustRecomputeNonLocals0), lambda__process_goal(Goal0, Goal1, Info0, Info1), Info1 = lambda_info(VarSet1, VarTypes1, Constraints, TypeVarSet, - TVarMap, TCVarMap, _, _, _, _, ModuleInfo, + _, TVarMap, TCVarMap, _, _, _, _, ModuleInfo, MustRecomputeNonLocals), % check if we need to requantify @@ -304,8 +306,8 @@ lambda__process_lambda(PredOrFunc, EvalMethod, Vars, Modes, Detism, OrigNonLocals0, LambdaGoal, Unification0, Functor, Unification, LambdaInfo0, LambdaInfo) :- LambdaInfo0 = lambda_info(VarSet, VarTypes, _PredConstraints, TVarSet, - TVarMap, TCVarMap, Markers, POF, OrigPredName, Owner, - ModuleInfo0, MustRecomputeNonLocals0), + InstVarSet, TVarMap, TCVarMap, Markers, POF, OrigPredName, + Owner, ModuleInfo0, MustRecomputeNonLocals0), % Calculate the constraints which apply to this lambda % expression. @@ -527,8 +529,8 @@ lambda__process_lambda(PredOrFunc, EvalMethod, Vars, Modes, Detism, % Now construct the proc_info and pred_info for the new % single-mode predicate, using the information computed above - proc_info_create(VarSet, VarTypes, AllArgVars, - AllArgModes, Detism, LambdaGoal, LambdaContext, + proc_info_create(VarSet, VarTypes, AllArgVars, AllArgModes, + InstVarSet, Detism, LambdaGoal, LambdaContext, TVarMap, TCVarMap, address_is_taken, ProcInfo), set__init(Assertions), @@ -553,8 +555,8 @@ lambda__process_lambda(PredOrFunc, EvalMethod, Vars, Modes, Detism, Unification = construct(Var, ConsId, ArgVars, UniModes, construct_dynamically, cell_is_unique, RLExprnId), LambdaInfo = lambda_info(VarSet, VarTypes, Constraints, TVarSet, - TVarMap, TCVarMap, Markers, POF, OrigPredName, Owner, - ModuleInfo, MustRecomputeNonLocals). + InstVarSet, TVarMap, TCVarMap, Markers, POF, OrigPredName, + Owner, ModuleInfo, MustRecomputeNonLocals). :- pred lambda__constraint_contains_vars(list(tvar), class_constraint). :- mode lambda__constraint_contains_vars(in, in) is semidet. diff --git a/compiler/magic.m b/compiler/magic.m index 1ec684368..c61db50db 100644 --- a/compiler/magic.m +++ b/compiler/magic.m @@ -574,7 +574,7 @@ magic__get_scc_inputs([PredProcId | PredProcIds], OutputMode = (free -> OutputInst) )) }, { list__map(GetOutputMode, InputModes, InputRelModes) }, - { Inst = ground(unique, yes(pred_inst_info(predicate, + { Inst = ground(unique, higher_order(pred_inst_info(predicate, InputRelModes, nondet))) }, { Mode = (Inst -> Inst) }, magic__get_scc_inputs(PredProcIds, Types, Modes). @@ -703,6 +703,7 @@ magic__adjust_proc_info(EntryPoints, CPredProcId, AditiPredProcId, InterfaceRequired = no }, + { proc_info_inst_varset(ProcInfo1, InstVarSet) }, magic__adjust_args(CPredProcId, AditiPredProcId, InterfaceRequired, Index, MagicTypes, MagicModes, PredInfo0, ProcInfo1, InputArgTypes, InputArgModes, LocalAditiPredProcId), @@ -714,7 +715,7 @@ magic__adjust_proc_info(EntryPoints, CPredProcId, AditiPredProcId, % for the current procedure. magic__create_magic_pred(CPredProcId, LocalAditiPredProcId, MagicTypes, MagicModes, InputArgTypes, InputArgModes, - Index) + InstVarSet, Index) ), % @@ -854,6 +855,7 @@ magic__create_interface_proc(Index, CPredProcId, AditiPredProcId, { proc_info_headvars(LocalProcInfo, HeadVars) }, { proc_info_vartypes(LocalProcInfo, VarTypes) }, { proc_info_varset(LocalProcInfo, VarSet) }, + { proc_info_inst_varset(LocalProcInfo, InstVarSet) }, { pred_info_get_markers(ExportedPredInfo0, Markers) }, { pred_info_get_aditi_owner(ExportedPredInfo0, Owner) }, @@ -863,8 +865,9 @@ magic__create_interface_proc(Index, CPredProcId, AditiPredProcId, { varset__init(TVarSet) }, { hlds_pred__define_new_pred(Goal, CallGoal, HeadVars, ExtraArgs, InstMap, PredName, TVarSet, VarTypes, ClassContext, TVarMap, - TCVarMap, VarSet, Markers, Owner, address_is_not_taken, - ModuleInfo1, ModuleInfo2, LocalPredProcId) }, + TCVarMap, VarSet, InstVarSet, Markers, Owner, + address_is_not_taken, ModuleInfo1, ModuleInfo2, + LocalPredProcId) }, { ExtraArgs = [] -> true ; @@ -1070,7 +1073,7 @@ magic__create_input_join_proc(CPredProcId, AditiPredProcId, JoinPredProcId, InputArgs, MagicArgModes, nondet) - InputGoalInfo, ClosureInst = ground(shared, - yes(pred_inst_info(predicate, MagicArgModes, nondet))), + higher_order(pred_inst_info(predicate, MagicArgModes, nondet))), ClosureMode = (ClosureInst -> ClosureInst), proc_info_set_argmodes(JoinProcInfo1, [ClosureMode | OutputArgModes], JoinProcInfo2), @@ -1283,11 +1286,11 @@ magic__make_const(Type, ConsId, Var, Goal, ProcInfo0, ProcInfo) :- % Allocate a predicate to collect the input for the current predicate. :- pred magic__create_magic_pred(pred_proc_id::in, pred_proc_id::in, list(type)::in, list(mode)::in, list(type)::in, - list(mode)::in, maybe(int)::in, + list(mode)::in, inst_varset::in, maybe(int)::in, magic_info::in, magic_info::out) is det. magic__create_magic_pred(CPredProcId, PredProcId, MagicTypes, MagicModes, - InputTypes0, InputModes0, Index) --> + InputTypes0, InputModes0, InstVarSet, Index) --> magic_info_get_module_info(ModuleInfo0), @@ -1385,8 +1388,8 @@ magic__create_magic_pred(CPredProcId, PredProcId, MagicTypes, MagicModes, { map__init(TVarMap) }, { map__init(TCVarMap) }, - { proc_info_create(VarSet, VarTypes, AllArgs, AllArgModes, nondet, - Goal, Context, TVarMap, TCVarMap, address_is_not_taken, + { proc_info_create(VarSet, VarTypes, AllArgs, AllArgModes, InstVarSet, + nondet, Goal, Context, TVarMap, TCVarMap, address_is_not_taken, ProcInfo) }, % @@ -1632,7 +1635,7 @@ magic__preprocess_call_args([Arg | Args], [NewArg | NewArgs], SeenArgs, { IntroducedArgs1 = [NewArg | IntroducedArgs0] }, { in_mode(InMode) }, { out_mode(OutMode) }, - { Inst = ground(shared, no) }, + { Inst = ground(shared, none) }, { set__list_to_set([Arg, NewArg], NonLocals) }, { instmap_delta_from_assoc_list([NewArg - Inst], Delta) }, { goal_info_init(NonLocals, Delta, det, GoalInfo) }, diff --git a/compiler/magic_util.m b/compiler/magic_util.m index 93f5c28bd..052ecfcad 100644 --- a/compiler/magic_util.m +++ b/compiler/magic_util.m @@ -808,12 +808,13 @@ magic_util__create_closure(_CurrVar, InputVar, InputMode, LambdaGoal, ( { SuppCall = call(SuppPredId, SuppProcId, _, _, _, _) - _ }, { mode_get_insts(ModuleInfo, InputMode, Inst, _) }, - { Inst = ground(_, yes(PredInstInfo)) } + { Inst = ground(_, higher_order(PredInstInfo)) } -> % Find the mode of the unification. { PredInstInfo = pred_inst_info(_, LambdaModes, _) }, { LambdaInst = ground(shared, - yes(pred_inst_info(predicate, LambdaModes, nondet))) }, + higher_order(pred_inst_info(predicate, LambdaModes, + nondet))) }, { UnifyMode = (free -> LambdaInst) - (LambdaInst -> LambdaInst) }, { mode_util__modes_to_uni_modes(LambdaModes, LambdaModes, @@ -1060,7 +1061,7 @@ magic_util__create_supp_call(Goals, MagicVars, SuppOutputArgs, Context, % instantiated. Any arguments that are partially % instantiated in the initial instmap for the % procedure will be reported there. - Mode = (ground(shared, no) -> ground(shared, no)) + Mode = (ground(shared, none) -> ground(shared, none)) ) )) }, { list__map(GetSuppMode, SuppOutputArgs, SuppOutputModes) }, @@ -1077,6 +1078,7 @@ magic_util__create_supp_call(Goals, MagicVars, SuppOutputArgs, Context, magic_info_get_module_info(ModuleInfo0), { proc_info_get_initial_instmap(ProcInfo, ModuleInfo0, InstMap) }, + { proc_info_inst_varset(ProcInfo, InstVarSet) }, { pred_info_get_aditi_owner(PredInfo, Owner) }, { pred_info_get_markers(PredInfo, Markers0) }, { AddMarkers = lambda([Marker::in, Ms0::in, Ms::out] is det, @@ -1094,7 +1096,7 @@ magic_util__create_supp_call(Goals, MagicVars, SuppOutputArgs, Context, { unqualify_name(NewName, NewPredName) }, { hlds_pred__define_new_pred(SuppGoal, SuppCall, SuppArgs, ExtraArgs, InstMap, NewPredName, TVarSet, VarTypes, ClassConstraints, - TVarMap, TCVarMap, VarSet, Markers, Owner, + TVarMap, TCVarMap, VarSet, InstVarSet, Markers, Owner, address_is_not_taken, ModuleInfo0, ModuleInfo, _) }, { ExtraArgs = [] -> true diff --git a/compiler/make_hlds.m b/compiler/make_hlds.m index 32b29154b..e57a9887c 100644 --- a/compiler/make_hlds.m +++ b/compiler/make_hlds.m @@ -40,10 +40,10 @@ qual_info, bool, bool, io__state, io__state). :- mode parse_tree_to_hlds(in, in, in, out, out, out, out, di, uo) is det. -:- pred add_new_proc(pred_info, arity, list(mode), maybe(list(mode)), - maybe(list(is_live)), maybe(determinism), +:- pred add_new_proc(pred_info, inst_varset, arity, list(mode), + maybe(list(mode)), maybe(list(is_live)), maybe(determinism), prog_context, is_address_taken, pred_info, proc_id). -:- mode add_new_proc(in, in, in, in, in, in, in, in, out, out) is det. +:- mode add_new_proc(in, in, in, in, in, in, in, in, in, out, out) is det. % add_special_pred_for_real(SpecialPredId, ModuleInfo0, TVarSet, % Type, TypeId, TypeBody, TypeContext, TypeStatus, ModuleInfo). @@ -113,6 +113,7 @@ parse_tree_to_hlds(module(Name, Items), MQInfo0, EqvMap, Module, QualInfo, maybe_report_stats(Statistics), add_item_list_decls_pass_2(Items, item_status(local, may_be_unqualified), Module1, Module2), + maybe_report_stats(Statistics), % balance the binary trees { module_info_optimize(Module2, Module3) }, @@ -1728,7 +1729,7 @@ modes_add(Modes0, VarSet, eqv_mode(Name, Args, Body), ) ). -:- pred mode_name_args(mode_defn, sym_name, list(inst_param), hlds_mode_body). +:- pred mode_name_args(mode_defn, sym_name, list(inst_var), hlds_mode_body). :- mode mode_name_args(in, out, out, out) is det. mode_name_args(eqv_mode(Name, Args, Body), Name, Args, eqv_mode(Body)). @@ -3116,7 +3117,10 @@ add_special_pred_decl_for_real(SpecialPredId, ArgTypes, Cond, Context, ClausesInfo0, Status, Markers, none, predicate, ClassContext, Proofs, Owner, PredInfo0), ArgLives = no, - add_new_proc(PredInfo0, Arity, ArgModes, yes(ArgModes), + varset__init(InstVarSet), + % Should not be any inst vars here so it's ok to use a + % fresh inst_varset. + add_new_proc(PredInfo0, InstVarSet, Arity, ArgModes, yes(ArgModes), ArgLives, yes(Det), Context, address_is_not_taken, PredInfo, _), @@ -3176,13 +3180,15 @@ adjust_special_pred_status(Status0, SpecialPredId, Status) :- Status = Status1 ). -add_new_proc(PredInfo0, Arity, ArgModes, MaybeDeclaredArgModes, MaybeArgLives, - MaybeDet, Context, IsAddressTaken, PredInfo, ModeId) :- +add_new_proc(PredInfo0, InstVarSet, Arity, ArgModes, MaybeDeclaredArgModes, + MaybeArgLives, MaybeDet, Context, IsAddressTaken, PredInfo, + ModeId) :- pred_info_procedures(PredInfo0, Procs0), pred_info_arg_types(PredInfo0, ArgTypes), next_mode_id(Procs0, MaybeDet, ModeId), proc_info_init(Arity, ArgTypes, ArgModes, MaybeDeclaredArgModes, - MaybeArgLives, MaybeDet, Context, IsAddressTaken, NewProc), + MaybeArgLives, MaybeDet, Context, IsAddressTaken, NewProc0), + proc_info_set_inst_varset(NewProc0, InstVarSet, NewProc), map__det_insert(Procs0, ModeId, NewProc, Procs), pred_info_set_procedures(PredInfo0, Procs, PredInfo). @@ -3200,7 +3206,7 @@ add_new_proc(PredInfo0, Arity, ArgModes, MaybeDeclaredArgModes, MaybeArgLives, % We should store the mode varset and the mode condition % in the hlds - at the moment we just ignore those two arguments. -module_add_mode(ModuleInfo0, _VarSet, PredName, Modes, MaybeDet, _Cond, +module_add_mode(ModuleInfo0, InstVarSet, PredName, Modes, MaybeDet, _Cond, Status, MContext, PredOrFunc, IsClassMethod, PredProcId, ModuleInfo) --> @@ -3233,19 +3239,20 @@ module_add_mode(ModuleInfo0, _VarSet, PredName, Modes, MaybeDet, _Cond, { predicate_table_get_preds(PredicateTable1, Preds0) }, { map__lookup(Preds0, PredId, PredInfo0) }, - module_do_add_mode(PredInfo0, Arity, Modes, MaybeDet, MContext, - PredInfo, ProcId), + module_do_add_mode(PredInfo0, InstVarSet, Arity, Modes, MaybeDet, + MContext, PredInfo, ProcId), { map__det_update(Preds0, PredId, PredInfo, Preds) }, { predicate_table_set_preds(PredicateTable1, Preds, PredicateTable) }, { module_info_set_predicate_table(ModuleInfo0, PredicateTable, ModuleInfo) }, { PredProcId = PredId - ProcId }. -:- pred module_do_add_mode(pred_info, arity, list(mode), maybe(determinism), - prog_context, pred_info, proc_id, io__state, io__state). -:- mode module_do_add_mode(in, in, in, in, in, out, out, di, uo) is det. +:- pred module_do_add_mode(pred_info, inst_varset, arity, list(mode), + maybe(determinism), prog_context, pred_info, proc_id, + io__state, io__state). +:- mode module_do_add_mode(in, in, in, in, in, in, out, out, di, uo) is det. -module_do_add_mode(PredInfo0, Arity, Modes, MaybeDet, MContext, +module_do_add_mode(PredInfo0, InstVarSet, Arity, Modes, MaybeDet, MContext, PredInfo, ProcId) --> % check that the determinism was specified ( @@ -3276,8 +3283,9 @@ module_do_add_mode(PredInfo0, Arity, Modes, MaybeDet, MContext, % add the mode declaration to the pred_info for this procedure. { ArgLives = no }, - { add_new_proc(PredInfo0, Arity, Modes, yes(Modes), ArgLives, - MaybeDet, MContext, address_is_not_taken, PredInfo, ProcId) }. + { add_new_proc(PredInfo0, InstVarSet, Arity, Modes, yes(Modes), + ArgLives, MaybeDet, MContext, address_is_not_taken, PredInfo, + ProcId) }. % Whenever there is a clause or mode declaration for an undeclared % predicate, we add an implicit declaration diff --git a/compiler/mercury_to_mercury.m b/compiler/mercury_to_mercury.m index e71baddc4..dd7880644 100644 --- a/compiler/mercury_to_mercury.m +++ b/compiler/mercury_to_mercury.m @@ -657,12 +657,14 @@ mercury_write_module_spec_list([ModuleName | ModuleNames]) --> mercury_output_inst_defn(VarSet, abstract_inst(Name, Args), Context) --> io__write_string(":- inst ("), - { construct_qualified_term(Name, Args, Context, InstTerm) }, + { list__map(pred(V::in, variable(V)::out) is det, Args, ArgTerms) }, + { construct_qualified_term(Name, ArgTerms, Context, InstTerm) }, mercury_output_term(InstTerm, VarSet, no), io__write_string(").\n"). mercury_output_inst_defn(VarSet, eqv_inst(Name, Args, Body), Context) --> io__write_string(":- inst ("), - { construct_qualified_term(Name, Args, Context, InstTerm) }, + { list__map(pred(V::in, variable(V)::out) is det, Args, ArgTerms) }, + { construct_qualified_term(Name, ArgTerms, Context, InstTerm) }, mercury_output_term(InstTerm, VarSet, no), io__write_string(") = "), mercury_output_inst(Body, VarSet), @@ -700,12 +702,12 @@ mercury_output_structured_inst(bound(Uniq, BoundInsts), Indent, VarSet) --> mercury_output_structured_bound_insts(BoundInsts, Indent, VarSet), mercury_output_tabs(Indent), io__write_string(")\n"). -mercury_output_structured_inst(ground(Uniq, MaybePredInfo), Indent, VarSet) +mercury_output_structured_inst(ground(Uniq, GroundInstInfo), Indent, VarSet) --> mercury_output_tabs(Indent), ( - { MaybePredInfo = yes(pred_inst_info(PredOrFunc, Modes, Det)) } - -> + { GroundInstInfo = higher_order(pred_inst_info(PredOrFunc, + Modes, Det)) }, ( { Uniq = shared } -> [] ; @@ -742,6 +744,12 @@ mercury_output_structured_inst(ground(Uniq, MaybePredInfo), Indent, VarSet) io__write_string(")\n") ) ; + { GroundInstInfo = constrained_inst_var(Var) }, + mercury_output_tabs(Indent), + mercury_output_var(Var, VarSet, no), + io__write_string("\n") + ; + { GroundInstInfo = none}, mercury_output_uniqueness(Uniq, "ground"), io__write_string("\n") ). @@ -769,10 +777,10 @@ mercury_output_inst(bound(Uniq, BoundInsts), VarSet) --> io__write_string("("), mercury_output_bound_insts(BoundInsts, VarSet), io__write_string(")"). -mercury_output_inst(ground(Uniq, MaybePredInfo), VarSet) --> +mercury_output_inst(ground(Uniq, GroundInstInfo), VarSet) --> ( - { MaybePredInfo = yes(pred_inst_info(PredOrFunc, Modes, Det)) } - -> + { GroundInstInfo = higher_order(pred_inst_info(PredOrFunc, + Modes, Det)) }, ( { Uniq = shared } -> [] ; @@ -810,6 +818,10 @@ mercury_output_inst(ground(Uniq, MaybePredInfo), VarSet) --> io__write_string(")") ) ; + { GroundInstInfo = constrained_inst_var(Var) }, + mercury_output_var(Var, VarSet, no) + ; + { GroundInstInfo = none }, mercury_output_uniqueness(Uniq, "ground") ). mercury_output_inst(inst_var(Var), VarSet) --> @@ -1162,7 +1174,8 @@ mercury_output_cons_id(tabling_pointer_const(_, _), _) --> mercury_output_mode_defn(VarSet, eqv_mode(Name, Args, Mode), Context) --> io__write_string(":- mode ("), - { construct_qualified_term(Name, Args, Context, ModeTerm) }, + { list__map(pred(V::in, variable(V)::out) is det, Args, ArgTerms) }, + { construct_qualified_term(Name, ArgTerms, Context, ModeTerm) }, mercury_output_term(ModeTerm, VarSet, no), io__write_string(") :: "), mercury_output_mode(Mode, VarSet), @@ -1199,8 +1212,8 @@ mercury_output_mode((InstA -> InstB), VarSet) --> % check for higher-order pred or func modes, and output them % in a nice format % - { InstA = ground(_Uniq, - yes(pred_inst_info(_PredOrFunc, _Modes, _Det))) }, + { InstA = ground(_Uniq, higher_order(pred_inst_info(_PredOrFunc, + _Modes, _Det))) }, { InstB = InstA } -> mercury_output_inst(InstA, VarSet) diff --git a/compiler/mode_info.m b/compiler/mode_info.m index 0d1b1f0f5..e6f6a70de 100644 --- a/compiler/mode_info.m +++ b/compiler/mode_info.m @@ -385,6 +385,8 @@ % execution point, since those variables will *already* have % been marked as mostly_unique rather than unique.) + instvarset :: inst_varset, + last_checkpoint_insts :: assoc_list(prog_var, inst), % This field is used by the checkpoint code when debug_modes is on. % It has the instmap that was current at the last mode checkpoint, @@ -445,6 +447,7 @@ mode_info_init(IOState, ModuleInfo, PredId, ProcId, Context, map__lookup(Procs, ProcId, ProcInfo), proc_info_varset(ProcInfo, VarSet), proc_info_vartypes(ProcInfo, VarTypes), + proc_info_inst_varset(ProcInfo, InstVarSet), LiveVarsList = [LiveVars], NondetLiveVarsList = [LiveVars], @@ -455,7 +458,7 @@ mode_info_init(IOState, ModuleInfo, PredId, ProcId, Context, ModeInfo = mode_info( IOState, ModuleInfo, PredId, ProcId, VarSet, VarTypes, Context, ModeContext, InstMapping0, LockedVars, DelayInfo, - ErrorList, LiveVarsList, NondetLiveVarsList, [], [], + ErrorList, LiveVarsList, NondetLiveVarsList, InstVarSet, [], [], Changed, HowToCheck, MayChangeProc, CheckingExtraGoals ). @@ -471,6 +474,8 @@ mode_info_set_io_state(ModeInfo, IOState0, ModeInfo^io_state := IOState) :- % XXX unsafe_promise_unique(IOState0, IOState). +%-----------------------------------------------------------------------------% + mode_info_get_preds(ModeInfo, Preds) :- module_info_preds(ModeInfo^module_info, Preds). @@ -573,7 +578,7 @@ mode_info_get_num_errors(ModeInfo, NumErrors) :- %-----------------------------------------------------------------------------% - % We keep track of the live variables and the nondet-live variables + % We keep track of the live variables and the nondet-live variables % a bag, represented as a list of sets of vars. % This allows us to easily add and remove sets of variables. % It's probably not maximally efficient. @@ -656,11 +661,7 @@ mode_info_get_liveness_2([LiveVarsSet | LiveVarsList], LiveVars0, LiveVars) :- %-----------------------------------------------------------------------------% - % Since we don't yet handle polymorphic modes, the inst varset - % is always empty. - -mode_info_get_instvarset(_ModeInfo, InstVarSet) :- - varset__init(InstVarSet). +mode_info_get_instvarset(ModeInfo, ModeInfo^instvarset). mode_info_get_types_of_vars(ModeInfo, Vars, TypesOfVars) :- mode_info_get_var_types(ModeInfo, VarTypes), diff --git a/compiler/mode_util.m b/compiler/mode_util.m index 46e291dce..3bd2ee6bb 100644 --- a/compiler/mode_util.m +++ b/compiler/mode_util.m @@ -116,7 +116,9 @@ module_info::in, module_info::out) is det. :- pred recompute_instmap_delta(bool::in, hlds_goal::in, hlds_goal::out, - vartypes::in, instmap::in, module_info::in, module_info::out) is det. + vartypes::in, inst_varset::in, instmap::in, module_info::in, + module_info::out) is det. + % Given corresponding lists of types and modes, produce a new % list of modes which includes the information provided by the @@ -175,6 +177,20 @@ :- pred partition_args(module_info, list(mode), list(T), list(T), list(T)). :- mode partition_args(in, in, in, out, out) is det. +%-----------------------------------------------------------------------------% + +:- pred inst_list_apply_substitution(list(inst), inst_var_sub, list(inst)). +:- mode inst_list_apply_substitution(in, in, out) is det. + +:- pred mode_list_apply_substitution(list(mode), inst_var_sub, list(mode)). +:- mode mode_list_apply_substitution(in, in, out) is det. + +%-----------------------------------------------------------------------------% + +:- pred rename_apart_inst_vars(inst_varset, inst_varset, list(mode), + list(mode)). +:- mode rename_apart_inst_vars(in, in, in, out) is det. + %-----------------------------------------------------------------------------% % Construct a mode corresponding to the standard `in', @@ -195,9 +211,10 @@ %-----------------------------------------------------------------------------% :- implementation. +:- import_module require, int, map, set, std_util, assoc_list, varset. :- import_module prog_util, prog_io, type_util. :- import_module inst_match, inst_util, mode_info. -:- import_module require, int, map, set, term, std_util, assoc_list. +:- import_module require, int, map, set, term, std_util, assoc_list, varset. %-----------------------------------------------------------------------------% @@ -229,27 +246,27 @@ insts_to_mode(Initial, Final, Mode) :- % This is just to make error messages and inferred modes % more readable. % - ( Initial = free, Final = ground(shared, no) -> + ( Initial = free, Final = ground(shared, none) -> make_std_mode("out", [], Mode) - ; Initial = free, Final = ground(unique, no) -> + ; Initial = free, Final = ground(unique, none) -> make_std_mode("uo", [], Mode) - ; Initial = free, Final = ground(mostly_unique, no) -> + ; Initial = free, Final = ground(mostly_unique, none) -> make_std_mode("muo", [], Mode) - ; Initial = ground(shared, no), Final = ground(shared, no) -> + ; Initial = ground(shared, none), Final = ground(shared, none) -> make_std_mode("in", [], Mode) - ; Initial = ground(unique, no), Final = ground(clobbered, no) -> + ; Initial = ground(unique, none), Final = ground(clobbered, none) -> make_std_mode("di", [], Mode) - ; Initial = ground(mostly_unique, no), - Final = ground(mostly_clobbered, no) -> + ; Initial = ground(mostly_unique, none), + Final = ground(mostly_clobbered, none) -> make_std_mode("mdi", [], Mode) - ; Initial = ground(unique, no), Final = ground(unique, no) -> + ; Initial = ground(unique, none), Final = ground(unique, none) -> make_std_mode("ui", [], Mode) - ; Initial = ground(mostly_unique, no), - Final = ground(mostly_unique, no) -> + ; Initial = ground(mostly_unique, none), + Final = ground(mostly_unique, none) -> make_std_mode("mdi", [], Mode) ; Initial = free -> make_std_mode("out", [Final], Mode) - ; Final = ground(clobbered, no) -> + ; Final = ground(clobbered, none) -> make_std_mode("di", [Initial], Mode) ; Initial = Final -> make_std_mode("in", [Initial], Mode) @@ -374,7 +391,7 @@ get_single_arg_inst(defined_inst(InstName), ModuleInfo, ConsId, ArgInst) :- inst_lookup(ModuleInfo, InstName, Inst), get_single_arg_inst(Inst, ModuleInfo, ConsId, ArgInst). get_single_arg_inst(not_reached, _, _, not_reached). -get_single_arg_inst(ground(Uniq, _PredInst), _, _, ground(Uniq, no)). +get_single_arg_inst(ground(Uniq, _PredInst), _, _, ground(Uniq, none)). get_single_arg_inst(bound(_Uniq, List), _, ConsId, ArgInst) :- ( get_single_arg_inst_2(List, ConsId, ArgInst0) -> ArgInst = ArgInst0 @@ -430,7 +447,7 @@ functors_to_cons_ids([Functor | Functors], [ConsId | ConsIds]) :- get_arg_insts(not_reached, _ConsId, Arity, ArgInsts) :- list__duplicate(Arity, not_reached, ArgInsts). get_arg_insts(ground(Uniq, _PredInst), _ConsId, Arity, ArgInsts) :- - list__duplicate(Arity, ground(Uniq, no), ArgInsts). + list__duplicate(Arity, ground(Uniq, none), ArgInsts). get_arg_insts(bound(_Uniq, List), ConsId, Arity, ArgInsts) :- ( get_arg_insts_2(List, ConsId, ArgInsts0) -> ArgInsts = ArgInsts0 @@ -536,7 +553,7 @@ inst_lookup_2(InstName, ModuleInfo, Inst) :- ; InstName = typed_ground(Uniq, Type), map__init(Subst), propagate_type_into_inst(Type, Subst, ModuleInfo, - ground(Uniq, no), Inst) + ground(Uniq, none), Inst) ; InstName = typed_inst(Type, TypedInstName), inst_lookup_2(TypedInstName, ModuleInfo, Inst0), map__init(Subst), @@ -657,19 +674,20 @@ propagate_ctor_info(bound(Uniq, BoundInsts0), Type, _Constructors, ModuleInfo, % XXX do we need to sort the BoundInsts? Inst = bound(Uniq, BoundInsts) ). -propagate_ctor_info(ground(Uniq, no), Type, Constructors, ModuleInfo, Inst) :- +propagate_ctor_info(ground(Uniq, none), Type, Constructors, ModuleInfo, Inst) + :- ( type_is_higher_order(Type, function, _, ArgTypes) -> default_higher_order_func_inst(ArgTypes, ModuleInfo, HigherOrderInstInfo), - Inst = ground(Uniq, yes(HigherOrderInstInfo)) + Inst = ground(Uniq, higher_order(HigherOrderInstInfo)) ; constructors_to_bound_insts(Constructors, Uniq, ModuleInfo, BoundInsts0), list__sort_and_remove_dups(BoundInsts0, BoundInsts), Inst = bound(Uniq, BoundInsts) ). -propagate_ctor_info(ground(Uniq, yes(PredInstInfo0)), Type, _Ctors, ModuleInfo, - ground(Uniq, yes(PredInstInfo))) :- +propagate_ctor_info(ground(Uniq, higher_order(PredInstInfo0)), Type, _Ctors, + ModuleInfo, ground(Uniq, higher_order(PredInstInfo))) :- PredInstInfo0 = pred_inst_info(PredOrFunc, Modes0, Det), PredInstInfo = pred_inst_info(PredOrFunc, Modes, Det), ( @@ -686,6 +704,8 @@ propagate_ctor_info(ground(Uniq, yes(PredInstInfo0)), Type, _Ctors, ModuleInfo, Modes = Modes0 ). +propagate_ctor_info(ground(Uniq, constrained_inst_var(Var)), _, _, _, + ground(Uniq, constrained_inst_var(Var))). propagate_ctor_info(not_reached, _Type, _Constructors, _ModuleInfo, not_reached). propagate_ctor_info(inst_var(V), _, _, _, inst_var(V)). @@ -717,12 +737,13 @@ propagate_ctor_info_lazily(bound(Uniq, BoundInsts0), Type0, Subst, % XXX do we need to sort the BoundInsts? Inst = bound(Uniq, BoundInsts) ). -propagate_ctor_info_lazily(ground(Uniq, no), Type0, Subst, ModuleInfo, Inst) :- +propagate_ctor_info_lazily(ground(Uniq, none), Type0, Subst, ModuleInfo, Inst) + :- apply_type_subst(Type0, Subst, Type), ( type_is_higher_order(Type, function, _, ArgTypes) -> default_higher_order_func_inst(ArgTypes, ModuleInfo, HigherOrderInstInfo), - Inst = ground(Uniq, yes(HigherOrderInstInfo)) + Inst = ground(Uniq, higher_order(HigherOrderInstInfo)) ; % XXX The information added by this is not yet used, % so it's disabled since it unnecessarily complicates @@ -730,11 +751,11 @@ propagate_ctor_info_lazily(ground(Uniq, no), Type0, Subst, ModuleInfo, Inst) :- /********* Inst = defined_inst(typed_ground(Uniq, Type)) *********/ - Inst = ground(Uniq, no) + Inst = ground(Uniq, none) ). -propagate_ctor_info_lazily(ground(Uniq, yes(PredInstInfo0)), Type0, Subst, - ModuleInfo, ground(Uniq, yes(PredInstInfo))) :- +propagate_ctor_info_lazily(ground(Uniq, higher_order(PredInstInfo0)), Type0, + Subst, ModuleInfo, ground(Uniq, higher_order(PredInstInfo))) :- PredInstInfo0 = pred_inst_info(PredOrFunc, Modes0, Det), PredInstInfo = pred_inst_info(PredOrFunc, Modes, Det), apply_type_subst(Type0, Subst, Type), @@ -751,6 +772,8 @@ propagate_ctor_info_lazily(ground(Uniq, yes(PredInstInfo0)), Type0, Subst, % be reported if anything tries to match with the inst. Modes = Modes0 ). +propagate_ctor_info_lazily(ground(Uniq, constrained_inst_var(Var)), _, _, _, + ground(Uniq, constrained_inst_var(Var))). propagate_ctor_info_lazily(not_reached, _Type, _, _ModuleInfo, not_reached). propagate_ctor_info_lazily(inst_var(Var), _, _, _, inst_var(Var)). propagate_ctor_info_lazily(abstract_inst(Name, Args), _, _, _, @@ -782,8 +805,8 @@ propagate_ctor_info_lazily(defined_inst(InstName0), Type0, Subst, _, :- mode default_higher_order_func_inst(in, in, out) is det. default_higher_order_func_inst(PredArgTypes, ModuleInfo, PredInstInfo) :- - In = (ground(shared, no) -> ground(shared, no)), - Out = (free -> ground(shared, no)), + In = (ground(shared, none) -> ground(shared, none)), + Out = (free -> ground(shared, none)), list__length(PredArgTypes, NumPredArgs), NumFuncArgs is NumPredArgs - 1, list__duplicate(NumFuncArgs, In, FuncArgModes), @@ -815,7 +838,7 @@ ctor_arg_list_to_inst_list([_Name - _Type | Args], Uniq, [Inst | Insts]) :- % The information added by this is not yet used, so it's disabled % since it unnecessarily complicates the insts. % Inst = defined_inst(typed_ground(Uniq, Type)), - Inst = ground(Uniq, no), + Inst = ground(Uniq, none), ctor_arg_list_to_inst_list(Args, Uniq, Insts). :- pred propagate_ctor_info_2(list(bound_inst), (type), module_info, @@ -918,7 +941,7 @@ apply_type_subst(Type0, Subst, Type) :- %-----------------------------------------------------------------------------% -:- pred inst_lookup_subst_args(hlds_inst_body, list(inst_param), sym_name, +:- pred inst_lookup_subst_args(hlds_inst_body, list(inst_var), sym_name, list(inst), inst). :- mode inst_lookup_subst_args(in, in, in, in, out) is det. @@ -959,7 +982,7 @@ mode_get_insts(ModuleInfo, Mode, Inst1, Inst2) :- % occurrences of Params in Mode0 with the corresponding % value in Args. -:- pred mode_substitute_arg_list(mode, list(inst_param), list(inst), mode). +:- pred mode_substitute_arg_list(mode, list(inst_var), list(inst), mode). :- mode mode_substitute_arg_list(in, in, in, out) is det. mode_substitute_arg_list(Mode0, Params, Args, Mode) :- @@ -975,7 +998,7 @@ mode_substitute_arg_list(Mode0, Params, Args, Mode) :- % occurrences of Params in Inst0 with the corresponding % value in Args. -:- pred inst_substitute_arg_list(inst, list(inst_param), list(inst), inst). +:- pred inst_substitute_arg_list(inst, list(inst_var), list(inst), inst). :- mode inst_substitute_arg_list(in, in, in, out) is det. inst_substitute_arg_list(Inst0, Params, Args, Inst) :- @@ -989,9 +1012,7 @@ inst_substitute_arg_list(Inst0, Params, Args, Inst) :- % mode_apply_substitution(Mode0, Subst, Mode) is true iff % Mode is the mode that results from apply Subst to Mode0. -:- type inst_subst == map(inst_param, inst). - -:- pred mode_apply_substitution(mode, inst_subst, mode). +:- pred mode_apply_substitution(mode, inst_var_sub, mode). :- mode mode_apply_substitution(in, in, out) is det. mode_apply_substitution((I0 -> F0), Subst, (I -> F)) :- @@ -999,39 +1020,44 @@ mode_apply_substitution((I0 -> F0), Subst, (I -> F)) :- inst_apply_substitution(F0, Subst, F). mode_apply_substitution(user_defined_mode(Name, Args0), Subst, user_defined_mode(Name, Args)) :- - inst_list_apply_substitution(Args0, Subst, Args). + inst_list_apply_substitution_2(Args0, Subst, Args). % inst_list_apply_substitution(Insts0, Subst, Insts) is true % iff Inst is the inst that results from applying Subst to Insts0. -:- pred inst_list_apply_substitution(list(inst), inst_subst, list(inst)). -:- mode inst_list_apply_substitution(in, in, out) is det. +inst_list_apply_substitution(Insts0, Subst, Insts) :- + ( map__is_empty(Subst) -> + Insts = Insts0 + ; + inst_list_apply_substitution_2(Insts0, Subst, Insts) + ). + +:- pred inst_list_apply_substitution_2(list(inst), inst_var_sub, list(inst)). +:- mode inst_list_apply_substitution_2(in, in, out) is det. -inst_list_apply_substitution([], _, []). -inst_list_apply_substitution([A0 | As0], Subst, [A | As]) :- +inst_list_apply_substitution_2([], _, []). +inst_list_apply_substitution_2([A0 | As0], Subst, [A | As]) :- inst_apply_substitution(A0, Subst, A), - inst_list_apply_substitution(As0, Subst, As). + inst_list_apply_substitution_2(As0, Subst, As). % inst_substitute_arg(Inst0, Subst, Inst) is true % iff Inst is the inst that results from substituting all % occurrences of Param in Inst0 with Arg. -:- pred inst_apply_substitution(inst, inst_subst, inst). +:- pred inst_apply_substitution(inst, inst_var_sub, inst). :- mode inst_apply_substitution(in, in, out) is det. inst_apply_substitution(any(Uniq), _, any(Uniq)). inst_apply_substitution(free, _, free). inst_apply_substitution(free(T), _, free(T)). -inst_apply_substitution(ground(Uniq, PredStuff0), Subst, - ground(Uniq, PredStuff)) :- - maybe_pred_inst_apply_substitution(PredStuff0, Subst, PredStuff). +inst_apply_substitution(ground(Uniq, GroundInstInfo0), Subst, Inst) :- + ground_inst_info_apply_substitution(GroundInstInfo0, Subst, Uniq, Inst). inst_apply_substitution(bound(Uniq, Alts0), Subst, bound(Uniq, Alts)) :- alt_list_apply_substitution(Alts0, Subst, Alts). inst_apply_substitution(not_reached, _, not_reached). inst_apply_substitution(inst_var(Var), Subst, Result) :- ( - % XXX should params be vars? - map__search(Subst, term__variable(Var), Replacement) + map__search(Subst, Var, Replacement) -> Result = Replacement ; @@ -1039,72 +1065,149 @@ inst_apply_substitution(inst_var(Var), Subst, Result) :- ). inst_apply_substitution(defined_inst(InstName0), Subst, defined_inst(InstName)) :- - inst_name_apply_substitution(InstName0, Subst, InstName). + ( inst_name_apply_substitution(InstName0, Subst, InstName1) -> + InstName = InstName1 + ; + InstName = InstName0 + ). inst_apply_substitution(abstract_inst(Name, Args0), Subst, abstract_inst(Name, Args)) :- - inst_list_apply_substitution(Args0, Subst, Args). + inst_list_apply_substitution_2(Args0, Subst, Args). -:- pred inst_name_apply_substitution(inst_name, inst_subst, inst_name). -:- mode inst_name_apply_substitution(in, in, out) is det. + % This predicate fails if the inst_name is not one of user_inst, + % typed_inst or typed_ground. The other types of inst_names are just + % used as keys in the inst_table so it does not make sense to apply + % substitutions to them. +:- pred inst_name_apply_substitution(inst_name, inst_var_sub, inst_name). +:- mode inst_name_apply_substitution(in, in, out) is semidet. inst_name_apply_substitution(user_inst(Name, Args0), Subst, user_inst(Name, Args)) :- - inst_list_apply_substitution(Args0, Subst, Args). -inst_name_apply_substitution(unify_inst(Live, InstA0, InstB0, Real), Subst, - unify_inst(Live, InstA, InstB, Real)) :- - inst_apply_substitution(InstA0, Subst, InstA), - inst_apply_substitution(InstB0, Subst, InstB). -inst_name_apply_substitution(merge_inst(InstA0, InstB0), Subst, - merge_inst(InstA, InstB)) :- - inst_apply_substitution(InstA0, Subst, InstA), - inst_apply_substitution(InstB0, Subst, InstB). -inst_name_apply_substitution(ground_inst(Inst0, IsLive, Uniq, Real), Subst, - ground_inst(Inst, IsLive, Uniq, Real)) :- - inst_name_apply_substitution(Inst0, Subst, Inst). -inst_name_apply_substitution(any_inst(Inst0, IsLive, Uniq, Real), Subst, - any_inst(Inst, IsLive, Uniq, Real)) :- - inst_name_apply_substitution(Inst0, Subst, Inst). -inst_name_apply_substitution(shared_inst(InstName0), Subst, - shared_inst(InstName)) :- - inst_name_apply_substitution(InstName0, Subst, InstName). -inst_name_apply_substitution(mostly_uniq_inst(InstName0), Subst, - mostly_uniq_inst(InstName)) :- - inst_name_apply_substitution(InstName0, Subst, InstName). + inst_list_apply_substitution_2(Args0, Subst, Args). inst_name_apply_substitution(typed_inst(T, Inst0), Subst, typed_inst(T, Inst)) :- inst_name_apply_substitution(Inst0, Subst, Inst). inst_name_apply_substitution(typed_ground(Uniq, T), _, typed_ground(Uniq, T)). -:- pred alt_list_apply_substitution(list(bound_inst), inst_subst, +:- pred alt_list_apply_substitution(list(bound_inst), inst_var_sub, list(bound_inst)). :- mode alt_list_apply_substitution(in, in, out) is det. alt_list_apply_substitution([], _, []). alt_list_apply_substitution([Alt0|Alts0], Subst, [Alt|Alts]) :- Alt0 = functor(Name, Args0), - inst_list_apply_substitution(Args0, Subst, Args), + inst_list_apply_substitution_2(Args0, Subst, Args), Alt = functor(Name, Args), alt_list_apply_substitution(Alts0, Subst, Alts). -:- pred maybe_pred_inst_apply_substitution(maybe(pred_inst_info), inst_subst, - maybe(pred_inst_info)). -:- mode maybe_pred_inst_apply_substitution(in, in, out) is det. +:- pred ground_inst_info_apply_substitution(ground_inst_info, inst_var_sub, + uniqueness, inst). +:- mode ground_inst_info_apply_substitution(in, in, in, out) is det. -maybe_pred_inst_apply_substitution(no, _, no). -maybe_pred_inst_apply_substitution(yes(pred_inst_info(PredOrFunc, Modes0, Det)), - Subst, yes(pred_inst_info(PredOrFunc, Modes, Det))) :- - mode_list_apply_substitution(Modes0, Subst, Modes). +ground_inst_info_apply_substitution(none, _, Uniq, ground(Uniq, none)). +ground_inst_info_apply_substitution(GII0, Subst, Uniq, ground(Uniq, GII)) :- + GII0 = higher_order(pred_inst_info(PredOrFunc, Modes0, Det)), + mode_list_apply_substitution(Modes0, Subst, Modes), + GII = higher_order(pred_inst_info(PredOrFunc, Modes, Det)). +ground_inst_info_apply_substitution(constrained_inst_var(Var), Subst, Uniq, + Inst) :- + ( + map__search(Subst, Var, Inst0) + -> + Inst = Inst0 + ; + Inst = ground(Uniq, constrained_inst_var(Var)) + ). % mode_list_apply_substitution(Modes0, Subst, Modes) is true % iff Mode is the mode that results from applying Subst to Modes0. -:- pred mode_list_apply_substitution(list(mode), inst_subst, list(mode)). -:- mode mode_list_apply_substitution(in, in, out) is det. +mode_list_apply_substitution(Modes0, Subst, Modes) :- + ( map__is_empty(Subst) -> + Modes = Modes0 + ; + mode_list_apply_substitution_2(Modes0, Subst, Modes) + ). -mode_list_apply_substitution([], _, []). -mode_list_apply_substitution([A0 | As0], Subst, [A | As]) :- +:- pred mode_list_apply_substitution_2(list(mode), inst_var_sub, list(mode)). +:- mode mode_list_apply_substitution_2(in, in, out) is det. + +mode_list_apply_substitution_2([], _, []). +mode_list_apply_substitution_2([A0 | As0], Subst, [A | As]) :- mode_apply_substitution(A0, Subst, A), - mode_list_apply_substitution(As0, Subst, As). + mode_list_apply_substitution_2(As0, Subst, As). + +%-----------------------------------------------------------------------------% + +rename_apart_inst_vars(VarSet, NewVarSet, Modes0, Modes) :- + varset__merge_subst(VarSet, NewVarSet, _, Sub), + list__map(rename_apart_inst_vars_in_mode(Sub), Modes0, Modes). + +:- pred rename_apart_inst_vars_in_mode(substitution(inst_var_type), mode, mode). +:- mode rename_apart_inst_vars_in_mode(in, in, out) is det. + +rename_apart_inst_vars_in_mode(Sub, I0 -> F0, I -> F) :- + rename_apart_inst_vars_in_inst(Sub, I0, I), + rename_apart_inst_vars_in_inst(Sub, F0, F). +rename_apart_inst_vars_in_mode(Sub, user_defined_mode(Name, Insts0), + user_defined_mode(Name, Insts)) :- + list__map(rename_apart_inst_vars_in_inst(Sub), Insts0, Insts). + +:- pred rename_apart_inst_vars_in_inst(substitution(inst_var_type), inst, inst). +:- mode rename_apart_inst_vars_in_inst(in, in, out) is det. + +rename_apart_inst_vars_in_inst(_, any(U), any(U)). +rename_apart_inst_vars_in_inst(_, free, free). +rename_apart_inst_vars_in_inst(_, free(T), free(T)). +rename_apart_inst_vars_in_inst(Sub, bound(U, BIs0), bound(U, BIs)) :- + list__map((pred(functor(C, Is0)::in, functor(C, Is)::out) is det :- + list__map(rename_apart_inst_vars_in_inst(Sub), Is0, Is)), + BIs0, BIs). +rename_apart_inst_vars_in_inst(Sub, ground(U, GI0), ground(U, GI)) :- + ( + GI0 = higher_order(pred_inst_info(PoF, Modes0, Det)), + list__map(rename_apart_inst_vars_in_mode(Sub), Modes0, Modes), + GI = higher_order(pred_inst_info(PoF, Modes, Det)) + ; + GI0 = constrained_inst_var(V0), + ( map__search(Sub, V0, term__variable(V)) -> + GI = constrained_inst_var(V) + ; + GI = GI0 + ) + ; + GI0 = none, + GI = none + ). +rename_apart_inst_vars_in_inst(_, not_reached, not_reached). +rename_apart_inst_vars_in_inst(Sub, inst_var(V0), inst_var(V)) :- + ( map__search(Sub, V0, term__variable(V1)) -> + V = V1 + ; + V = V0 + ). +rename_apart_inst_vars_in_inst(Sub, defined_inst(Name0), defined_inst(Name)) :- + ( rename_apart_inst_vars_in_inst_name(Sub, Name0, Name1) -> + Name = Name1 + ; + Name = Name0 + ). +rename_apart_inst_vars_in_inst(Sub, abstract_inst(Sym, Insts0), + abstract_inst(Sym, Insts)) :- + list__map(rename_apart_inst_vars_in_inst(Sub), Insts0, Insts). + +:- pred rename_apart_inst_vars_in_inst_name(substitution(inst_var_type), + inst_name, inst_name). +:- mode rename_apart_inst_vars_in_inst_name(in, in, out) is semidet. + +rename_apart_inst_vars_in_inst_name(Sub, user_inst(Sym, Insts0), + user_inst(Sym, Insts)) :- + list__map(rename_apart_inst_vars_in_inst(Sub), Insts0, Insts). +rename_apart_inst_vars_in_inst_name(Sub, typed_inst(Type, Name0), + typed_inst(Type, Name)) :- + rename_apart_inst_vars_in_inst_name(Sub, Name0, Name). +rename_apart_inst_vars_in_inst_name(_, typed_ground(U, T), typed_ground(U, T)). + %-----------------------------------------------------------------------------% @@ -1130,55 +1233,75 @@ recompute_instmap_delta_proc(RecomputeAtomic, ProcInfo0, ProcInfo) --> { proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InstMap0) }, { proc_info_vartypes(ProcInfo0, VarTypes) }, { proc_info_goal(ProcInfo0, Goal0) }, + { proc_info_inst_varset(ProcInfo0, InstVarSet) }, recompute_instmap_delta(RecomputeAtomic, Goal0, Goal, - VarTypes, InstMap0, _), + VarTypes, InstVarSet, InstMap0), { proc_info_set_goal(ProcInfo0, Goal, ProcInfo) }. -recompute_instmap_delta(RecomputeAtomic, Goal0, Goal, VarTypes, InstMap0) --> - recompute_instmap_delta(RecomputeAtomic, Goal0, Goal, VarTypes, - InstMap0, _). +recompute_instmap_delta(RecomputeAtomic, Goal0, Goal, VarTypes, InstVarSet, + InstMap0, ModuleInfo0, ModuleInfo) :- + RI0 = recompute_info(ModuleInfo0, InstVarSet), + recompute_instmap_delta_1(RecomputeAtomic, Goal0, Goal, VarTypes, + InstMap0, _, RI0, RI), + ModuleInfo = RI^module_info. -:- pred recompute_instmap_delta(bool::in, hlds_goal::in, hlds_goal::out, - vartypes::in, instmap::in, instmap_delta::out, - module_info::in, module_info::out) is det. +:- pred recompute_instmap_delta_1(bool, hlds_goal, hlds_goal, vartypes, + instmap, instmap_delta, recompute_info, recompute_info). +:- mode recompute_instmap_delta_1(in, in, out, in, in, out, in, out) is det. -recompute_instmap_delta(RecomputeAtomic, Goal0 - GoalInfo0, Goal - GoalInfo, - VarTypes, InstMap0, InstMapDelta) --> +recompute_instmap_delta_1(RecomputeAtomic, Goal0 - GoalInfo0, Goal - GoalInfo, + VarTypes, InstMap0, InstMapDelta, RI0, RI) :- ( - { RecomputeAtomic = no }, - ( - { goal_is_atomic(Goal0) } - ; + RecomputeAtomic = no, + goal_is_atomic(Goal0), + Goal0 \= unify(_,lambda_goal(_,_,_,_,_,_,_,_),_,_,_) % Lambda expressions always need to be processed. - { Goal0 = unify(_, Rhs, _, _, _) }, - { Rhs \= lambda_goal(_, _, _, _, _, _, _, _) } - ) -> - { Goal = Goal0 }, - { GoalInfo1 = GoalInfo0 } + Goal = Goal0, + GoalInfo1 = GoalInfo0, + RI0 = RI ; - recompute_instmap_delta_2(RecomputeAtomic, Goal0, - GoalInfo0, Goal, VarTypes, InstMap0, InstMapDelta0), - { goal_info_get_nonlocals(GoalInfo0, NonLocals) }, - { instmap_delta_restrict(InstMapDelta0, NonLocals, - InstMapDelta1) }, - { goal_info_set_instmap_delta(GoalInfo0, InstMapDelta1, - GoalInfo1) } + recompute_instmap_delta_2(RecomputeAtomic, Goal0, GoalInfo0, + Goal, VarTypes, InstMap0, InstMapDelta0, RI0, RI), + goal_info_get_nonlocals(GoalInfo0, NonLocals), + instmap_delta_restrict(InstMapDelta0, + NonLocals, InstMapDelta1), + goal_info_set_instmap_delta(GoalInfo0, + InstMapDelta1, GoalInfo1) ), % If the initial instmap is unreachable so is the final instmap. - ( { instmap__is_unreachable(InstMap0) } -> - { instmap_delta_init_unreachable(UnreachableInstMapDelta) }, - { goal_info_set_instmap_delta(GoalInfo1, - UnreachableInstMapDelta, GoalInfo) } + ( instmap__is_unreachable(InstMap0) -> + instmap_delta_init_unreachable(UnreachableInstMapDelta), + goal_info_set_instmap_delta(GoalInfo1, + UnreachableInstMapDelta, GoalInfo) ; - { GoalInfo = GoalInfo1 } + GoalInfo = GoalInfo1 ), - { goal_info_get_instmap_delta(GoalInfo, InstMapDelta) }. + goal_info_get_instmap_delta(GoalInfo, InstMapDelta). -:- pred recompute_instmap_delta_2(bool::in, hlds_goal_expr::in, - hlds_goal_info::in, hlds_goal_expr::out, vartypes::in, instmap::in, - instmap_delta::out, module_info::in, module_info::out) is det. +:- type recompute_info + ---> recompute_info( + module_info :: module_info, + inst_varset :: inst_varset + ). + + % update_module_info(P, R, RI0, RI) will call predicate P, passing it + % the module_info from RI0 and placing the output module_info in RI. + % The output of P's first argument is returned in R. +:- pred update_module_info(pred(T, module_info, module_info), T, + recompute_info, recompute_info). +:- mode update_module_info(pred(out, in, out) is det, out, in, out) is det. + +update_module_info(P, R) --> + ModuleInfo0 =^ module_info, + { P(R, ModuleInfo0, ModuleInfo) }, + ^module_info := ModuleInfo. + +:- pred recompute_instmap_delta_2(bool, hlds_goal_expr, hlds_goal_info, + hlds_goal_expr, vartypes, instmap, instmap_delta, + recompute_info, recompute_info). +:- mode recompute_instmap_delta_2(in, in, in, out, in, in, out, in, out) is det. recompute_instmap_delta_2(Atomic, switch(Var, Det, Cases0, SM), GoalInfo, switch(Var, Det, Cases, SM), VarTypes, InstMap, InstMapDelta) @@ -1207,42 +1330,42 @@ recompute_instmap_delta_2(Atomic, disj(Goals0, SM), GoalInfo, disj(Goals, SM), recompute_instmap_delta_2(Atomic, not(Goal0), _, not(Goal), VarTypes, InstMap, InstMapDelta) --> { instmap_delta_init_reachable(InstMapDelta) }, - recompute_instmap_delta(Atomic, Goal0, Goal, VarTypes, InstMap, _). + recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes, InstMap, _). recompute_instmap_delta_2(Atomic, if_then_else(Vars, A0, B0, C0, SM), GoalInfo, if_then_else(Vars, A, B, C, SM), VarTypes, InstMap0, InstMapDelta) --> - recompute_instmap_delta(Atomic, A0, A, VarTypes, InstMap0, + recompute_instmap_delta_1(Atomic, A0, A, VarTypes, InstMap0, InstMapDelta1), { instmap__apply_instmap_delta(InstMap0, InstMapDelta1, InstMap1) }, - recompute_instmap_delta(Atomic, B0, B, VarTypes, InstMap1, + recompute_instmap_delta_1(Atomic, B0, B, VarTypes, InstMap1, InstMapDelta2), - recompute_instmap_delta(Atomic, C0, C, VarTypes, InstMap0, + recompute_instmap_delta_1(Atomic, C0, C, VarTypes, InstMap0, InstMapDelta3), { instmap_delta_apply_instmap_delta(InstMapDelta1, InstMapDelta2, InstMapDelta4) }, { goal_info_get_nonlocals(GoalInfo, NonLocals) }, - merge_instmap_delta(InstMap0, NonLocals, InstMapDelta3, - InstMapDelta4, InstMapDelta). + update_module_info(merge_instmap_delta(InstMap0, NonLocals, + InstMapDelta3, InstMapDelta4), InstMapDelta). recompute_instmap_delta_2(Atomic, some(Vars, CanRemove, Goal0), _, - some(Vars, CanRemove, Goal), VarTypes, InstMap, InstMapDelta) - --> - recompute_instmap_delta(Atomic, Goal0, Goal, VarTypes, - InstMap, InstMapDelta). + some(Vars, CanRemove, Goal), + VarTypes, InstMap, InstMapDelta) --> + recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes, InstMap, + InstMapDelta). recompute_instmap_delta_2(_, generic_call(A, Vars, Modes, D), _, - generic_call(A, Vars, Modes, D), _VarTypes, _InstMap, - InstMapDelta) --> - =(ModuleInfo), + generic_call(A, Vars, Modes, D), + _VarTypes, _InstMap, InstMapDelta) --> + ModuleInfo =^ module_info, { instmap_delta_from_mode_list(Vars, Modes, ModuleInfo, InstMapDelta) }. recompute_instmap_delta_2(_, call(PredId, ProcId, Args, D, E, F), _, - call(PredId, ProcId, Args, D, E, F), _VarTypes, + call(PredId, ProcId, Args, D, E, F), VarTypes, InstMap, InstMapDelta) --> recompute_instmap_delta_call(PredId, ProcId, - Args, InstMap, InstMapDelta). + Args, VarTypes, InstMap, InstMapDelta). recompute_instmap_delta_2(Atomic, unify(A, Rhs0, UniMode0, Uni, E), GoalInfo, unify(A, Rhs, UniMode, Uni, E), VarTypes, InstMap0, @@ -1251,10 +1374,10 @@ recompute_instmap_delta_2(Atomic, unify(A, Rhs0, UniMode0, Uni, E), GoalInfo, { Rhs0 = lambda_goal(PorF, EvalMethod, FixModes, NonLocals, LambdaVars, Modes, Det, Goal0) } -> - =(ModuleInfo0), + ModuleInfo0 =^ module_info, { instmap__pre_lambda_update(ModuleInfo0, LambdaVars, Modes, InstMap0, InstMap) }, - recompute_instmap_delta(Atomic, Goal0, Goal, VarTypes, + recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes, InstMap, _), { Rhs = lambda_goal(PorF, EvalMethod, FixModes, NonLocals, LambdaVars, Modes, Det, Goal) } @@ -1272,9 +1395,9 @@ recompute_instmap_delta_2(Atomic, unify(A, Rhs0, UniMode0, Uni, E), GoalInfo, recompute_instmap_delta_2(_, pragma_foreign_code(A, B, PredId, ProcId, Args, F, G, H), _, pragma_foreign_code(A, B, PredId, ProcId, Args, F, G, H), - _VarTypes, InstMap, InstMapDelta) --> + VarTypes, InstMap, InstMapDelta) --> recompute_instmap_delta_call(PredId, ProcId, - Args, InstMap, InstMapDelta). + Args, VarTypes, InstMap, InstMapDelta). recompute_instmap_delta_2(_, bi_implication(_, _), _, _, _, _, _) --> % these should have been expanded out by now @@ -1284,14 +1407,14 @@ recompute_instmap_delta_2(_, bi_implication(_, _), _, _, _, _, _) --> :- pred recompute_instmap_delta_conj(bool::in, list(hlds_goal)::in, list(hlds_goal)::out, vartypes::in, instmap::in, instmap_delta::out, - module_info::in, module_info::out) is det. + recompute_info::in, recompute_info::out) is det. recompute_instmap_delta_conj(_, [], [], _, _, InstMapDelta) --> { instmap_delta_init_reachable(InstMapDelta) }. recompute_instmap_delta_conj(Atomic, [Goal0 | Goals0], [Goal | Goals], VarTypes, InstMap0, InstMapDelta) --> - recompute_instmap_delta(Atomic, Goal0, Goal, VarTypes, InstMap0, - InstMapDelta0), + recompute_instmap_delta_1(Atomic, Goal0, Goal, + VarTypes, InstMap0, InstMapDelta0), { instmap__apply_instmap_delta(InstMap0, InstMapDelta0, InstMap1) }, recompute_instmap_delta_conj(Atomic, Goals0, Goals, VarTypes, InstMap1, InstMapDelta1), @@ -1302,49 +1425,49 @@ recompute_instmap_delta_conj(Atomic, [Goal0 | Goals0], [Goal | Goals], :- pred recompute_instmap_delta_disj(bool::in, list(hlds_goal)::in, list(hlds_goal)::out, vartypes::in, instmap::in, set(prog_var)::in, - instmap_delta::out, module_info::in, module_info::out) is det. + instmap_delta::out, recompute_info::in, recompute_info::out) is det. recompute_instmap_delta_disj(_, [], [], _, _, _, InstMapDelta) --> { instmap_delta_init_unreachable(InstMapDelta) }. -recompute_instmap_delta_disj(Atomic, [Goal0], [Goal], VarTypes, InstMap, - _, InstMapDelta) --> - recompute_instmap_delta(Atomic, Goal0, Goal, VarTypes, InstMap, +recompute_instmap_delta_disj(Atomic, [Goal0], [Goal], + VarTypes, InstMap, _, InstMapDelta) --> + recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes, InstMap, InstMapDelta). recompute_instmap_delta_disj(Atomic, [Goal0 | Goals0], [Goal | Goals], VarTypes, InstMap, NonLocals, InstMapDelta) --> { Goals0 = [_|_] }, - recompute_instmap_delta(Atomic, Goal0, Goal, VarTypes, InstMap, - InstMapDelta0), + recompute_instmap_delta_1(Atomic, Goal0, Goal, + VarTypes, InstMap, InstMapDelta0), recompute_instmap_delta_disj(Atomic, Goals0, Goals, VarTypes, InstMap, NonLocals, InstMapDelta1), - merge_instmap_delta(InstMap, NonLocals, InstMapDelta0, - InstMapDelta1, InstMapDelta). + update_module_info(merge_instmap_delta(InstMap, NonLocals, + InstMapDelta0, InstMapDelta1), InstMapDelta). :- pred recompute_instmap_delta_par_conj(bool::in, list(hlds_goal)::in, list(hlds_goal)::out, vartypes::in, instmap::in, set(prog_var)::in, - instmap_delta::out, module_info::in, module_info::out) is det. + instmap_delta::out, recompute_info::in, recompute_info::out) is det. recompute_instmap_delta_par_conj(_, [], [], _, _, _, InstMapDelta) --> { instmap_delta_init_unreachable(InstMapDelta) }. -recompute_instmap_delta_par_conj(Atomic, [Goal0], [Goal], VarTypes, InstMap, - _, InstMapDelta) --> - recompute_instmap_delta(Atomic, Goal0, Goal, VarTypes, InstMap, +recompute_instmap_delta_par_conj(Atomic, [Goal0], [Goal], + VarTypes, InstMap, _, InstMapDelta) --> + recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes, InstMap, InstMapDelta). recompute_instmap_delta_par_conj(Atomic, [Goal0 | Goals0], [Goal | Goals], VarTypes, InstMap, NonLocals, InstMapDelta) --> { Goals0 = [_|_] }, - recompute_instmap_delta(Atomic, Goal0, Goal, VarTypes, InstMap, - InstMapDelta0), - recompute_instmap_delta_par_conj(Atomic, Goals0, Goals, VarTypes, - InstMap, NonLocals, InstMapDelta1), - unify_instmap_delta(InstMap, NonLocals, InstMapDelta0, - InstMapDelta1, InstMapDelta). + recompute_instmap_delta_1(Atomic, Goal0, Goal, + VarTypes, InstMap, InstMapDelta0), + recompute_instmap_delta_par_conj(Atomic, Goals0, Goals, + VarTypes, InstMap, NonLocals, InstMapDelta1), + update_module_info(unify_instmap_delta(InstMap, NonLocals, + InstMapDelta0, InstMapDelta1), InstMapDelta). %-----------------------------------------------------------------------------% :- pred recompute_instmap_delta_cases(bool::in, prog_var::in, list(case)::in, list(case)::out, vartypes::in, instmap::in, set(prog_var)::in, - instmap_delta::out, module_info::in, module_info::out) is det. + instmap_delta::out, recompute_info::in, recompute_info::out) is det. recompute_instmap_delta_cases(_, _, [], [], _, _, _, InstMapDelta) --> { instmap_delta_init_unreachable(InstMapDelta) }. @@ -1352,38 +1475,91 @@ recompute_instmap_delta_cases(Atomic, Var, [Case0 | Cases0], [Case | Cases], VarTypes, InstMap0, NonLocals, InstMapDelta) --> { Case0 = case(Functor, Goal0) }, { map__lookup(VarTypes, Var, Type) }, - instmap__bind_var_to_functor(Var, Type, Functor, InstMap0, InstMap), - recompute_instmap_delta(Atomic, Goal0, Goal, VarTypes, - InstMap, InstMapDelta0), - instmap_delta_bind_var_to_functor(Var, Type, Functor, - InstMap0, InstMapDelta0, InstMapDelta1), + update_module_info(instmap__bind_var_to_functor(Var, Type, Functor, + InstMap0), InstMap), + recompute_instmap_delta_1(Atomic, Goal0, Goal, VarTypes, InstMap, + InstMapDelta0), + update_module_info(instmap_delta_bind_var_to_functor(Var, Type, Functor, + InstMap0, InstMapDelta0), InstMapDelta1), { Case = case(Functor, Goal) }, recompute_instmap_delta_cases(Atomic, Var, Cases0, Cases, VarTypes, InstMap0, NonLocals, InstMapDelta2), - merge_instmap_delta(InstMap0, NonLocals, InstMapDelta1, - InstMapDelta2, InstMapDelta). + update_module_info(merge_instmap_delta(InstMap0, NonLocals, + InstMapDelta1, InstMapDelta2), InstMapDelta). %-----------------------------------------------------------------------------% :- pred recompute_instmap_delta_call(pred_id::in, proc_id::in, - list(prog_var)::in, instmap::in, instmap_delta::out, - module_info::in, module_info::out) is det. + list(prog_var)::in, vartypes::in, instmap::in, instmap_delta::out, + recompute_info::in, recompute_info::out) is det. -recompute_instmap_delta_call(PredId, ProcId, Args, InstMap, - InstMapDelta, ModuleInfo0, ModuleInfo) :- - module_info_pred_proc_info(ModuleInfo0, PredId, ProcId, _, ProcInfo), - proc_info_interface_determinism(ProcInfo, Detism), - ( determinism_components(Detism, _, at_most_zero) -> - instmap_delta_init_unreachable(InstMapDelta), - ModuleInfo = ModuleInfo0 +recompute_instmap_delta_call(PredId, ProcId, Args, VarTypes, InstMap, + InstMapDelta) --> + ModuleInfo =^ module_info, + { module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _, ProcInfo) }, + { proc_info_interface_determinism(ProcInfo, Detism) }, + ( { determinism_components(Detism, _, at_most_zero) } -> + { instmap_delta_init_unreachable(InstMapDelta) } ; - proc_info_argmodes(ProcInfo, ArgModes0), - recompute_instmap_delta_call_2(Args, InstMap, - ArgModes0, ArgModes, ModuleInfo0, ModuleInfo), - instmap_delta_from_mode_list(Args, ArgModes, - ModuleInfo, InstMapDelta) + { proc_info_argmodes(ProcInfo, ArgModes0) }, + { proc_info_inst_varset(ProcInfo, ProcInstVarSet) }, + InstVarSet =^ inst_varset, + { rename_apart_inst_vars(InstVarSet, ProcInstVarSet, + ArgModes0, ArgModes1) }, + { mode_list_get_initial_insts(ArgModes1, ModuleInfo, + InitialInsts) }, + + % Compute the inst_var substitution from the initial insts + % of the called procedure and the insts of the argument + % variables. + { map__init(InstVarSub0) }, + update_module_info(compute_inst_var_sub(Args, VarTypes, InstMap, + InitialInsts, InstVarSub0), InstVarSub), + + % Apply the inst_var substitution to the argument modes. + { mode_list_apply_substitution(ArgModes1, InstVarSub, + ArgModes2) }, + + % Calculate the final insts of the argument variables + % from their initial insts and the final insts of the called + % procedure (with inst_var substitutions applied). + update_module_info(recompute_instmap_delta_call_2(Args, InstMap, + ArgModes2), ArgModes), + { instmap_delta_from_mode_list(Args, ArgModes, + ModuleInfo, InstMapDelta) } ). +:- pred compute_inst_var_sub(list(prog_var), vartypes, instmap, + list(inst), inst_var_sub, inst_var_sub, module_info, module_info). +:- mode compute_inst_var_sub(in, in, in, in, in, out, in, out) is det. + +compute_inst_var_sub([], _, _, [], Sub, Sub, ModuleInfo, ModuleInfo). +compute_inst_var_sub([_|_], _, _, [], _, _, _, _) :- + error("compute_inst_var_sub"). +compute_inst_var_sub([], _, _, [_|_], _, _, _, _) :- + error("compute_inst_var_sub"). +compute_inst_var_sub([Arg | Args], VarTypes, InstMap, [Inst | Insts], + Sub0, Sub, ModuleInfo0, ModuleInfo) :- + % This is similar to modecheck_var_has_inst. + ( instmap__is_reachable(InstMap) -> + instmap__lookup_var(InstMap, Arg, ArgInst), + map__lookup(VarTypes, Arg, Type), + ( + inst_matches_initial(ArgInst, Inst, Type, ModuleInfo0, + ModuleInfo1, Sub0, Sub1) + -> + ModuleInfo2 = ModuleInfo1, + Sub2 = Sub1 + ; + error("compute_inst_var_sub: inst_matches_initial failed") + ) + ; + ModuleInfo2 = ModuleInfo0, + Sub2 = Sub0 + ), + compute_inst_var_sub(Args, VarTypes, InstMap, Insts, Sub2, + Sub, ModuleInfo2, ModuleInfo). + :- pred recompute_instmap_delta_call_2(list(prog_var)::in, instmap::in, list(mode)::in, list(mode)::out, module_info::in, module_info::out) is det. @@ -1418,14 +1594,15 @@ recompute_instmap_delta_call_2([Arg | Args], InstMap, [Mode0 | Modes0], :- pred recompute_instmap_delta_unify(unification::in, unify_mode::in, unify_mode::out, hlds_goal_info::in, instmap::in, instmap_delta::out, - module_info::in, module_info::out) is det. + recompute_info::in, recompute_info::out) is det. recompute_instmap_delta_unify(Uni, UniMode0, UniMode, GoalInfo, - InstMap, InstMapDelta, ModuleInfo, ModuleInfo) :- + InstMap, InstMapDelta) --> % Deconstructions are the only types of unifications % that can require updating of the instmap_delta after simplify.m % has been run. - ( + ModuleInfo =^ module_info, + { Uni = deconstruct(Var, _ConsId, Vars, UniModes, _, _CanCGC) -> % Get the final inst of the deconstructed var, which @@ -1452,7 +1629,7 @@ recompute_instmap_delta_unify(Uni, UniMode0, UniMode, GoalInfo, ; goal_info_get_instmap_delta(GoalInfo, InstMapDelta), UniMode = UniMode0 - ). + }. %-----------------------------------------------------------------------------% @@ -1521,8 +1698,8 @@ strip_builtin_qualifiers_from_inst(not_reached, not_reached). strip_builtin_qualifiers_from_inst(free, free). strip_builtin_qualifiers_from_inst(free(Type), free(Type)). strip_builtin_qualifiers_from_inst(any(Uniq), any(Uniq)). -strip_builtin_qualifiers_from_inst(ground(Uniq, Pred0), ground(Uniq, Pred)) :- - strip_builtin_qualifiers_from_pred_inst(Pred0, Pred). +strip_builtin_qualifiers_from_inst(ground(Uniq, GII0), ground(Uniq, GII)) :- + strip_builtin_qualifiers_from_ground_inst_info(GII0, GII). strip_builtin_qualifiers_from_inst(bound(Uniq, BoundInsts0), bound(Uniq, BoundInsts)) :- strip_builtin_qualifiers_from_bound_inst_list(BoundInsts0, BoundInsts). @@ -1561,20 +1738,23 @@ strip_builtin_qualifiers_from_inst_name(InstName0, Inst0, Inst) :- strip_builtin_qualifiers_from_inst_name(InstName1, Inst0, Inst) ; InstName0 = typed_ground(Uniq, _Type) -> % Don't output the $typed_ground in error messages. - Inst = ground(Uniq, no) + Inst = ground(Uniq, none) ; % for the compiler-generated insts, don't bother. Inst = Inst0 ). -:- pred strip_builtin_qualifiers_from_pred_inst(maybe(pred_inst_info)::in, - maybe(pred_inst_info)::out) is det. +:- pred strip_builtin_qualifiers_from_ground_inst_info(ground_inst_info::in, + ground_inst_info::out) is det. -strip_builtin_qualifiers_from_pred_inst(no, no). -strip_builtin_qualifiers_from_pred_inst(yes(Pred0), yes(Pred)) :- +strip_builtin_qualifiers_from_ground_inst_info(none, none). +strip_builtin_qualifiers_from_ground_inst_info(higher_order(Pred0), + higher_order(Pred)) :- Pred0 = pred_inst_info(Uniq, Modes0, Det), Pred = pred_inst_info(Uniq, Modes, Det), strip_builtin_qualifiers_from_mode_list(Modes0, Modes). +strip_builtin_qualifiers_from_ground_inst_info(constrained_inst_var(Var), + constrained_inst_var(Var)). %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% @@ -1604,7 +1784,7 @@ normalise_inst(Inst0, Type, ModuleInfo, NormalisedInst) :- % in the number of inferred modes without any benefit \+ is_introduced_type_info_type(Type) -> - NormalisedInst = ground(unique, no) + NormalisedInst = ground(unique, none) ; inst_is_ground(ModuleInfo, Inst), inst_is_mostly_unique(ModuleInfo, Inst), @@ -1613,12 +1793,12 @@ normalise_inst(Inst0, Type, ModuleInfo, NormalisedInst) :- % in the number of inferred modes without any benefit \+ is_introduced_type_info_type(Type) -> - NormalisedInst = ground(mostly_unique, no) + NormalisedInst = ground(mostly_unique, none) ; inst_is_ground(ModuleInfo, Inst), \+ inst_is_clobbered(ModuleInfo, Inst) -> - NormalisedInst = ground(shared, no) + NormalisedInst = ground(shared, none) ; % XXX need to limit the potential size of insts % here in order to avoid infinite loops in diff --git a/compiler/modecheck_call.m b/compiler/modecheck_call.m index a9779b127..cd0e933be 100644 --- a/compiler/modecheck_call.m +++ b/compiler/modecheck_call.m @@ -73,7 +73,7 @@ :- import_module mode_info, mode_debug, modes, mode_util, mode_errors. :- import_module clause_to_proc, inst_match. :- import_module det_report, unify_proc. -:- import_module int, map, bool, set, require. +:- import_module int, map, bool, set, require, term, varset. modecheck_higher_order_call(PredOrFunc, PredVar, Args0, Modes, Det, Args, ExtraGoals, ModeInfo0, ModeInfo) :- @@ -87,7 +87,7 @@ modecheck_higher_order_call(PredOrFunc, PredVar, Args0, Modes, Det, inst_expand(ModuleInfo0, PredVarInst0, PredVarInst), list__length(Args0, Arity), ( - PredVarInst = ground(_Uniq, yes(PredInstInfo)), + PredVarInst = ground(_Uniq, higher_order(PredInstInfo)), PredInstInfo = pred_inst_info(PredOrFunc, Modes0, Det0), list__length(Modes0, Arity) -> @@ -167,8 +167,9 @@ modecheck_arg_list(ArgOffset, Modes, ExtraGoals, Args0, Args, % mode_list_get_initial_insts(Modes, ModuleInfo0, InitialInsts), modecheck_var_has_inst_list(Args0, InitialInsts, ArgOffset, - ModeInfo1, ModeInfo2), - mode_list_get_final_insts(Modes, ModuleInfo0, FinalInsts), + InstVarSub, ModeInfo1, ModeInfo2), + mode_list_get_final_insts(Modes, ModuleInfo0, FinalInsts0), + inst_list_apply_substitution(FinalInsts0, InstVarSub, FinalInsts), modecheck_set_var_inst_list(Args0, InitialInsts, FinalInsts, ArgOffset, Args, ExtraGoals, ModeInfo2, ModeInfo). @@ -232,14 +233,19 @@ modecheck_call_pred(PredId, ProcId0, ArgVars0, DeterminismKnown, % initial insts, and set their new final insts (introducing % extra unifications for implied modes, if necessary). % - proc_info_argmodes(ProcInfo, ProcArgModes), + proc_info_argmodes(ProcInfo, ProcArgModes0), + proc_info_inst_varset(ProcInfo, ProcInstVarSet), + mode_info_get_instvarset(ModeInfo1, InstVarSet), + rename_apart_inst_vars(InstVarSet, ProcInstVarSet, + ProcArgModes0, ProcArgModes), mode_list_get_initial_insts(ProcArgModes, ModuleInfo, InitialInsts), modecheck_var_has_inst_list(ArgVars0, InitialInsts, ArgOffset, - ModeInfo1, ModeInfo2), + InstVarSub, ModeInfo1, ModeInfo2), - modecheck_end_of_call(ProcInfo, ArgVars0, ArgOffset, ArgVars, - ExtraGoals, ModeInfo2, ModeInfo) + modecheck_end_of_call(ProcInfo, ProcArgModes, ArgVars0, + ArgOffset, InstVarSub, ArgVars, ExtraGoals, ModeInfo2, + ModeInfo) ; % set the current error list to empty (and % save the old one in `OldErrors'). This is so the @@ -263,10 +269,12 @@ modecheck_call_pred(PredId, ProcId0, ArgVars0, DeterminismKnown, RevMatchingProcIds = [_|_], list__reverse(RevMatchingProcIds, MatchingProcIds), choose_best_match(MatchingProcIds, PredId, Procs, - ArgVars0, TheProcId, ModeInfo2), + ArgVars0, TheProcId, InstVarSub, ProcArgModes, + ModeInfo2), map__lookup(Procs, TheProcId, ProcInfo), - modecheck_end_of_call(ProcInfo, ArgVars0, ArgOffset, - ArgVars, ExtraGoals, ModeInfo2, ModeInfo3) + modecheck_end_of_call(ProcInfo, ProcArgModes, ArgVars0, + ArgOffset, InstVarSub, ArgVars, ExtraGoals, + ModeInfo2, ModeInfo3) ), % restore the error list, appending any new error(s) @@ -275,6 +283,8 @@ modecheck_call_pred(PredId, ProcId0, ArgVars0, DeterminismKnown, mode_info_set_errors(Errors, ModeInfo3, ModeInfo) ). +%--------------------------------------------------------------------------% + :- pred no_matching_modes(pred_id, list(prog_var), maybe(determinism), set(prog_var), proc_id, mode_info, mode_info). :- mode no_matching_modes(in, in, in, in, out, mode_info_di, mode_info_uo) @@ -310,10 +320,11 @@ no_matching_modes(PredId, ArgVars, DeterminismKnown, WaitingVars, TheProcId, ModeInfo1, ModeInfo) ). -:- pred modecheck_find_matching_modes( - list(proc_id), pred_id, proc_table, list(prog_var), - list(proc_id), list(proc_id), set(prog_var), set(prog_var), - mode_info, mode_info). +:- type proc_mode ---> proc_mode(proc_id, inst_var_sub, list(mode)). + +:- pred modecheck_find_matching_modes(list(proc_id), pred_id, proc_table, + list(prog_var), list(proc_mode), list(proc_mode), set(prog_var), + set(prog_var), mode_info, mode_info). :- mode modecheck_find_matching_modes(in, in, in, in, in, out, in, out, mode_info_di, mode_info_uo) is det. @@ -328,7 +339,11 @@ modecheck_find_matching_modes([ProcId | ProcIds], PredId, Procs, ArgVars0, % find the initial insts and the final livenesses % of the arguments for this mode of the called pred map__lookup(Procs, ProcId, ProcInfo), - proc_info_argmodes(ProcInfo, ProcArgModes), + proc_info_argmodes(ProcInfo, ProcArgModes0), + proc_info_inst_varset(ProcInfo, ProcInstVarSet), + mode_info_get_instvarset(ModeInfo0, InstVarSet), + rename_apart_inst_vars(InstVarSet, ProcInstVarSet, ProcArgModes0, + ProcArgModes), mode_info_get_module_info(ModeInfo0, ModuleInfo), proc_info_arglives(ProcInfo, ModuleInfo, ProcArgLives0), @@ -341,7 +356,7 @@ modecheck_find_matching_modes([ProcId | ProcIds], PredId, Procs, ArgVars0, % initial insts mode_list_get_initial_insts(ProcArgModes, ModuleInfo, InitialInsts), modecheck_var_has_inst_list(ArgVars0, InitialInsts, 0, - ModeInfo1, ModeInfo2), + InstVarSub, ModeInfo1, ModeInfo2), % If we got an error, reset the error list % and save the list of vars to wait on. @@ -356,7 +371,8 @@ modecheck_find_matching_modes([ProcId | ProcIds], PredId, Procs, ArgVars0, FirstError = mode_error_info(ErrorWaitingVars, _, _, _), set__union(WaitingVars0, ErrorWaitingVars, WaitingVars1) ; - MatchingProcIds1 = [ProcId | MatchingProcIds0], + MatchingProcIds1 = [proc_mode(ProcId, InstVarSub, ProcArgModes) + | MatchingProcIds0], ModeInfo3 = ModeInfo2, WaitingVars1 = WaitingVars0 ), @@ -366,17 +382,18 @@ modecheck_find_matching_modes([ProcId | ProcIds], PredId, Procs, ArgVars0, MatchingProcIds1, MatchingProcIds, WaitingVars1, WaitingVars, ModeInfo3, ModeInfo). -:- pred modecheck_end_of_call(proc_info, list(prog_var), int, - list(prog_var), extra_goals, mode_info, mode_info). -:- mode modecheck_end_of_call(in, in, in, out, out, +:- pred modecheck_end_of_call(proc_info, list(mode), list(prog_var), int, + inst_var_sub, list(prog_var), extra_goals, mode_info, mode_info). +:- mode modecheck_end_of_call(in, in, in, in, in, out, out, mode_info_di, mode_info_uo) is det. -modecheck_end_of_call(ProcInfo, ArgVars0, ArgOffset, +modecheck_end_of_call(ProcInfo, ProcArgModes, ArgVars0, ArgOffset, InstVarSub, ArgVars, ExtraGoals, ModeInfo0, ModeInfo) :- - proc_info_argmodes(ProcInfo, ProcArgModes), mode_info_get_module_info(ModeInfo0, ModuleInfo), - mode_list_get_initial_insts(ProcArgModes, ModuleInfo, InitialInsts), - mode_list_get_final_insts(ProcArgModes, ModuleInfo, FinalInsts), + mode_list_get_initial_insts(ProcArgModes, ModuleInfo, InitialInsts0), + inst_list_apply_substitution(InitialInsts0, InstVarSub, InitialInsts), + mode_list_get_final_insts(ProcArgModes, ModuleInfo, FinalInsts0), + inst_list_apply_substitution(FinalInsts0, InstVarSub, FinalInsts), modecheck_set_var_inst_list(ArgVars0, InitialInsts, FinalInsts, ArgOffset, ArgVars, ExtraGoals, ModeInfo0, ModeInfo1), proc_info_never_succeeds(ProcInfo, NeverSucceeds), @@ -408,14 +425,15 @@ insert_new_mode(PredId, ArgVars, MaybeDet, ProcId, ModeInfo0, ModeInfo) :- list__length(ArgVars, Arity), list__duplicate(Arity, not_reached, FinalInsts), inst_lists_to_mode_list(InitialInsts, FinalInsts, Modes), + mode_info_get_instvarset(ModeInfo0, InstVarSet), % % call unify_proc__request_proc, which will % create the new procedure, set its "can-process" flag to `no', % and insert it into the queue of requested procedures. % - unify_proc__request_proc(PredId, Modes, yes(ArgLives), MaybeDet, - Context, ModuleInfo0, ProcId, ModuleInfo), + unify_proc__request_proc(PredId, Modes, InstVarSet, yes(ArgLives), + MaybeDet, Context, ModuleInfo0, ProcId, ModuleInfo), mode_info_set_module_info(ModeInfo0, ModuleInfo, ModeInfo1), @@ -486,8 +504,9 @@ modes_are_indistinguishable(ProcId, OtherProcId, PredInfo, ModuleInfo) :- mode_list_get_initial_insts(ProcArgModes, ModuleInfo, InitialInsts), mode_list_get_initial_insts(OtherProcArgModes, ModuleInfo, OtherInitialInsts), + pred_info_arg_types(PredInfo, ArgTypes), compare_inst_list(InitialInsts, OtherInitialInsts, no, - CompareInsts, ModuleInfo), + ArgTypes, CompareInsts, ModuleInfo), CompareInsts = same, % @@ -534,8 +553,9 @@ modes_are_identical_bar_cc(ProcId, OtherProcId, PredInfo, ModuleInfo) :- mode_list_get_initial_insts(ProcArgModes, ModuleInfo, InitialInsts), mode_list_get_initial_insts(OtherProcArgModes, ModuleInfo, OtherInitialInsts), + pred_info_arg_types(PredInfo, ArgTypes), compare_inst_list(InitialInsts, OtherInitialInsts, no, - CompareInitialInsts, ModuleInfo), + ArgTypes, CompareInitialInsts, ModuleInfo), CompareInitialInsts = same, % @@ -545,7 +565,7 @@ modes_are_identical_bar_cc(ProcId, OtherProcId, PredInfo, ModuleInfo) :- mode_list_get_final_insts(OtherProcArgModes, ModuleInfo, OtherFinalInsts), compare_inst_list(FinalInsts, OtherFinalInsts, no, - CompareFinalInsts, ModuleInfo), + ArgTypes, CompareFinalInsts, ModuleInfo), CompareFinalInsts = same, % @@ -609,29 +629,32 @@ to the following specification: ; same ; incomparable. -:- pred choose_best_match(list(proc_id), pred_id, proc_table, list(prog_var), - proc_id, mode_info). -:- mode choose_best_match(in, in, in, in, out, - mode_info_ui) is det. +:- pred choose_best_match(list(proc_mode), pred_id, + proc_table, list(prog_var), proc_id, inst_var_sub, list(mode), + mode_info). +:- mode choose_best_match(in, in, in, in, out, out, out, mode_info_ui) is det. -choose_best_match([], _, _, _, _, _) :- +choose_best_match([], _, _, _, _, _, _, _) :- error("choose_best_match: no best match"). -choose_best_match([ProcId | ProcIds], PredId, Procs, ArgVars, TheProcId, - ModeInfo) :- +choose_best_match([proc_mode(ProcId, InstVarSub, ArgModes) | ProcIds], PredId, + Procs, ArgVars, TheProcId, TheInstVarSub, TheArgModes, + ModeInfo) :- % % This ProcId is best iff there is no other proc_id which is better. % ( \+ ( - list__member(OtherProcId, ProcIds), + list__member(proc_mode(OtherProcId, _, _), ProcIds), compare_proc(OtherProcId, ProcId, ArgVars, better, Procs, ModeInfo) ) -> - TheProcId = ProcId + TheProcId = ProcId, + TheInstVarSub = InstVarSub, + TheArgModes = ArgModes ; choose_best_match(ProcIds, PredId, Procs, ArgVars, TheProcId, - ModeInfo) + TheInstVarSub, TheArgModes, ModeInfo) ). % @@ -656,12 +679,14 @@ compare_proc(ProcId, OtherProcId, ArgVars, Compare, Procs, ModeInfo) :- proc_info_argmodes(ProcInfo, ProcArgModes), proc_info_argmodes(OtherProcInfo, OtherProcArgModes), mode_info_get_module_info(ModeInfo, ModuleInfo), + mode_info_get_var_types(ModeInfo, VarTypes), + list__map(map__lookup(VarTypes), ArgVars, ArgTypes), mode_list_get_initial_insts(ProcArgModes, ModuleInfo, InitialInsts), mode_list_get_initial_insts(OtherProcArgModes, ModuleInfo, OtherInitialInsts), get_var_insts_and_lives(ArgVars, ModeInfo, ArgInitialInsts, _ArgLives), compare_inst_list(InitialInsts, OtherInitialInsts, yes(ArgInitialInsts), - CompareInsts, ModuleInfo), + ArgTypes, CompareInsts, ModuleInfo), % % Compare the expected livenesses of the arguments % @@ -685,31 +710,35 @@ compare_proc(ProcId, OtherProcId, ArgVars, Compare, Procs, ModeInfo) :- combine_results(CompareInsts, CompareLives, Compare0), prioritized_combine_results(Compare0, CompareDet, Compare). -:- pred compare_inst_list(list(inst), list(inst), maybe(list(inst)), match, - module_info). -:- mode compare_inst_list(in, in, in, out, in) is det. +:- pred compare_inst_list(list(inst), list(inst), maybe(list(inst)), + list(type), match, module_info). +:- mode compare_inst_list(in, in, in, in, out, in) is det. -compare_inst_list(InstsA, InstsB, ArgInsts, Result, ModuleInfo) :- - ( compare_inst_list_2(InstsA, InstsB, ArgInsts, Result0, ModuleInfo) -> +compare_inst_list(InstsA, InstsB, ArgInsts, Types, Result, ModuleInfo) :- + ( + compare_inst_list_2(InstsA, InstsB, ArgInsts, Types, Result0, + ModuleInfo) + -> Result = Result0 ; error("compare_inst_list: length mis-match") ). -:- pred compare_inst_list_2(list(inst), list(inst), maybe(list(inst)), match, - module_info). -:- mode compare_inst_list_2(in, in, in, out, in) is semidet. +:- pred compare_inst_list_2(list(inst), list(inst), maybe(list(inst)), + list(type), match, module_info). +:- mode compare_inst_list_2(in, in, in, in, out, in) is semidet. -compare_inst_list_2([], [], _, same, _). +compare_inst_list_2([], [], _, [], same, _). compare_inst_list_2([InstA | InstsA], [InstB | InstsB], - no, Result, ModuleInfo) :- - compare_inst(InstA, InstB, no, Result0, ModuleInfo), - compare_inst_list_2(InstsA, InstsB, no, Result1, ModuleInfo), + no, [Type | Types], Result, ModuleInfo) :- + compare_inst(InstA, InstB, no, Type, Result0, ModuleInfo), + compare_inst_list_2(InstsA, InstsB, no, Types, Result1, ModuleInfo), combine_results(Result0, Result1, Result). compare_inst_list_2([InstA | InstsA], [InstB | InstsB], - yes([ArgInst|ArgInsts]), Result, ModuleInfo) :- - compare_inst(InstA, InstB, yes(ArgInst), Result0, ModuleInfo), - compare_inst_list_2(InstsA, InstsB, yes(ArgInsts), Result1, ModuleInfo), + yes([ArgInst|ArgInsts]), [Type | Types], Result, ModuleInfo) :- + compare_inst(InstA, InstB, yes(ArgInst), Type, Result0, ModuleInfo), + compare_inst_list_2(InstsA, InstsB, yes(ArgInsts), Types, Result1, + ModuleInfo), combine_results(Result0, Result1, Result). :- pred compare_liveness_list(list(is_live), list(is_live), match). @@ -784,21 +813,21 @@ combine_results(incomparable, _, incomparable). % prefer ground to any (e.g. prefer in to in(any)) % prefer any to free (e.g. prefer any->ground to out) -:- pred compare_inst(inst, inst, maybe(inst), match, module_info). -:- mode compare_inst(in, in, in, out, in) is det. +:- pred compare_inst(inst, inst, maybe(inst), type, match, module_info). +:- mode compare_inst(in, in, in, in, out, in) is det. -compare_inst(InstA, InstB, MaybeArgInst, Result, ModuleInfo) :- +compare_inst(InstA, InstB, MaybeArgInst, Type, Result, ModuleInfo) :- % inst_matches_initial(A,B) succeeds iff % A specifies at least as much information % and at least as much binding as B -- % with the exception that `any' matches_initial `free' % and perhaps vice versa. - ( inst_matches_initial(InstA, InstB, ModuleInfo) -> + ( inst_matches_initial(InstA, InstB, Type, ModuleInfo) -> A_mi_B = yes ; A_mi_B = no ), - ( inst_matches_initial(InstB, InstA, ModuleInfo) -> + ( inst_matches_initial(InstB, InstA, Type, ModuleInfo) -> B_mi_A = yes ; B_mi_A = no @@ -821,14 +850,16 @@ compare_inst(InstA, InstB, MaybeArgInst, Result, ModuleInfo) :- ; MaybeArgInst = yes(ArgInst), ( - inst_matches_final(ArgInst, InstA, ModuleInfo) + inst_matches_final(ArgInst, InstA, Type, + ModuleInfo) -> Arg_mf_A = yes ; Arg_mf_A = no ), ( - inst_matches_final(ArgInst, InstB, ModuleInfo) + inst_matches_final(ArgInst, InstB, Type, + ModuleInfo) -> Arg_mf_B = yes ; @@ -846,12 +877,12 @@ compare_inst(InstA, InstB, MaybeArgInst, Result, ModuleInfo) :- % or comparing with the arg inst doesn't help, % then compare the two proc insts % - ( inst_matches_final(InstA, InstB, ModuleInfo) -> + ( inst_matches_final(InstA, InstB, Type, ModuleInfo) -> A_mf_B = yes ; A_mf_B = no ), - ( inst_matches_final(InstB, InstA, ModuleInfo) -> + ( inst_matches_final(InstB, InstA, Type, ModuleInfo) -> B_mf_A = yes ; B_mf_A = no diff --git a/compiler/modecheck_unify.m b/compiler/modecheck_unify.m index a20a56b77..eb58fc245 100644 --- a/compiler/modecheck_unify.m +++ b/compiler/modecheck_unify.m @@ -356,7 +356,7 @@ modecheck_unify_lambda(X, PredOrFunc, ArgVars, LambdaModes, mode_info_get_module_info(ModeInfo0, ModuleInfo0), mode_info_get_instmap(ModeInfo0, InstMap0), instmap__lookup_var(InstMap0, X, InstOfX), - InstOfY = ground(unique, yes(LambdaPredInfo)), + InstOfY = ground(unique, higher_order(LambdaPredInfo)), LambdaPredInfo = pred_inst_info(PredOrFunc, LambdaModes, LambdaDet), ( abstractly_unify_inst(dead, InstOfX, InstOfY, real_unify, @@ -878,13 +878,15 @@ modecheck_complicated_unify(X, Y, Type, ModeOfX, ModeOfY, Det, UnifyContext, ModeInfo2 = ModeInfo0 ; list__length(UnifyTypeInfoVars, NumTypeInfoVars), - list__duplicate(NumTypeInfoVars, ground(shared, no), + list__duplicate(NumTypeInfoVars, ground(shared, none), ExpectedInsts), mode_info_set_call_context(unify(UnifyContext), ModeInfo0, ModeInfo1), InitialArgNum = 0, modecheck_var_has_inst_list(UnifyTypeInfoVars, ExpectedInsts, - InitialArgNum, ModeInfo1, ModeInfo2) + InitialArgNum, _InstVarSub, ModeInfo1, ModeInfo2) + % We can ignore _InstVarSub since type_info variables + % should not have variable insts. ), mode_info_get_module_info(ModeInfo2, ModuleInfo2), @@ -958,7 +960,8 @@ modecheck_complicated_unify(X, Y, Type, ModeOfX, ModeOfY, Det, UnifyContext, type_to_type_id(Type, TypeId, _) -> mode_info_get_context(ModeInfo2, Context), - unify_proc__request_unify(TypeId - UniMode, + mode_info_get_instvarset(ModeInfo2, InstVarSet), + unify_proc__request_unify(TypeId - UniMode, InstVarSet, Det, Context, ModuleInfo2, ModuleInfo), mode_info_set_module_info(ModeInfo2, ModuleInfo, ModeInfo) @@ -1169,8 +1172,8 @@ check_type_info_args_are_ground([ArgVar | ArgVars], VarTypes, UnifyContext) -> mode_info_set_call_context(unify(UnifyContext)), { InitialArgNum = 0 }, - modecheck_var_has_inst_list([ArgVar], [ground(shared, no)], - InitialArgNum), + modecheck_var_has_inst_list([ArgVar], [ground(shared, none)], + InitialArgNum, _InstVarSub), check_type_info_args_are_ground(ArgVars, VarTypes, UnifyContext) ; @@ -1185,7 +1188,7 @@ check_type_info_args_are_ground([ArgVar | ArgVars], VarTypes, UnifyContext) bind_args(not_reached, _) --> { instmap__init_unreachable(InstMap) }, mode_info_set_instmap(InstMap). -bind_args(ground(Uniq, no), Args) --> +bind_args(ground(Uniq, none), Args) --> ground_args(Uniq, Args). bind_args(bound(_Uniq, List), Args) --> ( { List = [] } -> @@ -1210,7 +1213,7 @@ bind_args_2([Arg | Args], [Inst | Insts]) --> ground_args(_Uniq, []) --> []. ground_args(Uniq, [Arg | Args]) --> - modecheck_set_var_inst(Arg, ground(Uniq, no)), + modecheck_set_var_inst(Arg, ground(Uniq, none)), ground_args(Uniq, Args). %-----------------------------------------------------------------------------% @@ -1228,8 +1231,8 @@ get_mode_of_args(not_reached, ArgInsts, ArgModes) :- mode_set_args(ArgInsts, not_reached, ArgModes). get_mode_of_args(any(Uniq), ArgInsts, ArgModes) :- mode_set_args(ArgInsts, any(Uniq), ArgModes). -get_mode_of_args(ground(Uniq, no), ArgInsts, ArgModes) :- - mode_set_args(ArgInsts, ground(Uniq, no), ArgModes). +get_mode_of_args(ground(Uniq, none), ArgInsts, ArgModes) :- + mode_set_args(ArgInsts, ground(Uniq, none), ArgModes). get_mode_of_args(bound(_Uniq, List), ArgInstsA, ArgModes) :- ( List = [] -> % the code is unreachable diff --git a/compiler/modes.m b/compiler/modes.m index 1a6fabefa..6cd2e586a 100644 --- a/compiler/modes.m +++ b/compiler/modes.m @@ -220,8 +220,8 @@ a variable live if its value will be used later on in the computation. % inst. % :- pred modecheck_var_has_inst_list(list(prog_var), list(inst), int, - mode_info, mode_info). -:- mode modecheck_var_has_inst_list(in, in, in, mode_info_di, mode_info_uo) + inst_var_sub, mode_info, mode_info). +:- mode modecheck_var_has_inst_list(in, in, in, out, mode_info_di, mode_info_uo) is det. :- pred modecheck_set_var_inst(prog_var, inst, mode_info, mode_info). @@ -320,7 +320,7 @@ a variable live if its value will be used later on in the computation. :- import_module make_hlds, hlds_data, unique_modes, mode_debug. :- import_module mode_info, delay_info, mode_errors, inst_match, instmap. -:- import_module type_util, mode_util, code_util, unify_proc. +:- import_module type_util, mode_util, code_util, unify_proc, special_pred. :- import_module globals, options, mercury_to_mercury, hlds_out, int, set. :- import_module passes_aux, typecheck, module_qual, clause_to_proc. :- import_module modecheck_unify, modecheck_call, inst_util, purity. @@ -611,10 +611,27 @@ modecheck_pred_mode_2(PredId, PredInfo0, WhatToCheck, MayChangeCalledProc, { pred_info_procedures(PredInfo0, Procs0) }, { map__keys(Procs0, ProcIds) }, ( { WhatToCheck = check_modes } -> - ( { ProcIds = [] } -> + ( + { ProcIds = [] } + -> maybe_report_error_no_modes(PredId, PredInfo0, ModuleInfo0), { NumErrors0 = 0 } + ; + { special_pred_name_arity(unify, _, PredName, + PredArity) }, + { pred_info_name(PredInfo0, PredName) }, + { pred_info_arity(PredInfo0, PredArity) } + -> + % Don't check for indistinguishable modes in unification + % predicates. The default (in, in) mode must be + % semidet, but for single-value types we also want to + % create a det mode which will be indistinguishable + % from the semidet mode. + % (When the type is known, the det mode is called, + % but the polymorphic unify needs to be able to call + % the semidet mode.) + { NumErrors0 = 0 } ; check_for_indistinguishable_modes(ProcIds, PredId, PredInfo0, ModuleInfo0, 0, NumErrors0) @@ -891,7 +908,7 @@ maybe_clobber_insts([_|_], [], _) :- maybe_clobber_insts([], [], []). maybe_clobber_insts([Inst0 | Insts0], [IsLive | IsLives], [Inst | Insts]) :- ( IsLive = dead -> - Inst = ground(clobbered, no) + Inst = ground(clobbered, none) ; Inst = Inst0 ), @@ -908,7 +925,10 @@ check_final_insts(Vars, Insts, VarInsts, InferModes, ArgNum, ModuleInfo, { Changed = Changed0 } ; { Vars = [Var|Vars1], Insts = [Inst|Insts1], VarInsts = [VarInst|VarInsts1] } -> - ( { inst_matches_final(VarInst, Inst, ModuleInfo) } -> + =(ModeInfo), + { mode_info_get_var_types(ModeInfo, VarTypes) }, + { map__lookup(VarTypes, Var, Type) }, + ( { inst_matches_final(VarInst, Inst, Type, ModuleInfo) } -> { Changed1 = Changed0 } ; { Changed1 = yes }, @@ -921,10 +941,10 @@ check_final_insts(Vars, Insts, VarInsts, InferModes, ArgNum, ModuleInfo, % XXX this might need to be reconsidered now % we have unique modes ( { inst_matches_initial(VarInst, Inst, - ModuleInfo) } -> + Type, ModuleInfo) } -> { Reason = too_instantiated } ; { inst_matches_initial(Inst, VarInst, - ModuleInfo) } -> + Type, ModuleInfo) } -> { Reason = not_instantiated_enough } ; % I don't think this can happen. @@ -1798,28 +1818,47 @@ modecheck_var_is_live(VarId, ExpectedIsLive, ModeInfo0, ModeInfo) :- % that the inst of each variable matches the corresponding initial % inst. -modecheck_var_has_inst_list([_|_], [], _) --> +modecheck_var_has_inst_list(Vars, Insts, ArgNum, Subst) --> + { map__init(Subst0) }, + modecheck_var_has_inst_list_2(Vars, Insts, ArgNum, Subst0, Subst). + +:- pred modecheck_var_has_inst_list_2(list(prog_var), list(inst), int, + inst_var_sub, inst_var_sub, mode_info, mode_info). +:- mode modecheck_var_has_inst_list_2(in, in, in, in, out, + mode_info_di, mode_info_uo) is det. + +modecheck_var_has_inst_list_2([_|_], [], _, _, _) --> { error("modecheck_var_has_inst_list: length mismatch") }. -modecheck_var_has_inst_list([], [_|_], _) --> +modecheck_var_has_inst_list_2([], [_|_], _, _, _) --> { error("modecheck_var_has_inst_list: length mismatch") }. -modecheck_var_has_inst_list([], [], _ArgNum) --> []. -modecheck_var_has_inst_list([Var|Vars], [Inst|Insts], ArgNum0) --> +modecheck_var_has_inst_list_2([], [], _ArgNum, Subst, Subst) --> []. +modecheck_var_has_inst_list_2([Var|Vars], [Inst|Insts], ArgNum0, Subst0, Subst) + --> { ArgNum is ArgNum0 + 1 }, mode_info_set_call_arg_context(ArgNum), - modecheck_var_has_inst(Var, Inst), - modecheck_var_has_inst_list(Vars, Insts, ArgNum). + modecheck_var_has_inst(Var, Inst, Subst0, Subst1), + modecheck_var_has_inst_list_2(Vars, Insts, ArgNum, Subst1, Subst). -:- pred modecheck_var_has_inst(prog_var, inst, mode_info, mode_info). -:- mode modecheck_var_has_inst(in, in, mode_info_di, mode_info_uo) is det. +:- pred modecheck_var_has_inst(prog_var, inst, inst_var_sub, inst_var_sub, + mode_info, mode_info). +:- mode modecheck_var_has_inst(in, in, in, out, mode_info_di, mode_info_uo) + is det. -modecheck_var_has_inst(VarId, Inst, ModeInfo0, ModeInfo) :- +modecheck_var_has_inst(VarId, Inst, Subst0, Subst, ModeInfo0, ModeInfo) :- mode_info_get_instmap(ModeInfo0, InstMap), instmap__lookup_var(InstMap, VarId, VarInst), + mode_info_get_var_types(ModeInfo0, VarTypes), + map__lookup(VarTypes, VarId, Type), - mode_info_get_module_info(ModeInfo0, ModuleInfo), - ( inst_matches_initial(VarInst, Inst, ModuleInfo) -> - ModeInfo = ModeInfo0 + mode_info_get_module_info(ModeInfo0, ModuleInfo0), + ( + inst_matches_initial(VarInst, Inst, Type, ModuleInfo0, + ModuleInfo, Subst0, Subst1) + -> + Subst = Subst1, + mode_info_set_module_info(ModeInfo0, ModuleInfo, ModeInfo) ; + Subst = Subst0, set__singleton_set(WaitingVars, VarId), mode_info_error(WaitingVars, mode_error_var_has_inst(VarId, VarInst, Inst), @@ -1919,7 +1958,9 @@ modecheck_set_var_inst(Var0, FinalInst, ModeInfo00, ModeInfo) :- % If we haven't added any information and % we haven't bound any part of the var, then % the only thing we can have done is lose uniqueness. - inst_matches_initial(Inst0, Inst, ModuleInfo) + mode_info_get_var_types(ModeInfo1, VarTypes), + map__lookup(VarTypes, Var0, Type), + inst_matches_initial(Inst0, Inst, Type, ModuleInfo) -> instmap__set(InstMap0, Var0, Inst, InstMap), mode_info_set_instmap(InstMap, ModeInfo1, ModeInfo3) @@ -1928,7 +1969,9 @@ modecheck_set_var_inst(Var0, FinalInst, ModeInfo00, ModeInfo) :- % lost some uniqueness, or bound part of the var. % The call to inst_matches_binding will succeed % only if we haven't bound any part of the var. - inst_matches_binding(Inst, Inst0, ModuleInfo) + mode_info_get_var_types(ModeInfo1, VarTypes), + map__lookup(VarTypes, Var0, Type), + inst_matches_binding(Inst, Inst0, Type, ModuleInfo) -> % We've just added some information % or lost some uniqueness. @@ -1987,12 +2030,15 @@ handle_implied_mode(Var0, VarInst0, InitialInst0, Var, mode_info_get_module_info(ModeInfo0, ModuleInfo0), inst_expand(ModuleInfo0, InitialInst0, InitialInst), inst_expand(ModuleInfo0, VarInst0, VarInst1), + + mode_info_get_var_types(ModeInfo0, VarTypes0), + map__lookup(VarTypes0, Var0, VarType), ( % If the initial inst of the variable matches_final % the initial inst specified in the pred's mode declaration, % then it's not a call to an implied mode, it's an exact % match with a genuine mode. - inst_matches_final(VarInst1, InitialInst, ModuleInfo0) + inst_matches_final(VarInst1, InitialInst, VarType, ModuleInfo0) -> Var = Var0, ExtraGoals = ExtraGoals0, @@ -2019,9 +2065,6 @@ handle_implied_mode(Var0, VarInst0, InitialInst0, Var, % XXX We ought to use a more elegant method % XXX than hard-coding the name `_init_any'. - mode_info_get_var_types(ModeInfo0, VarTypes0), - map__lookup(VarTypes0, Var, VarType), - mode_info_get_context(ModeInfo0, Context), mode_info_get_mode_context(ModeInfo0, ModeContext), mode_context_to_unify_context(ModeContext, ModeInfo0, @@ -2080,9 +2123,7 @@ handle_implied_mode(Var0, VarInst0, InitialInst0, Var, % Introduce a new variable mode_info_get_varset(ModeInfo0, VarSet0), - mode_info_get_var_types(ModeInfo0, VarTypes0), varset__new_var(VarSet0, Var, VarSet), - map__lookup(VarTypes0, Var0, VarType), map__set(VarTypes0, Var, VarType, VarTypes), mode_info_set_varset(VarSet, ModeInfo0, ModeInfo1), mode_info_set_var_types(VarTypes, ModeInfo1, ModeInfo), @@ -2233,11 +2274,11 @@ check_mode_of_main([Di, Uo], ModuleInfo) :- % manual specifies, rather than looking for a particular % abstract property. % - inst_expand(ModuleInfo, DiInitialInst, ground(unique, no)), - inst_expand(ModuleInfo, DiFinalInst, ground(clobbered, no)), + inst_expand(ModuleInfo, DiInitialInst, ground(unique, none)), + inst_expand(ModuleInfo, DiFinalInst, ground(clobbered, none)), inst_expand(ModuleInfo, UoInitialInst, Free), ( Free = free ; Free = free(_Type) ), - inst_expand(ModuleInfo, UoFinalInst, ground(unique, no)). + inst_expand(ModuleInfo, UoFinalInst, ground(unique, none)). :- pred report_eval_method_requires_ground_args(proc_info, module_info, module_info, io__state, io__state). diff --git a/compiler/module_qual.m b/compiler/module_qual.m index e264892c2..790996d2e 100644 --- a/compiler/module_qual.m +++ b/compiler/module_qual.m @@ -750,15 +750,20 @@ qualify_inst(free(_), _, _, _) --> qualify_inst(bound(Uniq, BoundInsts0), bound(Uniq, BoundInsts), Info0, Info) --> qualify_bound_inst_list(BoundInsts0, BoundInsts, Info0, Info). -qualify_inst(ground(Uniq, MaybePredInstInfo0), ground(Uniq, MaybePredInstInfo), +qualify_inst(ground(Uniq, GroundInstInfo0), ground(Uniq, GroundInstInfo), Info0, Info) --> ( - { MaybePredInstInfo0 = yes(pred_inst_info(A, Modes0, Det)) }, + { GroundInstInfo0 = higher_order(pred_inst_info(A, Modes0, + Det)) }, qualify_mode_list(Modes0, Modes, Info0, Info), - { MaybePredInstInfo = yes(pred_inst_info(A, Modes, Det)) } + { GroundInstInfo = higher_order(pred_inst_info(A, Modes, Det)) } ; - { MaybePredInstInfo0 = no }, - { MaybePredInstInfo = no }, + { GroundInstInfo0 = constrained_inst_var(Var) }, + { GroundInstInfo = constrained_inst_var(Var) }, + { Info = Info0 } + ; + { GroundInstInfo0 = none }, + { GroundInstInfo = none }, { Info = Info0 } ). qualify_inst(inst_var(Var), inst_var(Var), Info, Info) --> []. diff --git a/compiler/pd_info.m b/compiler/pd_info.m index 7c4db5d5c..1f3232c9c 100644 --- a/compiler/pd_info.m +++ b/compiler/pd_info.m @@ -1,5 +1,5 @@ %-----------------------------------------------------------------------------% -% Copyright (C) 1998-1999 University of Melbourne. +% Copyright (C) 1998-2000 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. %-----------------------------------------------------------------------------% @@ -680,7 +680,7 @@ pd_info__goal_is_more_general(ModuleInfo, OldGoal, OldInstMap, OldArgs, goal_info_get_nonlocals(OldGoalInfo, OldNonLocals0), set__to_sorted_list(OldNonLocals0, OldNonLocalsList), pd_info__check_insts(ModuleInfo, OldNonLocalsList, OldNewRenaming, - OldInstMap, NewInstMap, exact, Exact), + OldInstMap, NewInstMap, NewVarTypes, exact, Exact), MaybeVersion = version(Exact, PredProcId, Version, OldNewRenaming, TypeRenaming). @@ -690,21 +690,25 @@ pd_info__goal_is_more_general(ModuleInfo, OldGoal, OldInstMap, OldArgs, % Check that all the insts in the old version are at least as % general as the insts in the new version. :- pred pd_info__check_insts(module_info::in, list(prog_var)::in, - map(prog_var, prog_var)::in, instmap::in, instmap::in, - version_is_exact::in, version_is_exact::out) is semidet. + map(prog_var, prog_var)::in, instmap::in, instmap::in, vartypes::in, + version_is_exact::in, version_is_exact::out) is semidet. -pd_info__check_insts(_, [], _, _, _, Exact, Exact). +pd_info__check_insts(_, [], _, _, _, _, Exact, Exact). pd_info__check_insts(ModuleInfo, [OldVar | Vars], VarRenaming, OldInstMap, - NewInstMap, ExactSoFar0, ExactSoFar) :- + NewInstMap, VarTypes, ExactSoFar0, ExactSoFar) :- instmap__lookup_var(OldInstMap, OldVar, OldVarInst), map__lookup(VarRenaming, OldVar, NewVar), instmap__lookup_var(NewInstMap, NewVar, NewVarInst), - inst_matches_initial(NewVarInst, OldVarInst, ModuleInfo), + map__lookup(VarTypes, NewVar, Type), + inst_matches_initial(NewVarInst, OldVarInst, Type, ModuleInfo), ( ExactSoFar0 = exact -> % Does inst_matches_initial(Inst1, Inst2, M) and % inst_matches_initial(Inst2, Inst1, M) imply that Inst1 % and Inst2 are interchangable? - ( inst_matches_initial(OldVarInst, NewVarInst, ModuleInfo) -> + ( + inst_matches_initial(OldVarInst, NewVarInst, Type, + ModuleInfo) + -> ExactSoFar1 = exact ; ExactSoFar1 = more_general @@ -713,7 +717,7 @@ pd_info__check_insts(ModuleInfo, [OldVar | Vars], VarRenaming, OldInstMap, ExactSoFar1 = more_general ), pd_info__check_insts(ModuleInfo, Vars, VarRenaming, OldInstMap, - NewInstMap, ExactSoFar1, ExactSoFar). + NewInstMap, VarTypes, ExactSoFar1, ExactSoFar). %-----------------------------------------------------------------------------% @@ -744,11 +748,12 @@ pd_info__define_new_pred(Goal, PredProcId, CallGoal) --> { proc_info_vartypes(ProcInfo, VarTypes) }, { proc_info_typeinfo_varmap(ProcInfo, TVarMap) }, { proc_info_typeclass_info_varmap(ProcInfo, TCVarMap) }, + { proc_info_inst_varset(ProcInfo, InstVarSet) }, % XXX handle the extra typeinfo arguments for % --typeinfo-liveness properly. { hlds_pred__define_new_pred(Goal, CallGoal, Args, _ExtraArgs, InstMap, Name, TVarSet, VarTypes, ClassContext, TVarMap, TCVarMap, - VarSet, Markers, Owner, address_is_not_taken, + VarSet, InstVarSet, Markers, Owner, address_is_not_taken, ModuleInfo0, ModuleInfo, PredProcId) }, pd_info_set_module_info(ModuleInfo). diff --git a/compiler/pd_util.m b/compiler/pd_util.m index 136fc0652..04110b9c3 100644 --- a/compiler/pd_util.m +++ b/compiler/pd_util.m @@ -151,15 +151,16 @@ pd_util__simplify_goal(Simplifications, Goal0, Goal) --> pd_info_get_module_info(ModuleInfo0), { module_info_globals(ModuleInfo0, Globals) }, pd_info_get_pred_proc_id(proc(PredId, ProcId)), - { det_info_init(ModuleInfo0, PredId, ProcId, + { proc_info_vartypes(ProcInfo0, VarTypes0) }, + { det_info_init(ModuleInfo0, VarTypes0, PredId, ProcId, Globals, DetInfo0) }, pd_info_get_instmap(InstMap0), pd_info_get_proc_info(ProcInfo0), { proc_info_varset(ProcInfo0, VarSet0) }, - { proc_info_vartypes(ProcInfo0, VarTypes0) }, + { proc_info_inst_varset(ProcInfo0, InstVarSet0) }, { proc_info_typeinfo_varmap(ProcInfo0, TVarMap) }, { simplify_info_init(DetInfo0, Simplifications, InstMap0, - VarSet0, VarTypes0, TVarMap, SimplifyInfo0) }, + VarSet0, InstVarSet0, TVarMap, SimplifyInfo0) }, { simplify__process_goal(Goal0, Goal, SimplifyInfo0, SimplifyInfo) }, @@ -678,8 +679,9 @@ pd_util__recompute_instmap_delta(Goal0, Goal) --> pd_info_get_instmap(InstMap), pd_info_get_proc_info(ProcInfo), { proc_info_vartypes(ProcInfo, VarTypes) }, - { recompute_instmap_delta(yes, Goal0, Goal, - VarTypes, InstMap, ModuleInfo0, ModuleInfo) }, + { proc_info_inst_varset(ProcInfo, InstVarSet) }, + { recompute_instmap_delta(yes, Goal0, Goal, VarTypes, InstVarSet, + InstMap, ModuleInfo0, ModuleInfo) }, pd_info_set_module_info(ModuleInfo). %-----------------------------------------------------------------------------% @@ -796,7 +798,7 @@ bound_inst_list_MSG(Xs, Ys, Expansions, ModuleInfo, Uniq, List, Inst) :- Uniq = unique, inst_is_unique(ModuleInfo, bound(unique, List)) ), - Inst = ground(Uniq, no) + Inst = ground(Uniq, none) ). %-----------------------------------------------------------------------------% diff --git a/compiler/polymorphism.m b/compiler/polymorphism.m index bbe086c9d..86e1a151d 100644 --- a/compiler/polymorphism.m +++ b/compiler/polymorphism.m @@ -2270,8 +2270,8 @@ polymorphism__construct_typeclass_info(ArgUnconstrainedTypeInfoVars, RLExprnId = no, BaseUnification = construct(BaseVar, ConsId, [], [], construct_dynamically, cell_is_shared, RLExprnId), - BaseUnifyMode = (free -> ground(shared, no)) - - (ground(shared, no) -> ground(shared, no)), + BaseUnifyMode = (free -> ground(shared, none)) - + (ground(shared, none) -> ground(shared, none)), BaseUnifyContext = unify_context(explicit, []), % XXX the UnifyContext is wrong BaseUnify = unify(BaseVar, BaseTypeClassInfoTerm, BaseUnifyMode, @@ -2279,7 +2279,7 @@ polymorphism__construct_typeclass_info(ArgUnconstrainedTypeInfoVars, % create a goal_info for the unification set__list_to_set([BaseVar], NonLocals), - instmap_delta_from_assoc_list([BaseVar - ground(shared, no)], + instmap_delta_from_assoc_list([BaseVar - ground(shared, none)], InstmapDelta), goal_info_init(NonLocals, InstmapDelta, det, BaseGoalInfo), @@ -2298,14 +2298,14 @@ polymorphism__construct_typeclass_info(ArgUnconstrainedTypeInfoVars, % create the construction unification to initialize the % variable - UniMode = (free - ground(shared, no) -> - ground(shared, no) - ground(shared, no)), + UniMode = (free - ground(shared, none) -> + ground(shared, none) - ground(shared, none)), list__length(NewArgVars, NumArgVars), list__duplicate(NumArgVars, UniMode, UniModes), Unification = construct(NewVar, NewConsId, NewArgVars, UniModes, construct_dynamically, cell_is_unique, RLExprnId), - UnifyMode = (free -> ground(shared, no)) - - (ground(shared, no) -> ground(shared, no)), + UnifyMode = (free -> ground(shared, none)) - + (ground(shared, none) -> ground(shared, none)), UnifyContext = unify_context(explicit, []), % XXX the UnifyContext is wrong Unify = unify(NewVar, TypeClassInfoTerm, UnifyMode, @@ -2315,7 +2315,7 @@ polymorphism__construct_typeclass_info(ArgUnconstrainedTypeInfoVars, goal_info_init(GoalInfo0), set__list_to_set([NewVar | NewArgVars], TheNonLocals), goal_info_set_nonlocals(GoalInfo0, TheNonLocals, GoalInfo1), - list__duplicate(NumArgVars, ground(shared, no), ArgInsts), + list__duplicate(NumArgVars, ground(shared, none), ArgInsts), % note that we could perhaps be more accurate than % `ground(shared)', but it shouldn't make any % difference. @@ -2705,15 +2705,15 @@ polymorphism__init_type_info_var(Type, ArgVars, Symbol, VarSet0, VarTypes0, TypeInfoVar, VarSet, VarTypes), % create the construction unification to initialize the variable - UniMode = (free - ground(shared, no) -> - ground(shared, no) - ground(shared, no)), + UniMode = (free - ground(shared, none) -> + ground(shared, none) - ground(shared, none)), list__length(ArgVars, NumArgVars), list__duplicate(NumArgVars, UniMode, UniModes), RLExprnId = no, Unification = construct(TypeInfoVar, ConsId, ArgVars, UniModes, construct_dynamically, cell_is_unique, RLExprnId), - UnifyMode = (free -> ground(shared, no)) - - (ground(shared, no) -> ground(shared, no)), + UnifyMode = (free -> ground(shared, none)) - + (ground(shared, none) -> ground(shared, none)), UnifyContext = unify_context(explicit, []), % XXX the UnifyContext is wrong Unify = unify(TypeInfoVar, TypeInfoTerm, UnifyMode, @@ -2721,7 +2721,7 @@ polymorphism__init_type_info_var(Type, ArgVars, Symbol, VarSet0, VarTypes0, % create a goal_info for the unification set__list_to_set([TypeInfoVar | ArgVars], NonLocals), - list__duplicate(NumArgVars, ground(shared, no), ArgInsts), + list__duplicate(NumArgVars, ground(shared, none), ArgInsts), % note that we could perhaps be more accurate than % `ground(shared)', but it shouldn't make any % difference. @@ -2767,8 +2767,8 @@ polymorphism__init_const_type_ctor_info_var(Type, TypeId, RLExprnId = no, Unification = construct(TypeCtorInfoVar, ConsId, [], [], construct_dynamically, cell_is_shared, RLExprnId), - UnifyMode = (free -> ground(shared, no)) - - (ground(shared, no) -> ground(shared, no)), + UnifyMode = (free -> ground(shared, none)) - + (ground(shared, none) -> ground(shared, none)), UnifyContext = unify_context(explicit, []), % XXX the UnifyContext is wrong Unify = unify(TypeCtorInfoVar, TypeInfoTerm, UnifyMode, @@ -2776,7 +2776,7 @@ polymorphism__init_const_type_ctor_info_var(Type, TypeId, % create a goal_info for the unification set__list_to_set([TypeCtorInfoVar], NonLocals), - instmap_delta_from_assoc_list([TypeCtorInfoVar - ground(shared, no)], + instmap_delta_from_assoc_list([TypeCtorInfoVar - ground(shared, none)], InstmapDelta), goal_info_init(NonLocals, InstmapDelta, det, GoalInfo), @@ -2909,7 +2909,7 @@ polymorphism__gen_extract_type_info(TypeVar, TypeClassInfoVar, Index, % type_info argument even though its declaration is % polymorphic. set__list_to_set([TypeClassInfoVar, IndexVar, TypeInfoVar], NonLocals), - instmap_delta_from_assoc_list([TypeInfoVar - ground(shared, no)], + instmap_delta_from_assoc_list([TypeInfoVar - ground(shared, none)], InstmapDelta), goal_info_init(NonLocals, InstmapDelta, det, GoalInfo), diff --git a/compiler/post_typecheck.m b/compiler/post_typecheck.m index 4b61edf92..2c9d4b2dc 100644 --- a/compiler/post_typecheck.m +++ b/compiler/post_typecheck.m @@ -474,7 +474,7 @@ post_typecheck__finish_aditi_builtin(ModuleInfo, CallerPredInfo, Args, Context, PredOrFunc, ArgTypes, ClosurePredOrFunc, ClosureArgModes, ClosureDetism), - Inst = ground(shared, yes(pred_inst_info(ClosurePredOrFunc, + Inst = ground(shared, higher_order(pred_inst_info(ClosurePredOrFunc, ClosureArgModes, ClosureDetism))), Modes = [(Inst -> Inst), aditi_di_mode, aditi_uo_mode]. @@ -896,7 +896,7 @@ check_aditi_state_modes_2(ModuleInfo, [Type | Types], [Mode | Modes], mode_get_insts(ModuleInfo, Mode, InitialInst, _), % Mode analysis will check the final inst. inst_matches_initial(InitialInst, InitialAditiStateInst, - ModuleInfo) + Type, ModuleInfo) ; check_aditi_state_modes_2(ModuleInfo, Types, Modes, InitialAditiStateInst) diff --git a/compiler/prog_data.m b/compiler/prog_data.m index db3995877..d255068d6 100644 --- a/compiler/prog_data.m +++ b/compiler/prog_data.m @@ -730,11 +730,8 @@ % inst_defn/3 defined above :- type inst_defn - ---> eqv_inst(sym_name, list(inst_param), inst) - ; abstract_inst(sym_name, list(inst_param)). - - % probably inst parameters should be variables not terms -:- type inst_param == inst_term. + ---> eqv_inst(sym_name, list(inst_var), inst) + ; abstract_inst(sym_name, list(inst_var)). % An `inst_name' is used as a key for the inst_table. % It is either a user-defined inst `user_inst(Name, Args)', @@ -795,7 +792,7 @@ % mode_defn/3 defined above :- type mode_defn - ---> eqv_mode(sym_name, list(inst_param), mode). + ---> eqv_mode(sym_name, list(inst_var), mode). :- type (mode) ---> ((inst) -> (inst)) diff --git a/compiler/prog_io.m b/compiler/prog_io.m index 5cd2868ef..ea1f52f5f 100644 --- a/compiler/prog_io.m +++ b/compiler/prog_io.m @@ -1961,8 +1961,9 @@ process_mode(ModuleName, VarSet, Term, Cond, MaybeDet, Result) :- process_pred_mode(ok(F, As0), PredMode, VarSet0, MaybeDet, Cond, Result) :- ( - convert_mode_list(As0, As) + convert_mode_list(As0, As1) -> + list__map(constrain_inst_vars_in_mode, As1, As), varset__coerce(VarSet0, VarSet), Result = ok(pred_mode(VarSet, F, As, MaybeDet, Cond)) ; @@ -1978,9 +1979,11 @@ process_pred_mode(error(M, T), _, _, _, _, error(M, T)). process_func_mode(ok(F, As0), FuncMode, RetMode0, VarSet0, MaybeDet, Cond, Result) :- ( - convert_mode_list(As0, As) + convert_mode_list(As0, As1) -> - ( convert_mode(RetMode0, RetMode) -> + list__map(constrain_inst_vars_in_mode, As1, As), + ( convert_mode(RetMode0, RetMode1) -> + constrain_inst_vars_in_mode(RetMode1, RetMode), varset__coerce(VarSet0, VarSet), Result = ok(func_mode(VarSet, F, As, RetMode, MaybeDet, Cond)) @@ -1996,6 +1999,63 @@ process_func_mode(ok(F, As0), FuncMode, RetMode0, VarSet0, MaybeDet, Cond, ). process_func_mode(error(M, T), _, _, _, _, _, error(M, T)). +%-----------------------------------------------------------------------------% + +% Replace all occurrences of inst_var(I) with +% ground(shared, constrained_inst_var(I)). + +:- pred constrain_inst_vars_in_mode(mode, mode). +:- mode constrain_inst_vars_in_mode(in, out) is det. + +constrain_inst_vars_in_mode(I0 -> F0, I -> F) :- + constrain_inst_vars_in_inst(I0, I), + constrain_inst_vars_in_inst(F0, F). +constrain_inst_vars_in_mode(user_defined_mode(Name, Args0), + user_defined_mode(Name, Args)) :- + list__map(constrain_inst_vars_in_inst, Args0, Args). + +:- pred constrain_inst_vars_in_inst(inst, inst). +:- mode constrain_inst_vars_in_inst(in, out) is det. + +constrain_inst_vars_in_inst(any(U), any(U)). +constrain_inst_vars_in_inst(free, free). +constrain_inst_vars_in_inst(free(T), free(T)). +constrain_inst_vars_in_inst(bound(U, BIs0), bound(U, BIs)) :- + list__map((pred(functor(C, Is0)::in, functor(C, Is)::out) is det :- + list__map(constrain_inst_vars_in_inst, Is0, Is)), BIs0, BIs). +constrain_inst_vars_in_inst(ground(U, none), ground(U, none)). +constrain_inst_vars_in_inst(ground(U, higher_order(PredInstInfo0)), + ground(U, higher_order(PredInstInfo))) :- + constrain_inst_vars_in_pred_inst_info(PredInstInfo0, PredInstInfo). +constrain_inst_vars_in_inst(ground(U, constrained_inst_var(V)), + ground(U, constrained_inst_var(V))). +constrain_inst_vars_in_inst(not_reached, not_reached). +constrain_inst_vars_in_inst(inst_var(V), + ground(shared, constrained_inst_var(V))). +constrain_inst_vars_in_inst(defined_inst(Name0), defined_inst(Name)) :- + constrain_inst_vars_in_inst_name(Name0, Name). +constrain_inst_vars_in_inst(abstract_inst(N, Is0), abstract_inst(N, Is)) :- + list__map(constrain_inst_vars_in_inst, Is0, Is). + +:- pred constrain_inst_vars_in_pred_inst_info(pred_inst_info, pred_inst_info). +:- mode constrain_inst_vars_in_pred_inst_info(in, out) is det. + +constrain_inst_vars_in_pred_inst_info(PII0, PII) :- + PII0 = pred_inst_info(PredOrFunc, Modes0, Det), + list__map(constrain_inst_vars_in_mode, Modes0, Modes), + PII = pred_inst_info(PredOrFunc, Modes, Det). + +:- pred constrain_inst_vars_in_inst_name(inst_name, inst_name). +:- mode constrain_inst_vars_in_inst_name(in, out) is det. + +constrain_inst_vars_in_inst_name(Name0, Name) :- + ( Name0 = user_inst(SymName, Args0) -> + list__map(constrain_inst_vars_in_inst, Args0, Args), + Name = user_inst(SymName, Args) + ; + Name = Name0 + ). + %-----------------------------------------------------------------------------% % Parse a `:- inst .' declaration. @@ -2052,55 +2112,53 @@ convert_inst_defn(ModuleName, Head, Body, Result) :- :- mode convert_inst_defn_2(in, in, in, out) is det. convert_inst_defn_2(error(M, T), _, _, error(M, T)). -convert_inst_defn_2(ok(Name, Args), Head, Body, Result) :- - % check that all the head args are variables - ( %%% some [Arg] - ( - list__member(Arg, Args), - Arg \= term__variable(_) - ) +convert_inst_defn_2(ok(Name, ArgTerms), Head, Body, Result) :- + ( + % check that all the head args are variables + term__var_list_to_term_list(Args, ArgTerms) -> - Result = error("inst parameters must be variables", Head) - ; - % check that all the head arg variables are distinct - %%% some [Arg2, OtherArgs] ( + % check that all the head arg variables are distinct list__member(Arg2, Args, [Arg2|OtherArgs]), list__member(Arg2, OtherArgs) - ) - -> - Result = error("repeated inst parameters in LHS of inst defn", - Head) - ; - % check that all the variables in the body occur in the head - %%% some [Var2] - ( - term__contains_var(Body, Var2), - \+ term__contains_var_list(Args, Var2) - ) - -> - Result = error("free inst parameter in RHS of inst definition", - Body) - ; - % check that the inst is a valid user-defined inst, i.e. that - % it does not have the form of one of the builtin insts - \+ ( - convert_inst(Head, UserInst), - UserInst = defined_inst(user_inst(_, _)) - ) - -> - Result = error("attempt to redefine builtin inst", Head) - ; - % should improve the error message here - - ( %%% some [ConvertedBody] - convert_inst(Body, ConvertedBody) -> - list__map(term__coerce, Args, InstArgs), - Result = ok(eqv_inst(Name, InstArgs, ConvertedBody)) + Result = error( + "repeated inst parameters in LHS of inst defn", + Head) ; - Result = error("syntax error in inst body", Body) + % check that all the variables in the body occur + % in the head + term__contains_var(Body, Var2), + \+ list__member(Var2, Args) + -> + Result = error( + "free inst parameter in RHS of inst definition", + Body) + ; + % check that the inst is a valid user-defined + % inst, i.e. that it does not have the form of + % one of the builtin insts + \+ ( + convert_inst(Head, UserInst), + UserInst = defined_inst(user_inst(_, _)) + ) + -> + Result = error("attempt to redefine builtin inst", Head) + ; + % should improve the error message here + ( + convert_inst(Body, ConvertedBody) + -> + list__map(term__coerce_var, Args, InstArgs), + Result = ok(eqv_inst(Name, InstArgs, + ConvertedBody)) + ; + Result = error("syntax error in inst body", + Body) + ) ) + ; + Result = error("inst parameters must be variables", Head) ). :- pred convert_abstract_inst_defn(module_name, term, maybe1(inst_defn)). @@ -2113,29 +2171,25 @@ convert_abstract_inst_defn(ModuleName, Head, Result) :- :- pred convert_abstract_inst_defn_2(maybe_functor, term, maybe1(inst_defn)). :- mode convert_abstract_inst_defn_2(in, in, out) is det. convert_abstract_inst_defn_2(error(M, T), _, error(M, T)). -convert_abstract_inst_defn_2(ok(Name, Args), Head, Result) :- - % check that all the head args are variables - ( %%% some [Arg] - ( - list__member(Arg, Args), - Arg \= term__variable(_) - ) +convert_abstract_inst_defn_2(ok(Name, ArgTerms), Head, Result) :- + ( + % check that all the head args are variables + term__var_list_to_term_list(Args, ArgTerms) -> - Result = error("inst parameters must be variables", Head) - ; - % check that all the head arg variables are distinct - %%% some [Arg2, OtherArgs] ( + % check that all the head arg variables are distinct list__member(Arg2, Args, [Arg2|OtherArgs]), list__member(Arg2, OtherArgs) - ) - -> - Result = error( + -> + Result = error( "repeated inst parameters in abstract inst definition", Head) + ; + list__map(term__coerce_var, Args, InstArgs), + Result = ok(abstract_inst(Name, InstArgs)) + ) ; - list__map(term__coerce, Args, InstArgs), - Result = ok(abstract_inst(Name, InstArgs)) + Result = error("inst parameters must be variables", Head) ). :- pred make_inst_defn(varset, condition, inst_defn, item). @@ -2197,48 +2251,46 @@ convert_mode_defn(ModuleName, Head, Body, Result) :- :- pred convert_mode_defn_2(maybe_functor, term, term, maybe1(mode_defn)). :- mode convert_mode_defn_2(in, in, in, out) is det. convert_mode_defn_2(error(M, T), _, _, error(M, T)). -convert_mode_defn_2(ok(Name, Args), Head, Body, Result) :- - % check that all the head args are variables - ( %%% some [Arg] - ( - list__member(Arg, Args), - Arg \= term__variable(_) - ) +convert_mode_defn_2(ok(Name, ArgTerms), Head, Body, Result) :- + ( + % check that all the head args are variables + term__var_list_to_term_list(Args, ArgTerms) -> - Result = error("mode parameters must be variables", Head) - ; - % check that all the head arg variables are distinct - %%% some [Arg2, OtherArgs] ( + % check that all the head arg variables are distinct list__member(Arg2, Args, [Arg2|OtherArgs]), list__member(Arg2, OtherArgs) - ) - -> - Result = error("repeated parameters in LHS of mode defn", - Head) - % check that all the variables in the body occur in the head - ; %%% some [Var2] - ( - term__contains_var(Body, Var2), - \+ term__contains_var_list(Args, Var2) - ) - -> - Result = error("free inst parameter in RHS of mode definition", - Body) - ; - % should improve the error message here - - ( %%% some [ConvertedBody] - convert_mode(Body, ConvertedBody) -> - list__map(term__coerce, Args, InstArgs), - Result = ok(eqv_mode(Name, InstArgs, ConvertedBody)) + Result = error( + "repeated parameters in LHS of mode defn", + Head) + % check that all the variables in the body occur + % in the head ; - % catch-all error message - we should do - % better than this - Result = error("syntax error in mode definition body", + term__contains_var(Body, Var2), + \+ list__member(Var2, Args) + -> + Result = error( + "free inst parameter in RHS of mode definition", + Body) + ; + % should improve the error message here + ( + convert_mode(Body, ConvertedBody) + -> + list__map(term__coerce_var, Args, InstArgs), + Result = ok(eqv_mode(Name, InstArgs, + ConvertedBody)) + ; + % catch-all error message - we should do + % better than this + Result = error( + "syntax error in mode definition body", Body) + ) ) + ; + Result = error("mode parameters must be variables", Head) ). :- pred convert_type_and_mode_list(list(term), list(type_and_mode)). @@ -2256,7 +2308,8 @@ convert_type_and_mode(Term, Result) :- _Context) -> convert_type(TypeTerm, Type), - convert_mode(ModeTerm, Mode), + convert_mode(ModeTerm, Mode0), + constrain_inst_vars_in_mode(Mode0, Mode), Result = type_and_mode(Type, Mode) ; convert_type(Term, Type), diff --git a/compiler/prog_io_util.m b/compiler/prog_io_util.m index d6438b227..096ded1a8 100644 --- a/compiler/prog_io_util.m +++ b/compiler/prog_io_util.m @@ -267,7 +267,7 @@ convert_mode(Term, Mode) :- standard_det(DetString, Detism), convert_mode_list(ArgModesTerms, ArgModes), PredInstInfo = pred_inst_info(predicate, ArgModes, Detism), - Inst = ground(shared, yes(PredInstInfo)), + Inst = ground(shared, higher_order(PredInstInfo)), Mode = (Inst -> Inst) ; % Handle higher-order function modes: @@ -289,7 +289,7 @@ convert_mode(Term, Mode) :- convert_mode(RetModeTerm, RetMode), list__append(ArgModes0, [RetMode], ArgModes), FuncInstInfo = pred_inst_info(function, ArgModes, Detism), - Inst = ground(shared, yes(FuncInstInfo)), + Inst = ground(shared, higher_order(FuncInstInfo)), Mode = (Inst -> Inst) ; parse_qualified_term(Term, Term, "mode definition", R), @@ -325,15 +325,15 @@ convert_inst(Term, Result) :- % `ground' insts ; Name = term__atom("ground"), Args0 = [] -> - Result = ground(shared, no) + Result = ground(shared, none) ; Name = term__atom("unique"), Args0 = [] -> - Result = ground(unique, no) + Result = ground(unique, none) ; Name = term__atom("mostly_unique"), Args0 = [] -> - Result = ground(mostly_unique, no) + Result = ground(mostly_unique, none) ; Name = term__atom("clobbered"), Args0 = [] -> - Result = ground(clobbered, no) + Result = ground(clobbered, none) ; Name = term__atom("mostly_clobbered"), Args0 = [] -> - Result = ground(mostly_clobbered, no) + Result = ground(mostly_clobbered, none) ; % The syntax for a higher-order pred inst is % @@ -349,7 +349,7 @@ convert_inst(Term, Result) :- standard_det(DetString, Detism), convert_mode_list(ArgModesTerm, ArgModes), PredInst = pred_inst_info(predicate, ArgModes, Detism), - Result = ground(shared, yes(PredInst)) + Result = ground(shared, higher_order(PredInst)) ; % The syntax for a higher-order func inst is @@ -370,7 +370,7 @@ convert_inst(Term, Result) :- convert_mode(RetModeTerm, RetMode), list__append(ArgModes0, [RetMode], ArgModes), FuncInst = pred_inst_info(function, ArgModes, Detism), - Result = ground(shared, yes(FuncInst)) + Result = ground(shared, higher_order(FuncInst)) % `not_reached' inst ; Name = term__atom("not_reached"), Args0 = [] -> diff --git a/compiler/prog_rep.m b/compiler/prog_rep.m index 9b2931997..338021aa7 100644 --- a/compiler/prog_rep.m +++ b/compiler/prog_rep.m @@ -18,26 +18,38 @@ :- interface. -:- import_module hlds_goal, hlds_module, instmap. +:- import_module hlds_pred, hlds_goal, hlds_module, instmap. :- import_module mdb, mdb__program_representation. -:- pred prog_rep__represent_goal(hlds_goal::in, instmap::in, module_info::in, - goal_rep::out) is det. +:- pred prog_rep__represent_goal(hlds_goal::in, instmap::in, vartypes::in, + module_info::in, goal_rep::out) is det. :- implementation. -:- import_module hlds_pred, hlds_data, prog_data. +:- import_module hlds_data, prog_data. :- import_module string, list, set, std_util, require, term. -prog_rep__represent_goal(GoalExpr - GoalInfo, InstMap0, ModuleInfo, Rep) :- - prog_rep__represent_goal_expr(GoalExpr, GoalInfo, InstMap0, ModuleInfo, +:- type prog_rep__info + ---> info( + vartypes :: vartypes, + module_info :: module_info + ). + +prog_rep__represent_goal(Goal, InstMap0, VarTypes, ModuleInfo, Rep) :- + prog_rep__represent_goal(Goal, InstMap0, info(VarTypes, ModuleInfo), Rep). +:- pred prog_rep__represent_goal(hlds_goal::in, instmap::in, + prog_rep__info::in, goal_rep::out) is det. + +prog_rep__represent_goal(GoalExpr - GoalInfo, InstMap0, Info, Rep) :- + prog_rep__represent_goal_expr(GoalExpr, GoalInfo, InstMap0, Info, Rep). + :- pred prog_rep__represent_atomic_goal(hlds_goal_info::in, - instmap::in, module_info::in, detism_rep::out, + instmap::in, prog_rep__info::in, detism_rep::out, string::out, int::out, list(var_rep)::out) is det. -prog_rep__represent_atomic_goal(GoalInfo, InstMap0, ModuleInfo, +prog_rep__represent_atomic_goal(GoalInfo, InstMap0, Info, DetismRep, FilenameRep, LinenoRep, ChangedVarsRep) :- goal_info_get_determinism(GoalInfo, Detism), prog_rep__represent_detism(Detism, DetismRep), @@ -46,7 +58,8 @@ prog_rep__represent_atomic_goal(GoalInfo, InstMap0, ModuleInfo, term__context_line(Context, LinenoRep), goal_info_get_instmap_delta(GoalInfo, InstMapDelta), instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap), - instmap_changed_vars(InstMap0, InstMap, ModuleInfo, ChangedVars), + instmap_changed_vars(InstMap0, InstMap, Info^vartypes, Info^module_info, + ChangedVars), set__to_sorted_list(ChangedVars, ChangedVarsList), list__map(term__var_to_int, ChangedVarsList, ChangedVarsRep). @@ -92,10 +105,10 @@ prog_rep__represent_sym_name(qualified(_, String), String). %---------------------------------------------------------------------------% :- pred prog_rep__represent_goal_expr(hlds_goal_expr::in, hlds_goal_info::in, - instmap::in, module_info::in, goal_rep::out) is det. + instmap::in, prog_rep__info::in, goal_rep::out) is det. prog_rep__represent_goal_expr(unify(_, _, _, Uni, _), GoalInfo, InstMap0, - ModuleInfo, Rep) :- + Info, Rep) :- ( Uni = assign(Target, Source), term__var_to_int(Target, TargetRep), @@ -123,44 +136,44 @@ prog_rep__represent_goal_expr(unify(_, _, _, Uni, _), GoalInfo, InstMap0, Uni = complicated_unify(_, _, _), error("prog_rep__represent_goal_expr: complicated_unify") ), - prog_rep__represent_atomic_goal(GoalInfo, InstMap0, ModuleInfo, + prog_rep__represent_atomic_goal(GoalInfo, InstMap0, Info, DetismRep, FilenameRep, LinenoRep, ChangedVarsRep), Rep = atomic_goal_rep(DetismRep, FilenameRep, LinenoRep, ChangedVarsRep, AtomicGoalRep). -prog_rep__represent_goal_expr(conj(Goals), _, InstMap0, ModuleInfo, Rep) :- - prog_rep__represent_conj(Goals, InstMap0, ModuleInfo, Reps), +prog_rep__represent_goal_expr(conj(Goals), _, InstMap0, Info, Rep) :- + prog_rep__represent_conj(Goals, InstMap0, Info, Reps), list__reverse(Reps, ReverseReps), Rep = conj_rep(ReverseReps). prog_rep__represent_goal_expr(par_conj(_, _), _, _, _, _) :- error("Sorry, not yet implemented:\n\ parallel conjunctions and declarative debugging"). -prog_rep__represent_goal_expr(disj(Goals, _SM), _, InstMap0, ModuleInfo, Rep) +prog_rep__represent_goal_expr(disj(Goals, _SM), _, InstMap0, Info, Rep) :- - prog_rep__represent_disj(Goals, InstMap0, ModuleInfo, DisjReps), + prog_rep__represent_disj(Goals, InstMap0, Info, DisjReps), Rep = disj_rep(DisjReps). -prog_rep__represent_goal_expr(not(Goal), _GoalInfo, InstMap0, ModuleInfo, Rep) +prog_rep__represent_goal_expr(not(Goal), _GoalInfo, InstMap0, Info, Rep) :- - prog_rep__represent_goal(Goal, InstMap0, ModuleInfo, InnerRep), + prog_rep__represent_goal(Goal, InstMap0, Info, InnerRep), Rep = negation_rep(InnerRep). prog_rep__represent_goal_expr(if_then_else(_, Cond, Then, Else, _SM), - _, InstMap0, ModuleInfo, Rep) :- - prog_rep__represent_goal(Cond, InstMap0, ModuleInfo, CondRep), + _, InstMap0, Info, Rep) :- + prog_rep__represent_goal(Cond, InstMap0, Info, CondRep), Cond = _ - CondGoalInfo, goal_info_get_instmap_delta(CondGoalInfo, InstMapDelta), instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap1), - prog_rep__represent_goal(Then, InstMap1, ModuleInfo, ThenRep), - prog_rep__represent_goal(Else, InstMap0, ModuleInfo, ElseRep), + prog_rep__represent_goal(Then, InstMap1, Info, ThenRep), + prog_rep__represent_goal(Else, InstMap0, Info, ElseRep), Rep = ite_rep(CondRep, ThenRep, ElseRep). prog_rep__represent_goal_expr(switch(_, _, Cases, _SM), _, - InstMap0, ModuleInfo, Rep) :- - prog_rep__represent_cases(Cases, InstMap0, ModuleInfo, CaseReps), + InstMap0, Info, Rep) :- + prog_rep__represent_cases(Cases, InstMap0, Info, CaseReps), Rep = switch_rep(CaseReps). -prog_rep__represent_goal_expr(some(_, _, Goal), _, InstMap0, ModuleInfo, Rep) +prog_rep__represent_goal_expr(some(_, _, Goal), _, InstMap0, Info, Rep) :- - prog_rep__represent_goal(Goal, InstMap0, ModuleInfo, InnerRep), + prog_rep__represent_goal(Goal, InstMap0, Info, InnerRep), Rep = some_rep(InnerRep). prog_rep__represent_goal_expr(generic_call(GenericCall, Args, _, _), - GoalInfo, InstMap0, ModuleInfo, Rep) :- + GoalInfo, InstMap0, Info, Rep) :- list__map(term__var_to_int, Args, ArgsRep), ( GenericCall = higher_order(PredVar, _, _), @@ -175,26 +188,26 @@ prog_rep__represent_goal_expr(generic_call(GenericCall, Args, _, _), error("Sorry, not yet implemented\n\ Aditi and declarative debugging") ), - prog_rep__represent_atomic_goal(GoalInfo, InstMap0, ModuleInfo, + prog_rep__represent_atomic_goal(GoalInfo, InstMap0, Info, DetismRep, FilenameRep, LinenoRep, ChangedVarsRep), Rep = atomic_goal_rep(DetismRep, FilenameRep, LinenoRep, ChangedVarsRep, AtomicGoalRep). prog_rep__represent_goal_expr(call(PredId, _, Args, _, _, _), - GoalInfo, InstMap0, ModuleInfo, Rep) :- - module_info_pred_info(ModuleInfo, PredId, PredInfo), + GoalInfo, InstMap0, Info, Rep) :- + module_info_pred_info(Info^module_info, PredId, PredInfo), pred_info_name(PredInfo, PredName), list__map(term__var_to_int, Args, ArgsRep), AtomicGoalRep = plain_call_rep(PredName, ArgsRep), - prog_rep__represent_atomic_goal(GoalInfo, InstMap0, ModuleInfo, + prog_rep__represent_atomic_goal(GoalInfo, InstMap0, Info, DetismRep, FilenameRep, LinenoRep, ChangedVarsRep), Rep = atomic_goal_rep(DetismRep, FilenameRep, LinenoRep, ChangedVarsRep, AtomicGoalRep). prog_rep__represent_goal_expr(pragma_foreign_code(_, _, _PredId, _, Args, _, _, _), - GoalInfo, InstMap0, ModuleInfo, Rep) :- + GoalInfo, InstMap0, Info, Rep) :- list__map(term__var_to_int, Args, ArgsRep), AtomicGoalRep = pragma_foreign_code_rep(ArgsRep), - prog_rep__represent_atomic_goal(GoalInfo, InstMap0, ModuleInfo, + prog_rep__represent_atomic_goal(GoalInfo, InstMap0, Info, DetismRep, FilenameRep, LinenoRep, ChangedVarsRep), Rep = atomic_goal_rep(DetismRep, FilenameRep, LinenoRep, ChangedVarsRep, AtomicGoalRep). @@ -204,36 +217,36 @@ prog_rep__represent_goal_expr(bi_implication(_, _), _, _, _, _) :- %---------------------------------------------------------------------------% -:- pred prog_rep__represent_conj(hlds_goals::in, instmap::in, module_info::in, - list(goal_rep)::out) is det. +:- pred prog_rep__represent_conj(hlds_goals::in, instmap::in, + prog_rep__info::in, list(goal_rep)::out) is det. prog_rep__represent_conj([], _, _, []). -prog_rep__represent_conj([Goal | Goals], InstMap0, ModuleInfo, [Rep | Reps]) :- - prog_rep__represent_goal(Goal, InstMap0, ModuleInfo, Rep), +prog_rep__represent_conj([Goal | Goals], InstMap0, Info, [Rep | Reps]) :- + prog_rep__represent_goal(Goal, InstMap0, Info, Rep), Goal = _ - GoalInfo, goal_info_get_instmap_delta(GoalInfo, InstMapDelta), instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMap1), - prog_rep__represent_conj(Goals, InstMap1, ModuleInfo, Reps). + prog_rep__represent_conj(Goals, InstMap1, Info, Reps). %---------------------------------------------------------------------------% -:- pred prog_rep__represent_disj(hlds_goals::in, instmap::in, module_info::in, - list(goal_rep)::out) is det. +:- pred prog_rep__represent_disj(hlds_goals::in, instmap::in, + prog_rep__info::in, list(goal_rep)::out) is det. prog_rep__represent_disj([], _, _, []). -prog_rep__represent_disj([Goal | Goals], InstMap0, ModuleInfo, [Rep | Reps]) :- - prog_rep__represent_goal(Goal, InstMap0, ModuleInfo, Rep), - prog_rep__represent_disj(Goals, InstMap0, ModuleInfo, Reps). +prog_rep__represent_disj([Goal | Goals], InstMap0, Info, [Rep | Reps]) :- + prog_rep__represent_goal(Goal, InstMap0, Info, Rep), + prog_rep__represent_disj(Goals, InstMap0, Info, Reps). %---------------------------------------------------------------------------% -:- pred prog_rep__represent_cases(list(case)::in, instmap::in, module_info::in, - list(goal_rep)::out) is det. +:- pred prog_rep__represent_cases(list(case)::in, instmap::in, + prog_rep__info::in, list(goal_rep)::out) is det. prog_rep__represent_cases([], _, _, []). -prog_rep__represent_cases([case(_, Goal) | Cases], InstMap0, ModuleInfo, +prog_rep__represent_cases([case(_, Goal) | Cases], InstMap0, Info, [Rep | Reps]) :- - prog_rep__represent_goal(Goal, InstMap0, ModuleInfo, Rep), - prog_rep__represent_cases(Cases, InstMap0, ModuleInfo, Reps). + prog_rep__represent_goal(Goal, InstMap0, Info, Rep), + prog_rep__represent_cases(Cases, InstMap0, Info, Reps). %---------------------------------------------------------------------------% diff --git a/compiler/saved_vars.m b/compiler/saved_vars.m index 4a3f99d6a..df3c4ba51 100644 --- a/compiler/saved_vars.m +++ b/compiler/saved_vars.m @@ -69,7 +69,8 @@ saved_vars_proc_no_io(ProcInfo0, ProcInfo, ModuleInfo0, ModuleInfo) :- implicitly_quantify_clause_body(HeadVars, Goal1, Varset1, VarTypes1, Goal2, Varset, VarTypes, _Warnings), proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InstMap0), - recompute_instmap_delta(no, Goal2, Goal, VarTypes, InstMap0, + proc_info_inst_varset(ProcInfo0, InstVarSet), + recompute_instmap_delta(no, Goal2, Goal, VarTypes, InstVarSet, InstMap0, ModuleInfo0, ModuleInfo), % hlds_out__write_goal(Goal, ModuleInfo, Varset, 0, "\n"), diff --git a/compiler/simplify.m b/compiler/simplify.m index 7dafe3c73..10719b14d 100644 --- a/compiler/simplify.m +++ b/compiler/simplify.m @@ -150,15 +150,17 @@ simplify__proc(Simplifications, PredId, ProcId, ModuleInfo0, ModuleInfo, simplify__proc_2(Simplifications, PredId, ProcId, ModuleInfo0, ModuleInfo, ProcInfo0, ProcInfo, Msgs) :- module_info_globals(ModuleInfo0, Globals), - det_info_init(ModuleInfo0, PredId, ProcId, Globals, DetInfo0), + proc_info_vartypes(ProcInfo0, VarTypes0), + det_info_init(ModuleInfo0, VarTypes0, PredId, ProcId, Globals, + DetInfo0), proc_info_get_initial_instmap(ProcInfo0, ModuleInfo0, InstMap0), proc_info_varset(ProcInfo0, VarSet0), - proc_info_vartypes(ProcInfo0, VarTypes0), + proc_info_inst_varset(ProcInfo0, InstVarSet0), proc_info_typeinfo_varmap(ProcInfo0, TVarMap), proc_info_goal(ProcInfo0, Goal0), simplify_info_init(DetInfo0, Simplifications, InstMap0, - VarSet0, VarTypes0, TVarMap, Info0), + VarSet0, InstVarSet0, TVarMap, Info0), simplify__process_goal(Goal0, Goal, Info0, Info), simplify_info_get_varset(Info, VarSet), @@ -222,7 +224,8 @@ simplify__do_process_goal(Goal0, Goal, Info0, Info) :- simplify_info_get_module_info(Info3, ModuleInfo3), recompute_instmap_delta(RecomputeAtomic, Goal2, Goal3, - VarTypes, InstMap0, ModuleInfo3, ModuleInfo4), + VarTypes, Info3^inst_varset, InstMap0, ModuleInfo3, + ModuleInfo4), simplify_info_set_module_info(Info3, ModuleInfo4, Info4) ; Goal3 = Goal1, @@ -1936,7 +1939,7 @@ simplify__contains_multisoln_goal(Goals) :- % Info about common subexpressions. instmap :: instmap, varset :: prog_varset, - var_types :: map(prog_var, type), + inst_varset :: inst_varset, requantify :: bool, % Does the goal need requantification. recompute_atomic :: bool, @@ -1955,23 +1958,26 @@ simplify__contains_multisoln_goal(Goals) :- ). simplify_info_init(DetInfo, Simplifications0, InstMap, - VarSet, VarTypes, TVarMap, Info) :- + VarSet, InstVarSet, TVarMap, Info) :- common_info_init(CommonInfo), set__init(Msgs), set__list_to_set(Simplifications0, Simplifications), Info = simplify_info(DetInfo, Msgs, Simplifications, CommonInfo, - InstMap, VarSet, VarTypes, no, no, no, 0, 0, TVarMap). + InstMap, VarSet, InstVarSet, no, no, no, 0, 0, TVarMap). % Reinitialise the simplify_info before reprocessing a goal. :- pred simplify_info_reinit(set(simplification)::in, instmap::in, simplify_info::in, simplify_info::out) is det. -simplify_info_reinit(Simplifications, InstMap0, Info0, Info) :- - Info0 = simplify_info(DetInfo, Msgs, _, _, _, - VarSet, VarTypes, _, _, _, CostDelta, _, TVarMap), - common_info_init(Common), - Info = simplify_info(DetInfo, Msgs, Simplifications, Common, InstMap0, - VarSet, VarTypes, no, no, no, CostDelta, 0, TVarMap). +simplify_info_reinit(Simplifications, InstMap0) --> + { common_info_init(Common) }, + ^simplifications := Simplifications, + ^common_info := Common, + ^instmap := InstMap0, + ^requantify := no, + ^recompute_atomic := no, + ^rerun_det := no, + ^lambdas := 0. % exported for common.m :- interface. @@ -1979,9 +1985,9 @@ simplify_info_reinit(Simplifications, InstMap0, Info0, Info) :- :- import_module prog_data. :- import_module set. -:- pred simplify_info_init(det_info, list(simplification), instmap, - prog_varset, vartypes, type_info_varmap, simplify_info). -:- mode simplify_info_init(in, in, in, in, in, in, out) is det. +:- pred simplify_info_init(det_info::in, list(simplification)::in, instmap::in, + prog_varset::in, inst_varset::in, + type_info_varmap::in, simplify_info::out) is det. :- pred simplify_info_get_det_info(simplify_info::in, det_info::out) is det. :- pred simplify_info_get_msgs(simplify_info::in, set(det_msg)::out) is det. @@ -2013,7 +2019,7 @@ simplify_info_get_simplifications(SI, SI^simplifications). simplify_info_get_common_info(SI, SI^common_info). simplify_info_get_instmap(SI, SI^instmap). simplify_info_get_varset(SI, SI^varset). -simplify_info_get_var_types(SI, SI^var_types). +simplify_info_get_var_types(SI, SI^det_info^vartypes). simplify_info_requantify(SI) :- SI^requantify = yes. simplify_info_recompute_atomic(SI) :- @@ -2081,7 +2087,7 @@ simplify_info_set_simplifications(SI, Simp, SI^simplifications := Simp). simplify_info_set_instmap(SI, InstMap, SI^instmap := InstMap). simplify_info_set_common_info(SI, Common, SI^common_info := Common). simplify_info_set_varset(SI, VarSet, SI^varset := VarSet). -simplify_info_set_var_types(SI, VarTypes, SI^var_types := VarTypes). +simplify_info_set_var_types(SI, VarTypes, SI^det_info^vartypes := VarTypes). simplify_info_set_requantify(SI, SI^requantify := yes). simplify_info_set_recompute_atomic(SI, SI^recompute_atomic := yes). simplify_info_set_rerun_det(SI, SI^rerun_det := yes). diff --git a/compiler/special_pred.m b/compiler/special_pred.m index 947b0210b..c631a612a 100644 --- a/compiler/special_pred.m +++ b/compiler/special_pred.m @@ -27,6 +27,11 @@ ; index ; compare. + % This predicate always returns determinism `semidet' for + % unification procedures. For types with only one value, the + % unification is actually `det', however we need to pretend it + % is `semidet' so that it can be called correctly from the + % polymorphic `unify' procedure. :- pred special_pred_info(special_pred_id, type, string, list(type), list(mode), determinism). :- mode special_pred_info(in, in, out, out, out, out) is det. diff --git a/compiler/stack_layout.m b/compiler/stack_layout.m index 5b0012609..90adc9cde 100644 --- a/compiler/stack_layout.m +++ b/compiler/stack_layout.m @@ -594,7 +594,7 @@ stack_layout__construct_layouts(ProcLayoutInfo) --> { ProcLayoutInfo = proc_layout_info(EntryLabel, Detism, StackSlots, SuccipLoc, EvalMethod, MaybeCallLabel, MaxTraceReg, Goal, InstMap, TraceSlotInfo, ForceProcIdLayout, - VarSet, InternalMap) }, + VarSet, VarTypes, InternalMap) }, { map__to_assoc_list(InternalMap, Internals) }, stack_layout__set_cur_proc_named_vars(map__init), list__foldl(stack_layout__construct_internal_layout(EntryLabel), @@ -607,7 +607,7 @@ stack_layout__construct_layouts(ProcLayoutInfo) --> stack_layout__construct_proc_layout(EntryLabel, Detism, StackSlots, SuccipLoc, EvalMethod, MaybeCallLabel, MaxTraceReg, Goal, InstMap, TraceSlotInfo, ForceProcIdLayout, - VarSet, NamedVars). + VarSet, VarTypes, NamedVars). %---------------------------------------------------------------------------% @@ -702,15 +702,15 @@ stack_layout__context_is_valid(Context) :- % Construct a procedure-specific layout. :- pred stack_layout__construct_proc_layout(label::in, determinism::in, - int::in, maybe(int)::in, eval_method::in, maybe(label)::in, - int::in, hlds_goal::in, instmap::in, trace_slot_info::in, bool::in, - prog_varset::in, map(int, string)::in, + int::in, maybe(int)::in, eval_method::in, maybe(label)::in, int::in, + hlds_goal::in, instmap::in, trace_slot_info::in, bool::in, + prog_varset::in, vartypes::in, map(int, string)::in, stack_layout_info::in, stack_layout_info::out) is det. stack_layout__construct_proc_layout(EntryLabel, Detism, StackSlots, - MaybeSuccipLoc, EvalMethod, MaybeCallLabel, MaxTraceReg, - Goal, InstMap, TraceSlotInfo, ForceProcIdLayout, - VarSet, UsedVarNames) --> + MaybeSuccipLoc, EvalMethod, MaybeCallLabel, MaxTraceReg, Goal, + InstMap, TraceSlotInfo, ForceProcIdLayout, VarSet, VarTypes, + UsedVarNames) --> { MaybeSuccipLoc = yes(Location0) -> @@ -772,10 +772,9 @@ stack_layout__construct_proc_layout(EntryLabel, Detism, StackSlots, ProcLabel) }, { stack_layout__construct_procid_rvals(ProcLabel, IdRvals, IdArgTypes) }, - stack_layout__construct_trace_layout(EvalMethod, - MaybeCallLabel, MaxTraceReg, Goal, InstMap, - TraceSlotInfo, VarSet, UsedVarNames, - TraceRvals, TraceArgTypes), + stack_layout__construct_trace_layout(EvalMethod, MaybeCallLabel, + MaxTraceReg, Goal, InstMap, TraceSlotInfo, VarSet, + VarTypes, UsedVarNames, TraceRvals, TraceArgTypes), { list__append(IdRvals, TraceRvals, IdTraceRvals) }, { IdTraceArgTypes = initial(IdArgTypes, TraceArgTypes) } ; @@ -797,14 +796,14 @@ stack_layout__construct_proc_layout(EntryLabel, Detism, StackSlots, Rvals, ArgTypes, []) }, stack_layout__add_proc_layout_data(CData, CDataName, EntryLabel). -:- pred stack_layout__construct_trace_layout(eval_method::in, - maybe(label)::in, int::in, hlds_goal::in, instmap::in, - trace_slot_info::in, prog_varset::in, map(int, string)::in, +:- pred stack_layout__construct_trace_layout(eval_method::in, maybe(label)::in, + int::in, hlds_goal::in, instmap::in, trace_slot_info::in, + prog_varset::in, vartypes::in, map(int, string)::in, list(maybe(rval))::out, create_arg_types::out, stack_layout_info::in, stack_layout_info::out) is det. stack_layout__construct_trace_layout(EvalMethod, MaybeCallLabel, MaxTraceReg, - Goal, InstMap, TraceSlotInfo, VarSet, UsedVarNameMap, + Goal, InstMap, TraceSlotInfo, VarSet, VarTypes, UsedVarNameMap, Rvals, ArgTypes) --> stack_layout__get_trace_stack_layout(TraceLayout), ( { TraceLayout = yes } -> @@ -820,8 +819,8 @@ stack_layout__construct_trace_layout(EvalMethod, MaybeCallLabel, MaxTraceReg, ; { BodyReps = yes }, stack_layout__get_module_info(ModuleInfo0), - { prog_rep__represent_goal(Goal, InstMap, ModuleInfo0, - GoalRep) }, + { prog_rep__represent_goal(Goal, InstMap, VarTypes, + ModuleInfo0, GoalRep) }, { type_to_univ(GoalRep, GoalRepUniv) }, stack_layout__get_cell_counter(CellCounter0), { static_term__term_to_rval(GoalRepUniv, GoalRepRval, diff --git a/compiler/table_gen.m b/compiler/table_gen.m index ff2db14e1..30e393397 100644 --- a/compiler/table_gen.m +++ b/compiler/table_gen.m @@ -741,7 +741,7 @@ generate_non_lookup_goal(Vars, PredId, ProcId, Context, VarTypes0, VarTypes, generate_new_table_var("SubgoalVar", VarTypes2, VarTypes, VarSet2, VarSet, SubgoalVar), generate_call("table_nondet_setup", [TableNodeVar, SubgoalVar], - det, impure, [SubgoalVar - ground(unique, no)], + det, impure, [SubgoalVar - ground(unique, none)], Module, Context, SetupGoal), list__append([GetTableGoal | LookupGoals], [SetupGoal], Goals), @@ -813,7 +813,7 @@ gen_lookup_call_for_type(TypeCat, Type, TableVar, ArgVar, Context, generate_call("table_lookup_insert_enum", [TableVar, RangeVar, ArgVar, NextTableVar], det, impure, - [NextTableVar - ground(unique, no)], + [NextTableVar - ground(unique, none)], Module, Context, LookupGoal), set__init(NonLocals0), set__insert_list(NonLocals0, [TableVar, ArgVar], @@ -829,7 +829,7 @@ gen_lookup_call_for_type(TypeCat, Type, TableVar, ArgVar, Context, ; generate_new_table_var("TableNodeVar", VarTypes0, VarTypes1, VarSet0, VarSet1, NextTableVar), - InstMapAL = [NextTableVar - ground(unique, no)], + InstMapAL = [NextTableVar - ground(unique, none)], ( ( TypeCat = pred_type ; TypeCat = polymorphic_type @@ -891,7 +891,7 @@ generate_save_goal(AnsList, TableVar, Context, VarTypes0, VarTypes, generate_call("table_create_ans_block", [TableVar, NumAnsVarsVar, AnsTableVar], det, impure, - [AnsTableVar - ground(unique, no)], Module, Context, + [AnsTableVar - ground(unique, none)], Module, Context, CreateAnsBlockGoal), generate_save_goals(AnsList, AnsTableVar, 0, Context, @@ -928,7 +928,7 @@ generate_non_save_goal(AnsList, TableVar, Context, VarTypes0, VarTypes, generate_new_table_var("AnswerTableVar", VarTypes0, VarTypes1, VarSet0, VarSet1, AnsTableVar0), generate_call("table_nondet_get_ans_table", [TableVar, AnsTableVar0], - det, impure, [AnsTableVar0 - ground(unique, no)], + det, impure, [AnsTableVar0 - ground(unique, none)], Module, Context, GetAnsTableGoal), generate_lookup_goals(AnsList, Context, AnsTableVar0, AnsTableVar1, VarTypes1, VarTypes2, VarSet1, VarSet2, TableInfo0, TableInfo1, @@ -939,7 +939,7 @@ generate_non_save_goal(AnsList, TableVar, Context, VarTypes0, VarTypes, generate_new_table_var("AnswerSlotVar", VarTypes2, VarTypes3, VarSet2, VarSet3, AnsSlotVar), generate_call("table_nondet_new_ans_slot", [TableVar, AnsSlotVar], det, - impure, [AnsSlotVar - ground(unique, no)], + impure, [AnsSlotVar - ground(unique, none)], Module, Context, NewAnsSlotGoal), list__length(AnsList, NumAnsVars), @@ -949,7 +949,7 @@ generate_non_save_goal(AnsList, TableVar, Context, VarTypes0, VarTypes, VarSet4, VarSet5, AnsBlockVar), generate_call("table_create_ans_block", [AnsSlotVar, NumAnsVarsVar, AnsBlockVar], det, impure, - [AnsBlockVar - ground(unique, no)], + [AnsBlockVar - ground(unique, none)], Module, Context, CreateAnsBlockGoal), generate_save_goals(AnsList, AnsBlockVar, 0, Context, @@ -1072,7 +1072,7 @@ generate_restore_all_goal(Detism, OutputVars, TableVar, Module, Context, error("generate_restore_all_goal: invalid determinism") ), generate_call(ReturnAllAns, [TableVar, AnsTableVar], - Detism, semipure, [AnsTableVar - ground(unique, no)], + Detism, semipure, [AnsTableVar - ground(unique, none)], Module, Context, ReturnAnsBlocksGoal), generate_restore_goals(OutputVars, AnsTableVar, 0, Module, Context, @@ -1127,7 +1127,7 @@ gen_restore_call_for_type(TypeCat, _Type, TableVar, Var, OffsetVar, Module, LookupPredName) ), generate_call(LookupPredName, [TableVar, OffsetVar, Var], det, impure, - [Var - ground(shared, no)], Module, Context, Goal). + [Var - ground(shared, none)], Module, Context, Goal). %-----------------------------------------------------------------------------% @@ -1142,7 +1142,7 @@ generate_suspend_goal(OutputVars, TableVar, Module, Context, generate_new_table_var("AnswerTable", VarTypes0, VarTypes1, VarSet0, VarSet1, AnsTableVar), generate_call("table_nondet_suspend", [TableVar, AnsTableVar], - nondet, semipure, [AnsTableVar - ground(unique, no)], + nondet, semipure, [AnsTableVar - ground(unique, none)], Module, Context, ReturnAnsBlocksGoal), generate_restore_goals(OutputVars, AnsTableVar, 0, Module, Context, diff --git a/compiler/type_util.m b/compiler/type_util.m index bca62c0b4..12dd0ff79 100644 --- a/compiler/type_util.m +++ b/compiler/type_util.m @@ -196,9 +196,23 @@ % Work out the types of the arguments of a functor. % Aborts if the functor is existentially typed. + % The cons_id is expected to be un-module-qualified. :- pred type_util__get_cons_id_arg_types(module_info::in, (type)::in, cons_id::in, list(type)::out) is det. + % The same as type_util__get_cons_id_arg_types except that it + % fails rather than aborting if the functor is existentially + % typed. + % The cons_id is expected to be un-module-qualified. +:- pred type_util__get_cons_id_non_existential_arg_types(module_info::in, + (type)::in, cons_id::in, list(type)::out) is semidet. + + % The same as type_util__get_cons_id_arg_types except that the + % cons_id is output non-deterministically. + % The cons_id is not module-qualified. +:- pred type_util__cons_id_arg_types(module_info::in, (type)::in, + cons_id::out, list(type)::out) is nondet. + % Given a type and a cons_id, look up the definitions of that % type and constructor. Aborts if the cons_id is not user-defined. :- pred type_util__get_type_and_cons_defn(module_info, (type), cons_id, @@ -777,7 +791,28 @@ type_util__switch_type_num_functors(ModuleInfo, Type, NumFunctors) :- %-----------------------------------------------------------------------------% -type_util__get_cons_id_arg_types(ModuleInfo, VarType, ConsId, ArgTypes) :- +type_util__get_cons_id_arg_types(ModuleInfo, Type, ConsId, ArgTypes) :- + type_util__get_cons_id_arg_types_2(abort_on_exist_qvar, + ModuleInfo, Type, ConsId, ArgTypes). + +type_util__get_cons_id_non_existential_arg_types(ModuleInfo, Type, ConsId, + ArgTypes) :- + type_util__get_cons_id_arg_types_2(fail_on_exist_qvar, + ModuleInfo, Type, ConsId, ArgTypes). + +:- type exist_qvar_action + ---> fail_on_exist_qvar + ; abort_on_exist_qvar. + +:- pred type_util__get_cons_id_arg_types_2(exist_qvar_action, + module_info, (type), cons_id, list(type)). +:- mode type_util__get_cons_id_arg_types_2(in(bound(fail_on_exist_qvar)), + in, in, in, out) is semidet. +:- mode type_util__get_cons_id_arg_types_2(in(bound(abort_on_exist_qvar)), + in, in, in, out) is det. + +type_util__get_cons_id_arg_types_2(EQVarAction, ModuleInfo, VarType, ConsId, + ArgTypes) :- ( % The argument types of a tuple cons_id are the % arguments of the tuple type. @@ -796,8 +831,17 @@ type_util__get_cons_id_arg_types(ModuleInfo, VarType, ConsId, ArgTypes) :- term__term_list_to_var_list(TypeDefnParams, TypeDefnVars), % XXX handle ExistQVars - require(unify(ExistQVars0, []), - "type_util__get_cons_id_arg_types: existentially typed cons_id"), + ( ExistQVars0 = [] -> + true + ; + ( + EQVarAction = abort_on_exist_qvar, + error("type_util__get_cons_id_arg_types: existentially typed cons_id") + ; + EQVarAction = fail_on_exist_qvar, + fail + ) + ), map__from_corresponding_lists(TypeDefnVars, TypeArgs, TSubst), assoc_list__values(Args, ArgTypes0), @@ -806,6 +850,31 @@ type_util__get_cons_id_arg_types(ModuleInfo, VarType, ConsId, ArgTypes) :- ArgTypes = [] ). +type_util__cons_id_arg_types(ModuleInfo, VarType, ConsId, ArgTypes) :- + type_to_type_id(VarType, TypeId, TypeArgs), + module_info_types(ModuleInfo, Types), + map__search(Types, TypeId, TypeDefn), + hlds_data__get_type_defn_body(TypeDefn, TypeDefnBody), + TypeDefnBody = du_type(_, ConsTags, _, _), + map__member(ConsTags, ConsId, _), + + module_info_ctors(ModuleInfo, Ctors), + map__lookup(Ctors, ConsId, ConsDefns), + list__member(ConsDefn, ConsDefns), + + ConsDefn = hlds_cons_defn(ExistQVars0, _, Args, TypeId, _), + + % XXX handle ExistQVars + ExistQVars0 = [], + + hlds_data__get_type_defn_tparams(TypeDefn, TypeDefnParams), + term__term_list_to_var_list(TypeDefnParams, TypeDefnVars), + + map__from_corresponding_lists(TypeDefnVars, TypeArgs, TSubst), + assoc_list__values(Args, ArgTypes0), + term__apply_substitution_to_list(ArgTypes0, TSubst, ArgTypes). + + type_util__is_existq_cons(ModuleInfo, VarType, ConsId) :- type_util__is_existq_cons(ModuleInfo, VarType, ConsId, _). diff --git a/compiler/unify_proc.m b/compiler/unify_proc.m index 8ace13e46..12c4c55bc 100644 --- a/compiler/unify_proc.m +++ b/compiler/unify_proc.m @@ -62,18 +62,18 @@ % Add a new request for a unification procedure to the % proc_requests table. -:- pred unify_proc__request_unify(unify_proc_id, determinism, prog_context, - module_info, module_info). -:- mode unify_proc__request_unify(in, in, in, in, out) is det. +:- pred unify_proc__request_unify(unify_proc_id, inst_varset, + determinism, prog_context, module_info, module_info). +:- mode unify_proc__request_unify(in, in, in, in, in, 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 unify_proc__request_proc(pred_id, list(mode), maybe(list(is_live)), - maybe(determinism), prog_context, - module_info, proc_id, module_info). -:- mode unify_proc__request_proc(in, in, in, in, in, in, out, out) is det. +:- pred unify_proc__request_proc(pred_id, list(mode), inst_varset, + maybe(list(is_live)), maybe(determinism), prog_context, + module_info, proc_id, module_info). +:- mode unify_proc__request_proc(in, in, in, in, in, in, in, out, out) is det. % unify_proc__add_lazily_generated_unify_pred(TypeId, % UnifyPredId_for_Type, ModuleInfo0, ModuleInfo). @@ -237,8 +237,8 @@ unify_proc__search_mode_num(ModuleInfo, TypeId, UniMode, Determinism, ProcId) :- %-----------------------------------------------------------------------------% -unify_proc__request_unify(UnifyId, Determinism, Context, ModuleInfo0, - ModuleInfo) :- +unify_proc__request_unify(UnifyId, InstVarSet, Determinism, Context, + ModuleInfo0, ModuleInfo) :- % % check if this unification has already been requested, or % if the proc is hand defined. @@ -291,7 +291,7 @@ unify_proc__request_unify(UnifyId, Determinism, Context, ModuleInfo0, ArgLives = no, % XXX ArgLives should be part of the UnifyId - unify_proc__request_proc(PredId, ArgModes, ArgLives, + unify_proc__request_proc(PredId, ArgModes, InstVarSet, ArgLives, yes(Determinism), Context, ModuleInfo1, ProcId, ModuleInfo2), @@ -306,8 +306,8 @@ unify_proc__request_unify(UnifyId, Determinism, Context, ModuleInfo0, ModuleInfo) ). -unify_proc__request_proc(PredId, ArgModes, ArgLives, MaybeDet, Context, - ModuleInfo0, ProcId, ModuleInfo) :- +unify_proc__request_proc(PredId, ArgModes, InstVarSet, ArgLives, MaybeDet, + Context, ModuleInfo0, ProcId, ModuleInfo) :- % % create a new proc_info for this procedure % @@ -315,7 +315,7 @@ unify_proc__request_proc(PredId, ArgModes, ArgLives, MaybeDet, Context, map__lookup(Preds0, PredId, PredInfo0), list__length(ArgModes, Arity), DeclaredArgModes = no, - add_new_proc(PredInfo0, Arity, ArgModes, DeclaredArgModes, + add_new_proc(PredInfo0, InstVarSet, Arity, ArgModes, DeclaredArgModes, ArgLives, MaybeDet, Context, address_is_not_taken, PredInfo1, ProcId), @@ -1076,11 +1076,11 @@ unify_proc__generate_du_compare_clauses_2(Type, Ctors, Res, X, Y, Context, { goal_info_init(GoalInfo0) }, { goal_info_set_context(GoalInfo0, Context, GoalInfo) }, - { instmap_delta_from_assoc_list([X_Index - ground(shared, no)], + { instmap_delta_from_assoc_list([X_Index - ground(shared, none)], X_InstmapDelta) }, unify_proc__build_specific_call(Type, index, [X, X_Index], X_InstmapDelta, det, Context, Call_X_Index), - { instmap_delta_from_assoc_list([Y_Index - ground(shared, no)], + { instmap_delta_from_assoc_list([Y_Index - ground(shared, none)], Y_InstmapDelta) }, unify_proc__build_specific_call(Type, index, [Y, Y_Index], Y_InstmapDelta, det, Context, Call_Y_Index), diff --git a/compiler/unique_modes.m b/compiler/unique_modes.m index a2284cac9..ca9193947 100644 --- a/compiler/unique_modes.m +++ b/compiler/unique_modes.m @@ -194,10 +194,12 @@ select_changed_inst_vars([Var | Vars], DeltaInstMap, ModeInfo, ChangedVars) :- mode_info_get_module_info(ModeInfo, ModuleInfo), mode_info_get_instmap(ModeInfo, InstMap0), instmap__lookup_var(InstMap0, Var, Inst0), + mode_info_get_var_types(ModeInfo, VarTypes), + map__lookup(VarTypes, Var, Type), ( instmap_delta_is_reachable(DeltaInstMap), instmap_delta_search_var(DeltaInstMap, Var, Inst), - \+ inst_matches_final(Inst, Inst0, ModuleInfo) + \+ inst_matches_final(Inst, Inst0, Type, ModuleInfo) -> ChangedVars = [Var | ChangedVars1], select_changed_inst_vars(Vars, DeltaInstMap, ModeInfo, @@ -615,8 +617,9 @@ unique_modes__check_call_modes(ArgVars, ProcArgModes, ArgOffset, mode_list_get_initial_insts(ProcArgModes, ModuleInfo, InitialInsts), modecheck_var_has_inst_list(ArgVars, InitialInsts, ArgOffset, - ModeInfo0, ModeInfo1), - mode_list_get_final_insts(ProcArgModes, ModuleInfo, FinalInsts), + InstVarSub, ModeInfo0, ModeInfo1), + mode_list_get_final_insts(ProcArgModes, ModuleInfo, FinalInsts0), + inst_list_apply_substitution(FinalInsts0, InstVarSub, FinalInsts), modecheck_set_var_inst_list(ArgVars, InitialInsts, FinalInsts, ArgOffset, NewArgVars, ExtraGoals, ModeInfo1, ModeInfo2), ( NewArgVars = ArgVars, ExtraGoals = no_extra_goals -> diff --git a/compiler/unneeded_code.m b/compiler/unneeded_code.m index a8cfdf944..4416b696d 100644 --- a/compiler/unneeded_code.m +++ b/compiler/unneeded_code.m @@ -292,7 +292,7 @@ unneeded_code__process_proc(ProcInfo0, ProcInfo, ModuleInfo0, ModuleInfo, Limit), Options = option_values(FullyStrict, ReorderConj, Limit), unneeded_code__process_goal(Goal0, Goal1, InstMap0, InstMap, - ModuleInfo0, Options, WhereNeededMap1, _, + VarTypes0, ModuleInfo0, Options, WhereNeededMap1, _, RefinedGoals0, RefinedGoals1, no, Changed), unneeded_code__refine_goal(Goal1, RefinedGoals1, Goal2, RefinedGoals), require(map__is_empty(RefinedGoals), @@ -301,11 +301,12 @@ unneeded_code__process_proc(ProcInfo0, ProcInfo, ModuleInfo0, ModuleInfo, % We need to fix up the goal_info by recalculating % the nonlocal vars and the non-atomic instmap deltas. proc_info_headvars(ProcInfo0, HeadVars), + proc_info_inst_varset(ProcInfo0, InstVarSet), implicitly_quantify_clause_body(HeadVars, Goal2, Varset0, VarTypes0, Goal3, Varset, VarTypes, _Warnings), - recompute_instmap_delta(no, Goal3, Goal, - VarTypes, InstMap0, ModuleInfo0, ModuleInfo1), + recompute_instmap_delta(no, Goal3, Goal, VarTypes, InstVarSet, + InstMap0, ModuleInfo0, ModuleInfo1), proc_info_set_goal(ProcInfo1, Goal, ProcInfo2), proc_info_set_varset(ProcInfo2, Varset, ProcInfo3), proc_info_set_vartypes(ProcInfo3, VarTypes, ProcInfo4), @@ -318,21 +319,21 @@ unneeded_code__process_proc(ProcInfo0, ProcInfo, ModuleInfo0, ModuleInfo, Successful = no ). -:- pred unneeded_code__process_goal(hlds_goal::in, hlds_goal::out, - instmap::in, instmap::in, module_info::in, option_values::in, +:- pred unneeded_code__process_goal(hlds_goal::in, hlds_goal::out, instmap::in, + instmap::in, vartypes::in, module_info::in, option_values::in, where_needed_map::in, where_needed_map::out, refined_goal_map::in, refined_goal_map::out, bool::in, bool::out) is det. -unneeded_code__process_goal(Goal0, Goal, InstMap0, InstMap, ModuleInfo, - Options, WhereNeededMap0, WhereNeededMap, +unneeded_code__process_goal(Goal0, Goal, InstMap0, InstMap, VarTypes, + ModuleInfo, Options, WhereNeededMap0, WhereNeededMap, RefinedGoals0, RefinedGoals, Changed0, Changed) :- unneeded_code__can_eliminate_or_move(Goal0, InstMap0, InstMap, - ModuleInfo, Options, WhereNeededMap0, WhereInfo), + VarTypes, ModuleInfo, Options, WhereNeededMap0, WhereInfo), ( WhereInfo = everywhere, unneeded_code__process_goal_internal(Goal0, Goal, - InstMap0, InstMap, ModuleInfo, Options, + InstMap0, InstMap, VarTypes, ModuleInfo, Options, WhereNeededMap0, WhereNeededMap1, RefinedGoals0, RefinedGoals, Changed0, Changed) ; @@ -392,13 +393,14 @@ unneeded_code__insert_branch_arm_into_refined_goals(Goal, GoalPath, BranchNum, %-----------------------------------------------------------------------------% -:- pred unneeded_code__can_eliminate_or_move(hlds_goal::in, - instmap::in, instmap::in, module_info::in, option_values::in, +:- pred unneeded_code__can_eliminate_or_move(hlds_goal::in, instmap::in, + instmap::in, vartypes::in, module_info::in, option_values::in, where_needed_map::in, where_needed::out) is det. -unneeded_code__can_eliminate_or_move(Goal, InstMap0, InstMap, ModuleInfo, - Options, WhereNeededMap, WhereInfo) :- - instmap_changed_vars(InstMap0, InstMap, ModuleInfo, ChangedVarSet), +unneeded_code__can_eliminate_or_move(Goal, InstMap0, InstMap, VarTypes, + ModuleInfo, Options, WhereNeededMap, WhereInfo) :- + instmap_changed_vars(InstMap0, InstMap, VarTypes, ModuleInfo, + ChangedVarSet), set__to_sorted_list(ChangedVarSet, ChangedVars), map__init(Empty), WhereInfo0 = branches(Empty), @@ -582,13 +584,13 @@ unneeded_code__demand_var_everywhere(_Var, _WhereNeeded0, everywhere). %---------------------------------------------------------------------------% :- pred unneeded_code__process_goal_internal(hlds_goal::in, hlds_goal::out, - instmap::in, instmap::in, module_info::in, option_values::in, - where_needed_map::in, where_needed_map::out, + instmap::in, instmap::in, vartypes::in, module_info::in, + option_values::in, where_needed_map::in, where_needed_map::out, refined_goal_map::in, refined_goal_map::out, bool::in, bool::out) is det. unneeded_code__process_goal_internal(Goal0, Goal, InstMap0, InstMap, - ModuleInfo, Options, WhereNeededMap0, WhereNeededMap, + VarTypes, ModuleInfo, Options, WhereNeededMap0, WhereNeededMap, RefinedGoals0, RefinedGoals, Changed0, Changed) :- Goal0 = GoalExpr0 - GoalInfo0, % Goal = GoalExpr - GoalInfo, @@ -630,7 +632,7 @@ unneeded_code__process_goal_internal(Goal0, Goal, InstMap0, InstMap, ; GoalExpr0 = conj(Conjuncts0), unneeded_code__process_conj(Conjuncts0, Conjuncts, - InstMap0, InstMap, ModuleInfo, Options, + InstMap0, InstMap, VarTypes, ModuleInfo, Options, WhereNeededMap0, WhereNeededMap, RefinedGoals0, RefinedGoals, Changed0, Changed), GoalExpr = conj(Conjuncts), @@ -654,7 +656,7 @@ unneeded_code__process_goal_internal(Goal0, Goal, InstMap0, InstMap, WhereNeededMap0, WhereNeededMap1), map__init(BranchNeededMap0), unneeded_code__process_cases(Cases0, BranchPoint, 1, - InstMap0, InstMap, ModuleInfo, Options, + InstMap0, InstMap, VarTypes, ModuleInfo, Options, GoalPath, Cases, WhereNeededMap1, BranchNeededMap0, BranchNeededMap, RefinedGoals0, RefinedGoals, Changed0, Changed), @@ -670,7 +672,7 @@ unneeded_code__process_goal_internal(Goal0, Goal, InstMap0, InstMap, map__map_values(unneeded_code__demand_var_everywhere, WhereNeededMap0, WhereNeededMap1), unneeded_code__process_disj(Disjuncts0, InstMap0, InstMap, - ModuleInfo, Options, GoalPath, Disjuncts, + VarTypes, ModuleInfo, Options, GoalPath, Disjuncts, WhereNeededMap1, WhereNeededMap1, WhereNeededMap, RefinedGoals0, RefinedGoals, Changed0, Changed), GoalExpr = disj(Disjuncts, StoreMap), @@ -682,15 +684,16 @@ unneeded_code__process_goal_internal(Goal0, Goal, InstMap0, InstMap, map__map_values(unneeded_code__demand_var_everywhere, WhereNeededMap0, WhereNeededMap1), unneeded_code__process_ite(Cond0, Then0, Else0, BranchPoint, - InstMap0, InstMap, ModuleInfo, Options, GoalPath, - Cond, Then, Else, WhereNeededMap1, WhereNeededMap, - RefinedGoals0, RefinedGoals, Changed0, Changed), + InstMap0, InstMap, VarTypes, ModuleInfo, Options, + GoalPath, Cond, Then, Else, WhereNeededMap1, + WhereNeededMap, RefinedGoals0, RefinedGoals, Changed0, + Changed), GoalExpr = if_then_else(Quant, Cond, Then, Else, StoreMap), Goal = GoalExpr - GoalInfo0 ; GoalExpr0 = not(NegGoal0), unneeded_code__process_goal(NegGoal0, NegGoal, - InstMap0, InstMap, ModuleInfo, Options, + InstMap0, InstMap, VarTypes, ModuleInfo, Options, WhereNeededMap0, WhereNeededMap, RefinedGoals0, RefinedGoals, Changed0, Changed), GoalExpr = not(NegGoal), @@ -698,7 +701,7 @@ unneeded_code__process_goal_internal(Goal0, Goal, InstMap0, InstMap, ; GoalExpr0 = some(Vars, CanRemove, SomeGoal0), unneeded_code__process_goal(SomeGoal0, SomeGoal, - InstMap0, InstMap, ModuleInfo, Options, + InstMap0, InstMap, VarTypes, ModuleInfo, Options, WhereNeededMap0, WhereNeededMap, RefinedGoals0, RefinedGoals, Changed0, Changed), GoalExpr = some(Vars, CanRemove, SomeGoal), @@ -714,19 +717,18 @@ unneeded_code__process_goal_internal(Goal0, Goal, InstMap0, InstMap, ---> bracketed_goal(hlds_goal, instmap, instmap). :- pred unneeded_code__process_conj(list(hlds_goal)::in, list(hlds_goal)::out, - instmap::in, instmap::in, module_info::in, option_values::in, - where_needed_map::in, where_needed_map::out, + instmap::in, instmap::in, vartypes::in, module_info::in, + option_values::in, where_needed_map::in, where_needed_map::out, refined_goal_map::in, refined_goal_map::out, bool::in, bool::out) is det. -unneeded_code__process_conj(Goals0, Goals, InstMap0, _InstMap, ModuleInfo, -Options, - WhereNeededMap0, WhereNeededMap, RefinedGoals0, RefinedGoals, - Changed0, Changed) :- +unneeded_code__process_conj(Goals0, Goals, InstMap0, _InstMap, VarTypes, + ModuleInfo, Options, WhereNeededMap0, WhereNeededMap, + RefinedGoals0, RefinedGoals, Changed0, Changed) :- unneeded_code__build_bracketed_conj(Goals0, InstMap0, BracketedGoals), list__reverse(BracketedGoals, RevBracketedGoals), unneeded_code__process_rev_bracketed_conj(RevBracketedGoals, RevGoals, - ModuleInfo, Options, WhereNeededMap0, WhereNeededMap, + VarTypes, ModuleInfo, Options, WhereNeededMap0, WhereNeededMap, RefinedGoals0, RefinedGoals, Changed0, Changed), list__reverse(RevGoals, Goals). @@ -749,23 +751,24 @@ unneeded_code__build_bracketed_conj([Goal | Goals], InstMap0, BracketedGoals) ). :- pred unneeded_code__process_rev_bracketed_conj(list(bracketed_goal)::in, - list(hlds_goal)::out, module_info::in, option_values::in, + list(hlds_goal)::out, vartypes::in, module_info::in, option_values::in, where_needed_map::in, where_needed_map::out, refined_goal_map::in, refined_goal_map::out, bool::in, bool::out) is det. -unneeded_code__process_rev_bracketed_conj([], [], _, _, +unneeded_code__process_rev_bracketed_conj([], [], _, _, _, WhereNeededMap, WhereNeededMap, RefinedGoals, RefinedGoals, Changed, Changed). unneeded_code__process_rev_bracketed_conj([BracketedGoal | BracketedGoals], - Goals, ModuleInfo, Options, WhereNeededMap0, WhereNeededMap, - RefinedGoals0, RefinedGoals, Changed0, Changed) :- + Goals, VarTypes, ModuleInfo, Options, WhereNeededMap0, + WhereNeededMap, RefinedGoals0, RefinedGoals, Changed0, + Changed) :- BracketedGoal = bracketed_goal(Goal0, InstMap0, InstMap), unneeded_code__process_goal(Goal0, Goal1, InstMap0, InstMap, - ModuleInfo, Options, WhereNeededMap0, WhereNeededMap1, + VarTypes, ModuleInfo, Options, WhereNeededMap0, WhereNeededMap1, RefinedGoals0, RefinedGoals1, Changed0, Changed1), - unneeded_code__process_rev_bracketed_conj(BracketedGoals, - Goals1, ModuleInfo, Options, WhereNeededMap1, WhereNeededMap, + unneeded_code__process_rev_bracketed_conj(BracketedGoals, Goals1, + VarTypes, ModuleInfo, Options, WhereNeededMap1, WhereNeededMap, RefinedGoals1, RefinedGoals, Changed1, Changed), ( true_goal(Goal1) -> Goals = Goals1 @@ -775,84 +778,85 @@ unneeded_code__process_rev_bracketed_conj([BracketedGoal | BracketedGoals], %---------------------------------------------------------------------------% -:- pred unneeded_code__process_disj(list(hlds_goal)::in, - instmap::in, instmap::in, module_info::in, option_values::in, +:- pred unneeded_code__process_disj(list(hlds_goal)::in, instmap::in, + instmap::in, vartypes::in, module_info::in, option_values::in, goal_path::in, list(hlds_goal)::out, where_needed_map::in, where_needed_map::in, where_needed_map::out, refined_goal_map::in, refined_goal_map::out, bool::in, bool::out) is det. -unneeded_code__process_disj([], _, _, _, _, _, [], +unneeded_code__process_disj([], _, _, _, _, _, _, [], _, WhereNeededMap, WhereNeededMap, RefinedGoals, RefinedGoals, Changed, Changed). -unneeded_code__process_disj([Goal0 | Goals0], InstMap0, InstMap, ModuleInfo, - Options, CurrentPath, [Goal | Goals], StartWhereNeededMap, - WhereNeededMap0, WhereNeededMap, +unneeded_code__process_disj([Goal0 | Goals0], InstMap0, InstMap, VarTypes, + ModuleInfo, Options, CurrentPath, [Goal | Goals], + StartWhereNeededMap, WhereNeededMap0, WhereNeededMap, RefinedGoals0, RefinedGoals, Changed0, Changed) :- - unneeded_code__process_goal(Goal0, Goal, InstMap0, InstMap, ModuleInfo, - Options, StartWhereNeededMap, WhereNeededMapFirst, + unneeded_code__process_goal(Goal0, Goal, InstMap0, InstMap, VarTypes, + ModuleInfo, Options, StartWhereNeededMap, WhereNeededMapFirst, RefinedGoals0, RefinedGoals1, Changed0, Changed1), map__to_assoc_list(WhereNeededMapFirst, WhereNeededList), unneeded_code__add_where_needed_list(WhereNeededList, CurrentPath, WhereNeededMap0, WhereNeededMap1), - unneeded_code__process_disj(Goals0, InstMap0, InstMap, ModuleInfo, - Options, CurrentPath, Goals, + unneeded_code__process_disj(Goals0, InstMap0, InstMap, VarTypes, + ModuleInfo, Options, CurrentPath, Goals, StartWhereNeededMap, WhereNeededMap1, WhereNeededMap, RefinedGoals1, RefinedGoals, Changed1, Changed). %---------------------------------------------------------------------------% :- pred unneeded_code__process_cases(list(case)::in, branch_point::in, int::in, - instmap::in, instmap::in, module_info::in, option_values::in, - goal_path::in, list(case)::out, where_needed_map::in, + instmap::in, instmap::in, vartypes::in, module_info::in, + option_values::in, goal_path::in, list(case)::out, where_needed_map::in, where_needed_map::in, where_needed_map::out, refined_goal_map::in, refined_goal_map::out, bool::in, bool::out) is det. -unneeded_code__process_cases([], _, _, _, _, _, _, _, [], +unneeded_code__process_cases([], _, _, _, _, _, _, _, _, [], _, WhereNeededMap, WhereNeededMap, RefinedGoals, RefinedGoals, Changed, Changed). unneeded_code__process_cases([case(Var, Goal0) | Cases0], BranchPoint, BranchNum, InstMap0, InstMap, - ModuleInfo, Options, CurrentPath, + VarTypes, ModuleInfo, Options, CurrentPath, [case(Var, Goal) | Cases], StartWhereNeededMap, WhereNeededMap0, WhereNeededMap, RefinedGoals0, RefinedGoals, Changed0, Changed) :- - unneeded_code__process_goal(Goal0, Goal, InstMap0, InstMap, ModuleInfo, - Options, StartWhereNeededMap, WhereNeededMapFirst, + unneeded_code__process_goal(Goal0, Goal, InstMap0, InstMap, VarTypes, + ModuleInfo, Options, StartWhereNeededMap, WhereNeededMapFirst, RefinedGoals0, RefinedGoals1, Changed0, Changed1), map__to_assoc_list(WhereNeededMapFirst, WhereNeededList), unneeded_code__add_alt_start(WhereNeededList, BranchPoint, BranchNum, CurrentPath, WhereNeededMap0, WhereNeededMap1), unneeded_code__process_cases(Cases0, BranchPoint, BranchNum + 1, - InstMap0, InstMap, ModuleInfo, Options, CurrentPath, Cases, - StartWhereNeededMap, WhereNeededMap1, WhereNeededMap, + InstMap0, InstMap, VarTypes, ModuleInfo, Options, CurrentPath, + Cases, StartWhereNeededMap, WhereNeededMap1, WhereNeededMap, RefinedGoals1, RefinedGoals, Changed1, Changed). %---------------------------------------------------------------------------% :- pred unneeded_code__process_ite(hlds_goal::in, hlds_goal::in, hlds_goal::in, - branch_point::in, instmap::in, instmap::in, module_info::in, - option_values::in, goal_path::in, + branch_point::in, instmap::in, instmap::in, vartypes::in, + module_info::in, option_values::in, goal_path::in, hlds_goal::out, hlds_goal::out, hlds_goal::out, where_needed_map::in, where_needed_map::out, refined_goal_map::in, refined_goal_map::out, bool::in, bool::out) is det. unneeded_code__process_ite(Cond0, Then0, Else0, BranchPoint, - InstMap0, InstMap, ModuleInfo, Options, CurrentPath, + InstMap0, InstMap, VarTypes, ModuleInfo, Options, CurrentPath, Cond, Then, Else, WhereNeededMap0, WhereNeededMap, RefinedGoals0, RefinedGoals, Changed0, Changed) :- Cond0 = _ - CondInfo0, goal_info_get_instmap_delta(CondInfo0, InstMapDelta), instmap__apply_instmap_delta(InstMap0, InstMapDelta, InstMapCond), - unneeded_code__process_goal(Else0, Else, InstMap0, InstMap, + unneeded_code__process_goal(Else0, Else, InstMap0, InstMap, VarTypes, ModuleInfo, Options, WhereNeededMap0, WhereNeededMapElse, RefinedGoals0, RefinedGoals1, Changed0, Changed1), unneeded_code__process_goal(Then0, Then, InstMapCond, InstMap, - ModuleInfo, Options, WhereNeededMap0, WhereNeededMapThen, - RefinedGoals1, RefinedGoals2, Changed1, Changed2), + VarTypes, ModuleInfo, Options, WhereNeededMap0, + WhereNeededMapThen, RefinedGoals1, RefinedGoals2, Changed1, + Changed2), map__init(BranchNeededMap0), map__to_assoc_list(WhereNeededMapElse, WhereNeededListElse), @@ -865,8 +869,8 @@ unneeded_code__process_ite(Cond0, Then0, Else0, BranchPoint, WhereNeededMap0, BranchNeededMap, WhereNeededMapCond), unneeded_code__process_goal(Cond0, Cond, InstMap0, InstMapCond, - ModuleInfo, Options, WhereNeededMapCond, WhereNeededMap, - RefinedGoals2, RefinedGoals, Changed2, Changed). + VarTypes, ModuleInfo, Options, WhereNeededMapCond, + WhereNeededMap, RefinedGoals2, RefinedGoals, Changed2, Changed). %---------------------------------------------------------------------------% diff --git a/compiler/unused_args.m b/compiler/unused_args.m index 762627892..ab82a724d 100644 --- a/compiler/unused_args.m +++ b/compiler/unused_args.m @@ -265,7 +265,8 @@ setup_pred_args(ModuleInfo, PredId, [ProcId | Rest], UnusedArgInfo, VarUsage0, ), proc_info_goal(ProcInfo, Goal - _), - traverse_goal(ModuleInfo, Goal, VarDep3, VarDep), + Info = traverse_info(ModuleInfo, VarTypes), + traverse_goal(Info, Goal, VarDep3, VarDep), map__set(VarUsage0, proc(PredId, ProcId), VarDep, VarUsage1), PredProcs1 = [proc(PredId, ProcId) | PredProcs0], OptProcs1 = OptProcs0 @@ -378,49 +379,56 @@ lookup_local_var(VarDep, Var, UsageInfo) :- % Traversal of goal structure, building up dependencies for all % variables. -:- pred traverse_goal(module_info::in, hlds_goal_expr::in, +:- type traverse_info + ---> traverse_info( + module_info :: module_info, + vartypes :: vartypes + ). + +:- pred traverse_goal(traverse_info::in, hlds_goal_expr::in, var_dep::in, var_dep::out) is det. % handle conjunction -traverse_goal(ModuleInfo, conj(Goals), UseInf0, UseInf) :- - traverse_list_of_goals(ModuleInfo, Goals, UseInf0, UseInf). +traverse_goal(Info, conj(Goals), UseInf0, UseInf) :- + traverse_list_of_goals(Info, Goals, UseInf0, UseInf). % handle parallel conjunction -traverse_goal(ModuleInfo, par_conj(Goals, _SM), UseInf0, UseInf) :- - traverse_list_of_goals(ModuleInfo, Goals, UseInf0, UseInf). +traverse_goal(Info, par_conj(Goals, _SM), UseInf0, UseInf) :- + traverse_list_of_goals(Info, Goals, UseInf0, UseInf). % handle disjunction -traverse_goal(ModuleInfo, disj(Goals, _), UseInf0, UseInf) :- - traverse_list_of_goals(ModuleInfo, Goals, UseInf0, UseInf). +traverse_goal(Info, disj(Goals, _), UseInf0, UseInf) :- + traverse_list_of_goals(Info, Goals, UseInf0, UseInf). % handle switch -traverse_goal(ModuleInfo, switch(Var, _, Cases, _), UseInf0, UseInf) :- +traverse_goal(Info, switch(Var, _, Cases, _), UseInf0, UseInf) :- set_var_used(Var, UseInf0, UseInf1), list_case_to_list_goal(Cases, Goals), - traverse_list_of_goals(ModuleInfo, Goals, UseInf1, UseInf). + traverse_list_of_goals(Info, Goals, UseInf1, UseInf). % handle predicate call -traverse_goal(ModuleInfo, call(PredId, ProcId, Args, _, _, _), +traverse_goal(Info, call(PredId, ProcId, Args, _, _, _), UseInf0, UseInf) :- - module_info_pred_proc_info(ModuleInfo, PredId, ProcId, _Pred, Proc), + module_info_pred_proc_info(Info^module_info, PredId, ProcId, _Pred, + Proc), proc_info_headvars(Proc, HeadVars), add_pred_call_arg_dep(proc(PredId, ProcId), Args, HeadVars, UseInf0, UseInf). % handle if then else -traverse_goal(ModuleInfo, if_then_else(_, Cond - _, Then - _, Else - _, _), +traverse_goal(Info, if_then_else(_, Cond - _, Then - _, Else - _, _), UseInf0, UseInf) :- - traverse_goal(ModuleInfo, Cond, UseInf0, UseInf1), - traverse_goal(ModuleInfo, Then, UseInf1, UseInf2), - traverse_goal(ModuleInfo, Else, UseInf2, UseInf). + traverse_goal(Info, Cond, UseInf0, UseInf1), + traverse_goal(Info, Then, UseInf1, UseInf2), + traverse_goal(Info, Else, UseInf2, UseInf). % handle negation -traverse_goal(ModuleInfo, not(Goal - _), UseInf0, UseInf) :- - traverse_goal(ModuleInfo, Goal, UseInf0, UseInf). +traverse_goal(Info, not(Goal - _), UseInf0, UseInf) :- + traverse_goal(Info, Goal, UseInf0, UseInf). % handle quantification -traverse_goal(ModuleInfo, some(_, _, Goal - _), UseInf0, UseInf) :- - traverse_goal(ModuleInfo, Goal, UseInf0, UseInf). +traverse_goal(Info, some(_, _, Goal - _), UseInf0, UseInf) :- + traverse_goal(Info, Goal, UseInf0, UseInf). % we assume that higher-order predicate calls use all variables involved traverse_goal(_, generic_call(GenericCall, Args, _, _), UseInf0, UseInf) :- @@ -454,11 +462,11 @@ traverse_goal(_, unify(_, _, _, assign(Var1, Var2), _), UseInf0, UseInf) :- add_aliases(UseInf0, Var2, [Var1], UseInf) ). -traverse_goal(ModuleInfo, - unify(Var1, _, _, +traverse_goal(Info, + unify(Var1, _, _, deconstruct(_, _, Args, Modes, CanFail, _), _), UseInf0, UseInf) :- - partition_deconstruct_args(ModuleInfo, Args, + partition_deconstruct_args(Info, Args, Modes, InputVars, OutputVars), % The deconstructed variable is used if any of the % variables, that the deconstruction binds are used. @@ -537,23 +545,27 @@ add_arg_dep(UseInf0, Var, PredProc, Arg, UseInf) :- % Partition the arguments to a deconstruction into inputs % and outputs. -:- pred partition_deconstruct_args(module_info::in, list(prog_var)::in, +:- pred partition_deconstruct_args(traverse_info::in, list(prog_var)::in, list(uni_mode)::in, list(prog_var)::out, list(prog_var)::out) is det. -partition_deconstruct_args(ModuleInfo, ArgVars, ArgModes, - InputVars, OutputVars) :- +partition_deconstruct_args(Info, ArgVars, ArgModes, InputVars, OutputVars) :- ( ArgVars = [Var | Vars], ArgModes = [Mode | Modes] -> - partition_deconstruct_args(ModuleInfo, - Vars, Modes, InputVars1, OutputVars1), + partition_deconstruct_args(Info, Vars, Modes, InputVars1, + OutputVars1), Mode = ((InitialInst1 - InitialInst2) -> (FinalInst1 - FinalInst2)), + map__lookup(Info^vartypes, Var, Type), + % If the inst of the argument of the LHS is changed, % the argument is input. - ( inst_matches_binding(InitialInst1, FinalInst1, ModuleInfo) -> + ( + inst_matches_binding(InitialInst1, FinalInst1, + Type, Info^module_info) + -> InputVars = InputVars1 ; InputVars = [Var | InputVars1] @@ -561,7 +573,10 @@ partition_deconstruct_args(ModuleInfo, ArgVars, ArgModes, % If the inst of the argument of the RHS is changed, % the argument is output. - ( inst_matches_binding(InitialInst2, FinalInst2, ModuleInfo) -> + ( + inst_matches_binding(InitialInst2, FinalInst2, + Type, Info^module_info) + -> OutputVars = OutputVars1 ; OutputVars = [Var | OutputVars1] @@ -600,13 +615,13 @@ list_case_to_list_goal([case(_, Goal) | Cases], [Goal | Goals]) :- list_case_to_list_goal(Cases, Goals). -:- pred traverse_list_of_goals(module_info::in, list(hlds_goal)::in, +:- pred traverse_list_of_goals(traverse_info::in, list(hlds_goal)::in, var_dep::in, var_dep::out) is det. traverse_list_of_goals(_, [], UseInf, UseInf). -traverse_list_of_goals(ModuleInfo, [Goal - _ | Goals], UseInf0, UseInf) :- - traverse_goal(ModuleInfo, Goal, UseInf0, UseInf1), - traverse_list_of_goals(ModuleInfo, Goals, UseInf1, UseInf). +traverse_list_of_goals(Info, [Goal - _ | Goals], UseInf0, UseInf) :- + traverse_goal(Info, Goal, UseInf0, UseInf1), + traverse_list_of_goals(Info, Goals, UseInf1, UseInf). %------------------------------------------------------------------------------- diff --git a/tests/invalid/Mmakefile b/tests/invalid/Mmakefile index fe376fd23..9152beec7 100644 --- a/tests/invalid/Mmakefile +++ b/tests/invalid/Mmakefile @@ -90,7 +90,6 @@ SINGLEMODULE_SOURCES= \ typeclass_test_9.m \ types.m \ type_spec.m \ - unbound_inst_var.m \ unbound_type_vars.m \ undef_lambda_mode.m \ undef_mode.m \ diff --git a/tests/invalid/unbound_inst_var.err_exp b/tests/invalid/unbound_inst_var.err_exp deleted file mode 100644 index 352fc6757..000000000 --- a/tests/invalid/unbound_inst_var.err_exp +++ /dev/null @@ -1,5 +0,0 @@ -unbound_inst_var.m:019: In mode declaration for predicate `unbound_inst_var:test/1': -unbound_inst_var.m:019: error: unbound inst variable(s). -unbound_inst_var.m:019: (Sorry, polymorphic modes are not supported.) -unbound_inst_var.m:018: Error: no mode declaration for predicate `unbound_inst_var:test/1'. -For more information, try recompiling with `-E'. diff --git a/tests/valid/Mmakefile b/tests/valid/Mmakefile index c986acd89..5c6370d00 100644 --- a/tests/valid/Mmakefile +++ b/tests/valid/Mmakefile @@ -139,6 +139,7 @@ OTHER_SOURCES= \ two_pragma_c_codes.m \ two_way_unif.m \ type_inf_ambig_test.m \ + unbound_inst_var.m \ unbound_tvar_in_lambda.m \ undead_proc.m \ unify_typeinfo_bug.m \ diff --git a/tests/invalid/unbound_inst_var.m b/tests/valid/unbound_inst_var.m similarity index 52% rename from tests/invalid/unbound_inst_var.m rename to tests/valid/unbound_inst_var.m index 44f62513e..d3c03001c 100644 --- a/tests/invalid/unbound_inst_var.m +++ b/tests/valid/unbound_inst_var.m @@ -11,19 +11,26 @@ :- import_module char. -:- type all(X) ---> a(X) ; b ; c ; d. +:- type all(X) ---> a(X). -:- inst all(X) ---> a(X) ; ground. +:- inst all(X) ---> a(X). -:- pred test(all(char)). -:- mode test(in(all(_))) is det. +:- pred test(all(char), all(char)). +:- mode test(in(all(I)), out(all(I))) is det. -test(_) :- true. +:- pred try_test is det. + +test(X, X). %:- pred main(io__state,io__state). %:- mode main(di,uo) is det. main(IO,IO) :- - true. + true. + +try_test :- + ( C = a ; C = b ; C = c), + test(a(C), a(D)), + ( D = a ; D = b ; D = c). :- end_module unbound_inst_var.