Little Schemer Chapter 4

LittleSchemerChp4.scm

(define add1 (let ((f +)) (lambda (x) (f x 1))))
(define sub1 (let ((f -)) (lambda (x) (f x 1))))
(define atom? (let ((f1 pair?) (f2 not)) (lambda (x) (f2 (f1 x)))))

(define sum1 ( lambda (x) (+ 1 x)))

(define sub1 ( lambda (x) (- x 1)))


(define plus ( lambda (x y)
	( cond 
		( (zero? y)  x )
		( else 	( sum1 ( plus x ( sub1 y)   ) ) )
	)
))


(define minus ( lambda (x y)
	( cond 
		( (zero? y)  x )
		( else 	( sub1 ( minus x ( sub1 y)   ) ) )
	)
))

; my attempt at a (halfway) generic recursive function over numbers 
(define recnum ( lambda (f x y)
	( cond 
		( (zero? y)  x )
		( else 	( f ( recnum f x ( sub1 y)   ) ) )
	)
))


(define equlist?
  (lambda (l1 l2)
    (cond
      ((and (null? l1)(null? l2)) #t )
      ((or (null? l1)(null? l2)) #f )
      ((and (and (atom? (car l1)) (atom? (car l2))) (equal? (car l1) (car l2)))(equlist? (cdr l1)(cdr l2)))
      ((or (atom? (car l1)) (atom? (car l2))) #f )
      (else (and (equlist? (car l1) (car l2)) (equlist? (cdr l1) (cdr l2)) ) ) )
))

(define atom? (let ((f1 pair?) (f2 not)) (lambda (x) (f2 (f1 x)))))

(define numbered?
  (lambda (aexp)
    (cond
      ((atom? aexp) (number? aexp))
      ((eq? (car (cdr aexp)) '+ ) (and (numbered? (car aexp)) (numbered? (car (cdr (cdr aexp))))))
      ((eq? (car (cdr aexp)) '- ) (and (numbered? (car aexp)) (numbered? (car (cdr (cdr aexp))))))
      ((eq? (car (cdr aexp)) 'x ) (and (numbered? (car aexp)) (numbered? (car (cdr (cdr aexp))))))
      ((eq? (car (cdr aexp)) '^ ) (and (numbered? (car aexp)) (numbered? (car (cdr (cdr aexp))))))
      (else #f )
      )))

(define value
  (lambda (aexp)
    (cond
      ((atom? aexp) aexp)
      ((eq? (car (cdr aexp)) '+ ) (+ (value (car aexp)) (value (car (cdr (cdr aexp))))))
      ((eq? (car (cdr aexp)) '- ) (- (value (car aexp)) (value (car (cdr (cdr aexp))))))
      ((eq? (car (cdr aexp)) 'x ) (* (value (car aexp)) (value (car (cdr (cdr aexp))))))
      (else (expt (value (car aexp)) (value (car (cdr (cdr aexp))))))
      )))

; prefix notation
(define value1
  (lambda (aexp)
    (cond
      ((atom? aexp) aexp)
      ((eq? (car aexp) '+ ) (+ (value1 (car (cdr aexp))) (value1 (car (cdr (cdr aexp))))))
      ((eq? (car aexp) '- ) (- (value1 (car (cdr aexp))) (value1 (car (cdr (cdr aexp))))))
      ((eq? (car aexp) 'x ) (* (value1 (car (cdr aexp))) (value1 (car (cdr (cdr aexp))))))
      (else (expt (value1 (car (cdr aexp))) (value1 (car (cdr (cdr aexp))))))
      )))

(define 1st-sub-exp
  (lambda (aexp)
    ( car (cdr aexp))))

(define 2nd-sub-exp
  (lambda (aexp)
    ( car (cdr (cdr aexp)))))

(define operator 
  (lambda (aexp)
    (car aexp)))

(define value2
  (lambda (aexp)
    (cond
      ((atom? aexp) aexp )
      ((eq? (operator aexp) '+ ) (+ (value2 (1st-sub-exp aexp)) (value2 (2nd-sub-exp aexp))))
      ((eq? (operator aexp) '- ) (- (value2 (1st-sub-exp aexp)) (value2 (2nd-sub-exp aexp))))
      ((eq? (operator aexp) 'x ) (* (value2 (1st-sub-exp aexp)) (value2 (2nd-sub-exp aexp))))
      (else (expt (value2 (1st-sub-exp aexp)) (value2 (2nd-sub-exp aexp))))
      )))


; use () instead of numbers
(define sero?
  (lambda (n)
    (null? n)))

(define edd1
  (lambda (n)
    (cons '() n)))

(define zub1
  (lambda (n)
    (cdr n)))