1
1
mirror of https://github.com/github/semantic.git synced 2024-11-28 10:15:55 +03:00

Merge branch 'master' into precise-json

This commit is contained in:
Rob Rix 2019-10-08 14:36:36 -04:00
commit a67b67db6f
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
12 changed files with 74 additions and 105 deletions

View File

@ -83,7 +83,7 @@ Available options:
| 4 | Python | ✅ | ✅ | ✅ | ✅ | ✅ | ✅ | 🚧 | |
| 5 | Go | ✅ | ✅ | ✅ | ✅ | ✅ | ✅ | 🚧 | |
| | PHP | ✅ | ✅ | ✅ | ✅ | ✅ | | | |
| | Java | ✅ | ✅ | ✅ | 🔶 | ✅ | | | |
| | Java | 🚧 | 🚧 | 🚧 | 🔶 | ✅ | | | |
| | JSON | ✅ | ✅ | ✅ | N/A | N/A | N/A | N/A| |
| | JSX | ✅ | ✅ | ✅ | 🔶 | | | | |
| | Haskell | 🚧 | 🚧 | 🚧 | 🔶 | 🚧 | | | |

View File

@ -25,6 +25,7 @@ library
, Analysis.ImportGraph
, Analysis.ScopeGraph
, Analysis.Typecheck
, Control.Carrier.Fail.WithLoc
, Control.Effect.Readline
, Control.Monad.Module
, Data.Core
@ -36,8 +37,6 @@ library
, Data.Scope
, Data.Stack
, Data.Term
-- other-modules:
-- other-extensions:
build-depends: algebraic-graphs ^>= 0.3
, base >= 4.12 && < 5
, containers ^>= 0.6
@ -48,6 +47,7 @@ library
, parsers ^>= 0.12.10
, prettyprinter ^>= 1.2.1
, prettyprinter-ansi-terminal ^>= 1.1.1
, semantic-source ^>= 0
, semigroupoids ^>= 5.3
, text ^>= 1.2.3.1
, transformers ^>= 0.5.6

View File

@ -13,8 +13,8 @@ import qualified Algebra.Graph as G
import qualified Algebra.Graph.Export.Dot as G
import Analysis.Eval
import Control.Applicative (Alternative (..))
import Control.Carrier.Fail.WithLoc
import Control.Effect
import Control.Effect.Fail
import Control.Effect.Fresh
import Control.Effect.NonDet
import Control.Effect.Reader hiding (Local)
@ -32,6 +32,7 @@ import qualified Data.Set as Set
import Data.Text (Text, pack)
import Data.Traversable (for)
import Prelude hiding (fail)
import Source.Span
type Precise = Int
type Env = Map.Map Name Precise
@ -66,7 +67,7 @@ data Edge = Lexical | Import
-- | Concrete evaluation of a term to a value.
--
-- >>> map fileBody (snd (concrete eval [File (Loc "bool" emptySpan) (Core.bool True)]))
-- >>> map fileBody (snd (concrete eval [File (Loc "bool" (Span (Pos 1 1) (Pos 1 5))) (Core.bool True)]))
-- [Right (Bool True)]
concrete
:: (Foldable term, Show (term Name))
@ -102,7 +103,7 @@ runFile
-> m (File (Either (Loc, String) (Concrete (term Name))))
runFile eval file = traverse run file
where run = runReader (fileLoc file)
. runFailWithLoc
. runFail
. runReader @Env mempty
. fix (eval concreteAnalysis)
@ -197,7 +198,7 @@ heapAddressGraph = heapGraph (\ addr v -> (Value v, addr)) (fmap G.vertex . (,)
addressStyle :: Heap term -> G.Style (EdgeType term, Precise) Text
addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
where vertex (_, addr) = pack (show addr) <> " = " <> maybe "?" fromConcrete (IntMap.lookup addr heap)
edgeAttributes _ (Slot name, _) = ["label" G.:= name]
edgeAttributes _ (Slot name, _) = ["label" G.:= unName name]
edgeAttributes _ (Edge Import, _) = ["color" G.:= "blue"]
edgeAttributes _ (Edge Lexical, _) = ["color" G.:= "green"]
edgeAttributes _ _ = []
@ -205,7 +206,7 @@ addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
Unit -> "()"
Bool b -> pack $ show b
String s -> pack $ show s
Closure (Loc p (Span s e)) n _ _ -> "\\\\ " <> n <> " [" <> p <> ":" <> showPos s <> "-" <> showPos e <> "]"
Closure (Loc p (Span s e)) n _ _ -> "\\\\ " <> unName n <> " [" <> p <> ":" <> showPos s <> "-" <> showPos e <> "]"
Record _ -> "{}"
showPos (Pos l c) = pack (show l) <> ":" <> pack (show c)

View File

@ -8,8 +8,8 @@ module Analysis.ImportGraph
import Analysis.Eval
import Analysis.FlowInsensitive
import Control.Applicative (Alternative(..))
import Control.Carrier.Fail.WithLoc
import Control.Effect
import Control.Effect.Fail
import Control.Effect.Fresh
import Control.Effect.Reader
import Control.Effect.State
@ -84,7 +84,7 @@ runFile
-> m (File (Either (Loc, String) (Value term)))
runFile eval file = traverse run file
where run = runReader (fileLoc file)
. runFailWithLoc
. runFail
. fmap fold
. convergeTerm (Proxy @Name) (fix (cacheTerm . eval importGraphAnalysis))

View File

@ -10,8 +10,8 @@ module Analysis.ScopeGraph
import Analysis.Eval
import Analysis.FlowInsensitive
import Control.Applicative (Alternative (..))
import Control.Carrier.Fail.WithLoc
import Control.Effect.Carrier
import Control.Effect.Fail
import Control.Effect.Fresh
import Control.Effect.Reader
import Control.Effect.State
@ -25,12 +25,11 @@ import qualified Data.Map as Map
import Data.Name
import Data.Proxy
import qualified Data.Set as Set
import Data.Text (Text)
import Data.Traversable (for)
import Prelude hiding (fail)
data Decl = Decl
{ declSymbol :: Text
{ declSymbol :: Name
, declLoc :: Loc
}
deriving (Eq, Ord, Show)
@ -81,7 +80,7 @@ runFile
runFile eval file = traverse run file
where run = runReader (fileLoc file)
. runReader (Map.empty @Name @Loc)
. runFailWithLoc
. runFail
. fmap fold
. convergeTerm (Proxy @Name) (fix (cacheTerm . eval scopeGraphAnalysis))

View File

@ -10,8 +10,8 @@ module Analysis.Typecheck
import Analysis.Eval
import Analysis.FlowInsensitive
import Control.Applicative (Alternative (..))
import Control.Carrier.Fail.WithLoc
import Control.Effect.Carrier
import Control.Effect.Fail
import Control.Effect.Fresh as Fresh
import Control.Effect.Reader hiding (Local)
import Control.Effect.State
@ -133,7 +133,7 @@ runFile eval file = traverse run file
pure (substAll subst <$> t))
. runState (mempty :: Substitution)
. runReader (fileLoc file)
. runFailWithLoc
. runFail
. (\ m -> do
(cs, t) <- m
t <$ solve cs)

View File

@ -0,0 +1,31 @@
{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
module Control.Carrier.Fail.WithLoc
( -- * Fail effect
module Control.Effect.Fail
-- * Fail carrier
, runFail
, FailC(..)
) where
import Control.Applicative
import Control.Effect.Carrier
import Control.Effect.Error
import Control.Effect.Fail (Fail(..), MonadFail(..))
import Control.Effect.Reader
import Data.Loc
import Prelude hiding (fail)
runFail :: FailC m a -> m (Either (Loc, String) a)
runFail = runError . runFailC
newtype FailC m a = FailC { runFailC :: ErrorC (Loc, String) m a }
deriving (Alternative, Applicative, Functor, Monad)
instance (Carrier sig m, Effect sig, Member (Reader Loc) sig) => MonadFail (FailC m) where
fail s = do
loc <- ask
FailC (throwError (loc :: Loc, s))
instance (Carrier sig m, Effect sig, Member (Reader Loc) sig) => Carrier (Fail :+: sig) (FailC m) where
eff (L (Fail s)) = fail s
eff (R other) = FailC (eff (R (handleCoercible other)))

View File

@ -1,25 +1,14 @@
{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, TypeOperators, UndecidableInstances #-}
{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
module Data.Loc
( Loc(..)
, interactive
, Span(..)
, emptySpan
, Pos(..)
, here
, stackLoc
, FailWithLocC(..)
, runFailWithLoc
) where
import Control.Applicative
import Control.Effect.Carrier
import Control.Effect.Error
import Control.Effect.Fail
import Control.Effect.Reader
import Data.Text (Text, pack)
import Data.Text.Prettyprint.Doc (Pretty (..))
import GHC.Stack
import Prelude hiding (fail)
import Source.Span
data Loc = Loc
{ locPath :: !Text
@ -28,28 +17,7 @@ data Loc = Loc
deriving (Eq, Ord, Show)
interactive :: Loc
interactive = Loc "<interactive>" emptySpan
data Span = Span
{ spanStart :: {-# UNPACK #-} !Pos
, spanEnd :: {-# UNPACK #-} !Pos
}
deriving (Eq, Ord, Show)
instance Pretty Span where
pretty (Span s e) = pretty s <> "-" <> pretty e
emptySpan :: Span
emptySpan = Span (Pos 1 1) (Pos 1 1)
data Pos = Pos
{ posLine :: {-# UNPACK #-} !Int
, posCol :: {-# UNPACK #-} !Int
}
deriving (Eq, Ord, Show)
instance Pretty Pos where
pretty (Pos l c) = pretty l <> ":" <> pretty c
interactive = Loc "<interactive>" (Span (Pos 1 1) (Pos 1 1))
here :: HasCallStack => Maybe Loc
@ -62,19 +30,3 @@ stackLoc cs = case getCallStack cs of
fromGHCSrcLoc :: SrcLoc -> Loc
fromGHCSrcLoc SrcLoc{..} = Loc (pack srcLocFile) (Span (Pos srcLocStartLine srcLocStartCol) (Pos srcLocEndLine srcLocEndCol))
runFailWithLoc :: FailWithLocC m a -> m (Either (Loc, String) a)
runFailWithLoc = runError . runFailWithLocC
newtype FailWithLocC m a = FailWithLocC { runFailWithLocC :: ErrorC (Loc, String) m a }
deriving (Alternative, Applicative, Functor, Monad)
instance (Carrier sig m, Effect sig, Member (Reader Loc) sig) => MonadFail (FailWithLocC m) where
fail s = do
loc <- ask
FailWithLocC (throwError (loc :: Loc, s))
instance (Carrier sig m, Effect sig, Member (Reader Loc) sig) => Carrier (Fail :+: sig) (FailWithLocC m) where
eff (L (Fail s)) = fail s
eff (R other) = FailWithLocC (eff (R (handleCoercible other)))

View File

@ -1,6 +1,6 @@
{-# LANGUAGE DeriveTraversable, LambdaCase, OverloadedLists #-}
{-# LANGUAGE DeriveGeneric, DeriveTraversable, GeneralizedNewtypeDeriving, LambdaCase, OverloadedLists #-}
module Data.Name
( Name
( Name (..)
, Named(..)
, named
, named'
@ -15,10 +15,14 @@ module Data.Name
import qualified Data.Char as Char
import Data.HashSet (HashSet)
import qualified Data.HashSet as HashSet
import Data.String (IsString)
import Data.Text as Text (Text, any, unpack)
import Data.Text.Prettyprint.Doc (Pretty)
import GHC.Generics (Generic)
-- | User-specified and -relevant names.
type Name = Text
newtype Name = Name { unName :: Text }
deriving (Eq, Generic, IsString, Ord, Pretty, Show)
-- | Annotates an @a@ with a 'Name'-provided name, which is ignored for '==' and 'compare'.
data Named a = Named (Ignored Name) a
@ -50,7 +54,7 @@ reservedNames = [ "#true", "#false", "if", "then", "else"
-- | Returns true if any character would require quotation or if the
-- name conflicts with a Core primitive.
needsQuotation :: Name -> Bool
needsQuotation u = HashSet.member (unpack u) reservedNames || Text.any (not . isSimpleCharacter) u
needsQuotation (Name u) = HashSet.member (unpack u) reservedNames || Text.any (not . isSimpleCharacter) u
-- | A simple character is, loosely defined, a character that is compatible
-- with identifiers in most ASCII-oriented programming languages. This is defined

View File

@ -26,7 +26,7 @@ import Data.Term
-- interesting property as they parse regardless.
name :: MonadGen m => m (Named Name)
name = Gen.prune (named' <$> names) where
names = Gen.text (Range.linear 1 10) Gen.lower
names = Name <$> Gen.text (Range.linear 1 10) Gen.lower
boolean :: (Carrier sig t, Member Core.Core sig, MonadGen m) => m (t Name)
boolean = Core.bool <$> Gen.bool

View File

@ -1,7 +1,8 @@
{-# LANGUAGE ConstraintKinds, DataKinds, DefaultSignatures, DeriveAnyClass, DeriveGeneric, DerivingStrategies,
DerivingVia, DisambiguateRecordFields, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving,
KindSignatures, LambdaCase, NamedFieldPuns, OverloadedLists, OverloadedStrings, PatternSynonyms,
ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-}
ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances,
ViewPatterns #-}
module Language.Python.Core
( compile
@ -27,7 +28,6 @@ import Data.Text (Text)
import GHC.Generics
import GHC.Records
import Source.Span (Span)
import qualified Source.Span as Source
import qualified TreeSitter.Python.AST as Py
-- | Access to the current filename as Text to stick into location annotations.
@ -52,7 +52,7 @@ def n = coerce (Stack.:> n)
pattern SingleIdentifier :: Name -> Py.ExpressionList a
pattern SingleIdentifier name <- Py.ExpressionList
{ Py.extraChildren =
[ Py.PrimaryExpressionExpression (Py.IdentifierPrimaryExpression (Py.Identifier { bytes = name }))
[ Py.PrimaryExpressionExpression (Py.IdentifierPrimaryExpression (Py.Identifier { bytes = Name -> name }))
]
}
@ -97,9 +97,8 @@ compile :: ( Compile py
-> m (t Name)
compile t = compileCC t (pure none)
locFromTSSpan :: SourcePath -> Source.Span -> Loc
locFromTSSpan fp (Source.Span (Source.Pos a b) (Source.Pos c d))
= Data.Loc.Loc (rawPath fp) (Data.Loc.Span (Data.Loc.Pos a b) (Data.Loc.Pos c d))
locFromTSSpan :: SourcePath -> Span -> Loc
locFromTSSpan fp = Data.Loc.Loc (rawPath fp)
locate :: ( HasField "ann" syntax Span
, CoreSyntax syn t
@ -254,18 +253,18 @@ instance Compile Py.FunctionDefinition where
-- Give it a name (below), then augment the current continuation
-- with the new name (with 'def'), so that calling contexts know
-- that we have built an exportable definition.
assigning located <$> local (def name) cc
where param (Py.IdentifierParameter (Py.Identifier _pann pname)) = pure (named' pname)
assigning located <$> local (def (Name name)) cc
where param (Py.IdentifierParameter (Py.Identifier _pann pname)) = pure . named' . Name $ pname
param x = unimplemented x
unimplemented x = fail $ "unimplemented: " <> show x
assigning item f = (Name.named' name :<- item) >>>= f
assigning item f = (Name.named' (Name name) :<- item) >>>= f
instance Compile Py.FutureImportStatement
instance Compile Py.GeneratorExpression
instance Compile Py.GlobalStatement
instance Compile Py.Identifier where
compileCC Py.Identifier { bytes } _ = pure (pure bytes)
compileCC Py.Identifier { bytes } _ = pure . pure . Name $ bytes
instance Compile Py.IfStatement where
compileCC it@Py.IfStatement{ condition, consequence, alternative} cc =

View File

@ -8,18 +8,15 @@ module Instances () where
-- we should keep track of them in a dedicated file.
import Analysis.ScopeGraph
import Control.Effect.Sum
import Data.Aeson
import qualified Data.HashMap.Strict as HashMap
import Data.Loc
import Data.Core (Core, Ann (..))
import qualified Data.Map as Map
import Data.File
import Data.Term
import Data.Loc
import qualified Data.Map as Map
import Data.Name (Name (..))
import Data.Text (Text)
import Data.Scope (Scope, Incr)
import qualified Data.Scope as Scope
import Data.Name
deriving newtype instance ToJSON Name
deriving newtype instance ToJSONKey Name
instance ToJSON a => ToJSON (File a) where
toJSON File{fileLoc, fileBody} = object
@ -27,20 +24,6 @@ instance ToJSON a => ToJSON (File a) where
, "body" .= fileBody
]
instance ToJSON Span where
toJSON Span{spanStart, spanEnd} = object
[ "kind" .= ("span" :: Text)
, "start" .= spanStart
, "end" .= spanEnd
]
instance ToJSON Pos where
toJSON Pos{posLine, posCol} = object
[ "kind" .= ("pos" :: Text)
, "line" .= posLine
, "column" .= posCol
]
instance ToJSON Loc where
toJSON Loc{locPath, locSpan} = object
[ "kind" .= ("loc" :: Text)