The little scheme 书上的部分scheme代码（Guile 实现）- 1

scheme 和Guile其实都是Lisp的dialect. 因此看起来还是很像的，　拿出来little scheme 看了些实现，确实不错。
讲了很多+ * 的实现，当然书中的实现还仅限于两个argument，
而guile现在的+ / * 都支持多个argument.

#! /usr/bin/guile -s
!#

(define atom?
    (lambda (x)
        (and (not (pair? x)) (not (null? x)))))


;; a list of atom
(define lat?
    (lambda (l)
        (cond
            ((null? l) #t)
            ((atom? (car l)) (lat? (cdr l)))
            (else #f))))

;; check an atom whether a member of a list
(define member?
    (lambda (a lat)
        (cond
            ((null? lat) #f)
            (else (or (eq? (car lat) a)
                    (member? a (cdr lat)))))))

;; remove an atom of 1st occurrence from the list
(define rember
    (lambda (a lat)
        (cond
            ((null? lat) '())
            ((eq? (car lat) a) (cdr lat))
            (else (cons (car lat) (rember a (cdr lat)))))))

;; get all the car of the list
(define firsts
    (lambda (lat)
        (cond
            ((null? lat) '())
            (else (cons (car (car lat)) (firsts(cdr lat)))))))


;; add new to the right of old
(define insertR
    (lambda (old new lat)
        (cond
            ((null? lat) '())
            ((eq? (car lat) old) (cons old (cons new (cdr lat))))
            (else (cons (car lat) (insertR new old (cdr lat)))))))

;; add new to the left of old
(define insertL
    (lambda (old new lat)
        (cond
            ((null? lat) '())
            ((eq? (car lat) old) (cons new lat))
            (else (cons (car lat) (insertL new old (cdr lat)))))))


;; substitue old with new
(define subst
    (lambda (old new lat)
        (cond
            ((null? lat) '())
            ((eq? (car lat) old) (cons new (cdr lat)))
            (else (cons (car lat) (subst new old (cdr lat)))))))


;; subsitute o1 o2 with new
(define subst2
    (lambda (new o1 o2 lat)
        (cond
            ((null? lat) '())
            ( (or (eq? (car lat) o1) (eq? (car lat) o2))
                (cons new (cdr lat)))
            (else (cons (car lat) (subst2 new o1 o2 (cdr lat)))))))

;; multiple remove a atom from a list
(define multirember
    (lambda (a lat)
        (cond
            ((null? lat) '())
            ( (eq? (car lat) a)
                (multirember a (cdr lat)))
            (else (cons (car lat) (multirember a (cdr lat)))))))

;; multiple insert new to the right of old in a list
(define multiinsertR
    (lambda (new old lat)
        (cond
            ((null? lat) '())
            (else
                (cond
                    ((eq? (car lat) old)
                        (cons old(cons new (multiinsertR new old (cdr lat)))))
                    (else (cons (car lat) (multiinsertR new old (cdr lat)))))))))

;compute n+1
(define add1
    (lambda (n)
        (+ n 1)))

;compute n-1
(define sub1
    (lambda (n)
        (- n 1)))

; define +
(define my+
    (lambda (n m)
        (cond
            ((zero? m) n)
            (else (add1 (my+ n (sub1 m)))))))

; define -
(define my-
    (lambda (n m)
        (cond
            ((zero? m) n)
            (else (sub1 (my- n (sub1 m)))))))

; build a number by total all the numbers in a tuple
(define addtup
    (lambda (lat)
        (cond
            ((null? lat) 0)
            (else (my+ (car lat) (addtup (cdr lat)))))))

; add n for m times, n*m
(define my_x
    (lambda (n m)
        (cond
            ((zero? m) 0)
            (else (my+ n (my_x n (sub1 m)))))))



; add two tuple
(define tup+
    (lambda (tup1 tup2)
        (cond
            ((and (null? tup1) (null? tup2)) '())
            (else (cons (my+ (car tup1 ) (car tup2))
                (tup+ (cdr tup1) (cdr tup2)))))))


;; define "my>"
(define my>
    (lambda (n m)
        (cond
            ((zero? n) #f)
            ((zero? m) #t)
            (else (my> (sub1 n) (sub1 m))))))

;; define "my<"
(define my<
    (lambda (n m)
        (cond
            ((zero? m) #f)
            ((zero? n) #t)
            (else (my< (sub1 n) (sub1 m))))))


; define "="
(define my=
    (lambda (n m)
        (cond
            ((zero? n) (zero? m))
            ((zero? n) #f)
            (else (my= (sub1 n) (sub1 m))))))



;; define "my2=", 2nd way with "my>" and "my<"
(define my2=
    (lambda (n m)
        (cond
            ((my< n m) #f)
            ((my> n m) #f)
            (else #t))))

;; define my_expt
(define my_expt
    (lambda (n m)
        (cond
            ((zero? m) 1)
            (else (my_x n (my_expt n (sub1 m)))))))

;; define my_division "/"
(define my_division
    (lambda (n m)
        (cond
            ((my< n m) 0)
            (else ( add1 (my_division (my- n m) m))))))

;; define lat_length; length
(define lat_length
    (lambda (lat)
        (cond
            ((null? lat) 0)
            (else (add1 (lat_length (cdr lat)))))))

;; define function pick, pick the nst atom in the list
(define pick
    (lambda (n lat)
        (cond
            ((or (zero? n) (null? lat)) '())
            ((zero? (sub1 n)) (car lat))
            (else (pick (sub1 n) (cdr lat))))))


;; define function rempick
(define rempick
    (lambda (n lat)
        (cond
            ((null? lat) '())
            ((zero? (sub1 n)) (cdr lat))
            (else (cons (car lat) (rempick (sub1 n) (cdr lat)))))))


;;remove all the numbers from a lat
(define no-nums
    (lambda (lat)
        (cond
            ((null? lat) '())
            (else
                (cond
                    ((number? (car lat)) (no-nums (cdr lat)))
                    (else (cons (car lat) (no-nums (cdr lat)))))))))


;; only keep numbers
(define all-nums
    (lambda (lat)
        (cond
            ((null? lat) '())
            ((number? (car lat)) (cons (car lat) (all-nums (cdr lat))))
            (else (all-nums (cdr lat))))))

;; eqan? compare two object
(define eqans?
    (lambda (o1 o2)
        (cond
            ((and (number? o1) (number? o2)) (my= o1 o2))
            ((or (number? o1) (number? o2)) #f)
            (else (eq? o1 o2)))))

;; count an atom appeared n times in a list
(define occur
    (lambda (a lat)
        (cond
            ((null? lat) 0)
            ((eq? (car lat) a) (add1 (occur a (cdr lat))))
            (else (occur a (cdr lat))))))


;; one? (one? n) is #t if n==1 and #f for other number
(define one?
    (lambda (n)
        (cond
            ((zero? n) #f)
            (else (zero? (sub1 n))))))


(define one2?
    (lambda (n)
        (my= n 1)))


;; rewirte rempick remove the nth atom from a lat
(define rempick2
    (lambda (n lat)
        (cond
            ((one? n) (cdr lat))
            (else (cons (car lat) (rempick2 (sub1 n) (cdr lat)))))))

但是其实看看现在的guile.

scheme@(guile-user) [3]> (map + '(1 2 3) '(10 20 30) '(100 200 300))
$7 = (111 222 333)