;; Caltech CS1 Fall 2007
;; Scheme code used in Lecture 17 (11/26/2007)
;; mvanier@cs.caltech.edu
;; Page 1 of 3
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; set-car! is not a special form
;; To evaluate (set-car! exp1 exp2)
;;  evaluate the operands: exp1, exp2
;;     exp1 must be a pair
;;  replace the car value of the exp1 pair
;;    with the value of exp2

(define a (cons 1 2))
(set-car! a 3)
a ; result: (3 . 2)
(set-cdr! a 10)
a ; result: (3 . 10)

;; definition of append (functional)
(define (append lst1 lst2) 
  (cond ((null? lst1) lst2) 
        ((null? lst2) lst1) 
        (else (cons (car lst1) 
                    (append (cdr lst1) lst2)))))

;; definition of append! (mutating)
(define (append! lst1 lst2) 
  (define (join lst1 lst2) ; helper function
    (if (null? (cdr lst1)) ; end of list 
        (set-cdr! lst1 lst2) 
        (join (cdr lst1) lst2))) 
  (cond ((null? lst1) lst2) 
        ((null? lst2) lst1) 
        (else (join lst1 lst2) ; change cdr
              lst1))) ; return beginning of list

;; from day 10
(define (make-result x y) (cons x y))
(define (get-x res)       (car res))
(define (get-y res)       (cdr res))

;; sample list of results
(define my-results
  (list (make-result 4 7.8)
        (make-result 3 6.0)
        (make-result 2 4.3)
        (make-result 1 1.9)))

;; from day 10
(define (remove-by-x a-list x)
  (cond ((null? a-list) a-list)
        ((= (get-x (car a-list)) x)
         (cdr a-list))
        (else (cons (car a-list)
                    (remove-by-x (cdr a-list) x)))))

;; Page 2 of 3
;; new mutating version:
(define (remove-by-x-aux! previous x)
  (let ((current (cdr previous)))        
    (cond ((null? current) 'done)
          ((= (get-x (car current)) x)
           (set-cdr! previous (cdr current)))
          (else 
           (remove-by-x-aux! current x)))))

(define (remove-by-x! lst x)
  (cond ((null? lst) (list))
        ((= (get-x (car lst)) x) ;; special case
                                 ;; remove first
                                 ;; element in list
         (cdr lst))
        (else (remove-by-x-aux! lst x)
              lst)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; understanding equality
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; eq? says the two things are really a single
;;     thing.  Cannot change one without
;;     changing the other.

;; equal? is primitive, but this is what it does:
;(define (equal? obj1 obj2)
;  (cond ((and (null? obj1) (null? obj2)) #t)
;        ((and (pair? obj1) (pair? obj2))
;          (and (equal? (car obj1) (car obj2))
;               (equal? (cdr obj1) (cdr obj2))))
;        ((and (symbol? obj1) (symbol? obj2))
;         (eq? obj1 obj2))
;        ((and (number? obj1) (number? obj2))
;         (= obj1 obj2))
;        (else #f)))


;; Page 3 of 3
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Syntactic abstraction (macros)

;; more verbose form of "if"
(define-syntax new-if 
  (syntax-rules (then else) 
    ((new-if test (then expr1 ...) (else expr2 ...)) 
     (if test (begin expr1 ...) (begin expr2 ...)))))

(define x 9)
(new-if (< x 10) 
   (then 
    (display "less than 10!") 
    (newline)) 
   (else 
    (display "greater than 10!") 
    (newline)))

;; simple looping function, using recursion
(define (print-range f lo hi) 
  (if (> lo hi) 
      'done 
      (begin (display (f lo))
             (newline) 
             (print-range f (+ lo 1) hi))))

;; simple looping function, using "do"
(define (print-range f lo hi) 
  (do ((i lo (+ i 1))) 
      ((> i hi) 'done) 
    (display (f i)) 
    (newline)))

;; simple looping function, using new "for" special form
(define (print-range f lo hi) 
  (for ((i lo) (<= i hi) (+ i 1)) 
       (display (f i)) (newline)))

;; definition of "for"
;; This changes the syntax of scheme in six lines of code!
(define-syntax for 
  (syntax-rules () ;; no keywords 
    ((for ((var init) test incr) command ...) 
     (do ((var init incr)) 
         ((not test) 'done) 
       command ...))))