Start moving setting to Q:CgOp

sorear · Jul 15, 2010 · e9e5685 · e9e5685
1 parent e32cb27
commit e9e5685
Show file tree

Hide file tree

Showing 3 changed files with 51 additions and 19 deletions.
diff --git a/CgOp.pm b/CgOp.pm
@@ -111,6 +111,10 @@ use warnings;
         CgOp::NIL->new(ops => [ $_[0], [ 'clr_wrap' ] ]);
     }
 
+    sub unwrap {
+        CgOp::NIL->new(ops => [ $_[1], [ 'clr_unwrap', $_[0] ] ]);
+    }
+
     sub sink {
         CgOp::NIL->new(ops => [ $_[0], [ 'drop' ] ]);
     }
@@ -127,6 +131,10 @@ use warnings;
         CgOp::NIL->new(ops => [ $_[1], [ 'clr_field_get', $_[0] ] ]);
     }
 
+    sub getattr {
+        CgOp::NIL->new(ops => [ $_[1], [ 'attr_get', $_[0] ] ]);
+    }
+
     sub cast {
         CgOp::NIL->new(ops => [ $_[1], [ 'cast', $_[0] ] ]);
     }
@@ -159,6 +167,14 @@ use warnings;
         CgOp::NIL->new(ops => [ $_[1], $_[2], [ 'bind', $_[0] ] ]);
     }
 
+    sub compare {
+        CgOp::NIL->new(ops => [$_[1], $_[2], [ 'clr_compare', $_[0] ]]);
+    }
+
+    sub arith {
+        CgOp::NIL->new(ops => [$_[1], $_[2], [ 'clr_arith', $_[0] ]]);
+    }
+
     sub scopedlex {
         CgOp::NIL->new(ops => [[ scopelexget => $_[0] ]]);
     }

diff --git a/Niecza/Grammar.pm6 b/Niecza/Grammar.pm6
@@ -39,6 +39,10 @@ grammar CgOp is STD {
     token cgexp:name { <cgopname> }
     token cgexp:quote { <?before <[ ' " ]>> {} [ :lang(%*LANG<MAIN>) <quote> ] }
     token cgexp:decint { <decint> }
+    token cgexp:bad { <!before ')'> {}
+        [ <?stdstopper> <.panic "Missing cgop"> ]
+        <.panic: "Unparsable cgop">
+    }
 }
 
 # mnemonic characters: (@, !, =) fetch, store, lvalue.

diff --git a/setting b/setting
@@ -70,10 +70,12 @@ PRE-INIT {
     } }
 
     # $how.add-super($how)
-    sub add-super { Q:NIL {
-        =[0] @ @!meta-object unwrap:DynProtoMetaObject @.superclasses
-            =[1] @ @!meta-object unwrap:DynProtoMetaObject  .virtcall/1:Add
-        null:Variable
+    sub add-super { Q:CgOp { (prog
+        (rawcall
+          (getfield superclasses (unwrap DynProtoMetaObject
+            (getattr 'meta-object' (fetch (pos 0))))) Add
+          (unwrap DynProtoMetaObject (getattr 'meta-object' (fetch (pos 1)))))
+        (null Variable))
     } }
 
     # $how.add-scoped-method($name, $index, $sub)
@@ -112,7 +114,7 @@ PRE-INIT {
         L@$p wrapobj
     } }
 
-    sub compose { Q:NIL { null:Variable } }
+    sub compose { Q:CgOp { (null Variable) } }
 
     Q:NIL {
         LEXICALS: $chpmo : DynProtoMetaObject, $ch : DynObject
@@ -225,8 +227,13 @@ Q:NIL {
 
 my class Junction is Mu { }
 my class Num {
-    method Str () { Q:NIL { {self} @ unbox:Double .virtcall/0:ToString box:Str } }
-    method Bool() { Q:NIL { {self} @ unbox:Double  0 !=  box:Bool } }
+    method Str () { Q:CgOp {
+        (box Str (rawcall (unbox Double (fetch (scopedlex self))) ToString))
+    } }
+    method Bool() { Q:CgOp {
+        (box Bool (compare '!=' (double 0)
+                    (unbox Double (fetch (scopedlex self)))))
+    } }
 }
 my class Str {
     method Str () { self }
@@ -259,20 +266,24 @@ sub infix:<~>($l,$r) { Q:NIL {
         box:Str
 } }
 
-sub infix:<+>($l,$r) { Q:NIL {
-    {$l} @ unbox:Double  {$r} @ unbox:Double  +  box:Num
+sub infix:<+>($l,$r) { Q:CgOp {
+    (box Num (arith '+' (unbox Double (fetch (scopedlex '$l')))
+                        (unbox Double (fetch (scopedlex '$r')))))
 } }
 
-sub infix:<->($l,$r) { Q:NIL {
-    {$l} @ unbox:Double  {$r} @ unbox:Double  -  box:Num
+sub infix:<->($l,$r) { Q:CgOp {
+    (box Num (arith '-' (unbox Double (fetch (scopedlex '$l')))
+                        (unbox Double (fetch (scopedlex '$r')))))
 } }
 
-sub infix:<*>($l,$r) { Q:NIL {
-    {$l} @ unbox:Double  {$r} @ unbox:Double  *  box:Num
+sub infix:<*>($l,$r) { Q:CgOp {
+    (box Num (arith '*' (unbox Double (fetch (scopedlex '$l')))
+                        (unbox Double (fetch (scopedlex '$r')))))
 } }
 
-sub infix:</>($l,$r) { Q:NIL {
-    {$l} @ unbox:Double  {$r} @ unbox:Double  /  box:Num
+sub infix:</>($l,$r) { Q:CgOp {
+    (box Num (arith '/' (unbox Double (fetch (scopedlex '$l')))
+                        (unbox Double (fetch (scopedlex '$r')))))
 } }
 
 sub infix:<< < >>($l,$r) { Q:NIL {
@@ -331,8 +342,8 @@ sub infix:<===>($l,$r) { Q:NIL { {$l} @  {$r} @  == box:Bool } }
 # no MONKEY_TYPING.
 
 PRE-INIT {
-    my $i := Mu.HOW.push-scope(Q:NIL { callframe wrap });
-    Mu.HOW.add-scoped-method(Q:NIL { "defined" wrap }, $i,
+    my $i := Mu.HOW.push-scope(Q:CgOp { (wrap (callframe)) });
+    Mu.HOW.add-scoped-method(Q:CgOp { (wrap (clr_string "defined")) }, $i,
         anon method defined() {
             Q:NIL { {self} @ cast:DynObject @.slots
                     null:Dictionary<string,object> != box:Bool }
@@ -341,8 +352,9 @@ PRE-INIT {
         anon method Bool() { self.defined });
     Mu.HOW.add-scoped-method(Q:NIL { "Str" wrap }, $i,
         anon method Str() {
-            my $tn := Q:NIL {
-                {self} @ cast:DynObject @.klass @.proto @.name box:Str
+            my $tn := Q:CgOp {
+                (box Str (getfield name (getfield proto (getfield klass
+                    (cast DynObject (fetch (scopedlex self)))))))
             };
             if self.defined {
                 $tn ~ "()<instance>"