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
[ 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
! 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
[ [ [ 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
[ [ 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