;;; $Id: java-helpers.scm,v 1.3 2000/10/27 22:10:58 leavens Exp leavens $
;;;
;;; To the best of my memory, here's the set of helping procedures
;;; we discussed in class for dealing with the "Java" grammar.
;;; I did the helpers using records, both because that's easier for me,
;;; and because that's what we're studying now.
;;;
;;; Concrete syntax:
;;;   <Java> ::= <varref> | <number>
;;;            | (if <Java> <Java> <Java> )
;;;            | (while <Java> <Java> )
;;;            | (begin {<Java>}* )
;;;            | (assign <varref> <Java>)
;;;            | (vardecl <var> <Java>)
;;;   <varref> ::= <var>
;;;   <var> ::= <symbol>

;;; Abstract syntax:
(define-record-type varref Java
  ((var Java)))
(define-record-type lit Java
  ((number number)))
(define-record-type if Java
  ((test-exp Java) (then-exp Java) (else-exp Java)))
(define-record-type while Java
  ((test-exp Java) (body Java)))
(define-record-type begin Java
  ((javas (list Java))))
(define-record-type assign Java
  ((var symbol) (value Java)))
(define-record-type vardecl Java
  ((var symbol) (body Java)))

(deftype parse-Java (-> (datum) Java))
(deftype unparse-Java (-> (Java) datum))

(define-record varref (var))
(define-record lit (number))
(define-record if (test-exp then-exp else-exp))
(define-record while (test-exp body))
(define-record begin (javas))
(define-record assign (var value))
(define-record vardecl (var body))

(define parse-Java
  (lambda (d)
      (has-type-trusted
       Java
       (cond
	((symbol? d) (make-varref d))
	((number? d) (make-lit d))
	((and (list? d) (= 4 (length d)) (eq? 'if (car d)))
	 (make-if (parse-Java (cadr d))
		  (parse-Java (caddr d))
		  (parse-Java (cadddr d))))
	((and (list? d) (= 3 (length d)) (eq? 'while (car d)))
	 (make-while (parse-Java (cadr d))
		     (parse-Java (caddr d))))
	((and (list? d) (<= 1 (length d)) (eq? 'begin (car d)))
	 (make-begin (map parse-Java (cdr d))))
	((and (list? d) (= 3 (length d)) (eq? 'assign (car d))
	      (symbol? (cadr d)))
	 (make-assign (cadr d) (parse-Java (caddr d))))
	((and (list? d) (= 3 (length d)) (eq? 'vardecl (car d))
	      (symbol? (cadr d)))
	 (make-vardecl (cadr d) (parse-Java (caddr d))))
	(else (error "syntax error in:" d))))))

(define unparse-Java
   (lambda (java)
     (variant-case java
       (varref (var) (has-type datum var))
       (lit (number) (has-type datum number))
       (if (test-exp then-exp else-exp)
	   (list 'if
		 (unparse-Java test-exp)
		 (unparse-Java then-exp)
		 (unparse-Java else-exp)))
       (while (test-exp body)
	      (list 'while
		    (unparse-Java test-exp)
		    (unparse-Java body)))
       (begin (javas)
	      (cons 'begin (map unparse-Java javas)))
       (assign (var value)
	       (list 'assign
		     var
		     (unparse-Java value)))
       (vardecl (var body)
		(list 'vardecl
		      var
		      (unparse-Java body)))
       (else (error "bad abstract syntax to unparse-Java:" java)))))