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
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
;;;
;;; 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".
;;;
(eval-when (:compile-toplevel :load-toplevel :execute)
;;
;; Macro helper: performs steps 3 through 6 of the above
;; description, returning several values:
;; - a list of temporary symbols (gensyms)
;; - a list of forms which can be used to initialize these
;; symbols in a let-like construct
;; - an expression equivalent to expr, but which requires
;; the above bindings to be established.
;; - a symbol, which one of the gensyms in the first returned value.
;; If this symbol is bound to its init form, that symbols's
;; value then is the anaphoric value which can be bound to the "it"
;; variable.
;;
(defun anaphorize (construct expr env)
(flet ((candidate-p (expr)
(not (or (constantp expr env) (symbolp expr)))))
(let* ((sym (first expr))
(args (rest expr))
(n-candidate-args (count-if #'candidate-p args))
(pos-candidate (or (position-if #'candidate-p args) 0)))
(unless (fboundp sym)
(error "~a: only works with global functions." construct))
(when (> n-candidate-args 1)
(error "~a ambiguous situation: not clear what can be \"it\"."
construct))
(let* ((temps (loop for x in args collecting (gensym)))
(it-temp (nth pos-candidate temps)))
(values temps args `(,sym ,@temps) it-temp))))))
(defmacro kif (test then &optional else &environment env)
(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 (multiple-value-bind (temps args form it-temp)
(anaphorize 'kif test env)
`(let* (,@(mapcar #'list temps args) (it ,it-temp))
(if ,form ,then ,else))))))
(defmacro kwhile (test &rest forms)
(let ((label (gensym "again-")))
`(block nil
(tagbody ,label
(kif ,test (progn ,@forms (go ,label) (return nil)))))))
;;;
;;; 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)
|
