Author: pmichaud
Date: Thu May 4 23:55:01 2006
New Revision: 12510
Modified:
trunk/languages/perl6/lib/PAST.pir
trunk/languages/perl6/lib/POST.pir
trunk/languages/perl6/lib/past2post.tg
trunk/languages/perl6/lib/pge2past.tg
Log:
[perl6]: Initial changes to support lexical scoping.
Modified: trunk/languages/perl6/lib/PAST.pir
==============================================================================
--- trunk/languages/perl6/lib/PAST.pir (original)
+++ trunk/languages/perl6/lib/PAST.pir Thu May 4 23:55:01 2006
@@ -25,23 +25,23 @@
addattribute base, '@.children'
addattribute base, '$.source'
addattribute base, '$.pos'
+ addattribute base, '$.name'
$P0 = subclass base, 'Perl6::PAST::Op'
addattribute $P0, '$.op'
- addattribute $P0, '$.name'
$P0 = subclass base, 'Perl6::PAST::Val'
addattribute $P0, '$.valtype'
- addattribute $P0, '$.val'
$P0 = subclass base, 'Perl6::PAST::Var'
- addattribute $P0, '$.name'
addattribute $P0, '$.vartype'
+ $P0 = subclass base, 'Perl6::PAST::Sub'
+ addattribute $P0, '$.outer'
+
$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 = new .Integer
$P0 = 10
@@ -139,6 +139,13 @@
.end
+.sub 'name' :method
+ .param string name :optional
+ .param int has_name :opt_flag
+ .return self.'attr'('$.name', name, has_name)
+.end
+
+
.sub 'node' :method
.param pmc node
$I0 = isa node, 'Perl6::PAST::Node'
@@ -216,7 +223,7 @@
.sub '__dumplist' :method
- .return ('$.pos @.children')
+ .return ('$.pos $.name @.children')
.end
@@ -262,13 +269,6 @@
.end
-.sub 'name' :method
- .param string name :optional
- .param int has_name :opt_flag
- .return self.'attr'('$.name', name, has_name)
-.end
-
-
.sub '__dumplist' :method
.return ('$.op $.name @.children')
.end
@@ -282,27 +282,33 @@
.return self.'attr'('$.valtype', valtype, has_valtype)
.end
-.sub 'val' :method
- .param string val :optional
- .param int has_val :opt_flag
- .return self.'attr'('$.val', val, has_val)
-.end
-
.sub '__dumplist' :method
- .return ('$.valtype $.val')
+ .return ('$.name $.valtype')
.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
+
+
+.sub '__dumplist' :method
+ .return ('$.name $.vartype')
+.end
+
+
+.namespace [ 'Perl6::PAST::Sub' ]
+
+.sub 'outer' :method
+ .param pmc outer :optional
+ .param int has_outer :opt_flag
+ .return self.'attr'('$.outer', outer, has_outer)
+.end
+
+.sub '__dumplist' :method
+ .return ('$.name $.outer @.children')
+.end
Modified: trunk/languages/perl6/lib/POST.pir
==============================================================================
--- trunk/languages/perl6/lib/POST.pir (original)
+++ trunk/languages/perl6/lib/POST.pir Thu May 4 23:55:01 2006
@@ -26,7 +26,6 @@
.local pmc base
$P0 = getclass 'Perl6::PAST::Node'
base = subclass $P0, 'Perl6::POST::Node'
- addattribute base, '$.name'
addattribute base, '$.value'
$P0 = subclass base, 'Perl6::POST::Val'
@@ -36,10 +35,12 @@
addattribute $P0, '$.vartype'
addattribute $P0, '$.isgen'
+ $P0 = subclass base, 'Perl6::POST::Sub'
+ addattribute $P0, '$.outer'
+
$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
@@ -49,7 +50,7 @@
.sub '__init' :method
$P0 = new .String
setattribute self, '$.name', $P0
- $P0 = new String
+ $P0 = new .String
setattribute self, '$.value', $P0
.return ()
.end
@@ -63,10 +64,8 @@
=item C<Perl6::POST::Node::value()>
Set or return the invocant's value. If no value has been
-previously set for this node, then the default for POST::Node
-is to use the value of its last child. If it has no children,
-then we generate a unique PMC register (uninitialized) and
-use that.
+previously set for this node, then we generate a unique
+PMC register (uninitialized) and use that.
=cut
@@ -177,25 +176,47 @@
.namespace [ 'Perl6::POST::Sub' ]
+.sub 'outer' :method
+ .param pmc outer :optional
+ .param int has_outer :opt_flag
+ .return self.'attr'('$.outer', outer, has_outer)
+.end
+
.sub 'pir' :method
- .local pmc varhash
- varhash = new .Hash
- store_global 'Perl6::POST', '%!varhash', varhash
- .local pmc code, iter
+ .local string name, outer
+ name = self.'name'()
+ outer = self.'outer'()
+ if outer == '' goto outer_end
+ outer = concat ":outer('", outer
+ outer = concat outer, "')"
+ outer_end:
+ .local pmc code, iter, subcode
code = new 'PGE::CodeString'
- code.'emit'(".sub 'anon' :anon")
+ code.'emit'("\n.sub '%0' %1", name, outer)
+ subcode = new 'PGE::CodeString'
iter = self.'child_iter'()
iter_loop:
unless iter goto iter_end
$P0 = shift iter
$P1 = $P0.'pir'()
+ $I0 = isa $P0, 'Perl6::POST::Sub'
+ if $I0 goto concat_sub
code .= $P1
goto iter_loop
+ concat_sub:
+ subcode .= $P1
+ goto iter_loop
iter_end:
- code.'emit'('.end')
+ .local string value
+ value = self.'value'()
+ code.'emit'(" .return (%0)\n.end\n", value)
+ code = concat code, subcode
.return (code)
.end
+.sub '__dumplist' :method
+ .return ('$.name $.outer $.value @.children')
+.end
.namespace [ 'Perl6::POST::Val' ]
@@ -282,3 +303,4 @@
.return ($P0)
.end
+
Modified: trunk/languages/perl6/lib/past2post.tg
==============================================================================
--- trunk/languages/perl6/lib/past2post.tg (original)
+++ trunk/languages/perl6/lib/past2post.tg Thu May 4 23:55:01 2006
@@ -1,12 +1,32 @@
Perl6::PAST::Sub: post(.) = {
+ .local string name, outername
+ .local pmc outer
+ name = node.'name'()
+ outername = ''
+ outer = node.'outer'()
+ $I0 = defined outer
+ if $I0 == 0 goto outer_end
+ outername = outer.'name'()
+ outer_end:
.local pmc varhash
varhash = new .Hash
store_global 'Perl6::PAST', '%varhash', varhash
- $P0 = node[0]
- $P0 = tree.'get'('post', $P0)
.local pmc post
post = new 'Perl6::POST::Sub'
- post.'init'($P0, 'name'=>'anon')
+ post.'init'('node'=>node, 'name'=>name, 'outer'=>outername)
+ .local pmc iter
+ iter = node.'child_iter'()
+ iter_loop:
+ unless iter goto iter_end
+ .local pmc cpast, cpost
+ cpast = shift iter
+ cpost = tree.'get'('post', cpast)
+ post.'add_child'(cpost)
+ goto iter_loop
+ iter_end:
+ .local pmc value
+ value = cpost.'value'()
+ post.'value'(value)
.return (post)
}
@@ -84,6 +104,8 @@
unless iter goto iter_end
.local pmc cpast, cpost
cpast = shift iter
+ $I0 = defined cpast
+ if $I0 == 0 goto iter_loop
cpost = tree.'get'('post', cpast)
ops.'add_child'(cpost)
push arglist, cpost
@@ -254,7 +276,7 @@
Perl6::PAST::Val: post(.) = {
.local string val, valtype
- val = node.'val'()
+ val = node.'name'()
valtype = node.'valtype'()
.local pmc ops
ops = new 'Perl6::POST::Ops'
Modified: trunk/languages/perl6/lib/pge2past.tg
==============================================================================
--- trunk/languages/perl6/lib/pge2past.tg (original)
+++ trunk/languages/perl6/lib/pge2past.tg Thu May 4 23:55:01 2006
@@ -2,10 +2,13 @@
ROOT: past(.) = {
.local pmc past
- $P0 = node['statement_list']
- $P1 = tree.'get'('past', $P0, 'Perl6::Grammar::statement_list')
past = new 'Perl6::PAST::Sub'
- past.'init'($P1, 'node'=>node)
+ past.'init'('node'=>node, 'name'=>'anon')
+ store_global 'Perl6::PAST', '$?SUB', past
+ .local pmc cpast, cpost
+ cpast = node['statement_list']
+ cpost = tree.'get'('past', cpast, 'Perl6::Grammar::statement_list')
+ past.'add_child'(cpost)
.return (past)
}
@@ -221,7 +224,7 @@
.local pmc past
$I0 = node
past = new 'Perl6::PAST::Val'
- past.'init'('node'=>node, 'valtype'=>'int', 'val'=>$I0)
+ past.'init'('node'=>node, 'valtype'=>'int', 'name'=>$I0)
.return (past)
}
@@ -230,7 +233,7 @@
.local pmc past
$N0 = node
past = new 'Perl6::PAST::Val'
- past.'init'('node'=>node, 'valtype'=>'num', 'val'=>$N0)
+ past.'init'('node'=>node, 'valtype'=>'num', 'name'=>$N0)
.return (past)
}
@@ -239,7 +242,7 @@
.local pmc past
$S0 = node
past = new 'Perl6::PAST::Val'
- past.'init'('node'=>node, 'valtype'=>'str', 'val'=>$S0)
+ past.'init'('node'=>node, 'valtype'=>'str', 'name'=>$S0)
.return (past)
}
@@ -250,14 +253,32 @@
$S0 = concat $S0, "'"
.local pmc past
past = new 'Perl6::PAST::Val'
- past.'init'('node'=>node, 'valtype'=>'str', 'val'=>$S0)
+ past.'init'('node'=>node, 'valtype'=>'str', 'name'=>$S0)
.return (past)
}
Perl6::Grammar::block: past(.) = {
+ .local pmc outer
+ outer = find_global 'Perl6::PAST', '$?SUB'
+ .local string bname
+ bname = outer.'unique'('_block')
+ .local pmc bpast
+ bpast = new 'Perl6::PAST::Sub'
+ bpast.'init'('node'=>node, 'outer'=>outer, 'name'=>bname)
+ store_global 'Perl6::PAST', '$?SUB', bpast
+ .local pmc cpast
$P0 = node['simple_block']
- .return tree.'get'('past', $P0, 'Perl6::Grammar::simple_block')
+ cpast = tree.'get'('past', $P0, 'Perl6::Grammar::simple_block')
+ bpast.'add_child'(cpast)
+ outer.'add_child'(bpast)
+ store_global 'Perl6::PAST', '$?SUB', outer
+
+ bname = concat "'", bname
+ bname = concat bname, "'"
+ .local pmc past
+ past = outer.'new'('Perl6::PAST::Op', 'op'=>'prelist:', 'name'=>bname)
+ .return (past)
}
