add test for diverging words

library/platform/native/boot-stage2.factor

@@ -114,7 +114,7 @@ USE: stdio
     "/library/platform/native/heap-stats.factor"
     "/library/platform/native/gensym.factor"
     "/library/tools/interpreter.factor"
-    "/library/tools/inference.factor"
+!    "/library/tools/inference.factor"
 
     "/library/tools/image.factor"
     "/library/tools/cross-compiler.factor"

library/test/inference.factor

@@ -73,6 +73,16 @@ USE: lists
 
 [ [ 1 | 1 ] ] [ [ simple-recursion-2 ] infer ] unit-test
 
+: bad-recursion-1
+    dup [ drop bad-recursion-1 5 ] [ ] ifte ;
+
+[ [ bad-recursion-1 ] infer ] unit-test-fails
+
+: bad-recursion-2
+    dup [ uncons bad-recursion-2 ] [ ] ifte ;
+
+[ [ bad-recursion-2 ] infer ] unit-test-fails
+
 [ [ 2 | 1 ] ] [ [ 2list ] infer ] unit-test
 [ [ 3 | 1 ] ] [ [ 3list ] infer ] unit-test
 [ [ 2 | 1 ] ] [ [ append ] infer ] unit-test

library/tools/inference.factor

@@ -130,6 +130,14 @@ DEFER: (infer)
     current-word word-name
     " does not have a base case." cat2 throw ;
 
+: check-recursion ( -- )
+    #! If at the location of the recursive call, we're taking
+    #! more items from the stack than producing, we have a
+    #! diverging recursion.
+    d-in get meta-d get vector-length > [
+        current-word word-name " diverges." cat2 throw
+    ] when ;
+
 : recursive-word ( word effect -- )
     #! Handle a recursive call, by either applying a previously
     #! inferred base case, or raising an error.
@@ -139,7 +147,7 @@ DEFER: (infer)
     #! Apply the object's stack effect to the inferencer state.
     dup word? [
         dup recursive-state get assoc [
-            recursive-word
+            check-recursion recursive-word
         ] [
             apply-word
         ] ifte*