Playing Lisp again

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 aliases, which could keep the code simpler 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 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} 5

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
}

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} nil

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

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]

"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 {} null

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

Just for fun, we'll mark procs which use only LisPlay functions with "defun":

interp alias {} defun {} proc

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]
}

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

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

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]
}

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} t

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
# 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} nil

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