From 0af2b4f3f88b940834efb611197c5662035e21b8 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Wed, 21 Jan 2015 08:15:24 -0800 Subject: KIF: symbols may not be "it" candidates. --- kif.lisp | 47 ++++++++++++++++++++++++++--------------------- 1 file 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 -- cgit v1.2.3