aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux
blob: ea5d4ebb4d0dae50e2fe33cbf44024e8930cf3e9 (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
(.using
 [library
  [lux "*"
   ["_" test {"+" Test}]
   ["[0]" type ("[1]#[0]" equivalence)]
   [abstract
    [monad {"+" do}]]
   [control
    ["[0]" pipe]
    ["[0]" try]]
   [data
    ["[0]" product]]
   [math
    ["[0]" random]]
   [meta
    ["[0]" configuration "_"
     ["$[1]" \\test]]]]]
 [\\library
  ["[0]" /
   [///
    ["[1][0]" extension]
    [//
     ["[1][0]" analysis {"+" Analysis Operation}
      ["[2][0]" type]
      ["[2][0]" module]]
     [///
      ["[1][0]" phase ("[1]#[0]" functor)]]]]]])

(def: (analysis state module type it ?)
  (-> Lux Text Type (Operation Analysis) (-> Analysis Bit) Bit)
  (and (|> it
           (/type.expecting type)
           (/module.with 0 module)
           (/phase#each product.right)
           (/phase.result [/extension.#bundle /extension.empty
                           /extension.#state state])
           (pipe.case
             (pattern {try.#Success analysis})
             (? analysis)

             _
             false))
       (|> it
           (/type.expecting .Nothing)
           (/module.with 0 module)
           (/phase#each product.right)
           (/phase.result [/extension.#bundle /extension.empty
                           /extension.#state state])
           (pipe.case
             (pattern {try.#Failure error})
             true

             _
             false))
       (|> it
           /type.inferring
           (/module.with 0 module)
           (/phase#each product.right)
           (/phase.result [/extension.#bundle /extension.empty
                           /extension.#state state])
           (pipe.case
             (pattern {try.#Success [inferred analysis]})
             (and (type#= type inferred)
                  (? analysis))

             _
             false))))

(template: (analysis? <type> <tag>)
  [(: (-> <type> Analysis Bit)
      (function (_ expected)
        (|>> (pipe.case
               (pattern (<tag> actual))
               (same? expected actual)

               _
               false))))])

(def: .public test
  (<| (_.covering /._)
      (do [! random.monad]
        [version random.nat
         host (random.ascii/lower 1)
         module (random.ascii/lower 2)
         configuration ($configuration.random 5)
         .let [state (/analysis.state (/analysis.info version host configuration))]]
        (`` ($_ _.and
                (_.cover [/.unit]
                         (..analysis state module .Any /.unit
                                     (|>> (pipe.case (pattern (/analysis.unit)) true _ false))))
                (~~ (template [<analysis> <type> <random> <tag>]
                      [(do !
                         [sample <random>]
                         (_.cover [<analysis>]
                                  (..analysis state module <type> (<analysis> sample)
                                              ((..analysis? <type> <tag>) sample))))]

                      [/.bit .Bit random.bit /analysis.bit]
                      [/.nat .Nat random.nat /analysis.nat]
                      [/.int .Int random.int /analysis.int]
                      [/.rev .Rev random.rev /analysis.rev]
                      [/.frac .Frac random.frac /analysis.frac]
                      [/.text .Text (random.unicode 1) /analysis.text]
                      ))
                )))))