From 70005a6dee1eba3e3f5694aa4903e95988dcaa3d Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 13 Nov 2017 23:26:06 -0400 Subject: - Refactoring. - Now giving type checking/inference a higher priority. - Better error messages. --- .../source/luxc/lang/translation/procedure.jvm.lux | 2 +- .../luxc/lang/translation/procedure/host.jvm.lux | 44 ++++++++++++---------- .../source/luxc/lang/translation/statement.jvm.lux | 12 +++--- .../source/luxc/lang/translation/structure.jvm.lux | 7 +++- 4 files changed, 38 insertions(+), 27 deletions(-) (limited to 'new-luxc/source/luxc/lang/translation') 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 [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] [dict #+ Dict])) - [meta #+ with-gensyms "meta/" Monad] + [meta "meta/" Monad] (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 [ ] [(def: $;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 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 [ ] [(def: ( 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 - [] - (&;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 [#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 -- cgit v1.2.3