develooper Front page | perl.cvs.parrot | Postings from December 2008

[svn:parrot] r34713 - in trunk/languages/pipp/src: common pct

From:
bernhard
Date:
December 31, 2008 09:34
Subject:
[svn:parrot] r34713 - in trunk/languages/pipp/src: common pct
Message ID:
20081231173415.66A60CB9FA@x12.develooper.com
Author: bernhard
Date: Wed Dec 31 09:34:14 2008
New Revision: 34713

Modified:
   trunk/languages/pipp/src/common/guts.pir
   trunk/languages/pipp/src/pct/actions.pm

Log:
[Pipp] Add a call to !ADD_TO_WHENCE.


Modified: trunk/languages/pipp/src/common/guts.pir
==============================================================================
--- trunk/languages/pipp/src/common/guts.pir	(original)
+++ trunk/languages/pipp/src/common/guts.pir	Wed Dec 31 09:34:14 2008
@@ -110,6 +110,31 @@
     .return ()
 .end
 
+=item !ADD_TO_WHENCE
+
+Adds a key/value mapping to what will become the WHENCE on a proto-object (we
+don't have a proto-object to stick them on yet, so we put a property on the
+class temporarily, then attach it as the WHENCE clause later).
+
+=cut
+
+.sub '!ADD_TO_WHENCE'
+    .param pmc class
+    .param pmc attr_name
+    .param pmc value
+
+    # Get hash if we have it, if not make it.
+    .local pmc whence_hash
+    whence_hash = getprop '%!WHENCE', class
+    unless null whence_hash goto have_hash
+    whence_hash = new 'PhpArray'
+    setprop class, '%!WHENCE', whence_hash
+
+    # Make entry.
+  have_hash:
+    whence_hash[attr_name] = value
+.end
+
 
 =item !PROTOINIT
 

Modified: trunk/languages/pipp/src/pct/actions.pm
==============================================================================
--- trunk/languages/pipp/src/pct/actions.pm	(original)
+++ trunk/languages/pipp/src/pct/actions.pm	Wed Dec 31 09:34:14 2008
@@ -638,27 +638,6 @@
             )
         );
 
-        # It's a new class definition. Make proto-object.
-        $block.push(
-            PAST::Op.new(
-                :pasttype('call'),
-                :name('!PROTOINIT'),
-                PAST::Op.new(
-                    :pasttype('callmethod'),
-                    :name('register'),
-                    PAST::Var.new(
-                        :scope('package'),
-                        :name('$!P6META'),
-                        :namespace('PippObject')
-                    ),
-                    PAST::Var.new(
-                        :scope('register'),
-                        :name('def')
-                    )
-                )
-            )
-        );
-
         # nothing to do for $<const_definition,
         # setup of class constants is done in the 'loadinit' node
         for $<class_constant_definition> {
@@ -687,8 +666,47 @@
                     PAST::Val.new( :value($member_name) )
                 )
             );
+            $block.push(
+                PAST::Op.new(
+                    :pasttype('call'),
+                    :name('!ADD_TO_WHENCE'),
+                    PAST::Var.new(
+                        :name('def'),
+                        :scope('register'),
+                    ),
+                    PAST::Val.new(
+                        :value($member_name)
+                    ),
+                    $( $_<literal> )
+                )
+            );
         }
 
+        # It's a new class definition. Make proto-object.
+        $block.push(
+            PAST::Op.new(
+                :pasttype('call'),
+                :name('!PROTOINIT'),
+                PAST::Op.new(
+                    :pasttype('callmethod'),
+                    :name('register'),
+                    PAST::Var.new(
+                        :scope('package'),
+                        :name('$!P6META'),
+                        :namespace('PippObject')
+                    ),
+                    PAST::Var.new(
+                        :scope('register'),
+                        :name('def')
+                    ),
+                    PAST::Val.new(
+                        :value('PippObject'),
+                        :named( PAST::Val.new( :value('parent') ) )
+                    )
+                )
+            )
+        );
+
         # add the methods
         for $<class_method_definition> {
             $methods_block.push( $($_) );



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About