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]"} =====