--- /dev/null
+USING: combinators.private compiler.units effects help.markup help.syntax
+quotations ;
+IN: compiler.tree.propagation.call-effect
+
+HELP: cached-effect-valid?
+{ $values { "quot" quotation } { "?" "a boolean" } }
+{ $description { $link t } " if the cached effect is valid." } ;
+
+HELP: call-effect-ic
+{ $values { "quot" quotation } { "effect" effect } { "inline-cache" inline-cache } }
+{ $description "Checks if there is a hit in the call effect inline cache and if so calls the quotation using " { $link call-effect-unsafe } ". If there isn't a hit, the quotation is called in a slow way and the cache is updated." } ;
+
+HELP: call-effect>quot
+{ $values { "effect" effect } { "quot" quotation } }
+{ $description "Emits a quotation for calling a quotation with the given stack effect." } ;
+
+HELP: call-effect-slow>quot
+{ $values { "effect" effect } { "quot" quotation } }
+{ $description "Creates a quotation which wraps " { $link call-effect-unsafe } "." } ;
+
+HELP: call-effect-unsafe?
+{ $values { "cached-effect" "an effect or +unknown+" } { "effect" effect } { "?" "a boolean" } }
+{ $description "Checks if the given effect is safe with regards to the cached one." } ;
+
+HELP: update-inline-cache
+{ $values { "word/quot" } { "ic" inline-cache } }
+{ $description "Sets the inline caches " { $slot "value" } " to the given word/quot and updates its " { $slot "counter" } " to the value of the " { $link effect-counter } "." } ;
+
+
+ARTICLE: "compiler.tree.propagation.call-effect" "Expansions of call( and execute( words"
+"call( and execute( have complex expansions."
+$nl
+"If the input quotation is a literal, or built up from curry and compose with terminal quotations literal, it is inlined at the call site."
+$nl
+"For dynamic call sites, call( uses the following strategy:"
+{ $list
+ "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."
+ "Inline caches and cached effects are invalidated whenever a macro is redefined, or a word's effect changes, by comparing a global counter against the counter value last observed. The counter is incremented by compiler.units."
+}
+$nl
+"execute( uses a similar strategy." ;
+
+ABOUT: "compiler.tree.propagation.call-effect"
! Copyright (C) 2009 Slava Pestov, Daniel Ehrenberg.
! See http://factorcode.org/license.txt for BSD license.
-USING: compiler.tree.propagation.call-effect tools.test fry math effects kernel
-compiler.tree.builder compiler.tree.optimizer compiler.tree.debugger sequences
-eval combinators ;
+USING: combinators compiler.tree.propagation.call-effect compiler.units
+math effects kernel compiler.tree.builder compiler.tree.optimizer
+compiler.tree.debugger sequences eval fry tools.test ;
IN: compiler.tree.propagation.call-effect.tests
+! update-inline-cache
+{ t } [
+ [ boa ] inline-cache new [ update-inline-cache ] keep
+ [ boa ] effect-counter inline-cache boa =
+] unit-test
+
+! call-effect-slow>quot
+{ 10000 } [
+ 100 [ sq ] ( a -- b ) call-effect-slow>quot call
+] unit-test
+
[ t ] [ \ + ( a b -- c ) execute-effect-unsafe? ] unit-test
[ t ] [ \ + ( a b c -- d e ) execute-effect-unsafe? ] unit-test
[ f ] [ \ + ( a b c -- d ) execute-effect-unsafe? ] unit-test
stack-checker.transforms words ;
IN: compiler.tree.propagation.call-effect
-! call( and execute( have complex expansions.
-
-! If the input quotation is a literal, or built up from curry and
-! compose with terminal quotations literal, it is inlined at the
-! call site.
-
-! For dynamic call sites, 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.
-! - Inline caches and cached effects are invalidated whenever a macro is redefined, or
-! a word's effect changes, by comparing a global counter against the counter value
-! last observed. The counter is incremented by compiler.units.
-
-! execute( uses a similar strategy.
-
TUPLE: inline-cache value counter ;
: inline-cache-hit? ( word/quot ic -- ? )
{ [ value>> eq? ] [ nip counter>> effect-counter eq? ] } 2&& ; inline
: update-inline-cache ( word/quot ic -- )
- [ effect-counter ] dip
- [ value<< ] [ counter<< ] bi-curry bi* ; inline
+ swap >>value effect-counter >>counter drop ; inline
SINGLETON: +unknown+
cache-counter>> effect-counter eq? ; inline
: save-effect ( effect quot -- )
- [ effect-counter ] dip
- [ cached-effect<< ] [ cache-counter<< ] bi-curry bi* ;
+ swap >>cached-effect effect-counter >>cache-counter drop ;
M: quotation cached-effect
dup cached-effect-valid?
[ cached-effect>> ] [ [ safe-infer dup ] keep save-effect ] if ;
-: call-effect-unsafe? ( quot effect -- ? )
- [ cached-effect ] dip
- over +unknown+ eq?
- [ 2drop f ] [ [ { effect } declare ] dip effect<= ] if ; inline
+: call-effect-unsafe? ( cached-effect effect -- ? )
+ over +unknown+ eq? [ 2drop f ] [ effect<= ] if ;
: call-effect-slow>quot ( effect -- quot )
[ \ call-effect def>> curry ] [ add-effect-input ] bi
\ call-effect-slow t "no-compile" set-word-prop
: call-effect-fast ( quot effect inline-cache -- )
- 2over call-effect-unsafe?
+ 2over [ cached-effect ] dip call-effect-unsafe?
[ [ nip update-inline-cache ] [ drop call-effect-unsafe ] 3bi ]
[ drop call-effect-slow ]
if ; inline