(define (eval* exp env)
  @("Evaluates an expression lazily, given an environment."
    (exp "The expression to evaluate")
    (env "The environment to evaluate it in")
    (@to "object"))
  (cond ((self-evaluating? exp) exp)
        ((variable? exp) (lookup-variable-value exp env))
        ((quoted? exp) (text-of-quotation exp))
        ((assignment? exp) (eval-assignment exp env))
        ((definition? exp) (eval-definition exp env))
        ((if? exp) (eval-if exp env))
        ((lambda? exp) (make-procedure (lambda-parameters exp)
                                  (lambda-body exp)
                                  env))
        ((begin? exp)
         (eval-sequence (begin-actions exp) env))
        ((cond? exp) (eval* (cond->if exp) env))
        ((application? exp)
         (apply* (actual-value (operator exp) env)
                      (operands exp)
                      env))
        (else
         (error "Unknown expression type: EVAL*" exp))))

(define (actual-value exp env)
  (force-it (eval* exp env)))

(define (apply* procedure arguments env)
  (cond ((primitive-procedure? procedure)
         (apply-primitive-procedure
          procedure
          (list-of-arg-values arguments env)))
        ((compound-procedure? procedure)
         (eval-sequence
          (procedure-body procedure)
          (extend-environment
           (procedure-parameters procedure)
           (list-of-delayed-args arguments env)
           (procedure-environment procedure))))
        (else (error "Unknown procedure type: APPLY*"
                     procedure))))

(define (list-of-arg-values exps env)
  (if (no-operands? exps)
      '()
      (cons (actual-value (first-operand exps) env)
            (list-of-arg-values (rest-operands exps) env))))

(define (list-of-delayed-args exps env)
  (if (no-operands? exps)
      '()
      (cons (delay-it (first-operand exps) env)
            (list-of-delayed-args (rest-operands exps) env))))

(define (eval-if exp env)
  (if (true? (actual-value (if-predicate exp) env))
      (eval* (if-consequent exp) env)
      (eval* (if-alternative exp) env)))

(define input-prompt ";;; L-Eval input:")

(define output-prompt ";;; L-Eval value:")

(define (driver-loop)
  (prompt-for-input input-prompt)
  (let ((input (read)))
    (let ((output (actual-value input the-global-environment)))
      (announce-output output-prompt)
      (user-print output)))
  (driver-loop))

(define (delay-it exp env)
  (list 'thunk exp env))

(define (thunk? obj)
  (tagged-list? obj 'thunk))

(define (thunk-exp thunk) (cadr thunk))

(define (thunk-env thunk) (caddr thunk))

(define (evaluated-thunk? obj)
  (tagged-list? obj 'evaluated-thunk))

(define (thunk-value evaluated-thunk)
  (cadr evaluated-thunk))

(define (force-it obj)
  (cond ((thunk? obj)
         (let ((result (actual-value (thunk-exp obj)
                                     (thunk-env obj))))
           (set-car! obj 'evaluated-thunk)
           (set-car! (cdr obj) result)
           (set-cdr! (cdr obj) '())
           result))
        ((evaluated-thunk? obj) (thunk-value obj))
        (else obj)))

(define (with-lazy-lists procedures receive-env)
  @("Sets up an environment where lazy {{cons}}, {{car}} and {{cdr}}
have been defined."
    "{{With-lazy-lists}} is a wrapper around {{with-primitive-procedures}}."
    (procedures "A key-value list of names and their primitive
procedures in the underlying Scheme.")
    (receive-env "A lambda of one value that takes the prepared
environment")
    (@to "object"))  
  (with-primitive-procedures (append procedures `((= ,=) (- ,-)))
    (lambda (env)
      (eval* '(define (cons x y) (lambda (m) (m x y))) env)
      (eval* '(define (car z) (z (lambda (p q) p))) env)
      (eval* '(define (cdr z) (z (lambda (p q) q))) env)
      (eval* '(define (list-ref items n)
                (if (= n 0)
                    (car items)
                    (list-ref (cdr items) (- n 1))))
             env)
      (eval* '(define (map proc items)
                (if (null? items)
                    '()
                    (cons (proc (car items)) (map proc (cdr items)))))
             env)
      (receive-env env))))