More steps towards class decls. Allow lexget et al to directly access…

… protopads.

Body.pm

@@ -21,25 +21,70 @@ use CodeGen ();
         if ($self->codegen) { return $self->codegen }
         $self->codegen(CodeGen->new(name => $self->name));
         my $cg = $self->codegen;
-        $_->enter($cg, $self) for @{ $self->decls };
-        $_->void_cg($cg, $self) for @{ $self->enter };
+        $self->do_enter($cg);
         $self->do->item_cg($cg, $self);
         # TODO: Bind a return value here to catch non-ro sub use
         $cg->return(1) unless $cg->unreach;
         return $cg;
     }
 
+    sub do_enter {
+        my ($self, $cg) = @_;
+        $_->do_enter($cg, $self) for @{ $self->decls };
+        $_->void_cg($cg, $self) for @{ $self->enter };
+    }
+
     sub write {
         my ($self) = @_;
         $self->code->write;
         $_->write($self) for (@{ $self->decls });
     }
 
-    sub preinit {
+    sub do_preinit {
         my ($self, $cg) = @_;
-        $_->preinit($cg, $self) for @{ $self->decls };
+        $_->do_preinit($cg, $self) for @{ $self->decls };
     }
 
     __PACKAGE__->meta->make_immutable;
     no Moose;
 }
+
+# Like a normal body, but creates a protoobject during preinit and run!
+{
+    package Body::Class;
+    use Moose;
+    extends 'Body';
+
+    has 'var' => (is => 'rw', isa => 'Str');
+
+    sub makeproto {
+        my ($self, $cg) = @_;
+        $cg->lextypes('!plist', 'List<DynMetaObject>');
+        $cg->clr_new('List<DynMetaObject>', 0);
+        $cg->lexput(0, '!plist');
+        # TODO handle superclasses here!
+        $cg->lexget(1, $self->var . '!HOW');
+        $cg->dup_fetch;
+        $cg->callframe;
+        $cg->clr_call_direct('Kernel.NewROVar', 1);
+        $cg->lexget(0, '!plist');
+        $cg->clr_wrap;
+        $cg->call_method(1, "create-protoobject", 2);
+        $cg->lexput(1, $self->var);
+    }
+
+    before do_enter => sub {
+        my ($self, $cg) = @_;
+        $self->makeproto($cg);
+    };
+
+    after do_preinit => sub {
+        my ($self, $cg) = @_;
+        $self->makeproto($cg);
+    };
+
+    __PACKAGE__->meta->make_immutable;
+    no Moose;
+}
+
+1;

CodeGen.pm

@@ -140,19 +140,19 @@ use 5.010;
         my ($self, $which) = @_;
         my $var = "aux!${which}!" . ($self->auxdepths->{$which}++);
         $self->lextypes($var, $self->auxtypes->{$which});
-        $self->lexput(0, $var);
+        $self->rawlexput($var);
     }
 
     sub pop_aux {
         my ($self, $which) = @_;
         my $var = "aux!${which}!" . (--$self->auxdepths->{$which});
-        $self->lexget(0, $var);
+        $self->rawlexget($var);
     }
 
     sub peek_aux {
         my ($self, $which) = @_;
         my $var = "aux!${which}!" . ($self->auxdepths->{$which} - 1);
-        $self->lexget(0, $var);
+        $self->rawlexget($var);
     }
 
     sub label {
@@ -192,6 +192,7 @@ use 5.010;
 
     sub lextypes {
         my ($self, @args) = @_;
+        #say STDERR "lextypes: @args";
         %{ $self->lex2type } = (%{ $self->lex2type }, @args);
     }
 
@@ -209,15 +210,37 @@ use 5.010;
         $self->lexget($order, $name);
     }
 
+    sub rawlexget {
+        my ($self, $name) = @_;
+        $self->_push($self->lex2type->{$name}, "th.lex[" . qm($name) . "]");
+    }
+
+    sub rawlexput {
+        my ($self, $name) = @_;
+        $self->_emit("th.lex[" . qm($name) . "] = " . $self->_pop);
+    }
+
     sub lexget {
         my ($self, $order, $name) = @_;
+        my $frame = 'th.';
+        if ($self->auxdepths->{'protopad'}) {
+            $frame = '((Frame)th.lex[' .
+                qm('aux!protopad!' . ($self->auxdepths->{'protopad'} - 1)) .
+                ']).';
+        }
         $self->_push(($order ? 'Variable' : $self->lex2type->{$name}),
-            "th." . ("outer." x $order) . "lex[" . qm($name) . "]");
+            $frame . ("outer." x $order) . "lex[" . qm($name) . "]");
     }
 
     sub lexput {
         my ($self, $order, $name) = @_;
-        $self->_emit("th." . ("outer." x $order) . "lex[" . qm($name) . "] = " . $self->_pop);
+        my $frame = 'th.';
+        if ($self->auxdepths->{'protopad'}) {
+            $frame = '((Frame)th.lex[' .
+                qm('aux!protopad!' . ($self->auxdepths->{'protopad'} - 1)) .
+                ']).';
+        }
+        $self->_emit($frame . ("outer." x $order) . "lex[" . qm($name) . "] = " . $self->_pop);
     }
 
     sub string_var {
@@ -233,7 +256,13 @@ use 5.010;
 
     sub callframe {
         my ($self) = @_;
-        $self->_push("Frame", "th");
+        my $frame = 'th';
+        if ($self->auxdepths->{'protopad'}) {
+            $frame = '((Frame)th.lex[' .
+                qm('aux!protopad!' . ($self->auxdepths->{'protopad'} - 1)) .
+                '])';
+        }
+        $self->_push("Frame", $frame);
     }
 
     sub fetch {

Decl.pm

@@ -6,9 +6,9 @@ use 5.010;
     package Decl;
     use Moose;
 
-    sub preinit {}
-    sub enter   {}
-    sub write   {}
+    sub do_preinit {}
+    sub do_enter   {}
+    sub write     {}
 
     __PACKAGE__->meta->make_immutable;
     no Moose;
@@ -23,17 +23,17 @@ use 5.010;
     has code   => (isa => 'Body', is => 'ro', required => 1);
     has shared => (isa => 'Bool', is => 'ro', default => 0);
 
-    sub preinit {
+    sub do_preinit {
         my ($self, $cg, $body) = @_;
         $self->code->outer($body);
         $cg->open_protopad;
-        $self->code->preinit($cg);
+        $self->code->do_preinit($cg);
         $cg->close_sub($self->code->code);
         $cg->call_sub($self->has_var, 0);
         $cg->proto_var($self->var) if $self->has_var;
     }
 
-    sub enter {
+    sub do_enter {
         my ($self, $cg, $body) = @_;
         return unless $self->has_var;
         if ($self->shared) {
@@ -61,17 +61,17 @@ use 5.010;
     has var    => (isa => 'Str', is => 'ro', required => 1);
     has code   => (isa => 'Body', is => 'ro', required => 1);
 
-    sub preinit {
+    sub do_preinit {
         my ($self, $cg, $body) = @_;
         $self->code->outer($body);
         $cg->open_protopad;
-        $self->code->preinit($cg);
+        $self->code->do_preinit($cg);
         $cg->close_sub($self->code->code);
         $cg->clr_call_direct('Kernel.NewROVar', 1);
         $cg->proto_var($self->var);
     }
 
-    sub enter {
+    sub do_enter {
         my ($self, $cg, $body) = @_;
         $cg->clone_lex($self->var);
     }
@@ -100,7 +100,7 @@ use 5.010;
     # preinit
     has body => (is => 'ro', isa => 'Body::Class', required => 1);
 
-    sub preinit {
+    sub do_preinit {
         my ($self, $cg, $body) = @_;
         $cg->scopelexget("ClassHOW", $body);
         $cg->dup_fetch;
@@ -126,19 +126,15 @@ use 5.010;
         $cg->clr_call_direct('Kernel.NewROVar', 1);
         $cg->call_method(0, "push-scope", 1);
 
-        $self->body->preinit($cg);
+        $self->body->do_preinit($cg);
         $cg->close_sub($self->body->code);
         $cg->proto_var($self->var . '!BODY');
     }
 
-    sub enter   {
+    sub do_enter   {
         my ($self, $cg, $body) = @_;
         $cg->share_lex($self->var . '!HOW');
         $cg->clone_lex($self->var . '!BODY');
-        $cg->lexget($self->var . '!BODY');
-        $cg->fetch;
-        $cg->call_sub(0, 0);
-        # the body will set $self->var at ENTER time
     }
     sub write   {
         my ($self, $body) = @_;

Unit.pm

@@ -20,7 +20,7 @@ use 5.010;
             $cg->push_null('Frame');
             $cg->push_aux('protopad');
             $cg->open_protopad;
-            $self->mainline->preinit($cg);
+            $self->mainline->do_preinit($cg);
             $cg->close_sub($self->mainline->code);
             $cg->call_sub(0,0);
             $cg->return;
@@ -30,6 +30,7 @@ use 5.010;
 
     sub write {
         my ($self) = @_;
+        #say STDERR (YAML::XS::Dump($self));
         print <<EOH;
 using System;
 using System.Collections.Generic;