Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
[v6] mergeback
  • Loading branch information
@sorear
sorear committed Jan 12, 2011
1 parent d4cf9df commit 1b79755
Show file tree
Hide file tree
Showing 6 changed files with 19 additions and 199 deletions.
11 changes: 7 additions & 4 deletions v6/NieczaActions.pm6
View file
Expand Up @@ -45,6 +45,10 @@ method FALLBACK($meth, $/) {
if $meth eq '::($name)' { # XXX STD miscompilation
if $<O><prec> eq 't=' { # additive
make ::Op::Lexical.new(|node($/), name => '&infix:<' ~ self.get_op_sym($/) ~ '>');
} elsif $<semilist> && $<O><prec> eq 'y=' {
my $sym = $*GOAL eq '}' ?? '{ }' !! $*GOAL eq ']' ?? '[ ]' !!
die "Unhandled postcircumfix ending in $*GOAL";
make { postcircumfix => $sym, args => $<semilist>.ast };
}
return Nil;
} elsif substr($meth,0,7) eq 'prefix:' {
Expand Down Expand Up @@ -516,7 +520,7 @@ my %LISTrx_types = (
'||' => ::RxOp::SeqAlt,
);

sub LISTrx($/) {
method LISTrx($/) {
make %LISTrx_types{$<delims>[0]<sym>}.new(zyg =>
[ map *.ast, @( $<list> ) ], dba => %*RX<dba>);
}
Expand Down Expand Up @@ -1057,8 +1061,8 @@ method infix_prefix_meta_operator:sym<Z> ($/) {
}

method infixish($/) {
if $<colonpair> {
return Nil; # handled in POST
if $<colonpair> || $<regex_infix> {
return Nil; # handled elsewhere
}

if $<assign_meta_operator> {
Expand Down Expand Up @@ -2377,7 +2381,6 @@ method get_placeholder_sig($/) {
list => (substr($t,0,1) eq '@'), hash => (substr($t,0,1) eq '%'));
} else {
$/.CURSOR.sorry('Named placeholder parameters NYI');
return Sig.simple;
}
}
return Sig.new(params => @parms);
Expand Down
3 changes: 3 additions & 0 deletions v6/Op.pm6
View file
Expand Up @@ -249,6 +249,9 @@ class HereStub is Op {
has $.node = die "HereStub.node required";

method zyg() {
if defined($.node.[0]) && $.node.[0] ~~ Match {
$.node.[0] = $.node.[0]<nibbler>.ast
}
$.node.[0] // die "Here document used before body defined";
}

Expand Down
2 changes: 1 addition & 1 deletion v6/OptRxSimple.pm6
View file
Expand Up @@ -79,7 +79,7 @@ augment class RxOp::Alt { #OK exist
method rxsimp($cut) {
my @kids = map *.rxsimp($cut), @$.zyg;
::RxOp::Alt.new(
lads => [ map { OptRxSimple.run_lad($_) }, @$.lads ],
optimized_lads => [ map { OptRxSimple.run_lad($_.lad) }, @$.zyg ],
dba => $.dba,
zyg => @kids);
}
Expand Down
5 changes: 3 additions & 2 deletions v6/RxOp.pm6
View file
Expand Up @@ -441,7 +441,7 @@ class Subrule is Capturing {
passcap => $!passcap, _passcapltm => $!_passcapltm,
_passcapzyg => $!_passcapzyg, selfcut => $!selfcut,
zerowidth => $!zerowidth, negative => $!negative,
captures => $!captures, |%_);
captures => $.captures, |%_);
}

method opzyg() { $!regex // Nil }
Expand Down Expand Up @@ -552,9 +552,10 @@ class SetLang is RxOp {
}

class Alt is AltBase {
has $.optimized_lads;
method code($body) {
my @ls = map { self.label }, @$.zyg;
my @lads = map { $_.lad }, @$.zyg;
my @lads = @( $.optimized_lads // (map { $_.lad }, @$.zyg) );
my $end = self.label;

die "check screwed up" unless defined $.dba;
Expand Down
10 changes: 5 additions & 5 deletions v6/STD.pm6
View file
Expand Up @@ -742,7 +742,7 @@ class Herestub {
}

role herestop {
token stopper { ^^ {} $<ws>=(\h*?) $*DELIM \h* <.unv>?? $$ \v? }
token stopper { ^^ {} \h*? $*DELIM \h* <.unv>?? $$ \v? }
}

# XXX be sure to temporize @herestub_queue on reentry to new line of heredocs
Expand All @@ -753,9 +753,9 @@ method heredoc () {
my $*DELIM = $herestub.delim;
my $lang = $herestub.lang.mixin( herestop );
my $doc;
if ($doc,) = $here.nibble($lang) {
$here = $doc.trim_heredoc();
if defined($doc = first /:r :lang($lang) <nibbler> <stopper>/.($here)) {
$herestub.writeback.[0] = $doc;
$here = $here.cursor($doc.to);
# $herestub.orignode<doc> = $doc; NIECZA immutable matches
}
else {
Expand All @@ -778,7 +778,7 @@ token quibble ($l) {
if $lang.hereinfo.[0] {
push @herestub_queue,
Herestub.new(
delim => $<nibble><nibbles>[0]<TEXT>,
delim => ~$<nibble>,
orignode => $¢,
writeback => $lang.hereinfo.[1],
lang => $lang.hereinfo.[0],
Expand Down Expand Up @@ -5484,7 +5484,7 @@ method add_placeholder($name) {
my $varname = $name;
my $twigil = '';
my $signame;
my $signame = $varname;
my $M;
if _subst($M, $varname, /<[ ^ : ]>/, "") {
$twigil = $M.Str;
Expand Down
187 changes: 0 additions & 187 deletions v6/harness
View file
Expand Up @@ -23,193 +23,6 @@ use CClass;
use Sig;
use OptRxSimple;
use RxOp;
use STD;

augment class NieczaActions {
sub node($M) { { line => $M.cursor.lineof($M.to) } }
sub mkcall($/, $name, *@positionals) {
::Op::CallSub.new(|node($/),
invocant => ::Op::Lexical.new(|node($/), :$name), :@positionals);
}
my %LISTrx_types = (
'&' => ::RxOp::Conj,
'|' => ::RxOp::Alt,
'&&' => ::RxOp::SeqConj,
'||' => ::RxOp::SeqAlt,
);

method LISTrx($/) {
make %LISTrx_types{$<delims>[0]<sym>}.new(zyg =>
[ map *.ast, @( $<list> ) ], dba => %*RX<dba>);
}
method infixish($/) {
if $<colonpair> || $<regex_infix> {
return Nil; # handled elsewhere
}

if $<assign_meta_operator> {
# TODO: there should probably be at least a potential for others

make mkcall($/, '&assignop', $<infix>.ast);
} else {
make $<infix>.ast;
}
}
method get_placeholder_sig($/) {
# for some reason, STD wants to deparse this
my @things = $*CURLEX<$?SIGNATURE>.split(", ");
shift @things if @things[0] eq '';
my @parms;
for @things -> $t {
if substr($t, 0, 9) eq '$_ is ref' {
push @parms, ::Sig::Parameter.new(optional => True,
slot => '$_', name => '$_');
} elsif $t eq '*@_' {
push @parms, ::Sig::Parameter.new(slurpy => True, slot => '@_',
list => True, name => '*@_');
} elsif defined '$@%&'.index(substr($t,0,1)) {
push @parms, ::Sig::Parameter.new(slot => $t, name => $t,
list => (substr($t,0,1) eq '@'), hash => (substr($t,0,1) eq '%'));
} else {
$/.CURSOR.sorry('Named placeholder parameters NYI');
}
}
return Sig.new(params => @parms);
}
method FALLBACK($meth, $/) {
if $meth eq '::($name)' { # XXX STD miscompilation
if $<O><prec> eq 't=' { # additive
make ::Op::Lexical.new(|node($/), name => '&infix:<' ~ self.get_op_sym($/) ~ '>');
} elsif $<semilist> && $<O><prec> eq 'y=' {
my $sym = $*GOAL eq '}' ?? '{ }' !! $*GOAL eq ']' ?? '[ ]' !!
die "Unhandled postcircumfix ending in $*GOAL";
make { postcircumfix => $sym, args => $<semilist>.ast };
}
return Nil;
} elsif substr($meth,0,7) eq 'prefix:' {
} elsif substr($meth,0,8) eq 'postfix:' {
} elsif substr($meth,0,6) eq 'infix:' {
make ::Op::Lexical.new(|node($/), name => '&infix:<' ~ self.get_op_sym($/) ~ '>');
return Nil;
} else {
$/.CURSOR.sorry("Action method $meth not yet implemented");
}
}
}

augment class STD { #OK exist
sub _subst($M is rw, $text is rw, $regex, $repl) {
$text = $text.Str;
$M = ($text ~~ $regex);
if $M {
$text = $text.substr(0, $M.from) ~
(($repl ~~ Str) ?? $repl !! $repl()) ~
$text.substr($M.to, $text.chars - $M.to);
}
?$M;
}
method add_placeholder($name) {
my $decl = $*CURLEX.<!IN_DECL> // '';
$decl = ' ' ~ $decl if $decl;
my $*IN_DECL = 'variable';

if $*SIGNUM {
return self.sorry("Placeholder variable $name is not allowed in the$decl signature");
}
elsif my $siggy = $*CURLEX.<$?SIGNATURE> {
return self.sorry("Placeholder variable $name cannot override existing signature $siggy");
}
if not $*CURLEX.<!NEEDSIG> {
if $*CURLEX === $*UNIT {
return self.sorry("Placeholder variable $name may not be used outside of a block");
}
return self.sorry("Placeholder variable $name may not be used here because the surrounding$decl block takes no signature");
}
if $name ~~ /\:\:/ {
return self.sorry("Placeholder variable $name may not be package qualified");
}

my $varname = $name;
my $twigil = '';
my $signame = $varname;
my $M;
if _subst($M, $varname, /<[ ^ : ]>/, "") {
$twigil = $M.Str;
$signame = ($twigil eq ':' ?? ':' !! '') ~ $varname;
}
return self if $*CURLEX.{'%?PLACEHOLDERS'}{$signame}++;

if $*CURLEX{$varname} {
return self.sorry("$varname has already been used as a non-placeholder in the surrounding$decl block,\n so you will confuse the reader if you suddenly declare $name here");
}

self.add_my_name($varname);
$*CURLEX{$varname}<used> = 1;
self;
}
role herestop1 {
token stopper { ^^ {} \h*? $*DELIM \h* <.unv>?? $$ \v? }
}

# XXX be sure to temporize @herestub_queue on reentry to new line of heredocs
our @herestub_queue;
token quibble ($l) {
:my ($lang, $start, $stop);
<babble($l)>
{ my $B = $<babble><B>; ($lang,$start,$stop) = @$B; }

$start <nibble($lang)> [ $stop || <.panic: "Couldn't find terminator $stop"> ]

{
if $lang.hereinfo.[0] {
push @herestub_queue,
::STD::Herestub.new(
delim => ~$<nibble>,
orignode => $¢,
writeback => $lang.hereinfo.[1],
lang => $lang.hereinfo.[0],
);
}
}
}

method heredoc () {
my $here = self;
while my $herestub = shift @herestub_queue {
my $*DELIM = $herestub.delim;
my $lang = $herestub.lang.mixin( herestop1 );
my $doc;
if defined($doc = first /:r :lang($lang) <nibbler> <stopper>/.($here)) {
$herestub.writeback.[0] = $doc;
$here = $here.cursor($doc.to);
# $herestub.orignode<doc> = $doc; NIECZA immutable matches
}
else {
self.panic("Ending delimiter $*DELIM not found");
}
}
return self.cursor($here.pos); # return to initial type
}
}

augment class Op::HereStub { #OK exist
method zyg() {
if defined($.node.[0]) && $.node.[0] ~~ Match {
$.node.[0] = $.node.[0]<nibbler>.ast
}
$.node.[0] // die "Here document used before body defined";
}
}

augment class RxOp::Subrule { #OK exist
method clone(*%_) {
self.WHAT.new(method => $!method, regex => $!regex,
passcap => $!passcap, _passcapltm => $!_passcapltm,
_passcapzyg => $!_passcapzyg, selfcut => $!selfcut,
zerowidth => $!zerowidth, negative => $!negative,
captures => $.captures, |%_);
}
}

# XXX mega hack.
my class Instant {
Expand Down

0 comments on commit 1b79755

Please sign in to comment.