Create basis vocab root

[factor.git] / core / combinators / combinators.factor

diff --git a/core/combinators/combinators.factor b/core/combinators/combinators.factor
index 1cc64432cc672e5f4ace1ead4a9c0b546e737878..188dcb3d11a7fffb5645641a06cb56dc2871475b 100755 (executable)
--- a/core/combinators/combinators.factor
+++ b/core/combinators/combinators.factor
@@ -138,6 +138,22 @@ ERROR: no-case ;
         [ drop linear-case-quot ]
     } cond ;
 
+! assert-depth
+: trim-datastacks ( seq1 seq2 -- seq1' seq2' )
+    2dup [ length ] bi@ min tuck tail >r tail r> ;
+
+ERROR: relative-underflow stack ;
+
+ERROR: relative-overflow stack ;
+
+: assert-depth ( quot -- )
+    >r datastack r> dip >r datastack r>
+    2dup [ length ] compare {
+        { +lt+ [ trim-datastacks nip relative-underflow ] }
+        { +eq+ [ 2drop ] }
+        { +gt+ [ trim-datastacks drop relative-overflow ] }
+    } case ; inline
+
 ! recursive-hashcode
 : recursive-hashcode ( n obj quot -- code )
     pick 0 <= [ 3drop 0 ] [ rot 1- -rot call ] if ; inline