compiler.tree: fewer namespace lookups.

db4
John Benediktsson 2013-03-21 19:36:07 -07:00
parent 7da4a74588
commit 460d19f56c
2 changed files with 25 additions and 10 deletions

View File

@ -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

View File

@ -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 -- ? )