- Refactoring.

- Now giving type checking/inference a higher priority.
- Better error messages.

5 files changed, 40 insertions, 28 deletions

diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux
index c4ebf3642..cf3137aff 100644
--- a/new-luxc/source/luxc/lang/translation.lux
+++ b/new-luxc/source/luxc/lang/translation.lux
@@ -32,6 +32,7 @@
   (&;Analyser)
   (expressionA;analyser &eval;eval))
 
+(exception: #export Macro-Expansion-Failed)
 (exception: #export Unrecognized-Statement)
 
 (def: (translate code)
@@ -79,7 +80,7 @@
                          (#e;Success [compiler' output])
 
                          (#e;Error error)
-                         ((&;fail error) compiler)))
+                         ((&;throw Macro-Expansion-Failed error) compiler)))
            _ (monad;map @ translate expansion)]
           (wrap []))
         (&;throw Unrecognized-Statement (%code code))))
diff --git a/new-luxc/source/luxc/lang/translation/procedure.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure.jvm.lux
index 82b7c5d44..733f630d5 100644
--- a/new-luxc/source/luxc/lang/translation/procedure.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/procedure.jvm.lux
@@ -21,7 +21,7 @@
 (def: #export (translate-procedure translate name args)
   (-> (-> ls;Synthesis (Meta $;Inst)) Text (List ls;Synthesis)
       (Meta $;Inst))
-  (<| (maybe;default (&;throw Unknown-Procedure name))
+  (<| (maybe;default (&;throw Unknown-Procedure (%t name)))
       (do maybe;Monad<Maybe>
         [proc (dict;get name procedures)]
         (wrap (proc translate args)))))
diff --git a/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux b/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux
index 7168514c1..a5e06aac3 100644
--- a/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/procedure/host.jvm.lux
@@ -10,7 +10,7 @@
                    ["l" lexer])
              (coll [list "list/" Functor<List>]
                    [dict #+ Dict]))
-       [meta #+ with-gensyms "meta/" Monad<Meta>]
+       [meta "meta/" Monad<Meta>]
        (meta [code]
              ["s" syntax #+ syntax:])
        [host])
@@ -25,6 +25,15 @@
               ["ls" synthesis]))
   ["@" ../common])
 
+(exception: #export Wrong-Syntax)
+(def: (wrong-syntax procedure args)
+  (-> Text (List ls;Synthesis) Text)
+  (format "Procedure: " procedure "\n"
+          "Arguments: " (%code (code;tuple args))))
+
+(exception: #export Invalid-Syntax-For-JVM-Type)
+(exception: #export Invalid-Syntax-For-Argument-Generation)
+
 (do-template [<name> <inst>]
   [(def: <name>
      $;Inst
@@ -295,7 +304,7 @@
                  ($i;array arrayJT))))
 
     _
-    (&;fail (format "Wrong syntax for '" proc "'."))))
+    (&;throw Wrong-Syntax (wrong-syntax proc inputs))))
 
 (def: (array//read proc translate inputs)
   (-> Text @;Proc)
@@ -321,7 +330,7 @@
                  loadI)))
 
     _
-    (&;fail (format "Wrong syntax for '" proc "'."))))
+    (&;throw Wrong-Syntax (wrong-syntax proc inputs))))
 
 (def: (array//write proc translate inputs)
   (-> Text @;Proc)
@@ -350,7 +359,7 @@
                  storeI)))
 
     _
-    (&;fail (format "Wrong syntax for '" proc "'."))))
+    (&;throw Wrong-Syntax (wrong-syntax proc inputs))))
 
 (def: array-procs
   @;Bundle
@@ -406,7 +415,7 @@
                                   false))))
 
     _
-    (&;fail (format "Wrong syntax for '" proc "'."))))
+    (&;throw Wrong-Syntax (wrong-syntax proc inputs))))
 
 (def: (object//instance? proc translate inputs)
   (-> Text @;Proc)
@@ -419,7 +428,7 @@
                  ($i;wrap #$;Boolean))))
 
     _
-    (&;fail (format "Wrong syntax for '" proc "'."))))
+    (&;throw Wrong-Syntax (wrong-syntax proc inputs))))
 
 (def: object-procs
   @;Bundle
@@ -470,7 +479,7 @@
         (wrap ($i;GETSTATIC class field ($t;class unboxed (list))))))
 
     _
-    (&;fail (format "Wrong syntax for '" proc "'."))))
+    (&;throw Wrong-Syntax (wrong-syntax proc inputs))))
 
 (def: (static//put proc translate inputs)
   (-> Text @;Proc)
@@ -502,7 +511,7 @@
                    ($i;string hostL;unit)))))
 
     _
-    (&;fail (format "Wrong syntax for '" proc "'."))))
+    (&;throw Wrong-Syntax (wrong-syntax proc inputs))))
 
 (def: (virtual//get proc translate inputs)
   (-> Text @;Proc)
@@ -533,7 +542,7 @@
                    ($i;GETFIELD class field ($t;class unboxed (list)))))))
 
     _
-    (&;fail (format "Wrong syntax for '" proc "'."))))
+    (&;throw Wrong-Syntax (wrong-syntax proc inputs))))
 
 (def: (virtual//put proc translate inputs)
   (-> Text @;Proc)
@@ -570,9 +579,7 @@
                    ($i;PUTFIELD class field ($t;class unboxed (list)))))))
 
     _
-    (&;fail (format "Wrong syntax for '" proc "'."))))
-
-(exception: #export Invalid-Syntax-For-Argument-Generation)
+    (&;throw Wrong-Syntax (wrong-syntax proc inputs))))
 
 (def: base-type
   (l;Lexer $;Type)
@@ -601,7 +608,7 @@
   (-> Text (Meta $;Type))
   (case (l;run argD java-type)
     (#e;Error error)
-    (&;fail error)
+    (&;throw Invalid-Syntax-For-JVM-Type argD)
 
     (#e;Success type)
     (meta/wrap type)))
@@ -647,7 +654,7 @@
     (meta/wrap #;None)
 
     _
-    (:: meta;Monad<Meta> map (|>. #;Some) (translate-type description))))
+    (meta/map (|>. #;Some) (translate-type description))))
 
 (def: (prepare-return returnT returnI)
   (-> (Maybe $;Type) $;Inst $;Inst)
@@ -679,7 +686,7 @@
       (wrap (prepare-return returnT callI)))
 
     _
-    (&;fail (format "Wrong syntax for '" proc "'."))))
+    (&;throw Wrong-Syntax (wrong-syntax proc inputs))))
 
 (do-template [<name> <invoke> <interface?>]
   [(def: (<name> proc translate inputs)
@@ -700,7 +707,7 @@
          (wrap (prepare-return returnT callI)))
 
        _
-       (&;fail (format "Wrong syntax for '" proc "'."))))]
+       (&;throw Wrong-Syntax (wrong-syntax proc inputs))))]
 
   [invoke//virtual $i;INVOKEVIRTUAL false]
   [invoke//special $i;INVOKESPECIAL false]
@@ -721,7 +728,7 @@
                                    false))))
 
     _
-    (&;fail (format "Wrong syntax for '" proc "'."))))
+    (&;throw Wrong-Syntax (wrong-syntax proc inputs))))
 
 (def: member-procs
   @;Bundle
@@ -741,8 +748,7 @@
                               (@;install "virtual" invoke//virtual)
                               (@;install "special" invoke//special)
                               (@;install "interface" invoke//interface)
-                              (@;install "constructor" invoke//constructor)
-                              )))
+                              (@;install "constructor" invoke//constructor))))
           )))
 
 (def: #export procedures
diff --git a/new-luxc/source/luxc/lang/translation/statement.jvm.lux b/new-luxc/source/luxc/lang/translation/statement.jvm.lux
index feb64c293..2a2173fa9 100644
--- a/new-luxc/source/luxc/lang/translation/statement.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/statement.jvm.lux
@@ -21,6 +21,7 @@
                            [";T" common]))))
 
 (exception: #export Invalid-Definition-Value)
+(exception: #export Cannot-Evaluate-Definition)
 
 (host;import java.lang.Object
   (toString [] String))
@@ -56,13 +57,16 @@
                        [field (Class.getField [commonT;value-field] class)]
                        (Field.get [#;None] field))
                  (#e;Success #;None)
-                 (&;throw Invalid-Definition-Value (format current-module ";" def-name))
+                 (&;throw Invalid-Definition-Value (%ident [current-module def-name]))
                  
                  (#e;Success (#;Some valueV))
                  (wrap valueV)
                  
                  (#e;Error error)
-                 (&;fail error)))
+                 (&;throw Cannot-Evaluate-Definition
+                          (format "Definition: " (%ident [current-module def-name]) "\n"
+                                  "Error:\n"
+                                  error))))
      _ (&module;define [current-module def-name] [valueT metaV valueV])
      _ (if (meta;type? metaV)
          (case (meta;declared-tags metaV)
@@ -77,6 +81,4 @@
 
 (def: #export (translate-program program-args programI)
   (-> Text $;Inst (Meta Unit))
-  (do meta;Monad<Meta>
-    []
-    (&;fail "'lux program' is unimplemented.")))
+  (&;fail "\"lux program\" is unimplemented."))
diff --git a/new-luxc/source/luxc/lang/translation/structure.jvm.lux b/new-luxc/source/luxc/lang/translation/structure.jvm.lux
index 3ef03ac2c..68219b87c 100644
--- a/new-luxc/source/luxc/lang/translation/structure.jvm.lux
+++ b/new-luxc/source/luxc/lang/translation/structure.jvm.lux
@@ -1,6 +1,7 @@
 (;module:
   lux
-  (lux (control [monad #+ do])
+  (lux (control [monad #+ do]
+                ["ex" exception #+ exception:])
        (data text/format
              (coll [list]))
        [meta]
@@ -16,13 +17,15 @@
               (translation [";T" common])))
   [../runtime])
 
+(exception: #export Not-A-Tuple)
+
 (def: $Object $;Type ($t;class "java.lang.Object" (list)))
 
 (def: #export (translate-tuple translate members)
   (-> (-> ls;Synthesis (Meta $;Inst)) (List ls;Synthesis) (Meta $;Inst))
   (do meta;Monad<Meta>
     [#let [size (list;size members)]
-     _ (&;assert "Cannot translate tuples with less than 2 elements."
+     _ (&;assert Not-A-Tuple (%code (` [(~@ members)]))
                  (n.>= +2 size))
      membersI (|> members
                   list;enumerate