use reject instead of [ ... not ] filter.

[factor.git] / basis / stack-checker / stack-checker-tests.factor

diff --git a/basis/stack-checker/stack-checker-tests.factor b/basis/stack-checker/stack-checker-tests.factor
index 417b7fbed06790d1c41e5bfe06dbec24800a437b..8e9f97e45794c39728bd3f5300e38bef3ff6f0c5 100644 (file)
--- a/basis/stack-checker/stack-checker-tests.factor
+++ b/basis/stack-checker/stack-checker-tests.factor
@@ -7,7 +7,7 @@ sorting assocs definitions prettyprint io inspector
 classes.tuple classes.union classes.predicate debugger
 threads.private io.streams.string io.timeouts io.thread
 sequences.private destructors combinators eval locals.backend
-system compiler.units shuffle vocabs ;
+system compiler.units shuffle vocabs combinators.smart ;
 IN: stack-checker.tests
 
 [ 1234 infer ] must-fail
@@ -384,7 +384,8 @@ DEFER: eee'
 [ forget-test ] must-infer
 
 [ [ cond ] infer ] [ T{ unknown-macro-input f cond } = ] must-fail-with
-[ [ bi ] infer ] [ T{ unknown-macro-input f call } = ] must-fail-with
+[ [ call ] infer ] [ T{ unknown-macro-input f call } = ] must-fail-with
+[ [ dip ] infer ] [ T{ unknown-macro-input f call } = ] must-fail-with
 
 [ [ each ] infer ] [ T{ unknown-macro-input f each } = ] must-fail-with
 [ [ if* ] infer ] [ T{ unknown-macro-input f if* } = ] must-fail-with
@@ -408,9 +409,9 @@ DEFER: eee'
 ! Make sure all primitives are covered
 [ { } ] [
     all-words [ primitive? ] filter
-    [ "default-output-classes" word-prop not ] filter
-    [ "special" word-prop not ] filter
-    [ "shuffle" word-prop not ] filter
+    [ "default-output-classes" word-prop ] reject
+    [ "special" word-prop ] reject
+    [ "shuffle" word-prop ] reject
 ] unit-test
 
 { 1 0 } [ [ drop       ] each ] must-infer-as
@@ -450,8 +451,15 @@ DEFER: eee'
 [ [ [ 1 + ] strict-2map ] infer ] [ unbalanced-branches-error? ] must-fail-with
 
 ! ensure that polymorphic checking works on recursive combinators
-FROM: splitting.private => split, ;
-{ 2 0 } [ [ member? ] curry split, ] must-infer-as
+: (recursive-reduce) ( identity i seq quot: ( prev elt -- next ) n -- result )
+    [ pick ] dip swap over < [
+        [ [ [ nth-unsafe ] dip call ] 3keep [ 1 + ] 2dip ] dip
+        (recursive-reduce)
+    ] [ 4drop ] if ; inline recursive
+: recursive-reduce ( seq i quot: ( prev elt -- next ) -- result )
+    swapd [ 0 ] 2dip over length (recursive-reduce) ; inline
+{ 24995000 } [ 10000 iota 0 [ dup even? [ + ] [ drop ] if ] recursive-reduce ] unit-test
+{ 3 1 } [ [ member? [ 1 + ] when ] curry recursive-reduce ] must-infer-as
 
 [ [ [ write write ] each      ] infer ] [ unbalanced-branches-error? ] must-fail-with
 
@@ -501,3 +509,40 @@ USING: alien.c-types alien ;
     void { } cdecl [ recursive-callback-2 drop ] alien-callback ; inline recursive
 
 [ recursive-callback-2 ] must-infer
+
+! test one-sided row polymorphism
+
+: poly-output ( x a: ( x -- ..a ) -- ..a ) call ; inline
+
+[ [ ] poly-output ] must-infer
+[ [ f f f ] poly-output ] must-infer
+
+: poly-input ( ..a a: ( ..a -- x ) -- x ) call ; inline
+
+[ [ ] poly-input ] must-infer
+[ [ drop drop drop ] poly-input ] must-infer
+
+: poly-output-input ( x a: ( x -- ..a ) b: ( ..a -- y ) -- y ) [ call ] bi@ ; inline
+
+[ [ ] [ ] poly-output-input ] must-infer
+[ [ f f f ] [ drop drop drop ] poly-output-input ] must-infer
+[ [ [ f f ] [ drop drop drop ] poly-output-input ] infer ] [ unbalanced-branches-error? ] must-fail-with
+[ [ [ f f f ] [ drop drop ] poly-output-input ] infer ] [ unbalanced-branches-error? ] must-fail-with
+
+: poly-input-output ( ..a a: ( ..a -- x ) b: ( x -- ..b ) -- ..b ) [ call ] bi@ ; inline
+
+[ [ ] [ ] poly-input-output ] must-infer
+[ [ drop drop drop ] [ f f f ] poly-input-output ] must-infer
+[ [ drop drop ] [ f f f ] poly-input-output ] must-infer
+[ [ drop drop drop ] [ f f ] poly-input-output ] must-infer
+
+! Check that 'inputs' and 'outputs' work at compile-time
+
+: inputs-test0 ( -- n )
+    [ 5 + ] inputs ;
+
+: inputs-test1 ( x -- n )
+    [ + ] curry inputs ;
+
+[ 1 ] [ inputs-test0 ] unit-test
+[ 1 ] [ 10 inputs-test1 ] unit-test