aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--stdlib/source/lux/control/exception.lux53
-rw-r--r--stdlib/source/lux/lang/compiler.lux20
-rw-r--r--stdlib/source/lux/lang/compiler/analysis/function.lux14
-rw-r--r--stdlib/source/lux/lang/compiler/analysis/inference.lux8
-rw-r--r--stdlib/source/lux/lang/compiler/analysis/structure.lux8
5 files changed, 52 insertions, 51 deletions
diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux
index 066a81d65..2ca06defa 100644
--- a/stdlib/source/lux/control/exception.lux
+++ b/stdlib/source/lux/control/exception.lux
@@ -2,7 +2,7 @@
lux
(lux (control [monad #+ do]
["p" parser])
- (data ["e" error]
+ (data ["/" error #+ Error]
[maybe]
[product]
[text "text/" Monoid<Text>]
@@ -30,36 +30,36 @@
If no exception was detected, or a different one from the one being checked, then pass along the original value."}
(All [e a]
- (-> (Exception e) (-> Text a) (e.Error a)
- (e.Error a)))
+ (-> (Exception e) (-> Text a) (Error a)
+ (Error a)))
(case try
- (#e.Success output)
- (#e.Success output)
+ (#/.Success output)
+ (#/.Success output)
- (#e.Error error)
+ (#/.Error error)
(let [reference (get@ #label exception)]
(if (text.starts-with? reference error)
- (#e.Success (|> error
+ (#/.Success (|> error
(text.clip (text.size reference) (text.size error))
maybe.assume
then))
- (#e.Error error)))))
+ (#/.Error error)))))
(def: #export (otherwise to-do try)
{#.doc "If no handler could be found to catch the exception, then run a function as a last-resort measure."}
(All [a]
- (-> (-> Text a) (e.Error a) a))
+ (-> (-> Text a) (Error a) a))
(case try
- (#e.Success output)
+ (#/.Success output)
output
- (#e.Error error)
+ (#/.Error error)
(to-do error)))
(def: #export (return value)
{#.doc "A way to lift normal values into the error-handling context."}
- (All [a] (-> a (e.Error a)))
- (#e.Success value))
+ (All [a] (-> a (Error a)))
+ (#/.Success value))
(def: #export (construct exception message)
{#.doc "Constructs an exception."}
@@ -68,8 +68,8 @@
(def: #export (throw exception message)
{#.doc "Decorate an error message with an Exception and lift it into the error-handling context."}
- (All [e] (-> (Exception e) e e.Error))
- (#e.Error (construct exception message)))
+ (All [e] (-> (Exception e) e Error))
+ (#/.Error (construct exception message)))
(syntax: #export (exception: {export csr.export}
{t-vars (p.default (list) csr.type-variables)}
@@ -119,3 +119,26 @@
(wrap (list (` (report' (list (~+ (|> entries
(list/map (function (_ [header message])
(` [(~ header) (~ message)])))))))))))
+
+(def: separator
+ ($_ "lux text concat"
+ "\n\n"
+ "-----------------------------------------"
+ "\n\n"))
+
+(def: #export (with-stack exception message computation)
+ (All [e a] (-> (Exception e) e (Error a) (Error a)))
+ (case computation
+ (#/.Error error)
+ (#/.Error (case error
+ ""
+ (..construct exception message)
+
+ _
+ ($_ "lux text concat"
+ (..construct exception message)
+ ..separator
+ error)))
+
+ success
+ success))
diff --git a/stdlib/source/lux/lang/compiler.lux b/stdlib/source/lux/lang/compiler.lux
index 20278a6cd..2e88938de 100644
--- a/stdlib/source/lux/lang/compiler.lux
+++ b/stdlib/source/lux/lang/compiler.lux
@@ -57,22 +57,10 @@
(All [s o] (-> s (-> (Operation s o) (Operation s o))))
(localized (function.constant state)))
-(def: error-separator
- (format "\n\n"
- "-----------------------------------------"
- "\n\n"))
-
-(def: #export (with-stacked-errors handler action)
- (All [s o] (-> (-> [] Text) (Operation s o) (Operation s o)))
- (function (_ state)
- (case (action state)
- (#error.Error error)
- (#error.Error (if (text.empty? error)
- (handler [])
- (format (handler []) error-separator error)))
-
- success
- success)))
+(def: #export (with-stack exception message action)
+ (All [e s o] (-> (Exception e) e (Operation s o) (Operation s o)))
+ (<<| (ex.with-stack exception message)
+ action))
(def: #export identity
(All [s a] (Compiler s a a))
diff --git a/stdlib/source/lux/lang/compiler/analysis/function.lux b/stdlib/source/lux/lang/compiler/analysis/function.lux
index b6e09f11a..b16b18e59 100644
--- a/stdlib/source/lux/lang/compiler/analysis/function.lux
+++ b/stdlib/source/lux/lang/compiler/analysis/function.lux
@@ -35,9 +35,7 @@
(do macro.Monad<Meta>
[functionT macro.expected-type]
(loop [expectedT functionT]
- (///.with-stacked-errors
- (.function (_ _)
- (ex.construct cannot-analyse [expectedT function-name arg-name body]))
+ (///.with-stack cannot-analyse [expectedT function-name arg-name body]
(case expectedT
(#.Named name unnamedT)
(recur unnamedT)
@@ -95,9 +93,7 @@
(def: #export (apply analyse functionT functionA args)
(-> Compiler Type Analysis (List Code) (Meta Analysis))
- (///.with-stacked-errors
- (.function (_ _)
- (ex.construct cannot-apply [functionT args]))
- (do macro.Monad<Meta>
- [[applyT argsA] (//inference.general analyse functionT args)]
- (wrap (//.apply [functionA argsA])))))
+ (<| (///.with-stack cannot-apply [functionT args])
+ (do macro.Monad<Meta>
+ [[applyT argsA] (//inference.general analyse functionT args)])
+ (wrap (//.apply [functionA argsA]))))
diff --git a/stdlib/source/lux/lang/compiler/analysis/inference.lux b/stdlib/source/lux/lang/compiler/analysis/inference.lux
index abf1529d6..5e3fb0cfe 100644
--- a/stdlib/source/lux/lang/compiler/analysis/inference.lux
+++ b/stdlib/source/lux/lang/compiler/analysis/inference.lux
@@ -143,11 +143,9 @@
(#.Function inputT outputT)
(do ///.Monad<Operation>
[[outputT' args'A] (general analyse outputT args')
- argA (///.with-stacked-errors
- (function (_ _)
- (ex.construct cannot-infer-argument [inputT argC]))
- (//type.with-type inputT
- (analyse argC)))]
+ argA (<| (///.with-stack cannot-infer-argument [inputT argC])
+ (//type.with-type inputT)
+ (analyse argC))]
(wrap [outputT' (list& argA args'A)]))
(#.Var infer-id)
diff --git a/stdlib/source/lux/lang/compiler/analysis/structure.lux b/stdlib/source/lux/lang/compiler/analysis/structure.lux
index 78b36bc32..ed809135a 100644
--- a/stdlib/source/lux/lang/compiler/analysis/structure.lux
+++ b/stdlib/source/lux/lang/compiler/analysis/structure.lux
@@ -77,9 +77,7 @@
(-> Compiler Nat Code (Operation Analysis))
(do ///.Monad<Operation>
[expectedT macro.expected-type]
- (///.with-stacked-errors
- (function (_ _)
- (ex.construct cannot-analyse-variant [expectedT tag valueC]))
+ (///.with-stack cannot-analyse-variant [expectedT tag valueC]
(case expectedT
(#.Sum _)
(let [flat (type.flatten-variant expectedT)
@@ -191,9 +189,7 @@
(-> Compiler (List Code) (Operation Analysis))
(do ///.Monad<Operation>
[expectedT macro.expected-type]
- (///.with-stacked-errors
- (function (_ _)
- (ex.construct cannot-analyse-tuple [expectedT membersC]))
+ (///.with-stack cannot-analyse-tuple [expectedT membersC]
(case expectedT
(#.Product _)
(..typed-product analyse membersC)
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-24 18:32:10 +0000