continuations: keep original error when throwing wrapped errors as well, for easier...

[factor.git] / core / continuations / continuations.factor

diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor
index 196a12d0d2765fce3f71222683dd72a2bef0382c..896a4b982d3934ac5b0aab3f394fb2e79e03cade 100644 (file)
--- a/core/continuations/continuations.factor
+++ b/core/continuations/continuations.factor
@@ -12,6 +12,7 @@ IN: continuations
         swap [ set-datastack ] dip
     ] (( stack quot -- new-stack )) call-effect-unsafe ;
 
+SYMBOL: original-error
 SYMBOL: error
 SYMBOL: error-continuation
 SYMBOL: error-thread
@@ -102,8 +103,8 @@ GENERIC: compute-restarts ( error -- seq )
 <PRIVATE
 
 : save-error ( error -- )
-    dup error set-global
-    compute-restarts restarts set-global ;
+    [ error set-global ]
+    [ compute-restarts restarts set-global ] bi ;
 
 PRIVATE>
 
@@ -113,7 +114,8 @@ SYMBOL: thread-error-hook
     dup save-error
     catchstack* empty? [
         thread-error-hook get-global
-        [ (( error -- * )) call-effect-unsafe ] [ die ] if*
+        [ original-error get-global die ] or
+        (( error -- * )) call-effect-unsafe
     ] when
     c> continue-with ;
 
@@ -176,7 +178,7 @@ M: condition compute-restarts
         ! 63 = self
         63 special-object error-thread set-global
         continuation error-continuation set-global
-        rethrow
+        [ original-error set-global ] [ rethrow ] bi
     ] 5 set-special-object
     ! VM adds this to kernel errors, so that user-space
     ! can identify them