;; DESUGAR.SCM

;;6.001 PROJECT 3: EXPLICIT-CONTINUATION EVALUATOR 


;;DESUGAR
;transform a scheme expression to one with a reduced set of special forms.
(define (desugar expr)
  (cond ((quoted? expr) expr)
	((let? expr) (desugar-let expr))
	((let*? expr) (desugar-let* expr))
	((and? expr) (desugar-and expr))
        ((assignment? expr)
	 (make-assignment (assignment-variable expr)
                          (desugar (assignment-value expr))))
	((definition? expr)
	 (make-define (definition-variable expr)
                      (desugar (definition-value expr))))
	((begin? expr)
	 (make-begin (map desugar (begin-actions expr))))
	((lambda? expr)
	 (make-lambda (lambda-parameters expr)
		      (map desugar (lambda-body expr))))
	((application? expr) (desugar-application expr))
	(else expr)))

(define (make-assignment var expr)
  (list 'set! var expr))
(define (make-define var expr)
    (list 'define var expr))
(define (make-begin seq)
  (cons 'begin seq))


;;DESUGAR-AND
;turn an and into ifs.  return false, or the last true value
(define (desugar-and expr)
  (let ((a-exprs (and-exprs expr)))
    (if (pair? a-exprs)
        (let ((first-expr (car a-exprs))
              (rest-exprs (cdr a-exprs)))
          (if (pair? rest-exprs)
              (make-if (desugar first-expr)
                       (desugar (make-and rest-exprs))
                       #f)
              (desugar first-expr)))
        #t)))

(define (and? expr) (tagged-list? expr 'and))
(define and-exprs cdr)
(define (make-and exprs) (cons 'and exprs))
(define (make-if pred conseq alt)
  (list 'if pred conseq alt))

;;DESUGAR-LET
(define (desugar-let expr)
  (let ((names (let-bound-variables expr))
        (values (map desugar (let-values expr)))
        (body (map desugar (let-body expr))))
    (make-application (make-lambda names body)
		      values)))

(define (let? expr) (tagged-list? expr 'let))
(define (let-bound-variables expr) (map first (second expr)))
(define (let-values expr) (map second (second expr)))
(define (let-body expr) (cddr expr)) ;differs from lecture--body may be a sequence
(define (make-let bindings body)
  (cons 'let (cons bindings body)))
(define (make-application rator rands)
  (cons rator rands))


;;DESUGAR-LET*
(define (desugar-let* expr)
  (define (top-level-let*->let lexpr)
    (let ((binds (let*-bindings lexpr))
	  (bod (let*-body lexpr)))
      (if (null? binds)
	  (make-let nil bod)
	  (make-let
	     (list (car binds))
	     (if (null? (cdr binds))
		 bod
		 (list (make-let* (cdr binds) bod)))))))
  (desugar-let (top-level-let*->let expr)))

(define (let*? expr) (tagged-list? expr 'let*))
(define (let*-bindings expr) (second expr))
(define (let*-body expr) (cddr expr))
(define (make-let* binds body)
  (cons 'let* (cons binds body)))


;;DESUGAR-APPLICATION
;desugar each piece of a combination
(define (desugar-application expr)
  (map desugar expr))

;prevent runaway printer cycles
;(set! *unparser-list-depth-limit* 10)
;(set! *unparser-list-breadth-limit* 20)