aboutsummaryrefslogtreecommitdiff
path: root/new-luxc/test/test/luxc/analyser/primitive.lux
blob: 9c3c1acfe2c181e042f0fdbe4da2aa009066233b (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
(;module:
  lux
  (lux [io]
       (control [monad #+ do]
                pipe)
       (data [bool "B/" Eq<Bool>]
             [text "T/" Eq<Text>]
             (text format
                   ["l" lexer])
             [number]
             ["R" result]
             [product]
             (coll [list "L/" Functor<List> Fold<List>]))
       ["r" math/random "R/" Monad<Random>]
       [type "Type/" Eq<Type>]
       [macro #+ Monad<Lux>]
       (macro [code])
       test)
  (luxc ["&" base]
        ["&;" env]
        ["&;" module]
        (lang ["~" analysis])
        [analyser]
        (analyser ["@" primitive]
                  ["@;" common]))
  (.. common)
  (test/luxc common))

(context: "Primitives"
  [%bool% r;bool
   %nat% r;nat
   %int% r;int
   %deg% r;deg
   %frac% r;frac
   %text% (r;text +5)]
  (with-expansions
    [<tests> (do-template [<desc> <type> <tag> <value> <analyser>]
               [(test (format "Can analyse " <desc> ".")
                      (|> (@common;with-unknown-type
                            (<analyser> <value>))
                          (macro;run (init-compiler []))
                          (case> (#R;Success [_type (<tag> value)])
                                 (and (Type/= <type> _type)
                                      (is <value> value))

                                 _
                                 false))
                      )]

               ["unit" Unit #~;Unit []     (function [value] @;analyse-unit)]
               ["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]
               )]
    ($_ seq
        <tests>)))