blob: 5be8abeb702a82eb6501ff4a5c5ef0b6d86c9cd6 (
plain) (
blame)
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
|
(local _unpack (or table.unpack unpack))
(fn string? [x]
(= (type x) "string"))
(fn has-amp? [args]
(var res false)
(each [i s (ipairs args)]
(when (= (tostring s) "&")
(set res i)))
res)
(fn gen-arity [[args & body]]
(assert-compile (sequence? args) "fn* expects vector as it's parameter list.
Try wrapping arguments in square brackets." args)
(list (length args)
(list 'let [args ['...]] (_unpack body))
(has-amp? args)))
(fn arity-dispatcher [size fixed amp-body name]
(let [bodies []]
(each [i body (pairs (doto fixed))]
(table.insert bodies (list '= size i))
(table.insert bodies body))
(when amp-body
(let [[i body] amp-body]
(table.insert bodies (list '>= size (- i 1)))
(table.insert bodies body)))
(table.insert
bodies
(list 'error
(.. "wrong argument amount"
(if name (.. " for " name) "")) 3))
(list 'if (_unpack bodies))))
(fn fn* [name doc? ...]
(assert-compile (not (string? name)) "fn* expects symbol as function name" name)
(let [docstring (if (string? doc?) doc? nil)
fname (if (sym? name) (tostring name))
args (if (sym? name)
(if (string? doc?) [...] [doc? ...])
[name doc? ...])
[x] args
body (if (sequence? x)
;; Single-arity function
(let [[args & body] args
[arity body amp] (gen-arity [args (_unpack body)])]
`(let [len# (length [...])]
,(arity-dispatcher
'len#
(if amp {} {arity body})
(if amp [amp body])
fname)))
;; Multi-arity function
(list? x)
(let [bodies {}
amp-bodies {}]
(each [_ arity (ipairs args)]
(let [[n body amp] (gen-arity arity)]
(if amp
(do (table.insert amp-bodies amp)
(table.insert amp-bodies body)
(table.insert amp-bodies arity))
(tset bodies n body))))
(assert-compile (<= (length amp-bodies) 3)
"fn* must have only one arity with &:"
(. amp-bodies (length amp-bodies)))
`(let [len# (length [...])]
,(arity-dispatcher
'len#
bodies
(if (~= (next amp-bodies) nil)
amp-bodies)
fname)))
(assert-compile false "fn* expects vector as its arguments" x))]
(if (sym? name)
`(fn ,name [...] ,docstring ,body)
`(fn [...] ,docstring ,body))))
{: fn*}
;; (import-macros {: fn*} :fn)
;; (fn* f ([a] a) ([a b] (+ a b)))
|