mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-17 02:13:54 +00:00
Code Issues Projects Releases Wiki Activity
Files
3bb487e73400d4a11748dbebefaee4fabec00f7e
mercury/mdbcomp/program_representation.m
Zoltan Somogyi 62ec97d443 Report imports shadowed by other imports. 
If a module has two or more import_module or use_module declarations
for the same module, (typically, but not always, one being in its interface
and one in its implementation), generate an informational message about
each redundant declaration if --warn-unused-imports is enabled.

compiler/hlds_module.m:
    We used to record the set of imported/used modules, and the set of
    modules imported/used in the interface of the current module. However,
    these sets

    - did not record the distinction between imports and uses;
    - did not allow distinction between single and multiple imports/uses;
    - did not record the locations of the imports/uses.

    The first distinction was needed only by module_qual.m, which *did*
    pay attention to it; the other two were not needed at all.

    To generate messages for imports/uses shadowing other imports/uses,
    we need all three, so change the data structure storing such information
    for *direct* imports to one that records all three of the above kinds
    of information. (For imports made by read-in interface and optimization
    files, the old set of modules approach is fine, and this diff leaves
    the set of thus *indirectly* imported module names alone.)

compiler/unused_imports.m:
    Use the extra information now available to generate a
    severity_informational message about any import or use that is made
    redundant by an earlier, more general import or use.

    Fix two bugs in the code that generated warnings for just plain unused
    modules.

    (1) It did not consider that a use of the builtin type char justified
    an import of char.m, but without that import, the type is not visible.

    (2) It scanned cons_ids in goals in procedure bodies, but did not scan
    cons_ids that have been put into the const_struct_db. (I did not update
    the code here when I added the const_struct_db.)

    Also, add a (hopefully temporary) workaround for a bug in
    make_hlds_passes.m, which is noted below.

    However, there are at least three problems that prevent us from enabling
    --warn-unused-imports by default.

    (1) In some places, the import of a module is used only by clauses for
    a predicate that also has foreign procs. When compiled in a grade that
    selects one of those foreign_procs as the implementation of the predicate,
    the clauses are discarded *without* being added to the HLDS at all.
    This leads unused_imports.m to generate an uncalled-for warning in such
    cases. To fix this, we would need to preserve the Mercury clauses for
    *all* predicates, even those with foreign procs, and do all the semantic
    checks on them before throwing them away. (I tried to do this once, and
    failed, but the task should be easier after the item list change.)

    (2) We have two pieces of code to generate import warnings. The one in
    unused_imports.m operates on the HLDS after type and mode checking,
    while module_qual.m operates on the parse tree before the creation of
    the HLDS. The former is more powerful, since it knows e.g. what types and
    modes are used in the bodies of predicates, and hence can generate warnings
    about an import being unused *anywhere* in a module, as opposed to just
    unused in its interface.

    If --warn-unused-imports is enabled, we will get two separate set of
    reports about an interface import being unused in the interface,
    *unless* we get a type or mode error, in which case unused_imports.m
    won't be invoked. But in case we do get such errors, we don't want to
    throw away the warnings from module_qual.m. We could store them and
    throw them away only after we know we won't need them, or just get
    the two modules to generate identical error_specs for each warning,
    so that the sort_and_remove_dups of the error specs will do the
    throwing away for us for free, if we get that far.

    (3) The valid/bug100.m test case was added as a regression test for a bug
    that was fixed in module_qual.m. However the bug is still present in
    unused_imports.m.

compiler/make_hlds_passes.m:
    Give hlds_module.m the extra information it now needs for each item_avail.

    Add an XXX for a bug that cannot be fixed right now: the setting of
    the status of abstract instances to abstract_imported. (The "abstract"
    part is correct; the "imported" part may not be.)

compiler/intermod.m:
compiler/try_expand.m:
compiler/xml_documentation.m:
    Conform to the change in hlds_module.m.

compiler/module_qual.m:
    Update the documentation of the relationship of this module
    with unused_imports.m.

compiler/hlds_data.m:
    Document a problem with the status of instance definitions.

compiler/hlds_out_module.m:
    Update the code that prints out the module_info to conform to the change
    to hlds_module.m.

    Print status information about instances, which was needed to diagnose
    one of the bugs in unused_imports.m. Format the output for instances
    nicer.

compiler/prog_item.m:
    Add a convenience predicate.

compiler/prog_data.m:
    Remove a type synonym that makes things harder to understand, not easier.

compiler/modules.m:
    Delete an XXX that asks for the feature this diff implements.
    Add another XXX about how that feature could be improved.

compiler/Mercury.options.m:
    Add some more modules to the list of modules on which the compiler
    should be invoked with --no-warn-unused-imports.

compiler/*.m:
library/*.m:
mdbcomp/*.m:
browser/*.m:
deep_profiler/*.m:
mfilterjavac/*.m:
    Delete unneeded imports. Many of these shadow other imports, and some
    are just plain unneeded, as shown by --warn-unused-imports. In a few
    modules, there were a *lot* of unneeded imports, but most had just
    one or two.

    In a few cases, removing an import from a module, because it *itself*
    does not need it, required adding that same import to those of its
    submodules which *do* need it.

    In a few cases, conform to other changes above.

tests/invalid/Mercury.options:
    Test the generation of messages about import shadowing on the existing
    import_in_parent.m test case (although it was also tested very thoroughly
    when giving me the information needed for the deletion of all the
    unneeded imports above).

tests/*/*.{m,*exp}:
    Delete unneeded imports, and update any expected error messages
    to expect the now-smaller line numbers.
2015-08-25 00:38:49 +10:00

2056 lines
76 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2001-2011 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% 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.
% 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.
:- 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_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).
:- func project_case_rep_goal(case_rep(GoalAnnotation)) =
goal_rep(GoalAnnotation).
:- 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.
:- 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.
% 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.
% 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.
% 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.
:- pred maybe_search_var_name(var_name_table::in, var_rep::in,
maybe(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 or may not be there (currently, it isn't).
%
:- type var_type_table == map(var_rep, type_rep).
% 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)).
% If the given goal generates internal events directly then this
% function will return yes and no otherwise.
%
:- func goal_generates_internal_event(goal_rep(unit)) = bool.
% call_does_not_generate_events(ModuleName, PredName, Arity): succeeds 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.
% 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 a goal representation annotated with T into one annotated with
% U.
%
:- 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.
% 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.
%-----------------------------------------------------------------------------%
:- 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.
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),
( call_does_not_generate_events(ModuleName, PredName, NumArgs) ->
Generates = no
;
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, _, _)) =
goal_expr_generates_internal_event(GoalExpr).
:- func goal_expr_generates_internal_event(goal_expr_rep(unit)) = bool.
goal_expr_generates_internal_event(conj_rep(_)) = no.
goal_expr_generates_internal_event(disj_rep(_)) = yes.
goal_expr_generates_internal_event(switch_rep(_, _, _)) = yes.
goal_expr_generates_internal_event(ite_rep(_, _, _)) = yes.
goal_expr_generates_internal_event(negation_rep(_)) = yes.
goal_expr_generates_internal_event(scope_rep(_, _)) = no.
% Atomic goals may generate interface events, not internal events.
goal_expr_generates_internal_event(atomic_goal_rep(_, _, _, _)) = no.
atomic_goal_identifiable(unify_construct_rep(_, _, _)) = no.
atomic_goal_identifiable(unify_deconstruct_rep(_, _, _)) = no.
atomic_goal_identifiable(partial_construct_rep(_, _, _)) = no.
atomic_goal_identifiable(partial_deconstruct_rep(_, _, _)) = no.
atomic_goal_identifiable(unify_assign_rep(_, _)) = no.
atomic_goal_identifiable(unify_simple_test_rep(_, _)) = no.
atomic_goal_identifiable(cast_rep(_, _)) = no.
atomic_goal_identifiable(pragma_foreign_code_rep(_)) = no.
atomic_goal_identifiable(higher_order_call_rep(_, _)) = no.
atomic_goal_identifiable(method_call_rep(_, _, _)) = no.
atomic_goal_identifiable(builtin_call_rep(Module, Name, Args)) =
yes(atomic_goal_id(Module, Name, length(Args))).
atomic_goal_identifiable(plain_call_rep(Module, Name, Args)) =
yes(atomic_goal_id(Module, Name, length(Args))).
atomic_goal_identifiable(event_call_rep(_, _)) = no.
head_var_to_var(head_var_rep(Var, _)) = Var.
case_get_goal(case_rep(_, _, Goal), 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).
%-----------------------------------------------------------------------------%
transform_goal_rep(Pred, Goal0, Goal) :-
Goal0 = goal_rep(Expr0, Detism, A),
transform_goal_expr(Pred, Expr0, Expr),
Pred(A, B),
Goal = goal_rep(Expr, Detism, B).
:- 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),
map(transform_goal_rep(Pred), Conjs0, Conjs),
Expr = conj_rep(Conjs)
;
Expr0 = disj_rep(Disjs0),
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(ConsId, OtherConsIds, Goal0),
transform_goal_rep(Pred, Goal0, Goal),
Case = case_rep(ConsId, OtherConsIds, Goal).
%-----------------------------------------------------------------------------%
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).
%-----------------------------------------------------------------------------%
project_case_rep_goal(Case) = Case ^ cr_case_goal.
%-----------------------------------------------------------------------------%
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).
%-----------------------------------------------------------------------------%
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).
:- type var_name_table == map(var_rep, string).
lookup_var_name(VarNameTable, VarRep, String) :-
( search_var_name(VarNameTable, VarRep, StringPrime) ->
String = StringPrime
;
% Generate an automatic name for the variable.
String = string.format("V_%d", [i(VarRep)])
).
search_var_name(VarNameTable, VarRep, String) :-
map.search(VarNameTable, VarRep, String).
maybe_search_var_name(VarNameTable, VarRep, MaybeString) :-
( search_var_name(VarNameTable, VarRep, String) ->
MaybeString = yes(String)
;
MaybeString = no
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- 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),
( Size < 0 ->
io.make_err_msg(Error, "opening " ++ FileName ++ ": ", Msg, !IO),
Result = error(io.make_io_error(Msg))
;
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
").
%-----------------------------------------------------------------------------%
read_prog_rep_file(FileName, Result, !IO) :-
read_file_as_bytecode(FileName, ReadResult, !IO),
(
ReadResult = error(Error),
Result = error(Error)
;
ReadResult = ok(ByteCode),
(
some [!Pos] (
!:Pos = 0,
read_line(ByteCode, Line, !Pos),
( Line = old_procrep_id_string ->
ExpectNewFormat = no
; Line = new_procrep_id_string ->
ExpectNewFormat = yes
;
fail
),
read_module_reps(ExpectNewFormat, ByteCode,
map.init, ModuleReps, !Pos),
ByteCode = bytecode(_, Size),
!.Pos = Size
)
->
Result = ok(prog_rep(ModuleReps))
;
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_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),
( NumOISUTypes > 0 ->
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), $module, $pred,
"oisu limit mismatch")
;
OISUTypes = []
),
read_num(ByteCode, NumTableTypes, !Pos),
( NumTableTypes > 0 ->
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), $module, $pred,
"type limit mismatch")
;
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) :-
( CurTypeNum < NumTableTypes ->
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)
;
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_float_rep)
;
Selector = 7,
TypeRep = builtin_type_rep(builtin_type_string_rep)
;
Selector = 8,
TypeRep = builtin_type_rep(builtin_type_char_rep)
;
Selector = 9,
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 = 10,
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 = 11,
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 = 12,
read_num(ByteCode, VarNum, !Pos),
TypeRep = type_var_rep(VarNum)
).
%-----------------------------------------------------------------------------%
:- 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), $module, $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),
$module, $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) :-
( NumVarsLeftInTable > 0 ->
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)
;
% 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) :-
( NumVarsLeftInTable > 0 ->
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)
;
% No more variables to read.
true
).
%----------------------------------------------------------------------------%
:- 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),
( containing_module_layout(ProcLayout, ModuleLayout) ->
StringTable = module_string_table(ModuleLayout)
;
unexpected($module, $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), $module, $pred, "limit mismatch")
).
:- 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),
( byte_to_goal_type(GoalTypeByte, GoalType) ->
(
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),
( cut_byte(MaybeCutPrime, MaybeCutByte) ->
MaybeCut = MaybeCutPrime
;
unexpected($module, $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)
;
unexpected($module, $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),
( FileName0 = "" ->
FileName = Info ^ rpri_filename
;
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),
( YesOrNo = 1 ->
read_var(VarNumRep, ByteCode, Var, !Pos),
MaybeVar = yes(Var)
; YesOrNo = 0 ->
MaybeVar = no
;
unexpected($module, $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),
( var_num_rep_byte(VarNumRepPrime, Byte) ->
VarNumRep = VarNumRepPrime
;
unexpected($module, $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),
(
var_flag_byte(VarNumRepPrime,
IncludeVarNameTablePrime, IncludeVarTypesPrime, Byte)
->
VarNumRep = VarNumRepPrime,
IncludeVarNameTable = IncludeVarNameTablePrime,
IncludeVarTypes = IncludeVarTypesPrime
;
unexpected($module, $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),
( determinism_representation(DetismPrime, DetismByte) ->
Detism = DetismPrime
;
unexpected($module, $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),
(
(
CanFailByte = 0,
CanFailPrime = switch_can_fail_rep
;
CanFailByte = 1,
CanFailPrime = switch_can_not_fail_rep
)
->
CanFail = CanFailPrime
;
unexpected($module, $pred, "bad switch_can_fail")
).
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).
%-----------------------------------------------------------------------------%
% 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) :-
( N > 0 ->
Read(Item, !Pos),
read_n_items(Read, N - 1, TailItems, !Pos),
Items = [ Item | TailItems ]
;
Items = []
).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
no_type_info_builtin(ModuleName, PredName, Arity) :-
no_type_info_builtin_2(ModuleNameType, PredName, Arity),
(
ModuleNameType = builtin,
ModuleName = mercury_public_builtin_module
;
ModuleNameType = private_builtin,
ModuleName = mercury_private_builtin_module
;
ModuleNameType = table_builtin,
ModuleName = mercury_table_builtin_module
;
ModuleNameType = term_size_prof_builtin,
ModuleName = mercury_term_size_prof_builtin_module
;
ModuleNameType = par_builtin,
ModuleName = mercury_par_builtin_module
;
ModuleNameType = rtti_implementation_builtin,
ModuleName = mercury_rtti_implementation_builtin_module
).
:- type builtin_mod
---> builtin
; private_builtin
; table_builtin
; term_size_prof_builtin
; par_builtin
; rtti_implementation_builtin.
:- pred no_type_info_builtin_2(builtin_mod::out, string::in, int::in)
is semidet.
no_type_info_builtin_2(private_builtin, "store_at_ref", 2).
no_type_info_builtin_2(private_builtin, "store_at_ref_impure", 2).
no_type_info_builtin_2(private_builtin, "unsafe_type_cast", 2).
no_type_info_builtin_2(builtin, "unsafe_promise_unique", 2).
no_type_info_builtin_2(private_builtin,
"superclass_from_typeclass_info", 3).
no_type_info_builtin_2(private_builtin,
"instance_constraint_from_typeclass_info", 3).
no_type_info_builtin_2(private_builtin,
"type_info_from_typeclass_info", 3).
no_type_info_builtin_2(private_builtin,
"unconstrained_type_info_from_typeclass_info", 3).
no_type_info_builtin_2(private_builtin, "builtin_compound_eq", 2).
no_type_info_builtin_2(private_builtin, "builtin_compound_lt", 2).
no_type_info_builtin_2(table_builtin, "table_restore_any_answer", 3).
no_type_info_builtin_2(table_builtin, "table_lookup_insert_enum", 4).
no_type_info_builtin_2(table_builtin, "table_lookup_insert_typeinfo", 3).
no_type_info_builtin_2(table_builtin, "table_lookup_insert_typeclassinfo", 3).
no_type_info_builtin_2(term_size_prof_builtin, "increment_size", 2).
no_type_info_builtin_2(par_builtin, "new_future", 2).
no_type_info_builtin_2(par_builtin, "wait_future", 2).
no_type_info_builtin_2(par_builtin, "get_future", 2).
no_type_info_builtin_2(par_builtin, "signal_future", 2).
no_type_info_builtin_2(rtti_implementation_builtin, "semidet_call_3", 3).
no_type_info_builtin_2(rtti_implementation_builtin, "semidet_call_4", 4).
no_type_info_builtin_2(rtti_implementation_builtin, "semidet_call_5", 5).
no_type_info_builtin_2(rtti_implementation_builtin, "semidet_call_6", 6).
no_type_info_builtin_2(rtti_implementation_builtin, "semidet_call_7", 7).
no_type_info_builtin_2(rtti_implementation_builtin, "semidet_call_8", 8).
no_type_info_builtin_2(rtti_implementation_builtin, "result_call_4", 4).
no_type_info_builtin_2(rtti_implementation_builtin, "result_call_5", 5).
no_type_info_builtin_2(rtti_implementation_builtin, "result_call_6", 6).
no_type_info_builtin_2(rtti_implementation_builtin, "result_call_7", 7).
no_type_info_builtin_2(rtti_implementation_builtin, "result_call_8", 8).
no_type_info_builtin_2(rtti_implementation_builtin, "result_call_9", 9).
% True iff the given predicate is defined with an :- external 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).
%-----------------------------------------------------------------------------%
:- 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;
}
").
%-----------------------------------------------------------------------------%
%
% Please keep runtime/mercury_deep_profiling.h updated when modifying this
% section.
%
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").
:- 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"
]).
%-----------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink