cvsuser 04/11/28 10:06:50
Modified: languages/tcl TODO tcl.imc_template
languages/tcl/lib/commands string.imc
Log:
Add basic implementation of [string match], using PGE
Revision Changes Path
1.19 +9 -8 parrot/languages/tcl/TODO
Index: TODO
===================================================================
RCS file: /cvs/public/parrot/languages/tcl/TODO,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- TODO 28 Nov 2004 05:03:17 -0000 1.18
+++ TODO 28 Nov 2004 18:06:49 -0000 1.19
@@ -15,7 +15,8 @@
=item given PGE
-[string match] [regexp] [regsub] [switch] [glob]
+[array get] [array names] [array unset]
+[regexp] [regsub] [switch] [glob]
=item migrate all these issues to RT.
@@ -128,6 +129,11 @@
Move TclWord namespace into _Tcl::Word, less clutter?
+=item multiple level lists
+
+This will be much easier to do when we can call into the parser from
+the TclList PMC. (is this already doable?)
+
=item [[list]] proc
doesn't handle varargs.
@@ -169,7 +175,7 @@
tclword.imc tcl*.pmc
[concat] [join] [list] [llength] [lappend] [linsert] [lrepeat]
-[lrange] [array set] [global]
+[lrange] [array set] [global] [string match]
the macros?
expr's precedence and parens
[puts]'s ability to write to other channels.
@@ -202,17 +208,12 @@
[string trimright], [string compare], [string equal], [string last]
[string bytelength], [string compare], [sring is], [string map],
-[string match], [string wordstart], [string wordend]
+[string wordstart], [string wordend]
=item given [list]
[foreach]
-=item given [string match]
-
-The following items require [string match] to be implemented: [array get],
-[array names], [array unset]
-
=item given arrays
[string map]
1.10 +2 -1 parrot/languages/tcl/tcl.imc_template
Index: tcl.imc_template
===================================================================
RCS file: /cvs/public/parrot/languages/tcl/tcl.imc_template,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- tcl.imc_template 28 Nov 2004 04:49:43 -0000 1.9
+++ tcl.imc_template 28 Nov 2004 18:06:49 -0000 1.10
@@ -84,7 +84,8 @@
# Load any dependant libraries.
$P0 = loadlib "tcl_group"
load_bytecode "languages/tcl/lib/tclword.pbc"
- load_bytecode "runtime/parrot/library/Data/Escape.pbc"
+ load_bytecode "library/Data/Escape.pbc"
+ load_bytecode "library/PGE.pir"
.local int TclArray
TclArray = find_type "TclArray" # happy case.
1.6 +28 -29 parrot/languages/tcl/lib/commands/string.imc
Index: string.imc
===================================================================
RCS file: /cvs/public/parrot/languages/tcl/lib/commands/string.imc,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- string.imc 28 Nov 2004 04:49:45 -0000 1.5
+++ string.imc 28 Nov 2004 18:06:50 -0000 1.6
@@ -18,15 +18,12 @@
.local pmc string_index
string_index = find_global "_Tcl", "__string_index"
- #.local pmc string_match
- #string_match = find_global "_Tcl", "__string_match"
-
if argc == 0 goto noargs
command = argv[0]
if command == "first" goto first
if command == "index" goto index
if command == "length" goto length
- #if command == "match" goto match
+ if command == "match" goto match
if command == "range" goto range
if command == "repeat" goto repeat
goto badargs
@@ -99,35 +96,37 @@
return_type = TCL_ERROR
goto done
-#match:
- # XXX need better argument handling.
+match:
+ # XXX PGE doesn't support -nocase yet, we don't either.
# ?-nocase? pattern string
- #if argv > 3 goto bad_match
- #if argv < 2 goto bad_match
- #.local int match_case
- #match_case = 1
- #.local int argpos
- #argpos = 1
- #$S0 = argv[argpos]
- #if $S0 != "-nocase" goto match_next
- #match_case = 0
- #inc argpos
+ if argc != 3 goto bad_match
+
+match_next:
+ .local string pattern
+ .local string the_string
+
+ pattern = argv[1]
+ the_string = argv[2]
+
+ .local pmc globber
+ globber = find_global "PGE", "glob"
-#match_next:
- #.local string pattern
- #.local string string
-
- #pattern = argv[argpos]
- #inc argpos
- #string = argv[argpos]
+ .local pmc rule
+ rule = globber(pattern)
- #$I0 = string_match(pattern,string,match_case)
- #retval = $I0
+ .local pmc match
+ match = rule(the_string)
+
+ $I0 = match.__get_bool()
+ retval = new TclInt
+ retval = $I0
+ goto done
-#bad_match:
- #return_type = TCL_ERROR
- #retval = "wrong # args: should be \"string match ?-nocase? pattern
string\""
- #goto done
+bad_match:
+ retval = new TclString
+ return_type = TCL_ERROR
+ retval = "wrong # args: should be \"string match ?-nocase? pattern
string\""
+ goto done
range:
if argv != 4 goto bad_range
