Philip Quaife 23 Sept 05Taking up the challenge in
Named arguments et al, I am producting a system designed to be used by novices. This provides a striped down programming environment that interfaces to openGL.
An Example
Shape 2Boxs {
Colour r 1 b 0.5
glutSolidCube 1
Translate y 10
Colour b 1 a 0.5
glutSolidCube 1
}This gets translated as:
glColor3f 1 0 0.5
glutSolidCube 1
glTranslatef 0 10 0
glColor4f 0 0 1 0.5
glutSolidCube 1We don't expect a novice to unserstand the importance of the order of arguments nor indeed to be able to remember the order.
So I coded up the usual hack coincidently with some new comments on the issue of named arguments. I posted my quick hack and then after reflection , rewrote it to operate the way Tcl was intended. That reflection is posted here.
PurposeThe purpose of the code is to allow users to code simple instructions without having to remember the order of parameters. We allow the specification of arguments by a mix of positional as well as name. To this end we need two special markers:
- -, means skip the parameter that is in this ordinal position.
- -- The next parameter is not a parameter name even if it matches one.
First the original code # The argument processor.
proc userargs {_arglist _args} {
set _init [list]
set _initv [list]
#START-INIT
foreach _a $_arglist {
lappend _names [lindex $_a 0]
switch [llength $_a] {
1 {
}
2 {
foreach {_n _d} $_a {break}
lappend _init $_n
lappend _initv $_d
}
3 {
foreach {_n _d _e} $_a {break}
if {$_d ne {-}} {
lappend _init $_n
lappend _initv $_d
}
switch $_e {
required {
lappend _rq $_n
}
}
}
default {
error "Dont know what to do with 3+ options for $a"
}
}
}
#END-INIT
if {[llength $_init]} {
uplevel 1 [list foreach $_init $_initv {break}]
}
#START-ARGS
set _ai -1
set _fnd [list]
for {set _i 0} {$_i < [llength $_args]} {incr _i} {
switch -- [set _v [lindex $_args $_i]] {
- {
incr _ai
}
-- {
uplevel 1 [list set [lindex $_names [set _ai [expr {($_ai+1) % [llength $_names]}]]] [lindex $_args [incr _i]] ]
lappend _fnd [lindex $_names $_ai]
}
default {
if {[lsearch -exact $_names $_v] != -1 } {
uplevel 1 [list set $_v [lindex $_args [incr _i]]]
lappend _fnd $_v
} else {
uplevel 1 [list set [lindex $_names [set _ai [expr {($_ai+1) % [llength $_names]}]]] $_v ]
lappend _fnd [lindex $_names $_ai]
}
}
}
}
#END-ARGS
if {[llength $_rq]} {
#START-REQUIRED
foreach _i $_rq {
if {[lsearch $_fnd $_i] == -1} {
uplevel 1 [list error "missing argument $_i"]
}
}
#END-REQUIRED
}
}In the above the #markers were added at stage two of development, but listed here to save having two copies of the code here.A novice programmer would use the above by:
proc fred {args} {
userargs {{filename - required} {more r} -extra} $args
...
}We can save ourselves some typing by getting Tcl to do the work for us.
# The wrapper for procs.
proc myproc {cmd args body} {
proc $cmd {args} "[list userargs $args ] \$args\n$body"
}ExampleThe above code for the definition:
myproc fred {{filename - required} {mode r} -extra} {....}Can be called with any of:
fred /tmp/datafile w+
fred mode w+ /tmp/datafile
fred -extra O_CREATE mode w+ filename /tmp/datafile
fred -extra O_APPEND /tmp/datafile
fred /tmp/datafile -extra O_TRUNC w+The non astute programmer would not have created the '
myproc routine and would have manually added the call to
userargs to each proc that they wanted to have named arguments for.
A New FrontierHowever since we are into dynamic programming , why do we call another proc? to process the arguments.
Version two of the code :
- First we add commend markers to the proc userargs to allow us to extract the relevant portions
- Second the new proc:
# The TCL Way
proc myproc {name _arglist body} {
# get the text of the userargs procedure
set b [info body userargs]
# pull out the two sections of interest
foreach {- init} [regexp -inline {#START-INIT(.*?)#END-INIT} $b] {break}
foreach {- loop} [regexp -inline {#START-ARGS(.*?)#END-ARGS} $b] {break}
foreach {- required} [regexp -inline {#START-REQUIRED(.*?)#END-REQUIRED} $b] {break}
# process the arguments using the code from userargs
eval $init
set newbody {}
if {[llength $_init]} {
append newbody "\n#Initialise arguments\n"
append newbody "foreach {$_init} {$_initv} {break}\n\n"
puts "init $_init val $_initv"
}
# specialise length of named arguments
regsub -all {[[]llength [$]_names[]]} $loop [llength $_names] loop
# redefine the args variable
regsub -all {_args} $loop {args} loop
# replace names with actual names
regsub -all {\$_names} $loop "{$_names}" loop
# remove uplevel
regsub -all -lineanchor {uplevel 1 [[]list (.*?)[]]$} $loop {\1} loop
append newbody "# Process arguments\n"
append newbody $loop
if {[llength $_rq]} {
regsub -all {\$_rq} $required "{$_rq}" required
regsub -all -lineanchor {uplevel 1 [[]list (.*?)[]]$} $required {\1} required
append newbody "\n#Check on required arguments"
append newbody $required
}
append newbody "\n#Start of body code\n\n"
append newbody $body
# Now define the proc
proc $name {args} $newbody
puts "$name:\n[info body $name]"
}We develop the
userargs proc as a standalone entity, once we have got it working we can then tag the code internally and then use it for specialising the code that wants to use named arguments.
What could be easier.
In the example I have included an example of making 'required' parameters, we could also extend the code to handle
args definitions as well.
To Infinity and beyondWhy add yet another procedure definition?
rename proc _proc
rename myproc proc
MG If you do those renames, don't forget to change the call to proc inside the myproc body to _proc, or it'll loop indefinately
