--- /dev/null
+! 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
-! 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 ;
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
[ 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