mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 01:13:30 +00:00
library/array.m:
library/builtin.m:
library/construct.m:
Fix copy-and-paste errors.
library/arrayd2d.m:
Use the mode array2d_di instead of array_di in a spot.
Delete an extra space from an exception message.
library/bimap.m:
Fix formatting.
library/bit_buffer.m:
Fix inverted argument types.
library/dir.m:
Say that make_single_directory/4 returns an error rather
than saying that it fails.
library/io.m:
Fix errors in obsolete pragmas.
library/assoc_list.m:
library/bag.m:
library/cord.m:
library/deconstruct.m:
library/enum.m:
library/fat_sparse_bitset.m:
library/getopt*.m:
library/int*.m:
library/io*.m:
library/type_desc.m:
Fix documentation errors.
tests/hard_coded/array2d_from_array.exp:
Conform to the changed exception message in array2d.m.
1245 lines
37 KiB
Mathematica
1245 lines
37 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1994-2007, 2010-2012 The University of Melbourne.
|
|
% Copyright (C) 2014-2022, 2025-2026 The Mercury team.
|
|
% This file is distributed under the terms specified in COPYING.LIB.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% File: builtin.m.
|
|
% Main author: fjh.
|
|
% Stability: high.
|
|
%
|
|
% This file is automatically imported into every module.
|
|
% It is intended for things that are part of the language,
|
|
% but which are implemented the same way as normal user-level code
|
|
% rather than with special coding in the compiler.
|
|
%
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module builtin.
|
|
:- interface.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Types.
|
|
%
|
|
|
|
% The types `character', `int', `int8', `int16', `int32', `int64',
|
|
% `uint', `uint8', `uint16', `uint32', `uint64', `float', and `string',
|
|
% and tuple types `{}', `{T}', `{T1, T2}', ...
|
|
% and the types `pred', `pred(T)', `pred(T1, T2)', `pred(T1, T2, T3)', ...
|
|
% and `func(T1) = T2', `func(T1, T2) = T3', `func(T1, T2, T3) = T4', ...
|
|
% are builtin and are implemented using special code in the type-checker.
|
|
|
|
% The type c_pointer can be used by predicates that use the C interface.
|
|
%
|
|
% NOTE: We *strongly* recommend using a `foreign_type' pragma instead
|
|
% of using this type.
|
|
%
|
|
:- type c_pointer.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Insts.
|
|
%
|
|
|
|
% The standard insts `free', `ground', and `bound(...)' are builtin and are
|
|
% implemented using special code in the parser and mode-checker.
|
|
%
|
|
% So are the standard unique insts `unique', `unique(...)', `mostly_unique',
|
|
% `mostly_unique(...)', and `clobbered'.
|
|
%
|
|
% Higher-order predicate insts `pred(<modes>) is <detism>'
|
|
% and higher-order function insts `func(<modes>) = <mode> is <detism>'
|
|
% are also builtin.
|
|
%
|
|
% The `any' inst used for constraint solver interfaces is builtin and so are
|
|
% its higher-order variants: `any_pred(<modes>) is <detism>' and
|
|
% `any_func(<modes>) = <mode> is <detism>'.
|
|
|
|
% The name `dead' is allowed as a synonym for `clobbered'.
|
|
% Similarly, `mostly_dead' is a synonym for `mostly_clobbered'.
|
|
%
|
|
:- inst dead == clobbered.
|
|
:- inst mostly_dead == mostly_clobbered.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Standard modes.
|
|
%
|
|
|
|
:- mode unused == free >> free.
|
|
|
|
% This mode is deprecated, use `out' instead.
|
|
%
|
|
:- mode output == free >> ground.
|
|
|
|
% This mode is deprecated, use `in' instead.
|
|
%
|
|
:- mode input == ground >> ground.
|
|
|
|
:- mode in == ground >> ground.
|
|
:- mode out == free >> ground.
|
|
|
|
:- mode in(Inst) == Inst >> Inst.
|
|
:- mode out(Inst) == free >> Inst.
|
|
:- mode di(Inst) == Inst >> clobbered.
|
|
:- mode mdi(Inst) == Inst >> mostly_clobbered.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Unique modes.
|
|
%
|
|
|
|
% XXX These are still not fully implemented.
|
|
|
|
% unique output
|
|
%
|
|
:- mode uo == free >> unique.
|
|
|
|
% unique input
|
|
%
|
|
:- mode ui == unique >> unique.
|
|
|
|
% destructive input
|
|
%
|
|
:- mode di == unique >> clobbered.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% "Mostly" unique modes.
|
|
%
|
|
|
|
% Unique except that they may be referenced again on backtracking.
|
|
|
|
% mostly unique output
|
|
%
|
|
:- mode muo == free >> mostly_unique.
|
|
|
|
% mostly unique input
|
|
%
|
|
:- mode mui == mostly_unique >> mostly_unique.
|
|
|
|
% mostly destructive input
|
|
%
|
|
:- mode mdi == mostly_unique >> mostly_clobbered.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Dynamic modes.
|
|
%
|
|
|
|
% Solver type modes.
|
|
%
|
|
:- mode ia == any >> any.
|
|
:- mode oa == free >> any.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Predicates.
|
|
%
|
|
|
|
% copy/2 makes a deep copy of a data structure.
|
|
% The resulting copy is a `unique' value, so you can use
|
|
% destructive update on it.
|
|
%
|
|
:- pred copy(T, T).
|
|
:- mode copy(ui, uo) is det.
|
|
:- mode copy(in, uo) is det.
|
|
|
|
% unsafe_promise_unique/2 is used to promise the compiler that you
|
|
% have a `unique' copy of a data structure, so that you can use
|
|
% destructive update. It is used to work around limitations in
|
|
% the current support for unique modes.
|
|
% `unsafe_promise_unique(X, Y)' is the same as `Y = X' except that
|
|
% the compiler will assume that Y is unique.
|
|
%
|
|
% Note that misuse of this predicate may lead to unsound results:
|
|
% if there is more than one reference to the data in question,
|
|
% i.e. it is not `unique', then the behaviour is undefined.
|
|
% (If you lie to the compiler, the compiler will get its revenge!)
|
|
%
|
|
:- func unsafe_promise_unique(T::in) = (T::uo) is det.
|
|
:- pred unsafe_promise_unique(T::in, T::uo) is det.
|
|
|
|
% A synonym for fail/0; this name is more in keeping with Mercury's
|
|
% declarative style rather than its Prolog heritage.
|
|
%
|
|
:- pred false is failure.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% This function is useful for converting polymorphic non-solver type
|
|
% values with inst any to inst ground (the compiler recognises that
|
|
% inst any is equivalent to ground for non-polymorphic non-solver
|
|
% type values.)
|
|
%
|
|
% Do not call this on solver type values unless you are *absolutely sure*
|
|
% that they are semantically ground.
|
|
%
|
|
:- func unsafe_cast_any_to_ground(T::ia) = (T::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% unify(X, Y) is true if-and-only-if X = Y.
|
|
%
|
|
:- pred unify(T::in, T::in) is semidet.
|
|
|
|
% For use in defining user-defined unification predicates.
|
|
% The relation defined by a value of type `unify' must be
|
|
% an equivalence relation, meaning that it must be symmetric, reflexive,
|
|
% and transitive.
|
|
%
|
|
:- type unify(T) == pred(T, T).
|
|
:- inst unify == (pred(in, in) is semidet).
|
|
|
|
:- type comparison_result
|
|
---> (=)
|
|
; (<)
|
|
; (>).
|
|
|
|
% compare(Res, X, Y) binds Res to =, <, or > depending on whether
|
|
% X is =, <, or > Y in the standard ordering.
|
|
%
|
|
:- pred compare(comparison_result, T, T).
|
|
% NOTE_TO_IMPLEMENTORS The modes must appear in this order:
|
|
% NOTE_TO_IMPLEMENTORS compiler/higher_order.m depends on it, as does
|
|
% NOTE_TO_IMPLEMENTORS compiler/simplify.m (for the inequality
|
|
% NOTE_TO_IMPLEMENTORS simplification).
|
|
:- mode compare(uo, in, in) is det.
|
|
:- mode compare(uo, ui, ui) is det.
|
|
:- mode compare(uo, ui, in) is det.
|
|
:- mode compare(uo, in, ui) is det.
|
|
|
|
% For use in defining user-defined comparison predicates.
|
|
% For a value ComparePred of type `compare', the following
|
|
% conditions must hold:
|
|
%
|
|
% - the relation
|
|
% compare_eq(X, Y) :- ComparePred((=), X, Y).
|
|
% must be an equivalence relation; meaning that it must be symmetric,
|
|
% reflexive, and transitive.
|
|
%
|
|
% - the relations
|
|
% compare_leq(X, Y) :-
|
|
% ComparePred(R, X, Y), (R = (=) ; R = (<)).
|
|
% compare_geq(X, Y) :-
|
|
% ComparePred(R, X, Y), (R = (=) ; R = (>)).
|
|
% must be total order relations: meaning that they must be antisymmetric,
|
|
% reflexive and transitive.
|
|
%
|
|
:- type compare(T) == pred(comparison_result, T, T).
|
|
:- inst compare == (pred(uo, in, in) is det).
|
|
|
|
% ordering(X, Y) = R <=> compare(R, X, Y)
|
|
%
|
|
:- func ordering(T, T) = comparison_result.
|
|
|
|
% The standard inequalities defined in terms of compare/3.
|
|
% XXX The ui modes are commented out because they don't yet work properly.
|
|
%
|
|
:- pred T @< T.
|
|
:- mode in @< in is semidet.
|
|
% :- mode ui @< in is semidet.
|
|
% :- mode in @< ui is semidet.
|
|
% :- mode ui @< ui is semidet.
|
|
|
|
:- pred T @=< T.
|
|
:- mode in @=< in is semidet.
|
|
% :- mode ui @=< in is semidet.
|
|
% :- mode in @=< ui is semidet.
|
|
% :- mode ui @=< ui is semidet.
|
|
|
|
:- pred T @> T.
|
|
:- mode in @> in is semidet.
|
|
% :- mode ui @> in is semidet.
|
|
% :- mode in @> ui is semidet.
|
|
% :- mode ui @> ui is semidet.
|
|
|
|
:- pred T @>= T.
|
|
:- mode in @>= in is semidet.
|
|
% :- mode ui @>= in is semidet.
|
|
% :- mode in @>= ui is semidet.
|
|
% :- mode ui @>= ui is semidet.
|
|
|
|
% Values of types comparison_pred/1 and comparison_func/1 are used
|
|
% by predicates and functions which depend on an ordering on a given
|
|
% type, where this ordering is not necessarily the standard ordering.
|
|
% In addition to the type, mode and determinism constraints, a
|
|
% comparison predicate C is expected to obey two other laws.
|
|
% For all X, Y and Z of the appropriate type, and for all
|
|
% comparison_results R:
|
|
% 1) C(X, Y, (>)) if and only if C(Y, X, (<))
|
|
% 2) C(X, Y, R) and C(Y, Z, R) implies C(X, Z, R).
|
|
% Comparison functions are expected to obey analogous laws.
|
|
%
|
|
% Note that binary relations <, > and = can be defined from a
|
|
% comparison predicate or function in an obvious way. The following
|
|
% facts about these relations are entailed by the above constraints:
|
|
% = is an equivalence relation (not necessarily the usual equality),
|
|
% and the equivalence classes of this relation are totally ordered
|
|
% with respect to < and >.
|
|
%
|
|
:- type comparison_pred(T) == pred(T, T, comparison_result).
|
|
:- inst comparison_pred(I) == (pred(in(I), in(I), out) is det).
|
|
:- inst comparison_pred == comparison_pred(ground).
|
|
|
|
:- type comparison_func(T) == (func(T, T) = comparison_result).
|
|
:- inst comparison_func(I) == (func(in(I), in(I)) = out is det).
|
|
:- inst comparison_func == comparison_func(ground).
|
|
|
|
% In addition, the following predicate-like constructs are builtin:
|
|
%
|
|
% :- pred (T = T).
|
|
% :- pred (T \= T).
|
|
% :- pred (pred , pred).
|
|
% :- pred (pred ; pred).
|
|
% :- pred (\+ pred).
|
|
% :- pred (not pred).
|
|
% :- pred (pred -> pred).
|
|
% :- pred (if pred then pred).
|
|
% :- pred (if pred then pred else pred).
|
|
% :- pred (pred => pred).
|
|
% :- pred (pred <= pred).
|
|
% :- pred (pred <=> pred).
|
|
%
|
|
% (pred -> pred ; pred).
|
|
% some Vars pred
|
|
% all Vars pred
|
|
% call/N
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% `semidet_succeed' is exactly the same as `true', except that
|
|
% the compiler thinks that it is semi-deterministic. You can use
|
|
% calls to `semidet_succeed' to suppress warnings about determinism
|
|
% declarations that could be stricter.
|
|
%
|
|
:- pred semidet_succeed is semidet.
|
|
|
|
% `semidet_fail' is like `fail' except that its determinism is semidet
|
|
% rather than failure.
|
|
%
|
|
:- pred semidet_fail is semidet.
|
|
|
|
% A synonym for semidet_succeed/0.
|
|
%
|
|
:- pred semidet_true is semidet.
|
|
|
|
% A synonym for semidet_fail/0.
|
|
%
|
|
:- pred semidet_false is semidet.
|
|
|
|
% `cc_multi_equal(X, Y)' is the same as `X = Y' except that it
|
|
% is cc_multi rather than det.
|
|
%
|
|
:- pred cc_multi_equal(T, T).
|
|
:- mode cc_multi_equal(di, uo) is cc_multi.
|
|
:- mode cc_multi_equal(in, out) is cc_multi.
|
|
|
|
% `impure_true' is like `true' except that it is impure.
|
|
%
|
|
:- impure pred impure_true is det.
|
|
|
|
% `semipure_true' is like `true' except that it is semipure.
|
|
%
|
|
:- semipure pred semipure_true is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% dynamic_cast(X, Y) succeeds with Y = X if-and-only-if
|
|
% X has the same ground type as Y (so this may succeed
|
|
% if Y is of type list(int), say, but not if Y is of type list(T)).
|
|
%
|
|
:- pred dynamic_cast(T1::in, T2::out) is semidet.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
% Everything below here is not intended to be part of the public interface,
|
|
% and will not be included in the Mercury library reference manual.
|
|
|
|
:- interface.
|
|
|
|
% compare_representation(Result, X, Y):
|
|
%
|
|
% compare_representation is similar to the builtin predicate compare/3,
|
|
% except that it does not abort when asked to compare non-canonical terms.
|
|
%
|
|
% The declarative semantics of compare_representation for unequal
|
|
% non-canonical terms is that the result is either (<) or (>).
|
|
% For equal non-canonical terms the result can be anything.
|
|
%
|
|
% Operationally, the result of compare_representation for non-canonical
|
|
% terms is the same as that for comparing the internal representations
|
|
% of the terms, where the internal representation is that which would be
|
|
% produced by deconstruct.cc.
|
|
%
|
|
% XXX This predicate is not yet implemented for highlevel code.
|
|
% This is the reason it is not in the official part of the interface.
|
|
%
|
|
:- pred compare_representation(comparison_result, T, T).
|
|
:- mode compare_representation(uo, in, in) is cc_multi.
|
|
|
|
% Set up Mercury runtime to call special predicates implemented in this
|
|
% module.
|
|
%
|
|
:- impure pred init_runtime_hooks is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
% This import is needed for e.g. {unify,compare}_tuple_pos.
|
|
%
|
|
:- import_module int.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
false :-
|
|
fail.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% IMPORTANT: any changes or additions to external predicates
|
|
% should be reflected in the definition of pred_is_external in
|
|
% mdbcomp/program_representation.m. The debugger needs to know what predicates
|
|
% are defined externally, so that it knows not to expect events for those
|
|
% predicates.
|
|
|
|
:- pragma external_pred(unify/2).
|
|
:- pragma external_pred(compare/3).
|
|
:- pragma external_pred(compare_representation/3).
|
|
|
|
:- pragma foreign_export_enum("C#", comparison_result/0, [],
|
|
[
|
|
(=) - "COMPARE_EQUAL",
|
|
(<) - "COMPARE_LESS",
|
|
(>) - "COMPARE_GREATER"
|
|
]).
|
|
|
|
:- pragma foreign_export_enum("Java", comparison_result/0, [],
|
|
[
|
|
(=) - "COMPARE_EQUAL",
|
|
(<) - "COMPARE_LESS",
|
|
(>) - "COMPARE_GREATER"
|
|
]).
|
|
|
|
:- pragma foreign_code("C#", "
|
|
public static readonly object[] comparison_result_object = new object[] {
|
|
(Comparison_result_0) 0,
|
|
(Comparison_result_0) 1,
|
|
(Comparison_result_0) 2
|
|
};
|
|
").
|
|
|
|
ordering(X, Y) = R :-
|
|
compare(R, X, Y).
|
|
|
|
% simplify_goal_call.m automatically inlines these definitions.
|
|
|
|
X @< Y :-
|
|
compare((<), X, Y).
|
|
|
|
X @=< Y :-
|
|
not compare((>), X, Y).
|
|
|
|
X @> Y :-
|
|
compare((>), X, Y).
|
|
|
|
X @>= Y :-
|
|
not compare((<), X, Y).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Unify/compare of tuples.
|
|
%
|
|
|
|
% We implement these predicates in Mercury mainly to allow the compiler
|
|
% to perform the deep profiling transformation on them. init_runtime_hooks
|
|
% sets fields in MR_special_pred_hooks structure to point to the actual
|
|
% implementations, because we do not want the runtime to have unresolved
|
|
% references into the library when it is built.
|
|
|
|
:- pragma foreign_decl("C", "#include ""mercury_ho_call.h""").
|
|
|
|
:- pred unify_tuple(T::in, T::in) is semidet.
|
|
|
|
:- pragma foreign_export("C", unify_tuple(in, in), "ML_unify_tuple").
|
|
|
|
unify_tuple(TermA, TermB) :-
|
|
tuple_arity(TermA, Arity),
|
|
unify_tuple_pos(TermA, TermB, 0, Arity).
|
|
|
|
:- pred unify_tuple_pos(T::in, T::in, int::in, int::in) is semidet.
|
|
|
|
unify_tuple_pos(TermA, TermB, Index, Arity) :-
|
|
( if Index >= Arity then
|
|
true
|
|
else
|
|
tuple_arg(TermA, Index, SubTermA),
|
|
tuple_arg(TermB, Index, SubTermB),
|
|
private_builtin.unsafe_type_cast(SubTermB, CastSubTermB),
|
|
( if builtin.unify(SubTermA, CastSubTermB) then
|
|
unify_tuple_pos(TermA, TermB, Index + 1, Arity)
|
|
else
|
|
fail
|
|
)
|
|
).
|
|
|
|
:- pred compare_tuple(comparison_result::uo, T::in, T::in) is det.
|
|
|
|
:- pragma foreign_export("C", compare_tuple(uo, in, in), "ML_compare_tuple").
|
|
|
|
compare_tuple(Result, TermA, TermB) :-
|
|
tuple_arity(TermA, Arity),
|
|
compare_tuple_pos(Result, TermA, TermB, 0, Arity).
|
|
|
|
:- pred compare_tuple_pos(comparison_result::uo, T::in, T::in,
|
|
int::in, int::in) is det.
|
|
|
|
compare_tuple_pos(Result, TermA, TermB, Index, Arity) :-
|
|
( if Index >= Arity then
|
|
Result = (=)
|
|
else
|
|
tuple_arg(TermA, Index, SubTermA),
|
|
tuple_arg(TermB, Index, SubTermB),
|
|
private_builtin.unsafe_type_cast(SubTermB, CastSubTermB),
|
|
builtin.compare(SubResult, SubTermA, CastSubTermB),
|
|
(
|
|
SubResult = (=),
|
|
compare_tuple_pos(Result, TermA, TermB, Index + 1, Arity)
|
|
;
|
|
( SubResult = (<)
|
|
; SubResult = (>)
|
|
),
|
|
Result = SubResult
|
|
)
|
|
).
|
|
|
|
:- pred compare_rep_tuple(comparison_result::uo, T::in, T::in) is cc_multi.
|
|
|
|
:- pragma foreign_export("C", compare_rep_tuple(uo, in, in),
|
|
"ML_compare_rep_tuple").
|
|
|
|
compare_rep_tuple(Result, TermA, TermB) :-
|
|
tuple_arity(TermA, Arity),
|
|
compare_rep_tuple_pos(Result, TermA, TermB, 0, Arity).
|
|
|
|
:- pred compare_rep_tuple_pos(comparison_result::uo, T::in, T::in,
|
|
int::in, int::in) is cc_multi.
|
|
|
|
compare_rep_tuple_pos(Result, TermA, TermB, Index, Arity) :-
|
|
( if Index >= Arity then
|
|
Result = (=)
|
|
else
|
|
tuple_arg(TermA, Index, SubTermA),
|
|
tuple_arg(TermB, Index, SubTermB),
|
|
private_builtin.unsafe_type_cast(SubTermB, CastSubTermB),
|
|
builtin.compare_representation(SubResult, SubTermA, CastSubTermB),
|
|
(
|
|
SubResult = (=),
|
|
compare_rep_tuple_pos(Result, TermA, TermB, Index + 1, Arity)
|
|
;
|
|
( SubResult = (<)
|
|
; SubResult = (>)
|
|
),
|
|
Result = SubResult
|
|
)
|
|
).
|
|
|
|
:- pred tuple_arity(T::in, int::out) is det.
|
|
:- pragma no_determinism_warning(pred(tuple_arity/2)).
|
|
|
|
:- pragma foreign_proc("C",
|
|
tuple_arity(_Term::in, Arity::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
Arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY((MR_TypeInfo) TypeInfo_for_T);
|
|
").
|
|
|
|
tuple_arity(_, _) :-
|
|
private_builtin.sorry("tuple_arity/2").
|
|
|
|
:- some [ArgT] pred tuple_arg(T::in, int::in, ArgT::out) is det.
|
|
:- pragma no_determinism_warning(pred(tuple_arg/3)).
|
|
|
|
:- pragma foreign_proc("C",
|
|
tuple_arg(Term::in, Index::in, Arg::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
MR_TypeInfo type_info = (MR_TypeInfo) TypeInfo_for_T;
|
|
MR_Word *arg_vector = (MR_Word *) Term;
|
|
|
|
TypeInfo_for_ArgT =
|
|
(MR_Word) MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info)[1 + Index];
|
|
Arg = arg_vector[Index];
|
|
").
|
|
|
|
tuple_arg(_, _, -1) :-
|
|
private_builtin.sorry("tuple_arg/3").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pragma foreign_code("C#", "
|
|
//
|
|
// Generic unification/comparison routines.
|
|
//
|
|
|
|
public static bool
|
|
unify_2_p_0(runtime.TypeInfo_Struct ti,
|
|
object x, object y)
|
|
{
|
|
return rtti_implementation.generic_unify_2_p_0(ti, x, y);
|
|
}
|
|
|
|
public static Comparison_result_0
|
|
compare_3_p_0(runtime.TypeInfo_Struct ti,
|
|
object x, object y)
|
|
{
|
|
return rtti_implementation.generic_compare_3_p_0(ti, x, y);
|
|
}
|
|
|
|
public static Comparison_result_0
|
|
compare_3_p_1(runtime.TypeInfo_Struct ti,
|
|
object x, object y)
|
|
{
|
|
return compare_3_p_0(ti, x, y);
|
|
}
|
|
|
|
public static Comparison_result_0
|
|
compare_3_p_2(runtime.TypeInfo_Struct ti,
|
|
object x, object y)
|
|
{
|
|
return compare_3_p_0(ti, x, y);
|
|
}
|
|
|
|
public static Comparison_result_0
|
|
compare_3_p_3(runtime.TypeInfo_Struct ti,
|
|
object x, object y)
|
|
{
|
|
return compare_3_p_0(ti, x, y);
|
|
}
|
|
|
|
public static Comparison_result_0
|
|
compare_representation_3_p_0(runtime.TypeInfo_Struct ti,
|
|
object x, object y)
|
|
{
|
|
// stub only
|
|
runtime.Errors.SORRY(
|
|
""compare_representation_3_p_0/3 not implemented"");
|
|
return Comparison_result_0.f_equal;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_code("C#", "
|
|
public static object deep_copy(object o)
|
|
{
|
|
if (o == null) {
|
|
return null;
|
|
}
|
|
|
|
System.Type t = o.GetType();
|
|
System.Array arr;
|
|
|
|
if (t.IsValueType) {
|
|
return o;
|
|
} else if (t == typeof(string)) {
|
|
// XXX For some reason we need to handle strings specially.
|
|
// It is probably something to do with the fact that they
|
|
// are a builtin type.
|
|
string s;
|
|
s = (string) o;
|
|
return s;
|
|
} else if ((arr = o as System.Array) != null) {
|
|
return arr.Clone();
|
|
} else {
|
|
object n;
|
|
|
|
// This will do a bitwise shallow copy of the object.
|
|
n = t.InvokeMember(""MemberwiseClone"",
|
|
System.Reflection.BindingFlags.Instance |
|
|
System.Reflection.BindingFlags.NonPublic |
|
|
System.Reflection.BindingFlags.InvokeMethod,
|
|
null, o, new object[] {});
|
|
|
|
// Set each of the fields to point to a deep copy of the
|
|
// field.
|
|
deep_copy_fields(t.GetFields(
|
|
System.Reflection.BindingFlags.Public |
|
|
System.Reflection.BindingFlags.Instance),
|
|
n, o);
|
|
|
|
// XXX This requires that mercury.dll have
|
|
// System.Security.Permissions.ReflectionPermission
|
|
// so that the non-public fields are accessible.
|
|
deep_copy_fields(t.GetFields(
|
|
System.Reflection.BindingFlags.NonPublic |
|
|
System.Reflection.BindingFlags.Instance),
|
|
n, o);
|
|
|
|
return n;
|
|
}
|
|
}
|
|
|
|
public static void deep_copy_fields(System.Reflection.FieldInfo[] fields,
|
|
object dest, object src)
|
|
{
|
|
// XXX We don't handle init-only fields, but I can't think of a way.
|
|
foreach (System.Reflection.FieldInfo f in fields)
|
|
{
|
|
if (!f.IsNotSerialized) {
|
|
f.SetValue(dest, deep_copy(f.GetValue(src)));
|
|
}
|
|
}
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_code("C#", "
|
|
|
|
public static bool
|
|
__Unify____void_0_0(object x, object y)
|
|
{
|
|
runtime.Errors.fatal_error(""called unify for type `void'"");
|
|
return false;
|
|
}
|
|
|
|
public static bool
|
|
__Unify____c_pointer_0_0(object x, object y)
|
|
{
|
|
runtime.Errors.fatal_error(""called unify for type `c_pointer'"");
|
|
return false;
|
|
}
|
|
|
|
public static bool
|
|
__Unify____func_0_0(object[] x, object[] y)
|
|
{
|
|
runtime.Errors.fatal_error(""called unify for `func' type"");
|
|
return false;
|
|
}
|
|
|
|
public static bool
|
|
__Unify____tuple_0_0(object[] x, object[] y)
|
|
{
|
|
runtime.Errors.fatal_error(""called unify for `tuple' type"");
|
|
return false;
|
|
}
|
|
|
|
public static Comparison_result_0
|
|
__Compare____void_0_0(object x, object y)
|
|
{
|
|
runtime.Errors.fatal_error(""called compare for type `void'"");
|
|
return Comparison_result_0.f_equal;
|
|
}
|
|
|
|
public static Comparison_result_0
|
|
__Compare____c_pointer_0_0(object x, object y)
|
|
{
|
|
runtime.Errors.fatal_error(
|
|
""called compare/3 for type `c_pointer'"");
|
|
return Comparison_result_0.f_equal;
|
|
}
|
|
|
|
public static Comparison_result_0
|
|
__Compare____func_0_0(object x, object y)
|
|
{
|
|
runtime.Errors.fatal_error(""called compare for `func' type"");
|
|
return Comparison_result_0.f_equal;
|
|
}
|
|
|
|
public static Comparison_result_0
|
|
__Compare____tuple_0_0(object x, object y)
|
|
{
|
|
runtime.Errors.fatal_error(""called compare for `tuple' type"");
|
|
return Comparison_result_0.f_equal;
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_code("Java",
|
|
"
|
|
// Two other approaches to implement deep copy might be:
|
|
//
|
|
// 1. Get all mercury objects to implement the Serializable interface.
|
|
// Then this whole function could be replaced with code that writes
|
|
// the Object out via an ObjectOutputStream into a byte array (or
|
|
// something), then reads it back in again, thus creating a copy.
|
|
// This would copy non-Mercury objects as well, though.
|
|
//
|
|
// 2. Get all mercury objects to implement a clone() method (either the
|
|
// one in Object or our own). The MLDS doesn't have method calls
|
|
// and probably we wouldn't want to clutter it up just for this.
|
|
|
|
public static <T> T
|
|
deep_copy(final T original) throws
|
|
java.lang.InstantiationException, java.lang.IllegalAccessException
|
|
{
|
|
if (original == null) {
|
|
return null;
|
|
}
|
|
|
|
final java.lang.Class<T> cls =
|
|
(java.lang.Class<T>) original.getClass();
|
|
|
|
if (cls.isArray()) {
|
|
int length = java.lang.reflect.Array.getLength(original);
|
|
T clone = (T) java.lang.reflect.Array.newInstance(
|
|
cls.getComponentType(), length);
|
|
for (int i = 0; i < length; i++) {
|
|
java.lang.Object X = java.lang.reflect.Array.get(original, i);
|
|
java.lang.Object Y = deep_copy(X);
|
|
java.lang.reflect.Array.set(clone, i, Y);
|
|
}
|
|
return clone;
|
|
}
|
|
|
|
// We will only copy objects of Mercury-defined types.
|
|
// We could copy more, but that is what we do for C backends,
|
|
// and it is enough. We don't copy enumeration instances.
|
|
if (!(original instanceof jmercury.runtime.MercuryType)) {
|
|
return original;
|
|
}
|
|
if (original instanceof jmercury.runtime.MercuryEnum) {
|
|
return original;
|
|
}
|
|
|
|
// Make a new instance of the class and fill in the fields.
|
|
// This requires the class have a default constructor.
|
|
// (alternatively, we could use the Objenesis library).
|
|
T clone = cls.newInstance();
|
|
java.lang.Class<?> c = cls;
|
|
while (c != Object.class && c != null) {
|
|
for (java.lang.reflect.Field field : c.getDeclaredFields()) {
|
|
java.lang.Object X = field.get(original);
|
|
java.lang.Object Y = deep_copy(X);
|
|
field.set(clone, Y);
|
|
}
|
|
c = c.getSuperclass();
|
|
}
|
|
return clone;
|
|
}
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% unsafe_promise_unique is a compiler builtin.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
copy(Value::ui, Copy::uo),
|
|
[will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail,
|
|
does_not_affect_liveness],
|
|
"
|
|
MR_save_transient_registers();
|
|
Copy = MR_deep_copy(Value, (MR_TypeInfo) TypeInfo_for_T, NULL, NULL);
|
|
MR_restore_transient_registers();
|
|
").
|
|
|
|
:- pragma foreign_proc("C",
|
|
copy(Value::in, Copy::uo),
|
|
[will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail,
|
|
does_not_affect_liveness],
|
|
"
|
|
MR_save_transient_registers();
|
|
Copy = MR_deep_copy(Value, (MR_TypeInfo) TypeInfo_for_T, NULL, NULL);
|
|
MR_restore_transient_registers();
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
copy(X::ui, Y::uo),
|
|
[may_call_mercury, thread_safe, promise_pure, terminates],
|
|
"
|
|
Y = builtin.deep_copy(X);
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
copy(X::in, Y::uo),
|
|
[may_call_mercury, thread_safe, promise_pure, terminates],
|
|
"
|
|
Y = builtin.deep_copy(X);
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
copy(X::ui, Y::uo),
|
|
[may_call_mercury, thread_safe, promise_pure, terminates],
|
|
"
|
|
try {
|
|
Y = builtin.deep_copy(X);
|
|
} catch (java.lang.InstantiationException E) {
|
|
throw new RuntimeException(E);
|
|
} catch (java.lang.IllegalAccessException E) {
|
|
throw new RuntimeException(E);
|
|
}
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
copy(X::in, Y::uo),
|
|
[may_call_mercury, thread_safe, promise_pure, terminates],
|
|
"
|
|
try {
|
|
Y = builtin.deep_copy(X);
|
|
} catch (java.lang.InstantiationException E) {
|
|
throw new RuntimeException(E);
|
|
} catch (java.lang.IllegalAccessException E) {
|
|
throw new RuntimeException(E);
|
|
}
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% We need a definition of the Mercury type void/0 because we can generate
|
|
% references to it in code. See tests/hard_coded/nullary_ho_func.m for an
|
|
% example of code which does.
|
|
:- pragma foreign_code("C#", "
|
|
[System.Serializable]
|
|
public class Void_0
|
|
{
|
|
// Make the constructor private to ensure that we can
|
|
// never create an instance of this class.
|
|
private Void_0()
|
|
{
|
|
}
|
|
}
|
|
").
|
|
:- pragma foreign_code("Java", "
|
|
public static class Void_0 implements java.io.Serializable
|
|
{
|
|
// Make the constructor private to ensure that we can
|
|
// never create an instance of this class.
|
|
private Void_0()
|
|
{
|
|
}
|
|
}
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pragma foreign_code("Java", "
|
|
//
|
|
// Definitions of builtin types.
|
|
//
|
|
|
|
public static class Tuple_0
|
|
{
|
|
// stub only
|
|
}
|
|
|
|
public static class Func_0
|
|
{
|
|
// stub only
|
|
}
|
|
|
|
public static class C_pointer_0
|
|
{
|
|
// stub only
|
|
}
|
|
|
|
//
|
|
// Generic unification/comparison routines.
|
|
//
|
|
|
|
public static boolean
|
|
unify_2_p_0 (jmercury.runtime.TypeInfo_Struct ti,
|
|
java.lang.Object x, java.lang.Object y)
|
|
{
|
|
return jmercury.rtti_implementation.generic_unify_2_p_0(ti, x, y);
|
|
}
|
|
|
|
public static Comparison_result_0
|
|
compare_3_p_0 (jmercury.runtime.TypeInfo_Struct ti,
|
|
java.lang.Object x, java.lang.Object y)
|
|
{
|
|
return jmercury.rtti_implementation.generic_compare_3_p_0(ti, x, y);
|
|
}
|
|
|
|
public static Comparison_result_0
|
|
compare_3_p_1 (jmercury.runtime.TypeInfo_Struct ti,
|
|
java.lang.Object x, java.lang.Object y)
|
|
{
|
|
return compare_3_p_0(ti, x, y);
|
|
}
|
|
|
|
public static Comparison_result_0
|
|
compare_3_p_2 (jmercury.runtime.TypeInfo_Struct ti,
|
|
java.lang.Object x, java.lang.Object y)
|
|
{
|
|
return compare_3_p_0(ti, x, y);
|
|
}
|
|
|
|
public static Comparison_result_0
|
|
compare_3_p_3 (jmercury.runtime.TypeInfo_Struct ti,
|
|
java.lang.Object x, java.lang.Object y)
|
|
{
|
|
return compare_3_p_0(ti, x, y);
|
|
}
|
|
|
|
public static Comparison_result_0
|
|
compare_representation_3_p_0 (jmercury.runtime.TypeInfo_Struct ti,
|
|
java.lang.Object x, java.lang.Object y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error (
|
|
""compare_representation_3_p_0/3 not implemented"");
|
|
}
|
|
|
|
//
|
|
// Type-specific unification routines for builtin types.
|
|
//
|
|
|
|
public static boolean
|
|
__Unify____tuple_0_0(java.lang.Object[] x, java.lang.Object[] y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error (
|
|
""unify/2 for tuple types not implemented"");
|
|
}
|
|
|
|
public static boolean
|
|
__Unify____func_0_0(java.lang.Object[] x, java.lang.Object[] y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error (
|
|
""unify/2 for func types not implemented"");
|
|
}
|
|
|
|
public static boolean
|
|
__Unify____c_pointer_0_0(java.lang.Object x, java.lang.Object y)
|
|
{
|
|
// XXX should we try calling a Java comparison routine?
|
|
throw new java.lang.Error (""unify/2 called for c_pointer type"");
|
|
}
|
|
|
|
public static boolean
|
|
__Unify____void_0_0(builtin.Void_0 x, builtin.Void_0 y)
|
|
{
|
|
// there should never be any values of type void/0
|
|
throw new java.lang.Error (""unify/2 called for void type"");
|
|
}
|
|
|
|
//
|
|
// Type-specific comparison routines for builtin types.
|
|
//
|
|
|
|
public static Comparison_result_0
|
|
__Compare____tuple_0_0(java.lang.Object[] x, java.lang.Object[] y)
|
|
{
|
|
// stub only
|
|
throw new java.lang.Error
|
|
(""compare/3 for tuple types not implemented"");
|
|
}
|
|
|
|
public static Comparison_result_0
|
|
__Compare____func_0_0(java.lang.Object[] x, java.lang.Object[] y)
|
|
{
|
|
// comparing values of higher-order types is a run-time error
|
|
throw new java.lang.Error (""compare/3 called for func type"");
|
|
}
|
|
|
|
public static Comparison_result_0
|
|
__Compare____c_pointer_0_0(java.lang.Object x, java.lang.Object y)
|
|
{
|
|
// XXX should we try calling a Java comparison routine?
|
|
throw new java.lang.Error
|
|
(""compare/3 called for c_pointer type"");
|
|
}
|
|
|
|
public static Comparison_result_0
|
|
__Compare____void_0_0(builtin.Void_0 x, builtin.Void_0 y)
|
|
{
|
|
// there should never be any values of type void/0
|
|
throw new java.lang.Error (""compare/3 called for void type"");
|
|
}
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% semidet_succeed and semidet_fail
|
|
%
|
|
|
|
% semidet_succeed and semidet_fail are implemented using the foreign language
|
|
% interface to make sure that the compiler doesn't issue any determinism
|
|
% warnings for them.
|
|
|
|
% We can't just use "true" and "fail" in the Mercury versions, because that
|
|
% provokes warnings from determinism analysis, and the library is compiled
|
|
% with --halt-at-warn. So instead we use 0+0 = (or \=) 0.
|
|
% This is guaranteed to succeed or fail (respectively),
|
|
% and with a bit of luck will even get optimized by constant propagation.
|
|
% But this optimization won't happen until after determinism analysis,
|
|
% which doesn't know anything about integer arithmetic,
|
|
% so this code won't provide a warning from determinism analysis.
|
|
%
|
|
% XXX Actually, the above is long out-of-date. We have been able to define
|
|
% semidet_succeed as true, and semidet_fail as fail, since we added
|
|
% no_determinism_warning pragmas to the language. However, if we *do*
|
|
% define them that way, one of the test cases, general/test_parsing_utils,
|
|
% fails, with the symptom being several differences that replace output
|
|
% from the parser such as "expecting an operator" and "unterminated comment"
|
|
% with just "syntax error", which seems to implicate the call to semidet_fail
|
|
% in the implementation of the fail_with_message predicate as the cause,
|
|
% since both of those strings are passed to fail_with_message.
|
|
% However, there is no point in tracking down the precise cause,
|
|
% since the potential gain is so minuscule.
|
|
|
|
:- pragma foreign_proc("C",
|
|
semidet_succeed,
|
|
[will_not_call_mercury, thread_safe, promise_pure,
|
|
does_not_affect_liveness],
|
|
"
|
|
SUCCESS_INDICATOR = MR_TRUE;
|
|
").
|
|
:- pragma foreign_proc("C#",
|
|
semidet_succeed,
|
|
[will_not_call_mercury, thread_safe, promise_pure],
|
|
"
|
|
SUCCESS_INDICATOR = true;
|
|
").
|
|
|
|
semidet_succeed :-
|
|
0 + 0 = 0.
|
|
|
|
:- pragma foreign_proc("C",
|
|
semidet_fail,
|
|
[will_not_call_mercury, thread_safe, promise_pure,
|
|
does_not_affect_liveness],
|
|
"
|
|
SUCCESS_INDICATOR = MR_FALSE;
|
|
").
|
|
:- pragma foreign_proc("C#",
|
|
semidet_fail,
|
|
[will_not_call_mercury, thread_safe, promise_pure],
|
|
"
|
|
SUCCESS_INDICATOR = false;
|
|
").
|
|
|
|
semidet_fail :-
|
|
0 + 0 \= 0.
|
|
|
|
semidet_true :-
|
|
semidet_succeed.
|
|
|
|
semidet_false :-
|
|
semidet_fail.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% cc_multi_equal
|
|
%
|
|
|
|
% NOTE: cc_multi_equal/2 is handled specially in browser/declarative_tree.m.
|
|
% Any changes here may need to be reflected there.
|
|
|
|
:- pragma promise_equivalent_clauses(pred(cc_multi_equal/2)).
|
|
|
|
:- pragma foreign_proc("C",
|
|
cc_multi_equal(X::in, Y::out),
|
|
[will_not_call_mercury, thread_safe, promise_pure,
|
|
does_not_affect_liveness],
|
|
"
|
|
Y = X;
|
|
").
|
|
:- pragma foreign_proc("C",
|
|
cc_multi_equal(X::di, Y::uo),
|
|
[will_not_call_mercury, thread_safe, promise_pure,
|
|
does_not_affect_liveness],
|
|
"
|
|
Y = X;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
cc_multi_equal(X::in, Y::out),
|
|
[will_not_call_mercury, thread_safe, promise_pure],
|
|
"
|
|
Y = X;
|
|
").
|
|
:- pragma foreign_proc("C#",
|
|
cc_multi_equal(X::di, Y::uo),
|
|
[will_not_call_mercury, thread_safe, promise_pure],
|
|
"
|
|
Y = X;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
cc_multi_equal(X::in, Y::out),
|
|
[will_not_call_mercury, thread_safe, promise_pure],
|
|
"
|
|
Y = X;
|
|
").
|
|
:- pragma foreign_proc("Java",
|
|
cc_multi_equal(X::di, Y::uo),
|
|
[will_not_call_mercury, thread_safe, promise_pure],
|
|
"
|
|
Y = X;
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
impure_true :-
|
|
impure private_builtin.imp.
|
|
|
|
semipure_true :-
|
|
semipure private_builtin.semip.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% NOTE: dynamic_cast/2 is handled specially in compiler/const_prop.m.
|
|
% Any changes here may need to be reflected there.
|
|
|
|
dynamic_cast(X, Y) :-
|
|
private_builtin.typed_unify(X, Y).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
unsafe_cast_any_to_ground(X::ia) = (Y::out),
|
|
[promise_pure, will_not_call_mercury, thread_safe, will_not_modify_trail],
|
|
"
|
|
Y = X;
|
|
").
|
|
|
|
:- pragma foreign_proc("C#",
|
|
unsafe_cast_any_to_ground(X::ia) = (Y::out),
|
|
[promise_pure, will_not_call_mercury, thread_safe, will_not_modify_trail],
|
|
"
|
|
Y = X;
|
|
").
|
|
|
|
:- pragma foreign_proc("Java",
|
|
unsafe_cast_any_to_ground(X::ia) = (Y::out),
|
|
[promise_pure, will_not_call_mercury, thread_safe, will_not_modify_trail],
|
|
"
|
|
Y = X;
|
|
").
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
init_runtime_hooks,
|
|
[will_not_call_mercury, thread_safe, may_not_duplicate],
|
|
"
|
|
#ifdef MR_HIGHLEVEL_CODE
|
|
MR_special_pred_hooks.MR_unify_tuple_pred = ML_unify_tuple;
|
|
MR_special_pred_hooks.MR_compare_tuple_pred = ML_compare_tuple;
|
|
MR_special_pred_hooks.MR_compare_rep_tuple_pred = ML_compare_rep_tuple;
|
|
#else
|
|
MR_special_pred_hooks.MR_unify_tuple_pred =
|
|
MR_ENTRY(mercury__builtin__unify_tuple_2_0);
|
|
MR_special_pred_hooks.MR_compare_tuple_pred =
|
|
MR_ENTRY(mercury__builtin__compare_tuple_3_0);
|
|
MR_special_pred_hooks.MR_compare_rep_tuple_pred =
|
|
MR_ENTRY(mercury__builtin__compare_rep_tuple_3_0);
|
|
#endif
|
|
").
|
|
|
|
init_runtime_hooks.
|
|
% We have no runtime hooks for Java or C#.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module builtin.
|
|
%---------------------------------------------------------------------------%
|