Author: pmichaud
Date: Thu May 4 14:49:41 2006
New Revision: 12505
Modified:
trunk/languages/perl6/lib/PAST.pir
trunk/languages/perl6/lib/POST.pir
trunk/languages/perl6/lib/grammar_optok.pg
trunk/languages/perl6/lib/past2post.tg
trunk/languages/perl6/lib/pge2past.tg
Log:
[perl6]: Added initial package-scoped variable support.
Modified: trunk/languages/perl6/lib/PAST.pir
==============================================================================
--- trunk/languages/perl6/lib/PAST.pir (original)
+++ trunk/languages/perl6/lib/PAST.pir Thu May 4 14:49:41 2006
@@ -34,11 +34,14 @@
addattribute $P0, '$.valtype'
addattribute $P0, '$.val'
+ $P0 = subclass base, 'Perl6::PAST::Var'
+ addattribute $P0, '$.name'
+ addattribute $P0, '$.vartype'
+
$P0 = subclass base, 'Perl6::PAST::Exp'
$P0 = subclass base, 'Perl6::PAST::Stmt'
$P0 = subclass base, 'Perl6::PAST::Stmts'
$P0 = subclass base, 'Perl6::PAST::Sub'
- $P0 = subclass base, 'Perl6::PAST::Var'
$P0 = new .Integer
$P0 = 10
@@ -288,3 +291,18 @@
.sub '__dumplist' :method
.return ('$.valtype $.val')
.end
+
+
+.namespace [ 'Perl6::PAST::Var' ]
+
+.sub 'name' :method
+ .param string name :optional
+ .param int has_name :opt_flag
+ .return self.'attr'('$.name', name, has_name)
+.end
+
+.sub 'vartype' :method
+ .param string vartype :optional
+ .param int has_vartype :opt_flag
+ .return self.'attr'('$.vartype', vartype, has_vartype)
+.end
Modified: trunk/languages/perl6/lib/POST.pir
==============================================================================
--- trunk/languages/perl6/lib/POST.pir (original)
+++ trunk/languages/perl6/lib/POST.pir Thu May 4 14:49:41 2006
@@ -32,10 +32,15 @@
$P0 = subclass base, 'Perl6::POST::Val'
addattribute $P0, '$.valtype'
+ $P0 = subclass base, 'Perl6::POST::Var'
+ addattribute $P0, '$.vartype'
+ addattribute $P0, '$.isgen'
+
$P0 = subclass base, 'Perl6::POST::Op'
$P0 = subclass base, 'Perl6::POST::Ops'
$P0 = subclass base, 'Perl6::POST::Label'
$P0 = subclass base, 'Perl6::POST::Sub'
+ $P0 = subclass base, 'Perl6::POST::Assign'
.end
@@ -173,6 +178,9 @@
.namespace [ 'Perl6::POST::Sub' ]
.sub 'pir' :method
+ .local pmc varhash
+ varhash = new .Hash
+ store_global 'Perl6::POST', '%!varhash', varhash
.local pmc code, iter
code = new 'PGE::CodeString'
code.'emit'(".sub 'anon' :anon")
@@ -194,7 +202,6 @@
.sub 'value' :method
.param string value :optional
.param int has_value :opt_flag
- .local pmc v, valtype
.return self.'attr'('$.value', value, has_value)
.end
@@ -207,3 +214,71 @@
.sub '__dumplist' :method
.return ('$.name $.value $.valtype')
.end
+
+
+.namespace [ 'Perl6::POST::Var' ]
+
+.sub 'vartype' :method
+ .param string vartype :optional
+ .param int has_vartype :opt_flag
+ .return self.'attr'('$.vartype', vartype, has_vartype)
+.end
+
+.sub 'isgen' :method
+ .param string isgen :optional
+ .param int has_isgen :opt_flag
+ .return self.'attr'('$.isgen', isgen, has_isgen)
+.end
+
+.sub 'pir' :method
+ ## If we've already generated the pir for this variable, don't
+ ## do it a second time.
+ $I0 = self.'isgen'()
+ if $I0 == 0 goto gen_pir
+ .return ('')
+
+ gen_pir:
+ .local pmc name, value, code
+ name = self.'name'()
+ value = self.'value'()
+ code = new 'PGE::CodeString'
+ code.'emit'(" %0 = find_global '%1'", value, name)
+ self.'isgen'(1)
+ .return (code)
+.end
+
+
+.sub 'assignpir' :method
+ .param pmc x
+ .local pmc name, value, xvalue, code
+ name = self.'name'()
+ value = self.'value'()
+ xvalue = x.'value'()
+ code = new 'PGE::CodeString'
+ code.'emit'(" store_global '%0', %1", name, xvalue)
+ code.'emit'(" %0 = %1", value, xvalue)
+ self.'isgen'(1)
+ .return (code)
+.end
+
+
+.namespace [ 'Perl6::POST::Assign' ]
+
+.sub 'value' :method
+ ## return the value of our left hand side as our value
+ $P0 = self[0]
+ $P0 = $P0.'value'()
+ .return ($P0)
+.end
+
+
+.sub 'pir' :method
+ .local pmc rnode, rvalue
+ rnode = self[1]
+ rvalue = rnode.'value'()
+ .local pmc lnode
+ lnode = self[0]
+ $P0 = lnode.'assignpir'(rnode)
+ .return ($P0)
+.end
+
Modified: trunk/languages/perl6/lib/grammar_optok.pg
==============================================================================
--- trunk/languages/perl6/lib/grammar_optok.pg (original)
+++ trunk/languages/perl6/lib/grammar_optok.pg Thu May 4 14:49:41 2006
@@ -380,7 +380,7 @@
## assignment
proto 'infix:=' is precedence('07=') is assoc('right')
- is pir(" assign %0, %1") { ... }
+ is pasttype('assign') { ... }
proto 'infix::=' is equiv('infix:=') { ... }
Modified: trunk/languages/perl6/lib/past2post.tg
==============================================================================
--- trunk/languages/perl6/lib/past2post.tg (original)
+++ trunk/languages/perl6/lib/past2post.tg Thu May 4 14:49:41 2006
@@ -1,4 +1,7 @@
Perl6::PAST::Sub: post(.) = {
+ .local pmc varhash
+ varhash = new .Hash
+ store_global 'Perl6::PAST', '%varhash', varhash
$P0 = node[0]
$P0 = tree.'get'('post', $P0)
.local pmc post
@@ -96,6 +99,24 @@
}
+Perl6::PAST::Op: assign(.) = {
+ .local pmc ops
+ ops = new 'Perl6::POST::Ops'
+ ops.'init'('node'=>node)
+
+ .local pmc iter, lpast, rpast
+ iter = node.'child_iter'()
+ lpast = shift iter
+ rpast = shift iter
+ .local pmc lpost, rpost
+ lpost = tree.'get'('post', lpast)
+ rpost = tree.'get'('post', rpast)
+ ops.'add_child'(rpost)
+ ops.'add_child_new'('Perl6::POST::Assign', lpost, rpost, 'name'=>'assign')
+ .return (ops)
+}
+
+
Perl6::PAST::Op: cond(.) = {
.local pmc ops
ops = new 'Perl6::POST::Ops'
@@ -244,3 +265,23 @@
.return (ops)
}
+
+Perl6::PAST::Var: post(.) = {
+ .local string name, vartype
+ .local pmc post
+ name = node.'name'()
+ vartype = node.'vartype'()
+
+ .local pmc varhash
+ varhash = find_global 'Perl6::PAST', '%varhash'
+ $I0 = exists varhash[name]
+ if $I0 == 0 goto new_post
+ post = varhash[name]
+ .return (post)
+
+ new_post:
+ post = new 'Perl6::POST::Var'
+ post.'init'('node'=>node, 'vartype'=>vartype, 'name'=>name, 'isgen'=>0)
+ varhash[name] = post
+ .return (post)
+}
Modified: trunk/languages/perl6/lib/pge2past.tg
==============================================================================
--- trunk/languages/perl6/lib/pge2past.tg (original)
+++ trunk/languages/perl6/lib/pge2past.tg Thu May 4 14:49:41 2006
@@ -209,13 +209,10 @@
Perl6::Grammar::variable: past(.) = {
.local pmc past
- .local string scope
- past = new 'Perl6::PAST::Var'
- past.set_node(node)
- past['returns'] = 'var'
$S0 = node
- past['variable'] = $S0
+ past = new 'Perl6::PAST::Var'
+ past.'init'('node'=>node, 'name'=>$S0, 'vartype'=>'')
.return (past)
}
