Philip Quaife 23 Sept 05
Taking 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.
Purpose
The 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:
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 {
lassign $_a _n _d
lappend _init $_n
lappend _initv $_d
}
3 {
lassign $_a _n _d _e
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 lassign $_initv $_init]
}
#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"
}Example
The 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 Frontier
However since we are into dynamic programming , why do we call another proc? to process the arguments.
Version two of the code :
# 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
lassign [regexp -inline {#START-INIT(.*?)#END-INIT} $b] - init
lassign [regexp -inline {#START-ARGS(.*?)#END-ARGS} $b] - loop
lassign [regexp -inline {#START-REQUIRED(.*?)#END-REQUIRED} $b] - required
# process the arguments using the code from userargs
eval $init
set newbody {}
if {[llength $_init]} {
append newbody "\n#Initialise arguments\n"
append newbody "lassign {$_initv} {$_init}\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 beyond
Why 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