Implement a variant of viv's 'endsym' function

sorear · Feb 23, 2011 · 891071d · 891071d
1 parent 39b83a2
commit 891071d
Show file tree

Hide file tree

Showing 2 changed files with 45 additions and 5 deletions.
diff --git a/src/RxOp.pm6 b/src/RxOp.pm6
@@ -51,6 +51,7 @@ class Capturing is RxOp {
 
 class Sym is Capturing {
     has $.text; # Str, is rw
+    has $.endsym; # Str, is rw
     has $.igcase; # Bool
     has $.igmark; # Bool
 
@@ -59,25 +60,28 @@ class Sym is Capturing {
             :$captures);
     }
 
-    method check() { $.text = $*symtext; nextsame }
+    method check() { $.text = $*symtext; $.endsym = $*endsym; nextsame }
 
     method code($body) { #OK not used
         my $t = $.text;
         # We aren't going to make a real Match unless somebody comes up with
         # a good reason.
         my $p = CgOp.rxpushcapture(CgOp.string_var($t), @$.captures);
         my $ic = $.igcase ?? "NoCase" !! "";
+        my @e = !defined($.endsym) ?? () !!
+            ::RxOp::Subrule.new(method => $.endsym, :selfcut).code($body);
         if chars($t) == 1 {
-            $p, CgOp.rxbprim("ExactOne$ic", CgOp.char($t));
+            $p, CgOp.rxbprim("ExactOne$ic", CgOp.char($t)), @e;
         } else {
-            $p, CgOp.rxbprim("Exact$ic", CgOp.str($t));
+            $p, CgOp.rxbprim("Exact$ic", CgOp.str($t)), @e;
         }
     }
 
     method tocclist() { $!text.comb.map({ CClass.enum($_) }) }
 
     method lad() {
-        [ ($!igcase ?? 'StrNoCase' !! 'Str'), $!text ];
+        my $m = [ ($!igcase ?? 'StrNoCase' !! 'Str'), $!text ];
+        defined($!endsym) ?? [ 'Sequence', [ [ 'Method', $!endsym ], $m ] ] !! $m;
     }
 }
 

diff --git a/src/niecza b/src/niecza
@@ -1,5 +1,6 @@
 use Metamodel;
 use Op;
+use RxOp;
 use CClass;
 use CgOp;
 use Body;
@@ -25,6 +26,13 @@ use Operator;
 use OptRxSimple;
 use Sig;
 
+augment class RxOp::Sym { #OK exist
+    method lad() {
+        my $m = [ ($!igcase ?? 'StrNoCase' !! 'Str'), $!text ];
+        defined($!endsym) ?? [ 'Sequence', [$m, [ 'Method', $!endsym ]] ] !! $m;
+    }
+}
+
 augment class NieczaActions {
 method trait_mod:is ($/) {
     my $trait = ~$<longname>;
@@ -36,12 +44,22 @@ method trait_mod:is ($/) {
     } elsif $trait eq 'export' {
         make { export => [ 'DEFAULT', 'ALL' ] };
         $noparm = 'Export tags NYI';
-    } elsif ($trait eq 'rawcall') {
+    } elsif $trait eq 'endsym' {
+        my $text;
+        if !$<circumfix> || !$<circumfix>[0].ast.^isa(::Op::StringLiteral) {
+            $/.CURSOR.sorry("Argument to endsym must be a literal string");
+        } else {
+            $text = $<circumfix>[0].ast.text;
+        }
+        make { endsym => $text };
+    } elsif $trait eq 'rawcall' {
         make { nobinder => True };
     } elsif $trait eq 'return-pass' { # &return special
         make { return_pass => 1 };
     } elsif $trait eq 'parcel' {
         make { rwt => 1 };
+    } elsif $trait eq 'parcel' {
+        make { rwt => 1 };
     } else {
         make { $trait => True };
     }
@@ -51,6 +69,21 @@ method trait_mod:is ($/) {
     }
 }
 
+method op_for_regex($/, $rxop) {
+    my @lift = $rxop.oplift;
+    {
+        my $*paren = 0;
+        my $*dba = 'anonymous rule';
+        my $*symtext;
+        my $*endsym;
+        $rxop.check
+    }
+    my ($orxop, $mb) = OptRxSimple.run($rxop);
+    self.transparent($/, ::Op::RegexBody.new(|node($/), canback => $mb,
+            pre => @lift, rxop => $orxop),
+        class => 'Regex', type => 'regex', sig => Sig.simple.for_method);
+}
+
 method regex_def($/) {
     sub _symtext($name) {
         ($name ~~ /\:sym\<(.*)\>/) ?? ($name.substr(0, $/.from), ~$0) !!
@@ -102,13 +135,15 @@ method regex_def($/) {
             $/.CURSOR.sorry("Only simple {*} protoregexes with no parameters are supported");
             return Nil;
         }
+        @*MEMOS[0]<proto_endsym>{$basename} = $endsym;
         $isproto = True;
     } else {
         my $m2 = defined($symtext) ?? 'multi' !! 'only';
         if $*MULTINESS && $*MULTINESS ne $m2 {
             $/.CURSOR.sorry("Inferred multiness disagrees with explicit");
             return Nil;
         }
+        $endsym //= @*MEMOS[0]<proto_endsym>{$basename} if defined $basename;
     }
 
     if defined($path) && $scope ne 'our' {
@@ -139,6 +174,7 @@ method regex_def($/) {
     {
         my $*paren = 0;
         my $*symtext = $symtext;
+        my $*endsym = $endsym;
         my $*dba = $name // 'anonymous regex';
         $ast.check;
     }