This might not be possible but is there a way to pass a regular expression in tcl.
I have this function that i cannot change which you pass in a string if finds something and compares them to see if they are equal.
proc check {a } {
// find b in the database
if {$a == $b} {
puts "equals"
} {
puts "Not equals"
}
}
The problem is that the function uses '=='. this only matches if they are exact, but i need to have wild cards in 'a' so that 'a' and 'b' are equal if 'a' and 'b' start with the same words.
I have this function that i cannot change
Why? In tcl, you could easily redefine it with
proc check {a } {
# find b in the database
if {[string match -nocase $a $b]} {
puts "equals"
} {
puts "Not equals"
}
}
Or you could redefine if, although not recommended.
You could even search and replace the if line at runtime with
proc check [info args check] [string map {
{if {$a == $b}} {if {[string match -nocase $a $b]}}
} [info body check]]
So: Why can't you change the function?
The behavior of the == operator is fixed; it always does an equality test. Indeed it does an equality test that prefers to do numeric equality and only falls back to string equality if it has no other way.
Therefore, to change the behavior of check you have to get really tricky.
I'd look at using execution traces to intercept something inside of check so that you can then put a read trace on the local a variable so that when you read it you get actually whether its value matches something according to complex rules. (b can probably just hold a 1 for boolean truth.) The code to do this is sufficiently mind-bendingly complex that I'd really try to avoid doing it!
Much easier, if you can, is to redefine proc so that you can put a prefix on the body of check so you can apply the trace there. Or even massage the test itself.
# Rename the command to something that nothing else knows about (tricky!)
rename proc my_real_proc
my_real_proc proc {name arguments body} {
# Replace a simple equality with a basic no-case pattern match
if {$name eq "check"} {
set body [string map {{$a == $b} {[string match -nocase $b $a]}} $body]
}
# Delegate to the original definition of [proc] for everything else
uplevel my_real_proc $name $arguments $body
}
So long as you run that code before the definition of check, you'll change the code (without “changing the code”) and get the sort of capabilities you want.
Related
I have a piece of code like this
oo::class create class_test {
variable title_text
variable result
method title {t} {
set title_text $t
set result [format "%-6s %-6s" {*}$title_text]
}
method print {} {
return $result
}
}
set a "abcde"
set b "fghij"
class_test create foo
foo title {"$a" "$b"}
puts [foo print]
The real output is
$a $b
While the expected output is
abcde efghi
Could someone help to fix it?
Change
foo title {"$a" "$b"}
to
foo title [list $a $b]
so that the variables get substituted by their values.
You want to expand substitutions inside a {brace-quoted} string (logically) after the point that it is written in the script. This isn't usually recommended (not when you can construct arguments with list correctly), but you can do it.
method title {t} {
set title_text [lmap value $t {
uplevel 1 [list subst $value]
}]
set result [format "%-6s %-6s" {*}$title_text]
}
We do the transform on each word in the argument (lmap) and the transform is to apply subst to it, which must be done in the caller's context (uplevel 1). The use of list in there is so that we guarantee that we make a substitution-free script to run in the outer context, a very strongly recommended practice.
A feature of TclOO is that you don't need to take special precautions to use uplevel (or upvar) when using it, unlike some other older object systems for Tcl. That makes doing this sort of thing in a method no more tricky than doing it in a normal procedure. This is true even when inheritance is present.
Could someone help to fix it?
I fail to see why you, first, pack variable references into a single value and, then, uplevel-substitute them. In addition, the number of value arguments to format seem fixed. Why not just use two separate formal parameters to your title method and use them directly?
method title {v1 v2} {
set result [format "%-6s %-6s" $v1 $v2]
}
Then just call it like so:
foo title $a $b
Update
to generate the title in different length
then better use args like so?
method title {args} {
set result [format [join [lrepeat [llength $args] "%-6s"] " "] {*}$args]
}
args is the natural way of having a method (proc) with variable arguments in Tcl.
I wrote the following proc, which simulates the filter function in Lodash (javascript library) (https://lodash.com/docs/4.17.4#filter). You can call it in 3.5 basic formats, seen in the examples section. For the latter three calling options I would like to get rid of the the requirement to send in -s (shorthand). In order to do that I need to differentiate between an anonymous proc and a list/dict/string.
I tried looking at string is, but there isn't a string is proc. In researching here: http://wiki.tcl.tk/10166 I found they recommend info complete, however in most cases the parameters would pass that test regardless of the type of parameter.
Does anyone know of a way to reliable test this? I know I could leave it or change the proc definition, but I'm trying to stay as true as possible to Lodash.
Examples:
set users [list \
[dict create user barney age 36 active true] \
[dict create user fred age 40 active false] \
]
1. set result [_filter [list 1 2 3 4] {x {return true}}]
2. set result [_filter $users -s [dict create age 36 active true]]
3. set result [_filter $users -s [list age 36]]
4. set result [_filter $users -s "active"]
Proc Code:
proc _filter {collection predicate args} {
# They want to use shorthand syntax
if {$predicate=="-s"} {
# They passed a list/dict
if {[_dictIs {*}$args]} {
set predicate {x {
upvar args args
set truthy 1
dict for {k v} {*}$args {
if {[dict get $x $k]!=$v} {
set truthy false
break
}
}
return $truthy
}}
# They passed just an individual string
} else {
set predicate {x {
upvar args args;
if {[dict get $x $args]} {
return true;
}
return false;
}}
}
}
# Start the result list and the index (which may not be used)
set result {}
set i -1
# For each item in collection apply the iteratee.
# Dynamically pass the correct parameters.
set paramLen [llength [lindex $predicate 0]]
foreach item $collection {
set param [list $item]
if {$paramLen>=2} {lappend param [incr i];}
if {$paramLen>=3} {lappend param $collection;}
if {[apply $predicate {*}$param]} {
lappend result $item
}
}
return $result
}
Is x {return true} a string, a list, a dictionary or a lambda term (the correct name for an anonymous proc)?
The truth is that it may be all of them; it would be correct to say it was a value that was a member of any of the mentioned types. You need to describe your intent more precisely and explicitly rather than hiding it inside some sort of type magic. That greater precision may be achieved by using an option like -s or by different main command names, but it is still necessary either way. You cannot correctly and safely do what you seek to do.
In a little more depth…
All Tcl values are valid as strings.
Lists have a defined syntax and are properly subtypes of strings. (They're implemented differently internally, but you are supposed to ignore such details.)
Dictionaries have a syntax that is equivalent to lists with even numbers of elements where the elements at the even indices are all unique from each other.
Lambda terms are lists with two or three elements (the third element is the name of the context namespace, and defaults to the global namespace if it is absent). The first element of the list needs to be a valid list as well.
A two-element list matches the requirements for all the above. In Tcl's actual type logic, it is simultaneously all of the above. A particular instantiation of the value might have a particular implementation representation under the covers, but that is a transient thing that does not reflect the true type of the value.
Tcl's type system is different to that of many other languages.
How can I organize a cycle using TCL for searching list's each element existence in file or in another list, and if it doesn't exists there return unmatched element.
If the number of things that you are checking for is significantly smaller than the number of lines/tokens in the file, it is probably best to use the power of associative arrays to do the check as this can be done with linear scans (associative arrays are fast).
proc checkForAllPresent {tokens tokenList} {
foreach token $tokens {
set t($token) "dummy value"
}
foreach token $tokenList {
unset -nocomplain t($token)
}
# If the array is empty, all were found
return [expr {[array size t] == 0}]
}
Then, all we need to do is a little standard stanza to get the lines/tokens from the file and run them through the checker. Assuming we're dealing with lines:
proc getFileLines {filename} {
set f [open $filename]
set data [read $f]
close $f
return [split $data "\n"]
}
set shortList [getFileLines file1.txt]
set longList [getFileLines file2.txt]
if {[checkForAllPresent $shortList $longList]} {
puts "All were there"
} else {
puts "Some were absent"
}
It's probably better to return the list of absent lines (with return [array names t]) instead of whether everything is absent (with the general check of “is everything there” being done with llength) as that gives more useful information. (With more work, you can produce even more information about what is present, but that's a bit more code and makes things less clear.)
(When searching, be aware that leading and trailing whitespace on lines matters. This is all exact matching here. Or use string trim.)
Working with words instead of lines is really just as easy. You just end up with slightly different code to extract the tokens from the read-in contents of the files.
return [regexp -all -inline {\w+} $data]
Everything else is the same.
I want to find a pattern in a file, but the pattern can have several forms.
Here is the code :
while {[gets $thefile line] >= 0} {
for {set nb_table 1} {$nb_table<$count_table} {incr nb_table} {
if { [regexp {pattern_$nb_table} $line] } {
puts "I found one !"
}
}
}
the var $count_table is known, catched before on a on a other procedure.
If i do a puts of pattern_$nb_table in the for loop i got the name of all tables and that's good, but I never have I found one! printed out (sure i want to be another process but it is not the subject). Why I never go in the if? My file contains the pattern : pattern_1 pattern_2 .....
The problem is that the variable is not being substituted into the regular expression (the {…} disable all immediate substitutions). This is a situation where you'd use (putting the variable name in braces just for clarity, and putting the pattern in double quotes for highlighting only):
if {[regexp "pattern_${nb_table}" $line]} { ... }
Except that if I was looking for a string that simple, I'd try to use string first or string match:
if {[string first "pattern_${nb_table}" $line] >= 0} { ... }
if {[string match "*pattern_${nb_table}*" $line]} { ... }
Both of these are faster than regular expression matching, provided you're doing something simple. If the rest of the real pattern is a regular expression, only regexp will do. Of course.
I have a question about passing parameters in Tcl regarding to the following code:
set name "Ronaldo"
proc GET_PLAYER_INFO {player_id {player_name "$name"}} {
global name
puts $player_name
}
regarding to the code above, we have a global variable "name", and in the parameter list of proc GET_PLAYER_INFO, the default value of parameter player_name is set to "$name"? if the value of name is "ronaldo", it is already double quotation，do we need to put double quotation in the parameters list like this: player_name "$name"? and before we execute the "global name" command, is the default value of player_name is "Ronaldo"? is so, why we need to have "global name" command in our proc?
That won't work as it stands; the $name won't be evaluated at all so the default will be those literal five characters.
If you're binding the default value at the time you create the procedure, you'd do it like this:
proc GET_PLAYER_INFO [list player_id [list player_name $name]] {
...
}
That is, the arguments to proc are just normal things you can construct with Tcl commands and substitutions. This is one of the great things about Tcl.
However, if you're wanting to evaluate that $name at the time the procedure is called, you've got to do it differently. If you've got some kind of value that will never be used for the player name (e.g., the empty string) then it's pretty easy:
proc GET_PLAYER_INFO {player_id {player_name ""}} {
if {$player_name eq ""} {
set player_name $::name
}
...
}
Note that I've used the fully-qualified variable name there. There are other ways to get that name too (e.g., with global, with upvar, with variable, …)
The place where things get tricky is when you've not got a suitable sentinel value at all. At that point, you have to see how many arguments were actually supplied:
proc GET_PLAYER_INFO {player_id {player_name ""}} {
if {[llength [info level 0]] == 2} {
set player_name $::name
}
...
}
The command info level 0 returns the full list of argument words to the current procedure call. This includes the GET_PLAYER_INFO itself and would be a list of length 2 or 3 in a valid call to the definition above. Once the list is available, checking its length is a trivial exercise in llength and numeric comparison. (Using a sentinel value is easier though, and works in 99.99% of cases.)
The final option is to use the special args formal parameter and do the parsing manually:
proc GET_PLAYER_INFO args {
if {[llength $args] < 1 || [llength $args] > 2} {
return -code error "wrong # args: should be \"GET_PLAYER_INFO player_id ?player_name?\""
}
set player_id [lindex $args 0]
if {[llength $args] > 1} {
set player_name [lindex $args 1]
} else {
set player_name $::name
}
...
}
As you can see, this is rather long-winded...