; Examples from Lecture 5, Wed. Sept. 17, 2008

(load "tester.scm")

; tail-recursive reverse derived Using McCarthy's Transformation
; from an imperative program:
;
; Original program
;rev(L):
;    {
;    R = ();
;    while( not (L = ()) )
;        {
;         R = cons(first(L), R);
;         L = rest(L);
;         }
;    return R;
;    }
;
; Program with function annotations
;rev(L):
;    {
;    R = ();
;                                ----- f2(R, L)
;    while( not (L = ()) )
;        {
;                                ----- f3(R, L)
;         R = cons(first(L), R);
;                                ----- f4(R, L)
;         L = rest(L);
;         }
;                                ----- f5(R, L)
;    return R;
;    }
;
; Translation to mutual recursion program

(define (rev L)
  (f2 L ()))

(define (f2 L R)
  (if (null? L)
      (f5 L R)
      (f3 L R)))

(define (f3 L R)
  (f4 L (cons (first L) R)))

(define (f4 L R)
  (f2 (rest L) R))

(define (f5 L R)
  R)

(test (rev '(1 2 3 4 5)) '(5 4 3 2 1))

; "Compacted" recursive program
; obtained by replacing f3, f4, f5 with their definitions

(define (revc L)
  (f2 L ()))

(define (f2 L R)
  (if (null? L)
      R                                    ; was (f5 L R)
      (f2 (rest L) (cons (first L) R))))   ; was (f3 L R)

; Note that R is an "accumulator"
; Hopefully you could have derived this without using
; McCarthy's Transformation, but it is illustrative.

(test (revc '(1 2 3 4 5)) '(5 4 3 2 1))


; Conversion numbers to and from binary, as list of bits, msb first

;convert n to binary as list of bits

(define (tobinary n)
  (define (tobinary-helper n)
    (if (= n 0)
        ()
        (cons (modulo n 2) (tobinary-helper (quotient n 2)))))
  
  (if (= n 0)
      (list 0)
      (reverse (tobinary-helper n)))
  )

(test (tobinary  0)           '(0))
(test (tobinary  1)           '(1))
(test (tobinary  2)         '(1 0))
(test (tobinary  3)         '(1 1))
(test (tobinary  4)       '(1 0 0))
(test (tobinary  5)       '(1 0 1))
(test (tobinary  6)       '(1 1 0))
(test (tobinary  7)       '(1 1 1))
(test (tobinary  8)     '(1 0 0 0))
(test (tobinary  9)     '(1 0 0 1))
(test (tobinary 10)     '(1 0 1 0))
(test (tobinary 42) '(1 0 1 0 1 0))


;convert list of bits, msb first, to number as binary

(define (frombinary L)
  (define (frombinaryhelper R)
    (if (null? R)
        0
        (+ (first R) (* 2 (frombinaryhelper (rest R))))))
  
  (frombinaryhelper (reverse L)))

(test (frombinary '(0))            0)
(test (frombinary '(1))            1)
(test (frombinary '(1 0))          2)
(test (frombinary '(1 1))          3)
(test (frombinary '(1 0 0))        4)
(test (frombinary '(1 0 1))        5)
(test (frombinary '(1 1 0))        6)
(test (frombinary '(1 1 1))        7)
(test (frombinary '(1 0 0 0))      8)
(test (frombinary '(1 0 0 1))      9)
(test (frombinary '(1 0 1 0 ))    10)
(test (frombinary '(1 0 1 0 1 0)) 42)


; convert signed integer to two's complement, using the fewest bits possible
; The first bit of the result is the sign bit.

(define (toTwosComplement n)
  (if (>= n 0)
      (cons 0 (tobinary n))
      (cons 1 (twosComplement (tobinary n)))))

(define (twosComplement listOfBits)
  (addOne (onesComplement listOfBits)))

(define (onesComplement listOfBits)
  (map (lambda(bit) (if (= bit 0) 1 0)) listOfBits))

(define (addOne listOfBits)
  (define (addOneLSBfirst listOfBits)
    (if (null? listOfBits)
        (list 1)
        (if (= 0 (first listOfBits))
            (cons 1 (rest listOfBits))
            (cons 0 (addOneLSBfirst (rest listOfBits))))))
  
  (reverse (addOneLSBfirst (reverse listOfBits))))

    
(test (toTwosComplement  0)           '(0 0))
(test (toTwosComplement  1)           '(0 1))
(test (toTwosComplement  2)         '(0 1 0))
(test (toTwosComplement  3)         '(0 1 1))
(test (toTwosComplement  4)       '(0 1 0 0))
(test (toTwosComplement  5)       '(0 1 0 1))
(test (toTwosComplement  6)       '(0 1 1 0))
(test (toTwosComplement  7)       '(0 1 1 1))
(test (toTwosComplement  8)     '(0 1 0 0 0))
(test (toTwosComplement  9)     '(0 1 0 0 1))
(test (toTwosComplement 10)     '(0 1 0 1 0))
(test (toTwosComplement 42) '(0 1 0 1 0 1 0))

(test (toTwosComplement  -1)           '(1 1))
(test (toTwosComplement  -2)         '(1 1 0))
(test (toTwosComplement  -3)         '(1 0 1))
(test (toTwosComplement  -4)       '(1 1 0 0))
(test (toTwosComplement  -5)       '(1 0 1 1))
(test (toTwosComplement  -6)       '(1 0 1 0))
(test (toTwosComplement  -7)       '(1 0 0 1))
(test (toTwosComplement  -8)     '(1 1 0 0 0))
(test (toTwosComplement  -9)     '(1 0 1 1 1))
(test (toTwosComplement -10)     '(1 0 1 1 0))
(test (toTwosComplement -42) '(1 0 1 0 1 1 0))

(tester 'show)