mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-30 00:34:40 +00:00
This fix uses the approach discussed on m-dev 2020 nov 16/17 for fixing github issue #72, whose core problem is a need for information flow back to a the caller from a callee when the callee fills in the argument of a function symbol whose representation is a direct_arg tag. In most cases when the callee fills in the value of an argument, the caller can see it because the argument is in a word on the heap, but when the function symbol uses a direct_arg tag, that is not the case. compiler/direct_arg_in_out.m: A new module that implements the transformation proposed on m-dev. It creates a fresh clone variable every time an argument of a direct_arg tag function symbol is (or may be) updated. This can happen several times if a type has more than one function symbol with a direct_arg tag. Since the affected variable can be bound to only one function symbol at the start, its argument can be filled in only once, but the compiler cannot know in advance what function symbol the variable contains, and therefore which of the possibly several fill-in sites (which fill in the arguments of different function symbols) executed in sequence will actually update the variable. The transformation ensures that once a variable is cloned, it is never referred to again. It also ensures that in a branched control structure (if-then-else, disjunction or switch), all branches will use the *same* variable to represent the latest version of each cloned variable at the end, so that following code has a consistent view regardless of through which branch execution has reached it. There are three situations that the transformation cannot and does not handle. 1. Situations in which the mode of an argument is either an inst variable, or an abstract inst. In either case, the pass cannot know whether it should apply its transformation to the argument. 2. Situations where a procedure that has such an argument is exported to C code as a function. In that case, the C signature of the function we would generate would be different from what the user would normally expect. We could modify the documentation of the export pragma, but I don't think there much point due to lack of demand. (The problem cannot arise when targeting any language other than C, because we use direct_arg tags only with the low level data representation, which we only use for C.) 3. Situations where a procedure that has such an argument is defined by foreign_proc. Again, dealing with the problem would require nontrivial changes to the documented interface between code in foreign_procs and the surrounding Mercury code, and I see no demand for code that could benefit from that. In these cases, this module generates error messages. compiler/transform_hlds.m: Include the new module in the transform_hlds package. Delete unnecessary module qualification on some existing inclusions. Put some existing inclusions into a more meaningful order. compiler/notes/compiler_design.html: Document the new pass. Fix some nearby prose. compiler/lambda.m: compiler/simplify_proc.m: Use a predicate exported by direct_arg_in_out.m to test, for each procedure, whether the procedure has any argument positions that are subject to the problem that direct_arg_in_out.m addresses. simplify_proc.m does this for all procedures it processes; lambda.m does this for all the procedures it creates from lambda expressions. Give a predicate in simplify_proc.m a better name. Sort a list of predicate names. compiler/hlds_module.m: Add a field to the module_info that simplify_proc.m and lambda.m can use to tell direct_arg_in_out.m what work (if any) it needs to do. compiler/mercury_compile_middle_passes.m: Invoke direct_arg_in_out.m if the new field in the HLDS indicates that it has some work to do. (In the vast majority of compiler invocations, it won't have any.) compiler/hlds_pred.m: The new code in direct_arg_in_out.m creates a clone of each procedure affected by the problem, before deleting the originals (to make sure that no references to the unfixed versions of now-fixed procedures remain.) Make it possible to create exact clones of both predicates and procedures by adding two pairs of predicates, {pred,proc}_prepare_to_clone and {pred,proc}_create. Add the direct_arg_in_out transformation as a possible source of transformed predicates. library/private_builtin.m: Add a new builtin operation, partial_inst_copy, that the new module generates calls to. configure.ac: Require the installed compiler to recognize partial_inst_copy as a no_type_info builtin. compiler/builtin_ops.m: Recognize the new builtin. (This was committed before the rest; the diff to private_builtin.m can be done only once the change to builtin_ops.m is part of the installed compiler.) compiler/options.m: Add a way to test whether the builtin_ops.m in the installed compiler recognizes the new builtin. compiler/dead_proc_elim.m: Do not delete the new primitive before direct_arg_in_out.m has had a chance to generate calls to it. Add an XXX. compiler/error_util.m: Recognize the new module as a source of error messages. compiler/pred_table.m: Add a pair of utility predicates to be used when looking up builtin predicates, for which the compiler writer knows that there should be exactly one match. These are used in direct_arg_in_out.m. compiler/simplify_goal_call.m: Replace some existing code with calls to the new predicates in pred_table.m. compiler/hlds_goal.m: Add modes to rename_vars_in_goal_expr that express the fact that when an atomic goal_expr has some variables renamed inside it, it does not suddenly become some *other* kind of goal_expr. New code in direct_arg_in_out.m relies on this. compiler/hlds_out_goal.m: When the HLDS we are dumping out is malformed because it contains calls to predicates that have been deleted, the compiler used to abort at such calls. (I ran into this while debugging direct_arg_in_out.m.) Fix this. When such calls are encountered, we now print out as much information we can about the call, and prefix the call with an unmistakable prefix to draw attention to the problem. compiler/inst_util.m: Fix a bug that prevented direct_arg_in_out.m from even being invoked on some test code for it. The bug was in code that we use to unify a headvar's initial inst with its final inst. When the initial inst was a non-ground bound_inst such as the ones used in tests/hard_coded/gh72.m, and the final inst was simply "ground", this code quite properly returned a bound_inst (which, unlike ground, can show the exact set of function symbols that the headvar could be bound to). The problem was that it reused the original bound_inst's test results, including the one that said the final inst is NOT ground, which of course is wrong for any inst unified with ground. Fix two instances of this bug. compiler/modes.m: Make some of the code I had to traverse to find the bug in inst_util.m easier to read and understand. Replace some uses of booleans with bespoke enum types. Change the argument lists of some predicates to put related arguments next to each other. Give some variables more descriptive names. compiler/layout_out.m: Conform to the change in hlds_pred.m. compiler/var_locn.m: Fix a code generation bug. When filling-in the value of the argument of a function symbol represented by a direct_arg tag, the code we generated for it worked only if the direct_arg tag used 0 as its ptag value. In the test cases we initially used for github issue 72, that was the case, but the new tests/hard_coded/gh72.m has direct_tag args that use other ptag values as well. Document the reason why the updated code works. compiler/term_constr_initial.m: Add the new primitive predicate added to private_builtin.m, partial_inst_copy, to a table of builtins that do not take type_infos, even though their signatures contain type variables. Fix a bunch of old bugs: most other such primitives were not listed either. mdbcomp/program_representation.m: Add partial_inst_copy to the master list of builtins that do not take type_infos even though their signatures contain type variables. (Done by an earlier commit.) Document the fact that any updates here require updates to term_constr_initial.m. library/multi_map.m: We have long had multi_map.add and multi_map.set as synonyms, but we only had multi_map.reverse_set. Add multi_map.reverse_add as a synonym for it. Define the "set" versions in terms of the "add" versions, instead of vice versa. NEWS: Document the new predicates in multi_map.m. tests/hard_coded/gh72a.m: Fix typo. tests/hard_coded/gh72.{m,exp}: A new, much more comprehensive test case than gh72a.m. This one tries to tickle github issue 72 in as many forms of code as I can think of. tests/invalid/gh72_errors.{m,err_exp}: A test case for testing the generation of error messages for two out of the three kinds of situations that direct_arg_in_out.m cannot handle. (Proposals for how to test the third category welcome.) tests/hard_coded/Mmakefile: tests/invalid/Mmakefile: Enable the two new test cases, as well as two old ones, gh72[ab].m, that previously we didn't pass. tests/invalid/Mercury.option: Do not compile gh72_error.m with --errorcheck-only, since its errors are reported by a pass that --errorcheck-only does not invoke.
2340 lines
71 KiB
Mathematica
2340 lines
71 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1994-2007, 2012 The University of Melbourne.
|
|
% Copyright (C) 2013-2018 The Mercury team.
|
|
% This file is distributed under the terms specified in COPYING.LIB.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% File: private_builtin.m.
|
|
% Main authors: fjh, zs.
|
|
% Stability: medium.
|
|
%
|
|
% This file is automatically imported, as if via `use_module', into every
|
|
% module. It is intended for builtins that are just implementation details,
|
|
% such as procedures that the compiler generates implicit calls to when
|
|
% implementing polymorphism, unification, compare/3, etc.
|
|
% Note that the builtins that are needed only for the implementation of
|
|
% some specific constructs and/or in some specific grades, such as
|
|
% tabling, deep profiling and parallelism are in other modules named
|
|
% xxx_builtin.m in this directory.
|
|
%
|
|
% This module is a private part of the Mercury implementation; user modules
|
|
% should never explicitly import this module. The interface for this module
|
|
% does not get included in the Mercury library reference manual.
|
|
%
|
|
% Many of the predicates defined in this module are builtin: they do not
|
|
% have definitions, because the compiler generates code for them inline.
|
|
% Some others are implemented in the runtime. A third group are implemented
|
|
% normally in this module.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module private_builtin.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% This section of the module contains predicates that are used by the
|
|
% compiler to implement polymorphism. Changes here may also require changes
|
|
% in compiler/polymorphism.m, compiler/unify_proc.m, compiler/higher_order.m
|
|
% and runtime/mercury_type_info.{c,h}.
|
|
%
|
|
% These predicates should not be used by user programs directly.
|
|
%
|
|
|
|
:- interface.
|
|
|
|
:- pred builtin_unify_int(int::in, int::in) is semidet.
|
|
:- pred builtin_compare_int(comparison_result::uo, int::in, int::in) is det.
|
|
|
|
:- pred builtin_unify_uint(uint::in, uint::in) is semidet.
|
|
:- pred builtin_compare_uint(comparison_result::uo, uint::in, uint::in) is det.
|
|
|
|
:- pred builtin_unify_int8(int8::in, int8::in) is semidet.
|
|
:- pred builtin_compare_int8(comparison_result::uo, int8::in, int8::in) is det.
|
|
|
|
:- pred builtin_unify_uint8(uint8::in, uint8::in) is semidet.
|
|
:- pred builtin_compare_uint8(comparison_result::uo, uint8::in, uint8::in)
|
|
is det.
|
|
|
|
:- pred builtin_unify_int16(int16::in, int16::in) is semidet.
|
|
:- pred builtin_compare_int16(comparison_result::uo, int16::in, int16::in)
|
|
is det.
|
|
|
|
:- pred builtin_unify_uint16(uint16::in, uint16::in) is semidet.
|
|
:- pred builtin_compare_uint16(comparison_result::uo, uint16::in, uint16::in)
|
|
is det.
|
|
|
|
:- pred builtin_unify_int32(int32::in, int32::in) is semidet.
|
|
:- pred builtin_compare_int32(comparison_result::uo, int32::in, int32::in)
|
|
is det.
|
|
|
|
:- pred builtin_unify_uint32(uint32::in, uint32::in) is semidet.
|
|
:- pred builtin_compare_uint32(comparison_result::uo, uint32::in, uint32::in)
|
|
is det.
|
|
|
|
:- pred builtin_unify_int64(int64::in, int64::in) is semidet.
|
|
:- pred builtin_compare_int64(comparison_result::uo, int64::in, int64::in)
|
|
is det.
|
|
|
|
:- pred builtin_unify_uint64(uint64::in, uint64::in) is semidet.
|
|
:- pred builtin_compare_uint64(comparison_result::uo, uint64::in, uint64::in)
|
|
is det.
|
|
|
|
:- pred builtin_unify_character(character::in, character::in) is semidet.
|
|
:- pred builtin_compare_character(comparison_result::uo, character::in,
|
|
character::in) is det.
|
|
|
|
:- pred builtin_unify_string(string::in, string::in) is semidet.
|
|
:- pred builtin_compare_string(comparison_result::uo, string::in, string::in)
|
|
is det.
|
|
|
|
:- pred builtin_unify_float(float::in, float::in) is semidet.
|
|
:- pred builtin_compare_float(comparison_result::uo, float::in, float::in)
|
|
is det.
|
|
|
|
:- pred builtin_unify_pred((pred)::in, (pred)::in) is semidet.
|
|
:- pred builtin_compare_pred(comparison_result::uo, (pred)::in, (pred)::in)
|
|
is det.
|
|
|
|
% These should never be called -- the compiler never specializes
|
|
% comparison on these types because the generic compare is just as good
|
|
% as anything we could put here.
|
|
%
|
|
:- pred builtin_unify_tuple(T::in, T::in) is semidet.
|
|
:- pred builtin_compare_tuple(comparison_result::uo, T::in, T::in) is det.
|
|
|
|
% The following pred is used for compare/3 on non-canonical types
|
|
% (types for which there is a `where equality is ...' declaration).
|
|
%
|
|
:- pred builtin_compare_non_canonical_type(comparison_result::uo,
|
|
T::in, T::in) is det.
|
|
|
|
% The following predicates are used for unify/2 (compare/3) on
|
|
% solver types when the equality (comparison) attribute is omitted
|
|
% from the solver type definition.
|
|
%
|
|
:- pred builtin_unify_solver_type(T::in, T::in) is semidet.
|
|
:- pred builtin_compare_solver_type(comparison_result::uo,
|
|
T::in, T::in) is det.
|
|
|
|
% Compare_error is used in the code generated for compare/3 preds.
|
|
%
|
|
:- pred compare_error is erroneous.
|
|
|
|
% The builtin < and > operators on integers of all sizes and both
|
|
% signednesses, used in the code generated for compare/3 preds.
|
|
%
|
|
:- pred builtin_int_lt(int::in, int::in) is semidet.
|
|
:- pred builtin_int_gt(int::in, int::in) is semidet.
|
|
:- pred builtin_int8_lt(int8::in, int8::in) is semidet.
|
|
:- pred builtin_int8_gt(int8::in, int8::in) is semidet.
|
|
:- pred builtin_int16_lt(int16::in, int16::in) is semidet.
|
|
:- pred builtin_int16_gt(int16::in, int16::in) is semidet.
|
|
:- pred builtin_int32_lt(int32::in, int32::in) is semidet.
|
|
:- pred builtin_int32_gt(int32::in, int32::in) is semidet.
|
|
:- pred builtin_int64_lt(int64::in, int64::in) is semidet.
|
|
:- pred builtin_int64_gt(int64::in, int64::in) is semidet.
|
|
:- pred builtin_uint_lt(int::in, int::in) is semidet.
|
|
:- pred builtin_uint_gt(int::in, int::in) is semidet.
|
|
:- pred builtin_uint8_lt(uint8::in, uint8::in) is semidet.
|
|
:- pred builtin_uint8_gt(uint8::in, uint8::in) is semidet.
|
|
:- pred builtin_uint16_lt(uint16::in, uint16::in) is semidet.
|
|
:- pred builtin_uint16_gt(uint16::in, uint16::in) is semidet.
|
|
:- pred builtin_uint32_lt(uint32::in, uint32::in) is semidet.
|
|
:- pred builtin_uint32_gt(uint32::in, uint32::in) is semidet.
|
|
:- pred builtin_uint64_lt(uint64::in, uint64::in) is semidet.
|
|
:- pred builtin_uint64_gt(uint64::in, uint64::in) is semidet.
|
|
|
|
:- pred unsigned_lt(int::in, int::in) is semidet.
|
|
:- pred unsigned_le(int::in, int::in) is semidet.
|
|
|
|
% These should never be called -- the compiler replaces calls to these
|
|
% predicates with inline code. These predicates are declared not to take
|
|
% type_infos.
|
|
%
|
|
:- pred builtin_compound_eq(T::in, T::in) is semidet.
|
|
:- pred builtin_compound_lt(T::in, T::in) is semidet.
|
|
|
|
% A "typed" version of unify/2 -- i.e. one that can handle arguments
|
|
% of different types. It first unifies their types, and then (if the types
|
|
% are equal) it unifies the values.
|
|
%
|
|
:- pred typed_unify(T1, T2).
|
|
:- mode typed_unify(in, in) is semidet.
|
|
:- mode typed_unify(in, out) is semidet.
|
|
|
|
% A "typed" version of compare/3 -- i.e. one that can handle arguments
|
|
% of different types. It first compares the types, and then (if the
|
|
% types are equal) it compares the values.
|
|
%
|
|
:- pred typed_compare(comparison_result::uo, T1::in, T2::in) is det.
|
|
|
|
% True iff the two terms occupy the same address in memory.
|
|
% This is useful as a cheap but incomplete test of equality
|
|
% when implementing user-defined equality.
|
|
%
|
|
:- pred pointer_equal(T::in, T::in) is semidet.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module char.
|
|
:- import_module float.
|
|
:- import_module int.
|
|
:- import_module int8.
|
|
:- import_module int16.
|
|
:- import_module int32.
|
|
:- import_module int64.
|
|
:- import_module uint.
|
|
:- import_module uint8.
|
|
:- import_module uint16.
|
|
:- import_module uint32.
|
|
:- import_module uint64.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
:- import_module type_desc.
|
|
|
|
:- pragma inline(builtin_compare_int/3).
|
|
:- pragma inline(builtin_compare_uint/3).
|
|
:- pragma inline(builtin_compare_int8/3).
|
|
:- pragma inline(builtin_compare_uint8/3).
|
|
:- pragma inline(builtin_compare_int16/3).
|
|
:- pragma inline(builtin_compare_uint16/3).
|
|
:- pragma inline(builtin_compare_int32/3).
|
|
:- pragma inline(builtin_compare_uint32/3).
|
|
:- pragma inline(builtin_compare_int64/3).
|
|
:- pragma inline(builtin_compare_uint64/3).
|
|
:- pragma inline(builtin_compare_character/3).
|
|
:- pragma inline(builtin_compare_string/3).
|
|
:- pragma inline(builtin_compare_float/3).
|
|
|
|
builtin_unify_int(X, X).
|
|
|
|
builtin_compare_int(R, X, Y) :-
|
|
( if X < Y then
|
|
R = (<)
|
|
else if X = Y then
|
|
R = (=)
|
|
else
|
|
R = (>)
|
|
).
|
|
|
|
builtin_unify_uint(X, X).
|
|
|
|
builtin_compare_uint(R, X, Y) :-
|
|
( if X < Y then
|
|
R = (<)
|
|
else if X = Y then
|
|
R = (=)
|
|
else
|
|
R = (>)
|
|
).
|
|
|
|
builtin_unify_int8(X, X).
|
|
|
|
builtin_compare_int8(R, X, Y) :-
|
|
( if X < Y then
|
|
R = (<)
|
|
else if X = Y then
|
|
R = (=)
|
|
else
|
|
R = (>)
|
|
).
|
|
|
|
builtin_unify_uint8(X, X).
|
|
|
|
builtin_compare_uint8(R, X, Y) :-
|
|
( if X < Y then
|
|
R = (<)
|
|
else if X = Y then
|
|
R = (=)
|
|
else
|
|
R = (>)
|
|
).
|
|
|
|
builtin_unify_int16(X, X).
|
|
|
|
builtin_compare_int16(R, X, Y) :-
|
|
( if X < Y then
|
|
R = (<)
|
|
else if X = Y then
|
|
R = (=)
|
|
else
|
|
R = (>)
|
|
).
|
|
|
|
builtin_unify_uint16(X, X).
|
|
|
|
builtin_compare_uint16(R, X, Y) :-
|
|
( if X < Y then
|
|
R = (<)
|
|
else if X = Y then
|
|
R = (=)
|
|
else
|
|
R = (>)
|
|
).
|
|
|
|
builtin_unify_int32(X, X).
|
|
|
|
builtin_compare_int32(R, X, Y) :-
|
|
( if X < Y then
|
|
R = (<)
|
|
else if X = Y then
|
|
R = (=)
|
|
else
|
|
R = (>)
|
|
).
|
|
|
|
builtin_unify_uint32(X, X).
|
|
|
|
builtin_compare_uint32(R, X, Y) :-
|
|
( if X < Y then
|
|
R = (<)
|
|
else if X = Y then
|
|
R = (=)
|
|
else
|
|
R = (>)
|
|
).
|
|
|
|
builtin_unify_int64(X, X).
|
|
|
|
builtin_compare_int64(R, X, Y) :-
|
|
( if X < Y then
|
|
R = (<)
|
|
else if X = Y then
|
|
R = (=)
|
|
else
|
|
R = (>)
|
|
).
|
|
|
|
builtin_unify_uint64(X, X).
|
|
|
|
builtin_compare_uint64(R, X, Y) :-
|
|
( if X < Y then
|
|
R = (<)
|
|
else if X = Y then
|
|
R = (=)
|
|
else
|
|
R = (>)
|
|
).
|
|
|
|
builtin_unify_character(C, C).
|
|
|
|
builtin_compare_character(R, X, Y) :-
|
|
char.to_int(X, XI),
|
|
char.to_int(Y, YI),
|
|
( if XI < YI then
|
|
R = (<)
|
|
else if XI = YI then
|
|
R = (=)
|
|
else
|
|
R = (>)
|
|
).
|
|
|
|
builtin_unify_string(S, S).
|
|
|
|
builtin_compare_string(R, S1, S2) :-
|
|
builtin_strcmp(Res, S1, S2),
|
|
( if Res < 0 then
|
|
R = (<)
|
|
else if Res = 0 then
|
|
R = (=)
|
|
else
|
|
R = (>)
|
|
).
|
|
|
|
:- pred builtin_strcmp(int::out, string::in, string::in) is det.
|
|
|
|
:- pragma foreign_proc("C",
|
|
builtin_strcmp(Res::out, S1::in, S2::in),
|
|
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
|
|
does_not_affect_liveness],
|
|
"
|
|
Res = strcmp(S1, S2);
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
builtin_strcmp(Res::out, S1::in, S2::in),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
Res = System.String.CompareOrdinal(S1, S2);
|
|
").
|
|
:- pragma foreign_proc("Java",
|
|
builtin_strcmp(Res::out, S1::in, S2::in),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
Res = S1.compareTo(S2);
|
|
").
|
|
|
|
builtin_unify_float(F, F).
|
|
|
|
builtin_compare_float(R, F1, F2) :-
|
|
( if F1 < F2 then
|
|
R = (<)
|
|
else if F1 > F2 then
|
|
R = (>)
|
|
else
|
|
R = (=)
|
|
).
|
|
|
|
:- pragma no_inline(builtin_unify_pred/2).
|
|
builtin_unify_pred(_X, _Y) :-
|
|
( if semidet_succeed then
|
|
error("attempted higher-order unification")
|
|
else
|
|
% The following is never executed.
|
|
semidet_succeed
|
|
).
|
|
|
|
:- pragma no_inline(builtin_compare_pred/3).
|
|
builtin_compare_pred(Result, _X, _Y) :-
|
|
( if semidet_succeed then
|
|
error("attempted higher-order comparison")
|
|
else
|
|
% The following is never executed.
|
|
Result = (<)
|
|
).
|
|
|
|
builtin_unify_tuple(_, _) :-
|
|
( if semidet_succeed then
|
|
% The generic unification function in the runtime
|
|
% should handle this itself.
|
|
error("builtin_unify_tuple called")
|
|
else
|
|
% The following is never executed.
|
|
semidet_succeed
|
|
).
|
|
|
|
builtin_compare_tuple(Res, _, _) :-
|
|
( if semidet_succeed then
|
|
% The generic comparison function in the runtime
|
|
% should handle this itself.
|
|
error("builtin_compare_tuple called")
|
|
else
|
|
% The following is never executed.
|
|
Res = (<)
|
|
).
|
|
|
|
:- pragma no_inline(builtin_compare_non_canonical_type/3).
|
|
builtin_compare_non_canonical_type(Res, X, _Y) :-
|
|
% Suppress determinism warning.
|
|
( if semidet_succeed then
|
|
Message = "call to compare/3 for non-canonical type `"
|
|
++ type_name(type_of(X)) ++ "'",
|
|
error(Message)
|
|
else
|
|
% The following is never executed.
|
|
Res = (<)
|
|
).
|
|
|
|
:- pragma no_inline(builtin_unify_solver_type/2).
|
|
builtin_unify_solver_type(_X, _Y) :-
|
|
% Suppress determinism warning.
|
|
( if semidet_succeed then
|
|
% XXX ideally we should use the commented out code but looking up
|
|
% the name of the solver type in RTTI currently gives us the name of
|
|
% the representation type - reporting the name of the latter is likely
|
|
% to be confusing since representation types will nearly always have
|
|
% equality defined on them.
|
|
%Message = "call to unify/2 for solver type `"
|
|
% ++ type_name(type_of(X)) ++ "'",
|
|
Message = "call to generated unify/2 for solver type",
|
|
error(Message)
|
|
else
|
|
% This is never executed.
|
|
semidet_fail
|
|
).
|
|
|
|
:- pragma no_inline(builtin_compare_solver_type/3).
|
|
builtin_compare_solver_type(Res, _X, _Y) :-
|
|
% Suppress determinism warning.
|
|
( if semidet_succeed then
|
|
% XXX see the comment above regarding RTTI.
|
|
%Message = "call to compare/3 for solver type `"
|
|
% ++ type_name(type_of(X)) ++ "'",
|
|
Message = "call to generated compare/3 for solver type",
|
|
error(Message)
|
|
else
|
|
% This is never executed.
|
|
Res = (<)
|
|
).
|
|
|
|
:- pragma no_inline(compare_error/0).
|
|
compare_error :-
|
|
error("internal error in compare/3").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
typed_unify(X, Y) :-
|
|
( if type_of(X) = type_of(Y) then
|
|
unsafe_type_cast(X, Y)
|
|
else
|
|
fail
|
|
).
|
|
|
|
typed_compare(R, X, Y) :-
|
|
compare(R0, type_of(X), type_of(Y)),
|
|
( if R0 = (=) then
|
|
unsafe_type_cast(X, Z),
|
|
compare(R, Z, Y)
|
|
else
|
|
R = R0
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% This section of the module handles the runtime representation of
|
|
% type information.
|
|
%
|
|
|
|
:- interface.
|
|
|
|
:- type type_info.
|
|
:- type type_ctor_info.
|
|
|
|
:- type typeclass_info.
|
|
:- type base_typeclass_info.
|
|
|
|
% The following types are used by compiler/ml_code_util.m as the types
|
|
% used for copying type_info/0 and typeclass_info/0 types.
|
|
% XXX Document me better
|
|
%
|
|
:- type sample_type_info
|
|
---> sample_type_info(type_info).
|
|
:- type sample_typeclass_info
|
|
---> sample_typeclass_info(typeclass_info).
|
|
|
|
% type_info_from_typeclass_info(TypeClassInfo, Index, TypeInfo):
|
|
%
|
|
% Extracts TypeInfo from TypeClassInfo, where TypeInfo is the Index'th
|
|
% type_info in the typeclass_info.
|
|
%
|
|
% Note: Index must be equal to the number of the desired type_info
|
|
% plus the number of superclasses for this class.
|
|
%
|
|
:- pred type_info_from_typeclass_info(typeclass_info::in, int::in,
|
|
type_info::out) is det.
|
|
|
|
% unconstrained_type_info_from_typeclass_info(TypeClassInfo,
|
|
% Index, TypeInfo):
|
|
%
|
|
% Extracts the TypeInfo for the Indexth unconstrained type variable
|
|
% from the instance represented by TypeClassInfo.
|
|
%
|
|
:- pred unconstrained_type_info_from_typeclass_info(typeclass_info::in,
|
|
int::in, type_info::out) is det.
|
|
|
|
% superclass_from_typeclass_info(TypeClassInfo, Index, SuperClass):
|
|
%
|
|
% Extracts SuperClass from TypeClassInfo where SuperClass is the
|
|
% Indexth superclass of the class.
|
|
%
|
|
:- pred superclass_from_typeclass_info(typeclass_info::in,
|
|
int::in, typeclass_info::out) is det.
|
|
|
|
% instance_constraint_from_typeclass_info(TypeClassInfo, Index,
|
|
% InstanceConstraintTypeClassInfo):
|
|
%
|
|
% Extracts the typeclass_info for the Indexth typeclass constraint
|
|
% of the instance described by TypeClassInfo.
|
|
%
|
|
% Note: Index must be equal to the number of the desired constraint
|
|
% plus the number of unconstrained type variables for this instance.
|
|
%
|
|
:- pred instance_constraint_from_typeclass_info(typeclass_info::in,
|
|
int::in, typeclass_info::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
% The definitions for type_ctor_info/0 and type_info/0.
|
|
|
|
:- pragma foreign_code("C#", "
|
|
|
|
public static runtime.TypeInfo_Struct
|
|
MR_typeclass_info_param_type_info(object[] tcinfo, int index)
|
|
{
|
|
object[] tmp;
|
|
int t1;
|
|
|
|
tmp = (object[]) tcinfo[0];
|
|
t1 = System.Convert.ToInt32(tmp[0]) + index;
|
|
return (runtime.TypeInfo_Struct) tcinfo[t1];
|
|
}
|
|
|
|
public static runtime.TypeInfo_Struct
|
|
MR_typeclass_info_instance_tvar_type_info(
|
|
object[] tcinfo, int index)
|
|
{
|
|
return (runtime.TypeInfo_Struct) tcinfo[index];
|
|
}
|
|
|
|
public static object[] MR_typeclass_info_superclass_info(
|
|
object[] tcinfo, int index)
|
|
{
|
|
object[] tmp;
|
|
int t1;
|
|
|
|
tmp = (object[]) tcinfo[0];
|
|
t1 = System.Convert.ToInt32(tmp[0]) + index;
|
|
return (object[]) tcinfo[t1];
|
|
}
|
|
|
|
public static object[] MR_typeclass_info_arg_typeclass_info(
|
|
object[] tcinfo, int index)
|
|
{
|
|
return (object[]) tcinfo[index];
|
|
}
|
|
|
|
").
|
|
|
|
:- pragma foreign_code("Java", "
|
|
|
|
public static jmercury.runtime.TypeInfo_Struct
|
|
MR_typeclass_info_param_type_info(/* typeclass_info */ Object[] tcinfo,
|
|
int index)
|
|
{
|
|
/* typeclass_info */ Object[] base_tcinfo;
|
|
int t1;
|
|
|
|
base_tcinfo = (Object[]) tcinfo[0];
|
|
t1 = ((Integer) base_tcinfo[0]).intValue() + index;
|
|
return (jmercury.runtime.TypeInfo_Struct) tcinfo[t1];
|
|
}
|
|
|
|
public static jmercury.runtime.TypeInfo_Struct
|
|
MR_typeclass_info_instance_tvar_type_info(
|
|
/* typeclass_info */ Object[] tcinfo, int index)
|
|
{
|
|
return (jmercury.runtime.TypeInfo_Struct) tcinfo[index];
|
|
}
|
|
|
|
public static /* typeclass_info */ Object[] MR_typeclass_info_superclass_info(
|
|
/* typeclass_info */ Object[] tcinfo, int index)
|
|
{
|
|
/* typeclass_info */ Object[] base_tcinfo;
|
|
int t1;
|
|
|
|
// The zeroth argument is num_extra_instance_args.
|
|
base_tcinfo = (Object[]) tcinfo[0];
|
|
t1 = ((Integer) base_tcinfo[0]).intValue() + index;
|
|
return (/* typeclass_info */ Object[]) tcinfo[t1];
|
|
}
|
|
|
|
public static /* typeclass_info */ Object[]
|
|
MR_typeclass_info_arg_typeclass_info(
|
|
/* typeclass_info */ Object[] tcinfo, int index)
|
|
{
|
|
return (/* typeclass_info */ Object[]) tcinfo[index];
|
|
}
|
|
|
|
").
|
|
|
|
:- pragma foreign_code("C#", "
|
|
|
|
public class Ref_1
|
|
{
|
|
// XXX stub only
|
|
}
|
|
|
|
public class Heap_pointer_0
|
|
{
|
|
// XXX stub only
|
|
}
|
|
|
|
public static bool
|
|
__Unify____ref_1_0(runtime.TypeInfo_Struct ti,
|
|
private_builtin.Ref_1 x, private_builtin.Ref_1 y)
|
|
{
|
|
runtime.Errors.SORRY(""unify for ref"");
|
|
return false;
|
|
}
|
|
|
|
public static builtin.Comparison_result_0
|
|
__Compare____ref_1_0(runtime.TypeInfo_Struct ti,
|
|
private_builtin.Ref_1 x, private_builtin.Ref_1 y)
|
|
{
|
|
runtime.Errors.SORRY(""compare for ref"");
|
|
return builtin.Comparison_result_0.f_equal;
|
|
}
|
|
|
|
public static bool
|
|
__Unify____heap_pointer_0_0(
|
|
private_builtin.Heap_pointer_0 x, private_builtin.Heap_pointer_0 y)
|
|
{
|
|
runtime.Errors.SORRY(""unify for heap_pointer"");
|
|
return false;
|
|
}
|
|
|
|
public static builtin.Comparison_result_0
|
|
__Compare____heap_pointer_0_0(
|
|
private_builtin.Heap_pointer_0 x, private_builtin.Heap_pointer_0 y)
|
|
{
|
|
runtime.Errors.SORRY(""unify for heap_pointer"");
|
|
return builtin.Comparison_result_0.f_equal;
|
|
}
|
|
|
|
public static bool
|
|
__Unify____type_info_0_0(
|
|
runtime.TypeInfo_Struct x,
|
|
runtime.TypeInfo_Struct y)
|
|
{
|
|
runtime.Errors.SORRY(""unify for type_info"");
|
|
return false;
|
|
}
|
|
|
|
public static bool
|
|
__Unify____type_info_1_0(
|
|
object[] type_info,
|
|
runtime.TypeInfo_Struct x,
|
|
runtime.TypeInfo_Struct y)
|
|
{
|
|
runtime.Errors.SORRY(""unify for type_info"");
|
|
return false;
|
|
}
|
|
|
|
public static bool
|
|
__Unify____typeclass_info_0_0(
|
|
object[] x, object[] y)
|
|
{
|
|
runtime.Errors.SORRY(""unify for typeclass_info"");
|
|
return false;
|
|
}
|
|
|
|
public static bool
|
|
__Unify____typeclass_info_1_0(
|
|
object[] type_info, object[] x, object[] y)
|
|
{
|
|
runtime.Errors.SORRY(""unify for typeclass_info"");
|
|
return false;
|
|
}
|
|
|
|
public static bool
|
|
__Unify____base_typeclass_info_0_0(
|
|
object[] x, object[] y)
|
|
{
|
|
runtime.Errors.SORRY(""unify for base_typeclass_info"");
|
|
return false;
|
|
}
|
|
|
|
public static bool
|
|
__Unify____base_typeclass_info_1_0(
|
|
object[] type_info, object[] x, object[] y)
|
|
{
|
|
runtime.Errors.SORRY(""unify for base_typeclass_info"");
|
|
return false;
|
|
}
|
|
|
|
public static bool
|
|
__Unify____type_ctor_info_0_0(
|
|
runtime.TypeCtorInfo_Struct x,
|
|
runtime.TypeCtorInfo_Struct y)
|
|
{
|
|
runtime.Errors.SORRY(""unify for type_ctor_info"");
|
|
return false;
|
|
}
|
|
|
|
public static bool
|
|
__Unify____type_ctor_info_1_0(
|
|
object[] type_info, object[] x, object[] y)
|
|
{
|
|
runtime.Errors.SORRY(""unify for type_ctor_info"");
|
|
return false;
|
|
}
|
|
|
|
public static builtin.Comparison_result_0
|
|
__Compare____type_ctor_info_0_0(
|
|
runtime.TypeCtorInfo_Struct x,
|
|
runtime.TypeCtorInfo_Struct y)
|
|
{
|
|
runtime.Errors.SORRY(""compare for type_ctor_info"");
|
|
return builtin.Comparison_result_0.f_equal;
|
|
}
|
|
|
|
public static builtin.Comparison_result_0
|
|
__Compare____type_ctor_info_1_0(
|
|
object[] type_info, object[] x, object[] y)
|
|
{
|
|
runtime.Errors.SORRY(""compare for type_ctor_info"");
|
|
return builtin.Comparison_result_0.f_equal;
|
|
}
|
|
|
|
public static builtin.Comparison_result_0
|
|
__Compare____type_info_0_0(
|
|
runtime.TypeInfo_Struct x,
|
|
runtime.TypeInfo_Struct y)
|
|
{
|
|
runtime.Errors.SORRY(""compare for type_info"");
|
|
return builtin.Comparison_result_0.f_equal;
|
|
}
|
|
|
|
public static builtin.Comparison_result_0
|
|
__Compare____type_info_1_0(
|
|
object[] type_info,
|
|
runtime.TypeInfo_Struct x,
|
|
runtime.TypeInfo_Struct y)
|
|
{
|
|
runtime.Errors.SORRY(""compare for type_info"");
|
|
return builtin.Comparison_result_0.f_equal;
|
|
}
|
|
|
|
public static builtin.Comparison_result_0
|
|
__Compare____typeclass_info_0_0(
|
|
object[] x, object[] y)
|
|
{
|
|
runtime.Errors.SORRY(""compare for typeclass_info"");
|
|
return builtin.Comparison_result_0.f_equal;
|
|
}
|
|
|
|
public static builtin.Comparison_result_0
|
|
__Compare____typeclass_info_1_0(
|
|
object[] type_info, object[] x, object[] y)
|
|
{
|
|
runtime.Errors.SORRY(""compare for typeclass_info"");
|
|
return builtin.Comparison_result_0.f_equal;
|
|
}
|
|
|
|
public static builtin.Comparison_result_0
|
|
__Compare____base_typeclass_info_0_0(
|
|
object[] x, object[] y)
|
|
{
|
|
runtime.Errors.SORRY(""compare for base_typeclass_info"");
|
|
return builtin.Comparison_result_0.f_equal;
|
|
}
|
|
|
|
public static builtin.Comparison_result_0
|
|
__Compare____base_typeclass_info_1_0(
|
|
object[] type_info, object[] x, object[] y)
|
|
{
|
|
runtime.Errors.SORRY(""compare for base_typeclass_info"");
|
|
return builtin.Comparison_result_0.f_equal;
|
|
}
|
|
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
type_info_from_typeclass_info(TypeClassInfo::in, Index::in,
|
|
TypeInfo::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
|
|
does_not_affect_liveness],
|
|
"
|
|
TypeInfo = MR_typeclass_info_param_type_info(TypeClassInfo, Index);
|
|
").
|
|
:- pragma foreign_proc("C#",
|
|
type_info_from_typeclass_info(TypeClassInfo::in, Index::in,
|
|
TypeInfo::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
TypeInfo = private_builtin.MR_typeclass_info_param_type_info(
|
|
TypeClassInfo, Index);
|
|
").
|
|
:- pragma foreign_proc("Java",
|
|
type_info_from_typeclass_info(TypeClassInfo::in, Index::in,
|
|
TypeInfo::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
TypeInfo = jmercury.private_builtin.
|
|
MR_typeclass_info_param_type_info(TypeClassInfo, Index);
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
unconstrained_type_info_from_typeclass_info(TypeClassInfo::in,
|
|
Index::in, TypeInfo::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
|
|
does_not_affect_liveness],
|
|
"
|
|
TypeInfo = MR_typeclass_info_instance_tvar_type_info(TypeClassInfo, Index);
|
|
").
|
|
:- pragma foreign_proc("C#",
|
|
unconstrained_type_info_from_typeclass_info(TypeClassInfo::in,
|
|
Index::in, TypeInfo::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
TypeInfo = private_builtin.MR_typeclass_info_instance_tvar_type_info(
|
|
TypeClassInfo, Index);
|
|
").
|
|
:- pragma foreign_proc("Java",
|
|
unconstrained_type_info_from_typeclass_info(TypeClassInfo::in,
|
|
Index::in, TypeInfo::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
TypeInfo = jmercury.private_builtin.
|
|
MR_typeclass_info_instance_tvar_type_info(TypeClassInfo, Index);
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
superclass_from_typeclass_info(TypeClassInfo0::in, Index::in,
|
|
TypeClassInfo::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
|
|
does_not_affect_liveness],
|
|
"
|
|
TypeClassInfo =
|
|
MR_typeclass_info_superclass_info(TypeClassInfo0, Index);
|
|
").
|
|
:- pragma foreign_proc("C#",
|
|
superclass_from_typeclass_info(TypeClassInfo0::in, Index::in,
|
|
TypeClassInfo::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
TypeClassInfo = private_builtin.MR_typeclass_info_superclass_info(
|
|
TypeClassInfo0, Index);
|
|
").
|
|
:- pragma foreign_proc("Java",
|
|
superclass_from_typeclass_info(TypeClassInfo0::in, Index::in,
|
|
TypeClassInfo::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
TypeClassInfo = jmercury.private_builtin.
|
|
MR_typeclass_info_superclass_info(TypeClassInfo0, Index);
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
instance_constraint_from_typeclass_info(TypeClassInfo0::in,
|
|
Index::in, TypeClassInfo::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
|
|
does_not_affect_liveness],
|
|
"
|
|
TypeClassInfo =
|
|
MR_typeclass_info_arg_typeclass_info(TypeClassInfo0, Index);
|
|
").
|
|
:- pragma foreign_proc("C#",
|
|
instance_constraint_from_typeclass_info(TypeClassInfo0::in,
|
|
Index::in, TypeClassInfo::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
TypeClassInfo = private_builtin.MR_typeclass_info_arg_typeclass_info(
|
|
TypeClassInfo0, Index);
|
|
").
|
|
:- pragma foreign_proc("Java",
|
|
instance_constraint_from_typeclass_info(TypeClassInfo0::in,
|
|
Index::in, TypeClassInfo::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
TypeClassInfo = jmercury.private_builtin.
|
|
MR_typeclass_info_arg_typeclass_info(TypeClassInfo0, Index);
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% In LLDS grades with float registers, we require a type_ctor_info in
|
|
% closure layouts to represent hidden float values which are passed via
|
|
% regular registers. The standard type_ctor_info represents hidden float
|
|
% arguments passed via float registers.
|
|
%
|
|
|
|
:- interface.
|
|
|
|
:- type float_box
|
|
---> float_box(float).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% This section of the module contains predicates that are used by the
|
|
% MLDS back-end to implement trailing. (The LLDS back-end does not use these;
|
|
% instead it handles the corresponding tasks directly during code generation.)
|
|
%
|
|
% These predicates should not be used by user programs directly.
|
|
%
|
|
|
|
:- interface.
|
|
|
|
:- type ticket == c_pointer.
|
|
:- type ticket_counter == c_pointer.
|
|
|
|
% For documentation, see the corresponding LLDS instructions
|
|
% in compiler/llds.m. See also compiler/notes/trailing.html.
|
|
|
|
:- impure pred store_ticket(ticket::out) is det.
|
|
:- impure pred reset_ticket_undo(ticket::in) is det.
|
|
:- impure pred reset_ticket_commit(ticket::in) is det.
|
|
:- impure pred reset_ticket_solve(ticket::in) is det.
|
|
:- impure pred discard_ticket is det.
|
|
:- impure pred prune_ticket is det.
|
|
:- impure pred mark_ticket_stack(ticket_counter::out) is det.
|
|
:- impure pred prune_tickets_to(ticket_counter::in) is det.
|
|
|
|
:- implementation.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
store_ticket(Ticket::out),
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
#ifdef MR_USE_TRAIL
|
|
MR_store_ticket(Ticket);
|
|
#else
|
|
Ticket = 0;
|
|
#endif
|
|
").
|
|
:- pragma foreign_proc("C#",
|
|
store_ticket(Ticket::out),
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
#if MR_USE_TRAIL
|
|
runtime.Errors.SORRY(""foreign code for this function"");
|
|
// MR_store_ticket(Ticket);
|
|
#else
|
|
Ticket = null;
|
|
#endif
|
|
").
|
|
:- pragma foreign_proc("Java",
|
|
store_ticket(Ticket::out),
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
// XXX No trailing for the Java back-end, so take no action.
|
|
Ticket = null;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
reset_ticket_undo(Ticket::in),
|
|
[will_not_call_mercury, thread_safe, does_not_affect_liveness],
|
|
"
|
|
#ifdef MR_USE_TRAIL
|
|
MR_reset_ticket(Ticket, MR_undo);
|
|
#endif
|
|
").
|
|
:- pragma foreign_proc("C#",
|
|
reset_ticket_undo(Ticket::in),
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
#if MR_USE_TRAIL
|
|
runtime.Errors.SORRY(""foreign code for this function"");
|
|
// MR_reset_ticket(Ticket, MR_undo);
|
|
#endif
|
|
").
|
|
:- pragma foreign_proc("Java",
|
|
reset_ticket_undo(_Ticket::in),
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
// XXX No trailing for the Java back-end, so take no action.
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
reset_ticket_commit(Ticket::in),
|
|
[will_not_call_mercury, thread_safe, does_not_affect_liveness],
|
|
"
|
|
#ifdef MR_USE_TRAIL
|
|
MR_reset_ticket(Ticket, MR_commit);
|
|
#endif
|
|
").
|
|
:- pragma foreign_proc("C#",
|
|
reset_ticket_commit(Ticket::in),
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
#if MR_USE_TRAIL
|
|
runtime.Errors.SORRY(""foreign code for this function"");
|
|
// MR_reset_ticket(Ticket, MR_commit);
|
|
#endif
|
|
").
|
|
:- pragma foreign_proc("Java",
|
|
reset_ticket_commit(_Ticket::in),
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
// XXX No trailing for the Java back-end, so take no action.
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
reset_ticket_solve(Ticket::in),
|
|
[will_not_call_mercury, thread_safe, does_not_affect_liveness],
|
|
"
|
|
#ifdef MR_USE_TRAIL
|
|
MR_reset_ticket(Ticket, MR_solve);
|
|
#endif
|
|
").
|
|
:- pragma foreign_proc("C#",
|
|
reset_ticket_solve(Ticket::in),
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
#if MR_USE_TRAIL
|
|
runtime.Errors.SORRY(""foreign code for this function"");
|
|
// MR_reset_ticket(Ticket, MR_solve);
|
|
#endif
|
|
").
|
|
:- pragma foreign_proc("Java",
|
|
reset_ticket_solve(_Ticket::in),
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
// XXX No trailing for the Java back-end, so take no action.
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
discard_ticket,
|
|
[will_not_call_mercury, thread_safe, does_not_affect_liveness],
|
|
"
|
|
#ifdef MR_USE_TRAIL
|
|
MR_discard_ticket();
|
|
#endif
|
|
").
|
|
:- pragma foreign_proc("C#",
|
|
discard_ticket,
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
#if MR_USE_TRAIL
|
|
runtime.Errors.SORRY(""foreign code for this function"");
|
|
// MR_discard_ticket();
|
|
#endif
|
|
").
|
|
:- pragma foreign_proc("Java",
|
|
discard_ticket,
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
// XXX No trailing for the Java back-end, so take no action.
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
prune_ticket,
|
|
[will_not_call_mercury, thread_safe, does_not_affect_liveness],
|
|
"
|
|
#ifdef MR_USE_TRAIL
|
|
MR_prune_ticket();
|
|
#endif
|
|
").
|
|
:- pragma foreign_proc("C#",
|
|
prune_ticket,
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
#if MR_USE_TRAIL
|
|
runtime.Errors.SORRY(""foreign code for this function"");
|
|
// MR_prune_ticket();
|
|
#endif
|
|
").
|
|
:- pragma foreign_proc("Java",
|
|
prune_ticket,
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
// XXX No trailing for the Java back-end, so take no action.
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
mark_ticket_stack(TicketCounter::out),
|
|
[will_not_call_mercury, thread_safe, does_not_affect_liveness],
|
|
"
|
|
#ifdef MR_USE_TRAIL
|
|
MR_mark_ticket_stack(TicketCounter);
|
|
#else
|
|
TicketCounter = 0;
|
|
#endif
|
|
").
|
|
:- pragma foreign_proc("C#",
|
|
mark_ticket_stack(TicketCounter::out),
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
#if MR_USE_TRAIL
|
|
runtime.Errors.SORRY(""foreign code for this function"");
|
|
// MR_mark_ticket_stack(TicketCounter);
|
|
#else
|
|
TicketCounter = null;
|
|
#endif
|
|
").
|
|
:- pragma foreign_proc("Java",
|
|
mark_ticket_stack(TicketCounter::out),
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
// XXX No trailing for the Java back-end, so take no action.
|
|
TicketCounter = null;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
prune_tickets_to(TicketCounter::in),
|
|
[will_not_call_mercury, thread_safe, does_not_affect_liveness],
|
|
"
|
|
#ifdef MR_USE_TRAIL
|
|
MR_prune_tickets_to(TicketCounter);
|
|
#endif
|
|
").
|
|
:- pragma foreign_proc("C#",
|
|
prune_tickets_to(TicketCounter::in),
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
#if MR_USE_TRAIL
|
|
runtime.Errors.SORRY(""foreign code for this function"");
|
|
// MR_prune_tickets_to(TicketCounter);
|
|
#endif
|
|
").
|
|
:- pragma foreign_proc("Java",
|
|
prune_tickets_to(_TicketCounter::in),
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
// XXX No trailing for the Java back-end, so take no action.
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% This section of the module contains predicates and types that are used
|
|
% internally by the compiler for manipulating the heap.
|
|
%
|
|
% These predicates should not be used by user programs directly.
|
|
%
|
|
|
|
:- interface.
|
|
|
|
% free_heap/1 is used internally by the compiler to implement compile-time
|
|
% garbage collection. (Note that currently compile-time garbage collection
|
|
% is not yet fully implemented.)
|
|
%
|
|
% free_heap/1 explicitly deallocates a cell on the heap. It works by
|
|
% calling GC_free(), which will put the cell on the appropriate free list.
|
|
% It can only be used when doing conservative GC, since with `--gc none'
|
|
% or `--gc accurate', allocation does not use a free list. The `di' mode
|
|
% on the argument is overly conservative -- only the top-level cell is
|
|
% clobbered. This is handled correctly by recompute_instmap_delta in
|
|
% mode_util.
|
|
%
|
|
:- impure pred free_heap(T::di) is det.
|
|
|
|
:- type mutvar(T)
|
|
---> mutvar(c_pointer).
|
|
% A no_tag type, i.e. the representation is just a c_pointer.
|
|
|
|
% gc_trace/1 is used for accurate garbage collection in the MLDS->C
|
|
% backend. It takes as parameters a pointer to a variable (normally on
|
|
% the stack) and, implicitly, a type_info which describes the type of
|
|
% that variable. It traverses the heap object(s) pointed to by that
|
|
% variable, copying them to the new heap area, and updating the variable
|
|
% to point to the new copy. This is done by calling MR_agc_deep_copy()
|
|
% (from runtime/mercury_deep_copy*).
|
|
%
|
|
:- impure pred gc_trace(mutvar(T)::in) is det.
|
|
|
|
% mark_hp/1 and restore_hp/1 are used by the MLDS back-end, to implement
|
|
% heap reclamation on failure. (The LLDS back-end does not use these;
|
|
% instead it inserts the corresponding LLDS instructions directly during
|
|
% code generation.) For documentation, see the corresponding LLDS
|
|
% instructions in compiler/llds.m. See also compiler/notes/trailing.html.
|
|
|
|
:- type heap_pointer.
|
|
|
|
:- impure pred mark_hp(heap_pointer::out) is det.
|
|
:- impure pred restore_hp(heap_pointer::in) is det.
|
|
|
|
% The following is a built-in reference type. It is used to define the
|
|
% types store.generic_ref/2, store.generic_mutvar/2, solutions.mutvar/1,
|
|
% benchmarking.int_ref/0, etc.
|
|
:- type ref(T).
|
|
|
|
:- implementation.
|
|
|
|
% These routines are defined in C in ways which may make it not obvious
|
|
% to the Mercury compiler that they are worth inlining.
|
|
%
|
|
% (Note: it is probably not worth inlining gc_trace/1...)
|
|
|
|
:- pragma inline(free_heap/1).
|
|
:- pragma inline(mark_hp/1).
|
|
:- pragma inline(restore_hp/1).
|
|
|
|
:- pragma foreign_decl("C", "
|
|
#include ""mercury_heap.h"" // for MR_free_heap()
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
gc_trace(Pointer::in),
|
|
[will_not_call_mercury, thread_safe, will_not_modify_trail],
|
|
"
|
|
#ifdef MR_NATIVE_GC
|
|
* (MR_Word *) Pointer =
|
|
MR_agc_deep_copy(* (MR_Word *) Pointer, (MR_TypeInfo) TypeInfo_for_T,
|
|
MR_ENGINE(MR_eng_heap_zone2->MR_zone_min),
|
|
MR_ENGINE(MR_eng_heap_zone2->MR_zone_hardmax));
|
|
#else
|
|
MR_fatal_error(""private_builtin.gc_trace/2: ""
|
|
""called when accurate GC not enabled"");
|
|
#endif
|
|
").
|
|
:- pragma foreign_proc("Java",
|
|
gc_trace(_Pointer::in),
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
// For the Java back-end, we use the Java garbage collector,
|
|
// so we take no action here.
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
free_heap(Val::di),
|
|
[will_not_call_mercury, thread_safe, will_not_modify_trail],
|
|
"
|
|
MR_free_heap((void *) Val);
|
|
").
|
|
:- pragma foreign_proc("Java",
|
|
free_heap(_Val::di),
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
// For the Java back-end, we don't define our own heaps.
|
|
// So take no action here.
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
mark_hp(SavedHeapPointer::out),
|
|
[will_not_call_mercury, thread_safe, will_not_modify_trail,
|
|
does_not_affect_liveness],
|
|
"
|
|
#ifndef MR_CONSERVATIVE_GC
|
|
MR_mark_hp(SavedHeapPointer);
|
|
#else
|
|
// We can't do heap reclamation with conservative GC.
|
|
SavedHeapPointer = 0;
|
|
#endif
|
|
").
|
|
:- pragma foreign_proc("C#",
|
|
mark_hp(SavedHeapPointer::out),
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
// We can't do heap reclamation on failure in the .NET back-end.
|
|
SavedHeapPointer = null;
|
|
").
|
|
:- pragma foreign_proc("Java",
|
|
mark_hp(SavedHeapPointer::out),
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
// We can't do heap reclamation on failure in the Java back-end.
|
|
SavedHeapPointer = null;
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
restore_hp(SavedHeapPointer::in),
|
|
[will_not_call_mercury, thread_safe, will_not_modify_trail,
|
|
does_not_affect_liveness],
|
|
"
|
|
#ifndef MR_CONSERVATIVE_GC
|
|
MR_restore_hp(SavedHeapPointer);
|
|
#endif
|
|
").
|
|
:- pragma foreign_proc("C#",
|
|
restore_hp(_SavedHeapPointer::in),
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
// We can't do heap reclamation on failure in the .NET back-end.
|
|
").
|
|
:- pragma foreign_proc("Java",
|
|
restore_hp(_SavedHeapPointer::in),
|
|
[will_not_call_mercury, thread_safe],
|
|
"
|
|
// We can't do heap reclamation on failure in the Java back-end.
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Code to define the `heap_pointer' and `ref' types for the .NET back-end.
|
|
% (For the C back-ends, they're defined in runtime/mercury_builtin_types.[ch].)
|
|
|
|
:- pragma foreign_code("C#", "
|
|
|
|
public static bool
|
|
__Unify__private_builtin__heap_pointer_0_0(object[] x, object[] y)
|
|
{
|
|
runtime.Errors.fatal_error(
|
|
""called unify for type `private_builtin:heap_pointer'"");
|
|
return false;
|
|
}
|
|
|
|
public static void
|
|
__Compare__private_builtin__heap_pointer_0_0(
|
|
ref object[] result, object[] x, object[] y)
|
|
{
|
|
runtime.Errors.fatal_error(
|
|
""called compare/3 for type `private_builtin:heap_pointer'"");
|
|
}
|
|
|
|
public static bool
|
|
__Unify__private_builtin__ref_1_0(
|
|
object[] type_info, object[] x, object[] y)
|
|
{
|
|
return x == y;
|
|
}
|
|
|
|
public static void
|
|
__Compare__private_builtin__ref_1_0(
|
|
object[] type_info, ref object[] result, object[] x, object[] y)
|
|
{
|
|
runtime.Errors.fatal_error(
|
|
""called compare/3 for type `private_builtin.ref'"");
|
|
}
|
|
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% This section of the module is for miscellaneous predicates
|
|
% that sometimes have calls to them emitted by the compiler.
|
|
%
|
|
|
|
:- interface.
|
|
|
|
% unsafe_type_cast/2 is used internally by the compiler.
|
|
% Bad things will happen if this is used in programs.
|
|
% With the LLDS back-end, it has no definition,
|
|
% since for efficiency the code generator treats it as a builtin.
|
|
% With the MLDS back-end, it is defined in runtime/mercury.h.
|
|
%
|
|
:- pred unsafe_type_cast(T1::in, T2::out) is det.
|
|
|
|
% store_at_ref_impure/2 is used internally by the compiler.
|
|
% Bad things will happen if this is used in programs.
|
|
%
|
|
:- impure pred store_at_ref_impure(store_at_ref_type(T)::in, T::in) is det.
|
|
|
|
% This type should be used only by the program transformation that
|
|
% introduces calls to store_at_ref_impure. Any other use is will cause
|
|
% bad things to happen.
|
|
:- type store_at_ref_type(T)
|
|
---> store_at_ref_type(int).
|
|
|
|
% unused/0 should never be called.
|
|
% The compiler sometimes generates references to this procedure,
|
|
% but they should never get executed.
|
|
:- pred unused is det.
|
|
|
|
:- pred nyi_foreign_type_unify(T::in, T::in) is semidet.
|
|
:- pred nyi_foreign_type_compare(comparison_result::uo, T::in, T::in) is det.
|
|
|
|
:- semipure pred trace_evaluate_runtime_condition is semidet.
|
|
|
|
% unify_remote_arg_words(TermVarX, TermVarY, Ptag, CellOffsetVar):
|
|
%
|
|
% Succeed iff the argument words at the given offset are the same
|
|
% in TermVarX and TermVarY.
|
|
%
|
|
:- pred unify_remote_arg_words(T::in, T::in, int::in, int::in) is semidet.
|
|
|
|
% compare_remote_uint_words(TermVarX, TermVarY,
|
|
% Ptag, CellOffsetVar, ResultVar):
|
|
%
|
|
% Set ResultVar to the result of the unsigned comparison between
|
|
% two bitfields in the memory cells of TermVarX and TermVarY.
|
|
% The bitfields occupy the entirety of the words at offset
|
|
% CellOffsetVar.
|
|
%
|
|
:- pred compare_remote_uint_words(T::in, T::in, int::in, int::in,
|
|
comparison_result::uo) is det.
|
|
|
|
% compare_remote_uint_bitfields(TermVarX, TermVarY,
|
|
% Ptag, CellOffsetVar, ShiftVar, NumBitsVar, ResultVar):
|
|
%
|
|
% Set ResultVar to the result of the unsigned comparison between
|
|
% two bitfields in the memory cells of TermVarX and TermVarY.
|
|
% The bitfields are in the word at offset CellOffsetVar, with the
|
|
% LSBs of the bitfields being ShiftVar bits from the LSB of the word.
|
|
% Their size is NumBitsVar bits.
|
|
%
|
|
:- pred compare_remote_uint_bitfields(T::in, T::in, int::in, int::in,
|
|
int::in, int::in, comparison_result::uo) is det.
|
|
|
|
% compare_remote_int{8,16,32}_bitfields(TermVarX, TermVarY,
|
|
% Ptag, CellOffsetVar, ShiftVar, ResultVar):
|
|
%
|
|
% Set ResultVar to the result of the signed comparison between two
|
|
% {8,16,32} bit bitfields in the memory cells of TermVarX and TermVarY.
|
|
% The bitfields are in the word at offset CellOffsetVar, with the
|
|
% LSBs of the bitfields being ShiftVar bits from the LSB of the word.
|
|
%
|
|
:- pred compare_remote_int8_bitfields(T::in, T::in, int::in, int::in, int::in,
|
|
comparison_result::uo) is det.
|
|
:- pred compare_remote_int16_bitfields(T::in, T::in, int::in, int::in, int::in,
|
|
comparison_result::uo) is det.
|
|
:- pred compare_remote_int32_bitfields(T::in, T::in, int::in, int::in, int::in,
|
|
comparison_result::uo) is det.
|
|
|
|
% compare_local_uint_words(TermVarX, TermVarY, ResultVar):
|
|
%
|
|
% Set ResultVar to the result of the unsigned comparison between
|
|
% two bitfields in TermVarX and TermVarY.
|
|
% The bitfields occupy the entirety of the words containing
|
|
% the terms themselves.
|
|
%
|
|
:- pred compare_local_uint_words(T::in, T::in,
|
|
comparison_result::uo) is det.
|
|
|
|
% compare_local_uint_bitfields(TermVarX, TermVarY,
|
|
% ShiftVar, NumBitsVar, ResultVar):
|
|
%
|
|
% Set ResultVar to the result of the unsigned comparison between
|
|
% two bitfields in TermVarX and TermVarY.
|
|
% The bitfields are in the term words themselves, with the LSBs
|
|
% of the bitfields being ShiftVar bits from the LSB of the word.
|
|
% Their size is NumBitsVar bits.
|
|
%
|
|
:- pred compare_local_uint_bitfields(T::in, T::in, int::in, int::in,
|
|
comparison_result::uo) is det.
|
|
|
|
% compare_local_int{8,16,32}_bitfields(TermVarX, TermVarY,
|
|
% ShiftVar, ResultVar):
|
|
%
|
|
% Set ResultVar to the result of the signed comparison between two
|
|
% {8,16,32} bit bitfields in TermVarX and TermVarY.
|
|
% The bitfields are in the term words themselves, with the LSBs
|
|
% of the bitfields being ShiftVar bits from the LSB of the word.
|
|
%
|
|
:- pred compare_local_int8_bitfields(T::in, T::in, int::in,
|
|
comparison_result::uo) is det.
|
|
:- pred compare_local_int16_bitfields(T::in, T::in, int::in,
|
|
comparison_result::uo) is det.
|
|
:- pred compare_local_int32_bitfields(T::in, T::in, int::in,
|
|
comparison_result::uo) is det.
|
|
|
|
% This builtin is used by direct_arg_in_out.m.
|
|
%
|
|
% When we fill in the only argument of a partially-instantiated term
|
|
% whose top function symbol has a direct_arg_tag representation,
|
|
% that filling-in updates the non-ptag bits of a local variable.
|
|
% This local variable of course may (and often will) have a different
|
|
% value after the filling-in than it did before. When a predicate
|
|
% is supposed to return the filled-in value, we need to return it
|
|
% in a separate value, since the initial not-yet-filled-in value
|
|
% will have been passed using call-by-value. (This is github issue #72.)
|
|
%
|
|
% We use separate variables in a procedure body to represent the
|
|
% before-fill-in and after-fill-in versions of such variables
|
|
% when the filling-in is done by a call. When the filling-in is done
|
|
% by a unification, that unification's LHS variable will stand for
|
|
% both the pre-fill-in and post-fill-in versions of that value,
|
|
% at the start and end of its execution respectively. This is
|
|
% different from the call case.
|
|
%
|
|
% Arranging for all branches of a branched control structure to have
|
|
% a consistent view of the fill-in state of such an initially partially
|
|
% instantiated term is significantly easier when distinct variables
|
|
% represent distinct stages of filling-in, so we want to adopt that
|
|
% consistently. This is why, immediately after a unification does
|
|
% such a fill-in, we put a call to partial_inst_copy, with the
|
|
% just-filled-in variable as the first argument and a fresh new
|
|
% variable as the second. Operationally, this call assigns its first
|
|
% argument to its second, preserving its instantiation state, but its mode
|
|
% also says that the first argument should never be referenced again.
|
|
% If direct_arg_in_out.m's transformation of the procedure body ever
|
|
% violates this rule, the error will be detected when the instmap deltas
|
|
% are recomputed just after that transformation is completed.
|
|
%
|
|
:- pred partial_inst_copy(T, T).
|
|
:- mode partial_inst_copy(I >> clobbered, free >> I) is det.
|
|
|
|
:- implementation.
|
|
|
|
unused :-
|
|
( if semidet_succeed then
|
|
error("attempted use of dead predicate")
|
|
else
|
|
% the following is never executed
|
|
true
|
|
).
|
|
|
|
nyi_foreign_type_unify(_, _) :-
|
|
( if semidet_succeed then
|
|
sorry("unify for foreign types")
|
|
else
|
|
semidet_succeed
|
|
).
|
|
|
|
nyi_foreign_type_compare(Result, _, _) :-
|
|
( if semidet_succeed then
|
|
sorry("compare for foreign types")
|
|
else
|
|
Result = (=)
|
|
).
|
|
|
|
:- pragma foreign_proc("C",
|
|
trace_evaluate_runtime_condition,
|
|
[will_not_call_mercury, thread_safe, promise_semipure,
|
|
does_not_affect_liveness],
|
|
"
|
|
/* All uses of this predicate should override the body. */
|
|
MR_fatal_error(""trace_evaluate_runtime_condition called"");
|
|
").
|
|
:- pragma foreign_proc("C#",
|
|
trace_evaluate_runtime_condition,
|
|
[will_not_call_mercury, thread_safe, promise_semipure,
|
|
does_not_affect_liveness],
|
|
"
|
|
// All uses of this predicate should override the body.
|
|
throw new System.Exception(
|
|
""trace_evaluate_runtime_condition called"");
|
|
").
|
|
:- pragma foreign_proc("Java",
|
|
trace_evaluate_runtime_condition,
|
|
[will_not_call_mercury, thread_safe, promise_semipure,
|
|
does_not_affect_liveness, may_not_duplicate],
|
|
"
|
|
if (true) {
|
|
/* All uses of this predicate should override the body. */
|
|
throw new java.lang.RuntimeException(
|
|
""trace_evaluate_runtime_condition called"");
|
|
}
|
|
").
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
unify_remote_arg_words(TermVarX::in, TermVarY::in,
|
|
Ptag::in, CellOffsetVar::in),
|
|
[will_not_call_mercury, thread_safe, promise_pure,
|
|
does_not_affect_liveness, may_not_duplicate],
|
|
"
|
|
// All uses of this predicate should override the body,
|
|
// but just in case they don't ...
|
|
MR_Unsigned *cell_x;
|
|
MR_Unsigned *cell_y;
|
|
cell_x = (MR_Unsigned *) (((MR_Unsigned) TermVarX) - (MR_Unsigned) Ptag);
|
|
cell_y = (MR_Unsigned *) (((MR_Unsigned) TermVarY) - (MR_Unsigned) Ptag);
|
|
MR_Unsigned word_x = cell_x[CellOffsetVar];
|
|
MR_Unsigned word_y = cell_y[CellOffsetVar];
|
|
SUCCESS_INDICATOR = (word_x == word_y);
|
|
").
|
|
|
|
unify_remote_arg_words(_, _, _, _) :-
|
|
semidet_fail.
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
compare_remote_uint_words(TermVarX::in, TermVarY::in,
|
|
Ptag::in, CellOffsetVar::in, ResultVar::uo),
|
|
[will_not_call_mercury, thread_safe, promise_pure,
|
|
does_not_affect_liveness, may_not_duplicate],
|
|
"
|
|
// All uses of this predicate should override the body,
|
|
// but just in case they don't ...
|
|
MR_Unsigned *cell_x;
|
|
MR_Unsigned *cell_y;
|
|
cell_x = (MR_Unsigned *) (((MR_Unsigned) TermVarX) - (MR_Unsigned) Ptag);
|
|
cell_y = (MR_Unsigned *) (((MR_Unsigned) TermVarY) - (MR_Unsigned) Ptag);
|
|
MR_Unsigned word_x = cell_x[CellOffsetVar];
|
|
MR_Unsigned word_y = cell_y[CellOffsetVar];
|
|
if (word_x < word_y) {
|
|
ResultVar = MR_COMPARE_LESS;
|
|
} else if (word_x > word_y) {
|
|
ResultVar = MR_COMPARE_GREATER;
|
|
} else {
|
|
ResultVar = MR_COMPARE_EQUAL;
|
|
}
|
|
").
|
|
|
|
compare_remote_uint_words(_, _, _, _, Result) :-
|
|
( if semidet_fail then
|
|
Result = (=)
|
|
else
|
|
error("compare_remote_int32_words called")
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
compare_remote_uint_bitfields(TermVarX::in, TermVarY::in,
|
|
Ptag::in, CellOffsetVar::in, ShiftVar::in, NumBitsVar::in,
|
|
ResultVar::uo),
|
|
[will_not_call_mercury, thread_safe, promise_pure,
|
|
does_not_affect_liveness, may_not_duplicate],
|
|
"
|
|
// All uses of this predicate should override the body,
|
|
// but just in case they don't ...
|
|
MR_Unsigned *cell_x;
|
|
MR_Unsigned *cell_y;
|
|
cell_x = (MR_Unsigned *) (((MR_Unsigned) TermVarX) - (MR_Unsigned) Ptag);
|
|
cell_y = (MR_Unsigned *) (((MR_Unsigned) TermVarY) - (MR_Unsigned) Ptag);
|
|
MR_Unsigned word_x = cell_x[CellOffsetVar];
|
|
MR_Unsigned word_y = cell_y[CellOffsetVar];
|
|
MR_Unsigned value_x = ((word_x >> ShiftVar) & ((1 << NumBitsVar) - 1));
|
|
MR_Unsigned value_y = ((word_y >> ShiftVar) & ((1 << NumBitsVar) - 1));
|
|
if (value_x < value_y) {
|
|
ResultVar = MR_COMPARE_LESS;
|
|
} else if (value_x > value_y) {
|
|
ResultVar = MR_COMPARE_GREATER;
|
|
} else {
|
|
ResultVar = MR_COMPARE_EQUAL;
|
|
}
|
|
").
|
|
|
|
compare_remote_uint_bitfields(_, _, _, _, _, _, Result) :-
|
|
( if semidet_fail then
|
|
Result = (=)
|
|
else
|
|
error("compare_remote_int32_bitfields called")
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
compare_remote_int8_bitfields(TermVarX::in, TermVarY::in,
|
|
Ptag::in, CellOffsetVar::in, ShiftVar::in, ResultVar::uo),
|
|
[will_not_call_mercury, thread_safe, promise_pure,
|
|
does_not_affect_liveness, may_not_duplicate],
|
|
"
|
|
// All uses of this predicate should override the body,
|
|
// but just in case they don't ...
|
|
MR_Unsigned *cell_x;
|
|
MR_Unsigned *cell_y;
|
|
cell_x = (MR_Unsigned *) (((MR_Unsigned) TermVarX) - (MR_Unsigned) Ptag);
|
|
cell_y = (MR_Unsigned *) (((MR_Unsigned) TermVarY) - (MR_Unsigned) Ptag);
|
|
MR_Unsigned word_x = cell_x[CellOffsetVar];
|
|
MR_Unsigned word_y = cell_y[CellOffsetVar];
|
|
int8_t value_x = (int8_t) ((word_x >> ShiftVar) & ((1 << 8) - 1));
|
|
int8_t value_y = (int8_t) ((word_y >> ShiftVar) & ((1 << 8) - 1));
|
|
if (value_x < value_y) {
|
|
ResultVar = MR_COMPARE_LESS;
|
|
} else if (value_x > value_y) {
|
|
ResultVar = MR_COMPARE_GREATER;
|
|
} else {
|
|
ResultVar = MR_COMPARE_EQUAL;
|
|
}
|
|
").
|
|
|
|
compare_remote_int8_bitfields(_, _, _, _, _, Result) :-
|
|
( if semidet_fail then
|
|
Result = (=)
|
|
else
|
|
error("compare_remote_int8_bitfields called")
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
compare_remote_int16_bitfields(TermVarX::in, TermVarY::in,
|
|
Ptag::in, CellOffsetVar::in, ShiftVar::in, ResultVar::uo),
|
|
[will_not_call_mercury, thread_safe, promise_pure,
|
|
does_not_affect_liveness, may_not_duplicate],
|
|
"
|
|
// All uses of this predicate should override the body,
|
|
// but just in case they don't ...
|
|
MR_Unsigned *cell_x;
|
|
MR_Unsigned *cell_y;
|
|
cell_x = (MR_Unsigned *) (((MR_Unsigned) TermVarX) - (MR_Unsigned) Ptag);
|
|
cell_y = (MR_Unsigned *) (((MR_Unsigned) TermVarY) - (MR_Unsigned) Ptag);
|
|
MR_Unsigned word_x = cell_x[CellOffsetVar];
|
|
MR_Unsigned word_y = cell_y[CellOffsetVar];
|
|
int16_t value_x = (int16_t) ((word_x >> ShiftVar) & ((1 << 16) - 1));
|
|
int16_t value_y = (int16_t) ((word_y >> ShiftVar) & ((1 << 16) - 1));
|
|
if (value_x < value_y) {
|
|
ResultVar = MR_COMPARE_LESS;
|
|
} else if (value_x > value_y) {
|
|
ResultVar = MR_COMPARE_GREATER;
|
|
} else {
|
|
ResultVar = MR_COMPARE_EQUAL;
|
|
}
|
|
").
|
|
|
|
compare_remote_int16_bitfields(_, _, _, _, _, Result) :-
|
|
( if semidet_fail then
|
|
Result = (=)
|
|
else
|
|
error("compare_remote_int16_bitfields called")
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
compare_remote_int32_bitfields(TermVarX::in, TermVarY::in,
|
|
Ptag::in, CellOffsetVar::in, ShiftVar::in, ResultVar::uo),
|
|
[will_not_call_mercury, thread_safe, promise_pure,
|
|
does_not_affect_liveness, may_not_duplicate],
|
|
"
|
|
#ifdef MR_MERCURY_IS_64_BITS
|
|
// All uses of this predicate should override the body,
|
|
// but just in case they don't ...
|
|
MR_Unsigned *cell_x;
|
|
MR_Unsigned *cell_y;
|
|
cell_x = (MR_Unsigned *) (((MR_Unsigned) TermVarX) - (MR_Unsigned) Ptag);
|
|
cell_y = (MR_Unsigned *) (((MR_Unsigned) TermVarY) - (MR_Unsigned) Ptag);
|
|
MR_Unsigned word_x = cell_x[CellOffsetVar];
|
|
MR_Unsigned word_y = cell_y[CellOffsetVar];
|
|
int32_t value_x =
|
|
(int32_t) ((word_x >> ShiftVar) & ((INT64_C(1) << 32) - 1));
|
|
int32_t value_y =
|
|
(int32_t) ((word_y >> ShiftVar) & ((INT64_C(1) << 32) - 1));
|
|
if (value_x < value_y) {
|
|
ResultVar = MR_COMPARE_LESS;
|
|
} else if (value_x > value_y) {
|
|
ResultVar = MR_COMPARE_GREATER;
|
|
} else {
|
|
ResultVar = MR_COMPARE_EQUAL;
|
|
}
|
|
#else
|
|
MR_fatal_error(""compare_remote_int32_bitfields called on ""
|
|
""non-64-bit system"");
|
|
#endif
|
|
").
|
|
|
|
compare_remote_int32_bitfields(_, _, _, _, _, Result) :-
|
|
( if semidet_fail then
|
|
Result = (=)
|
|
else
|
|
error("compare_remote_int32_bitfields called")
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
compare_local_uint_words(TermVarX::in, TermVarY::in,
|
|
ResultVar::uo),
|
|
[will_not_call_mercury, thread_safe, promise_pure,
|
|
does_not_affect_liveness, may_not_duplicate],
|
|
"
|
|
// All uses of this predicate should override the body,
|
|
// but just in case they don't ...
|
|
MR_Unsigned value_x = (MR_Unsigned) TermVarX;
|
|
MR_Unsigned value_y = (MR_Unsigned) TermVarY;
|
|
if (value_x < value_y) {
|
|
ResultVar = MR_COMPARE_LESS;
|
|
} else if (value_x > value_y) {
|
|
ResultVar = MR_COMPARE_GREATER;
|
|
} else {
|
|
ResultVar = MR_COMPARE_EQUAL;
|
|
}
|
|
").
|
|
|
|
compare_local_uint_words(_, _, Result) :-
|
|
( if semidet_fail then
|
|
Result = (=)
|
|
else
|
|
error("compare_local_uint_words called")
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
compare_local_uint_bitfields(TermVarX::in, TermVarY::in,
|
|
ShiftVar::in, NumBitsVar::in, ResultVar::uo),
|
|
[will_not_call_mercury, thread_safe, promise_pure,
|
|
does_not_affect_liveness, may_not_duplicate],
|
|
"
|
|
// All uses of this predicate should override the body,
|
|
// but just in case they don't ...
|
|
MR_Unsigned word_x = (MR_Unsigned) TermVarX;
|
|
MR_Unsigned word_y = (MR_Unsigned) TermVarY;
|
|
MR_Unsigned value_x = ((word_x >> ShiftVar) & ((1 << NumBitsVar) - 1));
|
|
MR_Unsigned value_y = ((word_y >> ShiftVar) & ((1 << NumBitsVar) - 1));
|
|
if (value_x < value_y) {
|
|
ResultVar = MR_COMPARE_LESS;
|
|
} else if (value_x > value_y) {
|
|
ResultVar = MR_COMPARE_GREATER;
|
|
} else {
|
|
ResultVar = MR_COMPARE_EQUAL;
|
|
}
|
|
").
|
|
|
|
compare_local_uint_bitfields(_, _, _, _, Result) :-
|
|
( if semidet_fail then
|
|
Result = (=)
|
|
else
|
|
error("compare_local_uint_bitfields called")
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
compare_local_int8_bitfields(TermVarX::in, TermVarY::in,
|
|
ShiftVar::in, ResultVar::uo),
|
|
[will_not_call_mercury, thread_safe, promise_pure,
|
|
does_not_affect_liveness, may_not_duplicate],
|
|
"
|
|
// All uses of this predicate should override the body,
|
|
// but just in case they don't ...
|
|
MR_Unsigned word_x = (MR_Unsigned) TermVarX;
|
|
MR_Unsigned word_y = (MR_Unsigned) TermVarY;
|
|
int8_t value_x = (int8_t) ((word_x >> ShiftVar) & ((1 << 8) - 1));
|
|
int8_t value_y = (int8_t) ((word_y >> ShiftVar) & ((1 << 8) - 1));
|
|
if (value_x < value_y) {
|
|
ResultVar = MR_COMPARE_LESS;
|
|
} else if (value_x > value_y) {
|
|
ResultVar = MR_COMPARE_GREATER;
|
|
} else {
|
|
ResultVar = MR_COMPARE_EQUAL;
|
|
}
|
|
").
|
|
|
|
compare_local_int8_bitfields(_, _, _, Result) :-
|
|
( if semidet_fail then
|
|
Result = (=)
|
|
else
|
|
error("compare_local_int8_bitfields called")
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
compare_local_int16_bitfields(TermVarX::in, TermVarY::in,
|
|
ShiftVar::in, ResultVar::uo),
|
|
[will_not_call_mercury, thread_safe, promise_pure,
|
|
does_not_affect_liveness, may_not_duplicate],
|
|
"
|
|
// All uses of this predicate should override the body,
|
|
// but just in case they don't ...
|
|
MR_Unsigned word_x = (MR_Unsigned) TermVarX;
|
|
MR_Unsigned word_y = (MR_Unsigned) TermVarY;
|
|
int16_t value_x = (int16_t) ((word_x >> ShiftVar) & ((1 << 16) - 1));
|
|
int16_t value_y = (int16_t) ((word_y >> ShiftVar) & ((1 << 16) - 1));
|
|
if (value_x < value_y) {
|
|
ResultVar = MR_COMPARE_LESS;
|
|
} else if (value_x > value_y) {
|
|
ResultVar = MR_COMPARE_GREATER;
|
|
} else {
|
|
ResultVar = MR_COMPARE_EQUAL;
|
|
}
|
|
").
|
|
|
|
compare_local_int16_bitfields(_, _, _, Result) :-
|
|
( if semidet_fail then
|
|
Result = (=)
|
|
else
|
|
error("compare_local_int16_bitfields called")
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
compare_local_int32_bitfields(TermVarX::in, TermVarY::in,
|
|
ShiftVar::in, ResultVar::uo),
|
|
[will_not_call_mercury, thread_safe, promise_pure,
|
|
does_not_affect_liveness, may_not_duplicate],
|
|
"
|
|
#ifdef MR_MERCURY_IS_64_BITS
|
|
// All uses of this predicate should override the body,
|
|
// but just in case they don't ...
|
|
MR_Unsigned word_x = (MR_Unsigned) TermVarX;
|
|
MR_Unsigned word_y = (MR_Unsigned) TermVarY;
|
|
int32_t value_x =
|
|
(int32_t) ((word_x >> ShiftVar) & ((INT64_C(1) << 32) - 1));
|
|
int32_t value_y =
|
|
(int32_t) ((word_y >> ShiftVar) & ((INT64_C(1) << 32) - 1));
|
|
if (value_x < value_y) {
|
|
ResultVar = MR_COMPARE_LESS;
|
|
} else if (value_x > value_y) {
|
|
ResultVar = MR_COMPARE_GREATER;
|
|
} else {
|
|
ResultVar = MR_COMPARE_EQUAL;
|
|
}
|
|
#else
|
|
MR_fatal_error(""compare_local_int32_bitfields called on ""
|
|
""non-64-bit system"");
|
|
#endif
|
|
").
|
|
|
|
compare_local_int32_bitfields(_, _, _, Result) :-
|
|
( if semidet_fail then
|
|
Result = (=)
|
|
else
|
|
error("compare_local_int32_bitfields called")
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% This section of the module is for miscellaneous predicates
|
|
% that are useful in other modules of the Mercury standard library.
|
|
%
|
|
|
|
:- interface.
|
|
|
|
% var/1 is intended to make it possible to write code that effectively has
|
|
% different implementations for different modes. It has to be impure
|
|
% to ensure that reordering doesn't cause the wrong mode to be selected.
|
|
%
|
|
:- impure pred var(T).
|
|
:- mode var(ui) is failure.
|
|
:- mode var(in) is failure.
|
|
:- mode var(unused) is det.
|
|
|
|
:- impure pred nonvar(T).
|
|
:- mode nonvar(ui) is det.
|
|
:- mode nonvar(in) is det.
|
|
:- mode nonvar(unused) is failure.
|
|
|
|
% no_clauses/1 is used to report a run-time error when there is a call
|
|
% to a procedure for which there are no clauses, and the procedure was
|
|
% compiled with `--allow-stubs' and is not part of the Mercury standard
|
|
% library. (If the procedure is part of the Mercury standard library,
|
|
% the compiler will generate a call to sorry/1 instead of no_clauses/1.)
|
|
%
|
|
:- pred no_clauses(string::in) is erroneous.
|
|
|
|
% sorry/1 is used to apologize about the fact that we have not implemented
|
|
% some predicate or function in the Mercury standard library for a given
|
|
% back end. The argument should give the name of the predicate or function.
|
|
%
|
|
:- pred sorry(string::in) is erroneous.
|
|
|
|
% imp/0 is used to make pure predicates impure.
|
|
%
|
|
:- impure pred imp is det.
|
|
|
|
% semip/0 is used to make pure predicates semipure.
|
|
%
|
|
:- semipure pred semip is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
var(_::ui) :- fail.
|
|
var(_::in) :- fail.
|
|
var(_::unused) :- true.
|
|
|
|
nonvar(_::ui) :- true.
|
|
nonvar(_::in) :- true.
|
|
nonvar(_::unused) :- fail.
|
|
|
|
no_clauses(PredName) :-
|
|
error("no clauses for " ++ PredName).
|
|
|
|
sorry(PredName) :-
|
|
error("sorry, " ++ PredName ++ " not implemented\n" ++
|
|
"for this target language (or compiler back-end).").
|
|
|
|
:- pragma foreign_proc("C",
|
|
imp,
|
|
[will_not_call_mercury, thread_safe, will_not_modify_trail],
|
|
"").
|
|
:- pragma foreign_proc("C#",
|
|
imp,
|
|
[will_not_call_mercury, thread_safe],
|
|
"").
|
|
:- pragma foreign_proc("Java",
|
|
imp,
|
|
[will_not_call_mercury, thread_safe],
|
|
"").
|
|
|
|
:- pragma foreign_proc("C",
|
|
semip,
|
|
[will_not_call_mercury, thread_safe, promise_semipure,
|
|
will_not_modify_trail],
|
|
"").
|
|
:- pragma foreign_proc("C#",
|
|
semip,
|
|
[will_not_call_mercury, thread_safe, promise_semipure],
|
|
"").
|
|
:- pragma foreign_proc("Java",
|
|
semip,
|
|
[will_not_call_mercury, thread_safe, promise_semipure],
|
|
"").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Foreign language code defining miscellaneous stuff related to types.
|
|
% XXX The foreign_code pragmas below define different things for the
|
|
% different languages. All these should probably be somewhere else.
|
|
%
|
|
|
|
:- pragma foreign_decl("C", "
|
|
|
|
#include ""mercury_builtin_types.h""
|
|
|
|
MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_NAME(list, list, 1));
|
|
MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_NAME(univ, univ, 0));
|
|
|
|
").
|
|
|
|
:- pragma foreign_code("C", "
|
|
|
|
const MR_TypeCtorInfo ML_type_ctor_info_for_univ =
|
|
&MR_TYPE_CTOR_INFO_NAME(univ, univ, 0);
|
|
|
|
const MR_TypeCtorInfo ML_type_info_for_type_info =
|
|
&MR_TYPE_CTOR_INFO_NAME(private_builtin, type_info, 0);
|
|
|
|
const MR_TypeCtorInfo ML_type_info_for_pseudo_type_info =
|
|
/*
|
|
** For the time being, we handle pseudo_type_infos the same way
|
|
** as we handle type_infos.
|
|
*/
|
|
&MR_TYPE_CTOR_INFO_NAME(private_builtin, type_info, 0);
|
|
|
|
const MR_FA_TypeInfo_Struct1 ML_type_info_for_list_of_univ = {
|
|
&MR_TYPE_CTOR_INFO_NAME(list, list, 1),
|
|
{ (MR_TypeInfo) &MR_TYPE_CTOR_INFO_NAME(univ, univ, 0) }
|
|
};
|
|
|
|
const MR_FA_TypeInfo_Struct1 ML_type_info_for_list_of_int = {
|
|
&MR_TYPE_CTOR_INFO_NAME(list, list, 1),
|
|
{ (MR_TypeInfo) &MR_TYPE_CTOR_INFO_NAME(builtin, int, 0) }
|
|
};
|
|
|
|
const MR_FA_TypeInfo_Struct1 ML_type_info_for_list_of_char = {
|
|
&MR_TYPE_CTOR_INFO_NAME(list, list, 1),
|
|
{ (MR_TypeInfo) &MR_TYPE_CTOR_INFO_NAME(builtin, character, 0) }
|
|
};
|
|
|
|
const MR_FA_TypeInfo_Struct1 ML_type_info_for_list_of_string = {
|
|
&MR_TYPE_CTOR_INFO_NAME(list, list, 1),
|
|
{ (MR_TypeInfo) &MR_TYPE_CTOR_INFO_NAME(builtin, string, 0) }
|
|
};
|
|
|
|
const MR_FA_TypeInfo_Struct1 ML_type_info_for_list_of_type_info = {
|
|
&MR_TYPE_CTOR_INFO_NAME(list, list, 1),
|
|
{ (MR_TypeInfo) &ML_type_info_for_type_info }
|
|
};
|
|
|
|
const MR_FA_TypeInfo_Struct1 ML_type_info_for_list_of_pseudo_type_info = {
|
|
&MR_TYPE_CTOR_INFO_NAME(list, list, 1),
|
|
/*
|
|
** For the time being, we handle pseudo_type_infos the same way
|
|
** as we handle type_infos.
|
|
*/
|
|
{ (MR_TypeInfo) &ML_type_info_for_type_info }
|
|
};
|
|
|
|
").
|
|
|
|
:- pragma foreign_code("Java", "
|
|
public static class Ref_1
|
|
{
|
|
// XXX stub only
|
|
}
|
|
|
|
public static class Heap_pointer_0
|
|
{
|
|
// XXX stub only
|
|
}
|
|
|
|
public static final int MR_SECTAG_NONE = 0;
|
|
public static final int MR_SECTAG_NONE_DIRECT_ARG = 1;
|
|
public static final int MR_SECTAG_LOCAL = 2;
|
|
public static final int MR_SECTAG_LOCAL_REST_OF_WORD = 2; // synonym
|
|
public static final int MR_SECTAG_REMOTE = 3;
|
|
public static final int MR_SECTAG_REMOTE_FULL_WORD = 3; // synonym
|
|
public static final int MR_SECTAG_VARIABLE = 4;
|
|
// These are never used in Java grades.
|
|
// public static final int MR_SECTAG_LOCAL_BITS = 5;
|
|
// public static final int MR_SECTAG_REMOTE_BITS = 6;
|
|
|
|
public static final int MR_FUNCTOR_SUBTYPE_NONE = 0;
|
|
public static final int MR_FUNCTOR_SUBTYPE_EXISTS = 1;
|
|
|
|
public static final int MR_PREDICATE = 0;
|
|
public static final int MR_FUNCTION = 1;
|
|
|
|
// The dummy_var is used to represent io.states and values of other types
|
|
// (dummy types) that contain no information. Occasionally a dummy variable
|
|
// will be used by the code generator as an lval, so we use
|
|
// private_builtin.dummy_var as that lval.
|
|
public static java.lang.Object dummy_var;
|
|
").
|
|
|
|
:- pragma foreign_code("C#", "
|
|
// The dummy_var is used to represent io.states and values of other types
|
|
// (dummy types) that contain no information. Occasionally a dummy variable
|
|
// will be used by the code generator as an lval, so we use
|
|
// private_builtin.dummy_var as that lval.
|
|
public static object dummy_var;
|
|
").
|
|
|
|
:- pragma foreign_code("Java", "
|
|
// Type-specific unification and comparison routines.
|
|
|
|
public static boolean
|
|
__Unify____ref_1_0(jmercury.runtime.TypeInfo_Struct ti,
|
|
private_builtin.Ref_1 x, private_builtin.Ref_1 y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error
|
|
(""unify/2 for type private_builtin.ref not implemented"");
|
|
}
|
|
|
|
public static boolean
|
|
__Unify____heap_pointer_0_0 (private_builtin.Heap_pointer_0 x,
|
|
private_builtin.Heap_pointer_0 y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error(""unify/2 for type heap_pointer/0"");
|
|
}
|
|
|
|
public static boolean
|
|
__Unify____type_ctor_info_0_0(
|
|
jmercury.runtime.TypeCtorInfo_Struct x,
|
|
jmercury.runtime.TypeCtorInfo_Struct y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error
|
|
(""unify/2 for type type_ctor_info/1"");
|
|
}
|
|
|
|
public static boolean
|
|
__Unify____type_ctor_info_1_0(jmercury.runtime.TypeInfo_Struct ti,
|
|
jmercury.runtime.TypeCtorInfo_Struct x,
|
|
jmercury.runtime.TypeCtorInfo_Struct y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error
|
|
(""unify/2 for type type_ctor_info/1"");
|
|
}
|
|
|
|
public static boolean
|
|
__Unify____type_info_0_0(
|
|
jmercury.runtime.TypeInfo_Struct x,
|
|
jmercury.runtime.TypeInfo_Struct y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error
|
|
(""unify/2 for type type_info/0"");
|
|
}
|
|
|
|
public static boolean
|
|
__Unify____type_info_1_0(jmercury.runtime.TypeInfo_Struct ti,
|
|
jmercury.runtime.TypeInfo_Struct x,
|
|
jmercury.runtime.TypeInfo_Struct y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error
|
|
(""unify/2 for type type_info/0"");
|
|
}
|
|
|
|
public static boolean
|
|
__Unify____base_typeclass_info_0_0(
|
|
java.lang.Object[] x, java.lang.Object[] y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error(""unify/2 for type typeclass_info/0"");
|
|
}
|
|
|
|
public static boolean
|
|
__Unify____base_typeclass_info_1_0(jmercury.runtime.TypeInfo_Struct ti,
|
|
java.lang.Object[] x, java.lang.Object[] y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error(""unify/2 for type typeclass_info/0"");
|
|
}
|
|
|
|
public static boolean
|
|
__Unify____typeclass_info_0_0(java.lang.Object[] x, java.lang.Object[] y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error
|
|
(""unify/2 for type typeclass_info/1"");
|
|
}
|
|
|
|
public static boolean
|
|
__Unify____typeclass_info_1_0(jmercury.runtime.TypeInfo_Struct ti,
|
|
java.lang.Object[] x, java.lang.Object[] y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error
|
|
(""unify/2 for type typeclass_info/1"");
|
|
}
|
|
|
|
public static builtin.Comparison_result_0
|
|
__Compare____ref_1_0(jmercury.runtime.TypeInfo_Struct ti,
|
|
private_builtin.Ref_1 x, private_builtin.Ref_1 y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error
|
|
(""called compare/3 for type private_builtin.ref"");
|
|
}
|
|
|
|
public static builtin.Comparison_result_0
|
|
__Compare____heap_pointer_0_0 (
|
|
private_builtin.Heap_pointer_0 x,
|
|
private_builtin.Heap_pointer_0 y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error(""compare/2 for type heap_pointer/0"");
|
|
}
|
|
|
|
public static builtin.Comparison_result_0
|
|
__Compare____type_ctor_info_0_0(
|
|
jmercury.runtime.TypeCtorInfo_Struct x,
|
|
jmercury.runtime.TypeCtorInfo_Struct y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error
|
|
(""compare/2 for type type_ctor_info/1"");
|
|
}
|
|
|
|
public static builtin.Comparison_result_0
|
|
__Compare____type_ctor_info_1_0(jmercury.runtime.TypeInfo_Struct ti,
|
|
jmercury.runtime.TypeCtorInfo_Struct x,
|
|
jmercury.runtime.TypeCtorInfo_Struct y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error
|
|
(""compare/2 for type type_ctor_info/1"");
|
|
}
|
|
|
|
public static builtin.Comparison_result_0
|
|
__Compare____type_info_0_0(
|
|
jmercury.runtime.TypeInfo_Struct x,
|
|
jmercury.runtime.TypeInfo_Struct y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error
|
|
(""compare/2 for type type_info/0"");
|
|
}
|
|
|
|
public static builtin.Comparison_result_0
|
|
__Compare____type_info_1_0(jmercury.runtime.TypeInfo_Struct ti,
|
|
jmercury.runtime.TypeInfo_Struct x,
|
|
jmercury.runtime.TypeInfo_Struct y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error
|
|
(""compare/2 for type type_info/0"");
|
|
}
|
|
|
|
public static builtin.Comparison_result_0
|
|
__Compare____base_typeclass_info_0_0(
|
|
java.lang.Object[] x, java.lang.Object[] y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error(""compare/2 for type typeclass_info/1"");
|
|
}
|
|
|
|
public static builtin.Comparison_result_0
|
|
__Compare____base_typeclass_info_1_0(jmercury.runtime.TypeInfo_Struct ti,
|
|
java.lang.Object[] x, java.lang.Object[] y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error(""compare/2 for type typeclass_info/1"");
|
|
}
|
|
|
|
public static builtin.Comparison_result_0
|
|
__Compare____typeclass_info_0_0(java.lang.Object[] x, java.lang.Object[] y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error
|
|
(""compare/2 for type typeclass_info/0"");
|
|
}
|
|
|
|
public static builtin.Comparison_result_0
|
|
__Compare____typeclass_info_1_0(jmercury.runtime.TypeInfo_Struct ti,
|
|
java.lang.Object[] x, java.lang.Object[] y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error
|
|
(""compare/2 for type typeclass_info/0"");
|
|
}
|
|
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|