aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/test/test/luxc/lang/translation/structure.lux
blob: c92b132e20cf77039dcf025be4d5a4e2a1426d59 (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
113
114
115
116
117
118
119
120
121
122
(.module:
  [lux #*
   [control
    [monad (#+ do)]
    pipe]
   [data
    ["." error]
    ["." maybe]
    [text ("text/." Equivalence<Text>)
     format]
    [collection
     ["." array (#+ Array)]
     ["." list ("list/." Functor<List>)]]]
   [math
    ["r" random]]
   ["." host (#+ import:)]
   [compiler
    [default
     [phase
      ["." analysis]
      ["." synthesis]]]]
   test]
  [test
   [luxc
    common]])

(import: java/lang/Integer)

(def: (tuples-spec run)
  (-> Runner Test)
  (do r.Monad<Random>
    [size (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
     tuple-in (r.list size r.i64)]
    (test "Can translate tuple."
          (|> (run (synthesis.tuple (list/map (|>> synthesis.i64) tuple-in)))
              (case> (#error.Success tuple-out)
                     (let [tuple-out (:coerce (Array Any) tuple-out)]
                       (and (n/= size (array.size tuple-out))
                            (list.every? (function (_ [left right])
                                           (i/= left (:coerce Int right)))
                                         (list.zip2 tuple-in (array.to-list tuple-out)))))

                     (#error.Error error)
                     (exec (log! error)
                       #0))))))

(def: (variants-spec run)
  (-> Runner Test)
  (do r.Monad<Random>
    [num-tags (|> r.nat (:: @ map (|>> (n/% 10) (n/max 2))))
     tag-in (|> r.nat (:: @ map (n/% num-tags)))
     #let [last?-in (|> num-tags dec (n/= tag-in))]
     value-in r.i64]
    (test "Can translate variant."
          (|> (run (synthesis.variant {#analysis.lefts (if last?-in
                                                         (dec tag-in)
                                                         tag-in)
                                       #analysis.right? last?-in
                                       #analysis.value (synthesis.i64 value-in)}))
              (case> (#error.Success valueT)
                     (let [valueT (:coerce (Array Any) valueT)]
                       (and (n/= 3 (array.size valueT))
                            (let [tag-out (:coerce Integer (maybe.assume (array.read 0 valueT)))
                                  last?-out (array.read 1 valueT)
                                  value-out (:coerce Any (maybe.assume (array.read 2 valueT)))
                                  same-tag? (|> tag-out host.int-to-long (:coerce Nat) (n/= tag-in))
                                  same-flag? (case last?-out
                                               (#.Some last?-out')
                                               (and last?-in (text/= "" (:coerce Text last?-out')))

                                               #.None
                                               (not last?-in))
                                  same-value? (|> value-out (:coerce Int) (i/= value-in))]
                              (and same-tag?
                                   same-flag?
                                   same-value?))))

                     (#error.Error error)
                     (exec (log! error)
                       #0))))))

(def: (structure-spec run)
  (-> Runner Test)
  ($_ seq
      (tuples-spec run)
      (variants-spec run)))

(context: "[JVM] Structures."
  (<| (times 100)
      (structure-spec run-jvm)))

## (context: "[JS] Structures."
##   (<| (times 100)
##       (structure-spec run-js)))

## (context: "[Lua] Structures."
##   (<| (times 100)
##       (structure-spec run-lua)))

## (context: "[Ruby] Structures."
##   (<| (times 100)
##       (structure-spec run-ruby)))

## (context: "[Python] Structures."
##   (<| (times 100)
##       (structure-spec run-python)))

## (context: "[R] Structures."
##   (<| (times 100)
##       (structure-spec run-r)))

## (context: "[Scheme] Structures."
##   (<| (times 100)
##       (structure-spec run-scheme)))

## (context: "[Common Lisp] Structures."
##   (<| (times 100)
##       (structure-spec run-common-lisp)))

## (context: "[PHP] Structures."
##   (<| (times 100)
##       (structure-spec run-php)))