64 lines
1.7 KiB
Factor
64 lines
1.7 KiB
Factor
! Copyright (C) 2004, 2006 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
IN: inference
|
|
USING: kernel sequences hashtables kernel-internals words
|
|
namespaces generic vectors namespaces ;
|
|
|
|
! Name stack and variable binding simulation
|
|
SYMBOL: meta-n
|
|
|
|
: push-n meta-n get push ;
|
|
: pop-n meta-n get pop ;
|
|
: peek-n meta-n get peek ;
|
|
|
|
TUPLE: inferred-vars reads writes reads-globals writes-globals ;
|
|
|
|
: vars-trivial? ( vars -- ? ) tuple-slots [ empty? ] all? ;
|
|
|
|
: empty-vars ( -- vars )
|
|
V{ } clone V{ } clone V{ } clone V{ } clone
|
|
<inferred-vars> ;
|
|
|
|
: apply-var-seq ( seq -- )
|
|
inferred-vars [
|
|
>r [ tuple-slots ] map r> tuple-slots add flip
|
|
[ concat prune >vector ] map first4 <inferred-vars>
|
|
] change ;
|
|
|
|
: apply-var-read ( symbol -- )
|
|
dup meta-n get [ hash-member? ] contains-with? [
|
|
drop
|
|
] [
|
|
inferred-vars get 2dup inferred-vars-writes member? [
|
|
2drop
|
|
] [
|
|
inferred-vars-reads push-new
|
|
] if
|
|
] if ;
|
|
|
|
: apply-var-write ( symbol -- )
|
|
meta-n get empty? [
|
|
inferred-vars get inferred-vars-writes push-new
|
|
] [
|
|
dup peek-n set-hash
|
|
] if ;
|
|
|
|
: apply-global-read ( symbol -- )
|
|
inferred-vars get
|
|
2dup inferred-vars-writes-globals member? [
|
|
2drop
|
|
] [
|
|
inferred-vars-reads-globals push-new
|
|
] if ;
|
|
|
|
: apply-global-write ( symbol -- )
|
|
inferred-vars get inferred-vars-writes-globals push-new ;
|
|
|
|
: apply-vars ( vars -- )
|
|
[
|
|
dup inferred-vars-reads [ apply-var-read ] each
|
|
dup inferred-vars-writes [ apply-var-write ] each
|
|
dup inferred-vars-reads-globals [ apply-global-read ] each
|
|
inferred-vars-writes-globals [ apply-global-write ] each
|
|
] when* ;
|