diff --git a/basis/compiler/tree/def-use/def-use.factor b/basis/compiler/tree/def-use/def-use.factor index 4af54d0319..009346d428 100644 --- a/basis/compiler/tree/def-use/def-use.factor +++ b/basis/compiler/tree/def-use/def-use.factor @@ -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 ] [ [ [ ] 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 diff --git a/basis/compiler/tree/escape-analysis/allocations/allocations.factor b/basis/compiler/tree/escape-analysis/allocations/allocations.factor index 4a42d39938..d52de79872 100644 --- a/basis/compiler/tree/escape-analysis/allocations/allocations.factor +++ b/basis/compiler/tree/escape-analysis/allocations/allocations.factor @@ -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 -- ? )