blob: e656eadcc576b50632e64323a9a1b62f726ca940 (
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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
(compile-only
(defstruct param-parser-base nil
syntax form
rest req opt key
nreq nopt nfix
(:postinit (me)
(let* ((rest (nthlast 0 me.syntax))
(fixed (ldiff me.syntax rest))
nonkey key)
(cond
(me.mac-param-p
(while fixed
(let ((pp (pop fixed)))
(caseq pp
((:env :whole :form)
(unless fixed
(compile-error me.form "~s requires argument" pp))
(push (cons pp (pop fixed)) key))
(t (push pp nonkey)))))
(set nonkey (nreverse nonkey)
key (nreverse key)))
(t (set nonkey fixed)))
(tree-bind (: rp opt) (split* nonkey (op where (op eq :)))
(set me.rest rest
me.req rp
me.opt (mapcar [iffi atom list] opt)
me.key key
me.nreq (len rp)
me.nopt (len opt)
me.nfix (+ me.nreq me.nopt)))))
(:method opt-syms (me)
(build
(each ((o me.opt))
(caseql (len o)
((1 2) (add (car o)))
(3 (add (car o) (caddr o))))))))
(defstruct (fun-param-parser syntax form) param-parser-base
(mac-param-p nil))
(defstruct (mac-param-parser syntax form) param-parser-base
(mac-param-p t)))
|