- Added tests for type-checking and type-coercion.

- Implemented "eval".
- Fixed bugs when analysing variants and tuples.

4 files changed, 98 insertions, 7 deletions

diff --git a/new-luxc/test/test/luxc/analyser/common.lux b/new-luxc/test/test/luxc/analyser/common.lux
index 6d701e823..60f3eef50 100644
--- a/new-luxc/test/test/luxc/analyser/common.lux
+++ b/new-luxc/test/test/luxc/analyser/common.lux
@@ -6,7 +6,8 @@
        [macro]
        (macro [code]))
   (luxc ["&" base]
-        [analyser])
+        [analyser]
+        [eval])
   (test/luxc common))
 
 (def: gen-unit
@@ -33,7 +34,7 @@
 
 (def: #export analyse
   &;Analyser
-  (analyser;analyser (:!! [])))
+  (analyser;analyser eval;eval))
 
 (do-template [<name> <on-success> <on-failure>]
   [(def: #export (<name> analysis)
diff --git a/new-luxc/test/test/luxc/analyser/type.lux b/new-luxc/test/test/luxc/analyser/type.lux
new file mode 100644
index 000000000..b23b16d6a
--- /dev/null
+++ b/new-luxc/test/test/luxc/analyser/type.lux
@@ -0,0 +1,89 @@
+(;module:
+  lux
+  (lux [io]
+       (control [monad #+ do]
+                pipe)
+       (data [bool "bool/" Eq<Bool>]
+             [text "text/" Eq<Text>]
+             (text format
+                   ["l" lexer])
+             [number]
+             ["R" result]
+             [product]
+             (coll [list "list/" Functor<List> Fold<List>]))
+       ["r" math/random "r/" Monad<Random>]
+       [type "type/" Eq<Type>]
+       [macro #+ Monad<Lux>]
+       (macro [code])
+       test)
+  (luxc ["&" base]
+        ["&;" module]
+        (lang ["~" analysis])
+        [analyser]
+        (analyser ["@" type]
+                  ["@;" common])
+        (generator ["@;" runtime])
+        [eval])
+  (.. common)
+  (test/luxc common))
+
+(def: check
+  (r;Random [Code Type Code])
+  (with-expansions [<triples> (do-template [<random> <type> <code>]
+                                [(do r;Monad<Random>
+                                   [value <random>]
+                                   (wrap [(` <type>)
+                                          <type>
+                                          (<code> value)]))]
+
+                                [r;bool (+0 "#Bool" (+0)) code;bool]
+                                [r;nat (+0 "#Nat" (+0)) code;nat]
+                                [r;int (+0 "#Int" (+0)) code;int]
+                                [r;deg (+0 "#Deg" (+0)) code;deg]
+                                [r;frac (+0 "#Frac" (+0)) code;frac]
+                                [(r;text +5) (+0 "#Text" (+0)) code;text]
+                                )]
+    ($_ r;either
+        <triples>)))
+
+(context: "Type checking/coercion."
+  [[typeC codeT exprC] check]
+  ($_ seq
+      (test (format "Can analyse type-checking.")
+            (|> (do Monad<Lux>
+                  [runtime-bytecode @runtime;generate]
+                  (&;with-scope
+                    (@common;with-unknown-type
+                      (@;analyse-check analyse eval;eval typeC exprC))))
+                (macro;run (init-compiler []))
+                (case> (#R;Success [_ [analysisT analysisA]])
+                       (and (type/= codeT analysisT)
+                            (case [exprC analysisA]
+                              (^template [<expected> <actual> <test>]
+                                [[_ (<expected> expected)] (<actual> actual)]
+                                (<test> expected actual))
+                              ([#;Bool #~;Bool bool/=]
+                               [#;Nat  #~;Nat  n.=]
+                               [#;Int  #~;Int  i.=]
+                               [#;Deg  #~;Deg  d.=]
+                               [#;Frac #~;Frac f.=]
+                               [#;Text #~;Text text/=])
+                              
+                              _
+                              false))
+
+                       (#R;Error error)
+                       false)))
+      (test (format "Can analyse type-coercion.")
+            (|> (do Monad<Lux>
+                  [runtime-bytecode @runtime;generate]
+                  (&;with-scope
+                    (@common;with-unknown-type
+                      (@;analyse-coerce analyse eval;eval typeC exprC))))
+                (macro;run (init-compiler []))
+                (case> (#R;Success [_ [analysisT analysisA]])
+                       (type/= codeT analysisT)
+
+                       (#R;Error error)
+                       false)))
+      ))
diff --git a/new-luxc/test/test/luxc/generator/structure.lux b/new-luxc/test/test/luxc/generator/structure.lux
index 4652c4bd9..ab0c17ade 100644
--- a/new-luxc/test/test/luxc/generator/structure.lux
+++ b/new-luxc/test/test/luxc/generator/structure.lux
@@ -5,8 +5,8 @@
                 pipe)
        (data text/format
              ["R" result]
-             [bool "B/" Eq<Bool>]
-             [text "T/" Eq<Text>]
+             [bool "bool/" Eq<Bool>]
+             [text "text/" Eq<Text>]
              (coll ["a" array]
                    [list]))
        ["r" math/random "r/" Monad<Random>]
@@ -48,12 +48,12 @@
 
         (#R;Error error)
         false))
-    ([#ls;Bool Bool B/=]
+    ([#ls;Bool Bool bool/=]
      [#ls;Nat  Nat n.=]
      [#ls;Int  Int i.=]
      [#ls;Deg  Deg d.=]
      [#ls;Frac Frac f.=]
-     [#ls;Text Text T/=])
+     [#ls;Text Text text/=])
 
     _
     false
@@ -92,7 +92,7 @@
                             (and (n.= tag (|> _tag host;i2l int-to-nat))
                                  (case _last?
                                    (#;Some _last?')
-                                   (and last? (T/= "" (:! Text _last?')))
+                                   (and last? (text/= "" (:! Text _last?')))
 
                                    #;None
                                    (not last?))
diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux
index 30fab3878..28ccefc42 100644
--- a/new-luxc/test/tests.lux
+++ b/new-luxc/test/tests.lux
@@ -11,6 +11,7 @@
                         ["_;A" reference]
                         ["_;A" case]
                         ["_;A" function]
+                        ["_;A" type]
                         (procedure ["_;A" common]))
               (synthesizer ["_;S" primitive]
                            ["_;S" structure]