[nrx] compile /literalstring/

src/Niecza/Actions.pm

@@ -289,11 +289,13 @@ sub quote__S_Q { my ($cl, $M) = @_;
 }
 
 sub quote__S_Slash_Slash { my ($cl, $M) = @_;
-    my $slot = $cl->gensym;
-    # TODO should be a real pass.
-    local $::parenid = 0;
-    local $::symtext;
-    $M->{_ast} = $M->{nibble}{_ast}->close_rx;
+    $M->{_ast} = Op::SubDef->new(
+        var  => $cl->gensym,
+        body => Body->new(
+            class => 'Regex',
+            type  => 'regex',
+            signature => Sig->simple->for_regex,
+            do => Op::RegexBody->new(rxop => $M->{nibble}{_ast})));
 }
 
 sub regex_block { my ($cl, $M) = @_;
@@ -315,7 +317,7 @@ sub regex_def { my ($cl, $M) = @_;
     }
 
     my $isproto;
-    local $::symtext =
+    my $symtext =
         !defined($name) ? undef :
         ($name =~ /:sym<(.*)>/) ? $1 :
         ($name =~ /:(\w+)/) ? $1 :
@@ -360,8 +362,6 @@ sub regex_def { my ($cl, $M) = @_;
     my $var = ($scope eq 'anon' || $scope eq 'has') ? $cl->gensym
         : '&' . $name;
 
-    local $::parenid = 0;
-
     my $ast = $M->{regex_block}{_ast};
     if ($isproto) {
         $ast = RxOp::ProtoRedis->new(name => $name);

src/Op.pm

@@ -1,5 +1,6 @@
 use strict;
 use warnings;
+use utf8;
 use 5.010;
 
 use CgOp;
@@ -1007,6 +1008,32 @@ use CgOp;
     no Moose;
 }
 
+{
+    package Op::RegexBody;
+    use Moose;
+    extends 'Op';
+
+    has rxop => (isa => 'RxOp', is => 'ro', required => 1);
+
+    sub zyg { $_[0]->rxop->opzyg }
+
+    sub code {
+        my ($self, $body) = @_;
+
+        CgOp::prog(
+            CgOp::setfield('rx', CgOp::callframe,
+                CgOp::rawnew('RxFrame', CgOp::cast('Cursor',
+                        CgOp::fetch(CgOp::scopedlex('$¢'))))),
+            $self->rxop->code($body),
+            CgOp::rawccall(CgOp::getfield('rx', CgOp::callframe), 'End'),
+            CgOp::rawccall(CgOp::getfield('rx', CgOp::callframe), 'Backtrack'),
+            CgOp::null('Variable'));
+    }
+
+    __PACKAGE__->meta->make_immutable;
+    no Moose;
+}
+
 ### BEGIN DESUGARING OPS
 # These don't appear in source code, but are used by other ops to preserve
 # useful structure.

src/RxOp.pm

@@ -11,51 +11,7 @@ use CgOp;
 
     has zyg => (isa => 'ArrayRef[RxOp]', is => 'ro', default => sub { [] });
 
-    # 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,
-            once => 1, body => Body->new(
-                type        => $type,
-                class       => ucfirst($type),
-                signature   => Sig->simple(@$parms),
-                do          => $op));
-    }
-
-    sub _close_k {
-        my ($self, $cn, $cont) = @_;
-        $self->_close('sub', [$cn], $cont);
-    }
-
-    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);
-    }
-
-    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 close_rx {
-        my ($self) = @_;
-        my ($cn, $op) = $self->term_rx;
-        $self->_close('regex', [$cn], $op);
-    }
+    sub opzyg { map { $_->opzyg } @{ $_[0]->zyg } }
 
     __PACKAGE__->meta->make_immutable;
     no Moose;
@@ -68,16 +24,14 @@ use CgOp;
 
     has text => (isa => 'Str', is => 'ro', required => 1);
 
-    sub 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)
-            ]);
+    sub code {
+        my ($self, $body) = @_;
+        my $t = $self->text;
+        if (length($t) == 1) {
+            CgOp::rxbprim('ExactOne', CgOp::char($t));
+        } else {
+            CgOp::rxbprim('Exact', CgOp::clr_string($t));
+        }
     }
 
     sub lad {
@@ -170,14 +124,10 @@ use CgOp;
 
     # zyg * N
 
-    sub op {
-        my ($self, $cn, $cont) = @_;
-
-        for (reverse @{ $self->zyg }) {
-            ($cn, $cont) = $_->op($cn, $cont);
-        }
+    sub code {
+        my ($self, $body) = @_;
 
-        $cn, $cont;
+        CgOp::prog(map { $_->code($body) } @{ $self->zyg });
     }
 
     sub lad {

src/Sig.pm

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

test2.pl

@@ -3,21 +3,21 @@
 
 #ok '{}' ~~ / \{ <.ws> \} /, 'ws matches between \W';
 
-sub rxt($C) {
-    Q:CgOp {
-        (prog
-          (setfield rx (callframe) (rawnew RxFrame (cast Cursor (@ {$C}))))
-          (rxpushb SEQALT b1)
-          (rxbprim ExactOne (char x))
-          (goto b2)
-          (label b1)
-          (rxbprim ExactOne (char y))
-          (label b2)
-          (rawccall (getfield rx (callframe)) End)
-          (rawccall (getfield rx (callframe)) Backtrack)
-          (null Variable))
-    }
-}
+#sub rxt($C) {
+#    Q:CgOp {
+#        (prog
+#          (setfield rx (callframe) (rawnew RxFrame (cast Cursor (@ {$C}))))
+#          (rxpushb SEQALT b1)
+#          (rxbprim ExactOne (char x))
+#          (goto b2)
+#          (label b1)
+#          (rxbprim ExactOne (char y))
+#          (label b2)
+#          (rawccall (getfield rx (callframe)) End)
+#          (rawccall (getfield rx (callframe)) Backtrack)
+#          (null Variable))
+#    }
+#}
 
 PRE-INIT {
     Q:CgOp {
@@ -32,8 +32,11 @@ ($C)
     }
 }
 
-is +rxt(Cursor.new("x")), 1, "/x||y/ ~~ x";
-is +rxt(Cursor.new("y")), 1, "/x||y/ ~~ y";
-is +rxt(Cursor.new("z")), 0, "/x||y/ !~~ z";
+is +("x" ~~ /x/), 1, "x ~~ /x/";
+is +("y" ~~ /x/), 0, "y !~~ /x/";
+
+#is +rxt(Cursor.new("x")), 1, "/x||y/ ~~ x";
+#is +rxt(Cursor.new("y")), 1, "/x||y/ ~~ y";
+#is +rxt(Cursor.new("z")), 0, "/x||y/ !~~ z";
 
 done-testing;