implement trait 'is inlined' for attributes

This has only an effect for CUnions so far, but is easily extendable.
rakudo · Mar 24, 2015 · e8992fa · e8992fa
1 parent 6ce6405
commit e8992fa
Show file tree

Hide file tree

Showing 5 changed files with 21 additions and 8 deletions.
diff --git a/lib/NativeCall.pm b/lib/NativeCall.pm
@@ -400,6 +400,10 @@ multi trait_mod:<is>(Routine $p, :$encoded!) is export(:DEFAULT, :traits) {
     $p does NativeCallEncoded[$encoded];
 }
 
+multi trait_mod:<is>(Attribute $a, :$inlined!) is export(:DEFAULT, :traits) {
+    nqp::bindattr_i(nqp::decont($a), $a.WHAT, '$!inlined', 1);
+}
+
 role ExplicitlyManagedString {
     has $.cstr is rw;
 }

diff --git a/src/Perl6/Metamodel/BOOTSTRAP.nqp b/src/Perl6/Metamodel/BOOTSTRAP.nqp
@@ -21,10 +21,12 @@ my class BOOTSTRAPATTR {
     has $!type;
     has $!box_target;
     has $!package;
+    has $!inlined;
     method name() { $!name }
     method type() { $!type }
     method box_target() { $!box_target }
     method package() { $!package }
+    method inlined() { $!inlined }
     method has_accessor() { 0 }
     method has-accessor() { 0 }
     method positional_delegate() { 0 }
@@ -1082,20 +1084,22 @@ BEGIN {
     Attribute.HOW.add_attribute(Attribute, BOOTSTRAPATTR.new(:name<$!auto_viv_container>, :type(Mu), :package(Attribute)));
     Attribute.HOW.add_attribute(Attribute, BOOTSTRAPATTR.new(:name<$!build_closure>, :type(Mu), :package(Attribute)));
     Attribute.HOW.add_attribute(Attribute, BOOTSTRAPATTR.new(:name<$!package>, :type(Mu), :package(Attribute)));
+    Attribute.HOW.add_attribute(Attribute, BOOTSTRAPATTR.new(:name<$!inlined>, :type(int), :package(Attribute)));
     Attribute.HOW.add_attribute(Attribute, BOOTSTRAPATTR.new(:name<$!box_target>, :type(int), :package(Attribute)));
     Attribute.HOW.add_attribute(Attribute, BOOTSTRAPATTR.new(:name<$!positional_delegate>, :type(int), :package(Attribute)));
     Attribute.HOW.add_attribute(Attribute, BOOTSTRAPATTR.new(:name<$!associative_delegate>, :type(int), :package(Attribute)));
     Attribute.HOW.add_attribute(Attribute, BOOTSTRAPATTR.new(:name<$!why>, :type(Mu), :package(Attribute)));
 
     # Need new and accessor methods for Attribute in here for now.
     Attribute.HOW.add_method(Attribute, 'new',
-        nqp::getstaticcode(sub ($self, :$name!, :$type!, :$package!, :$has_accessor,
+        nqp::getstaticcode(sub ($self, :$name!, :$type!, :$package!, :$inlined = 0, :$has_accessor,
                 :$positional_delegate = 0, :$associative_delegate = 0, *%other) {
             my $attr := nqp::create($self);
             nqp::bindattr_s($attr, Attribute, '$!name', $name);
             nqp::bindattr($attr, Attribute, '$!type', nqp::decont($type));
             nqp::bindattr_i($attr, Attribute, '$!has_accessor', $has_accessor);
             nqp::bindattr($attr, Attribute, '$!package', $package);
+            nqp::bindattr_i($attr, Attribute, '$!inlined', $inlined);
             if nqp::existskey(%other, 'container_descriptor') {
                 nqp::bindattr($attr, Attribute, '$!container_descriptor', %other<container_descriptor>);
                 if nqp::existskey(%other, 'auto_viv_container') {

diff --git a/src/Perl6/Metamodel/REPRComposeProtocol.nqp b/src/Perl6/Metamodel/REPRComposeProtocol.nqp
@@ -46,6 +46,9 @@ role Perl6::Metamodel::REPRComposeProtocol {
                         if $attr.associative_delegate {
                             %attr_info<associative_delegate> := 1;
                         }
+                        if nqp::can($attr, 'inlined') {
+                            %attr_info<inlined> := $attr.inlined;
+                        }
                         nqp::push(@attrs, %attr_info);
                     }
 

diff --git a/src/core/Attribute.pm b/src/core/Attribute.pm
@@ -8,6 +8,7 @@ my class Attribute { # declared in BOOTSTRAP
     #     has Mu $!auto_viv_container;
     #     has Mu $!build_closure;
     #     has Mu $!package;
+    #     has int $!inlined;
     #     has int $!positional_delegate;
     #     has int $!associative_delegate;
     #     has Mu $!why;
@@ -110,6 +111,7 @@ my class Attribute { # declared in BOOTSTRAP
     method has-accessor() { ?$!has_accessor }
     method readonly() { !self.rw }
     method package() { $!package }
+    method inlined() { $!inlined }
     multi method Str(Attribute:D:) { self.name }
     multi method gist(Attribute:D:) { self.type.^name ~ " " ~ self.name }
 

diff --git a/t/04-nativecall/13-union.t b/t/04-nativecall/13-union.t
@@ -21,7 +21,7 @@ class MyStruct is repr('CStruct') {
     has long  $.long;
     has num64 $.num;
     has int8  $.byte;
-    has Onion $.onion;
+    has Onion $.onion is inlined;
     has num32 $.float;
 
     method init() {
@@ -71,11 +71,11 @@ SetCharMyStruct($cobj);
 is $cobj.onion.c, 1 +< 6,  'char in union';
 
 class MyStruct2 is repr('CStruct') {
-    has long           $.long;
-    has num64          $.num;
-    has int8           $.byte;
-    has Pointer[Onion] $.onion;
-    has num32          $.float;
+    has long  $.long;
+    has num64 $.num;
+    has int8  $.byte;
+    has Onion $.onion;
+    has num32 $.float;
 
     method init() {
         $!long = 42;
@@ -102,7 +102,7 @@ is_approx $cobj2.num,    4.2e0,  'getting num from C-created struct';
 is $cobj2.byte,          13,     'getting int8 from C-created struct';
 is_approx $cobj2.float, -6.28e0, 'getting num32 from C-created struct';
 
-my $onion = $cobj2.onion.deref;
+my $onion = $cobj2.onion;
 
 SetLongMyUnion($onion);
 is $onion.l, 1 +< 30, 'long in union*';