Skip to content

Instantly share code, notes, and snippets.

@efrecon
Last active May 25, 2018 22:01
Show Gist options
  • Save efrecon/4cfa1102b96a0adcc8493ee3d00fee51 to your computer and use it in GitHub Desktop.
Save efrecon/4cfa1102b96a0adcc8493ee3d00fee51 to your computer and use it in GitHub Desktop.
druct, C-like structs using dictionaries in Tcl
namespace eval ::druct {
namespace eval types {}
namespace export {[a-z]*}
namespace ensemble create
}
proc ::druct::new { type varname } {
set typedef [Definition $type]
if { ![info exists $typedef] } {
return -code error "$type does not exist!"
}
# Create empty dict
uplevel [list set $varname [dict create]]
# Initialise dictionary
foreach def [set $typedef] {
set k [lindex $def 0]
set v ""
foreach {opt val} [lrange $def 1 end] {
set opt [string tolower [string trimleft $opt -]]
if { $opt eq "default" } {
set v $val
break
}
}
uplevel [list dict set $varname $k $v]
}
# Install traces
set nspace ::[string trim [uplevel namespace current] :]
uplevel [list trace variable $varname w [list [namespace current]::CheckType $type $nspace]]
CheckType $type $nspace $varname {} w
}
proc ::druct::CheckKey { nspace k opts varname arrkey op } {
set varname [string trimright $nspace :]::[string trimleft $varname :]
switch -- $op {
"w" {
CheckVal $nspace $varname $k $opts 2
}
}
}
proc ::druct::CheckType { type nspace varname arrkey op } {
set varname [string trimright $nspace :]::[string trimleft $varname :]
switch -- $op {
"w" {
set typedef [Definition $type]
foreach def [set $typedef] {
set k [lindex $def 0]
set opts [lrange $def 1 end]
CheckVal $nspace $varname $k $opts 2
}
}
}
}
proc ::druct::CheckVal { nspace varname k opts {lvl 1}} {
set varname [string trimright $nspace :]::[string trimleft $varname :]
if { [GetOpt opts -type type] } {
switch -- $type {
"alnum" -
"alpha" -
"ascii" -
"control" -
"boolean" -
"digit" -
"double" -
"entier" -
"false" -
"graph" -
"integer" -
"list" -
"lower" -
"print" -
"punct" -
"space" -
"true" -
"upper" -
"wideinteger" -
"wordchar" -
"xdigit" {
set val [uplevel $lvl [list dict get [set $varname] $k]]
IsA $val $type $opts \
"$k is not of type $type in $varname"
if { $type eq "list" } {
if { [GetOpt opts -items subtype] } {
foreach i $val {
IsA $i $subtype $opts \
"Item $i in list at $k is not of type $subtype in $varname"
}
}
}
}
"enum" {
if { [GetOpt opts -values vals] } {
set val [uplevel [list dict get [set $varname] $k]]
if { $val ni $vals } {
return -code error "Value of $k is not one of [join $vals ,\ ]"
}
}
}
}
}
}
proc ::druct::IsA { val type opts msg } {
set strict [GetOpt opts -strict]
if { $strict } {
if { ![string is $type -strict $val] } {
return -code error $msg
}
} else {
if { ![string is $type $val] } {
return -code error $msg
}
}
}
proc ::druct::typedef { type args } {
set [Definition $type] $args
}
proc ::druct::typeadd { type args } {
lappend [Definition $type] $args
}
proc ::druct::keycheck { varname k args } {
set nspace ::[string trim [uplevel namespace current] :]
uplevel [list trace variable $varname w [list [namespace current]::CheckKey $nspace $k $args]]
CheckKey $nspace $k $args $varname {} w
}
proc ::druct::Definition { type } {
set type [string map [list ":" "_"] [string trimleft $type :]]
return [namespace current]::types::$type
}
proc ::druct::GetOpt {_argv name {_var ""} {default ""}} {
upvar 1 $_argv argv $_var var
set pos [lsearch -regexp $argv ^$name]
if {$pos>=0} {
set to $pos
if {$_var ne ""} {
set var [lindex $argv [incr to]]
}
set argv [lreplace $argv $pos $to]
return 1
} else {
if {[llength [info level 0]] == 5} {set var $default}
return 0
}
}
if {[info exists argv0] && [file tail [info script]] eq [file tail $argv0]} {
namespace eval ::test {}
# Create a type called ::test::mytype
druct typedef ::test::mytype {
id -type integer -default 0
} {
choice -type enum -values {DOING DONE ONGOING} -default DOING
}
# Add another key to the type, this type of programming can be used to avoid
# the multiple lists (and lines) from the declaration style above
druct typeadd ::test::mytype \
integers -type list -items integer
# Create an "instance" of the type. Creating the variable in the same
# namespace as the type is not mandatory, as you can see. The variable will
# automatically be a dictionary and will be initialised to all defaults
druct new ::test::mytype mydict
dict set mydict id 45
# the following would fail
#dict set mydict id fhrj
dict set mydict choice DONE
# the following would fail
#dict set mydict choice MAYBE
dict lappend mydict integers 45
# the following would fail
#dict lappend mydict integers abc
# You can also skip type definitions and simply put constraints on the keys
# of an already existing dictionary...
dict set ::test::onedict thekey 0
druct keycheck ::test::onedict thekey -type integer
dict set ::test::onedict anotherkey 0.6
druct keycheck ::test::onedict anotherkey -type double -strict
# the following would fail
dict set ::test::onedict thekey 5
# dict set ::test::onedict thekey abc
dict set ::test::onedict anotherkey 6.7
dict set ::test::onedict anotherkey ""
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment