The Little Schemer: applicative-order Y from Chapter 9 "... and Again, and Again, and Again, ..."

little-schemer-y.ss

#! /usr/local/bin/scheme --libdirs --script

;; chmod +x ./y.ss
;; echo "" | ./y.ss

;; The Little Schemer,  Friedman & Felleisen, 4th Edition
;;
;; Chapter 9 "... and Again, and Again, and Again, ..."
;;
;; Skipping partial vs. total functions with examples Ackerman, termination.
;; Mainly pages 160-173 following derivation of applicative-order Y.
;; For "applicative-order imperative Y (Y!), see The Seasoned Schemer,
;; chapter 16.
;;

;; page 151

;; example of bottom in scheme, "the most partial function"
;;
;; > (eternity 'foo)
;;   ^C ^C
;; break> quit
(define eternity
  (lambda (f)
    (eternity f)))

;; page 160

;; utility routine used in text
;; > (add1 2)
;; 3
(define add1
  (lambda (n)
    (+ 1 n)))

(display "(add1 2)")
(newline)
(display (add1 2))
(newline)

;; recursive point-of-reference

;; > (length '(1 2 3))
;; 3
(define length (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l)))))))

(display "(length '(1 2 3))")
(newline)
(display (length '(1 2 3)))
(newline)

;; now move to nameless, have to type these into repl, display statements show application to lists

;; base case: length function for lists of only length zero only
;;
;; > ((lambda (l) (cond ((null? l) 0) (else (add1 (eternity (cdr l)))))) '())
;; 0

(display "((lambda (l) (cond ((null? l) 0) (else (add1 (eternity (cdr l)))))) '()))")
(newline)
(display ((lambda (l) (cond ((null? l) 0) (else (add1 (eternity (cdr l)))))) '()))
(newline)

;; page 161

;; mechanical extension: in-line embedding in "(else (add1 .." of same function, works for lists of length zero and length one only,
;; same structure, if list isn't empty, add1 to application of repeat of same function to cdr of list, text shows extension to lists
;; of length 0, 1, or 2 by second in-line embedding around second "(else (add1 ..."
;;
;; > ((lambda (l) (cond ((null? l) 0) (else (add1 ((lambda (l) (cond ((null? l) 0) (else (add1 (eternity (cdr l)))))) (cdr l)))))) '(0))
;; 1
;; > ((lambda (l) (cond ((null? l) 0) (else (add1 ((lambda (l) (cond ((null? l) 0) (else (add1 (eternity (cdr l)))))) (cdr l)))))) '())
;; 0

(display "((lambda (l) (cond ((null? l) 0) (else (add1 ((lambda (l) (cond ((null? l) 0) (else (add1 (eternity (cdr l)))))) (cdr l)))))) '(0))")
(newline)
(display ((lambda (l) (cond ((null? l) 0) (else (add1 ((lambda (l) (cond ((null? l) 0) (else (add1 (eternity (cdr l)))))) (cdr l)))))) '(0)))
(newline)

(display "((lambda (l) (cond ((null? l) 0) (else (add1 ((lambda (l) (cond ((null? l) 0) (else (add1 (eternity (cdr l)))))) (cdr l)))))) '()))")
(newline)
(display ((lambda (l) (cond ((null? l) 0) (else (add1 ((lambda (l) (cond ((null? l) 0) (else (add1 (eternity (cdr l)))))) (cdr l)))))) '()))
(newline)

;; page 162

;; first-level abstraction: bind terminal function "eternity" with outer lambda, refer to binding "length" in terminal position, revert to length 
;; zero list two levels of binding, first of "eternity" to "length", leaves you with lambda looking for a list, then next of list "'()" to "l" in 
;; inner lambda
;;
;; > (((lambda (length) (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l))))))) eternity) '())
;; 0

(display "(((lambda (length) (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l))))))) eternity) '())")
(newline)
(display (((lambda (length) (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l))))))) eternity) '()))
(newline)

;; page 163

;; mechanical extension: where "eternity" was bound to "length" before, bind it first to "g", then bind enclosed lambda to "f", leaving outermost
;; lambda taking list, testing it for null else does add1 with "f" resolved to lamdba that tests for null else add1 with "g" resolved to eternity,
;; works for lists of lenth zero or one only
;;
;; > (((lambda (f) (lambda (l) (cond ((null? l) 0) (else (add1 (f (cdr l))))))) ((lambda (g) (lambda (l) (cond ((null? l) 0) (else (add1 (g (cdr l))))))) eternity)) '(0))
;; 1
;; > (((lambda (f) (lambda (l) (cond ((null? l) 0) (else (add1 (f (cdr l))))))) ((lambda (g) (lambda (l) (cond ((null? l) 0) (else (add1 (g (cdr l))))))) eternity)) '())
;; 0

(display "(((lambda (f) (lambda (l) (cond ((null? l) 0) (else (add1 (f (cdr l))))))) ((lambda (g) (lambda (l) (cond ((null? l) 0) (else (add1 (g (cdr l))))))) eternity)) '(0))")
(newline)
(display (((lambda (f) (lambda (l) (cond ((null? l) 0) (else (add1 (f (cdr l))))))) ((lambda (g) (lambda (l) (cond ((null? l) 0) (else (add1 (g (cdr l))))))) eternity)) '(0)))
(newline)

(display "(((lambda (f) (lambda (l) (cond ((null? l) 0) (else (add1 (f (cdr l))))))) ((lambda (g) (lambda (l) (cond ((null? l) 0) (else (add1 (g (cdr l))))))) eternity)) '())")
(newline)
(display (((lambda (f) (lambda (l) (cond ((null? l) 0) (else (add1 (f (cdr l))))))) ((lambda (g) (lambda (l) (cond ((null? l) 0) (else (add1 (g (cdr l))))))) eternity)) '()))
(newline)

;; page 164

;; second-level abstraction: bind application of function in outermost lambda to its own function "mk-length", applied once to yield
;; lambda that takes a list of length zero and answers length 0
;;
;; > (((lambda (mk-length) (mk-length eternity)) (lambda (length) (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l)))))))) '())
;; 0

(display "(((lambda (mk-length) (mk-length eternity)) (lambda (length) (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l)))))))) '())")
(newline)
(display (((lambda (mk-length) (mk-length eternity)) (lambda (length) (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l)))))))) '()))
(newline)

;; mechanical extension:  now nested application is up-front and more easily self-contained making it possible to type in a length function that works
;; for lists of lengths zero, one, or two -- now the tail stays the same and each extension is added to the first lambda only -- to me, this abstraction
;; and the consequent extension are giant steps toward the eventual syntax of Y, lets you see where application to a function to itself originates
;;
;; > (((lambda (mk-length) (mk-length (mk-length eternity))) (lambda (length) (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l)))))))) '(1))
;; 1

(display "(((lambda (mk-length) (mk-length (mk-length eternity))) (lambda (length) (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l)))))))) '(1))")
(newline)
(display (((lambda (mk-length) (mk-length (mk-length eternity))) (lambda (length) (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l)))))))) '(1)))
(newline)

;; > (((lambda (mk-length) (mk-length (mk-length (mk-length eternity)))) (lambda (length) (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l)))))))) '(0 1))
;; 2

(display "(((lambda (mk-length) (mk-length (mk-length (mk-length eternity)))) (lambda (length) (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l)))))))) '(0 1))")
(newline)
(display (((lambda (mk-length) (mk-length (mk-length (mk-length eternity)))) (lambda (length) (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l)))))))) '(0 1)))
(newline)

;; page 165

;; re-naming to reveal the name of the function that gets applied to itself doesn't matter, which lets us do away with "eternity",
;;
;; > (((lambda (mk-length) (mk-length mk-length)) (lambda (mk-length) (lambda (l) (cond ((null? l) 0) (else (add1 (mk-length (cdr l)))))))) '())
;; 0

;; apply it one too many times and instead of an endless loop you land with a lambda that gets passed to add1 instead of a number, whops
;;
;; > (((lambda (mk-length) (mk-length mk-length)) (lambda (mk-length) (lambda (l) (cond ((null? l) 0) (else (add1 (mk-length (cdr l)))))))) '(0))
;; Exception in +: #<procedure> is not a number
;; Type (debug) to enter the debugger.

(display "(((lambda (mk-length) (mk-length mk-length)) (lambda (mk-length) (lambda (l) (cond ((null? l) 0) (else (add1 (mk-length (cdr l)))))))) '())")
(newline)
(display (((lambda (mk-length) (mk-length mk-length)) (lambda (mk-length) (lambda (l) (cond ((null? l) 0) (else (add1 (mk-length (cdr l)))))))) '()))
(newline)

;; page 166

;; mechanical extension:  except it's not really that simple, because now to extend, we nest in the tail, first with a return to "eternity" ...
;; 
(display "(((lambda (mk-length) (mk-length mk-length)) (lambda (mk-length) (lambda (l) (cond ((null? l) 0) (else (add1 ((mk-length eternity) (cdr l)))))))) '(apples)))")
(newline)
(display (((lambda (mk-length) (mk-length mk-length)) (lambda (mk-length) (lambda (l) (cond ((null? l) 0) (else (add1 ((mk-length eternity) (cdr l)))))))) '(apples)))
(newline)

;; page 167

;; ... next with the big step:  replace "eternity" with self-application and repeat until the list is empty ... sparkling, aweseome, astounding magic!
;; this takes lots and lots of concentration to unwind (https://www.youtube.com/watch?v=lIpev8JXJHQ)
;;
(display "(((lambda (mk-length) (mk-length mk-length)) (lambda (mk-length) (lambda (l) (cond ((null? l) 0) (else (add1 ((mk-length mk-length) (cdr l)))))))) '(apples oranges)))")
(newline)
(display (((lambda (mk-length) (mk-length mk-length)) (lambda (mk-length) (lambda (l) (cond ((null? l) 0) (else (add1 ((mk-length mk-length) (cdr l)))))))) '(apples oranges)))
(newline)

(display "(((lambda (mk-length) (mk-length mk-length)) (lambda (mk-length) (lambda (l) (cond ((null? l) 0) (else (add1 ((mk-length mk-length) (cdr l)))))))) '(apples oranges grapes)))")
(newline)
(display (((lambda (mk-length) (mk-length mk-length)) (lambda (mk-length) (lambda (l) (cond ((null? l) 0) (else (add1 ((mk-length mk-length) (cdr l)))))))) '(apples oranges grapes)))
(newline)

(display "(((lambda (mk-length) (mk-length mk-length)) (lambda (mk-length) (lambda (l) (cond ((null? l) 0) (else (add1 ((mk-length mk-length) (cdr l)))))))) (iota 100)))")
(newline)
(display (((lambda (mk-length) (mk-length mk-length)) (lambda (mk-length) (lambda (l) (cond ((null? l) 0) (else (add1 ((mk-length mk-length) (cdr l)))))))) (iota 100)))
(newline)

;; but we're not close enough to Y quite yet

;; page 171

;; abstraction combined with another layer of application -- there are several steps to get to this point in the text
;; separating mechanism of Y from function it drives, in text "(lambda (length) (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l)))))))"
;; *is* length, so now we've isolated the Y bits in the applications of mk-length to mk-length at the start and the end
;; 
;; > (((lambda (mk-length) (mk-length mk-length)) (lambda (mk-length) ((lambda (length) (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l))))))) (lambda (x) ((mk-length mk-length) x))))) (iota 100))
;; 100
(display "(((lambda (mk-length) (mk-length mk-length)) (lambda (mk-length) ((lambda (length) (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l))))))) (lambda (x) ((mk-length mk-length) x))))) (iota 100)))")
(newline)
(display (((lambda (mk-length) (mk-length mk-length)) (lambda (mk-length) ((lambda (length) (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l))))))) (lambda (x) ((mk-length mk-length) x))))) (iota 100)))
(newline)

;; page 172

;; in-line Y
;;
;; > (((lambda (le) ((lambda (mk-length) (mk-length mk-length)) (lambda (mk-length) (le (lambda (x) ((mk-length mk-length) x)))))) (lambda (length) (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l)))))))) (iota 100))
;; 100
(display "(((lambda (le) ((lambda (mk-length) (mk-length mk-length)) (lambda (mk-length) (le (lambda (x) ((mk-length mk-length) x)))))) (lambda (length) (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l)))))))) (iota 100)))")
(newline)
(display (((lambda (le) ((lambda (mk-length) (mk-length mk-length)) (lambda (mk-length) (le (lambda (x) ((mk-length mk-length) x)))))) (lambda (length) (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l)))))))) (iota 100)))
(newline)

;; and finally back to naming
;;
(define Y
  (lambda (le)
    ((lambda (f) (f f))
     (lambda (f)
       (le (lambda (x) ((f f) x)))))))

;; like fix, Y takes a lambda that takes a single argument that is the name of the function for the recursive call from within
;; > ((Y (lambda (length) (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l)))))))) '(1 2 3))
;; 3
(display "(define Y (lambda (le) ((lambda (f) (f f)) (lambda (f) (le (lambda (x) ((f f) x)))))))")
(newline)
(display "((Y (lambda (length) (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l)))))))) '(1 2 3)))")
(newline)
(display ((Y (lambda (length) (lambda (l) (cond ((null? l) 0) (else (add1 (length (cdr l)))))))) '(1 2 3)))
(newline)