KIF: symbols may not be "it" candidates.

1 files changed, 26 insertions, 21 deletions

diff --git a/kif.lisp b/kif.lisp
index c36ddfe..a28379a 100644
--- a/kif.lisp
+++ b/kif.lisp
@@ -34,40 +34,45 @@
 ;;;      the whole thing is transformed to (kif X else then)
 ;;;      and processed recursively.
 ;;;
-;;;   test must be of the form (op {arg}+)
+;;;   Otherwise test must be of the form (op {arg}+)
 ;;;
 ;;;   3. If op is not a global function, then error, because it
 ;;;      is probably an operator. (Or a local function, but we don't
 ;;;      have the environment access at macro time to delve into that,
-;;       code walking is needed.)
+;;;      code walking is needed.)
 ;;;
-;;;   4. If op has more than one argument which is a non-constant
+;;;   Define a"candidate expression" be one that is neither a constant
+;;;   nor a symbol.
+;;;
+;;;   4. If op has more than one argument which is a candidate
 ;;;      expression, then an ambiguous situation results: error.
 ;;;
-;;;   5. If op has exactly one argument which is a non-constant
+;;;   5. If op has exactly one argument which is candidate
 ;;;      expression, then the value of that expression is "it".
 ;;;
-;;;   6. Otherwise if op has only constant arguments, then the leftmost
+;;;   6. Otherwise if op has no candidate arguments, then the leftmost
 ;;;      one is "it".
 ;;;
 
 (defmacro kif (test then &optional else)
-  (cond
-    ((or (atom test) (null (cdr test))) `(let ((it ,test))
-                                           (if it ,then ,else)))
-    ((member (first test) '(not null)) `(kif ,(second test) ,else ,then))
-    (t (let* ((sym (first test))
-              (args (rest test))
-              (n-var-args (count-if-not #'constantp args))
-              (pos-var-arg (or (position-if-not #'constantp args) 0)))
-         (unless (fboundp sym)
-           (error "kif: only works with global functions."))
-         (when (> n-var-args 1)
-           (error "kif: ambiguous situation: not clear what can be \"it\"."))
-         (let* ((temps (loop for x in args collecting (gensym)))
-                (it-temp (nth pos-var-arg temps)))
-           `(let* (,@(mapcar #'list temps args) (it ,it-temp))
-              (if (,sym ,@temps) ,then ,else)))))))
+  (flet ((candidate-p (expr)
+           (not (or (constantp expr) (symbolp expr)))))
+    (cond
+      ((or (atom test) (null (cdr test))) `(let ((it ,test))
+                                             (if it ,then ,else)))
+      ((member (first test) '(not null)) `(kif ,(second test) ,else ,then))
+      (t (let* ((sym (first test))
+                (args (rest test))
+                (n-candidate-args (count-if #'candidate-p args))
+                (pos-candidate (or (position-if #'candidate-p args) 0)))
+           (unless (fboundp sym)
+             (error "kif: only works with global functions."))
+           (when (> n-candidate-args 1)
+             (error "kif: ambiguous situation: not clear what can be \"it\"."))
+           (let* ((temps (loop for x in args collecting (gensym)))
+                  (it-temp (nth pos-candidate temps)))
+             `(let* (,@(mapcar #'list temps args) (it ,it-temp))
+                (if (,sym ,@temps) ,then ,else))))))))
 
 ;;;
 ;;; Test cases