aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/test/test/luxc/lang/analysis/primitive.lux
blob: 7c2e8b12323fe14e618ace5e1e954009f60696e1 (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
(;module:
  lux
  (lux [io]
       (control [monad #+ do]
                pipe)
       (data (text format)
             ["e" error])
       ["r" math/random]
       [meta]
       (meta [code])
       (lang [type "type/" Eq<Type>])
       test)
  (luxc ["&" lang]
        (lang ["&;" module]
              ["~" analysis]
              (analysis [";A" expression]
                        ["@" primitive]
                        ["@;" common])))
  (.. common)
  (test/luxc common))

(context: "Primitives"
  (<| (times +100)
      (do @
        [%bool% r;bool
         %nat% r;nat
         %int% r;int
         %deg% r;deg
         %frac% r;frac
         %text% (r;text +5)]
        (`` ($_ seq
                (test "Can analyse unit."
                      (|> (@common;with-unknown-type
                            @;analyse-unit)
                          (meta;run (init-compiler []))
                          (case> (^ (#e;Success [_type (^code [])]))
                                 (type/= Unit _type)

                                 _
                                 false))
                      )
                (~~ (do-template [<desc> <type> <tag> <value> <analyser>]
                      [(test (format "Can analyse " <desc> ".")
                             (|> (@common;with-unknown-type
                                   (<analyser> <value>))
                                 (meta;run (init-compiler []))
                                 (case> (#e;Success [_type [_ (<tag> value)]])
                                        (and (type/= <type> _type)
                                             (is <value> value))

                                        _
                                        false))
                             )]

                      ["bool" Bool #;Bool %bool% @;analyse-bool]
                      ["nat"  Nat  #;Nat  %nat%  @;analyse-nat]
                      ["int"  Int  #;Int  %int%  @;analyse-int]
                      ["deg"  Deg  #;Deg  %deg%  @;analyse-deg]
                      ["frac" Frac #;Frac %frac% @;analyse-frac]
                      ["text" Text #;Text %text% @;analyse-text]
                      )))))))