Merge branch 'master' of factorcode.org:/git/factor
commit
e67a48d720
|
@ -35,6 +35,24 @@ IN: combinators.tests
|
||||||
[ 7 ] [ 1 3 [ 2 * ] [ + ] compose compile-call(-test-1 ] unit-test
|
[ 7 ] [ 1 3 [ 2 * ] [ + ] compose compile-call(-test-1 ] unit-test
|
||||||
[ 4 ] [ 1 3 [ { + } [ ] like call ] compile-call(-test-1 ] unit-test
|
[ 4 ] [ 1 3 [ { + } [ ] like call ] compile-call(-test-1 ] unit-test
|
||||||
|
|
||||||
|
[ [ ] call( -- * ) ] must-fail
|
||||||
|
|
||||||
|
: compile-call(-test-2 ( -- ) [ ] call( -- * ) ;
|
||||||
|
|
||||||
|
[ compile-call(-test-2 ] [ wrong-values? ] must-fail-with
|
||||||
|
|
||||||
|
: compile-call(-test-3 ( quot -- ) call( -- * ) ;
|
||||||
|
|
||||||
|
[ [ ] compile-call(-test-3 ] [ wrong-values? ] must-fail-with
|
||||||
|
|
||||||
|
: compile-execute(-test-3 ( a -- ) \ . execute( value -- * ) ;
|
||||||
|
|
||||||
|
[ 10 compile-execute(-test-3 ] [ wrong-values? ] must-fail-with
|
||||||
|
|
||||||
|
: compile-execute(-test-4 ( a word -- ) execute( value -- * ) ;
|
||||||
|
|
||||||
|
[ 10 \ . compile-execute(-test-4 ] [ wrong-values? ] must-fail-with
|
||||||
|
|
||||||
! Compiled
|
! Compiled
|
||||||
: cond-test-1 ( obj -- str )
|
: cond-test-1 ( obj -- str )
|
||||||
{
|
{
|
||||||
|
|
|
@ -26,15 +26,17 @@ ERROR: wrong-values quot call-site ;
|
||||||
! We can't USE: effects here so we forward reference slots instead
|
! We can't USE: effects here so we forward reference slots instead
|
||||||
SLOT: in
|
SLOT: in
|
||||||
SLOT: out
|
SLOT: out
|
||||||
|
SLOT: terminated?
|
||||||
|
|
||||||
: call-effect ( quot effect -- )
|
: call-effect ( quot effect -- )
|
||||||
! Don't use fancy combinators here, since this word always
|
! Don't use fancy combinators here, since this word always
|
||||||
! runs unoptimized
|
! runs unoptimized
|
||||||
[ datastack ] 2dip
|
|
||||||
2dup [
|
2dup [
|
||||||
[ dip ] dip
|
[ [ datastack ] dip dip ] dip
|
||||||
|
dup terminated?>> [ 2drop f ] [
|
||||||
dup in>> length swap out>> length
|
dup in>> length swap out>> length
|
||||||
check-datastack
|
check-datastack
|
||||||
|
] if
|
||||||
] 2dip rot
|
] 2dip rot
|
||||||
[ 2drop ] [ wrong-values ] if ;
|
[ 2drop ] [ wrong-values ] if ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue