1 ! Copyright (C) 2009, 2010 Daniel Ehrenberg
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: words kernel locals accessors compiler.tree.propagation.info
4 sequences kernel.private assocs fry parser math quotations
5 effects arrays definitions compiler.units namespaces
6 compiler.tree.debugger generalizations stack-checker ;
9 : in-compilation-unit? ( -- ? )
10 changed-definitions get >boolean ;
12 : define-temp-in-unit ( quot effect -- word )
14 [ [ define-temp ] with-nested-compilation-unit ]
15 [ [ define-temp ] with-compilation-unit ]
18 : final-info-quot ( word -- quot )
19 [ stack-effect in>> length '[ _ ndrop ] ]
20 [ def>> [ final-info ] with-scope >quotation ] bi
23 ERROR: bad-outputs word quot ;
25 : define-outputs ( word quot -- )
26 2dup [ stack-effect ] [ infer ] bi* effect<=
27 [ "outputs" set-word-prop ] [ bad-outputs ] if ;
29 : record-final-info ( word -- )
30 dup final-info-quot define-outputs ;
32 :: lookup-specialized ( #call word n -- special-word/f )
33 #call in-d>> n tail* >array [ value-info class>> ] map
34 dup [ object = ] all? [ drop f ] [
35 word "specialized-defs" word-prop [
36 [ declare ] curry word def>> compose
37 word stack-effect define-temp-in-unit
43 : specialized-quot ( word n -- quot )
44 '[ _ _ lookup-specialized ] ;
46 : make-specialized ( word n -- )
47 [ drop H{ } clone "specialized-defs" set-word-prop ]
48 [ dupd specialized-quot "custom-inlining" set-word-prop ] 2bi ;
51 last-word dup stack-effect in>> length make-specialized ;
53 PREDICATE: specialized-word < word
54 "specialized-defs" word-prop >boolean ;