mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-16 18:03:36 +00:00
62db25b371
Add a new foreign type assertion `word_aligned_pointer' that asserts the
necessary conditions for the compiler to use the direct argument functor
representation on constructors of a single argument of that foreign type.
The conditions on the values of the foreign type are
- the values must fit in a single word
- the values must be clear in the tag bits ("word-aligned")
The first condition is the same as that asserted by
`can_pass_as_mercury_type' so we let `word_aligned_pointer' imply
`can_pass_as_mercury_type'.
compiler/prog_data.m:
Add `foreign_type_word_aligned_pointer' option.
Wrap list(foreign_type_assertions) in a new type to dissuade
direct checks for individual list members.
compiler/prog_io_pragma.m:
Parse `word_aligned_pointer' as a foreign type assertion.
compiler/hlds_data.m:
Add predicates for checking foreign type assertions. The
implication word_aligned_pointer => can_pass_as_mercury_type is
implemented in a single place.
compiler/make_tags.m:
Take `word_aligned_pointer' assertions into consideration when
deciding if a constructor can use the direct argument functor
representation.
Clarify the code.
compiler/foreign.m:
compiler/llds.m:
compiler/llds_out_instr.m:
compiler/ml_foreign_proc_gen.m:
compiler/parse_tree_out.m:
compiler/type_ctor_info.m:
Conform to changes.
doc/reference_manual.texi:
Add documentation.
tests/hard_coded/Mmakefile:
tests/hard_coded/word_aligned_pointer.exp:
tests/hard_coded/word_aligned_pointer.m:
tests/hard_coded/word_aligned_pointer_2.m:
Add test case.
NEWS:
Announce change.
86 lines
2.0 KiB
Mathematica
86 lines
2.0 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%x\\n"", 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),
|
|
format("yes(0x%x)\n", [i(get_foo(Foo))], !IO)
|
|
;
|
|
Bar = no,
|
|
write_string("no", !IO)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|