Implement ClassHOW injection and bootstraping (3rd time)

sorear · Jul 7, 2010 · 68a676c · 68a676c
1 parent 1c21454
commit 68a676c
Show file tree

Hide file tree

Showing 4 changed files with 31 additions and 3 deletions.
diff --git a/CodeGen.pm b/CodeGen.pm
@@ -179,6 +179,11 @@ use 5.010;
         $self->_cpscall("IP6", "$v.HOW(th)");
     }
 
+    sub callframe {
+        my ($self) = @_;
+        $self->_push("Frame", "th");
+    }
+
     sub fetch {
         my ($self) = @_;
         my $c = $self->_pop;

diff --git a/Niecza/Actions.pm b/Niecza/Actions.pm
@@ -340,6 +340,10 @@ sub insn__S_how { my ($cl, $M) = @_;
     $M->{_ast} = [[ 'how' ]];
 }
 
+sub insn__S_callframe { my ($cl, $M) = @_;
+    $M->{_ast} = [[ 'callframe' ]];
+}
+
 sub insn__S_fetch { my ($cl, $M) = @_;
     $M->{_ast} = [[ 'fetch' ]];
 }

diff --git a/Niecza/Grammar.pm6 b/Niecza/Grammar.pm6
@@ -34,7 +34,7 @@ grammar NIL is STD {
 
     token varid {
         [ <sigil> <twigil>? ]? <identifier> |
-            <?before "'"> [ :lang(%*LANG<main>) <quote> ]
+            <?before "'"> [ :lang(%*LANG<MAIN>) <quote> ]
     }
 
     token clrid { <ident>**'.' <clrgeneric>? <clrqual>* }
@@ -55,6 +55,7 @@ grammar NIL is STD {
     token insn:lexget { 'L@' {} <up> <varid> }
     token insn:lexput { 'L!' {} <up> <varid> }
     token insn:how { <sym> }
+    token insn:callframe { <sym> }
     token insn:fetch { '@' }
     token insn:dup_fetch { 'dup@' }
     token insn:pos { '=[' <?> ~ ']' <decint> }

diff --git a/setting b/setting
@@ -16,7 +16,7 @@
 #     has Dictionary[str,int] $.method-scopes;
 #     has Dictionary[str,Sub] $.methods;
 #
-#     has DynProtoMetaObject $.metaobject;
+#     has DynProtoMetaObject $.meta-object;
 # }
 #
 # Due to concerns of screwing up composition, adding new superclasses, roles,
@@ -49,7 +49,9 @@ PRE-INIT {
 
         L@$pmo L@$self !.how
         L@$pmo =[1] @ unwrap:String !.name
-        L@$self @.slots L@$pmo ![metaobject]
+
+        L@$self @.slots L@$pmo ![meta-object]
+        L@$self =[0] @ cast:DynObject @.klass !.klass
 
         L@$self .plaincall/1:Kernel.NewROVar
     } }
@@ -98,6 +100,22 @@ PRE-INIT {
     sub compose { Q:NIL { null:Variable } }
 
     Q:NIL {
+        LEXICALS: $chpmo : DynProtoMetaObject, $ch : DynObject
+        new/0:DynProtoMetaObject L!$chpmo
+        new/0:DynObject L!$ch
+
+        L@$chpmo L@$ch !.how
+        L@$chpmo "ClassHOW" !.name
+        L@$ch @.slots L@$chpmo ![meta-object]
+
+        L@&create-protoobject @
+            L@$ch .plaincall/1:Kernel.NewROVar
+            callframe new/1:CLRImportObject .plaincall/1:Kernel.NewROVar
+            .call/2 L!^ClassHOW
+
+        L@$ch  L@^ClassHOW @ cast:DynObject @.klass  !.klass
+        L@$ch  L!^'ClassHOW!HOW'
+
         null:Variable
     }
 }