SETQ signals error if the first argument is not a symbol

[jscl.git] / src / compiler / compiler.lisp

diff --git a/src/compiler/compiler.lisp b/src/compiler/compiler.lisp
index 60860b3..d5f0b55 100644 (file)
--- 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)
@@ -406,12 +440,14 @@
 
 
 (defun setq-pair (var val)
+  (unless (symbolp var)
+    (error "~a is not a symbol" var))
   (let ((b (lookup-in-lexenv var *environment* 'variable)))
     (cond
       ((and b
-            (eq (binding-type b) 'variable)
-            (not (member 'special (binding-declarations b)))
-            (not (member 'constant (binding-declarations b))))
+           (eq (binding-type b) 'variable)
+           (not (member 'special (binding-declarations b)))
+           (not (member 'constant (binding-declarations b))))
        `(= ,(binding-value b) ,(convert val)))
       ((and b (eq (binding-type b) 'macro))
        (convert `(setf ,var ,val)))
@@ -1072,9 +1108,6 @@
         (throw (+ "Function `" (call |xstring| (get symbol "name")) "' is undefined.")))
     (return func)))
 
-(define-builtin symbol-plist (x)
-  `(or (get ,x "plist") ,(convert nil)))
-
 (define-builtin lambda-code (x)
   `(call |make_lisp_string| (method-call ,x "toString")))
 
@@ -1155,9 +1188,6 @@
 (define-builtin functionp (x)
   `(bool (=== (typeof ,x) "function")))
 
-(define-builtin %write-string (x)
-  `(method-call |lisp| "write" ,x))
-
 (define-builtin /debug (x)
   `(method-call |console| "log" (call |xstring| ,x)))
 
@@ -1355,18 +1385,20 @@
       ((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))
-      ((and (consp function) (eq (car function) 'lambda))
+      #+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))
        `(call |js_to_lisp|
               (call ,(reduce (lambda (obj p)
                                `(property ,obj (call |xstring| ,p)))
                              (mapcar #'convert (cdr function)))
                     ,@(mapcar (lambda (s)
-                                `(call |lisp_to_js| ,s))
+                                `(call |lisp_to_js| ,(convert s)))
                               args))))
       (t
        (error "Bad function descriptor")))))