diff options
25 files changed, 221 insertions, 150 deletions
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<Promise> 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<Promise> 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 "text/" Monoid<Text>] + (coll [list "list/" Functor<List>])) [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<m> computation) (All [m a] @@ -131,10 +132,11 @@ (:: Monad<m> wrap [cleaners (#e.Error error)]))) (def: #export (throw Monad<m> 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<m> (exception message))) + (function [[region cleaners]] + (:: Monad<m> wrap [cleaners (ex.throw exception message)]))) (def: #export (lift Monad<m> 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 (<direction> 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<Text,XML> 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<Text,XML> 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<Error> @@ -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<Type>]) )) -(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 <succeed>]) #.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<Parser> [[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 [<name> <op>] [(def: #export (<name> 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<IO>] [read! Promise promise.Monad<Promise>])) -(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<Parser> [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))) diff --git a/stdlib/test/test/lux/concurrency/actor.lux b/stdlib/test/test/lux/concurrency/actor.lux index a5403d7d8..685ab169b 100644 --- a/stdlib/test/test/lux/concurrency/actor.lux +++ b/stdlib/test/test/lux/concurrency/actor.lux @@ -5,7 +5,7 @@ ["ex" exception]) (data [number] text/format - ["E" error]) + ["e" error]) (concurrency ["P" promise "P/" Monad<Promise>] ["T" task] ["&" actor #+ actor: message:])) @@ -27,7 +27,7 @@ cause))))) (message: #export Counter - (count! [increment Nat] state self Nat) + (count! {increment Nat} state self Nat) (let [state' (n/+ increment state)] (T.return [state' state']))) @@ -64,9 +64,9 @@ (n/= +3 output-3))))] (assert "Can send messages to actors." (case result - (#E.Success outcome) + (#e.Success outcome) outcome - (#E.Error error) + (#e.Error error) false)))) )) diff --git a/stdlib/test/test/lux/control/exception.lux b/stdlib/test/test/lux/control/exception.lux index 40838875e..0da875e29 100644 --- a/stdlib/test/test/lux/control/exception.lux +++ b/stdlib/test/test/lux/control/exception.lux @@ -40,7 +40,7 @@ default-val) actual (|> (: (E.Error Nat) (if should-throw? - (&.throw this-ex "Uh-oh...") + (&.throw this-ex []) (&.return default-val))) (&.catch Some-Exception (function [ex] some-val)) (&.catch Another-Exception (function [ex] another-val)) diff --git a/stdlib/test/test/lux/control/region.lux b/stdlib/test/test/lux/control/region.lux index 8de498dce..98344fac9 100644 --- a/stdlib/test/test/lux/control/region.lux +++ b/stdlib/test/test/lux/control/region.lux @@ -59,7 +59,7 @@ (do (/.Monad<Region> @) [_ (monad.map @ (/.acquire @@ count-clean-up) (list.n/range +1 expected-clean-ups)) - _ (/.throw @@ Oops "")] + _ (/.throw @@ Oops [])] (wrap []))) actual-clean-ups (thread.read clean-up-counter)] (wrap (and (error? outcome) @@ -73,7 +73,7 @@ count-clean-up (function [value] (do @ [_ (thread.update n/inc clean-up-counter)] - (wrap (: (Error Unit) (ex.throw Oops "")))))] + (wrap (: (Error Unit) (ex.throw Oops [])))))] outcome (/.run @ (do (/.Monad<Region> @) [_ (monad.map @ (/.acquire @@ count-clean-up) diff --git a/stdlib/test/test/lux/world/file.lux b/stdlib/test/test/lux/world/file.lux index 388a52807..6f4e26e6d 100644 --- a/stdlib/test/test/lux/world/file.lux +++ b/stdlib/test/test/lux/world/file.lux @@ -4,7 +4,7 @@ (control [monad #+ do]) (concurrency ["P" promise] ["T" task]) - (data ["E" error] + (data ["e" error] [text] text/format [number]) @@ -42,7 +42,7 @@ (wrap (and (not pre) post deleted? (not remains?)))))] (assert "Can create/delete files." - (E.default false result)))) + (e.default false result)))) (wrap (do P.Monad<Promise> [#let [file (format "temp_file_" (%n (n/+ +1 code)))] result (P.future @@ -52,7 +52,7 @@ _ (@.delete file)] (wrap (:: blob.Eq<Blob> = dataL output))))] (assert "Can write/read files." - (E.default false result)))) + (e.default false result)))) (wrap (do P.Monad<Promise> [#let [file (format "temp_file_" (%n (n/+ +2 code)))] result (P.future @@ -62,7 +62,7 @@ _ (@.delete file)] (wrap (n/= file-size read-size))))] (assert "Can read file size." - (E.default false result)))) + (e.default false result)))) (wrap (do P.Monad<Promise> [#let [file (format "temp_file_" (%n (n/+ +3 code)))] result (P.future @@ -73,23 +73,23 @@ read-size (@.size file) _ (@.delete file)] (wrap (and (n/= (n/* +2 file-size) read-size) - (:: blob.Eq<Blob> = dataL (E.assume (blob.slice +0 (n/dec file-size) output))) - (:: blob.Eq<Blob> = dataR (E.assume (blob.slice file-size (n/dec read-size) output)))))))] + (:: blob.Eq<Blob> = dataL (e.assume (blob.slice +0 (n/dec file-size) output))) + (:: blob.Eq<Blob> = dataR (e.assume (blob.slice file-size (n/dec read-size) output)))))))] (assert "Can append to files." - (E.default false result)))) + (e.default false result)))) (wrap (do P.Monad<Promise> [#let [dir (format "temp_dir_" (%n (n/+ +4 code)))] result (P.future (do io.Monad<Process> [pre (@.exists? dir) - _ (@.make-dir dir) + _ (@.make-directory dir) post (@.exists? dir) deleted? (@.delete dir) remains? (@.exists? dir)] (wrap (and (not pre) post deleted? (not remains?)))))] (assert "Can create/delete directories." - (E.default false result)))) + (e.default false result)))) (wrap (do P.Monad<Promise> [#let [file (format "temp_file_" (%n (n/+ +5 code))) dir (format "temp_dir_" (%n (n/+ +5 code)))] @@ -99,20 +99,20 @@ file-is-file (@.file? file) file-is-directory (@.directory? file) _ (@.delete file) - _ (@.make-dir dir) + _ (@.make-directory dir) directory-is-file (@.file? dir) directory-is-directory (@.directory? dir) _ (@.delete dir)] (wrap (and file-is-file (not file-is-directory) (not directory-is-file) directory-is-directory))))] (assert "Can differentiate files from directories." - (E.default false result)))) + (e.default false result)))) (wrap (do P.Monad<Promise> [#let [file (format "temp_file_" (%n (n/+ +6 code))) dir (format "temp_dir_" (%n (n/+ +6 code)))] result (P.future (do io.Monad<Process> - [_ (@.make-dir dir) + [_ (@.make-directory dir) #let [file' (format dir "/" file)] _ (@.write dataL file') read-size (@.size file') @@ -122,13 +122,13 @@ deleted-file deleted-dir))))] (assert "Can create files inside of directories." - (E.default false result)))) + (e.default false result)))) (wrap (do P.Monad<Promise> [#let [file (format "temp_file_" (%n (n/+ +7 code))) dir (format "temp_dir_" (%n (n/+ +7 code)))] result (P.future (do io.Monad<Process> - [_ (@.make-dir dir) + [_ (@.make-directory dir) #let [file' (format dir "/" file)] _ (@.write dataL file') children (@.files dir) @@ -141,19 +141,19 @@ _ false))))] (assert "Can list files inside a directory." - (E.default false result)))) + (e.default false result)))) (wrap (do P.Monad<Promise> [#let [file (format "temp_file_" (%n (n/+ +8 code)))] result (P.future (do io.Monad<Process> [_ (@.write dataL file) - was-modified? (@.set-last-modified last-modified file) - time-read (@.get-last-modified file) + was-modified? (@.modify last-modified file) + time-read (@.last-modified file) _ (@.delete file)] (wrap (and was-modified? (:: i.Eq<Instant> = last-modified time-read)))))] (assert "Can change the time of last modification." - (E.default false result)))) + (e.default false result)))) (wrap (do P.Monad<Promise> [#let [file0 (format "temp_file_" (%n (n/+ +9 code)) "0") file1 (format "temp_file_" (%n (n/+ +9 code)) "1")] @@ -168,5 +168,5 @@ (wrap (and pre moved? (not post) confirmed? deleted?))))] (assert "Can move a file from one path to another." - (E.default false result)))) + (e.default false result)))) ))) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 26a4212cc..98044e7d1 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -13,7 +13,8 @@ ["_." atom] ["_." frp] ["_." promise] - ["_." stm]) + ["_." stm] + ["_." semaphore]) (control ["_." exception] ["_." interval] ["_." pipe] @@ -68,15 +69,15 @@ (poly ["poly_." eq] ["poly_." functor])) (type ["_." implicit] - ["_." object]) + ["_." object] + ["_." resource]) (lang ["lang/_." syntax] ["_." type] (type ["_." check])) (world ["_." blob] ["_." file] (net ["_." tcp] - ["_." udp])) - )) + ["_." udp])))) (lux (control [contract] [concatenative] [predicate]) |