aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/tool/compiler/phase/synthesis/structure.lux
blob: 4e7f6c3b598c4e9ea912173924b4e064117e7bd6 (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
(.module:
  [lux #*
   [abstract ["." monad (#+ do)]]
   [data
    text/format
    ["." name]]
   ["r" math/random (#+ Random) ("#@." monad)]
   ["_" test (#+ Test)]
   [control
    pipe]
   [data
    ["." bit ("#@." equivalence)]
    ["." product]
    ["." error]
    [collection
     ["." list]]]]
  ["." // #_
   ["#." primitive]]
  {1
   ["." / #_
    ["/#" //
     ["/#" //
      [extension
       ["#." bundle]]
      ["/#" //
       ["#." analysis (#+ Analysis)]
       ["#." synthesis (#+ Synthesis)]]]]]})

(def: variant
  Test
  (do r.monad
    [size (|> r.nat (:: @ map (|>> (n/% 10) (n/+ 2))))
     tagA (|> r.nat (:: @ map (n/% size)))
     #let [right? (n/= (dec size) tagA)
           lefts (if right?
                   (dec tagA)
                   tagA)]
     memberA //primitive.primitive]
    (_.test "Can synthesize variants."
            (|> (////analysis.variant [lefts right? memberA])
                //.phase
                (///.run [///bundle.empty ////synthesis.init])
                (case> (^ (#error.Success (////synthesis.variant [leftsS right?S valueS])))
                       (let [tagS (if right?S (inc leftsS) leftsS)]
                         (and (n/= tagA tagS)
                              (|> tagS (n/= (dec size)) (bit@= right?S))
                              (//primitive.corresponds? memberA valueS)))
                       
                       _
                       false)))))

(def: tuple
  Test
  (do r.monad
    [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
     membersA (r.list size //primitive.primitive)]
    (_.test "Can synthesize tuple."
            (|> (////analysis.tuple membersA)
                //.phase
                (///.run [///bundle.empty ////synthesis.init])
                (case> (^ (#error.Success (////synthesis.tuple membersS)))
                       (and (n/= size (list.size membersS))
                            (list.every? (product.uncurry //primitive.corresponds?)
                                         (list.zip2 membersA membersS)))

                       _
                       false)))))

(def: #export test
  Test
  (<| (_.context (%name (name-of #////synthesis.Structure)))
      ($_ _.and
          ..variant
          ..tuple
          )))