mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-28 15:54:18 +00:00
Code Issues Projects Releases Wiki Activity
Files
55cf491e34eef8a0499330c3520e8e372fc8774e
mercury/mdbcomp/program_representation.m
Paul Bone 58e305e4c0 Implement the source-to-source part of the loop control transformation. The 
remaining part is the code generation for code that is to be spawned off.  It
must be handled in the code generator since it uses the parent stack pointer in
many cases.

I'm committing this now so that Zoltan can begin to review it while I work on
the code generator component.

compiler/par_loop_control.m:
    This new file contains the source-to-source part of the parallel loop
    control transformation..

compiler/transform_hlds.m.
    Include the par_loop_control module within the transform_hlds module.

compiler/mercury_compile_middle_passes.m:
    Call the loop control transformation at stage 206 - after the dependant
    parallel conjunction transformation.

    Move the last call optimisation pass from stage 175 to 206 since it will
    most-likely prevent loop control from working.  Where both transformations
    are applicable, the loop control transformation is preferred.

compiler/options.m:
    Add new options for loop control.

compiler/handle_options.m:
    Disable loop control if we're not in a grade that supports parallel
    conjunctions.

    Other tests that should have been testing for parallel conjunction support
    but only tested parallel support have been fixed.

compiler/hlds_goal.m:
    Add the feature_do_not_tailcall feature.

compiler/call_gen.m:
    Mark LLCS call goals that may not have last call optimisation applied to
    them if they have the feature_do_not_tailcall feature set in their HLDS
    info.

compiler/goal_util.m:
    Create a new predicate expand_plain_conj, this returns a list of the sub
    goals of a plain conjunction, or returns the goal in a singleton list.
    XXX: Could someone review the name of this predicate.

compiler/hlds_pred.m:
    Add a symbol for the new transformation in the pred_transformation type.

    Corrected a comment to match the arguments in the predicate it refers to.

compiler/prog_util.m:
    Add support to make_pred_name for creating names for loop control
    predicates.

compiler/dep_par_conj.m:
    Fix grammer in a comment.

compiler/saved_vars.m:
    Conform to the change in hlds_goal.m

compiler/layout_out.m:
    Conform to the change in hlds_pred.m

runtime/mercury_par_builtin.[ch]:
    Add support for lc_wait_free_slot/2, the blocking version of
    lc_get_free_slot/2.  This means that other loop control builtins have
    changed, for instance, lc_join_and_terminate/2 must wake up a context
    blocked in lc_wait_free_slot/2 after making the slot it was using free.

    Use a spin lock in the loop control structure rather than a POSIX mutex.

runtime/mercury_wrapper.[ch]:
    Add support for a runtime variable, the number of contexts per loop control.
    This can be controlled with a MERCURY_OPTIONS option.

mdbcomp/program_representation.m:
    Include lc_wait_free_slot/2 in the list of external predicates.

mdbcomp/mdbcomp.goal_path.m:
    Add two new predicates goal_path_remove_first/3 and goal_path_get_first/2.

library/par_builtin.m:
    Add new builtins to support the loop control transformation:

        lc_wait_free_slot/2 will block the context until a new slot is
        available.

        lc_default_num_contexts/1 will return the number of contexts to use, by
        default, for a loop-controlled loop.

    Add myself as an author of this module.

doc/user_guide.texi:
    Document the runtime --num-contexts-per-lc-per-thread option.  It is
    currently commented out since it is not intended for users, at least for
    now.

    Document the loop control options for the compiler.

---

The change below was written by Zoltan, I reviewed when I applied his diff to
my workspace.

Allow the compiler to mark calls in the LLDS as calls that cannot have last
call optimization applied to them. Paul will soon need this capability
in order to implement parallel conjunctions in which earlier conjuncts
are spawned off, and later conjuncts contain recursive calls, but the
earlier conjuncts need the stack frame.

compiler/llds.m:
        Add a flag to det and semi calls. (Model_non calls have had a similar
        flag for a long time, for a totally different reason.)

compiler/call_gen.m:
        By default, say that det and semi calls may have LCO applied to them.

compiler/jumpopt.m:
        Apply LCO to det and semi calls only if this flag allows it.

compiler/opt_debug.m:
        Include the flag in debugging dumps.
2011-09-27 00:49:27 +00:00

1687 lines
61 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 maybe 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 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_procs :: proc_map(GoalAnnotation)
).
:- type module_rep == module_rep(unit).
% 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 filed 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 feild. In this case a 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 table.
pdr_var_table :: var_table,
% The determinism of the procedure, this may be different from
% procedure's goal's determinism.
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 arn't understood by the bytecode
% representation are grouped within this value.
:- 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_cnoice.
:- 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_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_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_table::in, var_rep::in, string::out) is semidet.
:- pred maybe_search_var_name(var_table::in, var_rep::in, maybe(string)::out)
is det.
% 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
% in 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.
:- 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.
% 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 int.
:- import_module map.
:- 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_cnoice).
detism_committed_choice(semidet_rep, not_committed_cnoice).
detism_committed_choice(multidet_rep, not_committed_cnoice).
detism_committed_choice(nondet_rep, not_committed_cnoice).
detism_committed_choice(cc_multidet_rep, committed_choice).
detism_committed_choice(cc_nondet_rep, committed_choice).
detism_committed_choice(erroneous_rep, not_committed_cnoice).
detism_committed_choice(failure_rep, not_committed_cnoice).
%-----------------------------------------------------------------------------%
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).
:- type var_table == map(var_rep, string).
lookup_var_name(VarTable, VarRep, String) :-
( search_var_name(VarTable, VarRep, StringPrime) ->
String = StringPrime
;
% Generate an automatic name for the variable.
String = string.format("V_%d", [i(VarRep)])
).
search_var_name(VarTable, VarRep, String) :-
map.search(VarTable, VarRep, String).
maybe_search_var_name(VarTable, VarRep, MaybeString) :-
( search_var_name(VarTable, 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 = procrep_id_string,
read_module_reps(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 procrep_id_string = string.
procrep_id_string = "Mercury deep profiler procrep version 5\n".
:- pred read_module_reps(bytecode::in,
module_map(unit)::in, module_map(unit)::out,
int::in, int::out) is semidet.
read_module_reps(ByteCode, !ModuleReps, !Pos) :-
read_byte(ByteCode, MoreByte, !Pos),
is_more_modules(MoreByte, MoreModules),
(
MoreModules = no_more_modules
;
MoreModules = next_module,
read_module_rep(ByteCode, ModuleRep, !Pos),
map.det_insert(ModuleRep ^ mr_name, ModuleRep, !ModuleReps),
read_module_reps(ByteCode, !ModuleReps, !Pos)
).
:- pred read_module_rep(bytecode::in, module_rep(unit)::out, int::in, int::out)
is semidet.
read_module_rep(ByteCode, ModuleRep, !Pos) :-
read_len_string(ByteCode, ModuleName, !Pos),
read_string_table(ByteCode, StringTable, !Pos),
read_proc_reps(ByteCode, StringTable, map.init, ProcReps, !Pos),
ModuleRep = module_rep(ModuleName, StringTable, ProcReps).
:- pred read_proc_reps(bytecode::in, string_table::in,
proc_map(unit)::in, proc_map(unit)::out, int::in, int::out)
is semidet.
read_proc_reps(ByteCode, StringTable, !ProcReps, !Pos) :-
read_byte(ByteCode, MoreByte, !Pos),
is_more_procs(MoreByte, MoreProcs),
(
MoreProcs = no_more_procs
;
MoreProcs = next_proc,
read_proc_rep(ByteCode, StringTable, ProcRep, !Pos),
map.det_insert(ProcRep ^ pr_id, ProcRep, !ProcReps),
read_proc_reps(ByteCode, StringTable, !ProcReps, !Pos)
).
:- pred read_proc_rep(bytecode::in, string_table::in, proc_rep(unit)::out,
int::in, int::out) is semidet.
read_proc_rep(ByteCode, StringTable, 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(ByteCode, StringTable, VarNumRep, VarTable, !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, VarTable, Detism),
require(unify(!.Pos, StartPos + Size),
"trace_read_proc_defn_rep: 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 names all the
% variables used in the procedure representation.
%
% The representation of variables and the variable table restricts the
% number of possible variables in a procedure to 2^16.
%
:- pred read_var_table(bytecode::in, string_table::in, var_num_rep::out,
map(var_rep, string)::out, int::in, int::out) is semidet.
read_var_table(ByteCode, StringTable, VarNumRep, VarTable, !Pos) :-
read_var_num_rep(ByteCode, VarNumRep, !Pos),
read_int32(ByteCode, NumVarsInTable, !Pos),
read_var_table_entries(NumVarsInTable, VarNumRep, ByteCode, StringTable,
map.init, VarTable, !Pos).
% Read entries from the symbol table until the number of entries left to
% read is zero.
%
:- pred read_var_table_entries(var_rep::in, var_num_rep::in, bytecode::in,
string_table::in, map(var_rep, string)::in, map(var_rep, string)::out,
int::in, int::out) is semidet.
read_var_table_entries(NumVarsInTable, VarNumRep, ByteCode, StringTable,
!VarTable, !Pos) :-
( NumVarsInTable > 0 ->
read_var(VarNumRep, ByteCode, VarRep, !Pos),
read_string_via_offset(ByteCode, StringTable, VarName, !Pos),
map.insert(VarRep, VarName, !VarTable),
read_var_table_entries(NumVarsInTable - 1, VarNumRep, ByteCode,
StringTable, !VarTable, !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_common_layout(ProcLayout, ModuleCommonLayout) ->
StringTable = module_common_string_table(ModuleCommonLayout)
;
error("trace_read_proc_defn_rep: no module common 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),
read_var_table(ByteCode, StringTable, VarNumRep, VarTable, !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, VarTable, Detism),
require(unify(!.Pos, Size),
"trace_read_proc_defn_rep: limit mismatch")
).
:- type read_proc_rep_info
---> read_proc_rep_info(
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
;
error("read_goal: 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)
;
error("read_goal: 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 ^ 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
;
error("read_maybe_var: 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(VarNumRep0, Byte) ->
VarNumRep = VarNumRep0
;
error("read_var_num_rep: unknown var_num_rep")
).
:- 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
;
error("read_goal: 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
;
error("read_goal: 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 modifing 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