aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/macro/template.lux
blob: ad160085600e731d8e8c4eec97d01ef7c76c8d58 (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
(.module:
  [lux #*
   [abstract
    ["." monad (#+ do)]]
   [control
    ["p" parser ("#@." functor)]]
   [data
    ["." bit ("#@." codec)]
    ["." text]
    [number
     ["." nat ("#@." decimal)]
     ["." int ("#@." decimal)]
     ["." rev ("#@." decimal)]
     ["." frac ("#@." decimal)]]
    [collection
     ["." list ("#@." monad)]]]]
  ["." //
   ["." code]
   ["s" syntax (#+ Syntax syntax:)]])

(syntax: #export (splice {parts (s.tuple (p.some s.any))})
  (wrap parts))

(syntax: #export (with-locals {locals (s.tuple (p.some s.local-identifier))}
                   body)
  (do @
    [g!locals (|> (//.gensym "local")
                  (list.repeat (list.size locals))
                  (monad.seq @))]
    (wrap (list (` (.with-expansions [(~+ (|> (list.zip2 locals g!locals)
                                              (list@map (function (_ [name identifier])
                                                          (list (code.local-identifier name) (as-is identifier))))
                                              list@join))]
                     (~ body)))))))

(def: snippet
  (Syntax Text)
  ($_ p.either
      s.text
      s.local-identifier
      s.local-tag
      (p@map bit@encode s.bit)
      (p@map nat@encode s.nat)
      (p@map int@encode s.int)
      (p@map rev@encode s.rev)
      (p@map frac@encode s.frac)
      ))

(def: part
  (Syntax (List Text))
  (s.tuple (p.many ..snippet)))

(syntax: #export (text {simple ..part})
  (wrap (list (|> simple (text.join-with "") code.text))))

(template [<name> <simple> <complex>]
  [(syntax: #export (<name> {simple ..part} {complex (p.maybe ..part)})
     (case complex
       #.None
       (wrap (list (|> simple (text.join-with "") <simple>)))
       
       (#.Some complex)
       (wrap (list (<complex> [(text.join-with "" simple)
                               (text.join-with "" complex)])))))]

  [identifier code.local-identifier code.identifier]
  [tag code.local-tag code.tag]
  )