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

5 files changed, 118 insertions, 97 deletions

diff --git a/new-luxc/source/luxc/lang/extension.lux b/new-luxc/source/luxc/lang/extension.lux
index c5e6a8e25..e8121b9b6 100644
--- a/new-luxc/source/luxc/lang/extension.lux
+++ b/new-luxc/source/luxc/lang/extension.lux
@@ -10,15 +10,20 @@
   (// ["la" analysis]
       ["ls" synthesis]))
 
-(exception: #export Unknown-Analysis)
-(exception: #export Unknown-Synthesis)
-(exception: #export Unknown-Translation)
-(exception: #export Unknown-Statement)
-
-(exception: #export Cannot-Define-Analysis-More-Than-Once)
-(exception: #export Cannot-Define-Synthesis-More-Than-Once)
-(exception: #export Cannot-Define-Translation-More-Than-Once)
-(exception: #export Cannot-Define-Statement-More-Than-Once)
+(do-template [<name>]
+  [(exception: #export (<name> {message Text})
+     message)]
+
+  [Unknown-Analysis]
+  [Unknown-Synthesis]
+  [Unknown-Translation]
+  [Unknown-Statement]
+
+  [Cannot-Define-Analysis-More-Than-Once]
+  [Cannot-Define-Synthesis-More-Than-Once]
+  [Cannot-Define-Translation-More-Than-Once]
+  [Cannot-Define-Statement-More-Than-Once]
+  )
 
 (type: #export Analysis
   (-> (-> Code (Meta Code))
@@ -51,13 +56,13 @@
 
 (def: get
   (Meta Extensions)
-  (function [compiler]
+  (function (_ compiler)
     (#e.Success [compiler
                  (|> compiler (get@ #.extensions) (:! Extensions))])))
 
 (def: (set extensions)
   (-> Extensions (Meta Unit))
-  (function [compiler]
+  (function (_ compiler)
     (#e.Success [(set@ #.extensions (:! Void extensions) compiler)
                  []])))
 
diff --git a/new-luxc/source/luxc/lang/extension/analysis.lux b/new-luxc/source/luxc/lang/extension/analysis.lux
index 30f43acef..cc7de89b1 100644
--- a/new-luxc/source/luxc/lang/extension/analysis.lux
+++ b/new-luxc/source/luxc/lang/extension/analysis.lux
@@ -10,7 +10,7 @@
 (def: realize
   (-> /common.Bundle (Dict Text //.Analysis))
   (|>> dict.entries
-       (list/map (function [[name proc]] [name (proc name)]))
+       (list/map (function (_ [name proc]) [name (proc name)]))
        (dict.from-list text.Hash<Text>)))
 
 (def: #export defaults
diff --git a/new-luxc/source/luxc/lang/extension/analysis/common.lux b/new-luxc/source/luxc/lang/extension/analysis/common.lux
index 9fc807f75..8ec031066 100644
--- a/new-luxc/source/luxc/lang/extension/analysis/common.lux
+++ b/new-luxc/source/luxc/lang/extension/analysis/common.lux
@@ -20,8 +20,13 @@
                         [".A" type])))
   [///])
 
-(exception: #export Incorrect-Procedure-Arity)
-(exception: #export Invalid-Syntax)
+(do-template [<name>]
+  [(exception: #export (<name> {message Text})
+     message)]
+
+  [Incorrect-Procedure-Arity]
+  [Invalid-Syntax]
+  )
 
 ## [Utils]
 (type: #export Bundle
@@ -36,7 +41,7 @@
   (-> Text Bundle Bundle)
   (|> bundle
       dict.entries
-      (list/map (function [[key val]] [(format prefix " " key) val]))
+      (list/map (function (_ [key val]) [(format prefix " " key) val]))
       (dict.from-list text.Hash<Text>)))
 
 (def: #export (wrong-arity proc expected actual)
@@ -48,13 +53,13 @@
 (def: (simple proc inputsT+ outputT)
   (-> Text (List Type) Type ///.Analysis)
   (let [num-expected (list.size inputsT+)]
-    (function [analyse eval args]
+    (function (_ analyse eval args)
       (let [num-actual (list.size args)]
         (if (n/= num-expected num-actual)
           (do macro.Monad<Meta>
             [_ (&.infer outputT)
              argsA (monad.map @
-                              (function [[argT argC]]
+                              (function (_ [argT argC])
                                 (&.with-type argT
                                   (analyse argC)))
                               (list.zip2 inputsT+ args))]
@@ -81,7 +86,7 @@
 ## "lux is" represents reference/pointer equality.
 (def: (lux//is proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (do macro.Monad<Meta>
       [[var-id varT] (&.with-type-env tc.var)]
       ((binary varT varT Bool proc)
@@ -91,7 +96,7 @@
 ## error-handling facilities.
 (def: (lux//try proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case args
       (^ (list opC))
       (do macro.Monad<Meta>
@@ -106,7 +111,7 @@
 
 (def: (lux//function proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case args
       (^ (list [_ (#.Symbol ["" func-name])]
                [_ (#.Symbol ["" arg-name])]
@@ -118,7 +123,7 @@
 
 (def: (lux//case proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case args
       (^ (list input [_ (#.Record branches)]))
       (caseA.analyse-case analyse input branches)
@@ -128,7 +133,7 @@
 
 (def: (lux//in-module proc)
   (-> Text ///.Analysis)
-  (function [analyse eval argsC+]
+  (function (_ analyse eval argsC+)
     (case argsC+
       (^ (list [_ (#.Text module-name)] exprC))
       (&.with-current-module module-name
@@ -138,14 +143,14 @@
       (&.throw Invalid-Syntax (format "Procedure: " proc "\n"
                                       "   Inputs:" (|> argsC+
                                                        list.enumerate
-                                                       (list/map (function [[idx argC]]
+                                                       (list/map (function (_ [idx argC])
                                                                    (format "\n  " (%n idx) " " (%code argC))))
                                                        (text.join-with "")) "\n")))))
 
 (do-template [<name> <analyser>]
   [(def: (<name> proc)
      (-> Text ///.Analysis)
-     (function [analyse eval args]
+     (function (_ analyse eval args)
        (case args
          (^ (list typeC valueC))
          (<analyser> analyse eval typeC valueC)
@@ -158,7 +163,7 @@
 
 (def: (lux//check//type proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case args
       (^ (list valueC))
       (do macro.Monad<Meta>
@@ -295,7 +300,7 @@
 
 (def: (array//get proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (do macro.Monad<Meta>
       [[var-id varT] (&.with-type-env tc.var)]
       ((binary (type (Array varT)) Nat (type (Maybe varT)) proc)
@@ -303,7 +308,7 @@
 
 (def: (array//put proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (do macro.Monad<Meta>
       [[var-id varT] (&.with-type-env tc.var)]
       ((trinary (type (Array varT)) Nat varT (type (Array varT)) proc)
@@ -311,7 +316,7 @@
 
 (def: (array//remove proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (do macro.Monad<Meta>
       [[var-id varT] (&.with-type-env tc.var)]
       ((binary (type (Array varT)) Nat (type (Array varT)) proc)
@@ -352,7 +357,7 @@
 
 (def: (atom-new proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case args
       (^ (list initC))
       (do macro.Monad<Meta>
@@ -367,7 +372,7 @@
 
 (def: (atom-read proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (do macro.Monad<Meta>
       [[var-id varT] (&.with-type-env tc.var)]
       ((unary (type (Atom varT)) varT proc)
@@ -375,7 +380,7 @@
 
 (def: (atom//compare-and-swap proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (do macro.Monad<Meta>
       [[var-id varT] (&.with-type-env tc.var)]
       ((trinary (type (Atom varT)) varT varT Bool proc)
@@ -395,7 +400,7 @@
 
 (def: (box//new proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case args
       (^ (list initC))
       (do macro.Monad<Meta>
@@ -410,7 +415,7 @@
 
 (def: (box//read proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (do macro.Monad<Meta>
       [[thread-id threadT] (&.with-type-env tc.var)
        [var-id varT] (&.with-type-env tc.var)]
@@ -419,7 +424,7 @@
 
 (def: (box//write proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (do macro.Monad<Meta>
       [[thread-id threadT] (&.with-type-env tc.var)
        [var-id varT] (&.with-type-env tc.var)]
diff --git a/new-luxc/source/luxc/lang/extension/analysis/host.jvm.lux b/new-luxc/source/luxc/lang/extension/analysis/host.jvm.lux
index 5acc0cd46..9d9fef5ac 100644
--- a/new-luxc/source/luxc/lang/extension/analysis/host.jvm.lux
+++ b/new-luxc/source/luxc/lang/extension/analysis/host.jvm.lux
@@ -29,44 +29,50 @@
   [///]
   )
 
-(exception: #export Wrong-Syntax)
-(def: (wrong-syntax procedure args)
-  (-> Text (List Code) Text)
-  (format "Procedure: " procedure "\n"
-          "Arguments: " (%code (code.tuple args))))
+(do-template [<name>]
+  [(exception: #export (<name> {message Text})
+     message)]
+
+  [Wrong-Syntax]
 
-(exception: #export JVM-Type-Is-Not-Class)
+  [JVM-Type-Is-Not-Class]
 
-(exception: #export Non-Interface)
-(exception: #export Non-Object)
-(exception: #export Non-Array)
-(exception: #export Non-Throwable)
-(exception: #export Non-JVM-Type)
+  [Non-Interface]
+  [Non-Object]
+  [Non-Array]
+  [Non-Throwable]
+  [Non-JVM-Type]
 
-(exception: #export Unknown-Class)
-(exception: #export Primitives-Cannot-Have-Type-Parameters)
-(exception: #export Primitives-Are-Not-Objects)
-(exception: #export Invalid-Type-For-Array-Element)
+  [Unknown-Class]
+  [Primitives-Cannot-Have-Type-Parameters]
+  [Primitives-Are-Not-Objects]
+  [Invalid-Type-For-Array-Element]
 
-(exception: #export Unknown-Field)
-(exception: #export Mistaken-Field-Owner)
-(exception: #export Not-Virtual-Field)
-(exception: #export Not-Static-Field)
-(exception: #export Cannot-Set-Final-Field)
+  [Unknown-Field]
+  [Mistaken-Field-Owner]
+  [Not-Virtual-Field]
+  [Not-Static-Field]
+  [Cannot-Set-Final-Field]
 
-(exception: #export No-Candidates)
-(exception: #export Too-Many-Candidates)
+  [No-Candidates]
+  [Too-Many-Candidates]
 
-(exception: #export Cannot-Cast)
+  [Cannot-Cast]
 
-(exception: #export Cannot-Possibly-Be-Instance)
+  [Cannot-Possibly-Be-Instance]
 
-(exception: #export Cannot-Convert-To-Class)
-(exception: #export Cannot-Convert-To-Parameter)
-(exception: #export Cannot-Convert-To-Lux-Type)
-(exception: #export Unknown-Type-Var)
-(exception: #export Type-Parameter-Mismatch)
-(exception: #export Cannot-Correspond-Type-With-Class)
+  [Cannot-Convert-To-Class]
+  [Cannot-Convert-To-Parameter]
+  [Cannot-Convert-To-Lux-Type]
+  [Unknown-Type-Var]
+  [Type-Parameter-Mismatch]
+  [Cannot-Correspond-Type-With-Class]
+  )
+
+(def: (wrong-syntax procedure args)
+  (-> Text (List Code) Text)
+  (format "Procedure: " procedure "\n"
+          "Arguments: " (%code (code.tuple args))))
 
 (do-template [<name> <class>]
   [(def: #export <name> Type (#.Primitive <class> (list)))]
@@ -186,7 +192,7 @@
 
 (def: (array-length proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case args
       (^ (list arrayC))
       (do macro.Monad<Meta>
@@ -201,7 +207,7 @@
 
 (def: (array-new proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case args
       (^ (list lengthC))
       (do macro.Monad<Meta>
@@ -292,7 +298,7 @@
 
 (def: (array-read proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case args
       (^ (list arrayC idxC))
       (do macro.Monad<Meta>
@@ -312,7 +318,7 @@
 
 (def: (array-write proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case args
       (^ (list arrayC idxC valueC))
       (do macro.Monad<Meta>
@@ -344,7 +350,7 @@
 
 (def: (object//null proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case args
       (^ (list))
       (do macro.Monad<Meta>
@@ -357,7 +363,7 @@
 
 (def: (object//null? proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case args
       (^ (list objectC))
       (do macro.Monad<Meta>
@@ -372,7 +378,7 @@
 
 (def: (object//synchronized proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case args
       (^ (list monitorC exprC))
       (do macro.Monad<Meta>
@@ -467,7 +473,7 @@
 
 (def: (object//throw proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case args
       (^ (list exceptionC))
       (do macro.Monad<Meta>
@@ -487,7 +493,7 @@
 
 (def: (object//class proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case args
       (^ (list classC))
       (case classC
@@ -505,7 +511,7 @@
 
 (def: (object//instance? proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case args
       (^ (list classC objectC))
       (case classC
@@ -635,7 +641,7 @@
 
 (def: (object//cast proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case args
       (^ (list valueC))
       (do macro.Monad<Meta>
@@ -680,7 +686,7 @@
                                                                  "           For value: " (%code valueC) "\n")
                                              (Class::isAssignableFrom [current-class] to-class))
                                  candiate-parents (monad.map @
-                                                             (function [java-type]
+                                                             (function (_ java-type)
                                                                (do @
                                                                  [class-name (java-type-to-class java-type)
                                                                   class (load-class class-name)]
@@ -732,7 +738,7 @@
     (case (Class::getDeclaredField [field-name] class)
       (#e.Success field)
       (let [owner (Field::getDeclaringClass [] field)]
-        (if (is owner class)
+        (if (is? owner class)
           (wrap [class field])
           (&.throw Mistaken-Field-Owner
                    (format "       Field: " field-name "\n"
@@ -789,7 +795,7 @@
 
 (def: (static//get proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case args
       (^ (list classC fieldC))
       (case [classC fieldC]
@@ -806,7 +812,7 @@
 
 (def: (static//put proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case args
       (^ (list classC fieldC valueC))
       (case [classC fieldC]
@@ -828,7 +834,7 @@
 
 (def: (virtual//get proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case args
       (^ (list classC fieldC objectC))
       (case [classC fieldC]
@@ -847,7 +853,7 @@
 
 (def: (virtual//put proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case args
       (^ (list classC fieldC valueC objectC))
       (case [classC fieldC]
@@ -919,7 +925,7 @@
                  _
                  true)
                (n/= (list.size arg-classes) (list.size parameters))
-               (list/fold (function [[expectedJC actualJC] prev]
+               (list/fold (function (_ [expectedJC actualJC] prev)
                             (and prev
                                  (text/= expectedJC actualJC)))
                           true
@@ -933,7 +939,7 @@
                     (monad.map @ java-type-to-parameter))]
     (wrap (and (Object::equals [class] (Constructor::getDeclaringClass [] constructor))
                (n/= (list.size arg-classes) (list.size parameters))
-               (list/fold (function [[expectedJC actualJC] prev]
+               (list/fold (function (_ [expectedJC actualJC] prev)
                             (and prev
                                  (text/= expectedJC actualJC)))
                           true
@@ -1004,7 +1010,7 @@
      candidates (|> class
                     (Class::getDeclaredMethods [])
                     array.to-list
-                    (monad.map @ (function [method]
+                    (monad.map @ (function (_ method)
                                    (do @
                                      [passes? (check-method class method-name method-type arg-classes method)]
                                      (wrap [passes? method])))))]
@@ -1060,7 +1066,7 @@
      candidates (|> class
                     (Class::getConstructors [])
                     array.to-list
-                    (monad.map @ (function [constructor]
+                    (monad.map @ (function (_ constructor)
                                    (do @
                                      [passes? (check-constructor class arg-classes constructor)]
                                      (wrap [passes? constructor])))))]
@@ -1078,12 +1084,12 @@
   (-> (List Text) (List la.Analysis) (List la.Analysis))
   (|> inputsA
       (list.zip2 (list/map code.text typesT))
-      (list/map (function [[type value]]
+      (list/map (function (_ [type value])
                   (la.product (list type value))))))
 
 (def: (invoke//static proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case (: (e.Error [Text Text (List [Text Code])])
              (s.run args ($_ p.seq s.text s.text (p.some (s.tuple (p.seq s.text s.any))))))
       (#e.Success [class method argsTC])
@@ -1100,7 +1106,7 @@
 
 (def: (invoke//virtual proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case (: (e.Error [Text Text Code (List [Text Code])])
              (s.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any))))))
       (#e.Success [class method objectC argsTC])
@@ -1123,7 +1129,7 @@
 
 (def: (invoke//special proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case (: (e.Error [(List Code) [Text Text Code (List [Text Code]) Unit]])
              (p.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any))) s.end!)))
       (#e.Success [_ [class method objectC argsTC _]])
@@ -1140,7 +1146,7 @@
 
 (def: (invoke//interface proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case (: (e.Error [Text Text Code (List [Text Code])])
              (s.run args ($_ p.seq s.text s.text s.any (p.some (s.tuple (p.seq s.text s.any))))))
       (#e.Success [class-name method objectC argsTC])
@@ -1161,7 +1167,7 @@
 
 (def: (invoke//constructor proc)
   (-> Text ///.Analysis)
-  (function [analyse eval args]
+  (function (_ analyse eval args)
     (case (: (e.Error [Text (List [Text Code])])
              (s.run args ($_ p.seq s.text (p.some (s.tuple (p.seq s.text s.any))))))
       (#e.Success [class argsTC])
diff --git a/new-luxc/source/luxc/lang/extension/statement.lux b/new-luxc/source/luxc/lang/extension/statement.lux
index c084055b7..81b43f205 100644
--- a/new-luxc/source/luxc/lang/extension/statement.lux
+++ b/new-luxc/source/luxc/lang/extension/statement.lux
@@ -22,8 +22,13 @@
                                 [".T" eval]))
               [".L" eval])))
 
-(exception: #export Invalid-Statement)
-(exception: #export Invalid-Alias)
+(do-template [<name>]
+  [(exception: #export (<name> {message Text})
+     message)]
+
+  [Invalid-Statement]
+  [Invalid-Alias]
+  )
 
 (def: (throw-invalid-statement procedure inputsC+)
   (All [a] (-> Text (List Code) (Meta a)))
@@ -32,7 +37,7 @@
                       "  Inputs:"
                       (|> inputsC+
                           list.enumerate
-                          (list/map (function [[idx inputC]]
+                          (list/map (function (_ [idx inputC])
                                       (format "\n  " (%n idx) " " (%code inputC))))
                           (text.join-with "")) "\n")))
 
@@ -58,7 +63,7 @@
 
 (def: (lux//def procedure)
   (-> Text //.Statement)
-  (function [inputsC+]
+  (function (_ inputsC+)
     (case inputsC+
       (^ (list [_ (#.Symbol ["" def-name])] valueC annotationsC))
       (hostL.with-context def-name
@@ -96,7 +101,7 @@
 
 (def: (lux//program procedure)
   (-> Text //.Statement)
-  (function [inputsC+]
+  (function (_ inputsC+)
     (case inputsC+
       (^ (list [_ (#.Symbol ["" args])] programC))
       (do macro.Monad<Meta>
@@ -115,7 +120,7 @@
 (do-template [<mame> <type> <installer>]
   [(def: (<mame> procedure)
      (-> Text //.Statement)
-     (function [inputsC+]
+     (function (_ inputsC+)
        (case inputsC+
          (^ (list [_ (#.Text name)] valueC))
          (do macro.Monad<Meta>