(load "chez-init.ss")

(define-datatype expression expression?
  (lit-exp
   (val scheme-value?))
  (var-exp
   (id symbol?))
  (lambda-exp
   (parameters (list-of symbol?))
   (bodies (list-of expression?)))
  (lambda-exp-parameter-list
   (parameter symbol?)
   (bodies (list-of expression?)))
  (lambda-exp-improper-list
   (parameters scheme-value?)
   (bodies (list-of expression?)))
  (let-exp
   (ids (list-of symbol?))
   (vals (list-of expression?))
   (bodies (list-of expression?)))
  (if-exp
   (conditional expression?)
   (actions (list-of expression?)))
  (set!-exp
   (id symbol?)
   (val expression?))
  (app-exp
   (operator expression?)
   (operands (list-of expression?))))


(define scheme-value? (lambda (v) #t))

(define parse-expression
  (lambda (datum)
    (cond [(number? datum) (lit-exp datum)]
	  [(boolean? datum) (lit-exp datum)]
	  [(vector? datum) (lit-exp datum)]
	  [(string? datum) (lit-exp datum)]
	  [(symbol? datum) (var-exp datum)]
	  [(pair? datum)
	   (cond [(eq? (car datum) 'lambda)
		  (cond [(symbol? (cadr datum))
			 (lambda-exp-parameter-list (cadr datum)
						    (if (null? (cddr datum))
							(eopl:error 'parse-expression
								    "foo")
							(map parse-expression (cddr datum))))]
			[(list? (cadr datum))
			 (lambda-exp (cadr datum)
				     (if (null? (cddr datum))
					 (eopl:error 'parse-expression
						     "foo")
					 (map parse-expression (cddr datum))))]
			[(pair? (cadr datum))
			 (lambda-exp-improper-list (cadr datum)
						   (if (null? (cddr datum))
						       (eopl:error 'parse-expression
								   "foo")
						       (map parse-expression (cddr datum))))]
			[else (eopl:error 'parse-expression
					  "Invalid concrete syntax ~s" datum)])]
		 [(eq? (car datum) 'let)
		  (let-exp (map car (cadr datum))
			   (map parse-expression (map cadr (cadr datum)))
			   (map parse-expression (cddr datum)))]
		 [(eq? (car datum) 'if)
		  (if-exp
		   (parse-expression (cadr datum))
		   (map parse-expression (cddr datum)))]		     
		 [(eq? (car datum) 'set!)
		  (set!-exp
		   (cadr datum)
		   (parse-expression (cddr datum)))]
		 [(eq? (car datum) 'quote)
		  (lit-exp (cadr datum))]
		 [else (app-exp
			(parse-expression (car datum))
			(map parse-expression (cdr datum)))])]
	  [else (eopl:error 'parse-expression
		       "Invalid concrete syntax ~s" datum)])))


(define unparse-expression
  (lambda (exp)
    (cases expression exp
	   [lit-exp (val) val]
	   [var-exp (id) id]
	   [lambda-exp (parameters bodies)
		       (cons 'lambda (cons parameters
					   (map unparse-expression bodies)))]
	   [lambda-exp-parameter-list (parameter bodies)
		       (cons 'lambda (cons parameter
					   (map unparse-expression bodies)))]
	   [lambda-exp-improper-list (parameters bodies)
		       (cons 'lambda (cons parameters
					   (map unparse-expression bodies)))]
	   [let-exp (ids vals bodies)
		    (cons 'let
			  (cons (make-let ids vals)
				(map unparse-expression bodies)))]
	   [if-exp (condition actions)
		   (cons 'if
			 (cons (unparse-expression condition)
			       (map unparse-expression actions)))]
	   [set!-exp (id value)
		     (cons 'set! (cons id (unparse-expression value)))]
	   [app-exp (operator operands)
		    (cons (unparse-expression operator)
			  (map unparse-expression operands))])))

(define make-let
  (lambda (ids vals)
    (if (null? ids)
	'()
	(cons (list (car ids) (unparse-expression (car vals)))
	      (make-let (cdr ids) (cdr vals))))))