cvsuser 03/06/29 18:21:08
Modified: languages/BASIC/compiler COMP_expressions.pm
COMP_parsefuncs.pm COMP_parser.pm
RT_aggregates.pasm testsuite.pl
Log:
Impatient waiting for PerlHash->keys(), Parrot BASIC now has a KEYS x$(), y()
statement (assign keys of y or y$() to x$()) implemented using a array/hash
structure.
Performance penalty is O(n) on stores, none on array fetches.
Revision Changes Path
1.18 +1 -0 parrot/languages/BASIC/compiler/COMP_expressions.pm
Index: COMP_expressions.pm
===================================================================
RCS file: /cvs/public/parrot/languages/BASIC/compiler/COMP_expressions.pm,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -w -r1.17 -r1.18
--- COMP_expressions.pm 29 Jun 2003 22:43:48 -0000 1.17
+++ COMP_expressions.pm 30 Jun 2003 01:21:08 -0000 1.18
@@ -60,6 +60,7 @@
uevent unlock until using
view
wait while wend width window write
+ keys
);
sub dumpq {
1.22 +21 -1 parrot/languages/BASIC/compiler/COMP_parsefuncs.pm
Index: COMP_parsefuncs.pm
===================================================================
RCS file: /cvs/public/parrot/languages/BASIC/compiler/COMP_parsefuncs.pm,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -w -r1.21 -r1.22
--- COMP_parsefuncs.pm 29 Jun 2003 22:43:48 -0000 1.21
+++ COMP_parsefuncs.pm 30 Jun 2003 01:21:08 -0000 1.22
@@ -17,6 +17,22 @@
@selects=();
my $scopes=0;
my @data=();
+sub parse_keys {
+ feedme();
+ my $targ=$syms[CURR];
+ feedme();
+ feedme() while($syms[CURR] =~ /[(),]/);
+ my $source=$syms[CURR];
+ feedme();
+ feedme() while($syms[CURR] =~ /[(),]/);
+ $targ.=$seg;
+ $source.=$seg;
+ push @{$code{$seg}->{code}}, <<KEYS;
+ .arg "$targ"
+ .arg "$source"
+ call _ARRAY_KEYS
+KEYS
+}
sub parse_common {
feedme();
while($type[CURR] !~ /COMP|COMM|STMT/) {
@@ -1088,8 +1104,12 @@
push @{$code{$seg}->{code}}, <<DIMARR;
# Set aside storage for Array $var
\$P0 = new PerlHash
+ \$P2 = new PerlArray
+ \$P3 = new PerlHash
+ \$P3["index"]=\$P2
+ \$P3["hash"]=\$P0
find_global \$P1, "BASICARR"
- set \$P1["$var$seg"], \$P0
+ set \$P1["$var$seg"], \$P3
store_global "BASICARR", \$P1
#
DIMARR
1.15 +1 -1 parrot/languages/BASIC/compiler/COMP_parser.pm
Index: COMP_parser.pm
===================================================================
RCS file: /cvs/public/parrot/languages/BASIC/compiler/COMP_parser.pm,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -w -r1.14 -r1.15
--- COMP_parser.pm 29 Jun 2003 22:43:48 -0000 1.14
+++ COMP_parser.pm 30 Jun 2003 01:21:08 -0000 1.15
@@ -140,7 +140,7 @@
while | wend | dim | type | exit | function | for | next |
do | loop | goto | gosub | return | sub | call | select | case |
read | restore | input | open | close | on | randomize | stop | swap |
- common | cls | locate | color
+ common | cls | locate | color | keys
)$/x) {
no strict 'refs';
&{"parse_" . $1}();
1.6 +62 -7 parrot/languages/BASIC/compiler/RT_aggregates.pasm
Index: RT_aggregates.pasm
===================================================================
RCS file: /cvs/public/parrot/languages/BASIC/compiler/RT_aggregates.pasm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- RT_aggregates.pasm 29 Jun 2003 22:43:48 -0000 1.5
+++ RT_aggregates.pasm 30 Jun 2003 01:21:08 -0000 1.6
@@ -16,7 +16,8 @@
.return $P0 # Return the whole array.
branch ARR_END
ARR_NORMAL:
- set $N0, $P0[key]
+ $P1=$P0["hash"] # forked arrays, awaiting keys()
+ set $N0, $P1[key]
.return $N0
ARR_END:
restoreall
@@ -35,7 +36,8 @@
.return $P0
branch ARR_END
ARR_NORMAL:
- set $S0, $P0[key]
+ $P1=$P0["hash"] # forked arrays, awaiting keys()
+ set $S0, $P1[key]
.return $S0
ARR_END:
restoreall
@@ -57,7 +59,8 @@
call _ARRAY_BUILDKEY # Will absorb rest of arguments.
.result key
- set $P0, BASICARR[array]
+ set $P1, BASICARR[array]
+ set $P0, $P1["hash"]
set $P0[key], rhs
store_global "BASICARR", BASICARR
branch END_ASSIGN
@@ -73,7 +76,8 @@
call _ARRAY_BUILDKEY # Will absorb rest of arguments.
.result key
- set $P0, BASICARR[array]
+ set $P1, BASICARR[array]
+ set $P0, $P1["hash"]
set $P0[key], rhs
store_global "BASICARR", BASICARR
branch END_ASSIGN
@@ -86,7 +90,8 @@
.local PerlHash BASICARR
find_global BASICARR, "BASICARR"
call _ARRAY_BUILDKEY
- set $P0, BASICARR[array]
+ set $P1, BASICARR[array]
+ set $P0, $P1["hash"]
.result key
set $S0, blob[TYPE]
@@ -117,7 +122,57 @@
end
END_ASSIGN:
- restoreall
+ # Temporary, needed only until PerlHash->keys() gets implemented
+ find_global BASICARR, "BASICARR"
+ set $P1, BASICARR[array]
+ set $P0, $P1["index"]
+ .local int i
+ set i, 0
+E_A: set $S0, $P0[i]
+ eq $S0, "", E_A2
+ eq $S0, key, E_A2
+ inc i
+ branch E_A
+E_A2: $P0[i]=key
+ $P1["index"]=$P0
+ BASICARR[array]=$P1
+ store_global "BASICARR", BASICARR
+REALEND:restoreall
+ ret
+.end
+# This gets a *lot* easier when PerlHash->keys() gets implemented
+.sub _ARRAY_KEYS # void ARRAY_KEYS(string source, string target)
+ saveall
+ .param string source
+ .param string target
+ .local PerlHash BASICARR
+
+ .local PerlArray SRCINDEX
+ .local PerlHash TARGARR
+ .local PerlArray TARGINDEX
+ .local int i
+ find_global BASICARR, "BASICARR"
+ $P0=BASICARR[source]
+ SRCINDEX=$P0["index"]
+ $P0=BASICARR[target]
+ TARGARR=$P0["hash"]
+ TARGINDEX=$P0["index"]
+
+ set i, 0
+KEYLOOP:set $S0, SRCINDEX[i]
+ eq $S0, "", ENDLOOP
+ set $S1, i
+ set $S2, "|"
+ concat $S2, $S2, $S1
+ length $I1, $S0
+ dec $I1
+ substr $S3, $S0, 1, $I1
+ TARGARR[$S2]=$S3
+ TARGINDEX[i]=$S2
+ inc i
+ branch KEYLOOP
+
+ENDLOOP:restoreall
ret
.end
#.sub _ARRAY_ASSIGN_S # void ARRAY_ASSIGN_N(string array, string rhs, int
keycount[, string|float keys])
1.15 +26 -1 parrot/languages/BASIC/compiler/testsuite.pl
Index: testsuite.pl
===================================================================
RCS file: /cvs/public/parrot/languages/BASIC/compiler/testsuite.pl,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -w -r1.14 -r1.15
--- testsuite.pl 29 Jun 2003 22:43:48 -0000 1.14
+++ testsuite.pl 30 Jun 2003 01:21:08 -0000 1.15
@@ -32,6 +32,32 @@
}
__DATA__
+' Expect 10
+sub second(b() )
+ b(5)=10
+end sub
+sub first(a() )
+ call second(a())
+end sub
+dim t(),f()
+call first(t())
+print t(5)
+
+' Keys test, "interesting"
+dim a$(),b$()
+b$("Key 1")="This is"
+b$("Key 2")="an"
+B$("Hi Mom!")="interesting"
+B$(0)="development.
+keys a$(), b$()
+i=0
+do
+ t$=a$(i)
+ print t$,
+ print tab$(10),b$(t$)
+ i=i+1
+loop while t$ <> ""
+
' 5 and PI
dim a$(), m()
a$(1)="5"
@@ -52,7 +78,6 @@
next i
close #5
print
-
' Expect 5, 0, "Hello"
common i, a$
