summaryrefslogtreecommitdiff
path: root/fn.fnl
blob: e9378780322e89ab987a8d2d3e2c4b39038749a8 (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
(fn string? [x]
  (= (type x) "string"))

(fn has-amp? [args]
  (var res false)
  (each [_ s (ipairs args)]
    (when (= (tostring s) "&")
      (set res true)))
  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)
  (let [arg-length (if (has-amp? args) (sym "_") (length args))
        body (list 'let [args [(sym "...")]] (unpack body))]
    (list arg-length body)))

(fn fn* [name doc? ...]
  (assert-compile (not (string? name)) "fn* expects symbol as function name" name)
  (let [docstring (if (string? doc?) doc? nil)
        args (if (sym? name)
                 (if (string? doc?) [...] [doc? ...])
                 [name doc? ...])
        [x & xs] args]
    (if (sequence? x)
        ;; Ordinary function
        (let [[args & body] args]
          (if (sym? name)
              `(fn ,name ,args ,docstring ,(unpack body))
              `(fn ,args ,docstring ,(unpack body))))
        ;; Multi-arity function
        (list? x)
        (let [bodies []]
          (each [_ arity (ipairs args)]
            (let [[arity body] (gen-arity arity)]
              (table.insert bodies arity)
              (table.insert bodies body)))
          `(fn ,name [...] ,docstring (match (length [...]) ,(unpack bodies)))))))

{: fn*}

;; (import-macros {: fn*} :fn) (macrodebug (fn* f ([a] a)))