From 659b6d8f3c3e2ca0f5deed100e8ace971dd7e4c7 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Mon, 4 Feb 2008 23:30:38 -0600
Subject: [PATCH] Better assert-depth error
---
core/debugger/debugger.factor | 30 ++++++++++++++++++++++++++----
1 file changed, 26 insertions(+), 4 deletions(-)
diff --git a/core/debugger/debugger.factor b/core/debugger/debugger.factor
index 77c6da38e9..53f3387d85 100755
--- a/core/debugger/debugger.factor
+++ b/core/debugger/debugger.factor
@@ -87,7 +87,32 @@ TUPLE: assert got expect ;
: depth ( -- n ) datastack length ;
-: assert-depth ( quot -- ) depth slip depth swap assert= ;
+: trim-datastacks ( seq1 seq2 -- seq1' seq2' )
+ 2dup [ length ] 2apply min tuck tail >r tail r> ;
+
+TUPLE: relative-underflow stack ;
+
+: relative-underflow ( before after -- * )
+ trim-datastacks nip \ relative-underflow construct-boa throw ;
+
+M: relative-underflow summary
+ drop "Too many items removed from data stack" ;
+
+TUPLE: relative-overflow stack ;
+
+M: relative-overflow summary
+ drop "Superfluous items pushed to data stack" ;
+
+: relative-overflow ( before after -- * )
+ trim-datastacks drop \ relative-overflow construct-boa throw ;
+
+: assert-depth ( quot -- )
+ >r datastack r> swap slip >r datastack r>
+ 2dup [ length ] compare sgn {
+ { -1 [ relative-underflow ] }
+ { 0 [ 2drop ] }
+ { 1 [ relative-overflow ] }
+ } case ; inline
: expired-error. ( obj -- )
"Object did not survive image save/load: " write third . ;
@@ -222,9 +247,6 @@ M: redefine-error error.
"Re-definition of " write
redefine-error-def . ;
-M: forward-error error.
- "Forward reference to " write forward-error-word . ;
-
M: undefined summary
drop "Calling a deferred word before it has been defined" ;