From 6e5a2aeb9c2aaa75c0a6a3209597a4721703aabc Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 17 Jul 2018 13:59:11 -0400 Subject: [PATCH 01/26] Rename the AddressError constructors. --- src/Control/Abstract/Heap.hs | 10 +++++----- src/Semantic/Graph.hs | 4 ++-- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index 16cfcab93..1aeb42fb5 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -170,7 +170,7 @@ runAllocator :: ( Addressable address effects -> Evaluator address value effects a runAllocator = interpret $ \ eff -> case eff of Alloc name -> allocCell name - Deref addr -> heapLookup addr <$> get >>= maybeM (throwResumable (UnallocatedAddress addr)) >>= derefCell addr >>= maybeM (throwResumable (UninitializedAddress addr)) + Deref addr -> heapLookup addr <$> get >>= maybeM (throwResumable (Unallocated addr)) >>= derefCell addr >>= maybeM (throwResumable (Uninitialized addr)) Assign addr value -> modifyHeap (heapInsert addr value) GC roots -> modifyHeap (heapRestrict <*> reachable roots) @@ -182,16 +182,16 @@ instance Effect (Allocator address value) where data AddressError address value resume where - UnallocatedAddress :: address -> AddressError address value (Cell address value) - UninitializedAddress :: address -> AddressError address value value + Unallocated :: address -> AddressError address value (Cell address value) + Uninitialized :: address -> AddressError address value value deriving instance Eq address => Eq (AddressError address value resume) deriving instance Show address => Show (AddressError address value resume) instance Show address => Show1 (AddressError address value) where liftShowsPrec _ _ = showsPrec instance Eq address => Eq1 (AddressError address value) where - liftEq _ (UninitializedAddress a) (UninitializedAddress b) = a == b - liftEq _ (UnallocatedAddress a) (UnallocatedAddress b) = a == b + liftEq _ (Uninitialized a) (Uninitialized b) = a == b + liftEq _ (Unallocated a) (Unallocated b) = a == b liftEq _ _ _ = False diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 130f28f25..534dcdc9e 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -231,8 +231,8 @@ resumingUnspecialized = runUnspecializedWith (\ err@(Unspecialized _) -> trace ( resumingAddressError :: (AbstractHole value, Lower (Cell address value), Member Trace effects, Show address, Effects effects) => Evaluator address value (Resumable (AddressError address value) ': effects) a -> Evaluator address value effects a resumingAddressError = runAddressErrorWith (\ err -> trace ("AddressError: " <> prettyShow err) *> case err of - UnallocatedAddress _ -> pure lowerBound - UninitializedAddress _ -> pure hole) + Unallocated _ -> pure lowerBound + Uninitialized _ -> pure hole) resumingValueError :: (Member Trace effects, Show address, Effects effects) => Evaluator address (Value address body) (Resumable (ValueError address body) ': effects) a -> Evaluator address (Value address body) effects a resumingValueError = runValueErrorWith (\ err -> trace ("ValueError: " <> prettyShow err) *> case err of From 2c96cdf378785fd29e29180a0cd639c0da1ae9a8 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 17 Jul 2018 14:00:22 -0400 Subject: [PATCH 02/26] Align the fields. --- 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 534dcdc9e..e2c3b2472 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -231,7 +231,7 @@ resumingUnspecialized = runUnspecializedWith (\ err@(Unspecialized _) -> trace ( resumingAddressError :: (AbstractHole value, Lower (Cell address value), Member Trace effects, Show address, Effects effects) => Evaluator address value (Resumable (AddressError address value) ': effects) a -> Evaluator address value effects a resumingAddressError = runAddressErrorWith (\ err -> trace ("AddressError: " <> prettyShow err) *> case err of - Unallocated _ -> pure lowerBound + Unallocated _ -> pure lowerBound Uninitialized _ -> pure hole) resumingValueError :: (Member Trace effects, Show address, Effects effects) => Evaluator address (Value address body) (Resumable (ValueError address body) ': effects) a -> Evaluator address (Value address body) effects a From 27a81eb8783403e9d8c3bb7ae59aece401c9432f Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 17 Jul 2018 14:01:02 -0400 Subject: [PATCH 03/26] Reformat resumingAddressError. --- src/Semantic/Graph.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index e2c3b2472..5d4e9e886 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -230,9 +230,9 @@ resumingUnspecialized :: (Member Trace effects, AbstractHole value, Effects effe resumingUnspecialized = runUnspecializedWith (\ err@(Unspecialized _) -> trace ("Unspecialized: " <> prettyShow err) $> hole) resumingAddressError :: (AbstractHole value, Lower (Cell address value), Member Trace effects, Show address, Effects effects) => Evaluator address value (Resumable (AddressError address value) ': effects) a -> Evaluator address value effects a -resumingAddressError = runAddressErrorWith (\ err -> trace ("AddressError: " <> prettyShow err) *> case err of +resumingAddressError = runAddressErrorWith $ \ err -> trace ("AddressError: " <> prettyShow err) *> case err of Unallocated _ -> pure lowerBound - Uninitialized _ -> pure hole) + Uninitialized _ -> pure hole resumingValueError :: (Member Trace effects, Show address, Effects effects) => Evaluator address (Value address body) (Resumable (ValueError address body) ': effects) a -> Evaluator address (Value address body) effects a resumingValueError = runValueErrorWith (\ err -> trace ("ValueError: " <> prettyShow err) *> case err of From 52b41bb0c4fce856a71ea5a321bf2f9483435ce1 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 17 Jul 2018 15:05:08 -0400 Subject: [PATCH 04/26] Give Hole an extra parameter for context about errors. --- src/Analysis/Abstract/Graph.hs | 10 +++++----- src/Control/Abstract/Addressable.hs | 6 +++--- src/Control/Abstract/Hole.hs | 14 ++++++++------ src/Semantic/Graph.hs | 8 ++++---- 4 files changed, 20 insertions(+), 18 deletions(-) diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs index 5d5640845..aae5252c5 100644 --- a/src/Analysis/Abstract/Graph.hs +++ b/src/Analysis/Abstract/Graph.hs @@ -47,12 +47,12 @@ style = (defaultStyle (T.encodeUtf8Builder . vertexName)) -- | Add vertices to the graph for evaluated identifiers. graphingTerms :: ( Element Syntax.Identifier syntax , Member (Reader ModuleInfo) effects - , Member (Env (Hole (Located address))) effects + , Member (Env (Hole context (Located address))) effects , Member (State (Graph Vertex)) effects , Base term ~ TermF (Sum syntax) ann ) - => SubtermAlgebra (Base term) term (TermEvaluator term (Hole (Located address)) value effects a) - -> SubtermAlgebra (Base term) term (TermEvaluator term (Hole (Located address)) value effects a) + => SubtermAlgebra (Base term) term (TermEvaluator term (Hole context (Located address)) value effects a) + -> SubtermAlgebra (Base term) term (TermEvaluator term (Hole context (Located address)) value effects a) graphingTerms recur term@(In _ syntax) = do case project syntax of Just (Syntax.Identifier name) -> do @@ -128,11 +128,11 @@ moduleInclusion v = do appendGraph (vertex (moduleVertex m) `connect` vertex v) -- | Add an edge from the passed variable name to the module it originated within. -variableDefinition :: ( Member (Env (Hole (Located address))) effects +variableDefinition :: ( Member (Env (Hole context (Located address))) effects , Member (State (Graph Vertex)) effects ) => Name - -> TermEvaluator term (Hole (Located address)) value effects () + -> TermEvaluator term (Hole context (Located address)) value effects () variableDefinition name = do graph <- maybe lowerBound (maybe lowerBound (vertex . moduleVertex . addressModule) . toMaybe) <$> TermEvaluator (lookupEnv name) appendGraph (vertex (Variable (formatName name)) `connect` graph) diff --git a/src/Control/Abstract/Addressable.hs b/src/Control/Abstract/Addressable.hs index a995af468..6dcc4eae6 100644 --- a/src/Control/Abstract/Addressable.hs +++ b/src/Control/Abstract/Addressable.hs @@ -40,12 +40,12 @@ instance (Addressable address effects, Member (Reader ModuleInfo) effects, Membe allocCell name = relocate (Located <$> allocCell name <*> currentPackage <*> currentModule) derefCell (Located loc _ _) = relocate . derefCell loc -instance Addressable address effects => Addressable (Hole address) effects where - type Cell (Hole address) = Cell address +instance (Addressable address effects, Ord context, Show context) => Addressable (Hole context address) effects where + type Cell (Hole context address) = Cell address allocCell name = relocate (Total <$> allocCell name) derefCell (Total loc) = relocate . derefCell loc - derefCell Partial = const (pure Nothing) + 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/Hole.hs b/src/Control/Abstract/Hole.hs index 04ada8531..5103d441a 100644 --- a/src/Control/Abstract/Hole.hs +++ b/src/Control/Abstract/Hole.hs @@ -1,15 +1,17 @@ module Control.Abstract.Hole where +import Prologue + class AbstractHole a where hole :: a -data Hole a = Partial | Total a +data Hole context a = Partial context | Total a deriving (Foldable, Functor, Eq, Ord, Show, Traversable) -instance AbstractHole (Hole a) where - hole = Partial +instance Lower context => AbstractHole (Hole context a) where + hole = Partial lowerBound -toMaybe :: Hole a -> Maybe a -toMaybe Partial = Nothing -toMaybe (Total a) = Just a +toMaybe :: Hole context a -> Maybe a +toMaybe (Partial _) = Nothing +toMaybe (Total a) = Just a diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 5d4e9e886..4075479bf 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -92,7 +92,7 @@ runCallGraph lang includePackages modules package = do analyzeModule = (if includePackages then graphingPackages else id) . convergingModules . graphingModules extractGraph (_, (_, (graph, _))) = simplify graph runGraphAnalysis - = runState (lowerBound @(Heap (Hole (Located Monovariant)) All Abstract)) + = runState (lowerBound @(Heap (Hole () (Located Monovariant)) All Abstract)) . runFresh 0 . resumingLoadError . resumingUnspecialized @@ -100,13 +100,13 @@ runCallGraph lang includePackages modules package = do . resumingEvalError . resumingResolutionError . resumingAddressError - . runTermEvaluator @_ @(Hole (Located Monovariant)) @Abstract + . runTermEvaluator @_ @(Hole () (Located Monovariant)) @Abstract . graphing . caching @[] . runReader (packageInfo package) . runReader (lowerBound @Span) . providingLiveSet - . runReader (lowerBound @(ModuleTable (NonEmpty (Module (Environment (Hole (Located Monovariant)), Hole (Located Monovariant)))))) + . runReader (lowerBound @(ModuleTable (NonEmpty (Module (Environment (Hole () (Located Monovariant)), Hole () (Located Monovariant)))))) . raiseHandler (runModules (ModuleTable.modulePaths (packageModules package))) extractGraph <$> runEvaluator (runGraphAnalysis (evaluate lang analyzeModule analyzeTerm modules)) @@ -146,7 +146,7 @@ runImportGraph lang (package :: Package term) . runState lowerBound . runReader lowerBound . runModules (ModuleTable.modulePaths (packageModules package)) - . runTermEvaluator @_ @_ @(Value (Hole Precise) (ImportGraphEff term (Hole Precise) effs)) + . runTermEvaluator @_ @_ @(Value (Hole () Precise) (ImportGraphEff term (Hole () Precise) effs)) . runReader (packageInfo package) . runReader lowerBound in extractGraph <$> runEvaluator (runImportGraphAnalysis (evaluate @_ @_ @_ @_ @term lang analyzeModule id (ModuleTable.toPairs (packageModules package) >>= toList . snd))) From f213204a20c94bef82e24867dc600fc33eafc776 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 17 Jul 2018 15:11:52 -0400 Subject: [PATCH 05/26] Holes-as-addresses can be contextualized. --- src/Semantic/Graph.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 4075479bf..290d40e11 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -92,7 +92,7 @@ runCallGraph lang includePackages modules package = do analyzeModule = (if includePackages then graphingPackages else id) . convergingModules . graphingModules extractGraph (_, (_, (graph, _))) = simplify graph runGraphAnalysis - = runState (lowerBound @(Heap (Hole () (Located Monovariant)) All Abstract)) + = runState (lowerBound @(Heap (Hole (Maybe Name) (Located Monovariant)) All Abstract)) . runFresh 0 . resumingLoadError . resumingUnspecialized @@ -100,13 +100,13 @@ runCallGraph lang includePackages modules package = do . resumingEvalError . resumingResolutionError . resumingAddressError - . runTermEvaluator @_ @(Hole () (Located Monovariant)) @Abstract + . runTermEvaluator @_ @(Hole (Maybe Name) (Located Monovariant)) @Abstract . graphing . caching @[] . runReader (packageInfo package) . runReader (lowerBound @Span) . providingLiveSet - . runReader (lowerBound @(ModuleTable (NonEmpty (Module (Environment (Hole () (Located Monovariant)), Hole () (Located Monovariant)))))) + . runReader (lowerBound @(ModuleTable (NonEmpty (Module (Environment (Hole (Maybe Name) (Located Monovariant)), Hole (Maybe Name) (Located Monovariant)))))) . raiseHandler (runModules (ModuleTable.modulePaths (packageModules package))) extractGraph <$> runEvaluator (runGraphAnalysis (evaluate lang analyzeModule analyzeTerm modules)) @@ -146,7 +146,7 @@ runImportGraph lang (package :: Package term) . runState lowerBound . runReader lowerBound . runModules (ModuleTable.modulePaths (packageModules package)) - . runTermEvaluator @_ @_ @(Value (Hole () Precise) (ImportGraphEff term (Hole () Precise) effs)) + . runTermEvaluator @_ @_ @(Value (Hole (Maybe Name) Precise) (ImportGraphEff term (Hole (Maybe Name) Precise) effs)) . runReader (packageInfo package) . runReader lowerBound in extractGraph <$> runEvaluator (runImportGraphAnalysis (evaluate @_ @_ @_ @_ @term lang analyzeModule id (ModuleTable.toPairs (packageModules package) >>= toList . snd))) From aae736ba4c0b64a0409fa0b1e00c2723945f7abe Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 17 Jul 2018 15:20:36 -0400 Subject: [PATCH 06/26] =?UTF-8?q?Don=E2=80=99t=20compute=20lists=20of=20fr?= =?UTF-8?q?ee=20names.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Semantic/Graph.hs | 11 ++++------- 1 file changed, 4 insertions(+), 7 deletions(-) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 290d40e11..604d188af 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -27,7 +27,6 @@ import Analysis.Abstract.Caching import Analysis.Abstract.Collecting import Analysis.Abstract.Graph as Graph import Control.Abstract -import Control.Monad.Effect (reinterpret) import Data.Abstract.Address import Data.Abstract.Evaluatable import Data.Abstract.Module @@ -90,7 +89,7 @@ runCallGraph :: ( HasField ann Span runCallGraph lang includePackages modules package = do let analyzeTerm = withTermSpans . graphingTerms . cachingTerms analyzeModule = (if includePackages then graphingPackages else id) . convergingModules . graphingModules - extractGraph (_, (_, (graph, _))) = simplify graph + extractGraph (_, (graph, _)) = simplify graph runGraphAnalysis = runState (lowerBound @(Heap (Hole (Maybe Name) (Located Monovariant)) All Abstract)) . runFresh 0 @@ -130,7 +129,7 @@ runImportGraph lang (package :: Package term) | [m :| []] <- toList (packageModules package) = vertex m <$ trace ("single module, skipping import graph computation for " <> modulePath (moduleInfo m)) | otherwise = let analyzeModule = graphingModuleInfo - extractGraph (_, (_, (graph, _))) = do + extractGraph (_, (graph, _)) = do info <- graph maybe lowerBound (foldMap vertex) (ModuleTable.lookup (modulePath info) (packageModules package)) runImportGraphAnalysis @@ -250,10 +249,8 @@ resumingValueError = runValueErrorWith (\ err -> trace ("ValueError: " <> pretty KeyValueError{} -> pure (hole, hole) ArithmeticError{} -> pure hole) -resumingEnvironmentError :: (AbstractHole address, Effects effects) => Evaluator address value (Resumable (EnvironmentError address) ': effects) a -> Evaluator address value effects ([Name], a) -resumingEnvironmentError - = runState [] - . reinterpret (\ (Resumable (FreeVariable name)) -> modify' (name :) $> hole) +resumingEnvironmentError :: (AbstractHole address, Effects effects) => Evaluator address value (Resumable (EnvironmentError address) ': effects) a -> Evaluator address value effects a +resumingEnvironmentError = interpret (\ (Resumable (FreeVariable _)) -> pure hole) resumingTypeError :: ( Alternative (m address Type (State TypeMap ': effects)) , Effects effects From 1900507609707c8eb423325e12fb3f86d132ebeb Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 17 Jul 2018 15:22:01 -0400 Subject: [PATCH 07/26] resumingEnvironmentError contextualizes holes with names. --- src/Semantic/Graph.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 604d188af..36854e703 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -249,8 +249,8 @@ resumingValueError = runValueErrorWith (\ err -> trace ("ValueError: " <> pretty KeyValueError{} -> pure (hole, hole) ArithmeticError{} -> pure hole) -resumingEnvironmentError :: (AbstractHole address, Effects effects) => Evaluator address value (Resumable (EnvironmentError address) ': effects) a -> Evaluator address value effects a -resumingEnvironmentError = interpret (\ (Resumable (FreeVariable _)) -> pure hole) +resumingEnvironmentError :: Effects effects => Evaluator (Hole (Maybe Name) address) value (Resumable (EnvironmentError (Hole (Maybe Name) address)) ': effects) a -> Evaluator (Hole (Maybe Name) address) value effects a +resumingEnvironmentError = interpret (\ (Resumable (FreeVariable name)) -> pure (Partial (Just name))) resumingTypeError :: ( Alternative (m address Type (State TypeMap ': effects)) , Effects effects From 41b9fd65ca8ae9ea1ae9ebf239363540db20a101 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 17 Jul 2018 15:36:58 -0400 Subject: [PATCH 08/26] Specialize caching to []. --- src/Analysis/Abstract/Caching.hs | 4 ++-- src/Semantic/Graph.hs | 2 +- src/Semantic/Util.hs | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Analysis/Abstract/Caching.hs b/src/Analysis/Abstract/Caching.hs index 481f50a1d..a9ded9d3f 100644 --- a/src/Analysis/Abstract/Caching.hs +++ b/src/Analysis/Abstract/Caching.hs @@ -125,8 +125,8 @@ scatter :: (Foldable t, Member NonDet effects, Member (State (Heap address (Cell scatter = foldMapA (\ (Cached value heap') -> TermEvaluator (putHeap heap') $> value) -caching :: (Alternative f, Effects effects) => TermEvaluator term address value (NonDet ': Reader (Cache term address (Cell address) value) ': State (Cache term address (Cell address) value) ': effects) a -> TermEvaluator term address value effects (Cache term address (Cell address) value, f a) +caching :: Effects effects => TermEvaluator term address value (NonDet ': Reader (Cache term address (Cell address) value) ': State (Cache term address (Cell address) value) ': effects) a -> TermEvaluator term address value effects (Cache term address (Cell address) value, [a]) caching = runState lowerBound . runReader lowerBound - . runNonDetA + . runNonDet diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 36854e703..6840cae22 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -101,7 +101,7 @@ runCallGraph lang includePackages modules package = do . resumingAddressError . runTermEvaluator @_ @(Hole (Maybe Name) (Located Monovariant)) @Abstract . graphing - . caching @[] + . caching . runReader (packageInfo package) . runReader (lowerBound @Span) . providingLiveSet diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index a524d78fe..89f45f70e 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -82,7 +82,7 @@ checking . runFresh 0 . runPrintingTrace . runTermEvaluator @_ @Monovariant @Type - . caching @[] + . caching . providingLiveSet . fmap reassociate . runLoadError From 12772247958fdcb34d319f3a2a5990d7a275a946 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 17 Jul 2018 15:48:17 -0400 Subject: [PATCH 09/26] Define resumingEnvironmentError using runResumableWith. --- 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 6840cae22..9e6c3cc29 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -250,7 +250,7 @@ resumingValueError = runValueErrorWith (\ err -> trace ("ValueError: " <> pretty ArithmeticError{} -> pure hole) resumingEnvironmentError :: Effects effects => Evaluator (Hole (Maybe Name) address) value (Resumable (EnvironmentError (Hole (Maybe Name) address)) ': effects) a -> Evaluator (Hole (Maybe Name) address) value effects a -resumingEnvironmentError = interpret (\ (Resumable (FreeVariable name)) -> pure (Partial (Just name))) +resumingEnvironmentError = runResumableWith (\ (FreeVariable name) -> pure (Partial (Just name))) resumingTypeError :: ( Alternative (m address Type (State TypeMap ': effects)) , Effects effects From 0aa964f2c7f75501569e5c23162b89855f6bbffe Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 17 Jul 2018 16:04:41 -0400 Subject: [PATCH 10/26] Generalize resumingLoadError over the Effectful context. --- 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 9e6c3cc29..87d2d9582 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -213,7 +213,7 @@ resumingResolutionError = runResolutionErrorWith (\ err -> trace ("ResolutionErr NotFoundError nameToResolve _ _ -> pure nameToResolve GoImportError pathToResolve -> pure [pathToResolve]) -resumingLoadError :: (Member Trace effects, AbstractHole address, Effects effects) => Evaluator address value (Resumable (LoadError address) ': effects) a -> Evaluator address value effects a +resumingLoadError :: (AbstractHole address, Effectful (m address value), Effects effects, Functor (m address value effects), Member Trace effects) => m address value (Resumable (LoadError address) ': effects) a -> m address value effects a resumingLoadError = runLoadErrorWith (\ (ModuleNotFound path) -> trace ("LoadError: " <> path) $> (lowerBound, hole)) resumingEvalError :: (Member Fresh effects, Member Trace effects, Effects effects) => Evaluator address value (Resumable EvalError ': effects) a -> Evaluator address value effects a From f9a2c5724103ad96e19a2ebdde7e744fb74947ac Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 17 Jul 2018 16:05:36 -0400 Subject: [PATCH 11/26] Generalize resumingEvalError over the Effectful context. --- 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 87d2d9582..5f7e620d5 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -216,7 +216,7 @@ resumingResolutionError = runResolutionErrorWith (\ err -> trace ("ResolutionErr resumingLoadError :: (AbstractHole address, Effectful (m address value), Effects effects, Functor (m address value effects), Member Trace effects) => m address value (Resumable (LoadError address) ': effects) a -> m address value effects a resumingLoadError = runLoadErrorWith (\ (ModuleNotFound path) -> trace ("LoadError: " <> path) $> (lowerBound, hole)) -resumingEvalError :: (Member Fresh effects, Member Trace effects, Effects effects) => Evaluator address value (Resumable EvalError ': effects) a -> Evaluator address value effects a +resumingEvalError :: (Applicative (m effects), Effectful m, Effects effects, Member Fresh effects, Member Trace effects) => m (Resumable EvalError ': effects) a -> m effects a resumingEvalError = runEvalErrorWith (\ err -> trace ("EvalError:" <> prettyShow err) *> case err of DefaultExportError{} -> pure () ExportError{} -> pure () From a99c360b0cff799bd6f39defab93614116fef58d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 17 Jul 2018 16:06:33 -0400 Subject: [PATCH 12/26] Generalize resumingUnspecialized over the Effectful context. --- 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 5f7e620d5..45122237b 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -225,7 +225,7 @@ resumingEvalError = runEvalErrorWith (\ err -> trace ("EvalError:" <> prettyShow RationalFormatError{} -> pure 0 NoNameError -> gensym) -resumingUnspecialized :: (Member Trace effects, AbstractHole value, Effects effects) => Evaluator address value (Resumable (Unspecialized value) ': effects) a -> Evaluator address value effects a +resumingUnspecialized :: (AbstractHole value, Effectful (m value), Effects effects, Functor (m value effects), Member Trace effects) => m value (Resumable (Unspecialized value) ': effects) a -> m value effects a resumingUnspecialized = runUnspecializedWith (\ err@(Unspecialized _) -> trace ("Unspecialized: " <> prettyShow err) $> hole) resumingAddressError :: (AbstractHole value, Lower (Cell address value), Member Trace effects, Show address, Effects effects) => Evaluator address value (Resumable (AddressError address value) ': effects) a -> Evaluator address value effects a From 0d352ed1218258072f61471ff99c82aa95fd54c0 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 17 Jul 2018 16:07:38 -0400 Subject: [PATCH 13/26] Generalize resumingAddressError over the Effectful context. --- 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 45122237b..22d5be069 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -228,7 +228,7 @@ resumingEvalError = runEvalErrorWith (\ err -> trace ("EvalError:" <> prettyShow resumingUnspecialized :: (AbstractHole value, Effectful (m value), Effects effects, Functor (m value effects), Member Trace effects) => m value (Resumable (Unspecialized value) ': effects) a -> m value effects a resumingUnspecialized = runUnspecializedWith (\ err@(Unspecialized _) -> trace ("Unspecialized: " <> prettyShow err) $> hole) -resumingAddressError :: (AbstractHole value, Lower (Cell address value), Member Trace effects, Show address, Effects effects) => Evaluator address value (Resumable (AddressError address value) ': effects) a -> Evaluator address value effects a +resumingAddressError :: (AbstractHole value, Applicative (m address value effects), Effectful (m address value), Effects effects, Lower (Cell address value), Member Trace effects, Show address) => m address value (Resumable (AddressError address value) ': effects) a -> m address value effects a resumingAddressError = runAddressErrorWith $ \ err -> trace ("AddressError: " <> prettyShow err) *> case err of Unallocated _ -> pure lowerBound Uninitialized _ -> pure hole From f1d6080fdbbdb6c722ea37c9d796cd839e0ffd4a Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 17 Jul 2018 16:08:41 -0400 Subject: [PATCH 14/26] Generalize resumingValueError over the Effectful context. --- 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 22d5be069..7db2351cc 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -233,7 +233,7 @@ resumingAddressError = runAddressErrorWith $ \ err -> trace ("AddressError: " <> Unallocated _ -> pure lowerBound Uninitialized _ -> pure hole -resumingValueError :: (Member Trace effects, Show address, Effects effects) => Evaluator address (Value address body) (Resumable (ValueError address body) ': effects) a -> Evaluator address (Value address body) effects a +resumingValueError :: (Applicative (m address (Value address body) effects), Effectful (m address (Value address body)), Effects effects, Member Trace effects, Show address) => m address (Value address body) (Resumable (ValueError address body) ': effects) a -> m address (Value address body) effects a resumingValueError = runValueErrorWith (\ err -> trace ("ValueError: " <> prettyShow err) *> case err of CallError val -> pure val StringError val -> pure (pack (prettyShow val)) From cecc4e895a3c372d0ff53fab63330958fdf98069 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 17 Jul 2018 16:09:31 -0400 Subject: [PATCH 15/26] Generalize resumingEnvironmentError over the Effectful context. --- 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 7db2351cc..6b2bd1a6a 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -249,7 +249,7 @@ resumingValueError = runValueErrorWith (\ err -> trace ("ValueError: " <> pretty KeyValueError{} -> pure (hole, hole) ArithmeticError{} -> pure hole) -resumingEnvironmentError :: Effects effects => Evaluator (Hole (Maybe Name) address) value (Resumable (EnvironmentError (Hole (Maybe Name) address)) ': effects) a -> Evaluator (Hole (Maybe Name) address) value effects a +resumingEnvironmentError :: (Applicative (m (Hole (Maybe Name) address) value effects), Effectful (m (Hole (Maybe Name) address) value), Effects effects) => m (Hole (Maybe Name) address) value (Resumable (EnvironmentError (Hole (Maybe Name) address)) ': effects) a -> m (Hole (Maybe Name) address) value effects a resumingEnvironmentError = runResumableWith (\ (FreeVariable name) -> pure (Partial (Just name))) resumingTypeError :: ( Alternative (m address Type (State TypeMap ': effects)) From 9856ea7d77dbbe9411f2fceb4e2caecc528378ee Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 17 Jul 2018 16:14:56 -0400 Subject: [PATCH 16/26] Move runTermEvaluator up to the top. --- src/Semantic/Graph.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 6b2bd1a6a..203e32829 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -91,7 +91,8 @@ runCallGraph lang includePackages modules package = do analyzeModule = (if includePackages then graphingPackages else id) . convergingModules . graphingModules extractGraph (_, (graph, _)) = simplify graph runGraphAnalysis - = runState (lowerBound @(Heap (Hole (Maybe Name) (Located Monovariant)) All Abstract)) + = runTermEvaluator @_ @(Hole (Maybe Name) (Located Monovariant)) @Abstract + . runState (lowerBound @(Heap (Hole (Maybe Name) (Located Monovariant)) All Abstract)) . runFresh 0 . resumingLoadError . resumingUnspecialized @@ -99,7 +100,6 @@ runCallGraph lang includePackages modules package = do . resumingEvalError . resumingResolutionError . resumingAddressError - . runTermEvaluator @_ @(Hole (Maybe Name) (Located Monovariant)) @Abstract . graphing . caching . runReader (packageInfo package) From ae462ac8da323f74060717787a14af044eba9193 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 17 Jul 2018 16:16:28 -0400 Subject: [PATCH 17/26] Cache above the graph. --- src/Semantic/Graph.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 203e32829..8a94f6aca 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -89,7 +89,7 @@ runCallGraph :: ( HasField ann Span runCallGraph lang includePackages modules package = do let analyzeTerm = withTermSpans . graphingTerms . cachingTerms analyzeModule = (if includePackages then graphingPackages else id) . convergingModules . graphingModules - extractGraph (_, (graph, _)) = simplify graph + extractGraph (_, (_, pairs)) = simplify (foldMap fst pairs) runGraphAnalysis = runTermEvaluator @_ @(Hole (Maybe Name) (Located Monovariant)) @Abstract . runState (lowerBound @(Heap (Hole (Maybe Name) (Located Monovariant)) All Abstract)) @@ -100,8 +100,8 @@ runCallGraph lang includePackages modules package = do . resumingEvalError . resumingResolutionError . resumingAddressError - . graphing . caching + . graphing . runReader (packageInfo package) . runReader (lowerBound @Span) . providingLiveSet From 921627c61a66188d090104e9e19a0e2f876073a0 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 17 Jul 2018 16:17:11 -0400 Subject: [PATCH 18/26] Cache above the heap. --- src/Semantic/Graph.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 8a94f6aca..1e52d0e3b 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -89,9 +89,10 @@ runCallGraph :: ( HasField ann Span runCallGraph lang includePackages modules package = do let analyzeTerm = withTermSpans . graphingTerms . cachingTerms analyzeModule = (if includePackages then graphingPackages else id) . convergingModules . graphingModules - extractGraph (_, (_, pairs)) = simplify (foldMap fst pairs) + extractGraph (_, pairs) = simplify (foldMap (fst . snd) pairs) runGraphAnalysis = runTermEvaluator @_ @(Hole (Maybe Name) (Located Monovariant)) @Abstract + . caching . runState (lowerBound @(Heap (Hole (Maybe Name) (Located Monovariant)) All Abstract)) . runFresh 0 . resumingLoadError @@ -100,7 +101,6 @@ runCallGraph lang includePackages modules package = do . resumingEvalError . resumingResolutionError . resumingAddressError - . caching . graphing . runReader (packageInfo package) . runReader (lowerBound @Span) From 376ba5bb484ef749e04c0c02f712a6ed1a5f152d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 17 Jul 2018 16:25:00 -0400 Subject: [PATCH 19/26] Move graphing back outside caching. --- src/Semantic/Graph.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 1e52d0e3b..6d04fc270 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -89,9 +89,10 @@ runCallGraph :: ( HasField ann Span runCallGraph lang includePackages modules package = do let analyzeTerm = withTermSpans . graphingTerms . cachingTerms analyzeModule = (if includePackages then graphingPackages else id) . convergingModules . graphingModules - extractGraph (_, pairs) = simplify (foldMap (fst . snd) pairs) + extractGraph (graph, _) = simplify graph runGraphAnalysis = runTermEvaluator @_ @(Hole (Maybe Name) (Located Monovariant)) @Abstract + . graphing . caching . runState (lowerBound @(Heap (Hole (Maybe Name) (Located Monovariant)) All Abstract)) . runFresh 0 @@ -101,7 +102,6 @@ runCallGraph lang includePackages modules package = do . resumingEvalError . resumingResolutionError . resumingAddressError - . graphing . runReader (packageInfo package) . runReader (lowerBound @Span) . providingLiveSet From e131347600d1a05508f8289abca0387117d825ee Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 18 Jul 2018 12:59:26 -0400 Subject: [PATCH 20/26] Return the load order, not the terms. --- src/Semantic/Util.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 89f45f70e..82940df2a 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -109,7 +109,7 @@ callGraphRubyProject paths = runTaskWithOptions debugOptions $ do package <- parsePackage rubyParser (Project (takeDirectory (maybe "/" fst (uncons paths))) blobs lang []) modules <- topologicalSort <$> runImportGraph proxy package x <- runCallGraph proxy False modules package - pure (x, modules) + pure (x, (() <$) <$> modules) -- Evaluate a project consisting of the listed paths. From 692a0d00a3a95cdbcb1fe14827ffbea86df7d3c9 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 19 Jul 2018 12:06:39 -0400 Subject: [PATCH 21/26] Revert "Rename the AddressError constructors." This reverts commit 3a787ea1ad0ac17468470a3bb709c1916492e846. --- src/Control/Abstract/Heap.hs | 10 +++++----- src/Semantic/Graph.hs | 4 ++-- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index 1aeb42fb5..16cfcab93 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -170,7 +170,7 @@ runAllocator :: ( Addressable address effects -> Evaluator address value effects a runAllocator = interpret $ \ eff -> case eff of Alloc name -> allocCell name - Deref addr -> heapLookup addr <$> get >>= maybeM (throwResumable (Unallocated addr)) >>= derefCell addr >>= maybeM (throwResumable (Uninitialized addr)) + Deref addr -> heapLookup addr <$> get >>= maybeM (throwResumable (UnallocatedAddress addr)) >>= derefCell addr >>= maybeM (throwResumable (UninitializedAddress addr)) Assign addr value -> modifyHeap (heapInsert addr value) GC roots -> modifyHeap (heapRestrict <*> reachable roots) @@ -182,16 +182,16 @@ instance Effect (Allocator address value) where data AddressError address value resume where - Unallocated :: address -> AddressError address value (Cell address value) - Uninitialized :: address -> AddressError address value value + UnallocatedAddress :: address -> AddressError address value (Cell address value) + UninitializedAddress :: address -> AddressError address value value deriving instance Eq address => Eq (AddressError address value resume) deriving instance Show address => Show (AddressError address value resume) instance Show address => Show1 (AddressError address value) where liftShowsPrec _ _ = showsPrec instance Eq address => Eq1 (AddressError address value) where - liftEq _ (Uninitialized a) (Uninitialized b) = a == b - liftEq _ (Unallocated a) (Unallocated b) = a == b + liftEq _ (UninitializedAddress a) (UninitializedAddress b) = a == b + liftEq _ (UnallocatedAddress a) (UnallocatedAddress b) = a == b liftEq _ _ _ = False diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 6d04fc270..ebbe1f783 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -230,8 +230,8 @@ resumingUnspecialized = runUnspecializedWith (\ err@(Unspecialized _) -> trace ( resumingAddressError :: (AbstractHole value, Applicative (m address value effects), Effectful (m address value), Effects effects, Lower (Cell address value), Member Trace effects, Show address) => m address value (Resumable (AddressError address value) ': effects) a -> m address value effects a resumingAddressError = runAddressErrorWith $ \ err -> trace ("AddressError: " <> prettyShow err) *> case err of - Unallocated _ -> pure lowerBound - Uninitialized _ -> pure hole + UnallocatedAddress _ -> pure lowerBound + UninitializedAddress _ -> pure hole resumingValueError :: (Applicative (m address (Value address body) effects), Effectful (m address (Value address body)), Effects effects, Member Trace effects, Show address) => m address (Value address body) (Resumable (ValueError address body) ': effects) a -> m address (Value address body) effects a resumingValueError = runValueErrorWith (\ err -> trace ("ValueError: " <> prettyShow err) *> case err of From 0c2f5b44d61611ccca280ce4825422738e28003b Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 19 Jul 2018 13:15:44 -0400 Subject: [PATCH 22/26] Define a disjunction operation on values. --- src/Control/Abstract/Value.hs | 2 ++ src/Data/Abstract/Value/Abstract.hs | 1 + src/Data/Abstract/Value/Concrete.hs | 5 +++++ src/Data/Abstract/Value/Type.hs | 3 +++ 4 files changed, 11 insertions(+) diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index 2d3e8a487..6178326db 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -124,6 +124,8 @@ class (AbstractFunction address value effects, AbstractIntro value) => AbstractV -- | Eliminate boolean values. TODO: s/boolean/truthy ifthenelse :: value -> Evaluator address value effects a -> Evaluator address value effects a -> Evaluator address value effects a + disjunction :: Evaluator address value effects value -> Evaluator address value effects value -> Evaluator address value effects value + -- | @index x i@ computes @x[i]@, with zero-indexing. index :: value -> value -> Evaluator address value effects address diff --git a/src/Data/Abstract/Value/Abstract.hs b/src/Data/Abstract/Value/Abstract.hs index 3a4561fc4..e61b2d0d2 100644 --- a/src/Data/Abstract/Value/Abstract.hs +++ b/src/Data/Abstract/Value/Abstract.hs @@ -67,6 +67,7 @@ instance ( Member (Allocator address Abstract) effects index _ _ = box Abstract ifthenelse _ if' else' = if' <|> else' + disjunction = (<|>) liftNumeric _ _ = pure Abstract liftNumeric2 _ _ _ = pure Abstract diff --git a/src/Data/Abstract/Value/Concrete.hs b/src/Data/Abstract/Value/Concrete.hs index 394037f81..56d1a7709 100644 --- a/src/Data/Abstract/Value/Concrete.hs +++ b/src/Data/Abstract/Value/Concrete.hs @@ -145,6 +145,11 @@ instance ( Coercible body (Eff effects) bool <- case cond of { Boolean b -> pure b ; _ -> throwValueError (BoolError cond) } if bool then if' else else' + disjunction a b = do + a' <- a + ifthenelse a' (pure a') b + + index = go where tryIdx list ii | ii > genericLength list = box =<< throwValueError (BoundsError list ii) diff --git a/src/Data/Abstract/Value/Type.hs b/src/Data/Abstract/Value/Type.hs index a7b594c38..16ee6a3e7 100644 --- a/src/Data/Abstract/Value/Type.hs +++ b/src/Data/Abstract/Value/Type.hs @@ -293,6 +293,9 @@ instance ( Member (Allocator address Type) effects box (Var field) ifthenelse cond if' else' = unify cond Bool *> (if' <|> else') + disjunction a b = do + a' <- a + unify a' Bool *> (pure a' <|> b) liftNumeric _ = unify (Int :+ Float :+ Rational) liftNumeric2 _ left right = case (left, right) of From 3eac88bce956bb635653c87db4a11f1d169831eb Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 19 Jul 2018 13:17:21 -0400 Subject: [PATCH 23/26] Evaluate Or as disjunction. --- src/Data/Syntax/Expression.hs | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs index aa042a0b4..da84a5a6b 100644 --- a/src/Data/Syntax/Expression.hs +++ b/src/Data/Syntax/Expression.hs @@ -223,10 +223,7 @@ instance Ord1 Or where liftCompare = genericLiftCompare instance Show1 Or where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Or where - eval t = rvalBox =<< go (fmap subtermValue t) where - go (Or a b) = do - cond <- a - ifthenelse cond (pure cond) b + eval (Or a b) = disjunction (subtermValue a) (subtermValue b) >>= rvalBox data And a = And { lhs :: a, rhs :: a } deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable, Named1, Message1) From bdd75e6e7c7c616b8841e388cbd2ad3e449bfb96 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Thu, 19 Jul 2018 14:45:04 -0400 Subject: [PATCH 24/26] Add export lists to modules missing them. --- semantic.cabal | 3 +-- src/Control/Abstract/Hole.hs | 6 +++++- src/Control/Abstract/Primitive.hs | 9 ++++++++- src/Data/AST.hs | 7 ++++++- src/Data/Abstract/Address.hs | 8 +++++++- src/Data/Abstract/Cache.hs | 10 +++++++++- src/Data/Abstract/Configuration.hs | 2 +- src/Data/Abstract/Declarations.hs | 5 ++++- src/Data/Abstract/FreeVariables.hs | 5 ++++- src/Data/Abstract/Heap.hs | 10 +++++++++- src/Data/Abstract/Live.hs | 12 +++++++++++- src/Data/Abstract/Package.hs | 7 ++++++- src/Data/Abstract/Path.hs | 6 +++++- src/Data/Abstract/Ref.hs | 5 ++++- src/Data/Abstract/Value/Abstract.hs | 2 +- src/Data/Abstract/Value/Concrete.hs | 9 ++++++++- src/Data/Graph/Vertex.hs | 6 +++--- src/Data/Language.hs | 9 ++++++++- src/Data/Mergeable.hs | 2 +- src/Data/Options.hs | 1 - src/Data/Record.hs | 7 ++++++- src/Data/SplitDiff.hs | 8 ++++---- src/Data/Syntax.hs | 2 +- src/Data/Syntax/Comment.hs | 1 + src/Data/Syntax/Declaration.hs | 1 + src/Data/Syntax/Directive.hs | 1 + src/Data/Syntax/Expression.hs | 1 + src/Data/Syntax/Literal.hs | 1 + src/Data/Syntax/Statement.hs | 1 + src/Data/Syntax/Type.hs | 1 + src/Diffing/Algorithm.hs | 15 ++++++++++++++- src/Language/Go/Grammar.hs | 1 + src/Language/Go/Syntax.hs | 1 + src/Language/Go/Type.hs | 1 + src/Language/Haskell/Grammar.hs | 1 + src/Language/Haskell/Syntax.hs | 1 + src/Language/JSON/Grammar.hs | 1 + src/Language/Java/Grammar.hs | 1 + src/Language/Java/Syntax.hs | 1 + src/Language/Markdown/Syntax.hs | 1 + src/Language/PHP/Grammar.hs | 1 + src/Language/PHP/Syntax.hs | 1 + src/Language/Python/Grammar.hs | 1 + src/Language/Python/Syntax.hs | 1 + src/Language/Ruby/Grammar.hs | 1 + src/Language/Ruby/Syntax.hs | 1 + src/Language/TypeScript/Grammar.hs | 1 + src/Language/TypeScript/Syntax.hs | 1 + src/Semantic/AST.hs | 8 +++++++- src/Semantic/Config.hs | 13 ++++++++++++- src/Semantic/Diff.hs | 8 +++++++- src/Semantic/Env.hs | 5 ++++- src/Semantic/Graph.hs | 2 +- src/Semantic/Parse.hs | 7 ++++++- src/Semantic/Resolution.hs | 7 ++++++- src/Semantic/Telemetry/Haystack.hs | 8 +++++++- src/Semantic/Telemetry/Log.hs | 10 +++++++++- src/Semantic/Util.hs | 2 +- src/Semantic/Version.hs | 5 ++++- 59 files changed, 214 insertions(+), 41 deletions(-) delete mode 100644 src/Data/Options.hs diff --git a/semantic.cabal b/semantic.cabal index 7d8a91c71..533a8efe0 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -83,7 +83,6 @@ library , Data.Language , Data.Map.Monoidal , Data.Mergeable - , Data.Options , Data.Patch , Data.Project , Data.Range @@ -251,7 +250,7 @@ library if flag(release) ghc-options: -Wall -Werror -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -O1 -j else - ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -O0 -j + ghc-options: -Wall -Werror -Wmissing-export-lists -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -O0 -j ghc-prof-options: -fprof-auto executable semantic diff --git a/src/Control/Abstract/Hole.hs b/src/Control/Abstract/Hole.hs index 04ada8531..d1636c726 100644 --- a/src/Control/Abstract/Hole.hs +++ b/src/Control/Abstract/Hole.hs @@ -1,4 +1,8 @@ -module Control.Abstract.Hole where +module Control.Abstract.Hole + ( AbstractHole (..) + , Hole (..) + , toMaybe + ) where class AbstractHole a where hole :: a diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 969a87a1b..49c45a633 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -1,4 +1,11 @@ -module Control.Abstract.Primitive where +module Control.Abstract.Primitive + ( define + , defineClass + , defineNamespace + , builtInPrint + , builtInExport + , lambda + ) where import Control.Abstract.Context import Control.Abstract.Environment diff --git a/src/Data/AST.hs b/src/Data/AST.hs index 38af9fc15..79e0e8c62 100644 --- a/src/Data/AST.hs +++ b/src/Data/AST.hs @@ -1,5 +1,10 @@ {-# LANGUAGE DataKinds #-} -module Data.AST where +module Data.AST + ( Node (..) + , AST + , Location + , nodeLocation + ) where import Data.Range import Data.Record diff --git a/src/Data/Abstract/Address.hs b/src/Data/Abstract/Address.hs index cb87676fb..b9205a51a 100644 --- a/src/Data/Abstract/Address.hs +++ b/src/Data/Abstract/Address.hs @@ -1,5 +1,11 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-} -module Data.Abstract.Address where +module Data.Abstract.Address + ( Precise (..) + , Located (..) + , Latest (..) + , All (..) + , Monovariant (..) + ) where import Data.Abstract.Module (ModuleInfo) import Data.Abstract.Name diff --git a/src/Data/Abstract/Cache.hs b/src/Data/Abstract/Cache.hs index 78bd3ab25..0696016b7 100644 --- a/src/Data/Abstract/Cache.hs +++ b/src/Data/Abstract/Cache.hs @@ -1,5 +1,13 @@ {-# LANGUAGE ConstraintKinds, GeneralizedNewtypeDeriving, TypeFamilies #-} -module Data.Abstract.Cache where +module Data.Abstract.Cache + ( Cache + , Cached (..) + , Cacheable + , cacheLookup + , cacheSet + , cacheInsert + , cacheKeys + ) where import Data.Abstract.Configuration import Data.Abstract.Heap diff --git a/src/Data/Abstract/Configuration.hs b/src/Data/Abstract/Configuration.hs index 0d2f89471..7c5ca44ee 100644 --- a/src/Data/Abstract/Configuration.hs +++ b/src/Data/Abstract/Configuration.hs @@ -1,4 +1,4 @@ -module Data.Abstract.Configuration where +module Data.Abstract.Configuration ( Configuration (..) ) where import Data.Abstract.Environment import Data.Abstract.Heap diff --git a/src/Data/Abstract/Declarations.hs b/src/Data/Abstract/Declarations.hs index b304f146b..494db37e0 100644 --- a/src/Data/Abstract/Declarations.hs +++ b/src/Data/Abstract/Declarations.hs @@ -1,5 +1,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, UndecidableInstances #-} -module Data.Abstract.Declarations where +module Data.Abstract.Declarations + ( Declarations (..) + , Declarations1 (..) + ) where import Data.Abstract.Name import Data.Sum diff --git a/src/Data/Abstract/FreeVariables.hs b/src/Data/Abstract/FreeVariables.hs index 80a96e2e8..0010904e2 100644 --- a/src/Data/Abstract/FreeVariables.hs +++ b/src/Data/Abstract/FreeVariables.hs @@ -1,5 +1,8 @@ {-# LANGUAGE DefaultSignatures, GeneralizedNewtypeDeriving, UndecidableInstances #-} -module Data.Abstract.FreeVariables where +module Data.Abstract.FreeVariables + ( FreeVariables (..) + , FreeVariables1 (..) + ) where import Data.Abstract.Name import Data.Sum diff --git a/src/Data/Abstract/Heap.hs b/src/Data/Abstract/Heap.hs index 6fbd7cc19..956be461f 100644 --- a/src/Data/Abstract/Heap.hs +++ b/src/Data/Abstract/Heap.hs @@ -1,5 +1,13 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} -module Data.Abstract.Heap where +module Data.Abstract.Heap + ( Heap + , heapLookup + , heapLookupAll + , heapInsert + , heapInit + , heapSize + , heapRestrict + ) where import Data.Abstract.Live import qualified Data.Map.Monoidal as Monoidal diff --git a/src/Data/Abstract/Live.hs b/src/Data/Abstract/Live.hs index af922f17f..b7140ecda 100644 --- a/src/Data/Abstract/Live.hs +++ b/src/Data/Abstract/Live.hs @@ -1,5 +1,15 @@ {-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators #-} -module Data.Abstract.Live where +module Data.Abstract.Live + ( Live (..) + , fromAddresses + , liveSingleton + , liveInsert + , liveDelete + , liveDifference + , liveMember + , liveSplit + , liveMap + ) where import Data.Set as Set import Prologue diff --git a/src/Data/Abstract/Package.hs b/src/Data/Abstract/Package.hs index 38136f0c9..529599b16 100644 --- a/src/Data/Abstract/Package.hs +++ b/src/Data/Abstract/Package.hs @@ -1,4 +1,9 @@ -module Data.Abstract.Package where +module Data.Abstract.Package + ( Package (..) + , PackageInfo (..) + , PackageName + , Data.Abstract.Package.fromModules + ) where import Data.Abstract.Module import Data.Abstract.ModuleTable as ModuleTable diff --git a/src/Data/Abstract/Path.hs b/src/Data/Abstract/Path.hs index 54faa28c1..47b96ec2b 100644 --- a/src/Data/Abstract/Path.hs +++ b/src/Data/Abstract/Path.hs @@ -1,4 +1,8 @@ -module Data.Abstract.Path where +module Data.Abstract.Path + ( dropRelativePrefix + , joinPaths + , stripQuotes + ) where import Prologue import qualified Data.Text as T diff --git a/src/Data/Abstract/Ref.hs b/src/Data/Abstract/Ref.hs index 96e38ae79..72cad84f9 100644 --- a/src/Data/Abstract/Ref.hs +++ b/src/Data/Abstract/Ref.hs @@ -1,5 +1,8 @@ {-# LANGUAGE GADTs #-} -module Data.Abstract.Ref where +module Data.Abstract.Ref + ( ValueRef (..) + , Ref (..) + ) where import Data.Abstract.Name diff --git a/src/Data/Abstract/Value/Abstract.hs b/src/Data/Abstract/Value/Abstract.hs index 3a4561fc4..f8376dab9 100644 --- a/src/Data/Abstract/Value/Abstract.hs +++ b/src/Data/Abstract/Value/Abstract.hs @@ -1,5 +1,5 @@ {-# LANGUAGE GADTs, UndecidableInstances #-} -module Data.Abstract.Value.Abstract where +module Data.Abstract.Value.Abstract ( Abstract (..) ) where import Control.Abstract import Data.Abstract.Environment as Env diff --git a/src/Data/Abstract/Value/Concrete.hs b/src/Data/Abstract/Value/Concrete.hs index 394037f81..605e51d5a 100644 --- a/src/Data/Abstract/Value/Concrete.hs +++ b/src/Data/Abstract/Value/Concrete.hs @@ -1,5 +1,12 @@ {-# LANGUAGE GADTs, RankNTypes, TypeOperators, UndecidableInstances, LambdaCase #-} -module Data.Abstract.Value.Concrete where +module Data.Abstract.Value.Concrete + ( Value (..) + , ValueError (..) + , ClosureBody (..) + , runValueError + , runValueErrorWith + , throwValueError + ) where import Control.Abstract import Data.Abstract.Environment (Environment, Bindings) diff --git a/src/Data/Graph/Vertex.hs b/src/Data/Graph/Vertex.hs index c42071cd9..98d997e81 100644 --- a/src/Data/Graph/Vertex.hs +++ b/src/Data/Graph/Vertex.hs @@ -6,14 +6,14 @@ module Data.Graph.Vertex , vertexToType ) where -import Prologue hiding (packageName) +import Prologue import Data.Aeson import qualified Data.Text as T import Data.Abstract.Module (ModuleInfo (..)) import Data.Abstract.Name -import Data.Abstract.Package (PackageInfo (..)) +import Data.Abstract.Package hiding (Package (Package)) -- | A vertex of some specific type. data Vertex @@ -23,7 +23,7 @@ data Vertex deriving (Eq, Ord, Show, Generic, Hashable) packageVertex :: PackageInfo -> Vertex -packageVertex = Package . formatName . packageName +packageVertex = Package . formatName . Data.Abstract.Package.packageName moduleVertex :: ModuleInfo -> Vertex moduleVertex = Module . T.pack . modulePath diff --git a/src/Data/Language.hs b/src/Data/Language.hs index 1b2e4586e..58f6c21f0 100644 --- a/src/Data/Language.hs +++ b/src/Data/Language.hs @@ -1,5 +1,12 @@ {-# LANGUAGE DeriveAnyClass, DeriveGeneric, LambdaCase #-} -module Data.Language where +module Data.Language + ( Language (..) + , ensureLanguage + , extensionsForLanguage + , knownLanguage + , languageForFilePath + , languageForType + ) where import Data.Aeson import Data.Char (toUpper) diff --git a/src/Data/Mergeable.hs b/src/Data/Mergeable.hs index d9b5c63fe..9dbcef29b 100644 --- a/src/Data/Mergeable.hs +++ b/src/Data/Mergeable.hs @@ -1,5 +1,5 @@ {-# LANGUAGE DefaultSignatures, TypeOperators, UndecidableInstances #-} -module Data.Mergeable where +module Data.Mergeable ( Mergeable (..) ) where import Control.Applicative import Data.Functor.Identity diff --git a/src/Data/Options.hs b/src/Data/Options.hs deleted file mode 100644 index fe942341c..000000000 --- a/src/Data/Options.hs +++ /dev/null @@ -1 +0,0 @@ -module Data.Options where diff --git a/src/Data/Record.hs b/src/Data/Record.hs index 60902815f..761c2473c 100644 --- a/src/Data/Record.hs +++ b/src/Data/Record.hs @@ -1,5 +1,10 @@ {-# LANGUAGE ConstraintKinds, DataKinds, GADTs, KindSignatures, MultiParamTypeClasses, TypeFamilies, TypeOperators, UndecidableInstances #-} -module Data.Record where +module Data.Record + ( Record (..) + , HasField (..) + , rhead + , rtail + ) where import Data.Aeson import Data.JSON.Fields diff --git a/src/Data/SplitDiff.hs b/src/Data/SplitDiff.hs index 3bf57d28f..0c040f3bd 100644 --- a/src/Data/SplitDiff.hs +++ b/src/Data/SplitDiff.hs @@ -1,4 +1,7 @@ -module Data.SplitDiff where +module Data.SplitDiff + ( SplitPatch (..) + , getRange + ) where import Control.Monad.Free import Data.Range @@ -20,6 +23,3 @@ getRange diff = getField $ case diff of -- | A diff with only one side’s annotations. type SplitDiff syntax ann = Free (TermF syntax ann) (SplitPatch (Term syntax ann)) - -unSplit :: Functor syntax => SplitDiff syntax ann -> Term syntax ann -unSplit = iter Term . fmap splitTerm diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs index eef603e55..ac65c1498 100644 --- a/src/Data/Syntax.hs +++ b/src/Data/Syntax.hs @@ -1,5 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes, DeriveAnyClass, GADTs, TypeOperators, MultiParamTypeClasses, UndecidableInstances, ScopedTypeVariables, KindSignatures, RankNTypes, ConstraintKinds, GeneralizedNewtypeDeriving, DerivingStrategies #-} -{-# OPTIONS_GHC -Wno-redundant-constraints -fno-warn-orphans #-} -- For HasCallStack +{-# OPTIONS_GHC -Wno-missing-export-lists -Wno-redundant-constraints -fno-warn-orphans #-} -- For HasCallStack module Data.Syntax where import Data.Abstract.Evaluatable diff --git a/src/Data/Syntax/Comment.hs b/src/Data/Syntax/Comment.hs index ce7854c59..3cddf53c6 100644 --- a/src/Data/Syntax/Comment.hs +++ b/src/Data/Syntax/Comment.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Data.Syntax.Comment where import Data.Abstract.Evaluatable diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 8d0b52b2a..d0c752015 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Data.Syntax.Declaration where import qualified Data.Abstract.Environment as Env diff --git a/src/Data/Syntax/Directive.hs b/src/Data/Syntax/Directive.hs index 9fe5df02a..fdee4066d 100644 --- a/src/Data/Syntax/Directive.hs +++ b/src/Data/Syntax/Directive.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Data.Syntax.Directive where import Data.Abstract.Evaluatable diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs index aa042a0b4..35ac5b408 100644 --- a/src/Data/Syntax/Expression.hs +++ b/src/Data/Syntax/Expression.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances, DuplicateRecordFields #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Data.Syntax.Expression where import Data.Abstract.Evaluatable hiding (Member) diff --git a/src/Data/Syntax/Literal.hs b/src/Data/Syntax/Literal.hs index 386d8c9cb..93a19a7ba 100644 --- a/src/Data/Syntax/Literal.hs +++ b/src/Data/Syntax/Literal.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass, ViewPatterns, ScopedTypeVariables, DuplicateRecordFields #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Data.Syntax.Literal where import Data.Abstract.Evaluatable diff --git a/src/Data/Syntax/Statement.hs b/src/Data/Syntax/Statement.hs index 859a3a4d4..8813b79be 100644 --- a/src/Data/Syntax/Statement.hs +++ b/src/Data/Syntax/Statement.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass, ScopedTypeVariables, UndecidableInstances, ViewPatterns, DuplicateRecordFields #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Data.Syntax.Statement where import Data.Abstract.Evaluatable diff --git a/src/Data/Syntax/Type.hs b/src/Data/Syntax/Type.hs index fd1230229..882277e64 100644 --- a/src/Data/Syntax/Type.hs +++ b/src/Data/Syntax/Type.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DataKinds, DeriveAnyClass, DeriveGeneric, MultiParamTypeClasses, UndecidableInstances #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Data.Syntax.Type where import Data.Abstract.Evaluatable diff --git a/src/Diffing/Algorithm.hs b/src/Diffing/Algorithm.hs index db0af7633..bf82e1d0c 100644 --- a/src/Diffing/Algorithm.hs +++ b/src/Diffing/Algorithm.hs @@ -1,5 +1,18 @@ {-# LANGUAGE DefaultSignatures, GADTs, TypeOperators, UndecidableInstances #-} -module Diffing.Algorithm where +module Diffing.Algorithm + ( AlgorithmF (..) + , Algorithm + , Diffable (..) + , Equivalence (..) + , diff + , diffThese + , diffMaybe + , linearly + , byReplacing + , comparableTerms + , equivalentTerms + , algorithmForTerms + ) where import Control.Monad.Free.Freer import Data.Diff diff --git a/src/Language/Go/Grammar.hs b/src/Language/Go/Grammar.hs index a82ed955c..685bbe253 100644 --- a/src/Language/Go/Grammar.hs +++ b/src/Language/Go/Grammar.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Language.Go.Grammar where import Language.Haskell.TH diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index 3b217449c..b2a18ea52 100644 --- a/src/Language/Go/Syntax.hs +++ b/src/Language/Go/Syntax.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Language.Go.Syntax where import Data.Abstract.Evaluatable diff --git a/src/Language/Go/Type.hs b/src/Language/Go/Type.hs index e035737fb..167d769e0 100644 --- a/src/Language/Go/Type.hs +++ b/src/Language/Go/Type.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Language.Go.Type where import Prologue diff --git a/src/Language/Haskell/Grammar.hs b/src/Language/Haskell/Grammar.hs index 070d6bb3b..70074358b 100644 --- a/src/Language/Haskell/Grammar.hs +++ b/src/Language/Haskell/Grammar.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Language.Haskell.Grammar where import Language.Haskell.TH diff --git a/src/Language/Haskell/Syntax.hs b/src/Language/Haskell/Syntax.hs index 50b78fb11..05d668d68 100644 --- a/src/Language/Haskell/Syntax.hs +++ b/src/Language/Haskell/Syntax.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Language.Haskell.Syntax where import Data.Abstract.Evaluatable diff --git a/src/Language/JSON/Grammar.hs b/src/Language/JSON/Grammar.hs index 06b708cd3..17ee6f341 100644 --- a/src/Language/JSON/Grammar.hs +++ b/src/Language/JSON/Grammar.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Language.JSON.Grammar where import Language.Haskell.TH diff --git a/src/Language/Java/Grammar.hs b/src/Language/Java/Grammar.hs index 8d49da5e0..40eb06164 100644 --- a/src/Language/Java/Grammar.hs +++ b/src/Language/Java/Grammar.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Language.Java.Grammar where import Language.Haskell.TH diff --git a/src/Language/Java/Syntax.hs b/src/Language/Java/Syntax.hs index 8ffac8839..655551fd7 100644 --- a/src/Language/Java/Syntax.hs +++ b/src/Language/Java/Syntax.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Language.Java.Syntax where import Data.Abstract.Evaluatable diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs index ad0c76db7..bad66af9e 100644 --- a/src/Language/Markdown/Syntax.hs +++ b/src/Language/Markdown/Syntax.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Language.Markdown.Syntax where import Prologue hiding (Text) diff --git a/src/Language/PHP/Grammar.hs b/src/Language/PHP/Grammar.hs index 9c01dbdbe..75bca0580 100644 --- a/src/Language/PHP/Grammar.hs +++ b/src/Language/PHP/Grammar.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Language.PHP.Grammar where import Language.Haskell.TH diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index 38acf5460..24e3de0b1 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Language.PHP.Syntax where import Data.Abstract.Evaluatable diff --git a/src/Language/Python/Grammar.hs b/src/Language/Python/Grammar.hs index 6d22bc7bd..ed55fc12a 100644 --- a/src/Language/Python/Grammar.hs +++ b/src/Language/Python/Grammar.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Language.Python.Grammar where import Language.Haskell.TH diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index bb07c37f0..ec2739144 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Language.Python.Syntax where import Data.Abstract.Environment as Env diff --git a/src/Language/Ruby/Grammar.hs b/src/Language/Ruby/Grammar.hs index df4a5d1e6..440c3e163 100644 --- a/src/Language/Ruby/Grammar.hs +++ b/src/Language/Ruby/Grammar.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Language.Ruby.Grammar where import Language.Haskell.TH diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index a3fbc2480..a8d2c75df 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass, DuplicateRecordFields, TupleSections #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Language.Ruby.Syntax where import Control.Monad (unless) diff --git a/src/Language/TypeScript/Grammar.hs b/src/Language/TypeScript/Grammar.hs index 5a1224981..385fbaf79 100644 --- a/src/Language/TypeScript/Grammar.hs +++ b/src/Language/TypeScript/Grammar.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Language.TypeScript.Grammar where import Language.Haskell.TH diff --git a/src/Language/TypeScript/Syntax.hs b/src/Language/TypeScript/Syntax.hs index ca4a201dc..b6a9fd3a4 100644 --- a/src/Language/TypeScript/Syntax.hs +++ b/src/Language/TypeScript/Syntax.hs @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveAnyClass, DuplicateRecordFields #-} +{-# OPTIONS_GHC -Wno-missing-export-lists #-} module Language.TypeScript.Syntax where import qualified Data.Abstract.Environment as Env diff --git a/src/Semantic/AST.hs b/src/Semantic/AST.hs index 20d40566a..4c5333a15 100644 --- a/src/Semantic/AST.hs +++ b/src/Semantic/AST.hs @@ -1,5 +1,11 @@ {-# LANGUAGE GADTs, RankNTypes #-} -module Semantic.AST where +module Semantic.AST + ( SomeAST (..) + , withSomeAST + , astParseBlob + , ASTFormat (..) + , runASTParse + ) where import Data.AST import Data.Blob diff --git a/src/Semantic/Config.hs b/src/Semantic/Config.hs index a65c71c6b..704248dfe 100644 --- a/src/Semantic/Config.hs +++ b/src/Semantic/Config.hs @@ -1,6 +1,17 @@ {-# LANGUAGE LambdaCase #-} -module Semantic.Config where +module Semantic.Config + ( Config (..) + , defaultConfig + , Options (..) + , defaultOptions + , debugOptions + , lookupStatsAddr + , withHaystackFromConfig + , withLoggerFromConfig + , withStatterFromConfig + , withTelemetry + ) where import Network.BSD import Network.HTTP.Client.TLS diff --git a/src/Semantic/Diff.hs b/src/Semantic/Diff.hs index 9e597f7bb..eb34fa5d6 100644 --- a/src/Semantic/Diff.hs +++ b/src/Semantic/Diff.hs @@ -1,5 +1,11 @@ {-# LANGUAGE ConstraintKinds, GADTs, RankNTypes, ScopedTypeVariables #-} -module Semantic.Diff where +module Semantic.Diff + ( runDiff + , runRubyDiff + , runTypeScriptDiff + , runJSONDiff + , diffBlobTOCPairs + ) where import Analysis.ConstructorName (ConstructorName) import Analysis.Declaration (HasDeclaration, declarationAlgebra) diff --git a/src/Semantic/Env.hs b/src/Semantic/Env.hs index f01e88a8b..6dc30aa38 100644 --- a/src/Semantic/Env.hs +++ b/src/Semantic/Env.hs @@ -1,4 +1,7 @@ -module Semantic.Env where +module Semantic.Env + ( envLookupInt + , envLookupString + ) where import Control.Monad.IO.Class import Prologue diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 130f28f25..cfa79e06a 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -35,7 +35,7 @@ import qualified Data.Abstract.ModuleTable as ModuleTable import Data.Abstract.Package as Package import Data.Abstract.Value.Abstract import Data.Abstract.Value.Type -import Data.Abstract.Value.Concrete (Value, ValueError (..), runValueErrorWith) +import Data.Abstract.Value.Concrete (Value,ValueError (..), runValueErrorWith) import Data.Graph import Data.Project import Data.Record diff --git a/src/Semantic/Parse.hs b/src/Semantic/Parse.hs index d8e2791ec..bb0184c40 100644 --- a/src/Semantic/Parse.hs +++ b/src/Semantic/Parse.hs @@ -1,5 +1,10 @@ {-# LANGUAGE GADTs, RankNTypes #-} -module Semantic.Parse where +module Semantic.Parse + ( runParse + , runRubyParse + , runTypeScriptParse + , runJSONParse + ) where import Analysis.ConstructorName (ConstructorName) import Analysis.Declaration (HasDeclaration, declarationAlgebra) diff --git a/src/Semantic/Resolution.hs b/src/Semantic/Resolution.hs index 62ed86246..a014ce2d9 100644 --- a/src/Semantic/Resolution.hs +++ b/src/Semantic/Resolution.hs @@ -1,5 +1,10 @@ {-# LANGUAGE ConstraintKinds, GADTs, KindSignatures, ScopedTypeVariables, TypeOperators, UndecidableInstances #-} -module Semantic.Resolution where +module Semantic.Resolution + ( Resolution (..) + , nodeJSResolutionMap + , resolutionMap + , runResolution + ) where import Control.Monad.Effect import Data.Aeson diff --git a/src/Semantic/Telemetry/Haystack.hs b/src/Semantic/Telemetry/Haystack.hs index 86706f636..463eed18e 100644 --- a/src/Semantic/Telemetry/Haystack.hs +++ b/src/Semantic/Telemetry/Haystack.hs @@ -1,4 +1,10 @@ -module Semantic.Telemetry.Haystack where +module Semantic.Telemetry.Haystack + ( HaystackClient (..) + , ErrorReport (..) + , ErrorLogger + , haystackClient + , reportError + ) where import Control.Exception import Crypto.Hash diff --git a/src/Semantic/Telemetry/Log.hs b/src/Semantic/Telemetry/Log.hs index 8a116e017..ce826266d 100644 --- a/src/Semantic/Telemetry/Log.hs +++ b/src/Semantic/Telemetry/Log.hs @@ -1,4 +1,12 @@ -module Semantic.Telemetry.Log where +module Semantic.Telemetry.Log + ( Level (..) + , LogOptions (..) + , Message (..) + , LogFormatter + , logfmtFormatter + , terminalFormatter + , writeLogMessage + ) where import Control.Monad.IO.Class import Data.Error (withSGRCode) diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 9d13fe90c..93118a934 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -1,5 +1,5 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators #-} -{-# OPTIONS_GHC -Wno-missing-signatures #-} +{-# OPTIONS_GHC -Wno-missing-signatures -Wno-missing-export-lists #-} module Semantic.Util where import Prelude hiding (readFile) diff --git a/src/Semantic/Version.hs b/src/Semantic/Version.hs index 0a836d905..782cbc1f8 100644 --- a/src/Semantic/Version.hs +++ b/src/Semantic/Version.hs @@ -1,6 +1,9 @@ {-# OPTIONS_GHC -fforce-recomp #-} -- So that gitHash is correct. {-# LANGUAGE TemplateHaskell #-} -module Semantic.Version where +module Semantic.Version + ( buildSHA + , buildVersion + ) where import Data.Version (showVersion) import Development.GitRev From 587b97ffa5ba91a61d95b17fd53406bde369574e Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Thu, 19 Jul 2018 14:56:58 -0400 Subject: [PATCH 25/26] Add -Wmissing-export-lists to semantic. --- semantic.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/semantic.cabal b/semantic.cabal index 533a8efe0..d42c54c09 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -248,9 +248,9 @@ library , StrictData , TypeApplications if flag(release) - ghc-options: -Wall -Werror -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -O1 -j + ghc-options: -Wall -Werror -Wmissing-export-lists -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -O1 -j else - ghc-options: -Wall -Werror -Wmissing-export-lists -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -O0 -j + ghc-options: -Wall -Wmissing-export-lists -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -O0 -j ghc-prof-options: -fprof-auto executable semantic From f91ef9916c4f478071eebf0fa748a34aee12cf6a Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 19 Jul 2018 16:41:03 -0400 Subject: [PATCH 26/26] :memo: disjunction. --- src/Control/Abstract/Value.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index 6178326db..b2fccc404 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -124,6 +124,7 @@ class (AbstractFunction address value effects, AbstractIntro value) => AbstractV -- | Eliminate boolean values. TODO: s/boolean/truthy ifthenelse :: value -> Evaluator address value effects a -> Evaluator address value effects a -> Evaluator address value effects a + -- | Compute the disjunction (boolean or) of two computed values. This should have short-circuiting semantics where applicable. disjunction :: Evaluator address value effects value -> Evaluator address value effects value -> Evaluator address value effects value -- | @index x i@ computes @x[i]@, with zero-indexing.