stomp: unescape-header and adjust-stomp-version

[factor.git] / basis / compiler / cfg / dataflow-analysis / dataflow-analysis.factor

diff --git a/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor b/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor
index dde44fd15ddcfe8306242491e040274f2fa06c0e..3e7ce5000c882ad2ca71a801e89019811e7741e5 100644 (file)
--- a/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor
+++ b/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor
@@ -1,8 +1,9 @@
 ! Copyright (C) 2009 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors assocs deques dlists kernel locals sequences lexer
-namespaces functors compiler.cfg.rpo compiler.cfg.utilities
-compiler.cfg.predecessors compiler.cfg ;
+! See https://factorcode.org/license.txt for BSD license.
+USING: accessors assocs combinators.short-circuit
+compiler.cfg.predecessors compiler.cfg.rpo
+compiler.cfg.utilities deques dlists functors kernel lexer
+namespaces sequences ;
 IN: compiler.cfg.dataflow-analysis
 
 GENERIC: join-sets ( sets bb dfa -- set )
@@ -10,6 +11,7 @@ GENERIC: transfer-set ( in-set bb dfa -- out-set )
 GENERIC: block-order ( cfg dfa -- bbs )
 GENERIC: successors ( bb dfa -- seq )
 GENERIC: predecessors ( bb dfa -- seq )
+GENERIC: ignore-block? ( bb dfa -- ? )
 
 <PRIVATE
 
@@ -18,53 +20,47 @@ MIXIN: dataflow-analysis
 : <dfa-worklist> ( cfg dfa -- queue )
     block-order <hashed-dlist> [ push-all-front ] keep ;
 
-GENERIC# compute-in-set 2 ( bb out-sets dfa -- set )
-
-M: kill-block compute-in-set 3drop f ;
-
-M:: basic-block compute-in-set ( bb out-sets dfa -- set )
+:: compute-in-set ( bb out-sets dfa -- set )
     ! Only consider initialized sets.
-    bb dfa predecessors
-    [ out-sets key? ] filter
-    [ out-sets at ] map
-    bb dfa join-sets ;
+    bb dfa ignore-block? [ f ] [
+        bb dfa predecessors
+        [ out-sets key? ] filter
+        [ out-sets at ] map
+        bb dfa join-sets
+    ] if ;
 
 :: update-in-set ( bb in-sets out-sets dfa -- ? )
     bb out-sets dfa compute-in-set
     bb in-sets maybe-set-at ; inline
 
-GENERIC# compute-out-set 2 ( bb out-sets dfa -- set )
-
-M: kill-block compute-out-set 3drop f ;
-
-M:: basic-block compute-out-set ( bb in-sets dfa -- set )
-    bb in-sets at bb dfa transfer-set ;
+:: compute-out-set ( bb in-sets dfa -- set )
+    bb dfa ignore-block? [ f ] [ bb in-sets at bb dfa transfer-set ] if ;
 
 :: update-out-set ( bb in-sets out-sets dfa -- ? )
     bb in-sets dfa compute-out-set
     bb out-sets maybe-set-at ; inline
 
-:: dfa-step ( bb in-sets out-sets dfa work-list -- )
-    bb in-sets out-sets dfa update-in-set [
-        bb in-sets out-sets dfa update-out-set [
-            bb dfa successors work-list push-all-front
-        ] when
-    ] when ; inline
+: update-in/out-set ( bb in-sets out-sets dfa -- ? )
+    { [ update-in-set ] [ update-out-set ] } 4 n&& ;
+
+:: dfa-step ( bb in-sets out-sets dfa -- bbs )
+    bb in-sets out-sets dfa update-in/out-set bb dfa successors { } ? ;
 
 :: run-dataflow-analysis ( cfg dfa -- in-sets out-sets )
-    cfg needs-predecessors drop
     H{ } clone :> in-sets
     H{ } clone :> out-sets
-    cfg dfa <dfa-worklist> :> work-list
-    work-list [ in-sets out-sets dfa work-list dfa-step ] slurp-deque
+    cfg needs-predecessors
+    cfg dfa <dfa-worklist>
+    [ in-sets out-sets dfa dfa-step ] slurp/replenish-deque
     in-sets
     out-sets ; inline
 
-M: dataflow-analysis join-sets 2drop assoc-refine ;
+M: dataflow-analysis join-sets 2drop assoc-intersect-all ;
+M: dataflow-analysis ignore-block? drop kill-block?>> ;
 
-FUNCTOR: define-analysis ( name -- )
+<FUNCTOR: define-analysis ( name -- )
 
-name-analysis DEFINES-CLASS ${name}-analysis
+name DEFINES-CLASS ${name}
 name-ins DEFINES ${name}-ins
 name-outs DEFINES ${name}-outs
 name-in DEFINES ${name}-in
@@ -72,7 +68,7 @@ name-out DEFINES ${name}-out
 
 WHERE
 
-SINGLETON: name-analysis
+SINGLETON: name
 
 SYMBOL: name-ins
 
@@ -82,7 +78,7 @@ SYMBOL: name-outs
 
 : name-out ( bb -- set ) name-outs get at ;
 
-;FUNCTOR
+;FUNCTOR>
 
 ! ! ! Forward dataflow analysis
 
@@ -93,22 +89,22 @@ M: forward-analysis block-order  drop reverse-post-order ;
 M: forward-analysis successors   drop successors>> ;
 M: forward-analysis predecessors drop predecessors>> ;
 
-FUNCTOR: define-forward-analysis ( name -- )
+<FUNCTOR: define-forward-analysis ( name -- )
 
-name-analysis IS ${name}-analysis
+name IS ${name}
 name-ins IS ${name}-ins
 name-outs IS ${name}-outs
 compute-name-sets DEFINES compute-${name}-sets
 
 WHERE
 
-INSTANCE: name-analysis forward-analysis
+INSTANCE: name forward-analysis
 
 : compute-name-sets ( cfg -- )
-    name-analysis run-dataflow-analysis
+    name run-dataflow-analysis
     [ name-ins set ] [ name-outs set ] bi* ;
 
-;FUNCTOR
+;FUNCTOR>
 
 ! ! ! Backward dataflow analysis
 
@@ -119,27 +115,27 @@ M: backward-analysis block-order  drop post-order ;
 M: backward-analysis successors   drop predecessors>> ;
 M: backward-analysis predecessors drop successors>> ;
 
-FUNCTOR: define-backward-analysis ( name -- )
+<FUNCTOR: define-backward-analysis ( name -- )
 
-name-analysis IS ${name}-analysis
+name IS ${name}
 name-ins IS ${name}-ins
 name-outs IS ${name}-outs
 compute-name-sets DEFINES compute-${name}-sets
 
 WHERE
 
-INSTANCE: name-analysis backward-analysis
+INSTANCE: name backward-analysis
 
 : compute-name-sets ( cfg -- )
-    \ name-analysis run-dataflow-analysis
+    \ name run-dataflow-analysis
     [ name-outs set ] [ name-ins set ] bi* ;
 
-;FUNCTOR
+;FUNCTOR>
 
 PRIVATE>
 
 SYNTAX: FORWARD-ANALYSIS:
-    scan [ define-analysis ] [ define-forward-analysis ] bi ;
+    scan-token [ define-analysis ] [ define-forward-analysis ] bi ;
 
 SYNTAX: BACKWARD-ANALYSIS:
-    scan [ define-analysis ] [ define-backward-analysis ] bi ;
+    scan-token [ define-analysis ] [ define-backward-analysis ] bi ;