Some kind of hacker (davidw was too kind with me in the last version of this page ;).
I like TCL, while there are a number of changes I propose (look forward on this page).
Why I like TCL?
For the following reasons: TCL is the glue able to combine data and code in a direct and expressive way, without tons of special rules, but with few basic ideas that works accross the whole language, in an orthogonal way. Also TCL doesn't force you to take the language as it is, you can extend TCL in itself, so eventually you start programming bottom-up like in lisp-like languages. In TCL like in Lisp it's possible to adapt the language to fit well the application you are writing, then to write the application in this new language. So after all I like TCL for the same reasons I like Scheme, but I tend to use they for very different tasks: when I need the ability to work a lot with strings, regexps, libarires, mix with C code, TCL is my way to go.
For what I use TCL?:
And of course I use it a lot when I think to major ideas in programming languages. TCL, like Lisp and SmallTalk, have something of special in the design.
I know TCL thanks to davidw, he used to show me the main ideas, and after some time I got in love of the language (at the point to write a TCL-like programming language that is nowaday just a dead piece of code into my HD). Since then I used many other languages with the same target, such Python, but I like much more the flexibility of TCL.
Other languages I like are: C, Scheme, SmallTalk, FORTH.
How to make TCL better in my opinion
In short:
but the core language should support math using commands like +, *, / and so on, with lisp-like semanthics so that
[/ 1 2] => 1/2
Also native support for bignums seems to fit perferctly in TCL.
Random Stuff
The regmap function may be more secure (against malicious user input) and clean than the usual regsub+subst way, at least some time. Please tell me if something like this is already in some well known library.
Fles, a not complete SELF-like object system for Tcl
# fles - a SELF-like object world for Tcl
# Copyright (C) 2003 Salvatore Sanfilippo
#
# WARNING: not complete, just to show it to Tclers on the chat
# TODO
# destroy method
# intiialize/cleanup methods (called on clone/destroy).
#
# It is better to leave the difference between 'share' and 'childof'
# as a costructor operation?
# Costructors of objects interested in copy of parents (on clone)
# have just to call some 'cloneparent' procedure.
# On the other hand with share/childof it can be simpler, and
# it is much more easy to modify an object in order to change
# a parent from share to childof and vice-versa.
#
# What about for multi-messages form?
# Like:
# Rectangle x: 10 y: 20
# instead of
# Rectangle x: 10
# Rectangle y: 20
# But how to handle default arguments in methods this way?
#################### DKF's code for proper quoting -- Begin ####################
# Warning: possibly modified by me, extra errors are mine
proc makeMap {} {
set chars {{[\"$#; ]}}
append chars \t
set map [list \n \\n]
foreach c [split $chars {}] {lappend map $c \\$c}
return $map
}
variable addBackslashMap [makeMap]
proc ' {string} {
variable addBackslashMap
string map $addBackslashMap $string
}
proc braceQuote {string} {
list $string
}
##################### DKF's code for proper quoting -- End #####################
# String-concat its arguments.
proc cat args {join $args {}}
set ::objid 0; # objid 0 is reserved for the root object
proc var {name def} {
set ns [uplevel 2 set ns]
# methods to set variables are evaluated in the context
# of the slot owner, instead of the context of the object
# receiving the message.
namespace eval $ns [list variable __evalhere__$name 1]
namespace eval $ns [list variable __evalhere__$name: 1]
namespace eval $ns [list variable $name $def]
namespace eval $ns "proc [' $name] {} {variable [' $name]; set [' $name]}"
namespace eval $ns "proc [' $name]: val {variable [' $name]; set [' $name] [cat $ val]}"
}
proc method {name arglist body} {
set ns [uplevel 2 set ns]
namespace eval $ns [list variable __evalhere__$name 0]
namespace eval $ns [list proc $name $arglist $body]
}
proc childof name {
set ns [uplevel 2 set ns]
namespace eval $ns "variable parents; lappend parents [' $name]"
namespace eval $ns [list variable __cloneParent__$name 1]
}
proc share name {
set ns [uplevel 2 set ns]
namespace eval $ns "variable parents; lappend parents [' $name]"
namespace eval $ns [list variable __cloneParent__$name 0]
}
proc obj {{name -} {slots {}}} {
incr ::objid
if {[string equal $name -]} {set name __anonymousObj__$::objid}
set ns __obj__$::objid
interp alias {} $name {} sendmsg $::objid
interp alias {} [cat $ns ::self] {} $name
interp alias {} [cat $ns ::parent] {} sendmsgParent $::objid
namespace eval $ns [list variable self $name]
namespace eval $ns [list variable selfid $::objid]
namespace eval $ns {variable parents object}
namespace eval $ns [list variable __cloneParent__object 0]
namespace eval $ns $slots
namespace eval $ns "proc __ns__ {} {return [' $ns]}"
return $name
}
proc lookup {slot ns} {
set x [namespace eval $ns "string length \[info proc $slot\]"]
if {$x} {
set args [namespace eval $ns info args $slot]
set body [namespace eval $ns info body $slot]
set evalhere [namespace eval $ns "variable __evalhere__$slot; set __evalhere__$slot"]
lappend t $args $body
if {$evalhere} {lappend t $ns}
return $t
} else {
foreach parent [namespace eval $ns set parents] {
set y [lookup $slot [$parent __ns__]]
if {[llength $y]} {return $y}
}
return {}
}
}
proc uplookup {slot ns level} {
set x [namespace eval $ns "string length \[info proc $slot\]"]
if {$x && $level <= 0} {
set args [namespace eval $ns info args $slot]
set body [namespace eval $ns info body $slot]
set evalhere [namespace eval $ns "variable __evalhere__$slot; set __evalhere__$slot"]
lappend t $args $body
if {$evalhere} {lappend t $ns}
return $t
} else {
incr level -1
foreach parent [namespace eval $ns set parents] {
set y [uplookup $slot [$parent __ns__] $level]
if {[llength $y]} {return $y}
}
return {}
}
}
proc sendmsg {id slot args} {
set ns __obj__$id
set x [namespace eval $ns "string length \[info proc $slot\]"]
if {!$x} {
#puts "recurse..."
set slotimpl [lookup $slot $ns]
if {![llength $slotimpl]} {
error "No such method: '$slot'"
}
# Fixme, to eval in the namespace of the slot owner
# pass just one argument, the namespace itself, and
# dirctly call the proc by name instead to create
# the fake _ proc. Behaviour is the same but should
# be less slow.
if {[llength $slotimpl] == 3} {
foreach {a b ns} $slotimpl break
} else {
foreach {a b} $slotimpl break
}
namespace eval $ns [list proc _ $a $b]
namespace eval $ns _ $args
#catch {namespace eval $ns {rename _ {}}}
} else {
namespace eval $ns $slot $args
}
}
proc sendmsgParent {id slot args} {
set ns __obj__$id
set slotimpl [uplookup $slot $ns 1]
if {![llength $slotimpl]} {
error "No such parent method: '$slot'"
}
# Fixme, to eval in the namespace of the slot owner
# pass just one argument, the namespace itself, and
# dirctly call the proc by name instead to create
# the fake _ proc. Behaviour is the same but should
# be less slow.
if {[llength $slotimpl] == 3} {
foreach {a b ns} $slotimpl break
} else {
foreach {a b} $slotimpl break
}
namespace eval $ns [list proc _ $a $b]
namespace eval $ns _ $args
}
# The root object. It is a bit special so requires some hack.
# Note that the root object works like a class, it hasn't
# variables so can be shared between all the objects without
# to be cloned.
obj object {
method print {} {self printto stdout}
method printto {channel} {puts $channel [self tostring]}
method parents {} {
variable parents
return $parents
}
method clone {} {
set ns [self __ns__]
set clone [obj]
set cloneNs [$clone __ns__]
foreach t [info vars [namespace current]::*] {
set newname [cat :: $cloneNs :: [namespace tail $t]]
if {[info exists $newname]} continue
# puts "var : $t -> $newname"
set $newname [set $t]
}
foreach t [info procs [namespace current]::*] {
set newname [cat :: $cloneNs :: [namespace tail $t]]
if {[llength [info procs $newname]]} continue
# puts "proc: $t -> $newname"
proc $newname [info args $t] [info body $t]
}
# Create the parents list, cloning the non-shared parents.
set [cat :: $cloneNs :: parents] {}
foreach p [set [cat :: $ns :: parents]] {
if {[set [cat :: $ns :: __cloneParent__ $p]]} {
lappend [cat :: $cloneNs :: parents] [$p clone]
} else {
lappend [cat :: $cloneNs :: parents] $p
}
}
return $clone
# TODO: remember to handle alises if needed.
}
}
namespace eval [object __ns__] {
variable parents
set parents {}
}
# End of the root object prototype
obj toaster {
var crumbs 0
method toast {nslices} {
if {[self crumbs] > 50} {
error "== FIRE! FIRE! =="
}
self crumbs: [expr [self crumbs]+$nslices*4]
}
method clean {} {
self crumbs: 0
}
}
obj smartToaster {
method toast {nslices} {
if {[self crumbs] > 40} {
self clean
}
parent toast $nslices
}
childof toaster
}
if {0} {
smartToaster crumbs: 4
puts [smartToaster crumbs]
puts [toaster crumbs]
smartToaster toast 4
}
################################################################################# Shapes example
################################################################################
obj Shape {
var x 0
var y 0
method moveTo {newx newy} {
self x: $newx
self y: $newy
}
method rMoveTo {deltax deltay} {
self x: [expr {[self x]+$deltax}]
self y: [expr {[self y]+$deltay}]
}
}
obj Rectangle {
childof Shape
var width 0
var height 0
method tostring {} {return "A Rectangle at [self x],[self y], W:[self width]"}
}
puts [time {set r [Rectangle clone]} 100]
Rectangle x: 10
Rectangle y: 20
Rectangle width: 50
$r x: 100
$r y: 150
$r width: 50
Rectangle print
$r print
Rectangle rMoveTo 5 5
Rectangle print
$r print