aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/macro/code.lux
blob: 00d734ee7dd8b0610b2228b03fb46198ac41ab8c (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
(.module:
  [lux #*
   ["%" data/text/format (#+ format)]
   [abstract/monad (#+ do)]
   ["r" math/random (#+ Random)]
   ["_" test (#+ Test)]
   [data
    ["." text ("#@." equivalence)]
    [number
     ["i" int]
     ["f" frac]]]]
  {1
   ["." /]})

(def: #export test
  Test
  (<| (_.context (%.name (name-of /._)))
      (do r.monad
        [bit r.bit
         nat r.nat
         int r.int
         rev r.rev
         above (:: @ map (i.% +100) r.int)
         below (:: @ map (i.% +100) r.int)
         #let [frac (|> below
                        (i./ +100)
                        i.frac
                        (f.+ (i.frac above))
                        (f.* -1.0))]
         text (r.ascii 10)
         short (r.ascii/alpha 10)
         module (r.ascii/alpha 10)
         #let [name [module short]]]
        (`` ($_ _.and
                (~~ (template [<desc> <code> <text>]
                      [(let [code <code>]
                         (_.test (format "Can produce " <desc> " code node.")
                                 (and (text@= <text> (/.to-text code))
                                      (:: /.equivalence = code code))))]

                      ["bit"              (/.bit bit)                                 (%.bit bit)]
                      ["nat"              (/.nat nat)                                 (%.nat nat)]
                      ["int"              (/.int int)                                 (%.int int)]
                      ["rev"              (/.rev rev)                                 (%.rev rev)]
                      ["frac"             (/.frac frac)                               (%.frac frac)]
                      ["text"             (/.text text)                               (%.text text)]
                      ["local-ltag"       (/.local-tag short)                         (format "#" short)]
                      ["lag"              (/.tag [module short])                      (format "#" (%.name name))]
                      ["local-identifier" (/.local-identifier short)                  short]
                      ["identifier"       (/.identifier [module short])               (%.name name)]
                      ["form"             (/.form (list (/.bit bit) (/.int int)))     (format "(" (%.bit bit) " " (%.int int) ")")]
                      ["tuple"            (/.tuple (list (/.bit bit) (/.int int)))    (format "[" (%.bit bit) " " (%.int int) "]")]
                      ["record"           (/.record (list [(/.bit bit) (/.int int)])) (format "{" (%.bit bit) " " (%.int int) "}")]
                      )))))))