compiler.tree: fewer namespace lookups.
parent
7da4a74588
commit
460d19f56c
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays namespaces sequences kernel generic assocs
|
||||
USING: arrays fry namespaces sequences kernel generic assocs
|
||||
classes vectors accessors combinators sets
|
||||
stack-checker.state
|
||||
stack-checker.branches
|
||||
|
@ -22,22 +22,34 @@ TUPLE: definition value node uses ;
|
|||
|
||||
ERROR: no-def-error value ;
|
||||
|
||||
: (def-of) ( value def-use -- definition )
|
||||
?at [ no-def-error ] unless ; inline
|
||||
|
||||
: def-of ( value -- definition )
|
||||
def-use get ?at [ no-def-error ] unless ;
|
||||
def-use get (def-of) ;
|
||||
|
||||
ERROR: multiple-defs-error ;
|
||||
|
||||
: def-value ( node value -- )
|
||||
def-use get 2dup key? [
|
||||
: (def-value) ( node value def-use -- )
|
||||
2dup key? [
|
||||
multiple-defs-error
|
||||
] [
|
||||
[ [ <definition> ] keep ] dip set-at
|
||||
] if ;
|
||||
] if ; inline
|
||||
|
||||
: def-value ( node value -- )
|
||||
def-use get (def-value) ;
|
||||
|
||||
: def-values ( node values -- )
|
||||
def-use get '[ _ (def-value) ] with each ;
|
||||
|
||||
: used-by ( value -- nodes ) def-of uses>> ;
|
||||
|
||||
: use-value ( node value -- ) used-by push ;
|
||||
|
||||
: use-values ( node values -- )
|
||||
def-use get '[ _ (def-of) uses>> push ] with each ;
|
||||
|
||||
: defined-by ( value -- node ) def-of node>> ;
|
||||
|
||||
GENERIC: node-uses-values ( node -- values )
|
||||
|
@ -63,8 +75,8 @@ M: #alien-callback node-defs-values drop f ;
|
|||
M: node node-defs-values out-d>> ;
|
||||
|
||||
: node-def-use ( node -- )
|
||||
[ dup node-uses-values [ use-value ] with each ]
|
||||
[ dup node-defs-values [ def-value ] with each ] bi ;
|
||||
[ dup node-uses-values use-values ]
|
||||
[ dup node-defs-values def-values ] bi ;
|
||||
|
||||
: compute-def-use ( node -- node )
|
||||
H{ } clone def-use set
|
||||
|
|
|
@ -96,8 +96,11 @@ SYMBOL: +escaping+
|
|||
: unknown-allocations ( values -- )
|
||||
[ unknown-allocation ] each ;
|
||||
|
||||
: (escaping-value?) ( value escaping-values -- ? )
|
||||
+escaping+ swap equiv? ; inline
|
||||
|
||||
: escaping-value? ( value -- ? )
|
||||
+escaping+ escaping-values get equiv? ;
|
||||
escaping-values get (escaping-value?) ;
|
||||
|
||||
DEFER: copy-value
|
||||
|
||||
|
@ -127,8 +130,8 @@ DEFER: copy-value
|
|||
SYMBOL: escaping-allocations
|
||||
|
||||
: compute-escaping-allocations ( -- )
|
||||
allocations get
|
||||
[ drop escaping-value? ] assoc-filter
|
||||
allocations get escaping-values get
|
||||
'[ drop _ (escaping-value?) ] assoc-filter
|
||||
escaping-allocations set ;
|
||||
|
||||
: escaping-allocation? ( value -- ? )
|
||||
|
|
Loading…
Reference in New Issue