Fix some test failures
Slava Pestov
parent
7f889e4bb3
commit
425e9d0dde
|
|
@ -88,8 +88,8 @@ CONSTANT: simd-classes
|
|||
{
|
||||
[ "print-mr" get [ nip test-mr mr. ] [ 2drop ] if ]
|
||||
[ "print-checks" get [ [ . ] bi@ ] [ 2drop ] if ]
|
||||
[ [ call ] dip call ]
|
||||
[ [ call ] dip compile-call ]
|
||||
[ [ [ call ] dip call ] call( quot quot -- result ) ]
|
||||
[ [ [ call ] dip compile-call ] call( quot quot -- result ) ]
|
||||
} 2cleave
|
||||
@ not
|
||||
] filter ; inline
|
||||
|
|
@ -233,7 +233,7 @@ simd-classes&reps [
|
|||
] [ ] map-as
|
||||
word '[ _ execute ] ;
|
||||
|
||||
: check-boolean-ops ( class elt-class compare-quot -- )
|
||||
: check-boolean-ops ( class elt-class compare-quot -- seq )
|
||||
[
|
||||
[ boolean-ops [ dup word-schema ] { } map>assoc ] 2dip
|
||||
'[ first2 inputs _ _ check-boolean-op ]
|
||||
|
|
@ -357,13 +357,15 @@ simd-classes [
|
|||
new [ drop 16 random ] map ;
|
||||
|
||||
:: test-shift-vector ( class -- ? )
|
||||
class random-int-vector :> src
|
||||
char-16 random-shift-vector :> perm
|
||||
{ class char-16 } :> decl
|
||||
|
||||
src perm vshuffle
|
||||
src perm [ decl declare vshuffle ] compile-call
|
||||
= ; inline
|
||||
[
|
||||
class random-int-vector :> src
|
||||
char-16 random-shift-vector :> perm
|
||||
{ class char-16 } :> decl
|
||||
|
||||
src perm vshuffle
|
||||
src perm [ decl declare vshuffle ] compile-call
|
||||
=
|
||||
] call( -- ? ) ;
|
||||
|
||||
{ char-16 uchar-16 short-8 ushort-8 int-4 uint-4 longlong-2 ulonglong-2 }
|
||||
[ 10 swap '[ [ t ] [ _ test-shift-vector ] unit-test ] times ] each
|
||||
|
|
@ -371,19 +373,23 @@ simd-classes [
|
|||
"== Checking vector tests" print
|
||||
|
||||
:: test-vector-tests-bool ( vector declaration -- none? any? all? )
|
||||
vector
|
||||
[ [ declaration declare vnone? ] compile-call ]
|
||||
[ [ declaration declare vany? ] compile-call ]
|
||||
[ [ declaration declare vall? ] compile-call ] tri ; inline
|
||||
[
|
||||
vector
|
||||
[ [ declaration declare vnone? ] compile-call ]
|
||||
[ [ declaration declare vany? ] compile-call ]
|
||||
[ [ declaration declare vall? ] compile-call ] tri
|
||||
] call( -- none? any? all? ) ;
|
||||
|
||||
: yes ( -- x ) t ;
|
||||
: no ( -- x ) f ;
|
||||
|
||||
:: test-vector-tests-branch ( vector declaration -- none? any? all? )
|
||||
vector
|
||||
[ [ declaration declare vnone? [ yes ] [ no ] if ] compile-call ]
|
||||
[ [ declaration declare vany? [ yes ] [ no ] if ] compile-call ]
|
||||
[ [ declaration declare vall? [ yes ] [ no ] if ] compile-call ] tri ; inline
|
||||
[
|
||||
vector
|
||||
[ [ declaration declare vnone? [ yes ] [ no ] if ] compile-call ]
|
||||
[ [ declaration declare vany? [ yes ] [ no ] if ] compile-call ]
|
||||
[ [ declaration declare vall? [ yes ] [ no ] if ] compile-call ] tri
|
||||
] call( -- none? any? all? ) ;
|
||||
|
||||
TUPLE: inconsistent-vector-test bool branch ;
|
||||
|
||||
|
|
@ -391,12 +397,14 @@ TUPLE: inconsistent-vector-test bool branch ;
|
|||
2dup = [ drop ] [ inconsistent-vector-test boa ] if ;
|
||||
|
||||
:: test-vector-tests ( vector decl -- none? any? all? )
|
||||
vector decl test-vector-tests-bool :> ( bool-none bool-any bool-all )
|
||||
vector decl test-vector-tests-branch :> ( branch-none branch-any branch-all )
|
||||
|
||||
bool-none branch-none ?inconsistent
|
||||
bool-any branch-any ?inconsistent
|
||||
bool-all branch-all ?inconsistent ; inline
|
||||
[
|
||||
vector decl test-vector-tests-bool :> ( bool-none bool-any bool-all )
|
||||
vector decl test-vector-tests-branch :> ( branch-none branch-any branch-all )
|
||||
|
||||
bool-none branch-none ?inconsistent
|
||||
bool-any branch-any ?inconsistent
|
||||
bool-all branch-all ?inconsistent
|
||||
] call( -- none? any? all? ) ;
|
||||
|
||||
[ f t t ]
|
||||
[ float-4{ t t t t } { float-4 } test-vector-tests ] unit-test
|
||||
|
|
@ -470,7 +478,7 @@ TUPLE: inconsistent-vector-test bool branch ;
|
|||
"== Checking broadcast" print
|
||||
: test-broadcast ( seq -- failures )
|
||||
[ length >array ] keep
|
||||
'[ [ _ 1quotation ] dip '[ _ vbroadcast ] ] [ = ] check-optimizer ; inline
|
||||
'[ [ _ 1quotation ] dip '[ _ vbroadcast ] ] [ = ] check-optimizer ;
|
||||
|
||||
[ { } ] [ float-4{ 1.0 2.0 3.0 4.0 } test-broadcast ] unit-test
|
||||
[ { } ] [ int-4{ HEX: 7fffffff 3 4 -8 } test-broadcast ] unit-test
|
||||
|
|
|
|||
|
|
@ -57,7 +57,7 @@ $nl
|
|||
{ $heading "Limitations" }
|
||||
"The stack checker cannot guarantee that a literal quotation is still literal if it is passed on the data stack to an inlined recursive combinator such as " { $link each } " or " { $link map } ". For example, the following will not infer:"
|
||||
{ $example
|
||||
"[ [ reverse ] swap [ reverse ] map swap call ] infer." "Got a computed value where a literal quotation was expected"
|
||||
"[ [ reverse ] swap [ reverse ] map swap call ] infer." "Cannot apply “call” to a run-time computed value\nmacro call"
|
||||
}
|
||||
"To make this work, use " { $link dip } " to pass the quotation instead:"
|
||||
{ $example
|
||||
|
|
@ -77,7 +77,7 @@ $nl
|
|||
"Combinators which are recursive require additional care. In addition to being declared " { $link POSTPONE: inline } ", they must be declared " { $link POSTPONE: recursive } ". There are three restrictions that only apply to combinators with this declaration:"
|
||||
{ $heading "Input quotation declaration" }
|
||||
"Input parameters which are quotations must be annotated as much in the stack effect. For example, the following will not infer:"
|
||||
{ $example ": bad ( quot -- ) [ call ] keep bad ; inline recursive" "[ [ ] bad ] infer." "Got a computed value where a literal quotation was expected" }
|
||||
{ $example ": bad ( quot -- ) [ call ] keep bad ; inline recursive" "[ [ ] bad ] infer." "Cannot apply “call” to a run-time computed value\nmacro call" }
|
||||
"The following is correct:"
|
||||
{ $example ": good ( quot: ( -- ) -- ) [ call ] keep good ; inline recursive" "[ [ ] good ] infer." "( -- )" }
|
||||
"The effect of the nested quotation itself is only present for documentation purposes; the mere presence of a nested effect is sufficient to mark that value as a quotation parameter."
|
||||
|
|
@ -85,7 +85,7 @@ $nl
|
|||
"The stack checker does not trace data flow in two instances."
|
||||
$nl
|
||||
"An inline recursive word cannot pass a quotation on the data stack through the recursive call. For example, the following will not infer:"
|
||||
{ $example ": bad ( ? quot: ( ? -- ) -- ) 2dup [ not ] dip bad call ; inline recursive" "[ [ drop ] bad ] infer." "Got a computed value where a literal quotation was expected" }
|
||||
{ $unchecked-example ": bad ( ? quot: ( ? -- ) -- ) 2dup [ not ] dip bad call ; inline recursive" "[ [ drop ] bad ] infer." "Cannot apply “call” to a run-time computed value\nmacro call" }
|
||||
"However a small change can be made:"
|
||||
{ $example ": good ( ? quot: ( ? -- ) -- ) [ good ] 2keep [ not ] dip call ; inline recursive" "[ [ drop ] good ] infer." "( object -- )" }
|
||||
"An inline recursive word must have a fixed stack effect in its base case. The following will not infer:"
|
||||
|
|
|
|||
|
|
@ -1,12 +1,12 @@
|
|||
USING: namespaces math partial-continuations tools.test
|
||||
kernel sequences ;
|
||||
kernel sequences fry ;
|
||||
IN: partial-continuations.tests
|
||||
|
||||
SYMBOL: sum
|
||||
|
||||
: range ( r from to -- n )
|
||||
over - 1 + rot [
|
||||
-rot [ over + pick call drop ] each 2drop f
|
||||
'[ over + @ drop ] each drop f
|
||||
] bshift 2nip ; inline
|
||||
|
||||
[ 55 ] [
|
||||
|
|
|
|||
Loading…
Reference in New Issue