From 8f3265682a04aae60c298d5754886e4fcd907d8e Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 26 Jun 2018 13:20:35 -0400 Subject: [PATCH 01/58] extract runCallGraph --- src/Semantic/Graph.hs | 82 +++++++++++++++++++++++++++---------------- 1 file changed, 52 insertions(+), 30 deletions(-) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 28686e14f..c56cf4347 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -5,7 +5,7 @@ module Semantic.Graph , GraphType(..) , Graph , Vertex -, GraphEff(..) +, CallGraphEff(..) , ImportGraphEff(..) , style , parsePackage @@ -31,6 +31,7 @@ import Data.Abstract.Value (Value, ValueError (..), runValueErrorWith) import Data.Graph import Data.Project import Data.Record +import qualified Data.Syntax as Syntax import Data.Term import Data.Text (pack) import Parsing.Parser @@ -55,36 +56,14 @@ runGraph CallGraph includePackages project | SomeAnalysisParser parser lang <- someAnalysisParser (Proxy :: Proxy AnalysisClasses) (projectLanguage project) = do package <- parsePackage parser project modules <- runImportGraph lang package - let analyzeTerm = withTermSpans . graphingTerms - analyzeModule = (if includePackages then graphingPackages else id) . graphingModules - extractGraph (((_, graph), _), _) = simplify graph - runGraphAnalysis - = run - . runState lowerBound - . runFresh 0 - . runIgnoringTrace - . resumingLoadError - . resumingUnspecialized - . resumingEnvironmentError - . resumingEvalError - . resumingResolutionError - . resumingAddressError - . resumingValueError - . runTermEvaluator @_ @_ @(Value (Hole (Located Precise)) (GraphEff _)) - . graphing - . runReader (packageInfo package) - . runReader lowerBound - . fmap fst - . runState lowerBound - . raiseHandler (runModules (ModuleTable.modulePaths (packageModules package))) - extractGraph <$> analyze runGraphAnalysis (evaluate lang analyzeModule analyzeTerm (topologicalSort modules)) + runCallGraph lang includePackages modules package -- | The full list of effects in flight during the evaluation of terms. This, and other @newtype@s like it, are necessary to type 'Value', since the bodies of closures embed evaluators. This would otherwise require cycles in the effect list (i.e. references to @effects@ within @effects@ itself), which the typechecker forbids. -newtype GraphEff address a = GraphEff +newtype CallGraphEff address a = CallGraphEff { runGraphEff :: Eff '[ LoopControl address , Return address , Env address - , Allocator address (Value address (GraphEff address)) + , Allocator address (Value address (CallGraphEff address)) , Reader ModuleInfo , Modules address -- FIXME: This should really be a Reader effect but for https://github.com/joshvera/effects/issues/47 @@ -92,19 +71,62 @@ newtype GraphEff address a = GraphEff , Reader Span , Reader PackageInfo , State (Graph Vertex) - , Resumable (ValueError address (GraphEff address)) - , Resumable (AddressError address (Value address (GraphEff address))) + , Resumable (ValueError address (CallGraphEff address)) + , Resumable (AddressError address (Value address (CallGraphEff address))) , Resumable ResolutionError , Resumable EvalError , Resumable (EnvironmentError address) - , Resumable (Unspecialized (Value address (GraphEff address))) + , Resumable (Unspecialized (Value address (CallGraphEff address))) , Resumable (LoadError address) , Trace , Fresh - , State (Heap address Latest (Value address (GraphEff address))) + , State (Heap address Latest (Value address (CallGraphEff address))) ] a } +runCallGraph :: ( HasField ann Span + , Element Syntax.Identifier syntax + , Apply Eq1 syntax + , Apply Ord1 syntax + , Ord (Record ann) + , term ~ Term (Sum syntax) (Record ann) + , Declarations term + , Evaluatable (Base term) + , FreeVariables term + , HasPrelude lang + , Member Task effs + , Recursive term + ) + => Proxy lang + -> Bool + -> Graph (Module term) + -> Package term + -> Eff effs (Graph Vertex) +runCallGraph lang includePackages modules package = do + let analyzeTerm = withTermSpans . graphingTerms + analyzeModule = (if includePackages then graphingPackages else id) . graphingModules + extractGraph (((_, graph), _), _) = simplify graph + runGraphAnalysis + = run + . runState lowerBound + . runFresh 0 + . runIgnoringTrace + . resumingLoadError + . resumingUnspecialized + . resumingEnvironmentError + . resumingEvalError + . resumingResolutionError + . resumingAddressError + . resumingValueError + . runTermEvaluator @_ @_ @(Value (Hole (Located Precise)) (CallGraphEff _)) + . graphing + . runReader (packageInfo package) + . runReader lowerBound + . fmap fst + . runState lowerBound + . raiseHandler (runModules (ModuleTable.modulePaths (packageModules package))) + extractGraph <$> analyze runGraphAnalysis (evaluate lang analyzeModule analyzeTerm (topologicalSort modules)) + runImportGraph :: ( Declarations term , Evaluatable (Base term) From 18b20a4ed0512d0620d060a8e5af86da5b4b9c28 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 26 Jun 2018 13:43:50 -0400 Subject: [PATCH 02/58] call `caching` in runCallGraph --- src/Semantic/Graph.hs | 30 ++++++++++++++++++++++-------- 1 file changed, 22 insertions(+), 8 deletions(-) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index c56cf4347..b19dfbc4d 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -19,14 +19,17 @@ module Semantic.Graph , resumingEnvironmentError ) where +import Analysis.Abstract.Caching import Analysis.Abstract.Graph as Graph import Control.Abstract import Control.Monad.Effect (reinterpret) import Data.Abstract.Address +import Data.Abstract.Cache import Data.Abstract.Evaluatable import Data.Abstract.Module import qualified Data.Abstract.ModuleTable as ModuleTable import Data.Abstract.Package as Package +import Data.Abstract.Type import Data.Abstract.Value (Value, ValueError (..), runValueErrorWith) import Data.Graph import Data.Project @@ -35,7 +38,7 @@ import qualified Data.Syntax as Syntax import Data.Term import Data.Text (pack) import Parsing.Parser -import Prologue hiding (MonadError (..)) +import Prologue hiding (MonadError (..), TypeError (..)) import Semantic.IO (Files) import Semantic.Task as Task @@ -59,28 +62,31 @@ runGraph CallGraph includePackages project runCallGraph lang includePackages modules package -- | The full list of effects in flight during the evaluation of terms. This, and other @newtype@s like it, are necessary to type 'Value', since the bodies of closures embed evaluators. This would otherwise require cycles in the effect list (i.e. references to @effects@ within @effects@ itself), which the typechecker forbids. -newtype CallGraphEff address a = CallGraphEff +newtype CallGraphEff term address a = CallGraphEff { runGraphEff :: Eff '[ LoopControl address , Return address , Env address - , Allocator address (Value address (CallGraphEff address)) + , Allocator address (Value address (CallGraphEff term address)) , Reader ModuleInfo , Modules address -- FIXME: This should really be a Reader effect but for https://github.com/joshvera/effects/issues/47 , State (ModuleTable (NonEmpty (Module (address, Environment address)))) , Reader Span , Reader PackageInfo + , NonDet + , Reader (Cache term address (Cell address) (Value address (CallGraphEff term address))) + , State (Cache term address (Cell address) (Value address (CallGraphEff term address))) , State (Graph Vertex) - , Resumable (ValueError address (CallGraphEff address)) - , Resumable (AddressError address (Value address (CallGraphEff address))) + , Resumable (ValueError address (CallGraphEff term address)) + , Resumable (AddressError address (Value address (CallGraphEff term address))) , Resumable ResolutionError , Resumable EvalError , Resumable (EnvironmentError address) - , Resumable (Unspecialized (Value address (CallGraphEff address))) + , Resumable (Unspecialized (Value address (CallGraphEff term address))) , Resumable (LoadError address) , Trace , Fresh - , State (Heap address Latest (Value address (CallGraphEff address))) + , State (Heap address All (Value address (CallGraphEff term address))) ] a } @@ -105,6 +111,7 @@ runCallGraph :: ( HasField ann Span runCallGraph lang includePackages modules package = do let analyzeTerm = withTermSpans . graphingTerms analyzeModule = (if includePackages then graphingPackages else id) . graphingModules + extractGraph :: (((a, Graph Vertex), b), c) -> Graph Vertex extractGraph (((_, graph), _), _) = simplify graph runGraphAnalysis = run @@ -118,8 +125,9 @@ runCallGraph lang includePackages modules package = do . resumingResolutionError . resumingAddressError . resumingValueError - . runTermEvaluator @_ @_ @(Value (Hole (Located Precise)) (CallGraphEff _)) + . runTermEvaluator @_ @_ @(Value (Hole (Located Monovariant)) (CallGraphEff _ _)) . graphing + . caching @[] . runReader (packageInfo package) . runReader lowerBound . fmap fst @@ -271,3 +279,9 @@ resumingEnvironmentError :: AbstractHole address => Evaluator address value (Res resumingEnvironmentError = runState [] . reinterpret (\ (Resumable (FreeVariable name)) -> modify' (name :) $> hole) + +resumingTypeError :: (Alternative (m address Type effects), Effectful (m address Type), Member Trace effects) + => m address Type (Resumable TypeError ': effects) a + -> m address Type effects a +resumingTypeError = runTypeErrorWith (\err -> trace ("TypeError " <> show err) *> case err of + UnificationError l r -> pure l <|> pure r) From 3b7f91975cde1e3fe49a75b82bc9c41c13d2e6b7 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 26 Jun 2018 16:08:40 -0400 Subject: [PATCH 03/58] :pear: with Rob --- src/Analysis/Abstract/Graph.hs | 2 ++ src/Semantic/Graph.hs | 51 ++++++++-------------------------- 2 files changed, 14 insertions(+), 39 deletions(-) diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs index fcbfa5e55..d116623da 100644 --- a/src/Analysis/Abstract/Graph.hs +++ b/src/Analysis/Abstract/Graph.hs @@ -57,6 +57,7 @@ graphingTerms :: ( Element Syntax.Identifier syntax , Member (Reader ModuleInfo) effects , Member (Env (Hole (Located address))) effects , Member (State (Graph Vertex)) effects + , Member Trace effects , term ~ Term (Sum syntax) ann ) => SubtermAlgebra (Base term) term (TermEvaluator term (Hole (Located address)) value effects a) @@ -64,6 +65,7 @@ graphingTerms :: ( Element Syntax.Identifier syntax graphingTerms recur term@(In _ syntax) = do case project syntax of Just (Syntax.Identifier name) -> do + trace ("Examining identifier " <> show name) moduleInclusion (Variable (formatName name)) variableDefinition name _ -> pure () diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index b19dfbc4d..481342c5d 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -5,7 +5,6 @@ module Semantic.Graph , GraphType(..) , Graph , Vertex -, CallGraphEff(..) , ImportGraphEff(..) , style , parsePackage @@ -20,11 +19,12 @@ module Semantic.Graph ) where 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.Cache +-- import Data.Abstract.Cache import Data.Abstract.Evaluatable import Data.Abstract.Module import qualified Data.Abstract.ModuleTable as ModuleTable @@ -61,39 +61,11 @@ runGraph CallGraph includePackages project modules <- runImportGraph lang package runCallGraph lang includePackages modules package --- | The full list of effects in flight during the evaluation of terms. This, and other @newtype@s like it, are necessary to type 'Value', since the bodies of closures embed evaluators. This would otherwise require cycles in the effect list (i.e. references to @effects@ within @effects@ itself), which the typechecker forbids. -newtype CallGraphEff term address a = CallGraphEff - { runGraphEff :: Eff '[ LoopControl address - , Return address - , Env address - , Allocator address (Value address (CallGraphEff term address)) - , Reader ModuleInfo - , Modules address - -- FIXME: This should really be a Reader effect but for https://github.com/joshvera/effects/issues/47 - , State (ModuleTable (NonEmpty (Module (address, Environment address)))) - , Reader Span - , Reader PackageInfo - , NonDet - , Reader (Cache term address (Cell address) (Value address (CallGraphEff term address))) - , State (Cache term address (Cell address) (Value address (CallGraphEff term address))) - , State (Graph Vertex) - , Resumable (ValueError address (CallGraphEff term address)) - , Resumable (AddressError address (Value address (CallGraphEff term address))) - , Resumable ResolutionError - , Resumable EvalError - , Resumable (EnvironmentError address) - , Resumable (Unspecialized (Value address (CallGraphEff term address))) - , Resumable (LoadError address) - , Trace - , Fresh - , State (Heap address All (Value address (CallGraphEff term address))) - ] a - } - runCallGraph :: ( HasField ann Span , Element Syntax.Identifier syntax , Apply Eq1 syntax , Apply Ord1 syntax + , Apply Functor syntax , Ord (Record ann) , term ~ Term (Sum syntax) (Record ann) , Declarations term @@ -109,13 +81,13 @@ runCallGraph :: ( HasField ann Span -> Package term -> Eff effs (Graph Vertex) runCallGraph lang includePackages modules package = do - let analyzeTerm = withTermSpans . graphingTerms - analyzeModule = (if includePackages then graphingPackages else id) . graphingModules - extractGraph :: (((a, Graph Vertex), b), c) -> Graph Vertex + let analyzeTerm = withTermSpans . graphingTerms . cachingTerms + analyzeModule = (if includePackages then graphingPackages else id) . convergingModules . graphingModules +-- extractGraph :: (((a, Graph Vertex), b), c) -> Graph Vertex extractGraph (((_, graph), _), _) = simplify graph runGraphAnalysis = run - . runState lowerBound + . runState (lowerBound @(Heap (Hole (Located Monovariant)) All Type)) . runFresh 0 . runIgnoringTrace . resumingLoadError @@ -124,14 +96,15 @@ runCallGraph lang includePackages modules package = do . resumingEvalError . resumingResolutionError . resumingAddressError - . resumingValueError - . runTermEvaluator @_ @_ @(Value (Hole (Located Monovariant)) (CallGraphEff _ _)) + . runTermEvaluator @_ @(Hole (Located Monovariant)) @Type . graphing . caching @[] + . resumingTypeError . runReader (packageInfo package) - . runReader lowerBound + . runReader (lowerBound @Span) + . providingLiveSet . fmap fst - . runState lowerBound + . runState (lowerBound @(ModuleTable (NonEmpty (Module (Hole (Located Monovariant), Environment (Hole (Located Monovariant))))))) . raiseHandler (runModules (ModuleTable.modulePaths (packageModules package))) extractGraph <$> analyze runGraphAnalysis (evaluate lang analyzeModule analyzeTerm (topologicalSort modules)) From 9d5d24e1b5a9d0eac32053ff5f2604da77c85155 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 29 Jun 2018 12:26:51 -0400 Subject: [PATCH 04/58] otiose import --- src/Semantic/Graph.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 7b683681a..99c05adc4 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -42,7 +42,6 @@ import Data.Term import Data.Text (pack) import Parsing.Parser import Prologue hiding (MonadError (..), TypeError (..)) -import Semantic.IO (Files) import Semantic.Task as Task data GraphType = ImportGraph | CallGraph From 076aef0015352f27aa13bf8d5f329a92fd3897c3 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 29 Jun 2018 15:28:32 -0400 Subject: [PATCH 05/58] this appears to work --- src/Analysis/Abstract/Caching.hs | 32 +++++++++++++++++++++++++++----- src/Analysis/Abstract/Graph.hs | 10 ++++++++-- src/Control/Abstract/Heap.hs | 7 +++++-- src/Control/Abstract/Value.hs | 4 +++- src/Data/Abstract/Cache.hs | 3 +++ src/Data/Abstract/Evaluatable.hs | 6 +++++- src/Data/Map/Monoidal.hs | 4 ++++ src/Semantic/Graph.hs | 5 ++++- 8 files changed, 59 insertions(+), 12 deletions(-) diff --git a/src/Analysis/Abstract/Caching.hs b/src/Analysis/Abstract/Caching.hs index 33fa6a180..4b512c67e 100644 --- a/src/Analysis/Abstract/Caching.hs +++ b/src/Analysis/Abstract/Caching.hs @@ -10,6 +10,8 @@ import Data.Abstract.Cache import Data.Abstract.Module import Data.Abstract.Ref import Prologue +import Debug.Trace (traceM, traceShowId, trace) +import Text.Show.Pretty (ppShow) -- | Look up the set of values for a given configuration in the in-cache. consultOracle :: (Cacheable term address (Cell address) value, Member (Reader (Cache term address (Cell address) value)) effects) @@ -32,14 +34,23 @@ lookupCache :: (Cacheable term address (Cell address) value, Member (State (Cach lookupCache configuration = cacheLookup configuration <$> get -- | Run an action, caching its result and 'Heap' under the given configuration. -cachingConfiguration :: (Cacheable term address (Cell address) value, Member (State (Cache term address (Cell address) value)) effects, Member (State (Heap address (Cell address) value)) effects) +cachingConfiguration :: ( Cacheable term address (Cell address) value + , Member (State (Cache term address (Cell address) value)) effects + , Member (State (Heap address (Cell address) value)) effects + , Show address + , Show (Cell address value) + ) => Configuration term address (Cell address) value -> Set (Cached address (Cell address) value) -> TermEvaluator term address value effects (ValueRef address) -> TermEvaluator term address value effects (ValueRef address) cachingConfiguration configuration values action = do + traceM "modifying caching configuration" + -- traceM ("there are " <> ppShow values <> " values") modify' (cacheSet configuration values) + traceM "evaluating cached result" result <- Cached <$> action <*> TermEvaluator getHeap + traceM "inserting value " cachedValue result <$ modify' (cacheInsert configuration result) putCache :: Member (State (Cache term address (Cell address) value)) effects @@ -63,18 +74,26 @@ cachingTerms :: ( Cacheable term address (Cell address) value , Member (State (Cache term address (Cell address) value)) effects , Member (Env address) effects , Member (State (Heap address (Cell address) value)) effects + , Show address + , Show (Cell address value) ) => SubtermAlgebra (Base term) term (TermEvaluator term address value effects (ValueRef address)) -> SubtermAlgebra (Base term) term (TermEvaluator term address value effects (ValueRef address)) cachingTerms recur term = do + traceM "cachingTerms: getting configuration" c <- getConfiguration (embedSubterm term) + traceM "looking up cache" cached <- lookupCache c case cached of - Just pairs -> scatter pairs + Just pairs -> traceM "scattering" *> scatter pairs Nothing -> do + traceM "consulting oracle" pairs <- consultOracle c + traceM "caching configuration" cachingConfiguration c pairs (recur term) +tracePrettyId a = Debug.Trace.trace (ppShow a) a + convergingModules :: ( AbstractValue address value effects , Cacheable term address (Cell address) value , Member (Allocator address value) effects @@ -86,14 +105,17 @@ convergingModules :: ( AbstractValue address value effects , Member (State (Cache term address (Cell address) value)) effects , Member (Env address) effects , Member (State (Heap address (Cell address) value)) effects + , Show term + , Show address + , Show (Cell address value) ) => SubtermAlgebra Module term (TermEvaluator term address value effects address) -> SubtermAlgebra Module term (TermEvaluator term address value effects address) convergingModules recur m = do c <- getConfiguration (subterm (moduleBody m)) -- Convergence here is predicated upon an Eq instance, not α-equivalence - cache <- converge lowerBound (\ prevCache -> isolateCache . raiseHandler locally $ do - TermEvaluator (putHeap (configurationHeap c)) + cache <- converge lowerBound (\ prevCache -> fmap tracePrettyId . isolateCache . raiseHandler locally $ do + TermEvaluator (putHeap (configurationHeap c)) -- We need to reset fresh generation so that this invocation converges. resetFresh 0 $ -- This is subtle: though the calling context supports nondeterminism, we want @@ -115,7 +137,7 @@ converge :: (Eq a, Monad m) converge seed f = loop seed where loop x = do x' <- f x - if x' == x then + if x == x' then pure x else loop x' diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs index 7b7711266..51e1b72f7 100644 --- a/src/Analysis/Abstract/Graph.hs +++ b/src/Analysis/Abstract/Graph.hs @@ -15,6 +15,7 @@ module Analysis.Abstract.Graph , graphing ) where +import Debug.Trace (traceM) import Algebra.Graph.Export.Dot hiding (vertexName) import Control.Abstract import Data.Abstract.Address @@ -29,6 +30,7 @@ import qualified Data.Syntax as Syntax import Data.Term import qualified Data.Text.Encoding as T import Prologue hiding (project) +import Text.Show.Pretty (ppShow) style :: Style Vertex Builder style = (defaultStyle (T.encodeUtf8Builder . vertexName)) @@ -51,16 +53,20 @@ graphingTerms :: ( Element Syntax.Identifier syntax , Member (State (Graph Vertex)) effects , Member Trace effects , term ~ Term (Sum syntax) ann + , Apply Show1 syntax + , Apply Functor syntax + , Show ann + , Show term ) => SubtermAlgebra (Base term) term (TermEvaluator term (Hole (Located address)) value effects a) -> SubtermAlgebra (Base term) term (TermEvaluator term (Hole (Located address)) value effects a) graphingTerms recur term@(In _ syntax) = do case project syntax of Just (Syntax.Identifier name) -> do - trace ("Examining identifier " <> show name) + traceM ("Examining identifier " <> show name) moduleInclusion (Variable (formatName name)) variableDefinition name - _ -> pure () + Nothing -> pure () recur term -- | Add vertices to the graph for evaluated modules and the packages containing them. diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index 2b1c0cbc4..ae3967b5a 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -53,11 +53,14 @@ putHeap = put modifyHeap :: Member (State (Heap address (Cell address) value)) effects => (Heap address (Cell address) value -> Heap address (Cell address) value) -> Evaluator address value effects () modifyHeap = modify' -box :: Member (Allocator address value) effects +box :: ( Member (Allocator address value) effects + , Member Fresh effects + ) => value -> Evaluator address value effects address box val = do - addr <- alloc "" + nam <- nameI <$> fresh + addr <- alloc nam assign addr val pure addr diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index c23894a3e..7a713df4d 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -254,7 +254,9 @@ 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 value) effects + , Member Fresh effects + ) => value -> Evaluator address value effects (ValueRef address) rvalBox val = Rval <$> box val diff --git a/src/Data/Abstract/Cache.hs b/src/Data/Abstract/Cache.hs index 413340276..a5fe94962 100644 --- a/src/Data/Abstract/Cache.hs +++ b/src/Data/Abstract/Cache.hs @@ -32,6 +32,9 @@ cacheSet key value = Cache . Monoidal.insert key value . unCache cacheInsert :: Cacheable term address cell value => Configuration term address cell value -> Cached address cell value -> Cache term address cell value -> Cache term address cell value cacheInsert = curry cons +cacheKeys :: Cache term address cell value -> [Configuration term address cell value] +cacheKeys (Cache c) = Monoidal.keys c + instance (Show term, Show address, Show (cell value), Show value) => Show (Cache term address cell value) where showsPrec d = showsUnaryWith showsPrec "Cache" d . map (second toList) . Monoidal.pairs . unCache diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index a1d836995..7fbfa6315 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -59,6 +59,7 @@ class Show1 constr => Evaluatable constr where , Member (Resumable (Unspecialized value)) effects , Member (Return address) effects , Member Trace effects + , Member Fresh effects ) => SubtermAlgebra constr term (Evaluator address value effects (ValueRef address)) eval expr = rvalBox =<< throwResumable (Unspecialized ("Eval unspecialized for " <> liftShowsPrec (const (const id)) (const id) 0 expr "")) @@ -148,7 +149,10 @@ instance HasPrelude 'PHP builtInPrint :: ( AbstractIntro value , AbstractFunction address value effects , Member (Resumable (EnvironmentError address)) effects - , Member (Env address) effects, Member (Allocator address value) effects) + , Member (Env address) effects + , Member (Allocator address value) effects + , Member Fresh effects + ) => Name -> Evaluator address value effects address builtInPrint v = do diff --git a/src/Data/Map/Monoidal.hs b/src/Data/Map/Monoidal.hs index 34192cb2b..c6ed1ddd2 100644 --- a/src/Data/Map/Monoidal.hs +++ b/src/Data/Map/Monoidal.hs @@ -5,6 +5,7 @@ module Data.Map.Monoidal , lookup , singleton , size +, keys , insert , filterWithKey , pairs @@ -41,6 +42,9 @@ filterWithKey f = Map . Map.filterWithKey f . unMap pairs :: Map key value -> [(key, value)] pairs = Map.toList . unMap +keys :: Map key value -> [key] +keys = fmap fst . pairs + instance (Ord key, Semigroup value) => Semigroup (Map key value) where Map a <> Map b = Map (Map.unionWith (<>) a b) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 99c05adc4..4b2340957 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -21,6 +21,7 @@ module Semantic.Graph import Prelude hiding (readFile) +import Debug.Trace (traceM) import Analysis.Abstract.Caching import Analysis.Abstract.Collecting import Analysis.Abstract.Graph as Graph @@ -76,6 +77,8 @@ runCallGraph :: ( HasField ann Span , HasPrelude lang , Member Task effs , Recursive term + , Show (Record ann) + , Apply Show1 syntax ) => Proxy lang -> Bool @@ -84,7 +87,7 @@ runCallGraph :: ( HasField ann Span -> Eff effs (Graph Vertex) runCallGraph lang includePackages modules package = do let analyzeTerm = withTermSpans . graphingTerms . cachingTerms - analyzeModule = (if includePackages then graphingPackages else id) . convergingModules . graphingModules + analyzeModule = (if includePackages then graphingPackages else id) . convergingModules -- extractGraph :: (((a, Graph Vertex), b), c) -> Graph Vertex extractGraph (((_, graph), _), _) = simplify graph runGraphAnalysis From 75b6cd52c01739dd63496dfb918376798d3bd721 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 29 Jun 2018 15:44:51 -0400 Subject: [PATCH 06/58] define gensym and remove the IsString instance for Name --- src/Control/Abstract/Heap.hs | 3 +-- src/Control/Abstract/Primitive.hs | 2 +- src/Data/Abstract/Evaluatable.hs | 10 +++++----- src/Data/Abstract/Name.hs | 9 ++++++--- src/Semantic/Graph.hs | 2 +- 5 files changed, 14 insertions(+), 12 deletions(-) diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index ae3967b5a..bb6787cdf 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -59,8 +59,7 @@ box :: ( Member (Allocator address value) effects => value -> Evaluator address value effects address box val = do - nam <- nameI <$> fresh - addr <- alloc nam + addr <- gensym >>= alloc assign addr val pure addr diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 0912be487..c7ee8ae42 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -60,4 +60,4 @@ defineBuiltins :: ( AbstractValue address value effects ) => Evaluator address value effects () defineBuiltins = - define "__semantic_print" (lambda (\ v -> variable v >>= deref >>= asString >>= trace . unpack >> box unit)) + define (name "__semantic_print") (lambda (\ v -> variable v >>= deref >>= asString >>= trace . unpack >> box unit)) diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 7fbfa6315..7252443b8 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -156,20 +156,20 @@ builtInPrint :: ( AbstractIntro value => Name -> Evaluator address value effects address builtInPrint v = do - print <- variable "__semantic_print" >>= deref + print <- variable (name "__semantic_print") >>= deref void $ call print [variable v] box unit instance HasPrelude 'Python where definePrelude _ = - define "print" (lambda builtInPrint) + define (name "print") (lambda builtInPrint) instance HasPrelude 'Ruby where definePrelude _ = do - define "puts" (lambda builtInPrint) + define (name "puts") (lambda builtInPrint) - defineClass "Object" [] $ do - define "inspect" (lambda (const (box (string "")))) + defineClass (name "Object") [] $ do + define (name "inspect") (lambda (const (box (string "")))) instance HasPrelude 'TypeScript -- FIXME: define console.log using __semantic_print diff --git a/src/Data/Abstract/Name.hs b/src/Data/Abstract/Name.hs index cae8a6549..5072a340e 100644 --- a/src/Data/Abstract/Name.hs +++ b/src/Data/Abstract/Name.hs @@ -1,16 +1,18 @@ module Data.Abstract.Name ( Name -- * Constructors +, gensym , name , nameI , formatName ) where +import Control.Monad.Effect +import Control.Monad.Effect.Fresh import Data.Aeson import qualified Data.Char as Char import Data.Text (Text) import qualified Data.Text as Text -import Data.String import Prologue -- | The type of variable names. @@ -19,6 +21,9 @@ data Name | I Int deriving (Eq, Ord) +gensym :: (Functor (m effs), Member Fresh effs, Effectful m) => m effs Name +gensym = I <$> fresh + -- | Construct a 'Name' from a 'Text'. name :: Text -> Name name = Name @@ -34,8 +39,6 @@ formatName (I i) = Text.pack $ '_' : (alphabet !! a) : replicate n 'ʹ' where alphabet = ['a'..'z'] (n, a) = i `divMod` length alphabet -instance IsString Name where - fromString = Name . Text.pack -- $ -- >>> I 0 diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 4b2340957..58ded89ac 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -228,7 +228,7 @@ resumingEvalError = runEvalErrorWith (\ err -> trace ("EvalError" <> show err) * IntegerFormatError{} -> pure 0 FloatFormatError{} -> pure 0 RationalFormatError{} -> pure 0 - FreeVariablesError names -> pure (fromMaybeLast "unknown" names)) + FreeVariablesError names -> pure (fromMaybeLast (name "unknown") names)) resumingUnspecialized :: (Member Trace effects, AbstractHole value) => Evaluator address value (Resumable (Unspecialized value) ': effects) a -> Evaluator address value effects a resumingUnspecialized = runUnspecializedWith (\ err@(Unspecialized _) -> trace ("Unspecialized:" <> show err) $> hole) From b63624ac41a00d8d58ec80e2bf59282cd75390ca Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 29 Jun 2018 15:54:45 -0400 Subject: [PATCH 07/58] cleanup --- src/Analysis/Abstract/Caching.hs | 23 ++--------------------- src/Analysis/Abstract/Graph.hs | 10 +--------- src/Data/Abstract/Cache.hs | 4 ---- src/Data/Map/Monoidal.hs | 4 ---- src/Semantic/Graph.hs | 5 ----- 5 files changed, 3 insertions(+), 43 deletions(-) diff --git a/src/Analysis/Abstract/Caching.hs b/src/Analysis/Abstract/Caching.hs index 4b512c67e..fcc8af978 100644 --- a/src/Analysis/Abstract/Caching.hs +++ b/src/Analysis/Abstract/Caching.hs @@ -10,8 +10,6 @@ import Data.Abstract.Cache import Data.Abstract.Module import Data.Abstract.Ref import Prologue -import Debug.Trace (traceM, traceShowId, trace) -import Text.Show.Pretty (ppShow) -- | Look up the set of values for a given configuration in the in-cache. consultOracle :: (Cacheable term address (Cell address) value, Member (Reader (Cache term address (Cell address) value)) effects) @@ -37,20 +35,14 @@ lookupCache configuration = cacheLookup configuration <$> get cachingConfiguration :: ( Cacheable term address (Cell address) value , Member (State (Cache term address (Cell address) value)) effects , Member (State (Heap address (Cell address) value)) effects - , Show address - , Show (Cell address value) ) => Configuration term address (Cell address) value -> Set (Cached address (Cell address) value) -> TermEvaluator term address value effects (ValueRef address) -> TermEvaluator term address value effects (ValueRef address) cachingConfiguration configuration values action = do - traceM "modifying caching configuration" - -- traceM ("there are " <> ppShow values <> " values") modify' (cacheSet configuration values) - traceM "evaluating cached result" result <- Cached <$> action <*> TermEvaluator getHeap - traceM "inserting value " cachedValue result <$ modify' (cacheInsert configuration result) putCache :: Member (State (Cache term address (Cell address) value)) effects @@ -74,26 +66,18 @@ cachingTerms :: ( Cacheable term address (Cell address) value , Member (State (Cache term address (Cell address) value)) effects , Member (Env address) effects , Member (State (Heap address (Cell address) value)) effects - , Show address - , Show (Cell address value) ) => SubtermAlgebra (Base term) term (TermEvaluator term address value effects (ValueRef address)) -> SubtermAlgebra (Base term) term (TermEvaluator term address value effects (ValueRef address)) cachingTerms recur term = do - traceM "cachingTerms: getting configuration" c <- getConfiguration (embedSubterm term) - traceM "looking up cache" cached <- lookupCache c case cached of - Just pairs -> traceM "scattering" *> scatter pairs + Just pairs -> scatter pairs Nothing -> do - traceM "consulting oracle" pairs <- consultOracle c - traceM "caching configuration" cachingConfiguration c pairs (recur term) -tracePrettyId a = Debug.Trace.trace (ppShow a) a - convergingModules :: ( AbstractValue address value effects , Cacheable term address (Cell address) value , Member (Allocator address value) effects @@ -105,16 +89,13 @@ convergingModules :: ( AbstractValue address value effects , Member (State (Cache term address (Cell address) value)) effects , Member (Env address) effects , Member (State (Heap address (Cell address) value)) effects - , Show term - , Show address - , Show (Cell address value) ) => SubtermAlgebra Module term (TermEvaluator term address value effects address) -> SubtermAlgebra Module term (TermEvaluator term address value effects address) convergingModules recur m = do c <- getConfiguration (subterm (moduleBody m)) -- Convergence here is predicated upon an Eq instance, not α-equivalence - cache <- converge lowerBound (\ prevCache -> fmap tracePrettyId . isolateCache . raiseHandler locally $ do + cache <- converge lowerBound (\ prevCache -> isolateCache . raiseHandler locally $ do TermEvaluator (putHeap (configurationHeap c)) -- We need to reset fresh generation so that this invocation converges. resetFresh 0 $ diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs index 51e1b72f7..5a7431529 100644 --- a/src/Analysis/Abstract/Graph.hs +++ b/src/Analysis/Abstract/Graph.hs @@ -15,7 +15,6 @@ module Analysis.Abstract.Graph , graphing ) where -import Debug.Trace (traceM) import Algebra.Graph.Export.Dot hiding (vertexName) import Control.Abstract import Data.Abstract.Address @@ -30,7 +29,6 @@ import qualified Data.Syntax as Syntax import Data.Term import qualified Data.Text.Encoding as T import Prologue hiding (project) -import Text.Show.Pretty (ppShow) style :: Style Vertex Builder style = (defaultStyle (T.encodeUtf8Builder . vertexName)) @@ -51,22 +49,16 @@ graphingTerms :: ( Element Syntax.Identifier syntax , Member (Reader ModuleInfo) effects , Member (Env (Hole (Located address))) effects , Member (State (Graph Vertex)) effects - , Member Trace effects , term ~ Term (Sum syntax) ann - , Apply Show1 syntax - , Apply Functor syntax - , Show ann - , Show term ) => SubtermAlgebra (Base term) term (TermEvaluator term (Hole (Located address)) value effects a) -> SubtermAlgebra (Base term) term (TermEvaluator term (Hole (Located address)) value effects a) graphingTerms recur term@(In _ syntax) = do case project syntax of Just (Syntax.Identifier name) -> do - traceM ("Examining identifier " <> show name) moduleInclusion (Variable (formatName name)) variableDefinition name - Nothing -> pure () + _ -> pure () recur term -- | Add vertices to the graph for evaluated modules and the packages containing them. diff --git a/src/Data/Abstract/Cache.hs b/src/Data/Abstract/Cache.hs index a5fe94962..82e027f72 100644 --- a/src/Data/Abstract/Cache.hs +++ b/src/Data/Abstract/Cache.hs @@ -32,9 +32,5 @@ cacheSet key value = Cache . Monoidal.insert key value . unCache cacheInsert :: Cacheable term address cell value => Configuration term address cell value -> Cached address cell value -> Cache term address cell value -> Cache term address cell value cacheInsert = curry cons -cacheKeys :: Cache term address cell value -> [Configuration term address cell value] -cacheKeys (Cache c) = Monoidal.keys c - - instance (Show term, Show address, Show (cell value), Show value) => Show (Cache term address cell value) where showsPrec d = showsUnaryWith showsPrec "Cache" d . map (second toList) . Monoidal.pairs . unCache diff --git a/src/Data/Map/Monoidal.hs b/src/Data/Map/Monoidal.hs index c6ed1ddd2..34192cb2b 100644 --- a/src/Data/Map/Monoidal.hs +++ b/src/Data/Map/Monoidal.hs @@ -5,7 +5,6 @@ module Data.Map.Monoidal , lookup , singleton , size -, keys , insert , filterWithKey , pairs @@ -42,9 +41,6 @@ filterWithKey f = Map . Map.filterWithKey f . unMap pairs :: Map key value -> [(key, value)] pairs = Map.toList . unMap -keys :: Map key value -> [key] -keys = fmap fst . pairs - instance (Ord key, Semigroup value) => Semigroup (Map key value) where Map a <> Map b = Map (Map.unionWith (<>) a b) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 58ded89ac..b3556a0ed 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -21,14 +21,12 @@ module Semantic.Graph import Prelude hiding (readFile) -import Debug.Trace (traceM) 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.Cache import Data.Abstract.Evaluatable import Data.Abstract.Module import qualified Data.Abstract.ModuleTable as ModuleTable @@ -77,8 +75,6 @@ runCallGraph :: ( HasField ann Span , HasPrelude lang , Member Task effs , Recursive term - , Show (Record ann) - , Apply Show1 syntax ) => Proxy lang -> Bool @@ -88,7 +84,6 @@ runCallGraph :: ( HasField ann Span runCallGraph lang includePackages modules package = do let analyzeTerm = withTermSpans . graphingTerms . cachingTerms analyzeModule = (if includePackages then graphingPackages else id) . convergingModules --- extractGraph :: (((a, Graph Vertex), b), c) -> Graph Vertex extractGraph (((_, graph), _), _) = simplify graph runGraphAnalysis = run From bef406b5c766834fb577cb76d7421eac08d06d9e Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 29 Jun 2018 16:00:23 -0400 Subject: [PATCH 08/58] whitespace changes --- src/Analysis/Abstract/Caching.hs | 9 +++------ src/Data/Abstract/Cache.hs | 1 + src/Data/Abstract/Name.hs | 1 - 3 files changed, 4 insertions(+), 7 deletions(-) diff --git a/src/Analysis/Abstract/Caching.hs b/src/Analysis/Abstract/Caching.hs index fcc8af978..33fa6a180 100644 --- a/src/Analysis/Abstract/Caching.hs +++ b/src/Analysis/Abstract/Caching.hs @@ -32,10 +32,7 @@ lookupCache :: (Cacheable term address (Cell address) value, Member (State (Cach lookupCache configuration = cacheLookup configuration <$> get -- | Run an action, caching its result and 'Heap' under the given configuration. -cachingConfiguration :: ( Cacheable term address (Cell address) value - , Member (State (Cache term address (Cell address) value)) effects - , Member (State (Heap address (Cell address) value)) effects - ) +cachingConfiguration :: (Cacheable term address (Cell address) value, Member (State (Cache term address (Cell address) value)) effects, Member (State (Heap address (Cell address) value)) effects) => Configuration term address (Cell address) value -> Set (Cached address (Cell address) value) -> TermEvaluator term address value effects (ValueRef address) @@ -96,7 +93,7 @@ convergingModules recur m = do c <- getConfiguration (subterm (moduleBody m)) -- Convergence here is predicated upon an Eq instance, not α-equivalence cache <- converge lowerBound (\ prevCache -> isolateCache . raiseHandler locally $ do - TermEvaluator (putHeap (configurationHeap c)) + TermEvaluator (putHeap (configurationHeap c)) -- We need to reset fresh generation so that this invocation converges. resetFresh 0 $ -- This is subtle: though the calling context supports nondeterminism, we want @@ -118,7 +115,7 @@ converge :: (Eq a, Monad m) converge seed f = loop seed where loop x = do x' <- f x - if x == x' then + if x' == x then pure x else loop x' diff --git a/src/Data/Abstract/Cache.hs b/src/Data/Abstract/Cache.hs index 82e027f72..413340276 100644 --- a/src/Data/Abstract/Cache.hs +++ b/src/Data/Abstract/Cache.hs @@ -32,5 +32,6 @@ cacheSet key value = Cache . Monoidal.insert key value . unCache cacheInsert :: Cacheable term address cell value => Configuration term address cell value -> Cached address cell value -> Cache term address cell value -> Cache term address cell value cacheInsert = curry cons + instance (Show term, Show address, Show (cell value), Show value) => Show (Cache term address cell value) where showsPrec d = showsUnaryWith showsPrec "Cache" d . map (second toList) . Monoidal.pairs . unCache diff --git a/src/Data/Abstract/Name.hs b/src/Data/Abstract/Name.hs index 5072a340e..d5e0afa5b 100644 --- a/src/Data/Abstract/Name.hs +++ b/src/Data/Abstract/Name.hs @@ -39,7 +39,6 @@ formatName (I i) = Text.pack $ '_' : (alphabet !! a) : replicate n 'ʹ' where alphabet = ['a'..'z'] (n, a) = i `divMod` length alphabet - -- $ -- >>> I 0 -- "_a" From 1eed347da6df91626cb7b59774815d3c3de0d1a0 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 29 Jun 2018 16:17:27 -0400 Subject: [PATCH 09/58] fix the specs --- test/Diffing/Algorithm/RWS/Spec.hs | 2 +- test/Diffing/Interpreter/Spec.hs | 1 + test/SpecHelpers.hs | 8 ++++++++ 3 files changed, 10 insertions(+), 1 deletion(-) diff --git a/test/Diffing/Algorithm/RWS/Spec.hs b/test/Diffing/Algorithm/RWS/Spec.hs index 5a74597e9..aaf93710a 100644 --- a/test/Diffing/Algorithm/RWS/Spec.hs +++ b/test/Diffing/Algorithm/RWS/Spec.hs @@ -12,8 +12,8 @@ import Data.Term import Data.These import Diffing.Algorithm import Diffing.Algorithm.RWS -import Test.Hspec import Test.Hspec.LeanCheck +import SpecHelpers spec :: Spec spec = parallel $ do diff --git a/test/Diffing/Interpreter/Spec.hs b/test/Diffing/Interpreter/Spec.hs index 75cb107dc..d1e2d5700 100644 --- a/test/Diffing/Interpreter/Spec.hs +++ b/test/Diffing/Interpreter/Spec.hs @@ -14,6 +14,7 @@ import Test.Hspec (Spec, describe, it, parallel) import Test.Hspec.Expectations.Pretty import Test.Hspec.LeanCheck import Test.LeanCheck.Core +import SpecHelpers spec :: Spec spec = parallel $ do diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs index b4823e846..c156b6326 100644 --- a/test/SpecHelpers.hs +++ b/test/SpecHelpers.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + module SpecHelpers ( module X , runBuilder @@ -41,6 +43,7 @@ import Data.Record as X import Data.Semilattice.Lower as X import Data.Source as X import Data.Span as X +import Data.String import Data.Sum import Data.Term as X import Parsing.Parser as X @@ -68,6 +71,11 @@ import qualified Semantic.IO as IO runBuilder = toStrict . toLazyByteString +-- | This orphan instance is so we don't have to insert @name@ calls +-- in dozens and dozens of environment specs. +instance IsString Name where + fromString = name . fromString + -- | Returns an s-expression formatted diff for the specified FilePath pair. diffFilePaths :: Both FilePath -> IO ByteString diffFilePaths paths = readFilePair paths >>= fmap runBuilder . runTask . runDiff SExpressionDiffRenderer . pure From 0ca991f0ddfd8d0ad84ffa9a7e1a02e79dda6814 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 3 Jul 2018 14:29:47 -0400 Subject: [PATCH 10/58] Fix terrible bug associated with environment comparisons being false --- src/Analysis/Abstract/Caching.hs | 6 ++++-- src/Analysis/Abstract/Graph.hs | 2 +- src/Control/Abstract/Environment.hs | 8 ++++++++ src/Data/Abstract/Cache.hs | 2 ++ src/Data/Map/Monoidal.hs | 3 +++ src/Semantic/Graph.hs | 14 +++++++++----- src/Semantic/Util.hs | 10 ++++++++++ .../include-file-with-undefined-call/main.rb | 7 +++++++ .../include-file-with-undefined-call/target.rb | 3 +++ 9 files changed, 47 insertions(+), 8 deletions(-) create mode 100644 test/fixtures/ruby/analysis/graphing/include-file-with-undefined-call/main.rb create mode 100644 test/fixtures/ruby/analysis/graphing/include-file-with-undefined-call/target.rb diff --git a/src/Analysis/Abstract/Caching.hs b/src/Analysis/Abstract/Caching.hs index 33fa6a180..20c85b4b2 100644 --- a/src/Analysis/Abstract/Caching.hs +++ b/src/Analysis/Abstract/Caching.hs @@ -92,8 +92,9 @@ convergingModules :: ( AbstractValue address value effects convergingModules recur m = do c <- getConfiguration (subterm (moduleBody m)) -- Convergence here is predicated upon an Eq instance, not α-equivalence - cache <- converge lowerBound (\ prevCache -> isolateCache . raiseHandler locally $ do + cache <- converge lowerBound (\ prevCache -> isolateCache $ do TermEvaluator (putHeap (configurationHeap c)) + TermEvaluator (putEnv (configurationEnvironment c)) -- We need to reset fresh generation so that this invocation converges. resetFresh 0 $ -- This is subtle: though the calling context supports nondeterminism, we want @@ -102,8 +103,9 @@ convergingModules recur m = do -- would never complete). We don’t need to use the values, so we 'gather' the -- nondeterministic values into @()@. withOracle prevCache (gatherM (const ()) (recur m))) - TermEvaluator (address =<< runTermEvaluator (maybe empty scatter (cacheLookup c cache))) + -- TODO: We're hitting an infinite loop here, c.f test/fixtures/ruby/analysis/graphing/include-file-with-undefined-call + TermEvaluator (address =<< runTermEvaluator (maybe empty scatter (cacheLookup c cache))) -- | Iterate a monadic action starting from some initial seed until the results converge. -- diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs index 5a7431529..bfc661a6d 100644 --- a/src/Analysis/Abstract/Graph.hs +++ b/src/Analysis/Abstract/Graph.hs @@ -49,7 +49,7 @@ graphingTerms :: ( Element Syntax.Identifier syntax , Member (Reader ModuleInfo) effects , Member (Env (Hole (Located address))) effects , Member (State (Graph Vertex)) effects - , term ~ Term (Sum syntax) ann + , 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) diff --git a/src/Control/Abstract/Environment.hs b/src/Control/Abstract/Environment.hs index 3100c5c6f..5681f51dd 100644 --- a/src/Control/Abstract/Environment.hs +++ b/src/Control/Abstract/Environment.hs @@ -3,6 +3,7 @@ module Control.Abstract.Environment ( Environment , Exports , getEnv +, putEnv , export , lookupEnv , bind @@ -29,6 +30,10 @@ import Prologue getEnv :: Member (Env address) effects => Evaluator address value effects (Environment address) getEnv = send GetEnv +-- | This is only for use in Analysis.Abstract.Caching. +putEnv :: Member (Env address) effects => Environment address -> Evaluator address value effects () +putEnv = send . PutEnv + -- | Add an export to the global export state. export :: Member (Env address) effects => Name -> Name -> Maybe address -> Evaluator address value effects () export name alias addr = send (Export name alias addr) @@ -67,6 +72,8 @@ data Env address return where Pop :: Env address () GetEnv :: Env address (Environment address) Export :: Name -> Name -> Maybe address -> Env address () + PutEnv :: Environment address -> Env address () + handleEnv :: forall address effects value result . ( Member (State (Environment address)) effects @@ -81,6 +88,7 @@ handleEnv = \case Push -> modify (Env.push @address) Pop -> modify (Env.pop @address) GetEnv -> get + PutEnv e -> put e Export name alias addr -> modify (Exports.insert name alias addr) runEnv :: Environment address diff --git a/src/Data/Abstract/Cache.hs b/src/Data/Abstract/Cache.hs index 413340276..703691dc9 100644 --- a/src/Data/Abstract/Cache.hs +++ b/src/Data/Abstract/Cache.hs @@ -32,6 +32,8 @@ cacheSet key value = Cache . Monoidal.insert key value . unCache cacheInsert :: Cacheable term address cell value => Configuration term address cell value -> Cached address cell value -> Cache term address cell value -> Cache term address cell value cacheInsert = curry cons +cacheKeys :: Cacheable term address cell value => Cache term address cell value -> [Configuration term address cell value] +cacheKeys = Monoidal.keys . unCache instance (Show term, Show address, Show (cell value), Show value) => Show (Cache term address cell value) where showsPrec d = showsUnaryWith showsPrec "Cache" d . map (second toList) . Monoidal.pairs . unCache diff --git a/src/Data/Map/Monoidal.hs b/src/Data/Map/Monoidal.hs index 34192cb2b..6fa553857 100644 --- a/src/Data/Map/Monoidal.hs +++ b/src/Data/Map/Monoidal.hs @@ -8,6 +8,7 @@ module Data.Map.Monoidal , insert , filterWithKey , pairs +, keys , module Reducer ) where @@ -37,6 +38,8 @@ insert key value = Map . Map.insert key value . unMap filterWithKey :: (key -> value -> Bool) -> Map key value -> Map key value filterWithKey f = Map . Map.filterWithKey f . unMap +keys :: Map key value -> [key] +keys = map fst . pairs pairs :: Map key value -> [(key, value)] pairs = Map.toList . unMap diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index b3556a0ed..51658eecc 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -1,6 +1,7 @@ {-# LANGUAGE GADTs, ScopedTypeVariables, TypeOperators #-} module Semantic.Graph ( runGraph +, runCallGraph , runImportGraph , GraphType(..) , Graph @@ -59,7 +60,7 @@ runGraph ImportGraph _ project runGraph CallGraph includePackages project | SomeAnalysisParser parser lang <- someAnalysisParser (Proxy :: Proxy AnalysisClasses) (projectLanguage project) = do package <- parsePackage parser project - modules <- runImportGraph lang package + modules <- topologicalSort <$> runImportGraph lang package runCallGraph lang includePackages modules package runCallGraph :: ( HasField ann Span @@ -68,7 +69,10 @@ runCallGraph :: ( HasField ann Span , Apply Ord1 syntax , Apply Functor syntax , Ord (Record ann) - , term ~ Term (Sum syntax) (Record ann) + , Show term + , Base term ~ TermF (Sum syntax) (Record ann) + , Ord term + , Corecursive term , Declarations term , Evaluatable (Base term) , FreeVariables term @@ -78,12 +82,12 @@ runCallGraph :: ( HasField ann Span ) => Proxy lang -> Bool - -> Graph (Module term) + -> [Module term] -> Package term -> Eff effs (Graph Vertex) runCallGraph lang includePackages modules package = do let analyzeTerm = withTermSpans . graphingTerms . cachingTerms - analyzeModule = (if includePackages then graphingPackages else id) . convergingModules + analyzeModule = (if includePackages then graphingPackages else id) . convergingModules . graphingModules extractGraph (((_, graph), _), _) = simplify graph runGraphAnalysis = run @@ -106,7 +110,7 @@ runCallGraph lang includePackages modules package = do . fmap fst . runState (lowerBound @(ModuleTable (NonEmpty (Module (Hole (Located Monovariant), Environment (Hole (Located Monovariant))))))) . raiseHandler (runModules (ModuleTable.modulePaths (packageModules package))) - extractGraph <$> analyze runGraphAnalysis (evaluate lang analyzeModule analyzeTerm (topologicalSort modules)) + extractGraph <$> analyze runGraphAnalysis (evaluate lang analyzeModule analyzeTerm modules) runImportGraph :: ( Declarations term diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index e06100ea4..052227828 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -98,6 +98,16 @@ evalTypeScriptProject = justEvaluating <=< evaluateProject (Proxy :: Proxy 'Lang typecheckGoFile = checking <=< evaluateProjectWithCaching (Proxy :: Proxy 'Language.Go) goParser Language.Go +callGraphRubyProject paths = runTaskWithOptions debugOptions $ do + let proxy = Proxy @'Language.Ruby + let lang = Language.Ruby + blobs <- catMaybes <$> traverse readFile (flip File lang <$> paths) + 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) + + -- Evaluate a project consisting of the listed paths. evaluateProject proxy parser lang paths = runTaskWithOptions debugOptions $ do blobs <- catMaybes <$> traverse readFile (flip File lang <$> paths) diff --git a/test/fixtures/ruby/analysis/graphing/include-file-with-undefined-call/main.rb b/test/fixtures/ruby/analysis/graphing/include-file-with-undefined-call/main.rb new file mode 100644 index 000000000..92e64d33a --- /dev/null +++ b/test/fixtures/ruby/analysis/graphing/include-file-with-undefined-call/main.rb @@ -0,0 +1,7 @@ +require './target' + +def go() + "done" +end + +go() diff --git a/test/fixtures/ruby/analysis/graphing/include-file-with-undefined-call/target.rb b/test/fixtures/ruby/analysis/graphing/include-file-with-undefined-call/target.rb new file mode 100644 index 000000000..678daf934 --- /dev/null +++ b/test/fixtures/ruby/analysis/graphing/include-file-with-undefined-call/target.rb @@ -0,0 +1,3 @@ +barf() + +def foo(); end From cfefbefaa63d27a9c37d108478211b2f68d94e3e Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 3 Jul 2018 14:30:26 -0400 Subject: [PATCH 11/58] Remove the misleading Show instance for Environments. --- src/Data/Abstract/Environment.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Abstract/Environment.hs b/src/Data/Abstract/Environment.hs index d742a8ef6..26562ba9d 100644 --- a/src/Data/Abstract/Environment.hs +++ b/src/Data/Abstract/Environment.hs @@ -152,4 +152,4 @@ addresses = fromAddresses . map snd . flatPairs instance Lower (Environment address) where lowerBound = Environment (lowerBound :| []) instance Show address => Show (Environment address) where - showsPrec d = showsUnaryWith showsPrec "Environment" d . flatPairs + showsPrec d = showsUnaryWith showsPrec "Environment" d From 7d6195fe7dee065cfdae7386efd3d0e77f880e0e Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 3 Jul 2018 18:46:45 -0400 Subject: [PATCH 12/58] lints --- src/Data/Abstract/Cache.hs | 3 ++- src/Semantic/Graph.hs | 5 ----- 2 files changed, 2 insertions(+), 6 deletions(-) diff --git a/src/Data/Abstract/Cache.hs b/src/Data/Abstract/Cache.hs index 703691dc9..78bd3ab25 100644 --- a/src/Data/Abstract/Cache.hs +++ b/src/Data/Abstract/Cache.hs @@ -32,7 +32,8 @@ cacheSet key value = Cache . Monoidal.insert key value . unCache cacheInsert :: Cacheable term address cell value => Configuration term address cell value -> Cached address cell value -> Cache term address cell value -> Cache term address cell value cacheInsert = curry cons -cacheKeys :: Cacheable term address cell value => Cache term address cell value -> [Configuration term address cell value] +-- | Return all 'Configuration's in the provided cache. +cacheKeys :: Cache term address cell value -> [Configuration term address cell value] cacheKeys = Monoidal.keys . unCache instance (Show term, Show address, Show (cell value), Show value) => Show (Cache term address cell value) where diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 51658eecc..d89b1c8ca 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -65,11 +65,6 @@ runGraph CallGraph includePackages project runCallGraph :: ( HasField ann Span , Element Syntax.Identifier syntax - , Apply Eq1 syntax - , Apply Ord1 syntax - , Apply Functor syntax - , Ord (Record ann) - , Show term , Base term ~ TermF (Sum syntax) (Record ann) , Ord term , Corecursive term From 6dc30c3b87ef77e5cac005adbc843f632a16fa53 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Thu, 12 Jul 2018 17:13:36 -0400 Subject: [PATCH 13/58] Upgrade to LTS 12.0. --- src/Control/Abstract/Environment.hs | 2 +- test/Test/Hspec/LeanCheck.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Control/Abstract/Environment.hs b/src/Control/Abstract/Environment.hs index 5ffcb4be3..1d6693a0d 100644 --- a/src/Control/Abstract/Environment.hs +++ b/src/Control/Abstract/Environment.hs @@ -53,7 +53,7 @@ bindAll = foldr ((>>) . uncurry bind) (pure ()) . Env.flatPairs -- | Run an action in a new local scope. locally :: forall address value effects a . Member (Env address) effects => Evaluator address value effects a -> Evaluator address value effects a -locally = send . Locally @address . lowerEff +locally = send . Locally @_ @_ @address . lowerEff close :: Member (Env address) effects => Set Name -> Evaluator address value effects (Environment address) close = send . Close diff --git a/test/Test/Hspec/LeanCheck.hs b/test/Test/Hspec/LeanCheck.hs index 6ab3c97dd..0540bc017 100644 --- a/test/Test/Hspec/LeanCheck.hs +++ b/test/Test/Hspec/LeanCheck.hs @@ -47,8 +47,8 @@ instance Example Property where Left e | Just (LeanCheckException messages e') <- fromException e -> throw (addMessages messages e') | otherwise -> throw e - Right (Just messages) -> pure $ Failure Nothing (Reason (concat messages)) - Right Nothing -> pure Success + Right (Just messages) -> pure $ Result "" (Failure Nothing (Reason (concat messages))) + Right Nothing -> pure $ Result "" Success where addMessages messages (HUnit.HUnitFailure loc r) = HUnit.HUnitFailure loc $ case r of HUnit.Reason s -> HUnit.Reason (intercalate "\n" messages ++ "\n" ++ s) HUnit.ExpectedButGot Nothing expected actual -> HUnit.ExpectedButGot (Just (concat messages)) expected actual From dd772765fdf015af3d8c29b60901fac3bf04d183 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Thu, 12 Jul 2018 16:54:28 -0700 Subject: [PATCH 14/58] Refactor TypeScript DefaultExport eval instance slightly --- src/Language/TypeScript/Syntax.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Language/TypeScript/Syntax.hs b/src/Language/TypeScript/Syntax.hs index f515fe218..a94067956 100644 --- a/src/Language/TypeScript/Syntax.hs +++ b/src/Language/TypeScript/Syntax.hs @@ -270,11 +270,10 @@ instance Show1 DefaultExport where liftShowsPrec = genericLiftShowsPrec instance Evaluatable DefaultExport where eval (DefaultExport term) = do - v <- subtermValue term case declaredName term of Just name -> do addr <- lookupOrAlloc name - assign addr v + subtermValue term >>= assign addr export name name Nothing bind name addr Nothing -> throwEvalError DefaultExportError From bb8506b7bf6f6fe069a60046f2af538da31931d8 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Thu, 12 Jul 2018 16:55:07 -0700 Subject: [PATCH 15/58] Adding a Declarations constraint on Declarations1 for use with subterms --- src/Data/Abstract/Declarations.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Data/Abstract/Declarations.hs b/src/Data/Abstract/Declarations.hs index a15c74f04..d9e2a3573 100644 --- a/src/Data/Abstract/Declarations.hs +++ b/src/Data/Abstract/Declarations.hs @@ -13,7 +13,7 @@ class Declarations syntax where class Declarations1 syntax where -- | Lift a function mapping each element to its set of free variables through a containing structure, collecting the results into a single set. - liftDeclaredName :: (a -> [Name]) -> syntax a -> Maybe Name + liftDeclaredName :: Declarations a => (a -> [Name]) -> syntax a -> Maybe Name liftDeclaredName _ _ = Nothing instance Declarations t => Declarations (Subterm t a) where @@ -21,7 +21,7 @@ instance Declarations t => Declarations (Subterm t a) where deriving instance (Declarations1 syntax, FreeVariables1 syntax) => Declarations (Term syntax ann) -instance (FreeVariables recur, Declarations1 syntax) => Declarations (TermF syntax ann recur) where +instance (Declarations recur, FreeVariables recur, Declarations1 syntax) => Declarations (TermF syntax ann recur) where declaredName = liftDeclaredName freeVariables . termFOut instance (Apply Declarations1 fs) => Declarations1 (Sum fs) where From 57962113bba6e444ac0270f27060dc6201e4dafe Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Thu, 12 Jul 2018 16:55:42 -0700 Subject: [PATCH 16/58] Retrieve the declaredName for a Function declaration --- src/Data/Syntax/Declaration.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 148127c94..bf10221dd 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -10,7 +10,7 @@ import Prologue import Proto3.Suite.Class data Function a = Function { functionContext :: ![a], functionName :: !a, functionParameters :: ![a], functionBody :: !a } - deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Mergeable, FreeVariables1, Declarations1, ToJSONFields1, Named1, Message1) + deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Mergeable, FreeVariables1, ToJSONFields1, Named1, Message1) instance Diffable Function where equivalentBySubterm = Just . functionName @@ -33,6 +33,8 @@ instance Evaluatable Function where instance Declarations a => Declarations (Function a) where declaredName Function{..} = declaredName functionName +instance Declarations1 Function where + liftDeclaredName _ = declaredName data Method a = Method { methodContext :: ![a], methodReceiver :: !a, methodName :: !a, methodParameters :: ![a], methodBody :: !a } deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Mergeable, FreeVariables1, Declarations1, ToJSONFields1, Named1, Message1) From 8da0e3910c6cd21d22cc962c5e16394bd1dcaaa2 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Thu, 12 Jul 2018 16:56:27 -0700 Subject: [PATCH 17/58] Add javascript specific export test files --- test/fixtures/javascript/analysis/exports/lib.js | 6 ++++++ test/fixtures/javascript/analysis/exports/main.js | 3 +++ 2 files changed, 9 insertions(+) create mode 100644 test/fixtures/javascript/analysis/exports/lib.js create mode 100644 test/fixtures/javascript/analysis/exports/main.js diff --git a/test/fixtures/javascript/analysis/exports/lib.js b/test/fixtures/javascript/analysis/exports/lib.js new file mode 100644 index 000000000..ba64ec931 --- /dev/null +++ b/test/fixtures/javascript/analysis/exports/lib.js @@ -0,0 +1,6 @@ +export function square(x) { + return x * x; +} +export function area(x, y) { + return x * y; +} diff --git a/test/fixtures/javascript/analysis/exports/main.js b/test/fixtures/javascript/analysis/exports/main.js new file mode 100644 index 000000000..5ce529dbb --- /dev/null +++ b/test/fixtures/javascript/analysis/exports/main.js @@ -0,0 +1,3 @@ +import { square, area } from 'lib'; +console.log(square(11)); // 121 +console.log(area(4, 3)); // 12 From 25cc3317899e2fe2ba9837b7da62811d970d9c72 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 13 Jul 2018 11:21:54 -0400 Subject: [PATCH 18/58] merge fallout --- src/Control/Abstract/Environment.hs | 2 -- src/Data/Abstract/Evaluatable.hs | 13 ++++++------- src/Data/Abstract/Value/Abstract.hs | 1 - src/Semantic/Graph.hs | 1 + 4 files changed, 7 insertions(+), 10 deletions(-) diff --git a/src/Control/Abstract/Environment.hs b/src/Control/Abstract/Environment.hs index b169daeda..2c8225426 100644 --- a/src/Control/Abstract/Environment.hs +++ b/src/Control/Abstract/Environment.hs @@ -69,7 +69,6 @@ data Env address m return where GetEnv :: Env address m (Environment address) PutEnv :: Environment address -> Env address m () Export :: Name -> Name -> Maybe address -> Env address m () - PutEnv :: Environment address -> Env address m () instance Effect (Env address) where handleState c dist (Request (Lookup name) k) = Request (Lookup name) (dist . (<$ c) . k) @@ -79,7 +78,6 @@ instance Effect (Env address) where handleState c dist (Request GetEnv k) = Request GetEnv (dist . (<$ c) . k) handleState c dist (Request (PutEnv e) k) = Request (PutEnv e) (dist . (<$ c) . k) handleState c dist (Request (Export name alias addr) k) = Request (Export name alias addr) (dist . (<$ c) . k) - handleState c dist (Request (PutEnv e) k) = Request (PutEnv e) (dist . (<$ c) . k) runEnv :: Effects effects => Environment address diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 17e1b3231..d1c8ff330 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -52,7 +52,6 @@ class (Show1 constr, Foldable constr) => Evaluatable constr where , Member (Env address) effects , Member (Exc (LoopControl address)) effects , Member (Exc (Return address)) effects - , Member Fresh effects , Member (Modules address) effects , Member (Reader ModuleInfo) effects , Member (Reader PackageInfo) effects @@ -155,24 +154,24 @@ instance HasPrelude 'PHP instance HasPrelude 'Python where definePrelude _ = - define "print" builtInPrint + define (name "print") builtInPrint instance HasPrelude 'Ruby where definePrelude _ = do - define "puts" builtInPrint + define (name "puts") builtInPrint defineClass (name "Object") [] $ do define (name "inspect") (lambda (const (box (string "")))) instance HasPrelude 'TypeScript where definePrelude _ = - defineNamespace "console" $ do - define "log" builtInPrint + defineNamespace (name "console") $ do + define (name "log") builtInPrint instance HasPrelude 'JavaScript where definePrelude _ = do - defineNamespace "console" $ do - define "log" builtInPrint + defineNamespace (name "console") $ do + define (name "log") builtInPrint -- Postludes diff --git a/src/Data/Abstract/Value/Abstract.hs b/src/Data/Abstract/Value/Abstract.hs index 7c0886ddc..3a4561fc4 100644 --- a/src/Data/Abstract/Value/Abstract.hs +++ b/src/Data/Abstract/Value/Abstract.hs @@ -48,7 +48,6 @@ instance ( Member (Allocator address Abstract) effects instance ( Member (Allocator address Abstract) effects , Member (Env address) effects , Member (Exc (Return address)) effects - , Member Fresh effects , Member NonDet effects , Member Fresh effects ) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index f467cffed..f6b456f78 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -72,6 +72,7 @@ runCallGraph :: ( HasField ann Span , Evaluatable (Base term) , FreeVariables term , HasPrelude lang + , HasPostlude lang , Member Trace effs , Recursive term , Effects effs From 85bc3dbda6bd4d46f8fea726a3c289f82bdda3c7 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 13 Jul 2018 11:59:45 -0400 Subject: [PATCH 19/58] fix lints and bad imports --- src/Control/Abstract/Environment.hs | 2 +- src/Control/Abstract/Roots.hs | 3 --- src/Data/Abstract/ModuleTable.hs | 1 - src/Data/Functor/Both.hs | 1 - src/Data/Functor/Classes/Generic.hs | 1 - src/Data/Semigroup/App.hs | 1 - src/Language/Ruby/Syntax.hs | 4 ++-- src/Serializing/DOT.hs | 1 - 8 files changed, 3 insertions(+), 11 deletions(-) diff --git a/src/Control/Abstract/Environment.hs b/src/Control/Abstract/Environment.hs index 1d6693a0d..fbbd7afaf 100644 --- a/src/Control/Abstract/Environment.hs +++ b/src/Control/Abstract/Environment.hs @@ -31,7 +31,7 @@ getEnv :: Member (Env address) effects => Evaluator address value effects (Envir getEnv = send GetEnv -- | Replace the environment. -putEnv :: Member (Env address) effects => (Environment address) -> Evaluator address value effects () +putEnv :: Member (Env address) effects => Environment address -> Evaluator address value effects () putEnv = send . PutEnv -- | Add an export to the global export state. diff --git a/src/Control/Abstract/Roots.hs b/src/Control/Abstract/Roots.hs index bed08282d..b39e428c1 100644 --- a/src/Control/Abstract/Roots.hs +++ b/src/Control/Abstract/Roots.hs @@ -7,15 +7,12 @@ module Control.Abstract.Roots import Control.Abstract.Evaluator import Data.Abstract.Live -import Prologue - -- | Value types, e.g. closures, which can root a set of addresses. class ValueRoots address value where -- | Compute the set of addresses rooted by a given value. valueRoots :: value -> Live address - -- | Retrieve the local 'Live' set. askRoots :: Member (Reader (Live address)) effects => Evaluator address value effects (Live address) askRoots = ask diff --git a/src/Data/Abstract/ModuleTable.hs b/src/Data/Abstract/ModuleTable.hs index 57a2670a5..5efcc0ca9 100644 --- a/src/Data/Abstract/ModuleTable.hs +++ b/src/Data/Abstract/ModuleTable.hs @@ -15,7 +15,6 @@ module Data.Abstract.ModuleTable import Data.Abstract.Module import qualified Data.Map as Map -import Data.Semigroup import GHC.Generics (Generic1) import Prelude hiding (lookup) import Prologue diff --git a/src/Data/Functor/Both.hs b/src/Data/Functor/Both.hs index fb398b781..a1af631b5 100644 --- a/src/Data/Functor/Both.hs +++ b/src/Data/Functor/Both.hs @@ -8,7 +8,6 @@ module Data.Functor.Both import Data.Bifunctor.Join as X import Data.Functor.Classes -import Data.Semigroup -- | A computation over both sides of a pair. type Both = Join (,) diff --git a/src/Data/Functor/Classes/Generic.hs b/src/Data/Functor/Classes/Generic.hs index 1512295e1..b0aa00080 100644 --- a/src/Data/Functor/Classes/Generic.hs +++ b/src/Data/Functor/Classes/Generic.hs @@ -13,7 +13,6 @@ module Data.Functor.Classes.Generic import Data.Functor.Classes import Data.List (intersperse) -import Data.Semigroup import GHC.Generics import Text.Show (showListWith) diff --git a/src/Data/Semigroup/App.hs b/src/Data/Semigroup/App.hs index 4ed13ff3c..c11ff1a08 100644 --- a/src/Data/Semigroup/App.hs +++ b/src/Data/Semigroup/App.hs @@ -5,7 +5,6 @@ module Data.Semigroup.App ) where import Control.Applicative -import Data.Semigroup -- $setup -- >>> import Test.QuickCheck diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index 635b97a91..6c6f84fe1 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DeriveAnyClass, DuplicateRecordFields #-} +{-# LANGUAGE DeriveAnyClass, DuplicateRecordFields, TupleSections #-} module Language.Ruby.Syntax where import Control.Monad (unless) @@ -81,7 +81,7 @@ doRequire :: ( AbstractValue address value effects doRequire path = do result <- lookupModule path case result of - Nothing -> flip (,) (boolean True) . fst <$> load path + Nothing -> (, boolean True) . fst <$> load path Just (env, _) -> pure (env, boolean False) diff --git a/src/Serializing/DOT.hs b/src/Serializing/DOT.hs index 92f41188c..966228ec1 100644 --- a/src/Serializing/DOT.hs +++ b/src/Serializing/DOT.hs @@ -9,7 +9,6 @@ import Algebra.Graph.Export hiding ((<+>)) import Algebra.Graph.Export.Dot hiding (export) import Data.List import Data.String -import Prologue -- | Serialize a graph to DOT format. -- From acb4ac18c3347e3849279d87243f66be39e47bb8 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 13 Jul 2018 12:06:11 -0400 Subject: [PATCH 20/58] Address Rob's concerns. --- src/Analysis/Abstract/Caching.hs | 1 - src/Control/Abstract/Heap.hs | 3 ++- src/Data/Abstract/Evaluatable.hs | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Analysis/Abstract/Caching.hs b/src/Analysis/Abstract/Caching.hs index 8cef1c192..67cb3a23c 100644 --- a/src/Analysis/Abstract/Caching.hs +++ b/src/Analysis/Abstract/Caching.hs @@ -104,7 +104,6 @@ convergingModules recur m = do -- nondeterministic values into @()@. withOracle prevCache (gatherM (const ()) (recur m))) - -- TODO: We're hitting an infinite loop here, c.f test/fixtures/ruby/analysis/graphing/include-file-with-undefined-call TermEvaluator (address =<< runTermEvaluator (maybe empty scatter (cacheLookup c cache))) -- | Iterate a monadic action starting from some initial seed until the results converge. diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index 579990c50..16cfcab93 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -59,7 +59,8 @@ box :: ( Member (Allocator address value) effects => value -> Evaluator address value effects address box val = do - addr <- gensym >>= alloc + name <- gensym + addr <- alloc name assign addr val pure addr diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index d1c8ff330..b235ed56b 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -57,11 +57,11 @@ class (Show1 constr, Foldable constr) => Evaluatable constr where , Member (Reader PackageInfo) effects , Member (Reader Span) effects , Member (Resumable (EnvironmentError address)) effects + , Member (Resumable (Unspecialized value)) effects , Member (Resumable EvalError) effects , Member (Resumable ResolutionError) effects - , Member (Resumable (Unspecialized value)) effects - , Member Trace effects , Member Fresh effects + , Member Trace effects ) => SubtermAlgebra constr term (Evaluator address value effects (ValueRef address)) eval expr = do From 6a65fc0bc03141ad67ee34811006a78477aeb391 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 13 Jul 2018 12:10:17 -0400 Subject: [PATCH 21/58] Fix otiose parts of the diff. --- src/Analysis/Abstract/Caching.hs | 1 - .../graphing/include-file-with-undefined-call/main.rb | 7 ------- .../graphing/include-file-with-undefined-call/target.rb | 3 --- 3 files changed, 11 deletions(-) delete mode 100644 test/fixtures/ruby/analysis/graphing/include-file-with-undefined-call/main.rb delete mode 100644 test/fixtures/ruby/analysis/graphing/include-file-with-undefined-call/target.rb diff --git a/src/Analysis/Abstract/Caching.hs b/src/Analysis/Abstract/Caching.hs index 67cb3a23c..481f50a1d 100644 --- a/src/Analysis/Abstract/Caching.hs +++ b/src/Analysis/Abstract/Caching.hs @@ -103,7 +103,6 @@ convergingModules recur m = do -- would never complete). We don’t need to use the values, so we 'gather' the -- nondeterministic values into @()@. withOracle prevCache (gatherM (const ()) (recur m))) - TermEvaluator (address =<< runTermEvaluator (maybe empty scatter (cacheLookup c cache))) -- | Iterate a monadic action starting from some initial seed until the results converge. diff --git a/test/fixtures/ruby/analysis/graphing/include-file-with-undefined-call/main.rb b/test/fixtures/ruby/analysis/graphing/include-file-with-undefined-call/main.rb deleted file mode 100644 index 92e64d33a..000000000 --- a/test/fixtures/ruby/analysis/graphing/include-file-with-undefined-call/main.rb +++ /dev/null @@ -1,7 +0,0 @@ -require './target' - -def go() - "done" -end - -go() diff --git a/test/fixtures/ruby/analysis/graphing/include-file-with-undefined-call/target.rb b/test/fixtures/ruby/analysis/graphing/include-file-with-undefined-call/target.rb deleted file mode 100644 index 678daf934..000000000 --- a/test/fixtures/ruby/analysis/graphing/include-file-with-undefined-call/target.rb +++ /dev/null @@ -1,3 +0,0 @@ -barf() - -def foo(); end From 435d296b6c5cf60583500d228f12fe2dd63e7a5c Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Fri, 13 Jul 2018 09:31:24 -0700 Subject: [PATCH 22/58] Avoid `>>=` in `do` blocks --- src/Language/TypeScript/Syntax.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Language/TypeScript/Syntax.hs b/src/Language/TypeScript/Syntax.hs index a94067956..3fba9f25f 100644 --- a/src/Language/TypeScript/Syntax.hs +++ b/src/Language/TypeScript/Syntax.hs @@ -273,7 +273,8 @@ instance Evaluatable DefaultExport where case declaredName term of Just name -> do addr <- lookupOrAlloc name - subtermValue term >>= assign addr + v <- subtermValue term + assign addr v export name name Nothing bind name addr Nothing -> throwEvalError DefaultExportError From b928f7879ade7fdefe4e22e31e747e04f1de5ba1 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Fri, 13 Jul 2018 09:32:34 -0700 Subject: [PATCH 23/58] Use higher order `declaredName` function in `Declarations1` instance --- src/Data/Abstract/Declarations.hs | 4 ++-- src/Data/Syntax/Declaration.hs | 4 +++- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/Data/Abstract/Declarations.hs b/src/Data/Abstract/Declarations.hs index d9e2a3573..a15c74f04 100644 --- a/src/Data/Abstract/Declarations.hs +++ b/src/Data/Abstract/Declarations.hs @@ -13,7 +13,7 @@ class Declarations syntax where class Declarations1 syntax where -- | Lift a function mapping each element to its set of free variables through a containing structure, collecting the results into a single set. - liftDeclaredName :: Declarations a => (a -> [Name]) -> syntax a -> Maybe Name + liftDeclaredName :: (a -> [Name]) -> syntax a -> Maybe Name liftDeclaredName _ _ = Nothing instance Declarations t => Declarations (Subterm t a) where @@ -21,7 +21,7 @@ instance Declarations t => Declarations (Subterm t a) where deriving instance (Declarations1 syntax, FreeVariables1 syntax) => Declarations (Term syntax ann) -instance (Declarations recur, FreeVariables recur, Declarations1 syntax) => Declarations (TermF syntax ann recur) where +instance (FreeVariables recur, Declarations1 syntax) => Declarations (TermF syntax ann recur) where declaredName = liftDeclaredName freeVariables . termFOut instance (Apply Declarations1 fs) => Declarations1 (Sum fs) where diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index bf10221dd..bad9e0a35 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -34,7 +34,9 @@ instance Declarations a => Declarations (Function a) where declaredName Function{..} = declaredName functionName instance Declarations1 Function where - liftDeclaredName _ = declaredName + liftDeclaredName declaredName Function{..} = case declaredName functionName of + [] -> Nothing + (x:_) -> Just x data Method a = Method { methodContext :: ![a], methodReceiver :: !a, methodName :: !a, methodParameters :: ![a], methodBody :: !a } deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Mergeable, FreeVariables1, Declarations1, ToJSONFields1, Named1, Message1) From 6b3d930066ddbbb2fea04811bd7c9d2c652f2e7a Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 13 Jul 2018 12:42:26 -0400 Subject: [PATCH 24/58] Fix lints. --- src/Control/Abstract/Environment.hs | 2 +- src/Data/Abstract/Environment.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Control/Abstract/Environment.hs b/src/Control/Abstract/Environment.hs index 2c8225426..3e237ef9e 100644 --- a/src/Control/Abstract/Environment.hs +++ b/src/Control/Abstract/Environment.hs @@ -31,7 +31,7 @@ getEnv :: Member (Env address) effects => Evaluator address value effects (Envir getEnv = send GetEnv -- | Replace the environment. This is only for use in Analysis.Abstract.Caching. -putEnv :: Member (Env address) effects => (Environment address) -> Evaluator address value effects () +putEnv :: Member (Env address) effects => Environment address -> Evaluator address value effects () putEnv = send . PutEnv -- | Add an export to the global export state. diff --git a/src/Data/Abstract/Environment.hs b/src/Data/Abstract/Environment.hs index d6e87da73..7f56e62c9 100644 --- a/src/Data/Abstract/Environment.hs +++ b/src/Data/Abstract/Environment.hs @@ -152,4 +152,4 @@ addresses = fromAddresses . map snd . flatPairs instance Lower (Environment address) where lowerBound = Environment (lowerBound :| []) instance Show address => Show (Environment address) where - showsPrec d = showsUnaryWith showsPrec "Environment" d + showsPrec = showsUnaryWith showsPrec "Environment" From 9674d78075842836fe0682e3047af1278ce5fa68 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Fri, 13 Jul 2018 09:49:43 -0700 Subject: [PATCH 25/58] Adjust indentation --- src/Data/Syntax/Declaration.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index bad9e0a35..94c020d08 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -34,9 +34,10 @@ instance Declarations a => Declarations (Function a) where declaredName Function{..} = declaredName functionName instance Declarations1 Function where - liftDeclaredName declaredName Function{..} = case declaredName functionName of - [] -> Nothing - (x:_) -> Just x + liftDeclaredName declaredName Function{..} = + case declaredName functionName of + [] -> Nothing + (x:_) -> Just x data Method a = Method { methodContext :: ![a], methodReceiver :: !a, methodName :: !a, methodParameters :: ![a], methodBody :: !a } deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Mergeable, FreeVariables1, Declarations1, ToJSONFields1, Named1, Message1) From 37db866b7ac4cf9c96cf1ecd2c1634bdcaa6440f Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 13 Jul 2018 13:25:21 -0400 Subject: [PATCH 26/58] changing that Show instance caused the doctests to loop infinitely --- src/Data/Abstract/Environment.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Data/Abstract/Environment.hs b/src/Data/Abstract/Environment.hs index 7f56e62c9..25f3557ab 100644 --- a/src/Data/Abstract/Environment.hs +++ b/src/Data/Abstract/Environment.hs @@ -151,5 +151,8 @@ addresses = fromAddresses . map snd . flatPairs instance Lower (Environment address) where lowerBound = Environment (lowerBound :| []) +-- N.B. this show instance drops some information to avoid generating +-- an infinite string in certain cases. As such, two unequal +-- environments may produce equal outputs over Show. instance Show address => Show (Environment address) where - showsPrec = showsUnaryWith showsPrec "Environment" + showsPrec d = showsUnaryWith showsPrec "Environment" d . flatPairs From 6136ea09215000247fe9ce9ec353c4565d98b8eb Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 13 Jul 2018 13:38:05 -0400 Subject: [PATCH 27/58] every license ever --- .licenses/semantic/cabal/QuickCheck.txt | 4 +- .licenses/semantic/cabal/async.txt | 4 +- .../semantic/cabal/base-compat-batteries.txt | 27 ++++++++++++ .licenses/semantic/cabal/base-compat.txt | 8 ++-- .licenses/semantic/cabal/base-prelude.txt | 4 +- .licenses/semantic/cabal/base.txt | 4 +- .licenses/semantic/cabal/bifunctors.txt | 4 +- .licenses/semantic/cabal/cmark-gfm.txt | 4 +- .licenses/semantic/cabal/comonad.txt | 4 +- .licenses/semantic/cabal/containers.txt | 6 +-- .licenses/semantic/cabal/directory.txt | 16 ++++---- .licenses/semantic/cabal/exceptions.txt | 4 +- .licenses/semantic/cabal/fail.txt | 38 ----------------- .licenses/semantic/cabal/filepath.txt | 6 +-- .licenses/semantic/cabal/foldl.txt | 4 +- .licenses/semantic/cabal/ghc-boot-th.txt | 4 +- .licenses/semantic/cabal/ghc-boot.txt | 4 +- .licenses/semantic/cabal/ghc-prim.txt | 5 +-- .../semantic/cabal/ghc-tcplugins-extra.txt | 4 +- .../semantic/cabal/ghc-typelits-extra.txt | 4 +- .../semantic/cabal/ghc-typelits-knownnat.txt | 4 +- .../cabal/ghc-typelits-natnormalise.txt | 4 +- .licenses/semantic/cabal/ghc.txt | 4 +- .licenses/semantic/cabal/ghci.txt | 4 +- .licenses/semantic/cabal/hoopl.txt | 41 ------------------- .licenses/semantic/cabal/http-client.txt | 4 +- .licenses/semantic/cabal/integer-gmp.txt | 6 +-- .licenses/semantic/cabal/invariant.txt | 31 ++++++++++++++ .licenses/semantic/cabal/kan-extensions.txt | 4 +- .licenses/semantic/cabal/keys.txt | 4 +- .licenses/semantic/cabal/megaparsec.txt | 34 +++++++++++++++ .licenses/semantic/cabal/mime-types.txt | 4 +- .../semantic/cabal/neat-interpolation.txt | 2 +- .licenses/semantic/cabal/network.txt | 4 +- .../semantic/cabal/parser-combinators.txt | 36 ++++++++++++++++ .licenses/semantic/cabal/parsers.txt | 4 +- .licenses/semantic/cabal/pretty.txt | 12 +++--- .licenses/semantic/cabal/process.txt | 16 ++++---- .../semantic/cabal/quickcheck-instances.txt | 4 +- .../semantic/cabal/recursion-schemes.txt | 4 +- .licenses/semantic/cabal/reducers.txt | 4 +- .licenses/semantic/cabal/reflection.txt | 4 +- .licenses/semantic/cabal/semigroups.txt | 4 +- .../semantic/cabal/streaming-commons.txt | 2 +- .licenses/semantic/cabal/swagger2.txt | 5 +-- .licenses/semantic/cabal/template-haskell.txt | 7 ++-- .licenses/semantic/cabal/temporary.txt | 4 +- .licenses/semantic/cabal/terminfo.txt | 4 +- .licenses/semantic/cabal/th-abstraction.txt | 4 +- .../semantic/cabal/transformers-base.txt | 17 ++++---- .../semantic/cabal/transformers-compat.txt | 7 ++-- .licenses/semantic/cabal/transformers.txt | 6 +-- .licenses/semantic/cabal/turtle.txt | 4 +- 53 files changed, 250 insertions(+), 206 deletions(-) create mode 100644 .licenses/semantic/cabal/base-compat-batteries.txt delete mode 100644 .licenses/semantic/cabal/fail.txt delete mode 100644 .licenses/semantic/cabal/hoopl.txt create mode 100644 .licenses/semantic/cabal/invariant.txt create mode 100644 .licenses/semantic/cabal/megaparsec.txt create mode 100644 .licenses/semantic/cabal/parser-combinators.txt diff --git a/.licenses/semantic/cabal/QuickCheck.txt b/.licenses/semantic/cabal/QuickCheck.txt index 2b60b66a5..7895917c7 100644 --- a/.licenses/semantic/cabal/QuickCheck.txt +++ b/.licenses/semantic/cabal/QuickCheck.txt @@ -1,7 +1,7 @@ --- type: cabal name: QuickCheck -version: 2.10.1 +version: 2.11.3 summary: Automatic testing of Haskell programs homepage: https://github.com/nick8325/quickcheck license: bsd-3-clause @@ -34,4 +34,4 @@ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/async.txt b/.licenses/semantic/cabal/async.txt index 00949ba94..54ddc5aa6 100644 --- a/.licenses/semantic/cabal/async.txt +++ b/.licenses/semantic/cabal/async.txt @@ -1,7 +1,7 @@ --- type: cabal name: async -version: 2.1.1.1 +version: 2.2.1 summary: Run IO operations asynchronously and wait for their results homepage: https://github.com/simonmar/async license: bsd-3-clause @@ -35,4 +35,4 @@ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/base-compat-batteries.txt b/.licenses/semantic/cabal/base-compat-batteries.txt new file mode 100644 index 000000000..eaa71c1e5 --- /dev/null +++ b/.licenses/semantic/cabal/base-compat-batteries.txt @@ -0,0 +1,27 @@ +--- +type: cabal +name: base-compat-batteries +version: 0.10.1 +summary: base-compat with extra batteries +homepage: +license: mit +--- +Copyright (c) 2012-2018 Simon Hengel and Ryan Scott + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN +THE SOFTWARE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/base-compat.txt b/.licenses/semantic/cabal/base-compat.txt index 0d7e3297d..a15d24aa1 100644 --- a/.licenses/semantic/cabal/base-compat.txt +++ b/.licenses/semantic/cabal/base-compat.txt @@ -1,12 +1,12 @@ --- type: cabal name: base-compat -version: 0.9.3 +version: 0.10.4 summary: A compatibility layer for base -homepage: https://github.com/haskell-compat/base-compat +homepage: license: mit --- -Copyright (c) 2012-2017 Simon Hengel and Ryan Scott +Copyright (c) 2012-2018 Simon Hengel and Ryan Scott Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal @@ -24,4 +24,4 @@ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN -THE SOFTWARE. +THE SOFTWARE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/base-prelude.txt b/.licenses/semantic/cabal/base-prelude.txt index c95eb2e71..f1da8f7ab 100644 --- a/.licenses/semantic/cabal/base-prelude.txt +++ b/.licenses/semantic/cabal/base-prelude.txt @@ -1,7 +1,7 @@ --- type: cabal name: base-prelude -version: 1.2.1 +version: '1.3' summary: The most complete prelude formed solely from the "base" package homepage: https://github.com/nikita-volkov/base-prelude license: mit @@ -27,4 +27,4 @@ NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR -OTHER DEALINGS IN THE SOFTWARE. +OTHER DEALINGS IN THE SOFTWARE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/base.txt b/.licenses/semantic/cabal/base.txt index f635e3d4d..259331920 100644 --- a/.licenses/semantic/cabal/base.txt +++ b/.licenses/semantic/cabal/base.txt @@ -1,7 +1,7 @@ --- type: cabal name: base -version: 4.10.1.0 +version: 4.11.1.0 summary: Basic libraries homepage: license: bsd-3-clause @@ -88,4 +88,4 @@ the following license: version is clearly presented as such, and that it does not claim to be a definition of the Haskell 98 Foreign Function Interface. ------------------------------------------------------------------------------ +----------------------------------------------------------------------------- \ No newline at end of file diff --git a/.licenses/semantic/cabal/bifunctors.txt b/.licenses/semantic/cabal/bifunctors.txt index 86ab3841b..ad41b0bcb 100644 --- a/.licenses/semantic/cabal/bifunctors.txt +++ b/.licenses/semantic/cabal/bifunctors.txt @@ -1,7 +1,7 @@ --- type: cabal name: bifunctors -version: 5.5.2 +version: 5.5.3 summary: Bifunctors homepage: https://github.com/ekmett/bifunctors/ license: bsd-2-clause @@ -31,4 +31,4 @@ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -POSSIBILITY OF SUCH DAMAGE. +POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/cmark-gfm.txt b/.licenses/semantic/cabal/cmark-gfm.txt index 5fa19d73f..f9d254976 100644 --- a/.licenses/semantic/cabal/cmark-gfm.txt +++ b/.licenses/semantic/cabal/cmark-gfm.txt @@ -1,7 +1,7 @@ --- type: cabal name: cmark-gfm -version: 0.1.3 +version: 0.1.4 summary: Fast, accurate GitHub Flavored Markdown parser and renderer homepage: https://github.com/kivikakk/cmark-gfm-hs license: multiple @@ -141,4 +141,4 @@ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER -DEALINGS IN THE SOFTWARE. +DEALINGS IN THE SOFTWARE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/comonad.txt b/.licenses/semantic/cabal/comonad.txt index e446f16ce..66c8bf659 100644 --- a/.licenses/semantic/cabal/comonad.txt +++ b/.licenses/semantic/cabal/comonad.txt @@ -1,7 +1,7 @@ --- type: cabal name: comonad -version: 5.0.3 +version: 5.0.4 summary: Comonads homepage: https://github.com/ekmett/comonad/ license: bsd-2-clause @@ -32,4 +32,4 @@ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -POSSIBILITY OF SUCH DAMAGE. +POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/containers.txt b/.licenses/semantic/cabal/containers.txt index 4d981dc8e..07dec3c57 100644 --- a/.licenses/semantic/cabal/containers.txt +++ b/.licenses/semantic/cabal/containers.txt @@ -1,9 +1,9 @@ --- type: cabal name: containers -version: 0.5.10.2 +version: 0.5.11.0 summary: Assorted concrete container types -homepage: https://github.com/haskell/containers +homepage: license: bsd-3-clause --- The Glasgow Haskell Compiler License @@ -36,4 +36,4 @@ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH -DAMAGE. +DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/directory.txt b/.licenses/semantic/cabal/directory.txt index 1073a6c32..924f4b879 100644 --- a/.licenses/semantic/cabal/directory.txt +++ b/.licenses/semantic/cabal/directory.txt @@ -1,13 +1,13 @@ --- type: cabal name: directory -version: 1.3.0.2 +version: 1.3.1.5 summary: Platform-agnostic library for filesystem operations -homepage: https://github.com/haskell/directory +homepage: license: bsd-3-clause --- This library (libraries/base) is derived from code from two -sources: +sources: * Code from the GHC project which is largely (c) The University of Glasgow, and distributable under a BSD-style license (see below), @@ -23,7 +23,7 @@ licenses are BSD-style or compatible. The Glasgow Haskell Compiler License -Copyright 2004, The University Court of the University of Glasgow. +Copyright 2004, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without @@ -31,14 +31,14 @@ modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - + - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - + - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without -specific prior written permission. +specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, @@ -68,4 +68,4 @@ Haskell 98", is distributed under the following license: version is clearly presented as such, and that it does not claim to be a definition of the Haskell 98 Language. ------------------------------------------------------------------------------ +----------------------------------------------------------------------------- \ No newline at end of file diff --git a/.licenses/semantic/cabal/exceptions.txt b/.licenses/semantic/cabal/exceptions.txt index cb9aa0c34..37e993e22 100644 --- a/.licenses/semantic/cabal/exceptions.txt +++ b/.licenses/semantic/cabal/exceptions.txt @@ -1,7 +1,7 @@ --- type: cabal name: exceptions -version: 0.8.3 +version: 0.10.0 summary: Extensible optionally-pure exceptions homepage: https://github.com/ekmett/exceptions/ license: bsd-3-clause @@ -36,4 +36,4 @@ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -POSSIBILITY OF SUCH DAMAGE. +POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/fail.txt b/.licenses/semantic/cabal/fail.txt deleted file mode 100644 index 5813f1a22..000000000 --- a/.licenses/semantic/cabal/fail.txt +++ /dev/null @@ -1,38 +0,0 @@ ---- -type: cabal -name: fail -version: 4.9.0.0 -summary: Forward-compatible MonadFail class -homepage: https://prime.haskell.org/wiki/Libraries/Proposals/MonadFail -license: bsd-3-clause ---- -Copyright (c) 2015, David Luposchainsky & Herbert Valerio Riedel - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Herbert Valerio Riedel nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/.licenses/semantic/cabal/filepath.txt b/.licenses/semantic/cabal/filepath.txt index 519ef4455..69b1e218c 100644 --- a/.licenses/semantic/cabal/filepath.txt +++ b/.licenses/semantic/cabal/filepath.txt @@ -1,12 +1,12 @@ --- type: cabal name: filepath -version: 1.4.1.2 +version: 1.4.2 summary: Library for manipulating FilePaths in a cross platform way. homepage: https://github.com/haskell/filepath license: bsd-3-clause --- -Copyright Neil Mitchell 2005-2017. +Copyright Neil Mitchell 2005-2018. All rights reserved. Redistribution and use in source and binary forms, with or without @@ -35,4 +35,4 @@ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/foldl.txt b/.licenses/semantic/cabal/foldl.txt index f2992c91a..79f52cc9e 100644 --- a/.licenses/semantic/cabal/foldl.txt +++ b/.licenses/semantic/cabal/foldl.txt @@ -1,7 +1,7 @@ --- type: cabal name: foldl -version: 1.3.7 +version: 1.4.2 summary: Composable, streaming, and efficient left folds homepage: license: bsd-3-clause @@ -29,4 +29,4 @@ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/ghc-boot-th.txt b/.licenses/semantic/cabal/ghc-boot-th.txt index 6952609bb..60d7cd1d2 100644 --- a/.licenses/semantic/cabal/ghc-boot-th.txt +++ b/.licenses/semantic/cabal/ghc-boot-th.txt @@ -1,7 +1,7 @@ --- type: cabal name: ghc-boot-th -version: 8.2.2 +version: 8.4.3 summary: Shared functionality between GHC and the @template-haskell@ homepage: license: bsd-3-clause @@ -36,4 +36,4 @@ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH -DAMAGE. +DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/ghc-boot.txt b/.licenses/semantic/cabal/ghc-boot.txt index bbe2562f7..f0dac7074 100644 --- a/.licenses/semantic/cabal/ghc-boot.txt +++ b/.licenses/semantic/cabal/ghc-boot.txt @@ -1,7 +1,7 @@ --- type: cabal name: ghc-boot -version: 8.2.2 +version: 8.4.3 summary: Shared functionality between GHC and its boot libraries homepage: license: bsd-3-clause @@ -36,4 +36,4 @@ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH -DAMAGE. +DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/ghc-prim.txt b/.licenses/semantic/cabal/ghc-prim.txt index e4c4a419e..578e57be2 100644 --- a/.licenses/semantic/cabal/ghc-prim.txt +++ b/.licenses/semantic/cabal/ghc-prim.txt @@ -1,7 +1,7 @@ --- type: cabal name: ghc-prim -version: 0.5.1.1 +version: 0.5.2.0 summary: GHC primitives homepage: license: bsd-3-clause @@ -66,5 +66,4 @@ Haskell 98", is distributed under the following license: including this Notice. Modified versions of this Report may also be copied and distributed for any purpose, provided that the modified version is clearly presented as such, and that it does not claim to - be a definition of the Haskell 98 Language. - + be a definition of the Haskell 98 Language. \ No newline at end of file diff --git a/.licenses/semantic/cabal/ghc-tcplugins-extra.txt b/.licenses/semantic/cabal/ghc-tcplugins-extra.txt index 5ffef0f01..bb1d87031 100644 --- a/.licenses/semantic/cabal/ghc-tcplugins-extra.txt +++ b/.licenses/semantic/cabal/ghc-tcplugins-extra.txt @@ -1,7 +1,7 @@ --- type: cabal name: ghc-tcplugins-extra -version: 0.2.5 +version: '0.3' summary: Utilities for writing GHC type-checker plugins homepage: https://github.com/clash-lang/ghc-tcplugins-extra license: bsd-2-clause @@ -32,4 +32,4 @@ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/ghc-typelits-extra.txt b/.licenses/semantic/cabal/ghc-typelits-extra.txt index 483524e07..45883551c 100644 --- a/.licenses/semantic/cabal/ghc-typelits-extra.txt +++ b/.licenses/semantic/cabal/ghc-typelits-extra.txt @@ -1,7 +1,7 @@ --- type: cabal name: ghc-typelits-extra -version: 0.2.4 +version: 0.2.5 summary: Additional type-level operations on GHC.TypeLits.Nat homepage: https://www.clash-lang.org/ license: bsd-2-clause @@ -32,4 +32,4 @@ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/ghc-typelits-knownnat.txt b/.licenses/semantic/cabal/ghc-typelits-knownnat.txt index ff71adf4a..648e54960 100644 --- a/.licenses/semantic/cabal/ghc-typelits-knownnat.txt +++ b/.licenses/semantic/cabal/ghc-typelits-knownnat.txt @@ -1,7 +1,7 @@ --- type: cabal name: ghc-typelits-knownnat -version: 0.4.2 +version: '0.5' summary: Derive KnownNat constraints from other KnownNat constraints homepage: https://clash-lang.org/ license: bsd-2-clause @@ -33,4 +33,4 @@ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/ghc-typelits-natnormalise.txt b/.licenses/semantic/cabal/ghc-typelits-natnormalise.txt index 0d1f8e1cd..97170d80b 100644 --- a/.licenses/semantic/cabal/ghc-typelits-natnormalise.txt +++ b/.licenses/semantic/cabal/ghc-typelits-natnormalise.txt @@ -1,7 +1,7 @@ --- type: cabal name: ghc-typelits-natnormalise -version: 0.5.10 +version: 0.6.1 summary: GHC typechecker plugin for types of kind GHC.TypeLits.Nat homepage: https://www.clash-lang.org/ license: bsd-2-clause @@ -32,4 +32,4 @@ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/ghc.txt b/.licenses/semantic/cabal/ghc.txt index 4379a004f..2be721bcf 100644 --- a/.licenses/semantic/cabal/ghc.txt +++ b/.licenses/semantic/cabal/ghc.txt @@ -1,7 +1,7 @@ --- type: cabal name: ghc -version: 8.2.2 +version: 8.4.3 summary: The GHC API homepage: https://www.haskell.org/ghc/ license: bsd-3-clause @@ -36,4 +36,4 @@ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH -DAMAGE. +DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/ghci.txt b/.licenses/semantic/cabal/ghci.txt index e978664f1..26a7f4682 100644 --- a/.licenses/semantic/cabal/ghci.txt +++ b/.licenses/semantic/cabal/ghci.txt @@ -1,7 +1,7 @@ --- type: cabal name: ghci -version: 8.2.2 +version: 8.4.3 summary: The library supporting GHC's interactive interpreter homepage: license: bsd-3-clause @@ -36,4 +36,4 @@ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH -DAMAGE. +DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/hoopl.txt b/.licenses/semantic/cabal/hoopl.txt deleted file mode 100644 index 143308094..000000000 --- a/.licenses/semantic/cabal/hoopl.txt +++ /dev/null @@ -1,41 +0,0 @@ ---- -type: cabal -name: hoopl -version: 3.10.2.2 -summary: A library to support dataflow analysis and optimization -homepage: https://github.com/haskell/hoopl -license: bsd-3-clause ---- -Copyright (c) 2010, Jo�o Dias, Simon Marlow, Simon Peyton Jones, and Norman Ramsey -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are -met: - -Redistributions of source code must retain the above copyright notice, -this list of conditions and the following disclaimer. - -Redistributions in binary form must reproduce the above copyright -notice, this list of conditions and the following disclaimer in the -documentation and/or other materials provided with the distribution. - -Neither the name of Tufts University nor the names of its -contributors may be used to endorse or promote products derived from -this software without specific prior written permission. - -Neither the name of Microsoft nor the names of its -contributors may be used to endorse or promote products derived from -this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/.licenses/semantic/cabal/http-client.txt b/.licenses/semantic/cabal/http-client.txt index 99b81e9aa..146fe6645 100644 --- a/.licenses/semantic/cabal/http-client.txt +++ b/.licenses/semantic/cabal/http-client.txt @@ -1,7 +1,7 @@ --- type: cabal name: http-client -version: 0.5.12.1 +version: 0.5.13.1 summary: An HTTP client engine homepage: https://github.com/snoyberg/http-client license: mit @@ -25,4 +25,4 @@ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN -CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/integer-gmp.txt b/.licenses/semantic/cabal/integer-gmp.txt index f77694a0d..1ffa4b926 100644 --- a/.licenses/semantic/cabal/integer-gmp.txt +++ b/.licenses/semantic/cabal/integer-gmp.txt @@ -1,9 +1,9 @@ --- type: cabal name: integer-gmp -version: 1.0.1.0 +version: 1.0.2.0 summary: Integer library based on GMP -homepage: +homepage: license: bsd-3-clause --- Copyright (c) 2014, Herbert Valerio Riedel @@ -35,4 +35,4 @@ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/invariant.txt b/.licenses/semantic/cabal/invariant.txt new file mode 100644 index 000000000..56dead591 --- /dev/null +++ b/.licenses/semantic/cabal/invariant.txt @@ -0,0 +1,31 @@ +--- +type: cabal +name: invariant +version: '0.5' +summary: Haskell98 invariant functors +homepage: https://github.com/nfrisby/invariant-functors +license: bsd-2-clause +--- +Copyright (c) 2012-2017, University of Kansas +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/kan-extensions.txt b/.licenses/semantic/cabal/kan-extensions.txt index 32e8f7b88..c29662917 100644 --- a/.licenses/semantic/cabal/kan-extensions.txt +++ b/.licenses/semantic/cabal/kan-extensions.txt @@ -1,7 +1,7 @@ --- type: cabal name: kan-extensions -version: '5.1' +version: '5.2' summary: Kan extensions, Kan lifts, the Yoneda lemma, and (co)density (co)monads homepage: https://github.com/ekmett/kan-extensions/ license: bsd-3-clause @@ -35,4 +35,4 @@ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -POSSIBILITY OF SUCH DAMAGE. +POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/keys.txt b/.licenses/semantic/cabal/keys.txt index d6ed31e1e..38e7417ac 100644 --- a/.licenses/semantic/cabal/keys.txt +++ b/.licenses/semantic/cabal/keys.txt @@ -1,7 +1,7 @@ --- type: cabal name: keys -version: '3.12' +version: 3.12.1 summary: Keyed functors and containers homepage: https://github.com/ekmett/keys/ license: bsd-3-clause @@ -35,4 +35,4 @@ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -POSSIBILITY OF SUCH DAMAGE. +POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/megaparsec.txt b/.licenses/semantic/cabal/megaparsec.txt new file mode 100644 index 000000000..dcff8edf2 --- /dev/null +++ b/.licenses/semantic/cabal/megaparsec.txt @@ -0,0 +1,34 @@ +--- +type: cabal +name: megaparsec +version: 6.5.0 +summary: Monadic parser combinators +homepage: https://github.com/mrkkrp/megaparsec +license: other +--- +Copyright © 2015–2018 Megaparsec contributors
+Copyright © 2007 Paolo Martini
+Copyright © 1999–2000 Daan Leijen + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY EXPRESS +OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN +NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, +OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, +EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/mime-types.txt b/.licenses/semantic/cabal/mime-types.txt index f2b42ac46..ba18034b9 100644 --- a/.licenses/semantic/cabal/mime-types.txt +++ b/.licenses/semantic/cabal/mime-types.txt @@ -1,7 +1,7 @@ --- type: cabal name: mime-types -version: 0.1.0.7 +version: 0.1.0.8 summary: Basic mime-type handling types and functions homepage: https://github.com/yesodweb/wai license: mit @@ -25,4 +25,4 @@ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION -WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/neat-interpolation.txt b/.licenses/semantic/cabal/neat-interpolation.txt index 876eed2b2..06f105386 100644 --- a/.licenses/semantic/cabal/neat-interpolation.txt +++ b/.licenses/semantic/cabal/neat-interpolation.txt @@ -1,7 +1,7 @@ --- type: cabal name: neat-interpolation -version: 0.3.2.1 +version: 0.3.2.2 summary: A quasiquoter for neat and simple multiline text interpolation homepage: https://github.com/nikita-volkov/neat-interpolation license: mit diff --git a/.licenses/semantic/cabal/network.txt b/.licenses/semantic/cabal/network.txt index ad171f83c..56e63d694 100644 --- a/.licenses/semantic/cabal/network.txt +++ b/.licenses/semantic/cabal/network.txt @@ -1,7 +1,7 @@ --- type: cabal name: network -version: 2.6.3.5 +version: 2.6.3.6 summary: Low-level networking interface homepage: https://github.com/haskell/network license: bsd-3-clause @@ -34,4 +34,4 @@ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH -DAMAGE. +DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/parser-combinators.txt b/.licenses/semantic/cabal/parser-combinators.txt new file mode 100644 index 000000000..3f1b28f04 --- /dev/null +++ b/.licenses/semantic/cabal/parser-combinators.txt @@ -0,0 +1,36 @@ +--- +type: cabal +name: parser-combinators +version: 1.0.0 +summary: Lightweight package providing commonly useful parser combinators +homepage: https://github.com/mrkkrp/parser-combinators +license: other +--- +Copyright © 2017–2018 Mark Karpov + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +* Neither the name Mark Karpov nor the names of contributors may be used to + endorse or promote products derived from this software without specific + prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY EXPRESS +OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN +NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, +OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, +EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/parsers.txt b/.licenses/semantic/cabal/parsers.txt index 977bebcb0..1b066420b 100644 --- a/.licenses/semantic/cabal/parsers.txt +++ b/.licenses/semantic/cabal/parsers.txt @@ -1,7 +1,7 @@ --- type: cabal name: parsers -version: 0.12.8 +version: 0.12.9 summary: Parsing combinators homepage: https://github.com/ekmett/parsers/ license: bsd-3-clause @@ -35,4 +35,4 @@ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -POSSIBILITY OF SUCH DAMAGE. +POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/pretty.txt b/.licenses/semantic/cabal/pretty.txt index 5f42e1527..c832bf15f 100644 --- a/.licenses/semantic/cabal/pretty.txt +++ b/.licenses/semantic/cabal/pretty.txt @@ -1,7 +1,7 @@ --- type: cabal name: pretty -version: 1.1.3.3 +version: 1.1.3.6 summary: Pretty-printing library homepage: https://github.com/haskell/pretty license: bsd-3-clause @@ -14,7 +14,7 @@ Glasgow, and distributable under a BSD-style license (see below). The Glasgow Haskell Compiler License -Copyright 2004, The University Court of the University of Glasgow. +Copyright 2004, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without @@ -22,14 +22,14 @@ modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - + - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - + - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without -specific prior written permission. +specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, @@ -44,4 +44,4 @@ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ------------------------------------------------------------------------------ +----------------------------------------------------------------------------- \ No newline at end of file diff --git a/.licenses/semantic/cabal/process.txt b/.licenses/semantic/cabal/process.txt index 6cddc7436..a8172524d 100644 --- a/.licenses/semantic/cabal/process.txt +++ b/.licenses/semantic/cabal/process.txt @@ -1,13 +1,13 @@ --- type: cabal name: process -version: 1.6.1.0 +version: 1.6.3.0 summary: Process libraries -homepage: https://github.com/haskell/process +homepage: license: bsd-3-clause --- This library (libraries/process) is derived from code from two -sources: +sources: * Code from the GHC project which is largely (c) The University of Glasgow, and distributable under a BSD-style license (see below), @@ -23,7 +23,7 @@ licenses are BSD-style or compatible. The Glasgow Haskell Compiler License -Copyright 2004, The University Court of the University of Glasgow. +Copyright 2004, The University Court of the University of Glasgow. All rights reserved. Redistribution and use in source and binary forms, with or without @@ -31,14 +31,14 @@ modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - + - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - + - Neither name of the University nor the names of its contributors may be used to endorse or promote products derived from this software without -specific prior written permission. +specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, @@ -68,4 +68,4 @@ Haskell 98", is distributed under the following license: version is clearly presented as such, and that it does not claim to be a definition of the Haskell 98 Language. ------------------------------------------------------------------------------ +----------------------------------------------------------------------------- \ No newline at end of file diff --git a/.licenses/semantic/cabal/quickcheck-instances.txt b/.licenses/semantic/cabal/quickcheck-instances.txt index 3225681b8..ca3b0d89f 100644 --- a/.licenses/semantic/cabal/quickcheck-instances.txt +++ b/.licenses/semantic/cabal/quickcheck-instances.txt @@ -1,7 +1,7 @@ --- type: cabal name: quickcheck-instances -version: 0.3.16.1 +version: 0.3.18 summary: Common quickcheck instances homepage: https://github.com/phadej/qc-instances license: bsd-3-clause @@ -35,4 +35,4 @@ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/recursion-schemes.txt b/.licenses/semantic/cabal/recursion-schemes.txt index c05c7096e..7aa28b05b 100644 --- a/.licenses/semantic/cabal/recursion-schemes.txt +++ b/.licenses/semantic/cabal/recursion-schemes.txt @@ -1,7 +1,7 @@ --- type: cabal name: recursion-schemes -version: 5.0.2 +version: 5.0.3 summary: Generalized bananas, lenses and barbed wire homepage: https://github.com/ekmett/recursion-schemes/ license: bsd-2-clause @@ -31,4 +31,4 @@ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -POSSIBILITY OF SUCH DAMAGE. +POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/reducers.txt b/.licenses/semantic/cabal/reducers.txt index 728878f0c..7f5626b85 100644 --- a/.licenses/semantic/cabal/reducers.txt +++ b/.licenses/semantic/cabal/reducers.txt @@ -1,7 +1,7 @@ --- type: cabal name: reducers -version: 3.12.2 +version: 3.12.3 summary: Semigroups, specialized containers and a general map/reduce framework homepage: https://github.com/ekmett/reducers/ license: bsd-3-clause @@ -35,4 +35,4 @@ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -POSSIBILITY OF SUCH DAMAGE. +POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/reflection.txt b/.licenses/semantic/cabal/reflection.txt index 9cd1990bf..439910394 100644 --- a/.licenses/semantic/cabal/reflection.txt +++ b/.licenses/semantic/cabal/reflection.txt @@ -1,7 +1,7 @@ --- type: cabal name: reflection -version: 2.1.3 +version: 2.1.4 summary: Reifies arbitrary terms into types that can be reflected back into terms homepage: https://github.com/ekmett/reflection license: bsd-3-clause @@ -36,4 +36,4 @@ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/semigroups.txt b/.licenses/semantic/cabal/semigroups.txt index d2179cdc2..b754991a7 100644 --- a/.licenses/semantic/cabal/semigroups.txt +++ b/.licenses/semantic/cabal/semigroups.txt @@ -1,7 +1,7 @@ --- type: cabal name: semigroups -version: 0.18.4 +version: 0.18.5 summary: Anything that associates homepage: https://github.com/ekmett/semigroups/ license: bsd-2-clause @@ -31,4 +31,4 @@ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -POSSIBILITY OF SUCH DAMAGE. +POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/streaming-commons.txt b/.licenses/semantic/cabal/streaming-commons.txt index 9966cf83b..35930e681 100644 --- a/.licenses/semantic/cabal/streaming-commons.txt +++ b/.licenses/semantic/cabal/streaming-commons.txt @@ -1,7 +1,7 @@ --- type: cabal name: streaming-commons -version: 0.1.19 +version: 0.2.1.0 summary: Common lower-level functions needed by various streaming data libraries homepage: https://github.com/fpco/streaming-commons license: mit diff --git a/.licenses/semantic/cabal/swagger2.txt b/.licenses/semantic/cabal/swagger2.txt index 3cfde18ad..58ee199a3 100644 --- a/.licenses/semantic/cabal/swagger2.txt +++ b/.licenses/semantic/cabal/swagger2.txt @@ -1,7 +1,7 @@ --- type: cabal name: swagger2 -version: 2.1.6 +version: 2.2.2 summary: Swagger 2.0 data model homepage: https://github.com/GetShopTV/swagger2 license: bsd-3-clause @@ -32,5 +32,4 @@ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/template-haskell.txt b/.licenses/semantic/cabal/template-haskell.txt index 3966e0c06..913b123e7 100644 --- a/.licenses/semantic/cabal/template-haskell.txt +++ b/.licenses/semantic/cabal/template-haskell.txt @@ -1,12 +1,11 @@ --- type: cabal name: template-haskell -version: 2.12.0.0 +version: 2.13.0.0 summary: Support library for Template Haskell -homepage: +homepage: license: bsd-3-clause --- - The Glasgow Haskell Compiler License Copyright 2002-2007, The University Court of the University of Glasgow. @@ -37,4 +36,4 @@ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH -DAMAGE. +DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/temporary.txt b/.licenses/semantic/cabal/temporary.txt index a053720ed..5711611aa 100644 --- a/.licenses/semantic/cabal/temporary.txt +++ b/.licenses/semantic/cabal/temporary.txt @@ -1,7 +1,7 @@ --- type: cabal name: temporary -version: 1.2.1.1 +version: '1.3' summary: Portable temporary file and directory support homepage: https://github.com/feuerbach/temporary license: bsd-3-clause @@ -32,4 +32,4 @@ CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT -OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/terminfo.txt b/.licenses/semantic/cabal/terminfo.txt index d020aefdb..1d4fd8284 100644 --- a/.licenses/semantic/cabal/terminfo.txt +++ b/.licenses/semantic/cabal/terminfo.txt @@ -1,7 +1,7 @@ --- type: cabal name: terminfo -version: 0.4.1.0 +version: 0.4.1.1 summary: Haskell bindings to the terminfo library. homepage: https://github.com/judah/terminfo license: bsd-2-clause @@ -28,4 +28,4 @@ DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE -USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/th-abstraction.txt b/.licenses/semantic/cabal/th-abstraction.txt index 2f3ea8686..7863ef0fb 100644 --- a/.licenses/semantic/cabal/th-abstraction.txt +++ b/.licenses/semantic/cabal/th-abstraction.txt @@ -1,7 +1,7 @@ --- type: cabal name: th-abstraction -version: 0.2.6.0 +version: 0.2.8.0 summary: Nicer interface for reified information about data types homepage: https://github.com/glguy/th-abstraction license: isc @@ -18,4 +18,4 @@ FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF -THIS SOFTWARE. +THIS SOFTWARE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/transformers-base.txt b/.licenses/semantic/cabal/transformers-base.txt index 280a5ee80..1165a0f85 100644 --- a/.licenses/semantic/cabal/transformers-base.txt +++ b/.licenses/semantic/cabal/transformers-base.txt @@ -1,7 +1,7 @@ --- type: cabal name: transformers-base -version: 0.4.4 +version: 0.4.5.2 summary: Lift computations from the bottom of a transformer stack homepage: https://github.com/mvv/transformers-base license: bsd-3-clause @@ -9,16 +9,16 @@ license: bsd-3-clause Copyright (c) 2011, Mikhail Vorozhtsov, Bas van Dijk All rights reserved. -Redistribution and use in source and binary forms, with or without +Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: -- Redistributions of source code must retain the above copyright notice, +- Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. -- Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in the +- Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. -- Neither the names of the copyright owners nor the names of the - contributors may be used to endorse or promote products derived +- Neither the names of the copyright owners nor the names of the + contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS @@ -31,5 +31,4 @@ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/transformers-compat.txt b/.licenses/semantic/cabal/transformers-compat.txt index 622a339f1..90e712ee8 100644 --- a/.licenses/semantic/cabal/transformers-compat.txt +++ b/.licenses/semantic/cabal/transformers-compat.txt @@ -1,9 +1,8 @@ --- type: cabal name: transformers-compat -version: 0.5.1.4 -summary: A small compatibility shim exposing the new types from transformers 0.3 and - 0.4 to older Haskell platforms. +version: 0.6.2 +summary: A small compatibility shim for the transformers library homepage: https://github.com/ekmett/transformers-compat/ license: bsd-3-clause --- @@ -36,4 +35,4 @@ OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -POSSIBILITY OF SUCH DAMAGE. +POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/transformers.txt b/.licenses/semantic/cabal/transformers.txt index f898f0b46..7ab55c2b2 100644 --- a/.licenses/semantic/cabal/transformers.txt +++ b/.licenses/semantic/cabal/transformers.txt @@ -1,9 +1,9 @@ --- type: cabal name: transformers -version: 0.5.2.0 +version: 0.5.5.0 summary: Concrete functor and monad transformers -homepage: https://hub.darcs.net/ross/transformers +homepage: license: bsd-3-clause --- The Glasgow Haskell Compiler License @@ -36,4 +36,4 @@ SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH -DAMAGE. +DAMAGE. \ No newline at end of file diff --git a/.licenses/semantic/cabal/turtle.txt b/.licenses/semantic/cabal/turtle.txt index a268895f5..fe13fc082 100644 --- a/.licenses/semantic/cabal/turtle.txt +++ b/.licenses/semantic/cabal/turtle.txt @@ -1,7 +1,7 @@ --- type: cabal name: turtle -version: 1.5.8 +version: 1.5.10 summary: Shell programming, Haskell-style homepage: license: bsd-3-clause @@ -29,4 +29,4 @@ ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file From 695d280f509acd913c05f837cf09a90f8513b767 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 13 Jul 2018 15:15:10 -0400 Subject: [PATCH 28/58] bump up the cancelable parsing timeout --- test/Semantic/IO/Spec.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/Semantic/IO/Spec.hs b/test/Semantic/IO/Spec.hs index d96bcdf7f..bac839fdd 100644 --- a/test/Semantic/IO/Spec.hs +++ b/test/Semantic/IO/Spec.hs @@ -83,11 +83,11 @@ spec = parallel $ do TS.ts_parser_loop_until_cancelled p nullPtr nullPtr 0 pure True - res <- timeout 1500 (wait churn) + res <- timeout 2500 (wait churn) res `shouldBe` Nothing TS.ts_parser_set_enabled p (CBool 0) - done <- timeout 1500 (wait churn) + done <- timeout 2500 (wait churn) done `shouldBe` (Just True) From f9fcec872f1d4e91accdb30c9f998053588b40f4 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 13 Jul 2018 15:30:28 -0400 Subject: [PATCH 29/58] manually fix licenses --- .licenses/semantic/cabal/megaparsec.txt | 4 ++-- .licenses/semantic/cabal/parser-combinators.txt | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/.licenses/semantic/cabal/megaparsec.txt b/.licenses/semantic/cabal/megaparsec.txt index dcff8edf2..9e8a8498e 100644 --- a/.licenses/semantic/cabal/megaparsec.txt +++ b/.licenses/semantic/cabal/megaparsec.txt @@ -4,7 +4,7 @@ name: megaparsec version: 6.5.0 summary: Monadic parser combinators homepage: https://github.com/mrkkrp/megaparsec -license: other +license: bsd-2-clause --- Copyright © 2015–2018 Megaparsec contributors
Copyright © 2007 Paolo Martini
@@ -31,4 +31,4 @@ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, -EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file +EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/.licenses/semantic/cabal/parser-combinators.txt b/.licenses/semantic/cabal/parser-combinators.txt index 3f1b28f04..37130ecef 100644 --- a/.licenses/semantic/cabal/parser-combinators.txt +++ b/.licenses/semantic/cabal/parser-combinators.txt @@ -4,7 +4,7 @@ name: parser-combinators version: 1.0.0 summary: Lightweight package providing commonly useful parser combinators homepage: https://github.com/mrkkrp/parser-combinators -license: other +license: bsd-3-clause --- Copyright © 2017–2018 Mark Karpov @@ -33,4 +33,4 @@ LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, -EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file +EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. From 1884483753ea3ce51ad484de2b30bb4fc55adfcd Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 09:20:26 -0400 Subject: [PATCH 30/58] Bring in the default hints at a higher severity. --- .hlint.yaml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.hlint.yaml b/.hlint.yaml index bc767d285..4d93824d1 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -19,6 +19,9 @@ # Generalise map to fmap, ++ to <> - group: {name: generalise, enabled: true} +# Change the severity of the default group to warning +- warn: {group: {name: default}} + # Ignore some builtin hints - ignore: {name: Use mappend} - ignore: {name: Redundant do} From 279cf3bce53f53e524b9f3b8fe48039cde6f11c4 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 09:20:34 -0400 Subject: [PATCH 31/58] Ignore the module export list hint. --- .hlint.yaml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.hlint.yaml b/.hlint.yaml index 4d93824d1..b60478f4c 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -22,6 +22,9 @@ # Change the severity of the default group to warning - warn: {group: {name: default}} +# Ignore the highly noisy module export list hint +- ignore: {name: Use module export list} + # Ignore some builtin hints - ignore: {name: Use mappend} - ignore: {name: Redundant do} From 98f143811a278dd4b1c087359e4532927165a61e Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:16:02 -0400 Subject: [PATCH 32/58] Parameterizze liftDeclaredName by the declaredName function for its children. --- src/Data/Abstract/Declarations.hs | 11 +++++------ src/Data/Syntax/Declaration.hs | 5 +---- 2 files changed, 6 insertions(+), 10 deletions(-) diff --git a/src/Data/Abstract/Declarations.hs b/src/Data/Abstract/Declarations.hs index a15c74f04..17677d412 100644 --- a/src/Data/Abstract/Declarations.hs +++ b/src/Data/Abstract/Declarations.hs @@ -1,7 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving, UndecidableInstances #-} module Data.Abstract.Declarations where -import Data.Abstract.FreeVariables import Data.Abstract.Name import Data.Sum import Data.Term @@ -13,18 +12,18 @@ class Declarations syntax where class Declarations1 syntax where -- | Lift a function mapping each element to its set of free variables through a containing structure, collecting the results into a single set. - liftDeclaredName :: (a -> [Name]) -> syntax a -> Maybe Name + liftDeclaredName :: (a -> Maybe Name) -> syntax a -> Maybe Name liftDeclaredName _ _ = Nothing instance Declarations t => Declarations (Subterm t a) where declaredName = declaredName . subterm -deriving instance (Declarations1 syntax, FreeVariables1 syntax) => Declarations (Term syntax ann) +deriving instance Declarations1 syntax => Declarations (Term syntax ann) -instance (FreeVariables recur, Declarations1 syntax) => Declarations (TermF syntax ann recur) where - declaredName = liftDeclaredName freeVariables . termFOut +instance (Declarations recur, Declarations1 syntax) => Declarations (TermF syntax ann recur) where + declaredName = liftDeclaredName declaredName . termFOut -instance (Apply Declarations1 fs) => Declarations1 (Sum fs) where +instance Apply Declarations1 fs => Declarations1 (Sum fs) where liftDeclaredName f = apply @Declarations1 (liftDeclaredName f) instance Declarations1 [] diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 94c020d08..428c6d79b 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -34,10 +34,7 @@ instance Declarations a => Declarations (Function a) where declaredName Function{..} = declaredName functionName instance Declarations1 Function where - liftDeclaredName declaredName Function{..} = - case declaredName functionName of - [] -> Nothing - (x:_) -> Just x + liftDeclaredName declaredName Function{..} = declaredName functionName data Method a = Method { methodContext :: ![a], methodReceiver :: !a, methodName :: !a, methodParameters :: ![a], methodBody :: !a } deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Mergeable, FreeVariables1, Declarations1, ToJSONFields1, Named1, Message1) From 0805b68d62ce96496b94c06ec262ba4b1c7dfd50 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:16:48 -0400 Subject: [PATCH 33/58] Define a Declarations1 instance for Method. --- src/Data/Syntax/Declaration.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 428c6d79b..6c5b098f7 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -37,7 +37,7 @@ instance Declarations1 Function where liftDeclaredName declaredName Function{..} = declaredName functionName data Method a = Method { methodContext :: ![a], methodReceiver :: !a, methodName :: !a, methodParameters :: ![a], methodBody :: !a } - deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Mergeable, FreeVariables1, Declarations1, ToJSONFields1, Named1, Message1) + deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Mergeable, FreeVariables1, ToJSONFields1, Named1, Message1) instance Eq1 Method where liftEq = genericLiftEq instance Ord1 Method where liftCompare = genericLiftCompare @@ -56,6 +56,9 @@ instance Evaluatable Method where pure (Rval addr) where paramNames = foldMap (freeVariables . subterm) +instance Declarations1 Method where + liftDeclaredName declaredName = declaredName . methodName + -- | A method signature in TypeScript or a method spec in Go. data MethodSignature a = MethodSignature { methodSignatureContext :: ![a], methodSignatureName :: !a, methodSignatureParameters :: ![a] } From d6a0cf9895aa5bc39b908a8ab48c4d6e9711b112 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:17:05 -0400 Subject: [PATCH 34/58] Give a point-free definition of liftDeclaredName for Declaration.Function. --- src/Data/Syntax/Declaration.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 6c5b098f7..532181065 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -34,7 +34,7 @@ instance Declarations a => Declarations (Function a) where declaredName Function{..} = declaredName functionName instance Declarations1 Function where - liftDeclaredName declaredName Function{..} = declaredName functionName + liftDeclaredName declaredName = declaredName . functionName data Method a = Method { methodContext :: ![a], methodReceiver :: !a, methodName :: !a, methodParameters :: ![a], methodBody :: !a } deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Mergeable, FreeVariables1, ToJSONFields1, Named1, Message1) From ad436cafc3fadf63da6322f6cc1e7e2ca0ad588d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:17:22 -0400 Subject: [PATCH 35/58] :fire: the Declarations instance for Function. --- src/Data/Syntax/Declaration.hs | 3 --- 1 file changed, 3 deletions(-) diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 532181065..7510a36a5 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -30,9 +30,6 @@ instance Evaluatable Function where pure (Rval addr) where paramNames = foldMap (freeVariables . subterm) -instance Declarations a => Declarations (Function a) where - declaredName Function{..} = declaredName functionName - instance Declarations1 Function where liftDeclaredName declaredName = declaredName . functionName From 12d2bc1d6b772285afc3a0d69b520015b3f8ad9d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:21:00 -0400 Subject: [PATCH 36/58] Get the declared names of functions using declaredName. --- src/Data/Syntax/Declaration.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 7510a36a5..4c0c0a037 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -24,7 +24,7 @@ instance Show1 Function where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Function where eval Function{..} = do - name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm functionName) + name <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm functionName)) (_, addr) <- letrec name (closure (paramNames functionParameters) (Set.fromList (freeVariables functionBody)) (subtermAddress functionBody)) bind name addr pure (Rval addr) From cc6ed631039e26af86b3ee004ac7b197776c3686 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:21:30 -0400 Subject: [PATCH 37/58] Get the declared names of methods using declaredName. --- src/Data/Syntax/Declaration.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 4c0c0a037..25a1545dc 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -47,7 +47,7 @@ instance Diffable Method where -- local environment. instance Evaluatable Method where eval Method{..} = do - name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm methodName) + name <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm methodName)) (_, addr) <- letrec name (closure (paramNames methodParameters) (Set.fromList (freeVariables methodBody)) (subtermAddress methodBody)) bind name addr pure (Rval addr) From 406a2ee62585f64ba66ca3a417aadf7958d37ea6 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:22:27 -0400 Subject: [PATCH 38/58] Get the declared names of classes using declaredName. --- src/Data/Syntax/Declaration.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 25a1545dc..558fc15ee 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -164,7 +164,7 @@ instance Show1 Class where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Class where eval Class{..} = do - name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm classIdentifier) + name <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm classIdentifier)) supers <- traverse subtermAddress classSuperclasses (_, addr) <- letrec name $ do void $ subtermValue classBody From 2df729831cb0bc1638e92363c6258d9c483b53bf Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:23:01 -0400 Subject: [PATCH 39/58] Get the declared names of type aliases using declaredName. --- src/Data/Syntax/Declaration.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 558fc15ee..631d03b97 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -246,7 +246,7 @@ instance Show1 TypeAlias where liftShowsPrec = genericLiftShowsPrec -- TODO: Implement Eval instance for TypeAlias instance Evaluatable TypeAlias where eval TypeAlias{..} = do - name <- either (throwEvalError . FreeVariablesError) pure (freeVariable (subterm typeAliasIdentifier)) + name <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm typeAliasIdentifier)) v <- subtermValue typeAliasKind addr <- lookupOrAlloc name assign addr v From ab7daf2591bcca3fc606d88911d35f7eceae13ea Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:24:46 -0400 Subject: [PATCH 40/58] Use Declarations for the declared names in TypeScript. --- src/Language/TypeScript/Syntax.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Language/TypeScript/Syntax.hs b/src/Language/TypeScript/Syntax.hs index 3fba9f25f..ac17d840b 100644 --- a/src/Language/TypeScript/Syntax.hs +++ b/src/Language/TypeScript/Syntax.hs @@ -191,7 +191,7 @@ instance Show1 JavaScriptRequire where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JavaScriptRequire where eval (JavaScriptRequire aliasTerm importPath) = do modulePath <- resolveWithNodejsStrategy importPath javascriptExtensions - alias <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm aliasTerm) + alias <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm aliasTerm)) rvalBox =<< evalRequire modulePath alias @@ -205,7 +205,7 @@ instance Show1 QualifiedAliasedImport where liftShowsPrec = genericLiftShowsPrec instance Evaluatable QualifiedAliasedImport where eval (QualifiedAliasedImport aliasTerm importPath) = do modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions - alias <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm aliasTerm) + alias <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm aliasTerm)) rvalBox =<< evalRequire modulePath alias newtype SideEffectImport a = SideEffectImport { sideEffectImportFrom :: ImportPath } @@ -676,7 +676,7 @@ instance Show1 Module where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Module where eval (Module iden xs) = do - name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm iden) + name <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm iden)) rvalBox =<< letrec' name (\addr -> value =<< (eval xs <* makeNamespace name addr Nothing)) @@ -690,7 +690,7 @@ instance Show1 InternalModule where liftShowsPrec = genericLiftShowsPrec instance Evaluatable InternalModule where eval (InternalModule iden xs) = do - name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm iden) + name <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm iden)) rvalBox =<< letrec' name (\addr -> value =<< (eval xs <* makeNamespace name addr Nothing)) @@ -741,7 +741,7 @@ instance Declarations a => Declarations (AbstractClass a) where instance Evaluatable AbstractClass where eval AbstractClass{..} = do - name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm abstractClassIdentifier) + name <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm abstractClassIdentifier)) supers <- traverse subtermAddress classHeritage (v, addr) <- letrec name $ do void $ subtermValue classBody From 24825d3a6d1e2382e3e43f37e3f4328755a86b02 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:25:18 -0400 Subject: [PATCH 41/58] Use Declarations for declared names in Ruby. --- src/Language/Ruby/Syntax.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index 6c6f84fe1..2a08817ea 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -132,7 +132,7 @@ instance Show1 Class where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Class where eval Class{..} = do super <- traverse subtermAddress classSuperClass - name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm classIdentifier) + name <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm classIdentifier)) rvalBox =<< letrec' name (\addr -> subtermValue classBody <* makeNamespace name addr super) @@ -145,7 +145,7 @@ instance Show1 Module where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Module where eval (Module iden xs) = do - name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm iden) + name <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm iden)) rvalBox =<< letrec' name (\addr -> value =<< (eval xs <* makeNamespace name addr Nothing)) From 5df6613cf045d02b0658ba610d0b5ad86db75288 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:26:12 -0400 Subject: [PATCH 42/58] Use Declarations for declared names in Go. --- src/Language/Go/Syntax.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index 603f6a735..c0d3e0cf9 100644 --- a/src/Language/Go/Syntax.hs +++ b/src/Language/Go/Syntax.hs @@ -84,7 +84,7 @@ instance Show1 QualifiedImport where liftShowsPrec = genericLiftShowsPrec instance Evaluatable QualifiedImport where eval (QualifiedImport importPath aliasTerm) = do paths <- resolveGoImport importPath - alias <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm aliasTerm) + alias <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm aliasTerm)) void . letrec' alias $ \addr -> do for_ paths $ \p -> do traceResolve (unPath importPath) p From 8d07c5a30bf280098f8eee182c7e2ed76eeb1bbb Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:26:21 -0400 Subject: [PATCH 43/58] Use Declarations for declared names in Python. --- src/Language/Python/Syntax.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index e2ed33d99..5d8dc98bf 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -171,7 +171,7 @@ instance Evaluatable QualifiedAliasedImport where for_ (NonEmpty.init modulePaths) require -- Evaluate and import the last module, aliasing and updating the environment - alias <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm aliasTerm) + alias <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm aliasTerm)) rvalBox =<< letrec' alias (\addr -> do let path = NonEmpty.last modulePaths importedEnv <- fst <$> require path From 3829cf50dede1b3b9ed547cd6204dc8d8aca79c1 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:26:29 -0400 Subject: [PATCH 44/58] Use Declarations for declared names in lets. --- src/Data/Syntax/Statement.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Syntax/Statement.hs b/src/Data/Syntax/Statement.hs index ab4df4768..b9bd5699f 100644 --- a/src/Data/Syntax/Statement.hs +++ b/src/Data/Syntax/Statement.hs @@ -99,7 +99,7 @@ instance Show1 Let where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Let where eval Let{..} = do - name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm letVariable) + name <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm letVariable)) addr <- snd <$> letrec name (subtermValue letValue) Rval <$> locally (bind name addr *> subtermAddress letBody) From 44fb03899c6e83a7f0163e2584289a729b181f71 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:26:34 -0400 Subject: [PATCH 45/58] :fire: freeVariable. --- src/Data/Abstract/FreeVariables.hs | 5 ----- 1 file changed, 5 deletions(-) diff --git a/src/Data/Abstract/FreeVariables.hs b/src/Data/Abstract/FreeVariables.hs index ddf54b02e..3c87870c3 100644 --- a/src/Data/Abstract/FreeVariables.hs +++ b/src/Data/Abstract/FreeVariables.hs @@ -25,11 +25,6 @@ class FreeVariables1 syntax where freeVariables1 :: (FreeVariables1 t, FreeVariables a) => t a -> [Name] freeVariables1 = liftFreeVariables freeVariables -freeVariable :: FreeVariables term => term -> Either [Name] Name -freeVariable term = case freeVariables term of - [n] -> Right n - xs -> Left xs - instance (FreeVariables t) => FreeVariables (Subterm t a) where freeVariables = freeVariables . subterm From d74f5ce79c680cd77b4e313ee62b7bdcac650e4b Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:27:40 -0400 Subject: [PATCH 46/58] :fire: freeVariables1. --- src/Data/Abstract/FreeVariables.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/Data/Abstract/FreeVariables.hs b/src/Data/Abstract/FreeVariables.hs index 3c87870c3..f60339671 100644 --- a/src/Data/Abstract/FreeVariables.hs +++ b/src/Data/Abstract/FreeVariables.hs @@ -21,10 +21,6 @@ class FreeVariables1 syntax where default liftFreeVariables :: (Foldable syntax) => (a -> [Name]) -> syntax a -> [Name] liftFreeVariables = foldMap --- | Lift the 'freeVariables' method through a containing structure. -freeVariables1 :: (FreeVariables1 t, FreeVariables a) => t a -> [Name] -freeVariables1 = liftFreeVariables freeVariables - instance (FreeVariables t) => FreeVariables (Subterm t a) where freeVariables = freeVariables . subterm From 5ed183d25d6d96269e9b1ad68ba9c6af6dcb7279 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:27:54 -0400 Subject: [PATCH 47/58] :fire: a bunch of redundant parens. --- src/Data/Abstract/FreeVariables.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Data/Abstract/FreeVariables.hs b/src/Data/Abstract/FreeVariables.hs index f60339671..e86fbcdb6 100644 --- a/src/Data/Abstract/FreeVariables.hs +++ b/src/Data/Abstract/FreeVariables.hs @@ -21,7 +21,7 @@ class FreeVariables1 syntax where default liftFreeVariables :: (Foldable syntax) => (a -> [Name]) -> syntax a -> [Name] liftFreeVariables = foldMap -instance (FreeVariables t) => FreeVariables (Subterm t a) where +instance FreeVariables t => FreeVariables (Subterm t a) where freeVariables = freeVariables . subterm deriving instance FreeVariables1 syntax => FreeVariables (Term syntax ann) @@ -29,10 +29,10 @@ deriving instance FreeVariables1 syntax => FreeVariables (Term syntax ann) instance (FreeVariables recur, FreeVariables1 syntax) => FreeVariables (TermF syntax ann recur) where freeVariables = liftFreeVariables freeVariables -instance (FreeVariables1 syntax) => FreeVariables1 (TermF syntax ann) where +instance FreeVariables1 syntax => FreeVariables1 (TermF syntax ann) where liftFreeVariables f (In _ s) = liftFreeVariables f s -instance (Apply FreeVariables1 fs) => FreeVariables1 (Sum fs) where +instance Apply FreeVariables1 fs => FreeVariables1 (Sum fs) where liftFreeVariables f = apply @FreeVariables1 (liftFreeVariables f) instance FreeVariables1 [] From bebea2c6de3e776fb8a0fd07d568ede229414303 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:31:33 -0400 Subject: [PATCH 48/58] Use declaredName to get function/method parameter names. --- src/Data/Syntax/Declaration.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 631d03b97..2b916fcca 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -28,7 +28,7 @@ instance Evaluatable Function where (_, addr) <- letrec name (closure (paramNames functionParameters) (Set.fromList (freeVariables functionBody)) (subtermAddress functionBody)) bind name addr pure (Rval addr) - where paramNames = foldMap (freeVariables . subterm) + where paramNames = foldMap (maybeToList . declaredName . subterm) instance Declarations1 Function where liftDeclaredName declaredName = declaredName . functionName @@ -51,7 +51,7 @@ instance Evaluatable Method where (_, addr) <- letrec name (closure (paramNames methodParameters) (Set.fromList (freeVariables methodBody)) (subtermAddress methodBody)) bind name addr pure (Rval addr) - where paramNames = foldMap (freeVariables . subterm) + where paramNames = foldMap (maybeToList . declaredName . subterm) instance Declarations1 Method where liftDeclaredName declaredName = declaredName . methodName From 360ae0e2f1ec20c696699fb73ef07a6bc315e0f2 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:38:47 -0400 Subject: [PATCH 49/58] Replace FreeVariablesError with NoNameError. --- src/Data/Abstract/Evaluatable.hs | 4 ++-- src/Data/Syntax/Declaration.hs | 8 ++++---- src/Data/Syntax/Statement.hs | 2 +- src/Language/Go/Syntax.hs | 2 +- src/Language/PHP/Syntax.hs | 2 +- src/Language/Python/Syntax.hs | 2 +- src/Language/Ruby/Syntax.hs | 4 ++-- src/Language/TypeScript/Syntax.hs | 10 +++++----- src/Semantic/Graph.hs | 12 ++++++------ 9 files changed, 23 insertions(+), 23 deletions(-) diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index b235ed56b..781bee5dc 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -206,7 +206,7 @@ instance HasPostlude 'JavaScript where -- | The type of error thrown when failing to evaluate a term. data EvalError return where - FreeVariablesError :: [Name] -> EvalError Name + NoNameError :: EvalError Name -- Indicates that our evaluator wasn't able to make sense of these literals. IntegerFormatError :: Text -> EvalError Integer FloatFormatError :: Text -> EvalError Scientific @@ -218,7 +218,7 @@ deriving instance Eq (EvalError return) deriving instance Show (EvalError return) instance Eq1 EvalError where - liftEq _ (FreeVariablesError a) (FreeVariablesError b) = a == b + liftEq _ NoNameError NoNameError = True liftEq _ DefaultExportError DefaultExportError = True liftEq _ (ExportError a b) (ExportError c d) = (a == c) && (b == d) liftEq _ (IntegerFormatError a) (IntegerFormatError b) = a == b diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 2b916fcca..2bd89e9be 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -24,7 +24,7 @@ instance Show1 Function where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Function where eval Function{..} = do - name <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm functionName)) + name <- maybeM (throwEvalError NoNameError) (declaredName (subterm functionName)) (_, addr) <- letrec name (closure (paramNames functionParameters) (Set.fromList (freeVariables functionBody)) (subtermAddress functionBody)) bind name addr pure (Rval addr) @@ -47,7 +47,7 @@ instance Diffable Method where -- local environment. instance Evaluatable Method where eval Method{..} = do - name <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm methodName)) + name <- maybeM (throwEvalError NoNameError) (declaredName (subterm methodName)) (_, addr) <- letrec name (closure (paramNames methodParameters) (Set.fromList (freeVariables methodBody)) (subtermAddress methodBody)) bind name addr pure (Rval addr) @@ -164,7 +164,7 @@ instance Show1 Class where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Class where eval Class{..} = do - name <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm classIdentifier)) + name <- maybeM (throwEvalError NoNameError) (declaredName (subterm classIdentifier)) supers <- traverse subtermAddress classSuperclasses (_, addr) <- letrec name $ do void $ subtermValue classBody @@ -246,7 +246,7 @@ instance Show1 TypeAlias where liftShowsPrec = genericLiftShowsPrec -- TODO: Implement Eval instance for TypeAlias instance Evaluatable TypeAlias where eval TypeAlias{..} = do - name <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm typeAliasIdentifier)) + name <- maybeM (throwEvalError NoNameError) (declaredName (subterm typeAliasIdentifier)) v <- subtermValue typeAliasKind addr <- lookupOrAlloc name assign addr v diff --git a/src/Data/Syntax/Statement.hs b/src/Data/Syntax/Statement.hs index b9bd5699f..859a3a4d4 100644 --- a/src/Data/Syntax/Statement.hs +++ b/src/Data/Syntax/Statement.hs @@ -99,7 +99,7 @@ instance Show1 Let where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Let where eval Let{..} = do - name <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm letVariable)) + name <- maybeM (throwEvalError NoNameError) (declaredName (subterm letVariable)) addr <- snd <$> letrec name (subtermValue letValue) Rval <$> locally (bind name addr *> subtermAddress letBody) diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index c0d3e0cf9..3b217449c 100644 --- a/src/Language/Go/Syntax.hs +++ b/src/Language/Go/Syntax.hs @@ -84,7 +84,7 @@ instance Show1 QualifiedImport where liftShowsPrec = genericLiftShowsPrec instance Evaluatable QualifiedImport where eval (QualifiedImport importPath aliasTerm) = do paths <- resolveGoImport importPath - alias <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm aliasTerm)) + alias <- maybeM (throwEvalError NoNameError) (declaredName (subterm aliasTerm)) void . letrec' alias $ \addr -> do for_ paths $ \p -> do traceResolve (unPath importPath) p diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index 4fd906d2f..4ff062ab9 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -376,7 +376,7 @@ instance Evaluatable Namespace where go (x:xs) <* makeNamespace name addr Nothing -- The last name creates a closure over the namespace body. go names = do - name <- maybeM (throwEvalError (FreeVariablesError [])) (listToMaybe names) + name <- maybeM (throwEvalError NoNameError) (listToMaybe names) letrec' name $ \addr -> subtermValue namespaceBody *> makeNamespace name addr Nothing diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index 5d8dc98bf..bb07c37f0 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -171,7 +171,7 @@ instance Evaluatable QualifiedAliasedImport where for_ (NonEmpty.init modulePaths) require -- Evaluate and import the last module, aliasing and updating the environment - alias <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm aliasTerm)) + alias <- maybeM (throwEvalError NoNameError) (declaredName (subterm aliasTerm)) rvalBox =<< letrec' alias (\addr -> do let path = NonEmpty.last modulePaths importedEnv <- fst <$> require path diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index 2a08817ea..a3fbc2480 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -132,7 +132,7 @@ instance Show1 Class where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Class where eval Class{..} = do super <- traverse subtermAddress classSuperClass - name <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm classIdentifier)) + name <- maybeM (throwEvalError NoNameError) (declaredName (subterm classIdentifier)) rvalBox =<< letrec' name (\addr -> subtermValue classBody <* makeNamespace name addr super) @@ -145,7 +145,7 @@ instance Show1 Module where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Module where eval (Module iden xs) = do - name <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm iden)) + name <- maybeM (throwEvalError NoNameError) (declaredName (subterm iden)) rvalBox =<< letrec' name (\addr -> value =<< (eval xs <* makeNamespace name addr Nothing)) diff --git a/src/Language/TypeScript/Syntax.hs b/src/Language/TypeScript/Syntax.hs index ac17d840b..ca4a201dc 100644 --- a/src/Language/TypeScript/Syntax.hs +++ b/src/Language/TypeScript/Syntax.hs @@ -191,7 +191,7 @@ instance Show1 JavaScriptRequire where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JavaScriptRequire where eval (JavaScriptRequire aliasTerm importPath) = do modulePath <- resolveWithNodejsStrategy importPath javascriptExtensions - alias <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm aliasTerm)) + alias <- maybeM (throwEvalError NoNameError) (declaredName (subterm aliasTerm)) rvalBox =<< evalRequire modulePath alias @@ -205,7 +205,7 @@ instance Show1 QualifiedAliasedImport where liftShowsPrec = genericLiftShowsPrec instance Evaluatable QualifiedAliasedImport where eval (QualifiedAliasedImport aliasTerm importPath) = do modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions - alias <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm aliasTerm)) + alias <- maybeM (throwEvalError NoNameError) (declaredName (subterm aliasTerm)) rvalBox =<< evalRequire modulePath alias newtype SideEffectImport a = SideEffectImport { sideEffectImportFrom :: ImportPath } @@ -676,7 +676,7 @@ instance Show1 Module where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Module where eval (Module iden xs) = do - name <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm iden)) + name <- maybeM (throwEvalError NoNameError) (declaredName (subterm iden)) rvalBox =<< letrec' name (\addr -> value =<< (eval xs <* makeNamespace name addr Nothing)) @@ -690,7 +690,7 @@ instance Show1 InternalModule where liftShowsPrec = genericLiftShowsPrec instance Evaluatable InternalModule where eval (InternalModule iden xs) = do - name <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm iden)) + name <- maybeM (throwEvalError NoNameError) (declaredName (subterm iden)) rvalBox =<< letrec' name (\addr -> value =<< (eval xs <* makeNamespace name addr Nothing)) @@ -741,7 +741,7 @@ instance Declarations a => Declarations (AbstractClass a) where instance Evaluatable AbstractClass where eval AbstractClass{..} = do - name <- maybeM (throwEvalError (FreeVariablesError [])) (declaredName (subterm abstractClassIdentifier)) + name <- maybeM (throwEvalError NoNameError) (declaredName (subterm abstractClassIdentifier)) supers <- traverse subtermAddress classHeritage (v, addr) <- letrec name $ do void $ subtermValue classBody diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index f6b456f78..eeb5ca02f 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -215,12 +215,12 @@ resumingLoadError = runLoadErrorWith (\ (ModuleNotFound path) -> trace ("LoadErr resumingEvalError :: (Member Trace effects, Effects effects) => Evaluator address value (Resumable EvalError ': effects) a -> Evaluator address value effects a resumingEvalError = runEvalErrorWith (\ err -> trace ("EvalError" <> show err) *> case err of - DefaultExportError{} -> pure () - ExportError{} -> pure () - IntegerFormatError{} -> pure 0 - FloatFormatError{} -> pure 0 - RationalFormatError{} -> pure 0 - FreeVariablesError names -> pure (fromMaybeLast (name "unknown") names)) + DefaultExportError{} -> pure () + ExportError{} -> pure () + IntegerFormatError{} -> pure 0 + FloatFormatError{} -> pure 0 + RationalFormatError{} -> pure 0 + NoNameError -> pure (name "unknown")) resumingUnspecialized :: (Member Trace effects, AbstractHole value, Effects effects) => Evaluator address value (Resumable (Unspecialized value) ': effects) a -> Evaluator address value effects a resumingUnspecialized = runUnspecializedWith (\ err@(Unspecialized _) -> trace ("Unspecialized:" <> show err) $> hole) From 1b00ea555a65e00a9981f3742ecf092ae8fa8eee Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:39:20 -0400 Subject: [PATCH 50/58] Recover from NoNameError with a gensym. --- 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 eeb5ca02f..c529e189b 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -213,14 +213,14 @@ resumingResolutionError = runResolutionErrorWith (\ err -> trace ("ResolutionErr resumingLoadError :: (Member Trace effects, AbstractHole address, Effects effects) => Evaluator address value (Resumable (LoadError address) ': effects) a -> Evaluator address value effects a resumingLoadError = runLoadErrorWith (\ (ModuleNotFound path) -> trace ("LoadError: " <> path) $> (lowerBound, hole)) -resumingEvalError :: (Member Trace effects, Effects effects) => Evaluator address value (Resumable EvalError ': effects) a -> Evaluator address value effects a +resumingEvalError :: (Member Fresh effects, Member Trace effects, Effects effects) => Evaluator address value (Resumable EvalError ': effects) a -> Evaluator address value effects a resumingEvalError = runEvalErrorWith (\ err -> trace ("EvalError" <> show err) *> case err of DefaultExportError{} -> pure () ExportError{} -> pure () IntegerFormatError{} -> pure 0 FloatFormatError{} -> pure 0 RationalFormatError{} -> pure 0 - NoNameError -> pure (name "unknown")) + NoNameError -> gensym) resumingUnspecialized :: (Member Trace effects, AbstractHole value, Effects effects) => Evaluator address value (Resumable (Unspecialized value) ': effects) a -> Evaluator address value effects a resumingUnspecialized = runUnspecializedWith (\ err@(Unspecialized _) -> trace ("Unspecialized:" <> show err) $> hole) From d0fc64e2dff29f000b502be3d35a1cb9ce72b438 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:50:13 -0400 Subject: [PATCH 51/58] Unpack PHP namespace names. --- src/Language/PHP/Assignment.hs | 5 ++++- src/Language/PHP/Syntax.hs | 14 ++++++++------ 2 files changed, 12 insertions(+), 7 deletions(-) diff --git a/src/Language/PHP/Assignment.hs b/src/Language/PHP/Assignment.hs index 1a90337db..222e0c3d4 100644 --- a/src/Language/PHP/Assignment.hs +++ b/src/Language/PHP/Assignment.hs @@ -489,6 +489,9 @@ namespaceNameAsPrefix = symbol NamespaceNameAsPrefix *> children (term namespace namespaceName :: Assignment Term namespaceName = makeTerm <$> symbol NamespaceName <*> children (Syntax.NamespaceName <$> someTerm' name) +namespaceName' :: Assignment (NonEmpty Term) +namespaceName' = symbol NamespaceName *> children (someTerm' name) + updateExpression :: Assignment Term updateExpression = makeTerm <$> symbol UpdateExpression <*> children (Syntax.Update <$> term expression) @@ -704,7 +707,7 @@ traitAliasAsClause :: Assignment Term traitAliasAsClause = makeTerm <$> symbol TraitAliasAsClause <*> children (Syntax.AliasAs <$> term (classConstantAccessExpression <|> name) <*> (term visibilityModifier <|> emptyTerm) <*> (term name <|> emptyTerm)) namespaceDefinition :: Assignment Term -namespaceDefinition = makeTerm <$> symbol NamespaceDefinition <*> children (Syntax.Namespace <$> (term namespaceName <|> emptyTerm) <*> (term compoundStatement <|> emptyTerm)) +namespaceDefinition = makeTerm <$> symbol NamespaceDefinition <*> children (Syntax.Namespace <$> (toList <$> namespaceName' <|> pure []) <*> (term compoundStatement <|> emptyTerm)) namespaceUseDeclaration :: Assignment Term namespaceUseDeclaration = makeTerm <$> symbol NamespaceUseDeclaration <*> children (Syntax.NamespaceUseDeclaration <$> diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index 4ff062ab9..b1bad882d 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -361,7 +361,7 @@ instance Ord1 NamespaceUseGroupClause where liftCompare = genericLiftCompare instance Show1 NamespaceUseGroupClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable NamespaceUseGroupClause -data Namespace a = Namespace { namespaceName :: a, namespaceBody :: a } +data Namespace a = Namespace { namespaceName :: [a], namespaceBody :: a } deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable) instance Eq1 Namespace where liftEq = genericLiftEq @@ -369,14 +369,16 @@ instance Ord1 Namespace where liftCompare = genericLiftCompare instance Show1 Namespace where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Namespace where - eval Namespace{..} = rvalBox =<< go (freeVariables (subterm namespaceName)) + eval Namespace{..} = rvalBox =<< go (declaredName . subterm <$> namespaceName) where -- Each namespace name creates a closure over the subsequent namespace closures - go (name:x:xs) = letrec' name $ \addr -> - go (x:xs) <* makeNamespace name addr Nothing + go (n:x:xs) = do + name <- maybeM (throwResumable NoNameError) n + letrec' name $ \addr -> + go (x:xs) <* makeNamespace name addr Nothing -- The last name creates a closure over the namespace body. - go names = do - name <- maybeM (throwEvalError NoNameError) (listToMaybe names) + go [n] = do + name <- maybeM (throwResumable NoNameError) n letrec' name $ \addr -> subtermValue namespaceBody *> makeNamespace name addr Nothing From 91b446856f29a41e18a073a553d8382929beb26b Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:50:19 -0400 Subject: [PATCH 52/58] Handle anonymous namespaces. --- src/Language/PHP/Syntax.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index b1bad882d..5ad1ddcf2 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -381,6 +381,7 @@ instance Evaluatable Namespace where name <- maybeM (throwResumable NoNameError) n letrec' name $ \addr -> subtermValue namespaceBody *> makeNamespace name addr Nothing + go [] = subtermValue namespaceBody data TraitDeclaration a = TraitDeclaration { traitName :: a, traitStatements :: [a] } deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable) From 5cccde998b9eba7a9662f02c78a74ae71bf1d9fc Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:53:02 -0400 Subject: [PATCH 53/58] =?UTF-8?q?:memo:=20global=20scope=20=E2=80=9Cnamesp?= =?UTF-8?q?aces.=E2=80=9D?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Language/PHP/Syntax.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index 5ad1ddcf2..38acf5460 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -381,6 +381,7 @@ instance Evaluatable Namespace where name <- maybeM (throwResumable NoNameError) n letrec' name $ \addr -> subtermValue namespaceBody *> makeNamespace name addr Nothing + -- The absence of names implies global scope, cf http://php.net/manual/en/language.namespaces.definitionmultiple.php go [] = subtermValue namespaceBody data TraitDeclaration a = TraitDeclaration { traitName :: a, traitStatements :: [a] } From ad8dfb3b662eceabb34b5553da7642b6c43b60eb Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 10:55:41 -0400 Subject: [PATCH 54/58] Compute sets of free variables. --- src/Data/Abstract/FreeVariables.hs | 6 +++--- src/Data/Syntax.hs | 9 +++++---- src/Data/Syntax/Declaration.hs | 5 ++--- 3 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/Data/Abstract/FreeVariables.hs b/src/Data/Abstract/FreeVariables.hs index e86fbcdb6..80a96e2e8 100644 --- a/src/Data/Abstract/FreeVariables.hs +++ b/src/Data/Abstract/FreeVariables.hs @@ -9,7 +9,7 @@ import Prologue -- | Types which can contain unbound variables. class FreeVariables term where -- | The set of free variables in the given value. - freeVariables :: term -> [Name] + freeVariables :: term -> Set Name -- | A lifting of 'FreeVariables' to type constructors of kind @* -> *@. @@ -17,8 +17,8 @@ class FreeVariables term where -- 'Foldable' types requiring no additional semantics to the set of free variables (e.g. types which do not bind any variables) can use (and even derive, with @-XDeriveAnyClass@) the default implementation. class FreeVariables1 syntax where -- | Lift a function mapping each element to its set of free variables through a containing structure, collecting the results into a single set. - liftFreeVariables :: (a -> [Name]) -> syntax a -> [Name] - default liftFreeVariables :: (Foldable syntax) => (a -> [Name]) -> syntax a -> [Name] + liftFreeVariables :: (a -> Set Name) -> syntax a -> Set Name + default liftFreeVariables :: (Foldable syntax) => (a -> Set Name) -> syntax a -> Set Name liftFreeVariables = foldMap instance FreeVariables t => FreeVariables (Subterm t a) where diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs index f2e1a40fd..716a3b367 100644 --- a/src/Data/Syntax.hs +++ b/src/Data/Syntax.hs @@ -5,12 +5,16 @@ module Data.Syntax where import Data.Abstract.Evaluatable import Data.Aeson (ToJSON(..), object) import Data.AST +import Data.Char (toLower) import Data.JSON.Fields import Data.Range import Data.Record +import qualified Data.Set as Set import Data.Span import Data.Sum import Data.Term +import GHC.Types (Constraint) +import GHC.TypeLits import Diffing.Algorithm hiding (Empty) import Prelude import Prologue @@ -18,12 +22,9 @@ import qualified Assigning.Assignment as Assignment import qualified Data.Error as Error import Proto3.Suite.Class import Proto3.Wire.Types -import GHC.Types (Constraint) -import GHC.TypeLits import qualified Proto3.Suite.DotProto as Proto import qualified Proto3.Wire.Encode as Encode import qualified Proto3.Wire.Decode as Decode -import Data.Char (toLower) -- Combinators @@ -166,7 +167,7 @@ instance Evaluatable Identifier where eval (Identifier name) = pure (LvalLocal name) instance FreeVariables1 Identifier where - liftFreeVariables _ (Identifier x) = pure x + liftFreeVariables _ (Identifier x) = Set.singleton x instance Declarations1 Identifier where liftDeclaredName _ (Identifier x) = pure x diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 2bd89e9be..2726d3500 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -4,7 +4,6 @@ module Data.Syntax.Declaration where import qualified Data.Abstract.Environment as Env import Data.Abstract.Evaluatable import Data.JSON.Fields -import qualified Data.Set as Set (fromList) import Diffing.Algorithm import Prologue import Proto3.Suite.Class @@ -25,7 +24,7 @@ instance Show1 Function where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Function where eval Function{..} = do name <- maybeM (throwEvalError NoNameError) (declaredName (subterm functionName)) - (_, addr) <- letrec name (closure (paramNames functionParameters) (Set.fromList (freeVariables functionBody)) (subtermAddress functionBody)) + (_, addr) <- letrec name (closure (paramNames functionParameters) (freeVariables functionBody) (subtermAddress functionBody)) bind name addr pure (Rval addr) where paramNames = foldMap (maybeToList . declaredName . subterm) @@ -48,7 +47,7 @@ instance Diffable Method where instance Evaluatable Method where eval Method{..} = do name <- maybeM (throwEvalError NoNameError) (declaredName (subterm methodName)) - (_, addr) <- letrec name (closure (paramNames methodParameters) (Set.fromList (freeVariables methodBody)) (subtermAddress methodBody)) + (_, addr) <- letrec name (closure (paramNames methodParameters) (freeVariables methodBody) (subtermAddress methodBody)) bind name addr pure (Rval addr) where paramNames = foldMap (maybeToList . declaredName . subterm) From aee818fc35ddd657a019bfa5453adbd4ef51a76a Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 11:01:42 -0400 Subject: [PATCH 55/58] Specialize FreeVariables1 for Function. --- src/Data/Syntax/Declaration.hs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 2726d3500..130b3f473 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -4,12 +4,13 @@ module Data.Syntax.Declaration where import qualified Data.Abstract.Environment as Env import Data.Abstract.Evaluatable import Data.JSON.Fields +import qualified Data.Set as Set import Diffing.Algorithm import Prologue import Proto3.Suite.Class data Function a = Function { functionContext :: ![a], functionName :: !a, functionParameters :: ![a], functionBody :: !a } - deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Mergeable, FreeVariables1, ToJSONFields1, Named1, Message1) + deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Mergeable, ToJSONFields1, Named1, Message1) instance Diffable Function where equivalentBySubterm = Just . functionName @@ -32,6 +33,10 @@ instance Evaluatable Function where instance Declarations1 Function where liftDeclaredName declaredName = declaredName . functionName +instance FreeVariables1 Function where + liftFreeVariables freeVariables f@Function{..} = foldMap freeVariables f `Set.difference` foldMap freeVariables functionParameters + + data Method a = Method { methodContext :: ![a], methodReceiver :: !a, methodName :: !a, methodParameters :: ![a], methodBody :: !a } deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Mergeable, FreeVariables1, ToJSONFields1, Named1, Message1) From 153102a3e581de43a27390ebb4b4cbbd97071ff9 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 11:02:47 -0400 Subject: [PATCH 56/58] Specialize FreeVariables1 for Method. --- src/Data/Syntax/Declaration.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 130b3f473..8d0b52b2a 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -38,7 +38,7 @@ instance FreeVariables1 Function where data Method a = Method { methodContext :: ![a], methodReceiver :: !a, methodName :: !a, methodParameters :: ![a], methodBody :: !a } - deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Mergeable, FreeVariables1, ToJSONFields1, Named1, Message1) + deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Hashable1, Mergeable, ToJSONFields1, Named1, Message1) instance Eq1 Method where liftEq = genericLiftEq instance Ord1 Method where liftCompare = genericLiftCompare @@ -60,6 +60,9 @@ instance Evaluatable Method where instance Declarations1 Method where liftDeclaredName declaredName = declaredName . methodName +instance FreeVariables1 Method where + liftFreeVariables freeVariables m@Method{..} = foldMap freeVariables m `Set.difference` foldMap freeVariables methodParameters + -- | A method signature in TypeScript or a method spec in Go. data MethodSignature a = MethodSignature { methodSignatureContext :: ![a], methodSignatureName :: !a, methodSignatureParameters :: ![a] } From 27b3f4adac05284cb1d8611e1ebcd2644061d5cd Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 11:40:03 -0400 Subject: [PATCH 57/58] Correct the docs for liftDeclaredName. --- src/Data/Abstract/Declarations.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Abstract/Declarations.hs b/src/Data/Abstract/Declarations.hs index 17677d412..ac22b34e8 100644 --- a/src/Data/Abstract/Declarations.hs +++ b/src/Data/Abstract/Declarations.hs @@ -11,7 +11,7 @@ class Declarations syntax where declaredName = const Nothing class Declarations1 syntax where - -- | Lift a function mapping each element to its set of free variables through a containing structure, collecting the results into a single set. + -- | Lift a function mapping each element to its declared name (if any) through a containing structure. This can be used to define the declared name for a composite piece of syntax in terms of the declared name of one of its components. liftDeclaredName :: (a -> Maybe Name) -> syntax a -> Maybe Name liftDeclaredName _ _ = Nothing From ae5a7cba6675d5365d82277cec9294ee3e0f0189 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 16 Jul 2018 11:44:36 -0400 Subject: [PATCH 58/58] Note what a declared name even is. --- src/Data/Abstract/Declarations.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Data/Abstract/Declarations.hs b/src/Data/Abstract/Declarations.hs index ac22b34e8..b304f146b 100644 --- a/src/Data/Abstract/Declarations.hs +++ b/src/Data/Abstract/Declarations.hs @@ -12,6 +12,8 @@ class Declarations syntax where class Declarations1 syntax where -- | Lift a function mapping each element to its declared name (if any) through a containing structure. This can be used to define the declared name for a composite piece of syntax in terms of the declared name of one of its components. + -- + -- Note that not all syntax will have a declared name; in general it’s reserved for syntax where the user has provided a single, unambiguous name for whatever term is being introduced. Examples would be (non-anonymous) functions, methods, and classes; but not (generally) literals or blocks of imperative statements. liftDeclaredName :: (a -> Maybe Name) -> syntax a -> Maybe Name liftDeclaredName _ _ = Nothing