Initial code for subrule peeking.

perl6 · Oct 22, 2009 · c82db7d · c82db7d
1 parent 9197d53
commit c82db7d
Show file tree

Hide file tree

Showing 5 changed files with 675 additions and 571 deletions.
diff --git a/build/Makefile.in b/build/Makefile.in
@@ -136,13 +136,13 @@ $(P6GRAMMAR_PBC_1): $(P6GRAMMAR_PBC_0) $(P6REGEX_PBC_1) $(P6GRAMMAR_A) $(P6GRAMM
 	$(PARROT) --include=$(STAGE1) -o $(P6GRAMMAR_PBC_1) \
 	    src/Regex/P6Grammar.pir
 
-$(P6REGEX_PBC): $(P6GRAMMAR_PBC_1) $(P6REGEX_A) $(P6REGEX_SOURCES)
+$(P6REGEX_PBC): $(P6GRAMMAR_PBC) $(P6REGEX_A) $(P6REGEX_SOURCES)
 	$(PARROT) --library=$(STAGE1) $(P6GRAMMAR_PBC_1) \
 	    --target=pir --output=$(P6REGEX_G) \
 	    src/Regex/P6Regex/Grammar.pm
 	$(PARROT) -o $(P6REGEX_PBC) src/Regex/P6Regex.pir
 
-$(P6GRAMMAR_PBC): $(P6GRAMMAR_PBC_1) $(P6REGEX_PBC) $(P6GRAMMAR_A) $(P6GRAMMAR_SOURCES)
+$(P6GRAMMAR_PBC): $(P6GRAMMAR_PBC_1) $(P6GRAMMAR_A) $(P6GRAMMAR_SOURCES)
 	$(PARROT) --library=$(STAGE1) $(P6GRAMMAR_PBC_1) \
 	    --target=pir --output=$(P6GRAMMAR_G) \
 	    src/Regex/P6Grammar/Grammar.pm

diff --git a/src/PAST/Regex.pir b/src/PAST/Regex.pir
@@ -237,6 +237,32 @@ at this node.
     .tailcall self.'prefix_concat'(prefix, tail)
 .end
 
+.sub 'prefix_subrule_XXX' :method
+    .param string prefix
+    .param pmc tail
+
+    goto subrule_none
+
+    .local pmc name, negate, subtype
+    name = self.'name'()
+    negate = self.'negate'()
+    subtype = self.'subtype'()
+    $I0 = does name, 'string'
+    unless $I0 goto subrule_none
+    if negate goto subrule_none
+    if subtype == 'zerowidth' goto subrule_none
+
+    .local pmc selfpast, spast
+    $P99 = get_hll_global ['PAST'], 'Var'
+    selfpast = $P99.'new'( 'name'=>'self', 'scope'=>'register')
+    $P99 = get_hll_global ['PAST'], 'Op'
+    spast = $P99.'new'( selfpast, name, prefix, 'name'=>'!subrule_peek', 'pasttype'=>'callmethod')
+    .return (spast)
+
+  subrule_none:
+    .return (prefix)
+.end
+
 =back
 
 

diff --git a/src/Regex/Cursor-protoregex-peek.pir b/src/Regex/Cursor-protoregex-peek.pir
@@ -312,6 +312,17 @@ called C<name>.
     .return (tokrx, toklen)
 .end
 
+.sub '!protoregex_cmp' :anon
+    .param pmc a
+    .param pmc b
+    $S0 = a
+    $I0 = length $S0
+    $S1 = b
+    $I1 = length $S1
+    $I2 = cmp $I1, $I0
+    .return ($I2)
+.end
+
 =item !protoregex_peek(prototable, name)
 
 Return the set of initial tokens for protoregex C<name>.
@@ -357,15 +368,30 @@ Return the set of initial tokens for protoregex C<name>.
     .return (results :flat)
 .end
 
-.sub '!protoregex_cmp' :anon
-    .param pmc a
-    .param pmc b
-    $S0 = a
-    $I0 = length $S0
-    $S1 = b
-    $I1 = length $S1
-    $I2 = cmp $I1, $I0
-    .return ($I2)
+.sub '!subrule_peek' :method
+    .param string name
+    .param string prefix
+
+    $S0 = concat '!PREFIX__', name
+    $I0 = can self, $S0
+    unless $I0 goto subrule_none
+    .local pmc tokens, tokens_it
+    tokens = self.$S0()
+    unless tokens goto subrule_none
+    unless prefix goto tokens_done
+    tokens_it = iter tokens
+    tokens = new ['ResizablePMCArray']
+  tokens_loop:
+    unless tokens_it goto tokens_done
+    $S0 = shift tokens_it
+    $S0 = concat prefix, $S0
+    push tokens, $S0
+    goto tokens_loop
+  tokens_done:
+    .return (tokens)
+
+  subrule_none:
+    .return (prefix)
 .end
 
 =back