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.