- Adapted new-luxc's code to latest stdlib changes.

8 files changed, 116 insertions, 77 deletions

diff --git a/new-luxc/source/luxc/lang/analysis.lux b/new-luxc/source/luxc/lang/analysis.lux
index e33f51927..369e9dd7e 100644
--- a/new-luxc/source/luxc/lang/analysis.lux
+++ b/new-luxc/source/luxc/lang/analysis.lux
@@ -68,7 +68,7 @@
 
 (def: #export (apply args func)
   (-> (List Analysis) Analysis Analysis)
-  (list/fold (function [arg func]
+  (list/fold (function (_ arg func)
                (` ("lux apply" (~ arg) (~ func))))
              func
              args))
diff --git a/new-luxc/source/luxc/lang/analysis/case.lux b/new-luxc/source/luxc/lang/analysis/case.lux
index c40bb2ac3..a9731a1d7 100644
--- a/new-luxc/source/luxc/lang/analysis/case.lux
+++ b/new-luxc/source/luxc/lang/analysis/case.lux
@@ -22,13 +22,18 @@
                         [".A" structure]
                         (case [".A" coverage])))))
 
-(exception: #export Cannot-Match-Type-With-Pattern)
-(exception: #export Sum-Type-Has-No-Case)
-(exception: #export Unrecognized-Pattern-Syntax)
-(exception: #export Cannot-Simplify-Type-For-Pattern-Matching)
-(exception: #export Cannot-Have-Empty-Branches)
-(exception: #export Non-Exhaustive-Pattern-Matching)
-(exception: #export Symbols-Must-Be-Unqualified-Inside-Patterns)
+(do-template [<name>]
+  [(exception: #export (<name> {message Text})
+     message)]
+
+  [Cannot-Match-Type-With-Pattern]
+  [Sum-Type-Has-No-Case]
+  [Unrecognized-Pattern-Syntax]
+  [Cannot-Simplify-Type-For-Pattern-Matching]
+  [Cannot-Have-Empty-Branches]
+  [Non-Exhaustive-Pattern-Matching]
+  [Symbols-Must-Be-Unqualified-Inside-Patterns]
+  )
 
 (def: (pattern-error type pattern)
   (-> Type Code Text)
@@ -204,7 +209,7 @@
               [[memberP+ thenA] (list/fold (: (All [a]
                                                 (-> [Type Code] (Meta [(List la.Pattern) a])
                                                     (Meta [(List la.Pattern) a])))
-                                              (function [[memberT memberC] then]
+                                              (function (_ [memberT memberC] then)
                                                 (do @
                                                   [[memberP [memberP+ thenA]] ((:! (All [a] (-> (Maybe Nat) Type Code (Meta a) (Meta [la.Pattern a])))
                                                                                    analyse-pattern)
@@ -292,7 +297,7 @@
                          (analyse inputC))
        outputH (analyse-pattern #.None inputT patternH (analyse bodyH))
        outputT (monad.map @
-                          (function [[patternT bodyT]]
+                          (function (_ [patternT bodyT])
                             (analyse-pattern #.None inputT patternT (analyse bodyT)))
                           branchesT)
        outputHC (|> outputH product.left coverageA.determine)
diff --git a/new-luxc/source/luxc/lang/analysis/case/coverage.lux b/new-luxc/source/luxc/lang/analysis/case/coverage.lux
index ae72b47e4..b81a3b7a9 100644
--- a/new-luxc/source/luxc/lang/analysis/case/coverage.lux
+++ b/new-luxc/source/luxc/lang/analysis/case/coverage.lux
@@ -13,6 +13,9 @@
   (luxc ["&" lang]
         (lang ["la" analysis])))
 
+(exception: #export (Unknown-Pattern {message Text})
+  message)
+
 ## The coverage of a pattern-matching expression summarizes how well
 ## all the possible values of an input are being covered by the
 ## different patterns involved.
@@ -42,8 +45,6 @@
     _
     false))
 
-(exception: #export Unknown-Pattern)
-
 (def: #export (determine pattern)
   (-> la.Pattern (Meta Coverage))
   (case pattern
@@ -142,7 +143,7 @@
       (let [flatR (flatten-alt reference)
             flatS (flatten-alt sample)]
         (and (n/= (list.size flatR) (list.size flatS))
-             (list.every? (function [[coverageR coverageS]]
+             (list.every? (function (_ [coverageR coverageS])
                             (= coverageR coverageS))
                           (list.zip2 flatR flatS))))
 
@@ -184,7 +185,7 @@
           ## else
           (do e.Monad<Error>
             [casesM (monad.fold @
-                                (function [[tagA coverageA] casesSF']
+                                (function (_ [tagA coverageA] casesSF')
                                   (case (dict.get tagA casesSF')
                                     (#.Some coverageSF)
                                     (do @
@@ -251,7 +252,7 @@
       [#let [fuse-once (: (-> Coverage (List Coverage)
                               (e.Error [(Maybe Coverage)
                                         (List Coverage)]))
-                          (function [coverage possibilities]
+                          (function (_ coverage possibilities)
                             (loop [alts possibilities]
                               (case alts
                                 #.Nil
@@ -284,7 +285,7 @@
           #.None
           (case (list.reverse possibilities)
             (#.Cons last prevs)
-            (wrap (list/fold (function [left right] (#Alt left right))
+            (wrap (list/fold (function (_ left right) (#Alt left right))
                              last
                              prevs))
 
diff --git a/new-luxc/source/luxc/lang/analysis/common.lux b/new-luxc/source/luxc/lang/analysis/common.lux
index aeed656a8..c4ff4bfde 100644
--- a/new-luxc/source/luxc/lang/analysis/common.lux
+++ b/new-luxc/source/luxc/lang/analysis/common.lux
@@ -19,7 +19,8 @@
      knownT (&.with-type-env (tc.clean varT))]
     (wrap [knownT analysis])))
 
-(exception: #export Variant-Tag-Out-Of-Bounds)
+(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)))
diff --git a/new-luxc/source/luxc/lang/analysis/expression.lux b/new-luxc/source/luxc/lang/analysis/expression.lux
index 8907ba665..aaa64940b 100644
--- a/new-luxc/source/luxc/lang/analysis/expression.lux
+++ b/new-luxc/source/luxc/lang/analysis/expression.lux
@@ -22,14 +22,19 @@
       [".A" reference]
       [".A" structure]))
 
-(exception: #export Macro-Expression-Must-Have-Single-Expansion)
-(exception: #export Unrecognized-Syntax)
-(exception: #export Macro-Expansion-Failed)
+(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]
+     (function (analyse code)
        (do macro.Monad<Meta>
          [expectedT macro.expected-type]
          (let [[cursor code'] code]
@@ -96,7 +101,7 @@
                        (#.Some macro)
                        (do @
                          [expansion (: (Meta (List Code))
-                                       (function [compiler]
+                                       (function (_ compiler)
                                          (case (macroL.expand macro args compiler)
                                            (#e.Error error)
                                            ((&.throw Macro-Expansion-Failed error) compiler)
diff --git a/new-luxc/source/luxc/lang/analysis/function.lux b/new-luxc/source/luxc/lang/analysis/function.lux
index a502a9d19..eaddfa5bb 100644
--- a/new-luxc/source/luxc/lang/analysis/function.lux
+++ b/new-luxc/source/luxc/lang/analysis/function.lux
@@ -17,9 +17,14 @@
                         ["&." inference])
               [".L" variable #+ Variable])))
 
-(exception: #export Cannot-Analyse-Function)
-(exception: #export Invalid-Function-Type)
-(exception: #export Cannot-Apply-Function)
+(do-template [<name>]
+  [(exception: #export (<name> {message Text})
+     message)]
+
+  [Cannot-Analyse-Function]
+  [Invalid-Function-Type]
+  [Cannot-Apply-Function]
+  )
 
 ## [Analysers]
 (def: #export (analyse-function analyse func-name arg-name body)
@@ -28,10 +33,12 @@
     [functionT macro.expected-type]
     (loop [expectedT functionT]
       (&.with-stacked-errors
-        (function [_] (Cannot-Analyse-Function (format "    Type: " (%type expectedT) "\n"
-                                                       "Function: " func-name "\n"
-                                                       "Argument: " arg-name "\n"
-                                                       "    Body: " (%code body))))
+        (function (_ _)
+          (ex.construct Cannot-Analyse-Function
+                        (format "    Type: " (%type expectedT) "\n"
+                                "Function: " func-name "\n"
+                                "Argument: " arg-name "\n"
+                                "    Body: " (%code body))))
         (case expectedT
           (#.Named name unnamedT)
           (recur unnamedT)
@@ -73,7 +80,7 @@
               ))
 
           (#.Function inputT outputT)
-          (<| (:: @ map (function [[scope bodyA]]
+          (<| (:: @ map (function (_ [scope bodyA])
                           (` ("lux function" [(~+ (list/map code.int (variableL.environment scope)))]
                               (~ bodyA)))))
               &.with-scope
@@ -91,13 +98,14 @@
 (def: #export (analyse-apply analyse funcT funcA args)
   (-> &.Analyser Type Analysis (List Code) (Meta Analysis))
   (&.with-stacked-errors
-    (function [_]
-      (Cannot-Apply-Function (format " Function: " (%type funcT) "\n"
-                                     "Arguments:" (|> args
-                                                      list.enumerate
-                                                      (list/map (function [[idx argC]]
-                                                                  (format "\n  " (%n idx) " " (%code argC))))
-                                                      (text.join-with "")))))
+    (function (_ _)
+      (ex.construct Cannot-Apply-Function
+                    (format " Function: " (%type funcT) "\n"
+                            "Arguments:" (|> args
+                                             list.enumerate
+                                             (list/map (function (_ [idx argC])
+                                                         (format "\n  " (%n idx) " " (%code argC))))
+                                             (text.join-with "")))))
     (do macro.Monad<Meta>
       [[applyT argsA] (&inference.general analyse funcT args)]
       (wrap (la.apply argsA funcA)))))
diff --git a/new-luxc/source/luxc/lang/analysis/inference.lux b/new-luxc/source/luxc/lang/analysis/inference.lux
index 3919ff78d..9bc668050 100644
--- a/new-luxc/source/luxc/lang/analysis/inference.lux
+++ b/new-luxc/source/luxc/lang/analysis/inference.lux
@@ -13,23 +13,28 @@
         (lang ["la" analysis #+ Analysis]
               (analysis ["&." common]))))
 
-(exception: #export Cannot-Infer)
+(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]
+  )
+
 (def: (cannot-infer type args)
   (-> Type (List Code) Text)
   (format "     Type: " (%type type) "\n"
           "Arguments:"
           (|> args
               list.enumerate
-              (list/map (function [[idx argC]]
+              (list/map (function (_ [idx argC])
                           (format "\n  " (%n idx) " " (%code argC))))
               (text.join-with ""))))
 
-(exception: #export Cannot-Infer-Argument)
-(exception: #export Smaller-Variant-Than-Expected)
-(exception: #export Invalid-Type-Application)
-(exception: #export Not-A-Record-Type)
-(exception: #export Not-A-Variant-Type)
-
 (def: (replace-bound bound-idx replacementT type)
   (-> Nat Type Type Type)
   (case type
@@ -131,9 +136,10 @@
       (do macro.Monad<Meta>
         [[outputT' args'A] (general analyse outputT args')
          argA (&.with-stacked-errors
-                (function [_] (Cannot-Infer-Argument
-                               (format "Inferred Type: " (%type inputT) "\n"
-                                       "     Argument: " (%code argC))))
+                (function (_ _)
+                  (ex.construct Cannot-Infer-Argument
+                                (format "Inferred Type: " (%type inputT) "\n"
+                                        "     Argument: " (%code argC))))
                 (&.with-type inputT
                   (analyse argC)))]
         (wrap [outputT' (list& argA args'A)]))
diff --git a/new-luxc/source/luxc/lang/analysis/structure.lux b/new-luxc/source/luxc/lang/analysis/structure.lux
index 403fe4730..c5be94df6 100644
--- a/new-luxc/source/luxc/lang/analysis/structure.lux
+++ b/new-luxc/source/luxc/lang/analysis/structure.lux
@@ -21,27 +21,34 @@
                         [".A" primitive]
                         ["&." inference]))))
 
-(exception: #export Invalid-Variant-Type)
-(exception: #export Invalid-Tuple-Type)
-(exception: #export Not-Quantified-Type)
+(do-template [<name>]
+  [(exception: #export (<name> {message Text})
+     message)]
 
-(exception: #export Cannot-Analyse-Variant)
-(exception: #export Cannot-Analyse-Tuple)
+  [Invalid-Variant-Type]
+  [Invalid-Tuple-Type]
+  [Not-Quantified-Type]
 
-(exception: #export Cannot-Infer-Numeric-Tag)
-(exception: #export Record-Keys-Must-Be-Tags)
-(exception: #export Cannot-Repeat-Tag)
-(exception: #export Tag-Does-Not-Belong-To-Record)
-(exception: #export Record-Size-Mismatch)
+  [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 [_] (Cannot-Analyse-Variant (format "      Type: " (%type expectedT) "\n"
-                                                    "       Tag: " (%n tag) "\n"
-                                                    "Expression: " (%code  valueC))))
+      (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)
@@ -74,9 +81,10 @@
             ## 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)))
+            (&.throw Cannot-Infer-Numeric-Tag
+                     (format "      Type: " (%type expectedT) "\n"
+                             "       Tag: " (%n tag) "\n"
+                             "Expression: " (%code  valueC)))
             ))
 
         (^template [<tag> <instancer>]
@@ -169,8 +177,10 @@
   (do macro.Monad<Meta>
     [expectedT macro.expected-type]
     (&.with-stacked-errors
-      (function [_] (Cannot-Analyse-Tuple (format "      Type: " (%type expectedT) "\n"
-                                                  "Expression: " (%code (` [(~+ membersC)])))))
+      (function (_ _)
+        (ex.construct Cannot-Analyse-Tuple
+                      (format "      Type: " (%type expectedT) "\n"
+                              "Expression: " (%code (` [(~+ membersC)])))))
       (case expectedT
         (#.Product _)
         (analyse-typed-product analyse membersC)
@@ -218,8 +228,9 @@
                 (analyse-product analyse membersC))
 
               _
-              (&.throw Invalid-Tuple-Type (format "      Type: " (%type expectedT) "\n"
-                                                  "Expression: " (%code (` [(~+ membersC)]))))))
+              (&.throw Invalid-Tuple-Type
+                       (format "      Type: " (%type expectedT) "\n"
+                               "Expression: " (%code (` [(~+ membersC)]))))))
 
           _
           (case (type.apply (list inputT) funT)
@@ -231,8 +242,9 @@
               (analyse-product analyse membersC))))
         
         _
-        (&.throw Invalid-Tuple-Type (format "      Type: " (%type expectedT) "\n"
-                                            "Expression: " (%code (` [(~+ membersC)]))))
+        (&.throw Invalid-Tuple-Type
+                 (format "      Type: " (%type expectedT) "\n"
+                         "Expression: " (%code (` [(~+ membersC)]))))
         ))))
 
 (def: #export (analyse-tagged-sum analyse tag valueC)
@@ -260,7 +272,7 @@
 (def: #export (normalize record)
   (-> (List [Code Code]) (Meta (List [Ident Code])))
   (monad.map macro.Monad<Meta>
-             (function [[key val]]
+             (function (_ [key val])
                (case key
                  [_ (#.Tag key)]
                  (do macro.Monad<Meta>
@@ -268,8 +280,9 @@
                    (wrap [key val]))
 
                  _
-                 (&.throw Record-Keys-Must-Be-Tags (format "   Key: " (%code key) "\n"
-                                                           "Record: " (%code (code.record record))))))
+                 (&.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
@@ -295,13 +308,13 @@
                             "    Actual: " (|> size-record nat-to-int %i) "\n"
                             "      Type: " (%type recordT) "\n"
                             "Expression: " (%code (|> record
-                                                      (list/map (function [[keyI valueC]]
+                                                      (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]
+                            (function (_ [key val] idx->val)
                               (do @
                                 [key (macro.normalize key)]
                                 (case (dict.get key tag->idx)
@@ -314,14 +327,14 @@
                                   (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]]
+                                                     "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)))
+       #let [ordered-tuple (list/map (function (_ idx) (maybe.assume (dict.get idx idx->val)))
                                      tuple-range)]]
       (wrap [ordered-tuple recordT]))
     ))