1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
;;;
;;; 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.
;;;
;;; 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.)
;;;
;;; 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 candidate
;;; expression, then the value of that expression is "it".
;;;
;;; 6. Otherwise if op has no candidate arguments, then the leftmost
;;; one is "it".
;;;
(defmacro kif (test then &optional 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
;;;
(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)
|
