;;;; Pairs
;;; Primitives:
;;; cons: (cons 1 2) ==> (1 . 2)
;;; car: (car '(1 . 2)) ==> 1
;;; cdr: (cdr '(1 . 2)) ==> 2
;;; pair?: (pair? '(1 . 2)) ==> #!true
;;; (pair? 1) ==> #!false
;;; set-car!: (define a '(1 . 2)) ==> ??
;;; (set-car! a 0) ==> ??
;;; a ==> (0 . 2)
;;; used to be known as rplaca
;;; set-cdr!: (define a '(1 . 2)) ==> ??
;;; (set-cdr! a 0) ==> ??
;;; a ==> (1 . 0)
;;; used to be known as rplacd
;;;; Lists
;;; Primitives:
;;; Empty list:
;;; (): '() ==> ()
;;; (pair? '()) ==> #!false !!! nil is not a pair !!!
;;; used to be known as nil
;;; (1 . (2 . (3 . ()))) ==> (1 2 3)
;;; null?: (null? '()) ==> #!false
;;; used to be known as null
;;; Unlike in LISP (car '()) ==> error
;;; (cdr '()) ==> error
;;; TI SCHEME does not signal that error, but no code should depend on
;;; (cdr '()) returning '()
;;; Proper list is a pair cdr of which is either a proper list
;;; or an empty list
;;; Problem:
;;; define a predicate PROPER-LIST?
(define (proper-list? l)
(if (pair? l)
(proper-list? (cdr l))
(null? l)))
;;; An improper (dotted) list is a chain of pairs not ending in the empty
;;; list
;;; Problem:
;;; define a predicate IMPROPER-LIST?
(define (last-cdr l)
(if (pair? l)
(last-cdr (cdr l))
l))
(define (improper-list? l)
(and (pair? l) (not (null? (last-cdr l)))))
;;; More about lambda
;;; there are three ways to specify formal arguments of a function:
;;; 1 - (lambda variable
) ==> the procedure takes any number of
;;; arguments; they are put in a list and the list is bound to a
;;; variable
;;; 2 - (lambda proper-list-of-distinct-variables )
;;; the procedure takes a fixed number of arguments equal the length
;;; of the proper-list-of-distinct-variables; it is an error to give it
;;; more or less
;;; 3 - (lambda improper-list-of-distinct-variables )
;;; the extra arguments are bound to the last variable
;;; Non-primitive (but standard) functions on lists
;;; (define (caar x) (car (car x)))
;;; (define (cadr x) (car (cdr x)))
;;; (define (cdar x) (cdr (car x)))
;;; (define (cddr x) (cdr (cdr x)))
;;; ... and up to four letters
(define list (lambda x x))
;;; Explain!
;;; Problem:
;;; define a function LENGTH that returns length of a list
(define (my-length l)
(define (length-loop number list)
(if (pair? list)
(length-loop (+ number 1) (cdr list))
number))
(length-loop 0 l))
;;; Problem:
;;; define a function REVERSE that returns a newly allocated list consisting
;;; of the elements of list in reverse order
(define (reverse-append x y)
(if (pair? x)
(reverse-append (cdr x) (cons (car x) y))
y))
(define (my-reverse x)
(reverse-append x '()))
;;; Equivalence predicates
;;;
;;; Destructive functions
;;; reverse returns a new list (a new chain of pairs)
;;; but we may want to reverse the original list
;;; a function F is called applicative iff
;;; (lambda (x) ((lambda (y) (f x) (equal? x y)) (copy x)))
;;; always returns #!true
;;; for an applicative function F a function F! is its destructive
;;; equivalent iff
;;; 1. (f x) == (f! (copy x))
;;; 2. (not (equal? x (f x)))
;;; implies
;;; ((lambda (y) (f x) (not (equal? x y))) (copy x))
;;; from this two axioms we can derive:
;;; Bang rule 1:
;;; (w x) = (f (g x)) => (w! x) = (f! (g! x))
;;; Bang rule 2:
;;; (w! x) = (f! (g! x)) => (w x) = (f! (g x))
;;; Problem:
;;; implement REVERSE!
(define (reverse-append! x y)
(define (loop a b c)
(set-cdr! a c)
(if (pair? b)
(loop b (cdr b) a)
a))
(if (pair? x)
(loop x (cdr x) y)
y))
(define (my-reverse! x) (reverse-append! x '()))
;;; it is a little more difficult to right an iterative
;;; procedure COPY-LIST
;;; we can always do
(define (stupid-copy-list l)
(if (pair? l)
(cons (car l) (stupid-copy-list (cdr l)))
l))
;;; as a matter of fact, it is better to define it as:
(define (not-so-stupid-copy-list l)
(reverse! (reverse l)))
;;; there is a very good way to do it:
(define (rcons x y)
(set-cdr! x (cons y '()))
(cdr x))
(define (copy-list x)
(define (loop x y)
(if (pair? y)
(loop (rcons x (car y)) (cdr y))
(set-cdr! x y)))
(if (pair? x)
((lambda (header) (loop header (cdr x)) header)
(list (car x)))
x))
;;; COPY-LIST is still much slower than NOT-SO-STUPID-COPY-LIST
;;; redefine RCONS as:
(define-integrable
rcons
(lambda (x y)
(set-cdr! x (cons y '()))
(cdr x)))
;;; and recompile COPY-LIST
;;; Problem:
;;; implement APPEND as a function of an arbitrary number of lists
;;; which returns a list containing the elements of the first list
;;; followed by the elements of the other lists
;;; the resulting list is always newly allocated, exept that it shares
;;; structure with the last list argument. The last argument may actually
;;; be any object; an improper list results if it is not a proper list
;;; (see R3R page 16)
(define my-append
((lambda (header)
(lambda lists
(define (main-loop lists first next last)
(set-cdr! last first)
(if next
(main-loop next
(car next)
(cdr next)
(inner-loop first last))
(cdr header)))
(define (inner-loop list last)
(if (pair? list)
(inner-loop (cdr list) (rcons last (car list)))
last))
(if lists
(main-loop lists (car lists) (cdr lists) header)
'())))
(list '())))
;;; Problem:
;;; implement APPEND!
(define my-append!
((lambda (header)
(lambda lists
(define (main-loop lists first next last)
(set-cdr! last first)
(if next
(main-loop next
(car next)
(cdr next)
(inner-loop first last))
(cdr header)))
(define (inner-loop list last)
(if (pair? list)
(last-pair list)
last))
(if lists
(main-loop lists (car lists) (cdr lists) header)
'())))
(list '())))