Various fixes for call(

diff --git a/basis/core-foundation/fsevents/fsevents.factor b/basis/core-foundation/fsevents/fsevents.factor
index 06b9c6407bddf3647bc802296d132a6e3e76e76b..46f6639ab8f4b6b57693659944b1ec591dc9c092 100644 (file)
--- a/basis/core-foundation/fsevents/fsevents.factor
+++ b/basis/core-foundation/fsevents/fsevents.factor
@@ -167,7 +167,7 @@ SYMBOL: event-stream-callbacks
     eventFlags numEvents <direct-int-array>
     eventIds numEvents <direct-longlong-array>
     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 ef9a0305f6d0c9e231486d17249127e07fa39c2f..bd1f7c73c34489ad2e21877841604ced70c659c5 100644 (file)
--- 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 98fc06a9899a62e752920b5b0dd3f2c1c4afb448..239d34b86460b2c733c9cf29aa8a4b9b8e5a533d 100755 (executable)
--- 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 425989593661a1cf4778d14df7cbd4fd2d6e1b62..860a0f38492fa2e80400f8a77fd7ea8bce0be905 100644 (file)
--- 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 1a4ee34fa2e5acb971782fff49833b2f43064abe..be7d93873e40328595f1fefac15c919e53c379a1 100644 (file)
--- 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 )
     {