First pass at eliminating setprop usage.

Gets rid of them all, but unfortunately breaks the build.
rakudo · Apr 23, 2013 · ab9a836 · ab9a836
1 parent 61e1e2a
commit ab9a836
Show file tree

Hide file tree

Showing 2 changed files with 23 additions and 37 deletions.
diff --git a/src/Perl6/Metamodel/BOOTSTRAP.nqp b/src/Perl6/Metamodel/BOOTSTRAP.nqp
@@ -501,19 +501,14 @@ BEGIN {
     Code.HOW.add_method(Code, 'clone', static(sub ($self) {
             my $dcself    := nqp::decont($self);
             my $cloned    := nqp::clone($dcself);
-            my $do_cloned := nqp::clone(nqp::getattr($dcself, Code, '$!do'));
+            my $do        := nqp::getattr($dcself, Code, '$!do');
+            my $do_cloned := nqp::clone($do);
             nqp::bindattr($cloned, Code, '$!do', $do_cloned);
             nqp::setcodeobj($do_cloned, $cloned);
-            Q:PIR {
-                $P0 = find_lex '$dcself'
-                $P1 = find_lex 'Code'
-                $P0 = getattribute $P0, $P1, '$!do'
-                $P1 = getprop 'CLONE_CALLBACK', $P0
-                if null $P1 goto no_callback
-                $P2 = find_lex '$cloned'
-                $P1($P0, $P2)
-              no_callback:
-            };
+            my $compstuff := nqp::getattr($dcself, Code, '$!compstuff');
+            unless nqp::isnull($compstuff) {
+                $compstuff[2]($do, $cloned);
+            }
             $cloned
         }));
     Code.HOW.add_method(Code, 'is_generic', static(sub ($self) {
@@ -562,19 +557,14 @@ BEGIN {
     Block.HOW.add_method(Block, 'clone', static(sub ($self) {
             my $dcself    := nqp::decont($self);
             my $cloned    := nqp::clone($dcself);
-            my $do_cloned := nqp::clone(nqp::getattr($dcself, Code, '$!do'));
+            my $do        := nqp::getattr($dcself, Code, '$!do');
+            my $do_cloned := nqp::clone($do);
             nqp::bindattr($cloned, Code, '$!do', $do_cloned);
             nqp::setcodeobj($do_cloned, $cloned);
-            Q:PIR {
-                $P0 = find_lex '$dcself'
-                $P1 = find_lex 'Code'
-                $P0 = getattribute $P0, $P1, '$!do'
-                $P1 = getprop 'CLONE_CALLBACK', $P0
-                if null $P1 goto no_callback
-                $P2 = find_lex '$cloned'
-                $P1($P0, $P2)
-              no_callback:
-            };
+            my $compstuff := nqp::getattr($dcself, Code, '$!compstuff');
+            unless nqp::isnull($compstuff) {
+                $compstuff[2]($do, $cloned);
+            }
             nqp::bindattr($cloned, Block, '$!state_vars', nqp::null());
             $cloned
         }));
@@ -1050,12 +1040,12 @@ BEGIN {
                             # Otherwise, may need full bind check.
                             elsif nqp::existskey(%info, 'bind_check') {
                                 my $sub := nqp::atkey(%info, 'sub');
-                                my $ctf := pir::getprop__PsP("COMPILER_THUNK",
-                                    nqp::getattr($sub, Code, '$!do'));
-                                unless nqp::isnull($ctf) {
+                                my $cs := nqp::getattr($sub, Code, '$!compstuff');
+                                unless nqp::isnull($cs) {
                                     # We need to do the tie-break on something not yet compiled.
                                     # Get it compiled.
-                                    $ctf();
+                                    my $ctf := $cs[1];
+                                    $ctf() if $ctf;
                                 }
 
                                 # Since we had to do a bindability check, this is not

diff --git a/src/Perl6/World.nqp b/src/Perl6/World.nqp
@@ -935,8 +935,7 @@ class Perl6::World is HLL::World {
             # Also compile the candidates if this is a proto.
             if $is_dispatcher {
                 for nqp::getattr($code, $routine_type, '$!dispatchees') {
-                    my $stub := nqp::getattr($_, $code_type, '$!do');
-                    my $past := pir::getprop__PsP('PAST_BLOCK', $stub);
+                    my $past := nqp::getattr($_, $code_type, '$!compstuff')[0];
                     if $past {
                         self.compile_in_context($past, $code_type, $slp_type);
                     }
@@ -949,7 +948,7 @@ class Perl6::World is HLL::World {
             }
             $precomp(|@pos, |%named);
         });
-        pir::setprop__vPsP($stub, 'COMPILER_THUNK', $compiler_thunk);
+        @compstuff[1] := $compiler_thunk;
         nqp::setcodename($stub, $code_past.name);
         nqp::bindattr($code, $code_type, '$!do', $stub);
 
@@ -962,15 +961,13 @@ class Perl6::World is HLL::World {
         # If we clone the stub, need to mark it as a dynamic compilation
         # boundary.
         if self.is_precompilation_mode() {
-            my $clone_handler := sub ($orig, $clone) {
+            @compstuff[2] := sub ($orig, $clone) {
                 my $do := nqp::getattr($clone, $code_type, '$!do');
                 nqp::markcodestub($do);
                 nqp::push(@!cleanup_tasks, sub () {
                     nqp::bindattr($clone, $code_type, '$!compstuff', nqp::null());
                 });
-                pir::setprop__0PsP($do, 'CLONE_CALLBACK', $clone_handler);
             };
-            pir::setprop__0PsP($stub, 'CLONE_CALLBACK', $clone_handler);
         }
 
         # Fixup will install the real thing, unless we're in a role, in
@@ -987,12 +984,11 @@ class Perl6::World is HLL::World {
 
                 # If we clone the stub, then we must remember to do a fixup
                 # of it also.
-                pir::setprop__0PsP($stub, 'CLONE_CALLBACK', sub ($orig, $clone) {
+                @compstuff[2] := sub ($orig, $clone) {
                     self.add_object($clone);
                     nqp::push(@!cleanup_tasks, sub () {
                         nqp::bindattr($clone, $code_type, '$!compstuff', nqp::null());
                     });
-
                     my $tmp := $fixups.unique('tmp_block_fixup');
                     $fixups.push(QAST::Stmt.new(
                         QAST::Op.new(
@@ -1007,15 +1003,15 @@ class Perl6::World is HLL::World {
                             QAST::Var.new( :name($tmp), :scope('local') ),
                             QAST::WVal.new( :value($clone) )
                         )));
-                });
+                };
 
                 # Also stash fixups so we can know not to do them if we
                 # do dynamic compilation.
                 %!code_object_fixup_list{$code_past.cuid} := $fixups;
             }
 
-			# Attach the QAST block to the stub.
-			pir::setprop__0PsP($stub, 'PAST_BLOCK', $code_past);
+            # Stash the QAST block in the comp stuff.
+            @compstuff[0] := $code_past;
         }
 
         # If this is a dispatcher, install dispatchee list that we can