Merge branch 'master' of git://factorcode.org/git/factor
commit
e8c5950fe9
|
@ -14,12 +14,20 @@ IN: call.tests
|
||||||
[ 1 2 \ + execute( x y -- z a ) ] must-fail
|
[ 1 2 \ + execute( x y -- z a ) ] must-fail
|
||||||
[ \ + execute( x y -- z ) ] must-infer
|
[ \ + execute( x y -- z ) ] must-infer
|
||||||
|
|
||||||
|
: compile-execute(-test-1 ( a b -- c ) \ + execute( a b -- c ) ;
|
||||||
|
|
||||||
|
[ t ] [ \ compile-execute(-test-1 optimized>> ] unit-test
|
||||||
|
[ 4 ] [ 1 3 compile-execute(-test-1 ] unit-test
|
||||||
|
|
||||||
|
: compile-execute(-test-2 ( a b w -- c ) execute( a b -- c ) ;
|
||||||
|
|
||||||
|
[ t ] [ \ compile-execute(-test-2 optimized>> ] unit-test
|
||||||
|
[ 4 ] [ 1 3 \ + compile-execute(-test-2 ] unit-test
|
||||||
|
[ 5 ] [ 1 4 \ + compile-execute(-test-2 ] unit-test
|
||||||
|
[ -3 ] [ 1 4 \ - compile-execute(-test-2 ] unit-test
|
||||||
|
[ 5 ] [ 1 4 \ + compile-execute(-test-2 ] unit-test
|
||||||
|
|
||||||
[ t ] [ \ + (( a b -- c )) execute-effect-unsafe? ] unit-test
|
[ t ] [ \ + (( a b -- c )) execute-effect-unsafe? ] unit-test
|
||||||
[ t ] [ \ + (( a b c -- d e )) execute-effect-unsafe? ] unit-test
|
[ t ] [ \ + (( a b c -- d e )) execute-effect-unsafe? ] unit-test
|
||||||
[ f ] [ \ + (( a b c -- d )) execute-effect-unsafe? ] unit-test
|
[ f ] [ \ + (( a b c -- d )) execute-effect-unsafe? ] unit-test
|
||||||
[ f ] [ \ call (( x -- )) execute-effect-unsafe? ] unit-test
|
[ f ] [ \ call (( x -- )) execute-effect-unsafe? ] unit-test
|
||||||
|
|
||||||
: compile-execute(-test ( a b -- c ) \ + execute( a b -- c ) ;
|
|
||||||
|
|
||||||
[ t ] [ \ compile-execute(-test optimized>> ] unit-test
|
|
||||||
[ 4 ] [ 1 3 compile-execute(-test ] unit-test
|
|
|
@ -1,7 +1,8 @@
|
||||||
! Copyright (C) 2009 Daniel Ehrenberg.
|
! Copyright (C) 2009 Daniel Ehrenberg, Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: kernel macros fry summary sequences generalizations accessors
|
USING: kernel macros fry summary sequences sequences.private
|
||||||
continuations effects effects.parser parser words ;
|
generalizations accessors continuations effects effects.parser
|
||||||
|
parser words ;
|
||||||
IN: call
|
IN: call
|
||||||
|
|
||||||
ERROR: wrong-values values quot length-required ;
|
ERROR: wrong-values values quot length-required ;
|
||||||
|
@ -14,17 +15,9 @@ M: wrong-values summary
|
||||||
: firstn-safe ( array quot n -- ... )
|
: firstn-safe ( array quot n -- ... )
|
||||||
3dup nip swap length = [ nip firstn ] [ wrong-values ] if ; inline
|
3dup nip swap length = [ nip firstn ] [ wrong-values ] if ; inline
|
||||||
|
|
||||||
: execute-effect-unsafe ( word effect -- )
|
|
||||||
drop execute ;
|
|
||||||
|
|
||||||
: execute-effect-unsafe? ( word effect -- ? )
|
|
||||||
swap dup optimized>> [ stack-effect swap effect<= ] [ 2drop f ] if ; inline
|
|
||||||
|
|
||||||
: parse-call( ( accum word -- accum )
|
: parse-call( ( accum word -- accum )
|
||||||
[ ")" parse-effect parsed ] dip parsed ;
|
[ ")" parse-effect parsed ] dip parsed ;
|
||||||
|
|
||||||
: execute-unsafe( \ execute-effect-unsafe parse-call( ; parsing
|
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
MACRO: call-effect ( effect -- quot )
|
MACRO: call-effect ( effect -- quot )
|
||||||
|
@ -33,10 +26,35 @@ MACRO: call-effect ( effect -- quot )
|
||||||
|
|
||||||
: call( \ call-effect parse-call( ; parsing
|
: call( \ call-effect parse-call( ; parsing
|
||||||
|
|
||||||
: execute-effect ( word effect -- )
|
<PRIVATE
|
||||||
2dup execute-effect-unsafe?
|
|
||||||
[ execute-effect-unsafe ]
|
: execute-effect-unsafe ( word effect -- )
|
||||||
[ [ [ execute ] curry ] dip call-effect ]
|
drop execute ;
|
||||||
if ; inline
|
|
||||||
|
: execute-unsafe( \ execute-effect-unsafe parse-call( ; parsing
|
||||||
|
|
||||||
|
: execute-effect-slow ( word effect -- )
|
||||||
|
[ [ execute ] curry ] dip call-effect ; inline
|
||||||
|
|
||||||
|
: cache-hit? ( word ic -- ? ) first-unsafe eq? ; inline
|
||||||
|
|
||||||
|
: cache-hit ( word effect ic -- ) drop execute-effect-unsafe ; inline
|
||||||
|
|
||||||
|
: execute-effect-unsafe? ( word effect -- ? )
|
||||||
|
over optimized>> [ [ stack-effect ] dip effect<= ] [ 2drop f ] if ; inline
|
||||||
|
|
||||||
|
: cache-miss ( word effect ic -- )
|
||||||
|
[ 2dup execute-effect-unsafe? ] dip
|
||||||
|
'[ [ drop _ set-first ] [ execute-effect-unsafe ] 2bi ]
|
||||||
|
[ execute-effect-slow ] if ; inline
|
||||||
|
|
||||||
|
: execute-effect-ic ( word effect ic -- )
|
||||||
|
#! ic is a mutable cell { effect }
|
||||||
|
3dup nip cache-hit? [ cache-hit ] [ cache-miss ] if ; inline
|
||||||
|
|
||||||
|
PRIVATE>
|
||||||
|
|
||||||
|
MACRO: execute-effect ( effect -- )
|
||||||
|
{ f } clone '[ _ _ execute-effect-ic ] ;
|
||||||
|
|
||||||
: execute( \ execute-effect parse-call( ; parsing
|
: execute( \ execute-effect parse-call( ; parsing
|
||||||
|
|
Loading…
Reference in New Issue