From e981090045615814716f8e3fae78c864c6a0726f Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 16 Mar 2009 23:02:55 -0500
Subject: [PATCH] Inline caching for call(

---
 basis/stack-checker/call-effect/authors.txt   |  1 +
 .../call-effect/call-effect.factor            | 91 +++++++++++++++++++
 basis/stack-checker/stack-checker.factor      |  6 +-
 .../transforms/transforms.factor              | 41 ---------
 4 files changed, 96 insertions(+), 43 deletions(-)
 create mode 100644 basis/stack-checker/call-effect/authors.txt
 create mode 100644 basis/stack-checker/call-effect/call-effect.factor

diff --git a/basis/stack-checker/call-effect/authors.txt b/basis/stack-checker/call-effect/authors.txt
new file mode 100644
index 0000000000..d4f5d6b3ae
--- /dev/null
+++ b/basis/stack-checker/call-effect/authors.txt
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file
diff --git a/basis/stack-checker/call-effect/call-effect.factor b/basis/stack-checker/call-effect/call-effect.factor
new file mode 100644
index 0000000000..ef9a0305f6
--- /dev/null
+++ b/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
diff --git a/basis/stack-checker/stack-checker.factor b/basis/stack-checker/stack-checker.factor
index ff283ce9ca..e18a6f0840 100644
--- a/basis/stack-checker/stack-checker.factor
+++ b/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
\ No newline at end of file
diff --git a/basis/stack-checker/transforms/transforms.factor b/basis/stack-checker/transforms/transforms.factor
index 6c1d391490..3b783ce467 100755
--- a/basis/stack-checker/transforms/transforms.factor
+++ b/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