- Fixed some bugs.

- Improved error reporting.
- Implemented macro-expansion (for JVM).
- Implemented "let" compilation.

6 files changed, 334 insertions, 215 deletions

diff --git a/new-luxc/source/luxc/analyser.lux b/new-luxc/source/luxc/analyser.lux
index b10f29369..f0712794d 100644
--- a/new-luxc/source/luxc/analyser.lux
+++ b/new-luxc/source/luxc/analyser.lux
@@ -1,14 +1,19 @@
 (;module:
   lux
-  (lux (control monad)
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
        (data ["e" error]
+             [product]
              text/format)
        [meta]
        (meta [type]
-             (type ["tc" check])))
+             (type ["tc" check]))
+       [host #+ do-to])
   (luxc ["&" base]
+        [";L" host]
         (lang ["la" analysis])
-        ["&;" module])
+        ["&;" module]
+        (generator [";G" common]))
   (. ["&&;" common]
      ["&&;" function]
      ["&&;" primitive]
@@ -18,6 +23,37 @@
      ["&&;" case]
      ["&&;" procedure]))
 
+(for {"JVM" (as-is (host;import java.lang.reflect.Method
+                     (invoke [Object (Array Object)] #try Object))
+                   (host;import (java.lang.Class c)
+                     (getMethod [String (Array (Class Object))] #try Method))
+                   (host;import java.lang.Object
+                     (getClass [] (Class Object))
+                     (toString [] String))
+                   (def: _object-class (Class Object) (host;class-for Object))
+                   (def: _apply-args
+                     (Array (Class Object))
+                     (|> (host;array (Class Object) +2)
+                         (host;array-write +0 _object-class)
+                         (host;array-write +1 _object-class)))
+                   (def: (call-macro macro inputs)
+                     (-> Macro (List Code) (Meta (List Code)))
+                     (do meta;Monad<Meta>
+                       [class (commonG;load-class hostL;function-class)]
+                       (function [compiler]
+                         (do e;Monad<Error>
+                           [apply-method (Class.getMethod ["apply" _apply-args] class)
+                            output (Method.invoke [(:! Object macro)
+                                                   (|> (host;array Object +2)
+                                                       (host;array-write +0 (:! Object inputs))
+                                                       (host;array-write +1 (:! Object compiler)))]
+                                                  apply-method)]
+                           (:! (e;Error [Compiler (List Code)])
+                               output))))))
+      })
+
+(exception: #export Macro-Expression-Must-Have-Single-Expansion)
+
 (def: (to-branches raw)
   (-> (List Code) (Meta (List [Code Code])))
   (case raw
@@ -36,104 +72,113 @@
   (-> &;Eval &;Analyser)
   (: (-> Code (Meta la;Analysis))
      (function analyse [ast]
-       (let [[cursor ast'] ast]
-         ## The cursor must be set in the compiler for the sake
-         ## of having useful error messages.
-         (&;with-cursor cursor
-           (case ast'
-             (^template [<tag> <analyser>]
-               (<tag> value)
-               (<analyser> value))
-             ([#;Bool &&primitive;analyse-bool]
-              [#;Nat  &&primitive;analyse-nat]
-              [#;Int  &&primitive;analyse-int]
-              [#;Deg  &&primitive;analyse-deg]
-              [#;Frac &&primitive;analyse-frac]
-              [#;Text &&primitive;analyse-text])
-
-             (^ (#;Tuple (list)))
-             &&primitive;analyse-unit
-
-             ## Singleton tuples are equivalent to the element they contain.
-             (^ (#;Tuple (list singleton)))
-             (analyse singleton)
-
-             (^ (#;Tuple elems))
-             (&&structure;analyse-product analyse elems)
-
-             (^ (#;Record pairs))
-             (&&structure;analyse-record analyse pairs)
-
-             (#;Symbol reference)
-             (&&reference;analyse-reference reference)
-
-             (^ (#;Form (list [_ (#;Text "lux function")]
-                              [_ (#;Symbol ["" func-name])]
-                              [_ (#;Symbol ["" arg-name])]
-                              body)))
-             (&&function;analyse-function analyse func-name arg-name body)
-
-             (^template [<special> <analyser>]
-               (^ (#;Form (list [_ (#;Text <special>)] type value)))
-               (<analyser> analyse eval type value))
-             (["lux check" &&type;analyse-check]
-              ["lux coerce" &&type;analyse-coerce])
-             
-             (^ (#;Form (list& [_ (#;Text "lux case")]
-                               input
-                               branches)))
-             (do meta;Monad<Meta>
-               [paired (to-branches branches)]
-               (&&case;analyse-case analyse input paired))
-
-             (^ (#;Form (list& [_ (#;Text proc-name)] proc-args)))
-             (&&procedure;analyse-procedure analyse proc-name proc-args)
-
-             (^template [<tag> <analyser>]
-               (^ (#;Form (list& [_ (<tag> tag)]
-                                 values)))
-               (case values
-                 (#;Cons value #;Nil)
-                 (<analyser> analyse tag value)
-
-                 _
-                 (<analyser> analyse tag (` [(~@ values)]))))
-             ([#;Nat &&structure;analyse-sum]
-              [#;Tag &&structure;analyse-tagged-sum])
-
-             (#;Tag tag)
-             (&&structure;analyse-tagged-sum analyse tag (' []))
-             
-             (^ (#;Form (list& func args)))
-             (do meta;Monad<Meta>
-               [[funcT =func] (&&common;with-unknown-type
-                                (analyse func))]
-               (case =func
-                 (#la;Definition def-name)
-                 (do @
-                   [[def-type def-anns def-value] (meta;find-def def-name)]
-                   (if (meta;macro? def-anns)
-                     (do @
-                       [## macro-expansion (function [compiler]
-                        ##                   (case (macro-caller def-value args compiler)
-                        ##                     (#e;Success [compiler' output])
-                        ##                     (#e;Success [compiler' output])
-
-                        ##                     (#e;Error error)
-                        ##                     ((&;fail error) compiler)))
-                        macro-expansion (: (Meta (List Code))
-                                           (undefined))]
-                       (case macro-expansion
-                         (^ (list single-expansion))
-                         (analyse single-expansion)
-
-                         _
-                         (&;fail (format "Macro expressions must expand to a single expression: " (%code ast)))))
-                     (&&function;analyse-apply analyse funcT =func args)))
-
-                 _
-                 (&&function;analyse-apply analyse funcT =func args)))
-
-             _
-             (&;fail (format "Unrecognized syntax: " (%code ast)))
-             ))))))
+       (do meta;Monad<Meta>
+         [expectedT meta;expected-type]
+         (let [[cursor ast'] ast]
+           ## The cursor must be set in the compiler for the sake
+           ## of having useful error messages.
+           (&;with-cursor cursor
+             (case ast'
+               (^template [<tag> <analyser>]
+                 (<tag> value)
+                 (<analyser> value))
+               ([#;Bool &&primitive;analyse-bool]
+                [#;Nat  &&primitive;analyse-nat]
+                [#;Int  &&primitive;analyse-int]
+                [#;Deg  &&primitive;analyse-deg]
+                [#;Frac &&primitive;analyse-frac]
+                [#;Text &&primitive;analyse-text])
+
+               (^ (#;Tuple (list)))
+               &&primitive;analyse-unit
+
+               ## Singleton tuples are equivalent to the element they contain.
+               (^ (#;Tuple (list singleton)))
+               (analyse singleton)
+
+               (^ (#;Tuple elems))
+               (&&structure;analyse-product analyse elems)
+
+               (^ (#;Record pairs))
+               (&&structure;analyse-record analyse pairs)
+
+               (#;Symbol reference)
+               (&&reference;analyse-reference reference)
+
+               (^ (#;Form (list [_ (#;Text "lux function")]
+                                [_ (#;Symbol ["" func-name])]
+                                [_ (#;Symbol ["" arg-name])]
+                                body)))
+               (&&function;analyse-function analyse func-name arg-name body)
+
+               (^template [<special> <analyser>]
+                 (^ (#;Form (list [_ (#;Text <special>)] type value)))
+                 (<analyser> analyse eval type value))
+               (["lux check" &&type;analyse-check]
+                ["lux coerce" &&type;analyse-coerce])
+
+               (^ (#;Form (list [_ (#;Text "lux check type")] valueC)))
+               (do meta;Monad<Meta>
+                 [valueA (&;with-expected-type Type
+                           (analyse valueC))
+                  expected meta;expected-type
+                  _ (&;with-type-env
+                      (tc;check expected Type))]
+                 (wrap valueA))
+               
+               (^ (#;Form (list& [_ (#;Text "lux case")]
+                                 input
+                                 branches)))
+               (do meta;Monad<Meta>
+                 [paired (to-branches branches)]
+                 (&&case;analyse-case analyse input paired))
+
+               (^ (#;Form (list& [_ (#;Text proc-name)] proc-args)))
+               (&&procedure;analyse-procedure analyse proc-name proc-args)
+
+               (^template [<tag> <analyser>]
+                 (^ (#;Form (list& [_ (<tag> tag)]
+                                   values)))
+                 (case values
+                   (#;Cons value #;Nil)
+                   (<analyser> analyse tag value)
+
+                   _
+                   (<analyser> analyse tag (` [(~@ values)]))))
+               ([#;Nat &&structure;analyse-sum]
+                [#;Tag &&structure;analyse-tagged-sum])
+
+               (#;Tag tag)
+               (&&structure;analyse-tagged-sum analyse tag (' []))
+               
+               (^ (#;Form (list& func args)))
+               (do meta;Monad<Meta>
+                 [[funcT =func] (&&common;with-unknown-type
+                                  (analyse func))]
+                 (case =func
+                   (#la;Definition def-name)
+                   (do @
+                     [[def-type def-anns def-value] (meta;find-def def-name)]
+                     (if (meta;macro? def-anns)
+                       (do @
+                         [expansion (function [compiler]
+                                      (case (call-macro (:! Macro def-value) args compiler)
+                                        (#e;Success [compiler' output])
+                                        (#e;Success [compiler' output])
+
+                                        (#e;Error error)
+                                        ((&;fail error) compiler)))]
+                         (case expansion
+                           (^ (list single))
+                           (analyse single)
+
+                           _
+                           (&;throw Macro-Expression-Must-Have-Single-Expansion (%code ast))))
+                       (&&function;analyse-apply analyse funcT =func args)))
+
+                   _
+                   (&&function;analyse-apply analyse funcT =func args)))
+
+               _
+               (&;fail (format "Unrecognized syntax: " (%code ast)))
+               )))))))
diff --git a/new-luxc/source/luxc/analyser/case.lux b/new-luxc/source/luxc/analyser/case.lux
index b65b9ff94..b17dbcbfd 100644
--- a/new-luxc/source/luxc/analyser/case.lux
+++ b/new-luxc/source/luxc/analyser/case.lux
@@ -1,6 +1,7 @@
 (;module:
   lux
   (lux (control [monad #+ do]
+                ["ex" exception #+ exception:]
                 eq)
        (data [bool]
              [number]
@@ -21,10 +22,15 @@
       ["&;" structure])
   (. ["&&;" coverage]))
 
+(exception: #export Cannot-Match-Type-With-Pattern)
+(exception: #export Sum-Type-Has-No-Case)
+(exception: #export Unrecognized-Pattern-Syntax)
+
 (def: (pattern-error type pattern)
   (-> Type Code Text)
-  (format "Cannot match this type: " (%type type) "\n"
-          "     With this pattern: " (%code pattern)))
+  (Cannot-Match-Type-With-Pattern
+   (format "   Type: " (%type type) "\n"
+           "Pattern: " (%code pattern))))
 
 ## Type-checking on the input value is done during the analysis of a
 ## "case" expression, to ensure that the patterns being used make
@@ -56,6 +62,14 @@
                      tc;existential)]
       (simplify-case-type (maybe;assume (type;apply (list exT) type))))
 
+    (#;Apply inputT funcT)
+    (case (type;apply (list inputT) funcT)
+      (#;Some outputT)
+      (:: meta;Monad<Meta> wrap outputT)
+
+      #;None
+      (&;fail (format "Cannot apply type " (%type funcT) " to  type " (%type inputT))))
+
     _
     (:: meta;Monad<Meta> wrap type)))
 
@@ -122,7 +136,7 @@
         [inputT' (simplify-case-type inputT)]
         (case inputT'
           (#;Product _)
-          (let [sub-types (type;flatten-tuple inputT)
+          (let [sub-types (type;flatten-tuple inputT')
                 num-sub-types (maybe;default (list;size sub-types)
                                              num-tags)
                 num-sub-patterns (list;size sub-patterns)
@@ -175,7 +189,7 @@
         [inputT' (simplify-case-type inputT)]
         (case inputT'
           (#;Sum _)
-          (let [flat-sum (type;flatten-variant inputT)
+          (let [flat-sum (type;flatten-variant inputT')
                 size-sum (list;size flat-sum)
                 num-cases (maybe;default size-sum num-tags)]
             (case (list;nth idx flat-sum)
@@ -196,7 +210,9 @@
                          nextA])))
 
               _
-              (&;fail (format "Cannot match index " (%n idx) " against type: " (%type inputT)))))
+              (&;throw Sum-Type-Has-No-Case
+                       (format "Case: " (%n idx) "\n"
+                               "Type: " (%type inputT)))))
 
           _
           (&;fail (pattern-error inputT pattern)))))
@@ -211,10 +227,10 @@
         (analyse-pattern (#;Some (list;size group)) inputT (` ((~ (code;nat idx)) (~@ values))) next)))
 
     _
-    (&;fail (format "Unrecognized pattern syntax: " (%code pattern)))
+    (&;throw Unrecognized-Pattern-Syntax (%code pattern))
     ))
 
-(def: #export (analyse-case analyse input branches)
+(def: #export (analyse-case analyse inputC branches)
   (-> &;Analyser Code (List [Code Code]) (Meta la;Analysis))
   (case branches
     #;Nil
@@ -223,7 +239,7 @@
     (#;Cons [patternH bodyH] branchesT)
     (do meta;Monad<Meta>
       [[inputT inputA] (&common;with-unknown-type
-                         (analyse input))
+                         (analyse inputC))
        outputH (analyse-pattern #;None inputT patternH (analyse bodyH))
        outputT (monad;map @
                           (function [[patternT bodyT]]
diff --git a/new-luxc/source/luxc/analyser/function.lux b/new-luxc/source/luxc/analyser/function.lux
index 1432308f8..55896480e 100644
--- a/new-luxc/source/luxc/analyser/function.lux
+++ b/new-luxc/source/luxc/analyser/function.lux
@@ -1,6 +1,7 @@
 (;module:
   lux
-  (lux (control monad)
+  (lux (control monad
+                ["ex" exception #+ exception:])
        (data [maybe]
              [text]
              text/format
@@ -14,6 +15,9 @@
         (analyser ["&;" common]
                   ["&;" inference])))
 
+(exception: #export Invalid-Function-Type)
+(exception: #export Cannot-Apply-Function)
+
 ## [Analysers]
 (def: #export (analyse-function analyse func-name arg-name body)
   (-> &;Analyser Text Text Code (Meta Analysis))
@@ -21,7 +25,7 @@
     [functionT meta;expected-type]
     (loop [expectedT functionT]
       (&;with-stacked-errors
-        (function [_] (format "Functions require function types: " (type;to-text expectedT)))
+        (function [_] (Invalid-Function-Type (%type expectedT)))
         (case expectedT
           (#;Named name unnamedT)
           (recur unnamedT)
@@ -92,8 +96,9 @@
 (def: #export (analyse-apply analyse funcT funcA args)
   (-> &;Analyser Type Analysis (List Code) (Meta Analysis))
   (&;with-stacked-errors
-    (function [_] (format "Cannot apply function " (%type funcT)
-                          " to args: " (|> args (list/map %code) (text;join-with " "))))
+    (function [_]
+      (Cannot-Apply-Function (format " Function: " (%type funcT) "\n"
+                                     "Arguments: " (|> args (list/map %code) (text;join-with " ")))))
     (do Monad<Meta>
       [expected meta;expected-type
        [applyT argsA] (&inference;apply-function analyse funcT args)
diff --git a/new-luxc/source/luxc/analyser/inference.lux b/new-luxc/source/luxc/analyser/inference.lux
index 86832ae9e..049abec28 100644
--- a/new-luxc/source/luxc/analyser/inference.lux
+++ b/new-luxc/source/luxc/analyser/inference.lux
@@ -1,9 +1,11 @@
 (;module:
   lux
-  (lux (control monad)
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
        (data [maybe]
+             [text]
              text/format
-             (coll [list "L/" Functor<List>]))
+             (coll [list "list/" Functor<List>]))
        [meta #+ Monad<Meta>]
        (meta [type]
              (type ["tc" check])))
@@ -11,6 +13,10 @@
         (lang ["la" analysis #+ Analysis])
         (analyser ["&;" common])))
 
+(exception: #export Cannot-Infer)
+(exception: #export Cannot-Infer-Argument)
+(exception: #export Smaller-Variant-Than-Expected)
+
 ## When doing inference, type-variables often need to be created in
 ## order to figure out which types are present in the expression being
 ## inferred.
@@ -23,7 +29,7 @@
   (-> Nat Nat Type Type)
   (case type
     (#;Primitive name params)
-    (#;Primitive name (L/map (replace-var var-id bound-idx) params))
+    (#;Primitive name (list/map (replace-var var-id bound-idx) params))
 
     (^template [<tag>]
       (<tag> left right)
@@ -41,15 +47,41 @@
 
     (^template [<tag>]
       (<tag> env quantified)
-      (<tag> (L/map (replace-var var-id bound-idx) env)
+      (<tag> (list/map (replace-var var-id bound-idx) env)
              (replace-var var-id (n.+ +2 bound-idx) quantified)))
     ([#;UnivQ]
      [#;ExQ])
     
-    (#;Named name unnamedT)
-    (#;Named name
-             (replace-var var-id bound-idx unnamedT))
+    _
+    type))
 
+(def: (replace-bound bound-idx replacementT type)
+  (-> Nat Type Type Type)
+  (case type
+    (#;Primitive name params)
+    (#;Primitive name (list/map (replace-bound bound-idx replacementT) params))
+
+    (^template [<tag>]
+      (<tag> left right)
+      (<tag> (replace-bound bound-idx replacementT left)
+             (replace-bound bound-idx replacementT right)))
+    ([#;Sum]
+     [#;Product]
+     [#;Function]
+     [#;Apply])
+    
+    (#;Bound idx)
+    (if (n.= bound-idx idx)
+      replacementT
+      type)
+
+    (^template [<tag>]
+      (<tag> env quantified)
+      (<tag> (list/map (replace-bound bound-idx replacementT) env)
+             (replace-bound (n.+ +2 bound-idx) replacementT quantified)))
+    ([#;UnivQ]
+     [#;ExQ])
+    
     _
     type))
 
@@ -66,7 +98,7 @@
     #;Nil
     (:: Monad<Meta> wrap [funcT (list)])
     
-    (#;Cons arg args')
+    (#;Cons argC args')
     (case funcT
       (#;Named name unnamedT)
       (apply-function analyse unnamedT args)
@@ -104,29 +136,31 @@
       (do Monad<Meta>
         [[outputT' args'A] (apply-function analyse outputT args')
          argA (&;with-stacked-errors
-                (function [_] (format "Expected type: " (%type inputT) "\n"
-                                      " For argument: " (%code arg)))
+                (function [_] (Cannot-Infer-Argument
+                               (format "Inferred Type: " (%type inputT) "\n"
+                                       "     Argument: " (%code argC))))
                 (&;with-expected-type inputT
-                  (analyse arg)))]
+                  (analyse argC)))]
         (wrap [outputT' (list& argA args'A)]))
 
       _
-      (&;fail (format "Cannot apply a non-function: " (%type funcT))))
+      (&;throw Cannot-Infer (format "Inference Type: " (%type funcT)
+                                    "     Arguments: " (|> args (list/map %code) (text;join-with " ")))))
     ))
 
 ## Turns a record type into the kind of function type suitable for inference.
-(def: #export (record-inference-type type)
+(def: #export (record type)
   (-> Type (Meta Type))
   (case type
     (#;Named name unnamedT)
     (do Monad<Meta>
-      [unnamedT+ (record-inference-type unnamedT)]
-      (wrap (#;Named name unnamedT+)))
+      [unnamedT+ (record unnamedT)]
+      (wrap unnamedT+))
 
     (^template [<tag>]
       (<tag> env bodyT)
       (do Monad<Meta>
-        [bodyT+ (record-inference-type bodyT)]
+        [bodyT+ (record bodyT)]
         (wrap (<tag> env bodyT+))))
     ([#;UnivQ]
      [#;ExQ])
@@ -138,47 +172,57 @@
     (&;fail (format "Not a record type: " (%type type)))))
 
 ## Turns a variant type into the kind of function type suitable for inference.
-(def: #export (variant-inference-type tag expected-size type)
+(def: #export (variant tag expected-size type)
   (-> Nat Nat Type (Meta Type))
-  (case type
-    (#;Named name unnamedT)
-    (do Monad<Meta>
-      [unnamedT+ (variant-inference-type tag expected-size unnamedT)]
-      (wrap (#;Named name unnamedT+)))
-
-    (^template [<tag>]
-      (<tag> env bodyT)
+  (loop [depth +0
+         currentT type]
+    (case currentT
+      (#;Named name unnamedT)
       (do Monad<Meta>
-        [bodyT+ (variant-inference-type tag expected-size bodyT)]
-        (wrap (<tag> env bodyT+))))
-    ([#;UnivQ]
-     [#;ExQ])
-
-    (#;Sum _)
-    (let [cases (type;flatten-variant type)
-          actual-size (list;size cases)
-          boundary (n.dec expected-size)]
-      (cond (or (n.= expected-size actual-size)
-                (and (n.> expected-size actual-size)
-                     (n.< boundary tag)))
-            (case (list;nth tag cases)
-              (#;Some caseT)
-              (:: Monad<Meta> wrap (type;function (list caseT) type))
-
-              #;None
-              (&common;variant-out-of-bounds-error type expected-size tag))
-            
-            (n.< expected-size actual-size)
-            (&;fail (format "Variant type is smaller than expected." "\n"
-                            "Expected: " (%i (nat-to-int expected-size)) "\n"
-                            "  Actual: " (%i (nat-to-int actual-size))))
-
-            (n.= boundary tag)
-            (let [caseT (type;variant (list;drop boundary cases))]
-              (:: Monad<Meta> wrap (type;function (list caseT) type)))
-            
-            ## else
-            (&common;variant-out-of-bounds-error type expected-size tag)))
+        [unnamedT+ (recur depth unnamedT)]
+        (wrap unnamedT+))
+
+      (^template [<tag>]
+        (<tag> env bodyT)
+        (do Monad<Meta>
+          [bodyT+ (recur (n.inc depth) bodyT)]
+          (wrap (<tag> env bodyT+))))
+      ([#;UnivQ]
+       [#;ExQ])
+
+      (#;Sum _)
+      (let [cases (type;flatten-variant currentT)
+            actual-size (list;size cases)
+            boundary (n.dec expected-size)]
+        (cond (or (n.= expected-size actual-size)
+                  (and (n.> expected-size actual-size)
+                       (n.< boundary tag)))
+              (case (list;nth tag cases)
+                (#;Some caseT)
+                (:: Monad<Meta> wrap (if (n.= +0 depth)
+                                       (type;function (list caseT) currentT)
+                                       (let [replace! (replace-bound (|> depth n.dec (n.* +2)) type)]
+                                         (type;function (list (replace! caseT))
+                                           (replace! currentT)))))
+
+                #;None
+                (&common;variant-out-of-bounds-error type expected-size tag))
+              
+              (n.< expected-size actual-size)
+              (&;throw Smaller-Variant-Than-Expected
+                       (format "Expected: " (%i (nat-to-int expected-size)) "\n"
+                               "  Actual: " (%i (nat-to-int actual-size))))
+
+              (n.= boundary tag)
+              (let [caseT (type;variant (list;drop boundary cases))]
+                (:: Monad<Meta> wrap (if (n.= +0 depth)
+                                       (type;function (list caseT) currentT)
+                                       (let [replace! (replace-bound (|> depth n.dec (n.* +2)) type)]
+                                         (type;function (list (replace! caseT))
+                                           (replace! currentT))))))
+              
+              ## else
+              (&common;variant-out-of-bounds-error type expected-size tag)))
 
-    _
-    (&;fail (format "Not a variant type: " (%type type)))))
+      _
+      (&;fail (format "Not a variant type: " (%type type))))))
diff --git a/new-luxc/source/luxc/analyser/reference.lux b/new-luxc/source/luxc/analyser/reference.lux
index 9756a1b9c..4a2f6dbc5 100644
--- a/new-luxc/source/luxc/analyser/reference.lux
+++ b/new-luxc/source/luxc/analyser/reference.lux
@@ -1,8 +1,8 @@
 (;module:
   lux
   (lux (control monad)
-       [meta #+ Monad<Meta>]
-       (meta (type ["TC" check])))
+       [meta]
+       (meta (type ["tc" check])))
   (luxc ["&" base]
         (lang ["la" analysis #+ Analysis])
         ["&;" scope]))
@@ -10,23 +10,23 @@
 ## [Analysers]
 (def: (analyse-definition def-name)
   (-> Ident (Meta Analysis))
-  (do Monad<Meta>
-    [actual (meta;find-def-type def-name)
-     expected meta;expected-type
+  (do meta;Monad<Meta>
+    [actualT (meta;find-def-type def-name)
+     expectedT meta;expected-type
      _ (&;with-type-env
-         (TC;check expected actual))]
+         (tc;check expectedT actualT))]
     (wrap (#la;Definition def-name))))
 
 (def: (analyse-variable var-name)
   (-> Text (Meta (Maybe Analysis)))
-  (do Monad<Meta>
+  (do meta;Monad<Meta>
     [?var (&scope;find var-name)]
     (case ?var
-      (#;Some [actual ref])
+      (#;Some [actualT ref])
       (do @
-        [expected meta;expected-type
+        [expectedT meta;expected-type
          _ (&;with-type-env
-             (TC;check expected actual))]
+             (tc;check expectedT actualT))]
         (wrap (#;Some (#la;Variable ref))))
 
       #;None
@@ -36,7 +36,7 @@
   (-> Ident (Meta Analysis))
   (case reference
     ["" simple-name]
-    (do Monad<Meta>
+    (do meta;Monad<Meta>
       [?var (analyse-variable simple-name)]
       (case ?var
         (#;Some analysis)
diff --git a/new-luxc/source/luxc/analyser/structure.lux b/new-luxc/source/luxc/analyser/structure.lux
index 8c1f7118c..7720202d8 100644
--- a/new-luxc/source/luxc/analyser/structure.lux
+++ b/new-luxc/source/luxc/analyser/structure.lux
@@ -1,6 +1,7 @@
 (;module:
   lux
   (lux (control [monad #+ do]
+                ["ex" exception #+ exception:]
                 pipe)
        [function]
        (concurrency ["A" atom])
@@ -23,13 +24,13 @@
         (analyser ["&;" common]
                   ["&;" inference])))
 
+(exception: #export Not-Variant-Type)
+(exception: #export Not-Tuple-Type)
+(exception: #export Cannot-Infer-Numeric-Tag)
+
 (type: Type-Error
   (-> Type Text))
 
-(def: (not-variant type)
-  Type-Error
-  (format "Invalid type for variant: " (%type type)))
-
 (def: (not-quantified type)
   Type-Error
   (format "Not a quantified type: " (%type type)))
@@ -37,12 +38,14 @@
 (def: #export (analyse-sum analyse tag valueC)
   (-> &;Analyser Nat Code (Meta la;Analysis))
   (do meta;Monad<Meta>
-    [expected meta;expected-type]
+    [expectedT meta;expected-type]
     (&;with-stacked-errors
-      (function [_] (not-variant expected))
-      (case expected
+      (function [_] (Not-Variant-Type (format "  Tag: " (%n tag) "\n"
+                                              "Value: " (%code  valueC) "\n"
+                                              " Type: " (%type expectedT))))
+      (case expectedT
         (#;Sum _)
-        (let [flat (type;flatten-variant expected)
+        (let [flat (type;flatten-variant expectedT)
               type-size (list;size flat)]
           (case (list;nth tag flat)
             (#;Some variant-type)
@@ -53,7 +56,7 @@
               (wrap (la;sum tag type-size temp valueA)))
 
             #;None
-            (&common;variant-out-of-bounds-error expected type-size tag)))
+            (&common;variant-out-of-bounds-error expectedT type-size tag)))
 
         (#;Named name unnamedT)
         (&;with-expected-type unnamedT
@@ -65,26 +68,28 @@
                     (tc;bound? id))]
           (if bound?
             (do @
-              [expected' (&;with-type-env
-                           (tc;read id))]
-              (&;with-expected-type expected'
+              [expectedT' (&;with-type-env
+                            (tc;read id))]
+              (&;with-expected-type expectedT'
                 (analyse-sum analyse tag valueC)))
             ## Cannot do inference when the tag is numeric.
             ## This is because there is no way of knowing how many
             ## cases the inferred sum type would have.
-            (&;fail (not-variant expected))))
+            (&;throw Cannot-Infer-Numeric-Tag (format "  Tag: " (%n tag) "\n"
+                                                      "Value: " (%code  valueC) "\n"
+                                                      " Type: " (%type expectedT)))))
 
         (#;UnivQ _)
         (do @
           [[var-id var] (&;with-type-env
                           tc;existential)]
-          (&;with-expected-type (maybe;assume (type;apply (list var) expected))
+          (&;with-expected-type (maybe;assume (type;apply (list var) expectedT))
             (analyse-sum analyse tag valueC)))
 
         (#;ExQ _)
         (&common;with-var
           (function [[var-id var]]
-            (&;with-expected-type (maybe;assume (type;apply (list var) expected))
+            (&;with-expected-type (maybe;assume (type;apply (list var) expectedT))
               (analyse-sum analyse tag valueC))))
 
         (#;Apply inputT funT)
@@ -97,15 +102,17 @@
             (analyse-sum analyse tag valueC)))
         
         _
-        (&;fail "")))))
+        (&;throw Not-Variant-Type (format "  Tag: " (%n tag) "\n"
+                                          "Value: " (%code  valueC) "\n"
+                                          " Type: " (%type expectedT)))))))
 
 (def: (analyse-typed-product analyse members)
   (-> &;Analyser (List Code) (Meta la;Analysis))
   (do meta;Monad<Meta>
-    [expected meta;expected-type]
-    (loop [expected expected
+    [expectedT meta;expected-type]
+    (loop [expectedT expectedT
            members members]
-      (case [expected members]
+      (case [expectedT members]
         ## If the type and the code are still ongoing, match each
         ## sub-expression to its corresponding type.
         [(#;Product leftT rightT) (#;Cons leftC rightC)]
@@ -150,10 +157,11 @@
 (def: #export (analyse-product analyse membersC)
   (-> &;Analyser (List Code) (Meta la;Analysis))
   (do meta;Monad<Meta>
-    [expected meta;expected-type]
+    [expectedT meta;expected-type]
     (&;with-stacked-errors
-      (function [_] (format "Invalid type for tuple: " (%type expected)))
-      (case expected
+      (function [_] (Not-Tuple-Type (format " Type: " (%type expectedT) "\n"
+                                            "Value: " (%code (` [(~@ membersC)])))))
+      (case expectedT
         (#;Product _)
         (analyse-typed-product analyse membersC)
 
@@ -167,16 +175,16 @@
                     (tc;bound? id))]
           (if bound?
             (do @
-              [expected' (&;with-type-env
-                           (tc;read id))]
-              (&;with-expected-type expected'
+              [expectedT' (&;with-type-env
+                            (tc;read id))]
+              (&;with-expected-type expectedT'
                 (analyse-product analyse membersC)))
             ## Must do inference...
             (do @
               [membersTA (monad;map @ (|>. analyse &common;with-unknown-type)
                                     membersC)
                _ (&;with-type-env
-                   (tc;check expected
+                   (tc;check expectedT
                              (type;tuple (list/map product;left membersTA))))]
               (wrap (la;product (list/map product;right membersTA))))))
 
@@ -184,13 +192,13 @@
         (do @
           [[var-id var] (&;with-type-env
                           tc;existential)]
-          (&;with-expected-type (maybe;assume (type;apply (list var) expected))
+          (&;with-expected-type (maybe;assume (type;apply (list var) expectedT))
             (analyse-product analyse membersC)))
 
         (#;ExQ _)
         (&common;with-var
           (function [[var-id var]]
-            (&;with-expected-type (maybe;assume (type;apply (list var) expected))
+            (&;with-expected-type (maybe;assume (type;apply (list var) expectedT))
               (analyse-product analyse membersC))))
 
         (#;Apply inputT funT)
@@ -203,7 +211,8 @@
             (analyse-product analyse membersC)))
         
         _
-        (&;fail "")
+        (&;throw Not-Tuple-Type (format " Type: " (%type expectedT) "\n"
+                                        "Value: " (%code (` [(~@ membersC)]))))
         ))))
 
 (def: #export (analyse-tagged-sum analyse tag valueC)
@@ -216,7 +225,7 @@
       (#;Var _)
       (do @
         [#let [case-size (list;size group)]
-         inferenceT (&inference;variant-inference-type idx case-size variantT)
+         inferenceT (&inference;variant idx case-size variantT)
          [inferredT valueA+] (&inference;apply-function analyse inferenceT (list valueC))
          _ (&;with-type-env
              (tc;check expectedT inferredT))
@@ -295,7 +304,7 @@
     [members (normalize members)
      [members recordT] (order members)
      expectedT meta;expected-type
-     inferenceT (&inference;record-inference-type recordT)
+     inferenceT (&inference;record recordT)
      [inferredT membersA] (&inference;apply-function analyse inferenceT members)
      _ (&;with-type-env
          (tc;check expectedT inferredT))]