blob: ad5cb0b9eb907a3a454f2fee65732b788a20f3ab (
plain)
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
|
(defun sys:handle-bad-syntax (item)
(throwf 'eval-error "~s: bad clause syntax: ~s" 'handle item))
(defmacro handle (:whole form try-form . handle-clauses)
(let* ((exc-sym (gensym))
(exc-args (gensym))
(syms-fragments (collect-each ((hc handle-clauses))
(tree-case hc
((name arglist . body)
(unless (symbolp name)
(sys:handle-bad-syntax hc))
(list name ^(apply (lambda ,arglist ,*body)
,exc-sym ,exc-args)))
(else (sys:handle-bad-syntax hc))))))
^(handler-bind (lambda (,exc-sym . ,exc-args)
(cond
,*(mapcar (aret ^((exception-subtype-p ,exc-sym ',@1) ,@2))
syms-fragments)))
,[mapcar car syms-fragments]
,try-form)))
|