Clean variable and function lookup information with the compilation unit
authorDavid Vazquez <davazp@gmail.com>
Sat, 22 Dec 2012 14:19:03 +0000 (14:19 +0000)
committerDavid Vazquez <davazp@gmail.com>
Sat, 22 Dec 2012 14:19:03 +0000 (14:19 +0000)
lispstrack.lisp
test.lisp

index 5a0bd79..3da8058 100644 (file)
      (lookup-function-translation x fenv))))
 
 #+common-lisp
-(defmacro eval-when-compile (&body body)
+c(defmacro eval-when-compile (&body body)
   `(eval-when (:compile-toplevel :load-toplevel :execute)
      ,@body))
 
index a77545a..36ee4e4 100644 (file)
--- a/test.lisp
+++ b/test.lisp
@@ -66,6 +66,8 @@
 (defun truncate (x y) (floor (/ x y)))
 
 (defun cons (x y ) (cons x y))
+(defun consp (x) (consp x))
+
 (defun car (x) (car x))
 (defun caar (x) (car (car x)))
 (defun cadr (x) (car (cdr x)))
     (t
      (cons (car list) (remove x (cdr list))))))
 
+(defun remove-if (func list)
+  (cond
+    ((null list)
+     nil)
+    ((funcall func (car list))
+     (remove-if func (cdr list)))
+    (t
+     (cons (car list) (remove-if func (cdr list))))))
+
+(defun remove-if-not (func list)
+  (cond
+    ((null list)
+     nil)
+    ((funcall func (car list))
+     (cons (car list) (remove-if-not func (cdr list))))
+    (t
+     (remove-if-not func (cdr list)))))
+
 (defun digit-char-p (x)
   (if (and (<= #\0 x) (<= x #\9))
       (- x #\0)
 ;;; ----------------------------------------------------------
 
 (defmacro with-compilation-unit (&rest body)
-  `(prog1 (progn ,@body)
+  `(prog1
+       (progn
+         (setq *compilation-unit-checks* nil)
+         (setq *env* (remove-if-not #'binding-declared *env*))
+         (setq *fenv* (remove-if-not #'binding-declared *fenv*))
+         ,@body)
      (dolist (check *compilation-unit-checks*)
        (funcall check))
-     (setq *compilation-unit-checks* nil)))
+     ))
 
 (defun eval (x)
   (let ((code