WIP

- Simplified the Analysis type, by removing all meta-data.
- Added analysis of function calls.
- Added analysis of common Lux procedures.
- Lots of refactoring.

6 files changed, 205 insertions, 174 deletions

diff --git a/new-luxc/test/test/luxc/analyser/common.lux b/new-luxc/test/test/luxc/analyser/common.lux
new file mode 100644
index 000000000..9e3db3513
--- /dev/null
+++ b/new-luxc/test/test/luxc/analyser/common.lux
@@ -0,0 +1,53 @@
+(;module:
+  lux
+  (lux ["R" math/random "R/" Monad<Random>]
+       (macro [code])))
+
+(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: #export init-compiler
+  Compiler
+  {#;info            init-compiler-info
+   #;source          [dummy-cursor ""]
+   #;cursor          dummy-cursor
+   #;modules         (list)
+   #;scopes          (list)
+   #;type-context    init-type-context
+   #;expected        #;None
+   #;seed            +0
+   #;scope-type-vars (list)
+   #;host            (:! Void [])})
+
+(def: gen-unit
+  (R;Random Code)
+  (R/wrap (' [])))
+
+(def: #export 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>
+        )))
diff --git a/new-luxc/test/test/luxc/analyser/lux.lux b/new-luxc/test/test/luxc/analyser/lux.lux
deleted file mode 100644
index beb26513c..000000000
--- a/new-luxc/test/test/luxc/analyser/lux.lux
+++ /dev/null
@@ -1,173 +0,0 @@
-(;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/test/luxc/analyser/primitive.lux b/new-luxc/test/test/luxc/analyser/primitive.lux
new file mode 100644
index 000000000..321a51fcb
--- /dev/null
+++ b/new-luxc/test/test/luxc/analyser/primitive.lux
@@ -0,0 +1,61 @@
+(;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 ["@" primitive]
+                  ["@;" common]))
+  (.. common))
+
+(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> <value>))
+                                 (macro;run init-compiler)
+                                 (case> (#E;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]
+                    ["real" Real #~;Real %real% @;analyse-real]
+                    ["char" Char #~;Char %char% @;analyse-char]
+                    ["text" Text #~;Text %text% @;analyse-text]
+                    )]
+    ($_ seq
+        <primitives>)))
diff --git a/new-luxc/test/test/luxc/analyser/reference.lux b/new-luxc/test/test/luxc/analyser/reference.lux
new file mode 100644
index 000000000..4e83a7af8
--- /dev/null
+++ b/new-luxc/test/test/luxc/analyser/reference.lux
@@ -0,0 +1,49 @@
+(;module:
+  lux
+  (lux [io]
+       (control monad
+                pipe)
+       (data ["E" error])
+       ["R" math/random "R/" Monad<Random>]
+       [type "Type/" Eq<Type>]
+       [macro #+ Monad<Lux>]
+       test)
+  (luxc ["&;" env]
+        ["&;" module]
+        (lang ["~" analysis])
+        [analyser]
+        (analyser ["@" reference]
+                  ["@;" common]))
+  (.. common))
+
+(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 ["" var-name]))))
+                  (macro;run init-compiler)
+                  (case> (#E;Success [_type (#~;Relative idx)])
+                         (Type/= ref-type _type)
+
+                         _
+                         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 [module-name var-name])))
+                  (macro;run init-compiler)
+                  (case> (#E;Success [_type (#~;Absolute idx)])
+                         (Type/= ref-type _type)
+
+                         _
+                         false)))
+      ))
diff --git a/new-luxc/test/test/luxc/analyser/struct.lux b/new-luxc/test/test/luxc/analyser/struct.lux
new file mode 100644
index 000000000..a86f6da9c
--- /dev/null
+++ b/new-luxc/test/test/luxc/analyser/struct.lux
@@ -0,0 +1,39 @@
+(;module:
+  lux
+  (lux [io]
+       (control monad
+                pipe)
+       (data ["E" error]
+             [product]
+             (coll [list "L/" Functor<List>]))
+       ["R" math/random "R/" Monad<Random>]
+       [type "Type/" Eq<Type>]
+       [macro #+ Monad<Lux>]
+       test)
+  (luxc ["&" base]
+        (lang ["~" analysis])
+        [analyser]
+        (analyser ["@" struct]
+                  ["@;" common]))
+  (.. common))
+
+(def: analyse
+  &;Analyser
+  (analyser;analyser (:!! [])))
+
+(test: "Tuples"
+  [size (|> R;nat (:: @ map (|>. (n.% +10) (n.max +2))))
+   primitives (R;list size gen-simple-primitive)]
+  ($_ seq
+      (assert "Can analyse tuple."
+              (|> (@common;with-unknown-type
+                    (@;analyse-tuple analyse (L/map product;right primitives)))
+                  (macro;run init-compiler)
+                  (case> (#E;Success [_type (#~;Tuple elems)])
+                         (and (Type/= (type;tuple (L/map product;left primitives))
+                                      _type)
+                              (n.= size (list;size elems)))
+
+                         _
+                         false))
+              )))
diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux
index cbff78c2e..a330560fc 100644
--- a/new-luxc/test/tests.lux
+++ b/new-luxc/test/tests.lux
@@ -6,7 +6,9 @@
        [cli #+ program:]
        [test])
   (test (luxc ["_;" parser]
-              (analyser ["_;" lux]))))
+              (analyser ["_;" primitive]
+                        ["_;" struct]
+                        ["_;" reference]))))
 
 ## [Program]
 (program: args