assert-depth now has a static stack effect. This fixes a UI unit test failure

basis/cocoa/messages/messages.factor

@@ -91,7 +91,7 @@ class-init-hooks global [ H{ } clone or ] change-at
 
 : (objc-class) ( name word -- class )
     2dup execute dup [ 2nip ] [
-        drop over class-init-hooks get at [ call ] when*
+        drop over class-init-hooks get at [ assert-depth ] when*
         2dup execute dup [ 2nip ] [
             2drop "No such class: " prepend throw
         ] if

basis/help/lint/lint.factor

@@ -67,7 +67,7 @@ IN: help.lint
         vocab-exists? [ "$vocab-link to non-existent vocabulary" throw ] unless
     ] each ;
 
-: check-rendering ( word element -- )
+: check-rendering ( element -- )
     [ print-topic ] with-string-writer drop ;
 
 : all-word-help ( words -- seq )
@@ -87,13 +87,14 @@ M: help-error error.
 : check-word ( word -- )
     dup word-help [
         [
-            dup word-help [
+            dup word-help '[
-                2dup check-examples
+                _ _ {
-                2dup check-values
+                    [ check-examples ]
-                2dup check-see-also
+                    [ check-values ]
-                2dup nip check-modules
+                    [ check-see-also ]
-                2dup drop check-rendering
+                    [ [ check-rendering ] [ check-modules ] bi* ]
-            ] assert-depth 2drop
+                } 2cleave
+            ] assert-depth
         ] check-something
     ] [ drop ] if ;
 
@@ -101,9 +102,9 @@ M: help-error error.
 
 : check-article ( article -- )
     [
-        dup article-content [
+        dup article-content
-            2dup check-modules check-rendering
+        '[ _ check-rendering _ check-modules ]
-        ] assert-depth 2drop
+        assert-depth
     ] check-something ;
 
 : files>vocabs ( -- assoc )

basis/tools/test/test-docs.factor

@@ -86,7 +86,7 @@ HELP: test-all
 { $description "Runs unit tests for all loaded vocabularies." } ;
 
 HELP: run-all-tests
-{ $values { "prefix" "a vocabulary name" } { "failures" "an association list of unit test failures" } }
+{ $values { "failures" "an association list of unit test failures" } }
 { $description "Runs unit tests for all loaded vocabularies and outputs unit test failures as documented in " { $link "tools.test.failure" } "." } ;
 
 HELP: test-failures.

basis/tools/test/test-tests.factor

@@ -0,0 +1,4 @@
+IN: tools.test.tests
+USING: tools.test ;
+
+\ test-all must-infer

basis/tools/test/test.factor

@@ -88,7 +88,7 @@ SYMBOL: this-test
 : test ( prefix -- )
     run-tests test-failures. ;
 
-: run-all-tests ( prefix -- failures )
+: run-all-tests ( -- failures )
     "" run-tests ;
 
 : test-all ( -- )

core/combinators/combinators-docs.factor

@@ -29,17 +29,9 @@ $nl
 $nl
 "A combinator which can help with implementing methods on " { $link hashcode* } ":"
 { $subsection recursive-hashcode }
-{ $subsection "assertions" }
 { $subsection "combinators-quot" }
 { $see-also "quotations" "dataflow" } ;
 
-ARTICLE: "assertions" "Assertions"
-"Some words to make assertions easier to enforce:"
-{ $subsection assert }
-{ $subsection assert= }
-"Runtime stack depth checking:"
-{ $subsection assert-depth } ;
-
 ABOUT: "combinators"
 
 HELP: cleave
@@ -167,7 +159,3 @@ HELP: dispatch ( n array -- )
 { $values { "n" "a fixnum" } { "array" "an array of quotations" } }
 { $description "Calls the " { $snippet "n" } "th quotation in the array." }
 { $warning "This word is in the " { $vocab-link "kernel.private" } " vocabulary because it is an implementation detail used by the generic word system to accelerate method dispatch. It does not perform type or bounds checks, and user code should not need to call it directly." } ;
-
-HELP: assert-depth
-{ $values { "quot" "a quotation" } }
-{ $description "Runs a quotation. Throws an error if the total number of elements on the stack is not the same before and after the quotation runs." } ;

core/combinators/combinators.factor

@@ -134,22 +134,6 @@ ERROR: no-case ;
         [ drop linear-case-quot ]
     } cond ;
 
-! assert-depth
-: trim-datastacks ( seq1 seq2 -- seq1' seq2' )
-    2dup [ length ] bi@ min tuck [ tail ] 2bi@ ;
-
-ERROR: relative-underflow stack ;
-
-ERROR: relative-overflow stack ;
-
-: assert-depth ( quot -- )
-    [ datastack ] dip dip [ datastack ] dip
-    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

core/continuations/continuations-docs.factor

@@ -83,6 +83,7 @@ $nl
 { $subsection with-return }
 "Reflecting the datastack:"
 { $subsection with-datastack }
+{ $subsection assert-depth }
 "Continuations serve as the building block for a number of higher-level abstractions, such as " { $link "errors" } " and " { $link "threads" } "."
 { $subsection "continuations.private" } ;
 
@@ -216,6 +217,10 @@ HELP: with-datastack
     { $example "USING: continuations math prettyprint ;" "{ 3 7 } [ + ] with-datastack ." "{ 10 }" }
 } ;
 
+HELP: assert-depth
+{ $values { "quot" "a quotation" } }
+{ $description "Runs a quotation. Throws an error if the quotation attempts to take input values from the stack, or leave outputs on the stack." } ;
+
 HELP: <continuation>
 { $description "Constructs a new continuation." }
 { $notes "User code should call " { $link continuation } " instead." } ;

core/continuations/continuations.factor

@@ -114,6 +114,9 @@ SYMBOL: return-continuation
         ] 3 (throw)
     ] callcc1 2nip ;
 
+: assert-depth ( quot -- )
+    { } swap with-datastack { } assert= ; inline
+
 GENERIC: compute-restarts ( error -- seq )
 
 <PRIVATE

core/kernel/kernel-docs.factor

@@ -887,6 +887,11 @@ $nl
 "An object can be cloned; the clone has distinct identity but equal value:"
 { $subsection clone } ;
 
+ARTICLE: "assertions" "Assertions"
+"Some words to make assertions easier to enforce:"
+{ $subsection assert }
+{ $subsection assert= } ;
+
 ARTICLE: "dataflow" "Data and control flow"
 { $subsection "evaluator" }
 { $subsection "words" }
@@ -902,6 +907,7 @@ ARTICLE: "dataflow" "Data and control flow"
 { $subsection "compositional-combinators" }
 { $subsection "combinators" }
 "Advanced topics:"
+{ $subsection "assertions" }
 { $subsection "implementing-combinators" }
 { $subsection "errors" }
 { $subsection "continuations" } ;

core/parser/parser-tests.factor

@@ -5,6 +5,8 @@ sorting classes.tuple compiler.units debugger vocabs
 vocabs.loader accessors eval combinators lexer ;
 IN: parser.tests
 
+\ run-file must-infer
+
 [
     [ 1 [ 2 [ 3 ] 4 ] 5 ]
     [ "1\n[\n2\n[\n3\n]\n4\n]\n5" eval ]
@@ -400,7 +402,7 @@ IN: parser.tests
 ] times
 
 [ "resource:core/parser/test/assert-depth.factor" run-file ]
-[ stack>> { 1 2 3 } sequence= ]
+[ got>> { 1 2 3 } sequence= ]
 must-fail-with
 
 2 [

core/parser/parser.factor

@@ -307,7 +307,7 @@ print-use-hook global [ [ ] or ] change-at
     ] recover ;
 
 : run-file ( file -- )
-    [ dup parse-file call ] assert-depth drop ;
+    [ parse-file call ] curry assert-depth ;
 
 : ?run-file ( path -- )
     dup exists? [ run-file ] [ drop ] if ;