aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/tool/compiler/language/lux/analysis/pattern.lux
blob: ac6ce0392821d7d5a85651b968e950a2681e81e8 (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
(.using
 [library
  [lux "*"
   ["_" test {"+" Test}]
   [abstract
    [monad {"+" do}]
    [\\specification
     ["$[0]" equivalence]]]
   [data
    ["[0]" bit ("[1]#[0]" equivalence)]
    ["[0]" text ("[1]#[0]" equivalence)]]
   [math
    ["[0]" random {"+" Random} ("[1]#[0]" monad)]
    [number
     ["f" frac]]]]]
 [\\library
  ["[0]" /]]
 ["[0]" // "_"
  ["[1][0]" simple]
  ["[1][0]" complex]])

(def: .public random
  (Random /.Pattern)
  (random.rec
   (function (_ random)
     (all random.or
          //simple.random
          (//complex.random 4 random)
          random.nat
          ))))

(def: .public test
  Test
  (<| (_.covering /._)
      (_.for [/.Pattern])
      (do random.monad
        [expected_register random.nat
         expected_bit random.bit
         expected_nat random.nat
         expected_int random.int
         expected_rev random.rev
         expected_frac random.frac
         expected_text (random.lower_case 2)

         expected_lefts random.nat
         expected_right? random.bit

         left ..random
         right ..random])
      (`` (all _.and
               (_.for [/.equivalence]
                      ($equivalence.spec /.equivalence ..random))
               
               (_.coverage [/.format]
                 (bit#= (# /.equivalence = left right)
                        (text#= (/.format left) (/.format right))))
               (_.coverage [/.unit]
                 (case (/.unit)
                   (pattern (/.unit))
                   true

                   _
                   false))
               (~~ (template [<tag> <value>]
                     [(_.coverage [<tag>]
                        (case (<tag> <value>)
                          (pattern (<tag> actual))
                          (same? <value> actual)

                          _
                          false))]

                     [/.bind expected_register]
                     [/.bit expected_bit]
                     [/.nat expected_nat]
                     [/.int expected_int]
                     [/.rev expected_rev]
                     [/.frac expected_frac]
                     [/.text expected_text]
                     ))
               (_.coverage [/.variant]
                 (case (/.variant [expected_lefts expected_right? (/.text expected_text)])
                   (pattern (/.variant [actual_lefts actual_right? (/.text actual_text)]))
                   (and (same? expected_lefts actual_lefts)
                        (same? expected_right? actual_right?)
                        (same? expected_text actual_text))

                   _
                   false))
               (_.coverage [/.tuple]
                 (case (/.tuple (list (/.bit expected_bit)
                                      (/.nat expected_nat)
                                      (/.int expected_int)
                                      (/.rev expected_rev)
                                      (/.frac expected_frac)
                                      (/.text expected_text)))
                   (pattern (/.tuple (list (/.bit actual_bit)
                                           (/.nat actual_nat)
                                           (/.int actual_int)
                                           (/.rev actual_rev)
                                           (/.frac actual_frac)
                                           (/.text actual_text))))
                   (and (same? expected_bit actual_bit)
                        (same? expected_nat actual_nat)
                        (same? expected_int actual_int)
                        (same? expected_rev actual_rev)
                        (same? expected_frac actual_frac)
                        (same? expected_text actual_text))

                   _
                   false))
               ))))