Updated 2012-02-08 01:48:36 by RLE

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 1

We 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:

  • -, 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" 
 }

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 :

  • 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 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