[svn:parrot] r44930 - in branches/ops_pct: . compilers/nqp/src compilers/nqp/src/Grammar compilers/nqp/t
bacek at svn.parrot.org
bacek at svn.parrot.org
Mon Mar 15 07:05:49 UTC 2010
Author: bacek
Date: Mon Mar 15 07:05:36 2010
New Revision: 44930
URL: https://trac.parrot.org/parrot/changeset/44930
Log:
Copy compilers/nqp from trunk overriding old changes in branch.
Deleted:
branches/ops_pct/compilers/nqp/src/quote_expression.pir
branches/ops_pct/compilers/nqp/t/30-interpolate.t
Modified:
branches/ops_pct/MANIFEST
branches/ops_pct/compilers/nqp/src/Grammar.pg
branches/ops_pct/compilers/nqp/src/Grammar/Actions.pir
Modified: branches/ops_pct/MANIFEST
==============================================================================
--- branches/ops_pct/MANIFEST Mon Mar 15 01:30:29 2010 (r44929)
+++ branches/ops_pct/MANIFEST Mon Mar 15 07:05:36 2010 (r44930)
@@ -97,7 +97,6 @@
compilers/nqp/src/Grammar.pg [nqp]
compilers/nqp/src/Grammar/Actions.pir [nqp]
compilers/nqp/src/builtins.pir [nqp]
-compilers/nqp/src/quote_expression.pir [nqp]
compilers/nqp/t/01-literals.t [test]
compilers/nqp/t/02-if-else.t [test]
compilers/nqp/t/02-if.t [test]
@@ -127,7 +126,6 @@
compilers/nqp/t/27-ternary.t [test]
compilers/nqp/t/28-return.t [test]
compilers/nqp/t/29-self.t [test]
-compilers/nqp/t/30-interpolate.t [test]
compilers/nqp/t/30-subclass.t [test]
compilers/nqp/t/harness [test]
compilers/opsc/Defines.mak [opsc]
Modified: branches/ops_pct/compilers/nqp/src/Grammar.pg
==============================================================================
--- branches/ops_pct/compilers/nqp/src/Grammar.pg Mon Mar 15 01:30:29 2010 (r44929)
+++ branches/ops_pct/compilers/nqp/src/Grammar.pg Mon Mar 15 07:05:36 2010 (r44930)
@@ -186,15 +186,14 @@
rule inline_pir_statement {
'PIR'
- [ 'q:to:' [ \' (<-['\n]>+) \' | \" (<-["\n]>+) \" | \< (<-[\>\n]>+) \> ]
+ [ <quote> {*} #= quote
+ | '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
]
}
@@ -340,42 +339,13 @@
| <typename> {*} #= typename
}
-token nofun { <!before '(' | '.(' | '\\' > }
-
-## Quoting is tricky -- the <quote_concat> subrule is in
-## F<src/parser/quote_expression.pir> .
token quote {
- [
- | <.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'>
+ [ \' <string_literal: '\''> \' {*} #= string
+ | '"' <string_literal: '"'> '"' {*} #= string
+ | 'q' <.ws> '<' <string_literal: '>'> '>' {*} #= string
+ | 'Q' <.ws> ':PIR' <.ws>
+ [:ratchet(0) '{{' (.*?) '}}' | '{' (.*?) '}' ] {*} #= PIR
]
- {*}
}
Modified: branches/ops_pct/compilers/nqp/src/Grammar/Actions.pir
==============================================================================
--- branches/ops_pct/compilers/nqp/src/Grammar/Actions.pir Mon Mar 15 01:30:29 2010 (r44929)
+++ branches/ops_pct/compilers/nqp/src/Grammar/Actions.pir Mon Mar 15 07:05:36 2010 (r44930)
@@ -1,5 +1,4 @@
-#! parrot
-# Copyright (C) 2007-2010, Parrot Foundation.
+# Copyright (C) 2007-2009, Parrot Foundation.
# $Id$
.sub '__onload' :init :load
@@ -329,7 +328,7 @@
## method inline_pir_statement($/, $key) {
## my $inline;
-## if ($key eq 'quote') { $inline := $<quote_expression><quote_pir> }
+## if ($key eq 'quote') { $inline := ~$($<quote><string_literal>) }
## if ($key eq 'heredoc') { $inline := ~$/<text> }
##
## make PAST::Op.new( :inline( $inline ),
@@ -340,10 +339,11 @@
.sub 'inline_pir_statement' :method
.param pmc match
.param pmc key
- .local string inline
+ .local pmc inline
if key != 'quote' goto not_quote
- $P0 = match['quote_expression']
- inline = $P0['quote_pir']
+ $P0 = match['quote']
+ $P0 = $P0['string_literal']
+ inline = $P0.'ast'()
goto make
not_quote:
if key != 'heredoc' goto not_heredoc
@@ -936,207 +936,33 @@
.end
-## 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 );
+## method quote($/, $key) {
+## if $key eq 'PIR' {
+## make PAST::Op.new( :node($/), :inline(~($[0])) );
## }
-## make $past;
-## }
-.sub 'quote' :method
- .param pmc match
- $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'=>'infix:,', '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
- $P0 = match['quote_regex']
- $P1 = get_hll_global ['PAST'], 'Block'
- past = $P1.'new'($P0, 'compiler'=>'PGE::Perl6Regex', 'blocktype'=>'declaration', 'node'=>match)
- 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;
+## else {
+## make PAST::Val.new( :node($/), :value(~($<string_literal>)) );
## }
-## make $past;
## }
-.sub 'quote_concat' :method
+.sub 'quote' :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, $P0, 'pasttype'=>'pirop', 'pirop'=>'concat')
-
- inc count
- goto loop
-
- make:
- match.'!make'(past)
+ .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)
.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, :pirop('set S*'), :pasttype('pirop') );
-## }
-## elsif ($key eq 'circumfix') {
-## $past := $<circumfix>.ast;
-## if $past.isa(PAST::Block) {
-## $past.blocktype('immediate');
-## }
-## $past := PAST::Op.new( $past, :pirop('set S*'), :pasttype('pirop') );
-## }
-## 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
- $P1 = get_hll_global ['PAST'], 'Op'
- $P0 = match['variable']
- $P0 = $P0.'ast'()
- past = $P1.'new'($P0, 'pasttype'=>'pirop', 'pirop'=>'set S*')
- 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();
Deleted: branches/ops_pct/compilers/nqp/src/quote_expression.pir
==============================================================================
--- branches/ops_pct/compilers/nqp/src/quote_expression.pir Mon Mar 15 07:05:36 2010 (r44929)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,493 +0,0 @@
-# Copyright (C) 2007-2010, Parrot 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:
Deleted: branches/ops_pct/compilers/nqp/t/30-interpolate.t
==============================================================================
--- branches/ops_pct/compilers/nqp/t/30-interpolate.t Mon Mar 15 07:05:36 2010 (r44929)
+++ /dev/null 00:00:00 1970 (deleted)
@@ -1,38 +0,0 @@
-#!./parrot nqp.pbc
-
-# Iterpolation and quoting. Cherry-picked from Perl 6 spectest.
-
-plan(9);
-
-# interpolating into double quotes results in a Str
-my $a := 1;
-ok("foo $a bar" == "foo 1 bar", "Scalar interpolated in double-quotes");
-
-$a++;
-ok(q<ok $a> == "ok 2", "Scalar interpolated in q<>");
-
-# Multi-line
-$a++;
-my $b := $a++;
-ok(qq<
-foo $b
-bar $a
-> == '
-foo 3
-bar 4
-', 'Multi-line qq<> works');
-
-# Word quoting.
-my @list := qw{ foo bar baz };
-ok( + at list == 3, 'qw produced 3 words');
-
- at list := <foo bar>;
-ok( + at list == 2, '<> produced 2 words');
-ok( @list[0] == 'foo', 'First is "foo"');
-ok( @list[1] == 'bar', 'Second is "bar"');
-
-my $str := 'foo';
-my $matched := / foo /($str);
-ok($matched, 'Can positive match regexp');
-$matched := / bar /($str);
-ok(!$matched, 'Can negative match regexp');
More information about the parrot-commits
mailing list