Files
mercury/library/private_builtin.m
Julien Fischer e7d28ff90f Update copyright notices in stdlib.
library/*.m:
    As above.
2022-06-07 21:51:03 +10:00

2341 lines
72 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 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(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 .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"");
}
").
%---------------------------------------------------------------------------%
:- end_module private_builtin.
%---------------------------------------------------------------------------%