aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/lux/concurrency/actor.lux17
-rw-r--r--stdlib/source/lux/concurrency/task.lux5
-rw-r--r--stdlib/source/lux/control/exception.lux66
-rw-r--r--stdlib/source/lux/control/region.lux30
-rw-r--r--stdlib/source/lux/data/coll/tree/parser.lux2
-rw-r--r--stdlib/source/lux/data/format/context.lux3
-rw-r--r--stdlib/source/lux/data/format/xml.lux36
-rw-r--r--stdlib/source/lux/io.lux4
-rw-r--r--stdlib/source/lux/lang/syntax.lux16
-rw-r--r--stdlib/source/lux/lang/type/check.lux54
-rw-r--r--stdlib/source/lux/macro/poly.lux5
-rw-r--r--stdlib/source/lux/macro/syntax/common.lux4
-rw-r--r--stdlib/source/lux/macro/syntax/common/reader.lux4
-rw-r--r--stdlib/source/lux/macro/syntax/common/writer.lux5
-rw-r--r--stdlib/source/lux/math/constructive.lux2
-rw-r--r--stdlib/source/lux/math/modular.lux26
-rw-r--r--stdlib/source/lux/type/resource.lux8
-rw-r--r--stdlib/source/lux/world/blob.jvm.lux7
-rw-r--r--stdlib/source/lux/world/file.lux9
-rw-r--r--stdlib/source/lux/world/net/udp.jvm.lux7
20 files changed, 190 insertions, 120 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)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 19:14:34 +0000