aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/meta/macro/template.lux
blob: d2952d2681c550572f17a6ae8de5c3197a534c38 (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
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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
(.require
 [library
  [lux (.except)
   ["_" test (.only Test)]
   [abstract
    [monad (.only do)]]
   [control
    ["[0]" try]
    ["[0]" exception]]
   [data
    [collection
     ["[0]" list]]]
   [math
    ["[0]" random (.only Random)]
    [number
     ["[0]" nat]]]
   [meta
    ["[0]" code (.only)
     ["<[1]>" \\parser]]
    ["[0]" macro (.only)
     [syntax (.only syntax)]]]]]
 [\\library
  ["[0]" /]])

(/.let [(!pow/2 <scalar>)
        [(nat.* <scalar> <scalar>)]]
  (def pow/2
    (-> Nat Nat)
    (|>> !pow/2)))

(def macro_error
  (syntax (_ [macro <code>.any])
    (function (_ compiler)
      (case ((macro.expansion macro) compiler)
        {try.#Failure error}
        {try.#Success [compiler (list (code.text error))]}
        
        {try.#Success _}
        {try.#Failure "OOPS!"}))))

(def .public test
  Test
  (<| (_.covering /._)
      (do [! random.monad]
        [left random.nat
         mid random.nat
         right random.nat]
        (with_expansions [<module> (these [.5 -4 +3 2 #1 #0 c b "a"])
                          <module>' ".5-4+32#1#0cba"
                          <short> (these ["a" b c #0 #1 2 +3 -4 .5])
                          <short>' "abc#0#12+3-4.5"]
          (all _.and
               (_.coverage [/.spliced]
                 (at (list.equivalence nat.equivalence) =
                     (list left mid right)
                     (`` (list (,, (/.spliced [left mid right]))))))
               (_.coverage [/.amount]
                 (case (/.amount [left mid right])
                   3 true
                   _ false))
               (_.coverage [/.text]
                 (case (/.text <short>)
                   <short>' true
                   _ false))
               (_.coverage [/.symbol]
                 (and (case (`` (symbol (,, (/.symbol <short>))))
                        ["" <short>'] true
                        _ false)
                      (case (`` (symbol (,, (/.symbol <module> <short>))))
                        [<module>' <short>'] true
                        _ false)
                      ))
               (_.coverage [/.with_locals]
                 (/.with_locals [var0 var1]
                   (let [var0 left
                         var1 right]
                     (and (nat.= left var0)
                          (nat.= right var1)))))
               (do !
                 [scalar random.nat]
                 (_.coverage [/.let]
                   (let [can_use_with_statements!
                         (nat.= (all nat.* scalar scalar)
                                (..pow/2 scalar))]
                     (and can_use_with_statements!
                          (/.let [(pow/3 <scalar>)
                                  [(all nat.* <scalar> <scalar> <scalar>)]

                                  (pow/9 <scalar>)
                                  [(pow/3 (pow/3 <scalar>))]]
                            (let [can_use_with_expressions!
                                  (nat.= (all nat.* scalar scalar scalar)
                                         (pow/3 scalar))

                                  can_refer!
                                  (nat.= (all nat.*
                                              scalar scalar scalar
                                              scalar scalar scalar
                                              scalar scalar scalar)
                                         (pow/9 scalar))

                                  can_shadow!
                                  (let [pow/3 (function (_ scalar)
                                                (all nat.+ scalar scalar scalar))]
                                    (nat.= (all nat.+ scalar scalar scalar)
                                           (pow/3 scalar)))]
                              (and can_use_with_expressions!
                                   can_refer!
                                   can_shadow!)))
                          ))))
               (_.coverage [/.irregular_arguments]
                 (/.let [(arity/3 <0> <1> <2>)
                         [""]]
                   (exception.match? /.irregular_arguments
                                     (macro_error (arity/3 "a" "b")))))
               )))
      ))