;;
;; syntax.scm - 6.001 Spring '04
;; project 6 (register machines / analyze)
;;
;; syntax procedures for assembly
;;

;;; Syntax of expression types:

(define (tagged-list? exp tag)
  (and (pair? exp) (eq? (car exp) tag)))

(define label? symbol?)

(define instruction-tags '(assign perform test branch goto save restore halt))

(define (instruction? inst)
  (and (pair? inst) (memq (car inst) instruction-tags)))

(define (assign? inst)
  (tagged-list? inst 'assign))

(define (perform? inst)
  (tagged-list? inst 'perform))

(define (test? inst)
  (tagged-list? inst 'test))

(define (branch? inst)
  (tagged-list? inst 'branch))

(define (goto? inst)
  (tagged-list? inst 'goto))

(define (save? inst)
  (tagged-list? inst 'save))

(define (restore? inst)
  (tagged-list? inst 'restore))

(define (halt? inst)
  (tagged-list? inst 'halt))

;; instruction selectors

(define (assign-reg-name assign-instruction)
  (cadr assign-instruction))

(define (assign-value-exp assign-instruction)
  (cddr assign-instruction))

(define (perform-action inst)
  (cdr inst))

(define (test-condition test-instruction)
  (cdr test-instruction))

(define (branch-dest branch-instruction)
  (cdr branch-instruction))

(define (goto-dest goto-instruction)
  (cdr goto-instruction))

(define (save-register save-instruction)
  (cadr save-instruction))

(define (restore-register restore-instruction)
  (cadr restore-instruction))

;; sub-instruction expressions
; (reg R)
; (const C)
; (label L)
; (op O)

(define (register-exp? exp)
  (tagged-list? exp 'reg))

(define (register-exp-reg exp)
  (cadr exp))

(define (constant-exp? exp)
  (tagged-list? exp 'const))

(define (constant-exp-value exp)
  (cadr exp))

(define (label-exp? exp)
  (tagged-list? exp 'label))

(define (label-exp-label exp)
  (cadr exp))

(define (application-exp? exp)
  (and (pair? exp)
       (tagged-list? (car exp) 'op)))

(define (application-exp-op application-exp)
  (cadr (car application-exp)))

(define (application-exp-operands application-exp)
  (cdr application-exp))

;; utility procs

(define (remove-duplicates lst)
  (cond ((null? lst)
	 '())
	((memq (car lst) (cdr lst))
	 (remove-duplicates (cdr lst)))
	(else
	 (cons (car lst)
	       (remove-duplicates (cdr lst))))))

(define (index-of key lst)
  (define (ihelper i lst)
    (cond ((null? lst)
	   #f)
	  ((eq? (car lst) key)
	   i)
	  (else
	   (ihelper (+ i 1) (cdr lst)))))
  (ihelper 0 lst))

(define (subset? set superset)
  (cond ((null? set)
	 #t)
	((memq (car set) superset)
	 (subset? (cdr set) superset))
	(else
	 #f)))


(define (make-matrix n)
  (cons n (make-vector (* n n) 0)))

(define (matrix-size m)
  (car m))

(define (matrix-ref m i j)
  (vector-ref (cdr m) (+ (* i (car m)) j)))

(define (matrix-set! m i j val)
  (vector-set! (cdr m) (+ (* i (car m)) j) val))

(define (generate-identity-matrix n)
  (cons n
	(make-initialized-vector (* n n)
				 (lambda (x)
				   (if (= (remainder x n) (quotient x n))
				       1
				       0)))))

(define (generate-random-matrix n maxval)
  (cons n
	(make-initialized-vector (* n n)
				 (lambda (x)
				   (random maxval)))))

(define (print-matrix m)
  (let loop
      ((i 0))
    (if (= i (* (car m) (car m)))
	'done
	(begin
	  (if (= (remainder i (car m)) 0)
	      (newline))
	  (display "  ") (display (vector-ref (cdr m) i))
	  (loop (+ i 1)))))
  (newline))

(define (multiply-matrix a b)
  (let ((c (make-matrix (car a)))
	(n (car a)))
    (let loop
	((i 0) (j 0) (k 0) (sum 0))
      (cond ((= i n)
	     c)
	    ((= j n)
	     (loop (+ i 1) 0 0 0))
	    ((= k n)
	     (matrix-set! c i j sum)
	     (loop i (+ j 1) 0 0))
	    (else
	     (loop i j (+ k 1) (+ sum
				  (* (matrix-ref a i k)
				     (matrix-ref b k j)))))))))