mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 01:13:30 +00:00
ffb357724f
tests/hard_coded/target_mlobjs_c.c:
Fix a bad use of printf.
tests/hard_coded/trace_goal_4.m:
tests/hard_coded/word_aligned_pointer.m:
tests/hard_coded/word_aligned_pointer_2.m:
tests/tabling/memo_non.m:
tests/tabling/table_foreign_output.m:
tests/tabling/test_enum.m:
Don't assume that MR_Integers are ints; print them using
MR_INTEGER_LENGTH_MODIFIER.
87 lines
2.1 KiB
Mathematica
87 lines
2.1 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ts=4 sw=4 et ft=mercury
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- module word_aligned_pointer_2.
|
|
:- interface.
|
|
|
|
:- import_module io.
|
|
|
|
% abstract exported foreign type with `word_aligned_pointer' assertion
|
|
:- type foo.
|
|
|
|
:- type bar
|
|
---> yes(foo) % direct argument functor
|
|
; no.
|
|
|
|
:- func make_foo = foo.
|
|
|
|
:- func get_foo(foo) = int.
|
|
|
|
:- func make_bar = bar.
|
|
|
|
:- pred write_bar(bar::in, io::di, io::uo) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module list.
|
|
:- import_module string.
|
|
|
|
:- type foo
|
|
---> foo(int).
|
|
|
|
:- pragma foreign_type("C", foo, "MR_Word", [word_aligned_pointer]).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pragma no_inline(make_foo/0).
|
|
|
|
:- pragma foreign_proc("C",
|
|
make_foo = (X::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
X = MR_mkbody(0xcafe);
|
|
").
|
|
|
|
make_foo = foo(0xcafe).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pragma foreign_proc("C",
|
|
get_foo(X::in) = (Int::out),
|
|
[will_not_call_mercury, promise_pure, thread_safe],
|
|
"
|
|
if (X != MR_strip_tag(X)) {
|
|
fprintf(stderr, ""tag bits not clear in value""
|
|
""0x%"" MR_INTEGER_LENGTH_MODIFIER ""x\\n"", (MR_Unsigned) X);
|
|
abort();
|
|
}
|
|
Int = MR_unmkbody(X);
|
|
").
|
|
|
|
get_foo(foo(I)) = I.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pragma no_inline(make_bar/0).
|
|
|
|
make_bar = yes(make_foo).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pragma no_inline(write_bar/3).
|
|
|
|
write_bar(Bar, !IO) :-
|
|
(
|
|
Bar = yes(Foo),
|
|
io.format("yes(0x%x)\n", [i(get_foo(Foo))], !IO)
|
|
;
|
|
Bar = no,
|
|
io.write_string("no", !IO)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|