diff --git a/CgOp.pm b/CgOp.pm index 6319dca0..9802c012 100644 --- 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 index c7a65deb..d9675ba3 100644 --- a/Niecza/Grammar.pm6 +++ b/Niecza/Grammar.pm6 @@ -39,6 +39,10 @@ grammar CgOp is STD { token cgexp:name { } token cgexp:quote { > {} [ :lang(%*LANG
) ] } token cgexp:decint { } + token cgexp:bad { {} + [ <.panic "Missing cgop"> ] + <.panic: "Unparsable cgop"> + } } # mnemonic characters: (@, !, =) fetch, store, lvalue. diff --git a/setting b/setting index 1a9c03a6..7fd39bfe 100644 --- 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 != 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 ~ "()"