*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 lists 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} 5Now, 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 }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"} }The nil proc was extended so it runs with no argument as well:

proc nil args {return nil} ? {car nil} nil ? {cdr nil} nilLists 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]} nilBuilding 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]"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}... 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 {} nullAn 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} ;# identityJust for fun, we'll mark procs which use only LisPlay functions with "defun":

interp alias {} defun {} procThe "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] }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} nilA 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} nilTwo 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] }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)"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} tArithmetics 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 # List length must be determined recursively along the cons chain: 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)"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} nilFiltering 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]