%---------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %---------------------------------------------------------------------------% % Copyright (C) 2008, 2010-2012 The University of Melbourne. % Copyright (C) 2014-2018, 2022-2025 The Mercury team. % This file may only be copied under the terms of the GNU General % Public License - see the file COPYING in the Mercury distribution. %---------------------------------------------------------------------------% % % File: program_representation_utils.m. % Author: pbone. % % Utilities for working with the program representation structures in the % mdbcomp library. This file is not part of the mdbcomp library, since it % contains routines only used by the deep profiling tools. Code here % should be moved into the mdbcomp.program_representation.m module % if it is to be used by other tools. % %---------------------------------------------------------------------------% :- module program_representation_utils. :- interface. :- import_module mdbcomp. :- import_module mdbcomp.goal_path. :- import_module mdbcomp.program_representation. :- import_module cord. :- import_module list. :- import_module set. :- import_module unit. %---------------------------------------------------------------------------% % Ugly-print a module to a string representation. We return a cord of % strings is returned rather than a string, since this reduces the cost % of string concatenations. % :- pred print_module_to_strings(module_rep::in, cord(string)::out) is det. % Print a procedure to a string representation using a higher order value % to lookup goal attributes. % :- pred print_proc_to_strings((func(goal_id) = GoalAnn)::in, proc_rep(goal_id)::in, cord(string)::out) is det <= goal_annotation(GoalAnn). % Print a procedure to a string representation. % :- pred print_proc_to_strings(proc_rep(GoalAnn)::in, cord(string)::out) is det <= goal_annotation(GoalAnn). % Print a proc label to a string. % :- pred print_proc_label_to_string(string_proc_label::in, string::out) is det. :- type print_goal_info(Key, GoalAnn) ---> print_goal_info( pgi_lookup_annotation :: (func(Key) = GoalAnn), pgi_var_name_table :: var_name_table ). % print_goal_to_strings(Lookup, VarTable, Indent, RevGoalPath, Goal, % Strings): % % Print a goal (recursively) to a string representation. % :- pred print_goal_to_strings(print_goal_info(T, GoalAnn)::in, int::in, reverse_goal_path::in, goal_rep(T)::in, cord(string)::out) is det <= goal_annotation(GoalAnn). %---------------------------------------------------------------------------% :- typeclass goal_annotation(T) where [ % Print the goal annotation for inclusion by print_proc_to_strings % above. % pred print_goal_annotation_to_strings(var_name_table::in, T::in, cord(cord(string))::out) is det ]. % A goal with no particular annotation has empty strings printed for goal % annotations. % :- instance goal_annotation(unit). %---------------------------------------------------------------------------% % Goal IDs are a more efficient way to identify goals than goal paths. % % The allow annotations to be kept in an array indexed by the goal id. % :- pred label_goals(goal_id::out, containing_goal_map::out, goal_rep(T)::in, goal_rep(goal_id)::out) is det. %---------------------------------------------------------------------------% % Search a program representation for the given procedure and return its % procedure representation if found, otherwise fail. % :- pred progrep_search_proc(prog_rep::in, string_proc_label::in, proc_rep::out) is semidet. %---------------------------------------------------------------------------% % A map of variables to instantiation states, Like inst_map within the % compiler. % :- type inst_map. % Build the initial inst for a procedure. % :- func initial_inst_map(proc_defn_rep(T)) = inst_map. % inst_map_ground_vars(Vars, DepVars, !InstMap, SeenDuplicateInstantiaton). % % Make the variables in the given list ground in the new copy of the inst % map. % % DepVars is the set of variables that each of the Vars directly depends % upon. % % SeenDuplicateInstantiation will be true iff at least one of these % variables is already ground. % :- pred inst_map_ground_vars(list(var_rep)::in, set(var_rep)::in, inst_map::in, inst_map::out, seen_duplicate_instantiation::out) is det. % Retrieve the instantiatedness of a variable, and variables that it's % binding depends upon from the instmap, if the variable is new ir_free is % returned and the variables it depends upon is the empty set. % :- pred inst_map_get(inst_map::in, var_rep::in, inst_rep::out, set(var_rep)::out) is det. % Retrieve all the variables this variable depends upon, indirect % dependencies are also returned. % :- pred inst_map_get_var_deps(inst_map::in, var_rep::in, set(var_rep)::out) is det. % Merge two inst maps from different branches of execution. % :- func merge_inst_map(inst_map, detism_rep, inst_map, detism_rep) = inst_map. % This type represents whether a traversal has seen more than one % instantiation of a variable within a single branch. If at the end of a % traversal a duplicate instantiation has been seen, we can either % accept a pessimistic default, or abort parallelisation of this particular % conjunction. % :- type seen_duplicate_instantiation ---> seen_duplicate_instantiation ; have_not_seen_duplicate_instantiation. :- func merge_seen_duplicate_instantiation(seen_duplicate_instantiation, seen_duplicate_instantiation) = seen_duplicate_instantiation. %---------------------------------------------------------------------------% % A difference between too inst maps. This lists the variables that are % instantiated by a particular goal. % :- type inst_map_delta. % Get the set of variables that are instantiated by this inst map. % :- pred inst_map_delta_get_var_set(inst_map_delta::in, set(var_rep)::out) is det. % The empty inst_map_delta. Nothing is instantiated. % :- pred empty_inst_map_delta(inst_map_delta::out) is det. :- func empty_inst_map_delta = inst_map_delta. % calc_inst_map_delta(InstMapBefore, InstMapAfter, InstMapDelta) % % Calculate the difference between two inst maps. % % InstMapAfter is InstMapBefore after the variables in InstMapDelta have % been instantiated. % :- pred calc_inst_map_delta(inst_map::in, inst_map::in, inst_map_delta::out) is det. %---------------------------------------------------------------------------% % Retrieve a set of all the vars involved with this atomic goal. % :- pred atomic_goal_get_vars(atomic_goal_rep::in, set(var_rep)::out) is det. %---------------------------------------------------------------------------% :- type atomic_goal_is_call ---> atomic_goal_is_call(list(var_rep)) ; atomic_goal_is_trivial. :- pred atomic_goal_is_call(atomic_goal_rep::in, atomic_goal_is_call::out) is det. %---------------------------------------------------------------------------% :- implementation. :- import_module mdbcomp.prim_data. :- import_module mdbcomp.sym_name. :- import_module bool. :- import_module counter. :- import_module int. :- import_module map. :- import_module maybe. :- import_module require. :- import_module std_util. :- import_module string. :- import_module uint. %---------------------------------------------------------------------------% print_module_to_strings(ModuleRep, Strings) :- ModuleRep = module_rep(ModuleName, _StringTable, OISUTypesProcs, TypeTableMap, ProcReps), HeaderString = string.format("Module %s\n", [s(ModuleName)]), list.foldl(accumulate_print_oisu_type_procs_to_strings, OISUTypesProcs, cord.empty, OISUStrs), map.foldl(accumulate_print_type_table_entries_to_strings, TypeTableMap, cord.empty, TypeTableStrs0), ( if cord.is_empty(TypeTableStrs0) then TypeTableStrs = TypeTableStrs0 else TypeTableStrs = cord.singleton("\nType table:\n") ++ TypeTableStrs0 ++ nl ), map.foldl(accumulate_print_proc_to_strings, ProcReps, cord.empty, ProcRepStrs), Strings = cord.singleton(HeaderString) ++ OISUStrs ++ TypeTableStrs ++ ProcRepStrs. %---------------------------------------------------------------------------% :- pred accumulate_print_oisu_type_procs_to_strings(oisu_type_procs::in, cord(string)::in, cord(string)::out) is det. accumulate_print_oisu_type_procs_to_strings(OISUTypeProcs, !Strings) :- print_oisu_type_procs_to_strings(OISUTypeProcs, OISUStr), !:Strings = !.Strings ++ OISUStr. :- pred print_oisu_type_procs_to_strings(oisu_type_procs::in, cord(string)::out) is det. print_oisu_type_procs_to_strings(OISUTypeProcs, Str) :- OISUTypeProcs = oisu_type_procs(TypeCtor, CreatorProcLabels, MutatorProcLabels, DestructorProcLabels), list.map(print_proc_label_to_string, CreatorProcLabels, CreatorStrs), list.map(print_proc_label_to_string, MutatorProcLabels, MutatorStrs), list.map(print_proc_label_to_string, DestructorProcLabels, DestructorStrs), CreatorNlCords = list.map(add_nl, CreatorStrs), MutatorNlCords = list.map(add_nl, MutatorStrs), DestructorNlCords = list.map(add_nl, DestructorStrs), Str = cord.from_list(["\nOISU type constructor ", TypeCtor]) ++ cord.cons("\nCreator procs:\n", cord.cord_list_to_cord(CreatorNlCords)) ++ cord.cons("\nMutator procs:\n", cord.cord_list_to_cord(MutatorNlCords)) ++ cord.cons("\nDestructor procs:\n", cord.cord_list_to_cord(DestructorNlCords)). %---------------------------------------------------------------------------% :- pred accumulate_print_type_table_entries_to_strings(int::in, type_rep::in, cord(string)::in, cord(string)::out) is det. accumulate_print_type_table_entries_to_strings(TypeNum, TypeRep, !Strings) :- string.int_to_string(TypeNum, TypeNumStr), type_rep_to_strings(TypeRep, TypeRepStrCord), Str = cord.singleton(TypeNumStr) ++ cord.singleton(" -> ") ++ TypeRepStrCord ++ cord.singleton("\n"), !:Strings = !.Strings ++ Str. :- pred type_rep_to_strings(type_rep::in, cord(string)::out) is det. type_rep_to_strings(TypeRep, Cord) :- ( TypeRep = defined_type_rep(TypeCtorSymName, ArgTypes), TypeCtorSymNameStr = sym_name_to_string(TypeCtorSymName), TypeCtorSymNameCord = cord.singleton(TypeCtorSymNameStr), ( ArgTypes = [], Cord = TypeCtorSymNameCord ; ArgTypes = [HeadTypeRep | TailTypeReps], arg_type_reps_to_strings(HeadTypeRep, TailTypeReps, ArgTypesCord), Cord = TypeCtorSymNameCord ++ cord.singleton("(") ++ ArgTypesCord ++ cord.singleton(")") ) ; TypeRep = builtin_type_rep(BuiltinTypeRep), ( BuiltinTypeRep = builtin_type_int_rep, TypeNameStr = "int" ; BuiltinTypeRep = builtin_type_uint_rep, TypeNameStr = "uint" ; BuiltinTypeRep = builtin_type_int8_rep, TypeNameStr = "int8" ; BuiltinTypeRep = builtin_type_uint8_rep, TypeNameStr = "uint8" ; BuiltinTypeRep = builtin_type_int16_rep, TypeNameStr = "int16" ; BuiltinTypeRep = builtin_type_uint16_rep, TypeNameStr = "uint16" ; BuiltinTypeRep = builtin_type_int32_rep, TypeNameStr = "int32" ; BuiltinTypeRep = builtin_type_uint32_rep, TypeNameStr = "uint32" ; BuiltinTypeRep = builtin_type_int64_rep, TypeNameStr = "int64" ; BuiltinTypeRep = builtin_type_uint64_rep, TypeNameStr = "uint64" ; BuiltinTypeRep = builtin_type_float_rep, TypeNameStr = "float" ; BuiltinTypeRep = builtin_type_string_rep, TypeNameStr = "string" ; BuiltinTypeRep = builtin_type_char_rep, TypeNameStr = "char" ), Cord = cord.singleton(TypeNameStr) ; TypeRep = tuple_type_rep(ArgTypes), ( ArgTypes = [], Cord = cord.singleton("{}") ; ArgTypes = [HeadTypeRep | TailTypeReps], arg_type_reps_to_strings(HeadTypeRep, TailTypeReps, ArgTypesCord), Cord = cord.singleton("{") ++ ArgTypesCord ++ cord.singleton("}") ) ; TypeRep = higher_order_type_rep(ArgTypes, MaybeResultType), ( MaybeResultType = no, ( ArgTypes = [], Cord = cord.singleton("pred ()") ; ArgTypes = [HeadTypeRep | TailTypeReps], arg_type_reps_to_strings(HeadTypeRep, TailTypeReps, ArgTypesCord), Cord = cord.singleton("pred(") ++ ArgTypesCord ++ cord.singleton(")") ) ; MaybeResultType = yes(ResultType), type_rep_to_strings(ResultType, ResultTypeCord), ( ArgTypes = [], Cord = cord.singleton("func = ") ++ ResultTypeCord ; ArgTypes = [HeadTypeRep | TailTypeReps], arg_type_reps_to_strings(HeadTypeRep, TailTypeReps, ArgTypesCord), Cord = cord.singleton("func(") ++ ArgTypesCord ++ cord.singleton(") = ") ++ ResultTypeCord ) ) ; TypeRep = type_var_rep(N), string.int_to_string(N, NStr), Cord = cord.singleton("T" ++ NStr) ). :- pred arg_type_reps_to_strings(type_rep::in, list(type_rep)::in, cord(string)::out) is det. arg_type_reps_to_strings(HeadTypeRep, [], Cord) :- type_rep_to_strings(HeadTypeRep, Cord). arg_type_reps_to_strings(HeadTypeRep, [HeadTailTypeRep | TailTailTypeReps], Cord) :- type_rep_to_strings(HeadTypeRep, HeadCord), arg_type_reps_to_strings(HeadTailTypeRep, TailTailTypeReps, TailCord), Cord = HeadCord ++ cord.singleton(", ") ++ TailCord. %---------------------------------------------------------------------------% % Print a procedure to a string representation. % :- pred accumulate_print_proc_to_strings(string_proc_label::in, proc_rep(GoalAnn)::in, cord(string)::in, cord(string)::out) is det <= goal_annotation(GoalAnn). accumulate_print_proc_to_strings(_, Proc, !Strings) :- print_proc_to_strings(Proc, ProcStrings), !:Strings = !.Strings ++ ProcStrings. print_proc_to_strings(Lookup, ProcRep, Strings) :- print_proc_to_strings_2(Lookup, ProcRep, Strings). print_proc_to_strings(ProcRep, Strings) :- print_proc_to_strings_2(id, ProcRep, Strings). :- pred print_proc_to_strings_2((func(X) = GoalAnn)::in, proc_rep(X)::in, cord(string)::out) is det <= goal_annotation(GoalAnn). print_proc_to_strings_2(Lookup, ProcRep, Strings) :- ProcRep = proc_rep(ProcLabel, ProcDefnRep), ProcDefnRep = proc_defn_rep(ArgVarReps, GoalRep, VarNameTable, MaybeVarTypeTable, Detism), print_proc_label_to_string(ProcLabel, ProcLabelString0), detism_to_string(Detism, DetismString), ProcLabelString = DetismString ++ cord.singleton(" ") ++ cord.singleton(ProcLabelString0), print_args_to_strings(print_head_var, VarNameTable, ArgVarReps, ArgsString), print_goal_to_strings(print_goal_info(Lookup, VarNameTable), 1, rgp_nil, GoalRep, GoalString), MainStrings = ProcLabelString ++ ArgsString ++ cord.singleton(" :-\n") ++ GoalString ++ nl, ( MaybeVarTypeTable = no, Strings = MainStrings ; MaybeVarTypeTable = yes(VarTypeTable), map.foldl(accumulate_var_type_table_entry_strings(VarNameTable), VarTypeTable, cord.init, TypeTableStrings), Strings = TypeTableStrings ++ MainStrings ). :- pred accumulate_var_type_table_entry_strings(var_name_table::in, var_rep::in, type_rep::in, cord(string)::in, cord(string)::out) is det. accumulate_var_type_table_entry_strings(VarNameTable, VarNum, TypeRep, !Strings) :- string.int_to_string(VarNum, VarNumStr), ( if search_var_name(VarNameTable, VarNum, VarName), not VarName = "" then VarIdStrs = cord.from_list([VarName, " ", VarNumStr, " -> "]) else VarIdStrs = cord.from_list(["unnamed_var ", VarNumStr, " -> "]) ), type_rep_to_strings(TypeRep, TypeRepStrs), EntryStrs = VarIdStrs ++ TypeRepStrs ++ nl, !:Strings = !.Strings ++ EntryStrs. print_proc_label_to_string(ProcLabel, String) :- ( ProcLabel = str_ordinary_proc_label(PredFunc, DeclModule, _DefModule, Name, Arity, Mode), ( PredFunc = pf_predicate, PF = "pred" ; PredFunc = pf_function, PF = "func" ), string.format("%s %s.%s/%d-%d", [s(PF), s(DeclModule), s(Name), i(Arity), i(Mode)], String) ; ProcLabel = str_special_proc_label(TypeName, TypeModule, _DefModule, Name, Arity, Mode), string.format("%s for %s.%s/%d-%d", [s(Name), s(TypeModule), s(TypeName), i(Arity), i(Mode)], String) ). %---------------------------------------------------------------------------% print_goal_to_strings(Info, Indent, RevGoalPath, GoalRep, Strings) :- GoalRep = goal_rep(GoalExprRep, DetismRep, AnnotationKey), VarTable = Info ^ pgi_var_name_table, ( GoalExprRep = conj_rep(ConjGoalReps), print_conj_to_strings(Info, Indent, RevGoalPath, ConjGoalReps, ExprString) ; GoalExprRep = disj_rep(DisjGoalReps), print_disj_to_strings(Info, Indent, RevGoalPath, 1, DisjGoalReps, no, DisjString), ExprString = indent(Indent) ++ cord.singleton("(\n") ++ DisjString ++ indent(Indent) ++ cord.singleton(")\n") ; GoalExprRep = switch_rep(SwitchVarRep, CanFail, CasesRep), lookup_var_name(VarTable, SwitchVarRep, SwitchVarName), string.format("%s switch on %s\n", [s(string(CanFail)), s(SwitchVarName)], SwitchOnString), print_switch_to_strings(Info, Indent + 1, RevGoalPath, 1, CasesRep, no, SwitchString), ExprString = indent(Indent) ++ cord.singleton(SwitchOnString) ++ indent(Indent) ++ cord.singleton("(\n") ++ SwitchString ++ indent(Indent) ++ cord.singleton(")\n") ; GoalExprRep = ite_rep(CondRep, ThenRep, ElseRep), RevGoalPathCond = rgp_cons(RevGoalPath, step_ite_cond), RevGoalPathThen = rgp_cons(RevGoalPath, step_ite_then), RevGoalPathElse = rgp_cons(RevGoalPath, step_ite_else), print_goal_to_strings(Info, Indent + 1, RevGoalPathCond, CondRep, CondString), print_goal_to_strings(Info, Indent + 1, RevGoalPathThen, ThenRep, ThenString), print_goal_to_strings(Info, Indent + 1, RevGoalPathElse, ElseRep, ElseString), IndentString = indent(Indent), ExprString = IndentString ++ cord.singleton("(\n") ++ CondString ++ IndentString ++ cord.singleton("->\n") ++ ThenString ++ IndentString ++ cord.singleton(";\n") ++ ElseString ++ IndentString ++ cord.singleton(")\n") ; GoalExprRep = negation_rep(SubGoalRep), RevSubGoalPath = rgp_cons(RevGoalPath, step_neg), print_goal_to_strings(Info, Indent + 1, RevSubGoalPath, SubGoalRep, SubGoalString), ExprString = indent(Indent) ++ cord.singleton("not (\n") ++ SubGoalString ++ indent(Indent) ++ cord.singleton(")\n") ; GoalExprRep = scope_rep(SubGoalRep, MaybeCut), ( MaybeCut = scope_is_cut, CutString = cord.singleton(" cut") ; MaybeCut = scope_is_no_cut, CutString = cord.empty ), RevSubGoalPath = rgp_cons(RevGoalPath, step_scope(MaybeCut)), print_goal_to_strings(Info, Indent + 1, RevSubGoalPath, SubGoalRep, SubGoalString), ExprString = indent(Indent) ++ cord.singleton("scope") ++ CutString ++ cord.singleton(" (\n") ++ SubGoalString ++ indent(Indent) ++ cord.singleton(")\n") ; GoalExprRep = atomic_goal_rep(_FileName, _LineNumber, _BoundVars, AtomicGoalRep), print_atomic_goal_to_strings(VarTable, AtomicGoalRep, ExprString0), ExprString = indent(Indent) ++ ExprString0 ), ( if GoalExprRep = conj_rep(_) then LinePrefix = indent(Indent) ++ singleton("% conjunction: "), ExtraLineForConjunctions = nl else LinePrefix = indent(Indent) ++ singleton("% "), ExtraLineForConjunctions = empty ), detism_to_string(DetismRep, DetismString), DetismLine = LinePrefix ++ DetismString ++ nl, LookupAnnotation = Info ^ pgi_lookup_annotation, GoalAnnotation = LookupAnnotation(AnnotationKey), print_goal_annotation_to_strings(VarTable, GoalAnnotation, GoalAnnotationLines0), ( if is_empty(GoalAnnotationLines0) then GoalAnnotationLines = empty else GoalAnnotationLines1 = map((func(Line) = LinePrefix ++ Line ++ nl), GoalAnnotationLines0), GoalAnnotationLines = foldr(++, GoalAnnotationLines1, empty) ), GoalPathString0 = rev_goal_path_to_string(RevGoalPath), ( if GoalPathString0 = "" then GoalPathString = "root goal" else GoalPathString = GoalPathString0 ), GoalPathLine = LinePrefix ++ cord.singleton(GoalPathString) ++ nl, Strings = GoalPathLine ++ DetismLine ++ GoalAnnotationLines ++ ExtraLineForConjunctions ++ ExprString. :- pred print_conj_to_strings(print_goal_info(T, GoalAnn)::in, int::in, reverse_goal_path::in, list(goal_rep(T))::in, cord(string)::out) is det <= goal_annotation(GoalAnn). print_conj_to_strings(Info, Indent, RevGoalPath, GoalReps, Strings) :- ( GoalReps = [], Strings = cord.snoc(indent(Indent), "true\n") ; GoalReps = [_ | _], print_conj_to_strings_2(Info, Indent, RevGoalPath, 1, GoalReps, Strings) ). :- pred print_conj_to_strings_2(print_goal_info(T, GoalAnn)::in, int::in, reverse_goal_path::in, int::in, list(goal_rep(T))::in, cord(string)::out) is det <= goal_annotation(GoalAnn). print_conj_to_strings_2(_, _Indent, _, _, [], cord.empty). print_conj_to_strings_2(Info, Indent, RevGoalPath, ConjNum, [GoalRep | GoalReps], Strings) :- % We use the absence of a separator to denote conjunction. % % We could try to append the comma at the end of each goal that is % not last in a conjunction, but that would be significant work, % and (at least for now) there is no real need for it. RevSubGoalPath = rgp_cons(RevGoalPath, step_conj(ConjNum)), print_goal_to_strings(Info, Indent, RevSubGoalPath, GoalRep, HeadGoalString), print_conj_to_strings_2(Info, Indent, RevGoalPath, ConjNum + 1, GoalReps, TailGoalsString), ( GoalReps = [], Separator = empty ; GoalReps = [_ | _], Separator = indent(Indent) ++ singleton(",\n") ), Strings = HeadGoalString ++ Separator ++ TailGoalsString. :- pred print_disj_to_strings(print_goal_info(T, GoalAnn)::in, int::in, reverse_goal_path::in, int::in, list(goal_rep(T))::in, bool::in, cord(string)::out) is det <= goal_annotation(GoalAnn). print_disj_to_strings(_, _Indent, _, _, [], _PrintSemi, cord.empty). print_disj_to_strings(Info, Indent, RevGoalPath, DisjNum, [GoalRep | GoalReps], PrintSemi, Strings) :- ( PrintSemi = no, DelimString = cord.empty ; PrintSemi = yes, DelimString = indent(Indent) ++ cord.singleton(";\n") ), RevSubGoalPath = rgp_cons(RevGoalPath, step_disj(DisjNum)), print_goal_to_strings(Info, Indent + 1, RevSubGoalPath, GoalRep, HeadGoalString), print_disj_to_strings(Info, Indent, RevGoalPath, DisjNum + 1, GoalReps, yes, TailGoalsString), Strings = DelimString ++ HeadGoalString ++ TailGoalsString. :- pred print_switch_to_strings(print_goal_info(T, GoalAnn)::in, int::in, reverse_goal_path::in, int::in, list(case_rep(T))::in, bool::in, cord(string)::out) is det <= goal_annotation(GoalAnn). print_switch_to_strings(_, _Indent, _, _, [], _PrintSemi, cord.empty). print_switch_to_strings(Info, Indent, RevGoalPath, CaseNum, [CaseRep | CaseReps], PrintSemi, Strings) :- ( PrintSemi = no, DelimString = cord.empty ; PrintSemi = yes, DelimString = indent(Indent) ++ cord.singleton(";\n") ), CaseRep = case_rep(MainConsIdArityRep, OtherConsIdArityRep, GoalRep), print_cons_id_and_arity_to_strings(Indent + 1, MainConsIdArityRep, ConsIdArityString), list.map(print_cons_id_and_arity_to_strings(Indent + 1), OtherConsIdArityRep, OtherConsIdArityStrings), RevSubGoalPath = rgp_cons(RevGoalPath, step_switch(CaseNum, unknown_num_functors_in_type)), print_goal_to_strings(Info, Indent + 1, RevSubGoalPath, GoalRep, HeadGoalString), print_switch_to_strings(Info, Indent, RevGoalPath, CaseNum + 1, CaseReps, yes, TailCasesStrings), Strings = DelimString ++ ConsIdArityString ++ cord_list_to_cord(OtherConsIdArityStrings) ++ HeadGoalString ++ TailCasesStrings. :- pred print_cons_id_and_arity_to_strings(int::in, cons_id_arity_rep::in, cord(string)::out) is det. print_cons_id_and_arity_to_strings(Indent, ConsIdArityRep, Strings) :- ConsIdArityRep = cons_id_arity_rep(ConsIdRep, Arity), string.format("%% case %s/%d\n", [s(ConsIdRep), i(Arity)], String), Strings = cord.snoc(indent(Indent), String). %---------------------------------------------------------------------------% :- pred print_atomic_goal_to_strings(var_name_table::in, atomic_goal_rep::in, cord(string)::out) is det. print_atomic_goal_to_strings(VarTable, AtomicGoalRep, Strings) :- ( ( AtomicGoalRep = unify_construct_rep(VarRep, ConsIdRep, ArgReps), UnifyOp = "<=" ; AtomicGoalRep = unify_deconstruct_rep(VarRep, ConsIdRep, ArgReps), UnifyOp = "=>" ), lookup_var_name(VarTable, VarRep, VarName), string.format("%s %s %s", [s(VarName), s(UnifyOp), s(ConsIdRep)], UnifyString), print_args_to_strings(lookup_var_name, VarTable, ArgReps, ArgsString), Strings0 = cord.cons(UnifyString, ArgsString) ; ( AtomicGoalRep = partial_construct_rep(VarRep, ConsIdRep, MaybeArgReps), UnifyOp = "<=" ; AtomicGoalRep = partial_deconstruct_rep(VarRep, ConsIdRep, MaybeArgReps), UnifyOp = "=>" ), lookup_var_name(VarTable, VarRep, VarName), string.format("%s %s %s", [s(VarName), s(UnifyOp), s(ConsIdRep)], UnifyString), print_args_to_strings(print_maybe_var, VarTable, MaybeArgReps, ArgsString), Strings0 = cord.cons(UnifyString, ArgsString) ; AtomicGoalRep = unify_assign_rep(TargetRep, SourceRep), lookup_var_name(VarTable, TargetRep, TargetName), lookup_var_name(VarTable, SourceRep, SourceName), string.format("%s := %s", [s(TargetName), s(SourceName)], String), Strings0 = cord.singleton(String) ; AtomicGoalRep = cast_rep(TargetRep, SourceRep), lookup_var_name(VarTable, TargetRep, TargetName), lookup_var_name(VarTable, SourceRep, SourceName), string.format("cast %s to %s", [s(SourceName), s(TargetName)], String), Strings0 = cord.singleton(String) ; AtomicGoalRep = unify_simple_test_rep(TargetRep, SourceRep), lookup_var_name(VarTable, TargetRep, TargetName), lookup_var_name(VarTable, SourceRep, SourceName), string.format("%s == %s", [s(SourceName), s(TargetName)], String), Strings0 = cord.singleton(String) ; AtomicGoalRep = pragma_foreign_code_rep(Args), print_args_to_strings(lookup_var_name, VarTable, Args, ArgsString), Strings0 = cord.singleton("foreign_proc(") ++ ArgsString ++ cord.singleton(")") ; AtomicGoalRep = higher_order_call_rep(HOVarRep, Args), lookup_var_name(VarTable, HOVarRep, HOVarName), string.format("%s(", [s(HOVarName)], HeadString), print_args_to_strings(lookup_var_name, VarTable, Args, ArgsString), Strings0 = cord.singleton(HeadString) ++ ArgsString ++ cord.singleton(")") ; AtomicGoalRep = method_call_rep(TCIVarRep, MethodNumber, Args), lookup_var_name(VarTable, TCIVarRep, TCIVarName), string.format("method %d of %s(", [i(MethodNumber), s(TCIVarName)], HeadString), print_args_to_strings(lookup_var_name, VarTable, Args, ArgsString), Strings0 = cord.singleton(HeadString) ++ ArgsString ++ cord.singleton(")") ; AtomicGoalRep = plain_call_rep(Module, Pred, Args), string.format("%s.%s", [s(Module), s(Pred)], HeadString), print_args_to_strings(lookup_var_name, VarTable, Args, ArgsString), Strings0 = cord.cons(HeadString, ArgsString) ; AtomicGoalRep = builtin_call_rep(Module, Pred, Args), string.format("builtin %s.%s", [s(Module), s(Pred)], HeadString), print_args_to_strings(lookup_var_name, VarTable, Args, ArgsString), Strings0 = cord.cons(HeadString, ArgsString) ; AtomicGoalRep = event_call_rep(Event, Args), string.format("event %s", [s(Event)], HeadString), print_args_to_strings(lookup_var_name, VarTable, Args, ArgsString), Strings0 = cord.cons(HeadString, ArgsString) ), Strings = Strings0 ++ nl. %---------------------------------------------------------------------------% :- pred print_args_to_strings(pred(var_name_table, T, string), var_name_table, list(T), cord(string)). :- mode print_args_to_strings(in(pred(in, in, out) is det), in, in, out) is det. print_args_to_strings(PrintArg, VarTable, Args, Strings) :- ( Args = [], Strings = cord.empty ; Args = [_ | _], print_args_2_to_strings(PrintArg, VarTable, Args, cord.empty, ArgsStr), Strings = cord.cons("(", cord.snoc(ArgsStr, ")")) ). :- pred print_args_2_to_strings(pred(var_name_table, T, string), var_name_table, list(T), cord(string), cord(string)). :- mode print_args_2_to_strings(in(pred(in, in, out) is det), in, in, in, out) is det. print_args_2_to_strings(_, _, [], _, cord.empty). print_args_2_to_strings(PrintArg, VarTable, [Arg | Args], Prefix, Strings) :- PrintArg(VarTable, Arg, ArgName), print_args_2_to_strings(PrintArg, VarTable, Args, cord.singleton(", "), ArgsString), Strings = Prefix ++ cord.cons(ArgName, ArgsString). :- pred print_maybe_var(var_name_table::in, maybe(var_rep)::in, string::out) is det. print_maybe_var(_, no, "_"). print_maybe_var(VarTable, yes(VarRep), VarName) :- lookup_var_name(VarTable, VarRep, VarName). :- pred print_head_var(var_name_table::in, head_var_rep::in, string::out) is det. print_head_var(VarTable, head_var_rep(VarRep, VarMode), String) :- lookup_var_name(VarTable, VarRep, VarName), VarMode = var_mode_rep(InitialInst, FinalInst), inst_rep_to_string(InitialInst, InitialInstStr), inst_rep_to_string(FinalInst, FinalInstStr), String = string.format("%s::(%s >> %s)", [s(VarName), s(InitialInstStr), s(FinalInstStr)]). :- pred inst_rep_to_string(inst_rep::in, string::out) is det. inst_rep_to_string(ir_free_rep, "free"). inst_rep_to_string(ir_ground_rep, "ground"). inst_rep_to_string(ir_other_rep, "other"). %---------------------------------------------------------------------------% :- func indent(int) = cord(string). indent(N) = ( if N =< 0 then cord.empty else cord.singleton(" ") ++ indent(N - 1) ). :- func nl = cord(string). nl = cord.singleton("\n"). :- func add_nl(string) = cord(string). add_nl(Str) = cord.from_list([Str, "\n"]). %---------------------------------------------------------------------------% :- pred detism_to_string(detism_rep::in, cord(string)::out) is det. detism_to_string(Detism, DetismStrCord) :- ( Detism = det_rep, DetismStr = "det" ; Detism = semidet_rep, DetismStr = "semidet" ; Detism = nondet_rep, DetismStr = "nondet" ; Detism = multidet_rep, DetismStr = "multi" ; Detism = cc_nondet_rep, DetismStr = "cc_nondet" ; Detism = cc_multidet_rep, DetismStr = "cc_multi" ; Detism = erroneous_rep, DetismStr = "erroneous" ; Detism = failure_rep, DetismStr = "failure" ), DetismStrCord = cord.singleton(DetismStr). %---------------------------------------------------------------------------% :- instance goal_annotation(unit) where [ pred(print_goal_annotation_to_strings/3) is print_unit_to_strings ]. :- pred print_unit_to_strings(var_name_table::in, unit::in, cord(cord(string))::out) is det. print_unit_to_strings(_, _, cord.empty). %---------------------------------------------------------------------------% % % Label goals with IDs. % label_goals(goal_id(LastIdPlus1 - 1u), Map, !Goal) :- label_goal(whole_body_goal, !Goal, counter.uinit(1u), Counter, map.init, Map), counter.uallocate(LastIdPlus1, Counter, _). :- pred label_goal(containing_goal::in, goal_rep(T)::in, goal_rep(goal_id)::out, ucounter::in, ucounter::out, map(goal_id, containing_goal)::in, map(goal_id, containing_goal)::out) is det. label_goal(ContainingGoal, !Goal, !Counter, !Map) :- !.Goal = goal_rep(GoalExpr0, Detism, _), counter.uallocate(GoalIdNum, !Counter), GoalId = goal_id(GoalIdNum), map.det_insert(GoalId, ContainingGoal, !Map), ( GoalExpr0 = conj_rep(Conjs0), map_foldl3(label_goal_wrapper((func(N) = step_conj(N)), GoalId), Conjs0, Conjs, 1, _, !Counter, !Map), GoalExpr = conj_rep(Conjs) ; GoalExpr0 = disj_rep(Disjs0), map_foldl3(label_goal_wrapper((func(N) = step_disj(N)), GoalId), Disjs0, Disjs, 1, _, !Counter, !Map), GoalExpr = disj_rep(Disjs) ; GoalExpr0 = switch_rep(Var, CanFail, Cases0), map_foldl3(label_case(GoalId), Cases0, Cases, 1, _, !Counter, !Map), GoalExpr = switch_rep(Var, CanFail, Cases) ; GoalExpr0 = ite_rep(Cond0, Then0, Else0), label_goal(containing_goal(GoalId, step_ite_cond), Cond0, Cond, !Counter, !Map), label_goal(containing_goal(GoalId, step_ite_then), Then0, Then, !Counter, !Map), label_goal(containing_goal(GoalId, step_ite_else), Else0, Else, !Counter, !Map), GoalExpr = ite_rep(Cond, Then, Else) ; GoalExpr0 = negation_rep(SubGoal0), label_goal(containing_goal(GoalId, step_neg), SubGoal0, SubGoal, !Counter, !Map), GoalExpr = negation_rep(SubGoal) ; GoalExpr0 = scope_rep(SubGoal0, ScopeIsCut), label_goal(containing_goal(GoalId, step_scope(ScopeIsCut)), SubGoal0, SubGoal, !Counter, !Map), GoalExpr = scope_rep(SubGoal, ScopeIsCut) ; GoalExpr0 = atomic_goal_rep(File, Line, BoundVars, AtomicGoal), GoalExpr = atomic_goal_rep(File, Line, BoundVars, AtomicGoal) ), !:Goal = goal_rep(GoalExpr, Detism, GoalId). :- pred label_goal_wrapper( (func(int) = goal_path_step)::in(func(in) = out is det), goal_id::in, goal_rep(T)::in, goal_rep(goal_id)::out, int::in, int::out, ucounter::in, ucounter::out, map(goal_id, containing_goal)::in, map(goal_id, containing_goal)::out) is det. label_goal_wrapper(MakePathStep, ParentGoalId, !Goal, !GoalNum, !Counter, !Map) :- label_goal(containing_goal(ParentGoalId, MakePathStep(!.GoalNum)), !Goal, !Counter, !Map), !:GoalNum = !.GoalNum + 1. :- pred label_case(goal_id::in, case_rep(T)::in, case_rep(goal_id)::out, int::in, int::out, ucounter::in, ucounter::out, containing_goal_map::in, containing_goal_map::out) is det. label_case(ParentGoalId, !Case, !CaseNum, !Counter, !Map) :- !.Case = case_rep(MainConsId, OtherConsIds, Goal0), label_goal_wrapper( (func(N) = step_switch(N, unknown_num_functors_in_type)), ParentGoalId, Goal0, Goal, !CaseNum, !Counter, !Map), !:Case = case_rep(MainConsId, OtherConsIds, Goal). %---------------------------------------------------------------------------% progrep_search_proc(ProgRep, ProcLabel, ProcRep) :- ( ProcLabel = str_ordinary_proc_label(_, _DeclModule, DefModule, _, _, _) ; ProcLabel = str_special_proc_label(_, _DeclModule, DefModule, _, _, _) ), progrep_search_module(ProgRep, DefModule, ModuleRep), modulerep_search_proc(ModuleRep, ProcLabel, ProcRep). % Search for a module within a program representation. % :- pred progrep_search_module(prog_rep::in, string::in, module_rep::out) is semidet. progrep_search_module(ProgRep, ModuleName, ModuleRep) :- ProgRep = prog_rep(ModuleReps), map.search(ModuleReps, ModuleName, ModuleRep). % Search for a procedure within a module representation. % :- pred modulerep_search_proc(module_rep::in, string_proc_label::in, proc_rep::out) is semidet. modulerep_search_proc(ModuleRep, ProcLabel, ProcRep) :- map.search(ModuleRep ^ mr_procs, ProcLabel, ProcRep). %---------------------------------------------------------------------------% :- type inst_map ---> inst_map( % The actual inst map. im_inst_map :: map(var_rep, inst_rep), % A tree describing dependencies between bound variables. im_var_dep_map :: map(var_rep, set(var_rep)) ). initial_inst_map(ProcDefn) = InstMap :- HeadVars = ProcDefn ^ pdr_head_vars, list.foldl(add_head_var_inst_to_map, HeadVars, inst_map(map.init, map.init), InstMap). :- pred add_head_var_inst_to_map(head_var_rep::in, inst_map::in, inst_map::out) is det. add_head_var_inst_to_map(head_var_rep(VarRep, ModeRep), !InstMap) :- ModeRep = var_mode_rep(InitialInstRep, _), add_inst_mapping(VarRep, InitialInstRep, set.init, !InstMap). % Add an inst mapping. % :- pred add_inst_mapping(var_rep::in, inst_rep::in, set(var_rep)::in, inst_map::in, inst_map::out) is det. add_inst_mapping(VarRep, InstRep, DepVars, InstMap0, InstMap) :- InstMap0 = inst_map(VarToInst0, VarToDepVars0), map.det_insert(VarRep, InstRep, VarToInst0, VarToInst), map.det_insert(VarRep, DepVars, VarToDepVars0, VarToDepVars), InstMap = inst_map(VarToInst, VarToDepVars). %---------------------------------------------------------------------------% inst_map_ground_vars(Vars, DepVars, !InstMap, SeenDuplicateInstantiation) :- list.foldl2(inst_map_ground_var(DepVars), Vars, !InstMap, have_not_seen_duplicate_instantiation, SeenDuplicateInstantiation). :- pred inst_map_ground_var(set(var_rep)::in, var_rep::in, inst_map::in, inst_map::out, seen_duplicate_instantiation::in, seen_duplicate_instantiation::out) is det. inst_map_ground_var(DepVars0, Var, InstMap0, InstMap, !SeenDuplicateInstantiation) :- InstMap0 = inst_map(VarToInst0, VarToDepVars0), ( if map.search(VarToInst0, Var, InstPrime) then Inst = InstPrime else Inst = ir_free_rep ), ( Inst = ir_free_rep, NewInst = ir_ground_rep, DepVars = DepVars0 ; ( Inst = ir_ground_rep ; Inst = ir_other_rep ), NewInst = ir_other_rep, map.lookup(VarToDepVars0, Var, DepVarsFromIM), DepVars = set.union(DepVars0, DepVarsFromIM), !:SeenDuplicateInstantiation = seen_duplicate_instantiation ), map.set(Var, NewInst, VarToInst0, VarToInst), map.set(Var, DepVars, VarToDepVars0, VarToDepVars), InstMap = inst_map(VarToInst, VarToDepVars). %---------------------------------------------------------------------------% inst_map_get(inst_map(VarToInst, VarToDepVars), Var, Inst, DepVars) :- ( if map.search(VarToInst, Var, InstPrime) then Inst = InstPrime, map.lookup(VarToDepVars, Var, DepVars) else Inst = ir_free_rep, DepVars = set.init ). inst_map_get_var_deps(inst_map(_, VarToDepVars), VarRep, DepVars) :- inst_map_get_var_deps_2(VarToDepVars, VarRep, set.init, DepVars). :- pred inst_map_get_var_deps_2(map(var_rep, set(var_rep))::in, var_rep::in, set(var_rep)::in, set(var_rep)::out) is det. inst_map_get_var_deps_2(VarToDepVars, VarRep, !Set) :- ( if set.contains(!.Set, VarRep) then true % This variable has already been visited. Stopping here prevents % following any cycles in the graph (which should be impossible anyway) % or following the same path twice if there are diamonds in the graph. else ( if map.search(VarToDepVars, VarRep, DepVars) then !:Set = set.union(!.Set, DepVars), set.fold(inst_map_get_var_deps_2(VarToDepVars), DepVars, !Set) else true ) ). %---------------------------------------------------------------------------% merge_inst_map(InstMapA, DetismA, InstMapB, DetismB) = InstMap :- ( ( DetismA = erroneous_rep ; DetismA = failure_rep ), InstMap = InstMapB ; ( DetismA = det_rep ; DetismA = semidet_rep ; DetismA = nondet_rep ; DetismA = multidet_rep ; DetismA = cc_nondet_rep ; DetismA = cc_multidet_rep ), ( ( DetismB = erroneous_rep ; DetismB = failure_rep ), InstMap = InstMapA ; ( DetismB = det_rep ; DetismB = semidet_rep ; DetismB = nondet_rep ; DetismB = multidet_rep ; DetismB = cc_nondet_rep ; DetismB = cc_multidet_rep ), InstMapA = inst_map(VarToInstA, VarToDepVarsA), InstMapB = inst_map(VarToInstB, VarToDepVarsB), map.union(inst_intersect, VarToInstA, VarToInstB, VarToInst), map.union(set.union, VarToDepVarsA, VarToDepVarsB, VarToDepVars), InstMap = inst_map(VarToInst, VarToDepVars) ) ). :- pred inst_intersect(inst_rep::in, inst_rep::in, inst_rep::out) is det. inst_intersect(ir_free_rep, ir_free_rep, ir_free_rep). inst_intersect(ir_free_rep, ir_ground_rep, ir_other_rep). inst_intersect(ir_free_rep, ir_other_rep, ir_other_rep). inst_intersect(ir_ground_rep, ir_free_rep, ir_other_rep). inst_intersect(ir_ground_rep, ir_ground_rep, ir_ground_rep). inst_intersect(ir_ground_rep, ir_other_rep, ir_other_rep). inst_intersect(ir_other_rep, ir_free_rep, ir_other_rep). inst_intersect(ir_other_rep, ir_ground_rep, ir_other_rep). inst_intersect(ir_other_rep, ir_other_rep, ir_other_rep). %---------------------------------------------------------------------------% merge_seen_duplicate_instantiation(A, B) = R :- ( if A = have_not_seen_duplicate_instantiation, B = have_not_seen_duplicate_instantiation then R = have_not_seen_duplicate_instantiation else R = seen_duplicate_instantiation ). %---------------------------------------------------------------------------% :- type inst_map_delta ---> inst_map_delta(set(var_rep)). inst_map_delta_get_var_set(inst_map_delta(Vars), Vars). empty_inst_map_delta(inst_map_delta(Vars)) :- set.init(Vars). empty_inst_map_delta = InstMap :- empty_inst_map_delta(InstMap). calc_inst_map_delta(Before, After, inst_map_delta(DeltaVars)) :- AccInstantiatedVars = ( pred(Var::in, Inst::in, Set0::in, Set::out) is det :- ( if map.search(Before ^ im_inst_map, Var, BeforeInst) then ( BeforeInst = ir_free_rep, ( Inst = ir_free_rep, Set = Set0 ; ( Inst = ir_ground_rep ; Inst = ir_other_rep ), % This variable has become more instantiated. set.insert(Var, Set0, Set) ) ; BeforeInst = ir_ground_rep, ( Inst = ir_free_rep, unexpected($pred, "variable should become less instantiated") ; ( Inst = ir_ground_rep ; Inst = ir_other_rep ) ), Set = Set0 ; BeforeInst = ir_other_rep, ( Inst = ir_free_rep, unexpected($pred, "variable should become less instantiated") ; ( Inst = ir_ground_rep ; Inst = ir_other_rep ) ), Set = Set0 ) else % If we couldn't find the variable then it was free; % it may have been in the head of the procedure. ( Inst = ir_free_rep, Set = Set0 ; ( Inst = ir_ground_rep ; Inst = ir_other_rep ), % This variable has become more instantiated. set.insert(Var, Set0, Set) ) ) ), map.foldl(AccInstantiatedVars, After ^ im_inst_map, set.init, DeltaVars). %---------------------------------------------------------------------------% atomic_goal_get_vars(AtomicGoal, Vars) :- ( ( AtomicGoal = unify_construct_rep(Var, _, VarsL) ; AtomicGoal = unify_deconstruct_rep(Var, _, VarsL) ; AtomicGoal = higher_order_call_rep(Var, VarsL) ; AtomicGoal = method_call_rep(Var, _, VarsL) ), Vars0 = list_to_set(VarsL), set.insert(Var, Vars0, Vars) ; ( AtomicGoal = partial_construct_rep(Var, _, MaybeVars) ; AtomicGoal = partial_deconstruct_rep(Var, _, MaybeVars) ), list.foldl( ( pred(MaybeVar::in, Set0::in, Set::out) is det :- ( MaybeVar = yes(VarI), set.insert(VarI, Set0, Set) ; MaybeVar = no, Set = Set0 ) ), MaybeVars, set.init, Vars0), set.insert(Var, Vars0, Vars) ; ( AtomicGoal = unify_assign_rep(VarA, VarB) ; AtomicGoal = cast_rep(VarA, VarB) ; AtomicGoal = unify_simple_test_rep(VarA, VarB) ), Vars = list_to_set([ VarA, VarB ]) ; ( AtomicGoal = pragma_foreign_code_rep(VarsL) ; AtomicGoal = event_call_rep(_, VarsL) ; AtomicGoal = builtin_call_rep(_, _, VarsL) ; AtomicGoal = plain_call_rep(_, _, VarsL) ), Vars = list_to_set(VarsL) ). %---------------------------------------------------------------------------% atomic_goal_is_call(AtomicGoal, IsCall) :- ( ( AtomicGoal = unify_construct_rep(_, _, _) ; AtomicGoal = unify_deconstruct_rep(_, _, _) ; AtomicGoal = partial_construct_rep(_, _, _) ; AtomicGoal = partial_deconstruct_rep(_, _, _) ; AtomicGoal = unify_assign_rep(_, _) ; AtomicGoal = cast_rep(_, _) ; AtomicGoal = unify_simple_test_rep(_, _) ; AtomicGoal = pragma_foreign_code_rep(_) ; AtomicGoal = builtin_call_rep(_, _, _) ; AtomicGoal = event_call_rep(_, _) ), IsCall = atomic_goal_is_trivial ; ( AtomicGoal = higher_order_call_rep(_, Args) ; AtomicGoal = method_call_rep(_, _, Args) ; AtomicGoal = plain_call_rep(_, _, Args) ), IsCall = atomic_goal_is_call(Args) ). %---------------------------------------------------------------------------% :- end_module program_representation_utils. %---------------------------------------------------------------------------%