- Added tests for some kinds of analysis.

- WIP: Porting more code.

2 files changed, 175 insertions, 1 deletions

diff --git a/new-luxc/test/test/luxc/analyser/lux.lux b/new-luxc/test/test/luxc/analyser/lux.lux
new file mode 100644
index 000000000..beb26513c
--- /dev/null
+++ b/new-luxc/test/test/luxc/analyser/lux.lux
@@ -0,0 +1,173 @@
+(;module:
+  lux
+  (lux [io]
+       (control monad
+                pipe)
+       (data [bool "B/" Eq<Bool>]
+             [char "C/" Eq<Char>]
+             [text "T/" Eq<Text>]
+             (text format
+                   ["l" lexer])
+             [number]
+             ["E" error]
+             [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 ["@" lux]
+                  ["@;" common])))
+
+(def: init-cursor Cursor ["" +0 +0])
+
+(def: compiler-version Text "0.6.0")
+
+(def: init-compiler-info
+  Compiler-Info
+  {#;compiler-version compiler-version
+   #;compiler-mode    #;Build})
+
+(def: init-type-context
+  Type-Context
+  {#;ex-counter +0
+   #;var-counter +0
+   #;var-bindings (list)})
+
+(def: init-compiler
+  Compiler
+  {#;info            init-compiler-info
+   #;source          [init-cursor ""]
+   #;cursor          init-cursor
+   #;modules         (list)
+   #;scopes          (list)
+   #;type-context    init-type-context
+   #;expected        #;None
+   #;seed            +0
+   #;scope-type-vars (list)
+   #;host            (:! Void [])})
+
+(test: "Simple primitives"
+  [%bool% R;bool
+   %nat% R;nat
+   %int% R;int
+   %deg% R;deg
+   %real% R;real
+   %char% R;char
+   %text% (R;text +5)]
+  (with-expansions
+    [<primitives> (do-template [<desc> <type> <tag> <value> <analyser>]
+                    [(assert (format "Can analyse " <desc> ".")
+                             (|> (@common;with-unknown-type
+                                   (<analyser> init-cursor <value>))
+                                 (macro;run init-compiler)
+                                 (case> (#E;Success [[_type _cursor] (<tag> value)])
+                                        (and (Type/= <type> _type)
+                                             (is <value> value))
+
+                                        _
+                                        false))
+                             )]
+
+                    ["unit" Unit #~;Unit []     (function [cursor value] (@;analyse-unit cursor))]
+                    ["bool" Bool #~;Bool %bool% @;analyse-bool]
+                    ["nat"  Nat  #~;Nat  %nat%  @;analyse-nat]
+                    ["int"  Int  #~;Int  %int%  @;analyse-int]
+                    ["deg"  Deg  #~;Deg  %deg%  @;analyse-deg]
+                    ["real" Real #~;Real %real% @;analyse-real]
+                    ["char" Char #~;Char %char% @;analyse-char]
+                    ["text" Text #~;Text %text% @;analyse-text]
+                    )]
+    ($_ seq
+        <primitives>)))
+
+(def: gen-unit
+  (R;Random Code)
+  (R/wrap (' [])))
+
+(def: gen-simple-primitive
+  (R;Random [Type Code])
+  (with-expansions
+    [<generators> (do-template [<type> <code-wrapper> <value-gen>]
+                    [(R;seq (R/wrap <type>) (R/map <code-wrapper> <value-gen>))]
+
+                    [Unit code;tuple (R;list +0 gen-unit)]
+                    [Bool code;bool  R;bool]
+                    [Nat  code;nat   R;nat]
+                    [Int  code;int   R;int]
+                    [Deg  code;deg   R;deg]
+                    [Real code;real  R;real]
+                    [Char code;char  R;char]
+                    [Text code;text  (R;text +5)]
+                    )]
+    ($_ R;either
+        <generators>
+        )))
+
+(test: "Tuples"
+  [size (|> R;nat (:: @ map (|>. (n.% +10) (n.max +2))))
+   primitives (R;list size gen-simple-primitive)]
+  ($_ seq
+      (let [tuple-type (type;tuple (L/map product;left primitives))]
+        (assert "Can analyse tuple."
+                (|> (@common;with-unknown-type
+                      (@;analyse-tuple (analyser;analyse (:!! []))
+                                       init-cursor
+                                       (L/map product;right primitives)))
+                    (macro;run init-compiler)
+                    (case> (#E;Success [[_type _cursor] (#~;Tuple elems)])
+                           (and (Type/= tuple-type _type)
+                                (n.= size (list;size elems))
+                                (L/fold (function [[pt at] so-far]
+                                          (and so-far (Type/= pt at)))
+                                        true
+                                        (list;zip2 (L/map product;left primitives)
+                                                   (L/map ~;get-type elems))))
+
+                           _
+                           false))
+                ))))
+
+(test: "References"
+  [[ref-type _] gen-simple-primitive
+   module-name (R;text +5)
+   scope-name (R;text +5)
+   var-name (R;text +5)]
+  ($_ seq
+      (assert "Can analyse relative reference."
+              (|> (&env;with-scope scope-name
+                    (&env;with-local [var-name ref-type]
+                      (@common;with-unknown-type
+                        (@;analyse-reference init-cursor ["" var-name]))))
+                  (macro;run init-compiler)
+                  (case> (#E;Success [[_type _cursor] (#~;Relative idx)])
+                         (Type/= ref-type _type)
+
+                         (#E;Error error)
+                         false
+                         
+                         _
+                         false)))
+      (assert "Can analyse absolute reference."
+              (|> (do Monad<Lux>
+                    [_ (&module;create +0 module-name)
+                     _ (&module;define [module-name var-name]
+                                       [ref-type (list) (:! Void [])])]
+                    (@common;with-unknown-type
+                      (@;analyse-reference init-cursor [module-name var-name])))
+                  (macro;run init-compiler)
+                  (case> (#E;Success [[_type _cursor] (#~;Absolute idx)])
+                         (Type/= ref-type _type)
+
+                         (#E;Error error)
+                         false
+                         
+                         _
+                         false)))
+      ))
diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux
index 443ec6757..cbff78c2e 100644
--- a/new-luxc/test/tests.lux
+++ b/new-luxc/test/tests.lux
@@ -5,7 +5,8 @@
        (concurrency [promise])
        [cli #+ program:]
        [test])
-  (test (luxc ["_;" parser])))
+  (test (luxc ["_;" parser]
+              (analyser ["_;" lux]))))
 
 ## [Program]
 (program: args