;; BU CAS CS320, Spring 2002
;; Problem set 7, solution of problem 1
;; Provided by Nenad Dedic

;; The only possibilities are:
;; 121  --  P2 increases x, then P1 squares it
;; 100  --  P1 evaluates x*x=100 (and does not store it yet), then P2 increases x, and then
;;          P1 stores the evaluated value in x
;; 101  --  P1 squares x, and then P2 increases it

;; BU CAS CS320, Spring 2002
;; Problem set 7, solution of problem 3
;; Provided by Nenad Dedic

(load-option 'format)

(define (make-mutex)
  (let ((cell (list false)))
    (define (the-mutex m)
      (cond ((eq? m 'acquire)
             (if (test-and-set! cell)
                 (the-mutex 'acquire)))
            ((eq? m 'release)
	     (clear! cell))))
    the-mutex))

(define (clear! cell)
  (set-car! cell false))

(define (test-and-set! cell)
  (without-interrupts
   (lambda ()
     (if (car cell)
         true
         (begin (set-car! cell true)
                false)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (make-semaphore avail)
  (let ( (lmutex (make-mutex)) )
    (define (dispatch msg)
      (cond
       ((eq? msg 'acquire)
	(lmutex 'acquire)
	(cond
	 ((> avail 0)
	  (set! avail (- avail 1))
	  (lmutex 'release))
	 (else
	  (lmutex 'release)
	  (dispatch 'acquire))))
       ((eq? msg 'release)
	(lmutex 'acquire)
	(set! avail (+ avail 1))
	(lmutex 'release))
; This is not required -- just for convenience
       ((eq? msg 'avail) avail)
       (else
	(format #t "Unknown message: ~S\n" msg))))
    dispatch))

(define (make-tas-semaphore avail)
  (let ( (cell (list false)) )
    (define (dispatch msg)
      (cond ((eq? msg 'acquire)
	     (if (test-and-set! cell)
		 (dispatch 'acquire)
		 (begin
		   (if (> avail 0)
		       (begin
			 (set! avail (- avail 1))
			 (clear! cell))
		       (begin
			 (clear! cell)
			 (dispatch 'acquire))))))
	    ((eq? msg 'release)
	     (if (test-and-set! cell)
		 (dispatch 'release id)
		 (begin
		   (set! avail (+ avail 1))
		   (clear! cell))))
; This is not required -- just for convenience
	    ((eq? msg 'avail) avail)
	    (else (format #t "Unknown message: ~S\n" msg))))
    dispatch))

;; BU CAS CS320, Spring 2002
;; Problem set 7, solution of problem 4
;; Provided by Nenad Dedic

(define ints (cons-stream 1 (stream-map (lambda (x) (+ x 1)) ints)))

(define (stream-div s1 s2)
  (stream-map / s1 s2))

(define (stream-scale s x)
  (stream-map (lambda (y) (* x y)) s))

(define (stream-integral s)
  (cons-stream 0 (stream-div s ints)))

(define cosine-series
  (cons-stream 1 (stream-scale (stream-cdr (stream-integral sine-series)) -1)))

(define sine-series
  (cons-stream 0 (stream-cdr (stream-integral cosine-series))))



;; BU CAS CS320, Spring 2002
;; Problem set 7, solution of problem 5
;; Provided by Nenad Dedic

(define (stream-add s1 s2)
  (stream-map + s1 s2))

(define (stream-mul s1 s2)
  (stream-map * s1 s2))

(define (stream-scale s x)
  (stream-map (lambda (y) (* x y)) s))

(define (mul-series2 a b)
  (cons-stream
   (* (stream-car a) (stream-car b))
   (stream-add
    (stream-add (stream-scale (stream-cdr b) (stream-car a)) (stream-scale (stream-cdr a) (stream-car b)))
    (cons-stream 0 (mul-series (stream-cdr a) (stream-cdr b))))))

(define (inv-series s)
  (cons-stream 1 (stream-scale
		  (mul-series2 (inv-series s) (stream-cdr s)) -1)))

(define (div-series a b)
  (let ( (b0 (stream-car b)) )
    (if (zero? b0)
	(error "Divisor's costant term is 0")
	(stream-scale (mul-series2 a (inv-series (stream-scale b (/ 1 b0)))) b0))))

;; BU CAS CS320, Spring 2002
;; Problem set 7, solution of problem 6
;; Provided by Nenad Dedic

(define nil '())
(define hd car)
(define tl cdr)
(define true #t)
(define false #f)

(define (<> x y) (not (= x y)))

(define (write-dots n)
  (if (< 0 n)
      (begin (write-string ".")
	     (write-dots (- n 1)))))
   
(define (write-row size n)
  (begin (write-dots (- n 1))
	 (write-string "Q")
	 (write-dots (- size n))
	 (newline)))
      
(define (write-board size positions)
  (define (aux positions)
    (if (not (null? positions))
	(begin (write-row size (hd positions))
	       (write-board size (tl positions)))))
  (aux positions))

(define (safe-pos? d p1 p2)
  (and (<> p1 p2) (<> (abs (- p1 p2)) d)))

(define (safe-row? p positions)
  (define (aux d positions)
    (if (null? positions)
	true
	(and (safe-pos? d p (hd positions))
	     (aux (1+ d) (tl positions)))))
  (aux 1 positions))

; Modified queens procedure:

(define (queens size)
  (define (aux n p positions)
    (if (<= p size)
	(if (safe-row? p positions)
	    (if (= n size)
		(begin (write-board size (cons p positions))
		       (newline)
		       (lambda () (aux n (1+ p) positions)))
		(aux (1+ n) 1 (cons p positions)))
	    (aux n (1+ p) positions))
	(if (null? positions)
	    "no more solutions"
	    (aux (- n 1) (1+ (hd positions)) (tl positions)))))
  (aux 1 1 nil))
;; BU CAS CS320, Spring 2002
;; Problem set 7, solution of problem 7
;; Provided by Nenad Dedic

(define (add-streams a b)
  (stream-map + a b))

(define (scale-stream s a)
  (stream-map (lambda (x) (* a x)) s))

(define (integral delayed-integrand initial-value dt)
  (define int
    (cons-stream initial-value
                 (let ((integrand (force delayed-integrand)))
                   (add-streams (scale-stream integrand dt)
                                int))))
  int)

(define (rlc r l c dt)
  (lambda (ivc iil)
    (define vc
       (integral (delay (scale-stream vc (/ -1 c)))
		 ivc dt))
    (define il
      (integral (delay (add-streams
			(scale-stream vc (/ 1 l))
			(scale-stream il (/ (- r) l))))
		 iil dt))
    (cons vc il)))