From ea1760c428463dfa07ab97f0db3b08dc3388807d Mon Sep 17 00:00:00 2001
From: Jonathan Worthington <jnthn@jnthn.net>
Date: Wed, 21 Apr 2010 01:55:23 +0200
Subject: [PATCH] Get anonymous classes (mostly) working. Passes all the
 anonymous class tests apart from those that depend on Numeric and Stringy.
 Also we can remove some hacky stuff I put in earlier.

---
 src/Perl6/Compiler/Package.pm           | 13 +++++++++++--
 src/cheats/parrot/P6role.pir            |  9 ++++++---
 src/metamodel/ClassHOW.pir              | 23 +++++++++++------------
 src/metamodel/RoleToInstanceApplier.nqp |  3 ++-
 4 files changed, 30 insertions(+), 18 deletions(-)

diff --git a/src/Perl6/Compiler/Package.pm b/src/Perl6/Compiler/Package.pm
index f78f652972c..537fceb74f2 100644
--- a/src/Perl6/Compiler/Package.pm
+++ b/src/Perl6/Compiler/Package.pm
@@ -94,10 +94,15 @@ method name_adverbs() {
 }
 
 # This method drives the code generation and fixes up the block.
-# XXX Need to support lexical and anonymous.
 method finish($block) {
     my $decl := PAST::Stmts.new();
 
+    # Emit code to install the current scope as $*SCOPE.
+    $decl.push(PAST::Op.new( :pasttype('bind'),
+        PAST::Var.new( :scope('lexical'), :name('$*SCOPE'), :isdecl(1) ),
+        ~$!scope || 'our'
+    ));
+
     # Create or look up meta-class.
     my $how := $!how;
     my @how := Perl6::Grammar::parse_name(~$how);
@@ -191,7 +196,11 @@ method finish($block) {
     $decl.push(PAST::Op.new( :pasttype('callmethod'), :name('compose'), $meta_reg, $obj_reg ));
 
     # Check scope and put decls in the right place.
-    if $!scope eq 'our' || $!scope eq 'augment' {
+    if $!scope eq 'anon' || $!name eq '' {
+        $block.blocktype('immediate');
+        $block.push($decl);
+    }
+    elsif $!scope eq 'our' || $!scope eq 'augment' {
         my $init_decl_name := $block.unique('!class_init_');
         my @ns := Perl6::Grammar::parse_name($name);
         $block.push(PAST::Block.new( :name($init_decl_name), :blocktype('declaration'), $decl ));
diff --git a/src/cheats/parrot/P6role.pir b/src/cheats/parrot/P6role.pir
index d354e919685..ef584adb322 100644
--- a/src/cheats/parrot/P6role.pir
+++ b/src/cheats/parrot/P6role.pir
@@ -25,13 +25,16 @@ Puns the role to a class and returns that class.
     .return (pun)
   make_pun:
 
-    # Otherwise, need to create a punned class.
+    # Otherwise, need to create a punned class; set a $*SCOPE that is not
+    # 'our' just to ensure that we don't try and associate with a Parrot
+    # namespace.
+    $P0 = box 'anon'
+    .lex '$*SCOPE', $P0
     .local pmc ClassHOW, temp, meta, proto
     ClassHOW = get_root_global ['perl6'], 'ClassHOW'
-    null $P0
     $P1 = getprop '$!owner', self
     $P1 = getattribute $P1, '$!shortname'
-    temp = ClassHOW.'new'($P0, 'name'=>$P1)
+    temp = ClassHOW.'new'($P1)
     meta = temp.'HOW'()
     meta.'add_composable'(temp, self)
     proto = meta.'compose'(temp)
diff --git a/src/metamodel/ClassHOW.pir b/src/metamodel/ClassHOW.pir
index 4b4e102a546..8a04efa65e2 100644
--- a/src/metamodel/ClassHOW.pir
+++ b/src/metamodel/ClassHOW.pir
@@ -91,21 +91,23 @@ Creates a new instance of the meta-class and returns it in an associated
 =cut
 
 .sub 'new' :method
-    .param pmc name :optional
+    .param pmc name
     .param pmc options :named :slurpy
     .local pmc how, parrotclass, nsarray, ns
-    if null name goto anon_class
 
-    # Named class that we should associate with the Parrot namespace.
+    # If we have a named and our-scoped class, we want to associate it with a
+    # Parrot namespace for langauge inter-op.
+    if name == '' goto no_parrot_ns_assoc
+    $P0 = find_dynamic_lex '$*SCOPE'
+    unless $P0 == 'our' goto no_parrot_ns_assoc
     $P0 = get_hll_global [ 'Perl6';'Grammar' ], 'parse_name'
     nsarray = $P0(name)
     ns = get_hll_namespace nsarray
     parrotclass = newclass ns
     goto have_parrotclass
 
-    # Anonymous class - at least from a namespae point of view. Just create a new
-    # Parrot class and we're done.
-  anon_class:
+    # Don't want to associate with a Parrot namespace.
+  no_parrot_ns_assoc:
     parrotclass = new ['Class']
 
     # Stash in metaclass instance.
@@ -119,11 +121,8 @@ Creates a new instance of the meta-class and returns it in an associated
     setattribute how, '$!attributes', $P0
 
     # If we have a name option, use that as the short name.
-    $P0 = options['name']
-    if null $P0 goto no_alt_name
-    setattribute how, 'shortname', $P0
-    setattribute how, 'longname', $P0
-  no_alt_name:
+    setattribute how, 'shortname', name
+    setattribute how, 'longname', name
   
     # If we have ver and auth, store them.
     $P0 = options['ver']
@@ -788,7 +787,7 @@ correct protocol.
 
     # Make ClassHOW instance.
     .local pmc ctb, how
-    ctb = self.'new'()
+    ctb = self.'new'('')
     how = ctb.'HOW'()
     setattribute how, 'parrotclass', parrotclass
 
diff --git a/src/metamodel/RoleToInstanceApplier.nqp b/src/metamodel/RoleToInstanceApplier.nqp
index a37aafac114..be5fb6592b6 100644
--- a/src/metamodel/RoleToInstanceApplier.nqp
+++ b/src/metamodel/RoleToInstanceApplier.nqp
@@ -22,7 +22,8 @@ class Perl6::Metamodel::RoleToInstanceApplier;
 
 method apply($target, @composees) {
     # Make anonymous subclass.
-    my $subclass := $target.HOW.new;
+    my $*SCOPE := 'anon';
+    my $subclass := $target.HOW.new('');
     $subclass.HOW.add_parent($subclass, $target.WHAT);
 
     # Add all of our given composees to it.