mirror of
https://github.com/github/semantic.git
synced 2024-12-30 02:14:20 +03:00
🔥 the term & value parameters.
This commit is contained in:
Rob Rix
parent
3e0c8a08d8
commit
ca9533b06e
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
|
||||
module Analysis.Abstract.BadVariables where
|
||||
|
||||
import Control.Abstract.Analysis
|
||||
@ -6,23 +6,23 @@ import Data.Abstract.Evaluatable
|
||||
import Prologue
|
||||
|
||||
-- An analysis that resumes from evaluation errors and records the list of unresolved free variables.
|
||||
newtype BadVariables m term value (effects :: [* -> *]) a = BadVariables (m term value effects a)
|
||||
newtype BadVariables m (effects :: [* -> *]) a = BadVariables (m effects a)
|
||||
deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh, MonadNonDet)
|
||||
|
||||
deriving instance MonadControl term (m term value effects) => MonadControl term (BadVariables m term value effects)
|
||||
deriving instance MonadEnvironment value (m term value effects) => MonadEnvironment value (BadVariables m term value effects)
|
||||
deriving instance MonadHeap value (m term value effects) => MonadHeap value (BadVariables m term value effects)
|
||||
deriving instance MonadModuleTable term value (m term value effects) => MonadModuleTable term value (BadVariables m term value effects)
|
||||
deriving instance MonadEvaluator term value (m term value effects) => MonadEvaluator term value (BadVariables m term value effects)
|
||||
deriving instance MonadControl term (m effects) => MonadControl term (BadVariables m effects)
|
||||
deriving instance MonadEnvironment value (m effects) => MonadEnvironment value (BadVariables m effects)
|
||||
deriving instance MonadHeap value (m effects) => MonadHeap value (BadVariables m effects)
|
||||
deriving instance MonadModuleTable term value (m effects) => MonadModuleTable term value (BadVariables m effects)
|
||||
deriving instance MonadEvaluator term value (m effects) => MonadEvaluator term value (BadVariables m effects)
|
||||
|
||||
instance ( Effectful (m term value)
|
||||
instance ( Effectful m
|
||||
, Member (Resumable (EvalError value)) effects
|
||||
, Member (State [Name]) effects
|
||||
, MonadAnalysis term value (m term value effects)
|
||||
, MonadValue value (BadVariables m term value effects)
|
||||
, MonadAnalysis term value (m effects)
|
||||
, MonadValue value (BadVariables m effects)
|
||||
)
|
||||
=> MonadAnalysis term value (BadVariables m term value effects) where
|
||||
type RequiredEffects term value (BadVariables m term value effects) = State [Name] ': RequiredEffects term value (m term value effects)
|
||||
=> MonadAnalysis term value (BadVariables m effects) where
|
||||
type RequiredEffects term value (BadVariables m effects) = State [Name] ': RequiredEffects term value (m effects)
|
||||
|
||||
analyzeTerm eval term = resumeException @(EvalError value) (liftAnalyze analyzeTerm eval term) (
|
||||
\yield (FreeVariableError name) ->
|
||||
|
||||
@ -22,14 +22,14 @@ type CachingEffects term value effects
|
||||
type CacheFor term value = Cache (LocationFor value) term value
|
||||
|
||||
-- | A (coinductively-)cached analysis suitable for guaranteeing termination of (suitably finitized) analyses over recursive programs.
|
||||
newtype Caching m term value (effects :: [* -> *]) a = Caching (m term value effects a)
|
||||
newtype Caching m (effects :: [* -> *]) a = Caching (m effects a)
|
||||
deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh, MonadNonDet)
|
||||
|
||||
deriving instance MonadControl term (m term value effects) => MonadControl term (Caching m term value effects)
|
||||
deriving instance MonadEnvironment value (m term value effects) => MonadEnvironment value (Caching m term value effects)
|
||||
deriving instance MonadHeap value (m term value effects) => MonadHeap value (Caching m term value effects)
|
||||
deriving instance MonadModuleTable term value (m term value effects) => MonadModuleTable term value (Caching m term value effects)
|
||||
deriving instance MonadEvaluator term value (m term value effects) => MonadEvaluator term value (Caching m term value effects)
|
||||
deriving instance MonadControl term (m effects) => MonadControl term (Caching m effects)
|
||||
deriving instance MonadEnvironment value (m effects) => MonadEnvironment value (Caching m effects)
|
||||
deriving instance MonadHeap value (m effects) => MonadHeap value (Caching m effects)
|
||||
deriving instance MonadModuleTable term value (m effects) => MonadModuleTable term value (Caching m effects)
|
||||
deriving instance MonadEvaluator term value (m effects) => MonadEvaluator term value (Caching m effects)
|
||||
|
||||
-- | Functionality used to perform caching analysis. This is not exported, and exists primarily for organizational reasons.
|
||||
class MonadEvaluator term value m => MonadCaching term value m where
|
||||
@ -46,15 +46,15 @@ class MonadEvaluator term value m => MonadCaching term value m where
|
||||
-- | Run an action starting from an empty out-cache, and return the out-cache afterwards.
|
||||
isolateCache :: m a -> m (CacheFor term value)
|
||||
|
||||
instance ( Effectful (m term value)
|
||||
instance ( Effectful m
|
||||
, Members (CachingEffects term value '[]) effects
|
||||
, MonadEvaluator term value (m term value effects)
|
||||
, MonadEvaluator term value (m effects)
|
||||
, Ord (CellFor value)
|
||||
, Ord (LocationFor value)
|
||||
, Ord term
|
||||
, Ord value
|
||||
)
|
||||
=> MonadCaching term value (Caching m term value effects) where
|
||||
=> MonadCaching term value (Caching m effects) where
|
||||
consultOracle configuration = raise (fromMaybe mempty . cacheLookup configuration <$> ask)
|
||||
withOracle cache = raise . local (const cache) . lower
|
||||
|
||||
@ -69,19 +69,19 @@ instance ( Effectful (m term value)
|
||||
|
||||
-- | This instance coinductively iterates the analysis of a term until the results converge.
|
||||
instance ( Corecursive term
|
||||
, Effectful (m term value)
|
||||
, MonadAnalysis term value (m term value effects)
|
||||
, MonadFresh (m term value effects)
|
||||
, MonadNonDet (m term value effects)
|
||||
, Effectful m
|
||||
, MonadAnalysis term value (m effects)
|
||||
, MonadFresh (m effects)
|
||||
, MonadNonDet (m effects)
|
||||
, Members (CachingEffects term value '[]) effects
|
||||
, Ord (CellFor value)
|
||||
, Ord (LocationFor value)
|
||||
, Ord term
|
||||
, Ord value
|
||||
)
|
||||
=> MonadAnalysis term value (Caching m term value effects) where
|
||||
=> MonadAnalysis term value (Caching m effects) where
|
||||
-- We require the 'CachingEffects' in addition to the underlying analysis’ 'RequiredEffects'.
|
||||
type RequiredEffects term value (Caching m term value effects) = CachingEffects term value (RequiredEffects term value (m term value effects))
|
||||
type RequiredEffects term value (Caching m effects) = CachingEffects term value (RequiredEffects term value (m effects))
|
||||
|
||||
-- Analyze a term using the in-cache as an oracle & storing the results of the analysis in the out-cache.
|
||||
analyzeTerm recur e = do
|
||||
|
||||
@ -10,35 +10,35 @@ import Data.Abstract.Heap
|
||||
import Data.Abstract.Live
|
||||
import Prologue
|
||||
|
||||
newtype Collecting m term value (effects :: [* -> *]) a = Collecting (m term value effects a)
|
||||
newtype Collecting m (effects :: [* -> *]) a = Collecting (m effects a)
|
||||
deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh, MonadNonDet)
|
||||
|
||||
deriving instance MonadControl term (m term value effects) => MonadControl term (Collecting m term value effects)
|
||||
deriving instance MonadEnvironment value (m term value effects) => MonadEnvironment value (Collecting m term value effects)
|
||||
deriving instance MonadHeap value (m term value effects) => MonadHeap value (Collecting m term value effects)
|
||||
deriving instance MonadModuleTable term value (m term value effects) => MonadModuleTable term value (Collecting m term value effects)
|
||||
deriving instance MonadControl term (m effects) => MonadControl term (Collecting m effects)
|
||||
deriving instance MonadEnvironment value (m effects) => MonadEnvironment value (Collecting m effects)
|
||||
deriving instance MonadHeap value (m effects) => MonadHeap value (Collecting m effects)
|
||||
deriving instance MonadModuleTable term value (m effects) => MonadModuleTable term value (Collecting m effects)
|
||||
|
||||
instance ( Effectful (m term value)
|
||||
instance ( Effectful m
|
||||
, Member (Reader (Live (LocationFor value) value)) effects
|
||||
, MonadEvaluator term value (m term value effects)
|
||||
, MonadEvaluator term value (m effects)
|
||||
)
|
||||
=> MonadEvaluator term value (Collecting m term value effects) where
|
||||
=> MonadEvaluator term value (Collecting m effects) where
|
||||
getConfiguration term = Configuration term <$> askRoots <*> getEnv <*> getHeap
|
||||
|
||||
askModuleStack = Collecting askModuleStack
|
||||
|
||||
|
||||
instance ( Effectful (m term value)
|
||||
instance ( Effectful m
|
||||
, Foldable (Cell (LocationFor value))
|
||||
, Member (Reader (Live (LocationFor value) value)) effects
|
||||
, MonadAnalysis term value (m term value effects)
|
||||
, MonadAnalysis term value (m effects)
|
||||
, Ord (LocationFor value)
|
||||
, ValueRoots value
|
||||
)
|
||||
=> MonadAnalysis term value (Collecting m term value effects) where
|
||||
type RequiredEffects term value (Collecting m term value effects)
|
||||
=> MonadAnalysis term value (Collecting m effects) where
|
||||
type RequiredEffects term value (Collecting m effects)
|
||||
= Reader (Live (LocationFor value) value)
|
||||
': RequiredEffects term value (m term value effects)
|
||||
': RequiredEffects term value (m effects)
|
||||
|
||||
-- Small-step evaluation which garbage-collects any non-rooted addresses after evaluating each term.
|
||||
analyzeTerm recur term = do
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
|
||||
module Analysis.Abstract.Dead
|
||||
( type DeadCode
|
||||
) where
|
||||
@ -10,14 +10,14 @@ import Data.Set (delete)
|
||||
import Prologue
|
||||
|
||||
-- | An analysis tracking dead (unreachable) code.
|
||||
newtype DeadCode m term value (effects :: [* -> *]) a = DeadCode (m term value effects a)
|
||||
newtype DeadCode m (effects :: [* -> *]) a = DeadCode (m effects a)
|
||||
deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh, MonadNonDet)
|
||||
|
||||
deriving instance MonadControl term (m term value effects) => MonadControl term (DeadCode m term value effects)
|
||||
deriving instance MonadEnvironment value (m term value effects) => MonadEnvironment value (DeadCode m term value effects)
|
||||
deriving instance MonadHeap value (m term value effects) => MonadHeap value (DeadCode m term value effects)
|
||||
deriving instance MonadModuleTable term value (m term value effects) => MonadModuleTable term value (DeadCode m term value effects)
|
||||
deriving instance MonadEvaluator term value (m term value effects) => MonadEvaluator term value (DeadCode m term value effects)
|
||||
deriving instance MonadControl term (m effects) => MonadControl term (DeadCode m effects)
|
||||
deriving instance MonadEnvironment value (m effects) => MonadEnvironment value (DeadCode m effects)
|
||||
deriving instance MonadHeap value (m effects) => MonadHeap value (DeadCode m effects)
|
||||
deriving instance MonadModuleTable term value (m effects) => MonadModuleTable term value (DeadCode m effects)
|
||||
deriving instance MonadEvaluator term value (m effects) => MonadEvaluator term value (DeadCode m effects)
|
||||
|
||||
-- | A set of “dead” (unreachable) terms.
|
||||
newtype Dead term = Dead { unDead :: Set term }
|
||||
@ -26,11 +26,11 @@ newtype Dead term = Dead { unDead :: Set term }
|
||||
deriving instance Ord term => Reducer term (Dead term)
|
||||
|
||||
-- | Update the current 'Dead' set.
|
||||
killAll :: (Effectful (m term value), Member (State (Dead term)) effects) => Dead term -> DeadCode m term value effects ()
|
||||
killAll :: (Effectful m, Member (State (Dead term)) effects) => Dead term -> DeadCode m effects ()
|
||||
killAll = raise . put
|
||||
|
||||
-- | Revive a single term, removing it from the current 'Dead' set.
|
||||
revive :: (Effectful (m term value), Member (State (Dead term)) effects) => Ord term => term -> DeadCode m term value effects ()
|
||||
revive :: (Effectful m, Member (State (Dead term)) effects) => Ord term => term -> DeadCode m effects ()
|
||||
revive t = raise (modify (Dead . delete t . unDead))
|
||||
|
||||
-- | Compute the set of all subterms recursively.
|
||||
@ -39,15 +39,15 @@ subterms term = term `cons` para (foldMap (uncurry cons)) term
|
||||
|
||||
|
||||
instance ( Corecursive term
|
||||
, Effectful (m term value)
|
||||
, Effectful m
|
||||
, Foldable (Base term)
|
||||
, Member (State (Dead term)) effects
|
||||
, MonadAnalysis term value (m term value effects)
|
||||
, MonadAnalysis term value (m effects)
|
||||
, Ord term
|
||||
, Recursive term
|
||||
)
|
||||
=> MonadAnalysis term value (DeadCode m term value effects) where
|
||||
type RequiredEffects term value (DeadCode m term value effects) = State (Dead term) ': RequiredEffects term value (m term value effects)
|
||||
=> MonadAnalysis term value (DeadCode m effects) where
|
||||
type RequiredEffects term value (DeadCode m effects) = State (Dead term) ': RequiredEffects term value (m effects)
|
||||
|
||||
analyzeTerm recur term = do
|
||||
revive (embedSubterm term)
|
||||
|
||||
@ -23,23 +23,23 @@ newtype ImportGraph = ImportGraph { unImportGraph :: G.Graph Name }
|
||||
renderImportGraph :: ImportGraph -> ByteString
|
||||
renderImportGraph = export (defaultStyle friendlyName) . unImportGraph
|
||||
|
||||
newtype ImportGraphing m term value (effects :: [* -> *]) a = ImportGraphing (m term value effects a)
|
||||
newtype ImportGraphing m (effects :: [* -> *]) a = ImportGraphing (m effects a)
|
||||
deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh, MonadNonDet)
|
||||
|
||||
deriving instance MonadControl term (m term value effects) => MonadControl term (ImportGraphing m term value effects)
|
||||
deriving instance MonadEnvironment value (m term value effects) => MonadEnvironment value (ImportGraphing m term value effects)
|
||||
deriving instance MonadHeap value (m term value effects) => MonadHeap value (ImportGraphing m term value effects)
|
||||
deriving instance MonadModuleTable term value (m term value effects) => MonadModuleTable term value (ImportGraphing m term value effects)
|
||||
deriving instance MonadEvaluator term value (m term value effects) => MonadEvaluator term value (ImportGraphing m term value effects)
|
||||
deriving instance MonadControl term (m effects) => MonadControl term (ImportGraphing m effects)
|
||||
deriving instance MonadEnvironment value (m effects) => MonadEnvironment value (ImportGraphing m effects)
|
||||
deriving instance MonadHeap value (m effects) => MonadHeap value (ImportGraphing m effects)
|
||||
deriving instance MonadModuleTable term value (m effects) => MonadModuleTable term value (ImportGraphing m effects)
|
||||
deriving instance MonadEvaluator term value (m effects) => MonadEvaluator term value (ImportGraphing m effects)
|
||||
|
||||
|
||||
instance ( Effectful (m term value)
|
||||
instance ( Effectful m
|
||||
, Member (State ImportGraph) effects
|
||||
, MonadAnalysis term value (m term value effects)
|
||||
, MonadAnalysis term value (m effects)
|
||||
, Member (Resumable (LoadError term value)) effects
|
||||
)
|
||||
=> MonadAnalysis term value (ImportGraphing m term value effects) where
|
||||
type RequiredEffects term value (ImportGraphing m term value effects) = State ImportGraph ': RequiredEffects term value (m term value effects)
|
||||
=> MonadAnalysis term value (ImportGraphing m effects) where
|
||||
type RequiredEffects term value (ImportGraphing m effects) = State ImportGraph ': RequiredEffects term value (m effects)
|
||||
|
||||
analyzeTerm eval term = resumeException
|
||||
@(LoadError term value)
|
||||
@ -50,11 +50,11 @@ instance ( Effectful (m term value)
|
||||
insertVertexName (moduleName m)
|
||||
liftAnalyze analyzeModule recur m
|
||||
|
||||
insertVertexName :: (Effectful (m term value)
|
||||
insertVertexName :: (Effectful m
|
||||
, Member (State ImportGraph) effects
|
||||
, MonadEvaluator term value (m term value effects))
|
||||
, MonadEvaluator term value (m effects))
|
||||
=> NonEmpty ByteString
|
||||
-> ImportGraphing m term value effects ()
|
||||
-> ImportGraphing m effects ()
|
||||
insertVertexName name = do
|
||||
ms <- askModuleStack
|
||||
let parent = maybe empty (vertex . moduleName) (listToMaybe ms)
|
||||
@ -65,7 +65,7 @@ insertVertexName name = do
|
||||
|
||||
infixr 7 ><
|
||||
|
||||
modifyImportGraph :: (Effectful (m term value), Member (State ImportGraph) effects) => (ImportGraph -> ImportGraph) -> ImportGraphing m term value effects ()
|
||||
modifyImportGraph :: (Effectful m, Member (State ImportGraph) effects) => (ImportGraph -> ImportGraph) -> ImportGraphing m effects ()
|
||||
modifyImportGraph = raise . modify
|
||||
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeApplications, TypeFamilies #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeApplications, TypeFamilies, UndecidableInstances #-}
|
||||
module Analysis.Abstract.Quiet where
|
||||
|
||||
import Control.Abstract.Analysis
|
||||
@ -12,22 +12,22 @@ import Prologue
|
||||
-- > runAnalysis @(Quietly Evaluating term value) (…)
|
||||
--
|
||||
-- Note that exceptions thrown by other analyses may not be caught if 'Quietly' doesn’t know about them, i.e. if they’re not part of the generic 'MonadValue', 'MonadAddressable', etc. machinery.
|
||||
newtype Quietly m term value (effects :: [* -> *]) a = Quietly (m term value effects a)
|
||||
newtype Quietly m (effects :: [* -> *]) a = Quietly (m effects a)
|
||||
deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh, MonadNonDet)
|
||||
|
||||
deriving instance MonadControl term (m term value effects) => MonadControl term (Quietly m term value effects)
|
||||
deriving instance MonadEnvironment value (m term value effects) => MonadEnvironment value (Quietly m term value effects)
|
||||
deriving instance MonadHeap value (m term value effects) => MonadHeap value (Quietly m term value effects)
|
||||
deriving instance MonadModuleTable term value (m term value effects) => MonadModuleTable term value (Quietly m term value effects)
|
||||
deriving instance MonadEvaluator term value (m term value effects) => MonadEvaluator term value (Quietly m term value effects)
|
||||
deriving instance MonadControl term (m effects) => MonadControl term (Quietly m effects)
|
||||
deriving instance MonadEnvironment value (m effects) => MonadEnvironment value (Quietly m effects)
|
||||
deriving instance MonadHeap value (m effects) => MonadHeap value (Quietly m effects)
|
||||
deriving instance MonadModuleTable term value (m effects) => MonadModuleTable term value (Quietly m effects)
|
||||
deriving instance MonadEvaluator term value (m effects) => MonadEvaluator term value (Quietly m effects)
|
||||
|
||||
instance ( Effectful (m term value)
|
||||
instance ( Effectful m
|
||||
, Member (Resumable (Unspecialized value)) effects
|
||||
, MonadAnalysis term value (m term value effects)
|
||||
, MonadValue value (Quietly m term value effects)
|
||||
, MonadAnalysis term value (m effects)
|
||||
, MonadValue value (Quietly m effects)
|
||||
)
|
||||
=> MonadAnalysis term value (Quietly m term value effects) where
|
||||
type RequiredEffects term value (Quietly m term value effects) = RequiredEffects term value (m term value effects)
|
||||
=> MonadAnalysis term value (Quietly m effects) where
|
||||
type RequiredEffects term value (Quietly m effects) = RequiredEffects term value (m effects)
|
||||
|
||||
analyzeTerm eval term = resumeException @(Unspecialized value) (liftAnalyze analyzeTerm eval term) (\yield (Unspecialized _) -> unit >>= yield)
|
||||
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
|
||||
module Analysis.Abstract.Tracing
|
||||
( type Tracing
|
||||
) where
|
||||
@ -12,36 +12,36 @@ import Prologue hiding (trace)
|
||||
-- | Trace analysis.
|
||||
--
|
||||
-- Instantiating @trace@ to @[]@ yields a linear trace analysis, while @Set@ yields a reachable state analysis.
|
||||
newtype Tracing (trace :: * -> *) m term value (effects :: [* -> *]) a = Tracing (m term value effects a)
|
||||
newtype Tracing (trace :: * -> *) m (effects :: [* -> *]) a = Tracing (m effects a)
|
||||
deriving (Alternative, Applicative, Functor, Effectful, Monad, MonadFail, MonadFresh, MonadNonDet)
|
||||
|
||||
deriving instance MonadControl term (m term value effects) => MonadControl term (Tracing trace m term value effects)
|
||||
deriving instance MonadEnvironment value (m term value effects) => MonadEnvironment value (Tracing trace m term value effects)
|
||||
deriving instance MonadHeap value (m term value effects) => MonadHeap value (Tracing trace m term value effects)
|
||||
deriving instance MonadModuleTable term value (m term value effects) => MonadModuleTable term value (Tracing trace m term value effects)
|
||||
deriving instance MonadEvaluator term value (m term value effects) => MonadEvaluator term value (Tracing trace m term value effects)
|
||||
deriving instance MonadControl term (m effects) => MonadControl term (Tracing trace m effects)
|
||||
deriving instance MonadEnvironment value (m effects) => MonadEnvironment value (Tracing trace m effects)
|
||||
deriving instance MonadHeap value (m effects) => MonadHeap value (Tracing trace m effects)
|
||||
deriving instance MonadModuleTable term value (m effects) => MonadModuleTable term value (Tracing trace m effects)
|
||||
deriving instance MonadEvaluator term value (m effects) => MonadEvaluator term value (Tracing trace m effects)
|
||||
|
||||
instance ( Corecursive term
|
||||
, Effectful (m term value)
|
||||
, Effectful m
|
||||
, Member (Writer (trace (ConfigurationFor term value))) effects
|
||||
, MonadAnalysis term value (m term value effects)
|
||||
, MonadAnalysis term value (m effects)
|
||||
, Ord (LocationFor value)
|
||||
, Reducer (ConfigurationFor term value) (trace (ConfigurationFor term value))
|
||||
)
|
||||
=> MonadAnalysis term value (Tracing trace m term value effects) where
|
||||
type RequiredEffects term value (Tracing trace m term value effects) = Writer (trace (ConfigurationFor term value)) ': RequiredEffects term value (m term value effects)
|
||||
=> MonadAnalysis term value (Tracing trace m effects) where
|
||||
type RequiredEffects term value (Tracing trace m effects) = Writer (trace (ConfigurationFor term value)) ': RequiredEffects term value (m effects)
|
||||
|
||||
analyzeTerm recur term = do
|
||||
config <- getConfiguration (embedSubterm term)
|
||||
trace (Reducer.unit config)
|
||||
trace @m @trace @term @value (Reducer.unit config)
|
||||
liftAnalyze analyzeTerm recur term
|
||||
|
||||
analyzeModule = liftAnalyze analyzeModule
|
||||
|
||||
-- | Log the given trace of configurations.
|
||||
trace :: ( Effectful (m term value)
|
||||
trace :: ( Effectful m
|
||||
, Member (Writer (trace (ConfigurationFor term value))) effects
|
||||
)
|
||||
=> trace (ConfigurationFor term value)
|
||||
-> Tracing trace m term value effects ()
|
||||
-> Tracing trace m effects ()
|
||||
trace = raise . tell
|
||||
|
||||
@ -46,9 +46,9 @@ class MonadEvaluator term value m => MonadAnalysis term value m where
|
||||
|
||||
|
||||
-- | Lift a 'SubtermAlgebra' for an underlying analysis into a containing analysis. Use this when defining an analysis which can be composed onto other analyses to ensure that a call to 'analyzeTerm' occurs in the inner analysis and not the outer one.
|
||||
liftAnalyze :: Coercible ( m term value effects value) (t m term value (effects :: [* -> *]) value)
|
||||
=> ((base (Subterm term (outer value)) -> m term value effects value) -> (base (Subterm term (outer value)) -> m term value effects value))
|
||||
-> ((base (Subterm term (outer value)) -> t m term value effects value) -> (base (Subterm term (outer value)) -> t m term value effects value))
|
||||
liftAnalyze :: Coercible ( m effects value) (t m (effects :: [* -> *]) value)
|
||||
=> ((base (Subterm term (outer value)) -> m effects value) -> (base (Subterm term (outer value)) -> m effects value))
|
||||
-> ((base (Subterm term (outer value)) -> t m effects value) -> (base (Subterm term (outer value)) -> t m effects value))
|
||||
liftAnalyze analyze recur term = coerce (analyze (coerceWith (sym Coercion) . recur) term)
|
||||
|
||||
|
||||
|
||||
@ -42,27 +42,27 @@ import qualified Language.TypeScript.Assignment as TypeScript
|
||||
-- Ruby
|
||||
evaluateRubyFile = evaluateWithPrelude rubyParser
|
||||
evaluateRubyFiles = evaluateFilesWithPrelude rubyParser
|
||||
evaluateRubyImportGraph paths = runAnalysis @(ImportGraphing Evaluating Ruby.Term Value) . evaluateModules <$> parseFiles rubyParser paths
|
||||
evaluateRubyBadVariables paths = runAnalysis @(BadVariables Evaluating Ruby.Term Value) . evaluateModules <$> parseFiles rubyParser paths
|
||||
evaluateRubyImportGraph paths = runAnalysis @(ImportGraphing (Evaluating Ruby.Term Value)) . evaluateModules <$> parseFiles rubyParser paths
|
||||
evaluateRubyBadVariables paths = runAnalysis @(BadVariables (Evaluating Ruby.Term Value)) . evaluateModules <$> parseFiles rubyParser paths
|
||||
|
||||
-- Go
|
||||
evaluateGoFile = evaluateFile goParser
|
||||
evaluateGoFiles = evaluateFiles goParser
|
||||
typecheckGoFile path = runAnalysis @(Caching Evaluating Go.Term Type) . evaluateModule <$> parseFile goParser Nothing path
|
||||
typecheckGoFile path = runAnalysis @(Caching (Evaluating Go.Term Type)) . evaluateModule <$> parseFile goParser Nothing path
|
||||
|
||||
-- Python
|
||||
evaluatePythonFile = evaluateWithPrelude pythonParser
|
||||
evaluatePythonFiles = evaluateFilesWithPrelude pythonParser
|
||||
typecheckPythonFile path = runAnalysis @(Caching Evaluating Python.Term Type) . evaluateModule <$> parseFile pythonParser Nothing path
|
||||
tracePythonFile path = runAnalysis @(Tracing [] Evaluating Python.Term Value) . evaluateModule <$> parseFile pythonParser Nothing path
|
||||
evaluateDeadTracePythonFile path = runAnalysis @(DeadCode (Tracing [] Evaluating) Python.Term Value) . evaluateModule <$> parseFile pythonParser Nothing path
|
||||
typecheckPythonFile path = runAnalysis @(Caching (Evaluating Python.Term Type)) . evaluateModule <$> parseFile pythonParser Nothing path
|
||||
tracePythonFile path = runAnalysis @(Tracing [] (Evaluating Python.Term Value)) . evaluateModule <$> parseFile pythonParser Nothing path
|
||||
evaluateDeadTracePythonFile path = runAnalysis @(DeadCode (Tracing [] (Evaluating Python.Term Value))) . evaluateModule <$> parseFile pythonParser Nothing path
|
||||
|
||||
-- PHP
|
||||
evaluatePHPFile = evaluateFile phpParser
|
||||
evaluatePHPFiles = evaluateFiles phpParser
|
||||
|
||||
-- TypeScript
|
||||
typecheckTypeScriptFile path = runAnalysis @(Caching Evaluating TypeScript.Term Type) . evaluateModule <$> parseFile typescriptParser Nothing path
|
||||
typecheckTypeScriptFile path = runAnalysis @(Caching (Evaluating TypeScript.Term Type)) . evaluateModule <$> parseFile typescriptParser Nothing path
|
||||
evaluateTypeScriptFile = evaluateFile typescriptParser
|
||||
evaluateTypeScriptFiles = evaluateFiles typescriptParser
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user