Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Mergeback

  • Loading branch information...
commit 4de9ec8aae78b15bc7091017525eecd1dbaa7c3f 1 parent 0c9ee16
@sorear authored
Showing with 209 additions and 438 deletions.
  1. +3 −0  src/CgOp.pm6
  2. +132 −26 src/NieczaActions.pm6
  3. +74 −26 src/Op.pm6
  4. +0 −386 src/niecza
View
3  src/CgOp.pm6
@@ -280,6 +280,9 @@ method bif_array_constructor($i) { self._cgop("bif_array_constructor", $i) }
method callnext($cap) { self._cgop("callnext",$cap) }
method bif_zip($fcn,$pcl) { self._cgop("bif_zip",$fcn,$pcl) }
method bif_cross($fcn,$pcl) { self._cgop("bif_cross",$fcn,$pcl) }
+method letscope(*@items) { self._cgop('letscope', @items) }
+method xspan(*@items) { self._cgop('xspan', @items) }
+method bif_mod($x,$y) { self._cgop('bif_mod', $x, $y) }
method double($x) {
# Hack - prevent JSON syntax errors
View
158 src/NieczaActions.pm6
@@ -146,6 +146,11 @@ method integer($/) {
make ($<decint> // $<octint> // $<hexint> // $<binint>).ast
}
+method escale ($/) { }
+method dec_number ($/) {
+ make +((~$/).comb(/<-[_]>/).join(""));
+}
+
# XXX niecza rats will break this
method number($/) {
my $child = $<integer> // $<dec_number> // $<rad_number>;
@@ -247,6 +252,18 @@ method desigilname($/) {
method stopper($ ) { }
+method quote_mod:w ($) { }
+method quote_mod:ww ($) { }
+method quote_mod:p ($) { }
+method quote_mod:x ($) { }
+method quote_mod:to ($) { }
+method quote_mod:s ($) { }
+method quote_mod:a ($) { }
+method quote_mod:h ($) { }
+method quote_mod:f ($) { }
+method quote_mod:c ($) { }
+method quote_mod:b ($) { }
+
# quote :: Op
method quote:sym<" "> ($/) { make $<nibble>.ast }
method quote:sym<' '> ($/) { make $<nibble>.ast }
@@ -874,6 +891,30 @@ method escape:ws ($/) { make "" }
my class RangeSymbol { };
method escape:sym<..> ($/) { make RangeSymbol }
+sub mkstringycat($/, *@strings) {
+ my @a;
+ for @strings -> $s {
+ my $i = ($s !~~ Op) ?? ::Op::StringLiteral.new(|node($/),
+ text => $s) !! $s;
+
+ # this *might* belong in an optimization pass
+ if @a && @a[*-1] ~~ ::Op::StringLiteral &&
+ $i ~~ ::Op::StringLiteral {
+ @a[*-1] = ::Op::StringLiteral.new(|node($/),
+ text => (@a[*-1].text ~ $i.text));
+ } else {
+ push @a, $i;
+ }
+ }
+ if @a == 0 {
+ return ::Op::StringLiteral.new(|node($/), text => "");
+ } elsif @a == 1 {
+ return (@a[0] ~~ ::Op::StringLiteral) ?? @a[0] !!
+ mkcall($/, '&prefix:<~>', @a[0]);
+ } else {
+ return mkcall($/, '&infix:<~>', @a);
+ }
+}
# XXX I probably shouldn't have used "Str" for this action method name
method Str($match?) { "NieczaActions" } #OK not used
method process_nibble($/, @bits, $prefix?) {
@@ -886,25 +927,45 @@ method process_nibble($/, @bits, $prefix?) {
$ast = "";
}
- if $ast !~~ Op {
- my $str = $ast;
- $str = $str.split(/^^<before \s>[ $prefix || \s* ]/).join("") if defined $prefix;
- $ast = ::Op::StringLiteral.new(|node($/), text => $str);
+ if $ast !~~ Op && defined $prefix {
+ $ast = $ast.split(/^^<before \s>[ $prefix || \s* ]/).join("");
}
- # this *might* belong in an optimization pass
- if @acc && @acc[*-1] ~~ ::Op::StringLiteral &&
- $ast ~~ ::Op::StringLiteral {
- @acc[*-1] = ::Op::StringLiteral.new(|node($/),
- text => (@acc[*-1].text ~ $ast.text));
- } else {
- push @acc, $ast;
+ push @acc, $ast;
+ }
+
+ my $post = $/.CURSOR.postprocessor;
+ make mkstringycat($/, @acc);
+
+ if $post eq 'null' {
+ # already OK
+ }
+ # actually quotewords is a bit trickier than this...
+ elsif $post eq 'words' || $post eq 'quotewords' {
+ my $sl = $/.ast;
+ if !$sl.^isa(::Op::StringLiteral) {
+ make ::Op::CallMethod.new(|node($/), :name<words>, receiver => $sl);
+ }
+ else {
+ my @tok = $sl.text.words;
+ @tok = map { ::Op::StringLiteral.new(|node($/), text => $_) }, @tok;
+
+ make ((@tok == 1) ?? @tok[0] !!
+ ::Op::SimpleParcel.new(|node($/), items => @tok));
}
}
- make do @acc == 0 ?? ::Op::StringLiteral.new(|node($/), text => "") !!
- @acc == 1 ?? (@acc[0] ~~ ::Op::StringLiteral ?? @acc[0] !!
- mkcall($/, '&prefix:<~>', @acc[0])) !!
- mkcall($/, '&infix:<~>', @acc);
+ elsif $post eq 'path' {
+ # TODO could stand to be a lot fancier.
+ make ::Op::CallMethod(|node($/), receiver => $/.ast, :name<IO>);
+ }
+ elsif $post eq 'run' {
+ make mkcall($/, 'rungather', $/.ast);
+ }
+ else {
+ $/.CURSOR.sorry("Unhandled postprocessor $post");
+ }
+
+ $/.ast;
}
method process_tribble(@bits) {
@@ -983,9 +1044,9 @@ method split_circumfix ($/) {
make ((@tok == 1) ?? @tok[0] !!
::Op::SimpleParcel.new(|node($/), items => @tok));
}
-method circumfix:sym«< >» ($/) { self.split_circumfix($/) }
-method circumfix:sym«<< >>» ($/) { self.split_circumfix($/) }
-method circumfix:sym<« »> ($/) { self.split_circumfix($/) }
+method circumfix:sym«< >» ($/) { make $<nibble>.ast }
+method circumfix:sym«<< >>» ($/) { make $<nibble>.ast }
+method circumfix:sym<« »> ($/) { make $<nibble>.ast }
method circumfix:sym<( )> ($/) {
my @kids = @( $<semilist>.ast );
@@ -1242,8 +1303,7 @@ method postcircumfix:sym<{ }> ($/) {
make Operator.funop('&postcircumfix:<{ }>', 1, @( $<semilist>.ast ));
}
method postcircumfix:sym«< >» ($/) {
- self.split_circumfix($/);
- make Operator.funop('&postcircumfix:<{ }>', 1, $/.ast);
+ make Operator.funop('&postcircumfix:<{ }>', 1, $<nibble>.ast);
}
method postcircumfix:sym<( )> ($/) {
make ::Operator::PostCall.new(args => $<semiarglist>.ast[0]);
@@ -1665,9 +1725,16 @@ method param_var($/) {
# :: Sig::Parameter
method parameter($/) {
my $rw = False;
+ my $sorry;
+ my $slurpy;
+ my $slurpycap;
+ my $optional;
+ my $rwt;
for @( $<trait> ) -> $trait {
if $trait.ast<rw> { $rw = True }
+ elsif $trait.ast<parcel> { $rwt = True }
+ elsif $trait.ast<readonly> { $rw = False }
else {
$trait.CURSOR.sorry('Unhandled trait ' ~ $trait.ast.keys.[0]);
}
@@ -1681,11 +1748,6 @@ method parameter($/) {
my $default = $<default_value> ?? $<default_value>[0].ast !! Any;
- my $sorry;
- my $slurpy;
- my $slurpycap;
- my $optional;
- my $rwt;
my $tag = $<quant> ~ ':' ~ $<kind>;
if $tag eq '**:*' { $sorry = "Slice parameters NYI" }
elsif $tag eq '*:*' { $slurpy = True }
@@ -1760,7 +1822,7 @@ method cgexp:quote ($/) {
my %opshortcut = (
'@' => [ 'fetch' ],
- 'l' => [ 'scopedlex' ],
+ 'l' => [ 'letvar' ],
'ns' => [ 'newscalar' ],
'nsw' => [ 'newrwscalar' ],
's' => [ 'str' ],
@@ -1820,6 +1882,23 @@ method tribble($/) {}
method babble($/) {}
method quotepair($/) {}
+method capture($ ) {}
+method capterm($/) {
+ my @args;
+ if $<capture> {
+ my $x = $<capture>[0]<EXPR>.ast;
+ if $x.^isa(::Op::SimpleParcel) {
+ @args = @($x.items);
+ } else {
+ @args = $x;
+ }
+ } elsif $<termish> {
+ @args = ::Op::Paren.new(|node($/), inside => $<termish>.ast);
+ }
+ make ::Op::CallSub.new(|node($/), invocant => mklex($/, '&_make_capture'),
+ args => @args);
+}
+
# We can't do much at blockoid reduce time because the context is unknown.
# Roles and subs need somewhat different code gen
method blockoid($/) {
@@ -2167,6 +2246,11 @@ method statement_control:if ($/) {
make self.if_branches($/, $<xblock>, @( $<elsif> ));
}
+method statement_control:unless ($/) {
+ make ::Op::Conditional.new(|node($/), check => $<xblock>.ast[0],
+ false => self.block_to_immediate($/, 'cond', $<xblock>.ast[1]));
+}
+
method statement_control:while ($/) {
make ::Op::WhileLoop.new(|node($/), check => $<xblock>.ast[0],
body => self.block_to_immediate($/, 'loop', $<xblock>.ast[1]),
@@ -2179,6 +2263,24 @@ method statement_control:until ($/) {
:until, :!once);
}
+method statement_control:repeat ($/) {
+ my $until = $<wu> eq 'until';
+ my $check = $<xblock> ?? $<xblock>.ast[0] !! $<EXPR>.ast;
+ my $body = self.block_to_immediate($/, 'loop',
+ $<xblock> ?? $<xblock>.ast[1] !! $<pblock>.ast);
+ make ::Op::WhileLoop.new(|node($/), :$check, :$until, :$body, :once);
+}
+
+method statement_control:loop ($/) {
+ my $body = self.block_to_immediate($/, 'loop', $<block>.ast);
+ # XXX wrong interpretation
+ my $init = $0 && $0[0]<e1>[0] ?? $0[0]<e1>[0].ast !! Any;
+ my $cond = $0 && $0[0]<e2>[0] ?? $0[0]<e2>[0].ast !! Any;
+ my $step = $0 && $0[0]<e3>[0] ?? $0[0]<e3>[0].ast !! Any;
+
+ make ::Op::GeneralLoop.new(|node($/), :$body, :$init, :$cond, :$step);
+}
+
method statement_control:for ($/) {
$<xblock>.ast[1].type = 'loop';
make ::Op::ForLoop.new(|node($/), source => $<xblock>.ast[0],
@@ -2325,6 +2427,10 @@ method trait_mod:is ($/) {
make { return_pass => 1 };
} elsif $trait eq 'rw' {
make { rw => 1 };
+ } elsif $trait eq 'parcel' {
+ make { rwt => 1 };
+ } elsif $trait eq 'readonly' {
+ make { readonly => 1 };
} else {
$/.CURSOR.sorry("Unhandled trait $trait");
make { };
View
100 src/Op.pm6
@@ -369,13 +369,41 @@ class WhileLoop is Op {
CgOp.prog(
CgOp.whileloop(+$.until, +$.once,
CgOp.obj_getbool($.check.cgop($body)),
+ CgOp.sink(CgOp.xspan("redo$id", "next$id", 0, $.body.cgop($body),
+ 1, $l, "next$id", 2, $l, "last$id", 3, $l, "redo$id"))),
+ CgOp.label("last$id"),
+ CgOp.corelex('Nil'));
+ }
+}
+
+class GeneralLoop is Op {
+ has $.init; # Op
+ has $.cond; # Op
+ has $.step; # Op
+ has $.body; # Op
+
+ method zyg() { grep &defined, $.init, $.cond, $.step, $.body }
+ method ctxzyg($) {
+ ($.init ?? ($.init, 0) !! ()),
+ ($.cond ?? ($.cond, 1) !! ()),
+ ($.step ?? ($.step, 0) !! ()),
+ $.body, 0
+ }
+
+ method code($body) { self.code_labelled($body,'') }
+ method code_labelled($body, $l) {
+ my $id = ::GLOBAL::NieczaActions.genid;
+
+ CgOp.prog(
+ ($.init ?? CgOp.sink($.init.cgop($body)) !! ()),
+ CgOp.whileloop(0, 0,
+ ($.cond ?? CgOp.obj_getbool($.cond.cgop($body)) !!
+ CgOp.bool(1)),
CgOp.prog(
- CgOp.label("redo$id"),
- CgOp.sink($.body.cgop($body)),
- CgOp.label("next$id"),
- CgOp.ehspan(1, $l, 0, "redo$id", "next$id", "next$id"),
- CgOp.ehspan(2, $l, 0, "redo$id", "next$id", "last$id"),
- CgOp.ehspan(3, $l, 0, "redo$id", "next$id", "redo$id"))),
+ CgOp.sink(CgOp.xspan("redo$id", "next$id", 0,
+ $.body.cgop($body), 1, $l, "next$id",
+ 2, $l, "last$id", 3, $l, "redo$id")),
+ ($.step ?? CgOp.sink($.step.cgop($body)) !! ()))),
CgOp.label("last$id"),
CgOp.corelex('Nil'));
}
@@ -427,12 +455,11 @@ class ImmedForLoop is Op {
CgOp.prog(
CgOp.letvar($.var,
CgOp.vvarlist_shift(CgOp.letvar("!iter$id"))),
- CgOp.label("redo$id"),
- CgOp.sink($.sink.cgop($body)),
- CgOp.label("next$id"),
- CgOp.ehspan(1, $l, 0, "redo$id", "next$id", "next$id"),
- CgOp.ehspan(2, $l, 0, "redo$id", "next$id", "last$id"),
- CgOp.ehspan(3, $l, 0, "redo$id", "next$id", "redo$id"))),
+ CgOp.sink(CgOp.xspan("redo$id", "next$id", 0,
+ $.sink.cgop($body),
+ 1, $l, "next$id",
+ 2, $l, "last$id",
+ 3, $l, "redo$id")))),
CgOp.label("last$id")));
}
}
@@ -457,12 +484,11 @@ class When is Op {
CgOp.ternary(CgOp.obj_getbool(CgOp.methodcall(
$.match.cgop($body), 'ACCEPTS', CgOp.scopedlex('$_'))),
- CgOp.prog(
- CgOp.ehspan(7, '', 0, "start$id", "end$id", "end$id"),
- CgOp.span("start$id", "end$id", 0, CgOp.prog(
+ CgOp.xspan("start$id", "end$id", 0, CgOp.prog(
CgOp.sink($.body.cgop($body)),
CgOp.control(6, CgOp.null('frame'), CgOp.int(-1),
- CgOp.null('str'), CgOp.corelex('Nil'))))),
+ CgOp.null('str'), CgOp.corelex('Nil'))),
+ 7, '', "end$id"),
CgOp.corelex('Nil'));
}
}
@@ -499,9 +525,22 @@ class Try is Op {
method code($body) {
my $id = ::GLOBAL::NieczaActions.genid;
- CgOp.prog(
- CgOp.ehspan(5, '', 0, "start$id", "end$id", "end$id"),
- CgOp.span("start$id", "end$id", 1, $.body.cgop($body)));
+ CgOp.xspan("start$id", "end$id", 1, $.body.cgop($body),
+ 5, '', "end$id");
+ }
+}
+
+class Control is Op {
+ has $.payload = die "Control.payload required"; # Op
+ has $.name = "";
+ has $.number = die "Control.number required"; # Num
+
+ method zyg() { $.payload }
+
+ method code($body) {
+ CgOp.control($.number, CgOp.null('frame'), CgOp.int(-1),
+ ($.name eq '' ?? CgOp.null('str') !! CgOp.str($.name)),
+ $.payload.cgop($body));
}
}
@@ -838,6 +877,18 @@ class Let is Op {
}
}
+class LetScope is Op {
+ has $.transparent;
+ has $.names;
+ has $.inner;
+
+ method zyg() { $.inner }
+
+ method code($body) {
+ CgOp.letscope(+$.transparent, @($.names), $.inner.cgop($body));
+ }
+}
+
# These two are created to codegen wrappers in NAMOutput... bad factor
class TopicalHook is Op {
has $.inner;
@@ -846,9 +897,8 @@ class TopicalHook is Op {
method code($body) {
my $id = ::GLOBAL::NieczaActions.genid;
- CgOp.prog(
- CgOp.ehspan(6, '', 0, "start$id", "end$id", "end$id"),
- CgOp.span("start$id", "end$id", 0, $.inner.cgop($body)));
+ CgOp.xspan("start$id", "end$id", 0, $.inner.cgop($body),
+ 6, '', "end$id");
}
}
@@ -860,9 +910,7 @@ class LabelHook is Op {
method code($body) {
my $id = ::GLOBAL::NieczaActions.genid;
- CgOp.prog(
- map({ CgOp.ehspan(8, $_, 0, "start$id", "end$id", "goto_$_") },
- @$.labels),
- CgOp.span("start$id", "end$id", 0, $.inner.cgop($body)));
+ CgOp.xspan("start$id", "end$id", 0, $.inner.cgop($body),
+ map({ 8, $_, "goto_$_" }, @$.labels));
}
}
View
386 src/niecza
@@ -23,392 +23,6 @@ use NieczaActions;
use OpHelpers;
use Operator;
-sub mkstringycat($/, *@strings) {
- my @a;
- for @strings -> $s {
- my $i = ($s !~~ Op) ?? ::Op::StringLiteral.new(|node($/),
- text => $s) !! $s;
-
- # this *might* belong in an optimization pass
- if @a && @a[*-1] ~~ ::Op::StringLiteral &&
- $i ~~ ::Op::StringLiteral {
- @a[*-1] = ::Op::StringLiteral.new(|node($/),
- text => (@a[*-1].text ~ $i.text));
- } else {
- push @a, $i;
- }
- }
- if @a == 0 {
- return ::Op::StringLiteral.new(|node($/), text => "");
- } elsif @a == 1 {
- return (@a[0] ~~ ::Op::StringLiteral) ?? @a[0] !!
- mkcall($/, '&prefix:<~>', @a[0]);
- } else {
- return mkcall($/, '&infix:<~>', @a);
- }
-}
-
-augment class NieczaActions {
-method trait_mod:is ($/) {
- my $trait = ~$<longname>;
- my $noparm;
-
- if $/.CURSOR.is_name($trait) {
- make self.mangle_longname($<longname>);
- $noparm = 'Superclasses cannot have parameters';
- } elsif $trait eq 'export' {
- make { export => [ 'DEFAULT', 'ALL' ] };
- $noparm = 'Export tags NYI';
- } elsif ($trait eq 'rawcall') {
- make { nobinder => True };
- } elsif $trait eq 'return-pass' { # &return special
- make { return_pass => 1 };
- } elsif $trait eq 'rw' {
- make { rw => 1 };
- } elsif $trait eq 'parcel' {
- make { rwt => 1 };
- } elsif $trait eq 'readonly' {
- make { readonly => 1 };
- } else {
- $/.CURSOR.sorry("Unhandled trait $trait");
- make { };
- }
-
- if $noparm && $<circumfix> {
- $/.CURSOR.sorry($noparm);
- }
-}
-method parameter($/) {
- my $rw = False;
- my $sorry;
- my $slurpy;
- my $slurpycap;
- my $optional;
- my $rwt;
-
- for @( $<trait> ) -> $trait {
- if $trait.ast<rw> { $rw = True }
- elsif $trait.ast<parcel> { $rwt = True }
- elsif $trait.ast<readonly> { $rw = False }
- else {
- $trait.CURSOR.sorry('Unhandled trait ' ~ $trait.ast.keys.[0]);
- }
- }
-
- if $<post_constraint> > 0 {
- $/.sorry('Parameter post constraints NYI');
- make ::Sig::Parameter.new;
- return Nil;
- }
-
- my $default = $<default_value> ?? $<default_value>[0].ast !! Any;
-
- my $tag = $<quant> ~ ':' ~ $<kind>;
- if $tag eq '**:*' { $sorry = "Slice parameters NYI" }
- elsif $tag eq '*:*' { $slurpy = True }
- elsif $tag eq '|:*' { $slurpycap = True }
- elsif $tag eq '\\:!' { $rwt = True }
- elsif $tag eq '\\:?' { $rwt = True; $optional = True }
- elsif $tag eq ':!' { }
- elsif $tag eq ':*' { $optional = True }
- elsif $tag eq ':?' { $optional = True }
- elsif $tag eq '?:?' { $optional = True }
- elsif $tag eq '!:!' { }
- elsif $tag eq '!:?' { $optional = True }
- elsif $tag eq '!:*' { }
- else { $sorry = "Confusing parameters ($tag)" }
- if $sorry { $/.CURSOR.sorry($sorry); }
- my $p = $<param_var> // $<named_param>;
-
- make ::Sig::Parameter.new(name => ~$/, :$default,
- :$optional, :$slurpy, readonly => !$rw,
- :$slurpycap, rwtrans => $rwt, |$p.ast);
-}
-
-method capture($ ) {}
-method capterm($/) {
- my @args;
- if $<capture> {
- my $x = $<capture>[0]<EXPR>.ast;
- if $x.^isa(::Op::SimpleParcel) {
- @args = @($x.items);
- } else {
- @args = $x;
- }
- } elsif $<termish> {
- @args = ::Op::Paren.new(|node($/), inside => $<termish>.ast);
- }
- make ::Op::CallSub.new(|node($/), invocant => mklex($/, '&_make_capture'),
- args => @args);
-}
-method process_nibble($/, @bits, $prefix?) {
- my @acc;
- for @bits -> $n {
- my $ast = $n.ast;
-
- if $ast ~~ CClass {
- $n.CURSOR.sorry("Cannot use a character class in a string");
- $ast = "";
- }
-
- if $ast !~~ Op && defined $prefix {
- $ast = $ast.split(/^^<before \s>[ $prefix || \s* ]/).join("");
- }
-
- push @acc, $ast;
- }
-
- my $post = $/.CURSOR.postprocessor;
- make mkstringycat($/, @acc);
-
- if $post eq 'null' {
- # already OK
- }
- # actually quotewords is a bit trickier than this...
- elsif $post eq 'words' || $post eq 'quotewords' {
- my $sl = $/.ast;
- if !$sl.^isa(::Op::StringLiteral) {
- make ::Op::CallMethod.new(|node($/), :name<words>, receiver => $sl);
- }
- else {
- my @tok = $sl.text.words;
- @tok = map { ::Op::StringLiteral.new(|node($/), text => $_) }, @tok;
-
- make ((@tok == 1) ?? @tok[0] !!
- ::Op::SimpleParcel.new(|node($/), items => @tok));
- }
- }
- elsif $post eq 'path' {
- # TODO could stand to be a lot fancier.
- make ::Op::CallMethod(|node($/), receiver => $/.ast, :name<IO>);
- }
- elsif $post eq 'run' {
- make mkcall($/, 'rungather', $/.ast);
- }
- else {
- $/.CURSOR.sorry("Unhandled postprocessor $post");
- }
-
- $/.ast;
-}
-
-method circumfix:sym«< >» ($/) { make $<nibble>.ast }
-method circumfix:sym«<< >>» ($/) { make $<nibble>.ast }
-method circumfix:sym<« »> ($/) { make $<nibble>.ast }
-
-method postcircumfix:sym«< >» ($/) {
- make Operator.funop('&postcircumfix:<{ }>', 1, $<nibble>.ast);
-}
-
-method quote_mod:w ($) { }
-method quote_mod:ww ($) { }
-method quote_mod:p ($) { }
-method quote_mod:x ($) { }
-method quote_mod:to ($) { }
-method quote_mod:s ($) { }
-method quote_mod:a ($) { }
-method quote_mod:h ($) { }
-method quote_mod:f ($) { }
-method quote_mod:c ($) { }
-method quote_mod:b ($) { }
-my %opshortcut = (
- '@' => [ 'fetch' ],
- 'l' => [ 'letvar' ],
- 'ns' => [ 'newscalar' ],
- 'nsw' => [ 'newrwscalar' ],
- 's' => [ 'str' ],
- 'i' => [ 'int' ],
- 'b' => [ 'bool' ],
- 'd' => [ 'double' ],
- '==' => [ 'compare', '==' ], '!=' => [ 'compare', '!=' ],
- '>=' => [ 'compare', '>=' ], '<=' => [ 'compare', '<=' ],
- '<' => [ 'compare', '<' ], '>' => [ 'compare', '>' ],
- '+' => [ 'arith', '+' ], '-' => [ 'arith', '-' ],
- '*' => [ 'arith', '*' ], '/' => [ 'arith', '/' ],
-);
-
-method cgexp:op ($/) {
- my $l = ~$<cgopname>;
- my @p = @( %opshortcut{$l} // [ $l ] );
- make [@p, map *.ast, @( $<cgexp> )];
-}
-
-method statement_control:unless ($/) {
- make ::Op::Conditional.new(|node($/), check => $<xblock>.ast[0],
- false => self.block_to_immediate($/, 'cond', $<xblock>.ast[1]));
-}
-
-method statement_control:loop ($/) {
- my $body = self.block_to_immediate($/, 'loop', $<block>.ast);
- # XXX wrong interpretation
- my $init = $0 && $0[0]<e1>[0] ?? $0[0]<e1>[0].ast !! Any;
- my $cond = $0 && $0[0]<e2>[0] ?? $0[0]<e2>[0].ast !! Any;
- my $step = $0 && $0[0]<e3>[0] ?? $0[0]<e3>[0].ast !! Any;
-
- make ::Op::GeneralLoop.new(|node($/), :$body, :$init, :$cond, :$step);
-}
-
-method statement_control:repeat ($/) {
- my $until = $<wu> eq 'until';
- my $check = $<xblock> ?? $<xblock>.ast[0] !! $<EXPR>.ast;
- my $body = self.block_to_immediate($/, 'loop',
- $<xblock> ?? $<xblock>.ast[1] !! $<pblock>.ast);
- make ::Op::WhileLoop.new(|node($/), :$check, :$until, :$body, :once);
-}
-
-method escale ($/) { }
-method dec_number ($/) {
- make +((~$/).comb(/<-[_]>/).join(""));
-}
-}
-
-augment class CgOp {
-method letscope(*@items) { self._cgop('letscope', @items) }
-method xspan(*@items) { self._cgop('xspan', @items) }
-method bif_mod($x,$y) { self._cgop('bif_mod', $x, $y) }
-}
-
-augment class Op {
-class LetScope is Op {
- has $.transparent;
- has $.names;
- has $.inner;
-
- method zyg() { $.inner }
-
- method code($body) {
- CgOp.letscope(+$.transparent, @($.names), $.inner.cgop($body));
- }
-}
-
-class Control is Op {
- has $.payload = die "Control.payload required"; # Op
- has $.name = "";
- has $.number = die "Control.number required"; # Num
-
- method zyg() { $.payload }
-
- method code($body) {
- CgOp.control($.number, CgOp.null('frame'), CgOp.int(-1),
- ($.name eq '' ?? CgOp.null('str') !! CgOp.str($.name)),
- $.payload.cgop($body));
- }
-}
-
-class GeneralLoop is Op {
- has $.init; # Op
- has $.cond; # Op
- has $.step; # Op
- has $.body; # Op
-
- method zyg() { grep &defined, $.init, $.cond, $.step, $.body }
- method ctxzyg($) {
- ($.init ?? ($.init, 0) !! ()),
- ($.cond ?? ($.cond, 1) !! ()),
- ($.step ?? ($.step, 0) !! ()),
- $.body, 0
- }
-
- method code($body) { self.code_labelled($body,'') }
- method code_labelled($body, $l) {
- my $id = ::GLOBAL::NieczaActions.genid;
-
- CgOp.prog(
- ($.init ?? CgOp.sink($.init.cgop($body)) !! ()),
- CgOp.whileloop(0, 0,
- ($.cond ?? CgOp.obj_getbool($.cond.cgop($body)) !!
- CgOp.bool(1)),
- CgOp.prog(
- CgOp.sink(CgOp.xspan("redo$id", "next$id", 0,
- $.body.cgop($body), 1, $l, "next$id",
- 2, $l, "last$id", 3, $l, "redo$id")),
- ($.step ?? CgOp.sink($.step.cgop($body)) !! ()))),
- CgOp.label("last$id"),
- CgOp.corelex('Nil'));
- }
-}
-
-}
-
-augment class Op::WhileLoop { #OK exist
- method code_labelled($body, $l) {
- my $id = ::GLOBAL::NieczaActions.genid;
-
- CgOp.prog(
- CgOp.whileloop(+$.until, +$.once,
- CgOp.obj_getbool($.check.cgop($body)),
- CgOp.sink(CgOp.xspan("redo$id", "next$id", 0, $.body.cgop($body),
- 1, $l, "next$id", 2, $l, "last$id", 3, $l, "redo$id"))),
- CgOp.label("last$id"),
- CgOp.corelex('Nil'));
- }
-}
-
-augment class Op::ImmedForLoop { #OK exist
- method code_labelled($body, $l) {
- my $id = ::GLOBAL::NieczaActions.genid;
-
- CgOp.rnull(CgOp.letn(
- "!iter$id", CgOp.vvarlist_new_empty,
- $.var, CgOp.null('var'),
- CgOp.vvarlist_push(CgOp.letvar("!iter$id"),
- $.source.cgop($body)),
- CgOp.whileloop(0, 0,
- CgOp.iter_hasflat(CgOp.letvar("!iter$id")),
- CgOp.prog(
- CgOp.letvar($.var,
- CgOp.vvarlist_shift(CgOp.letvar("!iter$id"))),
- CgOp.sink(CgOp.xspan("redo$id", "next$id", 0,
- $.sink.cgop($body),
- 1, $l, "next$id",
- 2, $l, "last$id",
- 3, $l, "redo$id")))),
- CgOp.label("last$id")));
- }
-}
-
-augment class Op::When { #OK exist
- method code($body) {
- my $id = ::GLOBAL::NieczaActions.genid;
-
- CgOp.ternary(CgOp.obj_getbool(CgOp.methodcall(
- $.match.cgop($body), 'ACCEPTS', CgOp.scopedlex('$_'))),
- CgOp.xspan("start$id", "end$id", 0, CgOp.prog(
- CgOp.sink($.body.cgop($body)),
- CgOp.control(6, CgOp.null('frame'), CgOp.int(-1),
- CgOp.null('str'), CgOp.corelex('Nil'))),
- 7, '', "end$id"),
- CgOp.corelex('Nil'));
- }
-}
-
-augment class Op::Try { #OK exist
- method code($body) {
- my $id = ::GLOBAL::NieczaActions.genid;
-
- CgOp.xspan("start$id", "end$id", 1, $.body.cgop($body),
- 5, '', "end$id");
- }
-}
-
-augment class Op::TopicalHook { #OK exist
- method code($body) {
- my $id = ::GLOBAL::NieczaActions.genid;
-
- CgOp.xspan("start$id", "end$id", 0, $.inner.cgop($body),
- 6, '', "end$id");
- }
-}
-
-augment class Op::LabelHook { #OK exist
- method code($body) {
- my $id = ::GLOBAL::NieczaActions.genid;
-
- CgOp.xspan("start$id", "end$id", 0, $.inner.cgop($body),
- map({ 8, $_, "goto_$_" }, @$.labels));
- }
-}
-
my $usage = q:to/EOM/;
niecza -- a command line wrapper for Niecza
Please sign in to comment.
Something went wrong with that request. Please try again.