From 844a44f87bd03fc9c65e18149c6dd2ccf8e9cb32 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 7 Feb 2018 00:37:35 -0400 Subject: - Improved the way exceptions work. --- stdlib/source/lux/concurrency/actor.lux | 17 +++--- stdlib/source/lux/concurrency/task.lux | 5 +- stdlib/source/lux/control/exception.lux | 66 +++++++++++++++++------- stdlib/source/lux/control/region.lux | 30 ++++++----- stdlib/source/lux/data/coll/tree/parser.lux | 2 +- stdlib/source/lux/data/format/context.lux | 3 +- stdlib/source/lux/data/format/xml.lux | 36 +++++++------ stdlib/source/lux/io.lux | 4 +- stdlib/source/lux/lang/syntax.lux | 16 +++--- stdlib/source/lux/lang/type/check.lux | 54 ++++++++++--------- stdlib/source/lux/macro/poly.lux | 5 +- stdlib/source/lux/macro/syntax/common.lux | 4 ++ stdlib/source/lux/macro/syntax/common/reader.lux | 4 +- stdlib/source/lux/macro/syntax/common/writer.lux | 5 ++ stdlib/source/lux/math/constructive.lux | 2 +- stdlib/source/lux/math/modular.lux | 26 ++++++---- stdlib/source/lux/type/resource.lux | 8 +-- stdlib/source/lux/world/blob.jvm.lux | 7 ++- stdlib/source/lux/world/file.lux | 9 ++-- stdlib/source/lux/world/net/udp.jvm.lux | 7 ++- 20 files changed, 190 insertions(+), 120 deletions(-) (limited to 'stdlib/source') diff --git a/stdlib/source/lux/concurrency/actor.lux b/stdlib/source/lux/concurrency/actor.lux index 4c98d10e4..c5bcc8a0d 100644 --- a/stdlib/source/lux/concurrency/actor.lux +++ b/stdlib/source/lux/concurrency/actor.lux @@ -20,7 +20,11 @@ [task #+ Task])) (exception: #export Poisoned) -(exception: #export Dead) + +(exception: #export (Dead {actor-name Text} + {message-name Text}) + (format " Actor: " actor-name "\n" + "Message: " message-name "\n")) ## [Types] (with-expansions @@ -133,7 +137,7 @@ but allows the actor to handle previous messages."} (All [s] (-> (Actor s) (IO Bool))) (send (function [state self] - (task.throw Poisoned "")) + (task.throw Poisoned [])) actor)) ## [Syntax] @@ -263,7 +267,7 @@ (type: Signature {#vars (List Text) #name Text - #inputs (List [Text Code]) + #inputs (List cs.Typed-Input) #state Text #self Text #output Code}) @@ -311,7 +315,7 @@ g!actor-vars (list/map code.local-symbol actor-vars) actorC (` ((~ (code.symbol actor-name)) (~+ g!actor-vars))) g!all-vars (|> (get@ #vars signature) (list/map code.local-symbol) (list/compose g!actor-vars)) - g!inputsC (|> (get@ #inputs signature) (list/map (|>> product.left code.local-symbol))) + g!inputsC (|> (get@ #inputs signature) (list/map product.left)) g!inputsT (|> (get@ #inputs signature) (list/map product.right)) g!state (|> signature (get@ #state) code.local-symbol) g!self (|> signature (get@ #self) code.local-symbol) @@ -357,8 +361,7 @@ (~ g!self))] (if (~ g!sent?) ((~' wrap) (~ g!task)) - ((~' wrap) (<| (task.throw ..Dead) - (~ (code.text (format " Actor: " (%ident actor-name) "\n" - "Message: " (%ident message-name) "\n"))))))))))) + ((~' wrap) (task.throw ..Dead [(~ (code.text (%ident actor-name))) + (~ (code.text (%ident message-name)))])))))))) )) ))) diff --git a/stdlib/source/lux/concurrency/task.lux b/stdlib/source/lux/concurrency/task.lux index a740d7398..603dfc808 100644 --- a/stdlib/source/lux/concurrency/task.lux +++ b/stdlib/source/lux/concurrency/task.lux @@ -18,8 +18,9 @@ (:: P.Applicative wrap (#E.Error error))) (def: #export (throw exception message) - (All [a] (-> Exception Text (Task a))) - (fail (exception message))) + (All [e a] (-> (Exception e) e (Task a))) + (:: P.Applicative wrap + (ex.throw exception message))) (def: #export (return value) (All [a] (-> a (Task a))) diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index fcee396e1..c37b759a2 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -1,9 +1,11 @@ (.module: {#.doc "Exception-handling functionality built on top of the Error type."} lux - (lux (control monad) + (lux (control [monad #+ do] + ["p" parser]) (data ["e" error] [maybe] - [text "text/" Monoid]) + [text "text/" Monoid] + (coll [list "list/" Functor])) [macro] (macro [code] ["s" syntax #+ syntax: Syntax] @@ -12,28 +14,29 @@ ["csw" writer]))))) ## [Types] -(type: #export Exception +(type: #export (Exception a) {#.doc "An exception provides a way to decorate error messages."} - (-> Text Text)) + {#label Text + #constructor (-> a Text)}) ## [Values] (def: #export (match? exception error) - (-> Exception Text Bool) - (text.starts-with? (exception "") error)) + (All [e] (-> (Exception e) Text Bool)) + (text.starts-with? (get@ #label exception) error)) (def: #export (catch exception then try) {#.doc "If a particular exception is detected on a possibly-erroneous value, handle it. If no exception was detected, or a different one from the one being checked, then pass along the original value."} - (All [a] - (-> Exception (-> Text a) (e.Error a) + (All [e a] + (-> (Exception e) (-> Text a) (e.Error a) (e.Error a))) (case try (#e.Success output) (#e.Success output) (#e.Error error) - (let [reference (exception "")] + (let [reference (get@ #label exception)] (if (text.starts-with? reference error) (#e.Success (|> error (text.clip (text.size reference) (text.size error)) @@ -57,19 +60,42 @@ (All [a] (-> a (e.Error a))) (#e.Success value)) +(def: #export (construct exception message) + {#.doc "Constructs an exception."} + (All [e] (-> (Exception e) e Text)) + ((get@ #constructor exception) message)) + (def: #export (throw exception message) {#.doc "Decorate an error message with an Exception and lift it into the error-handling context."} - (All [a] (-> Exception Text (e.Error a))) - (#e.Error (exception message))) + (All [e] (-> (Exception e) e e.Error)) + (#e.Error (construct exception message))) -(syntax: #export (exception: [_ex-lev csr.export] [name s.local-symbol]) +(syntax: #export (exception: [export csr.export] + [t-vars (p.default (list) csr.type-variables)] + [[name inputs] (p.either (p.seq s.local-symbol (wrap (list))) + (s.form (p.seq s.local-symbol (p.some csr.typed-input))))] + [body (p.maybe s.any)]) {#.doc (doc "Define a new exception type." "It moslty just serves as a way to tag error messages for later catching." - (exception: #export Some-Exception))} - (do @ - [current-module macro.current-module-name - #let [descriptor ($_ text/compose "{" current-module "." name "}" "\n") - g!message (code.symbol ["" "message"])]] - (wrap (list (` (def: (~+ (csw.export _ex-lev)) ((~ (code.symbol ["" name])) (~ g!message)) - Exception - ((~! text/compose) (~ (code.text descriptor)) (~ g!message)))))))) + "" + "Simple case:" + (exception: #export Some-Exception) + "" + "Complex case:" + (exception: #export [optional type-vars] (Some-Exception [optional Text] {arguments Int}) + optional-body))} + (macro.with-gensyms [g!descriptor] + (do @ + [current-module macro.current-module-name + #let [descriptor ($_ text/compose "{" current-module "." name "}" "\n") + g!self (code.local-symbol name)]] + (wrap (list (` (def: (~+ (csw.export export)) + (~ g!self) + (All (~ (csw.type-variables t-vars)) + (..Exception [(~+ (list/map (get@ #cs.input-type) inputs))])) + (let [(~ g!descriptor) (~ (code.text descriptor))] + {#..label (~ g!descriptor) + #..constructor (function (~ g!self) [[(~+ (list/map (get@ #cs.input-binding) inputs))]] + ((~! text/compose) (~ g!descriptor) + (~ (maybe.default (' "") body))))}))))) + ))) diff --git a/stdlib/source/lux/control/region.lux b/stdlib/source/lux/control/region.lux index 8df68bf8e..2c8f6b795 100644 --- a/stdlib/source/lux/control/region.lux +++ b/stdlib/source/lux/control/region.lux @@ -16,8 +16,6 @@ (m [(List (Cleaner r m)) (Error a)]))) -(exception: #export Clean-Up-Error) - (def: separator Text (format "\n" @@ -26,6 +24,17 @@ "-----------------------------------------\n" "\n")) +(exception: #export [a] (Clean-Up-Error {error Text} + {output (Error a)}) + (format error + (case output + (#e.Success _) + "" + + (#e.Error error|output) + (format separator + error|output)))) + (def: (combine-outcomes clean-up output) (All [a] (-> (Error Unit) (Error a) (Error a))) (case clean-up @@ -33,15 +42,7 @@ output (#e.Error error|clean-up) - (ex.throw Clean-Up-Error - (format error|clean-up - (case output - (#e.Success _) - "" - - (#e.Error error|output) - (format separator - error|output)))))) + (ex.throw Clean-Up-Error [error|clean-up output]))) (def: #export (run Monad computation) (All [m a] @@ -131,10 +132,11 @@ (:: Monad wrap [cleaners (#e.Error error)]))) (def: #export (throw Monad exception message) - (All [m a] - (-> (Monad m) Exception Text + (All [m e a] + (-> (Monad m) (Exception e) e (All [r] (Region r m a)))) - (fail Monad (exception message))) + (function [[region cleaners]] + (:: Monad wrap [cleaners (ex.throw exception message)]))) (def: #export (lift Monad operation) (All [m a] diff --git a/stdlib/source/lux/data/coll/tree/parser.lux b/stdlib/source/lux/data/coll/tree/parser.lux index 2489e991b..726a04146 100644 --- a/stdlib/source/lux/data/coll/tree/parser.lux +++ b/stdlib/source/lux/data/coll/tree/parser.lux @@ -35,7 +35,7 @@ (function [zipper] (let [next ( zipper)] (if (is zipper next) - (ex.throw Cannot-Move-Further "") + (ex.throw Cannot-Move-Further []) (#E.Success [next []])))))] [up Z.up] diff --git a/stdlib/source/lux/data/format/context.lux b/stdlib/source/lux/data/format/context.lux index a52de9af8..83105137f 100644 --- a/stdlib/source/lux/data/format/context.lux +++ b/stdlib/source/lux/data/format/context.lux @@ -6,7 +6,8 @@ (data ["E" error] (coll ["d" dict])))) -(exception: #export Unknown-Property) +(exception: #export (Unknown-Property {property Text}) + property) (type: #export Context (d.Dict Text Text)) diff --git a/stdlib/source/lux/data/format/xml.lux b/stdlib/source/lux/data/format/xml.lux index 2d7e0a6f4..bd047b2f8 100644 --- a/stdlib/source/lux/data/format/xml.lux +++ b/stdlib/source/lux/data/format/xml.lux @@ -248,15 +248,21 @@ (exception: #export Empty-Input) (exception: #export Unexpected-Input) (exception: #export Unknown-Attribute) -(exception: #export Wrong-Tag) -(exception: #export Unconsumed-Inputs) + +(exception: #export (Wrong-Tag {tag Ident}) + (ident/encode tag)) + +(exception: #export (Unconsumed-Inputs {inputs (List XML)}) + (|> inputs + (L/map (:: Codec encode)) + (text.join-with "\n\n"))) (def: #export text (Reader Text) (function [docs] (case docs #.Nil - (ex.throw Empty-Input "") + (ex.throw Empty-Input []) (#.Cons head tail) (case head @@ -264,24 +270,24 @@ (#E.Success [tail value]) (#Node _) - (ex.throw Unexpected-Input ""))))) + (ex.throw Unexpected-Input []))))) (def: #export (attr name) (-> Ident (Reader Text)) (function [docs] (case docs #.Nil - (ex.throw Empty-Input "") + (ex.throw Empty-Input []) (#.Cons head _) (case head (#Text _) - (ex.throw Unexpected-Input "") + (ex.throw Unexpected-Input []) (#Node tag attrs children) (case (d.get name attrs) #.None - (ex.throw Unknown-Attribute "") + (ex.throw Unknown-Attribute []) (#.Some value) (#E.Success [docs value])))))) @@ -292,9 +298,7 @@ (#E.Success [remaining output]) (if (list.empty? remaining) (#E.Success output) - (ex.throw Unconsumed-Inputs (|> remaining - (L/map (:: Codec encode)) - (text.join-with "\n\n")))) + (ex.throw Unconsumed-Inputs remaining)) (#E.Error error) (#E.Error error))) @@ -304,29 +308,29 @@ (function [docs] (case docs #.Nil - (ex.throw Empty-Input "") + (ex.throw Empty-Input []) (#.Cons head _) (case head (#Text _) - (ex.throw Unexpected-Input "") + (ex.throw Unexpected-Input []) (#Node _tag _attrs _children) (if (ident/= tag _tag) (#E.Success [docs []]) - (ex.throw Wrong-Tag (ident/encode tag))))))) + (ex.throw Wrong-Tag tag)))))) (def: #export (children reader) (All [a] (-> (Reader a) (Reader a))) (function [docs] (case docs #.Nil - (ex.throw Empty-Input "") + (ex.throw Empty-Input []) (#.Cons head tail) (case head (#Text _) - (ex.throw Unexpected-Input "") + (ex.throw Unexpected-Input []) (#Node _tag _attrs _children) (do E.Monad @@ -338,7 +342,7 @@ (function [docs] (case docs #.Nil - (ex.throw Empty-Input "") + (ex.throw Empty-Input []) (#.Cons head tail) (#E.Success [tail []])))) diff --git a/stdlib/source/lux/io.lux b/stdlib/source/lux/io.lux index 5e1f2e59e..ca9d7b608 100644 --- a/stdlib/source/lux/io.lux +++ b/stdlib/source/lux/io.lux @@ -82,5 +82,5 @@ (io (#e.Error error))) (def: #export (throw exception message) - (All [a] (-> Exception Text (Process a))) - (io (#e.Error (exception message)))) + (All [e a] (-> (Exception e) e (Process a))) + (io (ex.throw exception message))) diff --git a/stdlib/source/lux/lang/syntax.lux b/stdlib/source/lux/lang/syntax.lux index ebb6c3f18..60bf3c11a 100644 --- a/stdlib/source/lux/lang/syntax.lux +++ b/stdlib/source/lux/lang/syntax.lux @@ -589,8 +589,13 @@ [tag #.Tag (p.after (l.this "#") (ident^ current-module aliases)) +1] ) -(exception: #export End-Of-File) -(exception: #export Unrecognized-Input) +(exception: #export (End-Of-File {module Text}) + module) + +(exception: #export (Unrecognized-Input {[file line column] Cursor}) + (format " File: " file "\n" + " Line: " (%n line) "\n" + "Column: " (%n column) "\n")) (def: (ast current-module aliases) (-> Text Aliases Cursor (l.Lexer [Cursor Code])) @@ -613,11 +618,8 @@ (do @ [end? l.end?] (if end? - (p.fail (End-Of-File current-module)) - (let [[_file _line _column] where] - (p.fail (Unrecognized-Input (format " File: " _file "\n" - " Line: " (%n _line) "\n" - "Column: " (%n _column) "\n")))))) + (p.fail (ex.construct End-Of-File current-module)) + (p.fail (ex.construct Unrecognized-Input where)))) ))))) (def: #export (read current-module aliases [where offset source]) diff --git a/stdlib/source/lux/lang/type/check.lux b/stdlib/source/lux/lang/type/check.lux index 9dc7e81b0..59f27ad43 100644 --- a/stdlib/source/lux/lang/type/check.lux +++ b/stdlib/source/lux/lang/type/check.lux @@ -14,12 +14,25 @@ (lang [type "type/" Eq]) )) -(exception: #export Unknown-Type-Var) -(exception: #export Unbound-Type-Var) -(exception: #export Improper-Ring) -(exception: #export Invalid-Type-Application) -(exception: #export Cannot-Rebind-Var) -(exception: #export Type-Check-Failed) +(exception: #export (Unknown-Type-Var {id Nat}) + (nat/encode id)) + +(exception: #export (Unbound-Type-Var {id Nat}) + (nat/encode id)) + +(exception: #export (Invalid-Type-Application {funcT Type} {argT Type}) + (type.to-text (#.Apply argT funcT))) + +(exception: #export (Cannot-Rebind-Var {id Nat} {type Type} {bound Type}) + ($_ text/compose + " Var: " (nat/encode id) "\n" + " Wanted Type: " (type.to-text type) "\n" + "Current Type: " (type.to-text bound))) + +(exception: #export (Type-Check-Failed {expected Type} {actual Type}) + ($_ text/compose + "Expected: " (type.to-text expected) "\n\n" + " Actual: " (type.to-text actual))) (type: #export Var Nat) @@ -141,7 +154,7 @@ (#e.Success output))) (def: #export (throw exception message) - (All [a] (-> ex.Exception Text (Check a))) + (All [e a] (-> (ex.Exception e) e (Check a))) (function [context] (ex.throw exception message))) @@ -166,7 +179,7 @@ (#e.Success [context ]) #.None - (ex.throw Unknown-Type-Var (nat/encode id)))))] + (ex.throw Unknown-Type-Var id))))] [bound? Bool false true] [read (Maybe Type) #.None (#.Some bound)] @@ -180,28 +193,24 @@ (#e.Success [context bound]) (#.Some #.None) - (ex.throw Unbound-Type-Var (nat/encode id)) + (ex.throw Unbound-Type-Var id) #.None - (ex.throw Unknown-Type-Var (nat/encode id))))) + (ex.throw Unknown-Type-Var id)))) (def: #export (write type id) (-> Type Var (Check Unit)) (function [context] (case (|> context (get@ #.var-bindings) (var::get id)) (#.Some (#.Some bound)) - (ex.throw Cannot-Rebind-Var - ($_ text/compose - " Var: " (nat/encode id) "\n" - " Wanted Type: " (type.to-text type) "\n" - "Current Type: " (type.to-text bound))) + (ex.throw Cannot-Rebind-Var [id type bound]) (#.Some #.None) (#e.Success [(update@ #.var-bindings (var::put id (#.Some type)) context) []]) #.None - (ex.throw Unknown-Type-Var (nat/encode id))))) + (ex.throw Unknown-Type-Var id)))) (def: (update type id) (-> Type Var (Check Unit)) @@ -212,7 +221,7 @@ []]) #.None - (ex.throw Unknown-Type-Var (nat/encode id))))) + (ex.throw Unknown-Type-Var id)))) (def: #export var (Check [Var Type]) @@ -243,7 +252,7 @@ [?funcT' (read func-id)] (case ?funcT' #.None - (throw Invalid-Type-Application (type.to-text (#.Apply argT funcT))) + (throw Invalid-Type-Application [funcT argT]) (#.Some funcT') (apply-type! funcT' argT))) @@ -252,7 +261,7 @@ (function [context] (case (type.apply (list argT) funcT) #.None - (ex.throw Invalid-Type-Application (type.to-text (#.Apply argT funcT))) + (ex.throw Invalid-Type-Application [funcT argT]) (#.Some output) (#e.Success [context output]))))) @@ -281,7 +290,7 @@ (#e.Success [context output]) #.None - (ex.throw Unknown-Type-Var (nat/encode current)))))) + (ex.throw Unknown-Type-Var current))))) (def: #export fresh-context Type-Context @@ -510,10 +519,7 @@ (if (is expected actual) (check/wrap assumptions) (with-error-stack - (function [_] (Type-Check-Failed - ($_ text/compose - "Expected: " (type.to-text expected) "\n\n" - " Actual: " (type.to-text actual)))) + (function [_] (ex.construct Type-Check-Failed [expected actual])) (case [expected actual] [(#.Var idE) (#.Var idA)] (check-vars check' assumptions idE idA) diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index a84196f2c..636824d99 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -286,7 +286,8 @@ _ (p.fail ($_ text/compose "Not a bound type: " (type.to-text headT)))))) -(exception: #export Not-Existential-Type) +(exception: #export (Not-Existential-Type {type Type}) + (type.to-text type)) (def: #export existential (Poly Nat) @@ -297,7 +298,7 @@ (wrap ex-id) _ - (p.fail (Not-Existential-Type (type.to-text headT)))))) + (p.fail (ex.construct Not-Existential-Type headT))))) (def: #export named (Poly [Ident Type]) diff --git a/stdlib/source/lux/macro/syntax/common.lux b/stdlib/source/lux/macro/syntax/common.lux index fa3d975db..32e5118af 100644 --- a/stdlib/source/lux/macro/syntax/common.lux +++ b/stdlib/source/lux/macro/syntax/common.lux @@ -21,3 +21,7 @@ #definition-anns Annotations #definition-args (List Text) }) + +(type: #export Typed-Input + {#input-binding Code + #input-type Code}) diff --git a/stdlib/source/lux/macro/syntax/common/reader.lux b/stdlib/source/lux/macro/syntax/common/reader.lux index bb2e128e6..f850bd217 100644 --- a/stdlib/source/lux/macro/syntax/common/reader.lux +++ b/stdlib/source/lux/macro/syntax/common/reader.lux @@ -137,8 +137,8 @@ (def: #export typed-input {#.doc "Reader for the common typed-argument syntax used by many macros."} - (Syntax [Text Code]) - (s.tuple (p.seq s.local-symbol s.any))) + (Syntax //.Typed-Input) + (s.record (p.seq s.any s.any))) (def: #export type-variables {#.doc "Reader for the common type var/param used by many macros."} diff --git a/stdlib/source/lux/macro/syntax/common/writer.lux b/stdlib/source/lux/macro/syntax/common/writer.lux index 34f911842..e9f899f1d 100644 --- a/stdlib/source/lux/macro/syntax/common/writer.lux +++ b/stdlib/source/lux/macro/syntax/common/writer.lux @@ -16,3 +16,8 @@ (def: #export (annotations anns) (-> //.Annotations Code) (|> anns (list/map (product.both code.tag id)) code.record)) + +## Type-Variables +(def: #export (type-variables vars) + (-> (List Text) Code) + (code.tuple (list/map code.local-symbol vars))) diff --git a/stdlib/source/lux/math/constructive.lux b/stdlib/source/lux/math/constructive.lux index 5ecd8d0e2..762e15e31 100644 --- a/stdlib/source/lux/math/constructive.lux +++ b/stdlib/source/lux/math/constructive.lux @@ -194,4 +194,4 @@ (.def: #export absurdity (.All [p] (-> p .Bottom)) (.function [proof] - (.error! (Absurdity "")))) + (.error! (ex.construct Absurdity [])))) diff --git a/stdlib/source/lux/math/modular.lux b/stdlib/source/lux/math/modular.lux index 7fadcd8b3..71d22395e 100644 --- a/stdlib/source/lux/math/modular.lux +++ b/stdlib/source/lux/math/modular.lux @@ -14,8 +14,6 @@ [math])) (exception: #export Zero-Cannot-Be-A-Modulus) -(exception: #export Cannot-Equalize-Numbers) -(exception: #export Incorrect-Modulus) (abstract: #export (Modulus m) {#.doc "A number used as a modulus in modular arithmetic. @@ -26,7 +24,7 @@ (def: #export (from-int value) (Ex [m] (-> Int (Error (Modulus m)))) (if (i/= 0 value) - (#e.Error (Zero-Cannot-Be-A-Modulus "")) + (ex.throw Zero-Cannot-Be-A-Modulus []) (#e.Success (@abstraction value)))) (def: #export (to-int modulus) @@ -34,6 +32,18 @@ (|> modulus @representation)) ) +(exception: #export [m] (Incorrect-Modulus {modulus (Modulus m)} + {parsed Int}) + ($_ text/compose + "Expected: " (int/encode (to-int modulus)) "\n" + " Actual: " (int/encode parsed) "\n")) + +(exception: #export [rm sm] (Cannot-Equalize-Moduli {reference (Modulus rm)} + {sample (Modulus sm)}) + ($_ text/compose + "Reference: " (int/encode (to-int reference)) "\n" + " Sample: " (int/encode (to-int sample)) "\n")) + (def: #export (congruent? modulus reference sample) (All [m] (-> (Modulus m) Int Int Bool)) (|> sample @@ -87,10 +97,7 @@ (<| (l.run text) (do p.Monad [[remainder _ _modulus] ($_ p.seq intL (l.this separator) intL) - _ (p.assert (Incorrect-Modulus - ($_ text/compose - "Expected modulus: " (int/encode (to-int modulus)) "\n" - " Actual modulus: " (int/encode _modulus) "\n")) + _ (p.assert (ex.construct Incorrect-Modulus [modulus _modulus]) (i/= (to-int modulus) _modulus))] (wrap (mod modulus remainder)))))) @@ -102,10 +109,7 @@ (to-int sample-modulus)) (#e.Success (@abstraction {#remainder sample #modulus reference-modulus})) - (#e.Error (Cannot-Equalize-Numbers - ($_ text/compose - "Reference modulus: " (int/encode (to-int reference-modulus)) "\n" - " Sample modulus: " (int/encode (to-int sample-modulus)) "\n")))))) + (ex.throw Cannot-Equalize-Moduli [reference-modulus sample-modulus])))) (do-template [ ] [(def: #export ( reference sample) diff --git a/stdlib/source/lux/type/resource.lux b/stdlib/source/lux/type/resource.lux index d57c25976..9045b2291 100644 --- a/stdlib/source/lux/type/resource.lux +++ b/stdlib/source/lux/type/resource.lux @@ -112,7 +112,9 @@ [read IO io.Monad] [read! Promise promise.Monad])) -(exception: #export Index-Cannot-Be-Repeated) +(exception: #export (Index-Cannot-Be-Repeated {index Nat}) + (%n index)) + (exception: #export Amount-Cannot-Be-Zero) (def: indices @@ -124,7 +126,7 @@ (wrap (list)) (do @ [head s.nat - _ (p.assert (Index-Cannot-Be-Repeated (%n head)) + _ (p.assert (ex.construct Index-Cannot-Be-Repeated head) (not (set.member? seen head))) tail (recur (set.add head seen))] (wrap (list& head tail)))))))) @@ -170,7 +172,7 @@ (Syntax Nat) (do p.Monad [raw s.nat - _ (p.assert (Amount-Cannot-Be-Zero "") + _ (p.assert (ex.construct Amount-Cannot-Be-Zero []) (n/> +0 raw))] (wrap raw))) diff --git a/stdlib/source/lux/world/blob.jvm.lux b/stdlib/source/lux/world/blob.jvm.lux index 6b04948e3..a9078d69c 100644 --- a/stdlib/source/lux/world/blob.jvm.lux +++ b/stdlib/source/lux/world/blob.jvm.lux @@ -9,8 +9,11 @@ text/format) [host])) -(exception: #export Index-Out-Of-Bounds) -(exception: #export Inverted-Range) +(exception: #export (Index-Out-Of-Bounds {description Text}) + description) + +(exception: #export (Inverted-Range {description Text}) + description) (type: #export Blob (host.type (Array byte))) diff --git a/stdlib/source/lux/world/file.lux b/stdlib/source/lux/world/file.lux index 92d9a7540..957bbc7ef 100644 --- a/stdlib/source/lux/world/file.lux +++ b/stdlib/source/lux/world/file.lux @@ -9,11 +9,14 @@ [io #+ Process] [host])) -(exception: #export Could-Not-Read-All-Data) -(exception: #export Not-A-Directory) - (type: #export File Text) +(exception: #export (Could-Not-Read-All-Data {file File}) + file) + +(exception: #export (Not-A-Directory {file File}) + file) + (host.import #long java/io/File (new [String]) (exists [] #io #try boolean) diff --git a/stdlib/source/lux/world/net/udp.jvm.lux b/stdlib/source/lux/world/net/udp.jvm.lux index c0aa54b77..dbfa154d9 100644 --- a/stdlib/source/lux/world/net/udp.jvm.lux +++ b/stdlib/source/lux/world/net/udp.jvm.lux @@ -40,8 +40,11 @@ ############################################################ ############################################################ -(exception: #export Cannot-Resolve-Address) -(exception: #export Multiple-Candidate-Addresses) +(exception: #export (Cannot-Resolve-Address {address //.Address}) + address) + +(exception: #export (Multiple-Candidate-Addresses {address //.Address}) + address) (def: (resolve address) (-> //.Address (io.IO (e.Error InetAddress))) -- cgit v1.2.3