From 01353c65c1a6b03285eee4de28a12abdbf3c9715 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 4 Jul 2018 19:05:21 -0400 Subject: - "with-stack" function for stacking exceptions. --- stdlib/source/lux/control/exception.lux | 53 ++++++++++++++++------ stdlib/source/lux/lang/compiler.lux | 20 ++------ .../source/lux/lang/compiler/analysis/function.lux | 14 ++---- .../lux/lang/compiler/analysis/inference.lux | 8 ++-- .../lux/lang/compiler/analysis/structure.lux | 8 +--- 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] @@ -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 [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 - [[applyT argsA] (//inference.general analyse functionT args)] - (wrap (//.apply [functionA argsA]))))) + (<| (///.with-stack cannot-apply [functionT args]) + (do macro.Monad + [[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 [[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 [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 [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) -- cgit v1.2.3