Handle :w (quote words) quote modifier .

perl6 · Oct 21, 2009 · 3de213c · 3de213c
1 parent b917679
commit 3de213c
Show file tree

Hide file tree

Showing 2 changed files with 54 additions and 19 deletions.
diff --git a/src/HLL/Actions.pm b/src/HLL/Actions.pm
@@ -48,34 +48,47 @@ method octint($/) {
 }
 
 method quote_EXPR($/) {
-    make $<quote_delimited>.ast;
+    my $past := $<quote_delimited>.ast;
+    if HLL::Grammar::quotemod_check($/, 'w') {
+        if isaPAST($past) { 
+            $/.panic("Can't form :w list from non-constant strings (yet)");
+        }
+        else {
+            my @words := HLL::Grammar::split_words($/, $past);
+            if +@words > 1 {
+                $past := PAST::Op.new( :pasttype('list'), :node($/) );
+                for @words { $past.push($_); }
+            }
+        }
+    }
+    if !isaPAST($past) {
+        $past := PAST::Val.new( :value(~$past) );
+    }
+    make $past;
 }
 
 method quote_delimited($/) {
-    my $past := PAST::Op.new( :pirop('concat'), :node($/) );
-    my $str := '';
-    my $lastlit := 0;
+    my @parts;
+    my $lastlit := '';
     for $<quote_atom> {
         my $ast := $_.ast;
-        if isPAST($ast) {
-            if $lastlit && $ast.isa(PAST::Val) {
-                $lastlit.value( $lastlit.value ~ $ast.value );
-            }
-            else { 
-                $past.push($ast);
-                $lastlit := $ast.isa(PAST::Val) ?? $ast !! 0;
-            }
+        if !isaPAST($ast) {
+            $lastlit := $lastlit ~ $ast;
         }
-        elsif $lastlit {
-            $lastlit.value( $lastlit.value ~ $ast );
+        elsif $ast.isa(PAST::Val) {
+            $lastlit := $lastlit ~ $ast.value;
         }
         else {
-            $lastlit := PAST::Val.new( :value($ast) );
-            $past.push($lastlit);
+            if $lastlit gt '' { @parts.push($lastlit); }
+            @parts.push($ast);
+            $lastlit := '';
         }
     }
-    if +$past.list < 1 { $past := PAST::Val.new( :value('') ); }
-    elsif +$past.list == 1 { $past := $past[0]; }
+    if $lastlit gt '' { @parts.push($lastlit); }
+    my $past := @parts ?? @parts.shift !! '';
+    while @parts {
+        $past := PAST::Op.new( $past, @parts.shift, :pirop('concat') );
+    }
     make $past;
 }
 
@@ -157,7 +170,7 @@ sub ints_to_string($ints) {
     };
 }
 
-sub isPAST($x) {
+sub isaPAST($x) {
     Q:PIR {
         $P0 = find_lex '$x'
         $I0 = isa $P0, ['PAST';'Node']

diff --git a/src/cheats/hll-grammar.pir b/src/cheats/hll-grammar.pir
@@ -395,6 +395,28 @@ position C<pos>.
 .end
 
 
+.sub 'split_words' :method
+    .param string words
+    .local int pos, eos
+    .local pmc result
+    pos = 0
+    eos = length words
+    result = new ['ResizablePMCArray']
+  split_loop:
+    pos = find_not_cclass .CCLASS_WHITESPACE, words, pos, eos
+    unless pos < eos goto split_done
+    $I0 = find_cclass .CCLASS_WHITESPACE, words, pos, eos
+    $I1 = $I0 - pos
+    $S0 = substr words, pos, $I1
+    say $S0
+    push result, $S0
+    pos = $I0
+    goto split_loop
+  split_done:
+    .return (result)
+.end
+
+
 =item EXPR(...)
 
 An operator precedence parser.