aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/test/test/luxc/lang/translation/case.lux
blob: ed8529429090d49314f9416e8a8bdc0bc7950818 (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
(.module:
  [lux #*
   [control
    [monad (#+ do)]
    pipe]
   [data
    ["e" error]
    [text
     format]
    [collection
     ["." list]]]
   [math
    ["r" random]]
   [compiler
    [default
     ["." reference]
     [phase
      ["." analysis]
      ["." synthesis (#+ Path Synthesis)]]]]
   test]
  [test
   [luxc
    ["." common (#+ Runner)]]]
  [//
   ["&" function]])

(def: struct-limit Nat 10)

(def: (tail? size idx)
  (-> Nat Nat Bit)
  (n/= (dec size) idx))

(def: gen-case
  (r.Random [Synthesis Path])
  (<| r.rec (function (_ gen-case))
      (`` ($_ r.either
              (do r.Monad<Random>
                [value r.i64]
                (wrap [(synthesis.i64 value)
                       synthesis.path/pop]))
              (~~ (do-template [<gen> <synth> <path>]
                    [(do r.Monad<Random>
                       [value <gen>]
                       (wrap [(<synth> value)
                              (<path> value)]))]

                    [r.bit         synthesis.bit  synthesis.path/bit]
                    [r.i64         synthesis.i64  synthesis.path/i64]
                    [r.frac        synthesis.f64  synthesis.path/f64]
                    [(r.unicode 5) synthesis.text synthesis.path/text]))
              (do r.Monad<Random>
                [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max 2))))
                 idx (|> r.nat (:: @ map (n/% size)))
                 [subS subP] gen-case
                 #let [unitS (synthesis.text synthesis.unit)
                       caseS (synthesis.tuple
                              (list.concat (list (list.repeat idx unitS)
                                                 (list subS)
                                                 (list.repeat (|> size dec (n/- idx)) unitS))))
                       caseP (synthesis.path/seq [(if (tail? size idx)
                                                    (synthesis.member/right idx)
                                                    (synthesis.member/left idx))
                                                  subP])]]
                (wrap [caseS caseP]))
              (do r.Monad<Random>
                [size (|> r.nat (:: @ map (|>> (n/% struct-limit) (n/max 2))))
                 idx (|> r.nat (:: @ map (n/% size)))
                 [subS subP] gen-case
                 #let [caseS (let [right? (tail? size idx)]
                               (synthesis.variant
                                {#analysis.lefts idx
                                 #analysis.right? right?
                                 #analysis.value subS}))
                       caseP (synthesis.path/seq
                              [(if (tail? size idx)
                                 (synthesis.side/right idx)
                                 (synthesis.side/left idx))
                               subP])]]
                (wrap [caseS caseP]))
              ))))

(def: (pattern-matching-spec run)
  (-> Runner Test)
  (do r.Monad<Random>
    [[valueS pathS] gen-case
     to-bind r.frac]
    ($_ seq
        (test "Can translate pattern-matching."
              (|> (run (synthesis.branch/case
                        [valueS
                         (synthesis.path/alt [(synthesis.path/seq [pathS
                                                                   (synthesis.path/then (synthesis.f64 to-bind))])
                                              (synthesis.path/then (synthesis.f64 +0.0))])]))
                  (&.check to-bind)))
        (test "Can bind values."
              (|> (run (synthesis.branch/case
                        [(synthesis.f64 to-bind)
                         (synthesis.path/seq [(synthesis.path/bind 0)
                                              (synthesis.path/then (synthesis.variable/local 0))])]))
                  (&.check to-bind)))
        )))

(context: "[JVM] Pattern-matching."
  (<| (times 100)
      (pattern-matching-spec common.run-jvm)))

## (context: "[JS] Pattern-matching."
##   (<| (times 100)
##       (pattern-matching-spec common.run-js)))

## (context: "[Lua] Pattern-matching."
##   (<| (times 100)
##       (pattern-matching-spec common.run-lua)))

## (context: "[Ruby] Pattern-matching."
##   (<| (times 100)
##       (pattern-matching-spec common.run-ruby)))

## (context: "[Python] Function."
##   (<| (times 100)
##       (pattern-matching-spec common.run-python)))

## (context: "[R] Pattern-matching."
##   (<| (times 100)
##       (pattern-matching-spec common.run-r)))

## (context: "[Scheme] Pattern-matching."
##   (<| (times 100)
##       (pattern-matching-spec common.run-scheme)))

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

## (context: "[PHP] Pattern-matching."
##   (<| (times 100)
##       (pattern-matching-spec common.run-php)))