Inline caching for call(

basis/stack-checker/call-effect/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

basis/stack-checker/call-effect/call-effect.factor

@@ -0,0 +1,91 @@
+! 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
+stack-checker stack-checker.transforms ;
+IN: stack-checker.call-effect
+
+! call( and execute( have complex expansions.
+
+! call( uses the following strategy:
+! - Inline caching. If the quotation is the same as last time, just call it unsafely
+! - Effect inference. Infer quotation's effect, caching it in the cached-effect slot,
+!   and compare it with declaration. If matches, call it unsafely.
+! - Fallback. If the above doesn't work, call it and compare the datastack before
+!   and after to make sure it didn't mess anything up.
+
+! execute( uses a similar strategy.
+
+TUPLE: inline-cache value ;
+
+: cache-hit? ( word/quot ic -- ? ) value>> eq? ; inline
+
+SYMBOL: +failed+
+
+: cached-effect ( quot -- effect )
+    dup cached-effect>>
+    [ ] [
+        [ [ infer ] [ 2drop +failed+ ] recover dup ] keep
+        (>>cached-effect)
+    ] ?if ;
+
+: call-effect-unsafe? ( quot effect -- ? )
+    [ cached-effect ] dip
+    over +failed+ eq?
+    [ 2drop f ] [ effect<= ] if ; inline
+
+: (call-effect-slow>quot) ( in out effect -- quot )
+    [
+        [ [ datastack ] dip dip ] %
+        [ [ , ] bi@ \ check-datastack , ] dip
+        '[ _ wrong-values ] , \ unless ,
+    ] [ ] make ;
+
+: call-effect-slow>quot ( effect -- quot )
+    [ in>> length ] [ out>> length ] [ ] tri
+    [ (call-effect-slow>quot) ] keep add-effect-input
+    [ call-effect-unsafe ] 2curry ;
+
+: call-effect-slow ( quot effect -- ) drop call ;
+
+\ call-effect-slow [ call-effect-slow>quot ] 1 define-transform
+
+: call-effect-fast ( quot effect inline-cache -- )
+    2over call-effect-unsafe?
+    [ [ nip (>>value) ] [ drop call-effect-unsafe ] 3bi ]
+    [ drop call-effect-slow ]
+    if ; inline
+
+\ call-effect [
+    inline-cache new '[
+        _
+        3dup nip cache-hit? [
+            drop call-effect-unsafe
+        ] [
+            call-effect-fast
+        ] if
+    ]
+] 0 define-transform
+
+: execute-effect-slow ( word effect -- )
+    [ '[ _ execute ] ] dip call-effect-slow ; inline
+
+: execute-effect-unsafe? ( word effect -- ? )
+    over optimized>> [ [ stack-effect ] dip effect<= ] [ 2drop f ] if ; inline
+
+: execute-effect-fast ( word effect inline-cache -- )
+    2over execute-effect-unsafe?
+    [ [ nip (>>value) ] [ drop execute-effect-unsafe ] 3bi ]
+    [ drop execute-effect-slow ]
+    if ; inline
+
+: execute-effect-ic ( word effect inline-cache -- )
+    3dup nip cache-hit?
+    [ drop execute-effect-unsafe ]
+    [ execute-effect-fast ]
+    if ; inline
+
+: execute-effect>quot ( effect -- quot )
+    inline-cache new '[ _ _ execute-effect-ic ] ;
+
+\ execute-effect [ execute-effect>quot ] 1 define-transform

basis/stack-checker/stack-checker.factor

@@ -1,7 +1,7 @@
-! Copyright (C) 2004, 2008 Slava Pestov.
+! Copyright (C) 2004, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel io effects namespaces sequences quotations vocabs
-generic words stack-checker.backend stack-checker.state
+vocabs.loader generic words stack-checker.backend stack-checker.state
 stack-checker.known-words stack-checker.transforms
 stack-checker.errors stack-checker.inlining
 stack-checker.visitor.dummy ;
@@ -28,3 +28,5 @@ M: callable infer ( quot -- effect )
         dup subwords [ f "inferred-effect" set-word-prop ] each
         f "inferred-effect" set-word-prop
     ] each ;
+
+"stack-checker.call-effect" require

basis/stack-checker/transforms/transforms.factor

@@ -51,47 +51,6 @@ IN: stack-checker.transforms
     [ nip "transform-n" set-word-prop ]
     3bi ;
 
-! call( and execute(
-: (call-effect>quot) ( in out effect -- quot )
-    [
-        [ [ datastack ] dip dip ] %
-        [ [ , ] bi@ \ check-datastack , ] dip
-        '[ _ wrong-values ] , \ unless ,
-    ] [ ] make ;
-
-: call-effect>quot ( effect -- quot )
-    [ in>> length ] [ out>> length ] [ ] tri
-    [ (call-effect>quot) ] keep add-effect-input
-    [ call-effect-unsafe ] 2curry ;
-
-\ call-effect [ call-effect>quot ] 1 define-transform
-
-: execute-effect-slow ( word effect -- )
-    [ '[ _ execute ] ] dip call-effect ; inline
-
-TUPLE: inline-cache value ;
-
-: cache-hit? ( word ic -- ? ) value>> 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 -- )
-    2over execute-effect-unsafe?
-    [ [ nip (>>value) ] [ drop execute-effect-unsafe ] 3bi ]
-    [ drop 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
-
-: execute-effect>quot ( effect -- quot )
-    inline-cache new '[ _ _ execute-effect-ic ] ;
-
-\ execute-effect [ execute-effect>quot ] 1 define-transform
-
 ! Combinators
 \ cond [ cond>quot ] 1 define-transform