Author: allison
Date: Sat Apr 7 23:53:54 2007
New Revision: 18035
Added:
trunk/languages/punie/t/op_each.t (contents, props changed)
Modified:
trunk/MANIFEST
trunk/languages/punie/lib/ASTGrammar.tg
trunk/languages/punie/lib/PunieBuiltins.pir
trunk/languages/punie/lib/punie.pg
trunk/languages/punie/t/op_list.t
Log:
[punie]: Implement arrays and hashes with keyed access.
Modified: trunk/MANIFEST
==============================================================================
--- trunk/MANIFEST (original)
+++ trunk/MANIFEST Sat Apr 7 23:53:54 2007
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Thu Apr 5 02:13:20 2007 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Sun Apr 8 06:51:14 2007 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -1843,6 +1843,7 @@
languages/punie/t/harness [punie]
languages/punie/t/io_print.t [punie]
languages/punie/t/op_do.t [punie]
+languages/punie/t/op_each.t [punie]
languages/punie/t/op_goto.t [punie]
languages/punie/t/op_list.t [punie]
languages/punie/t/op_math.t [punie]
@@ -2831,6 +2832,7 @@
t/native_pbc/string_2.pbc []
t/oo/composition.t []
t/oo/mro-c3.t []
+t/oo/ops.t []
t/op/00ff-dos.t []
t/op/00ff-unix.t []
t/op/01-parse_ops.t []
Modified: trunk/languages/punie/lib/ASTGrammar.tg
==============================================================================
--- trunk/languages/punie/lib/ASTGrammar.tg (original)
+++ trunk/languages/punie/lib/ASTGrammar.tg Sat Apr 7 23:53:54 2007
@@ -273,23 +273,45 @@
}
transform past (PunieGrammar::variable) :language('PIR') {
- .local pmc result
- result = new 'PAST::Var'
+ .local string sigil, word, name, key, pirtype, scope
.local int islvalue
islvalue = node['islvalue']
- result.'init'('node'=>node, 'viviself'=>'.Undef', 'islvalue' => islvalue)
- .local string sigil
- .local string name
- sigil = node['sigil']
- $S1 = node['word']
- name = sigil . $S1
+ sigil = node['sigil';0]
+ word = node['word']
+ key = node['key';0;'KEY']
+ scope = 'global'
+
+ if key == '{' goto hash_var
+ if key == '[' goto array_var
+ if sigil == '$' goto scalar_var
+ if sigil == '@' goto array_var
+ hash_var:
+ sigil = '%' # partridge can't handle globs, so we force the sigil
+ pirtype = ".Hash"
+ goto have_container_type
+ scalar_var:
+ pirtype = ".Undef"
+ goto have_container_type
+ array_var:
+ sigil = '@' # partridge can't handle globs, so we force the sigil
+ pirtype = ".ResizablePMCArray"
+ have_container_type:
+
+ .local pmc result, var_node, key_val
+ name = sigil . word
+ var_node = new 'PAST::Var'
+
var_node.'init'('node'=>node,'name'=>name,'viviself'=>pirtype,'scope'=>scope,'islvalue'=>islvalue)
+
+ result = var_node
+
+ unless key goto not_keyed
+ $P1 = node['key';0;'expr']
+ if null $P1 goto not_keyed
+ key_val = tree.'get'('past', $P1, 'PunieGrammar::expr')
- result.'name'(name)
- result.'scope'('global')
-
-# unless sigil == '$' goto not_scalar
-# result.'vartype'('scalar')
- not_scalar:
+ result = new 'PAST::Var'
+ result = result.'init'(var_node, key_val, 'node'=>node, 'scope'=>'keyed',
'viviself'=>'.Undef', 'islvalue'=>islvalue)
+ not_keyed:
.return (result)
}
@@ -439,14 +461,29 @@
goto iter_loop
iter_end:
- unless islvalue goto notlvalue
- $P4 = result[0]
- $P4.'islvalue'(islvalue)
- notlvalue:
+ tree.'get'('islvalue', result, 'PAST::Var')
.return (result)
}
+# The attribute 'islvalue' is inherited down the tree
+transform islvalue (PAST::Var) :language('PIR') {
+ .local pmc child
+ .local string islvalue
+ islvalue = node.'islvalue'()
+ unless islvalue goto notlvalue
+ child = node[0]
+ $I0 = defined child
+ unless $I0 goto notlvalue
+ $S1 = typeof child
+ unless $S1 == 'PAST::Var' goto notlvalue
+ child.'islvalue'(islvalue)
+ tree.'get'('islvalue', child) # recurse downward
+ notlvalue:
+ .return ()
+}
+
+
transform term (expr) :language('PIR') {
.local pmc result
.local pmc children
Modified: trunk/languages/punie/lib/PunieBuiltins.pir
==============================================================================
--- trunk/languages/punie/lib/PunieBuiltins.pir (original)
+++ trunk/languages/punie/lib/PunieBuiltins.pir Sat Apr 7 23:53:54 2007
@@ -143,3 +143,8 @@
iter_end:
.return (1)
.end
+
+.sub 'infix:,'
+ .param pmc args :slurpy
+ .return (args)
+.end
Modified: trunk/languages/punie/lib/punie.pg
==============================================================================
--- trunk/languages/punie/lib/punie.pg (original)
+++ trunk/languages/punie/lib/punie.pg Sat Apr 7 23:53:54 2007
@@ -39,16 +39,20 @@
regex term {
\( <expr> \)
- | <variable>
| <number>
| <integer>
| <stringdouble>
| <stringsingle>
| do <block>
| <subcall>
+ | <variable>
+}
+rule variable { <sigil>? <word> <key>? }
+token sigil { <[EMAIL PROTECTED]> }
+token key {
+ $<KEY>:=[\[] <?ws> <expr> <?ws> $<KEY_CLOSE>:=[\]]
+ | $<KEY>:=[\{] <?ws> <expr> <?ws> $<KEY_CLOSE>:=[\}]
}
-rule variable { <sigil> <word> }
-token sigil { <[EMAIL PROTECTED]> }
token integer { \d+ }
token number { \d+\.\d+ }
regex stringdouble { <PGE::Text::bracketed: "> }
Added: trunk/languages/punie/t/op_each.t
==============================================================================
--- (empty file)
+++ trunk/languages/punie/t/op_each.t Sat Apr 7 23:53:54 2007
@@ -0,0 +1,87 @@
+#!perl
+
+use strict;
+use warnings;
+use lib qw(t . lib ../lib ../../lib ../../../lib);
+use Parrot::Test tests => 2;
+use Test::More;
+
+language_output_is( 'punie', <<'CODE', <<'OUT', 'a basic hash' );
+$h{'a'} = 'A';
+$h{'b'} = 'B';
+print $h{'a'};
+print $h{'b'};
+print "\n";
+
+CODE
+AB
+OUT
+
+TODO: {
+ local $TODO = 'unimplemented feature';
+ language_output_is( 'punie', <<'CODE', <<'OUT', 'each op' );
+#!./perl
+
+# $Header: op.each,v 1.0 87/12/18 13:13:23 root Exp $
+
+print "1..2\n";
+
+$h{'abc'} = 'ABC';
+$h{'def'} = 'DEF';
+$h{'jkl'} = 'JKL';
+$h{'xyz'} = 'XYZ';
+$h{'a'} = 'A';
+$h{'b'} = 'B';
+$h{'c'} = 'C';
+$h{'d'} = 'D';
+$h{'e'} = 'E';
+$h{'f'} = 'F';
+$h{'g'} = 'G';
+$h{'h'} = 'H';
+$h{'i'} = 'I';
+$h{'j'} = 'J';
+$h{'k'} = 'K';
+$h{'l'} = 'L';
+$h{'m'} = 'M';
+$h{'n'} = 'N';
+$h{'o'} = 'O';
+$h{'p'} = 'P';
+$h{'q'} = 'Q';
+$h{'r'} = 'R';
+$h{'s'} = 'S';
+$h{'t'} = 'T';
+$h{'u'} = 'U';
+$h{'v'} = 'V';
+$h{'w'} = 'W';
+$h{'x'} = 'X';
+$h{'y'} = 'Y';
+$h{'z'} = 'Z';
+
[EMAIL PROTECTED] = keys(h);
[EMAIL PROTECTED] = values(h);
+
+if ($#keys == 29 && $#values == 29) {print "ok 1\n";} else {print "not ok
1\n";}
+
+while (($key,$value) = each(h)) {
+ if ($key eq $keys[$i] && $value eq $values[$i] && $key gt $value) {
+ $key =~ y/a-z/A-Z/;
+ $i++ if $key eq $value;
+ }
+}
+
+if ($i == 30) {print "ok 2\n";} else {print "not ok 2\n";}
+
+CODE
+1..2
+ok 1
+ok 2
+OUT
+
+}
+
+# Local Variables:
+# mode: cperl
+# cperl-indent-level: 4
+# fill-column: 100
+# End:
+# vim: expandtab shiftwidth=4:
Modified: trunk/languages/punie/t/op_list.t
==============================================================================
--- trunk/languages/punie/t/op_list.t (original)
+++ trunk/languages/punie/t/op_list.t Sat Apr 7 23:53:54 2007
@@ -3,9 +3,18 @@
use strict;
use warnings;
use lib qw(t . lib ../lib ../../lib ../../../lib);
-use Parrot::Test tests => 1;
+use Parrot::Test tests => 2;
use Test::More;
+language_output_is( 'punie', <<'EOC', <<'OUT', 'op.list' );
[EMAIL PROTECTED] = (1, 2, 3, 4);
+print $foo[0], "\n";
+print $foo[3], "\n";
+EOC
+1
+4
+OUT
+
TODO: {
local $TODO = 'unimplemented feature';
