%---------------------------------------------------------------------------% % vim: ft=mercury ts=4 sw=4 et %---------------------------------------------------------------------------% % Copyright (C) 2001-2011 The University of Melbourne. % Copyright (C) 2014-2018 The Mercury team. % This file is distributed under the terms specified in COPYING.LIB. %---------------------------------------------------------------------------% % % File: program_representation.m % Authors: zs, dougl % % This module defines the representation of procedure bodies used by the % declarative debugger and the deep profiler. % % One of the things we want the declarative debugger to be able to do % is to let the user specify which part of which output argument of an % incorrect or inadmissible atom is suspicious, and then find out where % that particular subterm came from, i.e. where it was bound. Doing this % requires knowing what the bodies of that procedure and its descendants are. % % If the Mercury compiler is invoked with the right options, it will include % in each procedure layout a pointer to a simplified representation of the goal % that is the body of the corresponding procedure. We use a simplified % representation partly because we want to insulate the code using procedure % representations from irrelevant changes in HLDS types, and partly because % we want to minimize the space taken in up in executables by these % representations. % % The current representation is intended to contain all the information % we are pretty sure can be usefully exploited by the declarative debugger % and/or the deep profiler. %---------------------------------------------------------------------------% :- module mdbcomp.program_representation. :- interface. :- import_module mdbcomp.goal_path. :- import_module mdbcomp.prim_data. :- import_module mdbcomp.rtti_access. :- import_module mdbcomp.sym_name. :- import_module bool. :- import_module io. :- import_module list. :- import_module map. :- import_module maybe. :- import_module unit. :- import_module type_desc. %---------------------------------------------------------------------------% % % The representation of programs, as recorded by the compiler for use % by tools such as the declarative debugger and the deep profiler. % :- type prog_rep(GoalAnnotation) ---> prog_rep( module_map(GoalAnnotation) ). :- type prog_rep == prog_rep(unit). % A map of module names to module representations. % :- type module_map(GoalAnnotation) == map(string, module_rep(GoalAnnotation)). :- type module_map == module_map(unit). :- type module_rep(GoalAnnotation) ---> module_rep( mr_name :: string, % The module name. mr_string_table :: string_table, mr_oisu_types :: list(oisu_type_procs), mr_type_rep_table :: map(int, type_rep), mr_procs :: proc_map(GoalAnnotation) ). :- type module_rep == module_rep(unit). :- type oisu_type_procs ---> oisu_type_procs( otp_type_ctor :: string, % name of type_ctor; arity 0 otp_creators :: list(string_proc_label), otp_mutators :: list(string_proc_label), otp_destructors :: list(string_proc_label) ). :- type type_rep ---> defined_type_rep(sym_name, list(type_rep)) ; builtin_type_rep(builtin_type_rep) ; tuple_type_rep(list(type_rep)) ; higher_order_type_rep(list(type_rep), maybe(type_rep)) ; type_var_rep(int). :- type encoded_type_table == map(int, type_rep). :- type builtin_type_rep ---> builtin_type_int_rep ; builtin_type_uint_rep ; builtin_type_int8_rep ; builtin_type_uint8_rep ; builtin_type_int16_rep ; builtin_type_uint16_rep ; builtin_type_int32_rep ; builtin_type_uint32_rep ; builtin_type_int64_rep ; builtin_type_uint64_rep ; builtin_type_float_rep ; builtin_type_string_rep ; builtin_type_char_rep. % A map of proc names to proc_reps. % :- type proc_map(GoalAnnotation) == map(string_proc_label, proc_rep(GoalAnnotation)). :- type proc_map == proc_map(unit). :- type proc_rep(GoalAnnotation) ---> proc_rep( pr_id :: string_proc_label, pr_defn :: proc_defn_rep(GoalAnnotation) ). :- type proc_rep == proc_rep(unit). % A string_proc_label is a data structure that uniquely identifies a % procedure. It is a version of the proc_label type from prim_data.m % that can be used outside the compiler, e.g. in RTTI data structures % and in data files generated by deep profiling. % % When procedures are imported from one module to another, for example for % inter-module optimisations, the def_module field may be different to the % decl_module field. If this is the case, then the procedure has been % imported into the def_module from the decl_module. This is also true % for the type_module and def_module fields in the str_special_proc_label % constructor. % :- type string_proc_label ---> str_ordinary_proc_label( s_ord_pred_or_func :: pred_or_func, s_ord_decl_module :: string, s_ord_def_module :: string, s_ord_name :: string, s_ord_arity :: int, s_ord_mode :: int ) ; str_special_proc_label( s_spec_type_name :: string, s_spec_type_module :: string, s_spec_def_module :: string, s_spec_pred_name :: string, s_spec_arity :: int, s_spec_mode :: int ). :- type proclabel_kind_token ---> proclabel_user_predicate ; proclabel_user_function ; proclabel_special. :- pred is_proclabel_kind(int::in, proclabel_kind_token::out) is semidet. % A representation of the procedure definitions (clause heads and bodies) % that we execute. These are generated by the compiler, which stores them % in the form of a bytecode representation in a field of the proc_layout % structures in the executable. % % Each element of this structure will correspond one-to-one % to an element of the original HLDS at the code generation stage. :- type proc_defn_rep(GoalAnnotation) ---> proc_defn_rep( % The head variables, in order, including the ones introduced % by the compiler. pdr_head_vars :: list(head_var_rep), % The procedure body. pdr_goal :: goal_rep(GoalAnnotation), % The variable name table. pdr_var_name_table :: var_name_table, % The variable type table, if present. pdr_var_type_table :: maybe(var_type_table), % The determinism of the procedure. Note that this may be % looser than the determinism of the procedure's body goal. pdr_detism :: detism_rep ). :- type proc_defn_rep == proc_defn_rep(unit). :- type goal_rep(GoalAnnotation) ---> goal_rep( % The expression this goal represents. goal_expr_rep :: goal_expr_rep(GoalAnnotation), % The determinism of this goal. goal_detism_rep :: detism_rep, % This slot may be used to annotate the goal with some extra % information. The deep profiling tools make use of this % to associate coverage profiling data with goals. goal_annotation :: GoalAnnotation ). :- type goal_rep == goal_rep(unit). :- type goal_expr_rep(GoalAnnotation) ---> conj_rep( % The conjuncts in the original order. list(goal_rep(GoalAnnotation)) ) ; disj_rep( % The disjuncts in the original order. list(goal_rep(GoalAnnotation)) ) ; switch_rep( % The variable being switched on. var_rep, % Completeness of the switch. switch_can_fail_rep, % The switch arms in the original order. list(case_rep(GoalAnnotation)) ) ; ite_rep( % The condition, the then branch and the else branch. goal_rep(GoalAnnotation), goal_rep(GoalAnnotation), goal_rep(GoalAnnotation) ) ; negation_rep( % The negated goal. goal_rep(GoalAnnotation) ) ; scope_rep( % The quantified goal. goal_rep(GoalAnnotation), maybe_cut ) ; atomic_goal_rep( string, % Filename of context. int, % Line number of context. list(var_rep), % The sorted list of the variables % bound by the atomic goal. atomic_goal_rep ). :- type case_rep(GoalAnnotation) ---> case_rep( % The name and arity of the first function symbol for which % this switch arm is applicable. cr_main_cons_id :: cons_id_arity_rep, % The names and arities of any other function symbols for % this switch arm. cr_other_cons_ids :: list(cons_id_arity_rep), % The code of the switch arm. cr_case_goal :: goal_rep(GoalAnnotation) ). :- type case_rep == case_rep(unit). :- type switch_can_fail_rep ---> switch_can_fail_rep ; switch_can_not_fail_rep. :- type atomic_goal_rep ---> unify_construct_rep( var_rep, cons_id_rep, list(var_rep) ) ; unify_deconstruct_rep( var_rep, cons_id_rep, list(var_rep) ) ; partial_deconstruct_rep( % A partial deconstruction of the form % X = f(Y_1, Y_2, ..., Y_n) % where X is more instantiated after the unification % than before. var_rep, % X cons_id_rep, % f list(maybe(var_rep)) % The list of Y_i's. Y_i's which are input % are wrapped in `yes', while the other % Y_i positions are `no'. ) ; partial_construct_rep( % A partial construction of the form % X = f(Y_1, Y_2, ..., Y_n) % where X is free before the unification and bound, % but not ground, after the unification. var_rep, % X cons_id_rep, % f list(maybe(var_rep)) % The list of Y_i's. Y_i's which are input % are wrapped in `yes', while the other % Y_i positions are `no'. ) ; unify_assign_rep( var_rep, % target var_rep % source ) ; cast_rep( var_rep, % target var_rep % source ) ; unify_simple_test_rep( var_rep, var_rep ) ; pragma_foreign_code_rep( list(var_rep) % arguments ) ; higher_order_call_rep( var_rep, % the closure to call list(var_rep) % the call's plain arguments ) ; method_call_rep( var_rep, % typeclass info var int, % method number list(var_rep) % the call's plain arguments ) ; plain_call_rep( string, % name of called pred's module string, % name of the called pred list(var_rep) % the call's arguments ) ; builtin_call_rep( % This represents inline builtins only. string, % name of called pred's module string, % name of the called pred list(var_rep) % the call's arguments ) ; event_call_rep( string, % name of the event list(var_rep) % the call's arguments ). :- type var_rep == int. :- type head_var_rep ---> head_var_rep( head_var_var :: var_rep, head_var_mode :: var_mode_rep ). :- type var_mode_rep ---> var_mode_rep( vm_initial_inst :: inst_rep, vm_final_inst :: inst_rep ). :- type inst_rep ---> ir_free_rep ; ir_ground_rep ; ir_other_rep. % Instantiation states that are not understood by the bytecode % representation are stored as ir_other_rep. :- type cons_id_arity_rep ---> cons_id_arity_rep( cons_id_rep, int ). :- type cons_id_rep == string. :- type detism_rep ---> det_rep ; semidet_rep ; nondet_rep ; multidet_rep ; cc_nondet_rep ; cc_multidet_rep ; erroneous_rep ; failure_rep. :- type solution_count_rep ---> at_most_zero_rep ; at_most_one_rep % Including committed choice. ; at_most_many_rep. :- type can_fail_rep ---> can_fail_rep ; cannot_fail_rep. :- type committed_choice ---> committed_choice ; not_committed_choice. %---------------------------------------------------------------------------% % % Operations on determinisms. % :- func detism_get_solutions(detism_rep) = solution_count_rep. :- func detism_get_can_fail(detism_rep) = can_fail_rep. :- pred detism_components(detism_rep, solution_count_rep, can_fail_rep). :- mode detism_components(in, out, out) is det. :- mode detism_components(out, in, in) is multi. :- pred detism_committed_choice(detism_rep, committed_choice). :- mode detism_committed_choice(in, out) is det. :- mode detism_committed_choice(out, in) is multi. %---------------------------------------------------------------------------% % % Operations on variable name tables. % % A table of var_rep to string mappings. % % This table may not contain all the variables in the procedure. Variables % created by the compiler are not included. The table may be empty if it is % not required, such as when used with the declarative debugger. % :- type var_name_table. % Retrieve the name for this variable if it is known, otherwise fail. % :- pred search_var_name(var_name_table::in, var_rep::in, string::out) is semidet. % Retrieve the name for this variable if it is known, otherwise, % return `no'. % :- pred maybe_search_var_name(var_name_table::in, var_rep::in, maybe(string)::out) is det. % Lookup the name of a variable within the variable table. If the variable % is unknown a distinct name is automatically generated. % :- pred lookup_var_name(var_name_table::in, var_rep::in, string::out) is det. % A table mapping var_reps to representations of the variables' types. % It is intended to be used by a program analysis for order-independent % state update in the auto-parallelisation feedback tool. % % This table should exist in any procedure that is named in a oisu pragma. % In other procedures, it may or may not be there (currently, it isn't). % :- type var_type_table == map(var_rep, type_rep). %---------------------------------------------------------------------------% % % Operations on goals. % % If the given atomic goal behaves like a call in the sense that it % generates events as ordinary calls do, then return the list of variables % that are passed as arguments. % :- func atomic_goal_generates_event_like_call(atomic_goal_rep) = maybe(list(var_rep)). % call_does_not_generate_events(ModuleName, PredName, Arity): % % Succeed iff a call to the named predicate will not generate events % in a debugging grade. % :- pred call_does_not_generate_events(string::in, string::in, int::in) is semidet. % If the given goal generates internal events directly, then return yes; % otherwise, return no. % :- func goal_generates_internal_event(goal_rep(unit)) = bool. % The atomic goal's module, name and arity. % :- type atomic_goal_id ---> atomic_goal_id(string, string, int). % Can we find out the atomic goal's name, module and arity from % its atomic_goal_rep? If so, return them; otherwise, return no. % :- func atomic_goal_identifiable(atomic_goal_rep) = maybe(atomic_goal_id). :- func head_var_to_var(head_var_rep) = var_rep. % Extract the goal from a case, this is implemented here so it can be used % as a higher order value. % :- pred case_get_goal(case_rep(T)::in, goal_rep(T)::out) is det. % Transform the annotations on a goal representation. This may change % not only the values of the annotations, but also their type. % :- pred transform_goal_rep(pred(T, U), goal_rep(T), goal_rep(U)). :- mode transform_goal_rep(pred(in, out) is det, in, out) is det. %---------------------------------------------------------------------------% % Describe a call site. % :- type call_site ---> call_site( caller :: string_proc_label, slot :: int, call_type_and_callee :: call_type_and_callee ). % The type and callee of call. The callee is known only for plain calls. % :- type call_type_and_callee ---> callback_call ; higher_order_call ; method_call ; plain_call(string_proc_label) ; special_call. % User-visible head variables are represented by a number from 1..N, % where N is the user-visible arity. % % Both user-visible and compiler-generated head variables can be % referred to via their position in the full list of head variables; % the first head variable is at position 1. :- type arg_pos ---> user_head_var(int) % Nth in the list of arguments after filtering out % non-user-visible vars. ; any_head_var(int) % Nth in the list of all arguments. ; any_head_var_from_back(int). % (M-N+1)th argument in the list of all arguments, where N is % the value of the int in the constructor and M is the total number % of arguments. % A particular subterm within a term is represented by a term_path. % This is the list of argument positions that need to be followed % in order to travel from the root to the subterm. This list is in % top-down order (i.e. the argument number in the top function symbol % is first). :- type term_path == list(int). %---------------------------------------------------------------------------% % Returns type_of(_ : proc_defn_rep), for use in C code. % :- func proc_defn_rep_type = type_desc. % Returns type_of(_ : goal_rep), for use in C code. % :- func goal_rep_type = type_desc. %---------------------------------------------------------------------------% % % Conversions between the internal form of program representations % and their form as stored in bytecode. % % Construct a representation of the interface determinism of a % procedure. The code we have chosen is not sequential; instead % it encodes the various properties of each determinism. % This must match the encoding of MR_Determinism in % mercury_stack_layout.h. % % The 8 bit is set iff the context is first_solution. % The 4 bit is set iff the min number of solutions is more than zero. % The 2 bit is set iff the max number of solutions is more than zero. % The 1 bit is set iff the max number of solutions is more than one. % :- func detism_rep(detism_rep) = int. :- pred determinism_representation(detism_rep, int). :- mode determinism_representation(in, out) is det. :- mode determinism_representation(out, in) is semidet. :- pred inst_representation(inst_rep, int). :- mode inst_representation(in, out) is det. :- mode inst_representation(out, in) is semidet. :- type bytecode_goal_type ---> goal_conj ; goal_disj ; goal_switch ; goal_ite ; goal_neg ; goal_scope ; goal_construct ; goal_deconstruct ; goal_partial_construct ; goal_partial_deconstruct ; goal_assign ; goal_cast ; goal_simple_test ; goal_foreign ; goal_ho_call ; goal_method_call ; goal_plain_call ; goal_builtin_call ; goal_event_call. :- func goal_type_to_byte(bytecode_goal_type) = int. :- pred byte_to_goal_type(int::in, bytecode_goal_type::out) is semidet. % We represent a variable number as % - one byte if all variable numbers fit into one byte, % - two bytes if all variable numbers fit into two bytes, but % some do not fit into one byte, and % - four bytes if some variable numbers do not fit into two bytes. % This assumes that all variable numbers fit into four bytes. % :- type var_num_rep ---> var_num_1_byte ; var_num_2_bytes ; var_num_4_bytes. % Describe whether a variable name table should be included in the % bytecode. The variable name table actually adds the strings into the % module's string table. % :- type maybe_include_var_name_table ---> do_not_include_var_name_table ; include_var_name_table. % Describe whether references to the types of variables should be included % in the variable table. The types themselves are in a separate table next % to the module's string table. % :- type maybe_include_var_types ---> do_not_include_var_types ; include_var_types. % This predicate is here only for reading Deep.procrep files in an % old format, for backwards compatibility. % :- pred var_num_rep_byte(var_num_rep, int). :- mode var_num_rep_byte(in, out) is det. :- mode var_num_rep_byte(out, in) is semidet. % This predicate is the replacement for var_num_rep_byte. % :- pred var_flag_byte(var_num_rep, maybe_include_var_name_table, maybe_include_var_types, int). :- mode var_flag_byte(in, in, in, out) is det. :- mode var_flag_byte(out, out, out, in) is semidet. % Represent whether a scope goal cuts away solutions or not. % :- pred cut_byte(maybe_cut, int). :- mode cut_byte(in, out) is det. :- mode cut_byte(out, in) is semidet. :- pred can_fail_byte(switch_can_fail_rep, int). :- mode can_fail_byte(in, out) is det. :- mode can_fail_byte(out, in) is semidet. %---------------------------------------------------------------------------% % read_prog_rep_file(FileName, Result, !IO) % :- pred read_prog_rep_file(string::in, io.res(prog_rep)::out, io::di, io::uo) is det. :- pred trace_read_proc_defn_rep(bytecode_bytes::in, label_layout::in, proc_defn_rep::out) is semidet. %---------------------------------------------------------------------------% % Some predicates that operate on polymorphic values do not need % the type_infos describing the types bound to the variables. % It is of course faster not to pass type_infos to such predicates % (especially since we may also be able to avoid constructing those % type_infos), and it can also be easier for a compiler module % (e.g. common.m, size_prof.m) that generates calls to such predicates % not to have to create those type_infos. % % All the predicates for whose names no_type_info_builtin succeeds % are defined by compiler implementors. They are all predicates % implemented by foreign language code in the standard library. % For some, but not all, the compiler generates code inline. % % If you are adding a predicate to no_type_info_builtin, remember that % this will only affect code built by a compiler linked with the new % mdbcomp library. For example, if you add a predicate P to % no_type_info_builtin, the compiler building the stage 1 library % won't yet know about P. The stage 1 compiler _will_ know about P, % so stage 2 is when P will be compiled differently. % :- pred no_type_info_builtin(module_name::in, string::in, int::in) is semidet. %---------------------------------------------------------------------------% :- type coverage_point_info ---> coverage_point_info( % Identifies the goal that this coverage point is near. % If cp_type is cp_type_branch_arm, the coverage point is % immediately before this goal, otherwise it is immediately % after. reverse_goal_path, % The type of this coverage point. cp_type ). % This enumeration specifies the type of coverage point. A branch arm % is an arm of an if-then-else, switch or disj goal. The coverage_after % type is used to measure the coverage after the goal its coverage point % refers to. :- type cp_type ---> cp_type_coverage_after ; cp_type_branch_arm. % Gives the value in C for this coverage point type. % :- pred coverage_point_type_c_value(cp_type::in, string::out) is det. %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% :- implementation. :- import_module mdbcomp.builtin_modules. :- import_module int. :- import_module require. :- import_module string. %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% detism_get_solutions(Detism) = Solutions :- detism_components(Detism, Solutions, _). detism_get_can_fail(Detism) = CanFail :- detism_components(Detism, _, CanFail). detism_components(det_rep, at_most_one_rep, cannot_fail_rep). detism_components(semidet_rep, at_most_one_rep, can_fail_rep). detism_components(multidet_rep, at_most_many_rep, cannot_fail_rep). detism_components(nondet_rep, at_most_many_rep, can_fail_rep). detism_components(cc_multidet_rep, at_most_one_rep, cannot_fail_rep). detism_components(cc_nondet_rep, at_most_one_rep, can_fail_rep). detism_components(erroneous_rep, at_most_zero_rep, cannot_fail_rep). detism_components(failure_rep, at_most_zero_rep, can_fail_rep). detism_committed_choice(det_rep, not_committed_choice). detism_committed_choice(semidet_rep, not_committed_choice). detism_committed_choice(multidet_rep, not_committed_choice). detism_committed_choice(nondet_rep, not_committed_choice). detism_committed_choice(cc_multidet_rep, committed_choice). detism_committed_choice(cc_nondet_rep, committed_choice). detism_committed_choice(erroneous_rep, not_committed_choice). detism_committed_choice(failure_rep, not_committed_choice). %---------------------------------------------------------------------------% :- type var_name_table == map(var_rep, string). search_var_name(VarNameTable, VarRep, String) :- map.search(VarNameTable, VarRep, String). maybe_search_var_name(VarNameTable, VarRep, MaybeString) :- ( if search_var_name(VarNameTable, VarRep, String) then MaybeString = yes(String) else MaybeString = no ). lookup_var_name(VarNameTable, VarRep, String) :- ( if search_var_name(VarNameTable, VarRep, StringPrime) then String = StringPrime else % Generate an automatic name for the variable. String = string.format("V_%d", [i(VarRep)]) ). %---------------------------------------------------------------------------% atomic_goal_generates_event_like_call(GoalRep) = Generates :- ( ( GoalRep = unify_construct_rep(_, _, _) ; GoalRep = unify_deconstruct_rep(_, _, _) ; GoalRep = partial_construct_rep(_, _, _) ; GoalRep = partial_deconstruct_rep(_, _, _) ; GoalRep = unify_assign_rep(_, _) ; GoalRep = unify_simple_test_rep(_, _) ; GoalRep = cast_rep(_, _) ; GoalRep = pragma_foreign_code_rep(_) ; GoalRep = builtin_call_rep(_, _, _) ; GoalRep = event_call_rep(_, _) ), Generates = no ; ( GoalRep = higher_order_call_rep(_, Args) ; GoalRep = method_call_rep(_, _, Args) ), Generates = yes(Args) ; GoalRep = plain_call_rep(ModuleName, PredName, Args), NumArgs = list.length(Args), ( if call_does_not_generate_events(ModuleName, PredName, NumArgs) then Generates = no else Generates = yes(Args) ) ). call_does_not_generate_events(ModuleName, PredName, Arity) :- ( SymModuleName = string_to_sym_name(ModuleName), non_traced_mercury_builtin_module(SymModuleName) ; % The debugger cannot handle calls to polymorphic builtins that % do not take a type_info argument, so such calls are not traced. SymModuleName = string_to_sym_name(ModuleName), no_type_info_builtin(SymModuleName, PredName, Arity) ; pred_is_external(ModuleName, PredName, Arity) ; % Events from compiler generated predicates are not included in the % annotated trace at the moment. ( PredName = "__Unify__" ; PredName = "__Index__" ; PredName = "__Compare__" ) ). goal_generates_internal_event(goal_rep(GoalExpr, _, _)) = InternalEvent :- require_complete_switch [GoalExpr] ( ( GoalExpr = conj_rep(_) ; GoalExpr = scope_rep(_, _) ; GoalExpr = atomic_goal_rep(_, _, _, _) % Atomic goals may generate interface events, % but not internal events. ), InternalEvent = no ; ( GoalExpr = disj_rep(_) ; GoalExpr = switch_rep(_, _, _) ; GoalExpr = ite_rep(_, _, _) ; GoalExpr = negation_rep(_) ), InternalEvent = yes ). atomic_goal_identifiable(AtomicGoalExpr) = Identifieable :- ( ( AtomicGoalExpr = unify_construct_rep(_, _, _) ; AtomicGoalExpr = unify_deconstruct_rep(_, _, _) ; AtomicGoalExpr = partial_construct_rep(_, _, _) ; AtomicGoalExpr = partial_deconstruct_rep(_, _, _) ; AtomicGoalExpr = unify_assign_rep(_, _) ; AtomicGoalExpr = unify_simple_test_rep(_, _) ; AtomicGoalExpr = cast_rep(_, _) ; AtomicGoalExpr = pragma_foreign_code_rep(_) ; AtomicGoalExpr = higher_order_call_rep(_, _) ; AtomicGoalExpr = method_call_rep(_, _, _) ; AtomicGoalExpr = event_call_rep(_, _) ), Identifieable = no ; AtomicGoalExpr = builtin_call_rep(Module, Name, Args), Identifieable = yes(atomic_goal_id(Module, Name, length(Args))) ; AtomicGoalExpr = plain_call_rep(Module, Name, Args), Identifieable = yes(atomic_goal_id(Module, Name, length(Args))) ). head_var_to_var(head_var_rep(Var, _)) = Var. case_get_goal(case_rep(_, _, Goal), Goal). %---------------------------------------------------------------------------% transform_goal_rep(Pred, Goal0, Goal) :- Goal0 = goal_rep(Expr0, Detism, AnnotationT), transform_goal_expr(Pred, Expr0, Expr), Pred(AnnotationT, AnnotationU), Goal = goal_rep(Expr, Detism, AnnotationU). :- pred transform_goal_expr(pred(T, U)::in(pred(in, out) is det), goal_expr_rep(T)::in, goal_expr_rep(U)::out) is det. transform_goal_expr(Pred, Expr0, Expr) :- ( Expr0 = conj_rep(Conjs0), list.map(transform_goal_rep(Pred), Conjs0, Conjs), Expr = conj_rep(Conjs) ; Expr0 = disj_rep(Disjs0), list.map(transform_goal_rep(Pred), Disjs0, Disjs), Expr = disj_rep(Disjs) ; Expr0 = switch_rep(Var, CanFail, Cases0), map(transform_switch_case(Pred), Cases0, Cases), Expr = switch_rep(Var, CanFail, Cases) ; Expr0 = ite_rep(Cond0, Then0, Else0), transform_goal_rep(Pred, Cond0, Cond), transform_goal_rep(Pred, Then0, Then), transform_goal_rep(Pred, Else0, Else), Expr = ite_rep(Cond, Then, Else) ; Expr0 = negation_rep(NegGoal0), transform_goal_rep(Pred, NegGoal0, NegGoal), Expr = negation_rep(NegGoal) ; Expr0 = scope_rep(SubGoal0, MaybeCut), transform_goal_rep(Pred, SubGoal0, SubGoal), Expr = scope_rep(SubGoal, MaybeCut) ; Expr0 = atomic_goal_rep(Filename, Lineno, BoundVars, AtomicGoal), Expr = atomic_goal_rep(Filename, Lineno, BoundVars, AtomicGoal) ). :- pred transform_switch_case(pred(T, U)::in(pred(in, out) is det), case_rep(T)::in, case_rep(U)::out) is det. transform_switch_case(Pred, Case0, Case) :- Case0 = case_rep(MainConsId, OtherConsIds, Goal0), transform_goal_rep(Pred, Goal0, Goal), Case = case_rep(MainConsId, OtherConsIds, Goal). %---------------------------------------------------------------------------% :- pragma foreign_export("C", proc_defn_rep_type = out, "ML_proc_defn_rep_type"). proc_defn_rep_type = type_of(_ : proc_defn_rep). :- pragma foreign_export("C", goal_rep_type = out, "ML_goal_rep_type"). goal_rep_type = type_of(_ : goal_rep). %---------------------------------------------------------------------------% detism_rep(Detism) = Rep :- determinism_representation(Detism, Rep). % This encoding must match the encoding of MR_Determinism in % runtime/mercury_stack_layout.h. The rationale for this encoding % is documented there. determinism_representation(det_rep, 6). determinism_representation(semidet_rep, 2). determinism_representation(nondet_rep, 3). determinism_representation(multidet_rep, 7). determinism_representation(erroneous_rep, 4). determinism_representation(failure_rep, 0). determinism_representation(cc_nondet_rep, 10). determinism_representation(cc_multidet_rep, 14). inst_representation(ir_free_rep, 0). inst_representation(ir_ground_rep, 1). inst_representation(ir_other_rep, 2). goal_type_to_byte(Type) = TypeInt :- goal_type_byte(TypeInt, Type). byte_to_goal_type(TypeInt, Type) :- goal_type_byte(TypeInt, Type). :- pred goal_type_byte(int, bytecode_goal_type). :- mode goal_type_byte(in, out) is semidet. :- mode goal_type_byte(out, in) is det. goal_type_byte(1, goal_conj). goal_type_byte(2, goal_disj). goal_type_byte(3, goal_switch). goal_type_byte(4, goal_ite). goal_type_byte(5, goal_neg). goal_type_byte(6, goal_scope). goal_type_byte(7, goal_construct). goal_type_byte(8, goal_deconstruct). goal_type_byte(9, goal_partial_construct). goal_type_byte(10, goal_partial_deconstruct). goal_type_byte(11, goal_assign). goal_type_byte(12, goal_cast). goal_type_byte(13, goal_simple_test). goal_type_byte(14, goal_foreign). goal_type_byte(15, goal_ho_call). goal_type_byte(16, goal_method_call). goal_type_byte(17, goal_plain_call). goal_type_byte(18, goal_builtin_call). goal_type_byte(19, goal_event_call). %---------------------------------------------------------------------------% var_num_rep_byte(var_num_1_byte, 0). var_num_rep_byte(var_num_2_bytes, 1). var_num_rep_byte(var_num_4_bytes, 2). var_flag_byte(var_num_1_byte, do_not_include_var_name_table, do_not_include_var_types, 0). var_flag_byte(var_num_1_byte, do_not_include_var_name_table, include_var_types, 1). var_flag_byte(var_num_1_byte, include_var_name_table, do_not_include_var_types, 2). var_flag_byte(var_num_1_byte, include_var_name_table, include_var_types, 3). var_flag_byte(var_num_2_bytes, do_not_include_var_name_table, do_not_include_var_types, 4). var_flag_byte(var_num_2_bytes, do_not_include_var_name_table, include_var_types, 5). var_flag_byte(var_num_2_bytes, include_var_name_table, do_not_include_var_types, 6). var_flag_byte(var_num_2_bytes, include_var_name_table, include_var_types, 7). var_flag_byte(var_num_4_bytes, do_not_include_var_name_table, do_not_include_var_types, 8). var_flag_byte(var_num_4_bytes, do_not_include_var_name_table, include_var_types, 9). var_flag_byte(var_num_4_bytes, include_var_name_table, do_not_include_var_types, 10). var_flag_byte(var_num_4_bytes, include_var_name_table, include_var_types, 11). cut_byte(scope_is_no_cut, 0). cut_byte(scope_is_cut, 1). can_fail_byte(switch_can_fail_rep, 0). can_fail_byte(switch_can_not_fail_rep, 1). %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% % % The top level of the code that reads the representation of a whole program % from a file. % read_prog_rep_file(FileName, Result, !IO) :- read_file_as_bytecode(FileName, ReadResult, !IO), ( ReadResult = error(Error), Result = error(Error) ; ReadResult = ok(ByteCode), ( if some [!Pos] ( !:Pos = 0, read_line(ByteCode, Line, !Pos), ( if Line = old_procrep_id_string then ExpectNewFormat = no else if Line = new_procrep_id_string then ExpectNewFormat = yes else fail ), read_module_reps(ExpectNewFormat, ByteCode, map.init, ModuleReps, !Pos), ByteCode = bytecode(_, Size), !.Pos = Size ) then Result = ok(prog_rep(ModuleReps)) else Msg = FileName ++ ": is not a valid program representation file", Result = error(io.make_io_error(Msg)) ) ). % Return the string written out by MR_write_out_procrep_id_string. % :- func old_procrep_id_string = string. :- func new_procrep_id_string = string. old_procrep_id_string = "Mercury deep profiler procrep version 5\n". new_procrep_id_string = "Mercury deep profiler procrep version 6\n". :- pred read_file_as_bytecode(string::in, io.res(bytecode)::out, io::di, io::uo) is det. read_file_as_bytecode(FileName, Result, !IO) :- read_file_as_bytecode_2(FileName, ByteCode, Size, Error, !IO), ( if Size < 0 then io.make_err_msg(Error, "opening " ++ FileName ++ ": ", Msg), Result = error(io.make_io_error(Msg)) else Result = ok(bytecode(ByteCode, Size)) ). :- pragma foreign_decl("C", " #ifdef MR_HAVE_SYS_STAT_H #include #endif "). :- pred read_file_as_bytecode_2(string::in, bytecode_bytes::out, int::out, io.system_error::out, io::di, io::uo) is det. :- pragma foreign_proc("C", read_file_as_bytecode_2(FileName::in, Bytes::out, Size::out, Error::out, _IO0::di, _IO::uo), [will_not_call_mercury, thread_safe, promise_pure], " #if defined(MR_HAVE_SYS_STAT_H) && \ defined(MR_HAVE_STAT) && \ defined(MR_HAVE_OPEN) struct stat statbuf; if (stat(FileName, &statbuf) != 0) { Bytes = NULL; Size = -1; Error = errno; } else { int fd; char *buf; Size = statbuf.st_size; MR_allocate_aligned_string_msg(buf, Size, MR_ALLOC_ID); fd = open(FileName, O_RDONLY, 0); if (fd < 0) { Bytes = NULL; Size = -1; Error = errno; } else { if (read(fd, buf, Size) != Size) { Bytes = NULL; Size = -1; Error = errno; } else { if (close(fd) != 0) { Bytes = NULL; Size = -1; Error = errno; } else { Bytes = (MR_uint_least8_t *) buf; Error = 0; } } } } #else MR_fatal_error(""read_file_as_bytecode: not supported on this platform""); #endif "). %---------------------------------------------------------------------------% % % The top level of the code that reads the representation of a procedure % from that procedure's proc layout structure. % :- pragma foreign_export("C", trace_read_proc_defn_rep(in, in, out), "MR_MDBCOMP_trace_read_proc_defn_rep"). trace_read_proc_defn_rep(Bytes, LabelLayout, ProcDefnRep) :- ProcLayout = containing_proc_layout(LabelLayout), ( if containing_module_layout(ProcLayout, ModuleLayout) then StringTable = module_string_table(ModuleLayout) else unexpected($pred, "no module layout") ), some [!Pos] ( !:Pos = 0, % The size of the bytecode is not recorded anywhere in the proc layout % except at the start of the bytecode itself. DummyByteCode = bytecode(Bytes, 4), read_int32(DummyByteCode, Size, !Pos), ByteCode = bytecode(Bytes, Size), read_string_via_offset(ByteCode, StringTable, FileName, !Pos), Info = read_proc_rep_info(FileName), % The declarative debugger does not need variable type representations % from the bytecode. It has access to actual type_infos in label % layouts. ExpectNewFormat = yes, read_var_table(ExpectNewFormat, ByteCode, StringTable, map.init, VarNumRep, VarNameTable, _MaybeVarTypeTable, !Pos), read_head_vars(VarNumRep, ByteCode, HeadVars, !Pos), read_goal(VarNumRep, ByteCode, StringTable, Info, Goal, !Pos), read_determinism(ByteCode, Detism, !Pos), ProcDefnRep = proc_defn_rep(HeadVars, Goal, VarNameTable, no, Detism), expect(unify(!.Pos, Size), $pred, "limit mismatch") ). %---------------------------------------------------------------------------% % % Operations that parse the (remaining part of) the bytecode string % as various components of a program representation. % :- pred read_module_reps(bool::in, bytecode::in, module_map(unit)::in, module_map(unit)::out, int::in, int::out) is semidet. read_module_reps(ExpectNewFormat, ByteCode, !ModuleReps, !Pos) :- read_byte(ByteCode, MoreByte, !Pos), is_more_modules(MoreByte, MoreModules), ( MoreModules = no_more_modules ; MoreModules = next_module, read_module_rep(ExpectNewFormat, ByteCode, ModuleRep, !Pos), map.det_insert(ModuleRep ^ mr_name, ModuleRep, !ModuleReps), disable_warning [suspicious_recursion] ( read_module_reps(ExpectNewFormat, ByteCode, !ModuleReps, !Pos) ) ). :- pred read_module_rep(bool::in, bytecode::in, module_rep(unit)::out, int::in, int::out) is semidet. read_module_rep(ExpectNewFormat, ByteCode, ModuleRep, !Pos) :- read_len_string(ByteCode, ModuleName, !Pos), trace [io(!IO), compiletime(flag("debug_oisu_bytecode"))] ( io.write_string("module rep for ", !IO), io.write_string(ModuleName, !IO), io.nl(!IO) ), read_string_table(ByteCode, StringTable, !Pos), ( ExpectNewFormat = no, OISUTypes = [], map.init(TypeTable) ; ExpectNewFormat = yes, read_num(ByteCode, NumOISUTypes, !Pos), ( if NumOISUTypes > 0 then OISUStartPos = !.Pos, read_int32(ByteCode, OISUSize, !Pos), trace [io(!IO), compiletime(flag("debug_oisu_bytecode"))] ( io.write_string("OISU num types ", !IO), io.write_int(NumOISUTypes, !IO), io.nl(!IO), io.write_string("OISU bytecode size ", !IO), io.write_int(OISUSize, !IO), io.nl(!IO) ), read_n_items(read_oisu_type_procs(ByteCode), NumOISUTypes, OISUTypes, !Pos), expect(unify(!.Pos, OISUStartPos + OISUSize), $pred, "oisu limit mismatch") else OISUTypes = [] ), read_num(ByteCode, NumTableTypes, !Pos), ( if NumTableTypes > 0 then TypeStartPos = !.Pos, read_int32(ByteCode, TypeSize, !Pos), trace [io(!IO), compiletime(flag("debug_oisu_bytecode"))] ( io.write_string("num types ", !IO), io.write_int(NumOISUTypes, !IO), io.nl(!IO), io.write_string("type bytecode size ", !IO), io.write_int(TypeSize, !IO), io.nl(!IO) ), read_n_encoded_types(ByteCode, StringTable, 0, NumTableTypes, map.init, TypeTable, !Pos), expect(unify(!.Pos, TypeStartPos + TypeSize), $pred, "type limit mismatch") else map.init(TypeTable) ) ), read_proc_reps(ExpectNewFormat, ByteCode, StringTable, TypeTable, map.init, ProcReps, !Pos), ModuleRep = module_rep(ModuleName, StringTable, OISUTypes, TypeTable, ProcReps). %---------------------% :- pred read_oisu_type_procs(bytecode::in, oisu_type_procs::out, int::in, int::out) is semidet. read_oisu_type_procs(ByteCode, OISUTypeProcs, !Pos) :- read_len_string(ByteCode, TypeCtorName, !Pos), read_num(ByteCode, NumCreators, !Pos), read_n_items(read_string_proc_label(ByteCode), NumCreators, CreatorProcLabels, !Pos), read_num(ByteCode, NumMutators, !Pos), read_n_items(read_string_proc_label(ByteCode), NumMutators, MutatorProcLabels, !Pos), read_num(ByteCode, NumDestructors, !Pos), read_n_items(read_string_proc_label(ByteCode), NumDestructors, DestructorProcLabels, !Pos), OISUTypeProcs = oisu_type_procs(TypeCtorName, CreatorProcLabels, MutatorProcLabels, DestructorProcLabels). %---------------------% :- pred read_n_encoded_types(bytecode::in, string_table::in, int::in, int::in, encoded_type_table::in, encoded_type_table::out, int::in, int::out) is semidet. read_n_encoded_types(ByteCode, StringTable, CurTypeNum, NumTableTypes, !TypeTable, !Pos) :- ( if CurTypeNum < NumTableTypes then read_encoded_type(ByteCode, StringTable, !.TypeTable, TypeRep, !Pos), map.det_insert(CurTypeNum, TypeRep, !TypeTable), read_n_encoded_types(ByteCode, StringTable, CurTypeNum + 1, NumTableTypes, !TypeTable, !Pos) else true ). :- pred read_encoded_type(bytecode::in, string_table::in, encoded_type_table::in, type_rep::out, int::in, int::out) is semidet. read_encoded_type(ByteCode, StringTable, TypeTable, TypeRep, !Pos) :- % The encoding read here is created by add_type_to_table in compiler/ % prog_rep_table.m. The code here and there must be kept in sync. read_byte(ByteCode, Selector, !Pos), ( Selector = 0, read_string_via_offset(ByteCode, StringTable, TypeCtorStr, !Pos), TypeCtorSymName = string_to_sym_name(TypeCtorStr), TypeRep = defined_type_rep(TypeCtorSymName, []) ; Selector = 1, read_string_via_offset(ByteCode, StringTable, TypeCtorStr, !Pos), TypeCtorSymName = string_to_sym_name(TypeCtorStr), read_num(ByteCode, TypeNumArg1, !Pos), map.lookup(TypeTable, TypeNumArg1, TypeRepArg1), TypeRep = defined_type_rep(TypeCtorSymName, [TypeRepArg1]) ; Selector = 2, read_string_via_offset(ByteCode, StringTable, TypeCtorStr, !Pos), TypeCtorSymName = string_to_sym_name(TypeCtorStr), read_num(ByteCode, TypeNumArg1, !Pos), read_num(ByteCode, TypeNumArg2, !Pos), map.lookup(TypeTable, TypeNumArg1, TypeRepArg1), map.lookup(TypeTable, TypeNumArg2, TypeRepArg2), TypeRep = defined_type_rep(TypeCtorSymName, [TypeRepArg1, TypeRepArg2]) ; Selector = 3, read_string_via_offset(ByteCode, StringTable, TypeCtorStr, !Pos), TypeCtorSymName = string_to_sym_name(TypeCtorStr), read_num(ByteCode, TypeNumArg1, !Pos), read_num(ByteCode, TypeNumArg2, !Pos), read_num(ByteCode, TypeNumArg3, !Pos), map.lookup(TypeTable, TypeNumArg1, TypeRepArg1), map.lookup(TypeTable, TypeNumArg2, TypeRepArg2), map.lookup(TypeTable, TypeNumArg3, TypeRepArg3), TypeRep = defined_type_rep(TypeCtorSymName, [TypeRepArg1, TypeRepArg2, TypeRepArg3]) ; Selector = 4, read_string_via_offset(ByteCode, StringTable, TypeCtorStr, !Pos), TypeCtorSymName = string_to_sym_name(TypeCtorStr), read_num(ByteCode, NumArgs, !Pos), read_n_items(read_num(ByteCode), NumArgs, TypeNumArgs, !Pos), list.map(map.lookup(TypeTable), TypeNumArgs, TypeRepArgs), TypeRep = defined_type_rep(TypeCtorSymName, TypeRepArgs) ; Selector = 5, TypeRep = builtin_type_rep(builtin_type_int_rep) ; Selector = 6, TypeRep = builtin_type_rep(builtin_type_uint_rep) ; Selector = 7, TypeRep = builtin_type_rep(builtin_type_float_rep) ; Selector = 8, TypeRep = builtin_type_rep(builtin_type_string_rep) ; Selector = 9, TypeRep = builtin_type_rep(builtin_type_char_rep) ; Selector = 10, read_num(ByteCode, NumArgs, !Pos), read_n_items(read_num(ByteCode), NumArgs, TypeNumArgs, !Pos), list.map(map.lookup(TypeTable), TypeNumArgs, TypeRepArgs), TypeRep = tuple_type_rep(TypeRepArgs) ; Selector = 11, read_num(ByteCode, NumArgs, !Pos), read_n_items(read_num(ByteCode), NumArgs, TypeNumArgs, !Pos), list.map(map.lookup(TypeTable), TypeNumArgs, TypeRepArgs), TypeRep = higher_order_type_rep(TypeRepArgs, no) ; Selector = 12, read_num(ByteCode, NumArgs, !Pos), read_n_items(read_num(ByteCode), NumArgs, TypeNumArgs, !Pos), list.map(map.lookup(TypeTable), TypeNumArgs, TypeRepArgs), read_num(ByteCode, TypeNumReturn, !Pos), map.lookup(TypeTable, TypeNumReturn, TypeRepReturn), TypeRep = higher_order_type_rep(TypeRepArgs, yes(TypeRepReturn)) ; Selector = 13, read_num(ByteCode, VarNum, !Pos), TypeRep = type_var_rep(VarNum) ; % XXX in order to avoid bumping the deep profiler binary compatibility % version number when the fixed size integers were added, the newly % added types were assigned unused Selector values. The next time the % format of the program representation file is changed for some % unavoidable reason this should be tidied up. Selector = 14, TypeRep = builtin_type_rep(builtin_type_int8_rep) ; Selector = 15, TypeRep = builtin_type_rep(builtin_type_uint8_rep) ; Selector = 16, TypeRep = builtin_type_rep(builtin_type_int16_rep) ; Selector = 17, TypeRep = builtin_type_rep(builtin_type_uint16_rep) ; Selector = 18, TypeRep = builtin_type_rep(builtin_type_int32_rep) ; Selector = 19, TypeRep = builtin_type_rep(builtin_type_uint32_rep) ; Selector = 20, TypeRep = builtin_type_rep(builtin_type_int64_rep) ; Selector = 21, TypeRep = builtin_type_rep(builtin_type_uint64_rep) ). %---------------------% :- pred read_proc_reps(bool::in, bytecode::in, string_table::in, encoded_type_table::in, proc_map(unit)::in, proc_map(unit)::out, int::in, int::out) is semidet. read_proc_reps(ExpectNewFormat, ByteCode, StringTable, TypeTable, !ProcReps, !Pos) :- read_byte(ByteCode, MoreByte, !Pos), is_more_procs(MoreByte, MoreProcs), ( MoreProcs = no_more_procs ; MoreProcs = next_proc, read_proc_rep(ExpectNewFormat, ByteCode, StringTable, TypeTable, ProcRep, !Pos), map.det_insert(ProcRep ^ pr_id, ProcRep, !ProcReps), disable_warning [suspicious_recursion] ( read_proc_reps(ExpectNewFormat, ByteCode, StringTable, TypeTable, !ProcReps, !Pos) ) ). :- pred read_proc_rep(bool::in, bytecode::in, string_table::in, encoded_type_table::in, proc_rep(unit)::out, int::in, int::out) is semidet. read_proc_rep(ExpectNewFormat, ByteCode, StringTable, TypeTable, ProcRep, !Pos) :- read_string_proc_label(ByteCode, ProcLabel, !Pos), StartPos = !.Pos, read_int32(ByteCode, Size, !Pos), read_string_via_offset(ByteCode, StringTable, FileName, !Pos), Info = read_proc_rep_info(FileName), read_var_table(ExpectNewFormat, ByteCode, StringTable, TypeTable, VarNumRep, VarNameTable, MaybeVarTypeTable, !Pos), read_head_vars(VarNumRep, ByteCode, HeadVars, !Pos), read_goal(VarNumRep, ByteCode, StringTable, Info, Goal, !Pos), read_determinism(ByteCode, Detism, !Pos), ProcDefnRep = proc_defn_rep(HeadVars, Goal, VarNameTable, MaybeVarTypeTable, Detism), expect(unify(!.Pos, StartPos + Size), $pred, "limit mismatch"), ProcRep = proc_rep(ProcLabel, ProcDefnRep). :- pred read_string_proc_label(bytecode::in, string_proc_label::out, int::in, int::out) is semidet. read_string_proc_label(ByteCode, ProcLabel, !Pos) :- read_byte(ByteCode, Byte, !Pos), is_proclabel_kind(Byte, ProcLabelKind), ( ProcLabelKind = proclabel_special, read_len_string(ByteCode, TypeName, !Pos), read_len_string(ByteCode, TypeModule, !Pos), read_len_string(ByteCode, DefModule, !Pos), read_len_string(ByteCode, PredName, !Pos), read_num(ByteCode, Arity, !Pos), read_num(ByteCode, ModeNum, !Pos), ProcLabel = str_special_proc_label(TypeName, TypeModule, DefModule, PredName, Arity, ModeNum) ; ( ProcLabelKind = proclabel_user_predicate, PredOrFunc = pf_predicate ; ProcLabelKind = proclabel_user_function, PredOrFunc = pf_function ), read_len_string(ByteCode, DeclModule, !Pos), read_len_string(ByteCode, DefModule, !Pos), read_len_string(ByteCode, PredName, !Pos), read_num(ByteCode, Arity, !Pos), read_num(ByteCode, ModeNum, !Pos), ProcLabel = str_ordinary_proc_label(PredOrFunc, DeclModule, DefModule, PredName, Arity, ModeNum) ). %---------------------% % Read the var table from the bytecode. The var table contains the names % of all the variables used in the procedure representation, and may % (or may not) also contain their types. % :- pred read_var_table(bool::in, bytecode::in, string_table::in, encoded_type_table::in, var_num_rep::out, var_name_table::out, maybe(var_type_table)::out, int::in, int::out) is semidet. read_var_table(ExpectNewFormat, ByteCode, StringTable, TypeTable, VarNumRep, VarNameTable, MaybeVarTypeTable, !Pos) :- ( ExpectNewFormat = no, read_var_num_rep(ByteCode, VarNumRep, !Pos), read_int32(ByteCode, NumVarsInTable, !Pos), read_var_name_table_entries(NumVarsInTable, VarNumRep, ByteCode, StringTable, map.init, VarNameTable, !Pos), MaybeVarTypeTable = no ; ExpectNewFormat = yes, read_var_flag(ByteCode, VarNumRep, IncludeVarNameTable, IncludeVarTypes, !Pos), ( IncludeVarNameTable = do_not_include_var_name_table, expect(unify(IncludeVarTypes, do_not_include_var_types), $pred, "var types but not names"), map.init(VarNameTable), MaybeVarTypeTable = no ; IncludeVarNameTable = include_var_name_table, ( IncludeVarTypes = do_not_include_var_types, read_num(ByteCode, NumVarsInTable, !Pos), read_var_name_table_entries(NumVarsInTable, VarNumRep, ByteCode, StringTable, map.init, VarNameTable, !Pos), MaybeVarTypeTable = no ; IncludeVarTypes = include_var_types, read_num(ByteCode, NumVarsInTable, !Pos), read_var_name_type_table_entries(NumVarsInTable, VarNumRep, ByteCode, StringTable, TypeTable, map.init, VarNameTable, map.init, VarTypeTable, !Pos), MaybeVarTypeTable = yes(VarTypeTable) ) ) ). % Read entries from the variable name table until there are no more % entries left to read. % :- pred read_var_name_table_entries(var_rep::in, var_num_rep::in, bytecode::in, string_table::in, var_name_table::in, var_name_table::out, int::in, int::out) is semidet. read_var_name_table_entries(NumVarsLeftInTable, VarNumRep, ByteCode, StringTable, !VarNameTable, !Pos) :- ( if NumVarsLeftInTable > 0 then read_var(VarNumRep, ByteCode, VarRep, !Pos), read_string_via_offset(ByteCode, StringTable, VarName, !Pos), map.det_insert(VarRep, VarName, !VarNameTable), read_var_name_table_entries(NumVarsLeftInTable - 1, VarNumRep, ByteCode, StringTable, !VarNameTable, !Pos) else % No more variables to read. true ). % Read entries from the variable name and type table until % there are no more entries left to read. % :- pred read_var_name_type_table_entries(var_rep::in, var_num_rep::in, bytecode::in, string_table::in, encoded_type_table::in, var_name_table::in, var_name_table::out, var_type_table::in, var_type_table::out, int::in, int::out) is semidet. read_var_name_type_table_entries(NumVarsLeftInTable, VarNumRep, ByteCode, StringTable, TypeTable, !VarNameTable, !VarTypeTable, !Pos) :- ( if NumVarsLeftInTable > 0 then read_var(VarNumRep, ByteCode, VarRep, !Pos), read_string_via_offset(ByteCode, StringTable, VarName, !Pos), map.det_insert(VarRep, VarName, !VarNameTable), read_num(ByteCode, TypeNum, !Pos), map.lookup(TypeTable, TypeNum, TypeRep), map.det_insert(VarRep, TypeRep, !VarTypeTable), read_var_name_type_table_entries(NumVarsLeftInTable - 1, VarNumRep, ByteCode, StringTable, TypeTable, !VarNameTable, !VarTypeTable, !Pos) else % No more variables to read. true ). %---------------------% :- type read_proc_rep_info ---> read_proc_rep_info( rpri_filename :: string ). :- pred read_goal(var_num_rep::in, bytecode::in, string_table::in, read_proc_rep_info::in, goal_rep::out, int::in, int::out) is semidet. read_goal(VarNumRep, ByteCode, StringTable, Info, Goal, !Pos) :- read_byte(ByteCode, GoalTypeByte, !Pos), ( if byte_to_goal_type(GoalTypeByte, GoalType) then ( GoalType = goal_conj, read_goals(VarNumRep, ByteCode, StringTable, Info, Goals, !Pos), GoalExpr = conj_rep(Goals) ; GoalType = goal_disj, read_goals(VarNumRep, ByteCode, StringTable, Info, Goals, !Pos), GoalExpr = disj_rep(Goals) ; GoalType = goal_neg, disable_warning [suspicious_recursion] ( read_goal(VarNumRep, ByteCode, StringTable, Info, SubGoal, !Pos) ), GoalExpr = negation_rep(SubGoal) ; GoalType = goal_ite, disable_warning [suspicious_recursion] ( read_goal(VarNumRep, ByteCode, StringTable, Info, Cond, !Pos), read_goal(VarNumRep, ByteCode, StringTable, Info, Then, !Pos), read_goal(VarNumRep, ByteCode, StringTable, Info, Else, !Pos) ), GoalExpr = ite_rep(Cond, Then, Else) ; GoalType = goal_switch, read_switch_can_fail(ByteCode, CanFail, !Pos), read_var(VarNumRep, ByteCode, Var, !Pos), read_cases(VarNumRep, ByteCode, StringTable, Info, Cases, !Pos), GoalExpr = switch_rep(Var, CanFail, Cases) ; GoalType = goal_assign, read_var(VarNumRep, ByteCode, Target, !Pos), read_var(VarNumRep, ByteCode, Source, !Pos), AtomicGoal = unify_assign_rep(Target, Source), read_atomic_info(VarNumRep, ByteCode, StringTable, Info, AtomicGoal, GoalExpr, !Pos) ; GoalType = goal_construct, read_var(VarNumRep, ByteCode, Var, !Pos), read_cons_id(ByteCode, StringTable, ConsId, !Pos), read_vars(VarNumRep, ByteCode, ArgVars, !Pos), AtomicGoal = unify_construct_rep(Var, ConsId, ArgVars), read_atomic_info(VarNumRep, ByteCode, StringTable, Info, AtomicGoal, GoalExpr, !Pos) ; GoalType = goal_deconstruct, read_var(VarNumRep, ByteCode, Var, !Pos), read_cons_id(ByteCode, StringTable, ConsId, !Pos), read_vars(VarNumRep, ByteCode, ArgVars, !Pos), AtomicGoal = unify_deconstruct_rep(Var, ConsId, ArgVars), read_atomic_info(VarNumRep, ByteCode, StringTable, Info, AtomicGoal, GoalExpr, !Pos) ; GoalType = goal_partial_construct, read_var(VarNumRep, ByteCode, Var, !Pos), read_cons_id(ByteCode, StringTable, ConsId, !Pos), read_maybe_vars(VarNumRep, ByteCode, MaybeVars, !Pos), AtomicGoal = partial_construct_rep(Var, ConsId, MaybeVars), read_atomic_info(VarNumRep, ByteCode, StringTable, Info, AtomicGoal, GoalExpr, !Pos) ; GoalType = goal_partial_deconstruct, read_var(VarNumRep, ByteCode, Var, !Pos), read_cons_id(ByteCode, StringTable, ConsId, !Pos), read_maybe_vars(VarNumRep, ByteCode, MaybeVars, !Pos), AtomicGoal = partial_deconstruct_rep(Var, ConsId, MaybeVars), read_atomic_info(VarNumRep, ByteCode, StringTable, Info, AtomicGoal, GoalExpr, !Pos) ; GoalType = goal_simple_test, read_var(VarNumRep, ByteCode, Var1, !Pos), read_var(VarNumRep, ByteCode, Var2, !Pos), AtomicGoal = unify_simple_test_rep(Var1, Var2), read_atomic_info(VarNumRep, ByteCode, StringTable, Info, AtomicGoal, GoalExpr, !Pos) ; GoalType = goal_scope, read_byte(ByteCode, MaybeCutByte, !Pos), ( if cut_byte(MaybeCutPrime, MaybeCutByte) then MaybeCut = MaybeCutPrime else unexpected($pred, "bad maybe_cut") ), disable_warning [suspicious_recursion] ( read_goal(VarNumRep, ByteCode, StringTable, Info, SubGoal, !Pos) ), GoalExpr = scope_rep(SubGoal, MaybeCut) ; GoalType = goal_ho_call, read_var(VarNumRep, ByteCode, Var, !Pos), read_vars(VarNumRep, ByteCode, Args, !Pos), AtomicGoal = higher_order_call_rep(Var, Args), read_atomic_info(VarNumRep, ByteCode, StringTable, Info, AtomicGoal, GoalExpr, !Pos) ; GoalType = goal_method_call, read_var(VarNumRep, ByteCode, Var, !Pos), read_method_num(ByteCode, MethodNum, !Pos), read_vars(VarNumRep, ByteCode, Args, !Pos), AtomicGoal = method_call_rep(Var, MethodNum, Args), read_atomic_info(VarNumRep, ByteCode, StringTable, Info, AtomicGoal, GoalExpr, !Pos) ; GoalType = goal_cast, read_var(VarNumRep, ByteCode, OutputVar, !Pos), read_var(VarNumRep, ByteCode, InputVar, !Pos), AtomicGoal = cast_rep(OutputVar, InputVar), read_atomic_info(VarNumRep, ByteCode, StringTable, Info, AtomicGoal, GoalExpr, !Pos) ; GoalType = goal_plain_call, read_string_via_offset(ByteCode, StringTable, ModuleName, !Pos), read_string_via_offset(ByteCode, StringTable, PredName, !Pos), read_vars(VarNumRep, ByteCode, Args, !Pos), AtomicGoal = plain_call_rep(ModuleName, PredName, Args), read_atomic_info(VarNumRep, ByteCode, StringTable, Info, AtomicGoal, GoalExpr, !Pos) ; GoalType = goal_builtin_call, read_string_via_offset(ByteCode, StringTable, ModuleName, !Pos), read_string_via_offset(ByteCode, StringTable, PredName, !Pos), read_vars(VarNumRep, ByteCode, Args, !Pos), AtomicGoal = builtin_call_rep(ModuleName, PredName, Args), read_atomic_info(VarNumRep, ByteCode, StringTable, Info, AtomicGoal, GoalExpr, !Pos) ; GoalType = goal_event_call, read_string_via_offset(ByteCode, StringTable, EventName, !Pos), read_vars(VarNumRep, ByteCode, Args, !Pos), AtomicGoal = event_call_rep(EventName, Args), read_atomic_info(VarNumRep, ByteCode, StringTable, Info, AtomicGoal, GoalExpr, !Pos) ; GoalType = goal_foreign, read_vars(VarNumRep, ByteCode, Args, !Pos), AtomicGoal = pragma_foreign_code_rep(Args), read_atomic_info(VarNumRep, ByteCode, StringTable, Info, AtomicGoal, GoalExpr, !Pos) ), read_determinism(ByteCode, Detism, !Pos), Goal = goal_rep(GoalExpr, Detism, unit) else unexpected($pred, "invalid goal type") ). :- pred read_atomic_info(var_num_rep::in, bytecode::in, string_table::in, read_proc_rep_info::in, atomic_goal_rep::in, goal_expr_rep(unit)::out, int::in, int::out) is semidet. read_atomic_info(VarNumRep, ByteCode, StringTable, Info, AtomicGoal, GoalExpr, !Pos) :- read_string_via_offset(ByteCode, StringTable, FileName0, !Pos), ( if FileName0 = "" then FileName = Info ^ rpri_filename else FileName = FileName0 ), read_lineno(ByteCode, LineNo, !Pos), read_vars(VarNumRep, ByteCode, BoundVars, !Pos), GoalExpr = atomic_goal_rep(FileName, LineNo, BoundVars, AtomicGoal). :- pred read_goals(var_num_rep::in, bytecode::in, string_table::in, read_proc_rep_info::in, list(goal_rep)::out, int::in, int::out) is semidet. read_goals(VarNumRep, ByteCode, StringTable, Info, Goals, !Pos) :- read_length(ByteCode, Len, !Pos), read_n_items(read_goal(VarNumRep, ByteCode, StringTable, Info), Len, Goals, !Pos). :- pred read_cases(var_num_rep::in, bytecode::in, string_table::in, read_proc_rep_info::in, list(case_rep(unit))::out, int::in, int::out) is semidet. read_cases(VarNumRep, ByteCode, StringTable, Info, Cases, !Pos) :- read_length(ByteCode, Len, !Pos), read_n_items(read_case(VarNumRep, ByteCode, StringTable, Info), Len, Cases, !Pos). :- pred read_case(var_num_rep::in, bytecode::in, string_table::in, read_proc_rep_info::in, case_rep(unit)::out, int::in, int::out) is semidet. read_case(VarNumRep, ByteCode, StringTable, Info, Case, !Pos) :- read_cons_id_arity(ByteCode, StringTable, MainConsId, !Pos), read_length(ByteCode, NumOtherConsIds, !Pos), read_n_items(read_cons_id_arity(ByteCode, StringTable), NumOtherConsIds, OtherConsIds, !Pos), read_goal(VarNumRep, ByteCode, StringTable, Info, Goal, !Pos), Case = case_rep(MainConsId, OtherConsIds, Goal). :- pred read_cons_id_arity(bytecode::in, string_table::in, cons_id_arity_rep::out, int::in, int::out) is semidet. read_cons_id_arity(ByteCode, StringTable, ConsId, !Pos) :- read_cons_id(ByteCode, StringTable, ConsIdFunctor, !Pos), read_short(ByteCode, ConsIdArity, !Pos), ConsId = cons_id_arity_rep(ConsIdFunctor, ConsIdArity). :- pred read_vars(var_num_rep::in, bytecode::in, list(var_rep)::out, int::in, int::out) is semidet. read_vars(VarNumRep, ByteCode, Vars, !Pos) :- read_length(ByteCode, Len, !Pos), read_n_items(read_var(VarNumRep, ByteCode), Len, Vars, !Pos). :- pred read_var(var_num_rep::in, bytecode::in, var_rep::out, int::in, int::out) is semidet. read_var(VarNumRep, ByteCode, Var, !Pos) :- ( VarNumRep = var_num_1_byte, read_byte(ByteCode, Var, !Pos) ; VarNumRep = var_num_2_bytes, read_short(ByteCode, Var, !Pos) ; VarNumRep = var_num_4_bytes, read_int32(ByteCode, Var, !Pos) ). :- pred read_maybe_vars(var_num_rep::in, bytecode::in, list(maybe(var_rep))::out, int::in, int::out) is semidet. read_maybe_vars(VarNumRep, ByteCode, MaybeVars, !Pos) :- read_length(ByteCode, Len, !Pos), read_n_items(read_maybe_var(VarNumRep, ByteCode), Len, MaybeVars, !Pos). :- pred read_maybe_var(var_num_rep::in, bytecode::in, maybe(var_rep)::out, int::in, int::out) is semidet. read_maybe_var(VarNumRep, ByteCode, MaybeVar, !Pos) :- read_byte(ByteCode, YesOrNo, !Pos), ( if YesOrNo = 1 then read_var(VarNumRep, ByteCode, Var, !Pos), MaybeVar = yes(Var) else if YesOrNo = 0 then MaybeVar = no else unexpected($pred, "invalid yes or no flag") ). :- pred read_head_vars(var_num_rep::in, bytecode::in, list(head_var_rep)::out, int::in, int::out) is semidet. read_head_vars(VarNumRep, ByteCode, HeadVars, !Pos) :- read_length(ByteCode, Len, !Pos), read_n_items(read_head_var(VarNumRep, ByteCode), Len, HeadVars, !Pos). :- pred read_head_var(var_num_rep::in, bytecode::in, head_var_rep::out, int::in, int::out) is semidet. read_head_var(VarNumRep, ByteCode, HeadVar, !Pos) :- read_var(VarNumRep, ByteCode, Var, !Pos), read_inst(ByteCode, InitialInst, !Pos), read_inst(ByteCode, FinalInst, !Pos), HeadVar = head_var_rep(Var, var_mode_rep(InitialInst, FinalInst)). :- pred read_inst(bytecode::in, inst_rep::out, int::in, int::out) is semidet. read_inst(ByteCode, Inst, !Pos) :- read_byte(ByteCode, Byte, !Pos), inst_representation(Inst, Byte). :- pred read_length(bytecode::in, var_rep::out, int::in, int::out) is semidet. read_length(ByteCode, Len, !Pos) :- read_int32(ByteCode, Len, !Pos). :- pred read_lineno(bytecode::in, int::out, int::in, int::out) is semidet. read_lineno(ByteCode, LineNo, !Pos) :- read_int32(ByteCode, LineNo, !Pos). :- pred read_method_num(bytecode::in, int::out, int::in, int::out) is semidet. read_method_num(ByteCode, MethodNum, !Pos) :- read_short(ByteCode, MethodNum, !Pos). :- pred read_cons_id(bytecode::in, string_table::in, cons_id_rep::out, int::in, int::out) is semidet. read_cons_id(ByteCode, StringTable, ConsId, !Pos) :- read_string_via_offset(ByteCode, StringTable, ConsId, !Pos). :- pred read_var_num_rep(bytecode::in, var_num_rep::out, int::in, int::out) is semidet. read_var_num_rep(ByteCode, VarNumRep, !Pos) :- read_byte(ByteCode, Byte, !Pos), ( if var_num_rep_byte(VarNumRepPrime, Byte) then VarNumRep = VarNumRepPrime else unexpected($pred, "unknown var_num_rep") ). :- pred read_var_flag(bytecode::in, var_num_rep::out, maybe_include_var_name_table::out, maybe_include_var_types::out, int::in, int::out) is semidet. read_var_flag(ByteCode, VarNumRep, IncludeVarNameTable, IncludeVarTypes, !Pos) :- read_byte(ByteCode, Byte, !Pos), ( if var_flag_byte(VarNumRepPrime, IncludeVarNameTablePrime, IncludeVarTypesPrime, Byte) then VarNumRep = VarNumRepPrime, IncludeVarNameTable = IncludeVarNameTablePrime, IncludeVarTypes = IncludeVarTypesPrime else unexpected($pred, "unknown var_flag_byte") ). :- pred read_determinism(bytecode::in, detism_rep::out, int::in, int::out) is semidet. read_determinism(ByteCode, Detism, !Pos) :- read_byte(ByteCode, DetismByte, !Pos), ( if determinism_representation(DetismPrime, DetismByte) then Detism = DetismPrime else unexpected($pred, "bad detism") ). :- pred read_switch_can_fail(bytecode::in, switch_can_fail_rep::out, int::in, int::out) is semidet. read_switch_can_fail(Bytecode, CanFail, !Pos) :- read_byte(Bytecode, CanFailByte, !Pos), ( if ( CanFailByte = 0, CanFailPrime = switch_can_fail_rep ; CanFailByte = 1, CanFailPrime = switch_can_not_fail_rep ) then CanFail = CanFailPrime else unexpected($pred, "bad switch_can_fail") ). %---------------------------------------------------------------------------% :- type more_modules ---> no_more_modules ; next_module. :- pragma foreign_enum("C", more_modules/0, [ no_more_modules - "MR_no_more_modules", next_module - "MR_next_module" ]). :- pred is_more_modules(int::in, more_modules::out) is semidet. :- pragma foreign_proc("C", is_more_modules(Int::in, MoreModules::out), [promise_pure, will_not_call_mercury, thread_safe], " MoreModules = (MR_MoreModules) Int; switch (MoreModules) { case MR_no_more_modules: case MR_next_module: SUCCESS_INDICATOR = MR_TRUE; break; default: SUCCESS_INDICATOR = MR_FALSE; break; } "). :- type more_procs ---> no_more_procs ; next_proc. :- pragma foreign_enum("C", more_procs/0, [ no_more_procs - "MR_no_more_procs", next_proc - "MR_next_proc" ]). :- pred is_more_procs(int::in, more_procs::out) is semidet. :- pragma foreign_proc("C", is_more_procs(Int::in, MoreProcs::out), [promise_pure, will_not_call_mercury, thread_safe], " MoreProcs = (MR_MoreProcs) Int; switch (MoreProcs) { case MR_no_more_procs: case MR_next_proc: SUCCESS_INDICATOR = MR_TRUE; break; default: SUCCESS_INDICATOR = MR_FALSE; break; } "). :- pragma foreign_enum("C", proclabel_kind_token/0, [ proclabel_user_predicate - "MR_proclabel_user_predicate", proclabel_user_function - "MR_proclabel_user_function", proclabel_special - "MR_proclabel_special" ]). :- pragma foreign_proc("C", is_proclabel_kind(Int::in, ProcLabelKind::out), [promise_pure, will_not_call_mercury, thread_safe], " ProcLabelKind = (MR_ProcLabelToken) Int; switch (ProcLabelKind) { case MR_proclabel_user_predicate: case MR_proclabel_user_function: case MR_proclabel_special: SUCCESS_INDICATOR = MR_TRUE; break; default: SUCCESS_INDICATOR = MR_FALSE; break; } "). %---------------------------------------------------------------------------% % An abstraction to read the given number of items using the higher order % predicate. % :- pred read_n_items(pred(T, int, int), int, list(T), int, int). :- mode read_n_items(pred(out, in, out) is det, in, out, in, out) is det. :- mode read_n_items(pred(out, in, out) is semidet, in, out, in, out) is semidet. read_n_items(Read, N, Items, !Pos) :- ( if N > 0 then Read(Item, !Pos), read_n_items(Read, N - 1, TailItems, !Pos), Items = [ Item | TailItems ] else Items = [] ). %---------------------------------------------------------------------------% %---------------------------------------------------------------------------% no_type_info_builtin(ModuleName, PredName, Arity) :- ( PredName = "unsafe_promise_unique", Arity = 2, ModuleName = mercury_public_builtin_module ; ( PredName = "builtin_compound_eq", Arity = 2 ; PredName = "builtin_compound_lt", Arity = 2 ; PredName = "compare_local_int16_bitfields", Arity = 4 ; PredName = "compare_local_int32_bitfields", Arity = 4 ; PredName = "compare_local_int8_bitfields", Arity = 4 ; PredName = "compare_local_uint_bitfields", Arity = 5 ; PredName = "compare_local_uint_words", Arity = 3 ; PredName = "compare_remote_int16_bitfields", Arity = 6 ; PredName = "compare_remote_int32_bitfields", Arity = 6 ; PredName = "compare_remote_int8_bitfields", Arity = 6 ; PredName = "compare_remote_uint_bitfields", Arity = 7 ; PredName = "compare_remote_uint_words", Arity = 5 ; PredName = "instance_constraint_from_typeclass_info", Arity = 3 ; PredName = "store_at_ref_impure", Arity = 2 ; PredName = "superclass_from_typeclass_info", Arity = 3 ; PredName = "type_info_from_typeclass_info", Arity = 3 ; PredName = "unconstrained_type_info_from_typeclass_info", Arity = 3 ; PredName = "unify_remote_arg_words", Arity = 4 ; PredName = "unsafe_type_cast", Arity = 2 ), ModuleName = mercury_private_builtin_module ; ( PredName = "table_lookup_insert_enum", Arity = 4 ; PredName = "table_lookup_insert_typeclassinfo", Arity = 3 ; PredName = "table_lookup_insert_typeinfo", Arity = 3 ; PredName = "table_restore_any_answer", Arity = 3 ), ModuleName = mercury_table_builtin_module ; PredName = "increment_size", Arity = 2, ModuleName = mercury_term_size_prof_builtin_module ; ( PredName = "get_future", Arity = 2 ; PredName = "new_future", Arity = 2 ; PredName = "signal_future", Arity = 2 ; PredName = "wait_future", Arity = 2 ), ModuleName = mercury_par_builtin_module ; ( PredName = "result_call_4", Arity = 4 ; PredName = "result_call_5", Arity = 5 ; PredName = "result_call_6", Arity = 6 ; PredName = "result_call_7", Arity = 7 ; PredName = "result_call_8", Arity = 8 ; PredName = "result_call_9", Arity = 9 ; PredName = "semidet_call_3", Arity = 3 ; PredName = "semidet_call_4", Arity = 4 ; PredName = "semidet_call_5", Arity = 5 ; PredName = "semidet_call_6", Arity = 6 ; PredName = "semidet_call_7", Arity = 7 ; PredName = "semidet_call_8", Arity = 8 ), ModuleName = mercury_rtti_implementation_builtin_module ). % True iff the given predicate has a `:- pragma external_pred' declaration. % Note that the arity includes the hidden type info arguments for % polymorphic predicates. % :- pred pred_is_external(string::in, string::in, int::in) is semidet. pred_is_external("exception", "builtin_catch", 4). pred_is_external("exception", "builtin_throw", 1). pred_is_external("builtin", "unify", 3). pred_is_external("builtin", "compare", 4). pred_is_external("builtin", "compare_representation", 4). pred_is_external("backjump", "builtin_choice_id", 1). pred_is_external("backjump", "builtin_backjump", 1). pred_is_external("par_builtin", "lc_finish", 1). pred_is_external("par_builtin", "lc_wait_free_slot", 2). %---------------------------------------------------------------------------% % % Please keep runtime/mercury_deep_profiling.h updated when modifying this % section. % :- pragma foreign_enum("C", cp_type/0, [ cp_type_coverage_after - "MR_cp_type_coverage_after", cp_type_branch_arm - "MR_cp_type_branch_arm" ]). coverage_point_type_c_value(cp_type_coverage_after, "MR_cp_type_coverage_after"). coverage_point_type_c_value(cp_type_branch_arm, "MR_cp_type_branch_arm"). %---------------------------------------------------------------------------%