summaryrefslogtreecommitdiff
path: root/macros/core.fnl
blob: deb363ac1ad8047f6940675a78449af3d4debf8d (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
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
(import-macros {: fn*} :macros.fn)
(local _unpack (or table.unpack unpack))
(local insert table.insert)

(fn check-bindings [bindings]
  (and (assert-compile (sequence? bindings) "expected binding table" [])
       (assert-compile (= (length bindings) 2) "expected exactly two forms in binding vector." bindings)))

(fn* if-let
  ([bindings then]
   (if-let bindings then 'nil))
  ([bindings then else]
   (check-bindings bindings)
   (let [[form test] bindings]
     `(let [tmp# ,test]
        (if tmp#
            (let [,form tmp#]
              ,then)
            ,else)))))

(fn* when-let
  [bindings & body]
  (check-bindings bindings)
  (let [[form test] bindings]
    `(let [tmp# ,test]
       (if tmp#
           (let [,form tmp#]
             ,(_unpack body))))))

(fn* if-some
  ([bindings then]
   (if-some bindings then 'nil))
  ([bindings then else]
   (check-bindings bindings)
   (let [[form test] bindings]
     `(let [tmp# ,test]
        (if (= tmp# nil)
            ,else
            (let [,form tmp#]
              ,then))))))

(fn* when-some
  [bindings & body]
  (check-bindings bindings)
  (let [[form test] bindings]
    `(let [tmp# ,test]
       (if (= tmp# nil)
           nil
           (let [,form tmp#]
             ,(_unpack body))))))


;; based on `seq' from `core.fnl'
(fn into [to from]
  (if (sequence? to)
      `(let [to# ,to
             from# ,from
             insert# table.insert
             unpack# (or table.unpack unpack)
             res# []]
         (var assoc# false)
         (each [k# v# (pairs from#)]
           (if (and (not assoc#)
                    (not (= (type k#) "number")))
               (set assoc# true))
           (insert# res# [k# v#]))
         (let [res# (if assoc# res# from#)]
           (if (~= (next to#) nil)
               (do (when (~= (next res#) nil)
                     (each [_# v# (ipairs res#)]
                       (insert# to# v#)))
                   to#)
               res#)))
      ;; to support (into {} {}) we first need transform `from' into a
      ;; sequential table.  Unfortunately it seems impossible to do
      ;; this with `(into [] ,from)' call, as it results in infinity
      ;; compilation loop.  Because of that the body of previous
      ;; branch is repeated here almost entirely, although without
      ;; some extra checks, as these aren't necessary in this case.
      (table? to)
      `(let [to# ,to
             from# (let [from# ,from
                         insert# table.insert
                         unpack# (or table.unpack unpack)
                         res# []]
                     (var assoc# false)
                     (each [k# v# (pairs from#)]
                       (if (and (not assoc#)
                                (not (= (type k#) "number")))
                           (set assoc# true))
                       (insert# res# [k# v#]))
                     (if assoc# res# from#))]
         (each [_# [k# v#] (ipairs from#)]
           (tset to# k# v#))
         to#)
      `(error "expected table as the first argument" 2)))

{: if-let
 : when-let
 : if-some
 : when-some
 : into}