aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/structure.lux
blob: 3ff107daa352b9ad96d674dfe603591ad305fdf9 (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
(.module:
  [lux "*"
   [abstract
    ["." monad {"+" [do]}]]
   [data
    ["%" text/format {"+" [format]}]
    ["." name]]
   ["r" math/random {"+" [Random]}]
   ["_" test {"+" [Test]}]
   [control
    pipe
    ["." try]]
   [data
    ["." bit ("#\." equivalence)]
    ["." product]
    [number
     ["n" nat]]
    [collection
     ["." list]]]]
  ["." // "_"
   ["#." primitive]]
  [\\
   ["." / "_"
    ["/#" //
     ["/#" // "_"
      [extension
       ["#." bundle]]
      ["/#" //
       ["#." analysis {"+" [Analysis]}]
       ["#." synthesis {"+" [Synthesis]}]
       [///
        ["." phase]
        [meta
         ["." archive]]]]]]]])

(def: variant
  Test
  (do {! r.monad}
    [size (|> r.nat (\ ! each (|>> (n.% 10) (n.+ 2))))
     tagA (|> r.nat (\ ! each (n.% size)))
     .let [right? (n.= (-- size) tagA)
           lefts (if right?
                   (-- tagA)
                   tagA)]
     memberA //primitive.primitive]
    (_.test "Can synthesize variants."
            (|> (////analysis.variant [lefts right? memberA])
                (//.phase archive.empty)
                (phase.result [///bundle.empty ////synthesis.init])
                (case> (^ (#try.Success (////synthesis.variant [leftsS right?S valueS])))
                       (let [tagS (if right?S (++ leftsS) leftsS)]
                         (and (n.= tagA tagS)
                              (|> tagS (n.= (-- size)) (bit\= right?S))
                              (//primitive.corresponds? memberA valueS)))
                       
                       _
                       false)))))

(def: tuple
  Test
  (do {! r.monad}
    [size (|> r.nat (\ ! each (|>> (n.% 10) (n.max 2))))
     membersA (r.list size //primitive.primitive)]
    (_.test "Can synthesize tuple."
            (|> (////analysis.tuple membersA)
                (//.phase archive.empty)
                (phase.result [///bundle.empty ////synthesis.init])
                (case> (^ (#try.Success (////synthesis.tuple membersS)))
                       (and (n.= size (list.size membersS))
                            (list.every? (product.uncurried //primitive.corresponds?)
                                         (list.zipped/2 membersA membersS)))

                       _
                       false)))))

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