1 ! Copyright (C) 2004, 2006 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
4 USING: kernel sequences hashtables kernel-internals words
5 namespaces generic vectors namespaces ;
7 ! Name stack and variable binding simulation
10 : push-n meta-n get push ;
11 : pop-n meta-n get pop ;
12 : peek-n meta-n get peek ;
14 TUPLE: inferred-vars reads writes reads-globals writes-globals ;
16 : vars-trivial? ( vars -- ? ) tuple-slots [ empty? ] all? ;
18 : empty-vars ( -- vars )
19 V{ } clone V{ } clone V{ } clone V{ } clone
22 : apply-var-seq ( seq -- )
24 >r [ tuple-slots ] map r> tuple-slots add flip
25 [ concat prune >vector ] map first4 <inferred-vars>
28 : apply-var-read ( symbol -- )
29 dup meta-n get [ hash-member? ] contains-with? [
32 inferred-vars get 2dup inferred-vars-writes member? [
35 inferred-vars-reads push-new
39 : apply-var-write ( symbol -- )
41 inferred-vars get inferred-vars-writes push-new
46 : apply-global-read ( symbol -- )
48 2dup inferred-vars-writes-globals member? [
51 inferred-vars-reads-globals push-new
54 : apply-global-write ( symbol -- )
55 inferred-vars get inferred-vars-writes-globals push-new ;
57 : apply-vars ( vars -- )
59 dup inferred-vars-reads [ apply-var-read ] each
60 dup inferred-vars-writes [ apply-var-write ] each
61 dup inferred-vars-reads-globals [ apply-global-read ] each
62 inferred-vars-writes-globals [ apply-global-write ] each