github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-11-24 00:42:33 +03:00
Code Issues Projects Releases Wiki Activity

Merge branch 'master' into source-aware-reprinter

Browse Source
This commit is contained in:
Timothy Clem 2018-08-28 11:34:53 -07:00 committed by GitHub
commit 34648a263a
11 changed files with 210 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
semantic.cabal
View File

@ -44,6 +44,7 @@ library
, Control.Abstract.Matching
, Control.Abstract.Modules
, Control.Abstract.Primitive
, Control.Abstract.PythonPackage
, Control.Abstract.Roots
, Control.Abstract.TermEvaluator
, Control.Abstract.Value

2
src/Control/Abstract/Primitive.hs
View File

@ -98,7 +98,7 @@ instance (Member Fresh effects, Lambda address value effects ret) => Lambda addr
{-# INLINE lambda' #-}
instance Member (Function address value) effects => Lambda address value effects (Evaluator address value effects address) where
lambda' vars = function vars lowerBound
lambda' vars = function Nothing vars lowerBound
{-# INLINE lambda' #-}
builtInPrint :: ( AbstractValue address value effects

66
src/Control/Abstract/PythonPackage.hs Normal file
View File

@ -0,0 +1,66 @@
{-# LANGUAGE GADTs, LambdaCase, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-}
module Control.Abstract.PythonPackage
( runPythonPackaging, Strategy(..) ) where
import Control.Abstract.Evaluator (LoopControl, Return)
import Control.Abstract.Heap (Allocator, Deref, deref)
import Control.Abstract.Value
import Control.Monad.Effect (Effectful (..))
import qualified Control.Monad.Effect as Eff
import Data.Abstract.Evaluatable
import Data.Abstract.Name (name)
import Data.Abstract.Path (stripQuotes)
import Data.Abstract.Value.Concrete (Value (..), ValueError (..))
import Data.Coerce
import qualified Data.Map as Map
import Prologue
data Strategy = Unknown | Packages [Text] | FindPackages [Text]
deriving (Show, Eq)
runPythonPackaging :: forall effects address body a. (
Eff.PureEffects effects
, Ord address
, Show address
, Member Trace effects
, Member (Boolean (Value address body)) effects
, Member (State (Heap address (Value address body))) effects
, Member (Resumable (BaseError (AddressError address (Value address body)))) effects
, Member (Resumable (BaseError (ValueError address body))) effects
, Member Fresh effects
, Coercible body (Eff.Eff effects)
, Member (State Strategy) effects
, Member (Allocator address) effects
, Member (Deref (Value address body)) effects
, Member (Env address) effects
, Member (Eff.Exc (LoopControl address)) effects
, Member (Eff.Exc (Return address)) effects
, Member (Eff.Reader ModuleInfo) effects
, Member (Eff.Reader PackageInfo) effects
, Member (Eff.Reader Span) effects
, Member (Function address (Value address body)) effects)
=> Evaluator address (Value address body) effects a
-> Evaluator address (Value address body) effects a
runPythonPackaging = Eff.interpose @(Function address (Value address body)) $ \case
Call callName super params -> do
case callName of
Closure _ _ name' paramNames _ _ -> do
let bindings = foldr (\ (name, addr) rest -> Map.insert name addr rest) lowerBound (zip paramNames params)
let asStrings address = (deref >=> asArray) address >>= traverse (deref >=> asString)
case name' of
Just n
| name "find_packages" == n -> do
as <- maybe (pure mempty) (fmap (fmap stripQuotes) . asStrings) (Map.lookup (name "exclude") bindings)
put (FindPackages as)
| name "setup" == n -> do
packageState <- get
if packageState == Unknown then do
as <- maybe (pure mempty) (fmap (fmap stripQuotes) . asStrings) (Map.lookup (name "packages") bindings)
put (Packages as)
else
pure ()
_ -> pure ()
_ -> pure ()
call callName super params
Function name params vars body -> function name params vars (raiseEff body)

18
src/Control/Abstract/Value.hs
View File

@ -48,7 +48,6 @@ data Comparator
= Concrete (forall a . Ord a => a -> a -> Bool)
| Generalized
-- Value effects
-- $valueEffects
@ -63,20 +62,19 @@ data Comparator
--
-- In the concrete domain, introductions & eliminations respectively construct & pattern match against values, while in abstract domains they respectively construct & project finite sets of discrete observations of abstract values. For example, an abstract domain modelling integers as a sign (-, 0, or +) would introduce abstract values by mapping integers to their sign and eliminate them by mapping signs back to some canonical integer, e.g. - -> -1, 0 -> 0, + -> 1.
function :: Member (Function address value) effects => [Name] -> Set Name -> Evaluator address value effects address -> Evaluator address value effects value
function names fvs (Evaluator body) = send (Function names fvs body)
function :: Member (Function address value) effects => Maybe Name -> [Name] -> Set Name -> Evaluator address value effects address -> Evaluator address value effects value
function name params fvs (Evaluator body) = send (Function name params fvs body)
call :: Member (Function address value) effects => value -> address -> [address] -> Evaluator address value effects address
call fn self args = send (Call fn self args)
data Function address value m result where
Function :: [Name] -> Set Name -> m address -> Function address value m value
Function :: Maybe Name -> [Name] -> Set Name -> m address -> Function address value m value
Call :: value -> address -> [address] -> Function address value m address
instance PureEffect (Function address value) where
handle handler (Request (Function name fvs body) k) = Request (Function name fvs (handler body)) (handler . k)
handle handler (Request (Call fn self addrs) k) = Request (Call fn self addrs) (handler . k)
handle handler (Request (Function name params fvs body) k) = Request (Function name params fvs (handler body)) (handler . k)
handle handler (Request (Call fn self addrs) k) = Request (Call fn self addrs) (handler . k)
-- | Construct a boolean value in the abstract domain.
boolean :: Member (Boolean value) effects => Bool -> Evaluator address value effects value
@ -178,6 +176,8 @@ class AbstractIntro value => AbstractValue address value effects where
-- | Construct an array of zero or more values.
array :: [address] -> Evaluator address value effects value
asArray :: value -> Evaluator address value effects [address]
-- | Extract the contents of a key-value pair as a tuple.
asPair :: value -> Evaluator address value effects (value, value)
@ -310,9 +310,9 @@ address :: ( AbstractValue address value effects
)
=> ValueRef address
-> Evaluator address value effects address
address (LvalLocal var) = variable var
address (LvalLocal var) = variable var
address (LvalMember ptr prop) = evaluateInScopedEnv ptr (variable prop)
address (Rval addr) = pure addr
address (Rval addr) = pure addr
-- | Evaluates a 'Subterm' to the address of its rval
subtermAddress :: ( AbstractValue address value effects

3
src/Data/Abstract/Value/Abstract.hs
View File

@ -29,7 +29,7 @@ runFunction :: ( Member (Allocator address) effects
=> Evaluator address Abstract (Function address Abstract ': effects) a
-> Evaluator address Abstract effects a
runFunction = interpret $ \case
Function params _ body -> do
Function _ params _ body -> do
env <- foldr (\ name rest -> do
addr <- alloc name
assign addr Abstract
@ -88,6 +88,7 @@ instance ( Member (Allocator address) effects
asString _ = pure ""
asPair _ = pure (Abstract, Abstract)
asArray _ = pure mempty
index _ _ = box Abstract

15
src/Data/Abstract/Value/Concrete.hs
View File

@ -27,7 +27,7 @@ import Data.Word
import Prologue
data Value address body
= Closure PackageInfo ModuleInfo [Name] (ClosureBody address body) (Environment address)
= Closure PackageInfo ModuleInfo (Maybe Name) [Name] (ClosureBody address body) (Environment address)
| Unit
| Boolean Bool
| Integer (Number.Number Integer)
@ -60,7 +60,7 @@ instance Show (ClosureBody address body) where
instance Ord address => ValueRoots address (Value address body) where
valueRoots v
| Closure _ _ _ _ env <- v = Env.addresses env
| Closure _ _ _ _ _ env <- v = Env.addresses env
| otherwise = mempty
@ -83,14 +83,14 @@ runFunction :: ( Member (Allocator address) effects
-> Evaluator address (Value address body) (Abstract.Function address (Value address body) ': effects) a
-> Evaluator address (Value address body) effects a
runFunction toEvaluator fromEvaluator = interpret $ \case
Abstract.Function params fvs body -> do
Abstract.Function name params fvs body -> do
packageInfo <- currentPackage
moduleInfo <- currentModule
i <- fresh
Closure packageInfo moduleInfo params (ClosureBody i (fromEvaluator (Evaluator body))) <$> close (foldr Set.delete fvs params)
Closure packageInfo moduleInfo name params (ClosureBody i (fromEvaluator (Evaluator body))) <$> close (foldr Set.delete fvs params)
Abstract.Call op self params -> do
case op of
Closure packageInfo moduleInfo names (ClosureBody _ body) env -> do
Closure packageInfo moduleInfo _ names (ClosureBody _ body) env -> do
-- Evaluate the bindings and body with the closure’s package/module info in scope in order to
-- charge them to the closure's origin.
withCurrentPackage packageInfo . withCurrentModule moduleInfo $ do
@ -187,6 +187,10 @@ instance ( Coercible body (Eff effects)
tuple = pure . Tuple
array = pure . Array
asArray val
| Array addresses <- val = pure addresses
| otherwise = throwValueError $ ArrayError val
klass n supers binds = do
pure $ Class n supers binds
@ -317,6 +321,7 @@ data ValueError address body resume where
BitwiseError :: Value address body -> ValueError address body (Value address body)
Bitwise2Error :: Value address body -> Value address body -> ValueError address body (Value address body)
KeyValueError :: Value address body -> ValueError address body (Value address body, Value address body)
ArrayError :: Value address body -> ValueError address body [address]
-- Indicates that we encountered an arithmetic exception inside Haskell-native number crunching.
ArithmeticError :: ArithException -> ValueError address body (Value address body)
-- Out-of-bounds error

5
src/Data/Abstract/Value/Type.hs
View File

@ -246,7 +246,7 @@ runFunction :: ( Member (Allocator address) effects
=> Evaluator address Type (Abstract.Function address Type ': effects) a
-> Evaluator address Type effects a
runFunction = interpret $ \case
Abstract.Function params _ body -> do
Abstract.Function _ params _ body -> do
(env, tvars) <- foldr (\ name rest -> do
addr <- alloc name
tvar <- Var <$> fresh
@ -324,6 +324,9 @@ instance ( Member (Allocator address) effects
t1 <- fresh
t2 <- fresh
unify t (Var t1 :* Var t2) $> (Var t1, Var t2)
asArray t = do
field <- fresh
unify t (Array (Var field)) $> mempty
index arr sub = do
_ <- unify sub Int

4
src/Data/Syntax/Declaration.hs
View File

@ -27,7 +27,7 @@ instance Show1 Function where liftShowsPrec = genericLiftShowsPrec
instance Evaluatable Function where
eval Function{..} = do
name <- maybeM (throwEvalError NoNameError) (declaredName (subterm functionName))
(_, addr) <- letrec name (function (paramNames functionParameters) (freeVariables functionBody) (subtermAddress functionBody))
(_, addr) <- letrec name (function (Just name) (paramNames functionParameters) (freeVariables functionBody) (subtermAddress functionBody))
bind name addr
pure (Rval addr)
where paramNames = foldMap (maybeToList . declaredName . subterm)
@ -60,7 +60,7 @@ instance Diffable Method where
instance Evaluatable Method where
eval Method{..} = do
name <- maybeM (throwEvalError NoNameError) (declaredName (subterm methodName))
(_, addr) <- letrec name (function (paramNames methodParameters) (freeVariables methodBody) (subtermAddress methodBody))
(_, addr) <- letrec name (function (Just name) (paramNames methodParameters) (freeVariables methodBody) (subtermAddress methodBody))
bind name addr
pure (Rval addr)
where paramNames = foldMap (maybeToList . declaredName . subterm)

114
src/Semantic/Graph.hs
View File

@ -11,6 +11,7 @@ module Semantic.Graph
, ConcreteEff(..)
, style
, parsePackage
, parsePythonPackage
, withTermSpans
, resumingResolutionError
, resumingLoadError
@ -29,31 +30,36 @@ import Analysis.Abstract.Caching
import Analysis.Abstract.Collecting
import Analysis.Abstract.Graph as Graph
import Control.Abstract
import Control.Abstract.PythonPackage as PythonPackage
import Data.Abstract.Address.Hole as Hole
import Data.Abstract.Address.Located as Located
import Data.Abstract.Address.Monovariant as Monovariant
import Data.Abstract.Address.Precise as Precise
import Data.Abstract.BaseError (BaseError(..))
import Data.Abstract.BaseError (BaseError (..))
import Data.Abstract.Evaluatable
import Data.Abstract.Module
import qualified Data.Abstract.ModuleTable as ModuleTable
import Data.Abstract.Package as Package
import Data.Abstract.Value.Abstract as Abstract
import Data.Abstract.Value.Concrete as Concrete (Value, ValueError (..), runBoolean, runFunction, runValueErrorWith)
import Data.Abstract.Value.Concrete as Concrete
(Value, ValueError (..), runBoolean, runFunction, runValueErrorWith)
import Data.Abstract.Value.Type as Type
import Data.Blob
import Data.Coerce
import Data.Graph
import Data.Graph.Vertex (VertexDeclarationStrategy, VertexDeclarationWithStrategy)
import Data.Language as Language
import Data.List (isPrefixOf, isSuffixOf)
import Data.Project
import Data.Record
import Data.Term
import Data.Text (pack)
import Data.Text (pack, unpack)
import Language.Haskell.HsColour
import Language.Haskell.HsColour.Colourise
import Parsing.Parser
import Prologue hiding (MonadError (..), TypeError (..))
import Semantic.Task as Task
import System.FilePath.Posix (takeDirectory, (</>))
import Text.Show.Pretty (ppShow)
data GraphType = ImportGraph | CallGraph
@ -66,12 +72,14 @@ runGraph :: forall effs. (Member Distribute effs, Member (Exc SomeException) eff
-> Project
-> Eff effs (Graph Vertex)
runGraph ImportGraph _ project
| SomeAnalysisParser parser lang <- someAnalysisParser (Proxy :: Proxy AnalysisClasses) (projectLanguage project) = do
package <- fmap snd <$> parsePackage parser project
runImportGraphToModuleInfos lang package
| SomeAnalysisParser parser (lang' :: Proxy lang) <- someAnalysisParser (Proxy :: Proxy AnalysisClasses) (projectLanguage project) = do
let parse = if projectLanguage project == Language.Python then parsePythonPackage parser else fmap (fmap snd) . parsePackage parser
package <- parse project
runImportGraphToModuleInfos lang' package
runGraph CallGraph includePackages project
| SomeAnalysisParser parser lang <- someAnalysisParser (Proxy :: Proxy AnalysisClasses) (projectLanguage project) = do
package <- fmap snd <$> parsePackage parser project
let parse = if projectLanguage project == Language.Python then parsePythonPackage parser else fmap (fmap snd) . parsePackage parser
package <- parse project
modules <- topologicalSort <$> runImportGraphToModules lang package
runCallGraph lang includePackages modules package
@ -227,13 +235,90 @@ parsePackage parser project = do
where
n = name (projectName project)
parseModules parser p = distributeFor (projectFiles p) (parseModule p parser)
-- | Parse all files in a project into 'Module's.
parseModules :: (Member Distribute effs, Member (Exc SomeException) effs, Member Task effs) => Parser term -> Project -> Eff effs [Module (Blob, term)]
parseModules parser p@Project{..} = distributeFor (projectFiles p) (parseModule p parser)
parseModule proj parser file = do
mBlob <- readFile proj file
case mBlob of
Just blob -> moduleForBlob (Just (projectRootDir proj)) blob . (,) blob <$> parse parser blob
Nothing -> throwError (SomeException (FileNotFound (filePath file)))
-- | Parse a list of packages from a python project.
parsePythonPackage :: forall syntax fields effs term.
( Declarations1 syntax
, Evaluatable syntax
, FreeVariables1 syntax
, Functor syntax
, term ~ Term syntax (Record fields)
, Member (Exc SomeException) effs
, Member Distribute effs
, Member Resolution effs
, Member Trace effs
, Member Task effs
, (Show (Record fields))
, Effects effs)
=> Parser term -- ^ A parser.
-> Project -- ^ Project to parse into a package.
-> Eff effs (Package term)
parsePythonPackage parser project = do
let runAnalysis = runEvaluator
. runState PythonPackage.Unknown
. runState lowerBound
. runFresh 0
. resumingLoadError
. resumingUnspecialized
. resumingEnvironmentError
. resumingEvalError
. resumingResolutionError
. resumingAddressError
. resumingValueError
. runReader lowerBound
. runModules lowerBound
. runTermEvaluator @_ @_ @(Value (Hole (Maybe Name) Precise) (ConcreteEff (Hole (Maybe Name) Precise) _))
. runReader (PackageInfo (name "setup") lowerBound)
. runReader lowerBound
runAddressEffects
= Hole.runAllocator Precise.handleAllocator
. Hole.runDeref Precise.handleDeref
strat <- case find ((== (projectRootDir project </> "setup.py")) . filePath) (projectFiles project) of
Just setupFile -> do
setupModule <- fmap snd <$> parseModule project parser setupFile
fst <$> runAnalysis (evaluate (Proxy @'Language.Python) id id runAddressEffects (Concrete.runBoolean . Concrete.runFunction coerce coerce . runPythonPackaging) [ setupModule ])
Nothing -> pure PythonPackage.Unknown
case strat of
PythonPackage.Unknown -> do
modules <- fmap (fmap snd) <$> parseModules parser project
resMap <- Task.resolutionMap project
pure (Package.fromModules (name (projectName project)) modules resMap)
PythonPackage.Packages dirs -> do
filteredBlobs <- for dirs $ \dir -> do
let packageDir = projectRootDir project </> unpack dir
let paths = filter ((packageDir `isPrefixOf`) . filePath) (projectFiles project)
traverse (readFile project) paths
packageFromProject project filteredBlobs
PythonPackage.FindPackages excludeDirs -> do
trace "In Graph.FindPackages"
let initFiles = filter (("__init__.py" `isSuffixOf`) . filePath) (projectFiles project)
let packageDirs = filter (`notElem` ((projectRootDir project </>) . unpack <$> excludeDirs)) (takeDirectory . filePath <$> initFiles)
filteredBlobs <- for packageDirs $ \dir -> do
let paths = filter ((dir `isPrefixOf`) . filePath) (projectFiles project)
traverse (readFile project) paths
packageFromProject project filteredBlobs
where
packageFromProject project filteredBlobs = do
let p = project { projectBlobs = catMaybes $ join filteredBlobs }
modules <- fmap (fmap snd) <$> parseModules parser p
resMap <- Task.resolutionMap p
pure (Package.fromModules (name $ projectName p) modules resMap)
parseModule :: (Member (Exc SomeException) effs, Member Task effs)
=> Project
-> Parser term
-> File
-> Eff effs (Module (Blob, term))
parseModule proj parser file = do
mBlob <- readFile proj file
case mBlob of
Just blob -> moduleForBlob (Just (projectRootDir proj)) blob . (,) blob <$> parse parser blob
Nothing -> throwError (SomeException (FileNotFound (filePath file)))
withTermSpans :: ( HasField fields Span
, Member (Reader Span) effects
@ -324,6 +409,7 @@ resumingValueError = runValueErrorWith (\ baseError -> traceError "ValueError" b
BitwiseError{} -> pure hole
Bitwise2Error{} -> pure hole
KeyValueError{} -> pure (hole, hole)
ArrayError{} -> pure lowerBound
ArithmeticError{} -> pure hole)
resumingEnvironmentError :: ( Monad (m (Hole (Maybe Name) address) value effects)
@ -344,7 +430,7 @@ resumingTypeError :: ( Alternative (m address Type (State TypeMap ': effects))
-> m address Type effects a
resumingTypeError = runTypesWith (\ baseError -> traceError "TypeError" baseError *> case baseErrorException baseError of
UnificationError l r -> pure l <|> pure r
InfiniteType _ r -> pure r)
InfiniteType _ r -> pure r)
prettyShow :: Show a => a -> String
prettyShow = hscolour TTY defaultColourPrefs False False "" False . ppShow

14
src/Semantic/Util.hs
View File

@ -87,6 +87,8 @@ callGraphProject parser proxy opts paths = runTaskWithOptions opts $ do
x <- runCallGraph proxy False modules package
pure (x, (() <$) <$> modules)
evaluatePythonProject = evaluatePythonProjects (Proxy @'Language.Python) pythonParser Language.Python
callGraphRubyProject = callGraphProject rubyParser (Proxy @'Language.Ruby) debugOptions
-- Evaluate a project consisting of the listed paths.
@ -107,6 +109,18 @@ evaluateProject' (TaskConfig config logger statter) proxy parser paths = either
(runReader (lowerBound @Span)
(evaluate proxy id withTermSpans (Precise.runAllocator . Precise.runDeref) (Concrete.runBoolean . Concrete.runFunction coerce coerce) modules))))))
evaluatePythonProjects proxy parser lang path = runTaskWithOptions debugOptions $ do
project <- readProject Nothing path lang []
package <- fmap quieterm <$> parsePythonPackage parser project
modules <- topologicalSort <$> runImportGraphToModules proxy package
trace $ "evaluating with load order: " <> show (map (modulePath . moduleInfo) modules)
pure (runTermEvaluator @_ @_ @(Value Precise (ConcreteEff Precise '[Trace]))
(runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult Precise)))))
(raiseHandler (runModules (ModuleTable.modulePaths (packageModules package)))
(runReader (packageInfo package)
(runReader (lowerBound @Span)
(evaluate proxy id withTermSpans (Precise.runAllocator . Precise.runDeref) (Concrete.runBoolean . Concrete.runFunction coerce coerce) modules))))))
evaluateProjectWithCaching proxy parser path = runTaskWithOptions debugOptions $ do
project <- readProject Nothing path (Language.reflect proxy) []

2
test/Control/Abstract/Evaluator/Spec.hs
View File

@ -26,7 +26,7 @@ spec = parallel $ do
it "calls functions" $ do
(_, expected) <- evaluate $ do
identity <- function [name "x"] lowerBound (variable (name "x"))
identity <- function Nothing [name "x"] lowerBound (variable (name "x"))
recv <- box unit
addr <- box (integer 123)
call identity recv [addr]