Skip to content

Commit

Permalink
Rebuild regex engine using gather/take and coroutines
Browse files Browse the repository at this point in the history
  • Loading branch information
@sorear
sorear committed Aug 10, 2010
1 parent 6a1c284 commit c11c833
Show file tree
Hide file tree
Showing 4 changed files with 74 additions and 112 deletions.
8 changes: 4 additions & 4 deletions Niecza/Actions.pm
View file
Expand Up @@ -186,7 +186,7 @@ sub quote__S_Slash_Slash { my ($cl, $M) = @_;
my $slot = $cl->gensym;
# TODO should be a real pass.
local $::parenid = 0;
$M->{_ast} = RxOp::Export->new(zyg => [$M->{nibble}{_ast}])->closure;
$M->{_ast} = $M->{nibble}{_ast}->close_rx;
}

sub regex_block { my ($cl, $M) = @_;
Expand All @@ -209,7 +209,6 @@ sub regex_def { my ($cl, $M) = @_;

my $sig = $M->{signature}[0] ? $M->{signature}[0]{_ast}
: $cl->get_placeholder_sig($M);
$sig = $sig->for_regex;

if ($scope =~ /state|augment|supercede/) {
$M->sorry("Nonsensical scope $scope for regex");
Expand All @@ -220,13 +219,14 @@ sub regex_def { my ($cl, $M) = @_;
: '&' . $name;

local $::parenid = 0;
my ($cn, $op) = $M->{regex_block}{_ast}->term_rx;
$M->{_ast} = Op::SubDef->new(
var => $var, class => 'Regex',
method_too => ($scope eq 'has' ? $name : undef),
body => Body->new(
type => 'regex',
signature => $sig,
do => RxOp::Export->new(zyg => [$M->{regex_block}{_ast}])->op));
signature => $sig->for_regex($cn),
do => $op));
}

sub regex_declarator { my ($cl, $M) = @_;
Expand Down
106 changes: 57 additions & 49 deletions RxOp.pm
View file
Expand Up @@ -11,59 +11,72 @@ use CgOp;

has zyg => (isa => 'ArrayRef[RxOp]', is => 'ro', default => sub { [] });

my $i = 0;
sub _closurize {
my ($self, $op) = @_;
Op::SubDef->new(var => 'rx!' . ($i++), class => 'Regex', body =>
Body->new(
type => 'regex',
signature => Sig->simple('$¢'),
# XXX transparent bodies with signatures are not yet handled well
# transparent => 1,
# op(cn, cont): provides cn in environment, calls cont per result, then
# returns; -> (cn, cont)
# closure: like op but just returns a function, takes cn/cont though

sub _close {
my ($self, $type, $parms, $op) = @_;
Op::SubDef->new(var => Niecza::Actions->gensym, class => ucfirst($type),
body => Body->new(
type => $type,
signature => Sig->simple(@$parms),
do => $op));
}

sub closure {
my ($self) = @_;
$self->_closurize($self->op);
sub _close_k {
my ($self, $cn, $cont) = @_;
$self->_close('sub', [$cn], $cont);
}

__PACKAGE__->meta->make_immutable;
no Moose;
}

{
package RxOp::String;
use Moose;
extends 'RxOp';
sub _close_op {
my ($self, $op) = @_;
my $icn = Niecza::Actions->gensym;
my $icv = Niecza::Actions->gensym;
my $icont = Op::CallSub->new(
invocant => Op::Lexical->new(name => $icv),
positionals => [ Op::Lexical->new(name => $icn) ]);
my ($cn, $cont) = $op->op($icn, $icont);
$self->_close('sub', [$cn, $icv], $cont);
}

has text => (isa => 'Str', is => 'ro', required => 1);
sub term_rx {
my ($self) = @_;
my $icn = Niecza::Actions->gensym;
my $icont = Op::Take->new(value => Op::Lexical->new(name => $icn));
my ($cn, $cont) = $self->op($icn, $icont);
$cn, Op::Gather->new(
var => Niecza::Actions->gensym,
body => Body->new(type => 'gather', do => $cont));
}

sub op {
sub close_rx {
my ($self) = @_;
Op::CallSub->new(
invocant => Op::Lexical->new(name => '&_rxstr'),
positionals => [
Op::Lexical->new(name => '$¢'),
Op::StringLiteral->new(text => $self->text)]);
my ($cn, $op) = $self->term_rx;
$self->_close('regex', [$cn], $op);
}

__PACKAGE__->meta->make_immutable;
no Moose;
}

{
package RxOp::Export;
package RxOp::String;
use Moose;
extends 'RxOp';

# zyg * 1
has text => (isa => 'Str', is => 'ro', required => 1);

sub op {
my ($self) = @_;
Op::CallSub->new(
invocant => Op::Lexical->new(name => '&_rxexport'),
positionals => [$self->zyg->[0]->op]);
my ($self, $cn, $cont) = @_;
my $icn = Niecza::Actions->gensym;
$icn, Op::CallSub->new(
invocant => Op::Lexical->new(name => '&_rxstr'),
positionals => [
Op::Lexical->new(name => $icn),
Op::StringLiteral->new(text => $self->text),
$self->_close_k($cn, $cont)
]);
}

__PACKAGE__->meta->make_immutable;
Expand All @@ -81,12 +94,14 @@ use CgOp;

my %qf = ( '+', 'plus', '*', 'star', '?', 'opt' );
sub op {
my ($self) = @_;
Op::CallSub->new(
my ($self, $cn, $cont) = @_;
my $icn = Niecza::Actions->gensym;
$icn, Op::CallSub->new(
invocant => Op::Lexical->new(name => '&_rx' . $qf{$self->type}),
positionals => [
Op::Lexical->new(name => '$¢'),
$self->zyg->[0]->closure]);
Op::Lexical->new(name => $icn),
$self->_close_op($self->zyg->[0]),
$self->_close_k($cn, $cont)]);
}

__PACKAGE__->meta->make_immutable;
Expand All @@ -101,20 +116,13 @@ use CgOp;
# zyg * N

sub op {
my ($self) = @_;
my @zyg = map { $_->op } @{ $self->zyg };

while (@zyg >= 2) {
my $r = pop @zyg;
my $l = pop @zyg;
push @zyg, Op::CallSub->new(
invocant => Op::Lexical->new(name => '&_rxlazymap'),
positionals => [ $l, $self->_closurize($r) ]);
my ($self, $cn, $cont) = @_;

for (reverse @{ $self->zyg }) {
($cn, $cont) = $_->op($cn, $cont);
}

$zyg[0] || Op::CallSub->new(
invocant => Op::Lexical->new(name => '&_rxone'),
positionals => [ Op::Lexical->new(name => '$¢') ]);
$cn, $cont;
}

__PACKAGE__->meta->make_immutable;
Expand Down
68 changes: 11 additions & 57 deletions SAFE.setting
View file
Expand Up @@ -887,75 +887,29 @@ my class Cursor {
(cast Int32 (unbox Double (@ (l $np)))))) } }
}
# Outside a regex, a result is a lazy list.
# Inside a regex, a result is a coroutiney thing (details will change)
sub _rxexport($cs) { unfold({ $cs() // EMPTY }) }
sub _rxlazymap($cs, $sub) {
my $k = sub { Any };
#say "in rxlazymap (1)";
sub get() {
#say "in rxlazymap (2)";
$k && ($k() || do {
#say "in rxlazymap (3)";
$k = $cs();
$k = ($k && $sub($k));
#say "in rxlazymap (4)";
get();
})
}
}
sub _rxdisj($cs1, $cs2) {
my $k1 = $cs1;
my $k2 = $cs2;
sub {
#say "in rxdisj (1)";
$k1() || ($k2 && do {
$k1 = $k2;
$k2 = Any;
#say "in rxdisj (2)";
$k1();
})
}
}
sub _rxone($C) {
my $k = $C;
sub {
my $x = $k;
$k = Any;
#say "in rxone" ~ $x;
$x;
}
}
sub _rxnone { Any };
sub _rxstar($C, $sub) {
#say "in rxstar recursion";
_rxdisj(_rxlazymap($sub($C), sub ($C) { _rxstar($C, $sub) }),
_rxone($C));
sub _rxstar($C, $f, $k) {
$f($C, -> $nC { _rxstar($nC, $f, $k) });
$k($C);
}
sub _rxopt($C, $sub) {
_rxdisj($sub($C), _rxone($C))
sub _rxopt($C, $f, $k) {
$f($C, $k);
$k($C);
}
sub _rxplus($C, $sub) {
_rxlazymap($sub($C), sub ($C) { _rxstar($C, $sub) })
sub _rxplus($C, $f, $k) {
$f($C, -> $nC { _rxstar($nC, $f, $k) });
}
sub _rxstr($C, $str) {
sub _rxstr($C, $str, $k) {
#say "_rxstr : " ~ ($C.str ~ (" @ " ~ ($C.from ~ (" ? " ~ $str))));
Q:CgOp {
(letn rt (rawcall (unbox Cursor (@ (l $C))) Exact
(unbox String (@ (l $str))))
[ternary
(!= (l rt) (null Cursor))
(subcall (@ (l &_rxone)) (box (@ (l $C)) (l rt)))
(l &_rxnone)])
(subcall (@ (l $k)) (box (@ (l $C)) (l rt)))
(null Variable)])
};
}
Expand Down
4 changes: 2 additions & 2 deletions Sig.pm
View file
Expand Up @@ -132,8 +132,8 @@ use 5.010;
}

sub for_regex {
my $self = shift;
my $sp = Sig::Parameter->new(slot => '$¢', name => '$¢');
my ($self, $cn) = @_;
my $sp = Sig::Parameter->new(slot => $cn, name => '$¢');
Sig->new(params => [ $sp, @{ $self->params } ]);
}

Expand Down

0 comments on commit c11c833

Please sign in to comment.