;; Question 1:
;; -----------
;; 
;; 1.1 15 pts (cxr)
;; ----------
;; Possible problems to avoid
;; - Does not return function
;; - Deals with strings      
;; - Tries to return caddr ready 
;; - Only works with caddr       
;; - Applies car/cdr in wrong order
;; - Does not check for empty list (call car/cdr directly)
;; - Syntax from another world   
;; - Take car or cdr of cxr      
;; - Define cxr with 2 parameters
;; - Loop on elements            
;; 
;; Solution 1:
;; -----------

(define (compose f g)
  (lambda (x)
    (f (g x))))

(define (cxr l) 
  (cond ((null? l) identity)
        ((eq? (car l) 'a) (compose car (cxr (cdr l))))
        ((eq? (car l) 'd) (compose cdr (cxr (cdr l))))))

;; Solution 2:
;; -----------

(define (cxr l)
  (lambda (l2)
    (cond ((null? l) l2)
          ((eq? (car l) 'a) (car ((cxr (cdr l)) l2)))
          ((eq? (car l) 'd) (cdr ((cxr (cdr l)) l2))))))


;; Solution 3:
;; -----------

(define (cxr l)
  (define (process commands list)
    (cond ((null? commands) list)
          ((eq? (car commands) 'a) (process (cdr commands) (car list)))
          ((eq? (car commands) 'd) (process (cdr commands) (cdr list)))))
  (lambda (list)
    (process (reverse l) list)))


;; 1.2 5 pts (environments)
;; ----------
;;
;; Depends on which solution you choose -- not too problematic.



;; ======================================================================
;; Question 2:
;; -----------
;; 
;; Possible problems to avoid:
;; 
;; - Not message passing (no dispatch)                             
;; - Syntax of message-passing to account (withdraw account price) 
;; 
;; 2.1 10 pts (company)
;; ----------
;; Possible problems:
;; - Initialization: available-shares = total-shares
;; - Check available-shares > nshares in buy-shares 
;; - Deposit / withdraw from account                
;; - Update available-shares                        

(define (make-company total-shares share-price)
  (let ((available-shares total-shares))
    (define (buy-shares nshares account)
      (let ((price-due (* nshares share-price)))
	(cond ((> nshares available-shares)
	       (error "Not enough shares"))
	      ((> price-due (account 'get-balance))
	       (error "You don't have enough money"))
	      (else
	       (set! available-shares (- available-shares nshares))
	       ((account 'withdraw) price-due)))))
    (define (sell-shares nshares account)
      (set! available-shares (+ available-shares nshares))
      ((account 'deposit) (* nshares share-price)))
    (define (dispatch msg)
      (cond ((eq? msg 'buy-shares) buy-shares)
	    ((eq? msg 'sell-shares) sell-shares)
	    ((eq? msg 'get-share-value) share-price)
	    (else (error "Unknown message -- COMPANY" msg))))
    dispatch))


;; 2.2 10 pts (bank-account-shares)
;; ----------
;; Possible problems:
;; - deposit/withdraw/get-balance:
;; - rewrote deposit... (no internal-account)
;; - no update of accounts-owned 
;; - no message sent to company  
;; - send message to company AND do its own deposit/withdraw
;; - deal with only one company

(define (make-bank-account-shares deposit)
  (let ((internal-account (make-bank-account deposit))
	(accounts-owned '()))
    (define (buy-shares nshares company)
      ((company buy-shares) nshares internal-account)
      (let ((pair (assq company accounts-owned)))
	(cond ((not pair) 
	       (set! accounts-owned 
		     (cons (cons company nshares) accounts-owned)))
	      (else
	       (set-cdr! pair (+ (cdr pair) nshares))))))
    (define (sell-shares nshares company)
      (let ((pair (assq company accounts-owned)))
	(cond ((not pair)
	       (error "You don't own stock from this company"))
	      ((> nshares (cdr pair))
	       (error "You don't own enough shares from this company"))
	      (else
	       ((company 'sell-shares) nshares internal-account)
	       (set-cdr! pair (- (cdr pair) nshares))))))
    (define (me msg)
      (cond ((eq? msg 'deposit) (internal-account 'deposit))
	    ((eq? msg 'withdraw) (internal-account 'withdraw))
	    ((eq? msg 'get-balance) (internal-account 'get-balance))
	    ((eq? msg 'buy-shares) buy-shares)
	    ((eq? msg 'sell-shares) sell-shares)
	    (else (error "Unknown message - BANK-ACCOUNT-SHARES" msg))))
    me))


;; ======================================================================
;; Question 3: (stream of rationals)
;; ---------------------------------
;; 
;; Possible problems:
;; - Do not generate all rational numbers (for example, only 1/n)   
;; - Do not generate the right order so that an infinite sequence is
;;   generated and another one is never reached.
;; - Generate with repetitions (no filter of non-reduced rationals) 
;; - Generate rationals > 1.                                        
;; - Generate a finite stream                                       
;; - Use append instead of interleave or append-finite-stream       
;; - Use pairs without defining it                                  
;; - Infinite recursion                                             
;; 

;; General utilities for stream == you didn't need to write them

;; Filter-stream: keep only the elements satisfying predicate
(define stream-car car)
(define (stream-cdr s) (force (cdr s)))

(define (filter-stream pred? stream)
  (cond ((eq? stream the-empty-stream) the-empty-stream)
	((pred? (stream-car stream))
	 (cons-stream (stream-car stream)
		      (filter-stream pred? (stream-cdr stream))))
	(else
	 (filter-stream pred? (stream-cdr stream)))))

(define (map-stream f stream)
  (if (eq? stream the-empty-stream) 
      the-empty-stream
      (cons-stream (f (stream-car stream)) 
		   (map-stream f (stream-cdr stream)))))

;; Assume s1 and s2 are infinite
(define (interleave s1 s2)
  (cons-stream (stream-car s1)
    (interleave s2 (stream-cdr s1))))

(define (show-n n stream)
  (cond ((eq? stream the-empty-stream) #f)
	((= n 0) #f)
	(else (display (stream-car stream)) (newline)
	      (show-n (- n 1) (stream-cdr stream)))))


;; ============================================
;; Solution 1
;; ============================================

(define (enumerate-interval j n)
  (if (>= j n)
      the-empty-stream
      (cons-stream j (enumerate-interval (+ j 1) n))))

;; Generate all pairs of the form (1 n) ... (n-1 n)
(define (pairs n)
  (map-stream (lambda (j) (list j n))
	      (enumerate-interval 1 n)))

;; Append a finite stream to a possibly infinite stream
(define (append-finite-stream fs is)
  (if (eq? fs the-empty-stream) 
      is
      (cons-stream (stream-car fs) 
		   (append-finite-stream (stream-cdr fs) is))))


;; Generate all pairs from 1/n and up...
(define (all-pairs n)
  (let ((pn (pairs n)))
    (cons-stream (stream-car pn)
		 (append-finite-stream (stream-cdr pn)
				       (all-pairs (+ n 1))))))

;; Generate all rationals as required
(define (rationals)
  (filter-stream (lambda (pair)
		   (eq? (gcd (car pair) (cadr pair)) 1))
		 (all-pairs 2)))
		 


;; ============================================
;; Solution 2 (using pairs)
;; ============================================

(define (integers n) 
  (cons-stream n (integers (+ n 1))))

;; Return the upper-right triangle of the matrix 
(define (pairs s1 s2)
  (cons-stream (list (stream-car s1)
		     (stream-car s2))
	       (interleave 
		(map-stream (lambda (j) (list (stream-car s1) j))
			    (stream-cdr s2))
		(pairs (stream-cdr s1) (stream-cdr s2)))))

;; Remove the diagonal and all pairs that are not prime to each other.
(define (rationals)
  (filter-stream (lambda (pair)
		   (eq? (gcd (car pair) (cadr pair)) 1))
		 (filter-stream (lambda (pair)
				  (< (car pair) (cadr pair)))
				(pairs (integers 1)
				       (integers 1)))))


;; ======================================================================
;; Question 4 (Constraints)

4.1 Why the multiplier cannot be used to implement a squarer constraint? (7pt)

If you try to bind the two input connectors of the multiplier to the same
connector by evaluating the expression (multiplier c1 c1 product), then the
following situation is created:

- If product does not have a value but c1 has a value, product correctly
  receives as a value c1*c1 (that is, the constraint works in one direction).
- If product has a value, but c1 does not have a value, then in the code of
  the multiplier, the following case is reached:

  (define (process-new-value)
    (cond ((or (and (has-value? m1) (= (get-value m1) 0))
	       (and (has-value? m2) (= (get-value m2) 0)))
	   (set-value! product 0 me))
	  ((and (has-value? m1) (has-value? m2))
	   (set-value! product (* (get-value m1) (get-value m2)) me))
	  ((and (has-value? m1) (has-value? product))
	   (set-value! m2 (/ (get-value product) (get-value m1)) me))
	  ((and (has-value? m2) (has-value? product))
	   (set-value! m1 (/ (get-value product) (get-value m2)) me))
	  ;; THIS CASE IS NOT CHECKED:
	  ;; m1 and m2 don't have a value / product has a value
	  ;; In general, there is no way to decide what the value of
	  ;; m1 and m2 can be (2 unknown variables / 1 equation).
	  ))

4.2 Change multiplier to make it works if two connectors are linked to the 
    same connector. (9 pts)


    To make multiplier works we need to add a special case to deal with the
    case where m1 and m2 are bound to the same connector:

  (define (process-new-value)
    (cond ((or (and (has-value? m1) (= (get-value m1) 0))
	       (and (has-value? m2) (= (get-value m2) 0)))
	   (set-value! product 0 me))
	  ((and (has-value? m1) (has-value? m2))
	   (set-value! product (* (get-value m1) (get-value m2)) me))

	  ;; This is the best place to check for the missing case
	  ;; Since we are dealing with message-passing objects, 
	  ;; eq? is an appropriate predicate to check for equality.
	  ((and (eq? m1 m2) (has-value? product))
	   (if (< (get-value product) 0)
	       (error "Impossible to take sqrt of negative number")
	       (set-value! m1 (sqrt (get-value product)) me)))

	  ((and (has-value? m1) (has-value? product))
	   (set-value! m2 (/ (get-value product) (get-value m1)) me))
	  ((and (has-value? m2) (has-value? product))
	   (set-value! m1 (/ (get-value product) (get-value m2)) me))
	  ))


4.3 To implement a squarer constraint with the new multiplier: (4pts) 

    (define (squarer x y) (multiplier x x y))



;; ======================================================================
;; Question 5 (Java / Threads)
;; ----------
;; 
;; 5.1 Explain how deadlock can be reached 6pt
;; 
;; 5.1 Deadlock can be reached if a thread T1 calls c1.swapContents(c2) and
;;     T2 calls c2.swapContents(c1).  
;;     When T1 executes c1.swapContents() it grabs the lock of c1 and when T2
;;     executes c2.swapContents() it grabs the lock of c2.
;;     When inside swapContents(), T1 invokes other.getValue() it needs to
;;     wait for the monitor on c2 and T2 waits for the monitor on c1 
;; 
;;     This is a deadlock.
;; 
;; 5.2 Implement deadlock scenario 7pt
;; - Run two threads                                        
;; - Use two cells                                          
;; - Find a right spot for Thread.yield()                   
;; - Implement a class extends thread or implement runnable 
;; 
;; public class Cell {
;;   private int value_;
;;   public Cell(int v) {
;;     value_ = v;
;;   }
;;   public synchronized int getValue() {
;;     return value_;
;;   }
;;   public synchronized void setValue(int v) {
;;     value_ = v;
;;   }
;;   public synchronized void swapContents(Cell other) {
;;     int newValue = other.getValue();
;;     Thread.yield();                    // This forces a deadlock to occur
;;     other.setValue(getValue());
;;     setValue(newValue);
;;   }
;; }
;; 
;; public class CellDeadlock extends Thread {
;;   public static void main(String[] args) {
;;     Cell c1 = new Cell(1);
;;     Cell c2 = new Cell(2);
;; 
;;     CellDeadlock t1 = new CellDeadlock(c1,c2);
;;     CellDeadlock t2 = new CellDeadlock(c2,c1);
;; 
;;     t1.start();      
;;     t2.start();
;;     Thread.yield();  
;;     
;;     System.out.println("Cell c1 contains "+t1.x.getValue());
;;     System.out.println("Cell c2 contains "+t2.x.getValue());
;;   }
;; 
;;   public Cell x,y;
;; 
;;   public CellDeadlock(Cell x, Cell y) {
;;     this.x = x;
;;     this.y = y;
;;   }
;; 
;;   public void run() {
;;     x.swapContents(y);
;;   }    
;; }


;; 5.3 Race conditions (7pts)
;;     - All outcomes are possible.
;;     - A timing diagram to explain each time is desirable.
;; 
;;     The primitive events inside swapContents are:
;;
;; 
;;     int newValue = other.getValue();   // 1. access other value
;;                                        // 2. assign newValue
;;     other.setValue(getValue());        // 3. access this value
;;                                        // 4. other setValue
;;     setValue(newValue);                // 5. this setValue
;; 
;;     If 2 threads run inside swapContents at the same time, 4 possible
;;     outcomes can be reached, with for each one an example timing 
;;     diagrams leading to this state:
;; 
;;      T1:             1 2 3 4 5
;;      T2:   1 2 3 4 5
;; Outcome: c1.value_ = 1
;;          c2.value_ = 2
;; 
;;      T1:   1   2   3   4   5
;;      T2:     1   2   3   4   5
;; Outcome: c1.value_ = 2
;;          c2.value_ = 1
;; 
;;      T1:     1 2 3 4 5
;;      T2:   1           2 3 4 5
;; Outcome: c1.value_ = 1
;;          c2.value_ = 1
;; 
;;      T1:   1           2 3 4 5
;;      T2:     1 2 3 4 5
;; Outcome: c1.value_ = 2
;;          c2.value_ = 2