xk2600 I wanted the ability to provide a constant "keyed" string mechanism (similar to enums) and liked this concept... I need to convert it into a proc which can create these on demand. The premise is simple, dynamically write a proc that contains a switch which based on a single arg returns a result.
namespace eval ::static {
namespace ensemble create -command ::static -map [list static [namespace current]::static] -parameters constant
}
proc ::static::enum {procName keyArg body} {
set namespace [namespace qualifiers $procName]
set procedure [namespace tail $procName]
# create base procedure
proc $procName $keyArg [format {switch -exact -- $%s} $keyArg]
# append switch case/eval clauses foreach pair of entries
foreach [list key val] $body {
proc $procName $keyArg [concat [info body $procName] \
[format {%s {return %s}} $key $val]]
}
}
proc ::static::constant {definitions} {
# append switch case/eval clauses foreach pair of entries
foreach [list procName result] $definitions {
proc $procName {} [format {return %s} $result]
}
}
% static enum { 100 Continue 200 OK }
% static constant { 100 Continue 200 OK} namespace eval httpd [list proc status {code} {switch -exact -- $code} ]
foreach {code message} {
100 Continue
101 {Switching Protocols}
102 Processing
200 OK
201 Created
202 Accepted
203 {Non-Authoritative Information}
204 {No Content}
205 {Reset Content}
206 {Partial Content}
207 Multi-Status
208 {Already Reported}
226 {IM Used}
300 {Multiple Choices}
301 {Moved Permenantly}
302 Found
303 {See Other}
304 {Not Modified}
305 {Use Proxy}
306 {Switch Proxy}
307 {Temporary Redirect}
308 {Permenant Redirect}
400 {Bad Request}
401 Unauthorized
402 {Payment Required}
403 Forbidden
404 {Not Found}
405 {Method Not Allowed}
406 {Not Acceptable}
407 {Proxy Authentication Required}
408 {Request Timeout}
409 Conflict
410 Gone
411 {Length Required}
412 {Precondition Failed}
413 {Payload Too Large}
414 {URI Too Long}
415 {Unsupported Media Type}
416 {Range Not Satisfiable}
417 {Expectation Failed}
421 {Misdircted Request}
422 {Unprocessable Entity}
423 Locked
424 {Failed Dependancy}
426 {Upgrade Required}
428 {Precondition Required}
429 {Too Many Requests}
431 {Request Header Fields Too Large}
451 {Unavailable For Legal Reasons}
500 {Internal Server Error}
501 {Not Implemented}
502 {Bad Gateway}
503 {Service Unavailable}
504 {Gateway Time-out}
505 {HTTP Version Not Supported}
506 {Variant Also Negotiates}
507 {Insufficient Storage}
508 {Loop Detected}
510 {Not Extended}
511 {Network Authentication Required}
} {
# This appends case + body onto the switch in the proc body
# eventually resulting in a proc that looks like this:
# proc ::httpd::status {code} {
# switch -exact -- $code \
# 100 {
# return {100 {continue}}
# } \
# ...
# 511 {
# return {511 {Network Authentication Required}}
# }
# }
#
# ...and is pretty slick if I say so myself!
namespace eval httpd [list proc status {code} \
[concat [info body ::httpd::status] \
$code \
[list [list return [list $code $message]]] \
] ]
}
% ::httpd::status 200
200 OKComments, suggestions, improvements welcome.
bll 2017-10-17 Seems complicated. Why not just:
namespace eval httpd {
variable vars
set vars(dict.code.msg) {
100 Continue
}
proc status { code } {
variable vars
if { [dict exists $vars(dict.code.msg) $code] } {
return [list $code [dict get $vars(dict.code.msg) $code]]
}
# handle future growth
return [list $code "Code $code"]
}
}Napier 10-17-2017
Hmm, I may be misunderstanding what you are trying to do here but I would also agree that there is more being done here than is really needed.
1. Why not simply a dict at that point? Then you can add to it extremely easily by either accepting a second value to httpd::status or by simply doing a [dict set ::httpd::STATUS_CODES $code $status] (identical to the suggestion above but without arrays as it adds an unnecessary layer in my opinion and would be slower)
namespace eval httpd {
variable STATUS_CODES {
100 Continue
}
proc status code {
variable STATUS_CODES
if {[dict exists $STATUS_CODES $code]} {
return [list $code [dict get $STATUS_CODES $code]]
} else {
return [list $code UNKNOWN]
}
}
}2. Seems like you want something like a var switch. This is also implemented within the varx package as varx::switch
package require varx
namespace eval httpd {
proc status code {
::varx::switch $code {
100 Continue
}
}
}18-Oct-2017 change
[list [list return [list $code $message]]] \
to
[list [list return $message]] \ to get rid of the redundant code value change and the pesky extra curly brackets.
xk2600 If I remember right, my goal was to maximize the performance on future calls as these error codes and the message that is output with them is static (for the lifetime of execution within the program) but is a called with every call to the webserver.
I really need to go back and run some benchmarks but the theory was that the switch within the proc would perform faster than lookups in an array or a dict... taking that in mind, the intent was to dynamically write a proc (which when ran the first time would be byte compiled) by appending onto the switch statement with the foreach loop the contents of the error code... taking the example above the proc body should end up looking like:
proc ::httpd::status {code} {
switch -exact -- $code \
100 {return {100 Continue}} \
101 {return {101 {Switching Protocols}}} \
102 {return {102 Processing}} \
200 {return {200 OK}} \
201 {return {201 Created}} \
202 {return {202 Accepted}} \
203 {return {203 {Non-Authoritative Information}}} \
204 {return {204 {No Content}}} \
205 {return {205 {Reset Content}}} \
206 {return {206 {Partial Content}}} \
207 {return {207 Multi-Status}} \
208 {return {208 {Already Reported}}} \
226 {return {226 {IM Used}}} \
300 {return {300 {Multiple Choices}}} \
301 {return {301 {Moved Permenantly}}} \
302 {return {302 Found}} \
303 {return {303 {See Other}}} \
304 {return {304 {Not Modified}}} \
305 {return {305 {Use Proxy}}} \
306 {return {306 {Switch Proxy}}} \
307 {return {307 {Temporary Redirect}}} \
308 {return {308 {Permenant Redirect}}} \
400 {return {400 {Bad Request}}} \
401 {return {401 Unauthorized}} \
402 {return {402 {Payment Require\d}}} \
403 {return {403 Forbidden}} \
404 {return {404 {Not Found}}} \
405 {return {405 {Method Not Allowed}}} \
406 {return {406 {Not Acceptable}}} \
407 {return {407 {Proxy Authentication Required}}} \
408 {return {408 {Request Timeout}}} \
409 {return {409 Conflict}} \
410 {return {410 Gone}} \
411 {return {411 {Length Required}}} \
412 {return {412 {Precondition Failed}}} \
413 {return {413 {Payload Too Large}}} \
414 {return {414 {URI Too Long}}} \
415 {return {415 {Unsupported Media Type}}} \
416 {return {416 {Range Not Satisfiable}}} \
417 {return {417 {Expectation Failed}}} \
421 {return {421 {Misdircted Request}}} \
422 {return {422 {Unprocessable Entity}}} \
423 {return {423 Locked}} \
424 {return {424 {Failed Dependancy}}} \
426 {return {426 {Upgrade Required}}} \
428 {return {428 {Precondition Required}}} \
429 {return {429 {Too Many Requests}}} \
431 {return {431 {Request Header Fields Too Large}}} \
451 {return {451 {Unavailable For Legal Reasons}}} \
500 {return {500 {Internal Server Error}}} \
501 {return {501 {Not Implemented}}} \
502 {return {502 {Bad Gateway}}} \
503 {return {503 {Service Unavailable}}} \
504 {return {504 {Gateway Time-out}}} \
505 {return {505 {HTTP Version Not Supported}}} \
506 {return {506 {Variant Also Negotiates}}} \
507 {return {507 {Insufficient Storage}}} \
508 {return {508 {Loop Detected}}} \
510 {return {510 {Not Extended}}} \
511 {return {511 {Network Authentication Required}}}
}To sweeten the code a little bit and provide some sugar:
proc staticEnum {procName keyArg body} {
set namespace [namespace qualifiers $procName]
set procedure [namespace tail $procName]
# create base procedure
proc $procName $keyArg [format {switch -exact -- $%s} $keyArg]
# append switch case/eval clauses foreach pair of entries
foreach [list key val] $body {
proc $procName $keyArg [concat [info body $procName] \
[format {%s {return {%s %s}}} $key $key $val]]
}
}Now we can write:
% namespace eval ::httpd {}
% staticEnum ::httpd::status {code} {
100 Continue
101 {Switching Protocols}
102 Processing
200 OK
201 Created
202 Accepted
203 {Non-Authoritative Information}
204 {No Content}
205 {Reset Content}
206 {Partial Content}
207 Multi-Status
208 {Already Reported}
226 {IM Used}
300 {Multiple Choices}
301 {Moved Permenantly}
302 Found
303 {See Other}
304 {Not Modified}
305 {Use Proxy}
306 {Switch Proxy}
307 {Temporary Redirect}
308 {Permenant Redirect}
400 {Bad Request}
401 Unauthorized
402 {Payment Required}
403 Forbidden
404 {Not Found}
405 {Method Not Allowed}
406 {Not Acceptable}
407 {Proxy Authentication Required}
408 {Request Timeout}
409 Conflict
410 Gone
411 {Length Required}
412 {Precondition Failed}
413 {Payload Too Large}
414 {URI Too Long}
415 {Unsupported Media Type}
416 {Range Not Satisfiable}
417 {Expectation Failed}
421 {Misdircted Request}
422 {Unprocessable Entity}
423 Locked
424 {Failed Dependancy}
426 {Upgrade Required}
428 {Precondition Required}
429 {Too Many Requests}
431 {Request Header Fields Too Large}
451 {Unavailable For Legal Reasons}
500 {Internal Server Error}
501 {Not Implemented}
502 {Bad Gateway}
503 {Service Unavailable}
504 {Gateway Time-out}
505 {HTTP Version Not Supported}
506 {Variant Also Negotiates}
507 {Insufficient Storage}
508 {Loop Detected}
510 {Not Extended}
511 {Network Authentication Required}
}
% ::httpd::status 200
200 OK
% time {::httpd::status [expr rand()*400+100]} 10000
1.7802 microseconds per iterationcomparitavely the utilization of dict as noted above:
namespace eval httpd {
variable STATUS_CODES {
100 Continue
101 {Switching Protocols}
102 Processing
200 OK
201 Created
202 Accepted
203 {Non-Authoritative Information}
204 {No Content}
205 {Reset Content}
206 {Partial Content}
207 Multi-Status
208 {Already Reported}
226 {IM Used}
300 {Multiple Choices}
301 {Moved Permenantly}
302 Found
303 {See Other}
304 {Not Modified}
305 {Use Proxy}
306 {Switch Proxy}
307 {Temporary Redirect}
308 {Permenant Redirect}
400 {Bad Request}
401 Unauthorized
402 {Payment Required}
403 Forbidden
404 {Not Found}
405 {Method Not Allowed}
406 {Not Acceptable}
407 {Proxy Authentication Required}
408 {Request Timeout}
409 Conflict
410 Gone
411 {Length Required}
412 {Precondition Failed}
413 {Payload Too Large}
414 {URI Too Long}
415 {Unsupported Media Type}
416 {Range Not Satisfiable}
417 {Expectation Failed}
421 {Misdircted Request}
422 {Unprocessable Entity}
423 Locked
424 {Failed Dependancy}
426 {Upgrade Required}
428 {Precondition Required}
429 {Too Many Requests}
431 {Request Header Fields Too Large}
451 {Unavailable For Legal Reasons}
500 {Internal Server Error}
501 {Not Implemented}
502 {Bad Gateway}
503 {Service Unavailable}
504 {Gateway Time-out}
505 {HTTP Version Not Supported}
506 {Variant Also Negotiates}
507 {Insufficient Storage}
508 {Loop Detected}
510 {Not Extended}
511 {Network Authentication Required}
}
proc status code {
variable STATUS_CODES
if {[dict exists $STATUS_CODES $code]} {
return [list $code [dict get $STATUS_CODES $code]]
} else {
return [list $code UNKNOWN]
}
}
}
% ::httpd::status 200
200 OK
% time {::httpd::status [expr rand()*400+100]} 10000
2.7135 microseconds per iteration
% info patchlevel
8.6.81.7ms vs 2.7ms static proc created dynamically at startup vs utilizing dict for lookup, the static proc provides a 58% improvement in performance, which is far from what I would consider negligible, especially on a webserver dumping out 200k requests/min.
HE 2018-08-26: I guess your solution is faster as you expect. You create with "expr rand()*400+100" always non integer numbers. This means, you test always against unknown values. I would use expr {int(rand()*400+100)} instead. But, even then most of the values would be unknown. In normal working condition I would expect matching values instead. So better would be to run the tests against fix codes like 600 (as an unknown value), 511 (as the value from the end) and, 100 (as the value from the beginning). This removes also the calculation of expr from every cycle. The other issue is that your dict using proc has to return a string and your static proc only an empty string. Also I would use no else part:
proc httpd::status code {
variable STATUS_CODES
if {[dict exists $STATUS_CODES $code]} {
return [list $code [dict get $STATUS_CODES $code]]
}
return {}
}My results: For completeness I created similar to the dict a procedure using an array.
| expr {int(rand()*400+100)} | code=600 | code=511 | code=100 | |
|---|---|---|---|---|
| static proc | 1.04ms | 0.47ms | 0.47ms | 0.47ms |
| dict proc | 1.4ms | 0.69ms | 0.77ms | 0.76ms |
| dict proc without else | 1.36ms | 0.64ms | 0.76ms | 0.78ms |
| array proc without else | 1.3ms | 0.62ms | 0.73ms | 0.72ms |
So the savings are between 25% and 40%. But, the solution is about 2 times faster then expected by your calculation ;)
Interestingly, using an array is slightly faster then using a dict.
Here the code for the array solution:
namespace eval httpd {
array set STATUS_CODES1 {
100 Continue \
101 {Switching Protocols} \
102 Processing \
200 OK \
201 Created \
202 Accepted \
203 {Non-Authoritative Information} \
204 {No Content} \
205 {Reset Content} \
206 {Partial Content} \
207 Multi-Status \
208 {Already Reported} \
226 {IM Used} \
300 {Multiple Choices} \
301 {Moved Permenantly} \
302 Found \
303 {See Other} \
304 {Not Modified} \
305 {Use Proxy} \
306 {Switch Proxy} \
307 {Temporary Redirect} \
308 {Permenant Redirect} \
400 {Bad Request} \
401 Unauthorized \
402 {Payment Required} \
403 Forbidden \
404 {Not Found} \
405 {Method Not Allowed} \
406 {Not Acceptable} \
407 {Proxy Authentication Required} \
408 {Request Timeout} \
409 Conflict \
410 Gone \
411 {Length Required} \
412 {Precondition Failed} \
413 {Payload Too Large} \
414 {URI Too Long} \
415 {Unsupported Media Type} \
416 {Range Not Satisfiable} \
417 {Expectation Failed} \
421 {Misdircted Request} \
422 {Unprocessable Entity} \
423 Locked \
424 {Failed Dependancy} \
426 {Upgrade Required} \
428 {Precondition Required} \
429 {Too Many Requests} \
431 {Request Header Fields Too Large} \
451 {Unavailable For Legal Reasons} \
500 {Internal Server Error} \
501 {Not Implemented} \
502 {Bad Gateway} \
503 {Service Unavailable} \
504 {Gateway Time-out} \
505 {HTTP Version Not Supported} \
506 {Variant Also Negotiates} \
507 {Insufficient Storage} \
508 {Loop Detected} \
510 {Not Extended} \
511 {Network Authentication Required} \
}
}
proc httpd::status1 code {
variable STATUS_CODES1
if {[info exists STATUS_CODES1($code)]} {
return [list $code $STATUS_CODES1($code)]
} else {
return [list $code UNKNOWN]
}
}
::httpd::status1 200
time {::httpd::status1 [expr {int(rand()*400+100)}]} 1000000
time {::httpd::status1 600} 1000000
time {::httpd::status1 511} 1000000
time {::httpd::status1 100} 1000000xk2600 2018-08-26 @HE Good catch on the expr rand() without int(). I was working quickly and was trying to determine if I this had any performance benefit or if when I had put it together it had been more of a "can I do magic with TCL" experience for my own edification. I was dynamically looking up rand() thinking depending on the utilization of the experiment by others (there may be a need to measure lookup failure) it would provide a good distribution of match vs failure, but in hindsight it would make far more sense to include a lookup of something known to exist in the 100 range and the 500 range as well as rand() to highlight the performance improvement. Honestly, I almost want to see what is happening on the way from bytecode to assembler. I have a sneaking suspicion that the compiler may be utilizing SIMD instructions to do a map/reduce against the possibilities. It just doesn't seem like an dict lookup (value comparison loop) should be that much slower than the switch statement in a compiled proc. Maybe there is some extra magic in the way TCL performs the switch statement.
I often find myself burning time playing with ideas that seem like they'll squeeze more performance out of TCL and the overhead required to build the sugar almost always outweighs the performance benefit. This is honestly the only time where the use-case panned out. I wouldn't be surprised if someone much smarter than I finds a serious flaw in the implementation. But either way if it helps someone else in whatever regard it's a win in my book.
HE 2018-08-27 If you expect no wrong status (which I thing would be true with httpd) then a bit faster would be to create an own procedure for every code like:
namespace eval ::httpd {}
proc httpd::status_100 {} {return {100 Continue}}
...
proc httpd::status_511 {} {return {511 Network Authentication Required}}And call it like (direct call):
httpd::status_200 =>200 OK
This is fast as the static proc .
Or call it like (via var):
set code 200 httpd::status_$code =>200 OK
Which becomes slower
The result (together with the results from above):
| expr {int(rand()*400+100)} | code=600 | code=511 | code=100 | |
|---|---|---|---|---|
| static proc | 1.04ms | 0.47ms | 0.47ms | 0.47ms |
| dict proc | 1.4ms | 0.69ms | 0.77ms | 0.76ms |
| dict proc without else | 1.36ms | 0.64ms | 0.76ms | 0.78ms |
| array proc without else | 1.3ms | 0.62ms | 0.73ms | 0.72ms |
| single static procs for every code direct call | error | error | 0.40ms | 0.40ms |
| single static procs for every code via var | error | error | 0.80ms | 0.81ms |
So, if somewhere the code is returned and then httpd::status is called it would be faster to call direct the appropriate status proc. In case not the static proc is slightly faster.
xk2600 20180227 - Interesting... I hadn't even thought of static discrete procs for each call. In my mind this would be a great way to provide a programming pattern that is strikingly similar to the C/C++ static constants. I feel like I may have seen something similar to this on the wiki prior, so if this is a rehash of someone elses work, please feel free to insert a reference.. For instance:
proc staticConst {definitions} {
# append switch case/eval clauses foreach pair of entries
foreach [list procName result] $definitions {
proc $procName {} [format {return %s} $result]
}
}I see an ever so slight improvement by eliminating the switch in the proc. The only pitfall is unless you're in the same namespace scope, you begin to take a hit by either doing a string append (as noted in HE's comments above) or by scoping the variable with 'namespace inscope,' 'qualifying the variable' or 'generating an ensemble'. I feel like I'm starting to split hairs but someone may find this interesting so here goes.
Very simple test to showcase this (I have added a test suite section to the top provide combinations as noted in this discussion for everyone to work from)
namespace eval ::httpd::status::code {
namespace ensemble create -command ::httpd::code -map [list 200 [namespace current]::200]
namespace export 200
}
proc ::httpd::status::code::100 {} {
return OK
}
proc simpletest {code} {
puts "\n\nAlready in correct scope:\n"
namespace inscope ::httpd::status::code [format {
puts {time {%s} 10000 :}
set res [catch {puts [time {%s} 10000]}]
if {$res} {puts {execution timer exception}}
puts {}
puts {time {600} 10000 :}
set res [catch {puts [time {600} 10000]}]
if {$res} {puts {execution timer exception}}
puts {}
puts {time {catch {%s} err} 10000 :}
puts stderr [time {set res [catch {%s}]} 10000]
if {$res} {puts {execution timer exception}}
puts {}
puts {time {catch {600} err} 10000 :}
puts stderr [time {set res [catch {600}]} 10000]
} $code $code $code $code]
set err {}
puts "\n\nNamespace Appended:\n"
puts stderr {time {::httpd::status::code::$code} 10000}
set res [catch {puts stderr [time {::httpd::status::code::$code} 10000]}]
if {$res} {puts {execution timer exception}}
puts stderr {time {::httpd::status::code::600} 10000}
set res [catch {puts stderr [time {::httpd::status::code::600} 10000]}]
if {$res} {puts {execution timer exception}}
puts stderr {time {catch {::httpd::status::code::$code}} 10000}
puts stderr [time {catch {::httpd::status::code::$code}} 10000]
puts {time {catch {::httpd::status::code::600}} 10000}
puts stderr [time {catch {::httpd::status::code::600}} 10000]
puts "\n\nNamespace Scoped:\n"
puts stderr {time {namespace inscope ::httpd::status::code $code} 10000}
set res [catch {puts stderr [time {namespace inscope ::httpd::status::code $code} 10000]}]
if {$res} {puts {execution timer exception}}
puts stderr {time {namespace inscope ::httpd::status::code {600}} 10000}
set res [catch {puts stderr [time {namespace inscope ::httpd::status::code {600}} 10000]}]
if {$res} {puts {execution timer exception}}
puts stderr {time {catch {namespace inscope ::httpd::status::code $code}} 10000}
puts stderr [time {catch {namespace inscope ::httpd::status::code $code}} 10000]
puts stderr {time {catch {namespace inscope ::httpd::status::code {600}}} 10000}
puts stderr [time {catch {namespace inscope ::httpd::status::code {600}}} 10000]
}
% simpletest 100
Already in correct scope:
time {100} 10000 :
0.309 microseconds per iteration
time {600} 10000 :
execution timer exception
time {catch {100} err} 10000 :
0.558 microseconds per iteration
time {catch {600} err} 10000 :
15.839 microseconds per iteration
Namespace Appended:
time {::httpd::status::code::$code} 10000
0.7018 microseconds per iteration
time {::httpd::status::code::600} 10000
execution timer exception
time {catch {::httpd::status::code::$code}} 10000
0.7856 microseconds per iteration
time {catch {::httpd::status::code::600}} 10000
18.5246 microseconds per iteration
Namespace Scoped:
time {namespace inscope ::httpd::status::code $code} 10000
0.6719 microseconds per iteration
time {namespace inscope ::httpd::status::code {600}} 10000
execution timer exception
time {catch {namespace inscope ::httpd::status::code $code}} 10000
0.771 microseconds per iteration
time {catch {namespace inscope ::httpd::status::code {600}}} 10000
19.4045 microseconds per iteration
% Which basically looks like there is a large performance hit anytime you have to specify the namespace scope, in the order of 2x.
2018-08-28: Why are you using namespace inscope?
Anyway, there is a lot to be said for straightforward code. Here is a variant that is almost as quick as your version above (lindex is used as an identity command):
namespace eval httpd {
namespace eval status {
namespace export *
namespace ensemble create
}
}
foreach {code message} {
100 Continue 200 OK
} {
interp alias {} ::httpd::status::$code {} lindex $message
}
time {::httpd::code 200} 100000
0.85062 microseconds per iteration
time {::httpd::status 200} 100000
0.91111 microseconds per iteration