aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/test/test/luxc/lang/translation/structure.lux
blob: 7443c33173fb1e1bd7ab194ce4c19ca085e89300 (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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
(.module:
  lux
  (lux [io #+ IO]
       (control [monad #+ do]
                pipe)
       (data ["e" error]
             [maybe]
             [bool "bool/" Eq<Bool>]
             [text "text/" Eq<Text>]
             text/format
             (coll [array]
                   [list]))
       ["r" math/random "r/" Monad<Random>]
       [macro]
       (macro [code])
       [host]
       test)
  (luxc [lang]
        (lang [".L" host]
              ["ls" synthesis]
              (translation (jvm [".T_jvm" expression]
                                [".T_jvm" runtime]
                                [".T_jvm" eval])
                           (js [".T_js" expression]
                               [".T_js" runtime]
                               [".T_js" eval]))))
  (test/luxc common))

(host.import java/lang/Integer)
(host.import java/lang/Long)

(def: gen-primitive
  (r.Random ls.Synthesis)
  (r.either (r.either (r.either (r/wrap (' []))
                                (r/map code.bool r.bool))
                      (r.either (r/map code.nat r.nat)
                                (r/map code.int r.int)))
            (r.either (r.either (r/map code.deg r.deg)
                                (r/map code.frac r.frac))
                      (r/map code.text (r.text +5)))))

(def: (corresponds? [prediction sample])
  (-> [ls.Synthesis Top] Bool)
  (case prediction
    [_ (#.Tuple #.Nil)]
    (text/= hostL.unit (:! Text sample))

    (^template [<tag> <type> <test>]
      [_ (<tag> prediction')]
      (case (host.try (<test> prediction' (:! <type> sample)))
        (#e.Success result)
        result

        (#e.Error error)
        false))
    ([#.Bool Bool bool/=]
     [#.Nat  Nat n/=]
     [#.Int  Int i/=]
     [#.Deg  Deg d/=]
     [#.Frac Frac f/=]
     [#.Text Text text/=])

    _
    false
    ))

(def: (tuples-spec translate-expression eval translate-runtime init)
  (All [a]
    (-> (-> ls.Synthesis (Meta a))
        (-> a (Meta Top))
        (Meta Top)
        (IO Compiler)
        Test))
  (do r.Monad<Random>
    [size (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
     members (r.list size gen-primitive)]
    (test "Can translate tuple."
          (|> (do macro.Monad<Meta>
                [_ translate-runtime
                 sampleO (translate-expression (code.tuple members))]
                (eval sampleO))
              (lang.with-current-module "")
              (macro.run (io.run init))
              (case> (#e.Success valueT)
                     (let [valueT (:! (Array Top) valueT)]
                       (and (n/= size (array.size valueT))
                            (list.every? corresponds? (list.zip2 members (array.to-list valueT)))))

                     (#e.Error error)
                     false)))))

(def: (variants-spec translate-expression eval translate-runtime init)
  (All [a]
    (-> (-> ls.Synthesis (Meta a))
        (-> a (Meta Top))
        (Meta Top)
        (IO Compiler)
        Test))
  (do r.Monad<Random>
    [num-tags (|> r.nat (:: @ map (|>> (n/% +10) (n/max +2))))
     tag (|> r.nat (:: @ map (n/% num-tags)))
     #let [last? (n/= (n/dec num-tags) tag)]
     member gen-primitive]
    (test "Can translate variant."
          (|> (do macro.Monad<Meta>
                [_ translate-runtime
                 sampleO (translate-expression (` ((~ (code.nat tag)) (~ (code.bool last?)) (~ member))))]
                (eval sampleO))
              (lang.with-current-module "")
              (macro.run (io.run init))
              (case> (#e.Success valueT)
                     (let [valueT (:! (Array Top) valueT)]
                       (and (n/= +3 (array.size valueT))
                            (let [_tag (:! Integer (maybe.assume (array.read +0 valueT)))
                                  _last? (array.read +1 valueT)
                                  _value (:! Top (maybe.assume (array.read +2 valueT)))]
                              (and (n/= tag (|> _tag host.int-to-long (:! Nat)))
                                   (case _last?
                                     (#.Some _last?')
                                     (and last? (text/= "" (:! Text _last?')))

                                     #.None
                                     (not last?))
                                   (corresponds? [member _value])))))

                     (#e.Error error)
                     false)))))

(context: "[JVM] Tuples."
  (<| (times +100)
      (tuples-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm)))

(context: "[JVM] Variants."
  (<| (times +100)
      (variants-spec expressionT_jvm.translate evalT_jvm.eval runtimeT_jvm.translate init-jvm)))

(context: "[JS] Tuples."
  (<| (times +100)
      (tuples-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js)))

(context: "[JS] Variants."
  (<| (times +100)
      (variants-spec expressionT_js.translate evalT_js.eval runtimeT_js.translate init-js)))