diff --git a/basis/core-foundation/fsevents/fsevents.factor b/basis/core-foundation/fsevents/fsevents.factor index 06b9c6407b..46f6639ab8 100644 --- a/basis/core-foundation/fsevents/fsevents.factor +++ b/basis/core-foundation/fsevents/fsevents.factor @@ -167,7 +167,7 @@ SYMBOL: event-stream-callbacks eventFlags numEvents eventIds numEvents 3array flip - info event-stream-callbacks get at [ drop ] or call ; + info event-stream-callbacks get at [ drop ] or call( changes -- ) ; : master-event-source-callback ( -- alien ) "void" diff --git a/basis/stack-checker/call-effect/call-effect.factor b/basis/stack-checker/call-effect/call-effect.factor index ef9a0305f6..bd1f7c73c3 100644 --- a/basis/stack-checker/call-effect/call-effect.factor +++ b/basis/stack-checker/call-effect/call-effect.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors combinators combinators.private effects fry -kernel kernel.private make sequences continuations +kernel kernel.private make sequences continuations quotations stack-checker stack-checker.transforms ; IN: stack-checker.call-effect @@ -20,18 +20,22 @@ TUPLE: inline-cache value ; : cache-hit? ( word/quot ic -- ? ) value>> eq? ; inline -SYMBOL: +failed+ +SYMBOL: +unknown+ -: cached-effect ( quot -- effect ) +GENERIC: cached-effect ( quot -- effect ) + +M: object cached-effect drop +unknown+ ; + +M: quotation cached-effect dup cached-effect>> [ ] [ - [ [ infer ] [ 2drop +failed+ ] recover dup ] keep + [ [ infer ] [ 2drop +unknown+ ] recover dup ] keep (>>cached-effect) ] ?if ; : call-effect-unsafe? ( quot effect -- ? ) [ cached-effect ] dip - over +failed+ eq? + over +unknown+ eq? [ 2drop f ] [ effect<= ] if ; inline : (call-effect-slow>quot) ( in out effect -- quot ) diff --git a/basis/tools/deploy/shaker/shaker.factor b/basis/tools/deploy/shaker/shaker.factor index 98fc06a989..239d34b864 100755 --- a/basis/tools/deploy/shaker/shaker.factor +++ b/basis/tools/deploy/shaker/shaker.factor @@ -122,6 +122,7 @@ IN: tools.deploy.shaker "inline" "inlined-block" "input-classes" + "instances" "interval" "intrinsics" "lambda" @@ -344,7 +345,8 @@ IN: tools.deploy.shaker ] 2each ; : compress-quotations ( -- ) - [ quotation? ] [ remain-compiled ] "quotations" compress ; + [ quotation? ] [ remain-compiled ] "quotations" compress + [ quotation? ] instances [ f >>cached-effect f >>cache-counter drop ] each ; : compress-strings ( -- ) [ string? ] [ ] "strings" compress ; diff --git a/basis/tools/deploy/shaker/strip-call.factor b/basis/tools/deploy/shaker/strip-call.factor index 4259895936..860a0f3849 100644 --- a/basis/tools/deploy/shaker/strip-call.factor +++ b/basis/tools/deploy/shaker/strip-call.factor @@ -5,4 +5,6 @@ IN: tools.deploy.shaker.call IN: call USE: call.private +: call-effect ( word effect -- ) call-effect-unsafe ; inline + : execute-effect ( word effect -- ) execute-effect-unsafe ; inline \ No newline at end of file diff --git a/core/combinators/combinators-tests.factor b/core/combinators/combinators-tests.factor index 1a4ee34fa2..be7d93873e 100644 --- a/core/combinators/combinators-tests.factor +++ b/core/combinators/combinators-tests.factor @@ -27,6 +27,14 @@ IN: combinators.tests [ -3 ] [ 1 4 \ - compile-execute(-test-2 ] unit-test [ 5 ] [ 1 4 \ + compile-execute(-test-2 ] unit-test +: compile-call(-test-1 ( a b q -- c ) call( a b -- c ) ; + +[ t ] [ \ compile-call(-test-1 optimized>> ] unit-test +[ 4 ] [ 1 3 [ + ] compile-call(-test-1 ] unit-test +[ 7 ] [ 1 3 2 [ * + ] curry 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 + ! Compiled : cond-test-1 ( obj -- str ) {