From e2bd55950d7eba2cf1ed1770c2c74d3a5f9d69e2 Mon Sep 17 00:00:00 2001 From: Rob Rix <rob.rix@me.com> Date: Mon, 17 Sep 2018 15:38:21 -0400 Subject: [PATCH 01/14] Widen the heap. --- src/Semantic/Graph.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 6e0e42614..ab3bbcd3f 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -111,8 +111,8 @@ runCallGraph lang includePackages modules package = do runGraphAnalysis = runTermEvaluator @_ @(Hole (Maybe Name) (Located Monovariant)) @Abstract . graphing @_ @_ @(Maybe Name) @Monovariant - . caching . runState (lowerBound @(Heap (Hole (Maybe Name) (Located Monovariant)) Abstract)) + . caching . runFresh 0 . resumingLoadError . resumingUnspecialized From 5043e62a7126ddb383c0f05afe729be54023fb22 Mon Sep 17 00:00:00 2001 From: Rob Rix <rob.rix@me.com> Date: Tue, 18 Sep 2018 09:59:37 -0400 Subject: [PATCH 02/14] Give the tracing analysis its own definition of Configuration. --- src/Analysis/Abstract/Tracing.hs | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) diff --git a/src/Analysis/Abstract/Tracing.hs b/src/Analysis/Abstract/Tracing.hs index 13073a138..988d2b054 100644 --- a/src/Analysis/Abstract/Tracing.hs +++ b/src/Analysis/Abstract/Tracing.hs @@ -4,9 +4,9 @@ module Analysis.Abstract.Tracing , tracing ) where -import Control.Abstract.Configuration -import Control.Abstract hiding (trace) +import Control.Abstract hiding (trace, Configuration) import Control.Monad.Effect.Writer +import Data.Abstract.Environment import Data.Semigroup.Reducer as Reducer import Prologue @@ -30,3 +30,19 @@ trace = tell tracing :: (Monoid (trace (Configuration term address value)), Effects effects) => TermEvaluator term address value (Writer (trace (Configuration term address value)) ': effects) a -> TermEvaluator term address value effects (trace (Configuration term address value), a) tracing = runWriter + + +-- | Get the current 'Configuration' with a passed-in term. +getConfiguration :: (Member (Reader (Live address)) effects, Member (Env address) effects, Member (State (Heap address value)) effects) + => term + -> TermEvaluator term address value effects (Configuration term address value) +getConfiguration term = Configuration term <$> TermEvaluator askRoots <*> TermEvaluator getEvalContext <*> TermEvaluator getHeap + +-- | A single point in a program’s execution. +data Configuration term address value = Configuration + { configurationTerm :: term -- ^ The “instruction,” i.e. the current term to evaluate. + , configurationRoots :: Live address -- ^ The set of rooted addresses. + , configurationContext :: EvalContext address -- ^ The evaluation context in 'configurationTerm'. + , configurationHeap :: Heap address value -- ^ The heap of values. + } + deriving (Eq, Ord, Show) From c612b0d490ecb74cfb4fe09c4d19bf506c41e6c8 Mon Sep 17 00:00:00 2001 From: Rob Rix <rob.rix@me.com> Date: Tue, 18 Sep 2018 10:02:32 -0400 Subject: [PATCH 03/14] =?UTF-8?q?Tracing=20doesn=E2=80=99t=20require=20the?= =?UTF-8?q?=20live=20set.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Analysis/Abstract/Tracing.hs | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/Analysis/Abstract/Tracing.hs b/src/Analysis/Abstract/Tracing.hs index 988d2b054..d195d56aa 100644 --- a/src/Analysis/Abstract/Tracing.hs +++ b/src/Analysis/Abstract/Tracing.hs @@ -14,7 +14,6 @@ import Prologue -- -- Instantiating @trace@ to @[]@ yields a linear trace analysis, while @Set@ yields a reachable state analysis. tracingTerms :: ( Corecursive term - , Member (Reader (Live address)) effects , Member (Env address) effects , Member (State (Heap address value)) effects , Member (Writer (trace (Configuration term address value))) effects @@ -33,15 +32,14 @@ tracing = runWriter -- | Get the current 'Configuration' with a passed-in term. -getConfiguration :: (Member (Reader (Live address)) effects, Member (Env address) effects, Member (State (Heap address value)) effects) +getConfiguration :: (Member (Env address) effects, Member (State (Heap address value)) effects) => term -> TermEvaluator term address value effects (Configuration term address value) -getConfiguration term = Configuration term <$> TermEvaluator askRoots <*> TermEvaluator getEvalContext <*> TermEvaluator getHeap +getConfiguration term = Configuration term <$> TermEvaluator getEvalContext <*> TermEvaluator getHeap -- | A single point in a program’s execution. data Configuration term address value = Configuration { configurationTerm :: term -- ^ The “instruction,” i.e. the current term to evaluate. - , configurationRoots :: Live address -- ^ The set of rooted addresses. , configurationContext :: EvalContext address -- ^ The evaluation context in 'configurationTerm'. , configurationHeap :: Heap address value -- ^ The heap of values. } From d15790bce7deeef33f28081f4545420e076175d5 Mon Sep 17 00:00:00 2001 From: Rob Rix <rob.rix@me.com> Date: Tue, 18 Sep 2018 10:04:53 -0400 Subject: [PATCH 04/14] :fire: some trailing whitespace. --- src/Control/Abstract/Configuration.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Control/Abstract/Configuration.hs b/src/Control/Abstract/Configuration.hs index fe92bf8e6..77dd6121e 100644 --- a/src/Control/Abstract/Configuration.hs +++ b/src/Control/Abstract/Configuration.hs @@ -12,4 +12,3 @@ getConfiguration :: (Member (Reader (Live address)) effects, Member (Env address => term -> TermEvaluator term address value effects (Configuration term address value) getConfiguration term = Configuration term <$> TermEvaluator askRoots <*> TermEvaluator getEvalContext <*> TermEvaluator getHeap - From 32d683fb20dfa8f51367f492bc67c32a48c65e58 Mon Sep 17 00:00:00 2001 From: Rob Rix <rob.rix@me.com> Date: Tue, 18 Sep 2018 10:05:03 -0400 Subject: [PATCH 05/14] =?UTF-8?q?Don=E2=80=99t=20re-export=20Configuration?= =?UTF-8?q?.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Analysis/Abstract/Caching.hs | 1 + src/Analysis/Abstract/Tracing.hs | 2 +- src/Control/Abstract/Configuration.hs | 1 + src/Control/Abstract/Heap.hs | 2 -- 4 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Analysis/Abstract/Caching.hs b/src/Analysis/Abstract/Caching.hs index d09a5fe3d..a5cc19681 100644 --- a/src/Analysis/Abstract/Caching.hs +++ b/src/Analysis/Abstract/Caching.hs @@ -8,6 +8,7 @@ module Analysis.Abstract.Caching import Control.Abstract.Configuration import Control.Abstract import Data.Abstract.Cache +import Data.Abstract.Configuration import Data.Abstract.BaseError import Data.Abstract.Environment import Data.Abstract.Module diff --git a/src/Analysis/Abstract/Tracing.hs b/src/Analysis/Abstract/Tracing.hs index d195d56aa..b1b6cfdef 100644 --- a/src/Analysis/Abstract/Tracing.hs +++ b/src/Analysis/Abstract/Tracing.hs @@ -4,7 +4,7 @@ module Analysis.Abstract.Tracing , tracing ) where -import Control.Abstract hiding (trace, Configuration) +import Control.Abstract hiding (trace) import Control.Monad.Effect.Writer import Data.Abstract.Environment import Data.Semigroup.Reducer as Reducer diff --git a/src/Control/Abstract/Configuration.hs b/src/Control/Abstract/Configuration.hs index 77dd6121e..297ce1a16 100644 --- a/src/Control/Abstract/Configuration.hs +++ b/src/Control/Abstract/Configuration.hs @@ -6,6 +6,7 @@ import Control.Abstract.Environment import Control.Abstract.Heap import Control.Abstract.Roots import Control.Abstract.TermEvaluator +import Data.Abstract.Configuration -- | Get the current 'Configuration' with a passed-in term. getConfiguration :: (Member (Reader (Live address)) effects, Member (Env address) effects, Member (State (Heap address value)) effects) diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index c0c46e2d9..1e7f742a1 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -1,7 +1,6 @@ {-# LANGUAGE GADTs, KindSignatures, RankNTypes, TypeOperators, UndecidableInstances #-} module Control.Abstract.Heap ( Heap -, Configuration(..) , Live , getHeap , putHeap @@ -22,7 +21,6 @@ module Control.Abstract.Heap import Control.Abstract.Evaluator import Control.Abstract.Roots -import Data.Abstract.Configuration import Data.Abstract.BaseError import Data.Abstract.Heap import Data.Abstract.Live From 3a760445e3cf3b17250c1cc8d2690014dc2f0d4c Mon Sep 17 00:00:00 2001 From: Rob Rix <rob.rix@me.com> Date: Tue, 18 Sep 2018 10:08:48 -0400 Subject: [PATCH 06/14] Give Caching its own definition of getConfiguration. --- src/Analysis/Abstract/Caching.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Analysis/Abstract/Caching.hs b/src/Analysis/Abstract/Caching.hs index a5cc19681..fc068ae3e 100644 --- a/src/Analysis/Abstract/Caching.hs +++ b/src/Analysis/Abstract/Caching.hs @@ -5,7 +5,6 @@ module Analysis.Abstract.Caching , caching ) where -import Control.Abstract.Configuration import Control.Abstract import Data.Abstract.Cache import Data.Abstract.Configuration @@ -130,6 +129,12 @@ converge seed f = loop seed scatter :: (Foldable t, Member NonDet effects, Member (State (Heap address value)) effects) => t (Cached address value) -> TermEvaluator term address value effects (ValueRef address) scatter = foldMapA (\ (Cached value heap') -> TermEvaluator (putHeap heap') $> value) +-- | Get the current 'Configuration' with a passed-in term. +getConfiguration :: (Member (Reader (Live address)) effects, Member (Env address) effects, Member (State (Heap address value)) effects) + => term + -> TermEvaluator term address value effects (Configuration term address value) +getConfiguration term = Configuration term <$> TermEvaluator askRoots <*> TermEvaluator getEvalContext <*> TermEvaluator getHeap + caching :: Effects effects => TermEvaluator term address value (NonDet ': Reader (Cache term address value) ': State (Cache term address value) ': effects) a -> TermEvaluator term address value effects (Cache term address value, [a]) caching From 51be2081ae3b10b80399e6300d79631664a60c77 Mon Sep 17 00:00:00 2001 From: Rob Rix <rob.rix@me.com> Date: Tue, 18 Sep 2018 10:10:03 -0400 Subject: [PATCH 07/14] :fire: Control.Abstract.Configuration. --- semantic.cabal | 1 - src/Control/Abstract/Configuration.hs | 15 --------------- 2 files changed, 16 deletions(-) delete mode 100644 src/Control/Abstract/Configuration.hs diff --git a/semantic.cabal b/semantic.cabal index ec2cd8b1e..6567ed4c2 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -35,7 +35,6 @@ library , Assigning.Assignment.Table -- Control structures & interfaces for abstract interpretation , Control.Abstract - , Control.Abstract.Configuration , Control.Abstract.Context , Control.Abstract.Environment , Control.Abstract.Evaluator diff --git a/src/Control/Abstract/Configuration.hs b/src/Control/Abstract/Configuration.hs deleted file mode 100644 index 297ce1a16..000000000 --- a/src/Control/Abstract/Configuration.hs +++ /dev/null @@ -1,15 +0,0 @@ -module Control.Abstract.Configuration -( getConfiguration -) where - -import Control.Abstract.Environment -import Control.Abstract.Heap -import Control.Abstract.Roots -import Control.Abstract.TermEvaluator -import Data.Abstract.Configuration - --- | Get the current 'Configuration' with a passed-in term. -getConfiguration :: (Member (Reader (Live address)) effects, Member (Env address) effects, Member (State (Heap address value)) effects) - => term - -> TermEvaluator term address value effects (Configuration term address value) -getConfiguration term = Configuration term <$> TermEvaluator askRoots <*> TermEvaluator getEvalContext <*> TermEvaluator getHeap From 86654a2dab6aab34146e7030b7e7a99f225759bd Mon Sep 17 00:00:00 2001 From: Rob Rix <rob.rix@me.com> Date: Tue, 18 Sep 2018 10:12:02 -0400 Subject: [PATCH 08/14] Move Configuration into Data.Abstract.Cache. --- semantic.cabal | 1 - src/Analysis/Abstract/Caching.hs | 1 - src/Data/Abstract/Cache.hs | 13 ++++++++++++- src/Data/Abstract/Configuration.hs | 14 -------------- 4 files changed, 12 insertions(+), 17 deletions(-) delete mode 100644 src/Data/Abstract/Configuration.hs diff --git a/semantic.cabal b/semantic.cabal index 6567ed4c2..0960b9398 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -54,7 +54,6 @@ library , Data.Abstract.Address.Precise , Data.Abstract.BaseError , Data.Abstract.Cache - , Data.Abstract.Configuration , Data.Abstract.Declarations , Data.Abstract.Environment , Data.Abstract.Evaluatable diff --git a/src/Analysis/Abstract/Caching.hs b/src/Analysis/Abstract/Caching.hs index fc068ae3e..0fee12dff 100644 --- a/src/Analysis/Abstract/Caching.hs +++ b/src/Analysis/Abstract/Caching.hs @@ -7,7 +7,6 @@ module Analysis.Abstract.Caching import Control.Abstract import Data.Abstract.Cache -import Data.Abstract.Configuration import Data.Abstract.BaseError import Data.Abstract.Environment import Data.Abstract.Module diff --git a/src/Data/Abstract/Cache.hs b/src/Data/Abstract/Cache.hs index 1db43d5a6..615acc805 100644 --- a/src/Data/Abstract/Cache.hs +++ b/src/Data/Abstract/Cache.hs @@ -1,6 +1,7 @@ {-# LANGUAGE ConstraintKinds, GeneralizedNewtypeDeriving, TypeFamilies #-} module Data.Abstract.Cache ( Cache + , Configuration (..) , Cached (..) , Cacheable , cacheLookup @@ -9,8 +10,9 @@ module Data.Abstract.Cache , cacheKeys ) where -import Data.Abstract.Configuration +import Data.Abstract.Environment import Data.Abstract.Heap +import Data.Abstract.Live import Data.Abstract.Ref import Data.Map.Monoidal as Monoidal import Prologue @@ -19,6 +21,15 @@ import Prologue newtype Cache term address value = Cache { unCache :: Monoidal.Map (Configuration term address value) (Set (Cached address value)) } deriving (Eq, Lower, Monoid, Ord, Reducer (Configuration term address value, Cached address value), Semigroup) +-- | A single point in a program’s execution. +data Configuration term address value = Configuration + { configurationTerm :: term -- ^ The “instruction,” i.e. the current term to evaluate. + , configurationRoots :: Live address -- ^ The set of rooted addresses. + , configurationContext :: EvalContext address -- ^ The evaluation context in 'configurationTerm'. + , configurationHeap :: Heap address value -- ^ The heap of values. + } + deriving (Eq, Ord, Show) + data Cached address value = Cached { cachedValue :: ValueRef address , cachedHeap :: Heap address value diff --git a/src/Data/Abstract/Configuration.hs b/src/Data/Abstract/Configuration.hs deleted file mode 100644 index 6f6a23e48..000000000 --- a/src/Data/Abstract/Configuration.hs +++ /dev/null @@ -1,14 +0,0 @@ -module Data.Abstract.Configuration ( Configuration (..) ) where - -import Data.Abstract.Environment -import Data.Abstract.Heap -import Data.Abstract.Live - --- | A single point in a program’s execution. -data Configuration term address value = Configuration - { configurationTerm :: term -- ^ The “instruction,” i.e. the current term to evaluate. - , configurationRoots :: Live address -- ^ The set of rooted addresses. - , configurationContext :: EvalContext address -- ^ The evaluation context in 'configurationTerm'. - , configurationHeap :: Heap address value -- ^ The heap of values. - } - deriving (Eq, Ord, Show) From 560c93784c2ce08ac4256da72bb6d22b7322649a Mon Sep 17 00:00:00 2001 From: Rob Rix <rob.rix@me.com> Date: Tue, 18 Sep 2018 10:21:25 -0400 Subject: [PATCH 09/14] Move the cache into the Caching module. --- semantic.cabal | 1 - src/Analysis/Abstract/Caching.hs | 42 +++++++++++++++++++++-- src/Data/Abstract/Cache.hs | 59 -------------------------------- 3 files changed, 40 insertions(+), 62 deletions(-) delete mode 100644 src/Data/Abstract/Cache.hs diff --git a/semantic.cabal b/semantic.cabal index 0960b9398..c0c705c4a 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -53,7 +53,6 @@ library , Data.Abstract.Address.Monovariant , Data.Abstract.Address.Precise , Data.Abstract.BaseError - , Data.Abstract.Cache , Data.Abstract.Declarations , Data.Abstract.Environment , Data.Abstract.Evaluatable diff --git a/src/Analysis/Abstract/Caching.hs b/src/Analysis/Abstract/Caching.hs index 0fee12dff..277c8c6bd 100644 --- a/src/Analysis/Abstract/Caching.hs +++ b/src/Analysis/Abstract/Caching.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, TypeOperators #-} +{-# LANGUAGE ConstraintKinds, GADTs, GeneralizedNewtypeDeriving, TypeOperators #-} module Analysis.Abstract.Caching ( cachingTerms , convergingModules @@ -6,11 +6,11 @@ module Analysis.Abstract.Caching ) where import Control.Abstract -import Data.Abstract.Cache import Data.Abstract.BaseError import Data.Abstract.Environment import Data.Abstract.Module import Data.Abstract.Ref +import Data.Map.Monoidal as Monoidal import Prologue -- | Look up the set of values for a given configuration in the in-cache. @@ -140,3 +140,41 @@ caching = runState lowerBound . runReader lowerBound . runNonDet + + +-- | A map of 'Configuration's to 'Set's of resulting values & 'Heap's. +newtype Cache term address value = Cache { unCache :: Monoidal.Map (Configuration term address value) (Set (Cached address value)) } + deriving (Eq, Lower, Monoid, Ord, Reducer (Configuration term address value, Cached address value), Semigroup) + +-- | A single point in a program’s execution. +data Configuration term address value = Configuration + { configurationTerm :: term -- ^ The “instruction,” i.e. the current term to evaluate. + , configurationRoots :: Live address -- ^ The set of rooted addresses. + , configurationContext :: EvalContext address -- ^ The evaluation context in 'configurationTerm'. + , configurationHeap :: Heap address value -- ^ The heap of values. + } + deriving (Eq, Ord, Show) + +data Cached address value = Cached + { cachedValue :: ValueRef address + , cachedHeap :: Heap address value + } + deriving (Eq, Ord, Show) + + +type Cacheable term address value = (Ord address, Ord term, Ord value) + +-- | Look up the resulting value & 'Heap' for a given 'Configuration'. +cacheLookup :: Cacheable term address value => Configuration term address value -> Cache term address value -> Maybe (Set (Cached address value)) +cacheLookup key = Monoidal.lookup key . unCache + +-- | Set the resulting value & 'Heap' for a given 'Configuration', overwriting any previous entry. +cacheSet :: Cacheable term address value => Configuration term address value -> Set (Cached address value) -> Cache term address value -> Cache term address value +cacheSet key value = Cache . Monoidal.insert key value . unCache + +-- | Insert the resulting value & 'Heap' for a given 'Configuration', appending onto any previous entry. +cacheInsert :: Cacheable term address value => Configuration term address value -> Cached address value -> Cache term address value -> Cache term address value +cacheInsert = curry cons + +instance (Show term, Show address, Show value) => Show (Cache term address value) where + showsPrec d = showsUnaryWith showsPrec "Cache" d . map (second toList) . Monoidal.pairs . unCache diff --git a/src/Data/Abstract/Cache.hs b/src/Data/Abstract/Cache.hs deleted file mode 100644 index 615acc805..000000000 --- a/src/Data/Abstract/Cache.hs +++ /dev/null @@ -1,59 +0,0 @@ -{-# LANGUAGE ConstraintKinds, GeneralizedNewtypeDeriving, TypeFamilies #-} -module Data.Abstract.Cache - ( Cache - , Configuration (..) - , Cached (..) - , Cacheable - , cacheLookup - , cacheSet - , cacheInsert - , cacheKeys - ) where - -import Data.Abstract.Environment -import Data.Abstract.Heap -import Data.Abstract.Live -import Data.Abstract.Ref -import Data.Map.Monoidal as Monoidal -import Prologue - --- | A map of 'Configuration's to 'Set's of resulting values & 'Heap's. -newtype Cache term address value = Cache { unCache :: Monoidal.Map (Configuration term address value) (Set (Cached address value)) } - deriving (Eq, Lower, Monoid, Ord, Reducer (Configuration term address value, Cached address value), Semigroup) - --- | A single point in a program’s execution. -data Configuration term address value = Configuration - { configurationTerm :: term -- ^ The “instruction,” i.e. the current term to evaluate. - , configurationRoots :: Live address -- ^ The set of rooted addresses. - , configurationContext :: EvalContext address -- ^ The evaluation context in 'configurationTerm'. - , configurationHeap :: Heap address value -- ^ The heap of values. - } - deriving (Eq, Ord, Show) - -data Cached address value = Cached - { cachedValue :: ValueRef address - , cachedHeap :: Heap address value - } - deriving (Eq, Ord, Show) - - -type Cacheable term address value = (Ord address, Ord term, Ord value) - --- | Look up the resulting value & 'Heap' for a given 'Configuration'. -cacheLookup :: Cacheable term address value => Configuration term address value -> Cache term address value -> Maybe (Set (Cached address value)) -cacheLookup key = Monoidal.lookup key . unCache - --- | Set the resulting value & 'Heap' for a given 'Configuration', overwriting any previous entry. -cacheSet :: Cacheable term address value => Configuration term address value -> Set (Cached address value) -> Cache term address value -> Cache term address value -cacheSet key value = Cache . Monoidal.insert key value . unCache - --- | Insert the resulting value & 'Heap' for a given 'Configuration', appending onto any previous entry. -cacheInsert :: Cacheable term address value => Configuration term address value -> Cached address value -> Cache term address value -> Cache term address value -cacheInsert = curry cons - --- | Return all 'Configuration's in the provided cache. -cacheKeys :: Cache term address value -> [Configuration term address value] -cacheKeys = Monoidal.keys . unCache - -instance (Show term, Show address, Show value) => Show (Cache term address value) where - showsPrec d = showsUnaryWith showsPrec "Cache" d . map (second toList) . Monoidal.pairs . unCache From 58c22658d356fc6c8f9a635d0a98adcb3b6626ce Mon Sep 17 00:00:00 2001 From: Rob Rix <rob.rix@me.com> Date: Tue, 18 Sep 2018 10:26:50 -0400 Subject: [PATCH 10/14] Rename the Caching module to note its flow-sensitivity. --- semantic.cabal | 2 +- src/Analysis/Abstract/{Caching.hs => Caching/FlowSensitive.hs} | 2 +- src/Semantic/Graph.hs | 2 +- src/Semantic/Util.hs | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) rename src/Analysis/Abstract/{Caching.hs => Caching/FlowSensitive.hs} (99%) diff --git a/semantic.cabal b/semantic.cabal index c0c705c4a..a218006ac 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -19,7 +19,7 @@ library hs-source-dirs: src exposed-modules: -- Analyses & term annotations - Analysis.Abstract.Caching + Analysis.Abstract.Caching.FlowSensitive , Analysis.Abstract.Collecting , Analysis.Abstract.Dead , Analysis.Abstract.Graph diff --git a/src/Analysis/Abstract/Caching.hs b/src/Analysis/Abstract/Caching/FlowSensitive.hs similarity index 99% rename from src/Analysis/Abstract/Caching.hs rename to src/Analysis/Abstract/Caching/FlowSensitive.hs index 277c8c6bd..51a09dd0d 100644 --- a/src/Analysis/Abstract/Caching.hs +++ b/src/Analysis/Abstract/Caching/FlowSensitive.hs @@ -1,5 +1,5 @@ {-# LANGUAGE ConstraintKinds, GADTs, GeneralizedNewtypeDeriving, TypeOperators #-} -module Analysis.Abstract.Caching +module Analysis.Abstract.Caching.FlowSensitive ( cachingTerms , convergingModules , caching diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index ab3bbcd3f..cad685c15 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -26,7 +26,7 @@ module Semantic.Graph import Prelude hiding (readFile) -import Analysis.Abstract.Caching +import Analysis.Abstract.Caching.FlowSensitive import Analysis.Abstract.Collecting import Analysis.Abstract.Graph as Graph import Control.Abstract diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 39e186616..dcde89dcb 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -4,7 +4,7 @@ module Semantic.Util where import Prelude hiding (id, (.), readFile) -import Analysis.Abstract.Caching +import Analysis.Abstract.Caching.FlowSensitive import Analysis.Abstract.Collecting import Control.Abstract import Control.Category From 87c609fa1cc5579a1e70204a7e2c9e9d5ee8d646 Mon Sep 17 00:00:00 2001 From: Rob Rix <rob.rix@me.com> Date: Tue, 18 Sep 2018 10:27:47 -0400 Subject: [PATCH 11/14] Duplicate the flow-sensitive caching module. --- semantic.cabal | 3 +- .../Abstract/Caching/FlowInsensitive.hs | 180 ++++++++++++++++++ 2 files changed, 182 insertions(+), 1 deletion(-) create mode 100644 src/Analysis/Abstract/Caching/FlowInsensitive.hs diff --git a/semantic.cabal b/semantic.cabal index a218006ac..d3a0cbcb6 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -19,7 +19,8 @@ library hs-source-dirs: src exposed-modules: -- Analyses & term annotations - Analysis.Abstract.Caching.FlowSensitive + Analysis.Abstract.Caching.FlowInsensitive + , Analysis.Abstract.Caching.FlowSensitive , Analysis.Abstract.Collecting , Analysis.Abstract.Dead , Analysis.Abstract.Graph diff --git a/src/Analysis/Abstract/Caching/FlowInsensitive.hs b/src/Analysis/Abstract/Caching/FlowInsensitive.hs new file mode 100644 index 000000000..6a5c172c4 --- /dev/null +++ b/src/Analysis/Abstract/Caching/FlowInsensitive.hs @@ -0,0 +1,180 @@ +{-# LANGUAGE ConstraintKinds, GADTs, GeneralizedNewtypeDeriving, TypeOperators #-} +module Analysis.Abstract.Caching.FlowInsensitive +( cachingTerms +, convergingModules +, caching +) where + +import Control.Abstract +import Data.Abstract.BaseError +import Data.Abstract.Environment +import Data.Abstract.Module +import Data.Abstract.Ref +import Data.Map.Monoidal as Monoidal +import Prologue + +-- | Look up the set of values for a given configuration in the in-cache. +consultOracle :: (Cacheable term address value, Member (Reader (Cache term address value)) effects) + => Configuration term address value + -> TermEvaluator term address value effects (Set (Cached address value)) +consultOracle configuration = fromMaybe mempty . cacheLookup configuration <$> ask + +-- | Run an action with the given in-cache. +withOracle :: Member (Reader (Cache term address value)) effects + => Cache term address value + -> TermEvaluator term address value effects a + -> TermEvaluator term address value effects a +withOracle cache = local (const cache) + + +-- | Look up the set of values for a given configuration in the out-cache. +lookupCache :: (Cacheable term address value, Member (State (Cache term address value)) effects) + => Configuration term address value + -> TermEvaluator term address value effects (Maybe (Set (Cached address value))) +lookupCache configuration = cacheLookup configuration <$> get + +-- | Run an action, caching its result and 'Heap' under the given configuration. +cachingConfiguration :: (Cacheable term address value, Member (State (Cache term address value)) effects, Member (State (Heap address value)) effects) + => Configuration term address value + -> Set (Cached address value) + -> TermEvaluator term address value effects (ValueRef address) + -> TermEvaluator term address value effects (ValueRef address) +cachingConfiguration configuration values action = do + modify' (cacheSet configuration values) + result <- Cached <$> action <*> TermEvaluator getHeap + cachedValue result <$ modify' (cacheInsert configuration result) + +putCache :: Member (State (Cache term address value)) effects + => Cache term address value + -> TermEvaluator term address value effects () +putCache = put + +-- | Run an action starting from an empty out-cache, and return the out-cache afterwards. +isolateCache :: Member (State (Cache term address value)) effects + => TermEvaluator term address value effects a + -> TermEvaluator term address value effects (Cache term address value) +isolateCache action = putCache lowerBound *> action *> get + + +-- | Analyze a term using the in-cache as an oracle & storing the results of the analysis in the out-cache. +cachingTerms :: ( Cacheable term address value + , Corecursive term + , Member NonDet effects + , Member (Reader (Cache term address value)) effects + , Member (Reader (Live address)) effects + , Member (State (Cache term address value)) effects + , Member (Env address) effects + , Member (State (Heap address value)) effects + ) + => SubtermAlgebra (Base term) term (TermEvaluator term address value effects (ValueRef address)) + -> SubtermAlgebra (Base term) term (TermEvaluator term address value effects (ValueRef address)) +cachingTerms recur term = do + c <- getConfiguration (embedSubterm term) + cached <- lookupCache c + case cached of + Just pairs -> scatter pairs + Nothing -> do + pairs <- consultOracle c + cachingConfiguration c pairs (recur term) + +convergingModules :: ( AbstractValue address value effects + , Cacheable term address value + , Member Fresh effects + , Member NonDet effects + , Member (Reader (Cache term address value)) effects + , Member (Reader (Live address)) effects + , Member (Reader ModuleInfo) effects + , Member (Reader Span) effects + , Member (Resumable (BaseError (EnvironmentError address))) effects + , Member (State (Cache term address value)) effects + , Member (Env address) effects + , Member (State (Heap address value)) effects + , Effects effects + ) + => SubtermAlgebra Module term (TermEvaluator term address value effects address) + -> SubtermAlgebra Module term (TermEvaluator term address value effects address) +convergingModules recur m = do + c <- getConfiguration (subterm (moduleBody m)) + -- Convergence here is predicated upon an Eq instance, not α-equivalence + cache <- converge lowerBound (\ prevCache -> isolateCache $ do + TermEvaluator (putHeap (configurationHeap c)) + TermEvaluator (putEvalContext (configurationContext c)) + -- We need to reset fresh generation so that this invocation converges. + resetFresh 0 $ + -- This is subtle: though the calling context supports nondeterminism, we want + -- to corral all the nondeterminism that happens in this @eval@ invocation, so + -- that it doesn't "leak" to the calling context and diverge (otherwise this + -- would never complete). We don’t need to use the values, so we 'gather' the + -- nondeterministic values into @()@. + withOracle prevCache (gatherM (const ()) (recur m))) + TermEvaluator (address =<< runTermEvaluator (maybe empty scatter (cacheLookup c cache))) + +-- | Iterate a monadic action starting from some initial seed until the results converge. +-- +-- This applies the Kleene fixed-point theorem to finitize a monotone action. cf https://en.wikipedia.org/wiki/Kleene_fixed-point_theorem +converge :: (Eq a, Monad m) + => a -- ^ An initial seed value to iterate from. + -> (a -> m a) -- ^ A monadic action to perform at each iteration, starting from the result of the previous iteration or from the seed value for the first iteration. + -> m a -- ^ A computation producing the least fixed point (the first value at which the actions converge). +converge seed f = loop seed + where loop x = do + x' <- f x + if x' == x then + pure x + else + loop x' + +-- | Nondeterministically write each of a collection of stores & return their associated results. +scatter :: (Foldable t, Member NonDet effects, Member (State (Heap address value)) effects) => t (Cached address value) -> TermEvaluator term address value effects (ValueRef address) +scatter = foldMapA (\ (Cached value heap') -> TermEvaluator (putHeap heap') $> value) + +-- | Get the current 'Configuration' with a passed-in term. +getConfiguration :: (Member (Reader (Live address)) effects, Member (Env address) effects, Member (State (Heap address value)) effects) + => term + -> TermEvaluator term address value effects (Configuration term address value) +getConfiguration term = Configuration term <$> TermEvaluator askRoots <*> TermEvaluator getEvalContext <*> TermEvaluator getHeap + + +caching :: Effects effects => TermEvaluator term address value (NonDet ': Reader (Cache term address value) ': State (Cache term address value) ': effects) a -> TermEvaluator term address value effects (Cache term address value, [a]) +caching + = runState lowerBound + . runReader lowerBound + . runNonDet + + +-- | A map of 'Configuration's to 'Set's of resulting values & 'Heap's. +newtype Cache term address value = Cache { unCache :: Monoidal.Map (Configuration term address value) (Set (Cached address value)) } + deriving (Eq, Lower, Monoid, Ord, Reducer (Configuration term address value, Cached address value), Semigroup) + +-- | A single point in a program’s execution. +data Configuration term address value = Configuration + { configurationTerm :: term -- ^ The “instruction,” i.e. the current term to evaluate. + , configurationRoots :: Live address -- ^ The set of rooted addresses. + , configurationContext :: EvalContext address -- ^ The evaluation context in 'configurationTerm'. + , configurationHeap :: Heap address value -- ^ The heap of values. + } + deriving (Eq, Ord, Show) + +data Cached address value = Cached + { cachedValue :: ValueRef address + , cachedHeap :: Heap address value + } + deriving (Eq, Ord, Show) + + +type Cacheable term address value = (Ord address, Ord term, Ord value) + +-- | Look up the resulting value & 'Heap' for a given 'Configuration'. +cacheLookup :: Cacheable term address value => Configuration term address value -> Cache term address value -> Maybe (Set (Cached address value)) +cacheLookup key = Monoidal.lookup key . unCache + +-- | Set the resulting value & 'Heap' for a given 'Configuration', overwriting any previous entry. +cacheSet :: Cacheable term address value => Configuration term address value -> Set (Cached address value) -> Cache term address value -> Cache term address value +cacheSet key value = Cache . Monoidal.insert key value . unCache + +-- | Insert the resulting value & 'Heap' for a given 'Configuration', appending onto any previous entry. +cacheInsert :: Cacheable term address value => Configuration term address value -> Cached address value -> Cache term address value -> Cache term address value +cacheInsert = curry cons + +instance (Show term, Show address, Show value) => Show (Cache term address value) where + showsPrec d = showsUnaryWith showsPrec "Cache" d . map (second toList) . Monoidal.pairs . unCache From dec0f3f84506885f684c3f97255b039283a20b18 Mon Sep 17 00:00:00 2001 From: Rob Rix <rob.rix@me.com> Date: Tue, 18 Sep 2018 10:33:34 -0400 Subject: [PATCH 12/14] Remove Heaps from the flow-insensitive cache. --- .../Abstract/Caching/FlowInsensitive.hs | 104 ++++++++---------- 1 file changed, 47 insertions(+), 57 deletions(-) diff --git a/src/Analysis/Abstract/Caching/FlowInsensitive.hs b/src/Analysis/Abstract/Caching/FlowInsensitive.hs index 6a5c172c4..f2602c215 100644 --- a/src/Analysis/Abstract/Caching/FlowInsensitive.hs +++ b/src/Analysis/Abstract/Caching/FlowInsensitive.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ConstraintKinds, GADTs, GeneralizedNewtypeDeriving, TypeOperators #-} +{-# LANGUAGE GADTs, GeneralizedNewtypeDeriving, TypeOperators #-} module Analysis.Abstract.Caching.FlowInsensitive ( cachingTerms , convergingModules @@ -14,57 +14,57 @@ import Data.Map.Monoidal as Monoidal import Prologue -- | Look up the set of values for a given configuration in the in-cache. -consultOracle :: (Cacheable term address value, Member (Reader (Cache term address value)) effects) - => Configuration term address value - -> TermEvaluator term address value effects (Set (Cached address value)) +consultOracle :: (Member (Reader (Cache term address)) effects, Ord address, Ord term) + => Configuration term address + -> TermEvaluator term address value effects (Set (ValueRef address)) consultOracle configuration = fromMaybe mempty . cacheLookup configuration <$> ask -- | Run an action with the given in-cache. -withOracle :: Member (Reader (Cache term address value)) effects - => Cache term address value +withOracle :: Member (Reader (Cache term address)) effects + => Cache term address -> TermEvaluator term address value effects a -> TermEvaluator term address value effects a withOracle cache = local (const cache) -- | Look up the set of values for a given configuration in the out-cache. -lookupCache :: (Cacheable term address value, Member (State (Cache term address value)) effects) - => Configuration term address value - -> TermEvaluator term address value effects (Maybe (Set (Cached address value))) +lookupCache :: (Member (State (Cache term address)) effects, Ord address, Ord term) + => Configuration term address + -> TermEvaluator term address value effects (Maybe (Set (ValueRef address))) lookupCache configuration = cacheLookup configuration <$> get -- | Run an action, caching its result and 'Heap' under the given configuration. -cachingConfiguration :: (Cacheable term address value, Member (State (Cache term address value)) effects, Member (State (Heap address value)) effects) - => Configuration term address value - -> Set (Cached address value) +cachingConfiguration :: (Member (State (Cache term address)) effects, Ord address, Ord term) + => Configuration term address + -> Set (ValueRef address) -> TermEvaluator term address value effects (ValueRef address) -> TermEvaluator term address value effects (ValueRef address) cachingConfiguration configuration values action = do modify' (cacheSet configuration values) - result <- Cached <$> action <*> TermEvaluator getHeap - cachedValue result <$ modify' (cacheInsert configuration result) + result <- action + result <$ modify' (cacheInsert configuration result) -putCache :: Member (State (Cache term address value)) effects - => Cache term address value +putCache :: Member (State (Cache term address)) effects + => Cache term address -> TermEvaluator term address value effects () putCache = put -- | Run an action starting from an empty out-cache, and return the out-cache afterwards. -isolateCache :: Member (State (Cache term address value)) effects +isolateCache :: Member (State (Cache term address)) effects => TermEvaluator term address value effects a - -> TermEvaluator term address value effects (Cache term address value) + -> TermEvaluator term address value effects (Cache term address) isolateCache action = putCache lowerBound *> action *> get -- | Analyze a term using the in-cache as an oracle & storing the results of the analysis in the out-cache. -cachingTerms :: ( Cacheable term address value - , Corecursive term - , Member NonDet effects - , Member (Reader (Cache term address value)) effects - , Member (Reader (Live address)) effects - , Member (State (Cache term address value)) effects +cachingTerms :: ( Corecursive term , Member (Env address) effects - , Member (State (Heap address value)) effects + , Member NonDet effects + , Member (Reader (Cache term address)) effects + , Member (Reader (Live address)) effects + , Member (State (Cache term address)) effects + , Ord address + , Ord term ) => SubtermAlgebra (Base term) term (TermEvaluator term address value effects (ValueRef address)) -> SubtermAlgebra (Base term) term (TermEvaluator term address value effects (ValueRef address)) @@ -72,24 +72,24 @@ cachingTerms recur term = do c <- getConfiguration (embedSubterm term) cached <- lookupCache c case cached of - Just pairs -> scatter pairs + Just values -> scatter values Nothing -> do - pairs <- consultOracle c - cachingConfiguration c pairs (recur term) + values <- consultOracle c + cachingConfiguration c values (recur term) convergingModules :: ( AbstractValue address value effects - , Cacheable term address value + , Effects effects + , Member (Env address) effects , Member Fresh effects , Member NonDet effects - , Member (Reader (Cache term address value)) effects + , Member (Reader (Cache term address)) effects , Member (Reader (Live address)) effects , Member (Reader ModuleInfo) effects , Member (Reader Span) effects , Member (Resumable (BaseError (EnvironmentError address))) effects - , Member (State (Cache term address value)) effects - , Member (Env address) effects - , Member (State (Heap address value)) effects - , Effects effects + , Member (State (Cache term address)) effects + , Ord address + , Ord term ) => SubtermAlgebra Module term (TermEvaluator term address value effects address) -> SubtermAlgebra Module term (TermEvaluator term address value effects address) @@ -97,7 +97,6 @@ convergingModules recur m = do c <- getConfiguration (subterm (moduleBody m)) -- Convergence here is predicated upon an Eq instance, not α-equivalence cache <- converge lowerBound (\ prevCache -> isolateCache $ do - TermEvaluator (putHeap (configurationHeap c)) TermEvaluator (putEvalContext (configurationContext c)) -- We need to reset fresh generation so that this invocation converges. resetFresh 0 $ @@ -125,17 +124,17 @@ converge seed f = loop seed loop x' -- | Nondeterministically write each of a collection of stores & return their associated results. -scatter :: (Foldable t, Member NonDet effects, Member (State (Heap address value)) effects) => t (Cached address value) -> TermEvaluator term address value effects (ValueRef address) -scatter = foldMapA (\ (Cached value heap') -> TermEvaluator (putHeap heap') $> value) +scatter :: (Foldable t, Member NonDet effects) => t (ValueRef address) -> TermEvaluator term address value effects (ValueRef address) +scatter = foldMapA pure -- | Get the current 'Configuration' with a passed-in term. -getConfiguration :: (Member (Reader (Live address)) effects, Member (Env address) effects, Member (State (Heap address value)) effects) +getConfiguration :: (Member (Reader (Live address)) effects, Member (Env address) effects) => term - -> TermEvaluator term address value effects (Configuration term address value) -getConfiguration term = Configuration term <$> TermEvaluator askRoots <*> TermEvaluator getEvalContext <*> TermEvaluator getHeap + -> TermEvaluator term address value effects (Configuration term address) +getConfiguration term = Configuration term <$> TermEvaluator askRoots <*> TermEvaluator getEvalContext -caching :: Effects effects => TermEvaluator term address value (NonDet ': Reader (Cache term address value) ': State (Cache term address value) ': effects) a -> TermEvaluator term address value effects (Cache term address value, [a]) +caching :: Effects effects => TermEvaluator term address value (NonDet ': Reader (Cache term address) ': State (Cache term address) ': effects) a -> TermEvaluator term address value effects (Cache term address, [a]) caching = runState lowerBound . runReader lowerBound @@ -143,38 +142,29 @@ caching -- | A map of 'Configuration's to 'Set's of resulting values & 'Heap's. -newtype Cache term address value = Cache { unCache :: Monoidal.Map (Configuration term address value) (Set (Cached address value)) } - deriving (Eq, Lower, Monoid, Ord, Reducer (Configuration term address value, Cached address value), Semigroup) +newtype Cache term address = Cache { unCache :: Monoidal.Map (Configuration term address) (Set (ValueRef address)) } + deriving (Eq, Lower, Monoid, Ord, Reducer (Configuration term address, ValueRef address), Semigroup) -- | A single point in a program’s execution. -data Configuration term address value = Configuration +data Configuration term address = Configuration { configurationTerm :: term -- ^ The “instruction,” i.e. the current term to evaluate. , configurationRoots :: Live address -- ^ The set of rooted addresses. , configurationContext :: EvalContext address -- ^ The evaluation context in 'configurationTerm'. - , configurationHeap :: Heap address value -- ^ The heap of values. } deriving (Eq, Ord, Show) -data Cached address value = Cached - { cachedValue :: ValueRef address - , cachedHeap :: Heap address value - } - deriving (Eq, Ord, Show) - - -type Cacheable term address value = (Ord address, Ord term, Ord value) -- | Look up the resulting value & 'Heap' for a given 'Configuration'. -cacheLookup :: Cacheable term address value => Configuration term address value -> Cache term address value -> Maybe (Set (Cached address value)) +cacheLookup :: (Ord address, Ord term) => Configuration term address -> Cache term address -> Maybe (Set (ValueRef address)) cacheLookup key = Monoidal.lookup key . unCache -- | Set the resulting value & 'Heap' for a given 'Configuration', overwriting any previous entry. -cacheSet :: Cacheable term address value => Configuration term address value -> Set (Cached address value) -> Cache term address value -> Cache term address value +cacheSet :: (Ord address, Ord term) => Configuration term address -> Set (ValueRef address) -> Cache term address -> Cache term address cacheSet key value = Cache . Monoidal.insert key value . unCache -- | Insert the resulting value & 'Heap' for a given 'Configuration', appending onto any previous entry. -cacheInsert :: Cacheable term address value => Configuration term address value -> Cached address value -> Cache term address value -> Cache term address value +cacheInsert :: (Ord address, Ord term) => Configuration term address -> ValueRef address -> Cache term address -> Cache term address cacheInsert = curry cons -instance (Show term, Show address, Show value) => Show (Cache term address value) where +instance (Show term, Show address) => Show (Cache term address) where showsPrec d = showsUnaryWith showsPrec "Cache" d . map (second toList) . Monoidal.pairs . unCache From 49251bbf27aee9535832a975363ee9c0489b5a07 Mon Sep 17 00:00:00 2001 From: Rob Rix <rob.rix@me.com> Date: Tue, 18 Sep 2018 10:45:37 -0400 Subject: [PATCH 13/14] Compute the least fixed-point of the cache and heap. --- src/Analysis/Abstract/Caching/FlowInsensitive.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/src/Analysis/Abstract/Caching/FlowInsensitive.hs b/src/Analysis/Abstract/Caching/FlowInsensitive.hs index f2602c215..64f96bad6 100644 --- a/src/Analysis/Abstract/Caching/FlowInsensitive.hs +++ b/src/Analysis/Abstract/Caching/FlowInsensitive.hs @@ -50,10 +50,10 @@ putCache :: Member (State (Cache term address)) effects putCache = put -- | Run an action starting from an empty out-cache, and return the out-cache afterwards. -isolateCache :: Member (State (Cache term address)) effects +isolateCache :: (Member (State (Cache term address)) effects, Member (State (Heap address value)) effects) => TermEvaluator term address value effects a - -> TermEvaluator term address value effects (Cache term address) -isolateCache action = putCache lowerBound *> action *> get + -> TermEvaluator term address value effects (Cache term address, Heap address value) +isolateCache action = putCache lowerBound *> action *> ((,) <$> get <*> get) -- | Analyze a term using the in-cache as an oracle & storing the results of the analysis in the out-cache. @@ -79,6 +79,7 @@ cachingTerms recur term = do convergingModules :: ( AbstractValue address value effects , Effects effects + , Eq value , Member (Env address) effects , Member Fresh effects , Member NonDet effects @@ -88,6 +89,7 @@ convergingModules :: ( AbstractValue address value effects , Member (Reader Span) effects , Member (Resumable (BaseError (EnvironmentError address))) effects , Member (State (Cache term address)) effects + , Member (State (Heap address value)) effects , Ord address , Ord term ) @@ -95,8 +97,9 @@ convergingModules :: ( AbstractValue address value effects -> SubtermAlgebra Module term (TermEvaluator term address value effects address) convergingModules recur m = do c <- getConfiguration (subterm (moduleBody m)) + heap <- TermEvaluator getHeap -- Convergence here is predicated upon an Eq instance, not α-equivalence - cache <- converge lowerBound (\ prevCache -> isolateCache $ do + (cache, _) <- converge (lowerBound, heap) (\ (prevCache, _) -> isolateCache $ do TermEvaluator (putEvalContext (configurationContext c)) -- We need to reset fresh generation so that this invocation converges. resetFresh 0 $ From c50cc165f6dc147a87880a56781d13cc6426a6ef Mon Sep 17 00:00:00 2001 From: Rob Rix <rob.rix@me.com> Date: Tue, 18 Sep 2018 10:46:17 -0400 Subject: [PATCH 14/14] Use the flow-insensitive caching algorithm. --- src/Semantic/Graph.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index cad685c15..a512487db 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -26,7 +26,7 @@ module Semantic.Graph import Prelude hiding (readFile) -import Analysis.Abstract.Caching.FlowSensitive +import Analysis.Abstract.Caching.FlowInsensitive import Analysis.Abstract.Collecting import Analysis.Abstract.Graph as Graph import Control.Abstract