KIF: more anaphoric than AIF.

1 files changed, 120 insertions, 0 deletions

diff --git a/kif.lisp b/kif.lisp
new file mode 100644
index 0000000..c36ddfe
--- /dev/null
+++ b/kif.lisp
@@ -0,0 +1,120 @@
+;;;
+;;; KIF: Kaz Kylheku's response to Paul Graham's "anaphoric if" macro.
+;;; January 2015
+;;;
+
+;;;
+;;; Consider the sentence: "If the square of x exceeds 25,
+;;; then double it, otherwise halve it". Most English speakers
+;;; will identify "it" either with x, or with "the square of x".
+;;; Those who are intelligent will note that there is no need for "it"
+;;; for the variable "x", since it can always be referred to as "x" without
+;;; a pronoun.
+;;;
+;;; Paul Grapham's silly identifies "it" with the main boolean
+;;; conditional "greater than" itself, which is not very often useful,
+;;; and also doesn't correspond with linguistic intuition regarding
+;;; anaphoric pronouns!
+;;;
+;;; A proper anaphoric if macro must work harder: it must analyze
+;;; the syntax of the test expression, and intelligently bind "it"
+;;; to an interesting constituent, rather than to the expression itself.
+;;;
+;;; KIF is a proposal in this direction. It could be smarter and have
+;;; more features.
+;;;
+;;; Kif works like this:
+;;;
+;;; (kif test then [ else ])
+;;;
+;;;   1. If test is an atom, or an operator with no arguments,
+;;;      then the value of test is "it": (let ((it test)) (if it then else))
+;;;
+;;;   2. If test matches the pattern (not X) or (null X)
+;;;      the whole thing is transformed to (kif X else then)
+;;;      and processed recursively.
+;;;
+;;;   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.)
+;;;
+;;;   4. If op has more than one argument which is a non-constant
+;;;      expression, then an ambiguous situation results: error.
+;;;
+;;;   5. If op has exactly one argument which is a non-constant
+;;;      expression, then the value of that expression is "it".
+;;;
+;;;   6. Otherwise if op has only constant 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)))))))
+
+;;;
+;;; Test cases
+;;;
+
+(defmacro error-to-sym (expr)
+  `(handler-case ,expr
+     (error (cond) :error)))
+
+;; test framework for KIF uses KIF!
+(defmacro test (&environment env expr expected)
+  (handler-case
+    (let ((expr-expn (macroexpand expr env)))
+      `(kif (not (equal (error-to-sym ,expr-expn) ',expected))
+         (error "test case ~s failed: produced ~s; expected ~s"
+                ',expr it ',expected)))
+    (error (cond)
+      (unless (eq expected :error)
+        (error "test case ~s failed to expand: expected is ~s" expr expected)))))
+
+;; "it" is (+ 2 2)
+(test (kif (> (+ 2 2) 0) (* it 2))
+      8)
+
+;; "it" is (* x x)
+(test (let ((x 7))
+        (kif (>= (* x x) 49)
+          (sqrt it)))
+      7)
+
+;; "it" is (* x x)
+(test (let ((x 7))
+        (kif (>= (* x x) 49)
+          (sqrt it)))
+      7)
+
+;; ambiguous: is "it" x or is "it" y?
+(test (kif (> x y) (print it)) :error)
+
+;; "it" is (+ 3 (* 2 x))
+(test (let ((x 5))
+        (kif (< 0 (+ 3 (* 2 x)) 20) (* 100 it)))
+      1300)
+
+;; "it" is (length '(a b c d))
+;; Intuition: it" could also be '(a b c d)
+;; TODO: deal specially with chains of unary functions.
+;; How about it = (length ...), itt = '(a b c d)
+(test (kif (not (oddp (length '(a b c d)))) it)
+      4)