PageRenderTime 28ms CodeModel.GetById 22ms app.highlight 5ms RepoModel.GetById 0ms app.codeStats 1ms

/extra/specialized/specialized.factor

http://github.com/abeaumont/factor
Unknown | 55 lines | 43 code | 12 blank | 0 comment | 0 complexity | 935fa2236c99d54dd622857c9eca4c2c MD5 | raw file
 1! Copyright (C) 2009, 2010 Daniel Ehrenberg
 2! See http://factorcode.org/license.txt for BSD license.
 3USING: words kernel locals accessors compiler.tree.propagation.info
 4sequences kernel.private assocs fry parser math quotations
 5effects arrays definitions compiler.units namespaces
 6compiler.tree.debugger generalizations stack-checker ;
 7IN: specialized
 8
 9: in-compilation-unit? ( -- ? )
10    changed-definitions get >boolean ;
11
12: define-temp-in-unit ( quot effect -- word )
13    in-compilation-unit?
14    [ [ define-temp ] with-nested-compilation-unit ]
15    [ [ define-temp ] with-compilation-unit ]
16    if ;
17
18: final-info-quot ( word -- quot )
19    [ stack-effect in>> length '[ _ ndrop ] ]
20    [ def>> [ final-info ] with-scope >quotation ] bi
21    compose ;
22
23ERROR: bad-outputs word quot ;
24
25: define-outputs ( word quot -- )
26    2dup [ stack-effect ] [ infer ] bi* effect<=
27    [ "outputs" set-word-prop ] [ bad-outputs ] if ;
28
29: record-final-info ( word -- )
30    dup final-info-quot define-outputs ;
31
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
38            dup record-final-info
39            1quotation
40        ] cache
41    ] if ;
42
43: specialized-quot ( word n -- quot )
44    '[ _ _ lookup-specialized ] ;
45
46: make-specialized ( word n -- )
47    [ drop H{ } clone "specialized-defs" set-word-prop ]
48    [ dupd specialized-quot "custom-inlining" set-word-prop ] 2bi ;
49
50SYNTAX: specialized
51    word dup stack-effect in>> length make-specialized ;
52
53PREDICATE: specialized-word < word
54   "specialized-defs" word-prop >boolean ;
55