- "with-stack" function for stacking exceptions.

4 files changed, 14 insertions, 36 deletions

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)