;;;; Interpreter with lazy evaluation.

;;; Produces (lambda (env) ...)
(define (analyze exp)
  (cond ((self-evaluating? exp) (analyze-self-evaluating exp))
        ((variable? exp) (analyze-variable exp))
        ((quoted? exp) (analyze-quoted exp))
        ((assignment? exp) (analyze-assignment exp))
        ((definition? exp) (analyze-definition exp))
        ((if? exp) (analyze-if exp))
        ((lambda? exp) (analyze-lambda exp))
        ((begin? exp) (analyze-sequence (begin-actions exp)))
        ((cond? exp) (analyze (COND->IF exp)))
        ((let? exp) (analyze (LET->combination exp)))
        ((application? exp) (analyze-application exp))
        (else
         (error "Unknown expression type -- ANALYZE" exp))))

(define (analyze-self-evaluating exp)
  (lambda (env) exp))

(define (analyze-quoted exp)
  (let ((qval (text-of-quotation exp)))
    (lambda (env) qval)))

(define (analyze-variable exp)
  (lambda (env)
    (lookup-variable-value exp env)))

(define (analyze-assignment exp)
  (let ((var (assignment-variable exp))
        (vproc (analyze (assignment-value exp))))
    (lambda (env)
      (set-variable-value! var (vproc env) env))))

(define (analyze-definition exp)
  (let ((var (definition-variable exp))
        (vproc (analyze (definition-value exp))))
    (lambda (env)
      (define-variable! var (vproc env) env))))

(define (analyze-lambda exp)
  (let ((vars (lambda-parameters exp))
        (bproc (analyze-sequence (lambda-body exp))))
    (if (exists declaration? vars)
        (lambda (env)
          (make-procedure-with-declarations vars bproc env))
        (lambda (env)
          (make-procedure vars bproc env)))))

(define (analyze-if exp)
  (let ((pproc (analyze (if-predicate exp)))
        (cproc (analyze (if-consequent exp)))
        (aproc (analyze (if-alternative exp))))
    (lambda (env)
      (if (force-it (pproc env))
          (cproc env)
          (aproc env)))))

(define (analyze-sequence exps)
  (define (sequentially a b)
    (lambda (x) (a x) (b x)))
  (let ((procs (map analyze exps)))
    (define (loop first rest)
      (if (null? rest)
          first
          (loop (sequentially first (car rest))
                (cdr rest))))
    (if (null? procs)
        (error
         "BEGIN requires subexpressions -- ANALYZE" exps))
    (loop (car procs) (cdr procs))))

(define (analyze-application exp)
  (let ((fproc (analyze (operator exp)))
        (aprocs (map analyze (operands exp))))
    (lambda (env)
      (exapply (force-it (fproc env)) aprocs env))))

(define (exapply proc aprocs env)
  (cond ((primitive-procedure? proc)
	 (apply-primitive-procedure proc
				    (force-all-args aprocs env)))
	((compound-procedure? proc)
	 ((procedure-body proc)
	  (extend-environment (procedure-parameters proc)
			      (force-all-args aprocs env)
			      (procedure-environment proc))))
	((procedure-with-declarations? proc)
	 (let ((params (procedure-parameters proc)))
	   ((procedure-body proc)
	    (extend-environment (map parameter-name params)
				(process-args params aprocs env)
				(procedure-environment proc)))))
	(else
	 (error "Unknown procedure type -- RTAPPLY"
		proc))))

(define (force-all-args aprocs env)
  (map (lambda (aproc) (force-it (aproc env)))
       aprocs))

(define (process-args params aprocs env)
  (map (lambda (param aproc)
         (cond ((variable? param) (aproc env))
               ((lazy? param) (delay-it aproc env))
               ((memo? param) (delay-it-memo aproc env))
               (else (error "Unknown declaration" param))))
       params
       aprocs))

;;; Delayed evaluation structures

(define (delay-it proc env)
  (cons 'lazythunk
        (lambda () (proc env))))

(define *unforced* (list '*unforced*))

(define (delay-it-memo proc env)
  (let ((value *unforced*))
    (cons 'lazythunk
          (lambda ()
            (if (eq? value *unforced*)
                (begin (set! value (proc env))
                       (set! proc '())
                       (set! env '())))
            value))))

(define (force-it obj)
  (if (and (pair? obj) (eq? (car obj) 'lazythunk))
      (force-it ((cdr obj)))
      obj))


;;; Initialization and driver loop
;;; The prompt is handled a bit differently than in the notes

(define (driver-loop)
  (newline)
  (let ((result
	 (mini-eval
	  (prompt-for-command-expression "L-EVAL=> ")
	  the-global-environment)))
    (newline)
    (display ";;L-value: ")
    (write (force-it result))
    (driver-loop)))

(define (mini-eval exp env)
  ((analyze exp) env))


(define the-global-environment)

;;; The environment is set up here to hook into Scheme along the lines
;;; of exercise 4.11.  The Scheme variable cache is an optimization
;;; (look at the implementation of lookup-variable-value in EVDATA.SCM)

(define (init)
  (set! the-global-environment
	(extend-environment '() '() the-empty-environment))
  (set! scheme-variable-cache '())
  (driver-loop))