mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 17:33:38 +00:00
compiler/add_foreign_proc.m:
The existing code for adding foreign_procs
- tests whether the foreign_proc is for an imported predicate,
and if so, stops with an error message,
- then tests whether the foreign_proc is for the current backend,
and if it is not, ignores the foreign_proc,
- and then both adds the foreign proc to the HLDS, and checks it
for singletons.
Reverse the order of the last two tests, so that we now test
foreign_procs for singletons *even if* they are not for the current
backend. (Though of course we do not add such foreign_procs to the HLDS.)
library/io.environment.m:
library/private_builtin.m:
library/rtti_implementation.m:
Fix the warnings for now result for non-C foreign_procs even during
bootchecks in C grades.
tests/warnings/foreign_singleton.err_exp:
Expect warnings for Java and C# foreign_procs as well as C foreign_procs.
tests/warnings/singleton_test.{m,err_exp}:
tests/warnings/warn_return.{m,err_exp}:
tests/warnings/warn_succ_ind.{m,err_exp}:
Make these test cases more readable. Delete any obsolete parts,
as well as the causes of warnings that these test cases are
not intended to test for. (The latter makes the tests' *outputs*
more readable.)
Expect warnings for Java and C# foreign_procs as well as C foreign_procs,
and expect them with the new line numbers.
tests/warnings/foreign_singleton.err_exp2:
tests/warnings/foreign_singleton.err_exp3:
tests/warnings/singleton_test.err_exp2:
tests/warnings/singleton_test.err_exp3:
tests/warnings/warn_return.err_exp2:
tests/warnings/warn_return.err_exp3:
tests/warnings/warn_succ_ind.err_exp2:
tests/warnings/warn_succ_ind.err_exp3:
Delete these Java- and C#-specific expected outputs, since the warnings
they test for are now in the corresponding .err_exp files.
2371 lines
73 KiB
Mathematica
2371 lines
73 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1994-2007, 2012 The University of Melbourne.
|
|
% Copyright (C) 2013-2018, 2020-2022, 2025-2026 The Mercury team.
|
|
% This file is distributed under the terms specified in COPYING.LIB.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% File: private_builtin.m.
|
|
% Main authors: fjh, zs.
|
|
% Stability: high.
|
|
%
|
|
% 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.
|
|
|
|
% Compare two integers after casting both to unsigned.
|
|
%
|
|
:- pred unsigned_lt(int::in, int::in) is semidet.
|
|
:- pred unsigned_le(int::in, int::in) is semidet.
|
|
|
|
% in_range(X, Max) is true if and only if 0 <= X, X < Max.
|
|
%
|
|
% Implemented as the above test when targeting Java,
|
|
% and as unsigned_lt(X, Max) when targeting C or C#.
|
|
%
|
|
:- pred in_range(int::in, int::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 if-and-only-if 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 require.
|
|
:- import_module string.
|
|
:- import_module type_desc.
|
|
:- import_module uint.
|
|
:- import_module uint8.
|
|
:- import_module uint16.
|
|
:- import_module uint32.
|
|
:- import_module uint64.
|
|
|
|
:- pragma inline(pred(builtin_compare_int/3)).
|
|
:- pragma inline(pred(builtin_compare_uint/3)).
|
|
:- pragma inline(pred(builtin_compare_int8/3)).
|
|
:- pragma inline(pred(builtin_compare_uint8/3)).
|
|
:- pragma inline(pred(builtin_compare_int16/3)).
|
|
:- pragma inline(pred(builtin_compare_uint16/3)).
|
|
:- pragma inline(pred(builtin_compare_int32/3)).
|
|
:- pragma inline(pred(builtin_compare_uint32/3)).
|
|
:- pragma inline(pred(builtin_compare_int64/3)).
|
|
:- pragma inline(pred(builtin_compare_uint64/3)).
|
|
:- pragma inline(pred(builtin_compare_character/3)).
|
|
:- pragma inline(pred(builtin_compare_string/3)).
|
|
:- pragma inline(pred(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(pred(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(pred(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(pred(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(pred(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(pred(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(pred(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(pred(free_heap/1)).
|
|
:- pragma inline(pred(mark_hp/1)).
|
|
:- pragma inline(pred(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 C# 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 C# 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 C# 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 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(TermX, TermY, Ptag, CellOffset):
|
|
%
|
|
% Succeed if-and-only-if the argument words at the given offset
|
|
% are the same in TermX and TermY.
|
|
%
|
|
:- pred unify_remote_arg_words(T::in, T::in, int::in, int::in) is semidet.
|
|
|
|
% compare_remote_uint_words(TermX, TermY, Ptag, CellOffset, Result):
|
|
%
|
|
% Set Result to the result of the unsigned comparison between
|
|
% two bitfields in the memory cells of TermX and TermY.
|
|
% The bitfields occupy the entirety of the words at offset
|
|
% CellOffset.
|
|
%
|
|
:- pred compare_remote_uint_words(T::in, T::in, int::in, int::in,
|
|
comparison_result::uo) is det.
|
|
|
|
% compare_remote_uint_bitfields(TermX, TermY,
|
|
% Ptag, CellOffset, Shift, NumBits, Result):
|
|
%
|
|
% Set Result to the result of the unsigned comparison between
|
|
% two bitfields in the memory cells of TermX and TermY.
|
|
% The bitfields are in the word at offset CellOffset, with the
|
|
% LSBs of the bitfields being Shift bits from the LSB of the word.
|
|
% Their size is NumBits 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(TermX, TermY,
|
|
% Ptag, CellOffset, Shift, Result):
|
|
%
|
|
% Set Result to the result of the signed comparison between two
|
|
% {8,16,32}-bit bitfields in the memory cells of TermX and TermY.
|
|
% The bitfields are in the word at offset CellOffset, with the
|
|
% LSBs of the bitfields being Shift 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(TermX, TermY, Result):
|
|
%
|
|
% Set Result to the result of the unsigned comparison between
|
|
% two bitfields in TermX and TermY.
|
|
% 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(TermX, TermY, Shift, NumBits, Result):
|
|
%
|
|
% Set Result to the result of the unsigned comparison between
|
|
% two bitfields in TermX and TermY.
|
|
% The bitfields are in the term words themselves, with the LSBs
|
|
% of the bitfields being Shift bits from the LSB of the word.
|
|
% Their size is NumBits 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(TermX, TermY, Shift, Result):
|
|
%
|
|
% Set Result to the result of the signed comparison between two
|
|
% {8,16,32} bit bitfields in TermX and TermY.
|
|
% The bitfields are in the term words themselves, with the LSBs
|
|
% of the bitfields being Shift 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(TermX::in, TermY::in, Ptag::in, CellOffset::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) TermX) - (MR_Unsigned) Ptag);
|
|
cell_y = (MR_Unsigned *) (((MR_Unsigned) TermY) - (MR_Unsigned) Ptag);
|
|
MR_Unsigned word_x = cell_x[CellOffset];
|
|
MR_Unsigned word_y = cell_y[CellOffset];
|
|
SUCCESS_INDICATOR = (word_x == word_y);
|
|
").
|
|
|
|
unify_remote_arg_words(_, _, _, _) :-
|
|
% This predicate should only ever be called when targeting C,
|
|
% in which case, its definition will be the foreign_proc above,
|
|
% not this clause.
|
|
( if semidet_fail then
|
|
% Make this predicate semidet.
|
|
( if semidet_fail then
|
|
true
|
|
else
|
|
fail
|
|
)
|
|
else
|
|
error("unify_remote_arg_words called")
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
compare_remote_uint_words(TermX::in, TermY::in, Ptag::in,
|
|
CellOffset::in, Result::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) TermX) - (MR_Unsigned) Ptag);
|
|
cell_y = (MR_Unsigned *) (((MR_Unsigned) TermY) - (MR_Unsigned) Ptag);
|
|
MR_Unsigned word_x = cell_x[CellOffset];
|
|
MR_Unsigned word_y = cell_y[CellOffset];
|
|
if (word_x < word_y) {
|
|
Result = MR_COMPARE_LESS;
|
|
} else if (word_x > word_y) {
|
|
Result = MR_COMPARE_GREATER;
|
|
} else {
|
|
Result = MR_COMPARE_EQUAL;
|
|
}
|
|
").
|
|
|
|
compare_remote_uint_words(_, _, _, _, Result) :-
|
|
% This predicate should only ever be called when targeting C,
|
|
% in which case, its definition will be the foreign_proc above,
|
|
% not this clause.
|
|
( if semidet_fail then
|
|
Result = (=)
|
|
else
|
|
error("compare_remote_int32_words called")
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
compare_remote_uint_bitfields(TermX::in, TermY::in, Ptag::in,
|
|
CellOffset::in, Shift::in, NumBits::in, Result::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) TermX) - (MR_Unsigned) Ptag);
|
|
cell_y = (MR_Unsigned *) (((MR_Unsigned) TermY) - (MR_Unsigned) Ptag);
|
|
MR_Unsigned word_x = cell_x[CellOffset];
|
|
MR_Unsigned word_y = cell_y[CellOffset];
|
|
MR_Unsigned value_x = ((word_x >> Shift) & ((1 << NumBits) - 1));
|
|
MR_Unsigned value_y = ((word_y >> Shift) & ((1 << NumBits) - 1));
|
|
if (value_x < value_y) {
|
|
Result = MR_COMPARE_LESS;
|
|
} else if (value_x > value_y) {
|
|
Result = MR_COMPARE_GREATER;
|
|
} else {
|
|
Result = MR_COMPARE_EQUAL;
|
|
}
|
|
").
|
|
|
|
compare_remote_uint_bitfields(_, _, _, _, _, _, Result) :-
|
|
% This predicate should only ever be called when targeting C,
|
|
% in which case, its definition will be the foreign_proc above,
|
|
% not this clause.
|
|
( if semidet_fail then
|
|
Result = (=)
|
|
else
|
|
error("compare_remote_int32_bitfields called")
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
compare_remote_int8_bitfields(TermX::in, TermY::in, Ptag::in,
|
|
CellOffset::in, Shift::in, Result::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) TermX) - (MR_Unsigned) Ptag);
|
|
cell_y = (MR_Unsigned *) (((MR_Unsigned) TermY) - (MR_Unsigned) Ptag);
|
|
MR_Unsigned word_x = cell_x[CellOffset];
|
|
MR_Unsigned word_y = cell_y[CellOffset];
|
|
int8_t value_x = (int8_t) ((word_x >> Shift) & ((1 << 8) - 1));
|
|
int8_t value_y = (int8_t) ((word_y >> Shift) & ((1 << 8) - 1));
|
|
if (value_x < value_y) {
|
|
Result = MR_COMPARE_LESS;
|
|
} else if (value_x > value_y) {
|
|
Result = MR_COMPARE_GREATER;
|
|
} else {
|
|
Result = MR_COMPARE_EQUAL;
|
|
}
|
|
").
|
|
|
|
compare_remote_int8_bitfields(_, _, _, _, _, Result) :-
|
|
% This predicate should only ever be called when targeting C,
|
|
% in which case, its definition will be the foreign_proc above,
|
|
% not this clause.
|
|
( if semidet_fail then
|
|
Result = (=)
|
|
else
|
|
error("compare_remote_int8_bitfields called")
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
compare_remote_int16_bitfields(TermX::in, TermY::in, Ptag::in,
|
|
CellOffset::in, Shift::in, Result::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) TermX) - (MR_Unsigned) Ptag);
|
|
cell_y = (MR_Unsigned *) (((MR_Unsigned) TermY) - (MR_Unsigned) Ptag);
|
|
MR_Unsigned word_x = cell_x[CellOffset];
|
|
MR_Unsigned word_y = cell_y[CellOffset];
|
|
int16_t value_x = (int16_t) ((word_x >> Shift) & ((1 << 16) - 1));
|
|
int16_t value_y = (int16_t) ((word_y >> Shift) & ((1 << 16) - 1));
|
|
if (value_x < value_y) {
|
|
Result = MR_COMPARE_LESS;
|
|
} else if (value_x > value_y) {
|
|
Result = MR_COMPARE_GREATER;
|
|
} else {
|
|
Result = MR_COMPARE_EQUAL;
|
|
}
|
|
").
|
|
|
|
compare_remote_int16_bitfields(_, _, _, _, _, Result) :-
|
|
% This predicate should only ever be called when targeting C,
|
|
% in which case, its definition will be the foreign_proc above,
|
|
% not this clause.
|
|
( if semidet_fail then
|
|
Result = (=)
|
|
else
|
|
error("compare_remote_int16_bitfields called")
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
compare_remote_int32_bitfields(TermX::in, TermY::in, Ptag::in,
|
|
CellOffset::in, Shift::in, Result::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) TermX) - (MR_Unsigned) Ptag);
|
|
cell_y = (MR_Unsigned *) (((MR_Unsigned) TermY) - (MR_Unsigned) Ptag);
|
|
MR_Unsigned word_x = cell_x[CellOffset];
|
|
MR_Unsigned word_y = cell_y[CellOffset];
|
|
int32_t value_x =
|
|
(int32_t) ((word_x >> Shift) & ((INT64_C(1) << 32) - 1));
|
|
int32_t value_y =
|
|
(int32_t) ((word_y >> Shift) & ((INT64_C(1) << 32) - 1));
|
|
if (value_x < value_y) {
|
|
Result = MR_COMPARE_LESS;
|
|
} else if (value_x > value_y) {
|
|
Result = MR_COMPARE_GREATER;
|
|
} else {
|
|
Result = MR_COMPARE_EQUAL;
|
|
}
|
|
#else
|
|
MR_fatal_error(""compare_remote_int32_bitfields called on ""
|
|
""non-64-bit system"");
|
|
#endif
|
|
").
|
|
|
|
compare_remote_int32_bitfields(_, _, _, _, _, Result) :-
|
|
% This predicate should only ever be called when targeting C,
|
|
% in which case, its definition will be the foreign_proc above,
|
|
% not this clause.
|
|
( if semidet_fail then
|
|
Result = (=)
|
|
else
|
|
error("compare_remote_int32_bitfields called")
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
compare_local_uint_words(TermX::in, TermY::in, Result::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) TermX;
|
|
MR_Unsigned value_y = (MR_Unsigned) TermY;
|
|
if (value_x < value_y) {
|
|
Result = MR_COMPARE_LESS;
|
|
} else if (value_x > value_y) {
|
|
Result = MR_COMPARE_GREATER;
|
|
} else {
|
|
Result = MR_COMPARE_EQUAL;
|
|
}
|
|
").
|
|
|
|
compare_local_uint_words(_, _, Result) :-
|
|
% This predicate should only ever be called when targeting C,
|
|
% in which case, its definition will be the foreign_proc above,
|
|
% not this clause.
|
|
( if semidet_fail then
|
|
Result = (=)
|
|
else
|
|
error("compare_local_uint_words called")
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
compare_local_uint_bitfields(TermX::in, TermY::in, Shift::in, NumBits::in,
|
|
Result::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) TermX;
|
|
MR_Unsigned word_y = (MR_Unsigned) TermY;
|
|
MR_Unsigned value_x = ((word_x >> Shift) & ((1 << NumBits) - 1));
|
|
MR_Unsigned value_y = ((word_y >> Shift) & ((1 << NumBits) - 1));
|
|
if (value_x < value_y) {
|
|
Result = MR_COMPARE_LESS;
|
|
} else if (value_x > value_y) {
|
|
Result = MR_COMPARE_GREATER;
|
|
} else {
|
|
Result = MR_COMPARE_EQUAL;
|
|
}
|
|
").
|
|
|
|
compare_local_uint_bitfields(_, _, _, _, Result) :-
|
|
% This predicate should only ever be called when targeting C,
|
|
% in which case, its definition will be the foreign_proc above,
|
|
% not this clause.
|
|
( if semidet_fail then
|
|
Result = (=)
|
|
else
|
|
error("compare_local_uint_bitfields called")
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
compare_local_int8_bitfields(TermX::in, TermY::in, Shift::in, Result::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) TermX;
|
|
MR_Unsigned word_y = (MR_Unsigned) TermY;
|
|
int8_t value_x = (int8_t) ((word_x >> Shift) & ((1 << 8) - 1));
|
|
int8_t value_y = (int8_t) ((word_y >> Shift) & ((1 << 8) - 1));
|
|
if (value_x < value_y) {
|
|
Result = MR_COMPARE_LESS;
|
|
} else if (value_x > value_y) {
|
|
Result = MR_COMPARE_GREATER;
|
|
} else {
|
|
Result = MR_COMPARE_EQUAL;
|
|
}
|
|
").
|
|
|
|
compare_local_int8_bitfields(_, _, _, Result) :-
|
|
% This predicate should only ever be called when targeting C,
|
|
% in which case, its definition will be the foreign_proc above,
|
|
% not this clause.
|
|
( if semidet_fail then
|
|
Result = (=)
|
|
else
|
|
error("compare_local_int8_bitfields called")
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
compare_local_int16_bitfields(TermX::in, TermY::in, Shift::in, Result::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) TermX;
|
|
MR_Unsigned word_y = (MR_Unsigned) TermY;
|
|
int16_t value_x = (int16_t) ((word_x >> Shift) & ((1 << 16) - 1));
|
|
int16_t value_y = (int16_t) ((word_y >> Shift) & ((1 << 16) - 1));
|
|
if (value_x < value_y) {
|
|
Result = MR_COMPARE_LESS;
|
|
} else if (value_x > value_y) {
|
|
Result = MR_COMPARE_GREATER;
|
|
} else {
|
|
Result = MR_COMPARE_EQUAL;
|
|
}
|
|
").
|
|
|
|
compare_local_int16_bitfields(_, _, _, Result) :-
|
|
% This predicate should only ever be called when targeting C,
|
|
% in which case, its definition will be the foreign_proc above,
|
|
% not this clause.
|
|
( if semidet_fail then
|
|
Result = (=)
|
|
else
|
|
error("compare_local_int16_bitfields called")
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
compare_local_int32_bitfields(TermX::in, TermY::in, Shift::in, Result::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) TermX;
|
|
MR_Unsigned word_y = (MR_Unsigned) TermY;
|
|
int32_t value_x =
|
|
(int32_t) ((word_x >> Shift) & ((INT64_C(1) << 32) - 1));
|
|
int32_t value_y =
|
|
(int32_t) ((word_y >> Shift) & ((INT64_C(1) << 32) - 1));
|
|
if (value_x < value_y) {
|
|
Result = MR_COMPARE_LESS;
|
|
} else if (value_x > value_y) {
|
|
Result = MR_COMPARE_GREATER;
|
|
} else {
|
|
Result = MR_COMPARE_EQUAL;
|
|
}
|
|
#else
|
|
MR_fatal_error(""compare_local_int32_bitfields called on ""
|
|
""non-64-bit system"");
|
|
#endif
|
|
").
|
|
|
|
compare_local_int32_bitfields(_, _, _, Result) :-
|
|
% This predicate should only ever be called when targeting C,
|
|
% in which case, its definition will be the foreign_proc above,
|
|
% not this clause.
|
|
( 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"");
|
|
}
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module private_builtin.
|
|
%---------------------------------------------------------------------------%
|