[svn:parrot] r39960 - in branches/ops_pct: compilers/nqp compilers/nqp/src compilers/nqp/src/Grammar config/gen/makefiles

bacek at svn.parrot.org bacek at svn.parrot.org
Thu Jul 9 11:38:06 UTC 2009


Author: bacek
Date: Thu Jul  9 11:38:04 2009
New Revision: 39960
URL: https://trac.parrot.org/parrot/changeset/39960

Log:
[nqp] Carefully steal quote_expression from Rakudo.

- Replace old token quote with new one
- Switch "PIR q" to use quote_expression directly
- Add stubs for interpolations.

Added:
   branches/ops_pct/compilers/nqp/src/quote_expression.pir
Modified:
   branches/ops_pct/compilers/nqp/nqp.pir
   branches/ops_pct/compilers/nqp/src/Grammar.pg
   branches/ops_pct/compilers/nqp/src/Grammar/Actions.pir
   branches/ops_pct/config/gen/makefiles/nqp.in

Modified: branches/ops_pct/compilers/nqp/nqp.pir
==============================================================================
--- branches/ops_pct/compilers/nqp/nqp.pir	Thu Jul  9 07:56:51 2009	(r39959)
+++ branches/ops_pct/compilers/nqp/nqp.pir	Thu Jul  9 11:38:04 2009	(r39960)
@@ -26,6 +26,8 @@
 
 .include 'src/Grammar/Actions.pir'
 
+.include 'src/quote_expression.pir'
+
 .include 'src/builtins.pir'
 
 # Local Variables:

Modified: branches/ops_pct/compilers/nqp/src/Grammar.pg
==============================================================================
--- branches/ops_pct/compilers/nqp/src/Grammar.pg	Thu Jul  9 07:56:51 2009	(r39959)
+++ branches/ops_pct/compilers/nqp/src/Grammar.pg	Thu Jul  9 11:38:04 2009	(r39960)
@@ -186,14 +186,15 @@
 
 rule inline_pir_statement {
     'PIR'
-    [ <quote> {*}                              #= quote
-    | 'q:to:' [ \' (<-['\n]>+) \' | \" (<-["\n]>+) \" | \< (<-[\>\n]>+) \> ]
+    [ 'q:to:' [ \' (<-['\n]>+) \' | \" (<-["\n]>+) \" | \< (<-[\>\n]>+) \> ]
       [:sigspace(0):ratchet(0)
         ';' \h*: \n
         $<text>=[ [\N*:\n]*? ]
         ^^ \h*: $0 \h*: \n
         <.MARK_STATEMENT_END>
       ] {*}                                    #= heredoc
+    #| <quote> {*}                              #= quote
+    | q <.nofun> <.ws> <quote_expression: :PIR> {*} #= quote
     ]
 }
 
@@ -338,13 +339,42 @@
     | <typename> {*}                                       #= typename
 }
 
+token nofun { <!before '(' | '.(' | '\\' > }
+
+##  Quoting is tricky -- the <quote_concat> subrule is in
+##  F<src/parser/quote_expression.pir> .
 token quote {
-    [ \'  <string_literal: '\''> \' {*}                    #= string
-    | '"' <string_literal: '"'> '"' {*}                    #= string
-    | 'q' <.ws> '<' <string_literal: '>'> '>' {*}          #= string
-    | 'Q' <.ws> ':PIR' <.ws>
-        [:ratchet(0) '{{' (.*?) '}}' | '{' (.*?) '}' ] {*} #= PIR
+    [
+    | <.before \'>     <quote_expression: :q>
+    | <.before '"' >   <quote_expression: :qq>
+    | <.before '<<' | '«'>  <quote_expression: :ww :qq>
+    | <.before '<' >   <quote_expression: :w :q>
+    | <.before '/'>    <quote_expression: :regex>
+    | [m|rx] <.nofun> <.ws> 
+        [ [':P5'|':Perl5'] <.nofun> <.ws> <quote_expression: :regex :P5>
+        |              <quote_expression: :regex>
+        ]
+    | qq [ <.ws> ':' ]?
+        [ w         <.nofun> <.ws> <quote_expression: :qq :w>
+        | $<x>=[x?] <.nofun> <.ws> <quote_expression: :qq>
+        ]
+    | q [ <.ws> ':' ]?
+        [ q         <.nofun> <.ws> <quote_expression: :qq>
+        | w         <.nofun> <.ws> <quote_expression: :q :w>
+        | PIR       <.nofun> <.ws> <quote_expression: :PIR>
+        | $<x>=[x?] <.nofun> <.ws> <quote_expression: :q>
+        ]
+    | Q [ <.ws> ':' ]?
+        [ PIR       <.nofun> <.ws> <quote_expression: :PIR>
+        | q         <.nofun> <.ws> <quote_expression: :q>
+        | qq        <.nofun> <.ws> <quote_expression: :qq>
+        | b         <.nofun> <.ws> <quote_expression: :b>
+        | $<x>=[x?] <.nofun> <.ws> <quote_expression: >
+        ]
+    | s <.nofun> <.ws> <quote_expression: :q> 
+        <.panic: 's/// not implemented, try .subst as workaround'>
     ]
+    {*}
 }
 
 

Modified: branches/ops_pct/compilers/nqp/src/Grammar/Actions.pir
==============================================================================
--- branches/ops_pct/compilers/nqp/src/Grammar/Actions.pir	Thu Jul  9 07:56:51 2009	(r39959)
+++ branches/ops_pct/compilers/nqp/src/Grammar/Actions.pir	Thu Jul  9 11:38:04 2009	(r39960)
@@ -326,7 +326,7 @@
 
 ##    method inline_pir_statement($/, $key) {
 ##        my $inline;
-##        if ($key eq 'quote')   { $inline := ~$($<quote><string_literal>) }
+##        if ($key eq 'quote')   { $inline := $<quote_expression><quote_pir> }
 ##        if ($key eq 'heredoc') { $inline := ~$/<text> }
 ##
 ##        make PAST::Op.new( :inline( $inline ),
@@ -337,11 +337,10 @@
 .sub 'inline_pir_statement' :method
     .param pmc match
     .param pmc key
-    .local pmc inline
+    .local string inline
     if key != 'quote' goto not_quote
-    $P0 = match['quote']
-    $P0 = $P0['string_literal']
-    inline = $P0.'ast'()
+    $P0 = match['quote_expression']
+    inline = $P0['quote_pir']
     goto make
   not_quote:
     if key != 'heredoc' goto not_heredoc
@@ -921,33 +920,202 @@
 .end
 
 
-##    method quote($/, $key) {
-##        if $key eq 'PIR' {
-##            make PAST::Op.new( :node($/), :inline(~($[0])) );
-##        }
-##        else {
-##            make PAST::Val.new( :node($/), :value(~($<string_literal>)) );
+##    method quote($/) {
+##        my $past := $<quote_expression>.ast;
+##        # We don't support :x in NQP. Not yet.
+##        if $<x> eq 'x' {
+##            $past := PAST::Op.new( :name('!qx'), :pasttype('call'), $past );
 ##        }
+##        make $past;
 ##    }
 .sub 'quote' :method
     .param pmc match
-    .param pmc key             :optional
-    .local string value
-    unless key == 'PIR' goto quote_string
-  quote_pir:
-    $S0 = match[0]
-    $P0 = get_hll_global ['PAST'], 'Op'
-    $P1 = $P0.'new'('node'=>match, 'inline'=>$S0)
-    goto end
-  quote_string:
-    $P0 = match['string_literal']
-    value = $P0.'ast'()
-    $P0 = get_hll_global ['PAST'], 'Val'
-    $P1 = $P0.'new'('node'=>match, 'value'=>value)
-  end:
-    match.'!make'($P1)
+    $P0 = match['quote_expression']
+    .local pmc past
+    past = $P0.'ast'()
+    match.'!make'(past)
+.end
+
+##    method quote_expression($/, $key) {
+##        my $past;
+##        if $key eq 'quote_concat' {
+##            if +$<quote_concat> == 1 {
+##                $past := $<quote_concat>[0].ast;
+##            }
+##            else {
+##                $past := PAST::Op.new(
+##                    :name('list'),
+##                    :pasttype('call'),
+##                    :node( $/ )
+##                );
+##                for $<quote_concat> {
+##                    $past.push( $_.ast );
+##                }
+##            }
+##        }
+##        elsif $key eq 'quote_regex' {
+##            $past := PAST::Block.new(
+##                $<quote_regex>,
+##                :compiler('PGE::Perl6Regex'),
+##                :blocktype('declaration'),
+##                :node( $/ )
+##            );
+##            set_block_type($past, 'Regex');
+##        }
+##        elsif $key eq 'quote_p5regex' {
+##            $past := PAST::Block.new(
+##                $<quote_p5regex>,
+##                :compiler('PGE::P5Regex'),
+##                :blocktype('declaration'),
+##                :node( $/ )
+##            );
+##            set_block_type($past, 'Regex');
+##        }
+##        elsif $key eq 'quote_pir' {
+##            $past := PAST::Op.new( :inline( $<quote_pir> ), :node($/) );
+##        }
+##        make $past;
+##    }
+.sub 'quote_expression' :method
+    .param pmc match
+    .param pmc key
+
+    .local pmc past
+
+    if key != 'quote_concat' goto not_quote_concat
+    $P0 = match['quote_concat']
+    $I0 = $P0
+    if $I0 != 1 goto quote_concat_list
+    $P1 = $P0[0]
+    past = $P1.'ast'()
+    goto make
+  quote_concat_list:
+
+    $P1 = get_hll_global ['PAST'], 'Op'
+    past = $P1.'new'('name'=>'list', 'pasttype'=>'call', 'node'=>match)
+    .local pmc it
+    it = iter $P0
+  iter_loop:
+    unless it goto iter_end
+    $P2 = shift it
+    $P2 = $P2.'ast'()
+    past.'push'($P2)
+    goto iter_loop
+  iter_end:
+    goto make
+
+  not_quote_concat:
+    if key != 'quote_regex' goto not_quote_regex
+    match.'panic'('Not implemented yet')
+    goto make
+
+  not_quote_regex:
+    if key != 'quote_p5regex' goto not_quote_p5regex
+    match.'panic'('Not implemented yet')
+    goto make
+
+  not_quote_p5regex:
+    if key != 'quote_pir' goto not_quote_pir
+    $P0 = match['quote_pir']
+    $P1 = get_hll_global ['PAST'], 'Op'
+    past = $P1.'new'( 'inline'=>$P0, 'pasttype'=>'inline', 'node'=>match)
+    goto make
+
+  not_quote_pir:
+    # XXX Panic here?
+
+  make:
+    match.'!make'(past)
+.end
+
+##    method quote_concat($/) {
+##        my $quote_term := $<quote_term>;
+##        my $terms := +$quote_term;
+##        my $count := 1;
+##        my $past := $quote_term[0].ast;
+##        while ($count != $terms) {
+##            $past := PAST::Op.new(
+##                $past,
+##                $quote_term[$count].ast,
+##                :pirop('concat'),
+##                :pasttype('pirop')
+##            );
+##            $count := $count + 1;
+##        }
+##        make $past;
+##    }
+.sub 'quote_concat' :method
+    .param pmc match
+    .local pmc quote_term
+    .local int terms, count
+    quote_term = match['quote_term']
+    terms = quote_term
+    count = 1
+    .local pmc past
+    $P0 = quote_term[0]
+    past = $P0.'ast'()
+    
+    $P1 = get_hll_global ['PAST'], 'Op'
+  loop:
+    if count == terms goto make
+    $P0 = quote_term[count]
+    $P0 = $P0.'ast'()
+    past = $P1.'new'(past, $P1, 'pasttype'=>'pirop', 'pirop'=>'concat')
+    
+    inc count
+    goto loop
+
+  make:
+    match.'!make'(past)
 .end
 
+##    method quote_term($/, $key) {
+##        my $past;
+##        if ($key eq 'literal') {
+##            $past := PAST::Val.new(
+##                :value( ~$<quote_literal>.ast ),
+##                :returns('Str'), :node($/)
+##            );
+##        }
+##        elsif ($key eq 'variable') {
+##            $past := PAST::Op.new( $<variable>.ast, :name('prefix:~'), :pasttype('call') );
+##        }
+##        elsif ($key eq 'circumfix') {
+##            $past := $<circumfix>.ast;
+##            if $past.isa(PAST::Block) {
+##                $past.blocktype('immediate');
+##            }
+##            $past := PAST::Op.new( $past, :name('prefix:~'), :pasttype('call') );
+##        }
+##        make $past;
+##    }
+.sub 'quote_term' :method
+    .param pmc match
+    .param pmc key
+    .local pmc past
+
+    if key != 'literal' goto not_literal
+    $P0 = match['quote_literal']
+    $S0 = $P0.'ast'()
+    $P1 = get_hll_global ['PAST'], 'Val'
+    past = $P1.'new'('value'=>$S0, 'node'=>$P0)
+    goto make
+
+  not_literal:
+    if key != 'variable' goto not_variable
+    match.'panic'('Not implemented yet')
+    goto make
+
+  not_variable:
+    match.'panic'('Not implemented yet')
+    if key != 'circumfix' goto not_circumfix
+
+  not_circumfix:
+    # XXX Panic here?
+
+  make:
+    match.'!make'(past)
+.end
 
 ##    method typename($/, $key) {
 ##        my $ns := $<name><ident>.clone();

Added: branches/ops_pct/compilers/nqp/src/quote_expression.pir
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ branches/ops_pct/compilers/nqp/src/quote_expression.pir	Thu Jul  9 11:38:04 2009	(r39960)
@@ -0,0 +1,493 @@
+# Copyright (C) 2007-2008, The Perl Foundation.
+# $Id$
+
+.include 'cclass.pasm'
+
+.namespace ['NQP';'Grammar']
+
+.sub '' :anon :load :init
+    .local pmc brackets
+    brackets = box unicode:"<>[](){}\xab\xbb\u0f3a\u0f3b\u0f3c\u0f3d\u169b\u169c\u2045\u2046\u207d\u207e\u208d\u208e\u2329\u232a\u2768\u2769\u276a\u276b\u276c\u276d\u276e\u276f\u2770\u2771\u2772\u2773\u2774\u2775\u27c5\u27c6\u27e6\u27e7\u27e8\u27e9\u27ea\u27eb\u2983\u2984\u2985\u2986\u2987\u2988\u2989\u298a\u298b\u298c\u298d\u298e\u298f\u2990\u2991\u2992\u2993\u2994\u2995\u2996\u2997\u2998\u29d8\u29d9\u29da\u29db\u29fc\u29fd\u3008\u3009\u300a\u300b\u300c\u300d\u300e\u300f\u3010\u3011\u3014\u3015\u3016\u3017\u3018\u3019\u301a\u301b\u301d\u301e\ufd3e\ufd3f\ufe17\ufe18\ufe35\ufe36\ufe37\ufe38\ufe39\ufe3a\ufe3b\ufe3c\ufe3d\ufe3e\ufe3f\ufe40\ufe41\ufe42\ufe43\ufe44\ufe47\ufe48\ufe59\ufe5a\ufe5b\ufe5c\ufe5d\ufe5e\uff08\uff09\uff3b\uff3d\uff5b\uff5d\uff5f\uff60\uff62\uff63"
+    set_global '$!brackets', brackets
+.end
+
+.sub 'opener' :method
+    .local string brackets
+    $P0 = get_global '$!brackets'
+    brackets = $P0
+
+    .local pmc mob
+    .local string target
+    .local int pos
+    (mob, pos, target) = self.'new'(self)
+    $S0 = substr target, pos, 1
+    $I0 = index brackets, $S0
+    if $I0 < 0 goto fail
+    $I0 = $I0 % 2
+    if $I0 goto fail
+    inc pos
+    mob.'to'(pos)
+  fail:
+    .return (mob)
+.end
+
+.sub 'peek_brackets' :method
+    .param string target
+    .param int pos
+    .local string brackets, start, stop
+
+    $P0 = get_global '$!brackets'
+    brackets = $P0
+
+    start = substr target, pos, 1
+    if start == ':' goto err_colon_delim
+    stop = start
+    $I0 = index brackets, start
+    if $I0 < 0 goto end
+    $I1 = $I0 % 2
+    unless $I1 goto bracket_valid
+    self.'panic'("Using a closing delimiter for an opener is reserved")
+    goto end
+  bracket_valid:
+    inc $I0
+    stop = substr brackets, $I0, 1
+    .local int len
+    len = 0
+  bracket_loop:
+    inc pos
+    inc len
+    $S0 = substr target, pos, 1
+    if $S0 == start goto bracket_loop
+    if len == 1 goto end
+    start = repeat start, len
+    stop  = repeat stop, len
+  end:
+    .return (start, stop)
+  err_colon_delim:
+    self.'panic'("Colons cannot be used as delimiters in quoting constructs")
+.end
+
+
+.sub 'quote_expression' :method
+    .param string flags
+    .param pmc options         :slurpy :named
+
+    ##  create a new match object
+    .local pmc mob
+    .local int pos
+    .local string target
+    (mob, pos, target) = self.'new'(self)
+
+    ##  get action object
+    .local pmc action
+    action = options['action']
+
+    ##  set up options based on flags
+    .local pmc flagarray, it
+    flagarray = split ' ', flags
+    it = iter flagarray
+  iter_loop:
+    unless it goto iter_end
+    .local string oname
+    oname = shift it
+    oname = substr oname, 1
+    options[oname] = 1
+    if oname == 'ww' goto opt_ww
+    if oname == 'w' goto opt_w
+    if oname == 'qq' goto opt_qq
+    if oname == 'b' goto opt_b
+    goto iter_loop
+  opt_ww:
+  opt_w:
+    options['wsstop'] = 1
+    goto iter_loop
+  opt_qq:
+    options['s'] = 1
+    options['a'] = 1
+    options['h'] = 1
+    options['f'] = 1
+    options['c'] = 1
+    options['b'] = 1
+  opt_b:
+    options['q'] = 1
+    goto iter_loop
+  iter_end:
+
+    .local string start, stop
+    (start, stop) = self.'peek_brackets'(target, pos)
+
+    ##  determine pos, lastpos
+    $I0 = length start
+    pos += $I0
+    .local int stoplen, lastpos, wsstop
+    stoplen = length stop
+    wsstop = options['wsstop']
+    lastpos = length target
+    lastpos -= stoplen
+    options['stop'] = stop
+
+    .local pmc quote_regex
+    $I0 = options['regex']
+    if $I0 goto regex_start
+    $I0 = options['PIR']
+    if $I0 goto pir_start
+    goto word_start
+
+  regex_start:
+    .local string key
+    key = 'quote_regex'
+    .local pmc regexparse
+    ##  handle :regex parsing
+    regexparse = get_root_global ['parrot';'PGE';'Perl6Regex'], 'regex'
+    $I0 = options['P5']
+    unless $I0 goto have_regexparse
+    regexparse = get_root_global ['parrot';'PGE';'P5Regex'], 'p5regex'
+    key = 'quote_p5regex'
+  have_regexparse:
+    mob.'to'(pos)
+    quote_regex = regexparse(mob, options :flat :named)
+    unless quote_regex goto fail
+    pos = quote_regex.'to'()
+    mob[key] = quote_regex
+    goto succeed
+
+  pir_start:
+    ##  scan to closing brackets
+    $I0 = index target, stop, pos
+    if $I0 < 0 goto fail
+    .local string pir
+    $I1 = $I0 - pos
+    pir = substr target, pos, $I1
+    pos = $I0
+    key = 'quote_pir'
+    mob[key] = pir
+    goto succeed
+
+    ##  handle word parsing
+  word_start:
+    ##  set up escapes based on flags
+    .local string escapes
+    escapes = ''
+    $I0 = options['s']
+    unless $I0 goto escape_s_done
+    escapes = '$'
+  escape_s_done:
+    $I0 = options['c']
+    unless $I0 goto escape_c_done
+    escapes .= '{'
+  escape_c_done:
+  have_escapes:
+    options['escapes'] = escapes
+
+    .local int optww
+    optww = options['ww']
+    unless optww goto have_wwopts
+    .local pmc wwsingleopts, wwdoubleopts, hashclass
+    hashclass = get_root_namespace ['parrot';'Hash']
+    wwsingleopts = new hashclass
+    wwsingleopts['q'] = 1
+    wwsingleopts['stop'] = "'"
+    wwsingleopts['action'] = action
+    ##  FIXME: RT#48112  -- currently 'clone' on a Hash can't
+    ##  handle null entries (and does a deepcopy), so we're
+    ##  using an iterator to do it.
+    ##  wwdoubleopts = clone options
+            wwdoubleopts = new hashclass
+            .local pmc it2
+            it2 = iter options
+          iter2_loop:
+            unless it2 goto iter2_end
+            $S0 = shift it2
+            $P0 = options[$S0]
+            wwdoubleopts[$S0] = $P0
+            goto iter2_loop
+          iter2_end:
+    wwdoubleopts['stop'] = '"'
+    wwdoubleopts['wsstop'] = 0
+  have_wwopts:
+
+    .local pmc quote_concat
+    quote_concat = new 'ResizablePMCArray'
+
+    unless wsstop goto word_plain
+  word_loop:
+    pos = find_not_cclass .CCLASS_WHITESPACE, target, pos, lastpos
+    if pos > lastpos goto fail
+    $S0 = substr target, pos, stoplen
+    if $S0 == stop goto word_succeed
+    if pos >= lastpos goto fail
+    unless optww goto word_plain
+  word_shell:
+    $S0 = substr target, pos, 1
+    if $S0 == '"' goto word_shell_double
+    if $S0 != "'" goto word_plain
+  word_shell_single:
+    inc pos
+    mob.'to'(pos)
+    $P0 = mob.'quote_concat'(wwsingleopts)
+    unless $P0 goto fail
+    push quote_concat, $P0
+    pos = $P0.'to'()
+    inc pos
+    goto word_loop
+  word_shell_double:
+    inc pos
+    mob.'to'(pos)
+    $P0 = mob.'quote_concat'(wwdoubleopts)
+    unless $P0 goto fail
+    push quote_concat, $P0
+    pos = $P0.'to'()
+    inc pos
+    goto word_loop
+  word_plain:
+    mob.'to'(pos)
+    $P0 = mob.'quote_concat'(options)
+    unless $P0 goto fail
+    push quote_concat, $P0
+    pos = $P0.'to'()
+    goto word_loop
+  word_succeed:
+    key = 'quote_concat'
+    mob[key] = quote_concat
+
+  succeed:
+    pos += stoplen
+    mob.'to'(pos)
+    if null action goto succeed_done
+    $I0 = can action, 'quote_expression'
+    unless $I0 goto succeed_done
+    action.'quote_expression'(mob, key)
+  succeed_done:
+    .return (mob)
+  fail:
+    mob.'to'(-1)
+    .return (mob)
+.end
+
+
+.sub 'quote_concat' :method
+    .param pmc options
+
+    ##  create a new match object
+    .local pmc mob
+    .local int pos
+    .local string target
+    (mob, pos, target) = self.'new'(self)
+
+    ##  determine pos, lastpos
+    .local string stop
+    .local int stoplen, lastpos, wsstop
+    stop = options['stop']
+    wsstop = options['wsstop']
+    stoplen = length stop
+    lastpos = length target
+    lastpos -= stoplen
+
+    .local string escapes
+    escapes = options['escapes']
+
+    .local pmc quote_term
+    quote_term = new 'ResizablePMCArray'
+
+  term_loop:
+    mob.'to'(pos)
+    $P0 = mob.'quote_term'(options)
+    unless $P0 goto fail
+    push quote_term, $P0
+    pos = $P0.'to'()
+    if pos > lastpos goto fail
+    $S0 = substr target, pos, stoplen
+    if $S0 == stop goto succeed
+    unless wsstop goto term_loop
+    $I0 = is_cclass .CCLASS_WHITESPACE, target, pos
+    unless $I0 goto term_loop
+  succeed:
+    ##  save the array of captured terms
+    mob['quote_term'] = quote_term
+    mob.'to'(pos)
+    ##  call any related {*} actions
+    .local pmc action
+    action = options['action']
+    if null action goto succeed_done
+    $I0 = can action, 'quote_concat'
+    unless $I0 goto succeed_done
+    action.'quote_concat'(mob)
+  succeed_done:
+    .return (mob)
+  fail:
+    mob.'to'(-1)
+    .return (mob)
+.end
+
+
+.sub 'quote_term' :method
+    .param pmc options
+
+    .local pmc action
+    action = options['action']
+
+    .local pmc mob
+    .local int pos
+    .local string target
+    (mob, pos, target) = self.'new'(self)
+
+    .local string leadchar, escapes
+    escapes = options['escapes']
+    leadchar = substr target, pos, 1
+    $I0 = index escapes, leadchar
+    if $I0 < 0 goto term_literal
+    if leadchar == '$' goto term_scalar
+    if leadchar == '{' goto term_closure
+  term_literal:
+    mob.'to'(pos)
+    $P0 = mob.'quote_literal'(options)
+    unless $P0 goto fail
+    pos = $P0.'to'()
+    mob['quote_literal'] = $P0
+    .local string key
+    key = 'literal'
+    goto succeed
+
+  term_scalar:
+    mob.'to'(pos)
+    $P0 = mob.'variable'('action'=>action)
+    unless $P0 goto err_scalar
+    pos = $P0.'to'()
+    key = 'variable'
+    mob[key] = $P0
+    goto succeed
+
+  term_closure:
+    mob.'to'(pos)
+    $P0 = mob.'circumfix'('action'=>action)
+    unless $P0 goto fail
+    pos = $P0.'to'()
+    key = 'circumfix'
+    mob[key] = $P0
+    goto succeed
+
+  succeed:
+    mob.'to'(pos)
+    if null action goto succeed_done
+    $I0 = can action, 'quote_term'
+    unless $I0 goto succeed_done
+    action.'quote_term'(mob, key)
+  succeed_done:
+    .return (mob)
+
+  fail:
+    mob.'to'(-1)
+    .return (mob)
+
+  err_scalar:
+    mob.'to'(pos)
+    mob.'panic'("Can't use $ as non-variable in interpolated string")
+    .return (mob)
+.end
+
+
+.sub 'quote_literal' :method
+    .param pmc options
+
+    .local pmc mob
+    .local int pos
+    .local string target
+    (mob, pos, target) = self.'new'(self)
+
+    .local string stop, stop1
+    .local int stoplen, lastpos, wsstop
+    stop = options['stop']
+    wsstop = options['wsstop']
+    stop1 = substr stop, 0, 1
+    stoplen = length stop
+    lastpos = length target
+    lastpos -= stoplen
+
+    .local string escapes
+    .local int optq, optb
+    escapes = options['escapes']
+    optq = options['q']
+    optb = options['b']
+
+    .local string literal
+    literal = ''
+
+  scan_loop:
+    if pos > lastpos goto fail
+    $S0 = substr target, pos, stoplen
+    if $S0 == stop goto succeed
+    unless wsstop goto scan_loop_1
+    $I0 = is_cclass .CCLASS_WHITESPACE, target, pos
+    if $I0 goto succeed
+  scan_loop_1:
+    if pos >= lastpos goto fail
+
+  scan_char:
+    .local string litchar
+    litchar = substr target, pos, 1
+    ##  if we've reached an escape char, we're done
+    $I0 = index escapes, litchar
+    if $I0 >= 0 goto succeed
+    ##  if this isn't an interpolation, add the char
+    unless optq goto add_litchar
+    if litchar != "\\" goto add_litchar
+    ##  okay, we have a backslash, let's process it
+    .local string backchar
+    $I0 = pos + 1
+    backchar = substr target, $I0, 1
+    ##  handle :q options, \\ and \+stop
+    if backchar == "\\" goto add_backchar
+    if backchar == stop1 goto add_backchar
+    unless optb goto add_litchar
+    ##  handle :b options
+    $I0 = index "0abefnrtxco123456789", backchar
+    if $I0 < 0 goto add_backchar
+    if $I0 >= 11 goto fail_backchar_digit
+    if $I0 >= 8 goto scan_xco
+    litchar = substr "\0\a\b\e\f\n\r\t", $I0, 1
+    if $I0 >= 1 goto add_litchar2
+    ##  peek ahead for octal digits after \0
+    $I0 = pos + 2
+    $S0 = substr target, $I0, 1
+    $I0 = index "01234567", $S0
+    if $I0 >= 0 goto fail_backchar_digit
+  add_litchar2:
+    pos += 2
+    literal .= litchar
+    goto scan_loop
+  add_backchar:
+    literal .= backchar
+    pos += 2
+    goto scan_loop
+  add_litchar:
+    literal .= litchar
+    inc pos
+    goto scan_loop
+
+  scan_xco:
+    ##  lean on PGE to handle \x, \c, and \o escapes.
+    $P0 = get_root_global['parrot';'PGE';'Perl6Regex'], 'p6escapes'
+    $P1 = $P0(mob, 'pos'=>pos)
+    unless $P1 goto fail
+    $S0 = $P1.'ast'()
+    literal .= $S0
+    pos = $P1.'to'()
+    goto scan_loop
+    
+  succeed:
+    mob.'!make'(literal)
+    mob.'to'(pos)
+    .return (mob)
+  fail_backchar_digit:
+    self.'panic'('\123 form deprecated, use \o123 instead')
+  fail:
+    mob.'to'(-1)
+    .return (mob)
+.end
+
+
+# Local Variables:
+#   mode: pir
+#   fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4 ft=pir:

Modified: branches/ops_pct/config/gen/makefiles/nqp.in
==============================================================================
--- branches/ops_pct/config/gen/makefiles/nqp.in	Thu Jul  9 07:56:51 2009	(r39959)
+++ branches/ops_pct/config/gen/makefiles/nqp.in	Thu Jul  9 11:38:04 2009	(r39960)
@@ -15,6 +15,7 @@
   nqp.pir \
   src/Grammar.pg \
   src/Grammar/Actions.pir \
+  src/quote_expression.pir \
   src/builtins.pir
 
 BOOTSRC := \


More information about the parrot-commits mailing list