From ebe7c315e2527ae59ce5544c4d117ead4dd04ff3 Mon Sep 17 00:00:00 2001 From: =?utf8?q?David=20V=C3=A1zquez?= Date: Fri, 21 Feb 2014 17:49:32 +0100 Subject: [PATCH] DEBUG: Basic compiler undefined function warning --- jscl.lisp | 11 ++++++++--- src/boot.lisp | 2 ++ src/compiler/compiler.lisp | 40 ++++++++++++++++++++++++++++++++++++++-- 3 files changed, 48 insertions(+), 5 deletions(-) diff --git a/jscl.lisp b/jscl.lisp index e21ab3d..b812e7b 100644 --- a/jscl.lisp +++ b/jscl.lisp @@ -160,17 +160,22 @@ (setq *variable-counter* 0 *gensym-counter* 0 *literal-counter* 0) - (with-open-file (out (merge-pathnames "jscl.js" *base-directory*) :direction :output :if-exists :supersede) + (with-open-file (out (merge-pathnames "jscl.js" *base-directory*) + :direction :output + :if-exists :supersede) (write-string (read-whole-file (source-pathname "prelude.js")) out) (do-source input :target (!compile-file input out)) (dump-global-environment out)) ;; Tests - (with-open-file (out (merge-pathnames "tests.js" *base-directory*) :direction :output :if-exists :supersede) + (with-open-file (out (merge-pathnames "tests.js" *base-directory*) + :direction :output + :if-exists :supersede) (dolist (input (append (directory "tests.lisp") (directory "tests/*.lisp") (directory "tests-report.lisp"))) - (!compile-file input out))))) + (!compile-file input out))) + (report-undefined-functions))) ;;; Run the tests in the host Lisp implementation. It is a quick way diff --git a/src/boot.lisp b/src/boot.lisp index ce61f98..4a435bd 100644 --- a/src/boot.lisp +++ b/src/boot.lisp @@ -78,6 +78,8 @@ (defmacro defun (name args &rest body) `(progn + (eval-when (:compile-toplevel) + (fn-info ',name :defined t)) (fset ',name #'(named-lambda ,name ,args ,@body)) ',name)) diff --git a/src/compiler/compiler.lisp b/src/compiler/compiler.lisp index d2b6975..a19b51d 100644 --- a/src/compiler/compiler.lisp +++ b/src/compiler/compiler.lisp @@ -154,6 +154,40 @@ `(%define-symbol-macro ',name ',expansion)) + +;;; Report functions which are called but not defined + +(defvar *fn-info* '()) + +(def!struct fn-info + symbol + defined + called) + +(defun find-fn-info (symbol) + (let ((entry (find symbol *fn-info* :key #'fn-info-symbol))) + (unless entry + (setq entry (make-fn-info :symbol symbol)) + (push entry *fn-info*)) + entry)) + +(defun fn-info (symbol &key defined called) + (let ((info (find-fn-info symbol))) + (when defined + (setf (fn-info-defined info) defined)) + (when called + (setf (fn-info-called info) called)))) + +(defun report-undefined-functions () + (dolist (info *fn-info*) + (let ((symbol (fn-info-symbol info))) + (when (and (fn-info-called info) + (not (fn-info-defined info))) + (warn "The function `~a' is undefined.~%" symbol)))) + (setq *fn-info* nil)) + + + ;;; Special forms (defvar *compilations* nil) @@ -1349,9 +1383,11 @@ ((and (symbolp function) #+jscl (eq (symbol-package function) (find-package "COMMON-LISP")) #-jscl t) + (fn-info function :called t) `(method-call ,(convert `',function) "fvalue" ,@arglist)) - #+jscl((symbolp function) - `(call ,(convert `#',function) ,@arglist)) + #+jscl + ((symbolp function) + `(call ,(convert `#',function) ,@arglist)) ((and (consp function) (eq (car function) 'lambda)) `(call ,(convert `(function ,function)) ,@arglist)) ((and (consp function) (eq (car function) 'oget)) -- 1.7.10.4