Version 23 of Tcl and LISP

Updated 2005-01-06 13:08:26 by lwv

Richard Suchenwirth 2001-03-01 - LISP (for LISt Processing) is one of the oldest computer languages, dating back to c. 1956, but still having a following (all of Emacs is configured in a LISP dialect) and evolution.

Though I like to play with other languages in Tcl, I never really bothered to "play LISP" (but now see Playing LISP). Is it because LISP and Tcl are at least superficially so similar that there is little to give or take? Both languages treat program code like data, and build strongly on lists (dynamic in length and types) as major data structure. In LISP as in Tcl, a command is a list where the first element ("CAR") is the command name and the others are its arguments. LISP's "property lists" are a mapping from strings to lists, or what Tcl'ers know as an array.

So "playing LISP" would start with just some vocabulary exercises:

 proc car L {lindex $L 0}     ;# "catch address register"
 proc cdr L {lrange $L 1 end} ;# "catch data register"

LISP is more consequent in enclosing each and every list in parens, so you'll see much more of those in any LISP code (and typically have to close one or two handful at the end the file ;-). By adding the commonsense \n and even semicolon as command delimiters, Tcl can do with much less enclosing. Compare LISP's

 (PROGN
   (DO THIS)
   (DO THAT)
 )

to Tcl's

 { 
   do $this
   do $that
 }

But Tcl lists are not exactly as powerful as LISP's, since they are "just" flat sequences, not made up of cons cells (something like pairs of pointers) - so in LISP you can have mutable list parts, circular lists... Didn't miss that yet, however.

See also


KBK (27 Feb 2000) --

Oh, but of course you can have mutable lists. Take a look at the following code. (Of course, for it to not leak memory, we need anonymous lambdas that are garbage collected. Feather?)

 # Create a word to represent an anonymous lambda

 namespace eval ::cell {}

 proc fwcons {} {
     variable cell
     if { [info exists cell] } {
         incr cell
     } else {
         set cell 1
     }
     return ::cell::$cell
 }

 # LAMBDA - Create an anonymous function

 proc lambda { args body } {
     set p [fwcons]
     proc $p $args $body
     return $p
 }

 # CONS - Return a pair consisting of x and y.  Implemented as an anonymous
 #        function

 proc cons { x y } {
     lambda { a } [list if {$a} [list return $x] [list return $y]]
 }

Isn't the above an implementation of "COND", not "CONS"? - JCW

RS: it creates an anonymous proc that returns either CAR or CDR, so the "cons cell" is implemented as proc body, and returns the generated (lambda) name. But see Modeling COND with expr

 # CAR/CDR - Dissect a pair by calling the anonymous function returned by CONS

 proc car { x } { $x 1 }
 proc cdr { x } { $x 0 }

 # NIL - The null list

 proc nil { a } { return nil }

 # NULL - Test if a list is empty

 proc null { l } { string equal nil $l }

 # MAP - Apply a function to each member of a list

 proc map { f l } {
     if { ! [null $l] } {
         $f [car $l]
         map $f [cdr $l]
     }
 }

 # PRIN1 - Print a thing with no newline

 proc prin1 { thing } {
     puts -nonewline $thing
     puts -nonewline { }
 }

 # PRINTLIST - Print each element of a list

 proc printlist { l } {
     map prin1 $l
     puts {}
 }

 # RPLACA - Replace the CAR of a list

 proc rplaca { l x } {
     proc $l [info args $l] [lreplace [info body $l] 2 2 [list return $x]]
     return $l
 }

 # RPLACD - Replace the CDR of a list

 proc rplacd { l y } {
     proc $l [info args $l] [lreplace [info body $l] 3 3 [list return $y]]
     return $l
 }

 set list [cons a [cons b [cons c nil]]]
 prin1 {Before:}
 printlist $list

 rplaca $list d
 rplacd [cdr [cdr $list]] [cons a nil]
 prin1 {After:}
 printlist $list

And here is a garbage collector. - Stephen Trier

 #
 # gc: Garbage collection for lambda functions.
 #
 # Makes the following simplistic assumptions:
 #  1. All references to anonymous functions are on the stack or in
 #     the root namespace.
 #  2. Any reference to an anonymous function's automatically-assigned
 #     proc name is in a proper Tcl list.
 #
 # Assumption 2 puts some restrictions on whether the name can be
 # concatenated with other stuff in a string, as when making a
 # multi-dimensional array index or dynamically constructing a proc
 # body.
 #
 # Whatever you do with the name you get from lambda, the result has
 # to look like a list or the reference will be missed by the garbage
 # collector.
 #
 # The namespace limitation won't be hard to fix.
 #
 # BUGS:
 #
 #   Doesn't look for anonymous functions in Tk bindings
 #
 #   Doesn't look for anonymous functions in interp aliases.
 #
 #   Doesn't check the names of procs on the stack.
 #
 #   Deeply nested structures will cause the GC to exceed the
 #   Tcl recursion limit.
 #

 proc safellength {s} {
     if {[catch {set l [llength $s]}]} {
         return 1
     } else {
         return $l
     }
 }

 proc findrefs {x} {
     upvar used used

     if {[safellength $x] > 1} {
         foreach item $x {
             findrefs $item
         }
     } elseif {[string match ::cell::* $x]} {
         findcellrefs $x
     }
 }

 proc findcellrefs {cell} {
     upvar used used

     if {[info exists used($cell)]} {
         if {$used($cell)} {
             return
         }
     }

     set used($cell) 1
     if {[string equal [info procs $cell] $cell]} {
         findrefs [info body $cell]
         findrefs [info args $cell]
     }
 }

 proc gc {} {
     foreach cell [info procs ::cell::*] {
         set used($cell) 0
     }

     foreach var [info globals] {
         findrefs $var
         if {[array exists ::$var]} {
             findrefs [array get ::$var]
         } else {
             findrefs [set ::$var]
         }
     }

     for {set i [info level]} {$i > 0} {incr i -1} {
         foreach var [uplevel $i info locals] {
             findrefs $var
             if {[uplevel $i array exists $var]} {
                 findrefs [uplevel $i array get $var]
             } else {
                 findrefs [uplevel $i set $var]
             }
         }
     }

     foreach p [info procs] {
         if {![string match ::cell::* $p]} {
             findrefs [info args $p]
             findrefs [info body $p]
         }
     }

     foreach {cell flag} [array get used] {
         if {!$flag} {
             rename $cell {}
         }
     }
 }

 #
 # Tests for the garbage collector
 #

 package require tcltest

 gc  ;# Need to start tests with a garbage-free workspace.

 ::tcltest::test gc-1.1 {garbage collecting global variables} {
     set before [llength [info procs ::cell::*]]

     set x [lambda a a]
     set y(2) [lambda b b]
     gc
     set n1 [expr [llength [info procs ::cell::*]] - $before]
     unset x
     gc
     set n2 [expr [llength [info procs ::cell::*]] - $before]
     unset y
     gc
     set n3 [expr [llength [info procs ::cell::*]] - $before]
     list $n1 $n2 $n3
 } {2 1 0}

 ::tcltest::test gc-1.2 {garbage collecting procs} {
     set before [llength [info procs ::cell::*]]

     proc foo {} [lambda b {puts hi}]
     gc
     set n1 [expr [llength [info procs ::cell::*]] - $before]
     rename foo {}
     gc
     set n2 [expr [llength [info procs ::cell::*]] - $before]
     list $n1 $n2
 } {1 0}

 ::tcltest::test gc-1.3 {garbage collecting procs} {
     proc bar {} {
         set before [llength [info procs ::cell::*]]
         lambda a {}
         set local [lambda b {}]
         set n0 [expr [llength [info procs ::cell::*]] - $before]
         gc
         set n1 [expr [llength [info procs ::cell::*]] - $before]
         unset local
         gc
         set n2 [expr [llength [info procs ::cell::*]] - $before]
         return [list $n0 $n1 $n2]
     }
     bar
 } {2 1 0}

 ::tcltest::test gc-1.4 {garbage collecting nested lambdas} {
     set before [llength [info procs ::cell::*]]

     set root [lambda a {}]
     set higher [lambda b [lambda c [lambda d $root]]]
     set n1 [expr [llength [info procs ::cell::*]] - $before]
     gc 
     set n2 [expr [llength [info procs ::cell::*]] - $before]
     unset higher
     gc 
     set n3 [expr [llength [info procs ::cell::*]] - $before]
     unset root
     gc 
     set n4 [expr [llength [info procs ::cell::*]] - $before]
     list $n1 $n2 $n3 $n4
 } {4 4 1 0}

Arjen Markus I have written a small script that takes a totally different approach to the issue: Garbage collection (When I originally added a question mark, the link was not created properly. Alas, the name now pretends more than the contents really is :-). Still, I think it is enjoyable a technique.


Doug Alcorn Besides lambda functions and garbage collection issues, what about unwind-protect and macros? Those are two of the coolest features of lisp I miss. unwind-protect evaluates a protected-form and guarantees that a cleanup-forms are executed before unwind-protect exits, whether it terminates normally or is aborted by a control transfer of some kind. unwind-protect is intended to be used to make sure that certain side effects take place after the evaluation of protected-form. This is a really safe way to do clean-up code.

KBK recommends looking at try ... finally ... for how to do (unwind-protect).

Macros are "functions" that return functions. You pass in a set of variables, the "body" of the macro is the code you want to return with these substitued.

Arjen Markus Macros are easy to simulate: use [interp alias] to hide the parameters you want substituted. Like:

   proc printIt { text } {
      puts $text
   }

   interp alias {} print {} printIt "Hello world"

   print 
   ==> Hello world

The new procedure "print" has no arguments (printIt takes "text" from the list provided by the alias) and is effectively the same as printIt with $text replaced.


See also Playing Lisp again for a cons/car/cdr implementation with macros.


Category Language