Introduction
(from "Common Lisp: A Gentle Introduction to Symbolic Computation",
David S. Tourestzky, The Benjamin/Cummings Publising Co., 1990)

List processor  
Function composition  
Functionals  
Recursion



Functional Programming 
Common Lisp

Numbers

Integers:

5, -15, 325

Floating point numbers: 5.0, -0.5, 6.02E+23

ratios:

2/3, -17/23, 10/5




Symbols

 A symbol is any sequence of letters, digits, and permissible special characters that is not a number

 YEAR-TO-DATE /usr/games/zork

 Permissible special characters:

  + - * / ~ $ % - & _ \ ( >


 Symbols can be used as plain data or as the names for variables or functions

 Two special symbols:

   T: true NIL: false

Evaluation of Expressions

Evaluation Rule for Numbers, T, and NIL: 
  Numbers, and the symbols T and NIL, evaluate to themselves
>4
4

>T
T

> NIL
nil


Evaluation Rule for Symbols:  A symbol
evaluates to the value of the variable it refers to

> pi
3.14159




Lists

A list is a  bunch  of objects enclosed  in parentheses

(red green blue) (aardvark) (2 3 5 7 11 13 17)

These objects are called the elements of the list

The empty list: () or NIL

 NIL is the only Lisp object that is both a symbol and a list

Nested lists:

((blue sky) (green grass)) ((brain surgeons) never (say oops))




Evaluation of Expressions

Evaluation Rule for Lists: 
The first element of the list specifies a function to be called.   
The remaining elements specify arguments to the function. 
The function is called  on the evaluated  arguments (innermost first).

> (* 3 (+ 1 6))
21

> (/ 15 (- 5 2)) 
5

> (sqrt (abs -16)) 
4



Representation of Lists

A list is represented as a chain of cons cells

(red green blue)
         __________      ___________    ____________
         |   |    |----->|    |    |--->|     |  --|--->NIL
         | | |    |      | |  |    |    |     |    |
         --|-------      --|--------    --|---------
           V               V              V
          red             green          blue

(aardvark)

         __________    
         |   |    |----->NIL
         | | |    |     
         --|-------   
           V    
         aardvark 

((brain surgeons) never (say oops))

         __________      ___________    ____________
         |   |    |----->|    |    |--->|     |  --|--->NIL
         | | |    |      | |  |    |    |     |    |
         --|-------      --|--------    --|---------
           V               V              V
           |             never           __________      ___________
           |                             |   |    |----->|    |  --|-->NIL
           |                             | | |    |      | |  |    |
           |                             --|-------      --|--------
           V                              say             oops 
         __________      ___________ 
         |   |    |----->|    |  --|--> NIL
         | | |    |      | |  |    |
         --|-------      --|--------
           V               V
         brain           surgeons 
          
                      


Symbols and Lists as Data

> 'pi
 pi

> '(red green blue) 
 (red green blue)

> ''pi

'pi

> ''pi

(quote pi)




Predicates

> (oddp 27)
t

> (oddp 28)
nil

> (evenp 27) 
nil

> (evenp 28) 
t

> (not nil)
t

> (not t)
nil

> (numberp 4) 
t

> (numberp 'red) 
nil

> (symbolp 4) 
nil

> (symbolp 'red) 
t

> (zerop O) 
t

> (zerop 35) 
nil

> (> 3 2)
t

> (> 2 3)
nil

> (< 3 2)
nil

> (< 2 3)
t

> (equal 'cat 'mouse) 
nil

> (equal 'cat 'cat) 
t

> (not 'fred) 
nil

> (equal 3 'cat) 
nil

Variable Number of Arguments

Functions on Lists

> (+ 1 2 3 4 5) 
15

> (- 15 2 3 4 5)
1

> (/ 120 2 3 4 5)
1

> (- 4)
-4

> (/ 4.0)
0.25

> (+)
0

> (*)
1



Functions Operate on Pointers

> (length '(a b c d)) 
4

> (length '(a (b c) d)) 
3

> (length nil)
O

> (first '(a b c d))
a

> (second '(a b c d)) 
b

> (third '(a b c d)) 
c

> (rest '(a b c d)) 
(b c d)

> (car '(a b c d)) 
a

> (cdr '(a b c d)) 
(b c d)

> (car nil)
nil

> (cdr nil)
nil

> (cadr '((a b) c d)) 
c

> (cdar '((a b) c d)) 
(b)

> (cadar '((a b) c d)) 
b

List Predicates

CONS and LIST

> (cons 'a '(b c d)) 
(a b c d)

> (cons nil nil)
(nil)

> (cons '(a b) '(e d)) 
((a b) c d)

> (list 'a '(b c d)) 
(a (b c d))

> (list nil)
(nil)

> (list '(a b) '(c d)) 
((a b) (e d))


       Defining Functions
(defun func-name (argument-list) body-expr)

> (defun average (x y) (/ (+ x y) 2.0))
average

> (average 4 6) 
5.0

> (defun double (n) (* n 2)) 
double

> (double 4) 
8

> (defun quadruple (n) (double (double n))) 
quadruple

> (quadruple 4)
16


List Predicates

> (listp 'red) 
nil

> (listp '(red green blue)) 
t

> (listp nil)
t

> (consp nil)
nil

> (atom 18) 
t

> (atom 'red) 
t

> (atom '(red green blue)) 
nil




IF

(if test true-part false-part)

> (if (oddp 1)  'odd 'even) 
odd

> (defun symbol-test (x) 
  (if (symbolp x)
     (list 'yes x 'is 'a 'symbol)
     (list 'no x 'is 'not 'a 'symbol))) 
symbol-test

> (symbol-test 'red) 
(yes red is a symbol)

> (symbol-test 12345) 
(no 12345 is not a symbol)

> (if t 'happy) 
happy

> (if nil 'happy) 
nil

COND

(cond (test-1 consequent-1)
      (test-2 consequent-2)
        ...
      (test-n consequent-n))

> (defun compare (x y)
    (cond ((equal x y) 'numbers-are-same)
          ((< x y) 'first-is-smaller)
          ((> x y) 'first-is-bigger)))
compare

>(compare 3 5)
first-is-smaller

>(compare 7 2)
first-is-bigger

> (Compare 4 4)
numbers-are-same



(cond (test-1 consequent-1)
      (test-2 consequent-2)
        ...
      (test-n consequent-n)
      (T consequent))
               

> (defun where-is (x)
   (cond ((equal x 'paris) 'france)
         ((equal x 'beijing) 'china)
         ((equal x 'london) 'england)
         (t 'unknown)))
where-is

> (where-is 'london)
england

> (where-is 'beijing)
china

> (where-is 'hackensack)
unknown



AND and OR

>(and nil t t)
nil

>(and 'george nil 'harry)
nil

> (and 'george 'fred 'harry)
harry

>(or nil t t)
t

> (or 'george nil 'harry)
george

> (or 'george 'fred 'harry)
george

> (or nil nil nil)
nil


Conditionals are Interchangeable

(defun where-is (x)
   (cond ((equal x 'paris) 'france)
         ((equal x 'london) 'england)
         ((equal x 'beijing) 'china)
         (t 'unknown)))

(defun where-is-2 (x)
   (if (equal x 'paris) 'france
       (if (equal x 'london) 'england
           (if (equal x 'beijing) 'china
                   'unknown))))

(defun where-is-3 (x)
   (or (and (equal x 'paris) 'france)
       (and (equal x 'london) 'england)
       (and (equal x 'beijing) 'china)
       'unknown))



SETF

> (setf vowels '(a e i o u)) 
(a e i o u)

> (length vowels) 
5

> (rest vowels) 
(e i o u)

> (setf vowels '(a e i o u and y)) 
(a e i o u and y)

> (setf head (first vowels)) 
a

> (setf tail (rest vowels)) 
(e i o u and y)

> (equal vowels (cons head tail)) 
t




Side Effects Can Cause Bugs

> (defun coin-with-bug () 
   (cond ((< (random 101) 50) 'heads) 
         ((> (random 101) 50) 'tails) 
         ((equal (random 101) 50) 'edge))) 
coin-with-bug

Side Effects

> (coin-with-bug) 
heads

> (coin-with-bug) 
tails

> (coin-with-bug) 
tails

> (coin-with-bug) 
nil



> (defun poor-style (p) 
   (setf p (+ p 5)) 
   (list 'result 'is p)) 
poor-style

> (poor-style 8) 
(result is 13)

> P
Error! unassigned variable

> (random 5)
1

> (random 5)
3

> (number 5.0) 
2.32459

> (number 5.0) 
4.94179




LET

(let ((var-1 value-1) 
      (var-2 value-2)
        ...
      (var-n value-n))
body)

> (defun average (x y) 
    (let ((sum (+ x y)))
     (list x y 'average 'is (/sum 2.0))))
average

> (average 3 7) 
(3 7 average is 5.0)

> (defun switch-billing (x) 
    (let ((star (first x)) 
           (co-star (third x)))
      (list co-star 'accompanied 'by star))) 
switch-billing

> (switch-billing '(fred and ginger)) 
(ginger accompanied by fred)

LET*

(let* ((var-1 value-1) 
       (var-2 value-2)
         ...
       (var-n value-n))
body)

> (defun price-change (old new) 
    (let* ((diff (- new old)) 
           (proportion (/ diff old))
           (percentage (* proportion 100.0))) 
    (list 'widgets 'changed 'by percentage 'percent)))

> (price-change 1.25 1.35) 
(widgets changed by 8.0 percent)))



APPEND

> (cons 'w '(x y z)) 
(W X y z)

> (cons '(a b c) 'd) 
((a b c) . d)

> (append '(a b) '(c d)) 
(a b c d)

> (append '((a 1) (b 2)) '((c 3) (d 4))) 
((a 1) (b 2) (c 3) (d 4))

> (append '(a b) nil) 
(a b)

> (append nil '(c d)) 
(c d)




A proper list is a cons cell chain ending in nil

(a b c)


A dotted pair is a single cons cell whose cdr is not nil

(a . b)


A dotted list is a cons cell chain whose last cons cell is a dotted pair

(a b c. d)




CONS, LIST, and APPEND

> (append nil nil)
nil

> (cons 'rice '(and beans))
(rice and beans)

> (list 'rice '(and beans)) 
(rice (and beans))

> (append 'rice '(and beans)) 
Error: rice is not a list

> (cons '(here today) '(gone tomorrow)) 
((here today) gone tomorrow)

> (list '(here today) '(gone tomorrow)) 
((here today) (gone tomorrow))

> (append '(here today) '(gone tomorrow)) 
(here today gone tomorrow)

> (cons '(eat at) 'joes) 
((eat at) . joes)

> (list '(eat at) 'joes) 
((eat at) joes)

> (append '(eat at) 'joes) 
(eat at . joes)

More Functions on Lists

> (reverse '(one two three four five)) 
(five four three two one)

> (reverse '((one 1) (two 2) (three 3))) 
((three 3) (two 2) (one 1))

> (reverse 'live) 
Error: wrong type input.

> (nthcdr O '(a b c)) 
(a b c)

> (nthcdr 2 '(a b c))
(c) 

> (nth O '(a b c))
a

> (nthcdr 2 '(a b c))





Lists as Sets

> (setf ducks '(huey hewey louie)) 
(huey dewey louie)

> (member 'huey ducks) 
(huey dewey louie)

> (member 'dewey ducks) 
(dewey louie)

> (member 'mickey ducks) 
nil

> (subsetp '(a i) '(a e i o u)) 
t

> (subsetp '(a x) '(a e i o u)) 
nil




More Functions on Lists

> (last '(a b c d))
(d)

> (last )(a b c . d)) 
(c . d)

> (last 'nil)
nil

> (last 'nevermore) 
Error: nevermore is not a list

> (remove 'a)  '(b a n a n a)) 
(b n n)

> (remove 1 '(3 1 4 1 5 9)) 
(3 4 5 9)




Sets

> (intersection '(a c e) '(b c d))
(c)

> (intersection '(a c e) '(b d f)) 
nil

> (union '(a c e) '(b c d)) 
(a c e b d)

> (union '(a c e) '(b d f)) 
(a c e b d f)

> (set-difference '(a c e) '(b c d)) 
(a e)

> (set-difference '(b c d) '(a c e)) 
(b d)

> (set-exclusive-or '(a c e) '(b c d)) 
(a e b d)

> (set-exclusive-or '(a c e) '(b d f)) 
(a c e b d f)

Programming with Sets

> (defun titledp (name)
    (member (first name) '(mr ms miss mrs)))

> (titledp '(jane doe)) 
nil

> (titledp '(ms jane doe)) 
(ms miss mrs)

> (setf male-first-names
        '(john kim richard fred george)) 
(john kim richard fred george)

> (setf female-first-names
    '(jane mart wanda barbara kim))
(jane mart wanda barbara kim)


> (defun malep (name) 
    (and (member name male-first-names) 
         (not (member name female-first-names))))
malep

> (defun femalep (name)
    (and (member name female-first-names) 
         (not (member name male-first-names))))
femalep

> (malep 'richard) 
t

> (malep 'barbara) 
nil

> (femalep 'barbara) 
t

> (femalep 'kim) 
nil


Programming with Sets

> (defun give-title (name) 
  (cond ((titledp name) name) 
        ((malep (first name))
           (cons  mr name))
        ((femalep (first name))
           (cons 'ms name))
        (t (append '(mr or ms) name))))
give-title

> (give-title '(miss jane adams)) 
(miss jane adams)

> (give-title '(john peterson)) 
(mr john peterson)

> (give-title '(barbara smith)) 
(ms barbara smith)

> (give-title '(kim johnson)) 
(mr or ms kim johnson)


Lists as Tables

words

> (setf words '((one un) (two deux) (three trois) (four quatre) (five cinq)))

> (assoc 'three words)
(three trois)


> (assoc 'four quatre)
(four words)

> (assoc 'six words) 
nil

> (defun translate (x)
    (second (assoc x words)))
translate

> (translate 'three) 
trois

Lists as Tables

> (setf sounds
    '((cow . moo)
    (pig . oink)
    (cat . meow)
    (dog . woof)
    (bird . tweet)))

> (rassoc 'woof sounds) 
(dog . woof)

> (assoc 'dog sounds) 
(dog . woof)






Programming with Tables

> (setf things
    '((object1 large green cube) 
      (object2 small red metal cube) 
      (object3 red small plastic cube) 
      (object4 small blue metal cube) 
      (object5 small red sphere) 
      (object6 large green sphere)))

> (defun description (x) (rest (assoc x things))) 
description

> (description 'object3) 
(red small plastic cube)

> (defun differences (x y) 
    (set-exclusive-or (description x) (description y))) 
differences

> (differences 'object2 'object3) 
(metal plastic)





> (setf quality-table

> (setf quality-table
    '((large . size)
      (small . size)
      (red . color)
      (green . color)
      (blue . color)
      (metal . material)
      (plastic . material)
      (cube . shape)
      (sphere . shape)))


> (defun quality (x)
    (cdr (assoc x quality-table)))

> (quality 'red) 
color

> (defun quality-difference (x y) 
    (quality (first (differences x y))))

> (quality-difference 'object2 'object3)
material




Programming with Tables

> (subst 'fred 'bill
     '(bill jones sent me the phone bill)) 
(fred jones sent me the phone fred)

> (sublis '((roses . violets) (red . blue)) '(roses are red))
(violets are blue)

> (remove-duplicates
      '(color color material material))

(color material)

> (defun contrast (x y) (remove-duplicates 
     (sublis quality-table
            (differences x y))))
contrast

> (quality-difference 'object2 'object3) 
material

> (contrast 'object3 'object4) 
(color material)

Equality of Objects

Equality of Objects

EQ compares addresses. It should not be used to compare numbers.

EQL is like EQ except it safely compare numbers of the same type. It is the default equality test in Common Lisp.

EQUAL compares lists element by element; otherwise it works like EQL.

= is  the  most  efficient  way to  compare numbers, and the only way to compare numbers of disparate types. It only accepts numbers.




Equality of Objects

> (eq 'foo 'foo)
t

> (eq 3 3)
Error: wrong input type

> (eql 'foo 'foo) 
t

> (eql 3 3)
t

> (eql 3 3.0)
nil

> (= 3  3.0) 
t


Equality of Objects

> (setf x1 (list 'a 'b 'c))
(a b c)

> (setf x2 (list 'a 'b 'c)) 
(a b c)

> (equal xl x2) 
t

> (eq x1 x2)
nil

> (setf z x1) 
(a b c)

> (eq z X1) 
t

> (eql x1 x2)
nil




Applicative Programming

Applicative operators are functions that takes another function as input and apply it to the elements of a list in various ways

> (funcall #'cons 'a 'b) 
(a . b)

> (setf fn #'cons) 
#(Compiled-function cons (6041410)>

> fn 
#(Compiled-function cons (6041410)>

> (funcall fn 'a 'b) 
(a . b)

> #'if 
Error: if is not an ordinary function

> (= 'foo 'foo) 
Error: foo is not a number

> #'turnips 
Error: turnips is an undefined function

FUNCTION

CONS

> 'cons
cons

> (quote cons)
cons

> #'cons 
#<Compiled-function cons 6041410>

> (function cons) 
#<Compiled-function cons 6041410>

> (setf fn #'cons) 
#<Compiled-function cons 6041410>

> (fn 'a 'b) 
Error: undefined function fn

> (funcall fn 'a 'b) a
(a . b)





 APPLY and EVAL
> (apply #'+ '(2 3)) 
5

> (apply #'cons '(as (you like it))) 
(as you like it)

> (eval '(+ 2 3)) 
5

> (eval ''boing)
'boing

> (eval (eval ''boing))
boing

> (eval '(list '* 9 6)) 
(* 9 6)

> (eval (eval '(list '* 9 6))) 
54



MAP CAR

> (defun square (n) (* n n)) 
square

> (square 3) 
9

> (square '(1 2 3 4 5)) 
Error: wrong input type

> (mapcar #'square '(1 2 3 4 5)) 
(1 4 9 16 25)

> (mapcar #'square '(3 8 -3 5 10)) 
(9 64 9 25 100)

> (mapcar #'square nil )
nil







Using MAPCAR on Tables

> (setf words
'((one un) (two deux) (three trois) (four quatre) (five cinq)))

> (mapcar #'first words) 
(one two three four five)

> (mapcar #'second words) 
(un deux trois quatre cinq)

> (mapcar #'reverse words) 
((un one) (deux two) (trois three) (quatre four) (cinq five))

> (defun translate (x)
    (second (assoc x words)))
translate

> (mapcar #'+ '(1 2 3) '(10 20 30)) 
(11 22 33)

> (mapcar #'translate
      '(three one four one five)) 
(trois un quatre un cinq)

Lambda Expressions

Lambda expressions are anonymous functions

(lambda (n) (* n n))

> (mapcar #'(lambda (n) (* n n)) '(1 2 3 4 5) 
(1 4 9 16 25)

> (mapcar #'(lambda (n) (* 10 n)) '(1 2 3 4 5) 
(10 20 30 40 50)

> (lambda (n) (* n 10)) 
Error: undefined function lambda

> #'(lambda (n) (* n 10)) 
#<lexical-closure {7142156}>



FIND-IF

> (find-if #'oddp ](2 4 6 7 8 9)) 
7

> (find-if #'oddp '(2 4 6 8)) 
nil

> (defun my-assoc (key table)
      (find-if #'(lambda (entry)
         (equal key (first entry)))
        table))
my-assoc

> (setf words
'((one un) (two deux) (three trois) (four quatre) (five cinq)))

> (my-assoc 'two words) 
(two deux)






REMOVE-IF

> (remove-if #'numberp '(2 for 1 sale)) 
(for sale)

> (remove-if #'(lambda (x) (not (plusp x))) '(2 O -4 6 -8 10)) 
(2 6 10)

> (remove-if-not #'plusp
       '(2 O -4 6 -8 10))
(2 6 10)


> (defun count-zeros (x)
    (length (remove-if-not #'zerop x))) 
count-zeros

> (count-zeros '(34 O O 95 0)) 
3

> (count-zeros '(1 2 3 4 5))
O


REDUCE

> (reduce #'+ '(1 2 3)) 
6

> (reduce #'+ '(5)) 
5

> (reduce #'+ nil)
O

> (reduce #'append
    '((one un) (two deux)))
(one un two deux)

> (reduce #'(lambda (x y)
    (+ (* x X)  (* y y))))
       '(1 2 3))
34

Recursion

> (defun anyoddp (x) 
    (cond ((null x) nil)
          ((oddp (first x)) t) 
          (t (anyoddp (rest x))))) 
anyoddp

> (anyoddp nil)
nil

> (anyoddp '(6)) 
nil

> (anyoddp '(7)) 
t

> (anyoddp '(2 4 6 7 8 9)) 
t


RECURSION

> (defun fact (n)
    (cond ((zerop n) 1)
          (t (* n (fact (- n 1))))))
fact


> (fact 3)
6

> (fact 2)

2

> (fact 1)

1

> (fact O)

1




EVERY

> (every #'numberp '(1 2 3 4 5)) 
t

> (every #'numberp '(1 2 a b 5)) 
nil

> (every #'numberp nil)
t

> (every #'> '(10 20 30 40) '(1 5 11 23))
t

Functions That Make Functions

> (defun make-greater-than-predicate (n) 
   #'(lambda (x) (> x n)))
make-greater-than-predicate

> (setf pred
      (make-greater-than-predicate 3))
#<Lexical-closure 7315225>

> (funcall pred 2) 
nil

> (funcall pred 5) 
t

> (find-if pred '(2 3 4 5)) 
4

Recursion

> (defun my-length (1)
    (cond ((null 1) 0)
          (t  (+ 1  (my-length (cdr 1))))))

my-length

> (my-length nil)
O

> (my-length '(1))
1

> (my-length '(1 2 3 4 5)) 
5




The Three Rules of Recursion 

Know when to stop 
Decide how to take one step 
Break thejourney down into that step plus a smaller journey



The Three Rules of Recursion

Stop When Input Is
anyoddp   nil 
fact      O 
my-length nil

Value Returned When Stop
anyoddp  nil 
fact     1 
my-length O

One Step to Take
anyoddp    (oddp (car x))
fact       n * ...
my-length  1 + ...

Rest of Problem
anyoddp     (anyoddp (cdr x)) 
fact        (fact (- n 1))
length      (length (cdr l))


Infinite Recursion

> (defun fib (n)
    (+ (fib (- n 1)
       (fib - n 2))))
fib

> (trace fib) (fib)

> (fib 3) 
-- (fib 3) 
-- (fib 2)
-- (fib 1)
-- (fib O)
-- (fib -1)
-- (fib -2) 
-- (fib -3)

Double-Test Tail Recursion

Template:

(defun func (x) 
  (cond (end-test-1 end-value-1) 
        (end-test-2 end-value-2) 
         . . .
        (t (func reduced-x))))

Example:

func:	anyoddp

end-test-1:	(null x)

end-value-1:	nil

end-test-2:	(oddp (car x))

end-value-2:	t

reduced-x:	(cdr x)


(defun anyoddp (x) 
  (cond ((null x) nil)
        ((oddp (car x)) t) 
        (t (anyoddp (cdr x)))))






Augmenting Recursion

Template:

(defun func (x)

   (cond (end-test end-value) 
         (t  (aug-fun aug-val
              (func reduced-x)))))

Example:

func:         my-length
end-test:     (null x) 
end-value:    O
aug-fun:      + 
aug-val:      1
reduced-x:    (cdr x)

(defun my-length (x) (cond ((null x) O)
   (t (+ 1 (my-length (cdr x))))))




Single-Test Tail Recursion

Template:

(defun func (x)
  (cond (end-test end-value) 
        (t (fune reduced-x))))

Example:

func:              find-first-atom
end-test:          (atom x)
end-value:         x
reduced-x:         (car x) 

find-first-atom (atom x) x (car x>

(defun find-first-atom (x) (cond ((atom x) x)
      (t  (find-first-atom (first x)))))

> (find-first-atom '(((a b) c) d)) a

> (find-first-atom 'a) a





List-Consing Recursion

Template:

(defun func (n) (cond (end-test nil)
      (t (cons new-element
           (func reduced-n)))))

func:               laugh
end-test:           (zerop n)
new-element:        'ha
reduced-n:          (- n 1)


(defun laugh (n)
  (cond ((zerop n) nil)
        (t (cons 'ha (laugh (- n 1))))))

Recursion on Several Variables

Template:

(defun func (n x) (cond (end-test end-value)
        (t (func reduced-n reduced-x))))

Example:

func:            my-nth
end-test:        (zerop n)
end-value:       (car x)
reduced-n:       (- n 1)
reduced-x:       (cdr x)

(defun my-nth (n x) (cond ((zerop n) (car x))
      (t (my-nth (- n i)  (cdr x)))))

> (my-nth 2 '(a b c d e))
c




Conditional Augmentation

Template:
(defun func (x)
   (cond (end-test end-value) 
         (aug-test (aug-fun aug-val
                (func reduced-x)))
         (t (func reduced-x))))


Example:


(defun extract-symbols (x) 
   (cond ((null x) nil) 
         ((symbolp (car x)) 
            (cons (car x) 
                (extract-symbols (cdr x))))
         (t (extract-symbols (cdr x)))))



Multiple Recursion

Template:
(defun func (n)

(cond (end-test-1 end-value-1) 
      (end-test-2 end-value-2) 
        . . .
      (t (combiner (func first-reduced-n)
                   (func second-reduced-n)))))

Example: 
func:           fib
end-test-1:     (equal n 0)
end-value-1:    1
end-test-2:     (equal n 1)
end-value-2:    1
combiner:       +
first-reduced-n: (- n 1)
second-reduced-n:(- n 2)

(defun fib (n)
  (cond ((equal n 0) 1)
        ((equal n 1) 1)
        (t (+ (fib (- n 1)
                   (- n 2))))))


Trees and CAR/CDR Recursion
Template:

(defun func (x)
   (cond (end-test-1 end-value-1) 
         (end-test-2 end-value-2) 
         . . .
         (t (combiner (func (car x))
                      (func (cdr x))))))


Example:

func:            find-number 
end-test-1:      (numberp x)
end-value-1:     x
end-test-2       (atom x)
end-value-2:     nil
combiner:        or


(defun find-number (x) 
  (cond ((numberp x) x) ((atom x) nil)
   (t (or (find-number (car x))
          (find-number (cdr x))))))

Using Helping Functions

> (count-up 5) 
(1 2 3 4 5)

> (count-up O) 
nil

(defun count-up (n)
  (count-up-recursively 1 n))

(defun count-up-recursively (cnt n) 
   (cond ((> cnt n) nil)
         (t (cons cnt
            (count-up-recursively (+ cnt 1) n)))))



PROG1, PROG2, and PROGN

> (prog1 (setf x 'foo) (setf x 'bar) (setf x 'bat)) 
foo

> (prog2 (setf x 'foo) (setf x 'bar) (setf x 'bat)) 
bar

> (progn (setf x 'foo) (setf x 'bar) (setf x 'bat)) 
bat


Optional Arguments

> (defun foo (x &optional y) (list x y))

> (foe 4)

(4 nil)

> (foe 3 5)

(3 5)

> (defun divide-check (dividend
                   &optional (divisor 2)) 
  (if (zerop (rem dividend divisor)) 
        (list dividend 'does 'divide 'evenly 'by divisor) 
        (list dividend 'does 'not 'divide 'evenly 'by divisor)))

> (divide-check 27 3) 
(27 does divide evenly by 3)

> (divide-check 27) 
(27 does not divide evenly by 2)




Rest Arguments

> (defun average (&rest args) 
    (/ (reduce #'+ args) (length args) 1.0)) 
average

> (average 1 2 3 4 5) 
3.0

(defun faulty-square-all (&rest args) 
  (if (null args) nil 
      (cons (* (car args) (car args)) 
            (faulty-square-all (cdr args)))))

(defun square-all (&rest args) 
  (if (null args) nil (cons (* (car args) (car args))
      (apply #'square-all (cdr args)))))

Keyword Arguments

(defun make-sundae (name
          &key (size 'regular)
               (ice-cream 'vanilla) 
               (syrup 'hot-fudge) 
               nuts 
               cherries 
               whipped-cream)

(list 'sundae
      (list 'for name) 
      (list ice-cream 'with syrup 'syrup) 
      (list 'toppings '= 
         (remove nil  
          (list (and nuts 'nuts) 
                (and cherries 'cherries) 
                (and whipped-cream 'whipped-cream))))))


Keyword Arguments

> (make-sundae 'john) 
(sundae (for john)
   (vanilla with hot-fudge syrup) 
   (toppings = nil))

> (make-sundae 'cindy
           :syrup 'strawberry 
           :nuts t
           :cherries t)

(sundae (for cindy)
    (vanilla with strawberry syrup) 
    (toppings = (nuts cherries)))
 



Macros

> (defmacro simple-incf (var) 
    (list 'setf var (list '+ var 1))) 
simple-incf

> (setf a 4) 
4

> (simple-incf a) 
5

> (defmacro simple-incf (var
        &optional (amount 1))
   (list 'setf var (list '+ var amount)))
simple-incf

> (setf b 2) 
2

> (simple-incf b (* 3 a)) 
17



Macros

> (defun faulty-incf (var) (setf var (+ var 1)))
faulty-incf

> (setf a 4) 
4

> (faulty-incf a) 
5

> (faulty-incf a) 
5

> a 
4

Macros as Syntactic Extensions

Differences between functions and macros:

The arguments to functions are always evaluated; the arguments to macros are not evaluated.

The result of a function can be anything at all; the result returned by a macro must be a valid Lisp expression.

After a macro function returns an expression, that expression is immediately evaluated. The results returned by functions do not get evaluated.



The Backquote Character

> (setf name 'fred) 
fred

> `(this is ,name from pittsburgh) 
(this is fred from pittsburgh)

> (defmacro simple-incf (var
            &optional (amount 1))
     '(setq ,var (+ ,var ,amount)))
simple-incf

> (defmacro two-from-one (func object) 
    `(,func ',object ',object)) 
two-from-one

> (two-from-one cons aardvark) 
(aardvark . aardvark)


Splicing with Backquote

> (setf name 'fred) 
fred

> (setf address '(16 maple drive)) 
(16 maple drive)

> `(,name lives at ,address now) 
(fred lives at (16 maple drive) now)

> '(,name lives at ,@address now) 
(fred lives at 16 maple drive now)




Splicing with Backquote

> (set-zero a b c) 
(zeroed a b c)

(progn
  (setf a O) (setf b O) (setf c O) '(zeroed a b c))

(defmacro set-zero (&rest variables) 
  `(progn ,@(mapcar #'(lambda (var)
                (list 'setf var 0))
          variables) 
      `(zeroed ,@variables)))


Output

(defun test (x) (format t
      "~&With escape characters: ~S" x)
   (format t
      "~&Without escape characters: ~A" x))

> (test "Hi, buddy!") 
With escape characters: "Hi, buddy!" 
Without escape characters: Hi, buddy! 
nil


Input

(defun my-square ()
   (format t "~&Please type in a number: ") 
   (let ((X (read))) 
     (format t
       "~&The number ~S squared is ~S.~%" 
         x (* x X))))

> (my-square) 
Please type in a number: 7 
The number 7 squared is 49. 
nil

> (my-square) 
Please type in a number: -4 
The number -4 squared is 16. 
nil

Output
> (format t "Hi, buddy!") 
Hi, buddy! 
nil

> (format t "Time flies~%like an arrow.") 
Time flies 
like an arrow. 
nil

> (format t "Time flies~&~&like an arrow.") 
Time flies 
like an arrow. 
nil       ~& only prints new line if not already at new line.

> (format t "~&Hi, buddy!") 
Hi, buddy! 
nil



> (format t "~&From ~S to ~S in ~S minutes!"
          'Boston '(New York) 55) 
From Boston to (New York) in 55 minutes!
nil

(defun square-talk (n)
    (format t "~&~S squared is ~S" n (* n n)))

> (square-talk 10) 
10 squared is 100 
nil

> (mapcar #'square-talk '(1 2 3)) 
1 squared is 1
2 squared is 4 
3 squared is 9 
(nil nil nil)


TYPEP and TYPE-OF

>(typep 3 'number)
t

>(typep 'foo 'symbol)
t


>(type-of 3.5)
short-float

>(type-of '(bat breath))
cons

>(type-of "Phooey")
(simple-string 6)


Defining Structures

>(defstruct starship
  (name nil)
  (speed 0)
  (condition 'green)
  (shields 'down))

>(setf s1 (make-starship))
#S(STARSHIP NAME NIL 
            SPEED 0
            CONDITION GREEN
            SHIELDS DOWN)

>(type-of s1)
STARSHIP

>(starship-p s1)
t

>(startship-shields s1)
down

>(setf (starship-name s1) "Enterprise")
Enterprise

>(incf (starship-speed s1))
1

>s1
#S(STARSHIP NAME "Enterprise"
            SPEED 1
            CONDITION GREEN
            SHIELDS DOWN)

>(setf s2 (make-starship :name "Reliant"
                         :shields 'damaged))
#S(STARSHIP NAME "Reliant"
            SPEED 0
            CONDITION GREEN
            SHIELDS DAMAGED)

use "equalp(x,y)" to compare 2 structures.



>(describe 'cons)
CONS is an external SYMBOL in package LISP.
   It can be called with these arguments: (x y)
   Function documentation:
     Returns a list with x as the CAR and y as the CDR.


Inheritance:

>(defstruct ship
    (name nil)
    (captain nil)
    (crew-size nil))

>(defstruct (starship (:include ship))
    (weapons nil)
    (shields nil))

>(setf z1 (make-starship :captain "James T. Kirk"))
#S(STARSHIP NAME NIL
            CAPTAIN "James T. Kirk"
            CREW-SIZE NIL
            WEAPONS NIL
            SHIELDS NIL)


Vectors and Hash Tables

>(setf my-vec '#(tuning violin 440 a))

>my-vec
#(TUNING VIOLIN 440 A)

>(car my-vec)
Error: #(TUNING VIOLIN 440 A) is not a list.

>(aref my-vec 1)
VIOLIN

>(setf (aref my-vec 2) 430)
430

>my-vec
#(TUNING VIOLIN 430 A)


>(make-array 5 :initial-element 1)
#(1 1 1 1 1)

>(make-array 5 :initial-contents '(a e i o u))
#(A E I O U)

>(length "Cockatoo")
8

>(reverse "Cockatoo")
"ootakcoC"

>(aref "Cockatoo" 3)
#\k

>(setf pet "Cockatoo")
"Cockatoo"

> (setf (aref pet 5) :\p)
#\p

> pet
"Cockapoo"

> (setf (aref pet 6) 'cute)
Error: CUTE is not of type CHARACTER


Hash Tables

> (setf h (make-hash-table))
#<EQL Hsah table 5173242>

>(type-of h)
HASH-TABLE

> (setf (gethash 'john h) '(attorney (16 maple drive)))
(ATTORNEY (16 MAPLE DRIVE))

> (gethash 'john h)
(ATTORNEY (16 MAPLE DRIVE))
T



Property Lists

(ind-1 val-1  ind-2 val-2  ind-3 val-3 ...)

>(setf (get 'fred 'sex) 'male)

>(setf (get 'fred 'age) 23)

>(setf (get 'fred 'siblings) '(george wanda))

>(describe 'fred)
FRED is a SYMBOL.
Its SIBLINGS property is (GEORGE WANDA).
Its AGE property is 23.
Its SEX property is male.

The actual property list looks like:
(siblings (george wanda) age 23 sex male)



LISP WRITTEN IN LISP


(defun myeval (e a)
   (cond ((symbolp e) (cdr (myassoc e a)))
         ((atom e) e)
         ((atom (car e))
                (cond ((eq (car e) (quote quote))
                      (cadr e))
                ((eq (car e) (quote cond))
                      (evcon (cdr e) a))
                (t (myapply (car e) (evlis
                      (cdr e) a) a))))
          (t (myapply (car e) (evlis (cdr e) a) a))))))))


(defun myapply (fn x a)
  (cond ((atom fn)
    (cond ((null fn) nil)
          ((eq fn (quote car))
                  (caar x))
          ((eq fn (quote cdr))
                  (cdar x))
          ((eq fn (quote cons))
                  (cons (car x) (cadr x)))
          ((eq fn (quote atom))
                  (atom (car x)))
          ((eq fn (quote eq))
                  (eq (car x) (cadr x)))
          ((eq fn (quote quote))
                  x)
          ((eq (car (myeval fn a)) 'lambda) (myapply (myeval fn a) x a))
          ((eq (car (myeval fn a)) 'label) (myapply (myeval fn a) x a))
          (t nil)))
     ((eq (car fn) (quote lambda))
          (myeval (caddr fn) (mypairlis (cadr fn) x a)))
     ((eq (car fn) (quote label))
          (myapply (caddr fn) x (cons (cons (cadr fn) (caddr fn)) a))))))))      

(defun evcon (c a)
  (cond ((myeval (caar c) a) (myeval (cadar c) a))
        (t (evcon (cdr c) a)))))))) 

(defun evlis (m a)
  (cond ((null m) nil)
	(t (cons (myeval (car m) a)
	   (evlis (cdr m) a))))))))))

(defun mypairlis (parms vals assc)
	(cond ((null parms) assc)
              ((null vals) assc)
              (t (mypairlis (cdr parms) (cdr vals) (cons (cons 
                  (car parms) (car vals)) assc))))))))

(defun myassoc (x alist)
	(cond ((null alist) nil)
              ((eq x (caar alist)) (car alist))
              (t (myassoc x (cdr alist)))))))