make simple (really simple) match work

rakudo-p5 · Mar 30, 2013 · 3a7bddc · 3a7bddc
1 parent 8e169cc
commit 3a7bddc
Show file tree

Hide file tree

Showing 3 changed files with 32 additions and 7 deletions.
diff --git a/lib/Perl6/P5Actions.pm b/lib/Perl6/P5Actions.pm
@@ -2873,7 +2873,7 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
             #$past := %*RX<P5>
             #    ?? %*LANG<P5Regex-actions>.qbuildsub($qast, $block, code_obj => $code)
             #    !! %*LANG<Regex-actions>.qbuildsub($qast, $block, code_obj => $code);
-            $past := %*LANG<P5Regex-actions>.qbuildsub($qast, $block, code_obj => $code)
+            $past := %*LANG<Regex-actions>.qbuildsub($qast, $block, code_obj => $code)
         }
         $past.name($name);
         $past.blocktype("declaration");
@@ -4346,6 +4346,8 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
         '==>>', -> $/, $sym { make_feed($/) },
         '<==',  -> $/, $sym { make_feed($/) },
         '<<==', -> $/, $sym { make_feed($/) },
+        '=~',   -> $/, $sym { make_match($/, 0) },
+        '!~',   -> $/, $sym { make_match($/, 1) },
         '~~',   -> $/, $sym { make_smartmatch($/, 0) },
         '!~~',  -> $/, $sym { make_smartmatch($/, 1) },
         '=',    -> $/, $sym { assign_op($/, $/[0].ast, $/[1].ast) },
@@ -4508,6 +4510,27 @@ class Perl6::P5Actions is HLL::Actions does STDActions {
         return $result;
     }
 
+    sub make_match($/, $negated) {
+        my $lhs := $/[0].ast;
+        my $rhs := $/[1].ast;
+
+        my $past := QAST::Op.new(
+            :node($/),
+            :op('callmethod'), :name( $rhs<is_subst> ?? 'subst' !! 'match' ),
+            $lhs,
+            $rhs
+        );
+
+        if $negated {
+            $past := QAST::Op.new( :op('call'), :name('&prefix:<!>'), $past );
+        }
+
+        make QAST::Op.new( :op('p6store'),
+            QAST::Var.new(:name('$/'), :scope('lexical')),
+            $past
+        );
+    }
+
     sub make_smartmatch($/, $negated) {
         my $lhs := $/[0].ast;
         my $rhs := $/[1].ast;

diff --git a/lib/Perl6/P5Grammar.pm b/lib/Perl6/P5Grammar.pm
@@ -2746,7 +2746,7 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD5 {
 #    }
     token quote:sym</ />  {
         :my %*RX;
-        '/' <nibble(self.quote_lang(%*LANG<P5Regex>, '/', '/'))> [ '/' || <.panic: "Unable to parse regex; couldn't find final '/'"> ]
+        '/' <nibble(self.quote_lang(%*LANG<Regex>, '/', '/'))> [ '/' || <.panic: "Unable to parse regex; couldn't find final '/'"> ]
         <.old_rx_mods>?
     }
 
@@ -2768,27 +2768,27 @@ grammar Perl6::P5Grammar is HLL::Grammar does STD5 {
     token quote:sym<qr> {
         <sym> »
         #<quibble( self.cursor_fresh( %*LANG<P5Regex> ) )>
-        <.quibble(%*LANG<P5Regex>)>
+        <.quibble(%*LANG<Regex>)>
         <rx_mods>?
     }
 
     token quote:sym<m>  {
         <sym> »
         #<quibble( self.cursor_fresh( %*LANG<P5Regex> ) )>
-        <.quibble(%*LANG<P5Regex>)>
+        <.quibble(%*LANG<Regex>)>
         <rx_mods>?
     }
 
     token quote:sym<s> {
         <sym> »
         #<pat=sibble( self.cursor_fresh( %*LANG<P5Regex> ), self.cursor_fresh( %*LANG<Q> ).tweak(:qq))>
-        <pat=sibble(%*LANG<P5Regex>, %*LANG<Q>)>
+        <pat=sibble(%*LANG<Regex>, %*LANG<Q>)>
         <rx_mods>?
     }
 
     token quote:sym<tr> {
         #<sym> » <pat=tribble( self.cursor_fresh( %*LANG<P5Regex> ))>
-        <sym> » <pat=tribble(%*LANG<P5Regex>)>
+        <sym> » <pat=tribble(%*LANG<Regex>)>
         <tr_mods>?
     }
 
@@ -4044,7 +4044,7 @@ grammar Perl6::P5QGrammar is HLL::Grammar does STD5 {
 
     method tweak_regex($v) {
         self.truly($v, ':regex');
-        return %*LANG<P5Regex>;
+        return %*LANG<Regex>;
     }
 } # end grammar
 

diff --git a/lib/v5.pm b/lib/v5.pm
@@ -17,3 +17,5 @@ $*W.HOW.mixin( $*W, Perl6::P5World );
 %*LANG<MAIN-actions> := Perl6::P5Actions;
 %*LANG<Q> := Perl6::P5QGrammar;
 %*LANG<Q-actions> := Perl6::P5QActions;
+%*LANG<Regex> := Perl6::P5RegexGrammar;
+%*LANG<Regex-actions> := Perl6::P5RegexActions;