diff --git a/semantic.cabal b/semantic.cabal index 7778ad4c8..a9ef0fd34 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.Addressable , Control.Abstract.Context , Control.Abstract.Environment , Control.Abstract.Evaluator @@ -48,7 +47,10 @@ library , Control.Abstract.TermEvaluator , Control.Abstract.Value -- Datatypes for abstract interpretation - , Data.Abstract.Address + , Data.Abstract.Address.Hole + , Data.Abstract.Address.Located + , Data.Abstract.Address.Monovariant + , Data.Abstract.Address.Precise , Data.Abstract.BaseError , Data.Abstract.Cache , Data.Abstract.Configuration diff --git a/src/Analysis/Abstract/Collecting.hs b/src/Analysis/Abstract/Collecting.hs index 45cc33a4d..e1d530985 100644 --- a/src/Analysis/Abstract/Collecting.hs +++ b/src/Analysis/Abstract/Collecting.hs @@ -9,7 +9,7 @@ import Prologue -- | An analysis performing GC after every instruction. collectingTerms :: ( Member (Reader (Live address)) effects - , Member (Allocator address value) effects + , Member (State (Heap address value)) effects , Ord address , ValueRoots address value ) diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs index 5917d0c98..1fb1a93a7 100644 --- a/src/Analysis/Abstract/Graph.hs +++ b/src/Analysis/Abstract/Graph.hs @@ -18,7 +18,8 @@ module Analysis.Abstract.Graph import Algebra.Graph.Export.Dot hiding (vertexName) import Control.Abstract hiding (Function(..)) -import Data.Abstract.Address +import Data.Abstract.Address.Hole +import Data.Abstract.Address.Located import Data.Abstract.BaseError import Data.Abstract.Ref import Data.Abstract.Declarations diff --git a/src/Control/Abstract.hs b/src/Control/Abstract.hs index 977c1482a..5d3aba7b6 100644 --- a/src/Control/Abstract.hs +++ b/src/Control/Abstract.hs @@ -2,7 +2,6 @@ module Control.Abstract ( module X ) where -import Control.Abstract.Addressable as X import Control.Abstract.Context as X import Control.Abstract.Environment as X hiding (Lookup) import Control.Abstract.Evaluator as X diff --git a/src/Control/Abstract/Addressable.hs b/src/Control/Abstract/Addressable.hs deleted file mode 100644 index 7a426e18b..000000000 --- a/src/Control/Abstract/Addressable.hs +++ /dev/null @@ -1,62 +0,0 @@ -{-# LANGUAGE UndecidableInstances #-} -module Control.Abstract.Addressable -( Allocatable(..) -, Derefable(..) -) where - -import Control.Abstract.Context -import Control.Abstract.Evaluator -import Control.Abstract.Hole -import Data.Abstract.Address -import Data.Abstract.Name -import qualified Data.Set as Set -import Prologue - -class (Ord address, Show address) => Allocatable address effects where - allocCell :: Name -> Evaluator address value effects address - - assignCell :: Ord value => address -> value -> Set value -> Evaluator address value effects (Set value) - -class (Ord address, Show address) => Derefable address effects where - derefCell :: address -> Set value -> Evaluator address value effects (Maybe value) - - -instance Member Fresh effects => Allocatable Precise effects where - allocCell _ = Precise <$> fresh - - assignCell _ value _ = pure (Set.singleton value) - -instance Derefable Precise effects where - derefCell _ = pure . fmap fst . Set.minView - - -instance Allocatable Monovariant effects where - allocCell = pure . Monovariant - - assignCell _ value values = pure (Set.insert value values) - -instance Member NonDet effects => Derefable Monovariant effects where - derefCell _ = traverse (foldMapA pure) . nonEmpty . toList - - -instance (Allocatable address effects, Member (Reader ModuleInfo) effects, Member (Reader PackageInfo) effects, Member (Reader Span) effects) => Allocatable (Located address) effects where - allocCell name = relocate (Located <$> allocCell name <*> currentPackage <*> currentModule <*> pure name <*> ask) - - assignCell (Located loc _ _ _ _) value = relocate . assignCell loc value - -instance Derefable address effects => Derefable (Located address) effects where - derefCell (Located loc _ _ _ _) = relocate . derefCell loc - - -instance (Allocatable address effects, Ord context, Show context) => Allocatable (Hole context address) effects where - allocCell name = relocate (Total <$> allocCell name) - - assignCell (Total loc) value = relocate . assignCell loc value - assignCell (Partial _) _ = pure - -instance (Derefable address effects, Ord context, Show context) => Derefable (Hole context address) effects where - derefCell (Total loc) = relocate . derefCell loc - derefCell (Partial _) = const (pure Nothing) - -relocate :: Evaluator address1 value effects a -> Evaluator address2 value effects a -relocate = raiseEff . lowerEff diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index 2797c6405..9541a1989 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -17,16 +17,13 @@ module Control.Abstract.Heap -- * Garbage collection , gc -- * Effects -, Allocator -, runAllocator +, Allocator(..) , Deref(..) -, runDeref , AddressError(..) , runAddressError , runAddressErrorWith ) where -import Control.Abstract.Addressable import Control.Abstract.Environment import Control.Abstract.Evaluator import Control.Abstract.Roots @@ -57,8 +54,11 @@ putHeap = put modifyHeap :: Member (State (Heap address value)) effects => (Heap address value -> Heap address value) -> Evaluator address value effects () modifyHeap = modify' -box :: ( Member (Allocator address value) effects +box :: ( Member (Allocator address) effects + , Member (Deref value) effects , Member Fresh effects + , Member (State (Heap address value)) effects + , Ord address ) => value -> Evaluator address value effects address @@ -68,27 +68,41 @@ box val = do assign addr val pure addr -alloc :: Member (Allocator address value) effects => Name -> Evaluator address value effects address -alloc = sendAllocator . Alloc +alloc :: Member (Allocator address) effects => Name -> Evaluator address value effects address +alloc = send . Alloc -dealloc :: Member (Allocator address value) effects => address -> Evaluator address value effects () -dealloc = sendAllocator . Delete +dealloc :: (Member (State (Heap address value)) effects, Ord address) => address -> Evaluator address value effects () +dealloc addr = modifyHeap (heapDelete addr) -- | Dereference the given address in the heap, or fail if the address is uninitialized. -deref :: Member (Deref address value) effects => address -> Evaluator address value effects value -deref = send . Deref +deref :: ( Member (Deref value) effects + , Member (Reader ModuleInfo) effects + , Member (Reader Span) effects + , Member (Resumable (BaseError (AddressError address value))) effects + , Member (State (Heap address value)) effects + , Ord address + ) + => address + -> Evaluator address value effects value +deref addr = gets (heapLookup addr) >>= maybeM (throwAddressError (UnallocatedAddress addr)) >>= send . DerefCell >>= maybeM (throwAddressError (UninitializedAddress addr)) -- | Write a value to the given address in the 'Allocator'. -assign :: Member (Allocator address value) effects +assign :: ( Member (Deref value) effects + , Member (State (Heap address value)) effects + , Ord address + ) => address -> value -> Evaluator address value effects () -assign address = send . Assign address +assign addr value = do + heap <- getHeap + cell <- send (AssignCell value (fromMaybe lowerBound (heapLookup addr heap))) + putHeap (heapInit addr cell heap) -- | Look up or allocate an address for a 'Name'. -lookupOrAlloc :: ( Member (Allocator address value) effects +lookupOrAlloc :: ( Member (Allocator address) effects , Member (Env address) effects ) => Name @@ -96,8 +110,11 @@ lookupOrAlloc :: ( Member (Allocator address value) effects lookupOrAlloc name = lookupEnv name >>= maybeM (alloc name) -letrec :: ( Member (Allocator address value) effects +letrec :: ( Member (Allocator address) effects + , Member (Deref value) effects , Member (Env address) effects + , Member (State (Heap address value)) effects + , Ord address ) => Name -> Evaluator address value effects value @@ -109,7 +126,7 @@ letrec name body = do pure (v, addr) -- Lookup/alloc a name passing the address to a body evaluated in a new local environment. -letrec' :: ( Member (Allocator address value) effects +letrec' :: ( Member (Allocator address) effects , Member (Env address) effects ) => Name @@ -135,10 +152,13 @@ variable name = lookupEnv name >>= maybeM (freeVariableError name) -- Garbage collection -- | Collect any addresses in the heap not rooted in or reachable from the given 'Live' set. -gc :: Member (Allocator address value) effects +gc :: ( Member (State (Heap address value)) effects + , Ord address + , ValueRoots address value + ) => Live address -- ^ The set of addresses to consider rooted. -> Evaluator address value effects () -gc roots = sendAllocator (GC roots) +gc roots = modifyHeap (heapRestrict <*> reachable roots) -- | Compute the set of addresses reachable from a given root set in a given heap. reachable :: ( Ord address @@ -157,59 +177,23 @@ reachable roots heap = go mempty roots -- Effects -sendAllocator :: Member (Allocator address value) effects => Allocator address value (Eff effects) return -> Evaluator address value effects return -sendAllocator = send +data Allocator address (m :: * -> *) return where + Alloc :: Name -> Allocator address m address -data Allocator address value (m :: * -> *) return where - Alloc :: Name -> Allocator address value m address - Assign :: address -> value -> Allocator address value m () - GC :: Live address -> Allocator address value m () - Delete :: address -> Allocator address value m () +data Deref value (m :: * -> *) return where + DerefCell :: Set value -> Deref value m (Maybe value) + AssignCell :: value -> Set value -> Deref value m (Set value) -data Deref address value (m :: * -> *) return where - Deref :: address -> Deref address value m value +instance PureEffect (Allocator address) -runAllocator :: ( Allocatable address effects - , Member (State (Heap address value)) effects - , Ord value - , PureEffects effects - , ValueRoots address value - ) - => Evaluator address value (Allocator address value ': effects) a - -> Evaluator address value effects a -runAllocator = interpret $ \ eff -> case eff of - Alloc name -> allocCell name - Assign addr value -> do - heap <- getHeap - cell <- assignCell addr value (fromMaybe mempty (heapLookup addr heap)) - putHeap (heapInit addr cell heap) - GC roots -> modifyHeap (heapRestrict <*> reachable roots) - Delete addr -> modifyHeap (heapDelete addr) - -runDeref :: ( Derefable address effects - , PureEffects effects - , Member (Reader ModuleInfo) effects - , Member (Reader Span) effects - , Member (Resumable (BaseError (AddressError address value))) effects - , Member (State (Heap address value)) effects - ) - => Evaluator address value (Deref address value ': effects) a - -> Evaluator address value effects a -runDeref = interpret $ \ eff -> case eff of - Deref addr -> heapLookup addr <$> get >>= maybeM (throwAddressError (UnallocatedAddress addr)) >>= derefCell addr >>= maybeM (throwAddressError (UninitializedAddress addr)) - -instance PureEffect (Allocator address value) - -instance Effect (Allocator address value) where +instance Effect (Allocator address) where handleState c dist (Request (Alloc name) k) = Request (Alloc name) (dist . (<$ c) . k) - handleState c dist (Request (Assign addr value) k) = Request (Assign addr value) (dist . (<$ c) . k) - handleState c dist (Request (GC roots) k) = Request (GC roots) (dist . (<$ c) . k) - handleState c dist (Request (Delete addr) k) = Request (Delete addr) (dist . (<$ c) . k) -instance PureEffect (Deref address value) +instance PureEffect (Deref value) -instance Effect (Deref address value) where - handleState c dist (Request (Deref addr) k) = Request (Deref addr) (dist . (<$ c) . k) +instance Effect (Deref value) where + handleState c dist (Request (DerefCell cell) k) = Request (DerefCell cell) (dist . (<$ c) . k) + handleState c dist (Request (AssignCell value cell) k) = Request (AssignCell value cell) (dist . (<$ c) . k) data AddressError address value resume where UnallocatedAddress :: address -> AddressError address value (Set value) diff --git a/src/Control/Abstract/Hole.hs b/src/Control/Abstract/Hole.hs index ccbb83eb6..8ea724d2d 100644 --- a/src/Control/Abstract/Hole.hs +++ b/src/Control/Abstract/Hole.hs @@ -1,21 +1,6 @@ module Control.Abstract.Hole ( AbstractHole (..) - , Hole (..) - , toMaybe ) where -import Prologue - class AbstractHole a where hole :: a - - -data Hole context a = Partial context | Total a - deriving (Foldable, Functor, Eq, Ord, Show, Traversable) - -instance Lower context => AbstractHole (Hole context a) where - hole = Partial lowerBound - -toMaybe :: Hole context a -> Maybe a -toMaybe (Partial _) = Nothing -toMaybe (Total a) = Just a diff --git a/src/Control/Abstract/Modules.hs b/src/Control/Abstract/Modules.hs index 47d84307e..c5f69d81f 100644 --- a/src/Control/Abstract/Modules.hs +++ b/src/Control/Abstract/Modules.hs @@ -127,9 +127,9 @@ throwLoadError err@(ModuleNotFoundError name) = throwResumable $ BaseError (Modu -- | An error thrown when we can't resolve a module from a qualified name. data ResolutionError resume where - NotFoundError :: String -- ^ The path that was not found. - -> [String] -- ^ List of paths searched that shows where semantic looked for this module. - -> Language -- ^ Language. + NotFoundError :: String -- The path that was not found. + -> [String] -- List of paths searched that shows where semantic looked for this module. + -> Language -- Language. -> ResolutionError ModulePath GoImportError :: FilePath -> ResolutionError [ModulePath] diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index d9d2b827c..e2036cbba 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -21,10 +21,13 @@ import Data.Text (unpack) import Prologue define :: ( HasCallStack - , Member (Allocator address value) effects + , Member (Allocator address) effects + , Member (Deref value) effects , Member (Env address) effects , Member (Reader ModuleInfo) effects , Member (Reader Span) effects + , Member (State (Heap address value)) effects + , Ord address ) => Name -> Evaluator address value effects value @@ -36,10 +39,13 @@ define name def = withCurrentCallStack callStack $ do defineClass :: ( AbstractValue address value effects , HasCallStack - , Member (Allocator address value) effects + , Member (Allocator address) effects + , Member (Deref value) effects , Member (Env address) effects , Member (Reader ModuleInfo) effects , Member (Reader Span) effects + , Member (State (Heap address value)) effects + , Ord address ) => Name -> [address] @@ -51,10 +57,13 @@ defineClass name superclasses body = define name $ do defineNamespace :: ( AbstractValue address value effects , HasCallStack - , Member (Allocator address value) effects + , Member (Allocator address) effects + , Member (Deref value) effects , Member (Env address) effects , Member (Reader ModuleInfo) effects , Member (Reader Span) effects + , Member (State (Heap address value)) effects + , Ord address ) => Name -> Evaluator address value effects a @@ -93,29 +102,35 @@ instance Member (Function address value) effects => Lambda address value effects builtInPrint :: ( AbstractValue address value effects , HasCallStack - , Member (Allocator address value) effects - , Member (Deref address value) effects + , Member (Allocator address) effects + , Member (Deref value) effects , Member (Env address) effects , Member Fresh effects , Member (Function address value) effects , Member (Reader ModuleInfo) effects , Member (Reader Span) effects + , Member (Resumable (BaseError (AddressError address value))) effects , Member (Resumable (BaseError (EnvironmentError address))) effects + , Member (State (Heap address value)) effects , Member Trace effects + , Ord address ) => Evaluator address value effects value builtInPrint = lambda (\ v -> variable v >>= deref >>= asString >>= trace . unpack >> box unit) builtInExport :: ( AbstractValue address value effects , HasCallStack - , Member (Allocator address value) effects - , Member (Deref address value) effects + , Member (Allocator address) effects + , Member (Deref value) effects , Member (Env address) effects , Member Fresh effects , Member (Function address value) effects , Member (Reader ModuleInfo) effects , Member (Reader Span) effects + , Member (Resumable (BaseError (AddressError address value))) effects , Member (Resumable (BaseError (EnvironmentError address))) effects + , Member (State (Heap address value)) effects + , Ord address ) => Evaluator address value effects value builtInExport = lambda (\ v -> do diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index fe20c2cc8..a8bd0ca60 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -200,8 +200,10 @@ doWhile body cond = loop $ \ continue -> body *> do ifthenelse this continue (pure unit) makeNamespace :: ( AbstractValue address value effects + , Member (Deref value) effects , Member (Env address) effects - , Member (Allocator address value) effects + , Member (State (Heap address value)) effects + , Ord address ) => Name -> address @@ -229,11 +231,14 @@ evaluateInScopedEnv receiver term = do -- | Evaluates a 'Value' returning the referenced value value :: ( AbstractValue address value effects - , Member (Deref address value) effects + , Member (Deref value) effects , Member (Env address) effects , Member (Reader ModuleInfo) effects , Member (Reader Span) effects + , Member (Resumable (BaseError (AddressError address value))) effects , Member (Resumable (BaseError (EnvironmentError address))) effects + , Member (State (Heap address value)) effects + , Ord address ) => ValueRef address -> Evaluator address value effects value @@ -241,11 +246,14 @@ value = deref <=< address -- | Evaluates a 'Subterm' to its rval subtermValue :: ( AbstractValue address value effects - , Member (Deref address value) effects + , Member (Deref value) effects , Member (Env address) effects , Member (Reader ModuleInfo) effects , Member (Reader Span) effects + , Member (Resumable (BaseError (AddressError address value))) effects , Member (Resumable (BaseError (EnvironmentError address))) effects + , Member (State (Heap address value)) effects + , Ord address ) => Subterm term (Evaluator address value effects (ValueRef address)) -> Evaluator address value effects value @@ -276,8 +284,11 @@ subtermAddress :: ( AbstractValue address value effects subtermAddress = address <=< subtermRef -- | Convenience function for boxing a raw value and wrapping it in an Rval -rvalBox :: ( Member (Allocator address value) effects +rvalBox :: ( Member (Allocator address) effects + , Member (Deref value) effects , Member Fresh effects + , Member (State (Heap address value)) effects + , Ord address ) => value -> Evaluator address value effects (ValueRef address) diff --git a/src/Data/Abstract/Address.hs b/src/Data/Abstract/Address.hs deleted file mode 100644 index 75bb12867..000000000 --- a/src/Data/Abstract/Address.hs +++ /dev/null @@ -1,36 +0,0 @@ -module Data.Abstract.Address - ( Precise (..) - , Located (..) - , Monovariant (..) - ) where - -import Data.Abstract.Module (ModuleInfo) -import Data.Abstract.Name -import Data.Abstract.Package (PackageInfo) -import Data.Span -import Prologue - --- | 'Precise' models precise store semantics where only the 'Latest' value is taken. Everything gets it's own address (always makes a new allocation) which makes for a larger store. -newtype Precise = Precise { unPrecise :: Int } - deriving (Eq, Ord) - -instance Show Precise where - showsPrec d = showsUnaryWith showsPrec "Precise" d . unPrecise - - --- | 'Monovariant' models using one address for a particular name. It trackes the set of values that a particular address takes and uses it's name to lookup in the store and only allocation if new. -newtype Monovariant = Monovariant { unMonovariant :: Name } - deriving (Eq, Ord) - -instance Show Monovariant where - showsPrec d = showsUnaryWith showsPrec "Monovariant" d . unMonovariant - - -data Located address = Located - { address :: address - , addressPackage :: {-# UNPACK #-} !PackageInfo - , addressModule :: !ModuleInfo - , addressName :: Name - , addressSpan :: Span - } - deriving (Eq, Ord, Show) diff --git a/src/Data/Abstract/Address/Hole.hs b/src/Data/Abstract/Address/Hole.hs new file mode 100644 index 000000000..6feb5219f --- /dev/null +++ b/src/Data/Abstract/Address/Hole.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE GADTs, RankNTypes, TypeOperators #-} +module Data.Abstract.Address.Hole +( Hole(..) +, toMaybe +, runAllocator +, handleAllocator +, runDeref +, handleDeref +) where + +import Control.Abstract +import Prologue + +data Hole context a = Partial context | Total a + deriving (Foldable, Functor, Eq, Ord, Show, Traversable) + +instance Lower context => AbstractHole (Hole context a) where + hole = Partial lowerBound + +toMaybe :: Hole context a -> Maybe a +toMaybe (Partial _) = Nothing +toMaybe (Total a) = Just a + + +relocate :: Evaluator address1 value effects a -> Evaluator address2 value effects a +relocate = raiseEff . lowerEff + + +runAllocator :: PureEffects effects + => (forall x. Allocator address (Eff (Allocator address ': effects)) x -> Evaluator address value effects x) + -> Evaluator (Hole context address) value (Allocator (Hole context address) ': effects) a + -> Evaluator (Hole context address) value effects a +runAllocator handler = interpret (handleAllocator handler) + +handleAllocator :: (forall x. Allocator address (Eff (Allocator address ': effects)) x -> Evaluator address value effects x) + -> Allocator (Hole context address) (Eff (Allocator (Hole context address) ': effects)) a + -> Evaluator (Hole context address) value effects a +handleAllocator handler (Alloc name) = relocate (Total <$> handler (Alloc name)) + +runDeref :: PureEffects effects + => (forall x. Deref value (Eff (Deref value ': effects)) x -> Evaluator address value effects x) + -> Evaluator (Hole context address) value (Deref value ': effects) a + -> Evaluator (Hole context address) value effects a +runDeref handler = interpret (handleDeref handler) + +handleDeref :: (forall x. Deref value (Eff (Deref value ': effects)) x -> Evaluator address value effects x) + -> Deref value (Eff (Deref value ': effects)) a + -> Evaluator (Hole context address) value effects a +handleDeref handler (DerefCell cell) = relocate (handler (DerefCell cell)) +handleDeref handler (AssignCell value cell) = relocate (handler (AssignCell value cell)) diff --git a/src/Data/Abstract/Address/Located.hs b/src/Data/Abstract/Address/Located.hs new file mode 100644 index 000000000..36fcd3d90 --- /dev/null +++ b/src/Data/Abstract/Address/Located.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE GADTs, RankNTypes, TypeOperators, UndecidableInstances #-} +module Data.Abstract.Address.Located +( Located(..) +, runAllocator +, handleAllocator +, runDeref +, handleDeref +) where + +import Control.Abstract +import Data.Abstract.Module (ModuleInfo) +import Data.Abstract.Name +import Data.Abstract.Package (PackageInfo) + +data Located address = Located + { address :: address + , addressPackage :: {-# UNPACK #-} !PackageInfo + , addressModule :: !ModuleInfo + , addressName :: Name + , addressSpan :: Span + } + deriving (Eq, Ord, Show) + + +relocate :: Evaluator address1 value effects a -> Evaluator address2 value effects a +relocate = raiseEff . lowerEff + + +runAllocator :: ( Member (Reader ModuleInfo) effects + , Member (Reader PackageInfo) effects + , Member (Reader Span) effects + , PureEffects effects + ) + => (forall x. Allocator address (Eff (Allocator address ': effects)) x -> Evaluator address value effects x) + -> Evaluator (Located address) value (Allocator (Located address) ': effects) a + -> Evaluator (Located address) value effects a +runAllocator handler = interpret (handleAllocator handler) + +handleAllocator :: ( Member (Reader ModuleInfo) effects + , Member (Reader PackageInfo) effects + , Member (Reader Span) effects + ) + => (forall x. Allocator address (Eff (Allocator address ': effects)) x -> Evaluator address value effects x) + -> Allocator (Located address) (Eff (Allocator (Located address) ': effects)) a + -> Evaluator (Located address) value effects a +handleAllocator handler (Alloc name) = relocate (Located <$> handler (Alloc name) <*> currentPackage <*> currentModule <*> pure name <*> ask) + +runDeref :: PureEffects effects + => (forall x. Deref value (Eff (Deref value ': effects)) x -> Evaluator address value effects x) + -> Evaluator (Located address) value (Deref value ': effects) a + -> Evaluator (Located address) value effects a +runDeref handler = interpret (handleDeref handler) + +handleDeref :: (forall x. Deref value (Eff (Deref value ': effects)) x -> Evaluator address value effects x) + -> Deref value (Eff (Deref value ': effects)) a + -> Evaluator (Located address) value effects a +handleDeref handler (DerefCell cell) = relocate (handler (DerefCell cell)) +handleDeref handler (AssignCell value cell) = relocate (handler (AssignCell value cell)) diff --git a/src/Data/Abstract/Address/Monovariant.hs b/src/Data/Abstract/Address/Monovariant.hs new file mode 100644 index 000000000..55e35edb6 --- /dev/null +++ b/src/Data/Abstract/Address/Monovariant.hs @@ -0,0 +1,45 @@ +{-# LANGUAGE GADTs, TypeOperators, UndecidableInstances #-} +module Data.Abstract.Address.Monovariant +( Monovariant(..) +, runAllocator +, handleAllocator +, runDeref +, handleDeref +) where + +import Control.Abstract +import Data.Abstract.Name +import qualified Data.Set as Set +import Prologue + +-- | 'Monovariant' models using one address for a particular name. It trackes the set of values that a particular address takes and uses it's name to lookup in the store and only allocation if new. +newtype Monovariant = Monovariant { unMonovariant :: Name } + deriving (Eq, Ord) + +instance Show Monovariant where + showsPrec d = showsUnaryWith showsPrec "Monovariant" d . unMonovariant + + +runAllocator :: PureEffects effects + => Evaluator Monovariant value (Allocator Monovariant ': effects) a + -> Evaluator Monovariant value effects a +runAllocator = interpret handleAllocator + +handleAllocator :: Allocator Monovariant (Eff (Allocator Monovariant ': effects)) a -> Evaluator Monovariant value effects a +handleAllocator (Alloc name) = pure (Monovariant name) + +runDeref :: ( Member NonDet effects + , Ord value + , PureEffects effects + ) + => Evaluator Monovariant value (Deref value ': effects) a + -> Evaluator Monovariant value effects a +runDeref = interpret handleDeref + +handleDeref :: ( Member NonDet effects + , Ord value + ) + => Deref value (Eff (Deref value ': effects)) a + -> Evaluator Monovariant value effects a +handleDeref (DerefCell cell) = traverse (foldMapA pure) (nonEmpty (toList cell)) +handleDeref (AssignCell value cell) = pure (Set.insert value cell) diff --git a/src/Data/Abstract/Address/Precise.hs b/src/Data/Abstract/Address/Precise.hs new file mode 100644 index 000000000..9159e79e6 --- /dev/null +++ b/src/Data/Abstract/Address/Precise.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE GADTs, TypeOperators, UndecidableInstances #-} +module Data.Abstract.Address.Precise +( Precise(..) +, runAllocator +, handleAllocator +, runDeref +, handleDeref +) where + +import Control.Abstract +import qualified Data.Set as Set +import Prologue + +-- | 'Precise' models precise store semantics where only the 'Latest' value is taken. Everything gets it's own address (always makes a new allocation) which makes for a larger store. +newtype Precise = Precise { unPrecise :: Int } + deriving (Eq, Ord) + +instance Show Precise where + showsPrec d = showsUnaryWith showsPrec "Precise" d . unPrecise + + +runAllocator :: ( Member Fresh effects + , PureEffects effects + ) + => Evaluator Precise value (Allocator Precise ': effects) a + -> Evaluator Precise value effects a +runAllocator = interpret handleAllocator + +handleAllocator :: Member Fresh effects => Allocator Precise (Eff (Allocator Precise ': effects)) a -> Evaluator Precise value effects a +handleAllocator (Alloc _) = Precise <$> fresh + +runDeref :: PureEffects effects + => Evaluator Precise value (Deref value ': effects) a + -> Evaluator Precise value effects a +runDeref = interpret handleDeref + +handleDeref :: Deref value (Eff (Deref value ': effects)) a -> Evaluator Precise value effects a +handleDeref (DerefCell cell) = pure (fst <$> Set.minView cell) +handleDeref (AssignCell value _) = pure (Set.singleton value) diff --git a/src/Data/Abstract/Environment.hs b/src/Data/Abstract/Environment.hs index f9e7ce90d..91f222e62 100644 --- a/src/Data/Abstract/Environment.hs +++ b/src/Data/Abstract/Environment.hs @@ -31,7 +31,7 @@ import Prelude hiding (head, lookup) import Prologue -- $setup --- >>> import Data.Abstract.Address +-- >>> import Data.Abstract.Address.Precise -- >>> let bright = push (insertEnv (name "foo") (Precise 0) lowerBound) -- >>> let shadowed = insertEnv (name "foo") (Precise 1) bright diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index a255758f7..e366c06ad 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -23,7 +23,7 @@ import Control.Abstract hiding (Load) import Control.Abstract.Context as X import Control.Abstract.Environment as X hiding (runEnvironmentError, runEnvironmentErrorWith) import Control.Abstract.Evaluator as X hiding (LoopControl(..), Return(..), catchLoopControl, runLoopControl, catchReturn, runReturn) -import Control.Abstract.Heap as X hiding (AddressError(..), runAddressError, runAddressErrorWith) +import Control.Abstract.Heap as X hiding (runAddressError, runAddressErrorWith) import Control.Abstract.Modules as X (Modules, ModuleResult, ResolutionError(..), load, lookupModule, listModulesInDir, require, resolve, throwResolutionError) import Control.Abstract.Value as X hiding (Function(..)) import Data.Abstract.Declarations as X @@ -48,22 +48,25 @@ class (Show1 constr, Foldable constr) => Evaluatable constr where eval :: ( AbstractValue address value effects , Declarations term , FreeVariables term - , Member (Allocator address value) effects - , Member (Deref address value) effects + , Member (Allocator address) effects + , Member (Deref value) effects , Member (Env address) effects , Member (Exc (LoopControl address)) effects , Member (Exc (Return address)) effects + , Member Fresh effects , Member (Function address value) effects , Member (Modules address) effects , Member (Reader ModuleInfo) effects , Member (Reader PackageInfo) effects , Member (Reader Span) effects + , Member (Resumable (BaseError (AddressError address value))) effects , Member (Resumable (BaseError (EnvironmentError address))) effects , Member (Resumable (BaseError (UnspecializedError value))) effects , Member (Resumable (BaseError EvalError)) effects , Member (Resumable (BaseError ResolutionError)) effects - , Member Fresh effects + , Member (State (Heap address value)) effects , Member Trace effects + , Ord address ) => SubtermAlgebra constr term (Evaluator address value effects (ValueRef address)) eval expr = do @@ -73,8 +76,6 @@ class (Show1 constr, Foldable constr) => Evaluatable constr where evaluate :: ( AbstractValue address value valueEffects - , Allocatable address (Reader ModuleInfo ': effects) - , Derefable address (Allocator address value ': Reader ModuleInfo ': effects) , Declarations term , Effects effects , Evaluatable (Base term) @@ -93,19 +94,19 @@ evaluate :: ( AbstractValue address value valueEffects , Member (Resumable (BaseError (UnspecializedError value))) effects , Member (State (Heap address value)) effects , Member Trace effects - , Ord value + , Ord address , Recursive term - , ValueRoots address value - , moduleEffects ~ (Exc (LoopControl address) ': Exc (Return address) ': Env address ': Deref address value ': Allocator address value ': Reader ModuleInfo ': effects) + , moduleEffects ~ (Exc (LoopControl address) ': Exc (Return address) ': Env address ': Deref value ': Allocator address ': Reader ModuleInfo ': effects) , valueEffects ~ (Function address value ': moduleEffects) ) => proxy lang -> (SubtermAlgebra Module term (TermEvaluator term address value moduleEffects address) -> SubtermAlgebra Module term (TermEvaluator term address value moduleEffects address)) -> (SubtermAlgebra (Base term) term (TermEvaluator term address value valueEffects (ValueRef address)) -> SubtermAlgebra (Base term) term (TermEvaluator term address value valueEffects (ValueRef address))) + -> (forall x . Evaluator address value (Deref value ': Allocator address ': Reader ModuleInfo ': effects) x -> Evaluator address value (Reader ModuleInfo ': effects) x) -> (forall x . Evaluator address value valueEffects x -> Evaluator address value moduleEffects x) -> [Module term] -> TermEvaluator term address value effects (ModuleTable (NonEmpty (Module (ModuleResult address)))) -evaluate lang analyzeModule analyzeTerm runValue modules = do +evaluate lang analyzeModule analyzeTerm runAllocDeref runValue modules = do (preludeBinds, _) <- TermEvaluator . runInModule lowerBound moduleInfoFromCallStack . runValue $ do definePrelude lang box unit @@ -124,8 +125,7 @@ evaluate lang analyzeModule analyzeTerm runValue modules = do runInModule preludeBinds info = runReader info - . runAllocator - . runDeref + . runAllocDeref . runEnv (EvalContext Nothing (X.push (newEnv preludeBinds))) . runReturn . runLoopControl @@ -140,15 +140,18 @@ traceResolve name path = trace ("resolved " <> show name <> " -> " <> show path) class HasPrelude (language :: Language) where definePrelude :: ( AbstractValue address value effects , HasCallStack - , Member (Allocator address value) effects - , Member (Deref address value) effects + , Member (Allocator address) effects + , Member (Deref value) effects , Member (Env address) effects , Member Fresh effects , Member (Function address value) effects , Member (Reader ModuleInfo) effects , Member (Reader Span) effects + , Member (Resumable (BaseError (AddressError address value))) effects , Member (Resumable (BaseError (EnvironmentError address))) effects + , Member (State (Heap address value)) effects , Member Trace effects + , Ord address ) => proxy language -> Evaluator address value effects () @@ -185,8 +188,8 @@ instance HasPrelude 'JavaScript where class HasPostlude (language :: Language) where postlude :: ( AbstractValue address value effects , HasCallStack - , Member (Allocator address value) effects - , Member (Deref address value) effects + , Member (Allocator address) effects + , Member (Deref value) effects , Member (Env address) effects , Member Fresh effects , Member (Reader ModuleInfo) effects diff --git a/src/Data/Abstract/Value/Abstract.hs b/src/Data/Abstract/Value/Abstract.hs index 3c854cf4a..94d52fced 100644 --- a/src/Data/Abstract/Value/Abstract.hs +++ b/src/Data/Abstract/Value/Abstract.hs @@ -5,6 +5,7 @@ module Data.Abstract.Value.Abstract ) where import Control.Abstract as Abstract +import Data.Abstract.BaseError import Data.Abstract.Environment as Env import Prologue @@ -12,11 +13,16 @@ data Abstract = Abstract deriving (Eq, Ord, Show) -runFunction :: ( Member (Allocator address Abstract) effects - , Member (Deref address Abstract) effects +runFunction :: ( Member (Allocator address) effects + , Member (Deref Abstract) effects , Member (Env address) effects , Member (Exc (Return address)) effects , Member Fresh effects + , Member (Reader ModuleInfo) effects + , Member (Reader Span) effects + , Member (Resumable (BaseError (AddressError address Abstract))) effects + , Member (State (Heap address Abstract)) effects + , Ord address , PureEffects effects ) => Evaluator address Abstract (Function address Abstract ': effects) a @@ -53,9 +59,12 @@ instance AbstractIntro Abstract where kvPair _ _ = Abstract null = Abstract -instance ( Member (Allocator address Abstract) effects - , Member NonDet effects +instance ( Member (Allocator address) effects + , Member (Deref Abstract) effects , Member Fresh effects + , Member NonDet effects + , Member (State (Heap address Abstract)) effects + , Ord address ) => AbstractValue address Abstract effects where array _ = pure Abstract diff --git a/src/Data/Abstract/Value/Concrete.hs b/src/Data/Abstract/Value/Concrete.hs index 58e487f10..8e45b71d6 100644 --- a/src/Data/Abstract/Value/Concrete.hs +++ b/src/Data/Abstract/Value/Concrete.hs @@ -61,14 +61,18 @@ instance Ord address => ValueRoots address (Value address body) where | otherwise = mempty -runFunction :: ( Member (Allocator address (Value address body)) effects +runFunction :: ( Member (Allocator address) effects + , Member (Deref (Value address body)) effects , Member (Env address) effects , Member (Exc (Return address)) effects , Member Fresh effects , Member (Reader ModuleInfo) effects , Member (Reader PackageInfo) effects , Member (Reader Span) effects + , Member (Resumable (BaseError (AddressError address (Value address body)))) effects , Member (Resumable (BaseError (ValueError address body))) effects + , Member (State (Heap address (Value address body))) effects + , Ord address , PureEffects effects ) => (body address -> Evaluator address (Value address body) (Abstract.Function address (Value address body) ': effects) address) @@ -111,7 +115,12 @@ instance Show address => AbstractIntro (Value address body) where null = Null -materializeEnvironment :: ( Member (Deref address (Value address body)) effects +materializeEnvironment :: ( Member (Deref (Value address body)) effects + , Member (Reader ModuleInfo) effects + , Member (Reader Span) effects + , Member (Resumable (BaseError (AddressError address (Value address body)))) effects + , Member (State (Heap address (Value address body))) effects + , Ord address ) => Value address body -> Evaluator address (Value address body) effects (Maybe (Environment address)) @@ -135,8 +144,8 @@ materializeEnvironment val = do -- | Construct a 'Value' wrapping the value arguments (if any). instance ( Coercible body (Eff effects) - , Member (Allocator address (Value address body)) effects - , Member (Deref address (Value address body)) effects + , Member (Allocator address) effects + , Member (Deref (Value address body)) effects , Member (Env address) effects , Member (Exc (LoopControl address)) effects , Member (Exc (Return address)) effects @@ -145,6 +154,9 @@ instance ( Coercible body (Eff effects) , Member (Reader PackageInfo) effects , Member (Reader Span) effects , Member (Resumable (BaseError (ValueError address body))) effects + , Member (Resumable (BaseError (AddressError address (Value address body)))) effects + , Member (State (Heap address (Value address body))) effects + , Ord address , Show address ) => AbstractValue address (Value address body) effects where diff --git a/src/Data/Abstract/Value/Type.hs b/src/Data/Abstract/Value/Type.hs index 7224088ed..34ebe22d9 100644 --- a/src/Data/Abstract/Value/Type.hs +++ b/src/Data/Abstract/Value/Type.hs @@ -228,15 +228,18 @@ instance Ord address => ValueRoots address Type where valueRoots _ = mempty -runFunction :: ( Member (Allocator address Type) effects - , Member (Deref address Type) effects +runFunction :: ( Member (Allocator address) effects + , Member (Deref Type) effects , Member (Env address) effects , Member (Exc (Return address)) effects , Member Fresh effects , Member (Reader ModuleInfo) effects , Member (Reader Span) effects , Member (Resumable (BaseError TypeError)) effects + , Member (Resumable (BaseError (AddressError address Type))) effects + , Member (State (Heap address Type)) effects , Member (State TypeMap) effects + , Ord address , PureEffects effects ) => Evaluator address Type (Abstract.Function address Type ': effects) a @@ -277,14 +280,17 @@ instance AbstractIntro Type where null = Null -- | Discard the value arguments (if any), constructing a 'Type' instead. -instance ( Member (Allocator address Type) effects - , Member (Deref address Type) effects +instance ( Member (Allocator address) effects + , Member (Deref Type) effects , Member Fresh effects , Member NonDet effects , Member (Reader ModuleInfo) effects , Member (Reader Span) effects + , Member (Resumable (BaseError (AddressError address Type))) effects , Member (Resumable (BaseError TypeError)) effects + , Member (State (Heap address Type)) effects , Member (State TypeMap) effects + , Ord address ) => AbstractValue address Type effects where array fields = do diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index 726547d25..9cf201ef7 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -51,14 +51,17 @@ resolvePHPName n = do toName = T.unpack . dropRelativePrefix . stripQuotes include :: ( AbstractValue address value effects - , Member (Deref address value) effects + , Member (Deref value) effects , Member (Env address) effects , Member (Modules address) effects , Member (Reader ModuleInfo) effects , Member (Reader Span) effects + , Member (Resumable (BaseError (AddressError address value))) effects , Member (Resumable (BaseError ResolutionError)) effects , Member (Resumable (BaseError (EnvironmentError address))) effects + , Member (State (Heap address value)) effects , Member Trace effects + , Ord address ) => Subterm term (Evaluator address value effects (ValueRef address)) -> (ModulePath -> Evaluator address value effects (ModuleResult address)) diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index efc3829cb..575531f27 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -156,9 +156,12 @@ instance Evaluatable Import where -- Evaluate a qualified import evalQualifiedImport :: ( AbstractValue address value effects - , Member (Allocator address value) effects + , Member (Allocator address) effects + , Member (Deref value) effects , Member (Env address) effects , Member (Modules address) effects + , Member (State (Heap address value)) effects + , Ord address ) => Name -> ModulePath -> Evaluator address value effects value evalQualifiedImport name path = letrec' name $ \addr -> do diff --git a/src/Language/TypeScript/Resolution.hs b/src/Language/TypeScript/Resolution.hs index 479c57313..1d44d6c84 100644 --- a/src/Language/TypeScript/Resolution.hs +++ b/src/Language/TypeScript/Resolution.hs @@ -164,9 +164,12 @@ javascriptExtensions :: [String] javascriptExtensions = ["js"] evalRequire :: ( AbstractValue address value effects - , Member (Allocator address value) effects + , Member (Allocator address) effects + , Member (Deref value) effects , Member (Env address) effects , Member (Modules address) effects + , Member (State (Heap address value)) effects + , Ord address ) => M.ModulePath -> Name diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 4cbb05a2e..8cade6f6a 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -29,7 +29,10 @@ import Analysis.Abstract.Caching import Analysis.Abstract.Collecting import Analysis.Abstract.Graph as Graph import Control.Abstract -import Data.Abstract.Address +import Data.Abstract.Address.Hole as Hole +import Data.Abstract.Address.Located as Located +import Data.Abstract.Address.Monovariant as Monovariant +import Data.Abstract.Address.Precise as Precise import Data.Abstract.BaseError (BaseError(..)) import Data.Abstract.Evaluatable import Data.Abstract.Module @@ -114,7 +117,10 @@ runCallGraph lang includePackages modules package = do . providingLiveSet . runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult (Hole (Maybe Name) (Located Monovariant))))))) . raiseHandler (runModules (ModuleTable.modulePaths (packageModules package))) - extractGraph <$> runEvaluator (runGraphAnalysis (evaluate lang analyzeModule analyzeTerm Abstract.runFunction modules)) + runAddressEffects + = Hole.runAllocator (Located.handleAllocator Monovariant.handleAllocator) + . Hole.runDeref (Located.handleDeref Monovariant.handleDeref) + extractGraph <$> runEvaluator (runGraphAnalysis (evaluate lang analyzeModule analyzeTerm runAddressEffects Abstract.runFunction modules)) runImportGraphToModuleInfos :: forall effs lang term. ( Declarations term @@ -181,15 +187,18 @@ runImportGraph lang (package :: Package term) f = . runTermEvaluator @_ @_ @(Value (Hole (Maybe Name) Precise) (ImportGraphEff (Hole (Maybe Name) Precise) effs)) . runReader (packageInfo package) . runReader lowerBound - in extractGraph <$> runEvaluator (runImportGraphAnalysis (evaluate lang analyzeModule id (Concrete.runFunction coerce coerce) (ModuleTable.toPairs (packageModules package) >>= toList . snd))) + runAddressEffects + = Hole.runAllocator Precise.handleAllocator + . Hole.runDeref Precise.handleDeref + in extractGraph <$> runEvaluator (runImportGraphAnalysis (evaluate lang analyzeModule id runAddressEffects (Concrete.runFunction coerce coerce) (ModuleTable.toPairs (packageModules package) >>= toList . snd))) newtype ImportGraphEff address outerEffects a = ImportGraphEff { runImportGraphEff :: Eff ( Function address (Value address (ImportGraphEff address outerEffects)) ': Exc (LoopControl address) ': Exc (Return address) ': Env address - ': Deref address (Value address (ImportGraphEff address outerEffects)) - ': Allocator address (Value address (ImportGraphEff address outerEffects)) + ': Deref (Value address (ImportGraphEff address outerEffects)) + ': Allocator address ': Reader ModuleInfo ': Reader Span ': Reader PackageInfo diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 92df73fad..04082522a 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -9,7 +9,8 @@ import Analysis.Abstract.Collecting import Control.Abstract import Control.Exception (displayException) import Control.Monad.Effect.Trace (runPrintingTrace) -import Data.Abstract.Address +import Data.Abstract.Address.Monovariant as Monovariant +import Data.Abstract.Address.Precise as Precise import Data.Abstract.BaseError (BaseError(..)) import Data.Abstract.Evaluatable import Data.Abstract.Module @@ -57,8 +58,8 @@ newtype UtilEff a = UtilEff , Exc (LoopControl Precise) , Exc (Return Precise) , Env Precise - , Deref Precise (Value Precise UtilEff) - , Allocator Precise (Value Precise UtilEff) + , Deref (Value Precise UtilEff) + , Allocator Precise , Reader ModuleInfo , Modules Precise , Reader (ModuleTable (NonEmpty (Module (ModuleResult Precise)))) @@ -130,7 +131,7 @@ evaluateProject' (TaskConfig config logger statter) proxy parser paths = either (runReader (lowerBound @Span) (runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult Precise))))) (raiseHandler (runModules (ModuleTable.modulePaths (packageModules package))) - (evaluate proxy id withTermSpans (Concrete.runFunction coerce coerce) modules)))))) + (evaluate proxy id withTermSpans (Precise.runAllocator . Precise.runDeref) (Concrete.runFunction coerce coerce) modules)))))) evaluateProjectWithCaching proxy parser path = runTaskWithOptions debugOptions $ do @@ -141,7 +142,7 @@ evaluateProjectWithCaching proxy parser path = runTaskWithOptions debugOptions $ (runReader (lowerBound @Span) (runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult Monovariant))))) (raiseHandler (runModules (ModuleTable.modulePaths (packageModules package))) - (evaluate proxy id withTermSpans Type.runFunction modules))))) + (evaluate proxy id withTermSpans (Monovariant.runAllocator . Monovariant.runDeref) Type.runFunction modules))))) parseFile :: Parser term -> FilePath -> IO term diff --git a/test/Control/Abstract/Evaluator/Spec.hs b/test/Control/Abstract/Evaluator/Spec.hs index 3cd59656c..d95937524 100644 --- a/test/Control/Abstract/Evaluator/Spec.hs +++ b/test/Control/Abstract/Evaluator/Spec.hs @@ -5,6 +5,7 @@ module Control.Abstract.Evaluator.Spec ) where import Control.Abstract +import Data.Abstract.Address.Precise as Precise import Data.Abstract.BaseError import Data.Abstract.Module import qualified Data.Abstract.Number as Number @@ -42,8 +43,8 @@ evaluate . runValueError . runEnvironmentError . runAddressError - . runDeref - . runAllocator @Precise @_ @Val + . Precise.runDeref @_ @Val + . Precise.runAllocator . (>>= deref . snd) . runEnv lowerBound . runReturn @@ -59,8 +60,8 @@ newtype SpecEff a = SpecEff , Exc (LoopControl Precise) , Exc (Return Precise) , Env Precise - , Allocator Precise Val - , Deref Precise Val + , Allocator Precise + , Deref Val , Resumable (BaseError (AddressError Precise Val)) , Resumable (BaseError (EnvironmentError Precise)) , Resumable (BaseError (ValueError Precise SpecEff)) diff --git a/test/Doctests.hs b/test/Doctests.hs index 8aa098b51..22218bc8e 100644 --- a/test/Doctests.hs +++ b/test/Doctests.hs @@ -6,7 +6,7 @@ import System.Environment import Test.DocTest defaultFiles = - [ "src/Data/Abstract/Address.hs" + [ "src/Data/Abstract/Address/Precise.hs" , "src/Data/Abstract/Environment.hs" , "src/Data/Abstract/Name.hs" , "src/Data/Graph.hs" diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs index c3c47b8b7..f2abdaa00 100644 --- a/test/SpecHelpers.hs +++ b/test/SpecHelpers.hs @@ -22,7 +22,7 @@ import Control.Abstract import Control.Arrow ((&&&)) import Control.Monad.Effect.Trace as X (runIgnoringTrace, runReturningTrace) import Control.Monad ((>=>)) -import Data.Abstract.Address as X +import Data.Abstract.Address.Precise as X import Data.Abstract.Environment as Env import Data.Abstract.Evaluatable import Data.Abstract.FreeVariables as X