- Fixes for pattern-matching (case) analysis.

- Small refactorings.
- Improved common procedures analysis.
- Can now handle tagged structures (variants & records).
- Tests for pattern-matching, functions (definition & application), and common procedures.

12 files changed, 499 insertions, 395 deletions

diff --git a/new-luxc/source/luxc/analyser.lux b/new-luxc/source/luxc/analyser.lux
index 2be2b6da6..44fa96081 100644
--- a/new-luxc/source/luxc/analyser.lux
+++ b/new-luxc/source/luxc/analyser.lux
@@ -18,9 +18,9 @@
      ["&&;" primitive]
      ["&&;" reference]
      ["&&;" type]
-     ["&&;" struct]
+     ["&&;" structure]
      ["&&;" case]
-     ["&&;" proc]))
+     ["&&;" procedure]))
 
 (def: (to-branches raw)
   (-> (List Code) (Lux (List [Code Code])))
@@ -61,14 +61,20 @@
              (analyse singleton)
 
              (^ (#;Tuple elems))
-             (&&struct;analyse-product analyse elems)
+             (&&structure;analyse-product analyse elems)
 
              (^ (#;Record pairs))
-             (&&struct;analyse-record analyse pairs)
+             (&&structure;analyse-record analyse pairs)
 
              (#;Symbol reference)
              (&&reference;analyse-reference reference)
 
+             (^ (#;Form (list [_ (#;Symbol ["" "_lux_function"])]
+                              [_ (#;Symbol ["" func-name])]
+                              [_ (#;Symbol ["" arg-name])]
+                              body)))
+             (&&function;analyse-function analyse func-name arg-name body)
+
              (^ (#;Form (list [_ (#;Symbol ["" "_lux_check"])]
                               type
                               value)))
@@ -79,10 +85,8 @@
                               value)))
              (&&type;analyse-coerce analyse eval type value)
 
-             (^ (#;Form (list [_ (#;Symbol ["" "_lux_proc"])]
-                              [_ (#;Symbol proc)]
-                              [_ (#;Tuple args)])))
-             (&&proc;analyse-proc analyse proc args)
+             (^ (#;Form (list& [_ (#;Text proc-name)] proc-args)))
+             (&&procedure;analyse-procedure analyse proc-name proc-args)
 
              (^ (#;Form (list& [_ (#;Symbol ["" "_lux_case"])]
                                input
@@ -93,11 +97,11 @@
 
              (^ (#;Form (list [_ (#;Nat tag)]
                               value)))
-             (&&struct;analyse-sum analyse tag value)
+             (&&structure;analyse-sum analyse tag value)
 
              (^ (#;Form (list [_ (#;Tag tag)]
                               value)))
-             (&&struct;analyse-tagged-sum analyse tag value)
+             (&&structure;analyse-tagged-sum analyse tag value)
 
              (^ (#;Form (list& func args)))
              (do Monad<Lux>
diff --git a/new-luxc/source/luxc/analyser/case.lux b/new-luxc/source/luxc/analyser/case.lux
index 239d846d1..d5c84b7bf 100644
--- a/new-luxc/source/luxc/analyser/case.lux
+++ b/new-luxc/source/luxc/analyser/case.lux
@@ -20,7 +20,7 @@
               ["lp" pattern #+ Pattern])
         ["&;" env]
         (analyser ["&;" common]
-                  ["&;" struct])))
+                  ["&;" structure])))
 
 (type: #rec Coverage
   #PartialC
@@ -146,8 +146,8 @@
 
     [cursor (#;Record pairs)]
     (do Monad<Lux>
-      [pairs (&struct;normalize-record pairs)
-       [members recordT] (&struct;order-record pairs)
+      [pairs (&structure;normalize-record pairs)
+       [members recordT] (&structure;order-record pairs)
        _ (&;within-type-env
           (TC;check inputT recordT))]
       (analyse-pattern (#;Some (list;size members)) inputT [cursor (#;Tuple members)] next))
@@ -173,12 +173,12 @@
                 (do Monad<Lux>
                   [[testP nextA] (analyse-pattern #;None
                                                   (type;variant (list;drop (n.dec num-cases) flat-sum))
-                                                  (' [(~@ values)])
+                                                  (` [(~@ values)])
                                                   next)]
                   (wrap [(#lp;Variant idx num-cases testP)
                          nextA]))
                 (do Monad<Lux>
-                  [[testP nextA] (analyse-pattern #;None case-type (' [(~@ values)]) next)]
+                  [[testP nextA] (analyse-pattern #;None case-type (` [(~@ values)]) next)]
                   (wrap [(#lp;Variant idx num-cases testP)
                          nextA])))
 
@@ -195,7 +195,7 @@
          [idx group variantT] (macro;resolve-tag tag)
          _ (&;within-type-env
             (TC;check inputT variantT))]
-        (analyse-pattern (#;Some (list;size group)) inputT (' ((~ (code;nat idx)) (~@ values))) next)))
+        (analyse-pattern (#;Some (list;size group)) inputT (` ((~ (code;nat idx)) (~@ values))) next)))
 
     _
     (&;fail (format "Unrecognized pattern syntax: " (%code pattern)))
@@ -274,7 +274,7 @@
 (struct: _ (Eq Coverage)
   (def: (= reference sample)
     (case [reference sample]
-      (^or [#TotalC #TotalC] [#PartialC #PartialC])
+      [#TotalC #TotalC]
       true
 
       [(#BoolC sideR) (#BoolC sideS)]
@@ -339,7 +339,9 @@
                                #;None
                                (wrap (D;put tagA coverageA casesSF'))))
                            casesSF (D;entries casesA))]
-            (wrap (if (list;every? total? (D;values casesM))
+            (wrap (if (let [case-coverages (D;values casesM)]
+                        (and (n.= allSF (list;size case-coverages))
+                             (list;every? total? case-coverages)))
                     #TotalC
                     (#VariantC allSF casesM)))))
 
diff --git a/new-luxc/source/luxc/analyser/function.lux b/new-luxc/source/luxc/analyser/function.lux
index 838de4181..394e65c4d 100644
--- a/new-luxc/source/luxc/analyser/function.lux
+++ b/new-luxc/source/luxc/analyser/function.lux
@@ -17,8 +17,8 @@
 (def: #export (analyse-function analyse func-name arg-name body)
   (-> &;Analyser Text Text Code (Lux Analysis))
   (do Monad<Lux>
-    [original macro;expected-type]
-    (loop [expected original]
+    [functionT macro;expected-type]
+    (loop [expected functionT]
       (&;with-stacked-errors
         (function [_] (format "Functions require function types: " (type;to-text expected)))
         (case expected
@@ -79,7 +79,7 @@
           (#;Function inputT outputT)
           (<| (:: @ map (|>. #la;Function))
               &;with-scope
-              (&env;with-local [func-name original])
+              (&env;with-local [func-name functionT])
               (&env;with-local [arg-name inputT])
               (&;with-expected-type outputT)
               (analyse body))
diff --git a/new-luxc/source/luxc/analyser/proc.lux b/new-luxc/source/luxc/analyser/proc.lux
deleted file mode 100644
index 56b4ba3b3..000000000
--- a/new-luxc/source/luxc/analyser/proc.lux
+++ /dev/null
@@ -1,19 +0,0 @@
-(;module:
-  lux
-  (lux (control monad)
-       (data [text]
-             text/format
-             (coll ["D" dict])
-             maybe))
-  (luxc ["&" base]
-        (lang ["la" analysis #+ Analysis]))
-  (. ["&&;" lux]))
-
-(def: #export (analyse-proc analyse [proc-category proc-name] proc-args)
-  (-> &;Analyser Ident (List Code) (Lux Analysis))
-  (default (let [proc-description (format "[" (%t proc-category) " " (%t proc-name) "]")]
-             (&;fail (format "Unknown procedure: " proc-description)))
-    (do Monad<Maybe>
-      [procs (D;get proc-category &&lux;procs)
-       proc (D;get proc-name procs)]
-      (wrap (proc analyse proc-args)))))
diff --git a/new-luxc/source/luxc/analyser/proc/lux.lux b/new-luxc/source/luxc/analyser/proc/lux.lux
deleted file mode 100644
index 8ad88baed..000000000
--- a/new-luxc/source/luxc/analyser/proc/lux.lux
+++ /dev/null
@@ -1,321 +0,0 @@
-(;module:
-  lux
-  (lux (control monad)
-       (concurrency ["A" atom])
-       (data [text]
-             text/format
-             (coll [list]
-                   [array #+ Array]
-                   ["D" dict]))
-       [macro #+ Monad<Lux>]
-       (type ["TC" check])
-       [io])
-  (luxc ["&" base]
-        (lang ["la" analysis #+ Analysis])
-        (analyser ["&;" common])))
-
-## [Utils]
-(type: Proc-Analyser
-  (-> &;Analyser (List Code) (Lux Analysis)))
-
-(type: Proc-Set
-  (D;Dict Text Proc-Analyser))
-
-(def: (wrong-amount-error proc expected actual)
-  (-> Ident Nat Nat Text)
-  (let [[proc-category proc-name] proc
-        proc-description (format "[" (%t proc-category) " " (%t proc-name) "]")]
-    (format "Wrong number of arguments for " proc-description "\n"
-            "Expected: " (|> expected nat-to-int %i) "\n"
-            "  Actual: " (|> actual nat-to-int %i))))
-
-(def: (simple-proc proc input-types output-type)
-  (-> Ident (List Type) Type Proc-Analyser)
-  (let [num-expected (list;size input-types)]
-    (function [analyse args]
-      (let [num-actual (list;size args)]
-        (if (n.= num-expected num-actual)
-          (do Monad<Lux>
-            [argsA (mapM @
-                         (function [[argT argC]]
-                           (&;with-expected-type argT
-                             (analyse argC)))
-                         (list;zip2 input-types args))
-             expected macro;expected-type
-             _ (&;within-type-env
-                (TC;check expected output-type))]
-            (wrap (#la;Procedure proc argsA)))
-          (&;fail (wrong-amount-error proc num-expected num-actual)))))))
-
-(def: (binary-operation proc subjectT paramT outputT)
-  (-> Ident Type Type Type Proc-Analyser)
-  (simple-proc proc (list subjectT paramT) outputT))
-
-(def: (trinary-operation proc subjectT param0T param1T outputT)
-  (-> Ident Type Type Type Type Proc-Analyser)
-  (simple-proc proc (list subjectT param0T param1T) outputT))
-
-(def: (unary-operation proc inputT outputT)
-  (-> Ident Type Type Proc-Analyser)
-  (simple-proc proc (list inputT) outputT))
-
-(def: (special-value proc valueT)
-  (-> Ident Type Proc-Analyser)
-  (simple-proc proc (list) valueT))
-
-(def: (converter proc fromT toT)
-  (-> Ident Type Type Proc-Analyser)
-  (simple-proc proc (list fromT) toT))
-
-## [Analysers]
-(def: (analyse-lux-is analyse args)
-  Proc-Analyser
-  (&common;with-var
-    (function [[var-id varT]]
-      ((binary-operation ["lux" "is"] varT varT Bool)
-       analyse args))))
-
-(def: (analyse-lux-try analyse args)
-  Proc-Analyser
-  (&common;with-var
-    (function [[var-id varT]]
-      (case args
-        (^ (list opC))
-        (do Monad<Lux>
-          [opA (&;with-expected-type (type (io;IO varT))
-                 (analyse opC))
-           outputT (&;within-type-env
-                    (TC;clean var-id (type (Either Text varT))))
-           expected macro;expected-type
-           _ (&;within-type-env
-              (TC;check expected outputT))]
-          (wrap (#la;Procedure ["lux" "try"] (list opA))))
-        
-        _
-        (&;fail (wrong-amount-error ["lux" "try"] +1 (list;size args)))))))
-
-(def: lux-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "is" analyse-lux-is)
-      (D;put "try" analyse-lux-try)))
-
-(def: io-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "log" (converter ["io" "log"] Text Unit))
-      (D;put "error" (converter ["io" "error"] Text Bottom))
-      (D;put "exit" (converter ["io" "exit"] Nat Bottom))
-      (D;put "current-time" (special-value ["io" "current-time"] Int))))
-
-(def: bit-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "count" (unary-operation ["bit" "count"] Nat Nat))
-      (D;put "and" (binary-operation ["bit" "and"] Nat Nat Nat))
-      (D;put "or" (binary-operation ["bit" "or"] Nat Nat Nat))
-      (D;put "xor" (binary-operation ["bit" "xor"] Nat Nat Nat))
-      (D;put "shift-left" (binary-operation ["bit" "shift-left"] Nat Nat Nat))
-      (D;put "unsigned-shift-right" (binary-operation ["bit" "unsigned-shift-right"] Nat Nat Nat))
-      (D;put "shift-right" (binary-operation ["bit" "shift-right"] Int Nat Int))
-      ))
-
-(def: nat-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "+" (binary-operation ["nat" "+"] Nat Nat Nat))
-      (D;put "-" (binary-operation ["nat" "-"] Nat Nat Nat))
-      (D;put "*" (binary-operation ["nat" "*"] Nat Nat Nat))
-      (D;put "/" (binary-operation ["nat" "/"] Nat Nat Nat))
-      (D;put "%" (binary-operation ["nat" "%"] Nat Nat Nat))
-      (D;put "=" (binary-operation ["nat" "="] Nat Nat Bool))
-      (D;put "<" (binary-operation ["nat" "<"] Nat Nat Bool))
-      (D;put "min-value" (special-value ["nat" "min-value"] Nat))
-      (D;put "max-value" (special-value ["nat" "max-value"] Nat))
-      (D;put "to-int" (converter ["nat" "to-int"] Nat Int))
-      (D;put "to-text" (converter ["nat" "to-text"] Nat Text))))
-
-(def: int-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "+" (binary-operation ["int" "+"] Int Int Int))
-      (D;put "-" (binary-operation ["int" "-"] Int Int Int))
-      (D;put "*" (binary-operation ["int" "*"] Int Int Int))
-      (D;put "/" (binary-operation ["int" "/"] Int Int Int))
-      (D;put "%" (binary-operation ["int" "%"] Int Int Int))
-      (D;put "=" (binary-operation ["int" "="] Int Int Bool))
-      (D;put "<" (binary-operation ["int" "<"] Int Int Bool))
-      (D;put "min-value" (special-value ["int" "min-value"] Int))
-      (D;put "max-value" (special-value ["int" "max-value"] Int))
-      (D;put "to-nat" (converter ["int" "to-nat"] Int Nat))
-      (D;put "to-real" (converter ["int" "to-real"] Int Real))))
-
-(def: deg-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "+" (binary-operation ["deg" "+"] Deg Deg Deg))
-      (D;put "-" (binary-operation ["deg" "-"] Deg Deg Deg))
-      (D;put "*" (binary-operation ["deg" "*"] Deg Deg Deg))
-      (D;put "/" (binary-operation ["deg" "/"] Deg Deg Deg))
-      (D;put "%" (binary-operation ["deg" "%"] Deg Deg Deg))
-      (D;put "=" (binary-operation ["deg" "="] Deg Deg Bool))
-      (D;put "<" (binary-operation ["deg" "<"] Deg Deg Bool))
-      (D;put "scale" (binary-operation ["deg" "scale"] Deg Nat Deg))
-      (D;put "reciprocal" (binary-operation ["deg" "scale"] Deg Nat Deg))
-      (D;put "min-value" (special-value ["deg" "min-value"] Deg))
-      (D;put "max-value" (special-value ["deg" "max-value"] Deg))
-      (D;put "to-real" (converter ["deg" "to-real"] Deg Real))))
-
-(def: real-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "+" (binary-operation ["real" "+"] Real Real Real))
-      (D;put "-" (binary-operation ["real" "-"] Real Real Real))
-      (D;put "*" (binary-operation ["real" "*"] Real Real Real))
-      (D;put "/" (binary-operation ["real" "/"] Real Real Real))
-      (D;put "%" (binary-operation ["real" "%"] Real Real Real))
-      (D;put "=" (binary-operation ["real" "="] Real Real Bool))
-      (D;put "<" (binary-operation ["real" "<"] Real Real Bool))
-      (D;put "smallest-value" (special-value ["real" "smallest-value"] Real))
-      (D;put "min-value" (special-value ["real" "min-value"] Real))
-      (D;put "max-value" (special-value ["real" "max-value"] Real))
-      (D;put "not-a-number" (special-value ["real" "not-a-number"] Real))
-      (D;put "positive-infinity" (special-value ["real" "positive-infinity"] Real))
-      (D;put "negative-infinity" (special-value ["real" "negative-infinity"] Real))
-      (D;put "to-deg" (converter ["real" "to-deg"] Real Deg))
-      (D;put "to-int" (converter ["real" "to-int"] Real Int))
-      (D;put "hash" (unary-operation ["real" "hash"] Real Nat))
-      (D;put "encode" (converter ["real" "encode"] Real Text))
-      (D;put "decode" (converter ["real" "decode"] Text (type (Maybe Real))))))
-
-(def: text-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "=" (binary-operation ["text" "="] Text Text Bool))
-      (D;put "<" (binary-operation ["text" "<"] Text Text Bool))
-      (D;put "prepend" (binary-operation ["text" "prepend"] Text Text Text))
-      (D;put "index" (trinary-operation ["text" "index"] Text Text Nat (type (Maybe Nat))))
-      (D;put "size" (unary-operation ["text" "size"] Text Nat))
-      (D;put "hash" (unary-operation ["text" "hash"] Text Nat))
-      (D;put "replace-once" (binary-operation ["text" "replace-once"] Text Text Text))
-      (D;put "replace-all" (binary-operation ["text" "replace-all"] Text Text Text))
-      (D;put "char" (binary-operation ["text" "char"] Text Nat Nat))
-      (D;put "clip" (trinary-operation ["text" "clip"] Text Nat Nat Text))
-      ))
-
-(def: (analyse-array-get analyse args)
-  Proc-Analyser
-  (&common;with-var
-    (function [[var-id varT]]
-      ((binary-operation ["lux" "get"] Nat (type (Array varT)) varT)
-       analyse args))))
-
-(def: (analyse-array-put analyse args)
-  Proc-Analyser
-  (&common;with-var
-    (function [[var-id varT]]
-      ((trinary-operation ["lux" "put"] Nat varT (type (Array varT)) (type (Array varT)))
-       analyse args))))
-
-(def: (analyse-array-remove analyse args)
-  Proc-Analyser
-  (&common;with-var
-    (function [[var-id varT]]
-      ((binary-operation ["lux" "remove"] Nat (type (Array varT)) (type (Array varT)))
-       analyse args))))
-
-(def: array-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "new" (unary-operation ["array" "hash"] Nat Array))
-      (D;put "get" analyse-array-get)
-      (D;put "put" analyse-array-put)
-      (D;put "remove" analyse-array-remove)
-      (D;put "size" (unary-operation ["array" "size"] (type (Ex [a] (Array a))) Nat))
-      ))
-
-(def: math-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "cos" (unary-operation ["math" "cos"] Real Real))
-      (D;put "sin" (unary-operation ["math" "sin"] Real Real))
-      (D;put "tan" (unary-operation ["math" "tan"] Real Real))
-      (D;put "acos" (unary-operation ["math" "acos"] Real Real))
-      (D;put "asin" (unary-operation ["math" "asin"] Real Real))
-      (D;put "atan" (unary-operation ["math" "atan"] Real Real))
-      (D;put "cosh" (unary-operation ["math" "cosh"] Real Real))
-      (D;put "sinh" (unary-operation ["math" "sinh"] Real Real))
-      (D;put "tanh" (unary-operation ["math" "tanh"] Real Real))
-      (D;put "exp" (unary-operation ["math" "exp"] Real Real))
-      (D;put "log" (unary-operation ["math" "log"] Real Real))
-      (D;put "root2" (unary-operation ["math" "root2"] Real Real))
-      (D;put "root3" (unary-operation ["math" "root3"] Real Real))
-      (D;put "ceil" (unary-operation ["math" "ceil"] Real Real))
-      (D;put "floor" (unary-operation ["math" "floor"] Real Real))
-      (D;put "round" (unary-operation ["math" "round"] Real Real))
-      (D;put "atan2" (binary-operation ["math" "atan2"] Real Real Real))
-      (D;put "pow" (binary-operation ["math" "pow"] Real Real Real))
-      ))
-
-(def: (analyse-atom-new analyse args)
-  Proc-Analyser
-  (&common;with-var
-    (function [[var-id varT]]
-      (case args
-        (^ (list initC))
-        (do Monad<Lux>
-          [initA (&;with-expected-type varT
-                   (analyse initC))
-           outputT (&;within-type-env
-                    (TC;clean var-id (type (A;Atom varT))))
-           expected macro;expected-type
-           _ (&;within-type-env
-              (TC;check expected outputT))]
-          (wrap (#la;Procedure ["atom" "new"] (list initA))))
-        
-        _
-        (&;fail (wrong-amount-error ["atom" "new"] +1 (list;size args)))))))
-
-(def: (analyse-atom-read analyse args)
-  (&common;with-var
-    (function [[var-id varT]]
-      ((unary-operation ["atom" "read"] (type (A;Atom varT)) varT)
-       analyse args))))
-
-(def: (analyse-atom-compare-and-swap analyse args)
-  (&common;with-var
-    (function [[var-id varT]]
-      ((trinary-operation ["atom" "compare-and-swap"] varT varT (type (A;Atom varT)) Bool)
-       analyse args))))
-
-(def: atom-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "new" analyse-atom-new)
-      (D;put "read" analyse-atom-read)
-      (D;put "compare-and-swap" analyse-atom-compare-and-swap)
-      ))
-
-(def: process-procs
-  Proc-Set
-  (|> (D;new text;Hash<Text>)
-      (D;put "concurrency-level" (special-value ["process" "concurrency-level"] Nat))
-      (D;put "future" (unary-operation ["process" "future"] (type (io;IO Top)) Unit))
-      (D;put "schedule" (binary-operation ["process" "schedule"] Nat (type (io;IO Top)) Unit))
-      ))
-
-(def: #export procs
-  (D;Dict Text Proc-Set)
-  (|> (D;new text;Hash<Text>)
-      (D;put "lux" lux-procs)
-      (D;put "bit" bit-procs)
-      (D;put "nat" nat-procs)
-      (D;put "int" int-procs)
-      (D;put "deg" deg-procs)
-      (D;put "real" real-procs)
-      (D;put "text" text-procs)
-      (D;put "array" array-procs)
-      (D;put "math" math-procs)
-      (D;put "atom" atom-procs)
-      (D;put "process" process-procs)
-      (D;put "io" io-procs)))
diff --git a/new-luxc/source/luxc/analyser/procedure.lux b/new-luxc/source/luxc/analyser/procedure.lux
new file mode 100644
index 000000000..d8778844f
--- /dev/null
+++ b/new-luxc/source/luxc/analyser/procedure.lux
@@ -0,0 +1,17 @@
+(;module:
+  lux
+  (lux (control monad)
+       (data [text]
+             text/format
+             (coll ["D" dict])
+             maybe))
+  (luxc ["&" base]
+        (lang ["la" analysis #+ Analysis]))
+  (. ["&&;" common]))
+
+(def: #export (analyse-procedure analyse proc-name proc-args)
+  (-> &;Analyser Text (List Code) (Lux Analysis))
+  (default (&;fail (format "Unknown procedure: " (%t proc-name)))
+    (do Monad<Maybe>
+      [proc (D;get proc-name &&common;procedures)]
+      (wrap (proc analyse proc-args)))))
diff --git a/new-luxc/source/luxc/analyser/procedure/common.lux b/new-luxc/source/luxc/analyser/procedure/common.lux
new file mode 100644
index 000000000..8a03f9cad
--- /dev/null
+++ b/new-luxc/source/luxc/analyser/procedure/common.lux
@@ -0,0 +1,333 @@
+(;module:
+  lux
+  (lux (control monad)
+       (concurrency ["A" atom])
+       (data [text]
+             text/format
+             (coll [list]
+                   [array #+ Array]
+                   ["D" dict]))
+       [macro #+ Monad<Lux>]
+       (type ["TC" check])
+       [io])
+  (luxc ["&" base]
+        (lang ["la" analysis #+ Analysis])
+        (analyser ["&;" common])))
+
+## [Utils]
+(type: Proc-Analyser
+  (-> &;Analyser (List Code) (Lux Analysis)))
+
+(type: Proc-Set
+  (D;Dict Text Proc-Analyser))
+
+(def: (install name unnamed)
+  (-> Text (-> Text Proc-Analyser)
+      (-> Proc-Set Proc-Set))
+  (D;put name (unnamed name)))
+
+(def: (wrong-amount-error proc expected actual)
+  (-> Text Nat Nat Text)
+  (format "Wrong number of arguments for " (%t proc) "\n"
+          "Expected: " (|> expected nat-to-int %i) "\n"
+          "  Actual: " (|> actual nat-to-int %i)))
+
+(def: (simple-proc proc input-types output-type)
+  (-> Text (List Type) Type Proc-Analyser)
+  (let [num-expected (list;size input-types)]
+    (function [analyse args]
+      (let [num-actual (list;size args)]
+        (if (n.= num-expected num-actual)
+          (do Monad<Lux>
+            [argsA (mapM @
+                         (function [[argT argC]]
+                           (&;with-expected-type argT
+                             (analyse argC)))
+                         (list;zip2 input-types args))
+             expected macro;expected-type
+             _ (&;within-type-env
+                (TC;check expected output-type))]
+            (wrap (#la;Procedure proc argsA)))
+          (&;fail (wrong-amount-error proc num-expected num-actual)))))))
+
+(def: (binary-operation subjectT paramT outputT proc)
+  (-> Type Type Type Text Proc-Analyser)
+  (simple-proc proc (list subjectT paramT) outputT))
+
+(def: (trinary-operation subjectT param0T param1T outputT proc)
+  (-> Type Type Type Type Text Proc-Analyser)
+  (simple-proc proc (list subjectT param0T param1T) outputT))
+
+(def: (unary-operation inputT outputT proc)
+  (-> Type Type Text Proc-Analyser)
+  (simple-proc proc (list inputT) outputT))
+
+(def: (special-value valueT proc)
+  (-> Type Text Proc-Analyser)
+  (simple-proc proc (list) valueT))
+
+(def: (converter fromT toT proc)
+  (-> Type Type Text Proc-Analyser)
+  (simple-proc proc (list fromT) toT))
+
+## [Analysers]
+(def: (analyse-lux-is proc)
+  (-> Text Proc-Analyser)
+  (function [analyse args]
+    (&common;with-var
+      (function [[var-id varT]]
+        ((binary-operation varT varT Bool proc)
+         analyse args)))))
+
+(def: (analyse-lux-try proc)
+  (-> Text Proc-Analyser)
+  (function [analyse args]
+    (&common;with-var
+      (function [[var-id varT]]
+        (case args
+          (^ (list opC))
+          (do Monad<Lux>
+            [opA (&;with-expected-type (type (io;IO varT))
+                   (analyse opC))
+             outputT (&;within-type-env
+                      (TC;clean var-id (type (Either Text varT))))
+             expected macro;expected-type
+             _ (&;within-type-env
+                (TC;check expected outputT))]
+            (wrap (#la;Procedure proc (list opA))))
+          
+          _
+          (&;fail (wrong-amount-error proc +1 (list;size args))))))))
+
+(def: lux-procs
+  Proc-Set
+  (|> (D;new text;Hash<Text>)
+      (install "lux is" analyse-lux-is)
+      (install "lux try" analyse-lux-try)))
+
+(def: io-procs
+  Proc-Set
+  (|> (D;new text;Hash<Text>)
+      (install "io log" (converter Text Unit))
+      (install "io error" (converter Text Bottom))
+      (install "io exit" (converter Nat Bottom))
+      (install "io current-time" (special-value Int))))
+
+(def: bit-procs
+  Proc-Set
+  (|> (D;new text;Hash<Text>)
+      (install "bit count" (unary-operation Nat Nat))
+      (install "bit and" (binary-operation Nat Nat Nat))
+      (install "bit or" (binary-operation Nat Nat Nat))
+      (install "bit xor" (binary-operation Nat Nat Nat))
+      (install "bit shift-left" (binary-operation Nat Nat Nat))
+      (install "bit unsigned-shift-right" (binary-operation Nat Nat Nat))
+      (install "bit shift-right" (binary-operation Int Nat Int))
+      ))
+
+(def: nat-procs
+  Proc-Set
+  (|> (D;new text;Hash<Text>)
+      (install "nat +" (binary-operation Nat Nat Nat))
+      (install "nat -" (binary-operation Nat Nat Nat))
+      (install "nat *" (binary-operation Nat Nat Nat))
+      (install "nat /" (binary-operation Nat Nat Nat))
+      (install "nat %" (binary-operation Nat Nat Nat))
+      (install "nat =" (binary-operation Nat Nat Bool))
+      (install "nat <" (binary-operation Nat Nat Bool))
+      (install "nat min" (special-value Nat))
+      (install "nat max" (special-value Nat))
+      (install "nat to-int" (converter Nat Int))
+      (install "nat to-text" (converter Nat Text))))
+
+(def: int-procs
+  Proc-Set
+  (|> (D;new text;Hash<Text>)
+      (install "int +" (binary-operation Int Int Int))
+      (install "int -" (binary-operation Int Int Int))
+      (install "int *" (binary-operation Int Int Int))
+      (install "int /" (binary-operation Int Int Int))
+      (install "int %" (binary-operation Int Int Int))
+      (install "int =" (binary-operation Int Int Bool))
+      (install "int <" (binary-operation Int Int Bool))
+      (install "int min" (special-value Int))
+      (install "int max" (special-value Int))
+      (install "int to-nat" (converter Int Nat))
+      (install "int to-real" (converter Int Real))))
+
+(def: deg-procs
+  Proc-Set
+  (|> (D;new text;Hash<Text>)
+      (install "deg +" (binary-operation Deg Deg Deg))
+      (install "deg -" (binary-operation Deg Deg Deg))
+      (install "deg *" (binary-operation Deg Deg Deg))
+      (install "deg /" (binary-operation Deg Deg Deg))
+      (install "deg %" (binary-operation Deg Deg Deg))
+      (install "deg =" (binary-operation Deg Deg Bool))
+      (install "deg <" (binary-operation Deg Deg Bool))
+      (install "deg scale" (binary-operation Deg Nat Deg))
+      (install "deg reciprocal" (unary-operation Nat Deg))
+      (install "deg min" (special-value Deg))
+      (install "deg max" (special-value Deg))
+      (install "deg to-real" (converter Deg Real))))
+
+(def: real-procs
+  Proc-Set
+  (|> (D;new text;Hash<Text>)
+      (install "real +" (binary-operation Real Real Real))
+      (install "real -" (binary-operation Real Real Real))
+      (install "real *" (binary-operation Real Real Real))
+      (install "real /" (binary-operation Real Real Real))
+      (install "real %" (binary-operation Real Real Real))
+      (install "real =" (binary-operation Real Real Bool))
+      (install "real <" (binary-operation Real Real Bool))
+      (install "real smallest" (special-value Real))
+      (install "real min" (special-value Real))
+      (install "real max" (special-value Real))
+      (install "real not-a-number" (special-value Real))
+      (install "real positive-infinity" (special-value Real))
+      (install "real negative-infinity" (special-value Real))
+      (install "real to-deg" (converter Real Deg))
+      (install "real to-int" (converter Real Int))
+      (install "real to-text" (converter Real Text))
+      (install "real from-text" (converter Text (type (Maybe Real))))))
+
+(def: text-procs
+  Proc-Set
+  (|> (D;new text;Hash<Text>)
+      (install "text =" (binary-operation Text Text Bool))
+      (install "text <" (binary-operation Text Text Bool))
+      (install "text prepend" (binary-operation Text Text Text))
+      (install "text index" (trinary-operation Text Text Nat (type (Maybe Nat))))
+      (install "text size" (unary-operation Text Nat))
+      (install "text hash" (unary-operation Text Nat))
+      (install "text replace-once" (trinary-operation Text Text Text Text))
+      (install "text replace-all" (trinary-operation Text Text Text Text))
+      (install "text char" (binary-operation Text Nat Nat))
+      (install "text clip" (trinary-operation Text Nat Nat Text))
+      ))
+
+(def: (analyse-array-get proc)
+  (-> Text Proc-Analyser)
+  (function [analyse args]
+    (&common;with-var
+      (function [[var-id varT]]
+        ((binary-operation Nat (type (Array varT)) varT proc)
+         analyse args)))))
+
+(def: (analyse-array-put proc)
+  (-> Text Proc-Analyser)
+  (function [analyse args]
+    (&common;with-var
+      (function [[var-id varT]]
+        ((trinary-operation Nat varT (type (Array varT)) (type (Array varT)) proc)
+         analyse args)))))
+
+(def: (analyse-array-remove proc)
+  (-> Text Proc-Analyser)
+  (function [analyse args]
+    (&common;with-var
+      (function [[var-id varT]]
+        ((binary-operation Nat (type (Array varT)) (type (Array varT)) proc)
+         analyse args)))))
+
+(def: array-procs
+  Proc-Set
+  (|> (D;new text;Hash<Text>)
+      (install "array new" (unary-operation Nat Array))
+      (install "array get" analyse-array-get)
+      (install "array put" analyse-array-put)
+      (install "array remove" analyse-array-remove)
+      (install "array size" (unary-operation (type (Ex [a] (Array a))) Nat))
+      ))
+
+(def: math-procs
+  Proc-Set
+  (|> (D;new text;Hash<Text>)
+      (install "math cos" (unary-operation Real Real))
+      (install "math sin" (unary-operation Real Real))
+      (install "math tan" (unary-operation Real Real))
+      (install "math acos" (unary-operation Real Real))
+      (install "math asin" (unary-operation Real Real))
+      (install "math atan" (unary-operation Real Real))
+      (install "math cosh" (unary-operation Real Real))
+      (install "math sinh" (unary-operation Real Real))
+      (install "math tanh" (unary-operation Real Real))
+      (install "math exp" (unary-operation Real Real))
+      (install "math log" (unary-operation Real Real))
+      (install "math root2" (unary-operation Real Real))
+      (install "math root3" (unary-operation Real Real))
+      (install "math ceil" (unary-operation Real Real))
+      (install "math floor" (unary-operation Real Real))
+      (install "math round" (unary-operation Real Real))
+      (install "math atan2" (binary-operation Real Real Real))
+      (install "math pow" (binary-operation Real Real Real))
+      ))
+
+(def: (analyse-atom-new proc)
+  (-> Text Proc-Analyser)
+  (function [analyse args]
+    (&common;with-var
+      (function [[var-id varT]]
+        (case args
+          (^ (list initC))
+          (do Monad<Lux>
+            [initA (&;with-expected-type varT
+                     (analyse initC))
+             outputT (&;within-type-env
+                      (TC;clean var-id (type (A;Atom varT))))
+             expected macro;expected-type
+             _ (&;within-type-env
+                (TC;check expected outputT))]
+            (wrap (#la;Procedure proc (list initA))))
+          
+          _
+          (&;fail (wrong-amount-error proc +1 (list;size args))))))))
+
+(def: (analyse-atom-read proc)
+  (-> Text Proc-Analyser)
+  (function [analyse args]
+    (&common;with-var
+      (function [[var-id varT]]
+        ((unary-operation (type (A;Atom varT)) varT proc)
+         analyse args)))))
+
+(def: (analyse-atom-compare-and-swap proc)
+  (-> Text Proc-Analyser)
+  (function [analyse args]
+    (&common;with-var
+      (function [[var-id varT]]
+        ((trinary-operation varT varT (type (A;Atom varT)) Bool proc)
+         analyse args)))))
+
+(def: atom-procs
+  Proc-Set
+  (|> (D;new text;Hash<Text>)
+      (install "atom new" analyse-atom-new)
+      (install "atom read" analyse-atom-read)
+      (install "atom compare-and-swap" analyse-atom-compare-and-swap)
+      ))
+
+(def: process-procs
+  Proc-Set
+  (|> (D;new text;Hash<Text>)
+      (install "process concurrency-level" (special-value Nat))
+      (install "process future" (unary-operation (type (io;IO Top)) Unit))
+      (install "process schedule" (binary-operation Nat (type (io;IO Top)) Unit))
+      ))
+
+(def: #export procedures
+  Proc-Set
+  (|> (D;new text;Hash<Text>)
+      (D;merge lux-procs)
+      (D;merge bit-procs)
+      (D;merge nat-procs)
+      (D;merge int-procs)
+      (D;merge deg-procs)
+      (D;merge real-procs)
+      (D;merge text-procs)
+      (D;merge array-procs)
+      (D;merge math-procs)
+      (D;merge atom-procs)
+      (D;merge process-procs)
+      (D;merge io-procs)))
diff --git a/new-luxc/source/luxc/analyser/struct.lux b/new-luxc/source/luxc/analyser/structure.lux
index 562e30294..ab6f6adae 100644
--- a/new-luxc/source/luxc/analyser/struct.lux
+++ b/new-luxc/source/luxc/analyser/structure.lux
@@ -82,7 +82,7 @@
                            "Expected: " (|> size-ts nat-to-int %i) "\n"
                            "  Actual: " (|> size-record nat-to-int %i) "\n"
                            "For type: " (%type recordT))))
-       #let [tuple-range (list;n.range +0 size-ts)
+       #let [tuple-range (list;n.range +0 (n.dec size-ts))
              tag->idx (D;from-list ident;Hash<Ident> (list;zip2 tag-set tuple-range))]
        idx->val (foldM @
                        (function [[key val] idx->val]
@@ -203,13 +203,13 @@
   (case type
     (#;Named name unnamedT)
     (do Monad<Lux>
-      [unnamedT+ (record-function-type unnamedT)]
+      [unnamedT+ (variant-function-type tag expected-size unnamedT)]
       (wrap (#;Named name unnamedT+)))
 
     (^template [<tag>]
       (<tag> env bodyT)
       (do Monad<Lux>
-        [bodyT+ (record-function-type bodyT)]
+        [bodyT+ (variant-function-type tag expected-size bodyT)]
         (wrap (<tag> env bodyT+))))
     ([#;UnivQ]
      [#;ExQ])
@@ -265,20 +265,21 @@
 
 (def: (variant tag size temp value)
   (-> Nat Nat Nat Analysis Analysis)
-  (let [last-tag (n.dec size)]
-    (if (n.= last-tag tag)
+  (if (n.= (n.dec size) tag)
+    (if (n.= +1 tag)
+      (sum-right value)
       (L/fold (function;const sum-left)
               (sum-right value)
-              (list;n.range +0 last-tag))
-      (L/fold (function;const sum-left)
-              (case value
-                (#la;Sum _)
-                (#la;Case value (list [(#lp;Bind temp)
-                                       (#la;Relative (#;Local temp))]))
+              (list;n.range +0 (n.- +2 tag))))
+    (L/fold (function;const sum-left)
+            (case value
+              (#la;Sum _)
+              (#la;Case value (list [(#lp;Bind temp)
+                                     (#la;Relative (#;Local temp))]))
 
-                _
-                value)
-              (list;n.range +0 tag)))))
+              _
+              value)
+            (list;n.range +0 tag))))
 
 (def: #export (analyse-tagged-sum analyse tag value)
   (-> &;Analyser Ident Code (Lux Analysis))
@@ -345,4 +346,6 @@
               (analyse-sum analyse tag valueC))))
         
         _
-        (&;fail "")))))
+        (if (n.= +0 tag)
+          (analyse valueC)
+          (&;fail ""))))))
diff --git a/new-luxc/source/luxc/base.lux b/new-luxc/source/luxc/base.lux
index 612ce70d2..abd154190 100644
--- a/new-luxc/source/luxc/base.lux
+++ b/new-luxc/source/luxc/base.lux
@@ -55,15 +55,25 @@
       (#R;Success [(set@ #;type-context context' compiler)
                    output]))))
 
-(def: #export (pl-contains? key mappings)
-  (All [a] (-> Text (List [Text a]) Bool))
-  (case mappings
+(def: #export (pl-get key table)
+  (All [a] (-> Text (List [Text a]) (Maybe a)))
+  (case table
     #;Nil
-    false
+    #;None
 
-    (#;Cons [k v] mappings')
-    (or (T/= key k)
-        (pl-contains? key mappings'))))
+    (#;Cons [k' v'] table')
+    (if (T/= key k')
+      (#;Some v')
+      (pl-get key table'))))
+
+(def: #export (pl-contains? key table)
+  (All [a] (-> Text (List [Text a]) Bool))
+  (case (pl-get key table)
+    (#;Some _)
+    true
+
+    #;None
+    false))
 
 (def: #export (pl-put key val table)
   (All [a] (-> Text a (List [Text a]) (List [Text a])))
@@ -78,16 +88,16 @@
       (#;Cons [k' v']
               (pl-put key val table')))))
 
-(def: #export (pl-get key table)
-  (All [a] (-> Text (List [Text a]) (Maybe a)))
+(def: #export (pl-update key f table)
+  (All [a] (-> Text (-> a a) (List [Text a]) (List [Text a])))
   (case table
     #;Nil
-    #;None
+    #;Nil
 
     (#;Cons [k' v'] table')
     (if (T/= key k')
-      (#;Some v')
-      (pl-get key table'))))
+      (#;Cons [k' (f v')] table')
+      (#;Cons [k' v'] (pl-update key f table')))))
 
 (def: #export (with-source-code source action)
   (All [a] (-> [Cursor Text] (Lux a) (Lux a)))
diff --git a/new-luxc/source/luxc/lang/analysis.lux b/new-luxc/source/luxc/lang/analysis.lux
index 4e823276d..3cd63b65f 100644
--- a/new-luxc/source/luxc/lang/analysis.lux
+++ b/new-luxc/source/luxc/lang/analysis.lux
@@ -4,6 +4,7 @@
   (.. ["lp" pattern]))
 
 (type: #export #rec Analysis
+  #Unit
   (#Bool Bool)
   (#Nat Nat)
   (#Int Int)
@@ -11,12 +12,11 @@
   (#Real Real)
   (#Char Char)
   (#Text Text)
-  #Unit
   (#Sum (Either Analysis Analysis))
   (#Product Analysis Analysis)
   (#Case Analysis (List [lp;Pattern Analysis]))
   (#Function Scope Analysis)
   (#Apply Analysis Analysis)
-  (#Procedure Ident (List Analysis))
+  (#Procedure Text (List Analysis))
   (#Relative Ref)
   (#Absolute Ident))
diff --git a/new-luxc/source/luxc/lang/synthesis.lux b/new-luxc/source/luxc/lang/synthesis.lux
index 1edf0f1a0..491891600 100644
--- a/new-luxc/source/luxc/lang/synthesis.lux
+++ b/new-luxc/source/luxc/lang/synthesis.lux
@@ -3,6 +3,7 @@
   (.. ["lp" pattern]))
 
 (type: #export #rec Synthesis
+  #Unit
   (#Bool Bool)
   (#Nat Nat)
   (#Int Int)
@@ -10,11 +11,12 @@
   (#Real Real)
   (#Char Char)
   (#Text Text)
-  (#Variant Nat Nat Synthesis)
+  (#Variant Nat Bool Synthesis)
   (#Tuple (List Synthesis))
   (#Case (List [lp;Pattern Synthesis]))
-  (#Function Scope Synthesis)
+  (#Function Nat Scope Synthesis)
   (#Call Synthesis (List Synthesis))
-  (#Procedure Ident (List Synthesis))
+  (#Recur Nat (List Synthesis))
+  (#Procedure Text (List Synthesis))
   (#Relative Ref)
   (#Absolute Ident))
diff --git a/new-luxc/source/luxc/module.lux b/new-luxc/source/luxc/module.lux
index 237fda3b9..b53ceefed 100644
--- a/new-luxc/source/luxc/module.lux
+++ b/new-luxc/source/luxc/module.lux
@@ -3,8 +3,11 @@
   (lux (control monad)
        (data [text "T/" Eq<Text>]
              text/format
-             ["R" result]))
-  (luxc ["&" base]))
+             ["R" result]
+             (coll [list "L/" Fold<List> Functor<List>]))
+       [macro #+ Monad<Lux>])
+  (luxc ["&" base]
+        ["&;" env]))
 
 (def: (new-module hash)
   (-> Nat Module)
@@ -49,6 +52,14 @@
                             compiler)
                    module]))))
 
+(def: #export (with-module hash name action)
+  (All [a] (-> Nat Text (Lux a) (Lux [Module a])))
+  (do Monad<Lux>
+    [_ (create hash name)
+     output (&env;with-scope name action)
+     module (macro;find-module name)]
+    (wrap [module output])))
+
 (do-template [<flagger> <asker> <tag>]
   [(def: #export (<flagger> module-name)
      (-> Text (Lux Unit))
@@ -85,3 +96,65 @@
   [flag-compiled! compiled? #;Compiled]
   [flag-cached!   cached?   #;Cached]
   )
+
+(do-template [<name> <tag> <type>]
+  [(def: (<name> module-name)
+     (-> Text (Lux <type>))
+     (function [compiler]
+       (case (|> compiler (get@ #;modules) (&;pl-get module-name))
+         (#;Some module)
+         (#R;Success [compiler (get@ <tag> module)])
+
+         #;None
+         (macro;run compiler (&;fail (format "Unknown module: " module-name))))
+       ))]
+
+  [tags-by-module  #;tags        (List [Text [Nat (List Ident) Bool Type]])]
+  [types-by-module #;types       (List [Text [(List Ident) Bool Type]])]
+  [module-hash     #;module-hash Nat]
+  )
+
+(def: (ensure-undeclared-tags module-name tags)
+  (-> Text (List Text) (Lux Unit))
+  (do Monad<Lux>
+    [bindings (tags-by-module module-name)
+     _ (mapM @
+             (function [tag]
+               (case (&;pl-get tag bindings)
+                 #;None
+                 (wrap [])
+
+                 (#;Some _)
+                 (&;fail (format "Cannot re-declare tag: " tag))))
+             tags)]
+    (wrap [])))
+
+(def: #export (declare-tags tags exported? type)
+  (-> (List Text) Bool Type (Lux Unit))
+  (do Monad<Lux>
+    [current-module macro;current-module-name
+     [type-module type-name] (case type
+                               (#;Named type-ident _)
+                               (wrap type-ident)
+
+                               _
+                               (&;fail (format "Cannot define tags for an unnamed type: " (%type type))))
+     _ (ensure-undeclared-tags current-module tags)
+     _ (macro;assert (format "Cannot define tags for a type belonging to a foreign module: " (%type type))
+                     (T/= current-module type-module))]
+    (function [compiler]
+      (case (|> compiler (get@ #;modules) (&;pl-get current-module))
+        (#;Some module)
+        (let [namespaced-tags (L/map (|>. [current-module]) tags)]
+          (#R;Success [(update@ #;modules
+                                (&;pl-update current-module
+                                             (|>. (update@ #;tags (function [tag-bindings]
+                                                                    (L/fold (function [[idx tag] table]
+                                                                              (&;pl-put tag [idx namespaced-tags exported? type] table))
+                                                                            tag-bindings
+                                                                            (list;enumerate tags))))
+                                                  (update@ #;types (&;pl-put type-name [namespaced-tags exported? type]))))
+                                compiler)
+                       []]))
+        #;None
+        (macro;run compiler (&;fail (format "Unknown module: " current-module)))))))