(define-datatype expression expression? 
  (lit-exp
   (value scheme-value?))
  (begin-exp
   (exps (list-of expression?)))
  (var-exp
   (id symbol?))
  (define-exp
    (id symbol?)
    (val expression?))
  (set-exp
   (id symbol?)
   (val expression?))
  (or-exp
   (exps (list-of expression?)))
  (cond-exp
   (cond-exps (list-of expression?))   
   (action-exps (list-of (list-of expression?))))
  (and-exp
   (exps (list-of expression?)))
  (while-exp
   (test-exp expression?)
   (bodies (list-of expression?)))
  (if-then-exp
   (test-exp expression?)
   (true-exp expression?))
  (if-else-exp
   (test-exp expression?)
   (true-exp expression?)
   (false-exp expression?))
  (lambda-exp
   (ids (list-of parameter?))
   (bodies (list-of expression?)))
  (lambda-exp-list
   (id symbol?)
   (bodies (list-of expression?)))
  (lambda-exp-dotted-list
   (ids scheme-value?)
   (bodies (list-of expression?)))
  (named-let-exp
   (label symbol?)
   (ids (list-of symbol?))
   (vals (list-of expression?))
   (bodies (list-of expression?)))
  (let-exp
   (ids (list-of symbol?))
   (vals (list-of expression?))
   (bodies (list-of expression?)))
  (let*-exp
   (ids (list-of symbol?))
   (vals (list-of expression?))
   (bodies (list-of expression?)))
  (letrec-exp
   (ids (list-of symbol?))
   (vals (list-of expression?))
   (bodies (list-of expression?)))
  (app-exp
   (rator expression?)
   (rands (list-of expression?))))


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

(define parameter?
  (lambda (v)
    (or (symbol? v)
	(and (eq? (car v) 'ref)
	     (symbol? (cadr v))
	     (= (length v) 2)))))


(define expand-syntax
  (lambda (expr)
    (cases expression expr
;           [or-exp (vals)
;		   (if (null? vals)
;		       (lit-exp #f)
;		       (expand-syntax (let-exp (list 'temp) (list (car vals))
;					       (list (if-else-exp (var-exp 'temp)
;								  (var-exp 'temp)
;								  (expand-syntax (or-exp (cdr vals))))))))]
;				
           [or-exp (vals)
		   (if (null? vals)
		       (lit-exp #f)
		       (app-exp (lambda-exp (list 'temp)
					    (list (if-else-exp (var-exp 'temp)
							       (var-exp 'temp)
							       (expand-syntax (or-exp (cdr vals))))))
				(list (car vals))))]
           [and-exp (vals)
		    (cond [(null? vals)	(lit-exp #t)]
			  [(null? (cdr vals)) (expand-syntax (car vals))]
			  [else (app-exp (lambda-exp (list 'temp)
						     (list (if-else-exp (var-exp 'temp)
									(expand-syntax (and-exp (cdr vals)))
									(var-exp 'temp))))
					 (list (car vals)))])]
	   [begin-exp (exps)
		      (letrec ([helper (lambda (exps)
					 (if (null? exps)
					     '()
					     (cons (expand-syntax (car exps))
						   (helper (cdr exps)))))])
			(begin-exp (helper exps)))]
	   [set-exp (id val)
		    (set-exp id (expand-syntax val))]
	   [define-exp (id val)
		    (define-exp id (expand-syntax val))]
	   [while-exp (test-exp bodies)
		      (letrec-exp (list 'helper) 
				  (list (lambda-exp '() 
						    (list (if-then-exp (expand-syntax test-exp)
								       (begin-exp (append bodies
											  (list (app-exp (var-exp 'helper) '()))))))))
				  (list (app-exp (var-exp 'helper) '())))]
	   [if-then-exp (test-exp true-exp)
			(if-then-exp (expand-syntax test-exp)
				     (expand-syntax true-exp))]
	   [cond-exp (cond-exps action-exps)
		     (app-exp (lambda-exp (list 'val) 
					  (if (null? (cdr cond-exps))
					      (list (if-then-exp (var-exp 'val)
								 (if (null? (car action-exps))
								     (var-exp 'val)
								     (expand-syntax (begin-exp (car action-exps))))))
					      (list (if-else-exp (var-exp 'val)
								 (if (null? (car action-exps))
								     (var-exp 'val)
								     (expand-syntax (begin-exp (car action-exps))))
								 (expand-syntax (cond-exp (cdr cond-exps) 
											  (cdr action-exps)))))))
			      (list (expand-syntax (car cond-exps))))]
	   [if-else-exp (test-exp true-exp false-exp)
			(if-else-exp (expand-syntax test-exp)
				     (expand-syntax true-exp)
				     (expand-syntax false-exp))]
	   [lambda-exp (ids bodies)
		      (letrec ([helper (lambda (exps)
					 (if (null? exps)
					     '()
					     (cons (expand-syntax (car exps))
						   (helper (cdr exps)))))])
			(lambda-exp ids (helper bodies)))]
	   [lambda-exp-list (id bodies)
		       (letrec ([helper (lambda (exps)
					  (if (null? exps)
					      '()
					      (cons (expand-syntax (car exps))
						    (helper (cdr exps)))))])
			 (lambda-exp-list id (helper bodies)))]
	   [lambda-exp-dotted-list (ids bodies)
				   (letrec ([helper (lambda (exps)
						      (if (null? exps)
							  '()
							  (cons (expand-syntax (car exps))
								(helper (cdr exps)))))])
				     (lambda-exp-dotted-list ids (helper bodies)))]
	   [let-exp (ids vals bodies)
		    (letrec ([helper (lambda (exps)
				       (if (null? exps)
					   '()
					   (cons (expand-syntax (car exps))
						 (helper (cdr exps)))))])
		      (app-exp (lambda-exp ids (helper bodies)) (helper vals)))]
	   [let*-exp (ids vals bodies)
		     (letrec ([helper (lambda (exps)
					(if (null? exps)
					    '()
					    (cons (expand-syntax (car exps))
						  (helper (cdr exps)))))])
		       (if (null? ids)
			   (app-exp
			    (lambda-exp '() (helper bodies))
			    '())
			   (app-exp
			    (lambda-exp (list (car ids))
					(list (expand-syntax (let*-exp (cdr ids)
								       (cdr vals)
								       bodies))))
			    (list (expand-syntax (car vals))))))]
	   [letrec-exp (ids vals bodies)
		    (letrec ([helper (lambda (exps)
				       (if (null? exps)
					   '()
					   (cons (expand-syntax (car exps))
						 (helper (cdr exps)))))])
		      (letrec-exp ids (helper vals) (helper bodies)))]

	   [named-let-exp (label ids vals bodies)
			  (app-exp (letrec-exp (list label) (list (lambda-exp ids bodies)) (list (var-exp label)))
				   (map expand-syntax vals))]
	   [app-exp (rator rands)
		    (letrec ([helper (lambda (exps)
				       (if (null? exps)
					   '()
					   (cons (expand-syntax (car exps))
						 (helper (cdr exps)))))])
		      (app-exp (expand-syntax rator) (helper rands)))]
           [else expr])))



(define parse-expression
  (lambda (datum)
    (cond [(symbol? datum) (var-exp datum)]
	  [(number? datum) (lit-exp datum)]
	  [(string? datum) (lit-exp datum)]
	  [(boolean? datum) (lit-exp datum)]	  	  
	  [(null? datum) (lit-exp datum)]
	  [(vector? datum) (lit-exp datum)]
	  [(pair? datum)
	   (cond [(eqv? (car datum) 'lambda)
		  (cond [(symbol? (cadr datum))
			 (lambda-exp-list (cadr datum)
					  (map parse-expression (cddr datum)))]
			[(list? (cadr datum))
			 (lambda-exp (cadr datum)
				     (map parse-expression (cddr datum)))]
			[else (lambda-exp-dotted-list (cadr datum)
						      (map parse-expression (cddr datum)))])]
		 [(eqv? (car datum) 'let)
		  (if (symbol? (cadr datum))
		      (named-let-exp (cadr datum)
				     (map car (caddr datum))
				     (map parse-expression (map cadr (caddr datum)))
				     (map parse-expression (cdddr datum)))
		      (let-exp (map car (cadr datum))
			       (map parse-expression (map cadr (cadr datum)))
			       (map parse-expression (cddr datum))))]
		 [(eqv? (car datum) 'let*)
		  (let*-exp (map car (cadr datum))
			    (map parse-expression (map cadr (cadr datum)))
			    (map parse-expression (cddr datum)))]
		 [(eqv? (car datum) 'letrec)
		  (letrec-exp (map car (cadr datum))
			      (map parse-expression (map cadr (cadr datum)))
			      (map parse-expression (cddr datum)))]
		 [(eqv? (car datum) 'set!)
		  (set-exp (cadr datum) (parse-expression (caddr datum)))]
		 [(eqv? (car datum) 'define)
		  (define-exp (cadr datum) (parse-expression (caddr datum)))]
		 [(eqv? (car datum) 'begin)
		  (begin-exp (map parse-expression (cdr datum)))]
		 [(eqv? (car datum) 'cond)
		  (cond-exp 
		   (map parse-expression (map car (cdr datum)))
		   (get-and-parse-action-exps (cdr datum)))]
		 [(eqv? (car datum) 'or)
		  (or-exp (map parse-expression (cdr datum)))]
		 [(eqv? (car datum) 'and)
		  (and-exp (map parse-expression (cdr datum)))]
		 [(eqv? (car datum) 'while)
		    (while-exp (parse-expression (cadr datum))
			       (map parse-expression (cddr datum)))]
		 [(eqv? (car datum) 'if)
		  (if (null? (cdddr datum))
		    (if-then-exp (parse-expression (cadr datum))
				 (parse-expression (caddr datum)))
		    (if-else-exp (parse-expression (cadr datum))
				 (parse-expression (caddr datum))
				 (parse-expression (cadddr datum))))]
		 [(eqv? (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 get-and-parse-action-exps
  (lambda (ls)
    (if (null? ls)
	'()
	(cons (map parse-expression (cdar ls))
	      (get-and-parse-action-exps (cdr ls))))))