if 0 {[Richard Suchenwirth] 2004-02-28 - In [Tcl and Lisp], [KBK] 
showed how to implement mutable lists with [lambda] procs. This 
weekend I started out with a variation using [interp alias]es, 
which could keep the code [simple]r and the memory consumption 
down - this is important as I did not bother for [garbage 
collection] yet... Aliases created by ''cons'' have a name of 
pattern =N, where N is a unique integer. Their "body" is just 
"list A D", with A and D the two cons arguments, ready for 
retrieval by ''car'' resp. ''cdr'', the two classic accessors to 
head resp. tail of the list thus implemented. (I know that Tcl 
[list]s are much easier in handling, but I just wanted to relive 
history, back to the 1960s... :)

This project quickly outgrew its cons-car-cdr beginnings, 
so I decided to test much, and in order to put tests close to 
their code (also as documentation), I define a minimal testing 
framework first:}
 proc ? {cmd exp} {
     if [catch {uplevel 1 $cmd} res] {
        error $::errorInfo
     } elseif {$res ne $exp} {
         puts "$cmd->$res, not $exp"
     }
 }
 ? {expr 2+3} 5
if 0 {Now, let this LisPlay begin - this is not "real" Lisp, as 
quoting and bracing still is Tcl. The classic constructor for a 
pair of things, cons, here goes like this:}
 if ![info exist N] {set N 0} ;# cons no.
 proc cons {ar dr} {
    interp alias {} =[incr ::N] {} \
        list $ar $dr
 }
if 0 {Given such a cons cell, access to its members is very 
straightforward:}
 proc car x {lindex [$x] 0}
 proc cdr x {lindex [$x] 1}
# or, closer to Lisp's behavior: 
 proc cdr x {
    expr {[llength [$x]]>1?[lindex [$x] 1]:"nil"}
 }
if 0 {The nil proc was extended so it runs with no argument as 
well:}
 proc nil args  {return nil}
 ? {car nil} nil
 ? {cdr nil} nil

if 0 {Lists in Lisp are done as a chain of conses, the last being 
terminated with "nil":}
 set try [cons foo [cons bar nil]]
 ? {car $try} foo
 ? {car [cdr $try]} bar
 ? {cdr [cdr $try]} nil
if 0 {Building a list with nested conses is tedious. As Lisp's 
list constructor is named "list" like in Tcl, I chose a slightly 
different name, so as not to lose the original:}
 proc List args {
    if [llength $args] {
       cons [lindex $args 0] \
          [eval List [lrange $args 1 end]]
    } else nil ;# empty list
 }
 set try [List foo bar grill]
if 0 {"Nil" is also boolean False in Lisp, everything else being 
True. A little adapter to Tcl's C-based convention of 0=false, 
every other number=true:}
 proc t? x  {expr {$x ne "nil"}}
 ? {t? whatever} 1
 ? {t? nil}   0
 proc t {} {return t}
if 0 {... and a converse adapter from Tcl to Lisp, plus a use 
case that tests for empty lists, and doubles up as logical NOT:}
 proc t/nil x {expr {$x? "t" : "nil"}}
 proc null x {t/nil [string equal $x nil]}
 ? {null $try}  nil
 ? {null nil} t
 interp alias {} not {} null
if 0 {An approximation of Lisp's conditional:}
 proc cond args {
    foreach {test result} $args {
       if {[uplevel 1 $test] ne "nil"} {
          return [uplevel 1 $result]
       }
    }
    return nil
 }
 proc is x {set x} ;# identity
if 0 {Just for fun, we'll mark procs which use only LisPlay 
functions with "defun":}
 interp alias {} defun {} proc

if 0 {The "and" and "or" operators work on Tcl lists, so the 
"args" can be used as they come. But in contrast to Lisp, they 
just return "t" for truth:}
 proc and args {
     if {$args eq ""} {return t}
     if ![t? [lindex $args 0]] {return nil}
     eval and [lrange $args 1 end]
 }
 proc or args {
     if {$args eq ""} {return nil}
     if [t? [lindex $args 0]] {return t}
     eval or [lrange $args 1 end]
 }
if 0 {The test whether an item is a cons is of course 
implementation-dependent, while its converse ''atom'' is just its 
negation:}
 proc consp x {
    t/nil [regexp {^=[0-9]+$} $x]
 }
 ? {consp $try} t
 ? {consp 42}   nil
 defun atom x {not [consp $x]}
 ? {atom 42} t
 ? {atom nil} t
 ? {atom $try} nil
if 0 {A list in Lisp can be either a cons, or the empty list 
(nil):}
 defun listp x {or [consp $x] [null $x]}
 ? {listp $try} t
 ? {listp nil}  t
 ? {listp 42} nil
if 0 {Two operators which change a cons cell "destructively" in 
place, using an alias serializer that returns a command to 
re-create that alias:}
 proc alias'serialize alias {
    set cmd [list interp alias {} $alias]
    concat $cmd {{}} [eval $cmd]
 }
 proc rplaca {l x} {
    set c [alias'serialize $l]
    eval [lreplace $c end-1 end-1 $x]
 }
 proc rplacd {l y} {
    set c [alias'serialize $l]
    eval [lreplace $c end end $y]
 }
if 0 {To test this, we need a way of rendering lists, or objects 
in general, to strings - which in Tcl is a non-problem. This also 
does "dotted pairs" right:}
 defun pr x {
    cond {consp $x} {
     is ([pr [car $x]][pr2 [cdr $x]])
    } t {is $x}
 }
 defun pr2 {x {acc ""}} {
    cond {consp $x} {
       pr2 [cdr $x] "$acc [pr [car $x]]"
    } {null $x} {is $acc} \
       t            {is "$acc . $x"}
 }
 ? {pr 42} 42
 ? {pr $try} "(foo bar grill)"
 set try2 [cons $try $try]
 ? {pr $try2} "((foo bar grill) foo bar grill)"
 ? {pr [cons this that]} "(this . that)"
 set rpl $try
 ? {pr [rplaca $rpl Tk]} "(Tk bar grill)"
 ? {pr [rplacd [cdr $rpl] [List rules]]} "(bar rules)"
 set foo [List 1 2 3]
 #-- copy is by reference
 set bar $foo
 rplaca [cdr $foo] 8
 ? {pr $foo} "(1 8 3)"
 ? {pr $bar} "(1 8 3)"
if 0 {Lisp is pretty different when it comes to equality, having 
'eq', 'eql' and 'equal' to choose from. The last is the broadest 
of them, it tests lists recursively:}
 proc eq {x y} {t/nil [expr {$x eq $y}]}
 ? {eq 2 2.0}   nil
 ? {eq 42 42}  t
 proc eql {x y} {t/nil [expr {$x==$y}]}
 ? {eql 2 2.0} t
 defun equal {x y} {
    cond {and [atom $x] [atom $y]} \
                {eql $x $y} \
       t {and [equal [car $x] [car $y]]\
                 [equal [cdr $x] [cdr $y]]}
 }
 ? {equal foo foo} t
 ? {equal foo bar} nil
 ? {equal 2 2.0}   t
 ? {equal $try $try} t

if 0 {Arithmetics for now just cover the bare necessities, but 
the principle should be evident:}
 proc + args {expr [join $args +]}
 ? {+ 3 4} 7
 proc * args {expr [join $args *]}
 ? {* 3 4} 12
 proc % {a b} {expr {$a%$b}}
 ? {% 17 4} 1
 ? {% 16 8} 0
 defun evenp x {eq [% $x 2] 0}
 ? {evenp 1234} t
 defun oddp x {not [evenp $x]}
 proc 1+ x {incr x}
 ? {1+ 5}  6
 proc 1- x {incr x -1}
 ? {1- 5}  4

# Some exercises in recursion:
 defun fac x {
    cond {eql 1 $x} {is 1} \
             t    {* $x [fac [1- $x]]}
 }
 ? {fac 5} 120
 defun length list {
     cond {null $list} {is 0} \
             t     {1+ [length [cdr $list]]}
 }
 ? {length $try} 3
 ? {length nil}   0
# Classic functional, map a function to a list:
 defun map {f l} {
   cond {null $l} nil \
      t {cons [$f [car $l]] [map $f [cdr $l]]}
 }
 ? {pr [map 1+ [List 1 2 3]]} "(2 3 4)"
if 0 {Another classic, list membership (for which Tcl has 
[lsearch]). However, 'member' returns the sublist starting with 
'item', which is an acceptable truth value:}
 defun member {item l} {
    cond {null $l}   nil \
          {equal $item [car $l]} {is $l} \
           t  {member $item [cdr $l]}
 }
 set try [List foo bar grill]
 ? {not [member foo $try]} nil
 ? {not [member bar $try]} nil
 ? {member baz $try} nil
if 0 {Filtering a list:}
 defun remove-if-not {f list} {
    cond {null $list} nil \
       {$f [car $list]} {cons [car $list] [remove-if-not $f [cdr $list]]} \
       t   {remove-if-not $f [cdr $list]}
 }
 ? {pr [remove-if-not evenp [List 1 2 3 4]]} "(2 4)"

# finally, a quickie to save typing on the iPaq:
 interp alias {} s {} source [info scrip]

----
[Arts and crafts of Tcl-Tk programming]