Configuration Language using Unknown

CMcC 4Jun2010: An attempt to derive a weakly-Tcl like language using unknown to exploit Tcl's incompletely recursive definition to interpret the 0th (command position) of each command as either a 'section' or a 'variable'-within-a-section, permitting an .ini like configuration structure with almost-full Tcl syntax.

This example uses three passes of evaluation: subst-for-commands, subst-for-vars and eval-of resultant form. It does so because there is currently no other way to distinguish command-application from the 0th position, and from substitution within word (per Dodekalogue 2.)

This three-pass interpretation, as well as being less efficient than a single pass of eval where unknown was able to make the distinction through introspection, also precludes a variable from referring to other variables within its section (although access to previously defined sections is permitted using namespace-form.)

# Config.tcl - support tcl-like config files

if {[info exists argv0] && ($argv0 eq [info script])} {
    lappend auto_path ~/Desktop/Work/Wub/ [file dirname [info script]]
}

if {[catch {package require Debug}]} {
    #proc Debug.config {args} {}
    proc Debug.config {args} {puts stderr HTTP@[uplevel subst $args]}
} else {
    Debug define config 10
}

#package require OO
#package require Dict

package provide Config 1.0

oo::class create Config {
    method dict {} {
        set result [configI eval ::_O::toDict]
    }
    method eval {config} {
        configI eval ::_O::namespace unknown ::_O::sunknown
        configI eval ::_O::namespace eval ::_C [list $config]
        return [my dict]
    }

    constructor {args} {
        Debug.config {Creating Config [self] $args}
        if {[llength $args]%2} {
            set cf [lindex $args end]
            set args [lrange $args 0 end-1]
            dict set args config $cf
        }
        variable config ""
        variable {*}$args
        catch {set args [dict merge [Site var? Config] $args]}        ;# allow .ini file to modify defaults
        next? {*}$args

        variable interp [interp create configI]
        configI eval {
            namespace eval ::_O {}
            proc ::get {section var} {
                return [set ::_C::${section}::$var]
            }

            proc ::toDict {} {
                set result {}
                foreach ns [namespace children ::_C] {
                    dict set result [namespace tail $ns] {}
                    foreach v [info vars ::${ns}::*] {
                        dict set result [namespace tail $ns] [namespace tail $v] [set $v]
                    }
                }
                return $result
            }

            # construct the variable unknown
            proc ::vunknown {ns args} {
                lassign $args var val
                set ::_C::${ns}::$var $val
            }

            # construct the section unknown
            proc ::sunknown {args} {
                set args [lassign $args ns script]
                namespace eval ::_C::$ns {}        ;# create the section namespace
                namespace eval ::_C [list ::_O::namespace unknown [list ::_O::vunknown $ns]]
                set script [namespace eval ::_C::$ns [list ::_O::subst -nocommands $script]]
                set script [subst -novariables $script]        ;# first run the script in ::_O for []
                namespace eval ::_C $script
                namespace eval ::_C [list ::_O::namespace unknown [list ::_O::sunknown]]
            }

            foreach cmd [info commands ::*] {
                if {$cmd ni {::rename ::if}} {
                    ::rename $cmd ::_O::$cmd
                }
            }

            ::rename ::if ::_O::if
            ::rename ::rename ::_O::rename
        }

        my eval $config
    }
}

if {[info exists argv0] && ($argv0 eq [info script])} {
    Debug on config 10

    set cf [Config new {
        section {
            var val        ;# this is a variable
            var1 val1
            v1 2
            v2 [expr {$v1 ^ 2}]
        }
        sect1 {
            v1 [expr {[get section v1] ^ 10}]
        }
    }]

    puts stderr "RESULT: [$cf dict]"
}

Category Uncategorized