Prepare for eliminating clone callback prop use.

Raku · Feb 9, 2013 · 978dc43 · 978dc43
1 parent afaf87d
commit 978dc43
Show file tree

Hide file tree

Showing 3 changed files with 28 additions and 1 deletion.
diff --git a/src/NQP/Actions.pm b/src/NQP/Actions.pm
@@ -123,6 +123,8 @@ class NQP::Actions is HLL::Actions {
             $unit
         );
 
+        $*W.cleanup();
+
         make $compunit;
     }
 

diff --git a/src/NQP/World.pm b/src/NQP/World.pm
@@ -23,12 +23,16 @@ class NQP::World is HLL::World {
     # Mapping of sub IDs to SC indexes of code stubs.
     has %!code_stub_sc_idx;
 
+    # Clear-up tasks.
+    has @!clearup_tasks; 
+
     method BUILD(*%opts) {
         @!BLOCKS := nqp::list();
         %!code_objects_to_fix_up := nqp::hash();
         %!code_object_types := nqp::hash();
         %!code_object_fixup_list := nqp::hash();
         %!code_stub_sc_idx := nqp::hash();
+        @!clearup_tasks := nqp::list();
 
         if nqp::defined(%*COMPILING<%?OPTIONS><dynext>) {
             my $dynext_path  := %*COMPILING<%?OPTIONS><dynext>;
@@ -256,6 +260,12 @@ class NQP::World is HLL::World {
             $compiled(|@args, |%named);
         };
 
+        # Create code object, if we'll need one.
+        my $code_obj;
+        if $have_code_type {
+            $code_obj := nqp::create($code_type);
+        }
+
         # See if we already have our compile-time dummy. If not, create it.
         my $fixups := QAST::Stmts.new();
         my $dummy;
@@ -319,7 +329,6 @@ class NQP::World is HLL::World {
         # code object.
         if $have_code_type {
             # Create it now.
-            my $code_obj := nqp::create($code_type);
             nqp::bindattr($code_obj, $code_type, '$!do', $dummy);
             nqp::bindattr($code_obj, $code_type, '$!dispatchees', nqp::list())
                 if $is_dispatcher;
@@ -500,6 +509,11 @@ class NQP::World is HLL::World {
         )));
     }
 
+    # Does cleanups.
+    method cleanup() {
+        for @!clearup_tasks { $_() }
+    }
+
     # Checks if the given name is known anywhere in the lexpad
     # and with lexical scope.
     method is_lexical($name) {

diff --git a/src/core/NQPRoutine.pm b/src/core/NQPRoutine.pm
@@ -4,6 +4,7 @@ my knowhow NQPRoutine {
     has $!dispatchees;
     has $!dispatch_cache;
     has $!dispatch_order;
+    has $!clone_callback;
 
     # Adds a multi-dispatch candidate.
     method add_dispatchee($code) {
@@ -35,6 +36,9 @@ my knowhow NQPRoutine {
         if nqp::defined($clone_callback) {
             $clone_callback($!do, $do, $der);
         }
+        unless nqp::isnull($!clone_callback) {
+            $!clone_callback($!do, $do, $der);
+        }
 
         $der
     }
@@ -334,6 +338,9 @@ my knowhow NQPRoutine {
         if nqp::defined($clone_callback) {
             $clone_callback($!do, $do, $der);
         }
+        unless nqp::isnull($!clone_callback) {
+            $!clone_callback($!do, $do, $der);
+        }
 
         $der
     }
@@ -367,6 +374,7 @@ my knowhow NQPRegex {
     has %!alt_nfas;
     has $!generic_nfa;
     has @!nested_codes;
+    has $!clone_callback;
     method SET_CAPS($caps) {
         $!caps := $caps;
     }
@@ -413,6 +421,9 @@ my knowhow NQPRegex {
         if nqp::defined($clone_callback) {
             $clone_callback($!do, $do, $der);
         }
+        unless nqp::isnull($!clone_callback) {
+            $!clone_callback($!do, $do, $der);
+        }
 
         $der
     }