Author: pmichaud
Date: Fri Jan 9 07:31:32 2009
New Revision: 35310
Modified:
trunk/compilers/pct/src/PAST/Compiler.pir
trunk/compilers/pct/src/PAST/Node.pir
trunk/compilers/pct/src/PCT/Node.pir
trunk/compilers/pct/src/POST/Compiler.pir
trunk/compilers/pct/src/POST/Node.pir
Log:
[pct]: Merged changes from rvar2 branch.
Modified: trunk/compilers/pct/src/PAST/Compiler.pir
==============================================================================
--- trunk/compilers/pct/src/PAST/Compiler.pir (original)
+++ trunk/compilers/pct/src/PAST/Compiler.pir Fri Jan 9 07:31:32 2009
@@ -80,7 +80,7 @@
piropsig['pow'] = 'NN+'
piropsig['print'] = 'v*'
piropsig['set'] = 'PP'
- piropsig['setprop'] = 'vP~P'
+ piropsig['setprop'] = '0P~P'
set_global '%piropsig', piropsig
## %valflags specifies when PAST::Val nodes are allowed to
@@ -584,7 +584,7 @@
=cut
-.sub 'as_post' :method :multi(_, ['PAST';'Node'])
+.sub 'as_post' :method :multi(_, ['PAST';'Node']) :subid('Node.as_post')
.param pmc node
.param pmc options :slurpy :named
@@ -743,10 +743,11 @@
unshift blockpast, node
.local string name, pirflags, blocktype
- .local pmc ns, hll
+ .local pmc subid, ns, hll
name = node.'name'()
pirflags = node.'pirflags'()
blocktype = node.'blocktype'()
+ subid = node.'subid'()
ns = node.'namespace'()
hll = node.'hll'()
@@ -760,7 +761,7 @@
## create a POST::Sub node for this block
.local pmc bpost
$P0 = get_hll_global ['POST'], 'Sub'
- bpost = $P0.'new'('node'=>node, 'name'=>name, 'blocktype'=>blocktype,
'namespace'=>ns, 'hll'=>hll)
+ bpost = $P0.'new'('node'=>node, 'name'=>name, 'blocktype'=>blocktype,
'namespace'=>ns, 'hll'=>hll, 'subid'=>subid)
unless pirflags goto pirflags_done
bpost.'pirflags'(pirflags)
pirflags_done:
@@ -798,8 +799,6 @@
## add block setup code (cpost) to outer block if needed
if null outerpost goto outer_done
- $I0 = index pirflags, ':anon'
- if $I0 >= 0 goto outer_done
.local pmc cpost
$P0 = get_hll_global ['POST'], 'Ops'
cpost = $P0.'new'( 'result'=>blockreg )
@@ -1045,6 +1044,11 @@
$S0 = substr signature, 0, 1
if $S0 == 'v' goto pirop_void
+ $I0 = index '0123456789', $S0
+ if $I0 < 0 goto pirop_reg
+ $S0 = arglist[$I0]
+ ops.'result'($S0)
+ goto pirop_void
pirop_reg:
.local string result
result = self.'uniquereg'($S0)
@@ -1505,6 +1509,37 @@
.end
+=item stmts(PAST::Op node)
+
+Treat the node like a PAST::Stmts node -- i.e., invoke all the
+children and return the value of the last one.
+
+=cut
+
+.sub 'stmts' :method :multi(_, ['PAST';'Op'])
+ .param pmc node
+ .param pmc options :slurpy :named
+
+ .const 'Sub' $P0 = 'Node.as_post'
+ .tailcall self.$P0(node, options :flat :named)
+.end
+
+
+=item null(PAST::Op node)
+
+A "no-op" node -- none of the children are processed, and
+no statements are generated.
+
+=cut
+
+.sub 'null' :method :multi(_, ['PAST';'Op'])
+ .param pmc node
+ .param pmc options :slurpy :named
+ $P0 = get_hll_global ['POST'], 'Ops'
+ .tailcall $P0.'new'('node'=>node)
+.end
+
+
=item return(PAST::Op node)
Generate a return exception, using the first child (if any) as
@@ -1916,7 +1951,17 @@
scope = concat " '", scope
scope = concat scope, "'"
scope_error_1:
- .tailcall self.'panic'("Scope", scope, " not found for PAST::Var '", name,
"'")
+ # Find the nearest named block
+ .local pmc it
+ $P0 = get_global '@?BLOCK'
+ it = iter $P0
+ scope_error_block_loop:
+ unless it goto scope_error_2
+ $P0 = shift it
+ $S0 = $P0.'name'()
+ unless $S0 goto scope_error_block_loop
+ scope_error_2:
+ .tailcall self.'panic'("Scope", scope, " not found for PAST::Var '", name,
"' in ", $S0)
.end
@@ -2156,9 +2201,6 @@
name = node.'name'()
name = self.'escape'(name)
- .local int isdecl
- isdecl = node.'isdecl'()
-
.local pmc call_on, ops
call_on = node[0]
if null call_on goto use_self
@@ -2173,21 +2215,14 @@
if bindpost goto attribute_bind
attribute_post:
- if isdecl goto attribute_decl
.local pmc fetchop, storeop
$P0 = get_hll_global ['POST'], 'Op'
fetchop = $P0.'new'(ops, call_on, name, 'pirop'=>'getattribute')
storeop = $P0.'new'(call_on, name, ops, 'pirop'=>'setattribute')
.tailcall self.'vivify'(node, ops, fetchop, storeop)
- attribute_decl:
- .tailcall $P0.'new'('node'=>node)
-
attribute_bind:
$P0 = get_hll_global ['POST'], 'Op'
- if isdecl goto attribute_bind_decl
- .tailcall $P0.'new'(call_on, name, bindpost, 'pirop'=>'setattribute',
'result'=>bindpost)
- attribute_bind_decl:
.tailcall $P0.'new'(call_on, name, bindpost, 'pirop'=>'setattribute',
'result'=>bindpost)
.end
@@ -2198,6 +2233,10 @@
.local string name
name = node.'name'()
+ if name goto have_name
+ name = self.'uniquereg'('P')
+ node.'name'(name)
+ have_name:
.local pmc ops
$P0 = get_hll_global ['POST'], 'Ops'
@@ -2253,6 +2292,8 @@
.local pmc value, returns
value = node['value']
if null value goto err_novalue
+ $I0 = isa value, ['PAST';'Block']
+ if $I0 goto value_block
returns = node.'returns'()
if returns goto have_returns
$S0 = typeof value
@@ -2277,13 +2318,25 @@
result_pmc:
.local string result
- result = self.'unique'('$P')
+ result = self.'uniquereg'('P')
returns = self.'escape'(returns)
ops.'push_pirop'('new', result, returns)
ops.'push_pirop'('assign', result, value)
ops.'result'(result)
.return (ops)
+ value_block:
+ .local string blockreg, blockref
+ blockreg = self.'uniquereg'('P')
+ blockref = concat ".const 'Sub' ", blockreg
+ concat blockref, ' = '
+ $P0 = value.'subid'()
+ $S0 = self.'escape'($P0)
+ concat blockref, $S0
+ ops.'push_pirop'(blockref)
+ ops.'result'(blockreg)
+ .return (ops)
+
err_novalue:
self.'panic'('PAST::Val node missing :value attribute')
.end
Modified: trunk/compilers/pct/src/PAST/Node.pir
==============================================================================
--- trunk/compilers/pct/src/PAST/Node.pir (original)
+++ trunk/compilers/pct/src/PAST/Node.pir Fri Jan 9 07:31:32 2009
@@ -551,7 +551,7 @@
.end
-=item symbol(name, [attr1 => val1, attr2 => val2, ...])
+=item symbol(name [, attr1 => val1, attr2 => val2, ...])
If called with named arguments, sets the symbol hash corresponding
to C<name> in the current block. The HLL is free to select
@@ -573,14 +573,24 @@
symtable = new 'Hash'
self['symtable'] = symtable
have_symtable:
- if attr goto set_symbol
- get_symbol:
- $P0 = symtable[name]
- if null $P0 goto end
- .return ($P0)
- set_symbol:
+ .local pmc symbol
+ symbol = symtable[name]
+ if null symbol goto symbol_empty
+ unless attr goto attr_done
+ .local pmc it
+ it = iter attr
+ attr_loop:
+ unless it goto attr_done
+ $S0 = shift it
+ $P0 = attr[$S0]
+ symbol[$S0] = $P0
+ goto attr_loop
+ attr_done:
+ .return (symbol)
+ symbol_empty:
+ unless attr goto symbol_done
symtable[name] = attr
- end:
+ symbol_done:
.return (attr)
.end
@@ -660,6 +670,27 @@
.tailcall self.'attr'('compiler_args', value, have_value)
.end
+=item subid([subid])
+
+If C<subid> is provided, then sets the subid for this block.
+Returns the current subid for the block, generating a unique
+subid for the block if one does not already exist.
+
+=cut
+
+.sub 'subid' :method
+ .param pmc value :optional
+ .param int has_value :opt_flag
+ if has_value goto getset_value
+ $I0 = exists self['subid']
+ if $I0 goto getset_value
+ value = self.'unique'()
+ has_value = 1
+ getset_value:
+ .tailcall self.'attr'('subid', value, has_value)
+.end
+
+
=item pirflags([pirflags])
Get/set any pirflags for this block.
Modified: trunk/compilers/pct/src/PCT/Node.pir
==============================================================================
--- trunk/compilers/pct/src/PCT/Node.pir (original)
+++ trunk/compilers/pct/src/PCT/Node.pir Fri Jan 9 07:31:32 2009
@@ -97,6 +97,18 @@
.end
+=item clone()
+
+Clone the node.
+
+=cut
+
+.sub 'clone' :method
+ $P0 = clone self
+ .return ($P0)
+.end
+
+
=item unshift(child)
Add C<child> to the beginning of the invocant's list of children.
Modified: trunk/compilers/pct/src/POST/Compiler.pir
==============================================================================
--- trunk/compilers/pct/src/POST/Compiler.pir (original)
+++ trunk/compilers/pct/src/POST/Compiler.pir Fri Jan 9 07:31:32 2009
@@ -28,7 +28,7 @@
$P0 = new 'String'
set_global '$?HLL', $P0
- $P0 = box '[]'
+ null $P0
set_global '$?NAMESPACE', $P0
.return ()
.end
@@ -249,12 +249,13 @@
.local pmc outerns, ns, nskey
outerns = get_global '$?NAMESPACE'
- nskey = outerns
- ns = node.'namespace'()
- unless ns goto have_ns
- nskey = code.'key'(ns)
- set_global '$?NAMESPACE', nskey
+ ns = outerns
+ $P0 = node.'namespace'()
+ unless $P0 goto have_ns
+ ns = $P0
have_ns:
+ set_global '$?NAMESPACE', ns
+ nskey = code.'key'(ns)
subpir_start:
$P0 = node.'compiler'()
@@ -312,7 +313,6 @@
.param pmc options :slurpy :named
options['target'] = 'pir'
- options['grammar'] = ''
$P0 = node.'subid'()
options['subid'] = $P0
.local pmc source, compiler, pir
Modified: trunk/compilers/pct/src/POST/Node.pir
==============================================================================
--- trunk/compilers/pct/src/POST/Node.pir (original)
+++ trunk/compilers/pct/src/POST/Node.pir Fri Jan 9 07:31:32 2009
@@ -207,7 +207,7 @@
if has_value goto getset_value
$I0 = exists self['subid']
if $I0 goto getset_value
- value = self.'unique'()
+ value = self.'unique'('post')
has_value = 1
getset_value:
.tailcall self.'attr'('subid', value, has_value)
