Add class statements

Body.pm

@@ -30,6 +30,7 @@ use CodeGen ();
 
     sub do_enter {
         my ($self, $cg) = @_;
+        $cg->lextypes($_, 'Variable') for keys %{ $self->lexical };
         $_->do_enter($cg, $self) for @{ $self->decls };
         $_->void_cg($cg, $self) for @{ $self->enter };
     }
@@ -66,7 +67,7 @@ use CodeGen ();
         $cg->lexget(1, $self->var . '!HOW');
         $cg->dup_fetch;
         $cg->callframe;
-        $cg->clr_call_direct('Kernel.NewROVar', 1);
+        $cg->clr_wrap;
         $cg->lexget(0, '!plist');
         $cg->clr_wrap;
         $cg->call_method(1, "create-protoobject", 2);

CodeGen.pm

@@ -228,7 +228,8 @@ use 5.010;
                 qm('aux!protopad!' . ($self->auxdepths->{'protopad'} - 1)) .
                 ']).';
         }
-        $self->_push(($order ? 'Variable' : $self->lex2type->{$name}),
+        # XXX need a better type tracking system
+        $self->_push(($order ? 'Variable' : ($self->lex2type->{$name} // 'Variable')),
             $frame . ("outer." x $order) . "lex[" . qm($name) . "]");
     }
 

Decl.pm

@@ -92,7 +92,7 @@ use 5.010;
 
     has name => (is => 'ro', isa => 'Str', predicate => 'has_name');
     has var  => (is => 'ro', isa => 'Str', required => 1);
-    has stub => (is => 'ro', isa => 'Bool', default => 1);
+    has stub => (is => 'ro', isa => 'Bool', default => 0);
     has parents => (is => 'ro', isa => 'ArrayRef', default => sub { [] });
 
     # the body is a very sublike thing; it has a preinit existance, and a
@@ -106,8 +106,8 @@ use 5.010;
         $cg->dup_fetch;
         $cg->string_var($self->name // 'ANON');
         $cg->call_method(1, "new", 1);
-        $cg->dup;
         $cg->push_aux('how');
+        $cg->peek_aux('how');
         $cg->proto_var($self->var . '!HOW');
 
         # TODO: Initialize the protoobject to a failure here so an awesome error
@@ -122,12 +122,13 @@ use 5.010;
 
         $cg->peek_aux('how');
         $cg->dup_fetch;
-        $cg->peek_aux('protopad');
-        $cg->clr_call_direct('Kernel.NewROVar', 1);
+        $cg->callframe;
+        $cg->clr_wrap;
         $cg->call_method(0, "push-scope", 1);
 
         $self->body->do_preinit($cg);
         $cg->close_sub($self->body->code);
+        $cg->clr_call_direct('Kernel.NewROVar', 1);
         $cg->proto_var($self->var . '!BODY');
     }
 

Niecza/Actions.pm

@@ -584,17 +584,46 @@ sub statementlist { my ($cl, $M) = @_;
 }
 
 sub package_def { my ($cl, $M) = @_;
-    if ($M->{longname}[0] && $::SCOPE ne 'my') {
-        $M->sorry('Non-lexical class definitions are not yet supported');
+    if ($::PKGDECL ne 'class') {
+        $M->sorry('Non-class package definitions are not yet supported');
         return;
     }
-    if (!$M->{decl}{stub}) {
-        $M->sorry('Non-stub class definitions are not yet supported');
+    my $scope = $::SCOPE;
+    if (!$M->{longname}[0]) {
+        $scope = 'anon';
+    }
+    if ($::SCOPE ne 'anon' && $::SCOPE ne 'my') {
+        $M->sorry('Non-lexical class definitions are not yet supported');
         return;
     }
+    my $name = $M->{longname}[0] ?
+        $cl->mangle_longname($M->{longname}[0]) : 'ANON';
+    my $outer = $cl->get_outer($::CURLEX);
+    my $outervar = $::SCOPE eq 'my' ? $name : $cl->gensym;
     # allocate a slot
-    $::CURLEX->{'!slots'}{$M->{decl}{name}} = 1;
-    $::CURLEX->{'!slots'}{$M->{decl}{name} . "!HOW"} = 1;
+    $outer->{'!slots'}{$outervar} = 1;
+    $outer->{'!slots'}{"$outervar!HOW"} = 1;
+    $outer->{'!slots'}{"$outervar!BODY"} = 1;
+    # TODO: there should probably be a decl used for stubs, too
+    if (!$M->{decl}{stub}) {
+        my $stmts = $M->{statementlist} // $M->{blockoid};
+        my $cbody = Body::Class->new(
+            name    => $name,
+            decls   => ($::CURLEX->{'!decls'} // []),
+            enter   => ($::CURLEX->{'!enter'} // []),
+            lexical => ($::CURLEX->{'!slots'} // {}),
+            do      => $stmts->{_ast});
+        my $cdecl = Decl::Class->new(
+            name    => $name,
+            var     => $outervar,
+            body    => $cbody);
+        push @{ $outer->{'!decls'} //= [] }, $cdecl;
+        $M->{_ast} = Op::StatementList->new(
+            children => [
+                Op::CallSub->new(
+                    invocant => Op::Lexical->new(name => $outervar . '!BODY')),
+                Op::Lexical->new(name => $outervar)]);
+    }
 }
 
 sub routine_declarator {}
@@ -616,8 +645,12 @@ sub sl_to_block { my ($cl, $ast, %args) = @_;
         do      => $ast);
 }
 
+sub get_outer { my ($cl, $pad) = @_;
+    $STD::ALL->{ $pad->{'OUTER::'}[0] };
+}
+
 sub block_to_closure { my ($cl, $blk, %args) = @_;
-    my $outer = $STD::ALL->{ $::CURLEX->{'OUTER::'}[0] };
+    my $outer = $cl->get_outer($::CURLEX);
     my $outer_key = $args{outer_key} // $cl->gensym;
 
     $outer->{'!slots'}{$outer_key} = 1 if $outer;

Op.pm

@@ -45,8 +45,9 @@ use 5.010;
     sub item_cg {
         my ($self, $cg, $body) = @_;
         if (!@{ $self->children }) {
-            # XXX scoping
-            Op::Lexical->new(name => 'Nil')->item_cg($cg, $body);
+            # XXX should be Nil or something
+            $cg->push_null('object');
+            $cg->clr_wrap;
         } else {
             my @kids = @{ $self->children };
             my $end = pop @kids;
@@ -88,6 +89,14 @@ use 5.010;
         $cg->call_sub(1, scalar(@{ $self->positionals }));
     }
 
+    sub void_cg {
+        my ($self, $cg, $body) = @_;
+        $self->invocant->item_cg($cg, $body);
+        $cg->fetch;
+        $_->item_cg($cg, $body) for @{ $self->positionals };
+        $cg->call_sub(0, scalar(@{ $self->positionals }));
+    }
+
     __PACKAGE__->meta->make_immutable;
     no Moose;
 }

Unit.pm

@@ -17,6 +17,7 @@ use 5.010;
         } else {
             $self->codegen($cg = CodeGen->new(name => 'boot'));
             $cg->new_aux('protopad', 'Frame');
+            $cg->new_aux('how', 'Variable');
             $cg->push_null('Frame');
             $cg->push_aux('protopad');
             $cg->open_protopad;

setting

@@ -219,4 +219,6 @@ sub say { Q:NIL {
     =[0] @ unwrap:String .plaincall/1:Console.WriteLine null:Variable
 } }
 
+my class Foo { }
+
 say("Hello, " ~ "World");