- Migrated structure analysis to stdlib.

- Added an easy way to report information in exceptions.

7 files changed, 56 insertions, 956 deletions

diff --git a/new-luxc/source/luxc/lang.lux b/new-luxc/source/luxc/lang.lux
index 1060eeb8e..28dd302c2 100644
--- a/new-luxc/source/luxc/lang.lux
+++ b/new-luxc/source/luxc/lang.lux
@@ -13,53 +13,6 @@
        (lang (type ["tc" check])))
   (luxc (lang ["la" analysis])))
 
-(type: #export Eval
-  (-> Type Code (Meta Top)))
-
-(def: #export (pl-get key table)
-  (All [a] (-> Text (List [Text a]) (Maybe a)))
-  (case table
-    #.Nil
-    #.None
-
-    (#.Cons [k' v'] table')
-    (if (text/= 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])))
-  (case table
-    #.Nil
-    (list [key val])
-
-    (#.Cons [k' v'] table')
-    (if (text/= key k')
-      (#.Cons [key val]
-              table')
-      (#.Cons [k' v']
-              (pl-put key val table')))))
-
-(def: #export (pl-update key f table)
-  (All [a] (-> Text (-> a a) (List [Text a]) (List [Text a])))
-  (case table
-    #.Nil
-    #.Nil
-
-    (#.Cons [k' v'] table')
-    (if (text/= key k')
-      (#.Cons [k' (f v')] table')
-      (#.Cons [k' v'] (pl-update key f table')))))
-
 (def: (normalize-char char)
   (-> Nat Text)
   (case char
diff --git a/new-luxc/source/luxc/lang/analysis.lux b/new-luxc/source/luxc/lang/analysis.lux
deleted file mode 100644
index 369e9dd7e..000000000
--- a/new-luxc/source/luxc/lang/analysis.lux
+++ /dev/null
@@ -1,111 +0,0 @@
-(.module:
-  lux
-  (lux [function]
-       (data (coll [list "list/" Fold<List>]))
-       (macro [code]))
-  (luxc (lang [".L" variable #+ Variable])))
-
-(type: #export Pattern Code)
-
-(type: #export Analysis Code)
-
-## Variants get analysed as binary sum types for the sake of semantic
-## simplicity.
-## This is because you can encode a variant of any size using just
-## binary sums by nesting them.
-
-(do-template [<name> <side>]
-  [(def: (<name> inner)
-     (-> Analysis Analysis)
-     (` (<side> (~ inner))))]
-
-  [sum-left  "lux sum left"]
-  [sum-right "lux sum right"])
-
-(def: (local-variable idx)
-  (-> Nat Int)
-  (nat-to-int idx))
-
-(def: #export (sum tag size temp value)
-  (-> Nat Nat Nat Analysis Analysis)
-  (if (n/= (n/dec size) tag)
-    (if (n/= +1 tag)
-      (sum-right value)
-      (list/fold (function.const sum-left)
-                 (sum-right value)
-                 (list.n/range +0 (n/- +2 tag))))
-    (list/fold (function.const sum-left)
-               (case value
-                 (^or (^code ("lux sum left" (~ inner)))
-                      (^code ("lux sum right" (~ inner))))
-                 (` ("lux case" (~ value)
-                     {("lux case bind" (~ (code.nat temp)))
-                      ((~ (code.int (local-variable temp))))}))
-
-                 _
-                 value)
-               (list.n/range +0 tag))))
-
-## Tuples get analysed into binary products for the sake of semantic
-## simplicity, since products/pairs can encode tuples of any length
-## through nesting.
-
-(def: #export (product members)
-  (-> (List Analysis) Analysis)
-  (case members
-    #.Nil
-    (` [])
-
-    (#.Cons singleton #.Nil)
-    singleton
-
-    (#.Cons left right)
-    (` [(~ left) (~ (product right))])))
-
-## Function application gets analysed into single-argument
-## applications, since every other kind of application can be encoded
-## into a finite series of single-argument applications.
-
-(def: #export (apply args func)
-  (-> (List Analysis) Analysis Analysis)
-  (list/fold (function (_ arg func)
-               (` ("lux apply" (~ arg) (~ func))))
-             func
-             args))
-
-(def: #export (procedure name args)
-  (-> Text (List Analysis) Analysis)
-  (` ((~ (code.text name)) (~+ args))))
-
-(def: #export (var idx)
-  (-> Variable Analysis)
-  (` ((~ (code.int idx)))))
-
-(def: #export (unfold-tuple analysis)
-  (-> Analysis (List Analysis))
-  (case analysis
-    (^code [(~ left) (~ right)])
-    (#.Cons left (unfold-tuple right))
-
-    _
-    (list analysis)))
-
-(def: #export (unfold-variant analysis)
-  (-> Analysis (Maybe [Nat Bool Analysis]))
-  (loop [so-far +0
-         variantA analysis]
-    (case variantA
-      (^code ("lux sum left" (~ valueA)))
-      (case valueA
-        (^or (^code ("lux sum left" (~ _)))
-             (^code ("lux sum right" (~ _))))
-        (recur (n/inc so-far) valueA)
-
-        _
-        (#.Some [so-far false valueA]))
-      
-      (^code ("lux sum right" (~ valueA)))
-      (#.Some [(n/inc so-far) true valueA])
-
-      _
-      #.None)))
diff --git a/new-luxc/source/luxc/lang/analysis/common.lux b/new-luxc/source/luxc/lang/analysis/common.lux
deleted file mode 100644
index 072616cfa..000000000
--- a/new-luxc/source/luxc/lang/analysis/common.lux
+++ /dev/null
@@ -1,21 +0,0 @@
-(.module:
-  lux
-  (lux (control monad
-                ["ex" exception #+ exception:])
-       (data text/format
-             [product])
-       [macro]
-       (lang [type]
-             (type ["tc" check])))
-  (luxc ["&" lang]
-        (lang analysis)))
-
-(exception: #export (Variant-Tag-Out-Of-Bounds {message Text})
-  message)
-
-(def: #export (variant-out-of-bounds-error type size tag)
-  (All [a] (-> Type Nat Nat (Meta a)))
-  (&.throw Variant-Tag-Out-Of-Bounds
-           (format "         Tag: " (%n tag) "\n"
-                   "Variant Size: " (%n size) "\n"
-                   "Variant Type: " (%type type))))
diff --git a/new-luxc/source/luxc/lang/analysis/expression.lux b/new-luxc/source/luxc/lang/analysis/expression.lux
deleted file mode 100644
index aaa64940b..000000000
--- a/new-luxc/source/luxc/lang/analysis/expression.lux
+++ /dev/null
@@ -1,126 +0,0 @@
-(.module:
-  lux
-  (lux (control [monad #+ do]
-                ["ex" exception #+ exception:])
-       (data ["e" error]
-             [product]
-             text/format)
-       [macro]
-       (lang [type]
-             (type ["tc" check]))
-       [host])
-  (luxc ["&" lang]
-        (lang ["&." module]
-              [".L" host]
-              [".L" macro]
-              [".L" extension]
-              ["la" analysis]
-              (translation (jvm [".T" common]))))
-  (// [".A" common]
-      [".A" function]
-      [".A" primitive]
-      [".A" reference]
-      [".A" structure]))
-
-(do-template [<name>]
-  [(exception: #export (<name> {message Text})
-     message)]
-
-  [Macro-Expression-Must-Have-Single-Expansion]
-  [Unrecognized-Syntax]
-  [Macro-Expansion-Failed]
-  )
-
-(def: #export (analyser eval)
-  (-> &.Eval &.Analyser)
-  (: (-> Code (Meta la.Analysis))
-     (function (analyse code)
-       (do macro.Monad<Meta>
-         [expectedT macro.expected-type]
-         (let [[cursor code'] code]
-           ## The cursor must be set in the compiler for the sake
-           ## of having useful error messages.
-           (&.with-cursor cursor
-             (case code'
-               (^template [<tag> <analyser>]
-                 (<tag> value)
-                 (<analyser> value))
-               ([#.Bool primitiveA.analyse-bool]
-                [#.Nat  primitiveA.analyse-nat]
-                [#.Int  primitiveA.analyse-int]
-                [#.Deg  primitiveA.analyse-deg]
-                [#.Frac primitiveA.analyse-frac]
-                [#.Text primitiveA.analyse-text])
-
-               (^ (#.Tuple (list)))
-               primitiveA.analyse-unit
-
-               ## Singleton tuples are equivalent to the element they contain.
-               (^ (#.Tuple (list singleton)))
-               (analyse singleton)
-
-               (^ (#.Tuple elems))
-               (structureA.analyse-product analyse elems)
-
-               (^ (#.Record pairs))
-               (structureA.analyse-record analyse pairs)
-
-               (#.Symbol reference)
-               (referenceA.analyse-reference reference)
-
-               (^ (#.Form (list& [_ (#.Text proc-name)] proc-args)))
-               (do macro.Monad<Meta>
-                 [procedure (extensionL.find-analysis proc-name)]
-                 (procedure analyse eval proc-args))
-
-               (^template [<tag> <analyser>]
-                 (^ (#.Form (list& [_ (<tag> tag)]
-                                   values)))
-                 (case values
-                   (#.Cons value #.Nil)
-                   (<analyser> analyse tag value)
-
-                   _
-                   (<analyser> analyse tag (` [(~+ values)]))))
-               ([#.Nat structureA.analyse-sum]
-                [#.Tag structureA.analyse-tagged-sum])
-
-               (#.Tag tag)
-               (structureA.analyse-tagged-sum analyse tag (' []))
-               
-               (^ (#.Form (list& func args)))
-               (do macro.Monad<Meta>
-                 [[funcT funcA] (commonA.with-unknown-type
-                                  (analyse func))]
-                 (case funcA
-                   [_ (#.Symbol def-name)]
-                   (do @
-                     [?macro (&.with-error-tracking
-                               (macro.find-macro def-name))]
-                     (case ?macro
-                       (#.Some macro)
-                       (do @
-                         [expansion (: (Meta (List Code))
-                                       (function (_ compiler)
-                                         (case (macroL.expand macro args compiler)
-                                           (#e.Error error)
-                                           ((&.throw Macro-Expansion-Failed error) compiler)
-
-                                           output
-                                           output)))]
-                         (case expansion
-                           (^ (list single))
-                           (analyse single)
-
-                           _
-                           (&.throw Macro-Expression-Must-Have-Single-Expansion (%code code))))
-
-                       _
-                       (functionA.analyse-apply analyse funcT funcA args)))
-
-                   _
-                   (functionA.analyse-apply analyse funcT funcA args)))
-
-               _
-               (&.throw Unrecognized-Syntax (%code code))
-               )))))))
diff --git a/new-luxc/source/luxc/lang/analysis/structure.lux b/new-luxc/source/luxc/lang/analysis/structure.lux
deleted file mode 100644
index f9e7ad8fc..000000000
--- a/new-luxc/source/luxc/lang/analysis/structure.lux
+++ /dev/null
@@ -1,365 +0,0 @@
-(.module:
-  lux
-  (lux (control [monad #+ do]
-                ["ex" exception #+ exception:])
-       (data [ident]
-             [number]
-             [product]
-             [maybe]
-             (coll [list "list/" Functor<List>]
-                   (dictionary ["dict" unordered #+ Dict]))
-             text/format)
-       [macro]
-       (macro [code])
-       (lang [type]
-             (type ["tc" check])))
-  (luxc ["&" lang]
-        (lang ["&." scope]
-              ["&." module]
-              ["la" analysis]
-              (analysis ["&." common]
-                        [".A" primitive]
-                        ["&." inference]))))
-
-(do-template [<name>]
-  [(exception: #export (<name> {message Text})
-     message)]
-
-  [Invalid-Variant-Type]
-  [Invalid-Tuple-Type]
-  [Not-Quantified-Type]
-
-  [Cannot-Analyse-Variant]
-  [Cannot-Analyse-Tuple]
-
-  [Cannot-Infer-Numeric-Tag]
-  [Record-Keys-Must-Be-Tags]
-  [Cannot-Repeat-Tag]
-  [Tag-Does-Not-Belong-To-Record]
-  [Record-Size-Mismatch]
-  )
-
-(def: #export (analyse-sum analyse tag valueC)
-  (-> &.Analyser Nat Code (Meta la.Analysis))
-  (do macro.Monad<Meta>
-    [expectedT macro.expected-type]
-    (&.with-stacked-errors
-      (function (_ _)
-        (ex.construct Cannot-Analyse-Variant
-                      (format "      Type: " (%type expectedT) "\n"
-                              "       Tag: " (%n tag) "\n"
-                              "Expression: " (%code  valueC))))
-      (case expectedT
-        (#.Sum _)
-        (let [flat (type.flatten-variant expectedT)
-              type-size (list.size flat)]
-          (case (list.nth tag flat)
-            (#.Some variant-type)
-            (do @
-              [valueA (&.with-type variant-type
-                        (analyse valueC))
-               temp &scope.next-local]
-              (wrap (la.sum tag type-size temp valueA)))
-
-            #.None
-            (&common.variant-out-of-bounds-error expectedT type-size tag)))
-
-        (#.Named name unnamedT)
-        (&.with-type unnamedT
-          (analyse-sum analyse tag valueC))
-
-        (#.Var id)
-        (do @
-          [?expectedT' (&.with-type-env
-                         (tc.read id))]
-          (case ?expectedT'
-            (#.Some expectedT')
-            (&.with-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.
-            (&.throw Cannot-Infer-Numeric-Tag
-                     (format "      Type: " (%type expectedT) "\n"
-                             "       Tag: " (%n tag) "\n"
-                             "Expression: " (%code  valueC)))
-            ))
-
-        (^template [<tag> <instancer>]
-          (<tag> _)
-          (do @
-            [[instance-id instanceT] (&.with-type-env <instancer>)]
-            (&.with-type (maybe.assume (type.apply (list instanceT) expectedT))
-              (analyse-sum analyse tag valueC))))
-        ([#.UnivQ tc.existential]
-         [#.ExQ tc.var])
-
-        (#.Apply inputT funT)
-        (case funT
-          (#.Var funT-id)
-          (do @
-            [?funT' (&.with-type-env (tc.read funT-id))]
-            (case ?funT'
-              (#.Some funT')
-              (&.with-type (#.Apply inputT funT')
-                (analyse-sum analyse tag valueC))
-
-              _
-              (&.throw Invalid-Variant-Type (format "      Type: " (%type expectedT) "\n"
-                                                    "       Tag: " (%n tag) "\n"
-                                                    "Expression: " (%code  valueC)))))
-
-          _
-          (case (type.apply (list inputT) funT)
-            #.None
-            (&.throw Not-Quantified-Type (%type funT))
-            
-            (#.Some outputT)
-            (&.with-type outputT
-              (analyse-sum analyse tag valueC))))
-        
-        _
-        (&.throw Invalid-Variant-Type (format "      Type: " (%type expectedT) "\n"
-                                              "       Tag: " (%n tag) "\n"
-                                              "Expression: " (%code  valueC)))))))
-
-(def: (analyse-typed-product analyse membersC+)
-  (-> &.Analyser (List Code) (Meta la.Analysis))
-  (do macro.Monad<Meta>
-    [expectedT macro.expected-type]
-    (loop [expectedT expectedT
-           membersC+ membersC+]
-      (case [expectedT membersC+]
-        ## If the tuple runs out, whatever expression is the last gets
-        ## matched to the remaining type.
-        [tailT (#.Cons tailC #.Nil)]
-        (&.with-type tailT
-          (analyse tailC))
-
-        ## If the type and the code are still ongoing, match each
-        ## sub-expression to its corresponding type.
-        [(#.Product leftT rightT) (#.Cons leftC rightC)]
-        (do @
-          [leftA (&.with-type leftT
-                   (analyse leftC))
-           rightA (recur rightT rightC)]
-          (wrap (` [(~ leftA) (~ rightA)])))
-
-        ## If, however, the type runs out but there is still enough
-        ## tail, the remaining elements get packaged into another
-        ## tuple, and analysed through the intermediation of a
-        ## temporary local variable.
-        ## The reason for this is that it is assumed that the type of
-        ## the tuple represents the expectations of the user.
-        ## If the type is for a 3-tuple, but a 5-tuple is provided, it
-        ## is assumed that the user intended the following layout:
-        ## [0, 1, [2, 3, 4]]
-        ## but that, for whatever reason, it was written in a flat
-        ## way.
-        ## The reason why an intermediate variable is used is that if
-        ## the code was just re-written with just tuple nesting, the
-        ## resulting analysis would have undone the explicity nesting,
-        ## since Product nodes rely on nesting inherently, thereby
-        ## blurring the line between what was wanted (the separation)
-        ## and what was analysed.
-        [tailT tailC]
-        (macro.with-gensyms [g!tail]
-          (&.with-type tailT
-            (analyse (` ("lux case" [(~+ tailC)]
-                         (~ g!tail)
-                         (~ g!tail))))))
-        ))))
-
-(def: #export (analyse-product analyse membersC)
-  (-> &.Analyser (List Code) (Meta la.Analysis))
-  (do macro.Monad<Meta>
-    [expectedT macro.expected-type]
-    (&.with-stacked-errors
-      (function (_ _)
-        (ex.construct Cannot-Analyse-Tuple
-                      (format "      Type: " (%type expectedT) "\n"
-                              "Expression: " (%code (` [(~+ membersC)])))))
-      (case expectedT
-        (#.Product _)
-        (analyse-typed-product analyse membersC)
-
-        (#.Named name unnamedT)
-        (&.with-type unnamedT
-          (analyse-product analyse membersC))
-
-        (#.Var id)
-        (do @
-          [?expectedT' (&.with-type-env
-                         (tc.read id))]
-          (case ?expectedT'
-            (#.Some expectedT')
-            (&.with-type expectedT'
-              (analyse-product analyse membersC))
-
-            _
-            ## Must do inference...
-            (do @
-              [membersTA (monad.map @ (|>> analyse &common.with-unknown-type)
-                                    membersC)
-               _ (&.with-type-env
-                   (tc.check expectedT
-                             (type.tuple (list/map product.left membersTA))))]
-              (wrap (la.product (list/map product.right membersTA))))))
-
-        (^template [<tag> <instancer>]
-          (<tag> _)
-          (do @
-            [[instance-id instanceT] (&.with-type-env <instancer>)]
-            (&.with-type (maybe.assume (type.apply (list instanceT) expectedT))
-              (analyse-product analyse membersC))))
-        ([#.UnivQ tc.existential]
-         [#.ExQ tc.var])
-
-        (#.Apply inputT funT)
-        (case funT
-          (#.Var funT-id)
-          (do @
-            [?funT' (&.with-type-env (tc.read funT-id))]
-            (case ?funT'
-              (#.Some funT')
-              (&.with-type (#.Apply inputT funT')
-                (analyse-product analyse membersC))
-
-              _
-              (&.throw Invalid-Tuple-Type
-                       (format "      Type: " (%type expectedT) "\n"
-                               "Expression: " (%code (` [(~+ membersC)]))))))
-
-          _
-          (case (type.apply (list inputT) funT)
-            #.None
-            (&.throw Not-Quantified-Type (%type funT))
-            
-            (#.Some outputT)
-            (&.with-type outputT
-              (analyse-product analyse membersC))))
-        
-        _
-        (&.throw Invalid-Tuple-Type
-                 (format "      Type: " (%type expectedT) "\n"
-                         "Expression: " (%code (` [(~+ membersC)]))))
-        ))))
-
-(def: #export (analyse-tagged-sum analyse tag valueC)
-  (-> &.Analyser Ident Code (Meta la.Analysis))
-  (do macro.Monad<Meta>
-    [tag (macro.normalize tag)
-     [idx group variantT] (macro.resolve-tag tag)
-     expectedT macro.expected-type]
-    (case expectedT
-      (#.Var _)
-      (do @
-        [#let [case-size (list.size group)]
-         inferenceT (&inference.variant idx case-size variantT)
-         [inferredT valueA+] (&inference.general analyse inferenceT (list valueC))
-         temp &scope.next-local]
-        (wrap (la.sum idx case-size temp (|> valueA+ list.head maybe.assume))))
-
-      _
-      (analyse-sum analyse idx valueC))))
-
-## There cannot be any ambiguity or improper syntax when analysing
-## records, so they must be normalized for further analysis.
-## Normalization just means that all the tags get resolved to their
-## canonical form (with their corresponding module identified).
-(def: #export (normalize record)
-  (-> (List [Code Code]) (Meta (List [Ident Code])))
-  (monad.map macro.Monad<Meta>
-             (function (_ [key val])
-               (case key
-                 [_ (#.Tag key)]
-                 (do macro.Monad<Meta>
-                   [key (macro.normalize key)]
-                   (wrap [key val]))
-
-                 _
-                 (&.throw Record-Keys-Must-Be-Tags
-                          (format "   Key: " (%code key) "\n"
-                                  "Record: " (%code (code.record record))))))
-             record))
-
-## Lux already possesses the means to analyse tuples, so
-## re-implementing the same functionality for records makes no sense.
-## Records, thus, get transformed into tuples by ordering the elements.
-(def: #export (order record)
-  (-> (List [Ident Code]) (Meta [(List Code) Type]))
-  (case record
-    ## empty-record = empty-tuple = unit = []
-    #.Nil
-    (:: macro.Monad<Meta> wrap [(list) Top])
-
-    (#.Cons [head-k head-v] _)
-    (do macro.Monad<Meta>
-      [head-k (macro.normalize head-k)
-       [_ tag-set recordT] (macro.resolve-tag head-k)
-       #let [size-record (list.size record)
-             size-ts (list.size tag-set)]
-       _ (if (n/= size-ts size-record)
-           (wrap [])
-           (&.throw Record-Size-Mismatch
-                    (format "  Expected: " (|> size-ts nat-to-int %i) "\n"
-                            "    Actual: " (|> size-record nat-to-int %i) "\n"
-                            "      Type: " (%type recordT) "\n"
-                            "Expression: " (%code (|> record
-                                                      (list/map (function (_ [keyI valueC])
-                                                                  [(code.tag keyI) valueC]))
-                                                      code.record)))))
-       #let [tuple-range (list.n/range +0 (n/dec size-ts))
-             tag->idx (dict.from-list ident.Hash<Ident> (list.zip2 tag-set tuple-range))]
-       idx->val (monad.fold @
-                            (function (_ [key val] idx->val)
-                              (do @
-                                [key (macro.normalize key)]
-                                (case (dict.get key tag->idx)
-                                  #.None
-                                  (&.throw Tag-Does-Not-Belong-To-Record
-                                           (format " Tag: " (%code (code.tag key)) "\n"
-                                                   "Type: " (%type recordT)))
-
-                                  (#.Some idx)
-                                  (if (dict.contains? idx idx->val)
-                                    (&.throw Cannot-Repeat-Tag
-                                             (format "   Tag: " (%code (code.tag key)) "\n"
-                                                     "Record: " (%code (code.record (list/map (function (_ [keyI valC])
-                                                                                                [(code.tag keyI) valC])
-                                                                                              record)))))
-                                    (wrap (dict.put idx val idx->val))))))
-                            (: (Dict Nat Code)
-                               (dict.new number.Hash<Nat>))
-                            record)
-       #let [ordered-tuple (list/map (function (_ idx) (maybe.assume (dict.get idx idx->val)))
-                                     tuple-range)]]
-      (wrap [ordered-tuple recordT]))
-    ))
-
-(def: #export (analyse-record analyse members)
-  (-> &.Analyser (List [Code Code]) (Meta la.Analysis))
-  (do macro.Monad<Meta>
-    [members (normalize members)
-     [membersC recordT] (order members)]
-    (case membersC
-      (^ (list))
-      primitiveA.analyse-unit
-      
-      (^ (list singletonC))
-      (analyse singletonC)
-
-      _
-      (do @
-        [expectedT macro.expected-type]
-        (case expectedT
-          (#.Var _)
-          (do @
-            [inferenceT (&inference.record recordT)
-             [inferredT membersA] (&inference.general analyse inferenceT membersC)]
-            (wrap (la.product membersA)))
-
-          _
-          (analyse-product analyse membersC))))))
diff --git a/new-luxc/source/luxc/lang/module.lux b/new-luxc/source/luxc/lang/module.lux
deleted file mode 100644
index 8e24d0cf4..000000000
--- a/new-luxc/source/luxc/lang/module.lux
+++ /dev/null
@@ -1,234 +0,0 @@
-(.module:
-  lux
-  (lux (control [monad #+ do]
-                ["ex" exception #+ exception:]
-                pipe)
-       (data [text "text/" Eq<Text>]
-             text/format
-             ["e" error]
-             (coll [list "list/" Fold<List> Functor<List>]))
-       [macro]
-       (macro [code]))
-  (luxc ["&" lang]
-        (lang ["&." scope])))
-
-(do-template [<name>]
-  [(exception: #export (<name> {message Text})
-     message)]
-
-  [Unknown-Module]
-  [Cannot-Declare-Tag-Twice]
-  [Cannot-Declare-Tags-For-Unnamed-Type]
-  [Cannot-Declare-Tags-For-Foreign-Type]
-  [Cannot-Define-More-Than-Once]
-  [Cannot-Define-In-Unknown-Module]
-  [Can-Only-Change-State-Of-Active-Module]
-  [Cannot-Set-Module-Annotations-More-Than-Once]
-  )
-
-(def: (new-module hash)
-  (-> Nat Module)
-  {#.module-hash        hash
-   #.module-aliases     (list)
-   #.definitions        (list)
-   #.imports            (list)
-   #.tags               (list)
-   #.types              (list)
-   #.module-annotations #.None
-   #.module-state       #.Active})
-
-(def: #export (set-annotations annotations)
-  (-> Code (Meta Top))
-  (do macro.Monad<Meta>
-    [self-name macro.current-module-name
-     self macro.current-module]
-    (case (get@ #.module-annotations self)
-      #.None
-      (function (_ compiler)
-        (#e.Success [(update@ #.modules
-                              (&.pl-put self-name (set@ #.module-annotations (#.Some annotations) self))
-                              compiler)
-                     []]))
-      
-      (#.Some old)
-      (&.throw Cannot-Set-Module-Annotations-More-Than-Once
-               (format "         Module: " self-name "\n"
-                       "Old annotations: " (%code old) "\n"
-                       "New annotations: " (%code annotations) "\n")))))
-
-(def: #export (import module)
-  (-> Text (Meta Top))
-  (do macro.Monad<Meta>
-    [self macro.current-module-name]
-    (function (_ compiler)
-      (#e.Success [(update@ #.modules
-                            (&.pl-update self (update@ #.imports (|>> (#.Cons module))))
-                            compiler)
-                   []]))))
-
-(def: #export (alias alias module)
-  (-> Text Text (Meta Top))
-  (do macro.Monad<Meta>
-    [self macro.current-module-name]
-    (function (_ compiler)
-      (#e.Success [(update@ #.modules
-                            (&.pl-update self (update@ #.module-aliases (: (-> (List [Text Text]) (List [Text Text]))
-                                                                           (|>> (#.Cons [alias module])))))
-                            compiler)
-                   []]))))
-
-(def: #export (exists? module)
-  (-> Text (Meta Bool))
-  (function (_ compiler)
-    (|> (get@ #.modules compiler)
-        (&.pl-get module)
-        (case> (#.Some _) true #.None false)
-        [compiler] #e.Success)))
-
-(def: #export (define (^@ full-name [module-name def-name])
-                      definition)
-  (-> Ident Definition (Meta Top))
-  (function (_ compiler)
-    (case (&.pl-get module-name (get@ #.modules compiler))
-      (#.Some module)
-      (case (&.pl-get def-name (get@ #.definitions module))
-        #.None
-        (#e.Success [(update@ #.modules
-                              (&.pl-put module-name
-                                        (update@ #.definitions
-                                                 (: (-> (List [Text Definition]) (List [Text Definition]))
-                                                    (|>> (#.Cons [def-name definition])))
-                                                 module))
-                              compiler)
-                     []])
-
-        (#.Some already-existing)
-        ((&.throw Cannot-Define-More-Than-Once (%ident full-name)) compiler))
-
-      #.None
-      ((&.throw Cannot-Define-In-Unknown-Module (%ident full-name)) compiler))))
-
-(def: #export (create hash name)
-  (-> Nat Text (Meta Module))
-  (function (_ compiler)
-    (let [module (new-module hash)]
-      (#e.Success [(update@ #.modules
-                            (&.pl-put name module)
-                            compiler)
-                   module]))))
-
-(def: #export (with-module hash name action)
-  (All [a] (-> Nat Text (Meta a) (Meta [Module a])))
-  (do macro.Monad<Meta>
-    [_ (create hash name)
-     output (&.with-current-module name
-              action)
-     module (macro.find-module name)]
-    (wrap [module output])))
-
-(do-template [<flagger> <asker> <tag> <description>]
-  [(def: #export (<flagger> module-name)
-     (-> Text (Meta Top))
-     (function (_ compiler)
-       (case (|> compiler (get@ #.modules) (&.pl-get module-name))
-         (#.Some module)
-         (let [active? (case (get@ #.module-state module)
-                         #.Active true
-                         _     false)]
-           (if active?
-             (#e.Success [(update@ #.modules
-                                   (&.pl-put module-name (set@ #.module-state <tag> module))
-                                   compiler)
-                          []])
-             ((&.throw Can-Only-Change-State-Of-Active-Module
-                       (format "       Module: " module-name "\n"
-                               "Desired state: " <description>))
-              compiler)))
-
-         #.None
-         ((&.throw Unknown-Module module-name) compiler))))
-   (def: #export (<asker> module-name)
-     (-> Text (Meta Bool))
-     (function (_ compiler)
-       (case (|> compiler (get@ #.modules) (&.pl-get module-name))
-         (#.Some module)
-         (#e.Success [compiler
-                      (case (get@ #.module-state module)
-                        <tag> true
-                        _     false)])
-
-         #.None
-         ((&.throw Unknown-Module module-name) compiler))
-       ))]
-
-  [flag-active!   active?   #.Active   "Active"]
-  [flag-compiled! compiled? #.Compiled "Compiled"]
-  [flag-cached!   cached?   #.Cached   "Cached"]
-  )
-
-(do-template [<name> <tag> <type>]
-  [(def: (<name> module-name)
-     (-> Text (Meta <type>))
-     (function (_ compiler)
-       (case (|> compiler (get@ #.modules) (&.pl-get module-name))
-         (#.Some module)
-         (#e.Success [compiler (get@ <tag> module)])
-
-         #.None
-         ((&.throw Unknown-Module module-name) compiler))
-       ))]
-
-  [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) (Meta Top))
-  (do macro.Monad<Meta>
-    [bindings (tags-by-module module-name)
-     _ (monad.map @
-                  (function (_ tag)
-                    (case (&.pl-get tag bindings)
-                      #.None
-                      (wrap [])
-
-                      (#.Some _)
-                      (&.throw Cannot-Declare-Tag-Twice (format "Module: " module-name "\n"
-                                                                "   Tag: " tag))))
-                  tags)]
-    (wrap [])))
-
-(def: #export (declare-tags tags exported? type)
-  (-> (List Text) Bool Type (Meta Top))
-  (do macro.Monad<Meta>
-    [current-module macro.current-module-name
-     [type-module type-name] (case type
-                               (#.Named type-ident _)
-                               (wrap type-ident)
-
-                               _
-                               (&.throw Cannot-Declare-Tags-For-Unnamed-Type
-                                        (format "Tags: " (|> tags (list/map code.text) code.tuple %code) "\n"
-                                                "Type: " (%type type))))
-     _ (ensure-undeclared-tags current-module tags)
-     _ (&.assert Cannot-Declare-Tags-For-Foreign-Type
-                 (format "Tags: " (|> tags (list/map code.text) code.tuple %code) "\n"
-                         "Type: " (%type type))
-                 (text/= current-module type-module))]
-    (function (_ compiler)
-      (case (|> compiler (get@ #.modules) (&.pl-get current-module))
-        (#.Some module)
-        (let [namespaced-tags (list/map (|>> [current-module]) tags)]
-          (#e.Success [(update@ #.modules
-                                (&.pl-update current-module
-                                             (|>> (update@ #.tags (function (_ tag-bindings)
-                                                                    (list/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
-        ((&.throw Unknown-Module current-module) compiler)))))
diff --git a/new-luxc/source/luxc/lang/analysis/inference.lux b/stdlib/source/lux/lang/analysis/inference.lux
index 9bc668050..732a8e6e3 100644
--- a/new-luxc/source/luxc/lang/analysis/inference.lux
+++ b/stdlib/source/lux/lang/analysis/inference.lux
@@ -7,33 +7,41 @@
              text/format
              (coll [list "list/" Functor<List>]))
        [macro "macro/" Monad<Meta>]
+       [lang]
        (lang [type]
-             (type ["tc" check])))
-  (luxc ["&" lang]
-        (lang ["la" analysis #+ Analysis]
-              (analysis ["&." common]))))
+             (type ["tc" check])
+             [analysis #+ Analysis Analyser]
+             (analysis [".A" type]))))
+
+(exception: #export (variant-tag-out-of-bounds {size Nat} {tag analysis.Tag} {type Type})
+  (ex.report ["Tag" (%n tag)]
+             ["Variant size" (%n size)]
+             ["Variant type" (%type type)]))
+
+(exception: #export (cannot-infer {type Type} {args (List Code)})
+  (ex.report ["Type" (%type type)]
+             ["Arguments" (|> args
+                              list.enumerate
+                              (list/map (function (_ [idx argC])
+                                          (format "\n  " (%n idx) " " (%code argC))))
+                              (text.join-with ""))]))
+
+(exception: #export (cannot-infer-argument {inferred Type} {argument Code})
+  (ex.report ["Inferred Type" (%type inferred)]
+             ["Argument" (%code argument)]))
+
+(exception: #export (smaller-variant-than-expected {expected Nat} {actual Nat})
+  (ex.report ["Expected" (%i (.int expected))]
+             ["Actual" (%i (.int actual))]))
 
 (do-template [<name>]
-  [(exception: #export (<name> {message Text})
-     message)]
-
-  [Cannot-Infer]
-  [Cannot-Infer-Argument]
-  [Smaller-Variant-Than-Expected]
-  [Invalid-Type-Application]
-  [Not-A-Record-Type]
-  [Not-A-Variant-Type]
-  )
+  [(exception: #export (<name> {type Type})
+     (%type type))]
 
-(def: (cannot-infer type args)
-  (-> Type (List Code) Text)
-  (format "     Type: " (%type type) "\n"
-          "Arguments:"
-          (|> args
-              list.enumerate
-              (list/map (function (_ [idx argC])
-                          (format "\n  " (%n idx) " " (%code argC))))
-              (text.join-with ""))))
+  [not-a-variant-type]
+  [not-a-record-type]
+  [invalid-type-application]
+  )
 
 (def: (replace-bound bound-idx replacementT type)
   (-> Nat Type Type Type)
@@ -69,7 +77,7 @@
   (Meta Type)
   (do macro.Monad<Meta>
     [[_module _line _column] macro.cursor
-     [ex-id exT] (&.with-type-env tc.existential)]
+     [ex-id exT] (typeA.with-env tc.existential)]
     (wrap (#.Primitive (format "{New Type @ " (%t _module)
                                "," (%n _line)
                                "," (%n _column)
@@ -84,11 +92,11 @@
 ## But, so long as the type being used for the inference can be treated
 ## as a function type, this method of inference should work.
 (def: #export (general analyse inferT args)
-  (-> &.Analyser Type (List Code) (Meta [Type (List Analysis)]))
+  (-> Analyser Type (List Code) (Meta [Type (List Analysis)]))
   (case args
     #.Nil
     (do macro.Monad<Meta>
-      [_ (&.infer inferT)]
+      [_ (typeA.infer inferT)]
       (wrap [inferT (list)]))
     
     (#.Cons argC args')
@@ -98,22 +106,22 @@
 
       (#.UnivQ _)
       (do macro.Monad<Meta>
-        [[var-id varT] (&.with-type-env tc.var)]
+        [[var-id varT] (typeA.with-env tc.var)]
         (general analyse (maybe.assume (type.apply (list varT) inferT)) args))
 
       (#.ExQ _)
       (do macro.Monad<Meta>
-        [[var-id varT] (&.with-type-env tc.var)
+        [[var-id varT] (typeA.with-env tc.var)
          output (general analyse
                          (maybe.assume (type.apply (list varT) inferT))
                          args)
-         bound? (&.with-type-env
+         bound? (typeA.with-env
                   (tc.bound? var-id))
          _ (if bound?
              (wrap [])
              (do @
                [newT new-named-type]
-               (&.with-type-env
+               (typeA.with-env
                  (tc.check varT newT))))]
         (wrap output))
 
@@ -123,7 +131,7 @@
         (general analyse outputT args)
 
         #.None
-        (&.throw Invalid-Type-Application (%type inferT)))
+        (lang.throw invalid-type-application inferT))
 
       ## Arguments are inferred back-to-front because, by convention,
       ## Lux functions take the most important arguments *last*, which
@@ -135,27 +143,25 @@
       (#.Function inputT outputT)
       (do macro.Monad<Meta>
         [[outputT' args'A] (general analyse outputT args')
-         argA (&.with-stacked-errors
+         argA (lang.with-stacked-errors
                 (function (_ _)
-                  (ex.construct Cannot-Infer-Argument
-                                (format "Inferred Type: " (%type inputT) "\n"
-                                        "     Argument: " (%code argC))))
-                (&.with-type inputT
+                  (ex.construct cannot-infer-argument [inputT argC]))
+                (typeA.with-type inputT
                   (analyse argC)))]
         (wrap [outputT' (list& argA args'A)]))
 
       (#.Var infer-id)
       (do macro.Monad<Meta>
-        [?inferT' (&.with-type-env (tc.read infer-id))]
+        [?inferT' (typeA.with-env (tc.read infer-id))]
         (case ?inferT'
           (#.Some inferT')
           (general analyse inferT' args)
 
           _
-          (&.throw Cannot-Infer (cannot-infer inferT args))))
+          (lang.throw cannot-infer [inferT args])))
 
       _
-      (&.throw Cannot-Infer (cannot-infer inferT args)))
+      (lang.throw cannot-infer [inferT args]))
     ))
 
 ## Turns a record type into the kind of function type suitable for inference.
@@ -179,13 +185,13 @@
       (record outputT)
 
       #.None
-      (&.throw Invalid-Type-Application (%type inferT)))
+      (lang.throw invalid-type-application inferT))
 
     (#.Product _)
     (macro/wrap (type.function (type.flatten-tuple inferT) inferT))
 
     _
-    (&.throw Not-A-Record-Type (%type inferT))))
+    (lang.throw not-a-record-type inferT)))
 
 ## Turns a variant type into the kind of function type suitable for inference.
 (def: #export (variant tag expected-size inferT)
@@ -201,7 +207,7 @@
       (^template [<tag>]
         (<tag> env bodyT)
         (do macro.Monad<Meta>
-          [bodyT+ (recur (n/inc depth) bodyT)]
+          [bodyT+ (recur (inc depth) bodyT)]
           (wrap (<tag> env bodyT+))))
       ([#.UnivQ]
        [#.ExQ])
@@ -209,7 +215,7 @@
       (#.Sum _)
       (let [cases (type.flatten-variant currentT)
             actual-size (list.size cases)
-            boundary (n/dec expected-size)]
+            boundary (dec expected-size)]
         (cond (or (n/= expected-size actual-size)
                   (and (n/> expected-size actual-size)
                        (n/< boundary tag)))
@@ -217,28 +223,26 @@
                 (#.Some caseT)
                 (macro/wrap (if (n/= +0 depth)
                               (type.function (list caseT) currentT)
-                              (let [replace! (replace-bound (|> depth n/dec (n/* +2)) inferT)]
+                              (let [replace! (replace-bound (|> depth dec (n/* +2)) inferT)]
                                 (type.function (list (replace! caseT))
                                   (replace! currentT)))))
 
                 #.None
-                (&common.variant-out-of-bounds-error inferT expected-size tag))
+                (lang.throw variant-tag-out-of-bounds [expected-size tag inferT]))
               
               (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))))
+              (lang.throw smaller-variant-than-expected [expected-size actual-size])
 
               (n/= boundary tag)
               (let [caseT (type.variant (list.drop boundary cases))]
                 (macro/wrap (if (n/= +0 depth)
                               (type.function (list caseT) currentT)
-                              (let [replace! (replace-bound (|> depth n/dec (n/* +2)) inferT)]
+                              (let [replace! (replace-bound (|> depth dec (n/* +2)) inferT)]
                                 (type.function (list (replace! caseT))
                                   (replace! currentT))))))
               
               ## else
-              (&common.variant-out-of-bounds-error inferT expected-size tag)))
+              (lang.throw variant-tag-out-of-bounds [expected-size tag inferT])))
 
       (#.Apply inputT funcT)
       (case (type.apply (list inputT) funcT)
@@ -246,7 +250,7 @@
         (variant tag expected-size outputT)
 
         #.None
-        (&.throw Invalid-Type-Application (%type inferT)))
+        (lang.throw invalid-type-application inferT))
 
       _
-      (&.throw Not-A-Variant-Type (%type inferT)))))
+      (lang.throw not-a-variant-type inferT))))