+(defun binding-name (b) (first b))
+(defun binding-type (b) (second b))
+(defun binding-translation (b) (third b))
+(defun binding-declared (b)
+ (and b (fourth b)))
+(defun mark-binding-as-declared (b)
+ (setcar (cdddr b) t))
+
+(let ((counter 0))
+ (defun gvarname (symbol)
+ (concat "v" (integer-to-string (incf counter))))
+
+ (defun lookup-variable (symbol env)
+ (or (assoc symbol env)
+ (assoc symbol *env*)
+ (let ((name (symbol-name symbol))
+ (binding (make-binding symbol 'variable (gvarname symbol) nil)))
+ (push binding *env*)
+ (push (lambda ()
+ (unless (binding-declared (assoc symbol *env*))
+ (error (concat "Undefined variable `" name "'"))))
+ *compilation-unit-checks*)
+ binding)))
+
+ (defun lookup-variable-translation (symbol env)
+ (binding-translation (lookup-variable symbol env)))
+
+ (defun extend-local-env (args env)
+ (append (mapcar (lambda (symbol)
+ (make-binding symbol 'variable (gvarname symbol) t))
+ args)
+ env)))
+
+(let ((counter 0))
+ (defun lookup-function (symbol env)
+ (or (assoc symbol env)
+ (assoc symbol *fenv*)
+ (let ((name (symbol-name symbol))
+ (binding
+ (make-binding symbol
+ 'function
+ (concat "f" (integer-to-string (incf counter)))
+ nil)))
+ (push binding *fenv*)
+ (push (lambda ()
+ (unless (binding-declared (assoc symbol *fenv*))
+ (error (concat "Undefined function `" name "'"))))
+ *compilation-unit-checks*)
+ binding)))
+
+ (defun lookup-function-translation (symbol env)
+ (binding-translation (lookup-function symbol env))))
+
+
+(defvar *toplevel-compilations* nil)