preprefix.txt

;; Boolean literals 
(define true (= 1 1))
(define false (= 1 0))
(define #t true)
(define #f false)

;; Streams
;; See mitpress.mit.edu/sicp/full-text/book/book-Z-H-24.html
(define (force u) (u))
(define stream-car car)
(define (stream-cdr s) (force (cdr s)))
(define stream-null? null?)
(define the-empty-stream '())

;; List stuff
;; (list 1 2 3) => (1 2 3)
(define list
   (lambda l
      l))

;; `length' - r6rs.pdf, page 48
(define (length list)
   (define (iter acc list)
      (cond
         ((null? list) acc)
         ((pair? list)
            (iter (+ acc 1) (cdr list)))
         (else acc)))
   (iter 0 list))

;; `list-tail' - r6rs.pdf, page 48
(define (list-tail list k)
   (if (>= (length list) k)
      (begin
         (define (iter p c)
            (if (= c 0)
               p
               (iter (cdr p) (- c 1))))
         (iter list k))
      '()))

;; `append' - r6rs.pdf, page 48
;; FIXME: naive recursive implementation, not iterative, explodes in space
;; ]=> (append '(a b) 'c '(d e f) '(g h) 'i)
;; (a b c d e f g h i)
(define append
   (begin
      ;; 2-argument implementation
      (define (append2 a b)
         (cond
            ((null? a) b)
            ((pair? a)
               (cons (car a) (append2 (cdr a) b)))
            (else
               (cons a (append2 '() b)))))

      ;; do a right-fold of append2 on the args
      (lambda args
         (define (iter l)
            (if (null? l)
               '()
	        (append2 (car l) (iter (cdr l)))))
         (iter args))))

;; `list-ref' - r6rs.pdf, page 48
(define (list-ref list k)
   (if (>= (length list) (+ k 1))
      (begin
         (define (iter count list)
            (if (= count k)
               (car list)
               (iter (+ count 1) (cdr list))))
         (iter 0 list))
      '()))

;; Misc. library routines...

;; `odd?' -- see r6rs.pdf, page 42
(define (odd? n)
   (= (remainder n 2) 1))

;; `even?'
(define even?
   (lambda (u) (not (odd? u))))

;; `fold-right' -- see r6rs-lib.pdf, pages 11-12
(define (fold-right combine nil . lr)
   (begin
      ;; append the list args together
      (define biglist (apply append lr))
      ;; define a one-list foldr
      (define (foldr1 c n l)
         (if (null? l)
            n
            (c (car l) (foldr1 c n (cdr l)))))
      ;; run the one-list foldr on the combined list
      (foldr1 combine nil biglist)))

;; `filter' -- see r6rs-lib.pdf, page 11
;; hopefully more efficient than the old one !
(define (filter proc list)
   (define (iter acc l)
      (if (null? l)
         acc
         (if (proc (car l))
            (iter (cons (car l) acc) (cdr l))
            (iter acc (cdr l)))))
   (reverse (iter '() list)))

;; `map' -- see r6rs.pdf, page 49
(define (map proc . lr)
   ;; first define a one-arg map for internal use
   (define (map1 proc list)
      (define (iter acc p l)
         (if (null? l)
            acc
            (iter (cons (p (car l)) acc) p (cdr l))))
      (reverse (iter '() proc list)))

   ;; check that all list-args have same length
   (define list-lengths (map1 length lr))
   (define len1 (car list-lengths))
   (define same-length
      (= 0
         (length (filter 
            (lambda (n) (not (= n len1)))
	    list-lengths))))

   ;; if they do, carry on...
   (if same-length
      (begin
         ;; `result' holds the final result in reverse order
         (define result '())
         ;; `iter' is a loop that applies `proc' to a list containing
         ;; member `n' of each arg-list, consing the result onto `result',
         ;; for 0 <= `n' < `len1', where `len1' is the length of each
         ;; argument-list
         (define (iter n)
            (if (not (= n len1))
               (begin
                  (set! result
                     (cons
                        (apply proc
                           (map1 (lambda (u) (list-ref u n)) lr))
                        result))
                  (iter (+ n 1)))))
         ;; run the loop
         (iter 0)
         ;; reverse `result' to get the final answer...
         (reverse result))))