Skip to content
This repository
  • 4 commits
  • 4 files changed
  • 0 comments
  • 3 contributors
Aug 03, 2012
Jonathan Scott Duff perlpilot Add a way to name native routines
Sometimes the names used in a particular native library may not mesh
well with their usage in Perl. Rather than force our Perl subroutines to
have the same name as their native counterparts, we provide a way to
specify the name of the routine in the native library that our arbitrarily-
named Perl subroutine maps to.
eb3e3d8
Aug 07, 2012
Arne Skjærholt arnsholt Merge pull request #8 from perlpilot/master
Provide a way to use a different name in your Perl than the native library
4af0a9a
Arne Skjærholt arnsholt Clean up pull request. As discussed on #perl6.
Renames is named trait to is symbol, use defined-or instead of boolean-or when
checking return value of native_symbol (moritz++). Add basic test to make sure
it works.
bc26b5e
Aug 21, 2012
Moritz Lenz moritz add export tags 3228da6
18 README.markdown
Source Rendered
@@ -33,6 +33,24 @@ that you can do is just adding to this simple pattern of declaring a Perl 6
33 33 sub, naming it after the symbol you want to call and marking it with the "native"
34 34 trait.
35 35
  36 +## Changing names
  37 +Sometimes you want the name of your Perl subroutine to be different from the name
  38 +used in the library you're loading. Maybe the name is long or has different casing
  39 +or is otherwise cumbersome within the context of the module you are trying to
  40 +create.
  41 +
  42 +Zavolaj provides a "symbol" trait for you to specify the name of the native
  43 +routine in your library that may be different from your Perl subroutine name.
  44 +
  45 + module Foo;
  46 + use NativeCall;
  47 + our sub Init() is native('libfoo') is symbol('FOO_INIT') { * }
  48 +
  49 +Inside of "libfoo" there is a routine called "FOO\_INIT" but, since we're
  50 +creating a module called Foo and we'd rather call the routine as Foo::Init,
  51 +we use the "symbol" trait to specify the name of the symbol in "libfoo"
  52 +and call the subroutine whatever we want ("Init" in this case).
  53 +
36 54 ## Passing and Returning Values
37 55 Normal Perl 6 signatures and the "returns" trait are used in order to convey
38 56 the type of arguments a native function expects and what it returns. Here is
27 lib/NativeCall.pm6
@@ -97,6 +97,10 @@ multi sub map_return_type($type) {
97 97 $type
98 98 }
99 99
  100 +my role NativeCallSymbol[Str $name] {
  101 + method native_symbol() { $name }
  102 +}
  103 +
100 104 # This role is mixed in to any routine that is marked as being a
101 105 # native call.
102 106 my role Native[Routine $r, Str $libname] {
@@ -113,7 +117,7 @@ my role Native[Routine $r, Str $libname] {
113 117 "$libname$*VM<config><load_ext>";
114 118 nqp::buildnativecall(self,
115 119 nqp::unbox_s($realname), # library name
116   - nqp::unbox_s($r.name), # symbol to call
  120 + nqp::unbox_s(self.?native_symbol // $r.name), # symbol to call
117 121 nqp::unbox_s($conv), # calling convention
118 122 $arg_info,
119 123 return_hash_for($r.signature));
@@ -135,10 +139,10 @@ my role NativeCallEncoded[$name] {
135 139 }
136 140
137 141 # Expose an OpaquePointer class for working with raw pointers.
138   -my class OpaquePointer is export is repr('CPointer') { }
  142 +my class OpaquePointer is export(:types, :DEFAULT) is repr('CPointer') { }
139 143
140 144 # CArray class, used to represent C arrays.
141   -my class CArray is export is repr('CArray') {
  145 +my class CArray is export(:types, :DEFAULT) is repr('CArray') {
142 146 method at_pos(CArray:D: $pos) { die "CArray cannot be used without a type" }
143 147
144 148 my role IntTypedCArray[::TValue] does Positional[TValue] {
@@ -222,22 +226,26 @@ my class CArray is export is repr('CArray') {
222 226 }
223 227 }
224 228
  229 +multi trait_mod:<is>(Routine $r, :$symbol!) is export(:DEFAULT, :traits) {
  230 + $r does NativeCallSymbol[$symbol];
  231 +}
  232 +
225 233 # Specifies that the routine is actually a native call, into the
226 234 # current executable (platform specific) or into a named library
227   -multi trait_mod:<is>(Routine $r, :$native!) is export {
  235 +multi trait_mod:<is>(Routine $r, :$native!) is export(:DEFAULT, :traits) {
228 236 $r does Native[$r, $native === True ?? Str !! $native];
229 237 }
230 238
231 239 # Specifies the calling convention to use for a native call.
232   -multi trait_mod:<is>(Routine $r, :$nativeconv!) is export {
  240 +multi trait_mod:<is>(Routine $r, :$nativeconv!) is export(:DEFAULT, :traits) {
233 241 $r does NativeCallingConvention[$nativeconv];
234 242 }
235 243
236 244 # Ways to specify how to marshall strings.
237   -multi trait_mod:<is>(Parameter $p, :$encoded!) is export {
  245 +multi trait_mod:<is>(Parameter $p, :$encoded!) is export(:DEFAULT, :traits) {
238 246 $p does NativeCallEncoded[$encoded];
239 247 }
240   -multi trait_mod:<is>(Routine $p, :$encoded!) is export {
  248 +multi trait_mod:<is>(Routine $p, :$encoded!) is export(:DEFAULT, :traits) {
241 249 $p does NativeCallEncoded[$encoded];
242 250 }
243 251
@@ -256,12 +264,13 @@ role ExplicitlyManagedString {
256 264 has CStr $.cstr is rw;
257 265 }
258 266
259   -multi explicitly-manage(Str $x is rw, :$encoding = 'utf8') is export {
  267 +multi explicitly-manage(Str $x is rw, :$encoding = 'utf8') is export(:DEFAULT,
  268 +:utils) {
260 269 $x does ExplicitlyManagedString;
261 270 $x.cstr = pir::repr_box_str__PsP(nqp::unbox_s($x), CStr[$encoding]);
262 271 }
263 272
264   -multi refresh($obj) is export {
  273 +multi refresh($obj) is export(:DEFAULT, :utils) {
265 274 nqp::nativecallrefresh($obj);
266 275 1;
267 276 }
5 t/01-argless.c
@@ -11,3 +11,8 @@ DLLEXPORT void Argless()
11 11 printf("ok 1 - Called argless function\n");
12 12 fflush(stdout);
13 13 }
  14 +
  15 +DLLEXPORT void long_and_complicated_name()
  16 +{
  17 + printf("ok 3 - called long_and_complicated_name");
  18 +}
5 t/01-argless.t
@@ -2,13 +2,16 @@ use lib '.';
2 2 use t::CompileTestLib;
3 3 use NativeCall;
4 4
5   -say "1..2";
  5 +say "1..3";
6 6
7 7 compile_test_lib('01-argless');
8 8
9 9 sub Argless() is native('./01-argless') { * }
  10 +sub short() is native('./01-argless') is symbol('long_and_complicated_name') { *}
10 11
11 12 # This emits the "ok 1"
12 13 Argless();
13 14
14 15 say("ok 2 - survived the call");
  16 +
  17 +short();

No commit comments for this range

Something went wrong with that request. Please try again.