From bca1172445d3254bd16d1b7e9aaae5889ec3e869 Mon Sep 17 00:00:00 2001 From: Stefan O'Rear Date: Fri, 16 Dec 2011 18:13:24 -0800 Subject: [PATCH] Implement calling my regex foo if in scope --- docs/TODO.S05 | 13 +++++------ lib/CodeGen.cs | 3 +++ src/niecza | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++ test2.pl | 11 +++++++++ 4 files changed, 81 insertions(+), 7 deletions(-) diff --git a/docs/TODO.S05 b/docs/TODO.S05 index 90b4bf40..36243539 100644 --- a/docs/TODO.S05 +++ b/docs/TODO.S05 @@ -15,16 +15,15 @@ All line numbers are relative to c4882a67. Also, deliberate discrepencies.) ( 535) No :rw ( 768) No internal smartmatches ( 924) $/ is a Cursor inside closures -( 933) Don't know how fail is supposed to work there -( 978) No negative quantifiers +( 933) Don't know how fail is supposed to work there DISCUSS +( 978) No negative quantifiers DUBIOUS (1057) No special handling of zero-width matches DISCUSS (1172) No auto-declared temporary variables $x = <.ident> (1178) No bindings to existing variables -(1186) No || @array temporal-alternation syntax DISCUSS PARSE +(1186) No || @array temporal-alternation syntax DISCUSS (1253) No handling of formal parameters in LTM (1258) No {*} and funky proto handling in general (1276) Declarativeness of constants is insufficiently general -(1388) never uses a lexical regex (1461) Arguments in <&foo(2)> not handled; STD parses EXPR but only this legal (1507) No support for indirect <::($name)> calls Also, nice fossil. @@ -43,15 +42,15 @@ All line numbers are relative to c4882a67. Also, deliberate discrepencies.) (2342) ::> is defined in terms of brackets, not temporal alternation (2380) No or (2460) $foo ~~ rule { } does not automatically dual-anchor (DISCUSS) -(2501) No (probable fossil) DISCUSS +(2501) No (probable fossil) DUBIOUS (2738) No success value; failed matches return Match (2818) In list context, $match[0] will return $match if $match[0] does not otherwise exist; useful for improving DWIM ness of lists (2851) @ does not seem to work (2868) No .values or .kv, .keys ignores numeric captures (2895) Undefined: caps, chunks, prematch, postmatch -(2910) No concept of cursor directionality -(3144) Missing captures don't produce Nil +(2910) No concept of cursor directionality DUBIOUS +(3144) Missing captures don't produce Nil DISCUSS (3718) $0=<.alpha>+ is processed backwards; $0=[<.alpha>]+ is fine (3750) No array aliasing (3923) No hash aliasing diff --git a/lib/CodeGen.cs b/lib/CodeGen.cs index aea2df63..8a4ba434 100644 --- a/lib/CodeGen.cs +++ b/lib/CodeGen.cs @@ -3910,6 +3910,9 @@ public class DowncallReceiver : CallReceiver { } else if (cmd == "sub_is_routine") { SubInfo s = (SubInfo)Handle.Unbox(args[1]); return s.mo.HasMRO(Kernel.RoutineMO); + } else if (cmd == "sub_is_regex") { + SubInfo s = (SubInfo)Handle.Unbox(args[1]); + return s.mo.HasMRO(Kernel.RegexMO); } else if (cmd == "sub_has_lexical") { SubInfo s = (SubInfo)Handle.Unbox(args[1]); return s.dylex.ContainsKey((string)args[2]); diff --git a/src/niecza b/src/niecza index 51c9f022..2f8722fe 100644 --- a/src/niecza +++ b/src/niecza @@ -163,6 +163,67 @@ method assertion:method ($/) { } } +method assertion:name ($/) { + my ($pname) = self.process_name($, :defer); + my $name = ~$; + + if !$pname { + $pname = { name => 'alpha' }; + $/.CURSOR.sorry('Method call requires a method name'); + } + + my @lex = $*CURLEX.lookup_lex("&$name"); + my $is_lexical = substr($/.orig, $/.from-1, 1) ne '.' && + @lex && @lex[0] eq 'sub' && @lex[4].is_regex; + + if $ { + make $.ast; + } elsif $name eq 'sym' { + $/.CURSOR.sorry(" is only valid in multiregexes") + unless defined %*RX; + make ::RxOp::Sym.new(igcase => %*RX, igmark => %*RX, + text => %*RX // '', endsym => %*RX); + } elsif $name eq 'before' { + make ::RxOp::Before.new(zyg => [$[0].ast]); + return Nil; + } elsif $name eq 'after' { + my @l = $[0].ast.tocclist; + if grep { !defined $_ }, @l { + $/.CURSOR.sorry("Unsuppored elements in after list"); + make ::RxOp::Sequence.new; + return Nil; + } + make ::RxOp::ZeroWidthCCs.new(neg => False, after => True, ccs => @l); + return; + } elsif !$ && !$ && !$pname && !$pname && + !$is_lexical { + make ::RxOp::Subrule.new(method => $pname); + } else { + my $args = $ ?? + [ self.op_for_regex($/, $.ast) ] !! + $ ?? $.ast !! []; + + if $pname { + $/.CURSOR.sorry('Indirect method calls NYI'); + $pname = {name => 'alpha'}; + } + + my $callop; + if $is_lexical { + $callop = ::Op::CallSub.new(invocant => mklex($/, "&$name"), + positionals => [ mklex($/, '$¢'), @$args ]); + } else { + $callop = ::Operator::Method.new(name => $pname, :$args, + package => $pname && $pname.xref)\ + .with_args($/, mklex($/, '$¢')); + } + + my $regex = self.rxembed($/, $callop, True); + + make ::RxOp::Subrule.new(regex => $regex); + } + make self.rxcapturize($/, ~$, $/.ast); +} method assertion:variable ($/) { given substr($/,0,1) { when '&' { diff --git a/test2.pl b/test2.pl index bdd03089..69d2d380 100644 --- a/test2.pl +++ b/test2.pl @@ -42,6 +42,17 @@ is ("fooooooo" ~~ / <@a3> /), 'fooooooo', '<@var> has longest-token semantics (compiling)'; is ("foo" ~~ /<."alpha"()>/), "f", "dottyop assertions work"; + + my regex sam { \d+ } + is ("fo23op" ~~ //), "23", "lexical regexes can be used without &"; + { + sub alpha() { } + is ("xyz" ~~ //), "x", "non-regex subs do not confuse"; + } + { + my regex alpha { . } + is ("4e" ~~ /<.alpha>/), "e", "leading dot forces method interpretation"; + } } {