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:
commit
a67b67db6f
@ -83,7 +83,7 @@ Available options:
|
||||
| 4 | Python | ✅ | ✅ | ✅ | ✅ | ✅ | ✅ | 🚧 | |
|
||||
| 5 | Go | ✅ | ✅ | ✅ | ✅ | ✅ | ✅ | 🚧 | |
|
||||
| | PHP | ✅ | ✅ | ✅ | ✅ | ✅ | | | |
|
||||
| | Java | ✅ | ✅ | ✅ | 🔶 | ✅ | | | |
|
||||
| | Java | 🚧 | 🚧 | 🚧 | 🔶 | ✅ | | | |
|
||||
| | JSON | ✅ | ✅ | ✅ | N/A | N/A | N/A | N/A| |
|
||||
| | JSX | ✅ | ✅ | ✅ | 🔶 | | | | |
|
||||
| | Haskell | 🚧 | 🚧 | 🚧 | 🔶 | 🚧 | | | |
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
||||
|
@ -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))
|
||||
|
||||
|
@ -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))
|
||||
|
||||
|
@ -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)
|
||||
|
31
semantic-core/src/Control/Carrier/Fail/WithLoc.hs
Normal file
31
semantic-core/src/Control/Carrier/Fail/WithLoc.hs
Normal 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)))
|
@ -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)))
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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 =
|
||||
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user