mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-13 04:44:39 +00:00
Code Issues Projects Releases Wiki Activity
Files
4ee7e744b715b7adf665a267de3814131839a617
mercury/mdbcomp/program_representation.m
Zoltan Somogyi 8303b503b6 Unify and compare packed args in bulk when possible. 
compiler/unify_proc.m:
    Try to optimize the code we generate for unification and comparison
    predicates when a function symbol's arguments include sub-word-sized
    arguments packed together into a word.

    For unify predicates, generate code to test whether the two words
    at the same offset in the terms being unified are equal. This works
    regardless of whether the arguments are signed or unsigned.

    For compare predicates, generate code to compare the two words
    at the same offset in the terms being compared *if* all the arguments
    in the terms being compared are unsigned. This works because we put
    the earlier arguments in the more significant bit positions. But if
    some of the arguments are signed, then divide the argument word
    in sequences of zero or more unsigned arguments separated by signed
    arguments. We then generate code that compares any contiguous sequences
    of unsigned arguments in bulk, while comparing each signed field
    separately.

    Do the bulk unification and comparison via foreign_proc goals generated
    inline. This works only when we are generating C, but this is ok because
    we pack sub-word-sized arguments into a word only when generating C.

    We do the comparison of signed sub-word-sized fields (int8, int16 or int32)
    via foreign_proc goals generated inline as well. Doing them using unify
    goals would work as well, but would be less efficient in general. This is
    because having N such arguments in a function symbols requires storing
    only one value across calls for each term being compared (the term itself)
    when generating foreign_procs, but would require storing N values across
    calls (the values of the sub-word-sized signed arguments) when generating
    unifications. Generating inline foreign_procs is effectively a manual
    application of the optimization implemented by saved_vars.m.

library/private_builtin.m:
    Add the builtin predicates that unify_proc.m now generates calls to.

    We should never need their bodies, but the compiler does need to know
    the declarations of all predicates mentioned in inline foreign_procs.

configure.ac:
runtime/mercury_conf.h.in:
    Define either MR_MERCURY_IS_32_BITS or MR_MERCURY_IS_64_BITS depending
    on the word size. Make the configured value of MR_BITS_PER_WORD available
    to C code.

mdbcomp/program_representation.m:
    Register the new builtin predicates as no_typeinfo_builtins, i.e.
    builtins whose arguments' types contain type variables, that nevertheless
    should *not* be passed the typeinfos of the actual types bound to those
    type variables.

compiler/hlds_clauses.m:
    Bulk unification of arguments works only when all the arguments involved
    are initially ground. The optimized unification clauses we can now generate
    are thus appropriate only for <in,in> unifications. (Technically, they
    *would* work for unifications for which the function symbol arguments
    involved in bulk unify operations are ground even if some other arguments
    are initially free, but that distinction is too hard to make, compared
    to the extremely small performance gain that would be available
    if we *could* make that distinction.)

    Provide a way for unify_proc.m to mark a clause as being for use either
    in the <in,in> modes of unifications (for the optimized version using bulk
    unifications), or as in all other modes of unifications (for a version in
    which that optimization has been disabled).

    Replace two boolean fields in clauses_infos with bespoke types, for
    greater readability and reliability. These are a remnant of a different
    way to differentiate <in,in> vs non-<in,in> clauses that I ultimately
    decided against. These bespoke types are independent of the main change
    in this diff, but there is no reason to undo their use.

compiler/clause_to_proc.m:
    When copying clauses to procedure bodies inside type-specific unify
    predicates, pay attention to the markers that unify_proc.m put on
    those clauses about which are for <in,in> modes and which are for
    non-<in,in> modes.

    To make this possible, make our callers pass us extra information.

compiler/options.m:
    Add a bootstrapping option that governs whether unify_proc.m should
    try to apply the new optimization.

    Give an option that governs comparisons of function symbols for Erlang
    a name that reflects that fact.

compiler/hlds_pred.m:
    Fix a misleading predicate name.

compiler/add_class.m:
compiler/add_clause.m:
compiler/add_foreign_proc.m:
compiler/add_pragma_type_spec.m:
compiler/add_pred.m:
compiler/dead_proc_elim.m:
compiler/det_report.m:
compiler/erl_code_gen.m:
compiler/handle_options.m:
compiler/higher_order.m:
compiler/hlds_out_module.m:
compiler/hlds_out_pred.m:
compiler/hlds_statistics.m:
compiler/intermod.m:
compiler/mercury_compile_front_end.m:
compiler/ml_proc_gen.m:
compiler/modecheck_unify.m:
compiler/proc_gen.m:
compiler/proc_requests.m:
compiler/purity.m:
compiler/resolve_unify_functor.m:
compiler/structure_reuse.indirect.m:
compiler/structure_sharing.analysis.m:
compiler/tabling_analysis.m:
compiler/type_constraints.m:
compiler/typecheck.m:
compiler/unused_args.m:
    Conform to the changes above.
2018-10-03 08:32:29 +10:00

2142 lines
78 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% 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 <sys/stat.h>
#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),
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),
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,
read_goal(VarNumRep, ByteCode, StringTable, Info, SubGoal, !Pos),
GoalExpr = negation_rep(SubGoal)
;
GoalType = goal_ite,
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")
),
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").
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink