mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-16 18:03:36 +00:00
120 lines
2.5 KiB
Mathematica
120 lines
2.5 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ts=4 sw=4 et ft=mercury
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module stable_foreign.
|
|
|
|
:- interface.
|
|
|
|
:- import_module io.
|
|
|
|
:- pred main(io::di, io::uo) is cc_multi.
|
|
|
|
:- implementation.
|
|
|
|
main(!IO) :-
|
|
init(Base),
|
|
offset(Base, 10, First),
|
|
offset(Base, 42, Second),
|
|
offset(Base, 77, Third),
|
|
test(First, First, !IO),
|
|
test(First, Second, !IO),
|
|
test(First, Third, !IO),
|
|
test(Second, Second, !IO),
|
|
test(Second, First, !IO),
|
|
test(Second, Third, !IO),
|
|
test(Third, First, !IO),
|
|
test(Third, Second, !IO),
|
|
test(Third, Third, !IO).
|
|
|
|
:- pred test(ptr::in, ptr::in, io::di, io::uo) is cc_multi.
|
|
|
|
test(P1, P2, !IO) :-
|
|
rep(P1, V1),
|
|
rep(P2, V2),
|
|
|
|
io.write_int(V1, !IO),
|
|
( if unify(P1, P2) then
|
|
io.write_string(" u= ", !IO)
|
|
else
|
|
io.write_string(" u!= ", !IO)
|
|
),
|
|
io.write_int(V2, !IO),
|
|
io.write_string("\n", !IO),
|
|
|
|
compare(R, P1, P2),
|
|
io.write_int(V1, !IO),
|
|
(
|
|
R = (<),
|
|
io.write_string(" c< ", !IO)
|
|
;
|
|
R = (=),
|
|
io.write_string(" c= ", !IO)
|
|
;
|
|
R = (>),
|
|
io.write_string(" c> ", !IO)
|
|
),
|
|
io.write_int(V2, !IO),
|
|
io.write_string("\n", !IO),
|
|
|
|
compare_representation(RR, P1, P2),
|
|
io.write_int(V1, !IO),
|
|
(
|
|
RR = (<),
|
|
io.write_string(" r< ", !IO)
|
|
;
|
|
RR = (=),
|
|
io.write_string(" r= ", !IO)
|
|
;
|
|
RR = (>),
|
|
io.write_string(" r> ", !IO)
|
|
),
|
|
io.write_int(V2, !IO),
|
|
io.write_string("\n", !IO).
|
|
|
|
:- pragma foreign_decl(c, "
|
|
#define STABLE_FOREIGN_MAX 100
|
|
static int stable_foreign_array[STABLE_FOREIGN_MAX];
|
|
").
|
|
|
|
:- type ptr.
|
|
:- pragma foreign_type(c, ptr, "int *", [can_pass_as_mercury_type, stable]).
|
|
|
|
:- pred init(ptr::out) is det.
|
|
|
|
:- pragma foreign_proc(c,
|
|
init(Ptr::out),
|
|
[will_not_call_mercury, promise_pure],
|
|
"
|
|
int i;
|
|
|
|
for (i = 0; i < STABLE_FOREIGN_MAX ; i++) {
|
|
stable_foreign_array[i] = i/2;
|
|
}
|
|
|
|
Ptr = &stable_foreign_array[0];
|
|
").
|
|
|
|
:- pred offset(ptr::in, int::in, ptr::out) is det.
|
|
|
|
:- pragma foreign_proc(c,
|
|
offset(Base::in, N::in, Ptr::out),
|
|
[will_not_call_mercury, promise_pure],
|
|
"
|
|
/* Base */
|
|
if (0 <= N && N < STABLE_FOREIGN_MAX) {
|
|
Ptr = &stable_foreign_array[N];
|
|
} else {
|
|
MR_fatal_error(""bad offset"");
|
|
}
|
|
").
|
|
|
|
:- pred rep(ptr::in, int::out) is det.
|
|
|
|
:- pragma foreign_proc(c,
|
|
rep(Ptr::in, Val::out),
|
|
[will_not_call_mercury, promise_pure],
|
|
"
|
|
Val = *Ptr;
|
|
").
|