From cb758983d9f583b913a6cf925a036f1f0e22c902 Mon Sep 17 00:00:00 2001 From: David Vazquez Date: Sat, 22 Dec 2012 14:19:03 +0000 Subject: [PATCH] Clean variable and function lookup information with the compilation unit --- lispstrack.lisp | 2 +- test.lisp | 29 +++++++++++++++++++++++++++-- 2 files changed, 28 insertions(+), 3 deletions(-) diff --git a/lispstrack.lisp b/lispstrack.lisp index 5a0bd79..3da8058 100644 --- a/lispstrack.lisp +++ b/lispstrack.lisp @@ -408,7 +408,7 @@ (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)) diff --git a/test.lisp b/test.lisp index a77545a..36ee4e4 100644 --- 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))) @@ -276,6 +278,24 @@ (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) @@ -1015,10 +1035,15 @@ ;;; ---------------------------------------------------------- (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 -- 1.7.10.4