--- parrotSVN/languages/tcl/lib/commands/parray.pir	2005-08-19 19:48:03.000000000 +1000
+++ parrot/languages/tcl/lib/commands/parray.pir	2005-08-21 22:35:07.113973480 +1000
@@ -3,6 +3,7 @@
 
 .namespace [ "Tcl" ]
 
+.include "iterator.pasm"
 .sub "&parray"
   .local pmc argv
   argv = foldup
@@ -13,36 +14,112 @@
   .local pmc retval
   retval = new String
   retval = ""
-  .local int return_type
-  return_type = TCL_OK
 
-  if argc == 0 goto error
+  if argc == 0 goto bad_args
+  if argc > 2 goto bad_args
 
-  .local pmc read
-  read = find_global "_Tcl", "__read"
-  .local string name
+  # get the array...
+  .local string name, full_name
   name = argv[0]
+  full_name = "$" . name
+
   .local pmc array
-  array = read(name)
+  .local int call_level
+  $P0 = find_global "_Tcl", "call_level"
+  call_level = $P0
+
+  null array
+  push_eh catch_var
+  if call_level goto find_lex
+    array = find_global "Tcl", full_name
+    clear_eh
+    branch catch_var
+  find_lex:
+    array = find_lex call_level, full_name
+    clear_eh
+catch_var:
+  if_null array, not_array
+
+
+  # get the pattern
+  .local string match_str
+  match_str = "*"
+  if argc == 1 goto match_all
+  match_str = argv[1]
+match_all:
   
-  .local pmc keys
-  keys = iter array
+  # for storing the matching results, so we can sort it
+  .local pmc filtered
+  filtered = new ResizablePMCArray
+
+  # for aligning the equal signs together
+  .local int maxsize
+  maxsize = 1
+
+  .local pmc rule
+  $P0 = find_global "PGE", "glob"
+  (rule, $P1, $P2) = $P0(match_str)
+
+
+  .local pmc iter
+  iter = new Iterator, array
+  iter = .ITERATE_FROM_START
+
+add_loop:
+  unless iter goto add_end
+  $S0 = shift iter
+
+  # check if it matches
+  $P0 = rule($S0)
+  unless $P0 goto add_loop
+
+  push filtered, $S0
+  $I0 = length $S0
+  if $I0 < maxsize goto add_loop
+  maxsize = $I0
+
+  goto add_loop
+add_end:
+
+null $P0
+filtered."sort"($P0)
+
+.local int c, size
+c = 0
+size = filtered
+print_loop:
+  if c == size goto print_end
+  $S0 = filtered[c]
+  $P1 = array[$S0]
 
-loop:
-  unless keys goto done
-  $P0 = keys."next"()
-  $S1 = array[$P0]
-  
   print name
   print "("
-  print $P0
-  print ") = "
+  print $S0
+  print ")"
+
+  $I0 = length $S0
+  $I1 = maxsize - $I0
+  $S1 = repeat " ", $I1
   print $S1
-  print "\n"
-  goto loop
 
-error:
+  print " = "
+  print $P1
+  print "\n"
   
+  inc c
+  branch print_loop
+print_end:
+
 done:
-  .return(return_type,retval)
+  .return(TCL_OK,retval)
+
+bad_args:
+  retval = "wrong # args: should be \"parray arrayName ?pattern?\""
+  .return(TCL_ERROR, retval)
+
+not_array:
+  retval = "\""
+  retval .= name 
+  retval .= "\" isn't an array"
+  .return(TCL_ERROR, retval)
 .end