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
|
(defmacro ifa (:env e test then : else)
(flet ((candidate-p (expr)
(not (or (constantp expr e) (symbolp expr)))))
(cond
((or (atom test) (null (cdr test))) ^(let ((it ,test))
(if it ,then ,else)))
((member (first test) '(not null false))
(unless (eql (length test) 2)
(throwf 'eval-error "ifa: wrong number of arguments to ~s"
(first test)))
^(ifa ,(second test) ,else ,then))
(t (let* ((sym (first test))
(args (rest test))
(n-candidate-args [count-if candidate-p args])
(pos-candidate (or [pos-if candidate-p args] 0)))
(unless (or (lexical-fun-p e sym)
(and (or (functionp (symbol-function sym))
(null (symbol-function sym)))))
(throwf 'eval-error "ifa: test expression must be \
\ a simple function call"))
(when (> n-candidate-args 1)
(throwf 'eval-error "ifa: ambiguous situation: \
\ not clear what can be \"it\""))
(let* ((temps (mapcar (ret (gensym)) args))
(it-temp [temps pos-candidate]))
^(let* (,*(zip temps args) (it ,it-temp))
(if (,sym ,*temps) ,then ,else))))))))
(defmacro conda (. pairs)
(tree-case pairs
(((test . forms) . rest) ^(ifa ,test (progn ,*forms)
(conda ,*rest)))
(() ())
(else (throwf 'eval-error "conda: bad syntax: ~s" pairs))))
|