(define (bind-variable var value env)
  (cons (cons (cons var value) (car env)) (cdr env)))

(define (extend-environment env)
  (cons '() env))

(define (lookup-variable-value var env)
  (if (null? env)
      (error "No binding for " var)
      (if (null? (car env))
	  (lookup-variable-value var (cdr env))
	  (if (eq? var (car (car (car env))))
	      (cdr (car (car env)))
	      (lookup-variable-value 
	       var 
	       (cons (cdr (car env)) (cdr env)))))))

(define (apply proc operand env)
  (if (eq? (car proc) 'primitive)
      ((car (cdr proc)) (force-eval operand env))
      (eval (car (cdr (cdr proc))) 
		 (bind-variable (car (car (cdr proc))) 
				operand (extend-environment env)))))

(define (force-eval expr env)
  (if (or (number? expr) 
	  (has-tag expr 'primitive))
      expr
      (if (has-tag expr 'thunk)
	  (force-eval (cadr expr) (caddr expr))
	  (if (symbol? expr) 
	      (force-eval (lookup-variable-value expr env) env)
	      (if (has-tag expr 'lambda)
		  (list 'procedure (car (cdr expr)) (car (cdr (cdr expr))))
		  (force-eval
		   (apply (force-eval (car expr) env) 
			  (make-thunk (car (cdr expr)) env) env)))))))


(define (has-tag s t)
  (and (list? s) (eq? (car s) t)))

(define (eval expr env)
  (if (or (number? expr) 
	  (has-tag expr 'primitive)
	  (has-tag expr 'thunk))
      expr
      (if (symbol? expr) 
	  (lookup-variable-value expr env)
	  (if (has-tag expr 'lambda)
	      (list 'procedure (car (cdr expr)) (car (cdr (cdr expr))))
	      (apply (force-eval (car expr) env)
		     (make-thunk (car (cdr expr)) env) env)))))


(define (make-thunk expr env)
  (list 'thunk expr env))

;;; These function save the trouble of passing around a global environment:

(define (nt x) (nt x))

(define global-env 
  (bind-variable 'minus (list 'primitive -) 
    (bind-variable 'nt (list 'primitive nt)
	'(()))))

(define (clear-global-environment)
  (set! global-env '(())))

(define (define-variable var value)
  (bind-variable var value global-env))

(define (geval expr)
  (force-eval (eval expr global-env) global-env))

(trace eval)
(trace apply)
(trace make-thunk)
(trace force-eval)