From 8209fd18169e18527cd5c7611e6af3c0aadc2aaf Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 21 Jan 2020 15:25:35 -0500 Subject: [PATCH 001/235] :note: Analysis.HasTextElement --- src/Analysis/HasTextElement.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Analysis/HasTextElement.hs b/src/Analysis/HasTextElement.hs index 78f6be8ba..3d59d5a0f 100644 --- a/src/Analysis/HasTextElement.hs +++ b/src/Analysis/HasTextElement.hs @@ -4,7 +4,7 @@ module Analysis.HasTextElement ) where import Data.Sum -import Prologue +import Data.Proxy import qualified Data.Syntax.Literal as Literal class HasTextElement syntax where From c1ca860cd74b156a2c9906879a0d222c5e10ce16 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 21 Jan 2020 15:27:49 -0500 Subject: [PATCH 002/235] :note: Diffing.Interpreter. --- src/Diffing/Interpreter.hs | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/src/Diffing/Interpreter.hs b/src/Diffing/Interpreter.hs index d9bdbb5ac..2e2ae638d 100644 --- a/src/Diffing/Interpreter.hs +++ b/src/Diffing/Interpreter.hs @@ -1,18 +1,27 @@ -{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Diffing.Interpreter ( diffTerms , DiffTerms(..) , stripDiff ) where -import Control.Algebra -import Control.Carrier.Cull.Church + +import Control.Algebra +import Control.Carrier.Cull.Church +import Control.Monad.IO.Class +import Data.Bifunctor import qualified Data.Diff as Diff -import Data.Edit (Edit, edit) -import Data.Term -import Diffing.Algorithm -import Diffing.Algorithm.RWS -import Prologue +import Data.Edit (Edit, edit) +import Data.Functor.Classes +import Data.Hashable.Lifted +import Data.Maybe +import Data.Term +import Diffing.Algorithm +import Diffing.Algorithm.RWS -- | Diff two à la carte terms recursively. diffTerms :: (Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax) From 66c1c685910cb6abcd18e4d0904c841312938c88 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 21 Jan 2020 15:31:16 -0500 Subject: [PATCH 003/235] Add Data.Maybe.Exts and :note: Diffing.Algorithm. --- semantic.cabal | 1 + src/Data/Maybe/Exts.hs | 19 +++++++++++++++++++ src/Diffing/Algorithm.hs | 33 ++++++++++++++++++++++++--------- 3 files changed, 44 insertions(+), 9 deletions(-) create mode 100644 src/Data/Maybe/Exts.hs diff --git a/semantic.cabal b/semantic.cabal index 835f911b1..e13f0b9c8 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -158,6 +158,7 @@ library , Data.JSON.Fields , Data.Language , Data.Map.Monoidal + , Data.Maybe.Exts , Data.Project , Data.Quieterm , Data.Semigroup.App diff --git a/src/Data/Maybe/Exts.hs b/src/Data/Maybe/Exts.hs new file mode 100644 index 000000000..98064937c --- /dev/null +++ b/src/Data/Maybe/Exts.hs @@ -0,0 +1,19 @@ +module Data.Maybe.Exts +( maybeLast +, fromMaybeLast +, maybeM +) where + +import Data.Maybe +import Data.Monoid + +maybeLast :: Foldable t => b -> (a -> b) -> t a -> b +maybeLast b f = maybe b f . getLast . foldMap (Last . Just) + +fromMaybeLast :: Foldable t => a -> t a -> a +fromMaybeLast b = fromMaybe b . getLast . foldMap (Last . Just) + +-- | Extract the 'Just' of a 'Maybe' in an 'Applicative' context or, given 'Nothing', run the provided action. +maybeM :: Applicative f => f a -> Maybe a -> f a +maybeM f = maybe f pure +{-# INLINE maybeM #-} diff --git a/src/Diffing/Algorithm.hs b/src/Diffing/Algorithm.hs index 9bd5f7011..98694b776 100644 --- a/src/Diffing/Algorithm.hs +++ b/src/Diffing/Algorithm.hs @@ -1,4 +1,14 @@ -{-# LANGUAGE DefaultSignatures, DeriveFunctor, DeriveGeneric, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, TypeApplications, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Diffing.Algorithm ( Diff (..) , Algorithm(..) @@ -14,14 +24,19 @@ module Diffing.Algorithm , algorithmForTerms ) where -import Control.Algebra hiding ((:+:)) -import Control.Effect.NonDet +import Control.Algebra hiding ((:+:)) +import Control.Applicative +import Control.Effect.NonDet import qualified Data.Diff as Diff import qualified Data.Edit as Edit -import Data.Sum -import Data.Term -import GHC.Generics -import Prologue +import Data.Functor +import Data.Functor.Classes +import Data.List.NonEmpty +import Data.Maybe +import Data.Maybe.Exts +import Data.Sum +import Data.Term +import GHC.Generics -- | A single step in a diffing algorithm, parameterized by the types of terms, diffs, and the result of the applicable algorithm. data Diff term1 term2 diff (m :: * -> *) k @@ -257,12 +272,12 @@ instance (GDiffable f, GDiffable g) => GDiffable (f :*: g) where instance (GDiffable f, GDiffable g) => GDiffable (f :+: g) where galgorithmFor (L1 a1) (L1 a2) = L1 <$> galgorithmFor a1 a2 galgorithmFor (R1 b1) (R1 b2) = R1 <$> galgorithmFor b1 b2 - galgorithmFor _ _ = empty + galgorithmFor _ _ = empty gtryAlignWith f a b = case (a, b) of (L1 a, L1 b) -> L1 <$> gtryAlignWith f a b (R1 a, R1 b) -> R1 <$> gtryAlignWith f a b - _ -> empty + _ -> empty gcomparableTo (L1 _) (L1 _) = True gcomparableTo (R1 _) (R1 _) = True From 0c30098129ad6f6dc3b438303e1f3d7e5d965a37 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 21 Jan 2020 15:32:40 -0500 Subject: [PATCH 004/235] :note: Analysis.ConstructorName. --- src/Analysis/ConstructorName.hs | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/src/Analysis/ConstructorName.hs b/src/Analysis/ConstructorName.hs index 2c41b9760..529bb3f82 100644 --- a/src/Analysis/ConstructorName.hs +++ b/src/Analysis/ConstructorName.hs @@ -1,12 +1,19 @@ -{-# LANGUAGE DataKinds, FlexibleInstances, MultiParamTypeClasses, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Analysis.ConstructorName ( ConstructorName(..) ) where +import Data.Proxy import Data.Sum import Data.Term import GHC.Generics -import Prologue -- | A typeclass to retrieve the name of the data constructor for a value. -- From 3ebc9adb573328859f605ecb910489a4c710c0a9 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 21 Jan 2020 15:39:51 -0500 Subject: [PATCH 005/235] :note: CyclomaticComplexity. --- src/Analysis/CyclomaticComplexity.hs | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/src/Analysis/CyclomaticComplexity.hs b/src/Analysis/CyclomaticComplexity.hs index 94738caf1..74e0ac8db 100644 --- a/src/Analysis/CyclomaticComplexity.hs +++ b/src/Analysis/CyclomaticComplexity.hs @@ -1,16 +1,24 @@ -{-# LANGUAGE DataKinds, DefaultSignatures, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, ScopedTypeVariables, TypeApplications, TypeFamilies, UndecidableInstances #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} module Analysis.CyclomaticComplexity ( CyclomaticComplexity(..) , HasCyclomaticComplexity , cyclomaticComplexityAlgebra ) where -import Data.Aeson -import Data.Sum +import Data.Aeson +import Data.Proxy +import Data.Sum import qualified Data.Syntax.Declaration as Declaration import qualified Data.Syntax.Statement as Statement -import Data.Term -import Prologue +import Data.Term -- | The cyclomatic complexity of a (sub)term. newtype CyclomaticComplexity = CyclomaticComplexity Int From 78e704f401c55e8cd86f2ba65185f790f07f7546 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 21 Jan 2020 15:40:50 -0500 Subject: [PATCH 006/235] :note: Analysis.PackageDef. --- src/Analysis/PackageDef.hs | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/src/Analysis/PackageDef.hs b/src/Analysis/PackageDef.hs index 8000ed14e..d9843d9e7 100644 --- a/src/Analysis/PackageDef.hs +++ b/src/Analysis/PackageDef.hs @@ -1,18 +1,26 @@ -{-# LANGUAGE DataKinds, FlexibleInstances, MultiParamTypeClasses, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeFamilies, UndecidableInstances #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} module Analysis.PackageDef ( PackageDef(..) , HasPackageDef , packageDefAlgebra ) where -import Data.Blob -import Source.Source as Source -import Data.Sum -import Data.Term +import Data.Algebra +import Data.Blob +import Data.Proxy +import Data.Sum +import Data.Term import qualified Data.Text as T import qualified Language.Go.Syntax -import Prologue -import Source.Loc +import Source.Loc +import Source.Source as Source newtype PackageDef = PackageDef { moduleDefIdentifier :: T.Text } deriving (Eq, Show) From c8fdb1b6e6780411892d87e80ee2f2be65e1ac45 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 21 Jan 2020 15:44:34 -0500 Subject: [PATCH 007/235] :note: Analysis.TOCSummary. --- src/Analysis/TOCSummary.hs | 24 +++++++++++++++++++++--- 1 file changed, 21 insertions(+), 3 deletions(-) diff --git a/src/Analysis/TOCSummary.hs b/src/Analysis/TOCSummary.hs index 29419c95e..9fe13a96f 100644 --- a/src/Analysis/TOCSummary.hs +++ b/src/Analysis/TOCSummary.hs @@ -1,4 +1,18 @@ -{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, OverloadedStrings, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances, ViewPatterns #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} module Analysis.TOCSummary ( Declaration(..) , formatIdentifier @@ -8,15 +22,19 @@ module Analysis.TOCSummary , declarationAlgebra ) where -import Prologue hiding (project) - +import Data.Algebra import Data.Blob import qualified Data.Error as Error import Data.Flag +import Data.Foldable (toList) import Data.Language as Language +import Data.List.NonEmpty (nonEmpty) +import Data.Semigroup (sconcat) +import Data.Sum import qualified Data.Syntax as Syntax import qualified Data.Syntax.Declaration as Declaration import Data.Term +import Data.Text (Text) import qualified Data.Text as T import qualified Language.Markdown.Syntax as Markdown import Source.Loc as Loc From 90b772927c5ceeba3c1ae5405265749848fe8751 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 21 Jan 2020 16:19:55 -0500 Subject: [PATCH 008/235] :note: Analysis.Decorator. --- src/Analysis/Decorator.hs | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/Analysis/Decorator.hs b/src/Analysis/Decorator.hs index 8bb1d677e..6b8151698 100644 --- a/src/Analysis/Decorator.hs +++ b/src/Analysis/Decorator.hs @@ -1,10 +1,13 @@ -{-# LANGUAGE FlexibleContexts, TypeFamilies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} module Analysis.Decorator ( decoratorWithAlgebra ) where +import Data.Algebra +import Data.Bifunctor +import Data.Functor.Foldable import Data.Term -import Prologue -- | Lift an algebra into a decorator for terms annotated with records. decoratorWithAlgebra :: (Functor (Syntax term), IsTerm term, Recursive (term a), Base (term a) ~ TermF (Syntax term) a) From a99d9476bc725f79c82e0569c2ebce7afea2a498 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 21 Jan 2020 16:20:22 -0500 Subject: [PATCH 009/235] :note: Serializing.SExpression. --- src/Serializing/SExpression.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/Serializing/SExpression.hs b/src/Serializing/SExpression.hs index 54993f9ec..40ad06f26 100644 --- a/src/Serializing/SExpression.hs +++ b/src/Serializing/SExpression.hs @@ -1,4 +1,8 @@ -{-# LANGUAGE FlexibleContexts, GADTs, OverloadedStrings, RankNTypes, ScopedTypeVariables #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} module Serializing.SExpression ( serializeSExpression , ToSExpression(..) @@ -9,9 +13,8 @@ import Analysis.ConstructorName import Data.ByteString.Builder import Data.Diff import Data.Edit +import Data.Functor.Foldable import Data.Term -import Prelude -import Prologue data Options = ByShow | ByConstructorName From 9cd984aad0b2437815ae6df5f0dcbc9a2ed0e456 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 21 Jan 2020 16:20:57 -0500 Subject: [PATCH 010/235] :note: Serializing.Format. --- src/Serializing/Format.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/Serializing/Format.hs b/src/Serializing/Format.hs index 295be2453..9568ec5d8 100644 --- a/src/Serializing/Format.hs +++ b/src/Serializing/Format.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE FlexibleContexts, GADTs, OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} module Serializing.Format ( Format(..) , FormatStyle(..) @@ -11,11 +13,11 @@ import Algebra.Graph.Export.Dot import Algebra.Graph.ToGraph import Data.Aeson (ToJSON (..), fromEncoding) import Data.ByteString.Builder -import Language.Haskell.HsColour -import Language.Haskell.HsColour.Colourise -import Prologue +import Data.Functor.Foldable import Data.ProtoLens.Encoding as Proto import Data.ProtoLens.Message (Message) +import Language.Haskell.HsColour +import Language.Haskell.HsColour.Colourise import Serializing.SExpression import Text.Show.Pretty From dbcd15c25c87b94bad605cffa6d506d1a7edf655 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 21 Jan 2020 16:22:27 -0500 Subject: [PATCH 011/235] :note: Tags.Tagging. --- src/Tags/Tagging.hs | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/src/Tags/Tagging.hs b/src/Tags/Tagging.hs index ba6ec25a7..896bb3d0f 100644 --- a/src/Tags/Tagging.hs +++ b/src/Tags/Tagging.hs @@ -1,4 +1,12 @@ -{-# LANGUAGE FlexibleContexts, GADTs, LambdaCase, OverloadedStrings, RankNTypes, ScopedTypeVariables, TypeApplications, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Tags.Tagging ( runTagging , Tag(..) @@ -8,10 +16,11 @@ module Tags.Tagging where import Prelude hiding (fail, filter, log) -import Prologue hiding (Element, hash) import Control.Carrier.State.Strict as Eff +import Control.Monad import Data.Abstract.Declarations (Declarations) +import Data.Functor.Foldable import Data.Text as T hiding (empty) import Streaming import qualified Streaming.Prelude as Streaming From dea38bdea64be0a044e95766d79fa712f9f5e2b8 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 21 Jan 2020 16:25:02 -0500 Subject: [PATCH 012/235] :note: Numeric.Exts. --- src/Numeric/Exts.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/Numeric/Exts.hs b/src/Numeric/Exts.hs index 9a18498c1..89098ca0d 100644 --- a/src/Numeric/Exts.hs +++ b/src/Numeric/Exts.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE OverloadedStrings, TypeApplications #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeApplications #-} module Numeric.Exts ( parseInteger , hex @@ -11,11 +12,11 @@ module Numeric.Exts import Control.Applicative import Control.Monad hiding (fail) import Data.Attoparsec.Text -import Data.Char (isDigit, isOctDigit, isHexDigit) +import Data.Char (isDigit, isHexDigit, isOctDigit) +import Data.Maybe.Exts import Data.Text import Numeric -import Prelude hiding (fail, filter) -import Prologue +import Prelude hiding (filter) import Text.Read (readMaybe) -- The ending stanza. Note the explicit endOfInput call to ensure we haven't left any dangling input. From 857995b280ae93aba04d0cf4f3331f24f92405c0 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 24 Jan 2020 09:42:42 -0500 Subject: [PATCH 013/235] Move maybeLast to Maybe.Exts. --- src/Data/Maybe/Exts.hs | 3 ++- src/Semantic/Resolution.hs | 21 +++++++++++++++++++-- 2 files changed, 21 insertions(+), 3 deletions(-) diff --git a/src/Data/Maybe/Exts.hs b/src/Data/Maybe/Exts.hs index 98064937c..363482203 100644 --- a/src/Data/Maybe/Exts.hs +++ b/src/Data/Maybe/Exts.hs @@ -1,5 +1,6 @@ module Data.Maybe.Exts -( maybeLast +( module Data.Maybe +, maybeLast , fromMaybeLast , maybeM ) where diff --git a/src/Semantic/Resolution.hs b/src/Semantic/Resolution.hs index 965b73b86..aaa5e5f05 100644 --- a/src/Semantic/Resolution.hs +++ b/src/Semantic/Resolution.hs @@ -1,4 +1,16 @@ -{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Semantic.Resolution ( Resolution (..) , nodeJSResolutionMap @@ -8,13 +20,18 @@ module Semantic.Resolution ) where import Control.Algebra +import Control.Monad.IO.Class import Data.Aeson import Data.Aeson.Types (parseMaybe) import Data.Blob +import Data.Foldable import Data.Language import qualified Data.Map as Map +import Data.Map.Strict (Map) +import Data.Maybe.Exts import Data.Project -import Prologue +import Data.Text (Text) +import GHC.Generics (Generic1) import Semantic.Task.Files import qualified Source.Source as Source import System.FilePath.Posix From 08f8b3b60db501fca49ea021eb5dc20157ed0934 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Sun, 26 Jan 2020 17:51:26 -0500 Subject: [PATCH 014/235] :note: Semantic/Env.hs. --- src/Semantic/Env.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Semantic/Env.hs b/src/Semantic/Env.hs index 8243d6fb4..d485be994 100644 --- a/src/Semantic/Env.hs +++ b/src/Semantic/Env.hs @@ -4,7 +4,8 @@ module Semantic.Env , envLookupString ) where -import Prologue +import Control.Monad.IO.Class +import Data.Maybe import System.Environment import Text.Read (readMaybe) From ae98033e1daad05d8703cd652c3049f1e8fd3254 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 27 Jan 2020 10:53:01 -0500 Subject: [PATCH 015/235] Excommunicado. --- docs/coding-style.md | 8 -------- 1 file changed, 8 deletions(-) diff --git a/docs/coding-style.md b/docs/coding-style.md index 7c199acc3..10499aed7 100644 --- a/docs/coding-style.md +++ b/docs/coding-style.md @@ -50,14 +50,6 @@ data Pos = Pos } ``` -### Split up imports into logical groups. - -We use the following convention, each section separated by a newline: - -1. Prelude/Prologue import -2. Library/stdlib imports -3. Local in-project imports. - ### Align typographical symbols. `->` in `case` statements and signatures, `=` in functions, and `::` in records should be aligned. Your editor can help with this. In certain situations, aligning symbols may decrease readability, e.g. complicated `case` statements. Use your best judgment. From 87be2f7e8b9158e59cfcc5533323cc203f56a911 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 27 Jan 2020 10:53:13 -0500 Subject: [PATCH 016/235] :note: Abstract/Number.hs. --- src/Data/Abstract/Number.hs | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/src/Data/Abstract/Number.hs b/src/Data/Abstract/Number.hs index 73baf1675..bf276b028 100644 --- a/src/Data/Abstract/Number.hs +++ b/src/Data/Abstract/Number.hs @@ -1,4 +1,8 @@ -{-# LANGUAGE GADTs, StandaloneDeriving, RankNTypes, TypeApplications #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} module Data.Abstract.Number ( Number (..) @@ -9,10 +13,10 @@ module Data.Abstract.Number , liftedFloorDiv ) where -import Data.Scientific +import Data.Function (on) +import Data.Scientific +import Prelude hiding (Integer) import qualified Prelude -import Prelude hiding (Integer) -import Prologue -- | A generalized number type that unifies all interpretable numeric types. -- This is a GADT, so you can specialize the 'a' parameter and be confident @@ -34,13 +38,13 @@ deriving instance Eq a => Eq (Number a) instance Show (Number a) where show (Integer i) = show i - show (Ratio r) = show r + show (Ratio r) = show r show (Decimal d) = show d -- | Every 'Number' can be coerced to a 'Scientific'. Used in the 'Ord' instance. toScientific :: Number a -> Scientific toScientific (Integer i) = fromInteger i -toScientific (Ratio r) = fromRational r +toScientific (Ratio r) = fromRational r toScientific (Decimal s) = s instance Eq a => Ord (Number a) where compare = compare `on` toScientific From 2ebe7e81a5f7ca86e2998b078686598924fe3a03 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 27 Jan 2020 10:58:22 -0500 Subject: [PATCH 017/235] :note: Assigning.Assignment. --- src/Assigning/Assignment.hs | 83 +++++++++++++++++++++++-------------- 1 file changed, 53 insertions(+), 30 deletions(-) diff --git a/src/Assigning/Assignment.hs b/src/Assigning/Assignment.hs index 6dd032395..13dd8bd00 100644 --- a/src/Assigning/Assignment.hs +++ b/src/Assigning/Assignment.hs @@ -1,4 +1,15 @@ -{-# LANGUAGE DataKinds, FlexibleContexts, FlexibleInstances, GADTs, InstanceSigs, MultiParamTypeClasses, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeFamilies, TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} -- | Assignment of AST onto some other structure (typically terms). -- -- Parsing yields an AST represented as a Rose tree labelled with symbols in the language’s grammar and source locations (byte Range and Span). An Assignment represents a (partial) map from AST nodes onto some other structure; in essence, it’s a parser that operates over trees. (For our purposes, this structure is typically Terms annotated with source locations.) Assignments are able to match based on symbol, sequence, and hierarchy; thus, in @x = y@, both @x@ and @y@ might have the same symbol, @Identifier@, the left can be assigned to a variable declaration, while the right can be assigned to a variable reference. @@ -90,20 +101,32 @@ module Assigning.Assignment , module Parsers ) where -import Prologue -import Prelude hiding (fail) import qualified Assigning.Assignment.Table as Table -import Control.Monad.Except (MonadError (..)) -import Data.AST -import Data.Error -import qualified Source.Source as Source -import Data.Term -import Data.Text.Encoding (decodeUtf8') +import Control.Applicative +import Control.Monad +import Control.Monad.Except (MonadError (..)) +import Data.AST +import Data.Bifunctor +import Data.ByteString (ByteString) +import Data.Error +import Data.Foldable +import Data.Function +import Data.Functor.Classes +import Data.Ix +import Data.List.NonEmpty (NonEmpty (..), nonEmpty) +import Data.Maybe +import Data.Semigroup +import Data.Term +import Data.Text (Text) +import Data.Text.Encoding (decodeUtf8') +import GHC.Stack +import Prelude hiding (fail) import qualified Source.Loc as L -import Source.Range as Range -import Source.Span as Span -import Text.Parser.Combinators as Parsers hiding (choice) -import TreeSitter.Language +import Source.Range as Range +import qualified Source.Source as Source +import Source.Span as Span +import Text.Parser.Combinators as Parsers hiding (choice) +import TreeSitter.Language -- | Assignment from an AST with some set of 'symbol's onto some other value. -- @@ -129,12 +152,12 @@ data Tracing f a where assignmentCallSite :: Assignment ast grammar a -> Maybe (String, SrcLoc) assignmentCallSite (Tracing site _ `Then` _) = site -assignmentCallSite _ = Nothing +assignmentCallSite _ = Nothing tracing :: HasCallStack => f a -> Tracing f a tracing f = case getCallStack callStack of (_ : site : _) -> Tracing (Just site) f - _ -> Tracing Nothing f + _ -> Tracing Nothing f -- | Zero-width production of the current location. -- @@ -209,8 +232,8 @@ nodeError cs expected n@Node{..} = Error (nodeSpan n) expected (Just (Right node firstSet :: (Enum grammar, Ix grammar) => Assignment ast grammar a -> [grammar] firstSet = iterFreer (\ _ (Tracing _ assignment) -> case assignment of Choose table _ _ -> Table.tableAddresses table - Label child _ -> firstSet child - _ -> []) . ([] <$) + Label child _ -> firstSet child + _ -> []) . ([] <$) -- | Run an assignment over an AST exhaustively. @@ -275,7 +298,7 @@ requireExhaustive callSite (a, state) = let state' = skipTokens state stack = fromCallSiteList (maybe id (:) callSite (stateCallSites state)) in case stateNodes state' of - [] -> Right (a, state') + [] -> Right (a, state') Term (In node _) : _ -> Left (nodeError stack [] node) skipTokens :: Symbol grammar => State ast grammar -> State ast grammar @@ -289,11 +312,11 @@ advanceState state@State{..} -- | State kept while running 'Assignment's. data State ast grammar = State - { stateOffset :: {-# UNPACK #-} !Int -- ^ The offset into the Source thus far reached, measured in bytes. - , statePos :: {-# UNPACK #-} !Pos -- ^ The (1-indexed) line/column position in the Source thus far reached. + { stateOffset :: {-# UNPACK #-} !Int -- ^ The offset into the Source thus far reached, measured in bytes. + , statePos :: {-# UNPACK #-} !Pos -- ^ The (1-indexed) line/column position in the Source thus far reached. , stateCallSites :: ![(String, SrcLoc)] -- ^ The symbols & source locations of the calls thus far. - , stateNodes :: ![AST ast grammar] -- ^ The remaining nodes to assign. Note that 'children' rules recur into subterms, and thus this does not necessarily reflect all of the terms remaining to be assigned in the overall algorithm, only those “in scope.” - , stateLocals :: ![Text] -- Special state necessary for the Ruby assignment. When we refactor Assignment to use effects we should pull this out into Language.Ruby.Assignment. + , stateNodes :: ![AST ast grammar] -- ^ The remaining nodes to assign. Note that 'children' rules recur into subterms, and thus this does not necessarily reflect all of the terms remaining to be assigned in the overall algorithm, only those “in scope.” + , stateLocals :: ![Text] -- Special state necessary for the Ruby assignment. When we refactor Assignment to use effects we should pull this out into Language.Ruby.Assignment. } deriving instance (Eq grammar, Eq1 ast) => Eq (State ast grammar) @@ -315,13 +338,13 @@ instance (Enum grammar, Eq1 ast, Ix grammar) => Alternative (Assignment ast gram l@(Tracing callSiteL la `Then` continueL) <|> r@(Tracing callSiteR ra `Then` continueR) = go callSiteL la continueL callSiteR ra continueR where go :: forall l r . Maybe (String, SrcLoc) -> AssignmentF ast grammar l -> (l -> Assignment ast grammar a) -> Maybe (String, SrcLoc) -> AssignmentF ast grammar r -> (r -> Assignment ast grammar a) -> Assignment ast grammar a go callSiteL la continueL callSiteR ra continueR = case (la, ra) of - (Fail _, _) -> r - (Alt [], _) -> r - (_, Alt []) -> l + (Fail _, _) -> r + (Alt [], _) -> r + (_, Alt []) -> l (Alt ls, Alt rs) -> alternate (Alt ((Left <$> ls) <> (Right <$> rs))) - (Alt ls, _) -> rebuild (Alt ((continueL <$> ls) <> pure r)) id - (_, Alt rs) -> rebuild (Alt (pure l <> (continueR <$> rs))) id - _ -> rebuild (Alt [l, r]) id + (Alt ls, _) -> rebuild (Alt ((continueL <$> ls) <> pure r)) id + (_, Alt rs) -> rebuild (Alt (pure l <> (continueR <$> rs))) id + _ -> rebuild (Alt [l, r]) id where alternate :: AssignmentF ast grammar (Either l r) -> Assignment ast grammar a alternate a = rebuild a (either continueL continueR) rebuild :: AssignmentF ast grammar x -> (x -> Assignment ast grammar a) -> Assignment ast grammar a @@ -368,7 +391,7 @@ infixl 1 `Then` instance Functor (Freer f) where fmap f = go - where go (Return result) = Return (f result) + where go (Return result) = Return (f result) go (Then step yield) = Then step (go . yield) {-# INLINE go #-} {-# INLINE fmap #-} @@ -405,7 +428,7 @@ instance Monad (Freer f) where -- This is analogous to 'iter' with a continuation for the interior values, and is therefore suitable for defining interpreters for GADTs/types lacking a 'Functor' instance. iterFreer :: (forall x. (x -> a) -> f x -> a) -> Freer f a -> a iterFreer algebra = go - where go (Return result) = result + where go (Return result) = result go (Then action continue) = algebra (go . continue) action {-# INLINE go #-} {-# INLINE iterFreer #-} From f01379c01b74a801650f791b3e737cf634614cdf Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 27 Jan 2020 11:08:51 -0500 Subject: [PATCH 018/235] :note: Semantic.CLI. --- src/Semantic/CLI.hs | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index a602f2aae..8859300eb 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -1,17 +1,21 @@ -{-# LANGUAGE ApplicativeDo, FlexibleContexts #-} +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE FlexibleContexts #-} module Semantic.CLI (main) where import qualified Control.Carrier.Parse.Measured as Parse import Control.Carrier.Reader +import Control.Exception +import Control.Monad.IO.Class import Data.Blob import Data.Blob.IO import qualified Data.Flag as Flag +import Data.Foldable import Data.Handle import qualified Data.Language as Language import Data.List (intercalate) +import Data.Maybe.Exts import Data.Project import Options.Applicative hiding (style) -import Prologue import Semantic.Api hiding (File) import Semantic.Config import qualified Semantic.Graph as Graph @@ -27,7 +31,6 @@ import qualified System.Path as Path import qualified System.Path.PartClass as Path.PartClass import Control.Concurrent (mkWeakThreadId, myThreadId) -import Control.Exception (throwTo) import Proto.Semantic_JSON () import System.Mem.Weak (deRefWeak) import System.Posix.Signals From bb970c1ba19f1212f8188fb322697df31aed0a24 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 27 Jan 2020 11:10:42 -0500 Subject: [PATCH 019/235] :note: Tags.Taggable. --- src/Tags/Taggable.hs | 25 ++++++++++++++++++------- 1 file changed, 18 insertions(+), 7 deletions(-) diff --git a/src/Tags/Taggable.hs b/src/Tags/Taggable.hs index 27871d34e..743a9f3cb 100644 --- a/src/Tags/Taggable.hs +++ b/src/Tags/Taggable.hs @@ -12,7 +12,17 @@ identify a new syntax as Taggable, you need to: constructor name of this syntax. -} -{-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, DataKinds, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeFamilies, UndecidableInstances #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} module Tags.Taggable ( Tagger , Token(..) @@ -23,18 +33,19 @@ module Tags.Taggable ) where -import Prologue - import Analysis.ConstructorName import Analysis.HasTextElement import Data.Abstract.Declarations import Data.Abstract.Name +import Data.Algebra +import Data.Foldable +import Data.Functor.Foldable import Data.Language +import Data.Sum import Data.Term import Data.Text hiding (empty) import Source.Loc as Loc import Source.Range - import Streaming hiding (Sum) import Streaming.Prelude (yield) @@ -206,11 +217,11 @@ instance TaggableBy 'Custom Ruby.Class where instance TaggableBy 'Custom Ruby.Module where snippet' ann (Ruby.Module _ (body:_)) = subtractLoc ann (termAnnotation body) - snippet' ann (Ruby.Module _ _) = byteRange ann + snippet' ann (Ruby.Module _ _) = byteRange ann symbolName' = declaredName . Ruby.moduleIdentifier instance TaggableBy 'Custom TypeScript.Module where - snippet' ann (TypeScript.Module _ (body:_)) = subtractLoc ann (termAnnotation body) + snippet' ann (TypeScript.Module _ (body:_)) = subtractLoc ann (termAnnotation body) snippet' ann (TypeScript.Module _ _ ) = byteRange ann symbolName' = declaredName . TypeScript.moduleIdentifier @@ -220,5 +231,5 @@ instance TaggableBy 'Custom Expression.Call where instance TaggableBy 'Custom Ruby.Send where snippet' ann (Ruby.Send _ _ _ (Just body)) = subtractLoc ann (termAnnotation body) - snippet' ann _ = byteRange ann + snippet' ann _ = byteRange ann symbolName' Ruby.Send{..} = declaredName =<< sendSelector From a32e715303d948b0969442820076480a96731687 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 27 Jan 2020 11:15:03 -0500 Subject: [PATCH 020/235] :note: Parsing.Parser. --- src/Parsing/Parser.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/Parsing/Parser.hs b/src/Parsing/Parser.hs index 1fbe6c93d..95e2b5c40 100644 --- a/src/Parsing/Parser.hs +++ b/src/Parsing/Parser.hs @@ -1,4 +1,8 @@ -{-# LANGUAGE ConstraintKinds, DataKinds, GADTs, TypeApplications, TypeFamilies #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} module Parsing.Parser ( Parser(..) -- * Parsers @@ -40,7 +44,9 @@ module Parsing.Parser import Assigning.Assignment import qualified CMarkGFM import Data.AST +import Data.Functor.Classes import Data.Language +import Data.Map (Map) import qualified Data.Map as Map import qualified Data.Syntax as Syntax import Data.Term @@ -60,7 +66,6 @@ import qualified Language.TSX.Assignment as TSXALaCarte import qualified Language.TypeScript as TypeScriptPrecise import qualified Language.TypeScript.Assignment as TypeScriptALaCarte import Prelude hiding (fail) -import Prologue import TreeSitter.Go import qualified TreeSitter.Language as TS (Language, Symbol) import TreeSitter.PHP From 5a713a3e0174a6be1d71b3a14a158c7d4b0b54b6 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 27 Jan 2020 11:19:14 -0500 Subject: [PATCH 021/235] :note: Semantic.Analysis. --- src/Semantic/Analysis.hs | 32 ++++++++++++++++++-------------- 1 file changed, 18 insertions(+), 14 deletions(-) diff --git a/src/Semantic/Analysis.hs b/src/Semantic/Analysis.hs index 92395d9c8..ad70b4214 100644 --- a/src/Semantic/Analysis.hs +++ b/src/Semantic/Analysis.hs @@ -1,24 +1,28 @@ -{-# LANGUAGE DataKinds, FlexibleContexts, TypeFamilies, TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module Semantic.Analysis ( evaluate , runDomainEffects , evalTerm ) where -import Prologue +import Control.Abstract as Abstract +import Control.Algebra +import Control.Carrier.Error.Either +import Control.Carrier.Reader +import Control.Effect.Interpose +import Data.Abstract.Evaluatable +import Data.Abstract.Module +import Data.Abstract.ModuleTable as ModuleTable +import Data.Foldable +import Data.Function +import Data.Functor.Foldable +import Data.Language (Language) import qualified Data.Map.Strict as Map - -import Control.Abstract as Abstract -import Control.Algebra -import Control.Carrier.Error.Either -import Control.Carrier.Reader -import Control.Effect.Interpose -import Data.Abstract.Evaluatable -import Data.Abstract.Module -import Data.Abstract.ModuleTable as ModuleTable -import Data.Language (Language) -import Source.Span +import Source.Span type ModuleC address value m = ErrorC (LoopControl value) @@ -77,7 +81,7 @@ evaluate lang runModule modules = do let (scopeEdges, frameLinks) = case (parentScope, parentFrame) of (Just parentScope, Just parentFrame) -> (Map.singleton Lexical [ parentScope ], Map.singleton Lexical (Map.singleton parentScope parentFrame)) _ -> mempty - scopeAddress <- if Prologue.null scopeEdges then newPreludeScope scopeEdges else newScope scopeEdges + scopeAddress <- if Data.Foldable.null scopeEdges then newPreludeScope scopeEdges else newScope scopeEdges frameAddress <- newFrame scopeAddress frameLinks val <- runInModule scopeAddress frameAddress m pure ((scopeAddress, frameAddress), val) From 9755413808e88733aa7ee5f9138a9c0c714c89bc Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 27 Jan 2020 11:20:38 -0500 Subject: [PATCH 022/235] :note: Parsing.TreeSitter. --- src/Parsing/TreeSitter.hs | 27 ++++++++++++++++++--------- 1 file changed, 18 insertions(+), 9 deletions(-) diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs index f61217b83..41bc30987 100644 --- a/src/Parsing/TreeSitter.hs +++ b/src/Parsing/TreeSitter.hs @@ -1,5 +1,11 @@ -{-# LANGUAGE DataKinds, DeriveGeneric, FlexibleContexts, GADTs, LambdaCase, RecordWildCards, ScopedTypeVariables, - TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} module Parsing.TreeSitter ( TSParseException (..) , Duration(..) @@ -7,16 +13,19 @@ module Parsing.TreeSitter , parseToPreciseAST ) where -import Prologue - -import Control.Carrier.Reader -import qualified Control.Exception as Exc -import Foreign -import Foreign.C.Types (CBool (..)) +import Control.Carrier.Reader +import Control.Exception as Exc +import Control.Monad +import Control.Monad.IO.Class +import Data.Functor.Foldable +import Foreign +import Foreign.C.Types (CBool (..)) +import GHC.Generics import Data.AST (AST, Node (Node)) import Data.Blob import Data.Duration +import Data.Maybe.Exts import Data.Term import Source.Loc import qualified Source.Source as Source @@ -67,7 +76,7 @@ parseToPreciseAST parseTimeout unmarshalTimeout language blob = runParse parseTi withTimeout :: IO a -> IO a withTimeout action = System.timeout (toMicroseconds unmarshalTimeout) action >>= maybeM (Exc.throw UnmarshalTimedOut) -instance Exception TSParseException where +instance Exc.Exception TSParseException where displayException = \case ParserTimedOut -> "tree-sitter: parser timed out" IncompatibleVersions -> "tree-sitter: incompatible versions" From 92bdea0d98e2324f4d786c0a7bb14c7e1c5c9ca0 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 27 Jan 2020 11:21:34 -0500 Subject: [PATCH 023/235] :note: Semantic.COnfig. --- src/Semantic/Config.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Semantic/Config.hs b/src/Semantic/Config.hs index 19069ef90..422569fe9 100644 --- a/src/Semantic/Config.hs +++ b/src/Semantic/Config.hs @@ -21,11 +21,11 @@ module Semantic.Config ) where import Data.Duration -import Data.Error (LogPrintSource(..)) +import Data.Error (LogPrintSource (..)) import Data.Flag +import Data.Maybe import Network.HostName import Network.URI -import Prologue import Semantic.Env import Semantic.Telemetry import qualified Semantic.Telemetry.Error as Error From 1c593fbd18908af3591030160b4b90bd1d0fa1d1 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 27 Jan 2020 11:22:07 -0500 Subject: [PATCH 024/235] :note: Rendering.JSON. --- src/Rendering/JSON.hs | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/src/Rendering/JSON.hs b/src/Rendering/JSON.hs index 4729d6742..1afb844ac 100644 --- a/src/Rendering/JSON.hs +++ b/src/Rendering/JSON.hs @@ -1,4 +1,11 @@ -{-# LANGUAGE DataKinds, GADTs, GeneralizedNewtypeDeriving, KindSignatures, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TypeApplications #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module Rendering.JSON ( JSON(..) , renderJSONDiff @@ -15,10 +22,10 @@ module Rendering.JSON import Data.Aeson as A import Data.Blob +import Data.Foldable (fold) import Data.JSON.Fields import Data.Text (pack) import GHC.TypeLits -import Prologue newtype JSON (key :: Symbol) a = JSON { unJSON :: [a] } deriving (Eq, Monoid, Semigroup, Show) From 4058bac8a645a5d1aa0baf3da7f197c43a497de2 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 27 Jan 2020 11:24:54 -0500 Subject: [PATCH 025/235] :note: Data.Syntax. --- src/Data/Syntax.hs | 75 ++++++++++++++++++++++++++++++++-------------- 1 file changed, 52 insertions(+), 23 deletions(-) diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs index 57065ee19..0b206d65d 100644 --- a/src/Data/Syntax.hs +++ b/src/Data/Syntax.hs @@ -1,25 +1,54 @@ -{-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, DataKinds, DeriveAnyClass, DeriveGeneric, DeriveTraversable, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Data.Syntax (module Data.Syntax) where -import Data.Abstract.Evaluatable hiding (Empty, Error) -import Data.Aeson as Aeson (ToJSON(..), object) -import Data.JSON.Fields -import qualified Data.Set as Set -import Data.Sum -import Data.Term -import GHC.Types (Constraint) -import GHC.TypeLits -import Diffing.Algorithm -import Prelude -import Prologue -import Source.Loc -import Source.Range as Range -import Source.Span as Span import qualified Assigning.Assignment as Assignment -import qualified Data.Error as Error -import Control.Abstract.ScopeGraph (reference, Reference(..), Declaration(..)) -import Control.Abstract.Heap (deref, lookupSlot) +import Control.Abstract.Heap (deref, lookupSlot) +import Control.Abstract.ScopeGraph (Declaration (..), Reference (..), reference) +import Data.Abstract.Evaluatable hiding (Empty, Error) import qualified Data.Abstract.ScopeGraph as ScopeGraph +import Data.Aeson as Aeson (ToJSON (..), object) +import Data.Bifunctor +import qualified Data.Error as Error +import Data.Foldable +import Data.Function +import Data.Functor.Classes +import Data.Functor.Classes.Generic +import Data.Functor.Foldable (cata) +import Data.Hashable +import Data.Hashable.Lifted +import Data.Ix +import Data.JSON.Fields +import Data.List.NonEmpty (NonEmpty (..), nonEmpty) +import Data.Proxy +import Data.Semigroup (sconcat) +import qualified Data.Set as Set +import Data.Sum +import Data.Term +import Data.Text (Text) +import Diffing.Algorithm +import GHC.Generics +import GHC.Stack +import GHC.TypeLits +import GHC.Types (Constraint) +import Source.Loc +import Source.Range as Range +import Source.Span as Span -- Combinators @@ -35,7 +64,7 @@ makeTerm' ann syntax = termIn (sconcat (ann :| (termAnnotation <$> toList syntax makeTerm'' :: (Element syntax syntaxes, Sum syntaxes ~ Syntax term, Semigroup ann, Apply Foldable syntaxes, Foldable syntax, IsTerm term) => ann -> syntax (term ann) -> term ann makeTerm'' ann children = case toList children of [x] -> x - _ -> makeTerm' ann (inject children) + _ -> makeTerm' ann (inject children) -- | Lift non-empty syntax into a term, injecting the syntax into a union & appending all subterms’.annotations to make the new term’s annotation. makeTerm1 :: (HasCallStack, Element syntax syntaxes, Sum syntaxes ~ Syntax term, Semigroup ann, Apply Foldable syntaxes, IsTerm term) => syntax (term ann) -> term ann @@ -45,7 +74,7 @@ makeTerm1 = makeTerm1' . inject makeTerm1' :: (HasCallStack, Semigroup ann, Foldable (Syntax term), IsTerm term) => Syntax term (term ann) -> term ann makeTerm1' syntax = case toList syntax of a : _ -> makeTerm' (termAnnotation a) syntax - _ -> error "makeTerm1': empty structure" + _ -> error "makeTerm1': empty structure" -- | Construct an empty term at the current position. emptyTerm :: (Empty :< syntaxes, Sum syntaxes ~ Syntax term, Apply Foldable syntaxes, IsTerm term) => Assignment.Assignment ast grammar (term Loc) @@ -68,7 +97,7 @@ contextualize :: (HasCallStack, Context :< syntaxes, Sum syntaxes ~ Syntax term, contextualize context rule = make <$> Assignment.manyThrough context rule where make (cs, node) = case nonEmpty cs of Just cs -> makeTerm1 (Context cs node) - _ -> node + _ -> node -- | Match context terms after a subject term and before a delimiter, returning the delimiter paired with a Context term if any context terms matched, or the subject term otherwise. postContextualizeThrough :: (HasCallStack, Context :< syntaxes, Sum syntaxes ~ Syntax term, Alternative m, Semigroup ann, Apply Foldable syntaxes, IsTerm term) @@ -79,7 +108,7 @@ postContextualizeThrough :: (HasCallStack, Context :< syntaxes, Sum syntaxes ~ S postContextualizeThrough context rule end = make <$> rule <*> Assignment.manyThrough context end where make node (cs, end) = case nonEmpty cs of Just cs -> (makeTerm1 (Context cs node), end) - _ -> (node, end) + _ -> (node, end) -- | Match context terms after a subject term, wrapping both up in a Context term if any context terms matched, or otherwise returning the subject term. postContextualize :: (HasCallStack, Context :< syntaxes, Sum syntaxes ~ Syntax term, Alternative m, Semigroup ann, Apply Foldable syntaxes, IsTerm term) @@ -89,7 +118,7 @@ postContextualize :: (HasCallStack, Context :< syntaxes, Sum syntaxes ~ Syntax t postContextualize context rule = make <$> rule <*> many context where make node cs = case nonEmpty cs of Just cs -> makeTerm1 (Context cs node) - _ -> node + _ -> node -- | Match infix terms separated by any of a list of operators, with optional context terms following each operand. infixContext :: (Context :< syntaxes, Sum syntaxes ~ Syntax term, Assignment.Parsing m, Semigroup ann, HasCallStack, Apply Foldable syntaxes, IsTerm term) From e8091780eb1bf22b1d97b2ae7a6c76039c312475 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 27 Jan 2020 11:25:42 -0500 Subject: [PATCH 026/235] :note: Semantic.Distribute. --- src/Semantic/Distribute.hs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/Semantic/Distribute.hs b/src/Semantic/Distribute.hs index d1615aefb..3de2224f6 100644 --- a/src/Semantic/Distribute.hs +++ b/src/Semantic/Distribute.hs @@ -1,5 +1,12 @@ -{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, - MultiParamTypeClasses, StandaloneDeriving, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- TODO: We should kill this entirely, because with fused-effects 1.0 we can unlift the various runConcurrently operations. module Semantic.Distribute @@ -18,7 +25,7 @@ import Control.Carrier.Reader import qualified Control.Concurrent.Async as Async import Control.Monad.IO.Unlift import Control.Parallel.Strategies -import Prologue +import Data.Foldable (fold) -- | Distribute a 'Traversable' container of tasks over the available cores (i.e. execute them concurrently), collecting their results. -- From ec26b353427570e4caec1e6b4517b7967c920252 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 27 Jan 2020 11:27:05 -0500 Subject: [PATCH 027/235] :note: Rendering.TOC. --- src/Rendering/TOC.hs | 36 ++++++++++++++++++++++++++---------- 1 file changed, 26 insertions(+), 10 deletions(-) diff --git a/src/Rendering/TOC.hs b/src/Rendering/TOC.hs index a0090fa4d..37934877b 100644 --- a/src/Rendering/TOC.hs +++ b/src/Rendering/TOC.hs @@ -1,4 +1,12 @@ -{-# LANGUAGE DeriveGeneric, DerivingVia, DuplicateRecordFields, LambdaCase, OverloadedStrings, RankNTypes, RecordWildCards, ScopedTypeVariables, TupleSections #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} module Rendering.TOC ( diffTOC , Summaries(..) @@ -10,17 +18,25 @@ module Rendering.TOC , summarizeChange ) where -import Prologue hiding (index) -import Analysis.TOCSummary -import Data.Aeson (ToJSON(..), Value, (.=), object) -import Data.Diff -import Data.Edit -import Data.Language as Language -import Data.List (sortOn) +import Analysis.TOCSummary +import Control.Applicative +import Control.Arrow ((&&&)) +import Data.Aeson (ToJSON (..), Value, object, (.=)) +import Data.Bifoldable +import Data.Bifunctor +import Data.Diff +import Data.Edit +import Data.Foldable +import Data.Functor.Foldable (cata) +import Data.Language as Language +import Data.List (sortOn) import qualified Data.Map.Monoidal as Map -import Data.Term +import Data.Maybe +import Data.Monoid.Generic +import Data.Term import qualified Data.Text as T -import Source.Loc +import GHC.Generics (Generic) +import Source.Loc data Summaries = Summaries { changes, errors :: Map.Map T.Text [Value] } deriving (Eq, Show, Generic) From 3bae3da785ba9d8b0d4704a095070c35e4aedd65 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 27 Jan 2020 11:27:38 -0500 Subject: [PATCH 028/235] :note: Semantic.Task. --- src/Semantic/Task.hs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs index 5773cbe9b..724205bf9 100644 --- a/src/Semantic/Task.hs +++ b/src/Semantic/Task.hs @@ -1,5 +1,13 @@ -{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, KindSignatures, - MultiParamTypeClasses, RecordWildCards, ScopedTypeVariables, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Semantic.Task ( TaskC , Level(..) @@ -51,10 +59,10 @@ import Control.Carrier.Error.Either import Control.Carrier.Lift import Control.Carrier.Reader import Control.Effect.Trace +import Control.Exception import Control.Monad.IO.Class import Data.ByteString.Builder import qualified Data.Flag as Flag -import Prologue hiding (project) import Semantic.Config import Semantic.Distribute import Semantic.Resolution From d9f5c9d41a31f59122348d04122a0c26be730db4 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 27 Jan 2020 11:28:47 -0500 Subject: [PATCH 029/235] :note: Rendering.Graph. --- src/Rendering/Graph.hs | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/src/Rendering/Graph.hs b/src/Rendering/Graph.hs index e35617099..66fd95ac9 100644 --- a/src/Rendering/Graph.hs +++ b/src/Rendering/Graph.hs @@ -1,4 +1,8 @@ -{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, MonoLocalBinds, OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE OverloadedStrings #-} module Rendering.Graph ( renderTreeGraph , termStyle @@ -14,14 +18,15 @@ import Control.Carrier.State.Strict import Control.Lens import Data.Diff import Data.Edit +import Data.Foldable +import Data.Functor.Foldable import Data.Graph import Data.ProtoLens (defMessage) import Data.String (IsString (..)) import Data.Term -import Prologue -import Semantic.Api.Bridge import Proto.Semantic as P import Proto.Semantic_Fields as P +import Semantic.Api.Bridge import Source.Loc as Loc import qualified Data.Text as T From afc61892275acb50709c322667f5cc3a96896a13 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 27 Jan 2020 11:29:59 -0500 Subject: [PATCH 030/235] :note: Data.Language. --- src/Data/Language.hs | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/src/Data/Language.hs b/src/Data/Language.hs index 6b972c859..9fbe1ceb1 100644 --- a/src/Data/Language.hs +++ b/src/Data/Language.hs @@ -1,4 +1,9 @@ -{-# LANGUAGE DataKinds, DeriveAnyClass, DeriveGeneric, KindSignatures, LambdaCase, OverloadedStrings #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} module Data.Language ( Language (..) , SLanguage (..) @@ -16,10 +21,11 @@ module Data.Language ) where import Data.Aeson +import Data.Hashable import qualified Data.Languages as Lingo -import qualified Data.Text as T import qualified Data.Map.Strict as Map -import Prologue +import qualified Data.Text as T +import GHC.Generics (Generic) import System.FilePath.Posix -- | The various languages we support. @@ -151,13 +157,13 @@ textToLanguage = \case data PerLanguageModes = PerLanguageModes - { pythonMode :: LanguageMode - , rubyMode :: LanguageMode - , goMode :: LanguageMode + { pythonMode :: LanguageMode + , rubyMode :: LanguageMode + , goMode :: LanguageMode , typescriptMode :: LanguageMode - , tsxMode :: LanguageMode + , tsxMode :: LanguageMode , javascriptMode :: LanguageMode - , jsxMode :: LanguageMode + , jsxMode :: LanguageMode } deriving (Eq, Ord, Show) From 458903ef6d5de9b949f2611e846cd615b529c7bb Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 27 Jan 2020 11:46:07 -0500 Subject: [PATCH 031/235] Remove Prologue from a great many little files. --- src/Analysis/Abstract/Collecting.hs | 2 +- src/Analysis/Abstract/Dead.hs | 11 ++++++++--- src/Analysis/Abstract/Graph.hs | 14 +++++++++++--- src/Data/Blob.hs | 10 +++++++--- src/Data/Error.hs | 12 +++++++++--- src/Data/Flag.hs | 2 +- src/Data/Graph.hs | 14 +++++++++++--- src/Data/Handle.hs | 10 ++++++---- src/Data/ImportPath.hs | 8 +++++--- src/Data/Project.hs | 5 +++-- src/Data/Term.hs | 19 ++++++++++++++++--- src/Language/Go/Syntax.hs | 20 +++++++++++++++----- src/Semantic/Graph.hs | 7 +++++-- src/Semantic/IO.hs | 8 ++++++-- src/Semantic/Util.hs | 20 ++++++++++++++------ 15 files changed, 118 insertions(+), 44 deletions(-) diff --git a/src/Analysis/Abstract/Collecting.hs b/src/Analysis/Abstract/Collecting.hs index 74dddf163..7499775db 100644 --- a/src/Analysis/Abstract/Collecting.hs +++ b/src/Analysis/Abstract/Collecting.hs @@ -4,7 +4,7 @@ module Analysis.Abstract.Collecting import Control.Abstract import Control.Carrier.Reader -import Prologue +import Data.Semilattice.Lower providingLiveSet :: Evaluator term address value (ReaderC (Live address) m) a -> Evaluator term address value m a providingLiveSet = raiseHandler (runReader lowerBound) diff --git a/src/Analysis/Abstract/Dead.hs b/src/Analysis/Abstract/Dead.hs index 578b5e338..d58cc6563 100644 --- a/src/Analysis/Abstract/Dead.hs +++ b/src/Analysis/Abstract/Dead.hs @@ -1,4 +1,8 @@ -{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE StandaloneDeriving #-} module Analysis.Abstract.Dead ( Dead(..) , revivingTerms @@ -9,9 +13,10 @@ module Analysis.Abstract.Dead import Control.Abstract import Control.Carrier.State.Strict import Data.Abstract.Module +import Data.Functor.Foldable import Data.Semigroup.Reducer as Reducer -import Data.Set (delete) -import Prologue +import Data.Semilattice.Lower +import Data.Set (Set, delete) -- | A set of “dead” (unreachable) terms. newtype Dead term = Dead { unDead :: Set term } diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs index 3e1115518..96a23bc0c 100644 --- a/src/Analysis/Abstract/Graph.hs +++ b/src/Analysis/Abstract/Graph.hs @@ -1,4 +1,13 @@ -{-# LANGUAGE DerivingVia, FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, OverloadedStrings, RankNTypes, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} module Analysis.Abstract.Graph ( Graph(..) , ControlFlowVertex(..) @@ -17,7 +26,7 @@ module Analysis.Abstract.Graph ) where import Algebra.Graph.Export.Dot hiding (vertexName) -import Control.Abstract hiding (Function(..)) +import Control.Abstract hiding (Function (..)) import Control.Algebra import Control.Carrier.Reader import Control.Carrier.State.Strict @@ -29,7 +38,6 @@ import Data.Graph import Data.Graph.ControlFlowVertex import qualified Data.Map as Map import qualified Data.Text.Encoding as T -import Prologue import Source.Loc style :: Style ControlFlowVertex Builder diff --git a/src/Data/Blob.hs b/src/Data/Blob.hs index 793fad522..87345ecf6 100644 --- a/src/Data/Blob.hs +++ b/src/Data/Blob.hs @@ -29,15 +29,19 @@ module Data.Blob , pathKeyForBlobPair ) where -import Prologue - import Control.Effect.Error +import Control.Exception import Data.Aeson +import Data.Bifunctor import qualified Data.ByteString.Lazy as BL import Data.Edit import Data.JSON.Fields import Data.Language +import Data.Maybe +import Data.Maybe.Exts import Data.Module +import Data.Text (Text) +import GHC.Generics (Generic) import Source.Source (Source) import qualified Source.Source as Source import qualified System.FilePath as FP @@ -124,7 +128,7 @@ instance FromJSON BlobPair where >>= maybeM (Prelude.fail "Expected object with 'before' and/or 'after' keys only") maybeBlobPair :: MonadFail m => Maybe Blob -> Maybe Blob -> m BlobPair -maybeBlobPair a b = maybeM (Prologue.fail "expected file pair with content on at least one side") (fromMaybes a b) +maybeBlobPair a b = maybeM (fail "expected file pair with content on at least one side") (fromMaybes a b) languageForBlobPair :: BlobPair -> Language languageForBlobPair = mergeEdit combine . bimap blobLanguage blobLanguage where diff --git a/src/Data/Error.hs b/src/Data/Error.hs index f034fc44b..cca446b7c 100644 --- a/src/Data/Error.hs +++ b/src/Data/Error.hs @@ -1,4 +1,8 @@ -{-# LANGUAGE DeriveFunctor, FlexibleInstances, GADTs, RankNTypes, RecordWildCards #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} module Data.Error ( Error (..) , formatError @@ -11,10 +15,12 @@ module Data.Error , Colourize (..) ) where -import Prologue - +import Control.Exception (Exception) import Data.ByteString.Char8 (unpack) +import Data.Foldable +import Data.Ix (inRange) import Data.List (intersperse, isSuffixOf) +import GHC.Stack import System.Console.ANSI import Data.Blob diff --git a/src/Data/Flag.hs b/src/Data/Flag.hs index 43f93e152..653ece241 100644 --- a/src/Data/Flag.hs +++ b/src/Data/Flag.hs @@ -8,7 +8,7 @@ module Data.Flag , choose ) where -import Prologue +import Data.Coerce -- | To declare a new flag, declare a singly-inhabited type: -- @data MyFlag = MyFlag@ diff --git a/src/Data/Graph.hs b/src/Data/Graph.hs index b219cc468..cb4c1c75d 100644 --- a/src/Data/Graph.hs +++ b/src/Data/Graph.hs @@ -1,4 +1,9 @@ -{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, OverloadedStrings, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} module Data.Graph ( Graph(..) , overlay @@ -13,16 +18,19 @@ module Data.Graph , edgeList ) where -import Prologue - import qualified Algebra.Graph as G import qualified Algebra.Graph.AdjacencyMap as A import Algebra.Graph.Class (connect, overlay, vertex) import qualified Algebra.Graph.Class as Class import qualified Algebra.Graph.ToGraph as Class +import Control.Applicative import Control.Carrier.State.Strict import Control.Lens (view) import Data.Aeson +import Data.Foldable +import Data.Function +import Data.Semilattice.Lower +import Data.Set (Set) import qualified Data.Set as Set import Proto.Semantic as P import Proto.Semantic_Fields as P diff --git a/src/Data/Handle.hs b/src/Data/Handle.hs index fbad909ae..86e4e4a6c 100644 --- a/src/Data/Handle.hs +++ b/src/Data/Handle.hs @@ -1,4 +1,7 @@ -{-# LANGUAGE DataKinds, DeriveAnyClass, GADTs, StandaloneDeriving #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE StandaloneDeriving #-} module Data.Handle ( Handle (..) @@ -14,9 +17,8 @@ module Data.Handle , InvalidJSONException (..) ) where -import Prologue - -import Control.Exception (throw) +import Control.Exception (Exception, throw) +import Control.Monad.IO.Class import Data.Aeson import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BLC diff --git a/src/Data/ImportPath.hs b/src/Data/ImportPath.hs index 1adcccd4d..c2b7d5d72 100644 --- a/src/Data/ImportPath.hs +++ b/src/Data/ImportPath.hs @@ -1,12 +1,14 @@ -{-# LANGUAGE DeriveAnyClass, DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} module Data.ImportPath (IsRelative(..), ImportPath(..), importPath, toName, defaultAlias) where -import Prologue - import Data.Abstract.Name import Data.Abstract.Path (stripQuotes) import Data.Aeson +import Data.Hashable +import Data.Text import qualified Data.Text as T +import GHC.Generics (Generic) import System.FilePath.Posix data IsRelative = Unknown | Relative | NonRelative diff --git a/src/Data/Project.hs b/src/Data/Project.hs index 815ddbc62..5256468a0 100644 --- a/src/Data/Project.hs +++ b/src/Data/Project.hs @@ -7,14 +7,15 @@ module Data.Project ) where import Prelude hiding (readFile) -import Prologue +import Control.Monad.IO.Class import Data.Blob import Data.Blob.IO import Data.Language +import Data.Text (Text) import qualified Data.Text as T -import System.FilePath.Posix import Semantic.IO +import System.FilePath.Posix import qualified System.Path as Path -- | A 'Project' contains all the information that semantic needs diff --git a/src/Data/Term.hs b/src/Data/Term.hs index c9a9277e1..9ad310865 100644 --- a/src/Data/Term.hs +++ b/src/Data/Term.hs @@ -1,4 +1,12 @@ -{-# LANGUAGE DeriveGeneric, DeriveTraversable, FlexibleContexts, FlexibleInstances, FunctionalDependencies, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FunctionalDependencies #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module Data.Term ( Term(..) , TermF(..) @@ -15,12 +23,17 @@ module Data.Term , injectTerm ) where -import Prologue - import Control.Lens.Lens import Data.Aeson +import Data.Bifoldable +import Data.Bifunctor +import Data.Bitraversable +import Data.Functor.Classes +import Data.Functor.Foldable import Data.JSON.Fields +import Data.Sum import qualified Data.Sum as Sum +import GHC.Generics (Generic1) import Source.Span import Text.Show diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index c0fa0423f..631bc2ed4 100644 --- a/src/Language/Go/Syntax.hs +++ b/src/Language/Go/Syntax.hs @@ -1,8 +1,11 @@ -{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, FlexibleContexts, RecordWildCards, TypeApplications #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} module Language.Go.Syntax (module Language.Go.Syntax) where -import Prologue - import Control.Abstract import Data.Abstract.BaseError import Data.Abstract.Evaluatable @@ -10,13 +13,20 @@ import Data.Abstract.Module import qualified Data.Abstract.Package as Package import Data.Abstract.Path import qualified Data.Abstract.ScopeGraph as ScopeGraph +import Data.Foldable +import Data.Functor.Classes +import Data.Functor.Classes.Generic +import Data.Hashable.Lifted import Data.ImportPath import Data.JSON.Fields +import Data.List.NonEmpty (nonEmpty) import qualified Data.Map as Map import Data.Semigroup.App import Data.Semigroup.Foldable +import Data.Text (Text) import qualified Data.Text as T import Diffing.Algorithm +import GHC.Generics (Generic1) import System.FilePath.Posix resolveGoImport :: ( Has (Modules address value) sig m @@ -34,7 +44,7 @@ resolveGoImport (ImportPath path Relative) = do paths <- listModulesInDir (joinPaths (takeDirectory modulePath) path) case paths of [] -> throwResolutionError $ GoImportError path - _ -> pure paths + _ -> pure paths resolveGoImport (ImportPath path NonRelative) = do package <- T.unpack . formatName . Package.packageName <$> currentPackage trace ("attempting to resolve " <> show path <> " for package " <> package) @@ -43,7 +53,7 @@ resolveGoImport (ImportPath path NonRelative) = do -- First two are source, next is package name, remaining are path to package -- (e.g. github.com/golang//path...). (_ : _ : p : xs) | p == package -> listModulesInDir (joinPath xs) - _ -> throwResolutionError $ GoImportError path + _ -> throwResolutionError $ GoImportError path -- | Import declarations (symbols are added directly to the calling environment). -- diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 7a5196e1e..06b8025fe 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -52,6 +52,7 @@ import Control.Carrier.Resumable.Resume import Control.Carrier.State.Strict import Control.Effect.Parse import Control.Lens.Getter +import Control.Monad import Data.Abstract.AccessControls.Instances () import Data.Abstract.Address.Hole as Hole import Data.Abstract.Address.Monovariant as Monovariant @@ -65,17 +66,19 @@ import Data.Abstract.Value.Abstract as Abstract import Data.Abstract.Value.Concrete as Concrete (Value, ValueError (..), runValueErrorWith) import Data.Abstract.Value.Type as Type import Data.Blob +import Data.Functor.Foldable import Data.Graph import Data.Graph.ControlFlowVertex (VertexDeclaration) import Data.Language as Language -import Data.List (isPrefixOf, isSuffixOf) +import Data.List (find, isPrefixOf, isSuffixOf) +import Data.Map (Map) import qualified Data.Map as Map import Data.Project +import Data.Proxy import Data.Text (pack, unpack) import Language.Haskell.HsColour import Language.Haskell.HsColour.Colourise import Parsing.Parser -import Prologue hiding (TypeError (..)) import Semantic.Analysis import Semantic.Task as Task import Source.Loc as Loc diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs index 292aaf779..bd59a4d14 100644 --- a/src/Semantic/IO.hs +++ b/src/Semantic/IO.hs @@ -1,12 +1,16 @@ -{-# LANGUAGE DuplicateRecordFields, GADTs, ScopedTypeVariables, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Semantic.IO ( isDirectory , findFilesInDir ) where import Prelude hiding (readFile) -import Prologue +import Control.Monad.IO.Class import Data.Language import System.Directory (doesDirectoryExist) import System.Directory.Tree (AnchoredDirTree (..)) diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 075726826..a2dd5c2cd 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -1,4 +1,9 @@ -{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleContexts, PartialTypeSignatures, TypeApplications, TypeOperators #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE PartialTypeSignatures #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -Wno-missing-signatures -Wno-missing-exported-signatures -Wno-partial-type-signatures -O0 #-} module Semantic.Util ( evaluateProject' @@ -13,13 +18,15 @@ import Prelude hiding (readFile) import Control.Abstract import Control.Carrier.Fresh.Strict -import Control.Carrier.Parse.Simple import Control.Carrier.Lift -import Control.Carrier.Trace.Printing +import Control.Carrier.Parse.Simple import Control.Carrier.Reader import Control.Carrier.Resumable.Either (SomeError (..)) import Control.Carrier.State.Strict +import Control.Carrier.Trace.Printing +import Control.Exception hiding (evaluate) import Control.Lens.Getter +import Control.Monad import Data.Abstract.Address.Precise as Precise import Data.Abstract.Evaluatable import Data.Abstract.Module @@ -31,15 +38,16 @@ import Data.Blob.IO import Data.Graph (topologicalSort) import qualified Data.Language as Language import Data.List (uncons) +import Data.Maybe import Data.Project -import Data.Sum (weaken) +import Data.Semilattice.Lower +import Data.Sum import Parsing.Parser -import Prologue import Semantic.Analysis import Semantic.Config import Semantic.Graph import Semantic.Task -import Source.Span (HasSpan(..)) +import Source.Span (HasSpan (..)) import System.Exit (die) import System.FilePath.Posix (takeDirectory) From 26723f9e1e9dff8d3abc605548b8227d9ed984e9 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 27 Jan 2020 13:10:00 -0500 Subject: [PATCH 032/235] De-Prologue various assignment and syntax modules. --- src/Analysis/Abstract/Graph.hs | 3 ++- src/Assigning/Assignment/Table.hs | 14 +++++++--- src/Diffing/Algorithm/RWS.hs | 39 +++++++++++++++++++-------- src/Language/Go/Assignment.hs | 17 +++++++----- src/Language/Go/Type.hs | 10 ++++--- src/Language/Markdown/Assignment.hs | 21 +++++++++------ src/Language/Markdown/Syntax.hs | 10 +++++-- src/Language/PHP/Assignment.hs | 13 ++++++--- src/Language/PHP/Syntax.hs | 14 +++++++--- src/Language/Python/Assignment.hs | 15 ++++++++--- src/Language/Python/Syntax.hs | 21 ++++++++++++--- src/Language/Ruby/Assignment.hs | 15 ++++++++--- src/Language/Ruby/Syntax.hs | 21 ++++++++++++--- src/Language/TSX/Assignment.hs | 33 ++++++++++++++--------- src/Language/TypeScript/Assignment.hs | 35 +++++++++++++++--------- 15 files changed, 200 insertions(+), 81 deletions(-) diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs index 96a23bc0c..28137fad3 100644 --- a/src/Analysis/Abstract/Graph.hs +++ b/src/Analysis/Abstract/Graph.hs @@ -36,6 +36,7 @@ import Data.Abstract.Module (Module (moduleInfo), ModuleInfo (..)) import Data.ByteString.Builder import Data.Graph import Data.Graph.ControlFlowVertex +import Data.Map (Map) import qualified Data.Map as Map import qualified Data.Text.Encoding as T import Source.Loc @@ -131,7 +132,7 @@ graphingModules recur m = do where -- NB: path is null for Languages like Ruby that have module imports that require concrete value semantics. includeModule path - = let path' = if Prologue.null path then "unknown, concrete semantics required" else path + = let path' = if Prelude.null path then "unknown, concrete semantics required" else path info = moduleInfo m in moduleInclusion (moduleVertex (ModuleInfo path' (moduleLanguage info) (moduleOid info))) diff --git a/src/Assigning/Assignment/Table.hs b/src/Assigning/Assignment/Table.hs index 11719ee42..5a3f0d294 100644 --- a/src/Assigning/Assignment/Table.hs +++ b/src/Assigning/Assignment/Table.hs @@ -1,4 +1,7 @@ -{-# LANGUAGE DeriveGeneric, DeriveTraversable, DerivingVia, RecordWildCards #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE RecordWildCards #-} module Assigning.Assignment.Table ( Table(tableAddresses) , singleton @@ -7,10 +10,15 @@ module Assigning.Assignment.Table , lookup ) where -import Prologue -import Prelude hiding (lookup) +import Data.Bifunctor +import Data.Functor.Classes +import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap import qualified Data.IntSet as IntSet +import Data.Monoid.Generic +import Data.Traversable +import GHC.Generics (Generic) +import Prelude hiding (lookup) data Table i a = Table { tableAddresses :: [i], tableBranches :: IntMap a } deriving (Eq, Foldable, Functor, Show, Traversable, Generic) diff --git a/src/Diffing/Algorithm/RWS.hs b/src/Diffing/Algorithm/RWS.hs index b57aad0ba..99b8aaad8 100644 --- a/src/Diffing/Algorithm/RWS.hs +++ b/src/Diffing/Algorithm/RWS.hs @@ -1,4 +1,10 @@ -{-# LANGUAGE DataKinds, DeriveAnyClass, DeriveGeneric, GADTs, RankNTypes, RecordWildCards, TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- FIXME module Diffing.Algorithm.RWS ( rws @@ -14,16 +20,27 @@ module Diffing.Algorithm.RWS , equalTerms ) where -import Control.Monad.State.Strict -import Data.Diff (DiffF(..), comparing, deleting, inserting, merge) -import Data.Edit +import Control.Applicative +import Control.Arrow ((&&&)) +import Control.Monad.State.Strict +import Data.Diff (DiffF (..), comparing, deleting, inserting, merge) +import Data.Edit +import Data.Foldable +import Data.Function +import Data.Functor.Classes +import Data.Functor.Foldable (cata) +import Data.Hashable +import Data.Hashable.Lifted +import Data.Ix (inRange) import qualified Data.KdMap.Static as KdMap -import Data.List (sortOn) -import Data.Term as Term -import Diffing.Algorithm (Diffable(..)) -import Diffing.Algorithm.RWS.FeatureVector -import Diffing.Algorithm.SES -import Prologue +import Data.List (sortOn) +import Data.Maybe +import Data.Term as Term +import Data.Traversable +import Diffing.Algorithm (Diffable (..)) +import Diffing.Algorithm.RWS.FeatureVector +import Diffing.Algorithm.SES +import GHC.Generics (Generic) -- | A relation on 'Term's, guaranteed constant-time in the size of the 'Term' by parametricity. -- @@ -158,7 +175,7 @@ editDistanceUpTo m a b = diffCost m (approximateDiff a b) where diffCost = flip . cata $ \ diff m -> case diff of _ | m <= 0 -> 0 Merge body -> sum (fmap ($ pred m) body) - body -> succ (sum (fmap ($ pred m) body)) + body -> succ (sum (fmap ($ pred m) body)) approximateDiff a b = maybe (comparing a b) (merge (termAnnotation a, termAnnotation b)) (tryAlignWith (Just . edit deleting inserting approximateDiff) (termOut a) (termOut b)) diff --git a/src/Language/Go/Assignment.hs b/src/Language/Go/Assignment.hs index 269bd20b4..c27cc9104 100644 --- a/src/Language/Go/Assignment.hs +++ b/src/Language/Go/Assignment.hs @@ -1,4 +1,8 @@ -{-# LANGUAGE DataKinds, FlexibleContexts, RankNTypes, TypeFamilies, TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module Language.Go.Assignment ( assignment , Go.Syntax @@ -6,12 +10,14 @@ module Language.Go.Assignment , Go.Term(..) ) where -import Prologue - import Assigning.Assignment hiding (Assignment, Error) import qualified Assigning.Assignment as Assignment -import qualified Data.Abstract.ScopeGraph as ScopeGraph (AccessControl(..)) +import Control.Monad import Data.Abstract.Name (name) +import qualified Data.Abstract.ScopeGraph as ScopeGraph (AccessControl (..)) +import Data.ImportPath (defaultAlias, importPath) +import Data.List.NonEmpty (NonEmpty (..), some1) +import Data.Sum import Data.Syntax (contextualize, emptyTerm, handleError, infixContext, makeTerm, makeTerm', makeTerm'', makeTerm1, parseError) import qualified Data.Syntax as Syntax @@ -22,10 +28,9 @@ import qualified Data.Syntax.Literal as Literal import qualified Data.Syntax.Statement as Statement import qualified Data.Syntax.Type as Type import qualified Data.Term as Term -import Language.Go.Syntax as Go.Syntax hiding (runeLiteral, labelName) +import Language.Go.Syntax as Go.Syntax hiding (labelName, runeLiteral) import Language.Go.Term as Go import Language.Go.Type as Go.Type -import Data.ImportPath (importPath, defaultAlias) import TreeSitter.Go as Grammar type Assignment = Assignment.Assignment [] Grammar diff --git a/src/Language/Go/Type.hs b/src/Language/Go/Type.hs index 1548779e5..d24445146 100644 --- a/src/Language/Go/Type.hs +++ b/src/Language/Go/Type.hs @@ -1,11 +1,15 @@ -{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DuplicateRecordFields #-} module Language.Go.Type (module Language.Go.Type) where -import Prologue - import Data.Abstract.Evaluatable +import Data.Functor.Classes.Generic +import Data.Hashable.Lifted import Data.JSON.Fields import Diffing.Algorithm +import GHC.Generics (Generic1) -- | A Bidirectional channel in Go (e.g. `chan`). newtype BidirectionalChannel a = BidirectionalChannel { value :: a } diff --git a/src/Language/Markdown/Assignment.hs b/src/Language/Markdown/Assignment.hs index d1124bc3b..37036d8e0 100644 --- a/src/Language/Markdown/Assignment.hs +++ b/src/Language/Markdown/Assignment.hs @@ -1,4 +1,9 @@ -{-# LANGUAGE DataKinds, FlexibleContexts, RankNTypes, RecordWildCards, TypeFamilies, TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module Language.Markdown.Assignment ( assignment , Markdown.Syntax @@ -6,11 +11,11 @@ module Language.Markdown.Assignment , Markdown.Term(..) ) where -import Prologue - import Assigning.Assignment hiding (Assignment, Error) import qualified Assigning.Assignment as Assignment import qualified CMarkGFM +import Control.Monad +import Data.Sum import Data.Syntax (makeTerm) import qualified Data.Syntax as Syntax import qualified Data.Term as Term @@ -46,7 +51,7 @@ list :: Assignment (Term Loc) list = Term.termIn <$> symbol List <*> (makeList . Term.termFAnnotation . Term.termFOut <$> currentNode <*> children (many item)) where makeList (CMarkGFM.LIST CMarkGFM.ListAttributes{..}) = case listType of - CMarkGFM.BULLET_LIST -> inject . Markup.UnorderedList + CMarkGFM.BULLET_LIST -> inject . Markup.UnorderedList CMarkGFM.ORDERED_LIST -> inject . Markup.OrderedList makeList _ = inject . Markup.UnorderedList @@ -57,7 +62,7 @@ heading :: Assignment (Term Loc) heading = makeTerm <$> symbol Heading <*> (makeHeading . Term.termFAnnotation . Term.termFOut <$> currentNode <*> children (many inlineElement) <*> manyTill blockElement (void (symbol Heading) <|> eof)) where makeHeading (CMarkGFM.HEADING level) = Markup.Heading level - makeHeading _ = Markup.Heading 0 + makeHeading _ = Markup.Heading 0 blockQuote :: Assignment (Term Loc) blockQuote = makeTerm <$> symbol BlockQuote <*> children (Markup.BlockQuote <$> many blockElement) @@ -66,7 +71,7 @@ codeBlock :: Assignment (Term Loc) codeBlock = makeTerm <$> symbol CodeBlock <*> (makeCode . Term.termFAnnotation . Term.termFOut <$> currentNode <*> source) where makeCode (CMarkGFM.CODE_BLOCK language _) = Markup.Code (nullText language) - makeCode _ = Markup.Code Nothing + makeCode _ = Markup.Code Nothing thematicBreak :: Assignment (Term Loc) thematicBreak = makeTerm <$> token ThematicBreak <*> pure Markup.ThematicBreak @@ -118,13 +123,13 @@ link :: Assignment (Term Loc) link = makeTerm <$> symbol Link <*> (makeLink . Term.termFAnnotation . Term.termFOut <$> currentNode) <* advance where makeLink (CMarkGFM.LINK url title) = Markup.Link url (nullText title) - makeLink _ = Markup.Link mempty Nothing + makeLink _ = Markup.Link mempty Nothing image :: Assignment (Term Loc) image = makeTerm <$> symbol Image <*> (makeImage . Term.termFAnnotation . Term.termFOut <$> currentNode) <* advance where makeImage (CMarkGFM.IMAGE url title) = Markup.Image url (nullText title) - makeImage _ = Markup.Image mempty Nothing + makeImage _ = Markup.Image mempty Nothing code :: Assignment (Term Loc) code = makeTerm <$> symbol Code <*> (Markup.Code Nothing <$> source) diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs index 188907426..fa9098d0d 100644 --- a/src/Language/Markdown/Syntax.hs +++ b/src/Language/Markdown/Syntax.hs @@ -1,11 +1,17 @@ -{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DuplicateRecordFields #-} module Language.Markdown.Syntax (module Language.Markdown.Syntax) where import Data.Abstract.Declarations +import Data.Functor.Classes +import Data.Functor.Classes.Generic +import Data.Hashable.Lifted import Data.JSON.Fields import qualified Data.Text as T import Diffing.Algorithm -import Prologue hiding (Text) +import GHC.Generics (Generic1) newtype Document a = Document { values :: [a] } deriving (Declarations1, Foldable, Traversable, Functor, Generic1, Hashable1, Diffable, ToJSONFields1) diff --git a/src/Language/PHP/Assignment.hs b/src/Language/PHP/Assignment.hs index 54aab1283..816cf6af4 100644 --- a/src/Language/PHP/Assignment.hs +++ b/src/Language/PHP/Assignment.hs @@ -1,4 +1,8 @@ -{-# LANGUAGE DataKinds, FlexibleContexts, RankNTypes, TypeFamilies, TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module Language.PHP.Assignment ( assignment , PHP.Syntax @@ -6,13 +10,14 @@ module Language.PHP.Assignment , PHP.Term(..) ) where -import Prologue - import Assigning.Assignment hiding (Assignment, Error) import qualified Assigning.Assignment as Assignment import qualified Data.Abstract.Name as Name -import qualified Data.Abstract.ScopeGraph as ScopeGraph (AccessControl(..)) +import qualified Data.Abstract.ScopeGraph as ScopeGraph (AccessControl (..)) +import Data.Foldable +import Data.List.NonEmpty (NonEmpty (..), some1) import qualified Data.List.NonEmpty as NonEmpty +import Data.Sum import Data.Syntax ( contextualize , emptyTerm diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index f3826b2a6..a4c1a5ab2 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -1,11 +1,19 @@ -{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields, FlexibleContexts #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} module Language.PHP.Syntax (module Language.PHP.Syntax) where -import Prologue hiding (Text) - import Control.Lens.Getter +import Data.Functor.Classes +import Data.Functor.Classes.Generic +import Data.Hashable.Lifted +import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.Map.Strict as Map +import Data.Maybe.Exts import qualified Data.Text as T +import GHC.Generics (Generic1) import Control.Abstract as Abstract import Data.Abstract.BaseError diff --git a/src/Language/Python/Assignment.hs b/src/Language/Python/Assignment.hs index 90cb3e3bc..05ef1f462 100644 --- a/src/Language/Python/Assignment.hs +++ b/src/Language/Python/Assignment.hs @@ -1,4 +1,8 @@ -{-# LANGUAGE DataKinds, FlexibleContexts, RankNTypes, TypeFamilies, TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module Language.Python.Assignment ( assignment , Python.Syntax @@ -8,8 +12,12 @@ module Language.Python.Assignment import Assigning.Assignment hiding (Assignment, Error) import qualified Assigning.Assignment as Assignment +import Control.Monad import Data.Abstract.Name (name) +import Data.Functor +import Data.List.NonEmpty (some1) import qualified Data.List.NonEmpty as NonEmpty +import Data.Maybe import Data.Sum import Data.Syntax ( contextualize @@ -32,7 +40,6 @@ import qualified Data.Syntax.Statement as Statement import qualified Data.Syntax.Type as Type import Language.Python.Syntax as Python.Syntax import Language.Python.Term as Python -import Prologue import TreeSitter.Python as Grammar type Assignment = Assignment.Assignment [] Grammar @@ -166,14 +173,14 @@ forStatement = symbol ForStatement >>= \ loc -> children (make loc <$> (symbol V where make loc binding subject body forElseClause = case forElseClause of Nothing -> makeTerm loc (Statement.ForEach binding subject body) - Just a -> makeTerm loc (Statement.Else (makeTerm loc $ Statement.ForEach binding subject body) a) + Just a -> makeTerm loc (Statement.Else (makeTerm loc $ Statement.ForEach binding subject body) a) whileStatement :: Assignment (Term Loc) whileStatement = symbol WhileStatement >>= \ loc -> children (make loc <$> term expression <*> term block <*> optional (symbol ElseClause *> children expressions)) where make loc whileCondition whileBody whileElseClause = case whileElseClause of Nothing -> makeTerm loc (Statement.While whileCondition whileBody) - Just a -> makeTerm loc (Statement.Else (makeTerm loc $ Statement.While whileCondition whileBody) a) + Just a -> makeTerm loc (Statement.Else (makeTerm loc $ Statement.While whileCondition whileBody) a) tryStatement :: Assignment (Term Loc) tryStatement = makeTerm <$> symbol TryStatement <*> children (Statement.Try <$> term block <*> manyTerm (expression <|> elseClause)) diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index 476e4957c..86bf32df3 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -1,14 +1,27 @@ -{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, FlexibleContexts, RecordWildCards, TypeApplications #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} module Language.Python.Syntax (module Language.Python.Syntax) where -import Prologue - import Control.Lens.Getter import Data.Aeson hiding (object) +import Data.Foldable +import Data.Functor.Classes +import Data.Functor.Classes.Generic +import Data.Hashable +import Data.Hashable.Lifted import qualified Data.List as List +import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Map.Strict as Map +import Data.Maybe.Exts +import Data.Text (Text) import qualified Data.Text as T +import Data.Traversable +import GHC.Generics (Generic, Generic1) import System.FilePath.Posix import Control.Abstract.Heap @@ -160,7 +173,7 @@ instance Evaluatable Import where -- Last module path is the one we want to import let path = NonEmpty.last modulePaths ((moduleScope, moduleFrame), _) <- require path - if Prologue.null xs then do + if Prelude.null xs then do insertImportEdge moduleScope insertFrameLink ScopeGraph.Import (Map.singleton moduleScope moduleFrame) else do diff --git a/src/Language/Ruby/Assignment.hs b/src/Language/Ruby/Assignment.hs index c32e530c2..3aa16205d 100644 --- a/src/Language/Ruby/Assignment.hs +++ b/src/Language/Ruby/Assignment.hs @@ -1,4 +1,9 @@ -{-# LANGUAGE DataKinds, FlexibleContexts, OverloadedStrings, RankNTypes, TypeFamilies, TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module Language.Ruby.Assignment ( assignment , Ruby.Syntax @@ -6,13 +11,15 @@ module Language.Ruby.Assignment , Ruby.Term(..) ) where -import Prologue hiding (for, unless) - import Assigning.Assignment hiding (Assignment, Error) import qualified Assigning.Assignment as Assignment +import Control.Monad hiding (unless) import Data.Abstract.Name (name) -import qualified Data.Abstract.ScopeGraph as ScopeGraph (AccessControl(..)) +import qualified Data.Abstract.ScopeGraph as ScopeGraph (AccessControl (..)) +import Data.List.NonEmpty (some1) import qualified Data.List.NonEmpty as NonEmpty +import Data.Maybe +import Data.Sum import Data.Syntax ( contextualize , emptyTerm diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index 934de67f5..5c0f2e668 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -1,22 +1,37 @@ -{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields, FlexibleContexts, OverloadedStrings, RecordWildCards, TupleSections, TypeApplications #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} module Language.Ruby.Syntax (module Language.Ruby.Syntax) where -import Prologue - import Control.Abstract as Abstract hiding (Load, String) +import Control.Monad import Data.Abstract.BaseError import Data.Abstract.Evaluatable import qualified Data.Abstract.Module as M import Data.Abstract.Name as Name import Data.Abstract.Path import qualified Data.Abstract.ScopeGraph as ScopeGraph +import Data.Functor.Classes +import Data.Functor.Classes.Generic +import Data.Hashable.Lifted import Data.JSON.Fields import qualified Data.Language as Language +import Data.List.NonEmpty (nonEmpty) import qualified Data.Map.Strict as Map +import Data.Maybe.Exts import Data.Semigroup.App import Data.Semigroup.Foldable +import Data.Text (Text) import qualified Data.Text as T +import Data.Traversable (for) import Diffing.Algorithm +import GHC.Generics (Generic1) import System.FilePath.Posix -- TODO: Fully sort out ruby require/load mechanics diff --git a/src/Language/TSX/Assignment.hs b/src/Language/TSX/Assignment.hs index cd4f35dbe..59f218489 100644 --- a/src/Language/TSX/Assignment.hs +++ b/src/Language/TSX/Assignment.hs @@ -1,4 +1,9 @@ -{-# LANGUAGE DataKinds, FlexibleContexts, OverloadedStrings, RankNTypes, TypeFamilies, TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module Language.TSX.Assignment ( assignment , TSX.Syntax @@ -6,12 +11,17 @@ module Language.TSX.Assignment , TSX.Term(..) ) where -import Assigning.Assignment hiding (Assignment, Error) -import Data.Abstract.Name (name) -import qualified Data.Abstract.ScopeGraph as ScopeGraph (AccessControl(..)) +import Assigning.Assignment hiding (Assignment, Error) import qualified Assigning.Assignment as Assignment -import Data.Sum -import Data.Syntax +import Control.Monad +import Data.Abstract.Name (name) +import qualified Data.Abstract.ScopeGraph as ScopeGraph (AccessControl (..)) +import Data.Foldable +import Data.Function +import Data.List.NonEmpty (nonEmpty, some1) +import Data.Maybe +import Data.Sum +import Data.Syntax ( contextualize , emptyTerm , handleError @@ -31,10 +41,9 @@ import qualified Data.Syntax.Literal as Literal import qualified Data.Syntax.Statement as Statement import qualified Data.Syntax.Type as Type import qualified Language.TSX.Syntax as TSX.Syntax +import Language.TSX.Term as TSX import qualified Language.TypeScript.Resolution as TypeScript.Resolution -import Language.TSX.Term as TSX -import Prologue -import TreeSitter.TSX as Grammar +import TreeSitter.TSX as Grammar type Assignment = Assignment.Assignment [] Grammar @@ -567,11 +576,11 @@ importStatement = makeImportTerm <$> symbol Grammar.ImportStatement <*> childr makeImportTerm1 loc from (Just alias, _) = makeTerm loc (TSX.Syntax.QualifiedAliasedImport alias from) makeImportTerm1 loc from (Nothing, symbols) = makeTerm loc (TSX.Syntax.Import (uncurry TSX.Syntax.Alias <$> symbols) from) makeImportTerm loc ([x], from) = makeImportTerm1 loc from x - makeImportTerm loc (xs, from) = makeTerm loc $ fmap (makeImportTerm1 loc from) xs + makeImportTerm loc (xs, from) = makeTerm loc $ fmap (makeImportTerm1 loc from) xs importSymbol = symbol Grammar.ImportSpecifier *> children (makeNameAliasPair <$> rawIdentifier <*> ((Just <$> rawIdentifier) <|> pure Nothing)) rawIdentifier = symbol Identifier *> (name <$> source) makeNameAliasPair from (Just alias) = (from, alias) - makeNameAliasPair from Nothing = (from, from) + makeNameAliasPair from Nothing = (from, from) -- TODO: Need to validate that inline comments are still handled with this change in assigning to Path and not a Term.Term (Sum TSX.Syntax). fromClause = symbol Grammar.String *> (TypeScript.Resolution.importPath <$> source) @@ -627,7 +636,7 @@ exportStatement = makeTerm <$> symbol Grammar.ExportStatement <*> children (flip exportSymbol = symbol Grammar.ExportSpecifier *> children (makeNameAliasPair <$> rawIdentifier <*> (Just <$> rawIdentifier)) <|> symbol Grammar.ExportSpecifier *> children (makeNameAliasPair <$> rawIdentifier <*> pure Nothing) makeNameAliasPair from (Just alias) = TSX.Syntax.Alias from alias - makeNameAliasPair from Nothing = TSX.Syntax.Alias from from + makeNameAliasPair from Nothing = TSX.Syntax.Alias from from rawIdentifier = symbol Identifier *> (name <$> source) -- TODO: Need to validate that inline comments are still handled with this change in assigning to Path and not a Term.Term (Sum TSX.Syntax). fromClause = symbol Grammar.String *> (TypeScript.Resolution.importPath <$> source) diff --git a/src/Language/TypeScript/Assignment.hs b/src/Language/TypeScript/Assignment.hs index a02a38db4..06f42e172 100644 --- a/src/Language/TypeScript/Assignment.hs +++ b/src/Language/TypeScript/Assignment.hs @@ -1,4 +1,9 @@ -{-# LANGUAGE DataKinds, FlexibleContexts, OverloadedStrings, RankNTypes, TypeFamilies, TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module Language.TypeScript.Assignment ( assignment , TypeScript.Syntax @@ -6,12 +11,17 @@ module Language.TypeScript.Assignment , TypeScript.Term(..) ) where -import Assigning.Assignment hiding (Assignment, Error) -import Data.Abstract.Name (name) -import qualified Data.Abstract.ScopeGraph as ScopeGraph (AccessControl(..)) +import Assigning.Assignment hiding (Assignment, Error) import qualified Assigning.Assignment as Assignment -import Data.Sum -import Data.Syntax +import Control.Monad +import Data.Abstract.Name (name) +import qualified Data.Abstract.ScopeGraph as ScopeGraph (AccessControl (..)) +import Data.Foldable +import Data.Function +import Data.List.NonEmpty (nonEmpty, some1) +import Data.Maybe +import Data.Sum +import Data.Syntax ( contextualize , emptyTerm , handleError @@ -30,11 +40,10 @@ import qualified Data.Syntax.Expression as Expression import qualified Data.Syntax.Literal as Literal import qualified Data.Syntax.Statement as Statement import qualified Data.Syntax.Type as Type -import qualified Language.TypeScript.Syntax as TypeScript.Syntax import qualified Language.TypeScript.Resolution as TypeScript.Resolution -import Language.TypeScript.Term as TypeScript -import Prologue -import TreeSitter.TypeScript as Grammar +import qualified Language.TypeScript.Syntax as TypeScript.Syntax +import Language.TypeScript.Term as TypeScript +import TreeSitter.TypeScript as Grammar type Assignment = Assignment.Assignment [] Grammar @@ -529,11 +538,11 @@ importStatement = makeImportTerm <$> symbol Grammar.ImportStatement <*> childr makeImportTerm1 loc from (Just alias, _) = makeTerm loc (TypeScript.Syntax.QualifiedAliasedImport alias from) makeImportTerm1 loc from (Nothing, symbols) = makeTerm loc (TypeScript.Syntax.Import (uncurry TypeScript.Syntax.Alias <$> symbols) from) makeImportTerm loc ([x], from) = makeImportTerm1 loc from x - makeImportTerm loc (xs, from) = makeTerm loc $ fmap (makeImportTerm1 loc from) xs + makeImportTerm loc (xs, from) = makeTerm loc $ fmap (makeImportTerm1 loc from) xs importSymbol = symbol Grammar.ImportSpecifier *> children (makeNameAliasPair <$> rawIdentifier <*> ((Just <$> rawIdentifier) <|> pure Nothing)) rawIdentifier = symbol Identifier *> (name <$> source) makeNameAliasPair from (Just alias) = (from, alias) - makeNameAliasPair from Nothing = (from, from) + makeNameAliasPair from Nothing = (from, from) -- TODO: Need to validate that inline comments are still handled with this change in assigning to Path and not a Term. fromClause = symbol Grammar.String *> (TypeScript.Resolution.importPath <$> source) @@ -589,7 +598,7 @@ exportStatement = makeTerm <$> symbol Grammar.ExportStatement <*> children (flip exportSymbol = symbol Grammar.ExportSpecifier *> children (makeNameAliasPair <$> rawIdentifier <*> (Just <$> rawIdentifier)) <|> symbol Grammar.ExportSpecifier *> children (makeNameAliasPair <$> rawIdentifier <*> pure Nothing) makeNameAliasPair from (Just alias) = TypeScript.Syntax.Alias from alias - makeNameAliasPair from Nothing = TypeScript.Syntax.Alias from from + makeNameAliasPair from Nothing = TypeScript.Syntax.Alias from from rawIdentifier = symbol Identifier *> (name <$> source) -- TODO: Need to validate that inline comments are still handled with this change in assigning to Path and not a Term. fromClause = symbol Grammar.String *> (TypeScript.Resolution.importPath <$> source) From 368b8ec7a4ddb24d77c219b63561d00b2b05bb81 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 27 Jan 2020 13:30:47 -0500 Subject: [PATCH 033/235] Un-Prologueify the Abstract hierarchy. --- src/Control/Abstract/Context.hs | 2 +- src/Control/Abstract/Heap.hs | 23 +++++++-- src/Control/Abstract/Modules.hs | 26 ++++++++-- src/Control/Abstract/Primitive.hs | 26 ++++++---- src/Control/Abstract/PythonPackage.hs | 10 +++- src/Control/Abstract/ScopeGraph.hs | 34 +++++++++++-- src/Control/Abstract/Value.hs | 16 ++++-- src/Control/Effect/REPL.hs | 20 ++++++-- src/Data/Abstract/BaseError.hs | 10 ++-- src/Data/Abstract/Evaluatable.hs | 72 ++++++++++++++++++++------- src/Data/Abstract/Live.hs | 13 +++-- src/Data/Abstract/ModuleTable.hs | 13 +++-- src/Data/Abstract/Path.hs | 4 +- 13 files changed, 202 insertions(+), 67 deletions(-) diff --git a/src/Control/Abstract/Context.hs b/src/Control/Abstract/Context.hs index 9b1cef723..ca8b826d9 100644 --- a/src/Control/Abstract/Context.hs +++ b/src/Control/Abstract/Context.hs @@ -17,8 +17,8 @@ import Control.Effect.Reader import Control.Effect.State import Data.Abstract.Module import Data.Abstract.Package +import Data.Maybe import GHC.Stack -import Prologue import Source.Span -- | Get the currently evaluating 'ModuleInfo'. diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index 1e28505f9..1827defa6 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -1,6 +1,15 @@ -{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, GADTs, GeneralizedNewtypeDeriving, KindSignatures, - RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeOperators, - UndecidableInstances #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Control.Abstract.Heap ( Heap , HeapError(..) @@ -60,8 +69,14 @@ import Data.Abstract.Live import Data.Abstract.Module (ModuleInfo) import Data.Abstract.Name import Data.Abstract.ScopeGraph (Kind (..), Path (..), putDeclarationScopeAtPosition) +import Data.Functor.Classes +import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Prologue +import Data.Maybe.Exts +import Data.Semilattice.Lower +import Data.Set (Set) +import GHC.Generics (Generic1) +import GHC.Stack import Source.Span (Span) diff --git a/src/Control/Abstract/Modules.hs b/src/Control/Abstract/Modules.hs index f60c1fd39..c39b7f477 100644 --- a/src/Control/Abstract/Modules.hs +++ b/src/Control/Abstract/Modules.hs @@ -1,6 +1,17 @@ -{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, - KindSignatures, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeOperators, - OverloadedStrings, UndecidableInstances #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Control.Abstract.Modules ( ModuleResult , lookupModule @@ -21,13 +32,18 @@ module Control.Abstract.Modules , ModuleTable ) where -import Prologue - import Control.Algebra import Control.Carrier.Reader import qualified Control.Carrier.Resumable.Either as Either import qualified Control.Carrier.Resumable.Resume as With +import Control.Monad.IO.Class +import Data.Foldable +import Data.Functor.Classes +import Data.Maybe.Exts +import Data.Semilattice.Lower +import Data.Set (Set) import qualified Data.Set as Set +import GHC.Generics (Generic1) import Source.Span import System.FilePath.Posix (takeDirectory) diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 9932974d2..4443bc439 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -1,20 +1,26 @@ -{-# LANGUAGE FlexibleContexts, RecordWildCards, TupleSections #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} module Control.Abstract.Primitive ( defineClass , defineNamespace , defineBuiltIn ) where -import Control.Abstract.Context -import Control.Abstract.Evaluator -import Control.Abstract.Heap -import Control.Abstract.ScopeGraph -import Control.Abstract.Value -import Data.Abstract.BaseError +import Control.Abstract.Context +import Control.Abstract.Evaluator +import Control.Abstract.Heap +import Control.Abstract.ScopeGraph +import Control.Abstract.Value +import Control.Monad +import Data.Abstract.BaseError +import Data.Abstract.Name import qualified Data.Abstract.ScopeGraph as ScopeGraph -import Data.Abstract.Name -import Data.Map.Strict as Map -import Prologue +import Data.Map.Strict as Map +import Data.Maybe +import Data.Semilattice.Lower +import Data.Traversable +import GHC.Stack defineBuiltIn :: ( HasCallStack , Has (Deref value) sig m diff --git a/src/Control/Abstract/PythonPackage.hs b/src/Control/Abstract/PythonPackage.hs index 291a16fe8..dd6c4c54f 100644 --- a/src/Control/Abstract/PythonPackage.hs +++ b/src/Control/Abstract/PythonPackage.hs @@ -1,15 +1,21 @@ -{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, OverloadedStrings, UndecidableInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE UndecidableInstances #-} module Control.Abstract.PythonPackage ( runPythonPackaging, Strategy(..) ) where import Control.Abstract as Abstract import Control.Algebra import Control.Effect.Sum.Project +import Control.Monad import Data.Abstract.Name (name) import Data.Abstract.Path (stripQuotes) import Data.Abstract.Value.Concrete (Value (..)) import qualified Data.Map as Map -import Prologue +import Data.Semilattice.Lower +import Data.Text (Text) data Strategy = Unknown | Packages [Text] | FindPackages [Text] deriving (Show, Eq) diff --git a/src/Control/Abstract/ScopeGraph.hs b/src/Control/Abstract/ScopeGraph.hs index a02af4346..2c59d5d4a 100644 --- a/src/Control/Abstract/ScopeGraph.hs +++ b/src/Control/Abstract/ScopeGraph.hs @@ -1,4 +1,16 @@ -{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, GADTs, GeneralizedNewtypeDeriving, KindSignatures, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Control.Abstract.ScopeGraph ( lookup , declare @@ -45,15 +57,29 @@ module Control.Abstract.ScopeGraph import Control.Abstract.Evaluator hiding (Local) import Control.Algebra -import qualified Control.Carrier.Resumable.Resume as With import qualified Control.Carrier.Resumable.Either as Either +import qualified Control.Carrier.Resumable.Resume as With import Data.Abstract.BaseError import Data.Abstract.Module import Data.Abstract.Name hiding (name) -import Data.Abstract.ScopeGraph (Kind, Declaration(..), EdgeLabel, Reference, Relation(..), Scope (..), ScopeGraph, Slot(..), Info(..), AccessControl(..)) +import Data.Abstract.ScopeGraph + ( AccessControl (..) + , Declaration (..) + , EdgeLabel + , Info (..) + , Kind + , Reference + , Relation (..) + , Scope (..) + , ScopeGraph + , Slot (..) + ) import qualified Data.Abstract.ScopeGraph as ScopeGraph +import Data.Functor.Classes +import Data.Map (Map) +import Data.Maybe.Exts +import GHC.Generics (Generic1) import Prelude hiding (lookup) -import Prologue import Source.Span lookup :: ( Ord address diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index 30a55013a..5d60f3664 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -1,5 +1,13 @@ -{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, GADTs, GeneralizedNewtypeDeriving, KindSignatures, - MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeOperators #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeOperators #-} module Control.Abstract.Value ( AbstractValue(..) , AbstractIntro(..) @@ -81,9 +89,11 @@ import Data.Abstract.BaseError import Data.Abstract.Module import Data.Abstract.Name import Data.Abstract.Number (Number, SomeNumber) +import Data.Bits import Data.Scientific (Scientific) +import Data.Text (Text) +import GHC.Generics (Generic, Generic1) import Prelude hiding (String) -import Prologue hiding (TypeError, hash) import Source.Span -- | This datum is passed into liftComparison to handle the fact that Ruby and PHP diff --git a/src/Control/Effect/REPL.hs b/src/Control/Effect/REPL.hs index a606ad7c7..ac6b59cb2 100644 --- a/src/Control/Effect/REPL.hs +++ b/src/Control/Effect/REPL.hs @@ -1,4 +1,12 @@ -{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Control.Effect.REPL ( REPL (..) @@ -8,12 +16,14 @@ module Control.Effect.REPL , runREPL ) where -import Prologue -import Control.Algebra -import Control.Carrier.Reader -import System.Console.Haskeline +import Control.Algebra +import Control.Carrier.Reader +import Control.Monad.IO.Class +import Data.Text (Text) import qualified Data.Text as T +import GHC.Generics (Generic1) +import System.Console.Haskeline data REPL (m :: * -> *) k = Prompt Text (Maybe Text -> m k) diff --git a/src/Data/Abstract/BaseError.hs b/src/Data/Abstract/BaseError.hs index 87db9a0c4..ec6e64dab 100644 --- a/src/Data/Abstract/BaseError.hs +++ b/src/Data/Abstract/BaseError.hs @@ -1,14 +1,16 @@ -{-# LANGUAGE FlexibleContexts, KindSignatures, RecordWildCards #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RecordWildCards #-} module Data.Abstract.BaseError ( BaseError(..) , throwBaseError ) where -import Control.Abstract.Context -import Control.Abstract.Evaluator +import Control.Abstract.Context +import Control.Abstract.Evaluator import qualified Data.Abstract.Module as M -import Prologue +import Data.Functor.Classes import qualified Source.Span as S data BaseError (exc :: * -> *) resume = BaseError { baseErrorModuleInfo :: ModuleInfo, baseErrorSpan :: Span, baseErrorException :: exc resume } diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index ab181b888..70e173a83 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -1,4 +1,13 @@ -{-# LANGUAGE DataKinds, FlexibleContexts, GADTs, KindSignatures, OverloadedStrings, RankNTypes, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Data.Abstract.Evaluatable ( module X , Evaluatable(..) @@ -17,31 +26,58 @@ module Data.Abstract.Evaluatable , throwUnspecializedError ) where -import Prologue - import Control.Algebra import qualified Control.Carrier.Resumable.Either as Either import qualified Control.Carrier.Resumable.Resume as With +import Data.Foldable +import Data.Functor.Classes +import Data.List.NonEmpty (nonEmpty) import Data.Scientific (Scientific) import Data.Semigroup.Foldable -import Source.Span (HasSpan(..)) +import Data.Semilattice.Lower +import Data.Sum +import Data.Text +import GHC.Stack +import Source.Span (HasSpan (..)) -import Control.Abstract hiding (Load, String) +import Control.Abstract hiding (Load, String) import qualified Control.Abstract as Abstract -import Control.Abstract.Context as X -import Control.Abstract.Evaluator as X hiding (LoopControl(..), Return(..), catchLoopControl, runLoopControl, catchReturn, runReturn) -import Control.Abstract.Modules as X (Modules, ModuleResult, ResolutionError(..), load, lookupModule, listModulesInDir, require, resolve, throwResolutionError) -import Control.Abstract.Value as X hiding (Bitwise(..), Boolean(..), Function(..), Numeric(..), Object(..), Array(..), Hash(..), String(..), Unit(..), While(..)) -import Data.Abstract.BaseError as X -import Data.Abstract.Declarations as X -import Data.Abstract.FreeVariables as X -import Data.Abstract.Module -import Data.Abstract.Name as X +import Control.Abstract.Context as X +import Control.Abstract.Evaluator as X hiding + (LoopControl (..), Return (..), catchLoopControl, catchReturn, runLoopControl, runReturn) +import Control.Abstract.Modules as X + ( ModuleResult + , Modules + , ResolutionError (..) + , listModulesInDir + , load + , lookupModule + , require + , resolve + , throwResolutionError + ) +import Control.Abstract.Value as X hiding + ( Array (..) + , Bitwise (..) + , Boolean (..) + , Function (..) + , Hash (..) + , Numeric (..) + , Object (..) + , String (..) + , Unit (..) + , While (..) + ) +import Data.Abstract.AccessControls.Class as X +import Data.Abstract.BaseError as X +import Data.Abstract.Declarations as X +import Data.Abstract.FreeVariables as X +import Data.Abstract.Module +import Data.Abstract.Name as X import qualified Data.Abstract.ScopeGraph as ScopeGraph -import Data.Abstract.AccessControls.Class as X -import Data.Language -import Data.Semigroup.App -import Data.Term +import Data.Language +import Data.Semigroup.App +import Data.Term -- | The 'Evaluatable' class defines the necessary interface for a term to be evaluated. While a default definition of 'eval' is given, instances with computational content must implement 'eval' to perform their small-step operational semantics. class (Show1 constr, Foldable constr) => Evaluatable constr where diff --git a/src/Data/Abstract/Live.hs b/src/Data/Abstract/Live.hs index b7140ecda..968809ff2 100644 --- a/src/Data/Abstract/Live.hs +++ b/src/Data/Abstract/Live.hs @@ -1,4 +1,7 @@ -{-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module Data.Abstract.Live ( Live (..) , fromAddresses @@ -11,15 +14,17 @@ module Data.Abstract.Live , liveMap ) where -import Data.Set as Set -import Prologue +import Data.Function +import Data.Functor.Classes +import Data.Semilattice.Lower +import Data.Set as Set hiding (foldr) -- | A set of live addresses (whether roots or reachable). newtype Live address = Live { unLive :: Set address } deriving (Eq, Lower, Monoid, Ord, Semigroup) fromAddresses :: (Foldable t, Ord address) => t address -> Live address -fromAddresses = Prologue.foldr liveInsert lowerBound +fromAddresses = foldr liveInsert lowerBound -- | Construct a 'Live' set containing only the given address. liveSingleton :: address -> Live address diff --git a/src/Data/Abstract/ModuleTable.hs b/src/Data/Abstract/ModuleTable.hs index 65c7d26e8..121a05880 100644 --- a/src/Data/Abstract/ModuleTable.hs +++ b/src/Data/Abstract/ModuleTable.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE DeriveTraversable, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} module Data.Abstract.ModuleTable ( ModulePath , ModuleTable (..) @@ -13,11 +14,13 @@ module Data.Abstract.ModuleTable , toPairs ) where -import Data.Abstract.Module +import Data.Abstract.Module +import Data.Functor.Classes import qualified Data.Map as Map -import Prelude hiding (lookup) -import Prologue -import System.FilePath.Posix +import Data.Semilattice.Lower +import Data.Set (Set) +import Prelude hiding (lookup) +import System.FilePath.Posix newtype ModuleTable a = ModuleTable { unModuleTable :: Map.Map ModulePath a } deriving (Eq, Foldable, Functor, Lower, Monoid, Ord, Semigroup, Traversable) diff --git a/src/Data/Abstract/Path.hs b/src/Data/Abstract/Path.hs index 47b96ec2b..73076e865 100644 --- a/src/Data/Abstract/Path.hs +++ b/src/Data/Abstract/Path.hs @@ -4,9 +4,9 @@ module Data.Abstract.Path , stripQuotes ) where -import Prologue +import Data.Text (Text) import qualified Data.Text as T -import System.FilePath.Posix +import System.FilePath.Posix -- | Join two paths a and b. Handles walking up relative directories in b. e.g. -- From a1529604ce3eb182d5f754d2402ad2739e5535a8 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 27 Jan 2020 13:34:41 -0500 Subject: [PATCH 034/235] Even more. The end is in sight. --- src/Data/Abstract/FreeVariables.hs | 12 ++++++++---- src/Data/Abstract/Heap.hs | 11 +++++++++-- src/Data/Graph/ControlFlowVertex.hs | 20 +++++++++++++++++--- src/Data/Map/Monoidal.hs | 13 ++++++++----- src/Semantic/Api/LegacyTypes.hs | 16 +++++++++++----- src/Semantic/Task/Files.hs | 18 ++++++++++++++---- 6 files changed, 67 insertions(+), 23 deletions(-) diff --git a/src/Data/Abstract/FreeVariables.hs b/src/Data/Abstract/FreeVariables.hs index 07926b922..ead6c136b 100644 --- a/src/Data/Abstract/FreeVariables.hs +++ b/src/Data/Abstract/FreeVariables.hs @@ -1,13 +1,17 @@ -{-# LANGUAGE DefaultSignatures, GeneralizedNewtypeDeriving, StandaloneDeriving, TypeApplications, UndecidableInstances #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE UndecidableInstances #-} module Data.Abstract.FreeVariables ( FreeVariables (..) , FreeVariables1 (..) ) where import Data.Abstract.Name -import Data.Sum -import Data.Term -import Prologue +import Data.Set (Set) +import Data.Sum +import Data.Term -- | Types which can contain unbound variables. class FreeVariables term where diff --git a/src/Data/Abstract/Heap.hs b/src/Data/Abstract/Heap.hs index 79b82bf43..2e47d70fb 100644 --- a/src/Data/Abstract/Heap.hs +++ b/src/Data/Abstract/Heap.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, RecordWildCards #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE RecordWildCards #-} module Data.Abstract.Heap ( Heap(..) , Frame(..) @@ -36,10 +38,15 @@ import Data.Abstract.ScopeGraph , pathDeclaration , pathPosition ) +import Data.Foldable +import Data.Functor.Classes +import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap +import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map +import Data.Semilattice.Lower +import Data.Set (Set) import Prelude hiding (lookup) -import Prologue -- | A Frame describes the vertices of the Heap. Think of it as an instance of a Scope in the ScopeGraph. data Frame scopeAddress frameAddress value = Frame diff --git a/src/Data/Graph/ControlFlowVertex.hs b/src/Data/Graph/ControlFlowVertex.hs index b0d822d66..461b98e2f 100644 --- a/src/Data/Graph/ControlFlowVertex.hs +++ b/src/Data/Graph/ControlFlowVertex.hs @@ -1,4 +1,14 @@ -{-# LANGUAGE DataKinds, EmptyCase, FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE EmptyCase #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Data.Graph.ControlFlowVertex ( ControlFlowVertex (..) , packageVertex @@ -20,15 +30,19 @@ import Data.Abstract.Name import Data.Abstract.Package (PackageInfo (..)) import Data.Aeson import Data.Graph (VertexTag (..)) -import Data.Quieterm (Quieterm(..)) +import Data.Hashable +import Data.Proxy +import Data.Quieterm (Quieterm (..)) +import Data.Semilattice.Lower +import Data.Sum import qualified Data.Syntax as Syntax import qualified Data.Syntax.Declaration as Declaration import qualified Data.Syntax.Expression as Expression import Data.Term +import Data.Text (Text) import qualified Data.Text as T import GHC.Generics (V1) import Prelude hiding (span) -import Prologue import qualified Source.Loc as Loc import Source.Span diff --git a/src/Data/Map/Monoidal.hs b/src/Data/Map/Monoidal.hs index a922e28b1..2084b05fd 100644 --- a/src/Data/Map/Monoidal.hs +++ b/src/Data/Map/Monoidal.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE DeriveTraversable, GeneralizedNewtypeDeriving, MultiParamTypeClasses #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} -- | This module defines a 'Map' type whose 'Monoid' and 'Reducer' instances merge values using the 'Semigroup' instance for the underlying type. module Data.Map.Monoidal ( Map @@ -15,11 +17,12 @@ module Data.Map.Monoidal , module Reducer ) where -import Data.Aeson (ToJSON) +import Data.Aeson (ToJSON) +import Data.Functor.Classes import qualified Data.Map as Map -import Data.Semigroup.Reducer as Reducer -import Prelude hiding (lookup) -import Prologue hiding (Map, empty) +import Data.Semigroup.Reducer as Reducer +import Data.Semilattice.Lower +import Prelude hiding (lookup) newtype Map key value = Map { unMap :: Map.Map key value } deriving (Eq, Eq1, Eq2, Foldable, Functor, Ord, Ord1, Ord2, Show, Show1, Show2, ToJSON, Traversable, Lower) diff --git a/src/Semantic/Api/LegacyTypes.hs b/src/Semantic/Api/LegacyTypes.hs index 02d0542b6..c4c4d5d6e 100644 --- a/src/Semantic/Api/LegacyTypes.hs +++ b/src/Semantic/Api/LegacyTypes.hs @@ -1,4 +1,9 @@ -{-# LANGUAGE DeriveGeneric, DerivingVia, DeriveAnyClass, DuplicateRecordFields, OverloadedStrings, RecordWildCards #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} module Semantic.Api.LegacyTypes ( DiffTreeRequest(..) , ParseTreeRequest(..) @@ -10,8 +15,9 @@ module Semantic.Api.LegacyTypes ) where import Data.Aeson -import Data.Blob hiding (File(..)) -import Prologue +import Data.Blob hiding (File (..)) +import Data.Text (Text) +import GHC.Generics (Generic) newtype DiffTreeRequest = DiffTreeRequest { blobs :: [BlobPair] } deriving (Eq, Show, Generic, FromJSON) @@ -27,9 +33,9 @@ newtype ParseTreeSymbolResponse = ParseTreeSymbolResponse { files :: [File] } deriving (Eq, Show, Generic, ToJSON) data File = File - { filePath :: Text + { filePath :: Text , fileLanguage :: Text - , fileSymbols :: [Symbol] + , fileSymbols :: [Symbol] } deriving (Eq, Show, Generic) diff --git a/src/Semantic/Task/Files.hs b/src/Semantic/Task/Files.hs index 905f0ad88..27005034d 100644 --- a/src/Semantic/Task/Files.hs +++ b/src/Semantic/Task/Files.hs @@ -1,6 +1,15 @@ -{-# LANGUAGE DataKinds, DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GADTs, - GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, StandaloneDeriving, TypeOperators, - UndecidableInstances #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Semantic.Task.Files ( Files @@ -20,6 +29,8 @@ module Semantic.Task.Files import Control.Algebra import Control.Effect.Error +import Control.Exception +import Control.Monad.IO.Class import Data.Blob import Data.Blob.IO import qualified Data.ByteString.Builder as B @@ -27,7 +38,6 @@ import Data.Handle import Data.Language import Data.Project import Prelude hiding (readFile) -import Prologue hiding (catch) import Semantic.IO import qualified System.IO as IO hiding (withBinaryFile) import qualified System.Path as Path From 1b5ea7acb4b8ed229ff38ef3f78aa4dd53f9fe51 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 27 Jan 2020 13:44:30 -0500 Subject: [PATCH 035/235] Stub in a module for the AST datatypes. Co-Authored-By: Ayman Nadeem --- semantic-json/semantic-json.cabal | 1 + semantic-json/src/Language/JSON/AST.hs | 2 ++ 2 files changed, 3 insertions(+) create mode 100644 semantic-json/src/Language/JSON/AST.hs diff --git a/semantic-json/semantic-json.cabal b/semantic-json/semantic-json.cabal index 8096aeb1a..90cbfd4b6 100644 --- a/semantic-json/semantic-json.cabal +++ b/semantic-json/semantic-json.cabal @@ -21,6 +21,7 @@ tested-with: GHC == 8.6.5 library exposed-modules: Language.JSON + Language.JSON.AST build-depends: base >= 4.13 && < 5 , semantic-tags ^>= 0.0 diff --git a/semantic-json/src/Language/JSON/AST.hs b/semantic-json/src/Language/JSON/AST.hs new file mode 100644 index 000000000..568c1e2cd --- /dev/null +++ b/semantic-json/src/Language/JSON/AST.hs @@ -0,0 +1,2 @@ +module Language.JSON.AST +() where From b77157cee657e7f2ee1f5ed08668517f8b0f0a6f Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 27 Jan 2020 13:49:24 -0500 Subject: [PATCH 036/235] Depend on template-haskell. Co-Authored-By: Ayman Nadeem --- semantic-json/semantic-json.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/semantic-json/semantic-json.cabal b/semantic-json/semantic-json.cabal index 90cbfd4b6..2f4cb3032 100644 --- a/semantic-json/semantic-json.cabal +++ b/semantic-json/semantic-json.cabal @@ -25,6 +25,7 @@ library build-depends: base >= 4.13 && < 5 , semantic-tags ^>= 0.0 + , template-haskell ^>= 2.15 , tree-sitter ^>= 0.8 , tree-sitter-json ^>= 0.6 hs-source-dirs: src From 575b19c451f512569f538357e3d6238396e45b2a Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 27 Jan 2020 13:57:13 -0500 Subject: [PATCH 037/235] Add a submodule of tree-sitter-json. Co-Authored-By: Ayman Nadeem --- .gitmodules | 3 +++ semantic-json/vendor/tree-sitter-json | 1 + 2 files changed, 4 insertions(+) create mode 160000 semantic-json/vendor/tree-sitter-json diff --git a/.gitmodules b/.gitmodules index e69de29bb..51c2c89ec 100644 --- a/.gitmodules +++ b/.gitmodules @@ -0,0 +1,3 @@ +[submodule "semantic-json/vendor/tree-sitter-json"] + path = semantic-json/vendor/tree-sitter-json + url = https://github.com/tree-sitter/tree-sitter-json.git diff --git a/semantic-json/vendor/tree-sitter-json b/semantic-json/vendor/tree-sitter-json new file mode 160000 index 000000000..7b6a33f30 --- /dev/null +++ b/semantic-json/vendor/tree-sitter-json @@ -0,0 +1 @@ +Subproject commit 7b6a33f300e3e88c3017e0a9d88c77b50ea6d149 From 0945a3a74f7e0f482f938df1ba57510fa1527df3 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 27 Jan 2020 13:57:41 -0500 Subject: [PATCH 038/235] Copy in the AST generation from tree-sitter-json. Co-Authored-By: Ayman Nadeem --- semantic-json/src/Language/JSON/AST.hs | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/semantic-json/src/Language/JSON/AST.hs b/semantic-json/src/Language/JSON/AST.hs index 568c1e2cd..a5be98f35 100644 --- a/semantic-json/src/Language/JSON/AST.hs +++ b/semantic-json/src/Language/JSON/AST.hs @@ -1,2 +1,20 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} module Language.JSON.AST -() where +( module Language.JSON.AST +) where + +import Prelude hiding (String) +import TreeSitter.GenerateSyntax +import qualified TreeSitter.JSON as Grammar + +astDeclarationsForLanguage Grammar.tree_sitter_json "../../../vendor/tree-sitter-json/src/node-types.json" From 289785d3e422093dfa9857140530a68d5932151c Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 27 Jan 2020 13:58:53 -0500 Subject: [PATCH 039/235] Get the semantic-json AST from semantic-json. Co-Authored-By: Ayman Nadeem --- semantic-json/src/Language/JSON.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic-json/src/Language/JSON.hs b/semantic-json/src/Language/JSON.hs index 8768226c7..a01c9e794 100644 --- a/semantic-json/src/Language/JSON.hs +++ b/semantic-json/src/Language/JSON.hs @@ -5,9 +5,9 @@ module Language.JSON ) where import Data.Proxy +import qualified Language.JSON.AST as JSON import qualified Tags.Tagging.Precise as Tags import qualified TreeSitter.JSON (tree_sitter_json) -import qualified TreeSitter.JSON.AST as JSON import qualified TreeSitter.Unmarshal as TS newtype Term a = Term { getTerm :: JSON.Document a } From 671a26c38930f764c006e95bbaf420386c1ab610 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 27 Jan 2020 14:22:52 -0500 Subject: [PATCH 040/235] Load Paths_semantic.hs correctly. Co-Authored-By: Ayman Nadeem --- script/ghci-flags | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/script/ghci-flags b/script/ghci-flags index 9f301df38..e290427ba 100755 --- a/script/ghci-flags +++ b/script/ghci-flags @@ -26,11 +26,11 @@ function flags { # preprocessor options, for -XCPP echo "-optP-include" - echo "-optP$build_products_dir/autogen/cabal_macros.h" + echo "-optPdist-newstyle/build/x86_64-osx/ghc-$ghc_version/semantic-0.10.0.0/build/autogen/cabal_macros.h" # autogenerated sources, both .hs and .h (e.g. Foo_paths.hs) - echo "-i$build_products_dir/autogen" - echo "-I$build_products_dir/autogen" + echo "-idist-newstyle/build/x86_64-osx/ghc-$ghc_version/semantic-0.10.0.0/build/autogen" + echo "-Idist-newstyle/build/x86_64-osx/ghc-$ghc_version/semantic-0.10.0.0/build/autogen" # .hs source dirs # TODO: would be nice to figure this out from cabal.project & the .cabal files From 836e10b2e590167ca3bece17fe988f3049854955 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 14:27:34 -0500 Subject: [PATCH 041/235] Create AST.hs --- semantic-python/src/Language/Python/AST.hs | 1 + 1 file changed, 1 insertion(+) create mode 100644 semantic-python/src/Language/Python/AST.hs diff --git a/semantic-python/src/Language/Python/AST.hs b/semantic-python/src/Language/Python/AST.hs new file mode 100644 index 000000000..5ba51ef63 --- /dev/null +++ b/semantic-python/src/Language/Python/AST.hs @@ -0,0 +1 @@ +module Language.Python.AST () where \ No newline at end of file From 806b9352a19a4fa29c14701fd689decc4ecfe2be Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 14:27:41 -0500 Subject: [PATCH 042/235] Update semantic-python.cabal --- semantic-python/semantic-python.cabal | 2 ++ 1 file changed, 2 insertions(+) diff --git a/semantic-python/semantic-python.cabal b/semantic-python/semantic-python.cabal index 435f50cfd..e1410ea98 100644 --- a/semantic-python/semantic-python.cabal +++ b/semantic-python/semantic-python.cabal @@ -29,6 +29,7 @@ common haskell , semantic-tags ^>= 0.0 , semantic-scope-graph ^>= 0.0 , semilattices ^>= 0 + , template-haskell ^>= 2.15 , text ^>= 1.2.3 , tree-sitter ^>= 0.8 , tree-sitter-python ^>= 0.8.1 @@ -53,6 +54,7 @@ library import: haskell exposed-modules: Language.Python + Language.Python.AST Language.Python.Core Language.Python.Failure Language.Python.Patterns From 1d82bcde1ccffea2284ccdc739dae10ef062d91d Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 14:33:52 -0500 Subject: [PATCH 043/235] actually add contents to AST --- semantic-python/src/Language/Python/AST.hs | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/semantic-python/src/Language/Python/AST.hs b/semantic-python/src/Language/Python/AST.hs index 5ba51ef63..8ee86b6b7 100644 --- a/semantic-python/src/Language/Python/AST.hs +++ b/semantic-python/src/Language/Python/AST.hs @@ -1 +1,21 @@ -module Language.Python.AST () where \ No newline at end of file +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} + +module Language.Python.AST +( module Language.Python.AST +) where + +import Prelude hiding (False, Float, Integer, String, True) +import TreeSitter.GenerateSyntax +import qualified TreeSitter.Python as Grammar + +astDeclarationsForLanguage Grammar.tree_sitter_python "../../../vendor/tree-sitter-python/src/node-types.json" From 03aad5aca018d19b6c09f39e00ced000991afe0b Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 14:35:18 -0500 Subject: [PATCH 044/235] create submodule for python AST --- .gitmodules | 3 +++ semantic-python/vendor/tree-sitter-python | 1 + 2 files changed, 4 insertions(+) create mode 160000 semantic-python/vendor/tree-sitter-python diff --git a/.gitmodules b/.gitmodules index 51c2c89ec..b38754b6d 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,3 +1,6 @@ [submodule "semantic-json/vendor/tree-sitter-json"] path = semantic-json/vendor/tree-sitter-json url = https://github.com/tree-sitter/tree-sitter-json.git +[submodule "semantic-python/vendor/tree-sitter-python"] + path = semantic-python/vendor/tree-sitter-python + url = https://github.com/tree-sitter/tree-sitter-python.git diff --git a/semantic-python/vendor/tree-sitter-python b/semantic-python/vendor/tree-sitter-python new file mode 160000 index 000000000..899ac8d5d --- /dev/null +++ b/semantic-python/vendor/tree-sitter-python @@ -0,0 +1 @@ +Subproject commit 899ac8d5d6c883b2f05362c9953e14e78aac474c From b423eb1d4b0b42f1a1970a093305fc12742a00ef Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 14:44:24 -0500 Subject: [PATCH 045/235] change TreeSitter.Python.AST to Language.Python.AST --- semantic-ast/app/Main.hs | 2 +- semantic-ast/semantic-ast.cabal | 1 + semantic-python/src/Language/Python.hs | 2 +- semantic-python/src/Language/Python/Core.hs | 2 +- semantic-python/src/Language/Python/Patterns.hs | 2 +- semantic-python/src/Language/Python/ScopeGraph.hs | 2 +- semantic-python/src/Language/Python/Tags.hs | 2 +- 7 files changed, 7 insertions(+), 6 deletions(-) diff --git a/semantic-ast/app/Main.hs b/semantic-ast/app/Main.hs index 4e86f2e86..32a2d32d9 100644 --- a/semantic-ast/app/Main.hs +++ b/semantic-ast/app/Main.hs @@ -3,7 +3,7 @@ module Main (main) where import TreeSitter.Unmarshal -import qualified TreeSitter.Python.AST as AST +import qualified Language.Python.AST as AST import qualified TreeSitter.Python as Python import Source.Range import Source.Span diff --git a/semantic-ast/semantic-ast.cabal b/semantic-ast/semantic-ast.cabal index b95ebb554..97546ab5c 100644 --- a/semantic-ast/semantic-ast.cabal +++ b/semantic-ast/semantic-ast.cabal @@ -72,5 +72,6 @@ executable semantic-ast , aeson , bytestring , aeson-pretty + , semantic-python hs-source-dirs: app default-language: Haskell2010 diff --git a/semantic-python/src/Language/Python.hs b/semantic-python/src/Language/Python.hs index 0539ba4e6..b0d37febe 100644 --- a/semantic-python/src/Language/Python.hs +++ b/semantic-python/src/Language/Python.hs @@ -5,12 +5,12 @@ module Language.Python ) where import Data.Proxy +import qualified Language.Python.AST as Py import Language.Python.ScopeGraph import qualified Language.Python.Tags as PyTags import ScopeGraph.Convert import qualified Tags.Tagging.Precise as Tags import qualified TreeSitter.Python (tree_sitter_python) -import qualified TreeSitter.Python.AST as Py import qualified TreeSitter.Unmarshal as TS newtype Term a = Term { getTerm :: Py.Module a } diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs index 7ecb03799..de52ebaff 100644 --- a/semantic-python/src/Language/Python/Core.hs +++ b/semantic-python/src/Language/Python/Core.hs @@ -33,12 +33,12 @@ import Data.Function import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe import GHC.Records +import qualified Language.Python.AST as Py import Language.Python.Failure import Language.Python.Patterns import Source.Span (Span) import Syntax.Stack (Stack (..)) import qualified Syntax.Stack as Stack -import qualified TreeSitter.Python.AST as Py -- | Keeps track of the current scope's bindings (so that we can, when -- compiling a class or module, return the list of bound variables as diff --git a/semantic-python/src/Language/Python/Patterns.hs b/semantic-python/src/Language/Python/Patterns.hs index a9844c105..83696ec24 100644 --- a/semantic-python/src/Language/Python/Patterns.hs +++ b/semantic-python/src/Language/Python/Patterns.hs @@ -11,7 +11,7 @@ module Language.Python.Patterns import AST.Element import Data.Coerce import Data.Text (Text) -import qualified TreeSitter.Python.AST as Py +import qualified Language.Python.AST as Py -- | Useful pattern synonym for extracting a single identifier from -- a Python ExpressionList. Easier than pattern-matching every time. diff --git a/semantic-python/src/Language/Python/ScopeGraph.hs b/semantic-python/src/Language/Python/ScopeGraph.hs index 8c34feb34..fb4edeae3 100644 --- a/semantic-python/src/Language/Python/ScopeGraph.hs +++ b/semantic-python/src/Language/Python/ScopeGraph.hs @@ -29,10 +29,10 @@ import Data.Name import GHC.Generics import GHC.Records import GHC.TypeLits +import qualified Language.Python.AST as Py import Language.Python.Patterns import ScopeGraph.Convert (Result (..), complete, todo) import Source.Loc -import qualified TreeSitter.Python.AST as Py -- This orphan instance will perish once it lands in fused-effects. instance Algebra sig m => Algebra sig (Ap m) where diff --git a/semantic-python/src/Language/Python/Tags.hs b/semantic-python/src/Language/Python/Tags.hs index 00a9d1a9e..175a0bc02 100644 --- a/semantic-python/src/Language/Python/Tags.hs +++ b/semantic-python/src/Language/Python/Tags.hs @@ -16,12 +16,12 @@ import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (listToMaybe) import Data.Text as Text import GHC.Generics +import qualified Language.Python.AST as Py import Source.Loc import Source.Range import Source.Source as Source import Tags.Tag import qualified Tags.Tagging.Precise as Tags -import qualified TreeSitter.Python.AST as Py import TreeSitter.Token class ToTags t where From d33a8d68011c100ba49d6d4dba1630c879b741d6 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 15:13:03 -0500 Subject: [PATCH 046/235] Create AST.hs --- semantic-java/src/Language/Java/AST.hs | 1 + 1 file changed, 1 insertion(+) create mode 100644 semantic-java/src/Language/Java/AST.hs diff --git a/semantic-java/src/Language/Java/AST.hs b/semantic-java/src/Language/Java/AST.hs new file mode 100644 index 000000000..2c0478422 --- /dev/null +++ b/semantic-java/src/Language/Java/AST.hs @@ -0,0 +1 @@ +module Language.Java.AST () where \ No newline at end of file From 5847bd7024940e01cdc80181c3124eb7e1d6014f Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 15:13:12 -0500 Subject: [PATCH 047/235] Update semantic-java.cabal --- semantic-java/semantic-java.cabal | 2 ++ 1 file changed, 2 insertions(+) diff --git a/semantic-java/semantic-java.cabal b/semantic-java/semantic-java.cabal index fd63d2d26..462807fbb 100644 --- a/semantic-java/semantic-java.cabal +++ b/semantic-java/semantic-java.cabal @@ -21,12 +21,14 @@ tested-with: GHC == 8.6.5 library exposed-modules: Language.Java + Language.Java.AST Language.Java.Tags build-depends: base >= 4.13 && < 5 , fused-effects ^>= 1.0 , semantic-source ^>= 0.0.1 , semantic-tags ^>= 0.0 + , template-haskell ^>= 2.15 , tree-sitter ^>= 0.8 , tree-sitter-java ^>= 0.6.1 hs-source-dirs: src From 5f218d909067f25024c6ab01478126d91d3c6485 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 15:17:35 -0500 Subject: [PATCH 048/235] add AST contents --- semantic-java/src/Language/Java/AST.hs | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/semantic-java/src/Language/Java/AST.hs b/semantic-java/src/Language/Java/AST.hs index 2c0478422..1e00cc727 100644 --- a/semantic-java/src/Language/Java/AST.hs +++ b/semantic-java/src/Language/Java/AST.hs @@ -1 +1,21 @@ -module Language.Java.AST () where \ No newline at end of file +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} + +module Language.Java.AST +( module Language.Java.AST +) where + +import TreeSitter.GenerateSyntax +import qualified TreeSitter.Java as Grammar +import TreeSitter.Token + +astDeclarationsForLanguage Grammar.tree_sitter_java "../../vendor/tree-sitter-java/src/node-types.json" \ No newline at end of file From 05bdf124dfc8aa29012232437dc5a16322c9410d Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 15:17:52 -0500 Subject: [PATCH 049/235] create submodule for java AST --- .gitmodules | 3 +++ semantic-java/vendor/tree-sitter-java | 1 + 2 files changed, 4 insertions(+) create mode 160000 semantic-java/vendor/tree-sitter-java diff --git a/.gitmodules b/.gitmodules index b38754b6d..79182a59b 100644 --- a/.gitmodules +++ b/.gitmodules @@ -4,3 +4,6 @@ [submodule "semantic-python/vendor/tree-sitter-python"] path = semantic-python/vendor/tree-sitter-python url = https://github.com/tree-sitter/tree-sitter-python.git +[submodule "semantic-java/vendor/tree-sitter-java"] + path = semantic-java/vendor/tree-sitter-java + url = https://github.com/tree-sitter/tree-sitter-java.git diff --git a/semantic-java/vendor/tree-sitter-java b/semantic-java/vendor/tree-sitter-java new file mode 160000 index 000000000..afc4cec79 --- /dev/null +++ b/semantic-java/vendor/tree-sitter-java @@ -0,0 +1 @@ +Subproject commit afc4cec799f6594390aeb0ca5e16ec89e73d488e From de6864049d829bb898434c3753d059994e32da5f Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 15:22:24 -0500 Subject: [PATCH 050/235] compensate for src --- semantic-java/src/Language/Java/AST.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic-java/src/Language/Java/AST.hs b/semantic-java/src/Language/Java/AST.hs index 1e00cc727..b81c6eba1 100644 --- a/semantic-java/src/Language/Java/AST.hs +++ b/semantic-java/src/Language/Java/AST.hs @@ -18,4 +18,4 @@ import TreeSitter.GenerateSyntax import qualified TreeSitter.Java as Grammar import TreeSitter.Token -astDeclarationsForLanguage Grammar.tree_sitter_java "../../vendor/tree-sitter-java/src/node-types.json" \ No newline at end of file +astDeclarationsForLanguage Grammar.tree_sitter_java "../../../vendor/tree-sitter-java/src/node-types.json" \ No newline at end of file From 04036eabea90c68556b3bf1415b4a427cf79fdf0 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 15:23:35 -0500 Subject: [PATCH 051/235] s/TreeSitter/Language --- semantic-java/src/Language/Java.hs | 2 +- semantic-java/src/Language/Java/Tags.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/semantic-java/src/Language/Java.hs b/semantic-java/src/Language/Java.hs index 70a449cf7..c1f1e5742 100644 --- a/semantic-java/src/Language/Java.hs +++ b/semantic-java/src/Language/Java.hs @@ -5,10 +5,10 @@ module Language.Java ) where import Data.Proxy +import qualified Language.Java.AST as Java import qualified Language.Java.Tags as JavaTags import qualified Tags.Tagging.Precise as Tags import qualified TreeSitter.Java (tree_sitter_java) -import qualified TreeSitter.Java.AST as Java import qualified TreeSitter.Unmarshal as TS newtype Term a = Term { getTerm :: Java.Program a } diff --git a/semantic-java/src/Language/Java/Tags.hs b/semantic-java/src/Language/Java/Tags.hs index 992daf8fd..ef97f3fdd 100644 --- a/semantic-java/src/Language/Java/Tags.hs +++ b/semantic-java/src/Language/Java/Tags.hs @@ -11,12 +11,12 @@ module Language.Java.Tags import Control.Effect.Reader import Control.Effect.Writer import GHC.Generics +import qualified Language.Java.AST as Java import Source.Loc import Source.Range import Source.Source as Source import Tags.Tag import qualified Tags.Tagging.Precise as Tags -import qualified TreeSitter.Java.AST as Java import TreeSitter.Token class ToTags t where From 2658bf6dee2da9e43e75b8012cf318fd8f47f5c2 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 15:28:15 -0500 Subject: [PATCH 052/235] This fails for some reason, investigate later --- semantic-java/src/Language/Java/Tags.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/semantic-java/src/Language/Java/Tags.hs b/semantic-java/src/Language/Java/Tags.hs index ef97f3fdd..215a4632b 100644 --- a/semantic-java/src/Language/Java/Tags.hs +++ b/semantic-java/src/Language/Java/Tags.hs @@ -140,7 +140,7 @@ instance ToTags Java.FieldAccess instance ToTags Java.FieldDeclaration instance ToTags Java.FinallyClause instance ToTags Java.FloatingPointType -instance ToTags Java.ForInit +-- instance ToTags Java.ForInit instance ToTags Java.ForStatement instance ToTags Java.FormalParameter instance ToTags Java.FormalParameters @@ -160,7 +160,7 @@ instance ToTags Java.LabeledStatement instance ToTags Java.LambdaExpression instance ToTags Java.Literal instance ToTags Java.LocalVariableDeclaration -instance ToTags Java.LocalVariableDeclarationStatement +-- instance ToTags Java.LocalVariableDeclarationStatement instance ToTags Java.MarkerAnnotation -- instance ToTags Java.MethodDeclaration -- instance ToTags Java.MethodInvocation From 51fc70a42f8fb639a8363f8a29cbdae02da98781 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 15:37:07 -0500 Subject: [PATCH 053/235] Create Language.Go.AST --- semantic-go/src/Language/Go/AST.hs | 1 + 1 file changed, 1 insertion(+) create mode 100644 semantic-go/src/Language/Go/AST.hs diff --git a/semantic-go/src/Language/Go/AST.hs b/semantic-go/src/Language/Go/AST.hs new file mode 100644 index 000000000..a6a392bbf --- /dev/null +++ b/semantic-go/src/Language/Go/AST.hs @@ -0,0 +1 @@ +module Language.Go.AST () where \ No newline at end of file From 1face91668d8e2fee71eb29e6f622a77327d26f1 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 15:37:10 -0500 Subject: [PATCH 054/235] Update semantic-go.cabal --- semantic-go/semantic-go.cabal | 2 ++ 1 file changed, 2 insertions(+) diff --git a/semantic-go/semantic-go.cabal b/semantic-go/semantic-go.cabal index ea7ab5515..f94995c5c 100644 --- a/semantic-go/semantic-go.cabal +++ b/semantic-go/semantic-go.cabal @@ -27,6 +27,7 @@ common haskell , semantic-core ^>= 0.0 , semantic-source ^>= 0.0.1 , semantic-tags ^>= 0.0 + , template-haskell ^>= 2.15 , text ^>= 1.2.3 , tree-sitter ^>= 0.8 , tree-sitter-go ^>= 0.4.1 @@ -50,5 +51,6 @@ library import: haskell exposed-modules: Language.Go + Language.Go.AST Language.Go.Tags hs-source-dirs: src From 6e36439f9c57a514823c763162103bf25b81d425 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 15:39:23 -0500 Subject: [PATCH 055/235] add contents to Language.Go.AST --- semantic-go/src/Language/Go/AST.hs | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/semantic-go/src/Language/Go/AST.hs b/semantic-go/src/Language/Go/AST.hs index a6a392bbf..5a655dc3b 100644 --- a/semantic-go/src/Language/Go/AST.hs +++ b/semantic-go/src/Language/Go/AST.hs @@ -1 +1,21 @@ -module Language.Go.AST () where \ No newline at end of file +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} + +module Language.Go.AST +( module Language.Go.AST +) where + +import Prelude hiding (False, Float, Integer, Rational, String, True) +import TreeSitter.GenerateSyntax +import qualified TreeSitter.Go as Grammar + +astDeclarationsForLanguage Grammar.tree_sitter_go "../../vendor/tree-sitter-go/src/node-types.json" \ No newline at end of file From 81a39439d4a0c7707b8f9badb08c4c53a4da455a Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 15:40:47 -0500 Subject: [PATCH 056/235] create submodule for go AST --- .gitmodules | 3 +++ semantic-go/vendor/tree-sitter-go | 1 + 2 files changed, 4 insertions(+) create mode 160000 semantic-go/vendor/tree-sitter-go diff --git a/.gitmodules b/.gitmodules index 79182a59b..d982edbd2 100644 --- a/.gitmodules +++ b/.gitmodules @@ -7,3 +7,6 @@ [submodule "semantic-java/vendor/tree-sitter-java"] path = semantic-java/vendor/tree-sitter-java url = https://github.com/tree-sitter/tree-sitter-java.git +[submodule "semantic-go/vendor/tree-sitter-go"] + path = semantic-go/vendor/tree-sitter-go + url = https://github.com/tree-sitter/tree-sitter-go.git diff --git a/semantic-go/vendor/tree-sitter-go b/semantic-go/vendor/tree-sitter-go new file mode 160000 index 000000000..689cc8fbd --- /dev/null +++ b/semantic-go/vendor/tree-sitter-go @@ -0,0 +1 @@ +Subproject commit 689cc8fbdc0613d267434f221af85aff91a31f8c From 36064c40f25eda7885502a06f23053455e3390d2 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 15:44:39 -0500 Subject: [PATCH 057/235] mo nesting mo problems --- semantic-go/src/Language/Go/AST.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic-go/src/Language/Go/AST.hs b/semantic-go/src/Language/Go/AST.hs index 5a655dc3b..184267a18 100644 --- a/semantic-go/src/Language/Go/AST.hs +++ b/semantic-go/src/Language/Go/AST.hs @@ -18,4 +18,4 @@ import Prelude hiding (False, Float, Integer, Rational, String, True) import TreeSitter.GenerateSyntax import qualified TreeSitter.Go as Grammar -astDeclarationsForLanguage Grammar.tree_sitter_go "../../vendor/tree-sitter-go/src/node-types.json" \ No newline at end of file +astDeclarationsForLanguage Grammar.tree_sitter_go "../../../vendor/tree-sitter-go/src/node-types.json" \ No newline at end of file From 0c87cfdf1b4895afb55db788d6d11db852da4068 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 15:44:51 -0500 Subject: [PATCH 058/235] s/TreeSitter/Language --- semantic-go/src/Language/Go.hs | 2 +- semantic-go/src/Language/Go/Tags.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/semantic-go/src/Language/Go.hs b/semantic-go/src/Language/Go.hs index 38bf2e79f..9eda7acd4 100644 --- a/semantic-go/src/Language/Go.hs +++ b/semantic-go/src/Language/Go.hs @@ -6,10 +6,10 @@ module Language.Go import Data.Proxy +import qualified Language.Go.AST as Go import qualified Language.Go.Tags as GoTags import qualified Tags.Tagging.Precise as Tags import qualified TreeSitter.Go (tree_sitter_go) -import qualified TreeSitter.Go.AST as Go import qualified TreeSitter.Unmarshal as TS newtype Term a = Term { getTerm :: Go.SourceFile a } diff --git a/semantic-go/src/Language/Go/Tags.hs b/semantic-go/src/Language/Go/Tags.hs index 1800de5af..7970eca44 100644 --- a/semantic-go/src/Language/Go/Tags.hs +++ b/semantic-go/src/Language/Go/Tags.hs @@ -13,11 +13,11 @@ import Control.Effect.Reader import Control.Effect.Writer import Data.Text as Text import GHC.Generics +import qualified Language.Go.AST as Go import Source.Loc import Source.Source as Source import Tags.Tag import qualified Tags.Tagging.Precise as Tags -import qualified TreeSitter.Go.AST as Go import TreeSitter.Token class ToTags t where From e626d0f51bc55bea0117fc0f1cc8d5b670e63f26 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 15:49:18 -0500 Subject: [PATCH 059/235] create Language.Ruby.AST --- semantic-ruby/src/Language/Ruby/AST.hs | 1 + 1 file changed, 1 insertion(+) create mode 100644 semantic-ruby/src/Language/Ruby/AST.hs diff --git a/semantic-ruby/src/Language/Ruby/AST.hs b/semantic-ruby/src/Language/Ruby/AST.hs new file mode 100644 index 000000000..efe3632a4 --- /dev/null +++ b/semantic-ruby/src/Language/Ruby/AST.hs @@ -0,0 +1 @@ +module Language.Ruby.AST () where \ No newline at end of file From c297d2c8a560507bd83e4162065e10fecb64d678 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 15:49:20 -0500 Subject: [PATCH 060/235] Update semantic-ruby.cabal --- semantic-ruby/semantic-ruby.cabal | 2 ++ 1 file changed, 2 insertions(+) diff --git a/semantic-ruby/semantic-ruby.cabal b/semantic-ruby/semantic-ruby.cabal index 0a50fc7c8..3effcd730 100644 --- a/semantic-ruby/semantic-ruby.cabal +++ b/semantic-ruby/semantic-ruby.cabal @@ -27,6 +27,7 @@ common haskell , semantic-core ^>= 0.0 , semantic-source ^>= 0.0.1 , semantic-tags ^>= 0.0 + , template-haskell ^>= 2.15 , text ^>= 1.2.3 , tree-sitter ^>= 0.8 , tree-sitter-ruby ^>= 0.4.1 @@ -50,5 +51,6 @@ library import: haskell exposed-modules: Language.Ruby + Language.Ruby.AST Language.Ruby.Tags hs-source-dirs: src From c448e0f0d992924952e7e08a7b8453878ed94578 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 15:50:51 -0500 Subject: [PATCH 061/235] add contents to Language.Ruby.AST --- semantic-ruby/src/Language/Ruby/AST.hs | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/semantic-ruby/src/Language/Ruby/AST.hs b/semantic-ruby/src/Language/Ruby/AST.hs index efe3632a4..ccf4bb8f0 100644 --- a/semantic-ruby/src/Language/Ruby/AST.hs +++ b/semantic-ruby/src/Language/Ruby/AST.hs @@ -1 +1,21 @@ -module Language.Ruby.AST () where \ No newline at end of file +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} + +module Language.Ruby.AST +( module Language.Ruby.AST +) where + +import Prelude hiding (False, Float, Integer, Rational, String, True) +import TreeSitter.GenerateSyntax +import qualified TreeSitter.Ruby as Grammar + +astDeclarationsForLanguage Grammar.tree_sitter_ruby "../../vendor/tree-sitter-ruby/src/node-types.json" \ No newline at end of file From ae7021efd4201a2e1fdcfbfaa8d12763e9be4bdf Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 15:56:25 -0500 Subject: [PATCH 062/235] create submodule for ruby AST --- .gitmodules | 3 +++ semantic-ruby/vendor/tree-sitter-ruby | 1 + 2 files changed, 4 insertions(+) create mode 160000 semantic-ruby/vendor/tree-sitter-ruby diff --git a/.gitmodules b/.gitmodules index d982edbd2..8a5c7f724 100644 --- a/.gitmodules +++ b/.gitmodules @@ -10,3 +10,6 @@ [submodule "semantic-go/vendor/tree-sitter-go"] path = semantic-go/vendor/tree-sitter-go url = https://github.com/tree-sitter/tree-sitter-go.git +[submodule "semantic-ruby/vendor/tree-sitter-ruby"] + path = semantic-ruby/vendor/tree-sitter-ruby + url = https://github.com/tree-sitter/tree-sitter-ruby.git diff --git a/semantic-ruby/vendor/tree-sitter-ruby b/semantic-ruby/vendor/tree-sitter-ruby new file mode 160000 index 000000000..eb2b6225b --- /dev/null +++ b/semantic-ruby/vendor/tree-sitter-ruby @@ -0,0 +1 @@ +Subproject commit eb2b6225bfb80010f2e4cbd27db8c6f3775230b5 From 38989b98c48217e9e1b31e4a2f8307a3eadddb8f Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 15:57:02 -0500 Subject: [PATCH 063/235] add ../ to Language.Ruby.AST --- semantic-ruby/src/Language/Ruby/AST.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic-ruby/src/Language/Ruby/AST.hs b/semantic-ruby/src/Language/Ruby/AST.hs index ccf4bb8f0..7b006f80c 100644 --- a/semantic-ruby/src/Language/Ruby/AST.hs +++ b/semantic-ruby/src/Language/Ruby/AST.hs @@ -18,4 +18,4 @@ import Prelude hiding (False, Float, Integer, Rational, String, True) import TreeSitter.GenerateSyntax import qualified TreeSitter.Ruby as Grammar -astDeclarationsForLanguage Grammar.tree_sitter_ruby "../../vendor/tree-sitter-ruby/src/node-types.json" \ No newline at end of file +astDeclarationsForLanguage Grammar.tree_sitter_ruby "../../../vendor/tree-sitter-ruby/src/node-types.json" \ No newline at end of file From d553f46586bb7b8f1830d2f4b12fe7dd5f15f99a Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 15:59:03 -0500 Subject: [PATCH 064/235] Replace TreeSitter.Ruby.AST with Language.Ruby.AST --- semantic-ruby/src/Language/Ruby.hs | 2 +- semantic-ruby/src/Language/Ruby/Tags.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/semantic-ruby/src/Language/Ruby.hs b/semantic-ruby/src/Language/Ruby.hs index 06c1b0dc8..d9926d074 100644 --- a/semantic-ruby/src/Language/Ruby.hs +++ b/semantic-ruby/src/Language/Ruby.hs @@ -9,10 +9,10 @@ module Language.Ruby import Control.Carrier.State.Strict import Data.Proxy import Data.Text (Text) +import qualified Language.Ruby.AST as Rb import qualified Language.Ruby.Tags as RbTags import qualified Tags.Tagging.Precise as Tags import qualified TreeSitter.Ruby (tree_sitter_ruby) -import qualified TreeSitter.Ruby.AST as Rb import qualified TreeSitter.Unmarshal as TS newtype Term a = Term { getTerm :: Rb.Program a } diff --git a/semantic-ruby/src/Language/Ruby/Tags.hs b/semantic-ruby/src/Language/Ruby/Tags.hs index 3fe1cbe41..88d09a2aa 100644 --- a/semantic-ruby/src/Language/Ruby/Tags.hs +++ b/semantic-ruby/src/Language/Ruby/Tags.hs @@ -19,12 +19,12 @@ import Control.Monad import Data.Foldable import Data.Text as Text import GHC.Generics +import qualified Language.Ruby.AST as Rb import Source.Loc import Source.Range as Range import Source.Source as Source import Tags.Tag import qualified Tags.Tagging.Precise as Tags -import qualified TreeSitter.Ruby.AST as Rb import TreeSitter.Token import qualified TreeSitter.Unmarshal as TS From 8cf1da829ace9898c01cefecd0c0e12ce1c2b138 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 16:04:16 -0500 Subject: [PATCH 065/235] Create AST.hs --- semantic-typescript/src/Language/TypeScript/AST.hs | 1 + 1 file changed, 1 insertion(+) create mode 100644 semantic-typescript/src/Language/TypeScript/AST.hs diff --git a/semantic-typescript/src/Language/TypeScript/AST.hs b/semantic-typescript/src/Language/TypeScript/AST.hs new file mode 100644 index 000000000..169854a43 --- /dev/null +++ b/semantic-typescript/src/Language/TypeScript/AST.hs @@ -0,0 +1 @@ +module Language.TypeScript.AST () where \ No newline at end of file From beb8f2ff6fd85c08d8c23328f3d48ebaaf0b7a49 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 16:04:21 -0500 Subject: [PATCH 066/235] Update semantic-typescript.cabal --- semantic-typescript/semantic-typescript.cabal | 2 ++ 1 file changed, 2 insertions(+) diff --git a/semantic-typescript/semantic-typescript.cabal b/semantic-typescript/semantic-typescript.cabal index 66042abd9..d317de126 100644 --- a/semantic-typescript/semantic-typescript.cabal +++ b/semantic-typescript/semantic-typescript.cabal @@ -27,6 +27,7 @@ common haskell , semantic-core ^>= 0.0 , semantic-source ^>= 0.0.1 , semantic-tags ^>= 0.0 + , template-haskell ^>= 2.15 , text ^>= 1.2.3 , tree-sitter ^>= 0.8 , tree-sitter-typescript ^>= 0.4.1 @@ -50,5 +51,6 @@ library import: haskell exposed-modules: Language.TypeScript + Language.TypeScript.AST Language.TypeScript.Tags hs-source-dirs: src From 7496c67128e3d72322241c4b2fe6fedd54493b57 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 16:06:35 -0500 Subject: [PATCH 067/235] add contents to Language.TypeScript.AST --- .../src/Language/TypeScript/AST.hs | 22 ++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/semantic-typescript/src/Language/TypeScript/AST.hs b/semantic-typescript/src/Language/TypeScript/AST.hs index 169854a43..731df756e 100644 --- a/semantic-typescript/src/Language/TypeScript/AST.hs +++ b/semantic-typescript/src/Language/TypeScript/AST.hs @@ -1 +1,21 @@ -module Language.TypeScript.AST () where \ No newline at end of file +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} + +module Language.TypeScript.AST +( module Language.TypeScript.AST +) where + +import Prelude hiding (False, Float, Integer, String, True) +import TreeSitter.GenerateSyntax +import qualified TreeSitter.TypeScript as Grammar + +astDeclarationsForLanguage Grammar.tree_sitter_typescript "../../../vendor/tree-sitter-typescript/typescript/src/node-types.json" From 87b200d3d23b5d953837a994690af334fa5f865a Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 16:06:52 -0500 Subject: [PATCH 068/235] create submodule for typescript AST --- .gitmodules | 3 +++ semantic-typescript/vendor/tree-sitter-typescript | 1 + 2 files changed, 4 insertions(+) create mode 160000 semantic-typescript/vendor/tree-sitter-typescript diff --git a/.gitmodules b/.gitmodules index 8a5c7f724..58866a3c9 100644 --- a/.gitmodules +++ b/.gitmodules @@ -13,3 +13,6 @@ [submodule "semantic-ruby/vendor/tree-sitter-ruby"] path = semantic-ruby/vendor/tree-sitter-ruby url = https://github.com/tree-sitter/tree-sitter-ruby.git +[submodule "semantic-typescript/vendor/tree-sitter-typescript"] + path = semantic-typescript/vendor/tree-sitter-typescript + url = https://github.com/tree-sitter/tree-sitter-typescript.git diff --git a/semantic-typescript/vendor/tree-sitter-typescript b/semantic-typescript/vendor/tree-sitter-typescript new file mode 160000 index 000000000..40320d8e0 --- /dev/null +++ b/semantic-typescript/vendor/tree-sitter-typescript @@ -0,0 +1 @@ +Subproject commit 40320d8e0953db5e173e6dfbb596d375a085ca65 From 3d559796c04888f26dc25b561c25e086d2f42f3e Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 16:11:40 -0500 Subject: [PATCH 069/235] change TreeSitter.TypeScript.AST to Language.TypeScript.AST --- semantic-typescript/src/Language/TypeScript.hs | 2 +- semantic-typescript/src/Language/TypeScript/Tags.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/semantic-typescript/src/Language/TypeScript.hs b/semantic-typescript/src/Language/TypeScript.hs index 13989839e..7da01f376 100644 --- a/semantic-typescript/src/Language/TypeScript.hs +++ b/semantic-typescript/src/Language/TypeScript.hs @@ -6,10 +6,10 @@ module Language.TypeScript ) where import Data.Proxy +import qualified Language.TypeScript.AST as TypeScript import qualified Language.TypeScript.Tags as TsTags import qualified Tags.Tagging.Precise as Tags import qualified TreeSitter.TypeScript (tree_sitter_typescript) -import qualified TreeSitter.TypeScript.AST as TypeScript import qualified TreeSitter.Unmarshal as TS newtype Term a = Term { getTerm :: TypeScript.Program a } diff --git a/semantic-typescript/src/Language/TypeScript/Tags.hs b/semantic-typescript/src/Language/TypeScript/Tags.hs index 0f5fea56c..e96e90167 100644 --- a/semantic-typescript/src/Language/TypeScript/Tags.hs +++ b/semantic-typescript/src/Language/TypeScript/Tags.hs @@ -15,12 +15,12 @@ import Control.Effect.Writer import Data.Foldable import Data.Text as Text import GHC.Generics +import qualified Language.TypeScript.AST as Ts import Source.Loc import Source.Source as Source import Tags.Tag import qualified Tags.Tagging.Precise as Tags import TreeSitter.Token -import qualified TreeSitter.TypeScript.AST as Ts class ToTags t where tags From f48c90cc143b5de4111848963528c2aaba35c9eb Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 16:13:17 -0500 Subject: [PATCH 070/235] Create AST.hs --- semantic-tsx/src/Language/TSX/AST.hs | 1 + 1 file changed, 1 insertion(+) create mode 100644 semantic-tsx/src/Language/TSX/AST.hs diff --git a/semantic-tsx/src/Language/TSX/AST.hs b/semantic-tsx/src/Language/TSX/AST.hs new file mode 100644 index 000000000..538dab5ae --- /dev/null +++ b/semantic-tsx/src/Language/TSX/AST.hs @@ -0,0 +1 @@ +module Language.TSX.AST () where \ No newline at end of file From 2d135bcef4abd13b9636da9bd997be7cf1168d28 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 16:13:20 -0500 Subject: [PATCH 071/235] Update semantic-tsx.cabal --- semantic-tsx/semantic-tsx.cabal | 2 ++ 1 file changed, 2 insertions(+) diff --git a/semantic-tsx/semantic-tsx.cabal b/semantic-tsx/semantic-tsx.cabal index e54353df0..fb7f39090 100644 --- a/semantic-tsx/semantic-tsx.cabal +++ b/semantic-tsx/semantic-tsx.cabal @@ -27,6 +27,7 @@ common haskell , semantic-core ^>= 0.0 , semantic-source ^>= 0.0.1 , semantic-tags ^>= 0.0 + , template-haskell ^>= 2.15 , text ^>= 1.2.3 , tree-sitter ^>= 0.8 , tree-sitter-tsx ^>= 0.4.1 @@ -50,5 +51,6 @@ library import: haskell exposed-modules: Language.TSX + Language.TSX.AST Language.TSX.Tags hs-source-dirs: src From 177ed479ced86729bd7795067f5271f7e9a88f05 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 16:14:20 -0500 Subject: [PATCH 072/235] add contents to Language.TSX.AST --- semantic-tsx/src/Language/TSX/AST.hs | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/semantic-tsx/src/Language/TSX/AST.hs b/semantic-tsx/src/Language/TSX/AST.hs index 538dab5ae..e7511382e 100644 --- a/semantic-tsx/src/Language/TSX/AST.hs +++ b/semantic-tsx/src/Language/TSX/AST.hs @@ -1 +1,21 @@ -module Language.TSX.AST () where \ No newline at end of file +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} + +module Language.TSX.AST +( module Language.TSX.AST +) where + +import Prelude hiding (False, Float, Integer, String, True) +import TreeSitter.GenerateSyntax +import qualified TreeSitter.TSX as Grammar + +astDeclarationsForLanguage Grammar.tree_sitter_tsx "../../../vendor/tree-sitter-typescript/tsx/src/node-types.json" \ No newline at end of file From 795feea890dc9d6b1c810becd09fb77ef709377c Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 16:28:42 -0500 Subject: [PATCH 073/235] Language not TreeSitter for TSX --- semantic-tsx/src/Language/TSX.hs | 2 +- semantic-tsx/src/Language/TSX/Tags.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/semantic-tsx/src/Language/TSX.hs b/semantic-tsx/src/Language/TSX.hs index 2a439c54a..5e645892d 100644 --- a/semantic-tsx/src/Language/TSX.hs +++ b/semantic-tsx/src/Language/TSX.hs @@ -6,10 +6,10 @@ module Language.TSX ) where import Data.Proxy +import qualified Language.TSX.AST as TSX import qualified Language.TSX.Tags as TsxTags import qualified Tags.Tagging.Precise as Tags import qualified TreeSitter.TSX (tree_sitter_tsx) -import qualified TreeSitter.TSX.AST as TSX import qualified TreeSitter.Unmarshal as TS newtype Term a = Term { getTerm :: TSX.Program a } diff --git a/semantic-tsx/src/Language/TSX/Tags.hs b/semantic-tsx/src/Language/TSX/Tags.hs index e063acfd7..b1442fa1a 100644 --- a/semantic-tsx/src/Language/TSX/Tags.hs +++ b/semantic-tsx/src/Language/TSX/Tags.hs @@ -15,12 +15,12 @@ import Control.Effect.Writer import Data.Foldable import Data.Text as Text import GHC.Generics +import qualified Language.TSX.AST as Tsx import Source.Loc import Source.Source as Source import Tags.Tag import qualified Tags.Tagging.Precise as Tags import TreeSitter.Token -import qualified TreeSitter.TSX.AST as Tsx class ToTags t where tags From 1ce8cdc539a43ef87498002ee2378a5de074d18e Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 16:29:04 -0500 Subject: [PATCH 074/235] create submodule for tsx AST --- .gitmodules | 3 +++ languages/tsx/vendor/tree-sitter-typescript | 1 + 2 files changed, 4 insertions(+) create mode 160000 languages/tsx/vendor/tree-sitter-typescript diff --git a/.gitmodules b/.gitmodules index 58866a3c9..e375dba8a 100644 --- a/.gitmodules +++ b/.gitmodules @@ -16,3 +16,6 @@ [submodule "semantic-typescript/vendor/tree-sitter-typescript"] path = semantic-typescript/vendor/tree-sitter-typescript url = https://github.com/tree-sitter/tree-sitter-typescript.git +[submodule "languages/tsx/vendor/tree-sitter-typescript"] + path = languages/tsx/vendor/tree-sitter-typescript + url = https://github.com/tree-sitter/tree-sitter-typescript.git diff --git a/languages/tsx/vendor/tree-sitter-typescript b/languages/tsx/vendor/tree-sitter-typescript new file mode 160000 index 000000000..40320d8e0 --- /dev/null +++ b/languages/tsx/vendor/tree-sitter-typescript @@ -0,0 +1 @@ +Subproject commit 40320d8e0953db5e173e6dfbb596d375a085ca65 From 8f818c4bfea14d3ce9efe6394f8ef74aceba1d9c Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 17:11:29 -0500 Subject: [PATCH 075/235] fix submodule mess --- .gitmodules | 4 ++-- languages/tsx/vendor/tree-sitter-typescript | 1 - semantic-tsx/vendor/tree-sitter-typescript | 1 + 3 files changed, 3 insertions(+), 3 deletions(-) delete mode 160000 languages/tsx/vendor/tree-sitter-typescript create mode 160000 semantic-tsx/vendor/tree-sitter-typescript diff --git a/.gitmodules b/.gitmodules index e375dba8a..bd49d21d1 100644 --- a/.gitmodules +++ b/.gitmodules @@ -16,6 +16,6 @@ [submodule "semantic-typescript/vendor/tree-sitter-typescript"] path = semantic-typescript/vendor/tree-sitter-typescript url = https://github.com/tree-sitter/tree-sitter-typescript.git -[submodule "languages/tsx/vendor/tree-sitter-typescript"] - path = languages/tsx/vendor/tree-sitter-typescript +[submodule "semantic-tsx/vendor/tree-sitter-typescript"] + path = semantic-tsx/vendor/tree-sitter-typescript url = https://github.com/tree-sitter/tree-sitter-typescript.git diff --git a/languages/tsx/vendor/tree-sitter-typescript b/languages/tsx/vendor/tree-sitter-typescript deleted file mode 160000 index 40320d8e0..000000000 --- a/languages/tsx/vendor/tree-sitter-typescript +++ /dev/null @@ -1 +0,0 @@ -Subproject commit 40320d8e0953db5e173e6dfbb596d375a085ca65 diff --git a/semantic-tsx/vendor/tree-sitter-typescript b/semantic-tsx/vendor/tree-sitter-typescript new file mode 160000 index 000000000..aa950f58e --- /dev/null +++ b/semantic-tsx/vendor/tree-sitter-typescript @@ -0,0 +1 @@ +Subproject commit aa950f58ea8aa112bc72f3481b98fc2d3c07b3e0 From a8c227102b3736e20fd92fc3298bed8775d8e624 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 19:12:40 -0500 Subject: [PATCH 076/235] Create Deserialize.hs --- semantic-ast/src/AST/Deserialize.hs | 1 + 1 file changed, 1 insertion(+) create mode 100644 semantic-ast/src/AST/Deserialize.hs diff --git a/semantic-ast/src/AST/Deserialize.hs b/semantic-ast/src/AST/Deserialize.hs new file mode 100644 index 000000000..ecb7a8b27 --- /dev/null +++ b/semantic-ast/src/AST/Deserialize.hs @@ -0,0 +1 @@ +module Deserialize () where \ No newline at end of file From 131699fd66096a2abe3d567947671d03c3d70a11 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 19:12:42 -0500 Subject: [PATCH 077/235] Create GenerateSyntax.hs --- semantic-ast/src/AST/GenerateSyntax.hs | 1 + 1 file changed, 1 insertion(+) create mode 100644 semantic-ast/src/AST/GenerateSyntax.hs diff --git a/semantic-ast/src/AST/GenerateSyntax.hs b/semantic-ast/src/AST/GenerateSyntax.hs new file mode 100644 index 000000000..c5d2b6d25 --- /dev/null +++ b/semantic-ast/src/AST/GenerateSyntax.hs @@ -0,0 +1 @@ +module GenerateSyntax () where \ No newline at end of file From 978b39c3eaec66ad47744187d749e746decc523f Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 19:12:45 -0500 Subject: [PATCH 078/235] Create Token.hs --- semantic-ast/src/AST/Token.hs | 1 + 1 file changed, 1 insertion(+) create mode 100644 semantic-ast/src/AST/Token.hs diff --git a/semantic-ast/src/AST/Token.hs b/semantic-ast/src/AST/Token.hs new file mode 100644 index 000000000..4725c3271 --- /dev/null +++ b/semantic-ast/src/AST/Token.hs @@ -0,0 +1 @@ +module Token () where \ No newline at end of file From 90f275acd101dc33a344086384ff27c648d6ad99 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 19:12:47 -0500 Subject: [PATCH 079/235] Create Unmarshal.hs --- semantic-ast/src/AST/Unmarshal.hs | 1 + 1 file changed, 1 insertion(+) create mode 100644 semantic-ast/src/AST/Unmarshal.hs diff --git a/semantic-ast/src/AST/Unmarshal.hs b/semantic-ast/src/AST/Unmarshal.hs new file mode 100644 index 000000000..da2ece926 --- /dev/null +++ b/semantic-ast/src/AST/Unmarshal.hs @@ -0,0 +1 @@ +module Unmarshal () where \ No newline at end of file From ad506fc3701f347caeda58abefe12d1538838d67 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 19:13:21 -0500 Subject: [PATCH 080/235] expose AST modules --- semantic-ast/semantic-ast.cabal | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/semantic-ast/semantic-ast.cabal b/semantic-ast/semantic-ast.cabal index 97546ab5c..a5cae5e84 100644 --- a/semantic-ast/semantic-ast.cabal +++ b/semantic-ast/semantic-ast.cabal @@ -38,6 +38,10 @@ common haskell library import: haskell exposed-modules: Marshal.JSON + AST.Deserialize + AST.GenerateSyntax + AST.Token + AST.Unmarshal -- other-modules: -- other-extensions: From f0f88c4e480b2a4848c9c778f87ce9f365b52449 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 19:13:31 -0500 Subject: [PATCH 081/235] Update semantic-ast.cabal --- semantic-ast/semantic-ast.cabal | 26 ++++++++++++++++++-------- 1 file changed, 18 insertions(+), 8 deletions(-) diff --git a/semantic-ast/semantic-ast.cabal b/semantic-ast/semantic-ast.cabal index a5cae5e84..223b21166 100644 --- a/semantic-ast/semantic-ast.cabal +++ b/semantic-ast/semantic-ast.cabal @@ -46,16 +46,22 @@ library -- other-modules: -- other-extensions: build-depends: base ^>= 4.13 - , tree-sitter ^>= 0.8 - , semantic-source ^>= 0.0.1 - , tree-sitter-python ^>= 0.8.1 - , bytestring ^>= 0.10.8.2 - , optparse-applicative >= 0.14.3 && < 0.16 - , pretty-simple ^>= 3.1.0.0 , aeson ^>= 1.4.2.0 - , text ^>= 1.2.3.1 - , bytestring ^>= 0.10.8.2 , aeson-pretty ^>= 0.8.8 + , bytestring ^>= 0.10.8.2 + , tree-sitter ^>= 0.8 + , semantic-source ^>= 0.0.1 + , template-haskell ^>= 2.15 + , tree-sitter-python ^>= 0.8.1 + , bytestring ^>= 0.10.8.2 + , optparse-applicative >= 0.14.3 && < 0.16 + , pretty-simple ^>= 3.1.0.0 + , text ^>= 1.2.3.1 + , unordered-containers ^>= 0.2.10 + , containers >= 0.6.0.1 + , text ^>= 1.2.3.1 + , filepath ^>= 1.4.1 + hs-source-dirs: src default-language: Haskell2010 @@ -77,5 +83,9 @@ executable semantic-ast , bytestring , aeson-pretty , semantic-python + , text + , unordered-containers + , containers + , filepath hs-source-dirs: app default-language: Haskell2010 From be28836c258e61770116cbc71aa3b9d188c908f1 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 19:21:33 -0500 Subject: [PATCH 082/235] add contents to Deserialize --- semantic-ast/src/AST/Deserialize.hs | 134 +++++++++++++++++++++++++++- 1 file changed, 133 insertions(+), 1 deletion(-) diff --git a/semantic-ast/src/AST/Deserialize.hs b/semantic-ast/src/AST/Deserialize.hs index ecb7a8b27..f808f7d9b 100644 --- a/semantic-ast/src/AST/Deserialize.hs +++ b/semantic-ast/src/AST/Deserialize.hs @@ -1 +1,133 @@ -module Deserialize () where \ No newline at end of file +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveLift #-} + +-- Turn off partial field warnings for Datatype. +{-# OPTIONS_GHC -Wno-partial-fields #-} +module AST.Deserialize +( Datatype (..) +, Field (..) +, Children(..) +, Required (..) +, Type (..) +, DatatypeName (..) +, Named (..) +, Multiple (..) +) where + +import Data.Aeson as Aeson +import Data.Aeson.Types +import Data.Char +import GHC.Generics hiding (Constructor, Datatype) +import Language.Haskell.TH.Syntax (Lift) +import Data.Text (Text, unpack) +import Data.List.NonEmpty (NonEmpty (..)) +import qualified Data.HashMap.Strict as HM +import Data.Maybe (fromMaybe) + +-- Types to deserialize into: +data Datatype + = SumType + { datatypeName :: DatatypeName + , datatypeNameStatus :: Named + , datatypeSubtypes :: NonEmpty Type + } + | ProductType + { datatypeName :: DatatypeName + , datatypeNameStatus :: Named + , datatypeChildren :: Maybe Children + , datatypeFields :: [(String, Field)] + } + | LeafType + { datatypeName :: DatatypeName + , datatypeNameStatus :: Named + } + deriving (Eq, Ord, Show, Generic, ToJSON) + +instance FromJSON Datatype where + parseJSON = withObject "Datatype" $ \v -> do + type' <- v .: "type" + named <- v .: "named" + subtypes <- v .:? "subtypes" + case subtypes of + Nothing -> do + fields <- fmap (fromMaybe HM.empty) (v .:? "fields") + children <- v .:? "children" + if null fields && null children then + pure (LeafType type' named) + else + ProductType type' named children <$> parseKVPairs (HM.toList fields) + Just subtypes -> pure (SumType type' named subtypes) + + +-- | Transforms list of key-value pairs to a Parser +parseKVPairs :: [(Text, Value)] -> Parser [(String, Field)] +parseKVPairs = traverse go + where go :: (Text, Value) -> Parser (String, Field) + go (t,v) = do + v' <- parseJSON v + pure (unpack t, v') + +data Field = MkField + { fieldRequired :: Required + , fieldTypes :: NonEmpty Type + , fieldMultiple :: Multiple + } + deriving (Eq, Ord, Show, Generic, ToJSON) + +instance FromJSON Field where + parseJSON = genericParseJSON customOptions + + +newtype Children = MkChildren Field + deriving (Eq, Ord, Show, Generic) + deriving newtype (ToJSON, FromJSON) + + +data Required = Optional | Required + deriving (Eq, Ord, Show, Generic, ToJSON) + +instance FromJSON Required where + parseJSON = withBool "Required" (\p -> pure (if p then Required else Optional)) + +data Type = MkType + { fieldType :: DatatypeName + , isNamed :: Named + } + deriving (Eq, Ord, Show, Generic, ToJSON) + +instance FromJSON Type where + parseJSON = genericParseJSON customOptions + +newtype DatatypeName = DatatypeName { getDatatypeName :: String } + deriving (Eq, Ord, Show, Generic) + deriving newtype (FromJSON, ToJSON) + +data Named = Anonymous | Named + deriving (Eq, Ord, Show, Generic, ToJSON, Lift) + +instance FromJSON Named where + parseJSON = withBool "Named" (\p -> pure (if p then Named else Anonymous)) + +data Multiple = Single | Multiple + deriving (Eq, Ord, Show, Generic, ToJSON) + +instance FromJSON Multiple where + parseJSON = withBool "Multiple" (\p -> pure (if p then Multiple else Single)) + +customOptions :: Aeson.Options +customOptions = Aeson.defaultOptions + { + fieldLabelModifier = initLower . dropPrefix + , constructorTagModifier = initLower + } + +dropPrefix :: String -> String +dropPrefix = Prelude.dropWhile isLower + +initLower :: String -> String +initLower (c:cs) = toLower c : cs +initLower "" = "" \ No newline at end of file From 3e2549105335cb444350d8135f5c47b54928184d Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 19:21:41 -0500 Subject: [PATCH 083/235] add contents to GenerateSyntax --- semantic-ast/src/AST/GenerateSyntax.hs | 187 ++++++++++++++++++++++++- 1 file changed, 186 insertions(+), 1 deletion(-) diff --git a/semantic-ast/src/AST/GenerateSyntax.hs b/semantic-ast/src/AST/GenerateSyntax.hs index c5d2b6d25..11dd92c08 100644 --- a/semantic-ast/src/AST/GenerateSyntax.hs +++ b/semantic-ast/src/AST/GenerateSyntax.hs @@ -1 +1,186 @@ -module GenerateSyntax () where \ No newline at end of file +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +module AST.GenerateSyntax +( syntaxDatatype +, astDeclarationsForLanguage +) where + +import Data.Aeson hiding (String) +import Data.Foldable +import Data.List +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Text (Text) +import Foreign.C.String +import Foreign.Ptr +import GHC.Generics hiding (Constructor, Datatype) +import GHC.Records +import Language.Haskell.TH as TH +import Language.Haskell.TH.Syntax as TH +import System.Directory +import System.FilePath.Posix +import AST.Deserialize (Children (..), Datatype (..), DatatypeName (..), Field (..), Multiple (..), Named (..), Required (..), Type (..)) +import qualified TreeSitter.Language as TS +import TreeSitter.Node +import TreeSitter.Symbol (TSSymbol, toHaskellCamelCaseIdentifier, toHaskellPascalCaseIdentifier) +import AST.Token +import qualified AST.Unmarshal as TS + +-- | Derive Haskell datatypes from a language and its @node-types.json@ file. +-- +-- Datatypes will be generated according to the specification in the @node-types.json@ file, with anonymous leaf types defined as synonyms for the 'Token' datatype. +-- +-- Any datatypes among the node types which have already been defined in the module where the splice is run will be skipped, allowing customization of the representation of parts of the tree. Note that this should be used sparingly, as it imposes extra maintenance burden, particularly when the grammar is changed. This may be used to e.g. parse literals into Haskell equivalents (e.g. parsing the textual contents of integer literals into 'Integer's), and may require defining 'TS.UnmarshalAnn' or 'TS.SymbolMatching' instances for (parts of) the custom datatypes, depending on where and how the datatype occurs in the generated tree, in addition to the usual 'Foldable', 'Functor', etc. instances provided for generated datatypes. +astDeclarationsForLanguage :: Ptr TS.Language -> FilePath -> Q [Dec] +astDeclarationsForLanguage language filePath = do + _ <- TS.addDependentFileRelative filePath + currentFilename <- loc_filename <$> location + pwd <- runIO getCurrentDirectory + let invocationRelativePath = takeDirectory (pwd currentFilename) filePath + input <- runIO (eitherDecodeFileStrict' invocationRelativePath) >>= either fail pure + allSymbols <- runIO (getAllSymbols language) + debugSymbolNames <- [d| + debugSymbolNames :: [String] + debugSymbolNames = $(listE (map (litE . stringL . debugPrefix) allSymbols)) + |] + (debugSymbolNames <>) . concat @[] <$> traverse (syntaxDatatype language allSymbols) input + +-- Build a list of all symbols +getAllSymbols :: Ptr TS.Language -> IO [(String, Named)] +getAllSymbols language = do + count <- TS.ts_language_symbol_count language + mapM getSymbol [(0 :: TSSymbol) .. fromIntegral (pred count)] + where + getSymbol i = do + cname <- TS.ts_language_symbol_name language i + n <- peekCString cname + t <- TS.ts_language_symbol_type language i + let named = if t == 0 then Named else Anonymous + pure (n, named) + +-- Auto-generate Haskell datatypes for sums, products and leaf types +syntaxDatatype :: Ptr TS.Language -> [(String, Named)] -> Datatype -> Q [Dec] +syntaxDatatype language allSymbols datatype = skipDefined $ do + typeParameterName <- newName "a" + case datatype of + SumType (DatatypeName _) _ subtypes -> do + types' <- fieldTypesToNestedSum subtypes + let fieldName = mkName ("get" <> nameStr) + con <- recC name [TH.varBangType fieldName (TH.bangType strictness (pure types' `appT` varT typeParameterName))] + hasFieldInstance <- makeHasFieldInstance (conT name) (varT typeParameterName) (varE fieldName) + pure + ( NewtypeD [] name [PlainTV typeParameterName] Nothing con [deriveGN, deriveStockClause, deriveAnyClassClause] + : hasFieldInstance) + ProductType (DatatypeName datatypeName) named children fields -> do + con <- ctorForProductType datatypeName typeParameterName children fields + result <- symbolMatchingInstance allSymbols name named datatypeName + pure $ generatedDatatype name [con] typeParameterName:result + -- Anonymous leaf types are defined as synonyms for the `Token` datatype + LeafType (DatatypeName datatypeName) Anonymous -> do + tsSymbol <- runIO $ withCStringLen datatypeName (\(s, len) -> TS.ts_language_symbol_for_name language s len False) + pure [ TySynD name [] (ConT ''Token `AppT` LitT (StrTyLit datatypeName) `AppT` LitT (NumTyLit (fromIntegral tsSymbol))) ] + LeafType (DatatypeName datatypeName) Named -> do + con <- ctorForLeafType (DatatypeName datatypeName) typeParameterName + result <- symbolMatchingInstance allSymbols name Named datatypeName + pure $ generatedDatatype name [con] typeParameterName:result + where + -- Skip generating datatypes that have already been defined (overridden) in the module where the splice is running. + skipDefined m = do + isLocal <- lookupTypeName nameStr >>= maybe (pure False) isLocalName + if isLocal then pure [] else m + name = mkName nameStr + nameStr = toNameString (datatypeNameStatus datatype) (getDatatypeName (AST.Deserialize.datatypeName datatype)) + deriveStockClause = DerivClause (Just StockStrategy) [ ConT ''Eq, ConT ''Ord, ConT ''Show, ConT ''Generic, ConT ''Foldable, ConT ''Functor, ConT ''Traversable, ConT ''Generic1] + deriveAnyClassClause = DerivClause (Just AnyclassStrategy) [ConT ''TS.Unmarshal] + deriveGN = DerivClause (Just NewtypeStrategy) [ConT ''TS.SymbolMatching] + generatedDatatype name cons typeParameterName = DataD [] name [PlainTV typeParameterName] Nothing cons [deriveStockClause, deriveAnyClassClause] + + +makeHasFieldInstance :: TypeQ -> TypeQ -> ExpQ -> Q [Dec] +makeHasFieldInstance ty param elim = + [d|instance HasField "ann" $(ty `appT` param) $param where + getField = TS.gann . $elim |] + +-- | Create TH-generated SymbolMatching instances for sums, products, leaves +symbolMatchingInstance :: [(String, Named)] -> Name -> Named -> String -> Q [Dec] +symbolMatchingInstance allSymbols name named str = do + let tsSymbols = elemIndices (str, named) allSymbols + names = intercalate ", " $ fmap (debugPrefix . (!!) allSymbols) tsSymbols + [d|instance TS.SymbolMatching $(conT name) where + matchedSymbols _ = tsSymbols + showFailure _ node = "expected " <> $(litE (stringL names)) + <> " but got " <> if nodeSymbol node == 65535 then "ERROR" else genericIndex debugSymbolNames (nodeSymbol node) + <> " [" <> show r1 <> ", " <> show c1 <> "] -" + <> " [" <> show r2 <> ", " <> show c2 <> "]" + where TSPoint r1 c1 = nodeStartPoint node + TSPoint r2 c2 = nodeEndPoint node|] + +-- | Prefix symbol names for debugging to disambiguate between Named and Anonymous nodes. +debugPrefix :: (String, Named) -> String +debugPrefix (name, Named) = name +debugPrefix (name, Anonymous) = "_" <> name + +-- | Build Q Constructor for product types (nodes with fields) +ctorForProductType :: String -> Name -> Maybe Children -> [(String, Field)] -> Q Con +ctorForProductType constructorName typeParameterName children fields = ctorForTypes constructorName lists where + lists = annotation : fieldList ++ childList + annotation = ("ann", varT typeParameterName) + fieldList = map (fmap toType) fields + childList = toList $ fmap toTypeChild children + toType (MkField required fieldTypes mult) = + let ftypes = fieldTypesToNestedSum fieldTypes `appT` varT typeParameterName + in case (required, mult) of + (Required, Multiple) -> appT (conT ''NonEmpty) ftypes + (Required, Single) -> ftypes + (Optional, Multiple) -> appT (conT ''[]) ftypes + (Optional, Single) -> appT (conT ''Maybe) ftypes + toTypeChild (MkChildren field) = ("extra_children", toType field) + +-- | Build Q Constructor for leaf types (nodes with no fields or subtypes) +ctorForLeafType :: DatatypeName -> Name -> Q Con +ctorForLeafType (DatatypeName name) typeParameterName = ctorForTypes name + [ ("ann", varT typeParameterName) -- ann :: a + , ("text", conT ''Text) -- text :: Text + ] + +-- | Build Q Constructor for records +ctorForTypes :: String -> [(String, Q TH.Type)] -> Q Con +ctorForTypes constructorName types = recC (toName Named constructorName) recordFields where + recordFields = map (uncurry toVarBangType) types + toVarBangType str type' = TH.varBangType (mkName . toHaskellCamelCaseIdentifier $ str) (TH.bangType strictness type') + + +-- | Convert field types to Q types +fieldTypesToNestedSum :: NonEmpty AST.Deserialize.Type -> Q TH.Type +fieldTypesToNestedSum xs = go (toList xs) + where + combine lhs rhs = (conT ''(:+:) `appT` lhs) `appT` rhs -- (((((a :+: b) :+: c) :+: d)) :+: e) ((a :+: b) :+: (c :+: d)) + convertToQType (MkType (DatatypeName n) named) = conT (toName named n) + go [x] = convertToQType x + go xs = let (l,r) = splitAt (length xs `div` 2) xs in combine (go l) (go r) + + +-- | Create bang required to build records +strictness :: BangQ +strictness = TH.bang noSourceUnpackedness noSourceStrictness + +-- | Prepend "Anonymous" to named node when false, otherwise use regular toName +toName :: Named -> String -> Name +toName named str = mkName (toNameString named str) + +toNameString :: Named -> String -> String +toNameString named str = prefix named <> toHaskellPascalCaseIdentifier str + where + prefix Anonymous = "Anonymous" + prefix Named = "" + +-- | Get the 'Module', if any, for a given 'Name'. +moduleForName :: Name -> Maybe Module +moduleForName n = Module . PkgName <$> namePackage n <*> (ModName <$> nameModule n) + +-- | Test whether the name is defined in the module where the splice is executed. +isLocalName :: Name -> Q Bool +isLocalName n = (moduleForName n ==) . Just <$> thisModule From 10a11b41adb2405dc4744ce2c52e21b20a09fb8f Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 19:21:48 -0500 Subject: [PATCH 084/235] add contents to Token --- semantic-ast/src/AST/Token.hs | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) diff --git a/semantic-ast/src/AST/Token.hs b/semantic-ast/src/AST/Token.hs index 4725c3271..7d3aa3644 100644 --- a/semantic-ast/src/AST/Token.hs +++ b/semantic-ast/src/AST/Token.hs @@ -1 +1,17 @@ -module Token () where \ No newline at end of file +{-# LANGUAGE DataKinds, DeriveGeneric, DeriveTraversable, KindSignatures #-} +module AST.Token +( Token(..) +) where + +import GHC.Generics (Generic, Generic1) +import GHC.TypeLits (Symbol, Nat) + +-- | An AST node representing a token, indexed by its name and numeric value. +-- +-- For convenience, token types are typically used via type synonyms, e.g.: +-- +-- @ +-- type AnonymousPlus = Token "+" 123 +-- @ +newtype Token (symName :: Symbol) (symVal :: Nat) a = Token { ann :: a } + deriving (Eq, Foldable, Functor, Generic, Generic1, Ord, Show, Traversable) \ No newline at end of file From 24bcd26b759d86e71382d33da466e65f18cff1b9 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 27 Jan 2020 19:21:55 -0500 Subject: [PATCH 085/235] add contents to Unmarshal --- semantic-ast/src/AST/Unmarshal.hs | 406 +++++++++++++++++++++++++++++- 1 file changed, 405 insertions(+), 1 deletion(-) diff --git a/semantic-ast/src/AST/Unmarshal.hs b/semantic-ast/src/AST/Unmarshal.hs index da2ece926..425bd8f6f 100644 --- a/semantic-ast/src/AST/Unmarshal.hs +++ b/semantic-ast/src/AST/Unmarshal.hs @@ -1 +1,405 @@ -module Unmarshal () where \ No newline at end of file +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} + +module AST.Unmarshal +( parseByteString +, UnmarshalState(..) +, UnmarshalError(..) +, FieldName(..) +, Unmarshal(..) +, UnmarshalAnn(..) +, UnmarshalField(..) +, SymbolMatching(..) +, Match(..) +, hoist +, lookupSymbol +, unmarshalNode +, GHasAnn(..) +) where + +import Control.Algebra (send) +import Control.Carrier.Reader hiding (asks) +import Control.Exception +import Control.Monad.IO.Class +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import Data.Coerce +import Data.Foldable (toList) +import qualified Data.IntMap as IntMap +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Proxy +import qualified Data.Text as Text +import Data.Text.Encoding +import Data.Text.Encoding.Error (lenientDecode) +import Foreign.C.String +import Foreign.Marshal.Array +import Foreign.Marshal.Utils +import Foreign.Ptr +import Foreign.Storable +import GHC.Generics +import GHC.Records +import GHC.TypeLits +import Source.Loc +import Source.Span +import TreeSitter.Cursor as TS +import TreeSitter.Language as TS +import TreeSitter.Node as TS +import TreeSitter.Parser as TS +import AST.Token as TS +import TreeSitter.Tree as TS + +asks :: Has (Reader r) sig m => (r -> r') -> m r' +asks f = send (Ask (pure . f)) +{-# INLINE asks #-} + +-- Parse source code and produce AST +parseByteString :: (Unmarshal t, UnmarshalAnn a) => Ptr TS.Language -> ByteString -> IO (Either String (t a)) +parseByteString language bytestring = withParser language $ \ parser -> withParseTree parser bytestring $ \ treePtr -> + if treePtr == nullPtr then + pure (Left "error: didn't get a root node") + else + withRootNode treePtr $ \ rootPtr -> + withCursor (castPtr rootPtr) $ \ cursor -> + (Right <$> runReader (UnmarshalState bytestring cursor) (liftIO (peek rootPtr) >>= unmarshalNode)) + `catch` (pure . Left . getUnmarshalError) + +newtype UnmarshalError = UnmarshalError { getUnmarshalError :: String } + deriving (Show) + +instance Exception UnmarshalError + +data UnmarshalState = UnmarshalState + { source :: {-# UNPACK #-} !ByteString + , cursor :: {-# UNPACK #-} !(Ptr Cursor) + } + +type MatchM = ReaderC UnmarshalState IO + +newtype Match t = Match + { runMatch :: forall a . UnmarshalAnn a => Node -> MatchM (t a) + } + +-- | A church-encoded binary tree with constant-time 'singleton', 'mempty', '<>', and 'fmap', and linear-time 'foldMap'. +newtype B a = B (forall r . (r -> r -> r) -> (a -> r) -> r -> r) + +instance Functor B where + fmap f (B run) = B (\ fork leaf -> run fork (leaf . f)) + {-# INLINE fmap #-} + a <$ B run = B (\ fork leaf -> run fork (leaf . const a)) + {-# INLINE (<$) #-} + +instance Semigroup (B a) where + B l <> B r = B (\ fork leaf nil -> fork (l fork leaf nil) (r fork leaf nil)) + {-# INLINE (<>) #-} + +instance Monoid (B a) where + mempty = B (\ _ _ nil -> nil) + {-# INLINE mempty #-} + +instance Foldable B where + foldMap f (B run) = run (<>) f mempty + {-# INLINE foldMap #-} + +singleton :: a -> B a +singleton a = B (\ _ leaf _ -> leaf a) +{-# INLINE singleton #-} + +hoist :: (forall x . t x -> t' x) -> Match t -> Match t' +hoist f (Match run) = Match (fmap f . run) +{-# INLINE hoist #-} + +lookupSymbol :: TSSymbol -> IntMap.IntMap a -> Maybe a +lookupSymbol sym map = IntMap.lookup (fromIntegral sym) map +{-# INLINE lookupSymbol #-} + +-- | Unmarshal a node +unmarshalNode :: forall t a . + ( UnmarshalAnn a + , Unmarshal t + ) + => Node + -> MatchM (t a) +unmarshalNode node = case lookupSymbol (nodeSymbol node) matchers' of + Just t -> runMatch t node + Nothing -> liftIO . throwIO . UnmarshalError $ showFailure (Proxy @t) node +{-# INLINE unmarshalNode #-} + +-- | Unmarshalling is the process of iterating over tree-sitter’s parse trees using its tree cursor API and producing Haskell ASTs for the relevant nodes. +-- +-- Datatypes which can be constructed from tree-sitter parse trees may use the default definition of 'matchers' providing that they have a suitable 'Generic1' instance. +class SymbolMatching t => Unmarshal t where + matchers' :: IntMap.IntMap (Match t) + matchers' = IntMap.fromList (toList matchers) + + matchers :: B (Int, Match t) + default matchers :: (Generic1 t, GUnmarshal (Rep1 t)) => B (Int, Match t) + matchers = foldMap (singleton . (, match)) (matchedSymbols (Proxy @t)) + where match = Match $ \ node -> do + cursor <- asks cursor + goto cursor (nodeTSNode node) + fmap to1 (gunmarshalNode node) + +instance (Unmarshal f, Unmarshal g) => Unmarshal (f :+: g) where + matchers = fmap (fmap (hoist L1)) matchers <> fmap (fmap (hoist R1)) matchers + +instance Unmarshal t => Unmarshal (Rec1 t) where + matchers = coerce (matchers @t) + +instance (KnownNat n, KnownSymbol sym) => Unmarshal (Token sym n) where + matchers = singleton (fromIntegral (natVal (Proxy @n)), Match (fmap Token . unmarshalAnn)) + + +-- | Unmarshal an annotation field. +-- +-- Leaf nodes have 'Text.Text' fields, and leaves, anonymous leaves, and products all have parametric annotation fields. All of these fields are unmarshalled using the metadata of the node, e.g. its start/end bytes, without reference to any child nodes it may contain. +class UnmarshalAnn a where + unmarshalAnn + :: Node + -> MatchM a + +instance UnmarshalAnn () where + unmarshalAnn _ = pure () + +instance UnmarshalAnn Text.Text where + unmarshalAnn node = do + range <- unmarshalAnn node + asks (decodeUtf8With lenientDecode . slice range . source) + +-- | Instance for pairs of annotations +instance (UnmarshalAnn a, UnmarshalAnn b) => UnmarshalAnn (a,b) where + unmarshalAnn node = (,) + <$> unmarshalAnn @a node + <*> unmarshalAnn @b node + +instance UnmarshalAnn Loc where + unmarshalAnn node = Loc + <$> unmarshalAnn @Range node + <*> unmarshalAnn @Span node + +instance UnmarshalAnn Range where + unmarshalAnn node = do + let start = fromIntegral (nodeStartByte node) + end = fromIntegral (nodeEndByte node) + pure (Range start end) + +instance UnmarshalAnn Span where + unmarshalAnn node = do + let spanStart = pointToPos (nodeStartPoint node) + spanEnd = pointToPos (nodeEndPoint node) + pure (Span spanStart spanEnd) + +pointToPos :: TSPoint -> Pos +pointToPos (TSPoint line column) = Pos (fromIntegral line) (fromIntegral column) + + +-- | Optional/repeated fields occurring in product datatypes are wrapped in type constructors, e.g. 'Maybe', '[]', or 'NonEmpty', and thus can unmarshal zero or more nodes for the same field name. +class UnmarshalField t where + unmarshalField + :: ( Unmarshal f + , UnmarshalAnn a + ) + => String -- ^ datatype name + -> String -- ^ field name + -> [Node] -- ^ nodes + -> MatchM (t (f a)) + +instance UnmarshalField Maybe where + unmarshalField _ _ [] = pure Nothing + unmarshalField _ _ [x] = Just <$> unmarshalNode x + unmarshalField d f _ = liftIO . throwIO . UnmarshalError $ "type '" <> d <> "' expected zero or one nodes in field '" <> f <> "' but got multiple" + +instance UnmarshalField [] where + unmarshalField d f (x:xs) = do + head' <- unmarshalNode x + tail' <- unmarshalField d f xs + pure $ head' : tail' + unmarshalField _ _ [] = pure [] + +instance UnmarshalField NonEmpty where + unmarshalField d f (x:xs) = do + head' <- unmarshalNode x + tail' <- unmarshalField d f xs + pure $ head' :| tail' + unmarshalField d f [] = liftIO . throwIO . UnmarshalError $ "type '" <> d <> "' expected one or more nodes in field '" <> f <> "' but got zero" + +class SymbolMatching (a :: * -> *) where + matchedSymbols :: Proxy a -> [Int] + + -- | Provide error message describing the node symbol vs. the symbols this can match + showFailure :: Proxy a -> Node -> String + +instance SymbolMatching f => SymbolMatching (M1 i c f) where + matchedSymbols _ = matchedSymbols (Proxy @f) + showFailure _ = showFailure (Proxy @f) + +instance SymbolMatching f => SymbolMatching (Rec1 f) where + matchedSymbols _ = matchedSymbols (Proxy @f) + showFailure _ = showFailure (Proxy @f) + +instance (KnownNat n, KnownSymbol sym) => SymbolMatching (Token sym n) where + matchedSymbols _ = [fromIntegral (natVal (Proxy @n))] + showFailure _ _ = "expected " ++ symbolVal (Proxy @sym) + +instance (SymbolMatching f, SymbolMatching g) => SymbolMatching (f :+: g) where + matchedSymbols _ = matchedSymbols (Proxy @f) <> matchedSymbols (Proxy @g) + showFailure _ = sep <$> showFailure (Proxy @f) <*> showFailure (Proxy @g) + +sep :: String -> String -> String +sep a b = a ++ ". " ++ b + +-- | Move the cursor to point at the passed 'TSNode'. +goto :: Ptr Cursor -> TSNode -> MatchM () +goto cursor node = liftIO (with node (ts_tree_cursor_reset_p cursor)) + + +type Fields = [(FieldName, Node)] + +-- | Return the fields remaining in the current branch, represented as 'Map.Map' of 'FieldName's to their corresponding 'Node's. +getFields :: Ptr Cursor -> Node -> MatchM Fields +getFields cursor node + | maxCount == 0 = pure [] + | otherwise = do + nodes <- liftIO . allocaArray maxCount $ \ ptr -> do + actualCount <- ts_tree_cursor_copy_child_nodes cursor ptr + peekArray (fromIntegral actualCount) ptr + traverse (\ node -> (, node) <$> getFieldName node) nodes + where + maxCount = fromIntegral (nodeChildCount node) + getFieldName node + | nodeFieldName node == nullPtr = pure (FieldName "extraChildren") + | otherwise = FieldName . toHaskellCamelCaseIdentifier <$> liftIO (peekCString (nodeFieldName node)) + +lookupField :: FieldName -> Fields -> [Node] +lookupField k = map snd . filter ((== k) . fst) + + +-- | Return a 'ByteString' that contains a slice of the given 'ByteString'. +slice :: Range -> ByteString -> ByteString +slice (Range start end) = take . drop + where drop = B.drop start + take = B.take (end - start) + + +newtype FieldName = FieldName { getFieldName :: String } + deriving (Eq, Ord, Show) + +-- | Generic construction of ASTs from a 'Map.Map' of named fields. +-- +-- Product types (specifically, record types) are constructed by looking up the node for each corresponding field name in the map, moving the cursor to it, and then invoking 'unmarshalNode' to construct the value for that field. Leaf types are constructed as a special case of product types. +-- +-- Sum types are constructed by using the current node’s symbol to select the corresponding constructor deterministically. +class GUnmarshal f where + gunmarshalNode + :: UnmarshalAnn a + => Node + -> MatchM (f a) + +instance (Datatype d, GUnmarshalData f) => GUnmarshal (M1 D d f) where + gunmarshalNode = go (gunmarshalNode' (datatypeName @d undefined)) where + go :: (Node -> MatchM (f a)) -> Node -> MatchM (M1 i c f a) + go = coerce + +class GUnmarshalData f where + gunmarshalNode' + :: UnmarshalAnn a + => String + -> Node + -> MatchM (f a) + +instance GUnmarshalData f => GUnmarshalData (M1 i c f) where + gunmarshalNode' = go gunmarshalNode' where + go :: (String -> Node -> MatchM (f a)) -> String -> Node -> MatchM (M1 i c f a) + go = coerce + +-- For anonymous leaf nodes: +instance GUnmarshalData U1 where + gunmarshalNode' _ _ = pure U1 + +-- For unary products: +instance UnmarshalAnn k => GUnmarshalData (K1 c k) where + gunmarshalNode' _ = go unmarshalAnn where + go :: (Node -> MatchM k) -> Node -> MatchM (K1 c k a) + go = coerce + +-- For anonymous leaf nodes +instance GUnmarshalData Par1 where + gunmarshalNode' _ = go unmarshalAnn where + go :: (Node -> MatchM a) -> Node -> MatchM (Par1 a) + go = coerce + +instance Unmarshal t => GUnmarshalData (Rec1 t) where + gunmarshalNode' _ = go unmarshalNode where + go :: (Node -> MatchM (t a)) -> Node -> MatchM (Rec1 t a) + go = coerce + +-- For product datatypes: +instance (GUnmarshalProduct f, GUnmarshalProduct g) => GUnmarshalData (f :*: g) where + gunmarshalNode' datatypeName node = asks cursor >>= flip getFields node >>= gunmarshalProductNode @(f :*: g) datatypeName node + + +-- | Generically unmarshal products +class GUnmarshalProduct f where + gunmarshalProductNode + :: UnmarshalAnn a + => String + -> Node + -> Fields + -> MatchM (f a) + +-- Product structure +instance (GUnmarshalProduct f, GUnmarshalProduct g) => GUnmarshalProduct (f :*: g) where + gunmarshalProductNode datatypeName node fields = (:*:) + <$> gunmarshalProductNode @f datatypeName node fields + <*> gunmarshalProductNode @g datatypeName node fields + +-- Contents of product types (ie., the leaves of the product tree) +instance UnmarshalAnn k => GUnmarshalProduct (M1 S c (K1 i k)) where + gunmarshalProductNode _ node _ = go unmarshalAnn node where + go :: (Node -> MatchM k) -> Node -> MatchM (M1 S c (K1 i k) a) + go = coerce + +instance GUnmarshalProduct (M1 S c Par1) where + gunmarshalProductNode _ node _ = go unmarshalAnn node where + go :: (Node -> MatchM a) -> Node -> MatchM (M1 S c Par1 a) + go = coerce + +instance (UnmarshalField f, Unmarshal g, Selector c) => GUnmarshalProduct (M1 S c (f :.: g)) where + gunmarshalProductNode datatypeName _ = go (unmarshalField datatypeName fieldName . lookupField (FieldName fieldName)) where + go :: (Fields -> MatchM (f (g a))) -> Fields -> MatchM (M1 S c (f :.: g) a) + go = coerce + fieldName = selName @c undefined + +instance (Unmarshal t, Selector c) => GUnmarshalProduct (M1 S c (Rec1 t)) where + gunmarshalProductNode datatypeName _ fields = + case lookupField (FieldName fieldName) fields of + [] -> liftIO . throwIO . UnmarshalError $ "type '" <> datatypeName <> "' expected a node '" <> fieldName <> "' but didn't get one" + [x] -> go unmarshalNode x where + go :: (Node -> MatchM (t a)) -> Node -> MatchM (M1 S c (Rec1 t) a) + go = coerce + _ -> liftIO . throwIO . UnmarshalError $ "type '" <> datatypeName <> "' expected a node but got multiple" + where + fieldName = selName @c undefined + + +class GHasAnn a t where + gann :: t a -> a + +instance GHasAnn a f => GHasAnn a (M1 i c f) where + gann = gann . unM1 + +instance (GHasAnn a l, GHasAnn a r) => GHasAnn a (l :+: r) where + gann (L1 l) = gann l + gann (R1 r) = gann r + +instance {-# OVERLAPPABLE #-} HasField "ann" (t a) a => GHasAnn a t where + gann = getField @"ann" \ No newline at end of file From 2cd3dd10b105577bf30a07aabcfe567dceeae434 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Tue, 28 Jan 2020 11:33:29 -0500 Subject: [PATCH 086/235] Update Main in semantic-ast to reference AST.Unmarshal --- semantic-ast/app/Main.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/semantic-ast/app/Main.hs b/semantic-ast/app/Main.hs index 32a2d32d9..5102b3d41 100644 --- a/semantic-ast/app/Main.hs +++ b/semantic-ast/app/Main.hs @@ -2,7 +2,7 @@ module Main (main) where -import TreeSitter.Unmarshal +import AST.Unmarshal as Unmarshal import qualified Language.Python.AST as AST import qualified TreeSitter.Python as Python import Source.Range @@ -54,7 +54,7 @@ generateAST (SemanticAST format noColor source) = Left filePaths -> traverse Data.ByteString.readFile filePaths Right source -> pure [Data.ByteString.Char8.pack source] go = ast >=> display - ast = parseByteString @AST.Module @(Range, Span) Python.tree_sitter_python -- TODO: generalize for all languages + ast = Unmarshal.parseByteString @AST.Module @(Range, Span) Python.tree_sitter_python -- TODO: generalize for all languages display = case format of Json -> Data.ByteString.Lazy.Char8.putStrLn . encodePretty . either toJSON (marshal . fmap (const ())) -- TODO: replacing range and span annotations with () for which there is a ToJSON instance for now, deal with this later Show -> print From 08483e82803a84cf87a65033aa6461c470abc0bf Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Tue, 28 Jan 2020 11:34:11 -0500 Subject: [PATCH 087/235] Update Go dependencies to reference AST.* instead of TreeSitter.* --- semantic-go/src/Language/Go.hs | 2 +- semantic-go/src/Language/Go/AST.hs | 2 +- semantic-go/src/Language/Go/Tags.hs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/semantic-go/src/Language/Go.hs b/semantic-go/src/Language/Go.hs index 9eda7acd4..4e7ef430a 100644 --- a/semantic-go/src/Language/Go.hs +++ b/semantic-go/src/Language/Go.hs @@ -10,7 +10,7 @@ import qualified Language.Go.AST as Go import qualified Language.Go.Tags as GoTags import qualified Tags.Tagging.Precise as Tags import qualified TreeSitter.Go (tree_sitter_go) -import qualified TreeSitter.Unmarshal as TS +import qualified AST.Unmarshal as TS newtype Term a = Term { getTerm :: Go.SourceFile a } diff --git a/semantic-go/src/Language/Go/AST.hs b/semantic-go/src/Language/Go/AST.hs index 184267a18..158b97228 100644 --- a/semantic-go/src/Language/Go/AST.hs +++ b/semantic-go/src/Language/Go/AST.hs @@ -15,7 +15,7 @@ module Language.Go.AST ) where import Prelude hiding (False, Float, Integer, Rational, String, True) -import TreeSitter.GenerateSyntax +import AST.GenerateSyntax import qualified TreeSitter.Go as Grammar astDeclarationsForLanguage Grammar.tree_sitter_go "../../../vendor/tree-sitter-go/src/node-types.json" \ No newline at end of file diff --git a/semantic-go/src/Language/Go/Tags.hs b/semantic-go/src/Language/Go/Tags.hs index 7970eca44..48294c21f 100644 --- a/semantic-go/src/Language/Go/Tags.hs +++ b/semantic-go/src/Language/Go/Tags.hs @@ -18,7 +18,7 @@ import Source.Loc import Source.Source as Source import Tags.Tag import qualified Tags.Tagging.Precise as Tags -import TreeSitter.Token +import AST.Token class ToTags t where tags From 5ff4b5d99dfbcbe3ff6bbb06f65103513e149f7a Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Tue, 28 Jan 2020 11:34:26 -0500 Subject: [PATCH 088/235] Update Python dependencies to reference AST.* instead of TreeSitter.* --- semantic-python/src/Language/Python.hs | 2 +- semantic-python/src/Language/Python/AST.hs | 2 +- semantic-python/src/Language/Python/Tags.hs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/semantic-python/src/Language/Python.hs b/semantic-python/src/Language/Python.hs index b0d37febe..0ee798923 100644 --- a/semantic-python/src/Language/Python.hs +++ b/semantic-python/src/Language/Python.hs @@ -11,7 +11,7 @@ import qualified Language.Python.Tags as PyTags import ScopeGraph.Convert import qualified Tags.Tagging.Precise as Tags import qualified TreeSitter.Python (tree_sitter_python) -import qualified TreeSitter.Unmarshal as TS +import qualified AST.Unmarshal as TS newtype Term a = Term { getTerm :: Py.Module a } diff --git a/semantic-python/src/Language/Python/AST.hs b/semantic-python/src/Language/Python/AST.hs index 8ee86b6b7..0d7d43413 100644 --- a/semantic-python/src/Language/Python/AST.hs +++ b/semantic-python/src/Language/Python/AST.hs @@ -15,7 +15,7 @@ module Language.Python.AST ) where import Prelude hiding (False, Float, Integer, String, True) -import TreeSitter.GenerateSyntax +import AST.GenerateSyntax import qualified TreeSitter.Python as Grammar astDeclarationsForLanguage Grammar.tree_sitter_python "../../../vendor/tree-sitter-python/src/node-types.json" diff --git a/semantic-python/src/Language/Python/Tags.hs b/semantic-python/src/Language/Python/Tags.hs index 175a0bc02..b308ff1d2 100644 --- a/semantic-python/src/Language/Python/Tags.hs +++ b/semantic-python/src/Language/Python/Tags.hs @@ -22,7 +22,7 @@ import Source.Range import Source.Source as Source import Tags.Tag import qualified Tags.Tagging.Precise as Tags -import TreeSitter.Token +import AST.Token class ToTags t where tags From 9e6eab11cb678469811fceaa91d3869cd7912b1a Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Tue, 28 Jan 2020 12:00:18 -0500 Subject: [PATCH 089/235] Update TypeScript dependencies to reference AST.* instead of TreeSitter.* --- semantic-typescript/src/Language/TypeScript.hs | 2 +- semantic-typescript/src/Language/TypeScript/AST.hs | 2 +- semantic-typescript/src/Language/TypeScript/Tags.hs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/semantic-typescript/src/Language/TypeScript.hs b/semantic-typescript/src/Language/TypeScript.hs index 7da01f376..935d3e923 100644 --- a/semantic-typescript/src/Language/TypeScript.hs +++ b/semantic-typescript/src/Language/TypeScript.hs @@ -10,7 +10,7 @@ import qualified Language.TypeScript.AST as TypeScript import qualified Language.TypeScript.Tags as TsTags import qualified Tags.Tagging.Precise as Tags import qualified TreeSitter.TypeScript (tree_sitter_typescript) -import qualified TreeSitter.Unmarshal as TS +import qualified AST.Unmarshal as TS newtype Term a = Term { getTerm :: TypeScript.Program a } diff --git a/semantic-typescript/src/Language/TypeScript/AST.hs b/semantic-typescript/src/Language/TypeScript/AST.hs index 731df756e..667f93937 100644 --- a/semantic-typescript/src/Language/TypeScript/AST.hs +++ b/semantic-typescript/src/Language/TypeScript/AST.hs @@ -15,7 +15,7 @@ module Language.TypeScript.AST ) where import Prelude hiding (False, Float, Integer, String, True) -import TreeSitter.GenerateSyntax +import AST.GenerateSyntax import qualified TreeSitter.TypeScript as Grammar astDeclarationsForLanguage Grammar.tree_sitter_typescript "../../../vendor/tree-sitter-typescript/typescript/src/node-types.json" diff --git a/semantic-typescript/src/Language/TypeScript/Tags.hs b/semantic-typescript/src/Language/TypeScript/Tags.hs index e96e90167..408bdd9ad 100644 --- a/semantic-typescript/src/Language/TypeScript/Tags.hs +++ b/semantic-typescript/src/Language/TypeScript/Tags.hs @@ -20,7 +20,7 @@ import Source.Loc import Source.Source as Source import Tags.Tag import qualified Tags.Tagging.Precise as Tags -import TreeSitter.Token +import AST.Token class ToTags t where tags From 82f3259c3d8e0d727a52154d20becb63c3fc5c3a Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Tue, 28 Jan 2020 12:04:01 -0500 Subject: [PATCH 090/235] Update Ruby dependencies to reference AST.* instead of TreeSitter.* --- semantic-ruby/src/Language/Ruby.hs | 2 +- semantic-ruby/src/Language/Ruby/AST.hs | 2 +- semantic-ruby/src/Language/Ruby/Tags.hs | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/semantic-ruby/src/Language/Ruby.hs b/semantic-ruby/src/Language/Ruby.hs index d9926d074..32af865f7 100644 --- a/semantic-ruby/src/Language/Ruby.hs +++ b/semantic-ruby/src/Language/Ruby.hs @@ -13,7 +13,7 @@ import qualified Language.Ruby.AST as Rb import qualified Language.Ruby.Tags as RbTags import qualified Tags.Tagging.Precise as Tags import qualified TreeSitter.Ruby (tree_sitter_ruby) -import qualified TreeSitter.Unmarshal as TS +import qualified AST.Unmarshal as TS newtype Term a = Term { getTerm :: Rb.Program a } diff --git a/semantic-ruby/src/Language/Ruby/AST.hs b/semantic-ruby/src/Language/Ruby/AST.hs index 7b006f80c..58b281976 100644 --- a/semantic-ruby/src/Language/Ruby/AST.hs +++ b/semantic-ruby/src/Language/Ruby/AST.hs @@ -15,7 +15,7 @@ module Language.Ruby.AST ) where import Prelude hiding (False, Float, Integer, Rational, String, True) -import TreeSitter.GenerateSyntax +import AST.GenerateSyntax import qualified TreeSitter.Ruby as Grammar astDeclarationsForLanguage Grammar.tree_sitter_ruby "../../../vendor/tree-sitter-ruby/src/node-types.json" \ No newline at end of file diff --git a/semantic-ruby/src/Language/Ruby/Tags.hs b/semantic-ruby/src/Language/Ruby/Tags.hs index 88d09a2aa..22d01a2e3 100644 --- a/semantic-ruby/src/Language/Ruby/Tags.hs +++ b/semantic-ruby/src/Language/Ruby/Tags.hs @@ -25,8 +25,8 @@ import Source.Range as Range import Source.Source as Source import Tags.Tag import qualified Tags.Tagging.Precise as Tags -import TreeSitter.Token -import qualified TreeSitter.Unmarshal as TS +import AST.Token +import qualified AST.Unmarshal as TS class ToTags t where tags From 56d89e9b4eb0472f3979192ae7c5586179c229bc Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Tue, 28 Jan 2020 12:04:24 -0500 Subject: [PATCH 091/235] Update JSON dependencies to reference AST.* instead of TreeSitter.* --- semantic-json/src/Language/JSON.hs | 2 +- semantic-json/src/Language/JSON/AST.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/semantic-json/src/Language/JSON.hs b/semantic-json/src/Language/JSON.hs index a01c9e794..0d168418f 100644 --- a/semantic-json/src/Language/JSON.hs +++ b/semantic-json/src/Language/JSON.hs @@ -8,7 +8,7 @@ import Data.Proxy import qualified Language.JSON.AST as JSON import qualified Tags.Tagging.Precise as Tags import qualified TreeSitter.JSON (tree_sitter_json) -import qualified TreeSitter.Unmarshal as TS +import qualified AST.Unmarshal as TS newtype Term a = Term { getTerm :: JSON.Document a } diff --git a/semantic-json/src/Language/JSON/AST.hs b/semantic-json/src/Language/JSON/AST.hs index a5be98f35..4526ddff6 100644 --- a/semantic-json/src/Language/JSON/AST.hs +++ b/semantic-json/src/Language/JSON/AST.hs @@ -14,7 +14,7 @@ module Language.JSON.AST ) where import Prelude hiding (String) -import TreeSitter.GenerateSyntax +import AST.GenerateSyntax import qualified TreeSitter.JSON as Grammar astDeclarationsForLanguage Grammar.tree_sitter_json "../../../vendor/tree-sitter-json/src/node-types.json" From 9c39c4e0a481fbace95ee4012b50aa6b1319f46e Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Tue, 28 Jan 2020 12:09:29 -0500 Subject: [PATCH 092/235] Updata Java dependencies to reference AST.* instead of TreeSitter.* --- semantic-java/src/Language/Java.hs | 2 +- semantic-java/src/Language/Java/AST.hs | 4 ++-- semantic-java/src/Language/Java/Tags.hs | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/semantic-java/src/Language/Java.hs b/semantic-java/src/Language/Java.hs index c1f1e5742..a37798d53 100644 --- a/semantic-java/src/Language/Java.hs +++ b/semantic-java/src/Language/Java.hs @@ -9,7 +9,7 @@ import qualified Language.Java.AST as Java import qualified Language.Java.Tags as JavaTags import qualified Tags.Tagging.Precise as Tags import qualified TreeSitter.Java (tree_sitter_java) -import qualified TreeSitter.Unmarshal as TS +import qualified AST.Unmarshal as TS newtype Term a = Term { getTerm :: Java.Program a } diff --git a/semantic-java/src/Language/Java/AST.hs b/semantic-java/src/Language/Java/AST.hs index b81c6eba1..90f2fe90b 100644 --- a/semantic-java/src/Language/Java/AST.hs +++ b/semantic-java/src/Language/Java/AST.hs @@ -14,8 +14,8 @@ module Language.Java.AST ( module Language.Java.AST ) where -import TreeSitter.GenerateSyntax +import AST.GenerateSyntax import qualified TreeSitter.Java as Grammar -import TreeSitter.Token +import AST.Token astDeclarationsForLanguage Grammar.tree_sitter_java "../../../vendor/tree-sitter-java/src/node-types.json" \ No newline at end of file diff --git a/semantic-java/src/Language/Java/Tags.hs b/semantic-java/src/Language/Java/Tags.hs index 215a4632b..6d7b5c005 100644 --- a/semantic-java/src/Language/Java/Tags.hs +++ b/semantic-java/src/Language/Java/Tags.hs @@ -17,7 +17,7 @@ import Source.Range import Source.Source as Source import Tags.Tag import qualified Tags.Tagging.Precise as Tags -import TreeSitter.Token +import AST.Token class ToTags t where tags From 81bab4a9a3ed223bad5bd0a8e6ca029f9a6919d5 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Tue, 28 Jan 2020 12:11:40 -0500 Subject: [PATCH 093/235] Update TSX dependencies to reference AST.* instead of TreeSitter.* --- semantic-tsx/src/Language/TSX.hs | 2 +- semantic-tsx/src/Language/TSX/AST.hs | 2 +- semantic-tsx/src/Language/TSX/Tags.hs | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/semantic-tsx/src/Language/TSX.hs b/semantic-tsx/src/Language/TSX.hs index 5e645892d..a60d936af 100644 --- a/semantic-tsx/src/Language/TSX.hs +++ b/semantic-tsx/src/Language/TSX.hs @@ -10,7 +10,7 @@ import qualified Language.TSX.AST as TSX import qualified Language.TSX.Tags as TsxTags import qualified Tags.Tagging.Precise as Tags import qualified TreeSitter.TSX (tree_sitter_tsx) -import qualified TreeSitter.Unmarshal as TS +import qualified AST.Unmarshal as TS newtype Term a = Term { getTerm :: TSX.Program a } diff --git a/semantic-tsx/src/Language/TSX/AST.hs b/semantic-tsx/src/Language/TSX/AST.hs index e7511382e..524f042cc 100644 --- a/semantic-tsx/src/Language/TSX/AST.hs +++ b/semantic-tsx/src/Language/TSX/AST.hs @@ -15,7 +15,7 @@ module Language.TSX.AST ) where import Prelude hiding (False, Float, Integer, String, True) -import TreeSitter.GenerateSyntax +import AST.GenerateSyntax import qualified TreeSitter.TSX as Grammar astDeclarationsForLanguage Grammar.tree_sitter_tsx "../../../vendor/tree-sitter-typescript/tsx/src/node-types.json" \ No newline at end of file diff --git a/semantic-tsx/src/Language/TSX/Tags.hs b/semantic-tsx/src/Language/TSX/Tags.hs index b1442fa1a..2d6a29d15 100644 --- a/semantic-tsx/src/Language/TSX/Tags.hs +++ b/semantic-tsx/src/Language/TSX/Tags.hs @@ -20,7 +20,7 @@ import Source.Loc import Source.Source as Source import Tags.Tag import qualified Tags.Tagging.Precise as Tags -import TreeSitter.Token +import AST.Token class ToTags t where tags From 69fd3e9cce94e1332e658d95c518f6ac345f8de8 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Tue, 28 Jan 2020 12:15:04 -0500 Subject: [PATCH 094/235] Update GraphTest.hs --- semantic-python/test-graphing/GraphTest.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic-python/test-graphing/GraphTest.hs b/semantic-python/test-graphing/GraphTest.hs index 07ceee9d0..fedfc6738 100644 --- a/semantic-python/test-graphing/GraphTest.hs +++ b/semantic-python/test-graphing/GraphTest.hs @@ -24,7 +24,7 @@ import qualified System.Path.Directory as Path import qualified Test.Tasty as Tasty import qualified Test.Tasty.HUnit as HUnit import qualified TreeSitter.Python as TSP -import qualified TreeSitter.Unmarshal as TS +import qualified AST.Unmarshal as TS {- From 4d37cc2fc4e56ed28762a24a0c9080582dcc3948 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Tue, 28 Jan 2020 12:18:03 -0500 Subject: [PATCH 095/235] Update Test.hs --- semantic-python/test/Test.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic-python/test/Test.hs b/semantic-python/test/Test.hs index e95ccab1d..cbbf51f9c 100644 --- a/semantic-python/test/Test.hs +++ b/semantic-python/test/Test.hs @@ -37,7 +37,7 @@ import qualified System.Path as Path import qualified System.Path.Directory as Path import qualified Text.Trifecta as Trifecta import qualified TreeSitter.Python as TSP -import qualified TreeSitter.Unmarshal as TS +import qualified AST.Unmarshal as TS import qualified Test.Tasty as Tasty import qualified Test.Tasty.HUnit as HUnit From ebaac0bdc9d649dec9f69dc29809c6fa144bea7a Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Tue, 28 Jan 2020 12:18:05 -0500 Subject: [PATCH 096/235] Update Parser.hs --- src/Parsing/Parser.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Parsing/Parser.hs b/src/Parsing/Parser.hs index 1fbe6c93d..8e73812af 100644 --- a/src/Parsing/Parser.hs +++ b/src/Parsing/Parser.hs @@ -68,7 +68,7 @@ import TreeSitter.Python import TreeSitter.Ruby (tree_sitter_ruby) import TreeSitter.TSX import TreeSitter.TypeScript -import TreeSitter.Unmarshal +import AST.Unmarshal -- | A parser from 'Source' onto some term type. data Parser term where From 2a51c09abb491cdde47cf2367605165d87bbea1b Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Tue, 28 Jan 2020 12:18:06 -0500 Subject: [PATCH 097/235] Update TreeSitter.hs --- src/Parsing/TreeSitter.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs index f61217b83..da67abddb 100644 --- a/src/Parsing/TreeSitter.hs +++ b/src/Parsing/TreeSitter.hs @@ -28,7 +28,7 @@ import qualified TreeSitter.Language as TS import qualified TreeSitter.Node as TS import qualified TreeSitter.Parser as TS import qualified TreeSitter.Tree as TS -import qualified TreeSitter.Unmarshal as TS +import qualified AST.Unmarshal as TS data TSParseException = ParserTimedOut From 4bb39cba963c1b2c3ae540b313ec1b96ea7afe04 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Tue, 28 Jan 2020 13:25:59 -0500 Subject: [PATCH 098/235] change Data.Graph to Data.Graph.Algebraic --- bench/Evaluation.hs | 4 ++-- semantic.cabal | 2 +- src/Analysis/Abstract/Graph.hs | 2 +- src/Data/{Graph.hs => Graph/Algebraic.hs} | 2 +- src/Data/Graph/ControlFlowVertex.hs | 2 +- src/Semantic/Util.hs | 2 +- test/Data/Graph/Spec.hs | 4 +--- test/Graphing/Calls/Spec.hs | 4 ++-- 8 files changed, 10 insertions(+), 12 deletions(-) rename src/Data/{Graph.hs => Graph/Algebraic.hs} (99%) diff --git a/bench/Evaluation.hs b/bench/Evaluation.hs index 1092d8cbf..b1f5bf62c 100644 --- a/bench/Evaluation.hs +++ b/bench/Evaluation.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, FlexibleContexts, PackageImports, PartialTypeSignatures, TypeApplications, TypeFamilies #-} +{-# LANGUAGE DataKinds, FlexibleContexts, PartialTypeSignatures, TypeApplications, TypeFamilies #-} module Evaluation (benchmarks) where @@ -8,7 +8,7 @@ import Data.Abstract.Evaluatable import Data.Blob import Data.Blob.IO (readBlobFromFile') import Data.Bifunctor -import "semantic" Data.Graph (topologicalSort) +import Data.Graph.Algebraic (topologicalSort) import qualified Data.Language as Language import Data.Project import Data.Proxy diff --git a/semantic.cabal b/semantic.cabal index 16e1896a8..2e6b240ac 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -150,7 +150,7 @@ library , Data.Error , Data.Flag , Data.Functor.Classes.Generic - , Data.Graph + , Data.Graph.Algebraic , Data.Graph.ControlFlowVertex , Data.Handle , Data.History diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs index 3e1115518..0eac99645 100644 --- a/src/Analysis/Abstract/Graph.hs +++ b/src/Analysis/Abstract/Graph.hs @@ -25,7 +25,7 @@ import Control.Effect.Sum.Project import Data.Abstract.BaseError import Data.Abstract.Module (Module (moduleInfo), ModuleInfo (..)) import Data.ByteString.Builder -import Data.Graph +import Data.Graph.Algebraic import Data.Graph.ControlFlowVertex import qualified Data.Map as Map import qualified Data.Text.Encoding as T diff --git a/src/Data/Graph.hs b/src/Data/Graph/Algebraic.hs similarity index 99% rename from src/Data/Graph.hs rename to src/Data/Graph/Algebraic.hs index b219cc468..627b5ee60 100644 --- a/src/Data/Graph.hs +++ b/src/Data/Graph/Algebraic.hs @@ -1,5 +1,5 @@ {-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, OverloadedStrings, ScopedTypeVariables, TypeFamilies, UndecidableInstances #-} -module Data.Graph +module Data.Graph.Algebraic ( Graph(..) , overlay , connect diff --git a/src/Data/Graph/ControlFlowVertex.hs b/src/Data/Graph/ControlFlowVertex.hs index b0d822d66..0c980b40e 100644 --- a/src/Data/Graph/ControlFlowVertex.hs +++ b/src/Data/Graph/ControlFlowVertex.hs @@ -19,7 +19,7 @@ import Data.Abstract.Module (ModuleInfo (..)) import Data.Abstract.Name import Data.Abstract.Package (PackageInfo (..)) import Data.Aeson -import Data.Graph (VertexTag (..)) +import Data.Graph.Algebraic (VertexTag (..)) import Data.Quieterm (Quieterm(..)) import qualified Data.Syntax as Syntax import qualified Data.Syntax.Declaration as Declaration diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 075726826..8d1f0c3f0 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -28,7 +28,7 @@ import Data.Abstract.Package import Data.Abstract.Value.Concrete as Concrete import Data.Blob import Data.Blob.IO -import Data.Graph (topologicalSort) +import Data.Graph.Algebraic (topologicalSort) import qualified Data.Language as Language import Data.List (uncons) import Data.Project diff --git a/test/Data/Graph/Spec.hs b/test/Data/Graph/Spec.hs index 22843514c..950b1d883 100644 --- a/test/Data/Graph/Spec.hs +++ b/test/Data/Graph/Spec.hs @@ -1,10 +1,8 @@ -{-# LANGUAGE PackageImports #-} - module Data.Graph.Spec (spec) where import SpecHelpers -import "semantic" Data.Graph +import Data.Graph.Algebraic import qualified Algebra.Graph.Class as Class spec :: Spec diff --git a/test/Graphing/Calls/Spec.hs b/test/Graphing/Calls/Spec.hs index 0440dd6bd..5adc3b0aa 100644 --- a/test/Graphing/Calls/Spec.hs +++ b/test/Graphing/Calls/Spec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, GADTs, OverloadedStrings, PackageImports, TypeApplications #-} +{-# LANGUAGE DataKinds, GADTs, OverloadedStrings, TypeApplications #-} module Graphing.Calls.Spec ( spec ) where @@ -8,7 +8,7 @@ import SpecHelpers import Algebra.Graph import Control.Effect.Parse -import "semantic" Data.Graph (Graph (..), topologicalSort) +import Data.Graph.Algebraic (Graph (..), topologicalSort) import Data.Graph.ControlFlowVertex import qualified Data.Language as Language import Semantic.Graph From f5a444f60a5676acb1e9e42104410a948e20c7aa Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Tue, 28 Jan 2020 16:09:19 -0500 Subject: [PATCH 099/235] Replace TreeSitter.Python with Language.Python.Grammar --- semantic-ast/app/Main.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic-ast/app/Main.hs b/semantic-ast/app/Main.hs index 5102b3d41..d1fbeb1da 100644 --- a/semantic-ast/app/Main.hs +++ b/semantic-ast/app/Main.hs @@ -4,7 +4,7 @@ module Main (main) where import AST.Unmarshal as Unmarshal import qualified Language.Python.AST as AST -import qualified TreeSitter.Python as Python +import qualified Language.Python.Grammar as Python import Source.Range import Source.Span import Data.Aeson (toJSON) From 6f308fdb579edeed5c913b8a7c467e5b5d69731b Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Tue, 28 Jan 2020 16:09:29 -0500 Subject: [PATCH 100/235] Language.Python.Grammar --- semantic-python/semantic-python.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/semantic-python/semantic-python.cabal b/semantic-python/semantic-python.cabal index e1410ea98..af8ee67c7 100644 --- a/semantic-python/semantic-python.cabal +++ b/semantic-python/semantic-python.cabal @@ -56,6 +56,7 @@ library Language.Python Language.Python.AST Language.Python.Core + Language.Python.Grammar Language.Python.Failure Language.Python.Patterns Language.Python.ScopeGraph From efe17d70b9c477d978240e60ed36807de944fa06 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Tue, 28 Jan 2020 16:10:20 -0500 Subject: [PATCH 101/235] Add python grammar --- semantic-python/src/Language/Python.hs | 4 ++-- semantic-python/src/Language/Python/AST.hs | 2 +- semantic-python/src/Language/Python/Grammar.hs | 15 +++++++++++++++ semantic-python/test-graphing/GraphTest.hs | 2 +- semantic-python/test/Test.hs | 2 +- 5 files changed, 20 insertions(+), 5 deletions(-) create mode 100644 semantic-python/src/Language/Python/Grammar.hs diff --git a/semantic-python/src/Language/Python.hs b/semantic-python/src/Language/Python.hs index 0ee798923..59abf0d09 100644 --- a/semantic-python/src/Language/Python.hs +++ b/semantic-python/src/Language/Python.hs @@ -1,7 +1,7 @@ -- | Semantic functionality for Python programs. module Language.Python ( Term(..) -, TreeSitter.Python.tree_sitter_python +, Language.Python.Grammar.tree_sitter_python ) where import Data.Proxy @@ -10,7 +10,7 @@ import Language.Python.ScopeGraph import qualified Language.Python.Tags as PyTags import ScopeGraph.Convert import qualified Tags.Tagging.Precise as Tags -import qualified TreeSitter.Python (tree_sitter_python) +import qualified Language.Python.Grammar (tree_sitter_python) import qualified AST.Unmarshal as TS newtype Term a = Term { getTerm :: Py.Module a } diff --git a/semantic-python/src/Language/Python/AST.hs b/semantic-python/src/Language/Python/AST.hs index 0d7d43413..0f10d379d 100644 --- a/semantic-python/src/Language/Python/AST.hs +++ b/semantic-python/src/Language/Python/AST.hs @@ -16,6 +16,6 @@ module Language.Python.AST import Prelude hiding (False, Float, Integer, String, True) import AST.GenerateSyntax -import qualified TreeSitter.Python as Grammar +import qualified Language.Python.Grammar as Grammar astDeclarationsForLanguage Grammar.tree_sitter_python "../../../vendor/tree-sitter-python/src/node-types.json" diff --git a/semantic-python/src/Language/Python/Grammar.hs b/semantic-python/src/Language/Python/Grammar.hs new file mode 100644 index 000000000..7ac7ea9ef --- /dev/null +++ b/semantic-python/src/Language/Python/Grammar.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE TemplateHaskell #-} +module Language.Python.Grammar +( tree_sitter_python +, Grammar(..) +) where + +import Language.Haskell.TH +import TreeSitter.Python.Internal +import TreeSitter.Language + +-- Regenerate template haskell code when these files change: +addDependentFileRelative "../vendor/tree-sitter-python/src/parser.c" + +-- | Statically-known rules corresponding to symbols in the grammar. +mkSymbolDatatype (mkName "Grammar") tree_sitter_python diff --git a/semantic-python/test-graphing/GraphTest.hs b/semantic-python/test-graphing/GraphTest.hs index fedfc6738..f14b1e72f 100644 --- a/semantic-python/test-graphing/GraphTest.hs +++ b/semantic-python/test-graphing/GraphTest.hs @@ -23,7 +23,7 @@ import qualified System.Path as Path import qualified System.Path.Directory as Path import qualified Test.Tasty as Tasty import qualified Test.Tasty.HUnit as HUnit -import qualified TreeSitter.Python as TSP +import qualified Language.Python.Grammar as TSP import qualified AST.Unmarshal as TS {- diff --git a/semantic-python/test/Test.hs b/semantic-python/test/Test.hs index cbbf51f9c..cb72c2167 100644 --- a/semantic-python/test/Test.hs +++ b/semantic-python/test/Test.hs @@ -36,7 +36,7 @@ import System.Path (()) import qualified System.Path as Path import qualified System.Path.Directory as Path import qualified Text.Trifecta as Trifecta -import qualified TreeSitter.Python as TSP +import qualified Language.Python.Grammar as TSP import qualified AST.Unmarshal as TS import qualified Test.Tasty as Tasty From cec73b5fb1ab9bdaf80777a0a6039067eb5a44c1 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Tue, 28 Jan 2020 16:10:35 -0500 Subject: [PATCH 102/235] upt to use new Python grammar --- src/Language/Python/Assignment.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Language/Python/Assignment.hs b/src/Language/Python/Assignment.hs index 90cb3e3bc..cf846edc0 100644 --- a/src/Language/Python/Assignment.hs +++ b/src/Language/Python/Assignment.hs @@ -33,7 +33,7 @@ import qualified Data.Syntax.Type as Type import Language.Python.Syntax as Python.Syntax import Language.Python.Term as Python import Prologue -import TreeSitter.Python as Grammar +import Language.Python.Grammar as Grammar type Assignment = Assignment.Assignment [] Grammar From 6e5d372947d09dfdf796f3d39bad6e8d84863aa1 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Tue, 28 Jan 2020 16:10:55 -0500 Subject: [PATCH 103/235] add ruby grammar --- semantic-ruby/semantic-ruby.cabal | 1 + semantic-ruby/src/Language/Ruby.hs | 2 +- semantic-ruby/src/Language/Ruby/AST.hs | 2 +- semantic-ruby/src/Language/Ruby/Grammar.hs | 15 +++++++++++++++ src/Language/Ruby/Assignment.hs | 2 +- 5 files changed, 19 insertions(+), 3 deletions(-) create mode 100644 semantic-ruby/src/Language/Ruby/Grammar.hs diff --git a/semantic-ruby/semantic-ruby.cabal b/semantic-ruby/semantic-ruby.cabal index 3effcd730..267aec558 100644 --- a/semantic-ruby/semantic-ruby.cabal +++ b/semantic-ruby/semantic-ruby.cabal @@ -52,5 +52,6 @@ library exposed-modules: Language.Ruby Language.Ruby.AST + Language.Ruby.Grammar Language.Ruby.Tags hs-source-dirs: src diff --git a/semantic-ruby/src/Language/Ruby.hs b/semantic-ruby/src/Language/Ruby.hs index 32af865f7..85dcc218a 100644 --- a/semantic-ruby/src/Language/Ruby.hs +++ b/semantic-ruby/src/Language/Ruby.hs @@ -12,7 +12,7 @@ import Data.Text (Text) import qualified Language.Ruby.AST as Rb import qualified Language.Ruby.Tags as RbTags import qualified Tags.Tagging.Precise as Tags -import qualified TreeSitter.Ruby (tree_sitter_ruby) +import qualified Language.Ruby.Grammar (tree_sitter_ruby) import qualified AST.Unmarshal as TS newtype Term a = Term { getTerm :: Rb.Program a } diff --git a/semantic-ruby/src/Language/Ruby/AST.hs b/semantic-ruby/src/Language/Ruby/AST.hs index 58b281976..270b4436d 100644 --- a/semantic-ruby/src/Language/Ruby/AST.hs +++ b/semantic-ruby/src/Language/Ruby/AST.hs @@ -16,6 +16,6 @@ module Language.Ruby.AST import Prelude hiding (False, Float, Integer, Rational, String, True) import AST.GenerateSyntax -import qualified TreeSitter.Ruby as Grammar +import qualified Language.Ruby.Grammar as Grammar astDeclarationsForLanguage Grammar.tree_sitter_ruby "../../../vendor/tree-sitter-ruby/src/node-types.json" \ No newline at end of file diff --git a/semantic-ruby/src/Language/Ruby/Grammar.hs b/semantic-ruby/src/Language/Ruby/Grammar.hs new file mode 100644 index 000000000..e269dcf3a --- /dev/null +++ b/semantic-ruby/src/Language/Ruby/Grammar.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE TemplateHaskell #-} +module Language.Ruby.Grammar +( tree_sitter_ruby +, Grammar(..) +) where + +import Language.Haskell.TH +import TreeSitter.Ruby.Internal +import TreeSitter.Language + +-- Regenerate template haskell code when these files change: +addDependentFileRelative "../vendor/tree-sitter-ruby/src/parser.c" + +-- | Statically-known rules corresponding to symbols in the grammar. +mkSymbolDatatype (mkName "Grammar") tree_sitter_ruby diff --git a/src/Language/Ruby/Assignment.hs b/src/Language/Ruby/Assignment.hs index c32e530c2..c90aa6b2d 100644 --- a/src/Language/Ruby/Assignment.hs +++ b/src/Language/Ruby/Assignment.hs @@ -35,7 +35,7 @@ import qualified Data.Syntax.Statement as Statement import qualified Data.Text as Text import qualified Language.Ruby.Syntax as Ruby.Syntax import Language.Ruby.Term as Ruby -import TreeSitter.Ruby as Grammar +import Language.Ruby.Grammar as Grammar type Assignment = Assignment.Assignment [] Grammar From 364e8038e2748106d36d7ca7b3d095b151855745 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Tue, 28 Jan 2020 16:11:06 -0500 Subject: [PATCH 104/235] python and ruby grammars --- src/Parsing/Parser.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Parsing/Parser.hs b/src/Parsing/Parser.hs index 8e73812af..c23df9a61 100644 --- a/src/Parsing/Parser.hs +++ b/src/Parsing/Parser.hs @@ -64,8 +64,8 @@ import Prologue import TreeSitter.Go import qualified TreeSitter.Language as TS (Language, Symbol) import TreeSitter.PHP -import TreeSitter.Python -import TreeSitter.Ruby (tree_sitter_ruby) +import Language.Python.Grammar +import Language.Ruby.Grammar (tree_sitter_ruby) import TreeSitter.TSX import TreeSitter.TypeScript import AST.Unmarshal From a515410edc53204ed0f66bfcd1852dc5e83b50e2 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Tue, 28 Jan 2020 16:20:43 -0500 Subject: [PATCH 105/235] correctly nest file structure for python --- semantic-ruby/src/Language/Ruby/Grammar.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic-ruby/src/Language/Ruby/Grammar.hs b/semantic-ruby/src/Language/Ruby/Grammar.hs index e269dcf3a..a941aa415 100644 --- a/semantic-ruby/src/Language/Ruby/Grammar.hs +++ b/semantic-ruby/src/Language/Ruby/Grammar.hs @@ -9,7 +9,7 @@ import TreeSitter.Ruby.Internal import TreeSitter.Language -- Regenerate template haskell code when these files change: -addDependentFileRelative "../vendor/tree-sitter-ruby/src/parser.c" +addDependentFileRelative "../../../vendor/tree-sitter-ruby/src/parser.c" -- | Statically-known rules corresponding to symbols in the grammar. mkSymbolDatatype (mkName "Grammar") tree_sitter_ruby From 82ec0115dc2e80566ea8459bd14dfff562c22e83 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Tue, 28 Jan 2020 16:20:49 -0500 Subject: [PATCH 106/235] correctly nest file structure for ruby --- semantic-python/src/Language/Python/Grammar.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic-python/src/Language/Python/Grammar.hs b/semantic-python/src/Language/Python/Grammar.hs index 7ac7ea9ef..5393172a1 100644 --- a/semantic-python/src/Language/Python/Grammar.hs +++ b/semantic-python/src/Language/Python/Grammar.hs @@ -9,7 +9,7 @@ import TreeSitter.Python.Internal import TreeSitter.Language -- Regenerate template haskell code when these files change: -addDependentFileRelative "../vendor/tree-sitter-python/src/parser.c" +addDependentFileRelative "../../../vendor/tree-sitter-python/src/parser.c" -- | Statically-known rules corresponding to symbols in the grammar. mkSymbolDatatype (mkName "Grammar") tree_sitter_python From 94667d0bcd63cbcef2e17a2065b2eef4d6e3f0df Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Wed, 29 Jan 2020 11:55:47 -0500 Subject: [PATCH 107/235] Create Grammar.hs --- semantic-typescript/src/Language/Grammar.hs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) create mode 100644 semantic-typescript/src/Language/Grammar.hs diff --git a/semantic-typescript/src/Language/Grammar.hs b/semantic-typescript/src/Language/Grammar.hs new file mode 100644 index 000000000..fe991efa0 --- /dev/null +++ b/semantic-typescript/src/Language/Grammar.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE TemplateHaskell #-} +module Language.TypeScript.Grammar +( tree_sitter_typescript +, Grammar(..) +) where + +import Language.Haskell.TH +import TreeSitter.TypeScript.Internal +import TreeSitter.Language + +-- Regenerate template haskell code when these files change: +addDependentFileRelative "../../../vendor/tree-sitter-typescript/typescript/src/parser.c" + +-- | Statically-known rules corresponding to symbols in the grammar. +mkSymbolDatatype (mkName "Grammar") tree_sitter_typescript From 13774b2d09d5ccae371fd01ad079619bdb6382fd Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Wed, 29 Jan 2020 11:55:57 -0500 Subject: [PATCH 108/235] Update semantic-typescript.cabal --- semantic-typescript/semantic-typescript.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/semantic-typescript/semantic-typescript.cabal b/semantic-typescript/semantic-typescript.cabal index f3aff21b4..dec4edf29 100644 --- a/semantic-typescript/semantic-typescript.cabal +++ b/semantic-typescript/semantic-typescript.cabal @@ -52,5 +52,6 @@ library exposed-modules: Language.TypeScript Language.TypeScript.AST + Language.TypeScript.Grammar Language.TypeScript.Tags hs-source-dirs: src From 02420957f9edae456dfaf9dac2dc811d7f95dab4 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Wed, 29 Jan 2020 11:56:52 -0500 Subject: [PATCH 109/235] update TreeSitter.TypeScript to Language.TypeScript.Grammar --- semantic-typescript/src/Language/TypeScript.hs | 4 ++-- semantic-typescript/src/Language/TypeScript/AST.hs | 2 +- src/Language/TypeScript/Assignment.hs | 2 +- src/Parsing/Parser.hs | 2 +- 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/semantic-typescript/src/Language/TypeScript.hs b/semantic-typescript/src/Language/TypeScript.hs index 935d3e923..29460afc1 100644 --- a/semantic-typescript/src/Language/TypeScript.hs +++ b/semantic-typescript/src/Language/TypeScript.hs @@ -2,14 +2,14 @@ -- | Semantic functionality for TypeScript programs. module Language.TypeScript ( Term(..) -, TreeSitter.TypeScript.tree_sitter_typescript +, Language.TypeScript.Grammar.tree_sitter_typescript ) where import Data.Proxy import qualified Language.TypeScript.AST as TypeScript import qualified Language.TypeScript.Tags as TsTags import qualified Tags.Tagging.Precise as Tags -import qualified TreeSitter.TypeScript (tree_sitter_typescript) +import qualified Language.TypeScript.Grammar (tree_sitter_typescript) import qualified AST.Unmarshal as TS newtype Term a = Term { getTerm :: TypeScript.Program a } diff --git a/semantic-typescript/src/Language/TypeScript/AST.hs b/semantic-typescript/src/Language/TypeScript/AST.hs index 667f93937..e55c62f4b 100644 --- a/semantic-typescript/src/Language/TypeScript/AST.hs +++ b/semantic-typescript/src/Language/TypeScript/AST.hs @@ -16,6 +16,6 @@ module Language.TypeScript.AST import Prelude hiding (False, Float, Integer, String, True) import AST.GenerateSyntax -import qualified TreeSitter.TypeScript as Grammar +import qualified Language.TypeScript.Grammar as Grammar astDeclarationsForLanguage Grammar.tree_sitter_typescript "../../../vendor/tree-sitter-typescript/typescript/src/node-types.json" diff --git a/src/Language/TypeScript/Assignment.hs b/src/Language/TypeScript/Assignment.hs index a02a38db4..08a09e9e4 100644 --- a/src/Language/TypeScript/Assignment.hs +++ b/src/Language/TypeScript/Assignment.hs @@ -34,7 +34,7 @@ import qualified Language.TypeScript.Syntax as TypeScript.Syntax import qualified Language.TypeScript.Resolution as TypeScript.Resolution import Language.TypeScript.Term as TypeScript import Prologue -import TreeSitter.TypeScript as Grammar +import Language.TypeScript.Grammar as Grammar type Assignment = Assignment.Assignment [] Grammar diff --git a/src/Parsing/Parser.hs b/src/Parsing/Parser.hs index c23df9a61..f629b5399 100644 --- a/src/Parsing/Parser.hs +++ b/src/Parsing/Parser.hs @@ -67,7 +67,7 @@ import TreeSitter.PHP import Language.Python.Grammar import Language.Ruby.Grammar (tree_sitter_ruby) import TreeSitter.TSX -import TreeSitter.TypeScript +import Language.TypeScript.Grammar import AST.Unmarshal -- | A parser from 'Source' onto some term type. From 8cd964b30abd2e415d2f0660da943707098b1b3c Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Wed, 29 Jan 2020 12:08:48 -0500 Subject: [PATCH 110/235] Create Grammar.hs --- semantic-go/src/Language/Go/Grammar.hs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) create mode 100644 semantic-go/src/Language/Go/Grammar.hs diff --git a/semantic-go/src/Language/Go/Grammar.hs b/semantic-go/src/Language/Go/Grammar.hs new file mode 100644 index 000000000..999aea0fb --- /dev/null +++ b/semantic-go/src/Language/Go/Grammar.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE TemplateHaskell #-} +module Language.Go.Grammar +( tree_sitter_go +, Grammar(..) +) where + +import Language.Haskell.TH +import TreeSitter.Go.Internal +import TreeSitter.Language + +-- Regenerate template haskell code when these files change: +addDependentFileRelative "../../../vendor/tree-sitter-go/src/parser.c" + +-- | Statically-known rules corresponding to symbols in the grammar. +mkSymbolDatatype (mkName "Grammar") tree_sitter_go From 4fbc60161740dbb14e612d57fe982daeeb789dac Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Wed, 29 Jan 2020 12:09:22 -0500 Subject: [PATCH 111/235] Depend on Language.Go.Grammar instead of TreeSitter.Go --- semantic-go/semantic-go.cabal | 1 + semantic-go/src/Language/Go.hs | 4 ++-- semantic-go/src/Language/Go/AST.hs | 2 +- src/Language/Go/Assignment.hs | 2 +- src/Parsing/Parser.hs | 2 +- 5 files changed, 6 insertions(+), 5 deletions(-) diff --git a/semantic-go/semantic-go.cabal b/semantic-go/semantic-go.cabal index f94995c5c..8ea783dc1 100644 --- a/semantic-go/semantic-go.cabal +++ b/semantic-go/semantic-go.cabal @@ -52,5 +52,6 @@ library exposed-modules: Language.Go Language.Go.AST + Language.Go.Grammar Language.Go.Tags hs-source-dirs: src diff --git a/semantic-go/src/Language/Go.hs b/semantic-go/src/Language/Go.hs index 4e7ef430a..8bbf54b47 100644 --- a/semantic-go/src/Language/Go.hs +++ b/semantic-go/src/Language/Go.hs @@ -1,7 +1,7 @@ -- | Semantic functionality for Go programs. module Language.Go ( Term(..) -, TreeSitter.Go.tree_sitter_go +, Language.Go.Grammar.tree_sitter_go ) where @@ -9,7 +9,7 @@ import Data.Proxy import qualified Language.Go.AST as Go import qualified Language.Go.Tags as GoTags import qualified Tags.Tagging.Precise as Tags -import qualified TreeSitter.Go (tree_sitter_go) +import qualified Language.Go.Grammar (tree_sitter_go) import qualified AST.Unmarshal as TS newtype Term a = Term { getTerm :: Go.SourceFile a } diff --git a/semantic-go/src/Language/Go/AST.hs b/semantic-go/src/Language/Go/AST.hs index 158b97228..7b4499a9b 100644 --- a/semantic-go/src/Language/Go/AST.hs +++ b/semantic-go/src/Language/Go/AST.hs @@ -16,6 +16,6 @@ module Language.Go.AST import Prelude hiding (False, Float, Integer, Rational, String, True) import AST.GenerateSyntax -import qualified TreeSitter.Go as Grammar +import qualified Language.Go.Grammar as Grammar astDeclarationsForLanguage Grammar.tree_sitter_go "../../../vendor/tree-sitter-go/src/node-types.json" \ No newline at end of file diff --git a/src/Language/Go/Assignment.hs b/src/Language/Go/Assignment.hs index 269bd20b4..62f9e013f 100644 --- a/src/Language/Go/Assignment.hs +++ b/src/Language/Go/Assignment.hs @@ -26,7 +26,7 @@ import Language.Go.Syntax as Go.Syntax hiding (runeLiteral, labelName) import Language.Go.Term as Go import Language.Go.Type as Go.Type import Data.ImportPath (importPath, defaultAlias) -import TreeSitter.Go as Grammar +import Language.Go.Grammar as Grammar type Assignment = Assignment.Assignment [] Grammar diff --git a/src/Parsing/Parser.hs b/src/Parsing/Parser.hs index f629b5399..d05a40291 100644 --- a/src/Parsing/Parser.hs +++ b/src/Parsing/Parser.hs @@ -61,7 +61,7 @@ import qualified Language.TypeScript as TypeScriptPrecise import qualified Language.TypeScript.Assignment as TypeScriptALaCarte import Prelude hiding (fail) import Prologue -import TreeSitter.Go +import Language.Go.Grammar import qualified TreeSitter.Language as TS (Language, Symbol) import TreeSitter.PHP import Language.Python.Grammar From a53495d3b4f6f6e2840204dd22497c2ef90e8af9 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 29 Jan 2020 12:32:53 -0500 Subject: [PATCH 112/235] Merge fallout. --- src/Data/Project.hs | 1 + src/Semantic/Graph.hs | 4 ---- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/src/Data/Project.hs b/src/Data/Project.hs index ca5964341..e0c698bf2 100644 --- a/src/Data/Project.hs +++ b/src/Data/Project.hs @@ -13,6 +13,7 @@ import Control.Monad.IO.Class import Data.Blob import Data.Blob.IO import Data.Language +import Data.Semilattice.Lower import Data.Text (Text) import qualified Data.Text as T import Semantic.IO diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index c354d26b7..88bf57fcb 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -71,12 +71,8 @@ import Data.Functor.Foldable import Data.Graph import Data.Graph.ControlFlowVertex (VertexDeclaration) import Data.Language as Language -<<<<<<< HEAD import Data.List (find, isPrefixOf, isSuffixOf) import Data.Map (Map) -======= -import Data.List (isPrefixOf) ->>>>>>> origin/master import qualified Data.Map as Map import Data.Project import Data.Proxy From 31e0ba5b32d7cc76118ef85d1ba1412acf5b8e49 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 29 Jan 2020 12:41:14 -0500 Subject: [PATCH 113/235] :note: De-prologuify semantic-lib internals. --- src/Data/Blob/IO.hs | 4 ++-- src/Data/Syntax/Directive.hs | 12 +++++++++--- src/Semantic/Api/Symbols.hs | 5 ++++- src/Semantic/CLI.hs | 1 - src/Semantic/Telemetry/Stat.hs | 6 ++++-- 5 files changed, 19 insertions(+), 9 deletions(-) diff --git a/src/Data/Blob/IO.hs b/src/Data/Blob/IO.hs index 74ef6d8ff..7ceae0e47 100644 --- a/src/Data/Blob/IO.hs +++ b/src/Data/Blob/IO.hs @@ -9,13 +9,13 @@ module Data.Blob.IO , readFilePair ) where -import Prologue - import Analysis.File as File import qualified Control.Concurrent.Async as Async +import Control.Monad.IO.Class import Data.Blob import qualified Data.ByteString as B import Data.Language +import Data.Maybe.Exts import Semantic.IO import qualified Source.Source as Source import qualified System.Path as Path diff --git a/src/Data/Syntax/Directive.hs b/src/Data/Syntax/Directive.hs index 145fc469b..580219167 100644 --- a/src/Data/Syntax/Directive.hs +++ b/src/Data/Syntax/Directive.hs @@ -1,13 +1,19 @@ -{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE UndecidableInstances #-} module Data.Syntax.Directive (module Data.Syntax.Directive) where -import Prologue - import Data.Abstract.Evaluatable import Data.Abstract.Module (ModuleInfo (..)) +import Data.Functor.Classes.Generic +import Data.Hashable.Lifted import Data.JSON.Fields import qualified Data.Text as T import Diffing.Algorithm +import GHC.Generics (Generic1) import Source.Span -- A file directive like the Ruby constant `__FILE__`. diff --git a/src/Semantic/Api/Symbols.hs b/src/Semantic/Api/Symbols.hs index caa4912b2..cbc0e5285 100644 --- a/src/Semantic/Api/Symbols.hs +++ b/src/Semantic/Api/Symbols.hs @@ -24,12 +24,15 @@ import Control.Lens import Data.Abstract.Declarations import Data.Blob import Data.ByteString.Builder +import Data.Foldable +import Data.Functor.Foldable import Data.Language +import Data.Map.Strict (Map) import Data.ProtoLens (defMessage) import Data.Term (IsTerm (..), TermF) +import Data.Text (Text) import Data.Text (pack) import qualified Parsing.Parser as Parser -import Prologue import Proto.Semantic as P hiding (Blob, BlobPair) import Proto.Semantic_Fields as P import Proto.Semantic_JSON () diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 5a6399ea4..9ef32f854 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -7,7 +7,6 @@ import qualified Control.Carrier.Parse.Measured as Parse import Control.Carrier.Reader import Control.Exception import Control.Monad.IO.Class -import Data.Blob import Data.Blob.IO import Data.Either import qualified Data.Flag as Flag diff --git a/src/Semantic/Telemetry/Stat.hs b/src/Semantic/Telemetry/Stat.hs index 304103776..2c8f78e95 100644 --- a/src/Semantic/Telemetry/Stat.hs +++ b/src/Semantic/Telemetry/Stat.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE FlexibleInstances, RecordWildCards #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RecordWildCards #-} module Semantic.Telemetry.Stat ( -- Primary API for creating stats. @@ -28,6 +29,8 @@ module Semantic.Telemetry.Stat ) where +import Control.Monad +import Control.Monad.IO.Class import qualified Data.ByteString.Char8 as B import Data.List (intercalate) import Data.List.Split (splitOneOf) @@ -36,7 +39,6 @@ import Network.Socket (Socket (..), SocketType (..), addrAddress, addrFamily, close, connect, defaultProtocol, getAddrInfo, socket) import Network.Socket.ByteString import Numeric -import Prologue import System.IO.Error -- | A named piece of data you wish to record a specific 'Metric' for. From ee95a399b544e34ce754fb9567b44f8a64787c76 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 29 Jan 2020 12:47:18 -0500 Subject: [PATCH 114/235] De-Prologue the Data.Syntax hierarchy. --- src/Data/JSON/Fields.hs | 5 +++- src/Data/Scientific/Exts.hs | 10 ++++---- src/Data/Syntax/Declaration.hs | 42 +++++++++++++++++++++++----------- src/Data/Syntax/Expression.hs | 28 +++++++++++++++++++---- src/Data/Syntax/Literal.hs | 15 ++++++++++-- src/Data/Syntax/Statement.hs | 21 +++++++++++++---- src/Data/Syntax/Type.hs | 15 +++++++++--- 7 files changed, 103 insertions(+), 33 deletions(-) diff --git a/src/Data/JSON/Fields.hs b/src/Data/JSON/Fields.hs index ad1e0722d..cf98bb5d4 100644 --- a/src/Data/JSON/Fields.hs +++ b/src/Data/JSON/Fields.hs @@ -17,12 +17,15 @@ module Data.JSON.Fields ) where import Data.Aeson +import Data.Bifunctor.Join import Data.Edit import qualified Data.Map as Map +import Data.Maybe import Data.ScopeGraph +import Data.Sum +import Data.Text (Text) import qualified Data.Text as Text import GHC.Generics -import Prologue import Source.Loc import Source.Range diff --git a/src/Data/Scientific/Exts.hs b/src/Data/Scientific/Exts.hs index 93a2429cc..4ad5b1d31 100644 --- a/src/Data/Scientific/Exts.hs +++ b/src/Data/Scientific/Exts.hs @@ -6,16 +6,16 @@ module Data.Scientific.Exts ) where import Control.Applicative -import Control.Exception as Exc (evaluate, try) +import Control.Exception as Exc (ArithException, evaluate, try) import Control.Monad hiding (fail) +import Control.Monad.Fail import Data.Attoparsec.Text -import Data.Text hiding (takeWhile) import Data.Char (isDigit) import Data.Scientific -import Prelude hiding (fail, filter, null, takeWhile) -import Prologue hiding (null) -import System.IO.Unsafe +import Data.Text hiding (takeWhile) import Numeric.Exts +import Prelude hiding (fail, filter, null, takeWhile) +import System.IO.Unsafe parseScientific :: Text -> Either String Scientific parseScientific = parseOnly parser diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 8c0dd2e55..26854beff 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -1,11 +1,27 @@ -{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, FlexibleContexts, MultiParamTypeClasses, RecordWildCards, ScopedTypeVariables, TypeApplications, TupleSections, UndecidableInstances #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE UndecidableInstances #-} module Data.Syntax.Declaration (module Data.Syntax.Declaration) where -import Prologue import Control.Lens.Getter +import Control.Monad +import Data.Foldable +import Data.Functor.Classes.Generic +import Data.Hashable.Lifted import qualified Data.Map.Strict as Map +import Data.Maybe.Exts +import Data.Semilattice.Lower import qualified Data.Set as Set +import Data.Traversable +import GHC.Generics (Generic1) import Control.Abstract hiding (AccessControl (..), Function) import Data.Abstract.Evaluatable @@ -65,11 +81,11 @@ 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 + { methodContext :: [a] + , methodReceiver :: a + , methodName :: a + , methodParameters :: [a] + , methodBody :: a , methodAccessControl :: ScopeGraph.AccessControl } deriving (Foldable, Traversable, Functor, Generic1, Hashable1, ToJSONFields1) @@ -106,9 +122,9 @@ instance FreeVariables1 Method where -- | A method signature in TypeScript or a method spec in Go. data MethodSignature a = MethodSignature - { methodSignatureContext :: [a] - , methodSignatureName :: a - , methodSignatureParameters :: [a] + { methodSignatureContext :: [a] + , methodSignatureName :: a + , methodSignatureParameters :: [a] , methodSignatureAccessControl :: ScopeGraph.AccessControl } deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) @@ -193,9 +209,9 @@ instance Declarations a => Declarations (InterfaceDeclaration a) where -- | A public field definition such as a field definition in a JavaScript class. data PublicFieldDefinition a = PublicFieldDefinition - { publicFieldContext :: [a] - , publicFieldPropertyName :: a - , publicFieldValue :: a + { publicFieldContext :: [a] + , publicFieldPropertyName :: a + , publicFieldValue :: a , publicFieldAccessControl :: ScopeGraph.AccessControl } deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs index e525e017f..bf5915f49 100644 --- a/src/Data/Syntax/Expression.hs +++ b/src/Data/Syntax/Expression.hs @@ -1,19 +1,39 @@ -{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields, FlexibleContexts, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TypeApplications, UndecidableInstances #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE UndecidableInstances #-} module Data.Syntax.Expression (module Data.Syntax.Expression) where import Prelude hiding (null) -import Prologue hiding (index, null) import Analysis.Name as Name import Control.Abstract hiding (Bitwise (..), Call) +import Control.Applicative +import Control.Monad import Data.Abstract.Evaluatable as Abstract import Data.Abstract.Number (liftIntegralFrac, liftReal, liftedExponent, liftedFloorDiv) +import qualified Data.Abstract.ScopeGraph as ScopeGraph +import Data.Bits import Data.Fixed +import Data.Foldable (for_) +import Data.Functor.Classes.Generic +import Data.Hashable.Lifted import Data.JSON.Fields +import Data.List (find) +import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Map.Strict as Map +import Data.Maybe +import Data.Maybe.Exts import Diffing.Algorithm hiding (Delete) -import qualified Data.Abstract.ScopeGraph as ScopeGraph +import GHC.Generics (Generic1) -- | Typical prefix function application, like `f(x)` in many languages, or `f x` in Haskell. data Call a = Call { callContext :: ![a], callFunction :: !a, callParams :: ![a], callBlock :: !a } @@ -454,7 +474,7 @@ instance Evaluatable MemberAccess where case lhsFrame of Just lhsFrame -> withScopeAndFrame lhsFrame (ref' rhs) -- Throw a ReferenceError since we're attempting to reference a name within a value that is not an Object. - Nothing -> throwEvalError (ReferenceError lhsValue rhs) + Nothing -> throwEvalError (ReferenceError lhsValue rhs) -- | Subscript (e.g a[1]) diff --git a/src/Data/Syntax/Literal.hs b/src/Data/Syntax/Literal.hs index 4d3a8569d..c8d139d40 100644 --- a/src/Data/Syntax/Literal.hs +++ b/src/Data/Syntax/Literal.hs @@ -1,14 +1,25 @@ -{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields, OverloadedStrings, RecordWildCards, ScopedTypeVariables, TypeApplications #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} module Data.Syntax.Literal (module Data.Syntax.Literal) where import Prelude hiding (Float, null) -import Prologue hiding (Set, hash, null) +import Control.Monad import Data.Abstract.Evaluatable as Eval +import Data.Functor.Classes.Generic +import Data.Hashable.Lifted import Data.JSON.Fields import Data.Scientific.Exts +import Data.Text (Text) import qualified Data.Text as T import Diffing.Algorithm +import GHC.Generics (Generic1) import Numeric.Exts import Text.Read (readMaybe) diff --git a/src/Data/Syntax/Statement.hs b/src/Data/Syntax/Statement.hs index e09c2db2b..ab2bd5dbb 100644 --- a/src/Data/Syntax/Statement.hs +++ b/src/Data/Syntax/Statement.hs @@ -1,17 +1,28 @@ -{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields, RecordWildCards, ScopedTypeVariables, TypeApplications, UndecidableInstances, ViewPatterns #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} module Data.Syntax.Statement (module Data.Syntax.Statement) where -import Prologue - import Control.Abstract hiding (Break, Catch, Continue, Return, Throw, While) import Data.Abstract.Evaluatable as Abstract hiding (Catch, Throw) -import Data.Aeson (ToJSON1 (..)) -import Data.JSON.Fields import qualified Data.Abstract.ScopeGraph as ScopeGraph +import Data.Aeson (ToJSON1 (..)) +import Data.Functor.Classes.Generic +import Data.Hashable.Lifted +import Data.JSON.Fields +import Data.List.NonEmpty (nonEmpty) import qualified Data.Map.Strict as Map +import Data.Maybe.Exts import Data.Semigroup.App import Data.Semigroup.Foldable import Diffing.Algorithm +import GHC.Generics (Generic1) -- | Imperative sequence of statements/declarations s.t.: -- diff --git a/src/Data/Syntax/Type.hs b/src/Data/Syntax/Type.hs index 010879228..bb6e39b6d 100644 --- a/src/Data/Syntax/Type.hs +++ b/src/Data/Syntax/Type.hs @@ -1,11 +1,20 @@ -{-# LANGUAGE DataKinds, DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields, MultiParamTypeClasses, RecordWildCards, UndecidableInstances #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE UndecidableInstances #-} module Data.Syntax.Type (module Data.Syntax.Type) where import Data.Abstract.Evaluatable +import Data.Functor.Classes.Generic +import Data.Hashable.Lifted import Data.JSON.Fields import Diffing.Algorithm -import Prelude hiding (Bool, Float, Int, Double) -import Prologue hiding (Map) +import GHC.Generics (Generic1) +import Prelude hiding (Bool, Double, Float, Int) data Array a = Array { arraySize :: Maybe a, arrayElementType :: a } deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) From ec990b44773f5d0eb879560822eab8a000d4d329 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 29 Jan 2020 12:59:41 -0500 Subject: [PATCH 115/235] De-prologuify some Api modules. --- src/Semantic/Api/Diffs.hs | 20 +++++++++++++++----- src/Semantic/Api/Terms.hs | 23 ++++++++++++++++++----- src/Semantic/Telemetry/Log.hs | 9 +++++---- 3 files changed, 38 insertions(+), 14 deletions(-) diff --git a/src/Semantic/Api/Diffs.hs b/src/Semantic/Api/Diffs.hs index 6465e1310..fbb1b4aa2 100644 --- a/src/Semantic/Api/Diffs.hs +++ b/src/Semantic/Api/Diffs.hs @@ -1,4 +1,10 @@ -{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleContexts, FlexibleInstances, MonoLocalBinds, RankNTypes, UndecidableInstances #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE UndecidableInstances #-} module Semantic.Api.Diffs ( parseDiffBuilder , DiffOutputFormat(..) @@ -13,23 +19,27 @@ import Control.Effect.Parse import Control.Effect.Reader import Control.Exception import Control.Lens +import Control.Monad import Control.Monad.IO.Class +import Data.Bifoldable import Data.Blob import Data.ByteString.Builder import Data.Diff import Data.Edit +import Data.Foldable +import Data.Functor.Classes import Data.Graph import Data.JSON.Fields (ToJSONFields1) import Data.Language +import Data.Map.Strict (Map) import Data.ProtoLens (defMessage) -import Data.Term (IsTerm(..)) +import Data.Term (IsTerm (..)) import qualified Data.Text as T -import Diffing.Interpreter (DiffTerms(..)) +import Diffing.Interpreter (DiffTerms (..)) import Parsing.Parser -import Prologue import Proto.Semantic as P hiding (Blob, BlobPair) import Proto.Semantic_Fields as P -import Proto.Semantic_JSON() +import Proto.Semantic_JSON () import Rendering.Graph import Rendering.JSON hiding (JSON) import qualified Rendering.JSON diff --git a/src/Semantic/Api/Terms.hs b/src/Semantic/Api/Terms.hs index ac63a15a0..6935e1ef0 100644 --- a/src/Semantic/Api/Terms.hs +++ b/src/Semantic/Api/Terms.hs @@ -1,4 +1,14 @@ -{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeFamilies, UndecidableInstances #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -freduction-depth=0 #-} module Semantic.Api.Terms ( termGraph @@ -16,17 +26,20 @@ import Data.Aeson (ToJSON) import Data.Blob import Data.ByteString.Builder import Data.Either +import Data.Foldable +import Data.Functor.Classes +import Data.Functor.Foldable import Data.Graph import Data.Language +import Data.Map.Strict (Map) import Data.ProtoLens (defMessage) import Data.Quieterm import Data.Term import qualified Data.Text as T import Parsing.Parser -import Prologue import Proto.Semantic as P hiding (Blob) import Proto.Semantic_Fields as P -import Proto.Semantic_JSON() +import Proto.Semantic_JSON () import Rendering.Graph import Rendering.JSON hiding (JSON) import qualified Rendering.JSON @@ -39,13 +52,13 @@ import qualified Serializing.SExpression as SExpr import qualified Serializing.SExpression.Precise as SExpr.Precise (serializeSExpression) import Source.Loc +import qualified Language.Go as GoPrecise import qualified Language.Java as Java import qualified Language.JSON as JSON -import qualified Language.Go as GoPrecise import qualified Language.Python as PythonPrecise import qualified Language.Ruby as RubyPrecise -import qualified Language.TypeScript as TypeScriptPrecise import qualified Language.TSX as TSXPrecise +import qualified Language.TypeScript as TypeScriptPrecise termGraph :: (Traversable t, Has Distribute sig m, Has (Error SomeException) sig m, Has Parse sig m) => t Blob -> m ParseTreeGraphResponse diff --git a/src/Semantic/Telemetry/Log.hs b/src/Semantic/Telemetry/Log.hs index 81986dc95..c6d837400 100644 --- a/src/Semantic/Telemetry/Log.hs +++ b/src/Semantic/Telemetry/Log.hs @@ -9,12 +9,13 @@ module Semantic.Telemetry.Log , writeLogMessage ) where +import Control.Monad.IO.Class +import Data.Bifunctor import Data.Error (Colourize (..), withSGRCode) import Data.Flag as Flag import Data.List (intersperse) import qualified Data.Time.Format as Time import qualified Data.Time.LocalTime as LocalTime -import Prologue import System.Console.ANSI import System.IO import Text.Printf @@ -36,9 +37,9 @@ data Level -- | Options for controlling logging data LogOptions = LogOptions - { logOptionsLevel :: Maybe Level -- ^ What level of messages to log. 'Nothing' disabled logging. - , logOptionsFormatter :: LogFormatter -- ^ Log formatter to use. - , logOptionsContext :: [(String, String)] + { logOptionsLevel :: Maybe Level -- ^ What level of messages to log. 'Nothing' disabled logging. + , logOptionsFormatter :: LogFormatter -- ^ Log formatter to use. + , logOptionsContext :: [(String, String)] } -- | Write a log a message to stderr. From aa8b789049a466a7bd9efab545d62a819ca16a07 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 29 Jan 2020 13:04:07 -0500 Subject: [PATCH 116/235] De-prologuify the Typescript syntax modules. --- src/Data/Syntax/Comment.hs | 12 +++++++--- src/Language/TSX/Syntax/JSX.hs | 10 +++++--- src/Language/TypeScript/Syntax/Import.hs | 25 ++++++++++++++------ src/Language/TypeScript/Syntax/JavaScript.hs | 12 +++++++--- src/Language/TypeScript/Syntax/TypeScript.hs | 21 ++++++++++++---- src/Language/TypeScript/Syntax/Types.hs | 14 +++++++---- 6 files changed, 70 insertions(+), 24 deletions(-) diff --git a/src/Data/Syntax/Comment.hs b/src/Data/Syntax/Comment.hs index bd86028f7..2496782ae 100644 --- a/src/Data/Syntax/Comment.hs +++ b/src/Data/Syntax/Comment.hs @@ -1,11 +1,17 @@ -{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DerivingVia, MultiParamTypeClasses #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE MultiParamTypeClasses #-} module Data.Syntax.Comment (module Data.Syntax.Comment) where -import Prologue - import Data.Abstract.Evaluatable +import Data.Functor.Classes.Generic +import Data.Hashable.Lifted import Data.JSON.Fields +import Data.Text (Text) import Diffing.Algorithm +import GHC.Generics (Generic1) -- | An unnested comment (line or block). newtype Comment a = Comment { commentContent :: Text } diff --git a/src/Language/TSX/Syntax/JSX.hs b/src/Language/TSX/Syntax/JSX.hs index 73123621f..577b01916 100644 --- a/src/Language/TSX/Syntax/JSX.hs +++ b/src/Language/TSX/Syntax/JSX.hs @@ -1,12 +1,16 @@ -{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DuplicateRecordFields #-} module Language.TSX.Syntax.JSX (module Language.TSX.Syntax.JSX) where -import Prologue - import Data.Abstract.Evaluatable +import Data.Functor.Classes.Generic +import Data.Hashable.Lifted import Data.JSON.Fields import qualified Data.Text as T import Diffing.Algorithm +import GHC.Generics (Generic1) data JsxElement a = JsxElement { jsxOpeningElement :: !a, jsxElements :: ![a], jsxClosingElement :: !a } diff --git a/src/Language/TypeScript/Syntax/Import.hs b/src/Language/TypeScript/Syntax/Import.hs index 61fe3c5d4..3f084fa7a 100644 --- a/src/Language/TypeScript/Syntax/Import.hs +++ b/src/Language/TypeScript/Syntax/Import.hs @@ -1,17 +1,28 @@ -{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields, OverloadedStrings, RecordWildCards, TypeApplications #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} module Language.TypeScript.Syntax.Import (module Language.TypeScript.Syntax.Import) where -import Prologue - import qualified Analysis.Name as Name import Control.Abstract hiding (Import) +import Control.Monad import Data.Abstract.Evaluatable as Evaluatable import qualified Data.Abstract.ScopeGraph as ScopeGraph +import Data.Aeson (ToJSON) +import Data.Foldable +import Data.Functor.Classes.Generic +import Data.Hashable +import Data.Hashable.Lifted import Data.JSON.Fields -import Diffing.Algorithm -import Language.TypeScript.Resolution import qualified Data.Map.Strict as Map -import Data.Aeson (ToJSON) +import Data.Semilattice.Lower +import Diffing.Algorithm +import GHC.Generics (Generic, Generic1) +import Language.TypeScript.Resolution data Import a = Import { importSymbols :: ![Alias], importFrom :: ImportPath } deriving (Declarations1, Diffable, Foldable, FreeVariables1, Functor, Generic1, Hashable1, ToJSONFields1, Traversable) @@ -25,7 +36,7 @@ instance Evaluatable Import where eval _ _ (Import symbols importPath) = do modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions ((moduleScope, moduleFrame), _) <- require modulePath - if Prologue.null symbols then do + if Prelude.null symbols then do insertImportEdge moduleScope insertFrameLink ScopeGraph.Import (Map.singleton moduleScope moduleFrame) else do diff --git a/src/Language/TypeScript/Syntax/JavaScript.hs b/src/Language/TypeScript/Syntax/JavaScript.hs index d5918b3b6..6577dba90 100644 --- a/src/Language/TypeScript/Syntax/JavaScript.hs +++ b/src/Language/TypeScript/Syntax/JavaScript.hs @@ -1,15 +1,21 @@ -{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields, RecordWildCards, TypeApplications #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} module Language.TypeScript.Syntax.JavaScript (module Language.TypeScript.Syntax.JavaScript) where -import Prologue - import Control.Abstract.Heap import Control.Abstract.ScopeGraph hiding (Import) import Data.Abstract.Evaluatable import qualified Data.Abstract.ScopeGraph as ScopeGraph +import Data.Functor.Classes.Generic +import Data.Hashable.Lifted import Data.JSON.Fields import qualified Data.Map.Strict as Map import Diffing.Algorithm +import GHC.Generics (Generic1) import Language.TypeScript.Resolution newtype ImplementsClause a = ImplementsClause { implementsClauseTypes :: [a] } diff --git a/src/Language/TypeScript/Syntax/TypeScript.hs b/src/Language/TypeScript/Syntax/TypeScript.hs index 8b0cf2c92..76e16447a 100644 --- a/src/Language/TypeScript/Syntax/TypeScript.hs +++ b/src/Language/TypeScript/Syntax/TypeScript.hs @@ -1,17 +1,30 @@ -{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields, FlexibleContexts, RecordWildCards, TupleSections, TypeApplications #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} module Language.TypeScript.Syntax.TypeScript (module Language.TypeScript.Syntax.TypeScript) where -import Prologue - import Control.Abstract hiding (Import) +import Control.Monad import Data.Abstract.Evaluatable as Evaluatable +import qualified Data.Abstract.ScopeGraph as ScopeGraph +import Data.Foldable +import Data.Functor.Classes.Generic +import Data.Hashable.Lifted import Data.JSON.Fields +import Data.List.NonEmpty (nonEmpty) import qualified Data.Map.Strict as Map +import Data.Maybe.Exts import Data.Semigroup.App import Data.Semigroup.Foldable import qualified Data.Text as T +import Data.Traversable import Diffing.Algorithm -import qualified Data.Abstract.ScopeGraph as ScopeGraph +import GHC.Generics (Generic1) -- | ShorthandPropertyIdentifier used in object patterns such as var baz = { foo } to mean var baz = { foo: foo } newtype ShorthandPropertyIdentifier a = ShorthandPropertyIdentifier { contents :: T.Text } diff --git a/src/Language/TypeScript/Syntax/Types.hs b/src/Language/TypeScript/Syntax/Types.hs index 47acf759d..b0788ba83 100644 --- a/src/Language/TypeScript/Syntax/Types.hs +++ b/src/Language/TypeScript/Syntax/Types.hs @@ -1,14 +1,20 @@ -{-# LANGUAGE DeriveAnyClass, DeriveGeneric, DeriveTraversable, DuplicateRecordFields, RecordWildCards, TypeApplications #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeApplications #-} module Language.TypeScript.Syntax.Types (module Language.TypeScript.Syntax.Types) where -import Prologue - import Control.Abstract hiding (Import) import Data.Abstract.Evaluatable as Evaluatable +import qualified Data.Abstract.ScopeGraph as ScopeGraph +import Data.Functor.Classes.Generic +import Data.Hashable.Lifted import Data.JSON.Fields import qualified Data.Text as T import Diffing.Algorithm -import qualified Data.Abstract.ScopeGraph as ScopeGraph +import GHC.Generics (Generic1) -- | Lookup type for a type-level key in a typescript map. data LookupType a = LookupType { lookupTypeIdentifier :: a, lookupTypeKey :: a } From dab1f4b7340c0f3da297c42989c4cc3830f64896 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 29 Jan 2020 13:11:38 -0500 Subject: [PATCH 117/235] Last few changes. --- .../Abstract/Caching/FlowInsensitive.hs | 18 ++-- .../Abstract/Caching/FlowSensitive.hs | 18 +++- src/Control/Carrier/Parse/Measured.hs | 16 +++- src/Data/Abstract/Address/Hole.hs | 10 ++- src/Data/Abstract/Address/Monovariant.hs | 22 +++-- src/Data/Abstract/Address/Precise.hs | 7 +- src/Data/Abstract/Value/Abstract.hs | 38 +++++---- src/Data/Abstract/Value/Concrete.hs | 25 ++++-- src/Data/Abstract/Value/Type.hs | 85 +++++++++++-------- 9 files changed, 154 insertions(+), 85 deletions(-) diff --git a/src/Analysis/Abstract/Caching/FlowInsensitive.hs b/src/Analysis/Abstract/Caching/FlowInsensitive.hs index b3119db29..c38948fd3 100644 --- a/src/Analysis/Abstract/Caching/FlowInsensitive.hs +++ b/src/Analysis/Abstract/Caching/FlowInsensitive.hs @@ -1,17 +1,25 @@ -{-# LANGUAGE DeriveFunctor, FlexibleContexts, GeneralizedNewtypeDeriving, TypeApplications, TypeOperators #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} module Analysis.Abstract.Caching.FlowInsensitive ( cachingTerms , convergingModules , caching ) where -import Prologue - import Control.Algebra (Effect) import Control.Carrier.Fresh.Strict import Control.Carrier.NonDet.Church import Control.Carrier.Reader import Control.Carrier.State.Strict +import Data.Bifunctor +import Data.Foldable +import Data.Functor.Classes +import Data.Maybe.Exts +import Data.Semilattice.Lower +import Data.Set (Set) import Control.Abstract import Data.Abstract.Module @@ -194,8 +202,8 @@ newtype Cache term address value = Cache { unCache :: Monoidal.Map (Configuratio -- | A single point in a program’s execution. data Configuration term address = Configuration - { configurationTerm :: term -- ^ The “instruction,” i.e. the current term to evaluate. - , configurationRoots :: Live address -- ^ The set of rooted addresses. + { configurationTerm :: term -- ^ The “instruction,” i.e. the current term to evaluate. + , configurationRoots :: Live address -- ^ The set of rooted addresses. } deriving (Eq, Ord, Show) diff --git a/src/Analysis/Abstract/Caching/FlowSensitive.hs b/src/Analysis/Abstract/Caching/FlowSensitive.hs index ab1a212ba..e464b83cc 100644 --- a/src/Analysis/Abstract/Caching/FlowSensitive.hs +++ b/src/Analysis/Abstract/Caching/FlowSensitive.hs @@ -1,4 +1,9 @@ -{-# LANGUAGE ConstraintKinds, FlexibleContexts, GADTs, GeneralizedNewtypeDeriving, TypeApplications, TypeOperators #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} module Analysis.Abstract.Caching.FlowSensitive ( Cache , cachingTerms @@ -6,13 +11,18 @@ module Analysis.Abstract.Caching.FlowSensitive , caching ) where -import Prologue - import Control.Algebra (Effect) +import Control.Carrier.Fresh.Strict import Control.Carrier.NonDet.Church import Control.Carrier.Reader -import Control.Carrier.Fresh.Strict import Control.Carrier.State.Strict +import Data.Bifunctor +import Data.Foldable +import Data.Functor +import Data.Functor.Classes +import Data.Maybe.Exts +import Data.Semilattice.Lower +import Data.Set (Set) import Control.Abstract import Data.Abstract.Module diff --git a/src/Control/Carrier/Parse/Measured.hs b/src/Control/Carrier/Parse/Measured.hs index 89bc0c858..9c90ae0e3 100644 --- a/src/Control/Carrier/Parse/Measured.hs +++ b/src/Control/Carrier/Parse/Measured.hs @@ -1,4 +1,11 @@ -{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RecordWildCards, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} -- | A carrier for 'Parse' effects suitable for use in production. module Control.Carrier.Parse.Measured ( -- * Parse carrier @@ -16,17 +23,18 @@ import Control.Effect.Parse import Control.Effect.Reader import Control.Effect.Trace import Control.Exception +import Control.Monad import Control.Monad.IO.Class import Data.Blob import qualified Data.Error as Error import qualified Data.Flag as Flag +import Data.Foldable import qualified Data.Syntax as Syntax import Parsing.CMark import Parsing.Parser import Parsing.TreeSitter -import Prologue hiding (project) import Semantic.Config -import Semantic.Task (TaskSession(..)) +import Semantic.Task (TaskSession (..)) import Semantic.Telemetry import Semantic.Timeout import Source.Source (Source) @@ -43,7 +51,7 @@ instance ( Has (Error SomeException) sig m ) => Algebra (Parse :+: sig) (ParseC m) where alg (L (Parse parser blob k)) = runParser blob parser >>= k - alg (R other) = ParseC (alg (handleCoercible other)) + alg (R other) = ParseC (alg (handleCoercible other)) -- | Parse a 'Blob' in 'IO'. runParser :: (Has (Error SomeException) sig m, Has (Reader TaskSession) sig m, Has Telemetry sig m, Has Timeout sig m, Has Trace sig m, MonadIO m) diff --git a/src/Data/Abstract/Address/Hole.hs b/src/Data/Abstract/Address/Hole.hs index 868e33244..aaaf91a01 100644 --- a/src/Data/Abstract/Address/Hole.hs +++ b/src/Data/Abstract/Address/Hole.hs @@ -1,4 +1,8 @@ -{-# LANGUAGE DeriveTraversable, FlexibleInstances, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Data.Abstract.Address.Hole ( Hole(..) , toMaybe @@ -6,7 +10,7 @@ module Data.Abstract.Address.Hole import Control.Abstract import Control.Algebra -import Prologue +import Data.Semilattice.Lower data Hole context a = Partial context | Total a deriving (Foldable, Functor, Eq, Ord, Show, Traversable) @@ -27,7 +31,7 @@ instance ( Algebra (Allocator address :+: sig) (AllocatorC address m) , Monad m ) => Algebra (Allocator (Hole context address) :+: sig) (AllocatorC (Hole context address) m) where - alg (R other) = AllocatorC . alg . handleCoercible $ other + alg (R other) = AllocatorC . alg . handleCoercible $ other alg (L (Alloc name k)) = Total <$> promoteA (alg (L (Alloc name pure))) >>= k diff --git a/src/Data/Abstract/Address/Monovariant.hs b/src/Data/Abstract/Address/Monovariant.hs index f2fd452c7..b060d578a 100644 --- a/src/Data/Abstract/Address/Monovariant.hs +++ b/src/Data/Abstract/Address/Monovariant.hs @@ -1,13 +1,17 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Data.Abstract.Address.Monovariant ( Monovariant(..) ) where -import Prologue - -import Analysis.Name -import Control.Abstract -import Control.Algebra +import Analysis.Name +import Control.Abstract +import Control.Algebra +import Data.Foldable +import Data.Functor.Classes +import Data.List.NonEmpty (nonEmpty) import qualified Data.Set as Set -- | 'Monovariant' models using one address for a particular name. It tracks the set of values that a particular address takes and uses it's name to lookup in the store and only allocation if new. @@ -20,9 +24,9 @@ instance Show Monovariant where instance Algebra sig m => Algebra (Allocator Monovariant :+: sig) (AllocatorC Monovariant m) where alg (L (Alloc name k)) = k (Monovariant name) - alg (R other) = AllocatorC . alg . handleCoercible $ other + alg (R other) = AllocatorC . alg . handleCoercible $ other instance (Ord value, Algebra sig m, Alternative m, Monad m) => Algebra (Deref value :+: sig) (DerefC Monovariant value m) where - alg (L (DerefCell cell k)) = traverse (foldMapA pure) (nonEmpty (toList cell)) >>= k + alg (L (DerefCell cell k)) = traverse (foldMapA pure) (nonEmpty (toList cell)) >>= k alg (L (AssignCell value cell k)) = k (Set.insert value cell) - alg (R other) = DerefC . alg . handleCoercible $ other + alg (R other) = DerefC . alg . handleCoercible $ other diff --git a/src/Data/Abstract/Address/Precise.hs b/src/Data/Abstract/Address/Precise.hs index a78ae58b6..362bc63d7 100644 --- a/src/Data/Abstract/Address/Precise.hs +++ b/src/Data/Abstract/Address/Precise.hs @@ -1,12 +1,15 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Data.Abstract.Address.Precise ( Precise(..) ) where import Control.Abstract import Control.Algebra +import Data.Functor.Classes import qualified Data.Set as Set -import Prologue -- | 'Precise' models precise store semantics where only the 'Latest' value is taken. Everything gets it's own address (always makes a new allocation) which makes for a larger store. newtype Precise = Precise { unPrecise :: Int } diff --git a/src/Data/Abstract/Value/Abstract.hs b/src/Data/Abstract/Value/Abstract.hs index 12c7e7f95..b45d08284 100644 --- a/src/Data/Abstract/Value/Abstract.hs +++ b/src/Data/Abstract/Value/Abstract.hs @@ -1,4 +1,8 @@ -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, OverloadedStrings, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Data.Abstract.Value.Abstract ( Abstract (..) , runFunction @@ -6,12 +10,12 @@ module Data.Abstract.Value.Abstract , runWhile ) where -import Control.Abstract as Abstract -import Control.Algebra -import Data.Abstract.BaseError -import Data.Abstract.Evaluatable +import Control.Abstract as Abstract +import Control.Algebra +import Data.Abstract.BaseError +import Data.Abstract.Evaluatable +import Data.Foldable import qualified Data.Map.Strict as Map -import Prologue data Abstract = Abstract deriving (Eq, Ord, Show) @@ -76,7 +80,7 @@ instance ( Has (Abstract.Boolean Abstract) sig m instance Algebra sig m => Algebra (Unit Abstract :+: sig) (UnitC Abstract m) where - alg (R other) = UnitC . alg . handleCoercible $ other + alg (R other) = UnitC . alg . handleCoercible $ other alg (L (Abstract.Unit k)) = k Abstract instance Algebra sig m @@ -90,18 +94,18 @@ instance Algebra sig m => Algebra (Numeric Abstract :+: sig) (NumericC Abstract m) where alg (R other) = NumericC . alg . handleCoercible $ other alg (L op) = case op of - Integer _ k -> k Abstract - Float _ k -> k Abstract - Rational _ k -> k Abstract - LiftNumeric _ _ k -> k Abstract + Integer _ k -> k Abstract + Float _ k -> k Abstract + Rational _ k -> k Abstract + LiftNumeric _ _ k -> k Abstract LiftNumeric2 _ _ _ k -> k Abstract instance Algebra sig m => Algebra (Bitwise Abstract :+: sig) (BitwiseC Abstract m) where alg (R other) = BitwiseC . alg . handleCoercible $ other alg (L op) = case op of - CastToInteger _ k -> k Abstract - LiftBitwise _ _ k -> k Abstract + CastToInteger _ k -> k Abstract + LiftBitwise _ _ k -> k Abstract LiftBitwise2 _ _ _ k -> k Abstract UnsignedRShift _ _ k -> k Abstract @@ -109,22 +113,22 @@ instance Algebra sig m => Algebra (Object address Abstract :+: sig) (ObjectC address Abstract m) where alg (R other) = ObjectC . alg . handleCoercible $ other alg (L op) = case op of - Object _ k -> k Abstract + Object _ k -> k Abstract ScopedEnvironment _ k -> k Nothing - Klass _ _ k -> k Abstract + Klass _ _ k -> k Abstract instance Algebra sig m => Algebra (Array Abstract :+: sig) (ArrayC Abstract m) where alg (R other) = ArrayC . alg . handleCoercible $ other alg (L op) = case op of - Array _ k -> k Abstract + Array _ k -> k Abstract AsArray _ k -> k [] instance Algebra sig m => Algebra (Hash Abstract :+: sig) (HashC Abstract m) where alg (R other) = HashC . alg . handleCoercible $ other alg (L op) = case op of - Hash _ k -> k Abstract + Hash _ k -> k Abstract KvPair _ _ k -> k Abstract diff --git a/src/Data/Abstract/Value/Concrete.hs b/src/Data/Abstract/Value/Concrete.hs index 94f9c88e7..2382ca2fc 100644 --- a/src/Data/Abstract/Value/Concrete.hs +++ b/src/Data/Abstract/Value/Concrete.hs @@ -1,5 +1,14 @@ -{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, LambdaCase, MultiParamTypeClasses, RankNTypes, - ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Data.Abstract.Value.Concrete ( Value (..) , ValueError (..) @@ -7,15 +16,21 @@ module Data.Abstract.Value.Concrete , runValueErrorWith ) where -import Prologue - import Control.Carrier.Resumable.Either (SomeError) import qualified Control.Carrier.Resumable.Either as Either import qualified Control.Carrier.Resumable.Resume as With +import Control.Exception (ArithException) +import Data.Bits (shiftR) +import Data.Foldable +import Data.Function +import Data.Functor +import Data.Functor.Classes import Data.List (genericIndex, genericLength) import qualified Data.Map.Strict as Map import Data.Scientific.Exts -import Data.Text (pack) +import Data.Semilattice.Lower +import Data.Text (Text, pack) +import Data.Word import Analysis.Name import Control.Abstract hiding diff --git a/src/Data/Abstract/Value/Type.hs b/src/Data/Abstract/Value/Type.hs index 3f4dc6d4d..ed1c77bde 100644 --- a/src/Data/Abstract/Value/Type.hs +++ b/src/Data/Abstract/Value/Type.hs @@ -1,4 +1,15 @@ -{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, LambdaCase, MultiParamTypeClasses, OverloadedStrings, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module Data.Abstract.Value.Type ( Type (..) , TypeError (..) @@ -11,21 +22,23 @@ module Data.Abstract.Value.Type , runWhile ) where -import Prologue hiding (TypeError) - import Control.Algebra -import Control.Carrier.State.Strict -import qualified Control.Carrier.Resumable.Resume as With import Control.Carrier.Resumable.Either (SomeError) import qualified Control.Carrier.Resumable.Either as Either +import qualified Control.Carrier.Resumable.Resume as With +import Control.Carrier.State.Strict +import Control.Monad +import Data.Functor +import Data.Functor.Classes +import Data.List.NonEmpty (NonEmpty, nonEmpty) import qualified Data.Map as Map -import Control.Abstract.ScopeGraph +import Control.Abstract hiding + (Array (..), Boolean (..), Function (..), Hash (..), Numeric (..), Object (..), String (..), Unit (..), While (..)) import qualified Control.Abstract as Abstract -import Control.Abstract hiding (Boolean(..), Function(..), Numeric(..), Object(..), Array(..), Hash(..), String(..), Unit(..), While(..)) -import Data.Abstract.BaseError -import Data.Semigroup.Foldable (foldMap1) -import Data.Abstract.Evaluatable +import Data.Abstract.BaseError +import Data.Abstract.Evaluatable +import Data.Semigroup.Foldable (foldMap1) type TName = Int @@ -81,14 +94,14 @@ deriving instance Show (TypeError resume) instance Eq1 TypeError where liftEq _ (UnificationError a1 b1) (UnificationError a2 b2) = a1 == a2 && b1 == b2 - liftEq _ (InfiniteType a1 b1) (InfiniteType a2 b2) = a1 == a2 && b1 == b2 - liftEq _ _ _ = False + liftEq _ (InfiniteType a1 b1) (InfiniteType a2 b2) = a1 == a2 && b1 == b2 + liftEq _ _ _ = False instance Ord1 TypeError where liftCompare _ (UnificationError a1 b1) (UnificationError a2 b2) = compare a1 a2 <> compare b1 b2 - liftCompare _ (InfiniteType a1 b1) (InfiniteType a2 b2) = compare a1 a2 <> compare b1 b2 - liftCompare _ (InfiniteType _ _) (UnificationError _ _) = LT - liftCompare _ (UnificationError _ _) (InfiniteType _ _) = GT + liftCompare _ (InfiniteType a1 b1) (InfiniteType a2 b2) = compare a1 a2 <> compare b1 b2 + liftCompare _ (InfiniteType _ _) (UnificationError _ _) = LT + liftCompare _ (UnificationError _ _) (InfiniteType _ _) = GT instance Show1 TypeError where liftShowsPrec _ _ = showsPrec @@ -210,17 +223,17 @@ unify a b = do b' <- prune b case (a', b') of (a1 :-> b1, a2 :-> b2) -> (:->) <$> unify a1 a2 <*> unify b1 b2 - (a, Null) -> pure a - (Null, b) -> pure b - (Var id, ty) -> substitute id ty - (ty, Var id) -> substitute id ty - (Array t1, Array t2) -> Array <$> unify t1 t2 + (a, Null) -> pure a + (Null, b) -> pure b + (Var id, ty) -> substitute id ty + (ty, Var id) -> substitute id ty + (Array t1, Array t2) -> Array <$> unify t1 t2 -- FIXME: unifying with sums should distribute nondeterministically. -- FIXME: ordering shouldn’t be significant for undiscriminated sums. - (a1 :+ b1, a2 :+ b2) -> (:+) <$> unify a1 a2 <*> unify b1 b2 - (a1 :* b1, a2 :* b2) -> (:*) <$> unify a1 a2 <*> unify b1 b2 - (t1, t2) | t1 == t2 -> pure t2 - _ -> throwTypeError (UnificationError a b) + (a1 :+ b1, a2 :+ b2) -> (:+) <$> unify a1 a2 <*> unify b1 b2 + (a1 :* b1, a2 :* b2) -> (:*) <$> unify a1 a2 <*> unify b1 b2 + (t1, t2) | t1 == t2 -> pure t2 + _ -> throwTypeError (UnificationError a b) instance Ord address => ValueRoots address Type where valueRoots _ = mempty @@ -290,7 +303,7 @@ instance ( Has (Reader ModuleInfo) sig m , Alternative m ) => Algebra (Abstract.Boolean Type :+: sig) (BooleanC Type m) where - alg (R other) = BooleanC . alg . handleCoercible $ other + alg (R other) = BooleanC . alg . handleCoercible $ other alg (L (Abstract.Boolean _ k)) = k Bool alg (L (Abstract.AsBool t k)) = unify t Bool *> (k True <|> k False) @@ -309,7 +322,7 @@ instance ( Has (Abstract.Boolean Type) sig m instance Algebra sig m => Algebra (Abstract.Unit Type :+: sig) (UnitC Type m) where - alg (R other) = UnitC . alg . handleCoercible $ other + alg (R other) = UnitC . alg . handleCoercible $ other alg (L (Abstract.Unit k)) = k Unit instance ( Has (Reader ModuleInfo) sig m @@ -320,8 +333,8 @@ instance ( Has (Reader ModuleInfo) sig m , Alternative m ) => Algebra (Abstract.String Type :+: sig) (StringC Type m) where - alg (R other) = StringC . alg . handleCoercible $ other - alg (L (Abstract.String _ k)) = k String + alg (R other) = StringC . alg . handleCoercible $ other + alg (L (Abstract.String _ k)) = k String alg (L (Abstract.AsString t k)) = unify t String *> k "" instance ( Has (Reader ModuleInfo) sig m @@ -353,17 +366,17 @@ instance ( Has (Reader ModuleInfo) sig m => Algebra (Abstract.Bitwise Type :+: sig) (BitwiseC Type m) where alg (R other) = BitwiseC . alg . handleCoercible $ other alg (L op) = case op of - CastToInteger t k -> unify t (Int :+ Float :+ Rational) *> k Int - LiftBitwise _ t k -> unify t Int >>= k + CastToInteger t k -> unify t (Int :+ Float :+ Rational) *> k Int + LiftBitwise _ t k -> unify t Int >>= k LiftBitwise2 _ t1 t2 k -> unify Int t1 >>= unify t2 >>= k UnsignedRShift t1 t2 k -> unify Int t2 *> unify Int t1 >>= k instance ( Algebra sig m ) => Algebra (Abstract.Object address Type :+: sig) (ObjectC address Type m) where alg (R other) = ObjectC . alg . handleCoercible $ other alg (L op) = case op of - Abstract.Object _ k -> k Object + Abstract.Object _ k -> k Object Abstract.ScopedEnvironment _ k -> k Nothing - Abstract.Klass _ _ k -> k Object + Abstract.Klass _ _ k -> k Object instance ( Has Fresh sig m , Has (Reader ModuleInfo) sig m @@ -384,8 +397,8 @@ instance ( Has Fresh sig m unify t (Array (Var field)) >> k mempty instance ( Algebra sig m ) => Algebra (Abstract.Hash Type :+: sig) (HashC Type m) where - alg (R other) = HashC . alg . handleCoercible $ other - alg (L (Abstract.Hash t k)) = k (Hash t) + alg (R other) = HashC . alg . handleCoercible $ other + alg (L (Abstract.Hash t k)) = k (Hash t) alg (L (Abstract.KvPair t1 t2 k)) = k (t1 :* t2) @@ -422,8 +435,8 @@ instance ( Has Fresh sig m liftComparison (Concrete _) left right = case (left, right) of (Float, Int) -> pure Bool (Int, Float) -> pure Bool - _ -> unify left right $> Bool + _ -> unify left right $> Bool liftComparison Generalized left right = case (left, right) of (Float, Int) -> pure Int (Int, Float) -> pure Int - _ -> unify left right $> Bool + _ -> unify left right $> Bool From 6ed3cf2e5544fafb646da47f4ed511b09dcc23a2 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 29 Jan 2020 13:11:43 -0500 Subject: [PATCH 118/235] Excise Prologue from docs. --- docs/coding-style.md | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/docs/coding-style.md b/docs/coding-style.md index 10499aed7..0da77c5a0 100644 --- a/docs/coding-style.md +++ b/docs/coding-style.md @@ -13,8 +13,6 @@ Our CI systems ensure that all patches pass `hlint`'s muster. We have our own se We strongly recommend adding Haddock documentation to any function/data type, unless its purpose is immediately apparent from its name. Comments should describe the "why", type signatures should describe the "what", and the code should describe the "how". -The Haskell Prelude is too minimal for serious work. The `Prologue` module should be imported in most files, as it reexports most of what you need. - # Formatting 2 spaces everywhere. Tabs are forbidden. Haskell indentation can be unpredictable, so generally stick with what your editor suggests. @@ -58,7 +56,7 @@ data Pos = Pos Locally bound variables (such as the arguments to functions, or helpers defined in a `where` clause) can have short names, such as `x` or `go`. Globally bound functions and variables should have descriptive names. -You'll often find yourself implementing functions that conflict with Prelude/Prologue definitions. If this is the case, avoid adding a prefix to these functions, and instead import them qualified. +You'll often find yourself implementing functions that conflict with Prelude definitions. If this is the case, avoid adding a prefix to these functions, and instead import them qualified. ``` haskell -- Broke From 575fc3cf19662cd668b648d8449d486a15e0fec1 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 29 Jan 2020 13:12:01 -0500 Subject: [PATCH 119/235] Delete the file. --- src/Prologue.hs | 77 ------------------------------------------------- 1 file changed, 77 deletions(-) delete mode 100644 src/Prologue.hs diff --git a/src/Prologue.hs b/src/Prologue.hs deleted file mode 100644 index 6fc52080a..000000000 --- a/src/Prologue.hs +++ /dev/null @@ -1,77 +0,0 @@ -{-# LANGUAGE UndecidableInstances #-} -module Prologue - ( module X - , eitherM - , maybeM - , maybeLast - , fromMaybeLast - ) where - - -import Data.Bifunctor.Join as X -import Data.Bits as X -import Data.ByteString as X (ByteString) -import Data.Coerce as X -import Data.Either as X (fromLeft, fromRight) -import Data.Int as X (Int16, Int32, Int64, Int8) -import Data.IntMap as X (IntMap) -import Data.IntSet as X (IntSet) -import Data.Ix as X (Ix (..)) -import Data.List.NonEmpty as X (NonEmpty (..), nonEmpty, some1) -import Data.Map as X (Map) -import Data.Maybe as X -import Data.Semilattice.Lower as X (Lower (..)) -import Data.Sequence as X (Seq) -import Data.Set as X (Set) -import Data.Sum as X ((:<), (:<:), Apply (..), Element, Elements, Sum, inject) -import Data.Text as X (Text) -import Data.Word as X (Word16, Word32, Word64, Word8) -import Debug.Trace as X (traceM, traceShowM) - -import Control.Exception as X hiding (Handler (..), assert, evaluate, throw, throwIO, throwTo) - --- Typeclasses -import Control.Applicative as X -import Control.Arrow as X ((&&&), (***)) -import Control.Effect.NonDet as X (foldMapA) -import Control.Monad as X hiding (fail, return) -import Control.Monad.Fail as X (MonadFail (..)) -import Control.Monad.IO.Class as X (MonadIO (..)) -import Data.Algebra as X -import Data.Bifoldable as X -import Data.Bifunctor as X (Bifunctor (..)) -import Data.Bitraversable as X -import Data.Foldable as X hiding (product, sum) -import Data.Function as X (fix, on, (&)) -import Data.Functor as X (($>)) -import Data.Functor.Classes as X -import Data.Functor.Classes.Generic as X -import Data.Functor.Foldable as X (Base, Corecursive (..), Recursive (..)) -import Data.Hashable as X (Hashable, hash, hashUsing, hashWithSalt) -import Data.Hashable.Lifted as X (Hashable1 (..), hashWithSalt1) -import Data.Monoid as X (First (..), Last (..), Monoid (..)) -import Data.Monoid.Generic as X -import Data.Proxy as X (Proxy (..)) -import Data.Semigroup as X (Semigroup (..)) -import Data.Traversable as X -import Data.Typeable as X (Typeable) - --- Generics -import GHC.Generics as X (Generic, Generic1) -import GHC.Stack as X - -maybeLast :: Foldable t => b -> (a -> b) -> t a -> b -maybeLast b f = maybe b f . getLast . foldMap (Last . Just) - -fromMaybeLast :: Foldable t => a -> t a -> a -fromMaybeLast b = fromMaybe b . getLast . foldMap (Last . Just) - --- | Extract the 'Just' of a 'Maybe' in an 'Applicative' context or, given 'Nothing', run the provided action. -maybeM :: Applicative f => f a -> Maybe a -> f a -maybeM f = maybe f pure -{-# INLINE maybeM #-} - --- Promote a function to either-applicatives. -eitherM :: Applicative f => (a -> f b) -> Either a b -> f b -eitherM f = either f pure -{-# INLINE eitherM #-} From 17af20e9924b64904b001e9ca73b6209a0534c11 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Wed, 29 Jan 2020 13:16:49 -0500 Subject: [PATCH 120/235] fix nesting --- semantic-typescript/src/Language/Grammar.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic-typescript/src/Language/Grammar.hs b/semantic-typescript/src/Language/Grammar.hs index fe991efa0..a45796673 100644 --- a/semantic-typescript/src/Language/Grammar.hs +++ b/semantic-typescript/src/Language/Grammar.hs @@ -9,7 +9,7 @@ import TreeSitter.TypeScript.Internal import TreeSitter.Language -- Regenerate template haskell code when these files change: -addDependentFileRelative "../../../vendor/tree-sitter-typescript/typescript/src/parser.c" +addDependentFileRelative "../../vendor/tree-sitter-typescript/typescript/src/parser.c" -- | Statically-known rules corresponding to symbols in the grammar. mkSymbolDatatype (mkName "Grammar") tree_sitter_typescript From 0a64c78a4caad2cc9569505c5fdd46c4c2a52e78 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 29 Jan 2020 13:18:45 -0500 Subject: [PATCH 121/235] Final fixups --- semantic.cabal | 1 - src/Semantic/Graph.hs | 2 +- src/Semantic/Util.hs | 6 ------ 3 files changed, 1 insertion(+), 8 deletions(-) diff --git a/semantic.cabal b/semantic.cabal index 15f8c7f06..02e041c73 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -255,7 +255,6 @@ library , Tags.Taggable , Tags.Tagging -- Custom Prelude - , Prologue autogen-modules: Paths_semantic other-modules: Paths_semantic build-depends: base >= 4.13 && < 5 diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 88bf57fcb..413b0761e 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -71,7 +71,7 @@ import Data.Functor.Foldable import Data.Graph import Data.Graph.ControlFlowVertex (VertexDeclaration) import Data.Language as Language -import Data.List (find, isPrefixOf, isSuffixOf) +import Data.List (find, isPrefixOf) import Data.Map (Map) import qualified Data.Map as Map import Data.Project diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 280d3bcb7..f3a754047 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -4,10 +4,7 @@ {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} -<<<<<<< HEAD -======= {-# LANGUAGE ViewPatterns #-} ->>>>>>> origin/master {-# OPTIONS_GHC -Wno-missing-signatures -Wno-missing-exported-signatures -Wno-partial-type-signatures -O0 #-} module Semantic.Util ( evaluateProject' @@ -29,10 +26,7 @@ import Control.Carrier.Reader import Control.Carrier.Resumable.Either (SomeError (..)) import Control.Carrier.State.Strict import Control.Carrier.Trace.Printing -<<<<<<< HEAD import Control.Exception hiding (evaluate) -======= ->>>>>>> origin/master import Control.Lens.Getter import Control.Monad import Data.Abstract.Address.Precise as Precise From 5b7384c25a464dd69ac98dfe3373b7039d34a8f6 Mon Sep 17 00:00:00 2001 From: Josh Vera Date: Wed, 29 Jan 2020 13:31:49 -0500 Subject: [PATCH 122/235] Update semantic-scope-graph/src/Control/Effect/Sketch.hs Co-Authored-By: Patrick Thomson --- semantic-scope-graph/src/Control/Effect/Sketch.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic-scope-graph/src/Control/Effect/Sketch.hs b/semantic-scope-graph/src/Control/Effect/Sketch.hs index f2fb98641..417da3cb4 100644 --- a/semantic-scope-graph/src/Control/Effect/Sketch.hs +++ b/semantic-scope-graph/src/Control/Effect/Sketch.hs @@ -89,7 +89,7 @@ declareMaybeName :: Has Sketch sig m -> m Name declareMaybeName maybeName props = do case maybeName of - Just name -> declare name props >> pure name + Just name -> name <$ declare name props _ -> Name.gensym >>= \name -> declare name (props { relation = ScopeGraph.Gensym }) >> pure name -- TODO: Modify props and change Kind to Gensym withScope :: Has Sketch sig m From fed5ebce9801b4bdb38e1388367a22592b5da286 Mon Sep 17 00:00:00 2001 From: joshvera Date: Wed, 29 Jan 2020 14:45:02 -0500 Subject: [PATCH 123/235] remove more imports --- semantic-python/src/Language/Python.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/semantic-python/src/Language/Python.hs b/semantic-python/src/Language/Python.hs index 8aa115835..0539ba4e6 100644 --- a/semantic-python/src/Language/Python.hs +++ b/semantic-python/src/Language/Python.hs @@ -12,8 +12,6 @@ import qualified Tags.Tagging.Precise as Tags import qualified TreeSitter.Python (tree_sitter_python) import qualified TreeSitter.Python.AST as Py import qualified TreeSitter.Unmarshal as TS -import qualified Data.ScopeGraph as ScopeGraph -import qualified Control.Effect.Sketch as Sketch newtype Term a = Term { getTerm :: Py.Module a } From 699f8c343b20ed63731f6176d28f44632f432618 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Wed, 29 Jan 2020 15:44:53 -0500 Subject: [PATCH 124/235] add JSON Grammar datatype --- semantic-json/src/Language/JSON.hs | 4 ++-- semantic-json/src/Language/JSON/AST.hs | 2 +- semantic-json/src/Language/JSON/Grammar.hs | 15 +++++++++++++++ test/Parsing/Spec.hs | 2 +- 4 files changed, 19 insertions(+), 4 deletions(-) create mode 100644 semantic-json/src/Language/JSON/Grammar.hs diff --git a/semantic-json/src/Language/JSON.hs b/semantic-json/src/Language/JSON.hs index 0d168418f..54a0a95da 100644 --- a/semantic-json/src/Language/JSON.hs +++ b/semantic-json/src/Language/JSON.hs @@ -1,13 +1,13 @@ -- | Semantic functionality for JSON programs. module Language.JSON ( Term(..) -, TreeSitter.JSON.tree_sitter_json +, Language.JSON.Grammar.tree_sitter_json ) where import Data.Proxy import qualified Language.JSON.AST as JSON import qualified Tags.Tagging.Precise as Tags -import qualified TreeSitter.JSON (tree_sitter_json) +import qualified Language.JSON.Grammar (tree_sitter_json) import qualified AST.Unmarshal as TS newtype Term a = Term { getTerm :: JSON.Document a } diff --git a/semantic-json/src/Language/JSON/AST.hs b/semantic-json/src/Language/JSON/AST.hs index 4526ddff6..15b02f840 100644 --- a/semantic-json/src/Language/JSON/AST.hs +++ b/semantic-json/src/Language/JSON/AST.hs @@ -15,6 +15,6 @@ module Language.JSON.AST import Prelude hiding (String) import AST.GenerateSyntax -import qualified TreeSitter.JSON as Grammar +import qualified Language.JSON.Grammar as Grammar astDeclarationsForLanguage Grammar.tree_sitter_json "../../../vendor/tree-sitter-json/src/node-types.json" diff --git a/semantic-json/src/Language/JSON/Grammar.hs b/semantic-json/src/Language/JSON/Grammar.hs new file mode 100644 index 000000000..5d6b07dcf --- /dev/null +++ b/semantic-json/src/Language/JSON/Grammar.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE TemplateHaskell #-} +module Language.JSON.Grammar +( tree_sitter_json +, Grammar(..) +) where + +import Language.Haskell.TH +import TreeSitter.JSON.Internal +import TreeSitter.Language + +-- Regenerate template haskell code when these files change: +addDependentFileRelative "../../../vendor/tree-sitter-json/src/parser.c" + +-- | Statically-known rules corresponding to symbols in the grammar. +mkSymbolDatatype (mkName "Grammar") tree_sitter_json diff --git a/test/Parsing/Spec.hs b/test/Parsing/Spec.hs index 741ee1d8e..ee5a8b04e 100644 --- a/test/Parsing/Spec.hs +++ b/test/Parsing/Spec.hs @@ -10,7 +10,7 @@ import Parsing.TreeSitter import Source.Source import SpecHelpers import qualified System.Path as Path -import TreeSitter.JSON (Grammar, tree_sitter_json) +import Language.JSON.Grammar (Grammar, tree_sitter_json) spec :: Spec spec = do From f2d3b140325277b4f7da7e8762b53043e157a874 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Wed, 29 Jan 2020 15:51:09 -0500 Subject: [PATCH 125/235] add Java grammar --- semantic-java/src/Language/Java.hs | 4 ++-- semantic-java/src/Language/Java/AST.hs | 2 +- semantic-java/src/Language/Java/Grammar.hs | 15 +++++++++++++++ 3 files changed, 18 insertions(+), 3 deletions(-) create mode 100644 semantic-java/src/Language/Java/Grammar.hs diff --git a/semantic-java/src/Language/Java.hs b/semantic-java/src/Language/Java.hs index a37798d53..293a16fd5 100644 --- a/semantic-java/src/Language/Java.hs +++ b/semantic-java/src/Language/Java.hs @@ -1,14 +1,14 @@ -- | Semantic functionality for Java programs. module Language.Java ( Term(..) -, TreeSitter.Java.tree_sitter_java +, Language.Java.Grammar.tree_sitter_java ) where import Data.Proxy import qualified Language.Java.AST as Java import qualified Language.Java.Tags as JavaTags import qualified Tags.Tagging.Precise as Tags -import qualified TreeSitter.Java (tree_sitter_java) +import qualified Language.Java.Grammar (tree_sitter_java) import qualified AST.Unmarshal as TS newtype Term a = Term { getTerm :: Java.Program a } diff --git a/semantic-java/src/Language/Java/AST.hs b/semantic-java/src/Language/Java/AST.hs index 90f2fe90b..274843883 100644 --- a/semantic-java/src/Language/Java/AST.hs +++ b/semantic-java/src/Language/Java/AST.hs @@ -15,7 +15,7 @@ module Language.Java.AST ) where import AST.GenerateSyntax -import qualified TreeSitter.Java as Grammar +import qualified Language.Java.Grammar as Grammar import AST.Token astDeclarationsForLanguage Grammar.tree_sitter_java "../../../vendor/tree-sitter-java/src/node-types.json" \ No newline at end of file diff --git a/semantic-java/src/Language/Java/Grammar.hs b/semantic-java/src/Language/Java/Grammar.hs new file mode 100644 index 000000000..6cd1c44eb --- /dev/null +++ b/semantic-java/src/Language/Java/Grammar.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE TemplateHaskell #-} +module Language.Java.Grammar +( tree_sitter_java +, Grammar(..) +) where + +import Language.Haskell.TH +import TreeSitter.Java.Internal +import TreeSitter.Language + +-- Regenerate template haskell code when these files change: +addDependentFileRelative "../../../vendor/tree-sitter-java/src/parser.c" + +-- | Statically-known rules corresponding to symbols in the grammar. +mkSymbolDatatype (mkName "Grammar") tree_sitter_java From 76eb3af0c369cf32389e13bcce6f190f48730d5b Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Wed, 29 Jan 2020 16:55:40 -0500 Subject: [PATCH 126/235] Update semantic-java.cabal --- semantic-java/semantic-java.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/semantic-java/semantic-java.cabal b/semantic-java/semantic-java.cabal index e5746f937..9fa3ac8f6 100644 --- a/semantic-java/semantic-java.cabal +++ b/semantic-java/semantic-java.cabal @@ -22,6 +22,7 @@ library exposed-modules: Language.Java Language.Java.AST + Language.Java.Grammar Language.Java.Tags build-depends: base >= 4.13 && < 5 From 59869619ec0862684b18f0e8089ef5b1fe21229b Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Wed, 29 Jan 2020 16:55:42 -0500 Subject: [PATCH 127/235] Update semantic-json.cabal --- semantic-json/semantic-json.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/semantic-json/semantic-json.cabal b/semantic-json/semantic-json.cabal index 2f4cb3032..c91e09883 100644 --- a/semantic-json/semantic-json.cabal +++ b/semantic-json/semantic-json.cabal @@ -22,6 +22,7 @@ library exposed-modules: Language.JSON Language.JSON.AST + Language.JSON.Grammar build-depends: base >= 4.13 && < 5 , semantic-tags ^>= 0.0 From 1c8900b1950c6b7a9bfb8e8715623328070b6307 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Thu, 30 Jan 2020 09:00:01 -0500 Subject: [PATCH 128/235] add tree-sitter-java and tree-sitter-json to cabal file temporarily to try to get through CI --- semantic.cabal | 2 ++ 1 file changed, 2 insertions(+) diff --git a/semantic.cabal b/semantic.cabal index 15a5d7632..c23b1ccda 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -304,6 +304,8 @@ library , unordered-containers ^>= 0.2.9.0 , vector ^>= 0.12.0.2 , tree-sitter-go ^>= 0.4.1.1 + , tree-sitter-java ^>= 0.6.1 + , tree-sitter-json ^>= 0.6 , tree-sitter-php ^>= 0.2 , tree-sitter-python ^>= 0.8.1 , tree-sitter-ruby ^>= 0.4.1 From 5e85e7d786f0f618c6cbee16ead41404643149a0 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Thu, 30 Jan 2020 13:18:12 -0500 Subject: [PATCH 129/235] fix java and json Grammars --- semantic-java/src/Language/Java/Grammar.hs | 3 ++- semantic-json/src/Language/JSON/Grammar.hs | 3 ++- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/semantic-java/src/Language/Java/Grammar.hs b/semantic-java/src/Language/Java/Grammar.hs index 6cd1c44eb..a4908e28c 100644 --- a/semantic-java/src/Language/Java/Grammar.hs +++ b/semantic-java/src/Language/Java/Grammar.hs @@ -5,7 +5,8 @@ module Language.Java.Grammar ) where import Language.Haskell.TH -import TreeSitter.Java.Internal +-- import TreeSitter.Java.Internal +import TreeSitter.Java (tree_sitter_java) import TreeSitter.Language -- Regenerate template haskell code when these files change: diff --git a/semantic-json/src/Language/JSON/Grammar.hs b/semantic-json/src/Language/JSON/Grammar.hs index 5d6b07dcf..2333026ed 100644 --- a/semantic-json/src/Language/JSON/Grammar.hs +++ b/semantic-json/src/Language/JSON/Grammar.hs @@ -5,7 +5,8 @@ module Language.JSON.Grammar ) where import Language.Haskell.TH -import TreeSitter.JSON.Internal +import TreeSitter.JSON (tree_sitter_json) +-- import TreeSitter.JSON.Internal import TreeSitter.Language -- Regenerate template haskell code when these files change: From 9a476cefc19f2ef981e86ae957130377bdb68c22 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Thu, 30 Jan 2020 13:26:26 -0500 Subject: [PATCH 130/235] Fix CI --- .github/workflows/haskell.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 21c35846c..df35bd28f 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -52,7 +52,7 @@ jobs: - name: Install dependencies run: | - cabal v2-update + script/bootstrap cabal v2-configure --project-file=cabal.project.ci --disable-optimization --enable-benchmarks --enable-tests --write-ghc-environment-files=always -j2 cabal v2-build --project-file=cabal.project.ci all --only-dependencies From 5f4d11bdf1b6cae1baf51eef682c84ec77718310 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Thu, 30 Jan 2020 13:44:27 -0500 Subject: [PATCH 131/235] change function name --- semantic-go/src/Language/Go/Grammar.hs | 6 +++--- semantic-java/src/Language/Java/Grammar.hs | 5 ++--- semantic-json/src/Language/JSON/Grammar.hs | 5 ++--- semantic-python/src/Language/Python/Grammar.hs | 6 +++--- semantic-ruby/src/Language/Ruby/Grammar.hs | 6 +++--- semantic-typescript/src/Language/Grammar.hs | 6 +++--- 6 files changed, 16 insertions(+), 18 deletions(-) diff --git a/semantic-go/src/Language/Go/Grammar.hs b/semantic-go/src/Language/Go/Grammar.hs index 999aea0fb..862d3c4ae 100644 --- a/semantic-go/src/Language/Go/Grammar.hs +++ b/semantic-go/src/Language/Go/Grammar.hs @@ -5,11 +5,11 @@ module Language.Go.Grammar ) where import Language.Haskell.TH -import TreeSitter.Go.Internal -import TreeSitter.Language +import TreeSitter.Go (tree_sitter_go) +import AST.Grammar.TH -- Regenerate template haskell code when these files change: addDependentFileRelative "../../../vendor/tree-sitter-go/src/parser.c" -- | Statically-known rules corresponding to symbols in the grammar. -mkSymbolDatatype (mkName "Grammar") tree_sitter_go +mkStaticallyKnownRuleGrammarData (mkName "Grammar") tree_sitter_go diff --git a/semantic-java/src/Language/Java/Grammar.hs b/semantic-java/src/Language/Java/Grammar.hs index a4908e28c..5ca2d0f06 100644 --- a/semantic-java/src/Language/Java/Grammar.hs +++ b/semantic-java/src/Language/Java/Grammar.hs @@ -5,12 +5,11 @@ module Language.Java.Grammar ) where import Language.Haskell.TH --- import TreeSitter.Java.Internal import TreeSitter.Java (tree_sitter_java) -import TreeSitter.Language +import AST.Grammar.TH -- Regenerate template haskell code when these files change: addDependentFileRelative "../../../vendor/tree-sitter-java/src/parser.c" -- | Statically-known rules corresponding to symbols in the grammar. -mkSymbolDatatype (mkName "Grammar") tree_sitter_java +mkStaticallyKnownRuleGrammarData (mkName "Grammar") tree_sitter_java diff --git a/semantic-json/src/Language/JSON/Grammar.hs b/semantic-json/src/Language/JSON/Grammar.hs index 2333026ed..92644f61e 100644 --- a/semantic-json/src/Language/JSON/Grammar.hs +++ b/semantic-json/src/Language/JSON/Grammar.hs @@ -6,11 +6,10 @@ module Language.JSON.Grammar import Language.Haskell.TH import TreeSitter.JSON (tree_sitter_json) --- import TreeSitter.JSON.Internal -import TreeSitter.Language +import AST.Grammar.TH -- Regenerate template haskell code when these files change: addDependentFileRelative "../../../vendor/tree-sitter-json/src/parser.c" -- | Statically-known rules corresponding to symbols in the grammar. -mkSymbolDatatype (mkName "Grammar") tree_sitter_json +mkStaticallyKnownRuleGrammarData (mkName "Grammar") tree_sitter_json diff --git a/semantic-python/src/Language/Python/Grammar.hs b/semantic-python/src/Language/Python/Grammar.hs index 5393172a1..c670a53e4 100644 --- a/semantic-python/src/Language/Python/Grammar.hs +++ b/semantic-python/src/Language/Python/Grammar.hs @@ -5,11 +5,11 @@ module Language.Python.Grammar ) where import Language.Haskell.TH -import TreeSitter.Python.Internal -import TreeSitter.Language +import TreeSitter.Python (tree_sitter_python) +import AST.Grammar.TH -- Regenerate template haskell code when these files change: addDependentFileRelative "../../../vendor/tree-sitter-python/src/parser.c" -- | Statically-known rules corresponding to symbols in the grammar. -mkSymbolDatatype (mkName "Grammar") tree_sitter_python +mkStaticallyKnownRuleGrammarData (mkName "Grammar") tree_sitter_python diff --git a/semantic-ruby/src/Language/Ruby/Grammar.hs b/semantic-ruby/src/Language/Ruby/Grammar.hs index a941aa415..553c5ecde 100644 --- a/semantic-ruby/src/Language/Ruby/Grammar.hs +++ b/semantic-ruby/src/Language/Ruby/Grammar.hs @@ -5,11 +5,11 @@ module Language.Ruby.Grammar ) where import Language.Haskell.TH -import TreeSitter.Ruby.Internal -import TreeSitter.Language +import TreeSitter.Ruby (tree_sitter_ruby) +import AST.Grammar.TH -- Regenerate template haskell code when these files change: addDependentFileRelative "../../../vendor/tree-sitter-ruby/src/parser.c" -- | Statically-known rules corresponding to symbols in the grammar. -mkSymbolDatatype (mkName "Grammar") tree_sitter_ruby +mkStaticallyKnownRuleGrammarData (mkName "Grammar") tree_sitter_ruby diff --git a/semantic-typescript/src/Language/Grammar.hs b/semantic-typescript/src/Language/Grammar.hs index a45796673..f4dc070dd 100644 --- a/semantic-typescript/src/Language/Grammar.hs +++ b/semantic-typescript/src/Language/Grammar.hs @@ -5,11 +5,11 @@ module Language.TypeScript.Grammar ) where import Language.Haskell.TH -import TreeSitter.TypeScript.Internal -import TreeSitter.Language +import TreeSitter.TypeScript (tree_sitter_typescript) +import AST.Grammar.TH -- Regenerate template haskell code when these files change: addDependentFileRelative "../../vendor/tree-sitter-typescript/typescript/src/parser.c" -- | Statically-known rules corresponding to symbols in the grammar. -mkSymbolDatatype (mkName "Grammar") tree_sitter_typescript +mkStaticallyKnownRuleGrammarData (mkName "Grammar") tree_sitter_typescript From 42cfbab4edc0c9f58a8526c16f032a86d61f7d00 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Thu, 30 Jan 2020 13:44:31 -0500 Subject: [PATCH 132/235] Create TH.hs --- semantic-ast/src/AST/Grammar/TH.hs | 33 ++++++++++++++++++++++++++++++ 1 file changed, 33 insertions(+) create mode 100644 semantic-ast/src/AST/Grammar/TH.hs diff --git a/semantic-ast/src/AST/Grammar/TH.hs b/semantic-ast/src/AST/Grammar/TH.hs new file mode 100644 index 000000000..769ccd915 --- /dev/null +++ b/semantic-ast/src/AST/Grammar/TH.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE TemplateHaskell #-} +module AST.Grammar.TH +( mkStaticallyKnownRuleGrammarData +) where + +import Data.Ix (Ix) +import Data.List (mapAccumL) +import qualified Data.Set as Set +import Foreign.Ptr +import Language.Haskell.TH +import Language.Haskell.TH.Syntax +import TreeSitter.Symbol +import TreeSitter.Language (Language, languageSymbols) + +-- | TemplateHaskell construction of a datatype for the referenced Language. +-- | Statically-known rules corresponding to symbols in the grammar. +mkStaticallyKnownRuleGrammarData :: Name -> Ptr Language -> Q [Dec] +mkStaticallyKnownRuleGrammarData name language = do + symbols <- renameDups . map ((,) . fst <*> uncurry symbolToName) . (++ [(Regular, "ParseError")]) <$> runIO (languageSymbols language) + Module _ modName <- thisModule + let mkMatch symbolType str = match (conP (Name (OccName str) (NameQ modName)) []) (normalB [e|symbolType|]) [] + datatype <- dataD (pure []) name [] Nothing (flip normalC [] . mkName . snd <$> symbols) + [ derivClause Nothing (map conT [ ''Bounded, ''Enum, ''Eq, ''Ix, ''Ord, ''Show ]) ] + symbolInstance <- [d| + instance Symbol $(conT name) where + symbolType = $(lamCaseE (uncurry mkMatch <$> symbols)) |] + pure (datatype : symbolInstance) + +renameDups :: [(a, String)] -> [(a, String)] +renameDups = snd . mapAccumL go mempty + where go done (ty, name) = let name' = rename name in (Set.insert name' done, (ty, name')) + where rename name | name `Set.member` done = rename (name ++ "'") + | otherwise = name \ No newline at end of file From 2d2ba3c819315ce7a0e1340fff8bcb2a7eb7b714 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Thu, 30 Jan 2020 13:45:26 -0500 Subject: [PATCH 133/235] Update semantic-ast.cabal --- semantic-ast/semantic-ast.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/semantic-ast/semantic-ast.cabal b/semantic-ast/semantic-ast.cabal index 0134dd0e3..b4c2a30db 100644 --- a/semantic-ast/semantic-ast.cabal +++ b/semantic-ast/semantic-ast.cabal @@ -40,6 +40,7 @@ library exposed-modules: Marshal.JSON AST.Deserialize AST.GenerateSyntax + AST.Grammar.TH AST.Token AST.Unmarshal From 0095b80ff8aba1a1b3079a5b313b7c7097af9cef Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Thu, 30 Jan 2020 13:49:19 -0500 Subject: [PATCH 134/235] bring addDependentFileRelative into scope for all Grammar files --- semantic-go/src/Language/Go/Grammar.hs | 1 + semantic-java/src/Language/Java/Grammar.hs | 1 + semantic-json/src/Language/JSON/Grammar.hs | 1 + semantic-python/src/Language/Python/Grammar.hs | 1 + semantic-ruby/src/Language/Ruby/Grammar.hs | 1 + semantic-typescript/src/Language/Grammar.hs | 1 + 6 files changed, 6 insertions(+) diff --git a/semantic-go/src/Language/Go/Grammar.hs b/semantic-go/src/Language/Go/Grammar.hs index 862d3c4ae..719860bef 100644 --- a/semantic-go/src/Language/Go/Grammar.hs +++ b/semantic-go/src/Language/Go/Grammar.hs @@ -7,6 +7,7 @@ module Language.Go.Grammar import Language.Haskell.TH import TreeSitter.Go (tree_sitter_go) import AST.Grammar.TH +import TreeSitter.Language (addDependentFileRelative) -- Regenerate template haskell code when these files change: addDependentFileRelative "../../../vendor/tree-sitter-go/src/parser.c" diff --git a/semantic-java/src/Language/Java/Grammar.hs b/semantic-java/src/Language/Java/Grammar.hs index 5ca2d0f06..8ac864fb6 100644 --- a/semantic-java/src/Language/Java/Grammar.hs +++ b/semantic-java/src/Language/Java/Grammar.hs @@ -7,6 +7,7 @@ module Language.Java.Grammar import Language.Haskell.TH import TreeSitter.Java (tree_sitter_java) import AST.Grammar.TH +import TreeSitter.Language (addDependentFileRelative) -- Regenerate template haskell code when these files change: addDependentFileRelative "../../../vendor/tree-sitter-java/src/parser.c" diff --git a/semantic-json/src/Language/JSON/Grammar.hs b/semantic-json/src/Language/JSON/Grammar.hs index 92644f61e..798366d84 100644 --- a/semantic-json/src/Language/JSON/Grammar.hs +++ b/semantic-json/src/Language/JSON/Grammar.hs @@ -7,6 +7,7 @@ module Language.JSON.Grammar import Language.Haskell.TH import TreeSitter.JSON (tree_sitter_json) import AST.Grammar.TH +import TreeSitter.Language (addDependentFileRelative) -- Regenerate template haskell code when these files change: addDependentFileRelative "../../../vendor/tree-sitter-json/src/parser.c" diff --git a/semantic-python/src/Language/Python/Grammar.hs b/semantic-python/src/Language/Python/Grammar.hs index c670a53e4..2a975ee35 100644 --- a/semantic-python/src/Language/Python/Grammar.hs +++ b/semantic-python/src/Language/Python/Grammar.hs @@ -7,6 +7,7 @@ module Language.Python.Grammar import Language.Haskell.TH import TreeSitter.Python (tree_sitter_python) import AST.Grammar.TH +import TreeSitter.Language (addDependentFileRelative) -- Regenerate template haskell code when these files change: addDependentFileRelative "../../../vendor/tree-sitter-python/src/parser.c" diff --git a/semantic-ruby/src/Language/Ruby/Grammar.hs b/semantic-ruby/src/Language/Ruby/Grammar.hs index 553c5ecde..2f426e334 100644 --- a/semantic-ruby/src/Language/Ruby/Grammar.hs +++ b/semantic-ruby/src/Language/Ruby/Grammar.hs @@ -7,6 +7,7 @@ module Language.Ruby.Grammar import Language.Haskell.TH import TreeSitter.Ruby (tree_sitter_ruby) import AST.Grammar.TH +import TreeSitter.Language (addDependentFileRelative) -- Regenerate template haskell code when these files change: addDependentFileRelative "../../../vendor/tree-sitter-ruby/src/parser.c" diff --git a/semantic-typescript/src/Language/Grammar.hs b/semantic-typescript/src/Language/Grammar.hs index f4dc070dd..29dbd0128 100644 --- a/semantic-typescript/src/Language/Grammar.hs +++ b/semantic-typescript/src/Language/Grammar.hs @@ -7,6 +7,7 @@ module Language.TypeScript.Grammar import Language.Haskell.TH import TreeSitter.TypeScript (tree_sitter_typescript) import AST.Grammar.TH +import TreeSitter.Language (addDependentFileRelative) -- Regenerate template haskell code when these files change: addDependentFileRelative "../../vendor/tree-sitter-typescript/typescript/src/parser.c" From 61e7155fb33f23e25b43290831f92fa5749f1f62 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Thu, 30 Jan 2020 16:48:35 -0500 Subject: [PATCH 135/235] add semantic-ast to semantic-LANG library dependencies --- semantic-go/semantic-go.cabal | 1 + semantic-java/semantic-java.cabal | 1 + semantic-json/semantic-json.cabal | 1 + semantic-python/semantic-python.cabal | 1 + semantic-ruby/semantic-ruby.cabal | 1 + semantic-typescript/semantic-typescript.cabal | 1 + 6 files changed, 6 insertions(+) diff --git a/semantic-go/semantic-go.cabal b/semantic-go/semantic-go.cabal index 8c465c145..7fa6f7972 100644 --- a/semantic-go/semantic-go.cabal +++ b/semantic-go/semantic-go.cabal @@ -24,6 +24,7 @@ common haskell , fused-effects ^>= 1.0 , fused-syntax , parsers ^>= 0.12.10 + , semantic-ast , semantic-core ^>= 0.0 , semantic-source ^>= 0.0.2 , semantic-tags ^>= 0.0 diff --git a/semantic-java/semantic-java.cabal b/semantic-java/semantic-java.cabal index 9fa3ac8f6..9a1c077bc 100644 --- a/semantic-java/semantic-java.cabal +++ b/semantic-java/semantic-java.cabal @@ -27,6 +27,7 @@ library build-depends: base >= 4.13 && < 5 , fused-effects ^>= 1.0 + , semantic-ast , semantic-source ^>= 0.0.2 , semantic-tags ^>= 0.0 , template-haskell ^>= 2.15 diff --git a/semantic-json/semantic-json.cabal b/semantic-json/semantic-json.cabal index c91e09883..9d45c7740 100644 --- a/semantic-json/semantic-json.cabal +++ b/semantic-json/semantic-json.cabal @@ -25,6 +25,7 @@ library Language.JSON.Grammar build-depends: base >= 4.13 && < 5 + , semantic-ast , semantic-tags ^>= 0.0 , template-haskell ^>= 2.15 , tree-sitter ^>= 0.8 diff --git a/semantic-python/semantic-python.cabal b/semantic-python/semantic-python.cabal index 09a9d1742..271942e92 100644 --- a/semantic-python/semantic-python.cabal +++ b/semantic-python/semantic-python.cabal @@ -83,6 +83,7 @@ test-suite compiling , process ^>= 1.6.5 , resourcet ^>= 1.2.2 , semantic-analysis ^>= 0 + , semantic-ast , streaming ^>= 0.2.2 , streaming-process ^>= 0.1 , streaming-bytestring ^>= 0.1.6 diff --git a/semantic-ruby/semantic-ruby.cabal b/semantic-ruby/semantic-ruby.cabal index 326606777..54b291ab4 100644 --- a/semantic-ruby/semantic-ruby.cabal +++ b/semantic-ruby/semantic-ruby.cabal @@ -24,6 +24,7 @@ common haskell , fused-effects ^>= 1.0 , fused-syntax , parsers ^>= 0.12.10 + , semantic-ast , semantic-core ^>= 0.0 , semantic-source ^>= 0.0.2 , semantic-tags ^>= 0.0 diff --git a/semantic-typescript/semantic-typescript.cabal b/semantic-typescript/semantic-typescript.cabal index a842d2b8f..81fc5b387 100644 --- a/semantic-typescript/semantic-typescript.cabal +++ b/semantic-typescript/semantic-typescript.cabal @@ -24,6 +24,7 @@ common haskell , fused-effects ^>= 1.0 , fused-syntax , parsers ^>= 0.12.10 + , semantic-ast , semantic-core ^>= 0.0 , semantic-source ^>= 0.0.2 , semantic-tags ^>= 0.0 From 6238e13d17d7b4a7bcb65b71bacbd581fffcd7f7 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Thu, 30 Jan 2020 17:11:12 -0500 Subject: [PATCH 136/235] Create semantic-codegen --- semantic-codegen/CHANGELOG.md | 5 +++++ semantic-codegen/Main.hs | 4 ++++ semantic-codegen/Setup.hs | 2 ++ semantic-codegen/semantic-codegen.cabal | 26 +++++++++++++++++++++++++ 4 files changed, 37 insertions(+) create mode 100644 semantic-codegen/CHANGELOG.md create mode 100644 semantic-codegen/Main.hs create mode 100644 semantic-codegen/Setup.hs create mode 100644 semantic-codegen/semantic-codegen.cabal diff --git a/semantic-codegen/CHANGELOG.md b/semantic-codegen/CHANGELOG.md new file mode 100644 index 000000000..f97ded255 --- /dev/null +++ b/semantic-codegen/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for semantic-codegen + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/semantic-codegen/Main.hs b/semantic-codegen/Main.hs new file mode 100644 index 000000000..65ae4a05d --- /dev/null +++ b/semantic-codegen/Main.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = putStrLn "Hello, Haskell!" diff --git a/semantic-codegen/Setup.hs b/semantic-codegen/Setup.hs new file mode 100644 index 000000000..9a994af67 --- /dev/null +++ b/semantic-codegen/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/semantic-codegen/semantic-codegen.cabal b/semantic-codegen/semantic-codegen.cabal new file mode 100644 index 000000000..ea057171f --- /dev/null +++ b/semantic-codegen/semantic-codegen.cabal @@ -0,0 +1,26 @@ +cabal-version: >=1.10 +-- Initial package description 'semantic-codegen.cabal' generated by 'cabal +-- init'. For further documentation, see +-- http://haskell.org/cabal/users-guide/ + +name: semantic-codegen +version: 0.1.0.0 +-- synopsis: +-- description: +-- bug-reports: +-- license: +license-file: LICENSE +author: Ayman Nadeem +maintainer: aymannadeem@github.com +-- copyright: +-- category: +build-type: Simple +extra-source-files: CHANGELOG.md + +executable semantic-codegen + main-is: Main.hs + -- other-modules: + -- other-extensions: + build-depends: base >=4.13 && <4.14 + -- hs-source-dirs: + default-language: Haskell2010 From fd227b869a789fdf1b510f99cac6dda16c74f1e9 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Thu, 30 Jan 2020 17:23:00 -0500 Subject: [PATCH 137/235] Update semantic-codegen.cabal --- semantic-codegen/semantic-codegen.cabal | 68 ++++++++++++++++++++++--- 1 file changed, 62 insertions(+), 6 deletions(-) diff --git a/semantic-codegen/semantic-codegen.cabal b/semantic-codegen/semantic-codegen.cabal index ea057171f..3a75d0a3d 100644 --- a/semantic-codegen/semantic-codegen.cabal +++ b/semantic-codegen/semantic-codegen.cabal @@ -8,19 +8,75 @@ version: 0.1.0.0 -- synopsis: -- description: -- bug-reports: --- license: +license: MIT license-file: LICENSE -author: Ayman Nadeem -maintainer: aymannadeem@github.com --- copyright: --- category: -build-type: Simple +author: The Semantic Authors +maintainer: opensource+semantic@github.com +copyright: (c) 2019 GitHub, Inc. +category: Language extra-source-files: CHANGELOG.md +tested-with: GHC == 8.6.5 + +common haskell + default-language: Haskell2010 + ghc-options: + -Weverything + -Wno-missing-local-signatures + -Wno-missing-import-lists + -Wno-implicit-prelude + -Wno-safe + -Wno-unsafe + -Wno-name-shadowing + -Wno-monomorphism-restriction + -Wno-missed-specialisations + -Wno-all-missed-specialisations + -Wno-star-is-type + if (impl(ghc >= 8.8)) + ghc-options: -Wno-missing-deriving-strategies + +library + import: haskell + exposed-modules: AST.Deserialize + AST.GenerateSyntax + AST.Grammar.TH + AST.Token + AST.Unmarshal + +-- other-modules: + -- other-extensions: + build-depends: base ^>= 4.13 + , aeson ^>= 1.4.2.0 + , bytestring ^>= 0.10.8.2 + , tree-sitter ^>= 0.8 + , semantic-source ^>= 0.0.2 + , template-haskell ^>= 2.15 + , bytestring ^>= 0.10.8.2 + , text ^>= 1.2.3.1 + , unordered-containers ^>= 0.2.10 + , containers >= 0.6.0.1 + , text ^>= 1.2.3.1 + , filepath ^>= 1.4.1 + + hs-source-dirs: src + default-language: Haskell2010 + executable semantic-codegen + import: haskell main-is: Main.hs -- other-modules: -- other-extensions: build-depends: base >=4.13 && <4.14 + , tree-sitter + , semantic-source + , tree-sitter-python + , bytestring + , aeson + , bytestring + , text + , unordered-containers + , containers + , filepath + default-language: Haskell2010 -- hs-source-dirs: default-language: Haskell2010 From 85f751fc6ca7f9845b220a977b8639ffd2f05996 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Thu, 30 Jan 2020 17:34:31 -0500 Subject: [PATCH 138/235] Move codegen files into semantic-codegen from semantic-ast --- {semantic-ast => semantic-codegen}/src/AST/Deserialize.hs | 0 {semantic-ast => semantic-codegen}/src/AST/GenerateSyntax.hs | 0 {semantic-ast => semantic-codegen}/src/AST/Grammar/TH.hs | 0 {semantic-ast => semantic-codegen}/src/AST/Token.hs | 0 {semantic-ast => semantic-codegen}/src/AST/Unmarshal.hs | 0 5 files changed, 0 insertions(+), 0 deletions(-) rename {semantic-ast => semantic-codegen}/src/AST/Deserialize.hs (100%) rename {semantic-ast => semantic-codegen}/src/AST/GenerateSyntax.hs (100%) rename {semantic-ast => semantic-codegen}/src/AST/Grammar/TH.hs (100%) rename {semantic-ast => semantic-codegen}/src/AST/Token.hs (100%) rename {semantic-ast => semantic-codegen}/src/AST/Unmarshal.hs (100%) diff --git a/semantic-ast/src/AST/Deserialize.hs b/semantic-codegen/src/AST/Deserialize.hs similarity index 100% rename from semantic-ast/src/AST/Deserialize.hs rename to semantic-codegen/src/AST/Deserialize.hs diff --git a/semantic-ast/src/AST/GenerateSyntax.hs b/semantic-codegen/src/AST/GenerateSyntax.hs similarity index 100% rename from semantic-ast/src/AST/GenerateSyntax.hs rename to semantic-codegen/src/AST/GenerateSyntax.hs diff --git a/semantic-ast/src/AST/Grammar/TH.hs b/semantic-codegen/src/AST/Grammar/TH.hs similarity index 100% rename from semantic-ast/src/AST/Grammar/TH.hs rename to semantic-codegen/src/AST/Grammar/TH.hs diff --git a/semantic-ast/src/AST/Token.hs b/semantic-codegen/src/AST/Token.hs similarity index 100% rename from semantic-ast/src/AST/Token.hs rename to semantic-codegen/src/AST/Token.hs diff --git a/semantic-ast/src/AST/Unmarshal.hs b/semantic-codegen/src/AST/Unmarshal.hs similarity index 100% rename from semantic-ast/src/AST/Unmarshal.hs rename to semantic-codegen/src/AST/Unmarshal.hs From f46e6f0bc55b5825d09036581dc0abf9acdba666 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Thu, 30 Jan 2020 17:35:51 -0500 Subject: [PATCH 139/235] remove all codegen modules from semantic-ast.cabal --- semantic-ast/semantic-ast.cabal | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/semantic-ast/semantic-ast.cabal b/semantic-ast/semantic-ast.cabal index b4c2a30db..53a06a09d 100644 --- a/semantic-ast/semantic-ast.cabal +++ b/semantic-ast/semantic-ast.cabal @@ -38,11 +38,7 @@ common haskell library import: haskell exposed-modules: Marshal.JSON - AST.Deserialize - AST.GenerateSyntax - AST.Grammar.TH - AST.Token - AST.Unmarshal + -- other-modules: -- other-extensions: From eab2503e1fd03b2456a70f55ce850d929947ea34 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Thu, 30 Jan 2020 17:36:06 -0500 Subject: [PATCH 140/235] remove all codegen dependencies from semantic-ast --- semantic-ast/semantic-ast.cabal | 7 ------- 1 file changed, 7 deletions(-) diff --git a/semantic-ast/semantic-ast.cabal b/semantic-ast/semantic-ast.cabal index 53a06a09d..0702851ca 100644 --- a/semantic-ast/semantic-ast.cabal +++ b/semantic-ast/semantic-ast.cabal @@ -54,10 +54,6 @@ library , optparse-applicative >= 0.14.3 && < 0.16 , pretty-simple ^>= 3.1.0.0 , text ^>= 1.2.3.1 - , unordered-containers ^>= 0.2.10 - , containers >= 0.6.0.1 - , text ^>= 1.2.3.1 - , filepath ^>= 1.4.1 hs-source-dirs: src default-language: Haskell2010 @@ -81,8 +77,5 @@ executable semantic-ast , aeson-pretty , semantic-python , text - , unordered-containers - , containers - , filepath hs-source-dirs: app default-language: Haskell2010 From a6cbd07c4c2abfeee5d23879bc72408bbcfb313c Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Thu, 30 Jan 2020 17:36:19 -0500 Subject: [PATCH 141/235] semantic-codegen can not rely on semantic-python --- semantic-codegen/semantic-codegen.cabal | 1 - 1 file changed, 1 deletion(-) diff --git a/semantic-codegen/semantic-codegen.cabal b/semantic-codegen/semantic-codegen.cabal index 3a75d0a3d..be0763459 100644 --- a/semantic-codegen/semantic-codegen.cabal +++ b/semantic-codegen/semantic-codegen.cabal @@ -69,7 +69,6 @@ executable semantic-codegen build-depends: base >=4.13 && <4.14 , tree-sitter , semantic-source - , tree-sitter-python , bytestring , aeson , bytestring From 9c31c3fcf847ab9ca4f04be49f10d7f47e887207 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Thu, 30 Jan 2020 17:44:09 -0500 Subject: [PATCH 142/235] change all semantic-LANG cabal files to depend on semantic-codegen instead of semantic-ast --- semantic-go/semantic-go.cabal | 2 +- semantic-java/semantic-java.cabal | 2 +- semantic-json/semantic-json.cabal | 2 +- semantic-python/semantic-python.cabal | 2 +- semantic-ruby/semantic-ruby.cabal | 2 +- semantic-typescript/semantic-typescript.cabal | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/semantic-go/semantic-go.cabal b/semantic-go/semantic-go.cabal index 7fa6f7972..a6371963e 100644 --- a/semantic-go/semantic-go.cabal +++ b/semantic-go/semantic-go.cabal @@ -24,7 +24,7 @@ common haskell , fused-effects ^>= 1.0 , fused-syntax , parsers ^>= 0.12.10 - , semantic-ast + , semantic-codegen , semantic-core ^>= 0.0 , semantic-source ^>= 0.0.2 , semantic-tags ^>= 0.0 diff --git a/semantic-java/semantic-java.cabal b/semantic-java/semantic-java.cabal index 9a1c077bc..85ced1577 100644 --- a/semantic-java/semantic-java.cabal +++ b/semantic-java/semantic-java.cabal @@ -27,7 +27,7 @@ library build-depends: base >= 4.13 && < 5 , fused-effects ^>= 1.0 - , semantic-ast + , semantic-codegen , semantic-source ^>= 0.0.2 , semantic-tags ^>= 0.0 , template-haskell ^>= 2.15 diff --git a/semantic-json/semantic-json.cabal b/semantic-json/semantic-json.cabal index 9d45c7740..2d112dfee 100644 --- a/semantic-json/semantic-json.cabal +++ b/semantic-json/semantic-json.cabal @@ -25,7 +25,7 @@ library Language.JSON.Grammar build-depends: base >= 4.13 && < 5 - , semantic-ast + , semantic-codegen , semantic-tags ^>= 0.0 , template-haskell ^>= 2.15 , tree-sitter ^>= 0.8 diff --git a/semantic-python/semantic-python.cabal b/semantic-python/semantic-python.cabal index 271942e92..9feced2b8 100644 --- a/semantic-python/semantic-python.cabal +++ b/semantic-python/semantic-python.cabal @@ -83,7 +83,7 @@ test-suite compiling , process ^>= 1.6.5 , resourcet ^>= 1.2.2 , semantic-analysis ^>= 0 - , semantic-ast + , semantic-codegen , streaming ^>= 0.2.2 , streaming-process ^>= 0.1 , streaming-bytestring ^>= 0.1.6 diff --git a/semantic-ruby/semantic-ruby.cabal b/semantic-ruby/semantic-ruby.cabal index 54b291ab4..0fedf0862 100644 --- a/semantic-ruby/semantic-ruby.cabal +++ b/semantic-ruby/semantic-ruby.cabal @@ -24,7 +24,7 @@ common haskell , fused-effects ^>= 1.0 , fused-syntax , parsers ^>= 0.12.10 - , semantic-ast + , semantic-codegen , semantic-core ^>= 0.0 , semantic-source ^>= 0.0.2 , semantic-tags ^>= 0.0 diff --git a/semantic-typescript/semantic-typescript.cabal b/semantic-typescript/semantic-typescript.cabal index 81fc5b387..8c15efa66 100644 --- a/semantic-typescript/semantic-typescript.cabal +++ b/semantic-typescript/semantic-typescript.cabal @@ -24,7 +24,7 @@ common haskell , fused-effects ^>= 1.0 , fused-syntax , parsers ^>= 0.12.10 - , semantic-ast + , semantic-codegen , semantic-core ^>= 0.0 , semantic-source ^>= 0.0.2 , semantic-tags ^>= 0.0 From f96572aa29f5bc1e312b52562eb0ab72d3243309 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 10:25:28 -0500 Subject: [PATCH 143/235] add semantic-codegen to cabal.project --- cabal.project | 1 + 1 file changed, 1 insertion(+) diff --git a/cabal.project b/cabal.project index 5e020ac53..79c09b84d 100644 --- a/cabal.project +++ b/cabal.project @@ -4,6 +4,7 @@ packages: . semantic-analysis semantic-ast + semantic-codegen semantic-core semantic-go semantic-java From 37c759e4da5689d6b6e64ff0931140971dea2b72 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 10:25:41 -0500 Subject: [PATCH 144/235] add semantic-codegen to cabal.project.ci --- cabal.project.ci | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/cabal.project.ci b/cabal.project.ci index 51b00d1da..1883773eb 100644 --- a/cabal.project.ci +++ b/cabal.project.ci @@ -4,6 +4,7 @@ packages: . semantic-analysis semantic-ast + semantic-codegen semantic-core semantic-go semantic-java @@ -43,6 +44,9 @@ package semantic-analysis package semantic-ast ghc-options: -Werror +package semantic-codegen + ghc-options: -Werror + package semantic-core ghc-options: -Werror From 8abc747c46008729bff6a0da58bf81c5ca5a860b Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 10:25:53 -0500 Subject: [PATCH 145/235] update docs --- cabal.project | 2 +- cabal.project.ci | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index 79c09b84d..3bba22f83 100644 --- a/cabal.project +++ b/cabal.project @@ -1,4 +1,4 @@ --- ATTENTION: care must be taken to keep this file in sync with cabal.project.ci. If you add a package here, add it there (and add a package stanza with ghc-options to enable errors in CI at the bottom of that file). +-- ATTENTION: care must be taken to keep this file in sync with cabal.project.ci and script/ghci-flags. If you add a package here, add it there (and add a package stanza with ghc-options to enable errors in CI at the bottom of that file). -- Local packages packages: . diff --git a/cabal.project.ci b/cabal.project.ci index 1883773eb..4ce526d96 100644 --- a/cabal.project.ci +++ b/cabal.project.ci @@ -1,4 +1,4 @@ --- ATTENTION: care must be taken to keep this file in sync with cabal.project. If you add a package here, add it there (and add a package stanza with ghc-options to enable errors in CI at the bottom of this file). +-- ATTENTION: care must be taken to keep this file in sync with cabal.project and script/ghci-flags. If you add a package here, add it there (and add a package stanza with ghc-options to enable errors in CI at the bottom of this file). -- Local packages packages: . From 75389e0a3a1780d2af2310cd4f06e25c88a97fe5 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 10:27:27 -0500 Subject: [PATCH 146/235] add semantic-codegen to script/ghci-flags --- script/ghci-flags | 1 + 1 file changed, 1 insertion(+) diff --git a/script/ghci-flags b/script/ghci-flags index e61ec0116..2e3762c4e 100755 --- a/script/ghci-flags +++ b/script/ghci-flags @@ -37,6 +37,7 @@ function flags { # TODO: would be nice to figure this out from cabal.project & the .cabal files echo "-isemantic-analysis/src" echo "-isemantic-ast/src" + echo "-isemantic-codegen/src" echo "-isemantic-core/src" echo "-isemantic-go/src" echo "-isemantic-java/src" From 9f6f5cbfc88d84286f3ad3878511b2666eab44d0 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 10:32:35 -0500 Subject: [PATCH 147/235] bump cabal version --- semantic-codegen/semantic-codegen.cabal | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic-codegen/semantic-codegen.cabal b/semantic-codegen/semantic-codegen.cabal index be0763459..e93ada600 100644 --- a/semantic-codegen/semantic-codegen.cabal +++ b/semantic-codegen/semantic-codegen.cabal @@ -1,4 +1,4 @@ -cabal-version: >=1.10 +cabal-version: 2.4 -- Initial package description 'semantic-codegen.cabal' generated by 'cabal -- init'. For further documentation, see -- http://haskell.org/cabal/users-guide/ From 09d54aa5aeca3ee62dcc1cb6590f20b2cfb5a8b1 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 10:40:08 -0500 Subject: [PATCH 148/235] change base version --- semantic-codegen/semantic-codegen.cabal | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/semantic-codegen/semantic-codegen.cabal b/semantic-codegen/semantic-codegen.cabal index e93ada600..7d7c517ad 100644 --- a/semantic-codegen/semantic-codegen.cabal +++ b/semantic-codegen/semantic-codegen.cabal @@ -45,7 +45,7 @@ library -- other-modules: -- other-extensions: - build-depends: base ^>= 4.13 + build-depends: base >= 4.13 , aeson ^>= 1.4.2.0 , bytestring ^>= 0.10.8.2 , tree-sitter ^>= 0.8 @@ -66,7 +66,7 @@ executable semantic-codegen main-is: Main.hs -- other-modules: -- other-extensions: - build-depends: base >=4.13 && <4.14 + build-depends: base , tree-sitter , semantic-source , bytestring From 47737f6475beaadda4c437ab662cf2493782e6b2 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 10:50:34 -0500 Subject: [PATCH 149/235] remove extra bytestring --- semantic-codegen/semantic-codegen.cabal | 1 - 1 file changed, 1 deletion(-) diff --git a/semantic-codegen/semantic-codegen.cabal b/semantic-codegen/semantic-codegen.cabal index 7d7c517ad..47e0d00bb 100644 --- a/semantic-codegen/semantic-codegen.cabal +++ b/semantic-codegen/semantic-codegen.cabal @@ -51,7 +51,6 @@ library , tree-sitter ^>= 0.8 , semantic-source ^>= 0.0.2 , template-haskell ^>= 2.15 - , bytestring ^>= 0.10.8.2 , text ^>= 1.2.3.1 , unordered-containers ^>= 0.2.10 , containers >= 0.6.0.1 From 6957d7d624424cc090f521b77b74a3ceeff30d36 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 10:50:55 -0500 Subject: [PATCH 150/235] oops forgot fused-effects --- semantic-codegen/semantic-codegen.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/semantic-codegen/semantic-codegen.cabal b/semantic-codegen/semantic-codegen.cabal index 47e0d00bb..8de37a7b8 100644 --- a/semantic-codegen/semantic-codegen.cabal +++ b/semantic-codegen/semantic-codegen.cabal @@ -49,6 +49,7 @@ library , aeson ^>= 1.4.2.0 , bytestring ^>= 0.10.8.2 , tree-sitter ^>= 0.8 + , fused-effects ^>= 1.0 , semantic-source ^>= 0.0.2 , template-haskell ^>= 2.15 , text ^>= 1.2.3.1 From aba376a0373c6e8039b569f00f546028e7d12e97 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 11:06:13 -0500 Subject: [PATCH 151/235] =?UTF-8?q?=20add=20=E2=80=98directory=E2=80=99=20?= =?UTF-8?q?to=20the=20build-depends?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- semantic-codegen/semantic-codegen.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/semantic-codegen/semantic-codegen.cabal b/semantic-codegen/semantic-codegen.cabal index 8de37a7b8..5285cc4e4 100644 --- a/semantic-codegen/semantic-codegen.cabal +++ b/semantic-codegen/semantic-codegen.cabal @@ -57,6 +57,7 @@ library , containers >= 0.6.0.1 , text ^>= 1.2.3.1 , filepath ^>= 1.4.1 + , directory ^>= 1.3.3.2 hs-source-dirs: src default-language: Haskell2010 From 51aa8587e80e9687465b6c58518cf5c5fd37a422 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 11:27:09 -0500 Subject: [PATCH 152/235] add -Wno-missing-deriving-strategies to semantic-json and semantic-java --- semantic-java/semantic-java.cabal | 2 ++ semantic-json/semantic-json.cabal | 2 ++ 2 files changed, 4 insertions(+) diff --git a/semantic-java/semantic-java.cabal b/semantic-java/semantic-java.cabal index 85ced1577..17ec3996c 100644 --- a/semantic-java/semantic-java.cabal +++ b/semantic-java/semantic-java.cabal @@ -47,3 +47,5 @@ library -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-star-is-type +if (impl(ghc >= 8.8)) + ghc-options: -Wno-missing-deriving-strategies diff --git a/semantic-json/semantic-json.cabal b/semantic-json/semantic-json.cabal index 2d112dfee..cca29cbff 100644 --- a/semantic-json/semantic-json.cabal +++ b/semantic-json/semantic-json.cabal @@ -44,3 +44,5 @@ library -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-star-is-type + if (impl(ghc >= 8.8)) + ghc-options: -Wno-missing-deriving-strategies From 4058cd7b8359010d056f77908218b59065cb96ca Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 31 Jan 2020 11:33:23 -0500 Subject: [PATCH 153/235] Correctly account of the presence of autogen files in build/noopt. If you have `optimizations: False` in your cabal.project.local (such as when you're in a tight build-run-debug cycle for some executable or test suite), the autogenerated cabal_macros and Paths_ files might not be present in the `build/` folder; if they aren't, we should look in `build/noopt`. This patch appears to address an issue I saw where the cabal macros were being redefined, but I'm not entirely sure why. :/ --- script/ghci-flags | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/script/ghci-flags b/script/ghci-flags index e61ec0116..8a132bb15 100755 --- a/script/ghci-flags +++ b/script/ghci-flags @@ -13,6 +13,14 @@ output_file="${HIE_BIOS_OUTPUT:-/dev/stdout}" build_dir="dist-newstyle/build/x86_64-osx/ghc-$ghc_version" build_products_dir="$build_dir/build-repl" +function add_autogen_includes { + echo "-optP-include" + echo "-optP$1/cabal_macros.h" + # autogenerated files, .h and .hs + echo "-i$1" + echo "-I$1" +} + function flags { # disable optimizations for faster loading echo "-O0" @@ -25,13 +33,11 @@ function flags { echo "-hidir $build_products_dir" echo "-stubdir $build_products_dir" - # preprocessor options, for -XCPP - echo "-optP-include" - echo "-optP$build_dir/semantic-0.10.0.0/build/autogen/cabal_macros.h" - - # autogenerated sources, both .hs and .h (e.g. Foo_paths.hs) - echo "-i$build_dir/semantic-0.10.0.0/build/autogen" - echo "-I$build_dir/semantic-0.10.0.0/build/autogen" + if [ -d "$build_dir/semantic-0.10.0.0/build/autogen" ] + then add_autogen_includes "$build_dir/semantic-0.10.0.0/build/autogen" + elif [ -d "$build_dir/semantic-0.10.0.0/noopt/build/autogen" ] + then add_autogen_includes "$build_dir/semantic-0.10.0.0/noopt/build/autogen" + fi # .hs source dirs # TODO: would be nice to figure this out from cabal.project & the .cabal files From 70c86a1366a93f447d5bbac860d7c2a3a651feee Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 11:49:08 -0500 Subject: [PATCH 154/235] Update semantic-tsx.cabal --- semantic-tsx/semantic-tsx.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/semantic-tsx/semantic-tsx.cabal b/semantic-tsx/semantic-tsx.cabal index a871739f9..02bffdaaf 100644 --- a/semantic-tsx/semantic-tsx.cabal +++ b/semantic-tsx/semantic-tsx.cabal @@ -24,6 +24,7 @@ common haskell , fused-effects ^>= 1.0 , fused-syntax , parsers ^>= 0.12.10 + , semantic-codegen , semantic-core ^>= 0.0 , semantic-source ^>= 0.0.2 , semantic-tags ^>= 0.0 From d1066dc16900f612256c6c6873fa5eb94a0f87bf Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 12:19:55 -0500 Subject: [PATCH 155/235] Update semantic-java.cabal --- semantic-java/semantic-java.cabal | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/semantic-java/semantic-java.cabal b/semantic-java/semantic-java.cabal index 17ec3996c..a07cdf653 100644 --- a/semantic-java/semantic-java.cabal +++ b/semantic-java/semantic-java.cabal @@ -47,5 +47,4 @@ library -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-star-is-type -if (impl(ghc >= 8.8)) - ghc-options: -Wno-missing-deriving-strategies + -Wno-missing-deriving-strategies From 2c71d826364b4bd7a2c94bc885021ba6cd7f9228 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 31 Jan 2020 12:36:16 -0500 Subject: [PATCH 156/235] Enter assignment RHS values during scope graphing. We were neglecting to enter this RHS. A happy little call to `maybe` addresses this. --- semantic-python/src/Language/Python/ScopeGraph.hs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/semantic-python/src/Language/Python/ScopeGraph.hs b/semantic-python/src/Language/Python/ScopeGraph.hs index e5303a863..76934b899 100644 --- a/semantic-python/src/Language/Python/ScopeGraph.hs +++ b/semantic-python/src/Language/Python/ScopeGraph.hs @@ -87,8 +87,10 @@ scopeGraphModule = getAp . scopeGraph instance ToScopeGraph Py.AssertStatement where scopeGraph = onChildren instance ToScopeGraph Py.Assignment where - scopeGraph (Py.Assignment _ (SingleIdentifier t) _val _typ) = complete <* declare @Name (formatName t) DeclProperties - scopeGraph x = todo x + scopeGraph (Py.Assignment _ (SingleIdentifier t) val _typ) = do + declare @Name (formatName t) DeclProperties + maybe complete scopeGraph val + scopeGraph x = todo x instance ToScopeGraph Py.Await where scopeGraph (Py.Await _ a) = scopeGraph a From 7ceda6c6318d94082f45bcec4cc27064a3c4a386 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 31 Jan 2020 12:40:32 -0500 Subject: [PATCH 157/235] Merge fallout. --- semantic-python/src/Language/Python/ScopeGraph.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/semantic-python/src/Language/Python/ScopeGraph.hs b/semantic-python/src/Language/Python/ScopeGraph.hs index 589562f24..5092df764 100644 --- a/semantic-python/src/Language/Python/ScopeGraph.hs +++ b/semantic-python/src/Language/Python/ScopeGraph.hs @@ -92,10 +92,10 @@ scopeGraphModule = getAp . scopeGraph instance ToScopeGraph Py.AssertStatement where scopeGraph = onChildren instance ToScopeGraph Py.Assignment where - scopeGraph (Py.Assignment _ (SingleIdentifier t) _val _typ) = do + scopeGraph (Py.Assignment _ (SingleIdentifier t) val _typ) = do let declProps = (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing) maybe complete scopeGraph val <* declare t declProps - scopeGraph x = todo x + scopeGraph x = todo x instance ToScopeGraph Py.Await where scopeGraph (Py.Await _ a) = scopeGraph a From 45c81efd2c8db34ccfd1b358b222a502c535dab2 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 31 Jan 2020 13:11:59 -0500 Subject: [PATCH 158/235] Preserve Python AST span information in scope graph. - [ ] Depends on #451. --- .../src/Language/Python/ScopeGraph.hs | 34 +++++++++++++------ semantic-python/test-graphing/GraphTest.hs | 19 ++++++----- .../semantic-scope-graph.cabal | 1 + .../src/Control/Carrier/Sketch/Fresh.hs | 5 +-- .../src/Control/Effect/Sketch.hs | 33 +++++++++++++----- 5 files changed, 63 insertions(+), 29 deletions(-) diff --git a/semantic-python/src/Language/Python/ScopeGraph.hs b/semantic-python/src/Language/Python/ScopeGraph.hs index 5092df764..6200f29bc 100644 --- a/semantic-python/src/Language/Python/ScopeGraph.hs +++ b/semantic-python/src/Language/Python/ScopeGraph.hs @@ -27,16 +27,19 @@ import AST.Element import Control.Algebra (Algebra (..), handleCoercible) import Control.Effect.Fresh import Control.Effect.Sketch +import Control.Lens ((&), (.~), (^.)) import Data.Foldable import Data.Maybe import Data.Monoid import qualified Data.ScopeGraph as ScopeGraph +import Data.Semilattice.Lower import Data.Traversable import GHC.Records import GHC.TypeLits import Language.Python.Patterns import ScopeGraph.Convert (Result (..), complete, todo) import Source.Loc +import Source.Span (span_) import qualified TreeSitter.Python.AST as Py -- This orphan instance will perish once it lands in fused-effects. @@ -92,9 +95,14 @@ scopeGraphModule = getAp . scopeGraph instance ToScopeGraph Py.AssertStatement where scopeGraph = onChildren instance ToScopeGraph Py.Assignment where - scopeGraph (Py.Assignment _ (SingleIdentifier t) val _typ) = do - let declProps = (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing) - maybe complete scopeGraph val <* declare t declProps + scopeGraph (Py.Assignment ann (SingleIdentifier t) val _typ) = do + declare t DeclProperties + { kind = ScopeGraph.Assignment + , relation = ScopeGraph.Default + , associatedScope = Nothing + , spanInfo = ann^.span_ + } + maybe complete scopeGraph val scopeGraph x = todo x instance ToScopeGraph Py.Await where @@ -177,23 +185,29 @@ instance ToScopeGraph Py.ForStatement where scopeGraph = todo instance ToScopeGraph Py.FunctionDefinition where scopeGraph Py.FunctionDefinition - { name = Py.Identifier _ann1 name + { ann + , name = Py.Identifier _ann1 name , parameters = Py.Parameters _ann2 parameters , body } = do - let funProps = FunProperties ScopeGraph.Function + let funProps = FunProperties ScopeGraph.Function (ann^.span_) (_, associatedScope) <- declareFunction (Just $ Name.name name) funProps withScope associatedScope $ do - let declProps = DeclProperties ScopeGraph.Parameter ScopeGraph.Default Nothing - let param (Py.Parameter (Prj (Py.Identifier _pann pname))) = Just (Name.name pname) - param _ = Nothing + let declProps = DeclProperties + { kind = ScopeGraph.Parameter + , relation = ScopeGraph.Default + , associatedScope = Nothing + , spanInfo = lowerBound + } + let param (Py.Parameter (Prj (Py.Identifier pann pname))) = Just (pann, Name.name pname) + param _ = Nothing let parameterMs = fmap param parameters if any isNothing parameterMs then todo parameterMs else do let parameters' = catMaybes parameterMs - paramDeclarations <- for parameters' $ \parameter -> - complete <* declare parameter declProps + paramDeclarations <- for parameters' $ \(pos, parameter) -> + complete <* declare parameter (declProps & span_ .~ pos^.span_) bodyResult <- scopeGraph body pure (mconcat paramDeclarations <> bodyResult) diff --git a/semantic-python/test-graphing/GraphTest.hs b/semantic-python/test-graphing/GraphTest.hs index ce30b84a7..a0f66d61e 100644 --- a/semantic-python/test-graphing/GraphTest.hs +++ b/semantic-python/test-graphing/GraphTest.hs @@ -13,11 +13,13 @@ import Control.Carrier.Sketch.Fresh import Control.Monad import qualified Data.ByteString as ByteString import qualified Data.ScopeGraph as ScopeGraph +import Data.Semilattice.Lower import qualified Language.Python () import qualified Language.Python as Py (Term) import ScopeGraph.Convert import Source.Loc import qualified Source.Source as Source +import Source.Span import System.Exit (die) import System.Path (()) import qualified System.Path as Path @@ -53,8 +55,9 @@ runScopeGraph p _src item = run . runSketch (Just p) $ scopeGraph item sampleGraphThing :: (Has Sketch sig m) => m Result sampleGraphThing = do - declare "hello" (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing) - declare "goodbye" (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing) + -- TODO: until https://github.com/github/semantic/issues/457 is fixed, these are 0-indexed, which is technically wrong + declare "hello" (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 2 0) (Pos 2 10))) + declare "goodbye" (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 3 0) (Pos 3 12))) pure Complete graphFile :: FilePath -> IO (ScopeGraph.ScopeGraph Name, Result) @@ -74,7 +77,7 @@ assertSimpleAssignment = do expectedReference :: (Has Sketch sig m) => m Result expectedReference = do - declare "x" (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing) + declare "x" (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 0 0) (Pos 0 5))) reference "x" "x" RefProperties pure Complete @@ -88,15 +91,15 @@ assertSimpleReference = do expectedLexicalScope :: (Has Sketch sig m) => m Result expectedLexicalScope = do - _ <- declareFunction (Just $ Name.name "foo") (FunProperties ScopeGraph.Function) + _ <- declareFunction (Just $ Name.name "foo") (FunProperties ScopeGraph.Function (Span (Pos 0 0) (Pos 1 24))) reference "foo" "foo" RefProperties {} pure Complete expectedFunctionArg :: (Has Sketch sig m) => m Result expectedFunctionArg = do - (_, associatedScope) <- declareFunction (Just $ Name.name "foo") (FunProperties ScopeGraph.Function) + (_, associatedScope) <- declareFunction (Just $ Name.name "foo") (FunProperties ScopeGraph.Function (Span (Pos 0 0) (Pos 1 12))) withScope associatedScope $ do - declare "x" (DeclProperties ScopeGraph.Identifier ScopeGraph.Default Nothing) + declare "x" (DeclProperties ScopeGraph.Identifier ScopeGraph.Default Nothing lowerBound) reference "x" "x" RefProperties pure () reference "foo" "foo" RefProperties @@ -108,7 +111,7 @@ assertLexicalScope = do (graph, _) <- graphFile path case run (runSketch Nothing expectedLexicalScope) of (expecto, Complete) -> HUnit.assertEqual "Should work for simple case" expecto graph - (_, Todo msg) -> HUnit.assertFailure ("Failed to complete:" <> show msg) + (_, Todo msg) -> HUnit.assertFailure ("Failed to complete:" <> show msg) assertFunctionArg :: HUnit.Assertion assertFunctionArg = do @@ -116,7 +119,7 @@ assertFunctionArg = do (graph, _) <- graphFile path case run (runSketch Nothing expectedFunctionArg) of (expecto, Complete) -> HUnit.assertEqual "Should work for simple case" expecto graph - (_, Todo msg) -> HUnit.assertFailure ("Failed to complete:" <> show msg) + (_, Todo msg) -> HUnit.assertFailure ("Failed to complete:" <> show msg) main :: IO () main = do diff --git a/semantic-scope-graph/semantic-scope-graph.cabal b/semantic-scope-graph/semantic-scope-graph.cabal index cf8f65f14..854304f7d 100644 --- a/semantic-scope-graph/semantic-scope-graph.cabal +++ b/semantic-scope-graph/semantic-scope-graph.cabal @@ -33,6 +33,7 @@ library , containers , fused-effects ^>= 1.0 , generic-monoid + , generic-lens , hashable , lens , pathtype diff --git a/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs b/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs index c4c15c773..982b0336e 100644 --- a/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs +++ b/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs @@ -23,9 +23,10 @@ import Analysis.Name (Name) import qualified Analysis.Name as Name import Control.Algebra import Control.Carrier.Fresh.Strict -import Control.Carrier.State.Strict import Control.Carrier.Reader +import Control.Carrier.State.Strict import Control.Effect.Sketch +import Control.Lens ((^.)) import Control.Monad.IO.Class import Data.Bifunctor import Data.Module @@ -65,7 +66,7 @@ instance (Effect sig, Algebra sig m) => Algebra (SketchEff :+: Reader Name :+: F (lowerBound @ModuleInfo) (relation props) ScopeGraph.Public - (lowerBound @Span) + (props^.span_) (getField @"kind" @DeclProperties props) (associatedScope props) current diff --git a/semantic-scope-graph/src/Control/Effect/Sketch.hs b/semantic-scope-graph/src/Control/Effect/Sketch.hs index 417da3cb4..a51d30e31 100644 --- a/semantic-scope-graph/src/Control/Effect/Sketch.hs +++ b/semantic-scope-graph/src/Control/Effect/Sketch.hs @@ -28,28 +28,38 @@ module Control.Effect.Sketch , Has ) where +import Analysis.Name (Name) +import qualified Analysis.Name as Name import Control.Algebra import Control.Effect.Fresh import Control.Effect.Reader +import Control.Lens ((^.)) +import Data.Generics.Product (field) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Analysis.Name (Name) -import qualified Analysis.Name as Name import qualified Data.ScopeGraph as ScopeGraph import Data.Text (Text) import GHC.Generics (Generic, Generic1) import GHC.Records +import Source.Span -data DeclProperties = DeclProperties { - kind :: ScopeGraph.Kind +data DeclProperties = DeclProperties + { kind :: ScopeGraph.Kind , relation :: ScopeGraph.Relation , associatedScope :: Maybe Name -} + , spanInfo :: Span + } deriving Generic + +instance HasSpan DeclProperties where span_ = field @"spanInfo" data RefProperties = RefProperties -data FunProperties = FunProperties { - kind :: ScopeGraph.Kind -} + +data FunProperties = FunProperties + { kind :: ScopeGraph.Kind + , spanInfo :: Span + } deriving Generic + +instance HasSpan FunProperties where span_ = field @"spanInfo" type Sketch = SketchEff @@ -80,7 +90,12 @@ declareFunction name props = do currentScope' <- currentScope let lexicalEdges = Map.singleton ScopeGraph.Lexical [ currentScope' ] associatedScope <- newScope lexicalEdges - name' <- declareMaybeName name (DeclProperties { relation = ScopeGraph.Default, kind = (getField @"kind" @FunProperties props), associatedScope = Just associatedScope }) + name' <- declareMaybeName name DeclProperties + { relation = ScopeGraph.Default + , kind = (getField @"kind" @FunProperties props) + , associatedScope = Just associatedScope + , spanInfo = props^.span_ + } pure (name', associatedScope) declareMaybeName :: Has Sketch sig m From c53416c5f738ae8ebfc54e340cfd5061da16da40 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 31 Jan 2020 13:28:53 -0500 Subject: [PATCH 159/235] Merge fallout. --- semantic-python/src/Language/Python/ScopeGraph.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/semantic-python/src/Language/Python/ScopeGraph.hs b/semantic-python/src/Language/Python/ScopeGraph.hs index ef410d8a4..54748331d 100644 --- a/semantic-python/src/Language/Python/ScopeGraph.hs +++ b/semantic-python/src/Language/Python/ScopeGraph.hs @@ -22,8 +22,8 @@ module Language.Python.ScopeGraph ( scopeGraphModule ) where -import AST.Element import qualified Analysis.Name as Name +import AST.Element import Control.Algebra (Algebra (..), handleCoercible) import Control.Effect.Fresh import Control.Effect.Sketch @@ -92,7 +92,7 @@ scopeGraphModule = getAp . scopeGraph instance ToScopeGraph Py.AssertStatement where scopeGraph = onChildren instance ToScopeGraph Py.Assignment where - scopeGraph (Py.Assignment _ (SingleIdentifier t) _val _typ) = do + scopeGraph (Py.Assignment _ (SingleIdentifier t) val _typ) = do let declProps = (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing) declare t declProps maybe complete scopeGraph val From 91a1a1720b4959c2398704ab0a4e252694e3e283 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 31 Jan 2020 13:32:00 -0500 Subject: [PATCH 160/235] Fix documentation for Source.Span.Pos. Fixes #457. --- semantic-source/src/Source/Span.hs | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/semantic-source/src/Source/Span.hs b/semantic-source/src/Source/Span.hs index 109f321d7..d71553af6 100644 --- a/semantic-source/src/Source/Span.hs +++ b/semantic-source/src/Source/Span.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE DeriveGeneric, OverloadedStrings, RankNTypes #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RankNTypes #-} -- | Source position and span information -- -- Mostly taken from purescript's SourcePos definition. @@ -16,9 +18,9 @@ import Control.DeepSeq (NFData) import Data.Aeson ((.:), (.=)) import qualified Data.Aeson as A import Data.Hashable (Hashable) -import Data.Semilattice.Lower (Lower(..)) +import Data.Semilattice.Lower (Lower (..)) import GHC.Generics (Generic) -import GHC.Stack (SrcLoc(..)) +import GHC.Stack (SrcLoc (..)) -- | A Span of position information data Span = Span @@ -56,7 +58,11 @@ spanFromSrcLoc :: SrcLoc -> Span spanFromSrcLoc s = Span (Pos (srcLocStartLine s) (srcLocStartCol s)) (Pos (srcLocEndLine s) (srcLocEndCol s)) --- | Source position information (1-indexed) +-- | Source position information. +-- The 'Pos' values associated with ASTs returned from tree-sitter +-- 'Unmarshal' instances are zero-indexed. Unless you are displaying +-- span information to a user, you should write your code assuming +-- zero-indexing. data Pos = Pos { line :: {-# UNPACK #-} !Int , column :: {-# UNPACK #-} !Int From 64cc956ed839c4aedc0a622c9f260066826abedf Mon Sep 17 00:00:00 2001 From: Josh Vera Date: Fri, 31 Jan 2020 13:44:42 -0500 Subject: [PATCH 161/235] Remove declareFunction stub --- .../src/Control/Effect/Sketch.hs | 19 +------------------ 1 file changed, 1 insertion(+), 18 deletions(-) diff --git a/semantic-scope-graph/src/Control/Effect/Sketch.hs b/semantic-scope-graph/src/Control/Effect/Sketch.hs index 417da3cb4..79c56106e 100644 --- a/semantic-scope-graph/src/Control/Effect/Sketch.hs +++ b/semantic-scope-graph/src/Control/Effect/Sketch.hs @@ -97,21 +97,4 @@ withScope :: Has Sketch sig m -> m a -> m a withScope scope = local (const scope) --- declareFunction :: ( Has (State (ScopeGraph address)) sig m --- , Has (Allocator address) sig m --- , Has (Reader (CurrentScope address)) sig m --- , Has (Reader ModuleInfo) sig m --- , Has Fresh sig m --- , Ord address --- ) --- => Maybe Name --- -> ScopeGraph.AccessControl --- -> Span --- -> ScopeGraph.Kind --- -> Evaluator term address value m (Name, address) --- declareFunction name accessControl span kind = do --- currentScope' <- currentScope --- let lexicalEdges = Map.singleton Lexical [ currentScope' ] --- associatedScope <- newScope lexicalEdges --- name' <- declareMaybeName name Default accessControl span kind (Just associatedScope) --- pure (name', associatedScope) + From abad239511f71bf9413d4955648672ba839823d1 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 13:58:11 -0500 Subject: [PATCH 162/235] correct file --- semantic-typescript/src/Language/{ => TypeScript}/Grammar.hs | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename semantic-typescript/src/Language/{ => TypeScript}/Grammar.hs (100%) diff --git a/semantic-typescript/src/Language/Grammar.hs b/semantic-typescript/src/Language/TypeScript/Grammar.hs similarity index 100% rename from semantic-typescript/src/Language/Grammar.hs rename to semantic-typescript/src/Language/TypeScript/Grammar.hs From de4d3e768193ac8677607379139d3282122d6e17 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 14:46:48 -0500 Subject: [PATCH 163/235] Update Grammar.hs --- semantic-typescript/src/Language/TypeScript/Grammar.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic-typescript/src/Language/TypeScript/Grammar.hs b/semantic-typescript/src/Language/TypeScript/Grammar.hs index 29dbd0128..b398626fa 100644 --- a/semantic-typescript/src/Language/TypeScript/Grammar.hs +++ b/semantic-typescript/src/Language/TypeScript/Grammar.hs @@ -10,7 +10,7 @@ import AST.Grammar.TH import TreeSitter.Language (addDependentFileRelative) -- Regenerate template haskell code when these files change: -addDependentFileRelative "../../vendor/tree-sitter-typescript/typescript/src/parser.c" +addDependentFileRelative "../../../vendor/tree-sitter-typescript/typescript/src/parser.c" -- | Statically-known rules corresponding to symbols in the grammar. mkStaticallyKnownRuleGrammarData (mkName "Grammar") tree_sitter_typescript From ab6331f800d9dc814eb2dade7f0d3352fca054b9 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 15:01:47 -0500 Subject: [PATCH 164/235] Language.Ruby.Grammar not TreeSitter.Ruby --- semantic-ruby/src/Language/Ruby.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic-ruby/src/Language/Ruby.hs b/semantic-ruby/src/Language/Ruby.hs index 85dcc218a..96544acc2 100644 --- a/semantic-ruby/src/Language/Ruby.hs +++ b/semantic-ruby/src/Language/Ruby.hs @@ -3,7 +3,7 @@ -- | Semantic functionality for Ruby programs. module Language.Ruby ( Term(..) -, TreeSitter.Ruby.tree_sitter_ruby +, Language.Ruby.Grammar.tree_sitter_ruby ) where import Control.Carrier.State.Strict From 9aefc3c1a1ada3cfab32778018f2364ccd289f1b Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 31 Jan 2020 15:09:09 -0500 Subject: [PATCH 165/235] Pass -j to script/repl's GHCi flags. This significantly improves parallelism. --- script/ghci-flags | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/script/ghci-flags b/script/ghci-flags index 8a132bb15..e72205d1f 100755 --- a/script/ghci-flags +++ b/script/ghci-flags @@ -21,12 +21,17 @@ function add_autogen_includes { echo "-I$1" } +cores=$(sysctl -n machdep.cpu.core_count || echo 4) + function flags { # disable optimizations for faster loading echo "-O0" # don’t load .ghci files (for ghcide) echo "-ignore-dot-ghci" + # use as many jobs as there are physical cores + echo "-j$cores" + # where to put build products echo "-outputdir $build_products_dir" echo "-odir $build_products_dir" From e4805a96b2c462a541adf3313a18e7da0d913a71 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 15:16:18 -0500 Subject: [PATCH 166/235] Update semantic-python.cabal --- semantic-python/semantic-python.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/semantic-python/semantic-python.cabal b/semantic-python/semantic-python.cabal index 9feced2b8..b1ac66ec4 100644 --- a/semantic-python/semantic-python.cabal +++ b/semantic-python/semantic-python.cabal @@ -104,6 +104,7 @@ test-suite graphing build-depends: base , semantic-python + , semantic-codegen , semantic-scope-graph , bytestring , pathtype From ceaff3555fbe7fd7363f6a0f6f71b40f6394e688 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 15:17:39 -0500 Subject: [PATCH 167/235] Update semantic-python.cabal --- semantic-python/semantic-python.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/semantic-python/semantic-python.cabal b/semantic-python/semantic-python.cabal index b1ac66ec4..96bd295d5 100644 --- a/semantic-python/semantic-python.cabal +++ b/semantic-python/semantic-python.cabal @@ -26,6 +26,7 @@ common haskell , parsers ^>= 0.12.10 , semantic-analysis ^>= 0 , semantic-core ^>= 0.0 + , semantic-codegen , semantic-source ^>= 0.0.2 , semantic-tags ^>= 0.0 , semantic-scope-graph ^>= 0.0 From 894dcb489707fce4dae3d31f77cf420a031538d7 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 15:33:44 -0500 Subject: [PATCH 168/235] include semantic-codegen in common stanza of semantic.cabal --- semantic.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/semantic.cabal b/semantic.cabal index c23b1ccda..3258685e5 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -67,6 +67,7 @@ common dependencies , recursion-schemes ^>= 5.1 , scientific ^>= 0.3.6.2 , safe-exceptions ^>= 0.1.7.0 + , semantic-codegen , semantic-analysis ^>= 0 , semantic-source ^>= 0.0.2 , semilattices ^>= 0.0.0.3 From ad78882f51c637eb6a5452423c80e3eadfd34090 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 31 Jan 2020 15:46:05 -0500 Subject: [PATCH 169/235] Draft a HACKING.md file outlining best practices for development. --- HACKING.md | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) create mode 100644 HACKING.md diff --git a/HACKING.md b/HACKING.md new file mode 100644 index 000000000..67b1fd6af --- /dev/null +++ b/HACKING.md @@ -0,0 +1,29 @@ +# Effective `semantic` Hacking for Fun and Profit + +The Semantic repository is a large one, containing dozens of subprojects. This means that GHC has to do a lot of work when compiling. For this reason, it's important to keep in mind the principles that will let you avoid recompiling the whole world as soon as you change a single .cabal file. + +## The Landscape + +We officially recommend [Visual Studio Code](https://code.visualstudio.com) with the [`ghcide`](https://marketplace.visualstudio.com/items?itemName=DigitalAssetHoldingsLLC.ghcide) extension. Though our tooling scripts may work with other editor integration solutions, we can't guarantee that they'll do so indefinitely. + +## Things to Do + +1. *Use `script/repl`.* The REPL script is much more powerful than `cabal repl`; it ensures that all packages can be loaded (including tests), so you should be able to `:load` any on-disk package that you want—and you shouldn't have to restart the REPL every time you add a new file, as GHCi will optimistically read from any `import` statements it encounters. Keep in mind that `:load` accepts both file paths and module identifiers. + +2. *Use the editor integration.* There is no substitute for a workflow that allows you to fix errors without switching applications. If you're using tooling other than VS Code and `ghcide`, we recommend you configure its GHCi process to be `script/repl`. + +3. *Run tests in the REPL.* Unlike `cabal repl`, all the testing packages are loaded into the REPL, so you can `:load` a path to a test file and invoke the relevant test with `main`. This will enable the fastest fix/build/test cycle possible. It may take some time to get used to avoiding `cabal test`. If all you're wanting to see is if the `semantic` CLI tool builds correctly, `:load src/Semantic/CLI.hs`. + +4. *If you have to build, be sure to disable optimizations and parallelize aggressively.* `cabal` builds with `-O1` on by default; this entails a significant hit to compile speed. If you find yourself building some product repeatedly, add `optimizations: False`. + +5. *Turn on stylish-haskell integration.* Most editors are capable of running Haskell code through `stylish-haskell` on save; enabling this does wonders towards keeping your code in compliance with our style guide, frees you from having to fret over the minor details of how something should be formatted, and saves us time in the review process. The VSCode extension for `stylish-haskell` can be found here. + +## Things to Avoid + +1. *Don't `cabal clean`*. `cabal clean` doesn't take any arguments that determine what to clean; as such, running it will clean everything, including the language ASTs, which take some time to recompile. + +2. *Don't `cabal configure` if humanly possible*. It nukes all your build caches. Should you need to modify a global build setting, edit `cabal.project.local` manually. + +3. *Write small modules with minimal dependencies.* Keep the code that deals with language ASTs well-isolated. + +4. *Avoid fancy type tricks if possible.* Techniques like [advanced overlap](https://wiki.haskell.org/GHC/AdvancedOverlap) can save on boilerplate but may not be worth the pain it puts the type checker through. If the only downside to avoiding a fancy type trick is some boilerplate, consider that boilerplate is often preferable to slowing down everyone's build for the indefinite future. From 611301b3bb387ff4b2960b192bfcbda9584a6e55 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 15:50:05 -0500 Subject: [PATCH 170/235] get rid of prologue --- src/Language/Python/Assignment.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Language/Python/Assignment.hs b/src/Language/Python/Assignment.hs index bf465d784..3bf59e143 100644 --- a/src/Language/Python/Assignment.hs +++ b/src/Language/Python/Assignment.hs @@ -40,7 +40,6 @@ import qualified Data.Syntax.Statement as Statement import qualified Data.Syntax.Type as Type import Language.Python.Syntax as Python.Syntax import Language.Python.Term as Python -import Prologue import Language.Python.Grammar as Grammar type Assignment = Assignment.Assignment [] Grammar From 3f2396ee8c58266f7b5af9a86593ad5aa3a9abd7 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 15:50:53 -0500 Subject: [PATCH 171/235] change name from Data.Graph to Data.Graph.Algebraic --- src/Rendering/Graph.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Rendering/Graph.hs b/src/Rendering/Graph.hs index 66fd95ac9..ac1b448ce 100644 --- a/src/Rendering/Graph.hs +++ b/src/Rendering/Graph.hs @@ -20,7 +20,7 @@ import Data.Diff import Data.Edit import Data.Foldable import Data.Functor.Foldable -import Data.Graph +import Data.Graph.Algebraic import Data.ProtoLens (defMessage) import Data.String (IsString (..)) import Data.Term From c318e29326181522178424b690e93c2b1704c688 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 15:50:57 -0500 Subject: [PATCH 172/235] change name from Data.Graph to Data.Graph.Algebraic --- src/Semantic/Graph.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 413b0761e..7435e5890 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -68,7 +68,7 @@ import Data.Abstract.Value.Concrete as Concrete (Value, ValueError (.. import Data.Abstract.Value.Type as Type import Data.Blob import Data.Functor.Foldable -import Data.Graph +import Data.Graph.Algebraic import Data.Graph.ControlFlowVertex (VertexDeclaration) import Data.Language as Language import Data.List (find, isPrefixOf) From c5a2c1f8352f31d37f6aac7c269ac701e35c2f22 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 15:55:30 -0500 Subject: [PATCH 173/235] Update Terms.hs --- src/Semantic/Api/Terms.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Semantic/Api/Terms.hs b/src/Semantic/Api/Terms.hs index 6935e1ef0..1f8c76345 100644 --- a/src/Semantic/Api/Terms.hs +++ b/src/Semantic/Api/Terms.hs @@ -29,7 +29,7 @@ import Data.Either import Data.Foldable import Data.Functor.Classes import Data.Functor.Foldable -import Data.Graph +import Data.Graph.Algebraic (Edge(..), vertexList, edgeList) import Data.Language import Data.Map.Strict (Map) import Data.ProtoLens (defMessage) From 4a10964a012ed0501a4079a200634f222e1d7b72 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 15:56:28 -0500 Subject: [PATCH 174/235] Update Diffs.hs --- src/Semantic/Api/Diffs.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Semantic/Api/Diffs.hs b/src/Semantic/Api/Diffs.hs index fbb1b4aa2..3fdc570cb 100644 --- a/src/Semantic/Api/Diffs.hs +++ b/src/Semantic/Api/Diffs.hs @@ -28,7 +28,7 @@ import Data.Diff import Data.Edit import Data.Foldable import Data.Functor.Classes -import Data.Graph +import Data.Graph.Algebraic import Data.JSON.Fields (ToJSONFields1) import Data.Language import Data.Map.Strict (Map) From debaf51d7f617285698c3a87c57b264b51922c72 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Fri, 31 Jan 2020 16:09:45 -0500 Subject: [PATCH 175/235] =?UTF-8?q?import=20of=20=E2=80=98Data.ImportPath?= =?UTF-8?q?=E2=80=99=20is=20redundant?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Language/Go/Assignment.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Language/Go/Assignment.hs b/src/Language/Go/Assignment.hs index 0358fc43d..ee35acafd 100644 --- a/src/Language/Go/Assignment.hs +++ b/src/Language/Go/Assignment.hs @@ -15,7 +15,7 @@ import Assigning.Assignment hiding (Assignment, Error) import qualified Assigning.Assignment as Assignment import Control.Monad import qualified Data.Abstract.ScopeGraph as ScopeGraph (AccessControl (..)) -import Data.ImportPath (defaultAlias, importPath) +import Data.ImportPath () import Data.List.NonEmpty (NonEmpty (..), some1) import Data.Sum import Data.Syntax From 603f3c6130f3bc044893ab29033cdd271b0a4283 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Sun, 2 Feb 2020 09:06:43 -0500 Subject: [PATCH 176/235] add semantic-json to semantic.cabal test-suite --- semantic.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/semantic.cabal b/semantic.cabal index 3258685e5..290fd0d5f 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -361,6 +361,7 @@ test-suite test , Generators , Properties build-depends: semantic + , semantic-json , tree-sitter-json ^>= 0.6 , Glob ^>= 0.10.0 , hedgehog ^>= 1 From b21289b55be462b72f50b113e3d43c42fc9d241f Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 3 Feb 2020 10:14:53 -0500 Subject: [PATCH 177/235] Add lens dependency. --- semantic-python/semantic-python.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/semantic-python/semantic-python.cabal b/semantic-python/semantic-python.cabal index 39d06b261..140cebcc6 100644 --- a/semantic-python/semantic-python.cabal +++ b/semantic-python/semantic-python.cabal @@ -60,6 +60,7 @@ library Language.Python.ScopeGraph Language.Python.Tags hs-source-dirs: src + build-depends: lens ^>= 4.18 test-suite compiling import: haskell From 886962199ed001b463881aa1d65c6760fe9e9352 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 3 Feb 2020 10:19:40 -0500 Subject: [PATCH 178/235] add TSX grammar --- semantic-tsx/src/Language/TSX/Grammar.hs | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) create mode 100644 semantic-tsx/src/Language/TSX/Grammar.hs diff --git a/semantic-tsx/src/Language/TSX/Grammar.hs b/semantic-tsx/src/Language/TSX/Grammar.hs new file mode 100644 index 000000000..3af3469b6 --- /dev/null +++ b/semantic-tsx/src/Language/TSX/Grammar.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE TemplateHaskell #-} +module Language.TSX.Grammar +( tree_sitter_tsx +, Grammar(..) +) where + +import Language.Haskell.TH +import TreeSitter.TSX (tree_sitter_tsx) +import AST.Grammar.TH +import TreeSitter.Language (addDependentFileRelative) + +-- Regenerate template haskell code when these files change: +addDependentFileRelative "../../../vendor/tree-sitter-typescript/tsx/src/parser.c" + +-- | Statically-known rules corresponding to symbols in the grammar. +mkStaticallyKnownRuleGrammarData (mkName "Grammar") tree_sitter_tsx From 8592d531c1b139c3d6cb5bf0f049e4295a3f3261 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 3 Feb 2020 10:20:27 -0500 Subject: [PATCH 179/235] bump v5 to v6 to fix cabal store bug --- .github/workflows/haskell.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index df35bd28f..1129295df 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -37,7 +37,7 @@ jobs: name: Cache ~/.cabal/store with: path: ~/.cabal/store - key: ${{ runner.os }}-${{ matrix.ghc }}-v5-cabal-store + key: ${{ runner.os }}-${{ matrix.ghc }}-v6-cabal-store - uses: actions/cache@v1 name: Cache dist-newstyle From 510151ba353ed4152a1c68072534773dbe94e5b8 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 3 Feb 2020 10:24:47 -0500 Subject: [PATCH 180/235] Blow the cache. --- .github/workflows/haskell.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 21c35846c..850c0a7a8 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -37,7 +37,7 @@ jobs: name: Cache ~/.cabal/store with: path: ~/.cabal/store - key: ${{ runner.os }}-${{ matrix.ghc }}-v5-cabal-store + key: ${{ runner.os }}-${{ matrix.ghc }}-v6-cabal-store - uses: actions/cache@v1 name: Cache dist-newstyle From ccedf13bdeee617755d7370fc54de766831278ed Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 3 Feb 2020 10:33:20 -0500 Subject: [PATCH 181/235] Use some selector names in this FunProperties. --- semantic-python/src/Language/Python/ScopeGraph.hs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/semantic-python/src/Language/Python/ScopeGraph.hs b/semantic-python/src/Language/Python/ScopeGraph.hs index 6200f29bc..bcb51f8f4 100644 --- a/semantic-python/src/Language/Python/ScopeGraph.hs +++ b/semantic-python/src/Language/Python/ScopeGraph.hs @@ -27,7 +27,7 @@ import AST.Element import Control.Algebra (Algebra (..), handleCoercible) import Control.Effect.Fresh import Control.Effect.Sketch -import Control.Lens ((&), (.~), (^.)) +import Control.Lens (set, (^.)) import Data.Foldable import Data.Maybe import Data.Monoid @@ -190,8 +190,10 @@ instance ToScopeGraph Py.FunctionDefinition where , parameters = Py.Parameters _ann2 parameters , body } = do - let funProps = FunProperties ScopeGraph.Function (ann^.span_) - (_, associatedScope) <- declareFunction (Just $ Name.name name) funProps + (_, associatedScope) <- declareFunction (Just $ Name.name name) FunProperties + { kind = ScopeGraph.Function + , spanInfo = ann^.span_ + } withScope associatedScope $ do let declProps = DeclProperties { kind = ScopeGraph.Parameter @@ -207,7 +209,7 @@ instance ToScopeGraph Py.FunctionDefinition where else do let parameters' = catMaybes parameterMs paramDeclarations <- for parameters' $ \(pos, parameter) -> - complete <* declare parameter (declProps & span_ .~ pos^.span_) + complete <* declare parameter (set span_ (pos^.span_) declProps) bodyResult <- scopeGraph body pure (mconcat paramDeclarations <> bodyResult) From 546bfb25813a59806df71ecd933d4e59c51252c0 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 3 Feb 2020 11:10:31 -0500 Subject: [PATCH 182/235] Move DeclProperties to ScopeGraph.Properties.Declaration. --- .../src/Language/Python/ScopeGraph.hs | 21 ++++++------- semantic-python/test-graphing/GraphTest.hs | 10 +++---- .../semantic-scope-graph.cabal | 1 + .../src/Control/Carrier/Sketch/Fresh.hs | 12 ++++---- .../src/Control/Effect/Sketch.hs | 30 ++++++++----------- 5 files changed, 35 insertions(+), 39 deletions(-) diff --git a/semantic-python/src/Language/Python/ScopeGraph.hs b/semantic-python/src/Language/Python/ScopeGraph.hs index bcb51f8f4..1d9421d22 100644 --- a/semantic-python/src/Language/Python/ScopeGraph.hs +++ b/semantic-python/src/Language/Python/ScopeGraph.hs @@ -38,6 +38,7 @@ import GHC.Records import GHC.TypeLits import Language.Python.Patterns import ScopeGraph.Convert (Result (..), complete, todo) +import qualified ScopeGraph.Properties.Declaration as Props import Source.Loc import Source.Span (span_) import qualified TreeSitter.Python.AST as Py @@ -96,11 +97,11 @@ instance ToScopeGraph Py.AssertStatement where scopeGraph = onChildren instance ToScopeGraph Py.Assignment where scopeGraph (Py.Assignment ann (SingleIdentifier t) val _typ) = do - declare t DeclProperties - { kind = ScopeGraph.Assignment - , relation = ScopeGraph.Default - , associatedScope = Nothing - , spanInfo = ann^.span_ + declare t Props.Declaration + { Props.kind = ScopeGraph.Assignment + , Props.relation = ScopeGraph.Default + , Props.associatedScope = Nothing + , Props.span = ann^.span_ } maybe complete scopeGraph val scopeGraph x = todo x @@ -195,11 +196,11 @@ instance ToScopeGraph Py.FunctionDefinition where , spanInfo = ann^.span_ } withScope associatedScope $ do - let declProps = DeclProperties - { kind = ScopeGraph.Parameter - , relation = ScopeGraph.Default - , associatedScope = Nothing - , spanInfo = lowerBound + let declProps = Props.Declaration + { Props.kind = ScopeGraph.Parameter + , Props.relation = ScopeGraph.Default + , Props.associatedScope = Nothing + , Props.span = lowerBound } let param (Py.Parameter (Prj (Py.Identifier pann pname))) = Just (pann, Name.name pname) param _ = Nothing diff --git a/semantic-python/test-graphing/GraphTest.hs b/semantic-python/test-graphing/GraphTest.hs index a0f66d61e..5345820ab 100644 --- a/semantic-python/test-graphing/GraphTest.hs +++ b/semantic-python/test-graphing/GraphTest.hs @@ -17,6 +17,7 @@ import Data.Semilattice.Lower import qualified Language.Python () import qualified Language.Python as Py (Term) import ScopeGraph.Convert +import qualified ScopeGraph.Properties.Declaration as Props import Source.Loc import qualified Source.Source as Source import Source.Span @@ -55,9 +56,8 @@ runScopeGraph p _src item = run . runSketch (Just p) $ scopeGraph item sampleGraphThing :: (Has Sketch sig m) => m Result sampleGraphThing = do - -- TODO: until https://github.com/github/semantic/issues/457 is fixed, these are 0-indexed, which is technically wrong - declare "hello" (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 2 0) (Pos 2 10))) - declare "goodbye" (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 3 0) (Pos 3 12))) + declare "hello" (Props.Declaration ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 2 0) (Pos 2 10))) + declare "goodbye" (Props.Declaration ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 3 0) (Pos 3 12))) pure Complete graphFile :: FilePath -> IO (ScopeGraph.ScopeGraph Name, Result) @@ -77,7 +77,7 @@ assertSimpleAssignment = do expectedReference :: (Has Sketch sig m) => m Result expectedReference = do - declare "x" (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 0 0) (Pos 0 5))) + declare "x" (Props.Declaration ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 0 0) (Pos 0 5))) reference "x" "x" RefProperties pure Complete @@ -99,7 +99,7 @@ expectedFunctionArg :: (Has Sketch sig m) => m Result expectedFunctionArg = do (_, associatedScope) <- declareFunction (Just $ Name.name "foo") (FunProperties ScopeGraph.Function (Span (Pos 0 0) (Pos 1 12))) withScope associatedScope $ do - declare "x" (DeclProperties ScopeGraph.Identifier ScopeGraph.Default Nothing lowerBound) + declare "x" (Props.Declaration ScopeGraph.Identifier ScopeGraph.Default Nothing lowerBound) reference "x" "x" RefProperties pure () reference "foo" "foo" RefProperties diff --git a/semantic-scope-graph/semantic-scope-graph.cabal b/semantic-scope-graph/semantic-scope-graph.cabal index 854304f7d..4f5a08d53 100644 --- a/semantic-scope-graph/semantic-scope-graph.cabal +++ b/semantic-scope-graph/semantic-scope-graph.cabal @@ -23,6 +23,7 @@ library Control.Carrier.Sketch.Fresh Control.Effect.Sketch ScopeGraph.Convert + ScopeGraph.Properties.Declaration Data.Hole Data.Module Data.ScopeGraph diff --git a/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs b/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs index 982b0336e..a8d5c60ac 100644 --- a/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs +++ b/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs @@ -26,14 +26,13 @@ import Control.Carrier.Fresh.Strict import Control.Carrier.Reader import Control.Carrier.State.Strict import Control.Effect.Sketch -import Control.Lens ((^.)) import Control.Monad.IO.Class import Data.Bifunctor import Data.Module import Data.ScopeGraph (ScopeGraph) import qualified Data.ScopeGraph as ScopeGraph import Data.Semilattice.Lower -import GHC.Records +import qualified ScopeGraph.Properties.Declaration as Props import Source.Span import qualified System.Path as Path @@ -60,15 +59,16 @@ newtype SketchC address m a = SketchC (StateC Sketchbook (FreshC m) a) instance (Effect sig, Algebra sig m) => Algebra (SketchEff :+: Reader Name :+: Fresh :+: sig) (SketchC Name m) where alg (L (Declare n props k)) = do Sketchbook old current <- SketchC (get @Sketchbook) + let Props.Declaration kind relation associatedScope span = props let (new, _pos) = ScopeGraph.declare (ScopeGraph.Declaration n) (lowerBound @ModuleInfo) - (relation props) + relation ScopeGraph.Public - (props^.span_) - (getField @"kind" @DeclProperties props) - (associatedScope props) + span + kind + associatedScope current old SketchC (put (Sketchbook new current)) diff --git a/semantic-scope-graph/src/Control/Effect/Sketch.hs b/semantic-scope-graph/src/Control/Effect/Sketch.hs index 8f19edcb5..db6cd709d 100644 --- a/semantic-scope-graph/src/Control/Effect/Sketch.hs +++ b/semantic-scope-graph/src/Control/Effect/Sketch.hs @@ -14,7 +14,6 @@ module Control.Effect.Sketch ( Sketch , SketchEff (..) - , DeclProperties (..) , RefProperties (..) , FunProperties (..) , declare @@ -41,16 +40,9 @@ import qualified Data.ScopeGraph as ScopeGraph import Data.Text (Text) import GHC.Generics (Generic, Generic1) import GHC.Records +import qualified ScopeGraph.Properties.Declaration as Props import Source.Span -data DeclProperties = DeclProperties - { kind :: ScopeGraph.Kind - , relation :: ScopeGraph.Relation - , associatedScope :: Maybe Name - , spanInfo :: Span - } deriving Generic - -instance HasSpan DeclProperties where span_ = field @"spanInfo" data RefProperties = RefProperties @@ -67,7 +59,7 @@ type Sketch :+: Reader Name data SketchEff m k = - Declare Name DeclProperties (() -> m k) + Declare Name Props.Declaration (() -> m k) | Reference Text Text RefProperties (() -> m k) | NewScope (Map ScopeGraph.EdgeLabel [Name]) (Name -> m k) deriving (Generic, Generic1, HFunctor, Effect) @@ -75,7 +67,7 @@ data SketchEff m k = currentScope :: Has (Reader Name) sig m => m Name currentScope = ask -declare :: forall sig m . (Has Sketch sig m) => Name -> DeclProperties -> m () +declare :: forall sig m . (Has Sketch sig m) => Name -> Props.Declaration -> m () declare n props = send (Declare n props pure) -- | Establish a reference to a prior declaration. @@ -90,22 +82,24 @@ declareFunction name props = do currentScope' <- currentScope let lexicalEdges = Map.singleton ScopeGraph.Lexical [ currentScope' ] associatedScope <- newScope lexicalEdges - name' <- declareMaybeName name DeclProperties - { relation = ScopeGraph.Default - , kind = (getField @"kind" @FunProperties props) - , associatedScope = Just associatedScope - , spanInfo = props^.span_ + name' <- declareMaybeName name Props.Declaration + { Props.relation = ScopeGraph.Default + , Props.kind = (getField @"kind" @FunProperties props) + , Props.associatedScope = Just associatedScope + , Props.span = props^.span_ } pure (name', associatedScope) declareMaybeName :: Has Sketch sig m => Maybe Name - -> DeclProperties + -> Props.Declaration -> m Name declareMaybeName maybeName props = do case maybeName of Just name -> name <$ declare name props - _ -> Name.gensym >>= \name -> declare name (props { relation = ScopeGraph.Gensym }) >> pure name -- TODO: Modify props and change Kind to Gensym + _ -> do + name <- Name.gensym + name <$ declare name (props { Props.relation = ScopeGraph.Gensym }) withScope :: Has Sketch sig m => Name From 4bfbd5407e235ac4a1a60b35c06c1aa51598d3e8 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 3 Feb 2020 11:10:31 -0500 Subject: [PATCH 183/235] Move DeclProperties to ScopeGraph.Properties.Declaration. --- .../src/Language/Python/ScopeGraph.hs | 21 ++++++------- semantic-python/test-graphing/GraphTest.hs | 10 +++---- .../semantic-scope-graph.cabal | 1 + .../src/Control/Carrier/Sketch/Fresh.hs | 12 ++++---- .../src/Control/Effect/Sketch.hs | 30 ++++++++----------- .../src/ScopeGraph/Properties/Declaration.hs | 25 ++++++++++++++++ 6 files changed, 60 insertions(+), 39 deletions(-) create mode 100644 semantic-scope-graph/src/ScopeGraph/Properties/Declaration.hs diff --git a/semantic-python/src/Language/Python/ScopeGraph.hs b/semantic-python/src/Language/Python/ScopeGraph.hs index bcb51f8f4..1d9421d22 100644 --- a/semantic-python/src/Language/Python/ScopeGraph.hs +++ b/semantic-python/src/Language/Python/ScopeGraph.hs @@ -38,6 +38,7 @@ import GHC.Records import GHC.TypeLits import Language.Python.Patterns import ScopeGraph.Convert (Result (..), complete, todo) +import qualified ScopeGraph.Properties.Declaration as Props import Source.Loc import Source.Span (span_) import qualified TreeSitter.Python.AST as Py @@ -96,11 +97,11 @@ instance ToScopeGraph Py.AssertStatement where scopeGraph = onChildren instance ToScopeGraph Py.Assignment where scopeGraph (Py.Assignment ann (SingleIdentifier t) val _typ) = do - declare t DeclProperties - { kind = ScopeGraph.Assignment - , relation = ScopeGraph.Default - , associatedScope = Nothing - , spanInfo = ann^.span_ + declare t Props.Declaration + { Props.kind = ScopeGraph.Assignment + , Props.relation = ScopeGraph.Default + , Props.associatedScope = Nothing + , Props.span = ann^.span_ } maybe complete scopeGraph val scopeGraph x = todo x @@ -195,11 +196,11 @@ instance ToScopeGraph Py.FunctionDefinition where , spanInfo = ann^.span_ } withScope associatedScope $ do - let declProps = DeclProperties - { kind = ScopeGraph.Parameter - , relation = ScopeGraph.Default - , associatedScope = Nothing - , spanInfo = lowerBound + let declProps = Props.Declaration + { Props.kind = ScopeGraph.Parameter + , Props.relation = ScopeGraph.Default + , Props.associatedScope = Nothing + , Props.span = lowerBound } let param (Py.Parameter (Prj (Py.Identifier pann pname))) = Just (pann, Name.name pname) param _ = Nothing diff --git a/semantic-python/test-graphing/GraphTest.hs b/semantic-python/test-graphing/GraphTest.hs index a0f66d61e..5345820ab 100644 --- a/semantic-python/test-graphing/GraphTest.hs +++ b/semantic-python/test-graphing/GraphTest.hs @@ -17,6 +17,7 @@ import Data.Semilattice.Lower import qualified Language.Python () import qualified Language.Python as Py (Term) import ScopeGraph.Convert +import qualified ScopeGraph.Properties.Declaration as Props import Source.Loc import qualified Source.Source as Source import Source.Span @@ -55,9 +56,8 @@ runScopeGraph p _src item = run . runSketch (Just p) $ scopeGraph item sampleGraphThing :: (Has Sketch sig m) => m Result sampleGraphThing = do - -- TODO: until https://github.com/github/semantic/issues/457 is fixed, these are 0-indexed, which is technically wrong - declare "hello" (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 2 0) (Pos 2 10))) - declare "goodbye" (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 3 0) (Pos 3 12))) + declare "hello" (Props.Declaration ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 2 0) (Pos 2 10))) + declare "goodbye" (Props.Declaration ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 3 0) (Pos 3 12))) pure Complete graphFile :: FilePath -> IO (ScopeGraph.ScopeGraph Name, Result) @@ -77,7 +77,7 @@ assertSimpleAssignment = do expectedReference :: (Has Sketch sig m) => m Result expectedReference = do - declare "x" (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 0 0) (Pos 0 5))) + declare "x" (Props.Declaration ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 0 0) (Pos 0 5))) reference "x" "x" RefProperties pure Complete @@ -99,7 +99,7 @@ expectedFunctionArg :: (Has Sketch sig m) => m Result expectedFunctionArg = do (_, associatedScope) <- declareFunction (Just $ Name.name "foo") (FunProperties ScopeGraph.Function (Span (Pos 0 0) (Pos 1 12))) withScope associatedScope $ do - declare "x" (DeclProperties ScopeGraph.Identifier ScopeGraph.Default Nothing lowerBound) + declare "x" (Props.Declaration ScopeGraph.Identifier ScopeGraph.Default Nothing lowerBound) reference "x" "x" RefProperties pure () reference "foo" "foo" RefProperties diff --git a/semantic-scope-graph/semantic-scope-graph.cabal b/semantic-scope-graph/semantic-scope-graph.cabal index 854304f7d..4f5a08d53 100644 --- a/semantic-scope-graph/semantic-scope-graph.cabal +++ b/semantic-scope-graph/semantic-scope-graph.cabal @@ -23,6 +23,7 @@ library Control.Carrier.Sketch.Fresh Control.Effect.Sketch ScopeGraph.Convert + ScopeGraph.Properties.Declaration Data.Hole Data.Module Data.ScopeGraph diff --git a/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs b/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs index 982b0336e..a8d5c60ac 100644 --- a/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs +++ b/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs @@ -26,14 +26,13 @@ import Control.Carrier.Fresh.Strict import Control.Carrier.Reader import Control.Carrier.State.Strict import Control.Effect.Sketch -import Control.Lens ((^.)) import Control.Monad.IO.Class import Data.Bifunctor import Data.Module import Data.ScopeGraph (ScopeGraph) import qualified Data.ScopeGraph as ScopeGraph import Data.Semilattice.Lower -import GHC.Records +import qualified ScopeGraph.Properties.Declaration as Props import Source.Span import qualified System.Path as Path @@ -60,15 +59,16 @@ newtype SketchC address m a = SketchC (StateC Sketchbook (FreshC m) a) instance (Effect sig, Algebra sig m) => Algebra (SketchEff :+: Reader Name :+: Fresh :+: sig) (SketchC Name m) where alg (L (Declare n props k)) = do Sketchbook old current <- SketchC (get @Sketchbook) + let Props.Declaration kind relation associatedScope span = props let (new, _pos) = ScopeGraph.declare (ScopeGraph.Declaration n) (lowerBound @ModuleInfo) - (relation props) + relation ScopeGraph.Public - (props^.span_) - (getField @"kind" @DeclProperties props) - (associatedScope props) + span + kind + associatedScope current old SketchC (put (Sketchbook new current)) diff --git a/semantic-scope-graph/src/Control/Effect/Sketch.hs b/semantic-scope-graph/src/Control/Effect/Sketch.hs index 8f19edcb5..db6cd709d 100644 --- a/semantic-scope-graph/src/Control/Effect/Sketch.hs +++ b/semantic-scope-graph/src/Control/Effect/Sketch.hs @@ -14,7 +14,6 @@ module Control.Effect.Sketch ( Sketch , SketchEff (..) - , DeclProperties (..) , RefProperties (..) , FunProperties (..) , declare @@ -41,16 +40,9 @@ import qualified Data.ScopeGraph as ScopeGraph import Data.Text (Text) import GHC.Generics (Generic, Generic1) import GHC.Records +import qualified ScopeGraph.Properties.Declaration as Props import Source.Span -data DeclProperties = DeclProperties - { kind :: ScopeGraph.Kind - , relation :: ScopeGraph.Relation - , associatedScope :: Maybe Name - , spanInfo :: Span - } deriving Generic - -instance HasSpan DeclProperties where span_ = field @"spanInfo" data RefProperties = RefProperties @@ -67,7 +59,7 @@ type Sketch :+: Reader Name data SketchEff m k = - Declare Name DeclProperties (() -> m k) + Declare Name Props.Declaration (() -> m k) | Reference Text Text RefProperties (() -> m k) | NewScope (Map ScopeGraph.EdgeLabel [Name]) (Name -> m k) deriving (Generic, Generic1, HFunctor, Effect) @@ -75,7 +67,7 @@ data SketchEff m k = currentScope :: Has (Reader Name) sig m => m Name currentScope = ask -declare :: forall sig m . (Has Sketch sig m) => Name -> DeclProperties -> m () +declare :: forall sig m . (Has Sketch sig m) => Name -> Props.Declaration -> m () declare n props = send (Declare n props pure) -- | Establish a reference to a prior declaration. @@ -90,22 +82,24 @@ declareFunction name props = do currentScope' <- currentScope let lexicalEdges = Map.singleton ScopeGraph.Lexical [ currentScope' ] associatedScope <- newScope lexicalEdges - name' <- declareMaybeName name DeclProperties - { relation = ScopeGraph.Default - , kind = (getField @"kind" @FunProperties props) - , associatedScope = Just associatedScope - , spanInfo = props^.span_ + name' <- declareMaybeName name Props.Declaration + { Props.relation = ScopeGraph.Default + , Props.kind = (getField @"kind" @FunProperties props) + , Props.associatedScope = Just associatedScope + , Props.span = props^.span_ } pure (name', associatedScope) declareMaybeName :: Has Sketch sig m => Maybe Name - -> DeclProperties + -> Props.Declaration -> m Name declareMaybeName maybeName props = do case maybeName of Just name -> name <$ declare name props - _ -> Name.gensym >>= \name -> declare name (props { relation = ScopeGraph.Gensym }) >> pure name -- TODO: Modify props and change Kind to Gensym + _ -> do + name <- Name.gensym + name <$ declare name (props { Props.relation = ScopeGraph.Gensym }) withScope :: Has Sketch sig m => Name diff --git a/semantic-scope-graph/src/ScopeGraph/Properties/Declaration.hs b/semantic-scope-graph/src/ScopeGraph/Properties/Declaration.hs new file mode 100644 index 000000000..3ea7aca37 --- /dev/null +++ b/semantic-scope-graph/src/ScopeGraph/Properties/Declaration.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeApplications #-} + +-- | The 'Declaration' record type is used by the 'Control.Effect.Sketch' module to keep +-- track of the parameters that need to be passed when establishing a new declaration. +-- That is to say, it is a record type primarily used for its selector names. +module ScopeGraph.Properties.Declaration + ( Declaration (..) + ) where + +import Analysis.Name (Name) +import Data.Generics.Product (field) +import Data.ScopeGraph as ScopeGraph (Kind, Relation) +import GHC.Generics (Generic) +import Source.Span + +data Declaration = Declaration + { kind :: ScopeGraph.Kind + , relation :: ScopeGraph.Relation + , associatedScope :: Maybe Name + , span :: Span + } deriving Generic + +instance HasSpan Declaration where span_ = field @"span" From 1672c577682331528948a2282b0ea3d51afec6a5 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Mon, 3 Feb 2020 11:19:54 -0500 Subject: [PATCH 184/235] Move over Function and Reference properties. --- .../src/Language/Python/ScopeGraph.hs | 10 ++++--- semantic-python/test-graphing/GraphTest.hs | 14 +++++---- .../semantic-scope-graph.cabal | 2 ++ .../src/Control/Effect/Sketch.hs | 30 +++++-------------- .../src/ScopeGraph/Properties/Function.hs | 22 ++++++++++++++ .../src/ScopeGraph/Properties/Reference.hs | 9 ++++++ 6 files changed, 55 insertions(+), 32 deletions(-) create mode 100644 semantic-scope-graph/src/ScopeGraph/Properties/Function.hs create mode 100644 semantic-scope-graph/src/ScopeGraph/Properties/Reference.hs diff --git a/semantic-python/src/Language/Python/ScopeGraph.hs b/semantic-python/src/Language/Python/ScopeGraph.hs index 1d9421d22..d2f383b57 100644 --- a/semantic-python/src/Language/Python/ScopeGraph.hs +++ b/semantic-python/src/Language/Python/ScopeGraph.hs @@ -39,6 +39,8 @@ import GHC.TypeLits import Language.Python.Patterns import ScopeGraph.Convert (Result (..), complete, todo) import qualified ScopeGraph.Properties.Declaration as Props +import qualified ScopeGraph.Properties.Function as Props +import qualified ScopeGraph.Properties.Reference as Props import Source.Loc import Source.Span (span_) import qualified TreeSitter.Python.AST as Py @@ -191,9 +193,9 @@ instance ToScopeGraph Py.FunctionDefinition where , parameters = Py.Parameters _ann2 parameters , body } = do - (_, associatedScope) <- declareFunction (Just $ Name.name name) FunProperties - { kind = ScopeGraph.Function - , spanInfo = ann^.span_ + (_, associatedScope) <- declareFunction (Just $ Name.name name) Props.Function + { Props.kind = ScopeGraph.Function + , Props.span = ann^.span_ } withScope associatedScope $ do let declProps = Props.Declaration @@ -220,7 +222,7 @@ instance ToScopeGraph Py.GeneratorExpression where scopeGraph = todo instance ToScopeGraph Py.Identifier where scopeGraph (Py.Identifier _ name) = do - reference name name RefProperties + reference name name Props.Reference complete instance ToScopeGraph Py.IfStatement where diff --git a/semantic-python/test-graphing/GraphTest.hs b/semantic-python/test-graphing/GraphTest.hs index 5345820ab..f64c798bd 100644 --- a/semantic-python/test-graphing/GraphTest.hs +++ b/semantic-python/test-graphing/GraphTest.hs @@ -18,6 +18,8 @@ import qualified Language.Python () import qualified Language.Python as Py (Term) import ScopeGraph.Convert import qualified ScopeGraph.Properties.Declaration as Props +import qualified ScopeGraph.Properties.Function as Props +import qualified ScopeGraph.Properties.Reference as Props import Source.Loc import qualified Source.Source as Source import Source.Span @@ -78,7 +80,7 @@ assertSimpleAssignment = do expectedReference :: (Has Sketch sig m) => m Result expectedReference = do declare "x" (Props.Declaration ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 0 0) (Pos 0 5))) - reference "x" "x" RefProperties + reference "x" "x" Props.Reference pure Complete assertSimpleReference :: HUnit.Assertion @@ -91,18 +93,18 @@ assertSimpleReference = do expectedLexicalScope :: (Has Sketch sig m) => m Result expectedLexicalScope = do - _ <- declareFunction (Just $ Name.name "foo") (FunProperties ScopeGraph.Function (Span (Pos 0 0) (Pos 1 24))) - reference "foo" "foo" RefProperties {} + _ <- declareFunction (Just $ Name.name "foo") (Props.Function ScopeGraph.Function (Span (Pos 0 0) (Pos 1 24))) + reference "foo" "foo" Props.Reference {} pure Complete expectedFunctionArg :: (Has Sketch sig m) => m Result expectedFunctionArg = do - (_, associatedScope) <- declareFunction (Just $ Name.name "foo") (FunProperties ScopeGraph.Function (Span (Pos 0 0) (Pos 1 12))) + (_, associatedScope) <- declareFunction (Just $ Name.name "foo") (Props.Function ScopeGraph.Function (Span (Pos 0 0) (Pos 1 12))) withScope associatedScope $ do declare "x" (Props.Declaration ScopeGraph.Identifier ScopeGraph.Default Nothing lowerBound) - reference "x" "x" RefProperties + reference "x" "x" Props.Reference pure () - reference "foo" "foo" RefProperties + reference "foo" "foo" Props.Reference pure Complete assertLexicalScope :: HUnit.Assertion diff --git a/semantic-scope-graph/semantic-scope-graph.cabal b/semantic-scope-graph/semantic-scope-graph.cabal index 4f5a08d53..08d962bd1 100644 --- a/semantic-scope-graph/semantic-scope-graph.cabal +++ b/semantic-scope-graph/semantic-scope-graph.cabal @@ -24,6 +24,8 @@ library Control.Effect.Sketch ScopeGraph.Convert ScopeGraph.Properties.Declaration + ScopeGraph.Properties.Function + ScopeGraph.Properties.Reference Data.Hole Data.Module Data.ScopeGraph diff --git a/semantic-scope-graph/src/Control/Effect/Sketch.hs b/semantic-scope-graph/src/Control/Effect/Sketch.hs index db6cd709d..c33d40e04 100644 --- a/semantic-scope-graph/src/Control/Effect/Sketch.hs +++ b/semantic-scope-graph/src/Control/Effect/Sketch.hs @@ -14,8 +14,6 @@ module Control.Effect.Sketch ( Sketch , SketchEff (..) - , RefProperties (..) - , FunProperties (..) , declare -- Scope Manipulation , currentScope @@ -32,26 +30,14 @@ import qualified Analysis.Name as Name import Control.Algebra import Control.Effect.Fresh import Control.Effect.Reader -import Control.Lens ((^.)) -import Data.Generics.Product (field) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import qualified Data.ScopeGraph as ScopeGraph import Data.Text (Text) import GHC.Generics (Generic, Generic1) -import GHC.Records import qualified ScopeGraph.Properties.Declaration as Props -import Source.Span - - -data RefProperties = RefProperties - -data FunProperties = FunProperties - { kind :: ScopeGraph.Kind - , spanInfo :: Span - } deriving Generic - -instance HasSpan FunProperties where span_ = field @"spanInfo" +import qualified ScopeGraph.Properties.Function as Props +import qualified ScopeGraph.Properties.Reference as Props type Sketch = SketchEff @@ -60,7 +46,7 @@ type Sketch data SketchEff m k = Declare Name Props.Declaration (() -> m k) - | Reference Text Text RefProperties (() -> m k) + | Reference Text Text Props.Reference (() -> m k) | NewScope (Map ScopeGraph.EdgeLabel [Name]) (Name -> m k) deriving (Generic, Generic1, HFunctor, Effect) @@ -71,22 +57,22 @@ declare :: forall sig m . (Has Sketch sig m) => Name -> Props.Declaration -> m ( declare n props = send (Declare n props pure) -- | Establish a reference to a prior declaration. -reference :: forall sig m . (Has Sketch sig m) => Text -> Text -> RefProperties -> m () +reference :: forall sig m . (Has Sketch sig m) => Text -> Text -> Props.Reference -> m () reference n decl props = send (Reference n decl props pure) newScope :: forall sig m . (Has Sketch sig m) => Map ScopeGraph.EdgeLabel [Name] -> m Name newScope edges = send (NewScope edges pure) -declareFunction :: forall sig m . (Has Sketch sig m) => Maybe Name -> FunProperties -> m (Name, Name) -declareFunction name props = do +declareFunction :: forall sig m . (Has Sketch sig m) => Maybe Name -> Props.Function -> m (Name, Name) +declareFunction name (Props.Function kind span) = do currentScope' <- currentScope let lexicalEdges = Map.singleton ScopeGraph.Lexical [ currentScope' ] associatedScope <- newScope lexicalEdges name' <- declareMaybeName name Props.Declaration { Props.relation = ScopeGraph.Default - , Props.kind = (getField @"kind" @FunProperties props) + , Props.kind = kind , Props.associatedScope = Just associatedScope - , Props.span = props^.span_ + , Props.span = span } pure (name', associatedScope) diff --git a/semantic-scope-graph/src/ScopeGraph/Properties/Function.hs b/semantic-scope-graph/src/ScopeGraph/Properties/Function.hs new file mode 100644 index 000000000..9146455b8 --- /dev/null +++ b/semantic-scope-graph/src/ScopeGraph/Properties/Function.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeApplications #-} + +-- | The 'Function' record type is used by the 'Control.Effect.Sketch' module to keep +-- track of the parameters that need to be passed when establishing a new declaration. +-- That is to say, it is a record type primarily used for its selector names. +module ScopeGraph.Properties.Function + ( Function (..) + ) where + +import Data.Generics.Product (field) +import qualified Data.ScopeGraph as ScopeGraph (Kind) +import GHC.Generics (Generic) +import Source.Span + +data Function = Function + { kind :: ScopeGraph.Kind + , span :: Span + } deriving Generic + +instance HasSpan Function where span_ = field @"span" diff --git a/semantic-scope-graph/src/ScopeGraph/Properties/Reference.hs b/semantic-scope-graph/src/ScopeGraph/Properties/Reference.hs new file mode 100644 index 000000000..84f598efe --- /dev/null +++ b/semantic-scope-graph/src/ScopeGraph/Properties/Reference.hs @@ -0,0 +1,9 @@ +-- | The 'Declaration' record type is used by the 'Control.Effect.Sketch' module to keep +-- track of the parameters that need to be passed when establishing a new reference. +-- It is currently unused, but will possess more fields in the future as scope graph +-- functionality is enhanced. +module ScopeGraph.Properties.Reference + ( Reference (..) + ) where + +data Reference = Reference From 048e6c54fd22c73bfc9fe8038e6c9331865fdd24 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 3 Feb 2020 11:47:13 -0500 Subject: [PATCH 185/235] Create README.md --- semantic-codegen/README.md | 214 +++++++++++++++++++++++++++++++++++++ 1 file changed, 214 insertions(+) create mode 100644 semantic-codegen/README.md diff --git a/semantic-codegen/README.md b/semantic-codegen/README.md new file mode 100644 index 000000000..af6fe558b --- /dev/null +++ b/semantic-codegen/README.md @@ -0,0 +1,214 @@ +# CodeGen Documentation + +CodeGen is the process for auto-generating language-specific, strongly-typed ASTs to be used in [Semantic](https://github.com/github/semantic-code/blob/d9f91a05dc30a61b9ff8c536d75661d417f3c506/design-docs/precise-code-navigation.md). + +### Prerequisites +To get started, first make sure your language has: + +1. An existing [tree-sitter](http://tree-sitter.github.io/tree-sitter/) parser; +2. An existing Cabal package in this repository for said language. This will provide an interface into tree-sitter's C source. [Here](https://github.com/tree-sitter/haskell-tree-sitter/tree/master/tree-sitter-python) is an example of a library for Python, a supported language that the remaining documentation will refer to. + +### CodeGen Pipeline + +During parser generation, tree-sitter produces a JSON file that captures the structure of a language's grammar. Based on this, we're able to derive datatypes representing surface languages, and then use those datatypes to generically build ASTs. This automates the engineering effort [historically required for adding a new language](https://github.com/github/semantic/blob/master/docs/adding-new-languages.md). + +The following steps provide a high-level outline of the process: + +1. [**Deserialize.**](https://github.com/tree-sitter/haskell-tree-sitter/blob/master/tree-sitter/src/TreeSitter/Deserialize.hs) First, we deserialize the `node-types.json` file for a given language into the desired shape of datatypes via parsing capabilities afforded by the [Aeson](http://hackage.haskell.org/package/aeson) library. There are four distinct types represented in the node-types.json file takes on: sums, products, named leaves and anonymous leaves. +2. [**Generate Syntax.**](https://github.com/tree-sitter/haskell-tree-sitter/blob/master/tree-sitter/src/TreeSitter/GenerateSyntax.hs) We then use Template Haskell to auto-generate language-specific, strongly-typed datatypes that represent various language constructs. This API exports the top-level function `astDeclarationsForLanguage` to auto-generate datatypes at compile-time, which is is invoked by a given language [AST](https://github.com/tree-sitter/haskell-tree-sitter/blob/master/tree-sitter-python/TreeSitter/Python/AST.hs) module. +3. [**Unmarshal.**](https://github.com/tree-sitter/haskell-tree-sitter/blob/master/tree-sitter/src/TreeSitter/Unmarshal.hs) Unmarshaling is the process of iterating over tree-sitter’s parse trees using its tree cursor API, and producing Haskell ASTs for the relevant nodes. We parse source code from tree-sitter and unmarshal the data we get to build these ASTs generically. This file exports the top-level function `parseByteString`, which takes source code and a language as arguments, and produces an AST. + +Here is an example that describes the relationship between a Python identifier represented in the tree-sitter generated JSON file, and a datatype generated by Template Haskell based on the provided JSON: + +| Type | JSON | TH-generated code | +|----------|--------------|------------| +|Named leaf|{
"type": "identifier",
"named": true
}|data TreeSitter.Python.AST.Identifier a
= TreeSitter.Python.AST.Identifier {TreeSitter.Python.AST.ann :: a,
TreeSitter.Python.AST.bytes :: text-1.2.3.1:Data.Text.Internal.Text} -- Defined at TreeSitter/Python/AST.hs:10:1
instance Show a => Show (TreeSitter.Python.AST.Identifier a) -- Defined at TreeSitter/Python/AST.hs:10:1
instance Ord a => Ord (TreeSitter.Python.AST.Identifier a) -- Defined at TreeSitter/Python/AST.hs:10:1
instance Eq a => Eq (TreeSitter.Python.AST.Identifier a) -- Defined at TreeSitter/Python/AST.hs:10:1
instance Traversable TreeSitter.Python.AST.Identifier -- Defined at TreeSitter/Python/AST.hs:10:1
instance Functor TreeSitter.Python.AST.Identifier -- Defined at TreeSitter/Python/AST.hs:10:1
instance Foldable TreeSitter.Python.AST.Identifier -- Defined at TreeSitter/Python/AST.hs:10:1
instance Unmarshal TreeSitter.Python.AST.Identifier -- Defined at TreeSitter/Python/AST.hs:10:1
instance SymbolMatching TreeSitter.Python.AST.Identifier -- Defined at TreeSitter/Python/AST.hs:10:1| + +The remaining document provides more details on generating ASTs, inspecting datatypes, tests, and information on decisions pertaining to relevant APIs. +___ + +### Table of Contents +- [CodeGen Documentation](#codegen-documentation) + - [Prerequisites](#prerequisites) + - [CodeGen Pipeline](#codegen-pipeline) + - [Table of Contents](#table-of-contents) + - [Generating ASTs](#generating-asts) + - [Inspecting auto-generated datatypes](#inspecting-auto-generated-datatypes) + - [Tests](#tests) + - [Additional notes](#additional-notes) +___ + +### Generating ASTs + +To parse source code and produce ASTs locally: + +1. Load the REPL for a given language: + +``` +cabal new-repl lib:tree-sitter-python +``` + +2. Set language extensions, `OverloadedStrings` and `TypeApplications`, and import relevant modules, `TreeSitter.Unmarshal`, `Source.Range` and `Source.Span`: + +``` +:seti -XOverloadedStrings +:seti -XTypeApplications + +import Source.Span +import Source.Range +import TreeSitter.Unmarshal +``` + +3. You can now call `parseByteString`, passing in the desired language you wish to parse (in this case Python exemplified by `tree_sitter_python`), and the source code (in this case an integer `1`). Since the function is constrained by `(Unmarshal t, UnmarshalAnn a)`, you can use type applications to provide a top-level node `t`, an entry point into the tree, in addition to a polymorphic annotation `a` used to represent range and span: + +``` +parseByteString @TreeSitter.Python.AST.Module @(Source.Span.Span, Source.Range.Range) tree_sitter_python "1" +``` + +This generates the following AST: + +``` +Right + ( Module + { ann = + ( Range + { start = 0 + , end = 1 + } + , Span + { start = Pos + { line = 0 + , column = 0 + } + , end = Pos + { line = 0 + , column = 1 + } + } + ) + , extraChildren = + [ R1 + ( SimpleStatement + ( L1 + ( R1 + ( R1 + ( L1 + ( ExpressionStatement + { ann = + ( Range + { start = 0 + , end = 1 + } + , Span + { start = Pos + { line = 0 + , column = 0 + } + , end = Pos + { line = 0 + , column = 1 + } + } + ) + , extraChildren = L1 + ( L1 + ( Expression + ( L1 + ( L1 + ( L1 + ( PrimaryExpression + ( R1 + ( L1 + ( L1 + ( L1 + ( Integer + { ann = + ( Range + { start = 0 + , end = 1 + } + , Span + { start = Pos + { line = 0 + , column = 0 + } + , end = Pos + { line = 0 + , column = 1 + } + } + ) + , text = "1" + } + ) + ) + ) + ) + ) + ) + ) + ) + ) + ) + ) :| [] + } + ) + ) + ) + ) + ) + ) + ] + } + ) +``` + +### Inspecting auto-generated datatypes + +Datatypes are derived from a language and its `node-types.json` file using the GenerateSyntax API. Definition can be viewed in the REPL just as they would for any other datatype, using `:i`: + +``` +:i TreeSitter.Python.AST.Module +``` + +This shows us the auto-generated `Module` datatype: + +```Haskell +data TreeSitter.Python.AST.Module a + = TreeSitter.Python.AST.Module {TreeSitter.Python.AST.ann :: a, + TreeSitter.Python.AST.extraChildren :: [(GHC.Generics.:+:) + TreeSitter.Python.AST.CompoundStatement + TreeSitter.Python.AST.SimpleStatement + a]} + -- Defined at TreeSitter/Python/AST.hs:10:1 +instance Show a => Show (TreeSitter.Python.AST.Module a) + -- Defined at TreeSitter/Python/AST.hs:10:1 +instance Ord a => Ord (TreeSitter.Python.AST.Module a) + -- Defined at TreeSitter/Python/AST.hs:10:1 +instance Eq a => Eq (TreeSitter.Python.AST.Module a) + -- Defined at TreeSitter/Python/AST.hs:10:1 +instance Traversable TreeSitter.Python.AST.Module + -- Defined at TreeSitter/Python/AST.hs:10:1 +instance Functor TreeSitter.Python.AST.Module + -- Defined at TreeSitter/Python/AST.hs:10:1 +instance Foldable TreeSitter.Python.AST.Module + -- Defined at TreeSitter/Python/AST.hs:10:1 +instance Unmarshal TreeSitter.Python.AST.Module + -- Defined at TreeSitter/Python/AST.hs:10:1 +instance SymbolMatching TreeSitter.Python.AST.Module + -- Defined at TreeSitter/Python/AST.hs:10:1 +``` + +### Tests + +As of right now, Hedgehog tests are minimal and only in place for the Python library. + +To run tests: + +`cabal v2-test tree-sitter-python` + +### Additional notes + +- [GenerateSyntax](https://github.com/tree-sitter/haskell-tree-sitter/blob/master/tree-sitter/src/TreeSitter/GenerateSyntax.hs) provides a way to pre-define certain datatypes for which Template Haskell is not used. Any datatypes among the node types which have already been defined in the module where the splice is run will be skipped, allowing customization of the representation of parts of the tree. While this gives us flexibility, we encourage that this is used sparingly, as it imposes extra maintenance burden, particularly when the grammar is changed. This may be used to e.g. parse literals into Haskell equivalents (e.g. parsing the textual contents of integer literals into `Integer`s), and may require defining `TS.UnmarshalAnn` or `TS.SymbolMatching` instances for (parts of) the custom datatypes, depending on where and how the datatype occurs in the generated tree, in addition to the usual `Foldable`, `Functor`, etc. instances provided for generated datatypes. +- Annotations are captured by a polymorphic parameter `a` +- [Unmarshal](https://github.com/tree-sitter/haskell-tree-sitter/blob/master/tree-sitter/src/TreeSitter/Unmarshal.hs) defines both generic and non-generic classes. This is because generic behaviors are different than what we get non-generically, and in the case of ` Maybe`, `[]`—we actually preference doing things non-generically. Since `[]` is a sum, the generic behavior for `:+:` would be invoked and expect that we’d have repetitions represented in the parse tree as right-nested singly-linked lists (ex., `(a (b (c (d…))))`) rather than as just consecutive sibling nodes (ex., `(a b c ...d)`, which is what our trees have). We want to match the latter. From 3f27722a6355f5338374144b336a10fbc2e1e339 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 3 Feb 2020 11:57:20 -0500 Subject: [PATCH 186/235] Update adding-new-languages.md --- docs/adding-new-languages.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/adding-new-languages.md b/docs/adding-new-languages.md index 9d6bc5e0f..29ddc5cfe 100644 --- a/docs/adding-new-languages.md +++ b/docs/adding-new-languages.md @@ -9,7 +9,7 @@ Please note that this list of steps reflects the state of Semantic as is, not wh 1. **Find or write a [tree-sitter](https://tree-sitter.github.io) parser for your language.** The tree-sitter [organization page](https://github.com/tree-sitter) has a number of parsers beyond those we currently support in Semantic; look there first to make sure you're not duplicating work. The tree-sitter [documentation on creating parsers](http://tree-sitter.github.io/tree-sitter/creating-parsers) provides an exhaustive look at the process of developing and debugging tree-sitter parsers. Though we do not support grammars written with other toolkits such as [ANTLR](https://www.antlr.org), translating an ANTLR or other BNF-style grammar into a tree-sitter grammar is usually straightforward. 2. **Create a Haskell library providing an interface to that C source.** The [`haskell-tree-sitter`](https://github.com/tree-sitter/haskell-tree-sitter) repository provides a Cabal package for each supported language. You can find an example of a pull request to add such a package here. Each package needs to provide two API surfaces: * a bridged (via the FFI) reference to the toplevel parser in the generated file ([example](https://github.com/tree-sitter/haskell-tree-sitter/blob/master/tree-sitter-json/internal/TreeSitter/JSON/Internal.hs)) - * symbol datatypes for each syntax node in the parser, generated with the `mkSymbolDatatype` Template Haskell splice ([example](https://github.com/tree-sitter/haskell-tree-sitter/blob/master/tree-sitter-json/TreeSitter/JSON.hs)) + * symbol datatypes for each syntax node in the parser, generated with the `mkSymbolDatatype` Template Haskell splice ([example](https://github.com/github/semantic/blob/master/semantic-json/src/Language/JSON/Grammar.hs)). For more information, see CodeGen docs. 3. **Identify the new syntax nodes required to represent your language.** While we provide an extensive library of reusable AST nodes for [literals](https://github.com/github/semantic/blob/master/src/Data/Syntax/Literal.hs), [expressions](https://github.com/github/semantic/blob/master/src/Data/Syntax/Expression.hs), [statements](https://github.com/github/semantic/blob/master/src/Data/Syntax/Statement.hs), and [types](https://github.com/github/semantic/blob/master/src/Data/Syntax/Type.hs), most languages will require some syntax nodes not found in other languages. You'll need to create a new module providing those data types, and those data types must be written as an open union: [here](https://github.com/github/semantic/commits/master/src/Language/Ruby/Syntax.hs?author=charliesome) is an example for Ruby's syntactic details. 4. **Write an assignment step that translates tree-sitter trees into Haskell datatypes.** More information about this can be found in the [assignment documentation](assignment.md). This is currently the most time-consuming and error-prone part of the process (see [https://github.com/github/semantic/issues/77]). 5. **Implement `Evaluatable` instances and add new [`Value` effects](https://github.com/github/semantic/blob/master/src/Control/Abstract/Value.hs) as is needed to describe the control flow of your language.** While several features of Semantic (e.g. `semantic parse --symbols` and `semantic diff`) will become fully available given a working assignment step, further features based on concrete or abstract interpretation (such as `semantic graph`) require implementing the `Evaluatable` typeclass and providing value-style effects for each control flow feature provided by the language. This means that language support is a spectrum: Semantic can provide useful information without any knowledge of a language's semantics, but each successive addition to its interpretive capabilities enables more functionality. From 434b7391e8006104b8e32ce8999eaf81255b1af4 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 3 Feb 2020 12:12:48 -0500 Subject: [PATCH 187/235] add code-gen docs to adding-new-languages.md --- docs/adding-new-languages.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docs/adding-new-languages.md b/docs/adding-new-languages.md index 29ddc5cfe..a12b33f08 100644 --- a/docs/adding-new-languages.md +++ b/docs/adding-new-languages.md @@ -9,7 +9,7 @@ Please note that this list of steps reflects the state of Semantic as is, not wh 1. **Find or write a [tree-sitter](https://tree-sitter.github.io) parser for your language.** The tree-sitter [organization page](https://github.com/tree-sitter) has a number of parsers beyond those we currently support in Semantic; look there first to make sure you're not duplicating work. The tree-sitter [documentation on creating parsers](http://tree-sitter.github.io/tree-sitter/creating-parsers) provides an exhaustive look at the process of developing and debugging tree-sitter parsers. Though we do not support grammars written with other toolkits such as [ANTLR](https://www.antlr.org), translating an ANTLR or other BNF-style grammar into a tree-sitter grammar is usually straightforward. 2. **Create a Haskell library providing an interface to that C source.** The [`haskell-tree-sitter`](https://github.com/tree-sitter/haskell-tree-sitter) repository provides a Cabal package for each supported language. You can find an example of a pull request to add such a package here. Each package needs to provide two API surfaces: * a bridged (via the FFI) reference to the toplevel parser in the generated file ([example](https://github.com/tree-sitter/haskell-tree-sitter/blob/master/tree-sitter-json/internal/TreeSitter/JSON/Internal.hs)) - * symbol datatypes for each syntax node in the parser, generated with the `mkSymbolDatatype` Template Haskell splice ([example](https://github.com/github/semantic/blob/master/semantic-json/src/Language/JSON/Grammar.hs)). For more information, see CodeGen docs. + * symbol datatypes for each syntax node in the parser, generated with the `mkSymbolDatatype` Template Haskell splice ([example](https://github.com/github/semantic/blob/master/semantic-json/src/Language/JSON/Grammar.hs)). For more information, see [CodeGen docs](https://github.com/github/semantic/blob/master/semantic-codegen/README.md). 3. **Identify the new syntax nodes required to represent your language.** While we provide an extensive library of reusable AST nodes for [literals](https://github.com/github/semantic/blob/master/src/Data/Syntax/Literal.hs), [expressions](https://github.com/github/semantic/blob/master/src/Data/Syntax/Expression.hs), [statements](https://github.com/github/semantic/blob/master/src/Data/Syntax/Statement.hs), and [types](https://github.com/github/semantic/blob/master/src/Data/Syntax/Type.hs), most languages will require some syntax nodes not found in other languages. You'll need to create a new module providing those data types, and those data types must be written as an open union: [here](https://github.com/github/semantic/commits/master/src/Language/Ruby/Syntax.hs?author=charliesome) is an example for Ruby's syntactic details. 4. **Write an assignment step that translates tree-sitter trees into Haskell datatypes.** More information about this can be found in the [assignment documentation](assignment.md). This is currently the most time-consuming and error-prone part of the process (see [https://github.com/github/semantic/issues/77]). 5. **Implement `Evaluatable` instances and add new [`Value` effects](https://github.com/github/semantic/blob/master/src/Control/Abstract/Value.hs) as is needed to describe the control flow of your language.** While several features of Semantic (e.g. `semantic parse --symbols` and `semantic diff`) will become fully available given a working assignment step, further features based on concrete or abstract interpretation (such as `semantic graph`) require implementing the `Evaluatable` typeclass and providing value-style effects for each control flow feature provided by the language. This means that language support is a spectrum: Semantic can provide useful information without any knowledge of a language's semantics, but each successive addition to its interpretive capabilities enables more functionality. From 4a3bfdc9a445682f22b8c8dc0ba3f441d85da34a Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 3 Feb 2020 12:17:00 -0500 Subject: [PATCH 188/235] Update `Deserialize` location --- semantic-codegen/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic-codegen/README.md b/semantic-codegen/README.md index af6fe558b..d7ab9b6ac 100644 --- a/semantic-codegen/README.md +++ b/semantic-codegen/README.md @@ -14,7 +14,7 @@ During parser generation, tree-sitter produces a JSON file that captures the str The following steps provide a high-level outline of the process: -1. [**Deserialize.**](https://github.com/tree-sitter/haskell-tree-sitter/blob/master/tree-sitter/src/TreeSitter/Deserialize.hs) First, we deserialize the `node-types.json` file for a given language into the desired shape of datatypes via parsing capabilities afforded by the [Aeson](http://hackage.haskell.org/package/aeson) library. There are four distinct types represented in the node-types.json file takes on: sums, products, named leaves and anonymous leaves. +1. [**Deserialize.**](https://github.com/github/semantic/blob/master/semantic-codegen/src/AST/Deserialize.hs) First, we deserialize the `node-types.json` file for a given language into the desired shape of datatypes via parsing capabilities afforded by the [Aeson](http://hackage.haskell.org/package/aeson) library. There are four distinct types represented in the node-types.json file takes on: sums, products, named leaves and anonymous leaves. 2. [**Generate Syntax.**](https://github.com/tree-sitter/haskell-tree-sitter/blob/master/tree-sitter/src/TreeSitter/GenerateSyntax.hs) We then use Template Haskell to auto-generate language-specific, strongly-typed datatypes that represent various language constructs. This API exports the top-level function `astDeclarationsForLanguage` to auto-generate datatypes at compile-time, which is is invoked by a given language [AST](https://github.com/tree-sitter/haskell-tree-sitter/blob/master/tree-sitter-python/TreeSitter/Python/AST.hs) module. 3. [**Unmarshal.**](https://github.com/tree-sitter/haskell-tree-sitter/blob/master/tree-sitter/src/TreeSitter/Unmarshal.hs) Unmarshaling is the process of iterating over tree-sitter’s parse trees using its tree cursor API, and producing Haskell ASTs for the relevant nodes. We parse source code from tree-sitter and unmarshal the data we get to build these ASTs generically. This file exports the top-level function `parseByteString`, which takes source code and a language as arguments, and produces an AST. From 69e7cfd3521f48ff01b43459e900ef5ae64a0a9b Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 3 Feb 2020 12:20:11 -0500 Subject: [PATCH 189/235] Update `GenerateSyntax` location --- semantic-codegen/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic-codegen/README.md b/semantic-codegen/README.md index d7ab9b6ac..95252540c 100644 --- a/semantic-codegen/README.md +++ b/semantic-codegen/README.md @@ -15,8 +15,8 @@ During parser generation, tree-sitter produces a JSON file that captures the str The following steps provide a high-level outline of the process: 1. [**Deserialize.**](https://github.com/github/semantic/blob/master/semantic-codegen/src/AST/Deserialize.hs) First, we deserialize the `node-types.json` file for a given language into the desired shape of datatypes via parsing capabilities afforded by the [Aeson](http://hackage.haskell.org/package/aeson) library. There are four distinct types represented in the node-types.json file takes on: sums, products, named leaves and anonymous leaves. -2. [**Generate Syntax.**](https://github.com/tree-sitter/haskell-tree-sitter/blob/master/tree-sitter/src/TreeSitter/GenerateSyntax.hs) We then use Template Haskell to auto-generate language-specific, strongly-typed datatypes that represent various language constructs. This API exports the top-level function `astDeclarationsForLanguage` to auto-generate datatypes at compile-time, which is is invoked by a given language [AST](https://github.com/tree-sitter/haskell-tree-sitter/blob/master/tree-sitter-python/TreeSitter/Python/AST.hs) module. 3. [**Unmarshal.**](https://github.com/tree-sitter/haskell-tree-sitter/blob/master/tree-sitter/src/TreeSitter/Unmarshal.hs) Unmarshaling is the process of iterating over tree-sitter’s parse trees using its tree cursor API, and producing Haskell ASTs for the relevant nodes. We parse source code from tree-sitter and unmarshal the data we get to build these ASTs generically. This file exports the top-level function `parseByteString`, which takes source code and a language as arguments, and produces an AST. +2. [**Generate Syntax.**](https://github.com/github/semantic/blob/master/semantic-codegen/src/AST/GenerateSyntax.hs) We then use Template Haskell to auto-generate language-specific, strongly-typed datatypes that represent various language constructs. This API exports the top-level function `astDeclarationsForLanguage` to auto-generate datatypes at compile-time, which is is invoked by a given language [AST](https://github.com/github/semantic/blob/master/semantic-python/src/Language/Python/AST.hs) module. Here is an example that describes the relationship between a Python identifier represented in the tree-sitter generated JSON file, and a datatype generated by Template Haskell based on the provided JSON: From 59eaa42e893db6b88ff3339fa1a3cbc83470999a Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 3 Feb 2020 12:20:26 -0500 Subject: [PATCH 190/235] Update `Unmarshal` location --- semantic-codegen/README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/semantic-codegen/README.md b/semantic-codegen/README.md index 95252540c..2235902b9 100644 --- a/semantic-codegen/README.md +++ b/semantic-codegen/README.md @@ -15,8 +15,8 @@ During parser generation, tree-sitter produces a JSON file that captures the str The following steps provide a high-level outline of the process: 1. [**Deserialize.**](https://github.com/github/semantic/blob/master/semantic-codegen/src/AST/Deserialize.hs) First, we deserialize the `node-types.json` file for a given language into the desired shape of datatypes via parsing capabilities afforded by the [Aeson](http://hackage.haskell.org/package/aeson) library. There are four distinct types represented in the node-types.json file takes on: sums, products, named leaves and anonymous leaves. -3. [**Unmarshal.**](https://github.com/tree-sitter/haskell-tree-sitter/blob/master/tree-sitter/src/TreeSitter/Unmarshal.hs) Unmarshaling is the process of iterating over tree-sitter’s parse trees using its tree cursor API, and producing Haskell ASTs for the relevant nodes. We parse source code from tree-sitter and unmarshal the data we get to build these ASTs generically. This file exports the top-level function `parseByteString`, which takes source code and a language as arguments, and produces an AST. 2. [**Generate Syntax.**](https://github.com/github/semantic/blob/master/semantic-codegen/src/AST/GenerateSyntax.hs) We then use Template Haskell to auto-generate language-specific, strongly-typed datatypes that represent various language constructs. This API exports the top-level function `astDeclarationsForLanguage` to auto-generate datatypes at compile-time, which is is invoked by a given language [AST](https://github.com/github/semantic/blob/master/semantic-python/src/Language/Python/AST.hs) module. +3. [**Unmarshal.**](https://github.com/github/semantic/blob/master/semantic-codegen/src/AST/Unmarshal.hs) Unmarshaling is the process of iterating over tree-sitter’s parse trees using its tree cursor API, and producing Haskell ASTs for the relevant nodes. We parse source code from tree-sitter and unmarshal the data we get to build these ASTs generically. This file exports the top-level function `parseByteString`, which takes source code and a language as arguments, and produces an AST. Here is an example that describes the relationship between a Python identifier represented in the tree-sitter generated JSON file, and a datatype generated by Template Haskell based on the provided JSON: From 7ee9da344dc28678366fec6fa297f76614ec0670 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 3 Feb 2020 12:20:49 -0500 Subject: [PATCH 191/235] change `TreeSitter.*` to `AST.*` --- semantic-codegen/README.md | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/semantic-codegen/README.md b/semantic-codegen/README.md index 2235902b9..691814bcd 100644 --- a/semantic-codegen/README.md +++ b/semantic-codegen/README.md @@ -48,7 +48,6 @@ To parse source code and produce ASTs locally: cabal new-repl lib:tree-sitter-python ``` -2. Set language extensions, `OverloadedStrings` and `TypeApplications`, and import relevant modules, `TreeSitter.Unmarshal`, `Source.Range` and `Source.Span`: ``` :seti -XOverloadedStrings @@ -56,7 +55,7 @@ cabal new-repl lib:tree-sitter-python import Source.Span import Source.Range -import TreeSitter.Unmarshal +import AST.Unmarshal ``` 3. You can now call `parseByteString`, passing in the desired language you wish to parse (in this case Python exemplified by `tree_sitter_python`), and the source code (in this case an integer `1`). Since the function is constrained by `(Unmarshal t, UnmarshalAnn a)`, you can use type applications to provide a top-level node `t`, an entry point into the tree, in addition to a polymorphic annotation `a` used to represent range and span: From 3aa65bd2d5b49410607fe3af7ab5576894617a41 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 3 Feb 2020 12:28:58 -0500 Subject: [PATCH 192/235] leave a note talking about movement --- semantic-codegen/README.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/semantic-codegen/README.md b/semantic-codegen/README.md index 691814bcd..f4ac9bbc6 100644 --- a/semantic-codegen/README.md +++ b/semantic-codegen/README.md @@ -2,6 +2,8 @@ CodeGen is the process for auto-generating language-specific, strongly-typed ASTs to be used in [Semantic](https://github.com/github/semantic-code/blob/d9f91a05dc30a61b9ff8c536d75661d417f3c506/design-docs/precise-code-navigation.md). +_Note: This project was recently moved from `tree-sitter` into `Semantic`. These docs are in the process of being updated to reflect changes._ + ### Prerequisites To get started, first make sure your language has: From c2b94456b67ab299a0fcbdd539b42d26fba7cf55 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 3 Feb 2020 12:29:13 -0500 Subject: [PATCH 193/235] AST.Marshal ftw --- semantic-codegen/README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/semantic-codegen/README.md b/semantic-codegen/README.md index f4ac9bbc6..18b78a94b 100644 --- a/semantic-codegen/README.md +++ b/semantic-codegen/README.md @@ -50,6 +50,7 @@ To parse source code and produce ASTs locally: cabal new-repl lib:tree-sitter-python ``` +2. Set language extensions, `OverloadedStrings` and `TypeApplications`, and import relevant modules, `AST.Unmarshal`, `Source.Range` and `Source.Span`: ``` :seti -XOverloadedStrings From 5b8c7fdbaf69bd541f9de8b23e20c1ec55712d40 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 3 Feb 2020 14:11:52 -0500 Subject: [PATCH 194/235] Create Examples.hs --- semantic-codegen/src/AST/Grammar/Examples.hs | 83 ++++++++++++++++++++ 1 file changed, 83 insertions(+) create mode 100644 semantic-codegen/src/AST/Grammar/Examples.hs diff --git a/semantic-codegen/src/AST/Grammar/Examples.hs b/semantic-codegen/src/AST/Grammar/Examples.hs new file mode 100644 index 000000000..71e2c352a --- /dev/null +++ b/semantic-codegen/src/AST/Grammar/Examples.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE DataKinds, DeriveAnyClass, DeriveGeneric, DuplicateRecordFields, TypeOperators #-} +module AST.Grammar.Examples () where + +import Control.Effect.Reader +import Control.Monad.Fail +import qualified Data.ByteString as B +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import GHC.Generics ((:+:), Generic1) +import Numeric (readDec) +import Prelude hiding (fail) +import Source.Range +import AST.Token +import AST.Unmarshal + +-- | An example of a sum-of-products datatype. +newtype Expr a = Expr ((If :+: Block :+: Var :+: Lit :+: Bin) a) + deriving (Generic1, Unmarshal) + +instance SymbolMatching Expr where + matchedSymbols _ = [] + showFailure _ _ = "" + +-- | Product with multiple fields. +data If a = If { ann :: a, condition :: Expr a, consequence :: Expr a, alternative :: Maybe (Expr a) } + deriving (Generic1, Unmarshal) + +instance SymbolMatching If where + matchedSymbols _ = [] + showFailure _ _ = "" + +-- | Single-field product. +data Block a = Block { ann :: a, body :: [Expr a] } + deriving (Generic1, Unmarshal) + +instance SymbolMatching Block where + matchedSymbols _ = [] + showFailure _ _ = "" + +-- | Leaf node. +data Var a = Var { ann :: a, text :: Text.Text } + deriving (Generic1, Unmarshal) + +instance SymbolMatching Var where + matchedSymbols _ = [] + showFailure _ _ = "" + +-- | Custom leaf node. +data Lit a = Lit { ann :: a, lit :: IntegerLit } + deriving (Generic1, Unmarshal) + +instance SymbolMatching Lit where + matchedSymbols _ = [] + showFailure _ _ = "" + +-- | Product with anonymous sum field. +data Bin a = Bin { ann :: a, lhs :: Expr a, op :: (AnonPlus :+: AnonTimes) a, rhs :: Expr a } + deriving (Generic1, Unmarshal) + +instance SymbolMatching Bin where + matchedSymbols _ = [] + showFailure _ _ = "" + +-- | Anonymous leaf node. +type AnonPlus = Token "+" 0 + +-- | Anonymous leaf node. +type AnonTimes = Token "*" 1 + + +newtype IntegerLit = IntegerLit Integer + +instance UnmarshalAnn IntegerLit where + unmarshalAnn node = do + Range start end <- unmarshalAnn node + bytestring <- asks source + let drop = B.drop start + take = B.take (end - start) + slice = take . drop + str = Text.unpack (Text.decodeUtf8 (slice bytestring)) + case readDec str of + (i, _):_ -> pure (IntegerLit i) + _ -> fail ("could not parse '" <> str <> "'") From 24cea64644864acbba5981e9510467aa37219b96 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 3 Feb 2020 16:14:14 -0500 Subject: [PATCH 195/235] remove unnecessary qualifier --- semantic-ast/app/Main.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/semantic-ast/app/Main.hs b/semantic-ast/app/Main.hs index 0f3126184..9425b22a5 100644 --- a/semantic-ast/app/Main.hs +++ b/semantic-ast/app/Main.hs @@ -2,7 +2,7 @@ module Main (main) where -import AST.Unmarshal as Unmarshal +import AST.Unmarshal import qualified Language.Python.AST as AST import qualified Language.Python.Grammar as Python import Source.Range @@ -54,7 +54,7 @@ generateAST (SemanticAST format noColor source) = Left filePaths -> traverse Data.ByteString.readFile filePaths Right source -> pure [Data.ByteString.Char8.pack source] go = ast >=> display - ast = Unmarshal.parseByteString @AST.Module @(Range, Span) Python.tree_sitter_python -- TODO: generalize for all languages + ast = parseByteString @AST.Module @(Range, Span) Python.tree_sitter_python -- TODO: generalize for all languages display = case format of Json -> Data.ByteString.Lazy.Char8.putStrLn . encodePretty . either toJSON (marshal . fmap (const ())) -- TODO: replacing range and span annotations with () for which there is a ToJSON instance for now, deal with this later Show -> print From 131f706e01491f56a46a89f1ec7142f59507d949 Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 3 Feb 2020 16:16:29 -0500 Subject: [PATCH 196/235] Continue to get this symbol from TreeSitter.Go --- semantic-go/src/Language/Go.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/semantic-go/src/Language/Go.hs b/semantic-go/src/Language/Go.hs index 8bbf54b47..4e7ef430a 100644 --- a/semantic-go/src/Language/Go.hs +++ b/semantic-go/src/Language/Go.hs @@ -1,7 +1,7 @@ -- | Semantic functionality for Go programs. module Language.Go ( Term(..) -, Language.Go.Grammar.tree_sitter_go +, TreeSitter.Go.tree_sitter_go ) where @@ -9,7 +9,7 @@ import Data.Proxy import qualified Language.Go.AST as Go import qualified Language.Go.Tags as GoTags import qualified Tags.Tagging.Precise as Tags -import qualified Language.Go.Grammar (tree_sitter_go) +import qualified TreeSitter.Go (tree_sitter_go) import qualified AST.Unmarshal as TS newtype Term a = Term { getTerm :: Go.SourceFile a } From dd3b686d7ca2cb42f2a87c6663966b1ae501c82a Mon Sep 17 00:00:00 2001 From: Ayman Nadeem Date: Mon, 3 Feb 2020 16:17:59 -0500 Subject: [PATCH 197/235] alphabetize --- semantic-ruby/src/Language/Ruby.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/semantic-ruby/src/Language/Ruby.hs b/semantic-ruby/src/Language/Ruby.hs index 96544acc2..fad36a7eb 100644 --- a/semantic-ruby/src/Language/Ruby.hs +++ b/semantic-ruby/src/Language/Ruby.hs @@ -6,14 +6,14 @@ module Language.Ruby , Language.Ruby.Grammar.tree_sitter_ruby ) where +import qualified AST.Unmarshal as TS import Control.Carrier.State.Strict import Data.Proxy import Data.Text (Text) import qualified Language.Ruby.AST as Rb +import qualified Language.Ruby.Grammar (tree_sitter_ruby) import qualified Language.Ruby.Tags as RbTags import qualified Tags.Tagging.Precise as Tags -import qualified Language.Ruby.Grammar (tree_sitter_ruby) -import qualified AST.Unmarshal as TS newtype Term a = Term { getTerm :: Rb.Program a } From 46b9ce578e95c25ca53634ad15a0d60966bb79cc Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 4 Feb 2020 10:39:18 -0500 Subject: [PATCH 198/235] Make Data.Span.Pos's Lower instance zero-indexed. This is a major version bump for semantic-source. --- semantic-source/semantic-source.cabal | 2 +- semantic-source/src/Source/Span.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/semantic-source/semantic-source.cabal b/semantic-source/semantic-source.cabal index c4eca2548..fa1024711 100644 --- a/semantic-source/semantic-source.cabal +++ b/semantic-source/semantic-source.cabal @@ -1,7 +1,7 @@ cabal-version: 2.4 name: semantic-source -version: 0.0.2.0 +version: 0.1.0.0 synopsis: Types and functionality for working with source code description: Types and functionality for working with source code (program text). homepage: https://github.com/github/semantic/tree/master/semantic-source#readme diff --git a/semantic-source/src/Source/Span.hs b/semantic-source/src/Source/Span.hs index d71553af6..f3e645071 100644 --- a/semantic-source/src/Source/Span.hs +++ b/semantic-source/src/Source/Span.hs @@ -84,7 +84,7 @@ instance A.FromJSON Pos where pure $ Pos line col instance Lower Pos where - lowerBound = Pos 1 1 + lowerBound = Pos 0 0 line_, column_ :: Lens' Pos Int From 93e0047b7512aaa1d670a4408b62745500def943 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 4 Feb 2020 11:15:57 -0500 Subject: [PATCH 199/235] Remove the Lower instance for Span and Pos entirely. If we ever need these in the future, we can create named variables for them. The `Lower` instance is an information-hole. --- semantic-source/src/Source/Span.hs | 9 --------- 1 file changed, 9 deletions(-) diff --git a/semantic-source/src/Source/Span.hs b/semantic-source/src/Source/Span.hs index f3e645071..7d15bce87 100644 --- a/semantic-source/src/Source/Span.hs +++ b/semantic-source/src/Source/Span.hs @@ -18,7 +18,6 @@ import Control.DeepSeq (NFData) import Data.Aeson ((.:), (.=)) import qualified Data.Aeson as A import Data.Hashable (Hashable) -import Data.Semilattice.Lower (Lower (..)) import GHC.Generics (Generic) import GHC.Stack (SrcLoc (..)) @@ -46,10 +45,6 @@ instance A.FromJSON Span where <$> o .: "start" <*> o .: "end" -instance Lower Span where - lowerBound = Span lowerBound lowerBound - - -- | Construct a Span with a given value for both its start and end positions. point :: Pos -> Span point p = Span p p @@ -83,10 +78,6 @@ instance A.FromJSON Pos where [ line, col ] <- A.parseJSON arr pure $ Pos line col -instance Lower Pos where - lowerBound = Pos 0 0 - - line_, column_ :: Lens' Pos Int line_ = lens line (\p l -> p { line = l }) column_ = lens column (\p l -> p { column = l }) From 7c410bedf4ab4e131d988607554cf307247699e2 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 4 Feb 2020 11:35:11 -0500 Subject: [PATCH 200/235] Use Pos 1 1 here for backwards compat. --- semantic-source/src/Source/Source.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/semantic-source/src/Source/Source.hs b/semantic-source/src/Source/Source.hs index 9724a8f5f..2cafdab82 100644 --- a/semantic-source/src/Source/Source.hs +++ b/semantic-source/src/Source/Source.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-| 'Source' models source code, represented as a thin wrapper around a 'B.ByteString' with conveniences for splitting by line, slicing, etc. @@ -37,7 +38,7 @@ import Data.Aeson (FromJSON (..), withText) import qualified Data.ByteString as B import Data.Char (ord) import Data.Maybe (fromMaybe) -import Data.Monoid (Last(..)) +import Data.Monoid (Last (..)) import Data.Semilattice.Lower import Data.String (IsString (..)) import qualified Data.Text as T @@ -45,7 +46,7 @@ import qualified Data.Text.Encoding as T import Data.Text.Encoding.Error (lenientDecode) import GHC.Generics (Generic) import Source.Range -import Source.Span (Span(Span), Pos(..)) +import Source.Span (Pos (..), Span (Span)) -- | The contents of a source file. This is represented as a UTF-8 @@ -75,7 +76,7 @@ totalRange = Range 0 . B.length . bytes -- | Return a 'Span' that covers the entire text. totalSpan :: Source -> Span -totalSpan source = Span lowerBound (Pos (Prelude.length ranges) (succ (end lastRange - start lastRange))) where +totalSpan source = Span (Pos 1 1) (Pos (Prelude.length ranges) (succ (end lastRange - start lastRange))) where ranges = lineRanges source lastRange = fromMaybe lowerBound (getLast (foldMap (Last . Just) ranges)) From 0d5bf3716f39a82fdf41f6417ec760e06e239657 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 4 Feb 2020 12:29:57 -0500 Subject: [PATCH 201/235] Bump fused-effects version and remove orphan instance. --- semantic-python/semantic-python.cabal | 2 +- semantic-python/src/Language/Python/ScopeGraph.hs | 5 ----- 2 files changed, 1 insertion(+), 6 deletions(-) diff --git a/semantic-python/semantic-python.cabal b/semantic-python/semantic-python.cabal index 4c5cbe389..ae269de23 100644 --- a/semantic-python/semantic-python.cabal +++ b/semantic-python/semantic-python.cabal @@ -21,7 +21,7 @@ tested-with: GHC == 8.6.5 common haskell default-language: Haskell2010 build-depends: base ^>= 4.13 - , fused-effects ^>= 1.0 + , fused-effects ^>= 1.0.0.1 , fused-syntax , parsers ^>= 0.12.10 , semantic-analysis ^>= 0 diff --git a/semantic-python/src/Language/Python/ScopeGraph.hs b/semantic-python/src/Language/Python/ScopeGraph.hs index d9bcd6b85..a94da3f39 100644 --- a/semantic-python/src/Language/Python/ScopeGraph.hs +++ b/semantic-python/src/Language/Python/ScopeGraph.hs @@ -16,7 +16,6 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} module Language.Python.ScopeGraph ( scopeGraphModule @@ -39,10 +38,6 @@ import Language.Python.Patterns import ScopeGraph.Convert (Result (..), complete, todo) import Source.Loc --- This orphan instance will perish once it lands in fused-effects. -instance Algebra sig m => Algebra sig (Ap m) where - alg = Ap . alg . handleCoercible - -- This typeclass is internal-only, though it shares the same interface -- as the one defined in semantic-scope-graph. The somewhat-unconventional -- quantified constraint is to avoid having to define Show1 instances for From 4fc5b720fc3680b272edb980126d79b0af92d7a5 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 4 Feb 2020 12:33:01 -0500 Subject: [PATCH 202/235] Revert "Move DeclProperties to ScopeGraph.Properties.Declaration." This reverts commit 546bfb25813a59806df71ecd933d4e59c51252c0. --- .../src/Language/Python/ScopeGraph.hs | 21 +++++++------ semantic-python/test-graphing/GraphTest.hs | 10 +++---- .../semantic-scope-graph.cabal | 1 - .../src/Control/Carrier/Sketch/Fresh.hs | 12 ++++---- .../src/Control/Effect/Sketch.hs | 30 +++++++++++-------- 5 files changed, 39 insertions(+), 35 deletions(-) diff --git a/semantic-python/src/Language/Python/ScopeGraph.hs b/semantic-python/src/Language/Python/ScopeGraph.hs index 9e1a89b60..dab821498 100644 --- a/semantic-python/src/Language/Python/ScopeGraph.hs +++ b/semantic-python/src/Language/Python/ScopeGraph.hs @@ -39,7 +39,6 @@ import GHC.TypeLits import qualified Language.Python.AST as Py import Language.Python.Patterns import ScopeGraph.Convert (Result (..), complete, todo) -import qualified ScopeGraph.Properties.Declaration as Props import Source.Loc import Source.Span (span_) @@ -97,11 +96,11 @@ instance ToScopeGraph Py.AssertStatement where scopeGraph = onChildren instance ToScopeGraph Py.Assignment where scopeGraph (Py.Assignment ann (SingleIdentifier t) val _typ) = do - declare t Props.Declaration - { Props.kind = ScopeGraph.Assignment - , Props.relation = ScopeGraph.Default - , Props.associatedScope = Nothing - , Props.span = ann^.span_ + declare t DeclProperties + { kind = ScopeGraph.Assignment + , relation = ScopeGraph.Default + , associatedScope = Nothing + , spanInfo = ann^.span_ } maybe complete scopeGraph val scopeGraph x = todo x @@ -196,11 +195,11 @@ instance ToScopeGraph Py.FunctionDefinition where , spanInfo = ann^.span_ } withScope associatedScope $ do - let declProps = Props.Declaration - { Props.kind = ScopeGraph.Parameter - , Props.relation = ScopeGraph.Default - , Props.associatedScope = Nothing - , Props.span = lowerBound + let declProps = DeclProperties + { kind = ScopeGraph.Parameter + , relation = ScopeGraph.Default + , associatedScope = Nothing + , spanInfo = lowerBound } let param (Py.Parameter (Prj (Py.Identifier pann pname))) = Just (pann, Name.name pname) param _ = Nothing diff --git a/semantic-python/test-graphing/GraphTest.hs b/semantic-python/test-graphing/GraphTest.hs index 8b6f1c174..a55325423 100644 --- a/semantic-python/test-graphing/GraphTest.hs +++ b/semantic-python/test-graphing/GraphTest.hs @@ -17,7 +17,6 @@ import Data.Semilattice.Lower import qualified Language.Python () import qualified Language.Python as Py (Term) import ScopeGraph.Convert -import qualified ScopeGraph.Properties.Declaration as Props import Source.Loc import qualified Source.Source as Source import Source.Span @@ -56,8 +55,9 @@ runScopeGraph p _src item = run . runSketch (Just p) $ scopeGraph item sampleGraphThing :: (Has Sketch sig m) => m Result sampleGraphThing = do - declare "hello" (Props.Declaration ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 2 0) (Pos 2 10))) - declare "goodbye" (Props.Declaration ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 3 0) (Pos 3 12))) + -- TODO: until https://github.com/github/semantic/issues/457 is fixed, these are 0-indexed, which is technically wrong + declare "hello" (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 2 0) (Pos 2 10))) + declare "goodbye" (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 3 0) (Pos 3 12))) pure Complete graphFile :: FilePath -> IO (ScopeGraph.ScopeGraph Name, Result) @@ -77,7 +77,7 @@ assertSimpleAssignment = do expectedReference :: (Has Sketch sig m) => m Result expectedReference = do - declare "x" (Props.Declaration ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 0 0) (Pos 0 5))) + declare "x" (DeclProperties ScopeGraph.Assignment ScopeGraph.Default Nothing (Span (Pos 0 0) (Pos 0 5))) reference "x" "x" RefProperties pure Complete @@ -99,7 +99,7 @@ expectedFunctionArg :: (Has Sketch sig m) => m Result expectedFunctionArg = do (_, associatedScope) <- declareFunction (Just $ Name.name "foo") (FunProperties ScopeGraph.Function (Span (Pos 0 0) (Pos 1 12))) withScope associatedScope $ do - declare "x" (Props.Declaration ScopeGraph.Identifier ScopeGraph.Default Nothing lowerBound) + declare "x" (DeclProperties ScopeGraph.Identifier ScopeGraph.Default Nothing lowerBound) reference "x" "x" RefProperties pure () reference "foo" "foo" RefProperties diff --git a/semantic-scope-graph/semantic-scope-graph.cabal b/semantic-scope-graph/semantic-scope-graph.cabal index 4f5a08d53..854304f7d 100644 --- a/semantic-scope-graph/semantic-scope-graph.cabal +++ b/semantic-scope-graph/semantic-scope-graph.cabal @@ -23,7 +23,6 @@ library Control.Carrier.Sketch.Fresh Control.Effect.Sketch ScopeGraph.Convert - ScopeGraph.Properties.Declaration Data.Hole Data.Module Data.ScopeGraph diff --git a/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs b/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs index a8d5c60ac..982b0336e 100644 --- a/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs +++ b/semantic-scope-graph/src/Control/Carrier/Sketch/Fresh.hs @@ -26,13 +26,14 @@ import Control.Carrier.Fresh.Strict import Control.Carrier.Reader import Control.Carrier.State.Strict import Control.Effect.Sketch +import Control.Lens ((^.)) import Control.Monad.IO.Class import Data.Bifunctor import Data.Module import Data.ScopeGraph (ScopeGraph) import qualified Data.ScopeGraph as ScopeGraph import Data.Semilattice.Lower -import qualified ScopeGraph.Properties.Declaration as Props +import GHC.Records import Source.Span import qualified System.Path as Path @@ -59,16 +60,15 @@ newtype SketchC address m a = SketchC (StateC Sketchbook (FreshC m) a) instance (Effect sig, Algebra sig m) => Algebra (SketchEff :+: Reader Name :+: Fresh :+: sig) (SketchC Name m) where alg (L (Declare n props k)) = do Sketchbook old current <- SketchC (get @Sketchbook) - let Props.Declaration kind relation associatedScope span = props let (new, _pos) = ScopeGraph.declare (ScopeGraph.Declaration n) (lowerBound @ModuleInfo) - relation + (relation props) ScopeGraph.Public - span - kind - associatedScope + (props^.span_) + (getField @"kind" @DeclProperties props) + (associatedScope props) current old SketchC (put (Sketchbook new current)) diff --git a/semantic-scope-graph/src/Control/Effect/Sketch.hs b/semantic-scope-graph/src/Control/Effect/Sketch.hs index db6cd709d..8f19edcb5 100644 --- a/semantic-scope-graph/src/Control/Effect/Sketch.hs +++ b/semantic-scope-graph/src/Control/Effect/Sketch.hs @@ -14,6 +14,7 @@ module Control.Effect.Sketch ( Sketch , SketchEff (..) + , DeclProperties (..) , RefProperties (..) , FunProperties (..) , declare @@ -40,9 +41,16 @@ import qualified Data.ScopeGraph as ScopeGraph import Data.Text (Text) import GHC.Generics (Generic, Generic1) import GHC.Records -import qualified ScopeGraph.Properties.Declaration as Props import Source.Span +data DeclProperties = DeclProperties + { kind :: ScopeGraph.Kind + , relation :: ScopeGraph.Relation + , associatedScope :: Maybe Name + , spanInfo :: Span + } deriving Generic + +instance HasSpan DeclProperties where span_ = field @"spanInfo" data RefProperties = RefProperties @@ -59,7 +67,7 @@ type Sketch :+: Reader Name data SketchEff m k = - Declare Name Props.Declaration (() -> m k) + Declare Name DeclProperties (() -> m k) | Reference Text Text RefProperties (() -> m k) | NewScope (Map ScopeGraph.EdgeLabel [Name]) (Name -> m k) deriving (Generic, Generic1, HFunctor, Effect) @@ -67,7 +75,7 @@ data SketchEff m k = currentScope :: Has (Reader Name) sig m => m Name currentScope = ask -declare :: forall sig m . (Has Sketch sig m) => Name -> Props.Declaration -> m () +declare :: forall sig m . (Has Sketch sig m) => Name -> DeclProperties -> m () declare n props = send (Declare n props pure) -- | Establish a reference to a prior declaration. @@ -82,24 +90,22 @@ declareFunction name props = do currentScope' <- currentScope let lexicalEdges = Map.singleton ScopeGraph.Lexical [ currentScope' ] associatedScope <- newScope lexicalEdges - name' <- declareMaybeName name Props.Declaration - { Props.relation = ScopeGraph.Default - , Props.kind = (getField @"kind" @FunProperties props) - , Props.associatedScope = Just associatedScope - , Props.span = props^.span_ + name' <- declareMaybeName name DeclProperties + { relation = ScopeGraph.Default + , kind = (getField @"kind" @FunProperties props) + , associatedScope = Just associatedScope + , spanInfo = props^.span_ } pure (name', associatedScope) declareMaybeName :: Has Sketch sig m => Maybe Name - -> Props.Declaration + -> DeclProperties -> m Name declareMaybeName maybeName props = do case maybeName of Just name -> name <$ declare name props - _ -> do - name <- Name.gensym - name <$ declare name (props { Props.relation = ScopeGraph.Gensym }) + _ -> Name.gensym >>= \name -> declare name (props { relation = ScopeGraph.Gensym }) >> pure name -- TODO: Modify props and change Kind to Gensym withScope :: Has Sketch sig m => Name From 1f5214961a9bd6cde3c0cb5ecc40d81474907938 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 4 Feb 2020 12:39:59 -0500 Subject: [PATCH 203/235] Blow the cache. --- .github/workflows/haskell.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 1129295df..d1c4ff993 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -37,7 +37,7 @@ jobs: name: Cache ~/.cabal/store with: path: ~/.cabal/store - key: ${{ runner.os }}-${{ matrix.ghc }}-v6-cabal-store + key: ${{ runner.os }}-${{ matrix.ghc }}-v7-cabal-store - uses: actions/cache@v1 name: Cache dist-newstyle From 369dc558b40b2bd3cc255c678fbda2de9c7929d0 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 4 Feb 2020 12:39:59 -0500 Subject: [PATCH 204/235] Blow the cache. --- .github/workflows/haskell.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 1129295df..d1c4ff993 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -37,7 +37,7 @@ jobs: name: Cache ~/.cabal/store with: path: ~/.cabal/store - key: ${{ runner.os }}-${{ matrix.ghc }}-v6-cabal-store + key: ${{ runner.os }}-${{ matrix.ghc }}-v7-cabal-store - uses: actions/cache@v1 name: Cache dist-newstyle From 34bbbb830d0353113de661d842ab2f2b99d7613a Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 4 Feb 2020 13:15:51 -0500 Subject: [PATCH 205/235] Stray import. --- semantic-python/src/Language/Python/ScopeGraph.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/semantic-python/src/Language/Python/ScopeGraph.hs b/semantic-python/src/Language/Python/ScopeGraph.hs index a94da3f39..cf785cae7 100644 --- a/semantic-python/src/Language/Python/ScopeGraph.hs +++ b/semantic-python/src/Language/Python/ScopeGraph.hs @@ -23,7 +23,6 @@ module Language.Python.ScopeGraph import qualified Analysis.Name as Name import AST.Element -import Control.Algebra (Algebra (..), handleCoercible) import Control.Effect.Fresh import Control.Effect.Sketch import Data.Foldable From 933f135eae46d32adcfda7011d1e5b6473cfea60 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 13:23:26 -0500 Subject: [PATCH 206/235] Stub in a module for Traversable1. --- semantic-ast/semantic-ast.cabal | 4 +++- semantic-ast/src/AST/Traversable1.hs | 2 ++ 2 files changed, 5 insertions(+), 1 deletion(-) create mode 100644 semantic-ast/src/AST/Traversable1.hs diff --git a/semantic-ast/semantic-ast.cabal b/semantic-ast/semantic-ast.cabal index 0702851ca..c9f38d59f 100644 --- a/semantic-ast/semantic-ast.cabal +++ b/semantic-ast/semantic-ast.cabal @@ -37,7 +37,9 @@ common haskell library import: haskell - exposed-modules: Marshal.JSON + exposed-modules: + AST.Traversable1 + Marshal.JSON -- other-modules: diff --git a/semantic-ast/src/AST/Traversable1.hs b/semantic-ast/src/AST/Traversable1.hs new file mode 100644 index 000000000..b9e072b21 --- /dev/null +++ b/semantic-ast/src/AST/Traversable1.hs @@ -0,0 +1,2 @@ +module AST.Traversable1 +() where From 924ada57444475f45a406a43641a7dd0e5a8fe6a Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 13:29:33 -0500 Subject: [PATCH 207/235] Apply stylish-haskell. --- semantic-go/src/Language/Go/Tags.hs | 2 +- semantic-java/src/Language/Java/Tags.hs | 2 +- semantic-python/src/Language/Python/Tags.hs | 2 +- semantic-ruby/src/Language/Ruby/Tags.hs | 14 +++++++------- semantic-tsx/src/Language/TSX/Tags.hs | 4 ++-- .../src/Language/TypeScript/Tags.hs | 4 ++-- 6 files changed, 14 insertions(+), 14 deletions(-) diff --git a/semantic-go/src/Language/Go/Tags.hs b/semantic-go/src/Language/Go/Tags.hs index 48294c21f..de4a5ecce 100644 --- a/semantic-go/src/Language/Go/Tags.hs +++ b/semantic-go/src/Language/Go/Tags.hs @@ -9,6 +9,7 @@ module Language.Go.Tags ) where import AST.Element +import AST.Token import Control.Effect.Reader import Control.Effect.Writer import Data.Text as Text @@ -18,7 +19,6 @@ import Source.Loc import Source.Source as Source import Tags.Tag import qualified Tags.Tagging.Precise as Tags -import AST.Token class ToTags t where tags diff --git a/semantic-java/src/Language/Java/Tags.hs b/semantic-java/src/Language/Java/Tags.hs index 6d7b5c005..dc9a404b0 100644 --- a/semantic-java/src/Language/Java/Tags.hs +++ b/semantic-java/src/Language/Java/Tags.hs @@ -8,6 +8,7 @@ module Language.Java.Tags ( ToTags(..) ) where +import AST.Token import Control.Effect.Reader import Control.Effect.Writer import GHC.Generics @@ -17,7 +18,6 @@ import Source.Range import Source.Source as Source import Tags.Tag import qualified Tags.Tagging.Precise as Tags -import AST.Token class ToTags t where tags diff --git a/semantic-python/src/Language/Python/Tags.hs b/semantic-python/src/Language/Python/Tags.hs index b308ff1d2..c3ff379ab 100644 --- a/semantic-python/src/Language/Python/Tags.hs +++ b/semantic-python/src/Language/Python/Tags.hs @@ -10,6 +10,7 @@ module Language.Python.Tags ) where import AST.Element +import AST.Token import Control.Effect.Reader import Control.Effect.Writer import Data.List.NonEmpty (NonEmpty (..)) @@ -22,7 +23,6 @@ import Source.Range import Source.Source as Source import Tags.Tag import qualified Tags.Tagging.Precise as Tags -import AST.Token class ToTags t where tags diff --git a/semantic-ruby/src/Language/Ruby/Tags.hs b/semantic-ruby/src/Language/Ruby/Tags.hs index 22d01a2e3..19b7713f5 100644 --- a/semantic-ruby/src/Language/Ruby/Tags.hs +++ b/semantic-ruby/src/Language/Ruby/Tags.hs @@ -12,6 +12,8 @@ module Language.Ruby.Tags ) where import AST.Element +import AST.Token +import qualified AST.Unmarshal as TS import Control.Effect.Reader import Control.Effect.State import Control.Effect.Writer @@ -25,8 +27,6 @@ import Source.Range as Range import Source.Source as Source import Tags.Tag import qualified Tags.Tagging.Precise as Tags -import AST.Token -import qualified AST.Unmarshal as TS class ToTags t where tags @@ -89,7 +89,7 @@ instance ToTags Rb.Class where where range' = case extraChildren of Prj Rb.Superclass { ann = Loc { byteRange = Range { end }}} : _ -> Range start end - _ -> Range start (getEnd expr) + _ -> Range start (getEnd expr) getEnd = Range.end . byteRange . TS.gann yield name = yieldTag name Class loc range' >> gtags t @@ -106,7 +106,7 @@ instance ToTags Rb.SingletonClass where where range' = case extraChildren of x : _ -> Range start (getStart x) - _ -> range + _ -> range getStart = Range.start . byteRange . TS.gann yield name = yieldTag name Class loc range' >> gtags t @@ -123,7 +123,7 @@ instance ToTags Rb.Module where where range' = case extraChildren of x : _ -> Range start (getStart x) - _ -> Range start (getEnd expr) + _ -> Range start (getEnd expr) getEnd = Range.end . byteRange . TS.gann getStart = Range.start . byteRange . TS.gann yield name = yieldTag name Module loc range' >> gtags t @@ -165,7 +165,7 @@ instance ToTags Rb.Method where where range' = case parameters of Just Rb.MethodParameters { ann = Loc { byteRange = Range { end } }} -> Range start end - _ -> Range start (getEnd name) + _ -> Range start (getEnd name) getEnd = Range.end . byteRange . TS.gann instance ToTags Rb.SingletonMethod where @@ -177,7 +177,7 @@ instance ToTags Rb.SingletonMethod where where range' = case parameters of Just Rb.MethodParameters { ann = Loc { byteRange = Range { end } }} -> Range start end - _ -> Range start (getEnd name) + _ -> Range start (getEnd name) getEnd = Range.end . byteRange . TS.gann instance ToTags Rb.Block where diff --git a/semantic-tsx/src/Language/TSX/Tags.hs b/semantic-tsx/src/Language/TSX/Tags.hs index 00b75676f..358dfa4ad 100644 --- a/semantic-tsx/src/Language/TSX/Tags.hs +++ b/semantic-tsx/src/Language/TSX/Tags.hs @@ -10,6 +10,7 @@ module Language.TSX.Tags ) where import AST.Element +import AST.Token import Control.Effect.Reader import Control.Effect.Writer import Data.Foldable @@ -20,7 +21,6 @@ import Source.Loc import Source.Source as Source import Tags.Tag import qualified Tags.Tagging.Precise as Tags -import AST.Token class ToTags t where tags @@ -110,7 +110,7 @@ instance ToTags Tsx.Module where Prj Tsx.Identifier { text } -> yield text -- TODO: Handle NestedIdentifiers and Strings -- Prj Tsx.NestedIdentifier { extraChildren } -> match - _ -> gtags t + _ -> gtags t yield text = yieldTag text Module loc byteRange >> gtags t instance (ToTags l, ToTags r) => ToTags (l :+: r) where diff --git a/semantic-typescript/src/Language/TypeScript/Tags.hs b/semantic-typescript/src/Language/TypeScript/Tags.hs index 40713d684..85a8818f6 100644 --- a/semantic-typescript/src/Language/TypeScript/Tags.hs +++ b/semantic-typescript/src/Language/TypeScript/Tags.hs @@ -10,6 +10,7 @@ module Language.TypeScript.Tags ) where import AST.Element +import AST.Token import Control.Effect.Reader import Control.Effect.Writer import Data.Foldable @@ -20,7 +21,6 @@ import Source.Loc import Source.Source as Source import Tags.Tag import qualified Tags.Tagging.Precise as Tags -import AST.Token class ToTags t where tags @@ -103,7 +103,7 @@ instance ToTags Ts.Module where Prj Ts.Identifier { text } -> yield text -- TODO: Handle NestedIdentifiers and Strings -- Prj Tsx.NestedIdentifier { extraChildren } -> match - _ -> gtags t + _ -> gtags t yield text = yieldTag text Module loc byteRange >> gtags t instance (ToTags l, ToTags r) => ToTags (l :+: r) where From 7a2cc7fb7a147fa79c127829b8fa9df804072cd5 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 13:35:35 -0500 Subject: [PATCH 208/235] Move Traversable1 into semantic-ast. --- semantic-ast/src/AST/Traversable1.hs | 160 +++++++++++++++++- semantic-go/semantic-go.cabal | 1 + semantic-go/src/Language/Go/Tags.hs | 7 +- semantic-java/semantic-java.cabal | 1 + semantic-java/src/Language/Java/Tags.hs | 7 +- semantic-python/semantic-python.cabal | 1 + semantic-python/src/Language/Python/Tags.hs | 9 +- semantic-ruby/semantic-ruby.cabal | 1 + semantic-ruby/src/Language/Ruby/Tags.hs | 9 +- semantic-tags/src/Tags/Tagging/Precise.hs | 160 +----------------- semantic-tsx/semantic-tsx.cabal | 1 + semantic-tsx/src/Language/TSX/Tags.hs | 7 +- semantic-typescript/semantic-typescript.cabal | 1 + .../src/Language/TypeScript/Tags.hs | 7 +- 14 files changed, 192 insertions(+), 180 deletions(-) diff --git a/semantic-ast/src/AST/Traversable1.hs b/semantic-ast/src/AST/Traversable1.hs index b9e072b21..27e029d2a 100644 --- a/semantic-ast/src/AST/Traversable1.hs +++ b/semantic-ast/src/AST/Traversable1.hs @@ -1,2 +1,160 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} module AST.Traversable1 -() where +( Traversable1(..) +, for1 +, traverse1_ +, for1_ +, foldMap1 +, foldMapDefault1 +, fmapDefault1 +, traverseDefault1 +, GTraversable1(..) +, Generics(..) +) where + +import Data.Functor (void) +import Data.Functor.Const +import Data.Functor.Identity +import Data.Monoid (Ap (..)) +import GHC.Generics + +-- FIXME: derive Traversable1 instances for TH-generated syntax types. + +-- | Simultaneous traversal of subterms of kind @*@ and @* -> *@ in an 'Applicative' context. +-- +-- 'Traversable1' can express any combination of first- and second-order mapping, folding, and traversal. +-- +-- Note that the @1@ suffix is used in the manner of 'Data.Functor.Classes.Show1' or 'Generic1', rather than 'foldr1'; it’s a higher-order traversal which is simultaneously able to traverse (and alter) annotations. +class Traversable1 c t where + -- | Map annotations of kind @*@ and heterogeneously-typed subterms of kind @* -> *@ under some constraint @c@ into an 'Applicative' context. The constraint is necessary to operate on otherwise universally-quantified subterms, since otherwise there would be insufficient information to inspect them at all. + -- + -- No proxy is provided for the constraint @c@; instead, @-XTypeApplications@ should be used. E.g. here we ignore the annotations and print all the @* -> *@ subterms using 'Show1': + -- + -- @ + -- 'traverse1' \@'Data.Functor.Classes.Show1' 'pure' (\ t -> t '<$' 'putStrLn' ('Data.Functor.Classes.showsPrec1' 0 t "")) + -- @ + -- + -- Note that this traversal is non-recursive: any recursion through subterms must be performed by the second function argument. + traverse1 + :: Applicative f + => (a -> f b) + -> (forall t' . c t' => t' a -> f (t' b)) + -> t a + -> f (t b) + default traverse1 + :: (Applicative f, Generic1 t, GTraversable1 c (Rep1 t)) + => (a -> f b) + -> (forall t' . c t' => t' a -> f (t' b)) + -> t a + -> f (t b) + traverse1 f g = fmap to1 . gtraverse1 @c f g . from1 + +for1 + :: forall c t f a b + . (Traversable1 c t, Applicative f) + => t a + -> (a -> f b) + -> (forall t' . c t' => t' a -> f (t' b)) + -> f (t b) +for1 t f g = traverse1 @c f g t + +traverse1_ + :: forall c t f a a' a'' + . (Traversable1 c t, Applicative f) + => (a -> f a') + -> (forall t' . c t' => t' a -> f a'') + -> t a + -> f () +traverse1_ f g = getAp . foldMap1 @c (Ap . void . f) (Ap . void . g) + +for1_ + :: forall c t f a a' a'' + . (Traversable1 c t, Applicative f) + => t a + -> (a -> f a') + -> (forall t' . c t' => t' a -> f a'') + -> f () +for1_ t f g = getAp $ foldMap1 @c (Ap . void . f) (Ap . void . g) t + +foldMap1 :: forall c t b a . (Traversable1 c t, Monoid b) => (a -> b) -> (forall t' . c t' => t' a -> b) -> t a -> b +foldMap1 f g = getConst . traverse1 @c (Const . f) (Const . g) + + +-- | This function may be used as a value for 'foldMap' in a 'Foldable' instance. +foldMapDefault1 :: (Traversable1 Foldable t, Monoid b) => (a -> b) -> t a -> b +foldMapDefault1 f = foldMap1 @Foldable f (foldMap f) + +-- | This function may be used as a value for 'fmap' in a 'Functor' instance. +fmapDefault1 :: Traversable1 Functor t => (a -> b) -> t a -> t b +fmapDefault1 f = runIdentity . traverse1 @Functor (Identity . f) (Identity . fmap f) + +-- | This function may be used as a value for 'traverse' in a 'Traversable' instance. +traverseDefault1 :: (Traversable1 Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) +traverseDefault1 f = traverse1 @Traversable f (traverse f) + + +class GTraversable1 c t where + -- | Generically map annotations and subterms of kind @* -> *@ into an 'Applicative' context. + gtraverse1 + :: Applicative f + => (a -> f b) + -> (forall t' . c t' => t' a -> f (t' b)) + -> t a + -> f (t b) + +instance GTraversable1 c f => GTraversable1 c (M1 i c' f) where + gtraverse1 f g = fmap M1 . gtraverse1 @c f g . unM1 + +instance (GTraversable1 c f, GTraversable1 c g) => GTraversable1 c (f :*: g) where + gtraverse1 f g (l :*: r) = (:*:) <$> gtraverse1 @c f g l <*> gtraverse1 @c f g r + +instance (GTraversable1 c f, GTraversable1 c g) => GTraversable1 c (f :+: g) where + gtraverse1 f g (L1 l) = L1 <$> gtraverse1 @c f g l + gtraverse1 f g (R1 r) = R1 <$> gtraverse1 @c f g r + +instance GTraversable1 c (K1 R t) where + gtraverse1 _ _ (K1 k) = pure (K1 k) + +instance GTraversable1 c Par1 where + gtraverse1 f _ (Par1 a) = Par1 <$> f a + +instance c t => GTraversable1 c (Rec1 t) where + gtraverse1 _ g (Rec1 t) = Rec1 <$> g t + +instance (Traversable f, GTraversable1 c g) => GTraversable1 c (f :.: g) where + gtraverse1 f g = fmap Comp1 . traverse (gtraverse1 @c f g) . unComp1 + +instance GTraversable1 c U1 where + gtraverse1 _ _ _ = pure U1 + + +-- | @'Generics' t@ has a 'Traversable1' instance when @'Rep1' t@ has a 'GTraversable1' instance, making this convenient for applying 'traverse1' to 'Generic1' types lacking 'Traversable1' instances: +-- +-- @ +-- 'getGenerics' '<$>' 'traverse1' f g ('Generics' t) = 'to1' '<$>' 'gtraverse1' f g ('from1' t) +-- @ +-- +-- It further defines its 'Foldable', 'Functor', and 'Traversable' instances using 'Traversable1', making it suitable for deriving with @-XDerivingVia@. +newtype Generics t a = Generics { getGenerics :: t a } + +instance (Generic1 t, GTraversable1 Foldable (Rep1 t)) => Foldable (Generics t) where + foldMap = foldMapDefault1 + +instance (Generic1 t, GTraversable1 Functor (Rep1 t)) => Functor (Generics t) where + fmap = fmapDefault1 + +instance (Generic1 t, GTraversable1 Foldable (Rep1 t), GTraversable1 Functor (Rep1 t), GTraversable1 Traversable (Rep1 t)) => Traversable (Generics t) where + traverse = traverseDefault1 + +instance (Generic1 t, GTraversable1 c (Rep1 t)) => Traversable1 c (Generics t) where + traverse1 f g = fmap (Generics . to1) . gtraverse1 @c f g . from1 . getGenerics diff --git a/semantic-go/semantic-go.cabal b/semantic-go/semantic-go.cabal index a6371963e..e21e7c389 100644 --- a/semantic-go/semantic-go.cabal +++ b/semantic-go/semantic-go.cabal @@ -24,6 +24,7 @@ common haskell , fused-effects ^>= 1.0 , fused-syntax , parsers ^>= 0.12.10 + , semantic-ast , semantic-codegen , semantic-core ^>= 0.0 , semantic-source ^>= 0.0.2 diff --git a/semantic-go/src/Language/Go/Tags.hs b/semantic-go/src/Language/Go/Tags.hs index de4a5ecce..773e9bfd8 100644 --- a/semantic-go/src/Language/Go/Tags.hs +++ b/semantic-go/src/Language/Go/Tags.hs @@ -10,6 +10,7 @@ module Language.Go.Tags import AST.Element import AST.Token +import AST.Traversable1 import Control.Effect.Reader import Control.Effect.Writer import Data.Text as Text @@ -31,7 +32,7 @@ class ToTags t where :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m , Generic1 t - , Tags.GTraversable1 ToTags (Rep1 t) + , GTraversable1 ToTags (Rep1 t) ) => t Loc -> m () @@ -73,11 +74,11 @@ gtags :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m , Generic1 t - , Tags.GTraversable1 ToTags (Rep1 t) + , GTraversable1 ToTags (Rep1 t) ) => t Loc -> m () -gtags = Tags.traverse1_ @ToTags (const (pure ())) tags . Tags.Generics +gtags = traverse1_ @ToTags (const (pure ())) tags . Generics yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> Kind -> Loc -> Range -> m () yieldTag name kind loc range = do diff --git a/semantic-java/semantic-java.cabal b/semantic-java/semantic-java.cabal index a07cdf653..9e0f27dfc 100644 --- a/semantic-java/semantic-java.cabal +++ b/semantic-java/semantic-java.cabal @@ -27,6 +27,7 @@ library build-depends: base >= 4.13 && < 5 , fused-effects ^>= 1.0 + , semantic-ast , semantic-codegen , semantic-source ^>= 0.0.2 , semantic-tags ^>= 0.0 diff --git a/semantic-java/src/Language/Java/Tags.hs b/semantic-java/src/Language/Java/Tags.hs index dc9a404b0..628c099b1 100644 --- a/semantic-java/src/Language/Java/Tags.hs +++ b/semantic-java/src/Language/Java/Tags.hs @@ -9,6 +9,7 @@ module Language.Java.Tags ) where import AST.Token +import AST.Traversable1 import Control.Effect.Reader import Control.Effect.Writer import GHC.Generics @@ -30,7 +31,7 @@ class ToTags t where :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m , Generic1 t - , Tags.GTraversable1 ToTags (Rep1 t) + , GTraversable1 ToTags (Rep1 t) ) => t Loc -> m () @@ -81,11 +82,11 @@ gtags :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m , Generic1 t - , Tags.GTraversable1 ToTags (Rep1 t) + , GTraversable1 ToTags (Rep1 t) ) => t Loc -> m () -gtags = Tags.traverse1_ @ToTags (const (pure ())) tags . Tags.Generics +gtags = traverse1_ @ToTags (const (pure ())) tags . Generics instance ToTags Java.AnnotatedType instance ToTags Java.Annotation diff --git a/semantic-python/semantic-python.cabal b/semantic-python/semantic-python.cabal index 4c5cbe389..3896e5768 100644 --- a/semantic-python/semantic-python.cabal +++ b/semantic-python/semantic-python.cabal @@ -25,6 +25,7 @@ common haskell , fused-syntax , parsers ^>= 0.12.10 , semantic-analysis ^>= 0 + , semantic-ast , semantic-core ^>= 0.0 , semantic-codegen , semantic-source ^>= 0.0.2 diff --git a/semantic-python/src/Language/Python/Tags.hs b/semantic-python/src/Language/Python/Tags.hs index c3ff379ab..987ac76db 100644 --- a/semantic-python/src/Language/Python/Tags.hs +++ b/semantic-python/src/Language/Python/Tags.hs @@ -11,6 +11,7 @@ module Language.Python.Tags import AST.Element import AST.Token +import AST.Traversable1 import Control.Effect.Reader import Control.Effect.Writer import Data.List.NonEmpty (NonEmpty (..)) @@ -35,7 +36,7 @@ class ToTags t where :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m , Generic1 t - , Tags.GTraversable1 ToTags (Rep1 t) + , GTraversable1 ToTags (Rep1 t) ) => t Loc -> m () @@ -51,7 +52,7 @@ keywordFunctionCall :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m , Generic1 t - , Tags.GTraversable1 ToTags (Rep1 t) + , GTraversable1 ToTags (Rep1 t) ) => t Loc -> Loc -> Range -> Text -> m () keywordFunctionCall t loc range name = yieldTag name Function loc range Nothing >> gtags t @@ -128,11 +129,11 @@ gtags :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m , Generic1 t - , Tags.GTraversable1 ToTags (Rep1 t) + , GTraversable1 ToTags (Rep1 t) ) => t Loc -> m () -gtags = Tags.traverse1_ @ToTags (const (pure ())) tags . Tags.Generics +gtags = traverse1_ @ToTags (const (pure ())) tags . Generics instance ToTags Py.AliasedImport instance ToTags Py.ArgumentList diff --git a/semantic-ruby/semantic-ruby.cabal b/semantic-ruby/semantic-ruby.cabal index 0fedf0862..993ab35cb 100644 --- a/semantic-ruby/semantic-ruby.cabal +++ b/semantic-ruby/semantic-ruby.cabal @@ -24,6 +24,7 @@ common haskell , fused-effects ^>= 1.0 , fused-syntax , parsers ^>= 0.12.10 + , semantic-ast , semantic-codegen , semantic-core ^>= 0.0 , semantic-source ^>= 0.0.2 diff --git a/semantic-ruby/src/Language/Ruby/Tags.hs b/semantic-ruby/src/Language/Ruby/Tags.hs index 19b7713f5..165bd1d1c 100644 --- a/semantic-ruby/src/Language/Ruby/Tags.hs +++ b/semantic-ruby/src/Language/Ruby/Tags.hs @@ -13,6 +13,7 @@ module Language.Ruby.Tags import AST.Element import AST.Token +import AST.Traversable1 import qualified AST.Unmarshal as TS import Control.Effect.Reader import Control.Effect.State @@ -41,7 +42,7 @@ class ToTags t where , Has (Writer Tags.Tags) sig m , Has (State [Text]) sig m , Generic1 t - , Tags.GTraversable1 ToTags (Rep1 t) + , GTraversable1 ToTags (Rep1 t) ) => t Loc -> m () @@ -133,7 +134,7 @@ yieldMethodNameTag , Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m , Generic1 t - , Tags.GTraversable1 ToTags (Rep1 t) + , GTraversable1 ToTags (Rep1 t) ) => t Loc -> Loc -> Range -> Rb.MethodName Loc -> m () yieldMethodNameTag t loc range (Rb.MethodName expr) = enterScope True $ case expr of Prj Rb.Identifier { text = name } -> yield name @@ -337,11 +338,11 @@ gtags , Has (Writer Tags.Tags) sig m , Has (State [Text]) sig m , Generic1 t - , Tags.GTraversable1 ToTags (Rep1 t) + , GTraversable1 ToTags (Rep1 t) ) => t Loc -> m () -gtags = Tags.traverse1_ @ToTags (const (pure ())) tags . Tags.Generics +gtags = traverse1_ @ToTags (const (pure ())) tags . Generics -- instance ToTags Rb.Alias instance ToTags Rb.Arg diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs index b592edce9..45d3e55aa 100644 --- a/semantic-tags/src/Tags/Tagging/Precise.hs +++ b/semantic-tags/src/Tags/Tagging/Precise.hs @@ -1,40 +1,16 @@ -{-# LANGUAGE AllowAmbiguousTypes #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} module Tags.Tagging.Precise ( Tags , ToTags(..) , yield , runTagging , firstLine -, Traversable1(..) -, for1 -, traverse1_ -, for1_ -, foldMap1 -, foldMapDefault1 -, fmapDefault1 -, traverseDefault1 -, GTraversable1(..) -, Generics(..) ) where import Control.Carrier.Reader import Control.Carrier.Writer.Strict -import Data.Functor (void) -import Data.Functor.Const import Data.Functor.Identity -import Data.Monoid (Ap (..), Endo (..)) +import Data.Monoid (Endo (..)) import Data.Text as Text (Text, take, takeWhile, stripEnd) -import GHC.Generics import Prelude hiding (span) import Source.Loc (Loc (..)) import Source.Source as Source @@ -64,137 +40,3 @@ runTagging source -- | Slices a range out of 'Source' and gives back the first line of source up to 180 characters. firstLine :: Source -> Range -> Text firstLine src = Text.stripEnd . Text.take 180 . Text.takeWhile (/= '\n') . Source.toText . slice src - - --- FIXME: move Traversable1 into semantic-ast. --- FIXME: derive Traversable1 instances for TH-generated syntax types. - --- | Simultaneous traversal of subterms of kind @*@ and @* -> *@ in an 'Applicative' context. --- --- 'Traversable1' can express any combination of first- and second-order mapping, folding, and traversal. --- --- Note that the @1@ suffix is used in the manner of 'Data.Functor.Classes.Show1' or 'Generic1', rather than 'foldr1'; it’s a higher-order traversal which is simultaneously able to traverse (and alter) annotations. -class Traversable1 c t where - -- | Map annotations of kind @*@ and heterogeneously-typed subterms of kind @* -> *@ under some constraint @c@ into an 'Applicative' context. The constraint is necessary to operate on otherwise universally-quantified subterms, since otherwise there would be insufficient information to inspect them at all. - -- - -- No proxy is provided for the constraint @c@; instead, @-XTypeApplications@ should be used. E.g. here we ignore the annotations and print all the @* -> *@ subterms using 'Show1': - -- - -- @ - -- 'traverse1' \@'Data.Functor.Classes.Show1' 'pure' (\ t -> t '<$' 'putStrLn' ('Data.Functor.Classes.showsPrec1' 0 t "")) - -- @ - -- - -- Note that this traversal is non-recursive: any recursion through subterms must be performed by the second function argument. - traverse1 - :: Applicative f - => (a -> f b) - -> (forall t' . c t' => t' a -> f (t' b)) - -> t a - -> f (t b) - default traverse1 - :: (Applicative f, Generic1 t, GTraversable1 c (Rep1 t)) - => (a -> f b) - -> (forall t' . c t' => t' a -> f (t' b)) - -> t a - -> f (t b) - traverse1 f g = fmap to1 . gtraverse1 @c f g . from1 - -for1 - :: forall c t f a b - . (Traversable1 c t, Applicative f) - => t a - -> (a -> f b) - -> (forall t' . c t' => t' a -> f (t' b)) - -> f (t b) -for1 t f g = traverse1 @c f g t - -traverse1_ - :: forall c t f a a' a'' - . (Traversable1 c t, Applicative f) - => (a -> f a') - -> (forall t' . c t' => t' a -> f a'') - -> t a - -> f () -traverse1_ f g = getAp . foldMap1 @c (Ap . void . f) (Ap . void . g) - -for1_ - :: forall c t f a a' a'' - . (Traversable1 c t, Applicative f) - => t a - -> (a -> f a') - -> (forall t' . c t' => t' a -> f a'') - -> f () -for1_ t f g = getAp $ foldMap1 @c (Ap . void . f) (Ap . void . g) t - -foldMap1 :: forall c t b a . (Traversable1 c t, Monoid b) => (a -> b) -> (forall t' . c t' => t' a -> b) -> t a -> b -foldMap1 f g = getConst . traverse1 @c (Const . f) (Const . g) - - --- | This function may be used as a value for 'foldMap' in a 'Foldable' instance. -foldMapDefault1 :: (Traversable1 Foldable t, Monoid b) => (a -> b) -> t a -> b -foldMapDefault1 f = foldMap1 @Foldable f (foldMap f) - --- | This function may be used as a value for 'fmap' in a 'Functor' instance. -fmapDefault1 :: Traversable1 Functor t => (a -> b) -> t a -> t b -fmapDefault1 f = runIdentity . traverse1 @Functor (Identity . f) (Identity . fmap f) - --- | This function may be used as a value for 'traverse' in a 'Traversable' instance. -traverseDefault1 :: (Traversable1 Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) -traverseDefault1 f = traverse1 @Traversable f (traverse f) - - --- FIXME: move GTraversable1 into semantic-ast. -class GTraversable1 c t where - -- | Generically map annotations and subterms of kind @* -> *@ into an 'Applicative' context. - gtraverse1 - :: Applicative f - => (a -> f b) - -> (forall t' . c t' => t' a -> f (t' b)) - -> t a - -> f (t b) - -instance GTraversable1 c f => GTraversable1 c (M1 i c' f) where - gtraverse1 f g = fmap M1 . gtraverse1 @c f g . unM1 - -instance (GTraversable1 c f, GTraversable1 c g) => GTraversable1 c (f :*: g) where - gtraverse1 f g (l :*: r) = (:*:) <$> gtraverse1 @c f g l <*> gtraverse1 @c f g r - -instance (GTraversable1 c f, GTraversable1 c g) => GTraversable1 c (f :+: g) where - gtraverse1 f g (L1 l) = L1 <$> gtraverse1 @c f g l - gtraverse1 f g (R1 r) = R1 <$> gtraverse1 @c f g r - -instance GTraversable1 c (K1 R t) where - gtraverse1 _ _ (K1 k) = pure (K1 k) - -instance GTraversable1 c Par1 where - gtraverse1 f _ (Par1 a) = Par1 <$> f a - -instance c t => GTraversable1 c (Rec1 t) where - gtraverse1 _ g (Rec1 t) = Rec1 <$> g t - -instance (Traversable f, GTraversable1 c g) => GTraversable1 c (f :.: g) where - gtraverse1 f g = fmap Comp1 . traverse (gtraverse1 @c f g) . unComp1 - -instance GTraversable1 c U1 where - gtraverse1 _ _ _ = pure U1 - - --- | @'Generics' t@ has a 'Traversable1' instance when @'Rep1' t@ has a 'GTraversable1' instance, making this convenient for applying 'traverse1' to 'Generic1' types lacking 'Traversable1' instances: --- --- @ --- 'getGenerics' '<$>' 'traverse1' f g ('Generics' t) = 'to1' '<$>' 'gtraverse1' f g ('from1' t) --- @ --- --- It further defines its 'Foldable', 'Functor', and 'Traversable' instances using 'Traversable1', making it suitable for deriving with @-XDerivingVia@. -newtype Generics t a = Generics { getGenerics :: t a } - -instance (Generic1 t, GTraversable1 Foldable (Rep1 t)) => Foldable (Generics t) where - foldMap = foldMapDefault1 - -instance (Generic1 t, GTraversable1 Functor (Rep1 t)) => Functor (Generics t) where - fmap = fmapDefault1 - -instance (Generic1 t, GTraversable1 Foldable (Rep1 t), GTraversable1 Functor (Rep1 t), GTraversable1 Traversable (Rep1 t)) => Traversable (Generics t) where - traverse = traverseDefault1 - -instance (Generic1 t, GTraversable1 c (Rep1 t)) => Traversable1 c (Generics t) where - traverse1 f g = fmap (Generics . to1) . gtraverse1 @c f g . from1 . getGenerics diff --git a/semantic-tsx/semantic-tsx.cabal b/semantic-tsx/semantic-tsx.cabal index 02bffdaaf..c08da087c 100644 --- a/semantic-tsx/semantic-tsx.cabal +++ b/semantic-tsx/semantic-tsx.cabal @@ -24,6 +24,7 @@ common haskell , fused-effects ^>= 1.0 , fused-syntax , parsers ^>= 0.12.10 + , semantic-ast , semantic-codegen , semantic-core ^>= 0.0 , semantic-source ^>= 0.0.2 diff --git a/semantic-tsx/src/Language/TSX/Tags.hs b/semantic-tsx/src/Language/TSX/Tags.hs index 358dfa4ad..0de77d20b 100644 --- a/semantic-tsx/src/Language/TSX/Tags.hs +++ b/semantic-tsx/src/Language/TSX/Tags.hs @@ -11,6 +11,7 @@ module Language.TSX.Tags import AST.Element import AST.Token +import AST.Traversable1 import Control.Effect.Reader import Control.Effect.Writer import Data.Foldable @@ -33,7 +34,7 @@ class ToTags t where :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m , Generic1 t - , Tags.GTraversable1 ToTags (Rep1 t) + , GTraversable1 ToTags (Rep1 t) ) => t Loc -> m () @@ -123,11 +124,11 @@ gtags :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m , Generic1 t - , Tags.GTraversable1 ToTags (Rep1 t) + , GTraversable1 ToTags (Rep1 t) ) => t Loc -> m () -gtags = Tags.traverse1_ @ToTags (const (pure ())) tags . Tags.Generics +gtags = traverse1_ @ToTags (const (pure ())) tags . Generics -- These are all valid, but point to built-in functions (e.g. require) that a la -- carte doesn't display and since we have nothing to link to yet (can't diff --git a/semantic-typescript/semantic-typescript.cabal b/semantic-typescript/semantic-typescript.cabal index 8c15efa66..4e12753e2 100644 --- a/semantic-typescript/semantic-typescript.cabal +++ b/semantic-typescript/semantic-typescript.cabal @@ -24,6 +24,7 @@ common haskell , fused-effects ^>= 1.0 , fused-syntax , parsers ^>= 0.12.10 + , semantic-ast , semantic-codegen , semantic-core ^>= 0.0 , semantic-source ^>= 0.0.2 diff --git a/semantic-typescript/src/Language/TypeScript/Tags.hs b/semantic-typescript/src/Language/TypeScript/Tags.hs index 85a8818f6..672ea5854 100644 --- a/semantic-typescript/src/Language/TypeScript/Tags.hs +++ b/semantic-typescript/src/Language/TypeScript/Tags.hs @@ -11,6 +11,7 @@ module Language.TypeScript.Tags import AST.Element import AST.Token +import AST.Traversable1 import Control.Effect.Reader import Control.Effect.Writer import Data.Foldable @@ -33,7 +34,7 @@ class ToTags t where :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m , Generic1 t - , Tags.GTraversable1 ToTags (Rep1 t) + , GTraversable1 ToTags (Rep1 t) ) => t Loc -> m () @@ -116,11 +117,11 @@ gtags :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m , Generic1 t - , Tags.GTraversable1 ToTags (Rep1 t) + , GTraversable1 ToTags (Rep1 t) ) => t Loc -> m () -gtags = Tags.traverse1_ @ToTags (const (pure ())) tags . Tags.Generics +gtags = traverse1_ @ToTags (const (pure ())) tags . Generics -- These are all valid, but point to built-in functions (e.g. require) that a la -- carte doesn't display and since we have nothing to link to yet (can't From d40f3832e803d55365c36b3bc873273fbb779850 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 13:36:40 -0500 Subject: [PATCH 209/235] Move AST.Element from semantic-tags into semantic-ast. --- semantic-ast/semantic-ast.cabal | 1 + {semantic-tags => semantic-ast}/src/AST/Element.hs | 0 semantic-tags/semantic-tags.cabal | 1 - 3 files changed, 1 insertion(+), 1 deletion(-) rename {semantic-tags => semantic-ast}/src/AST/Element.hs (100%) diff --git a/semantic-ast/semantic-ast.cabal b/semantic-ast/semantic-ast.cabal index c9f38d59f..8218e6cae 100644 --- a/semantic-ast/semantic-ast.cabal +++ b/semantic-ast/semantic-ast.cabal @@ -38,6 +38,7 @@ common haskell library import: haskell exposed-modules: + AST.Element AST.Traversable1 Marshal.JSON diff --git a/semantic-tags/src/AST/Element.hs b/semantic-ast/src/AST/Element.hs similarity index 100% rename from semantic-tags/src/AST/Element.hs rename to semantic-ast/src/AST/Element.hs diff --git a/semantic-tags/semantic-tags.cabal b/semantic-tags/semantic-tags.cabal index d2eee1a6d..6c547c73c 100644 --- a/semantic-tags/semantic-tags.cabal +++ b/semantic-tags/semantic-tags.cabal @@ -20,7 +20,6 @@ tested-with: GHC == 8.6.5 library exposed-modules: - AST.Element Tags.Tag Tags.Tagging.Precise build-depends: From ca0d7d51fe5916318d9576a522525e45ef1c6e22 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 13:41:20 -0500 Subject: [PATCH 210/235] Apply stylish-haskell. --- semantic-codegen/src/AST/GenerateSyntax.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/semantic-codegen/src/AST/GenerateSyntax.hs b/semantic-codegen/src/AST/GenerateSyntax.hs index 11dd92c08..58a14b0ab 100644 --- a/semantic-codegen/src/AST/GenerateSyntax.hs +++ b/semantic-codegen/src/AST/GenerateSyntax.hs @@ -9,6 +9,9 @@ module AST.GenerateSyntax , astDeclarationsForLanguage ) where +import AST.Deserialize (Children (..), Datatype (..), DatatypeName (..), Field (..), Multiple (..), Named (..), Required (..), Type (..)) +import AST.Token +import qualified AST.Unmarshal as TS import Data.Aeson hiding (String) import Data.Foldable import Data.List @@ -22,12 +25,9 @@ import Language.Haskell.TH as TH import Language.Haskell.TH.Syntax as TH import System.Directory import System.FilePath.Posix -import AST.Deserialize (Children (..), Datatype (..), DatatypeName (..), Field (..), Multiple (..), Named (..), Required (..), Type (..)) import qualified TreeSitter.Language as TS import TreeSitter.Node import TreeSitter.Symbol (TSSymbol, toHaskellCamelCaseIdentifier, toHaskellPascalCaseIdentifier) -import AST.Token -import qualified AST.Unmarshal as TS -- | Derive Haskell datatypes from a language and its @node-types.json@ file. -- From 869b27966135f935c8bd01cdf7a9365dfb15eebe Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 13:41:55 -0500 Subject: [PATCH 211/235] Derive a Traversable1 instance for ASTs. --- semantic-codegen/src/AST/GenerateSyntax.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/semantic-codegen/src/AST/GenerateSyntax.hs b/semantic-codegen/src/AST/GenerateSyntax.hs index 58a14b0ab..b54618fc6 100644 --- a/semantic-codegen/src/AST/GenerateSyntax.hs +++ b/semantic-codegen/src/AST/GenerateSyntax.hs @@ -11,6 +11,7 @@ module AST.GenerateSyntax import AST.Deserialize (Children (..), Datatype (..), DatatypeName (..), Field (..), Multiple (..), Named (..), Required (..), Type (..)) import AST.Token +import AST.Traversable1 import qualified AST.Unmarshal as TS import Data.Aeson hiding (String) import Data.Foldable @@ -94,7 +95,7 @@ syntaxDatatype language allSymbols datatype = skipDefined $ do name = mkName nameStr nameStr = toNameString (datatypeNameStatus datatype) (getDatatypeName (AST.Deserialize.datatypeName datatype)) deriveStockClause = DerivClause (Just StockStrategy) [ ConT ''Eq, ConT ''Ord, ConT ''Show, ConT ''Generic, ConT ''Foldable, ConT ''Functor, ConT ''Traversable, ConT ''Generic1] - deriveAnyClassClause = DerivClause (Just AnyclassStrategy) [ConT ''TS.Unmarshal] + deriveAnyClassClause = DerivClause (Just AnyclassStrategy) [ConT ''TS.Unmarshal, ConT ''Traversable1 `AppT` VarT (mkName "someConstraint")] deriveGN = DerivClause (Just NewtypeStrategy) [ConT ''TS.SymbolMatching] generatedDatatype name cons typeParameterName = DataD [] name [PlainTV typeParameterName] Nothing cons [deriveStockClause, deriveAnyClassClause] From c88c5b42a6c0be5ca3b7617f053151f0bc4a388e Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 13:42:53 -0500 Subject: [PATCH 212/235] Stub in a definition to construct instances from Traversable1. --- semantic-codegen/src/AST/GenerateSyntax.hs | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/semantic-codegen/src/AST/GenerateSyntax.hs b/semantic-codegen/src/AST/GenerateSyntax.hs index b54618fc6..db4bf23fb 100644 --- a/semantic-codegen/src/AST/GenerateSyntax.hs +++ b/semantic-codegen/src/AST/GenerateSyntax.hs @@ -100,6 +100,17 @@ syntaxDatatype language allSymbols datatype = skipDefined $ do generatedDatatype name cons typeParameterName = DataD [] name [PlainTV typeParameterName] Nothing cons [deriveStockClause, deriveAnyClassClause] +makeInstances :: TypeQ -> Q [Dec] +makeInstances ty = + [d| + instance Foldable $ty where + foldMap = foldMapDefault1 + instance Functor $ty where + fmap = fmapDefault1 + instance Traversable $ty where + traverse = traverseDefault1 + |] + makeHasFieldInstance :: TypeQ -> TypeQ -> ExpQ -> Q [Dec] makeHasFieldInstance ty param elim = [d|instance HasField "ann" $(ty `appT` param) $param where From 4605c6b36616421ea4fd855d36a496bdb3da4b59 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 13:45:09 -0500 Subject: [PATCH 213/235] Rename makeInstances to makeTraversalInstances. --- semantic-codegen/src/AST/GenerateSyntax.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/semantic-codegen/src/AST/GenerateSyntax.hs b/semantic-codegen/src/AST/GenerateSyntax.hs index db4bf23fb..9b7bf2d9a 100644 --- a/semantic-codegen/src/AST/GenerateSyntax.hs +++ b/semantic-codegen/src/AST/GenerateSyntax.hs @@ -100,8 +100,8 @@ syntaxDatatype language allSymbols datatype = skipDefined $ do generatedDatatype name cons typeParameterName = DataD [] name [PlainTV typeParameterName] Nothing cons [deriveStockClause, deriveAnyClassClause] -makeInstances :: TypeQ -> Q [Dec] -makeInstances ty = +makeTraversalInstances :: TypeQ -> Q [Dec] +makeTraversalInstances ty = [d| instance Foldable $ty where foldMap = foldMapDefault1 From 3c4a39a1d737f1ec5a49584955e2c3372e6d6a12 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 13:47:15 -0500 Subject: [PATCH 214/235] Define the traversal instances using Traversable1. --- semantic-codegen/src/AST/GenerateSyntax.hs | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/semantic-codegen/src/AST/GenerateSyntax.hs b/semantic-codegen/src/AST/GenerateSyntax.hs index 9b7bf2d9a..a1f0803b8 100644 --- a/semantic-codegen/src/AST/GenerateSyntax.hs +++ b/semantic-codegen/src/AST/GenerateSyntax.hs @@ -72,13 +72,19 @@ syntaxDatatype language allSymbols datatype = skipDefined $ do let fieldName = mkName ("get" <> nameStr) con <- recC name [TH.varBangType fieldName (TH.bangType strictness (pure types' `appT` varT typeParameterName))] hasFieldInstance <- makeHasFieldInstance (conT name) (varT typeParameterName) (varE fieldName) + traversalInstances <- makeTraversalInstances (conT name) pure - ( NewtypeD [] name [PlainTV typeParameterName] Nothing con [deriveGN, deriveStockClause, deriveAnyClassClause] - : hasFieldInstance) + ( NewtypeD [] name [PlainTV typeParameterName] Nothing con [deriveGN, deriveStockClause, deriveAnyClassClause] + : hasFieldInstance + <> traversalInstances) ProductType (DatatypeName datatypeName) named children fields -> do con <- ctorForProductType datatypeName typeParameterName children fields result <- symbolMatchingInstance allSymbols name named datatypeName - pure $ generatedDatatype name [con] typeParameterName:result + traversalInstances <- makeTraversalInstances (conT name) + pure + ( generatedDatatype name [con] typeParameterName + : result + <> traversalInstances) -- Anonymous leaf types are defined as synonyms for the `Token` datatype LeafType (DatatypeName datatypeName) Anonymous -> do tsSymbol <- runIO $ withCStringLen datatypeName (\(s, len) -> TS.ts_language_symbol_for_name language s len False) @@ -86,7 +92,11 @@ syntaxDatatype language allSymbols datatype = skipDefined $ do LeafType (DatatypeName datatypeName) Named -> do con <- ctorForLeafType (DatatypeName datatypeName) typeParameterName result <- symbolMatchingInstance allSymbols name Named datatypeName - pure $ generatedDatatype name [con] typeParameterName:result + traversalInstances <- makeTraversalInstances (conT name) + pure + ( generatedDatatype name [con] typeParameterName + : result + <> traversalInstances) where -- Skip generating datatypes that have already been defined (overridden) in the module where the splice is running. skipDefined m = do @@ -94,7 +104,7 @@ syntaxDatatype language allSymbols datatype = skipDefined $ do if isLocal then pure [] else m name = mkName nameStr nameStr = toNameString (datatypeNameStatus datatype) (getDatatypeName (AST.Deserialize.datatypeName datatype)) - deriveStockClause = DerivClause (Just StockStrategy) [ ConT ''Eq, ConT ''Ord, ConT ''Show, ConT ''Generic, ConT ''Foldable, ConT ''Functor, ConT ''Traversable, ConT ''Generic1] + deriveStockClause = DerivClause (Just StockStrategy) [ ConT ''Eq, ConT ''Ord, ConT ''Show, ConT ''Generic, ConT ''Generic1] deriveAnyClassClause = DerivClause (Just AnyclassStrategy) [ConT ''TS.Unmarshal, ConT ''Traversable1 `AppT` VarT (mkName "someConstraint")] deriveGN = DerivClause (Just NewtypeStrategy) [ConT ''TS.SymbolMatching] generatedDatatype name cons typeParameterName = DataD [] name [PlainTV typeParameterName] Nothing cons [deriveStockClause, deriveAnyClassClause] From cc553e2c5ccec883162c621f1b28e107691c2ad5 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 13:48:10 -0500 Subject: [PATCH 215/235] Rename result to symbolMatchingInstance. --- semantic-codegen/src/AST/GenerateSyntax.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/semantic-codegen/src/AST/GenerateSyntax.hs b/semantic-codegen/src/AST/GenerateSyntax.hs index a1f0803b8..41544c757 100644 --- a/semantic-codegen/src/AST/GenerateSyntax.hs +++ b/semantic-codegen/src/AST/GenerateSyntax.hs @@ -79,11 +79,11 @@ syntaxDatatype language allSymbols datatype = skipDefined $ do <> traversalInstances) ProductType (DatatypeName datatypeName) named children fields -> do con <- ctorForProductType datatypeName typeParameterName children fields - result <- symbolMatchingInstance allSymbols name named datatypeName + symbolMatchingInstance <- symbolMatchingInstance allSymbols name named datatypeName traversalInstances <- makeTraversalInstances (conT name) pure ( generatedDatatype name [con] typeParameterName - : result + : symbolMatchingInstance <> traversalInstances) -- Anonymous leaf types are defined as synonyms for the `Token` datatype LeafType (DatatypeName datatypeName) Anonymous -> do @@ -91,11 +91,11 @@ syntaxDatatype language allSymbols datatype = skipDefined $ do pure [ TySynD name [] (ConT ''Token `AppT` LitT (StrTyLit datatypeName) `AppT` LitT (NumTyLit (fromIntegral tsSymbol))) ] LeafType (DatatypeName datatypeName) Named -> do con <- ctorForLeafType (DatatypeName datatypeName) typeParameterName - result <- symbolMatchingInstance allSymbols name Named datatypeName + symbolMatchingInstance <- symbolMatchingInstance allSymbols name Named datatypeName traversalInstances <- makeTraversalInstances (conT name) pure ( generatedDatatype name [con] typeParameterName - : result + : symbolMatchingInstance <> traversalInstances) where -- Skip generating datatypes that have already been defined (overridden) in the module where the splice is running. From 16c2e867e866bee5ea3e8c18f5fadcbd2809864c Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 13:55:52 -0500 Subject: [PATCH 216/235] Newlines at EOF. --- semantic-go/src/Language/Go/AST.hs | 2 +- semantic-java/src/Language/Java/AST.hs | 2 +- semantic-ruby/src/Language/Ruby/AST.hs | 2 +- semantic-tsx/src/Language/TSX/AST.hs | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/semantic-go/src/Language/Go/AST.hs b/semantic-go/src/Language/Go/AST.hs index 7b4499a9b..47413860a 100644 --- a/semantic-go/src/Language/Go/AST.hs +++ b/semantic-go/src/Language/Go/AST.hs @@ -18,4 +18,4 @@ import Prelude hiding (False, Float, Integer, Rational, String, True) import AST.GenerateSyntax import qualified Language.Go.Grammar as Grammar -astDeclarationsForLanguage Grammar.tree_sitter_go "../../../vendor/tree-sitter-go/src/node-types.json" \ No newline at end of file +astDeclarationsForLanguage Grammar.tree_sitter_go "../../../vendor/tree-sitter-go/src/node-types.json" diff --git a/semantic-java/src/Language/Java/AST.hs b/semantic-java/src/Language/Java/AST.hs index 274843883..96f435d19 100644 --- a/semantic-java/src/Language/Java/AST.hs +++ b/semantic-java/src/Language/Java/AST.hs @@ -18,4 +18,4 @@ import AST.GenerateSyntax import qualified Language.Java.Grammar as Grammar import AST.Token -astDeclarationsForLanguage Grammar.tree_sitter_java "../../../vendor/tree-sitter-java/src/node-types.json" \ No newline at end of file +astDeclarationsForLanguage Grammar.tree_sitter_java "../../../vendor/tree-sitter-java/src/node-types.json" diff --git a/semantic-ruby/src/Language/Ruby/AST.hs b/semantic-ruby/src/Language/Ruby/AST.hs index 270b4436d..2b5bbdd33 100644 --- a/semantic-ruby/src/Language/Ruby/AST.hs +++ b/semantic-ruby/src/Language/Ruby/AST.hs @@ -18,4 +18,4 @@ import Prelude hiding (False, Float, Integer, Rational, String, True) import AST.GenerateSyntax import qualified Language.Ruby.Grammar as Grammar -astDeclarationsForLanguage Grammar.tree_sitter_ruby "../../../vendor/tree-sitter-ruby/src/node-types.json" \ No newline at end of file +astDeclarationsForLanguage Grammar.tree_sitter_ruby "../../../vendor/tree-sitter-ruby/src/node-types.json" diff --git a/semantic-tsx/src/Language/TSX/AST.hs b/semantic-tsx/src/Language/TSX/AST.hs index 524f042cc..2f927dd5f 100644 --- a/semantic-tsx/src/Language/TSX/AST.hs +++ b/semantic-tsx/src/Language/TSX/AST.hs @@ -18,4 +18,4 @@ import Prelude hiding (False, Float, Integer, String, True) import AST.GenerateSyntax import qualified TreeSitter.TSX as Grammar -astDeclarationsForLanguage Grammar.tree_sitter_tsx "../../../vendor/tree-sitter-typescript/tsx/src/node-types.json" \ No newline at end of file +astDeclarationsForLanguage Grammar.tree_sitter_tsx "../../../vendor/tree-sitter-typescript/tsx/src/node-types.json" From 790431ac7437ed43635aa1c4d56447be8bff4dcd Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 13:56:19 -0500 Subject: [PATCH 217/235] Tagging uses Traversable1 instead of GTraversable1. --- semantic-go/src/Language/Go/Tags.hs | 9 +++------ semantic-java/src/Language/Java/Tags.hs | 10 ++++------ semantic-python/src/Language/Python/Tags.hs | 12 ++++-------- semantic-ruby/src/Language/Ruby/Tags.hs | 12 ++++-------- semantic-tsx/src/Language/TSX/Tags.hs | 9 +++------ semantic-typescript/src/Language/TypeScript/Tags.hs | 9 +++------ 6 files changed, 21 insertions(+), 40 deletions(-) diff --git a/semantic-go/src/Language/Go/Tags.hs b/semantic-go/src/Language/Go/Tags.hs index 773e9bfd8..7301f86c1 100644 --- a/semantic-go/src/Language/Go/Tags.hs +++ b/semantic-go/src/Language/Go/Tags.hs @@ -14,7 +14,6 @@ import AST.Traversable1 import Control.Effect.Reader import Control.Effect.Writer import Data.Text as Text -import GHC.Generics import qualified Language.Go.AST as Go import Source.Loc import Source.Source as Source @@ -31,8 +30,7 @@ class ToTags t where default tags :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m - , Generic1 t - , GTraversable1 ToTags (Rep1 t) + , Traversable1 ToTags t ) => t Loc -> m () @@ -73,12 +71,11 @@ instance ToTags (Token sym n) where tags _ = pure () gtags :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m - , Generic1 t - , GTraversable1 ToTags (Rep1 t) + , Traversable1 ToTags t ) => t Loc -> m () -gtags = traverse1_ @ToTags (const (pure ())) tags . Generics +gtags = traverse1_ @ToTags (const (pure ())) tags yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> Kind -> Loc -> Range -> m () yieldTag name kind loc range = do diff --git a/semantic-java/src/Language/Java/Tags.hs b/semantic-java/src/Language/Java/Tags.hs index 628c099b1..173af233d 100644 --- a/semantic-java/src/Language/Java/Tags.hs +++ b/semantic-java/src/Language/Java/Tags.hs @@ -12,7 +12,7 @@ import AST.Token import AST.Traversable1 import Control.Effect.Reader import Control.Effect.Writer -import GHC.Generics +import GHC.Generics ((:+:)(..)) import qualified Language.Java.AST as Java import Source.Loc import Source.Range @@ -30,8 +30,7 @@ class ToTags t where default tags :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m - , Generic1 t - , GTraversable1 ToTags (Rep1 t) + , Traversable1 ToTags t ) => t Loc -> m () @@ -81,12 +80,11 @@ instance ToTags Java.MethodInvocation where gtags :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m - , Generic1 t - , GTraversable1 ToTags (Rep1 t) + , Traversable1 ToTags t ) => t Loc -> m () -gtags = traverse1_ @ToTags (const (pure ())) tags . Generics +gtags = traverse1_ @ToTags (const (pure ())) tags instance ToTags Java.AnnotatedType instance ToTags Java.Annotation diff --git a/semantic-python/src/Language/Python/Tags.hs b/semantic-python/src/Language/Python/Tags.hs index 987ac76db..192a9cf20 100644 --- a/semantic-python/src/Language/Python/Tags.hs +++ b/semantic-python/src/Language/Python/Tags.hs @@ -17,7 +17,6 @@ import Control.Effect.Writer import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (listToMaybe) import Data.Text as Text -import GHC.Generics import qualified Language.Python.AST as Py import Source.Loc import Source.Range @@ -35,8 +34,7 @@ class ToTags t where default tags :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m - , Generic1 t - , GTraversable1 ToTags (Rep1 t) + , Traversable1 ToTags t ) => t Loc -> m () @@ -51,8 +49,7 @@ instance ToTags (Token sym n) where tags _ = pure () keywordFunctionCall :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m - , Generic1 t - , GTraversable1 ToTags (Rep1 t) + , Traversable1 ToTags t ) => t Loc -> Loc -> Range -> Text -> m () keywordFunctionCall t loc range name = yieldTag name Function loc range Nothing >> gtags t @@ -128,12 +125,11 @@ docComment _ _ = Nothing gtags :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m - , Generic1 t - , GTraversable1 ToTags (Rep1 t) + , Traversable1 ToTags t ) => t Loc -> m () -gtags = traverse1_ @ToTags (const (pure ())) tags . Generics +gtags = traverse1_ @ToTags (const (pure ())) tags instance ToTags Py.AliasedImport instance ToTags Py.ArgumentList diff --git a/semantic-ruby/src/Language/Ruby/Tags.hs b/semantic-ruby/src/Language/Ruby/Tags.hs index 165bd1d1c..5bf6dea57 100644 --- a/semantic-ruby/src/Language/Ruby/Tags.hs +++ b/semantic-ruby/src/Language/Ruby/Tags.hs @@ -21,7 +21,6 @@ import Control.Effect.Writer import Control.Monad import Data.Foldable import Data.Text as Text -import GHC.Generics import qualified Language.Ruby.AST as Rb import Source.Loc import Source.Range as Range @@ -41,8 +40,7 @@ class ToTags t where :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m , Has (State [Text]) sig m - , Generic1 t - , GTraversable1 ToTags (Rep1 t) + , Traversable1 ToTags t ) => t Loc -> m () @@ -133,8 +131,7 @@ yieldMethodNameTag :: ( Has (State [Text]) sig m , Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m - , Generic1 t - , GTraversable1 ToTags (Rep1 t) + , Traversable1 ToTags t ) => t Loc -> Loc -> Range -> Rb.MethodName Loc -> m () yieldMethodNameTag t loc range (Rb.MethodName expr) = enterScope True $ case expr of Prj Rb.Identifier { text = name } -> yield name @@ -337,12 +334,11 @@ gtags :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m , Has (State [Text]) sig m - , Generic1 t - , GTraversable1 ToTags (Rep1 t) + , Traversable1 ToTags t ) => t Loc -> m () -gtags = traverse1_ @ToTags (const (pure ())) tags . Generics +gtags = traverse1_ @ToTags (const (pure ())) tags -- instance ToTags Rb.Alias instance ToTags Rb.Arg diff --git a/semantic-tsx/src/Language/TSX/Tags.hs b/semantic-tsx/src/Language/TSX/Tags.hs index 0de77d20b..60351bf05 100644 --- a/semantic-tsx/src/Language/TSX/Tags.hs +++ b/semantic-tsx/src/Language/TSX/Tags.hs @@ -16,7 +16,6 @@ import Control.Effect.Reader import Control.Effect.Writer import Data.Foldable import Data.Text as Text -import GHC.Generics import qualified Language.TSX.AST as Tsx import Source.Loc import Source.Source as Source @@ -33,8 +32,7 @@ class ToTags t where default tags :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m - , Generic1 t - , GTraversable1 ToTags (Rep1 t) + , Traversable1 ToTags t ) => t Loc -> m () @@ -123,12 +121,11 @@ instance ToTags (Token sym n) where tags _ = pure () gtags :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m - , Generic1 t - , GTraversable1 ToTags (Rep1 t) + , Traversable1 ToTags t ) => t Loc -> m () -gtags = traverse1_ @ToTags (const (pure ())) tags . Generics +gtags = traverse1_ @ToTags (const (pure ())) tags -- These are all valid, but point to built-in functions (e.g. require) that a la -- carte doesn't display and since we have nothing to link to yet (can't diff --git a/semantic-typescript/src/Language/TypeScript/Tags.hs b/semantic-typescript/src/Language/TypeScript/Tags.hs index 672ea5854..d54637b1f 100644 --- a/semantic-typescript/src/Language/TypeScript/Tags.hs +++ b/semantic-typescript/src/Language/TypeScript/Tags.hs @@ -16,7 +16,6 @@ import Control.Effect.Reader import Control.Effect.Writer import Data.Foldable import Data.Text as Text -import GHC.Generics import qualified Language.TypeScript.AST as Ts import Source.Loc import Source.Source as Source @@ -33,8 +32,7 @@ class ToTags t where default tags :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m - , Generic1 t - , GTraversable1 ToTags (Rep1 t) + , Traversable1 ToTags t ) => t Loc -> m () @@ -116,12 +114,11 @@ instance ToTags (Token sym n) where tags _ = pure () gtags :: ( Has (Reader Source) sig m , Has (Writer Tags.Tags) sig m - , Generic1 t - , GTraversable1 ToTags (Rep1 t) + , Traversable1 ToTags t ) => t Loc -> m () -gtags = traverse1_ @ToTags (const (pure ())) tags . Generics +gtags = traverse1_ @ToTags (const (pure ())) tags -- These are all valid, but point to built-in functions (e.g. require) that a la -- carte doesn't display and since we have nothing to link to yet (can't From bcea47bda14ce891e30f2f9edfaf0a5ffb95b973 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 13:57:45 -0500 Subject: [PATCH 218/235] Fixed. --- semantic-ast/src/AST/Traversable1.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/semantic-ast/src/AST/Traversable1.hs b/semantic-ast/src/AST/Traversable1.hs index 27e029d2a..4f9180643 100644 --- a/semantic-ast/src/AST/Traversable1.hs +++ b/semantic-ast/src/AST/Traversable1.hs @@ -28,8 +28,6 @@ import Data.Functor.Identity import Data.Monoid (Ap (..)) import GHC.Generics --- FIXME: derive Traversable1 instances for TH-generated syntax types. - -- | Simultaneous traversal of subterms of kind @*@ and @* -> *@ in an 'Applicative' context. -- -- 'Traversable1' can express any combination of first- and second-order mapping, folding, and traversal. From 3737b2b4cfd5909d725bc70f70692e3fce1d3f4c Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 14:11:43 -0500 Subject: [PATCH 219/235] Stub in a module for just the Traversable1 class. --- semantic-ast/semantic-ast.cabal | 4 ++-- semantic-ast/src/AST/Traversable1/Class.hs | 2 ++ 2 files changed, 4 insertions(+), 2 deletions(-) create mode 100644 semantic-ast/src/AST/Traversable1/Class.hs diff --git a/semantic-ast/semantic-ast.cabal b/semantic-ast/semantic-ast.cabal index 8218e6cae..4c51ba3fb 100644 --- a/semantic-ast/semantic-ast.cabal +++ b/semantic-ast/semantic-ast.cabal @@ -40,6 +40,7 @@ library exposed-modules: AST.Element AST.Traversable1 + AST.Traversable1.Class Marshal.JSON @@ -52,7 +53,6 @@ library , tree-sitter ^>= 0.8 , semantic-source ^>= 0.0.2 , template-haskell ^>= 2.15 - , tree-sitter-python ^>= 0.8.1 , bytestring ^>= 0.10.8.2 , optparse-applicative >= 0.14.3 && < 0.16 , pretty-simple ^>= 3.1.0.0 @@ -71,7 +71,7 @@ executable semantic-ast , semantic-ast , tree-sitter , semantic-source - , tree-sitter-python + , tree-sitter-python ^>= 0.8.1 , bytestring , optparse-applicative , pretty-simple diff --git a/semantic-ast/src/AST/Traversable1/Class.hs b/semantic-ast/src/AST/Traversable1/Class.hs new file mode 100644 index 000000000..6a586daa9 --- /dev/null +++ b/semantic-ast/src/AST/Traversable1/Class.hs @@ -0,0 +1,2 @@ +module AST.Traversable1.Class +() where From 7e08d781c94290e88045441a16a2c7c52506d2b3 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 14:13:10 -0500 Subject: [PATCH 220/235] Add a module header describing the organizational concerns. --- semantic-ast/src/AST/Traversable1/Class.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/semantic-ast/src/AST/Traversable1/Class.hs b/semantic-ast/src/AST/Traversable1/Class.hs index 6a586daa9..15711b224 100644 --- a/semantic-ast/src/AST/Traversable1/Class.hs +++ b/semantic-ast/src/AST/Traversable1/Class.hs @@ -1,2 +1,3 @@ +-- | This module defines the 'Traversable1' class and its generic derivation using 'GTraversable1'. Note that any changes to this file will require recompilation of all of the AST modules, which is quite expensive; thus, most additions should be made in "AST.Traversable1" instead, and that that module should not be imported by the AST modules. module AST.Traversable1.Class () where From e82c505f6828ef7934ba4c3efb34e70e40d51b84 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 4 Feb 2020 14:16:53 -0500 Subject: [PATCH 221/235] One more otiose import out of nowhere. --- src/Analysis/Abstract/Caching/FlowSensitive.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Analysis/Abstract/Caching/FlowSensitive.hs b/src/Analysis/Abstract/Caching/FlowSensitive.hs index e464b83cc..530a974f4 100644 --- a/src/Analysis/Abstract/Caching/FlowSensitive.hs +++ b/src/Analysis/Abstract/Caching/FlowSensitive.hs @@ -11,7 +11,6 @@ module Analysis.Abstract.Caching.FlowSensitive , caching ) where -import Control.Algebra (Effect) import Control.Carrier.Fresh.Strict import Control.Carrier.NonDet.Church import Control.Carrier.Reader From 70156b80bb7a4f5be76bb758f230ee0cfd82b7dd Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 4 Feb 2020 14:16:53 -0500 Subject: [PATCH 222/235] One more otiose import out of nowhere. --- src/Analysis/Abstract/Caching/FlowSensitive.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Analysis/Abstract/Caching/FlowSensitive.hs b/src/Analysis/Abstract/Caching/FlowSensitive.hs index e464b83cc..530a974f4 100644 --- a/src/Analysis/Abstract/Caching/FlowSensitive.hs +++ b/src/Analysis/Abstract/Caching/FlowSensitive.hs @@ -11,7 +11,6 @@ module Analysis.Abstract.Caching.FlowSensitive , caching ) where -import Control.Algebra (Effect) import Control.Carrier.Fresh.Strict import Control.Carrier.NonDet.Church import Control.Carrier.Reader From b66974b95b504ded108580dd412164fe23d90294 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 14:18:37 -0500 Subject: [PATCH 223/235] Split up AST.Traversable1 into two modules. --- semantic-ast/src/AST/Traversable1.hs | 85 +------------------ semantic-ast/src/AST/Traversable1/Class.hs | 99 +++++++++++++++++++++- semantic-codegen/src/AST/GenerateSyntax.hs | 2 +- 3 files changed, 101 insertions(+), 85 deletions(-) diff --git a/semantic-ast/src/AST/Traversable1.hs b/semantic-ast/src/AST/Traversable1.hs index 4f9180643..e0576dd5d 100644 --- a/semantic-ast/src/AST/Traversable1.hs +++ b/semantic-ast/src/AST/Traversable1.hs @@ -10,53 +10,20 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} module AST.Traversable1 -( Traversable1(..) +( module AST.Traversable1.Class , for1 , traverse1_ , for1_ , foldMap1 -, foldMapDefault1 -, fmapDefault1 -, traverseDefault1 -, GTraversable1(..) , Generics(..) ) where +import AST.Traversable1.Class import Data.Functor (void) import Data.Functor.Const -import Data.Functor.Identity import Data.Monoid (Ap (..)) import GHC.Generics --- | Simultaneous traversal of subterms of kind @*@ and @* -> *@ in an 'Applicative' context. --- --- 'Traversable1' can express any combination of first- and second-order mapping, folding, and traversal. --- --- Note that the @1@ suffix is used in the manner of 'Data.Functor.Classes.Show1' or 'Generic1', rather than 'foldr1'; it’s a higher-order traversal which is simultaneously able to traverse (and alter) annotations. -class Traversable1 c t where - -- | Map annotations of kind @*@ and heterogeneously-typed subterms of kind @* -> *@ under some constraint @c@ into an 'Applicative' context. The constraint is necessary to operate on otherwise universally-quantified subterms, since otherwise there would be insufficient information to inspect them at all. - -- - -- No proxy is provided for the constraint @c@; instead, @-XTypeApplications@ should be used. E.g. here we ignore the annotations and print all the @* -> *@ subterms using 'Show1': - -- - -- @ - -- 'traverse1' \@'Data.Functor.Classes.Show1' 'pure' (\ t -> t '<$' 'putStrLn' ('Data.Functor.Classes.showsPrec1' 0 t "")) - -- @ - -- - -- Note that this traversal is non-recursive: any recursion through subterms must be performed by the second function argument. - traverse1 - :: Applicative f - => (a -> f b) - -> (forall t' . c t' => t' a -> f (t' b)) - -> t a - -> f (t b) - default traverse1 - :: (Applicative f, Generic1 t, GTraversable1 c (Rep1 t)) - => (a -> f b) - -> (forall t' . c t' => t' a -> f (t' b)) - -> t a - -> f (t b) - traverse1 f g = fmap to1 . gtraverse1 @c f g . from1 - for1 :: forall c t f a b . (Traversable1 c t, Applicative f) @@ -88,54 +55,6 @@ foldMap1 :: forall c t b a . (Traversable1 c t, Monoid b) => (a -> b) -> (forall foldMap1 f g = getConst . traverse1 @c (Const . f) (Const . g) --- | This function may be used as a value for 'foldMap' in a 'Foldable' instance. -foldMapDefault1 :: (Traversable1 Foldable t, Monoid b) => (a -> b) -> t a -> b -foldMapDefault1 f = foldMap1 @Foldable f (foldMap f) - --- | This function may be used as a value for 'fmap' in a 'Functor' instance. -fmapDefault1 :: Traversable1 Functor t => (a -> b) -> t a -> t b -fmapDefault1 f = runIdentity . traverse1 @Functor (Identity . f) (Identity . fmap f) - --- | This function may be used as a value for 'traverse' in a 'Traversable' instance. -traverseDefault1 :: (Traversable1 Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) -traverseDefault1 f = traverse1 @Traversable f (traverse f) - - -class GTraversable1 c t where - -- | Generically map annotations and subterms of kind @* -> *@ into an 'Applicative' context. - gtraverse1 - :: Applicative f - => (a -> f b) - -> (forall t' . c t' => t' a -> f (t' b)) - -> t a - -> f (t b) - -instance GTraversable1 c f => GTraversable1 c (M1 i c' f) where - gtraverse1 f g = fmap M1 . gtraverse1 @c f g . unM1 - -instance (GTraversable1 c f, GTraversable1 c g) => GTraversable1 c (f :*: g) where - gtraverse1 f g (l :*: r) = (:*:) <$> gtraverse1 @c f g l <*> gtraverse1 @c f g r - -instance (GTraversable1 c f, GTraversable1 c g) => GTraversable1 c (f :+: g) where - gtraverse1 f g (L1 l) = L1 <$> gtraverse1 @c f g l - gtraverse1 f g (R1 r) = R1 <$> gtraverse1 @c f g r - -instance GTraversable1 c (K1 R t) where - gtraverse1 _ _ (K1 k) = pure (K1 k) - -instance GTraversable1 c Par1 where - gtraverse1 f _ (Par1 a) = Par1 <$> f a - -instance c t => GTraversable1 c (Rec1 t) where - gtraverse1 _ g (Rec1 t) = Rec1 <$> g t - -instance (Traversable f, GTraversable1 c g) => GTraversable1 c (f :.: g) where - gtraverse1 f g = fmap Comp1 . traverse (gtraverse1 @c f g) . unComp1 - -instance GTraversable1 c U1 where - gtraverse1 _ _ _ = pure U1 - - -- | @'Generics' t@ has a 'Traversable1' instance when @'Rep1' t@ has a 'GTraversable1' instance, making this convenient for applying 'traverse1' to 'Generic1' types lacking 'Traversable1' instances: -- -- @ diff --git a/semantic-ast/src/AST/Traversable1/Class.hs b/semantic-ast/src/AST/Traversable1/Class.hs index 15711b224..6c02a62df 100644 --- a/semantic-ast/src/AST/Traversable1/Class.hs +++ b/semantic-ast/src/AST/Traversable1/Class.hs @@ -1,3 +1,100 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} -- | This module defines the 'Traversable1' class and its generic derivation using 'GTraversable1'. Note that any changes to this file will require recompilation of all of the AST modules, which is quite expensive; thus, most additions should be made in "AST.Traversable1" instead, and that that module should not be imported by the AST modules. module AST.Traversable1.Class -() where +( Traversable1(..) +, foldMapDefault1 +, fmapDefault1 +, traverseDefault1 +, GTraversable1(..) +) where + +import Data.Functor.Const +import Data.Functor.Identity +import GHC.Generics + +-- | Simultaneous traversal of subterms of kind @*@ and @* -> *@ in an 'Applicative' context. +-- +-- 'Traversable1' can express any combination of first- and second-order mapping, folding, and traversal. +-- +-- Note that the @1@ suffix is used in the manner of 'Data.Functor.Classes.Show1' or 'Generic1', rather than 'foldr1'; it’s a higher-order traversal which is simultaneously able to traverse (and alter) annotations. +class Traversable1 c t where + -- | Map annotations of kind @*@ and heterogeneously-typed subterms of kind @* -> *@ under some constraint @c@ into an 'Applicative' context. The constraint is necessary to operate on otherwise universally-quantified subterms, since otherwise there would be insufficient information to inspect them at all. + -- + -- No proxy is provided for the constraint @c@; instead, @-XTypeApplications@ should be used. E.g. here we ignore the annotations and print all the @* -> *@ subterms using 'Show1': + -- + -- @ + -- 'traverse1' \@'Data.Functor.Classes.Show1' 'pure' (\ t -> t '<$' 'putStrLn' ('Data.Functor.Classes.showsPrec1' 0 t "")) + -- @ + -- + -- Note that this traversal is non-recursive: any recursion through subterms must be performed by the second function argument. + traverse1 + :: Applicative f + => (a -> f b) + -> (forall t' . c t' => t' a -> f (t' b)) + -> t a + -> f (t b) + default traverse1 + :: (Applicative f, Generic1 t, GTraversable1 c (Rep1 t)) + => (a -> f b) + -> (forall t' . c t' => t' a -> f (t' b)) + -> t a + -> f (t b) + traverse1 f g = fmap to1 . gtraverse1 @c f g . from1 + + +-- | This function may be used as a value for 'foldMap' in a 'Foldable' instance. +foldMapDefault1 :: (Traversable1 Foldable t, Monoid b) => (a -> b) -> t a -> b +foldMapDefault1 f = getConst . traverse1 @Foldable (Const . f) (Const . foldMap f) + +-- | This function may be used as a value for 'fmap' in a 'Functor' instance. +fmapDefault1 :: Traversable1 Functor t => (a -> b) -> t a -> t b +fmapDefault1 f = runIdentity . traverse1 @Functor (Identity . f) (Identity . fmap f) + +-- | This function may be used as a value for 'traverse' in a 'Traversable' instance. +traverseDefault1 :: (Traversable1 Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) +traverseDefault1 f = traverse1 @Traversable f (traverse f) + + +class GTraversable1 c t where + -- | Generically map annotations and subterms of kind @* -> *@ into an 'Applicative' context. + gtraverse1 + :: Applicative f + => (a -> f b) + -> (forall t' . c t' => t' a -> f (t' b)) + -> t a + -> f (t b) + +instance GTraversable1 c f => GTraversable1 c (M1 i c' f) where + gtraverse1 f g = fmap M1 . gtraverse1 @c f g . unM1 + +instance (GTraversable1 c f, GTraversable1 c g) => GTraversable1 c (f :*: g) where + gtraverse1 f g (l :*: r) = (:*:) <$> gtraverse1 @c f g l <*> gtraverse1 @c f g r + +instance (GTraversable1 c f, GTraversable1 c g) => GTraversable1 c (f :+: g) where + gtraverse1 f g (L1 l) = L1 <$> gtraverse1 @c f g l + gtraverse1 f g (R1 r) = R1 <$> gtraverse1 @c f g r + +instance GTraversable1 c (K1 R t) where + gtraverse1 _ _ (K1 k) = pure (K1 k) + +instance GTraversable1 c Par1 where + gtraverse1 f _ (Par1 a) = Par1 <$> f a + +instance c t => GTraversable1 c (Rec1 t) where + gtraverse1 _ g (Rec1 t) = Rec1 <$> g t + +instance (Traversable f, GTraversable1 c g) => GTraversable1 c (f :.: g) where + gtraverse1 f g = fmap Comp1 . traverse (gtraverse1 @c f g) . unComp1 + +instance GTraversable1 c U1 where + gtraverse1 _ _ _ = pure U1 diff --git a/semantic-codegen/src/AST/GenerateSyntax.hs b/semantic-codegen/src/AST/GenerateSyntax.hs index 41544c757..6036cc6f5 100644 --- a/semantic-codegen/src/AST/GenerateSyntax.hs +++ b/semantic-codegen/src/AST/GenerateSyntax.hs @@ -11,7 +11,7 @@ module AST.GenerateSyntax import AST.Deserialize (Children (..), Datatype (..), DatatypeName (..), Field (..), Multiple (..), Named (..), Required (..), Type (..)) import AST.Token -import AST.Traversable1 +import AST.Traversable1.Class import qualified AST.Unmarshal as TS import Data.Aeson hiding (String) import Data.Foldable From 0291afcd989c87887dfe0af84f4eea93ec4205a4 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 14:21:38 -0500 Subject: [PATCH 224/235] Placate hlint. --- semantic-ast/src/AST/Traversable1.hs | 2 -- semantic-codegen/src/AST/GenerateSyntax.hs | 4 ++-- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/semantic-ast/src/AST/Traversable1.hs b/semantic-ast/src/AST/Traversable1.hs index e0576dd5d..db3474425 100644 --- a/semantic-ast/src/AST/Traversable1.hs +++ b/semantic-ast/src/AST/Traversable1.hs @@ -1,7 +1,5 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} diff --git a/semantic-codegen/src/AST/GenerateSyntax.hs b/semantic-codegen/src/AST/GenerateSyntax.hs index 6036cc6f5..6918447cb 100644 --- a/semantic-codegen/src/AST/GenerateSyntax.hs +++ b/semantic-codegen/src/AST/GenerateSyntax.hs @@ -53,7 +53,7 @@ astDeclarationsForLanguage language filePath = do getAllSymbols :: Ptr TS.Language -> IO [(String, Named)] getAllSymbols language = do count <- TS.ts_language_symbol_count language - mapM getSymbol [(0 :: TSSymbol) .. fromIntegral (pred count)] + traverse getSymbol [(0 :: TSSymbol) .. fromIntegral (pred count)] where getSymbol i = do cname <- TS.ts_language_symbol_name language i @@ -148,7 +148,7 @@ debugPrefix (name, Anonymous) = "_" <> name -- | Build Q Constructor for product types (nodes with fields) ctorForProductType :: String -> Name -> Maybe Children -> [(String, Field)] -> Q Con ctorForProductType constructorName typeParameterName children fields = ctorForTypes constructorName lists where - lists = annotation : fieldList ++ childList + lists = annotation : fieldList <> childList annotation = ("ann", varT typeParameterName) fieldList = map (fmap toType) fields childList = toList $ fmap toTypeChild children From 0e5c97038fc7880d8c5950cbb86804972dd0795f Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 14:25:39 -0500 Subject: [PATCH 225/235] Add a semantic-parse package. --- cabal.project | 1 + cabal.project.ci | 1 + script/ghci-flags | 1 + semantic-parse/CHANGELOG.md | 5 ++ semantic-parse/LICENSE | 21 ++++++++ semantic-parse/Setup.hs | 2 + semantic-parse/app/Main.hs | 75 +++++++++++++++++++++++++++++ semantic-parse/semantic-parse.cabal | 57 ++++++++++++++++++++++ 8 files changed, 163 insertions(+) create mode 100644 semantic-parse/CHANGELOG.md create mode 100644 semantic-parse/LICENSE create mode 100644 semantic-parse/Setup.hs create mode 100644 semantic-parse/app/Main.hs create mode 100644 semantic-parse/semantic-parse.cabal diff --git a/cabal.project b/cabal.project index 3bba22f83..e39e01577 100644 --- a/cabal.project +++ b/cabal.project @@ -9,6 +9,7 @@ packages: . semantic-go semantic-java semantic-json + semantic-parse semantic-python semantic-ruby semantic-scope-graph diff --git a/cabal.project.ci b/cabal.project.ci index 4ce526d96..d8c29ef4a 100644 --- a/cabal.project.ci +++ b/cabal.project.ci @@ -9,6 +9,7 @@ packages: . semantic-go semantic-java semantic-json + semantic-parse semantic-python semantic-ruby semantic-scope-graph diff --git a/script/ghci-flags b/script/ghci-flags index 627c9f3e8..1d2842bb9 100755 --- a/script/ghci-flags +++ b/script/ghci-flags @@ -53,6 +53,7 @@ function flags { echo "-isemantic-go/src" echo "-isemantic-java/src" echo "-isemantic-json/src" + echo "-isemantic-parse/src" echo "-isemantic-python/src" echo "-isemantic-python/test" echo "-isemantic-ruby/src" diff --git a/semantic-parse/CHANGELOG.md b/semantic-parse/CHANGELOG.md new file mode 100644 index 000000000..ee89a5d7d --- /dev/null +++ b/semantic-parse/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for semantic-parse + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/semantic-parse/LICENSE b/semantic-parse/LICENSE new file mode 100644 index 000000000..331b241b3 --- /dev/null +++ b/semantic-parse/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2019 GitHub + +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. diff --git a/semantic-parse/Setup.hs b/semantic-parse/Setup.hs new file mode 100644 index 000000000..9a994af67 --- /dev/null +++ b/semantic-parse/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/semantic-parse/app/Main.hs b/semantic-parse/app/Main.hs new file mode 100644 index 000000000..9425b22a5 --- /dev/null +++ b/semantic-parse/app/Main.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE TypeApplications #-} + +module Main (main) where + +import AST.Unmarshal +import qualified Language.Python.AST as AST +import qualified Language.Python.Grammar as Python +import Source.Range +import Source.Span +import Data.Aeson (toJSON) +import Data.ByteString.Char8 +import Data.ByteString (readFile) +import Options.Applicative hiding (style) +import Text.Pretty.Simple (pPrint, pPrintNoColor) +import Data.Foldable (traverse_) +import Control.Monad ((>=>)) +import Marshal.JSON (marshal) +import Data.ByteString.Lazy.Char8 (putStrLn) +import Data.Aeson.Encode.Pretty (encodePretty) + +data SemanticAST = SemanticAST + { _format :: Format + , _noColor :: Bool + , _source :: Either [FilePath] String + } + +-- Usage: semantic-ast --format ARG [--no-color] (--sourceString STRING | FILEPATHS…) +parseAST :: Parser SemanticAST +parseAST = SemanticAST + <$> option auto + ( long "format" + <> help "Specify desired output: show, json, sexpression" ) + <*> switch + ( long "no-color" + <> help "Print with color: --color" + ) + <*> (Left <$> some + (Options.Applicative.argument str (metavar "FILEPATH(S)")) + <|> Right <$> strOption + ( long "sourceString" + <> metavar "STRING" + <> help "Specify source input to parse" + )) + + +main :: IO () +main = generateAST =<< execParser opts + + +generateAST :: SemanticAST -> IO () +generateAST (SemanticAST format noColor source) = + getByteStrings >>= traverse_ go + where getByteStrings = case source of + Left filePaths -> traverse Data.ByteString.readFile filePaths + Right source -> pure [Data.ByteString.Char8.pack source] + go = ast >=> display + ast = parseByteString @AST.Module @(Range, Span) Python.tree_sitter_python -- TODO: generalize for all languages + display = case format of + Json -> Data.ByteString.Lazy.Char8.putStrLn . encodePretty . either toJSON (marshal . fmap (const ())) -- TODO: replacing range and span annotations with () for which there is a ToJSON instance for now, deal with this later + Show -> print + Pretty | noColor -> pPrintNoColor + | otherwise -> pPrint + + +opts :: ParserInfo SemanticAST +opts = info (parseAST <**> helper) + ( fullDesc + <> progDesc "Parse source code and produce an AST" + <> header "semantic-ast is a package used to parse source code" ) + +-- TODO: Define formats for json, sexpression, etc. +data Format = Show + | Pretty + | Json + deriving (Read) diff --git a/semantic-parse/semantic-parse.cabal b/semantic-parse/semantic-parse.cabal new file mode 100644 index 000000000..9d428745c --- /dev/null +++ b/semantic-parse/semantic-parse.cabal @@ -0,0 +1,57 @@ +cabal-version: 2.4 +-- Initial package description 'semantic-ast.cabal' generated by 'cabal +-- init'. For further documentation, see +-- http://haskell.org/cabal/users-guide/ + +name: semantic-parse +version: 0.1.0.0 +-- synopsis: +-- description: +-- bug-reports: +license: MIT +license-file: LICENSE +author: The Semantic Authors +maintainer: opensource+semantic@github.com +copyright: (c) 2019 GitHub, Inc. +category: Language +extra-source-files: CHANGELOG.md + +tested-with: GHC == 8.6.5 + +common haskell + default-language: Haskell2010 + ghc-options: + -Weverything + -Wno-missing-local-signatures + -Wno-missing-import-lists + -Wno-implicit-prelude + -Wno-safe + -Wno-unsafe + -Wno-name-shadowing + -Wno-monomorphism-restriction + -Wno-missed-specialisations + -Wno-all-missed-specialisations + -Wno-star-is-type + if (impl(ghc >= 8.8)) + ghc-options: -Wno-missing-deriving-strategies + +executable semantic-parse + import: haskell + main-is: Main.hs + -- other-modules: + -- other-extensions: + build-depends: base + , semantic-ast + , tree-sitter + , semantic-source + , tree-sitter-python ^>= 0.8.1 + , bytestring + , optparse-applicative + , pretty-simple + , aeson + , bytestring + , aeson-pretty + , semantic-python + , text + hs-source-dirs: app + default-language: Haskell2010 From c17840243052c559a509a417152d38a45323c0a6 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 14:26:13 -0500 Subject: [PATCH 226/235] :fire: a duplicated project. --- cabal.project | 1 - 1 file changed, 1 deletion(-) diff --git a/cabal.project b/cabal.project index e39e01577..ca83eaf04 100644 --- a/cabal.project +++ b/cabal.project @@ -16,7 +16,6 @@ packages: . semantic-tsx semantic-typescript semantic-tags - semantic-scope-graph -- Packages brought in from other repos instead of hackage -- ATTENTION: remember to update cabal.project.ci when bumping SHAs here! From 97e11a42f0e284fe960a02f1c4f347854b2ef618 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 14:26:37 -0500 Subject: [PATCH 227/235] CI builds in hard mode. --- cabal.project.ci | 3 +++ 1 file changed, 3 insertions(+) diff --git a/cabal.project.ci b/cabal.project.ci index d8c29ef4a..aacd6bead 100644 --- a/cabal.project.ci +++ b/cabal.project.ci @@ -60,6 +60,9 @@ package semantic-java package semantic-json ghc-options: -Werror +package semantic-parse + ghc-options: -Werror + package semantic-python ghc-options: -Werror From 23649d50bea0801d203fc6a50cce4f7beae1b6ab Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 14:27:37 -0500 Subject: [PATCH 228/235] :fire: the semantic-ast executable (since it has been moved to semantic-parse). --- semantic-ast/app/Main.hs | 75 --------------------------------- semantic-ast/semantic-ast.cabal | 22 ---------- 2 files changed, 97 deletions(-) delete mode 100644 semantic-ast/app/Main.hs diff --git a/semantic-ast/app/Main.hs b/semantic-ast/app/Main.hs deleted file mode 100644 index 9425b22a5..000000000 --- a/semantic-ast/app/Main.hs +++ /dev/null @@ -1,75 +0,0 @@ -{-# LANGUAGE TypeApplications #-} - -module Main (main) where - -import AST.Unmarshal -import qualified Language.Python.AST as AST -import qualified Language.Python.Grammar as Python -import Source.Range -import Source.Span -import Data.Aeson (toJSON) -import Data.ByteString.Char8 -import Data.ByteString (readFile) -import Options.Applicative hiding (style) -import Text.Pretty.Simple (pPrint, pPrintNoColor) -import Data.Foldable (traverse_) -import Control.Monad ((>=>)) -import Marshal.JSON (marshal) -import Data.ByteString.Lazy.Char8 (putStrLn) -import Data.Aeson.Encode.Pretty (encodePretty) - -data SemanticAST = SemanticAST - { _format :: Format - , _noColor :: Bool - , _source :: Either [FilePath] String - } - --- Usage: semantic-ast --format ARG [--no-color] (--sourceString STRING | FILEPATHS…) -parseAST :: Parser SemanticAST -parseAST = SemanticAST - <$> option auto - ( long "format" - <> help "Specify desired output: show, json, sexpression" ) - <*> switch - ( long "no-color" - <> help "Print with color: --color" - ) - <*> (Left <$> some - (Options.Applicative.argument str (metavar "FILEPATH(S)")) - <|> Right <$> strOption - ( long "sourceString" - <> metavar "STRING" - <> help "Specify source input to parse" - )) - - -main :: IO () -main = generateAST =<< execParser opts - - -generateAST :: SemanticAST -> IO () -generateAST (SemanticAST format noColor source) = - getByteStrings >>= traverse_ go - where getByteStrings = case source of - Left filePaths -> traverse Data.ByteString.readFile filePaths - Right source -> pure [Data.ByteString.Char8.pack source] - go = ast >=> display - ast = parseByteString @AST.Module @(Range, Span) Python.tree_sitter_python -- TODO: generalize for all languages - display = case format of - Json -> Data.ByteString.Lazy.Char8.putStrLn . encodePretty . either toJSON (marshal . fmap (const ())) -- TODO: replacing range and span annotations with () for which there is a ToJSON instance for now, deal with this later - Show -> print - Pretty | noColor -> pPrintNoColor - | otherwise -> pPrint - - -opts :: ParserInfo SemanticAST -opts = info (parseAST <**> helper) - ( fullDesc - <> progDesc "Parse source code and produce an AST" - <> header "semantic-ast is a package used to parse source code" ) - --- TODO: Define formats for json, sexpression, etc. -data Format = Show - | Pretty - | Json - deriving (Read) diff --git a/semantic-ast/semantic-ast.cabal b/semantic-ast/semantic-ast.cabal index 4c51ba3fb..b2fbea058 100644 --- a/semantic-ast/semantic-ast.cabal +++ b/semantic-ast/semantic-ast.cabal @@ -60,25 +60,3 @@ library hs-source-dirs: src default-language: Haskell2010 - - -executable semantic-ast - import: haskell - main-is: Main.hs - -- other-modules: - -- other-extensions: - build-depends: base - , semantic-ast - , tree-sitter - , semantic-source - , tree-sitter-python ^>= 0.8.1 - , bytestring - , optparse-applicative - , pretty-simple - , aeson - , bytestring - , aeson-pretty - , semantic-python - , text - hs-source-dirs: app - default-language: Haskell2010 From 223fd96fdb524cbe8ef8ac5ac6ef8abb648a7eb9 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 14:28:18 -0500 Subject: [PATCH 229/235] Move the README to semantic-parse. --- {semantic-ast => semantic-parse}/README.md | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) rename {semantic-ast => semantic-parse}/README.md (88%) diff --git a/semantic-ast/README.md b/semantic-parse/README.md similarity index 88% rename from semantic-ast/README.md rename to semantic-parse/README.md index 9ef6ec273..25355afb5 100644 --- a/semantic-ast/README.md +++ b/semantic-parse/README.md @@ -1,9 +1,6 @@ # semantic-ast -This package has two goals: - -1. Develop a library that will produce ASTs; -2. Provide a command line tool that will output ASTs in supported formats. +This package provides a command line tool that will output ASTs in supported formats. #### CLI From a9485a0d0fa76cd0f0e502dfa9171c06f4f052e7 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 14:28:34 -0500 Subject: [PATCH 230/235] Update the references. --- semantic-parse/README.md | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/semantic-parse/README.md b/semantic-parse/README.md index 25355afb5..04be8e6b7 100644 --- a/semantic-parse/README.md +++ b/semantic-parse/README.md @@ -1,25 +1,25 @@ -# semantic-ast +# semantic-parse This package provides a command line tool that will output ASTs in supported formats. #### CLI -To output ASTs, run the `semantic-ast` command, specifying two mandatory options: 1) the format you'd like to return (ex., `Show`, `JSON`, etc.) and 2) the option specifying whether the source code will be passed in directly via command line (using `--sourceString`) or via providing the file path `--sourceFile`. +To output ASTs, run the `semantic-parse` command, specifying two mandatory options: 1) the format you'd like to return (ex., `Show`, `JSON`, etc.) and 2) the option specifying whether the source code will be passed in directly via command line (using `--sourceString`) or via providing the file path `--sourceFile`. Filepath: ``` -semantic-ast --format [FORMAT] --sourceFile [FILEPATH] +semantic-parse --format [FORMAT] --sourceFile [FILEPATH] ``` Source string: ``` -semantic-ast --format [FORMAT] --sourceString [SOURCE] +semantic-parse --format [FORMAT] --sourceString [SOURCE] ``` An example command is: ``` -semantic-ast -- --format Show --sourceString "a" +semantic-parse -- --format Show --sourceString "a" ``` This will generate an AST From 816511846df0063bf27cf232b1fc3d9595ef337c Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 4 Feb 2020 14:40:59 -0500 Subject: [PATCH 231/235] cache buster, cache buster, bust me a cache --- .github/workflows/haskell.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index 1129295df..d1c4ff993 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -37,7 +37,7 @@ jobs: name: Cache ~/.cabal/store with: path: ~/.cabal/store - key: ${{ runner.os }}-${{ matrix.ghc }}-v6-cabal-store + key: ${{ runner.os }}-${{ matrix.ghc }}-v7-cabal-store - uses: actions/cache@v1 name: Cache dist-newstyle From 51db7cd3e8a23aef416e7cb310a8bc598e969f76 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 4 Feb 2020 15:00:08 -0500 Subject: [PATCH 232/235] One more import (where are these coming from?) --- src/Analysis/Abstract/Caching/FlowInsensitive.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Analysis/Abstract/Caching/FlowInsensitive.hs b/src/Analysis/Abstract/Caching/FlowInsensitive.hs index c38948fd3..8951cd22e 100644 --- a/src/Analysis/Abstract/Caching/FlowInsensitive.hs +++ b/src/Analysis/Abstract/Caching/FlowInsensitive.hs @@ -9,7 +9,6 @@ module Analysis.Abstract.Caching.FlowInsensitive , caching ) where -import Control.Algebra (Effect) import Control.Carrier.Fresh.Strict import Control.Carrier.NonDet.Church import Control.Carrier.Reader From a5f2076091f2a2079680fc589828360461ac3b7f Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 4 Feb 2020 15:41:58 -0500 Subject: [PATCH 233/235] One more. --- src/Semantic/Graph.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 7435e5890..080c80e71 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -46,7 +46,6 @@ import Analysis.Abstract.Graph as Graph import Analysis.File import Control.Abstract hiding (String) import Control.Abstract.PythonPackage as PythonPackage -import Control.Algebra import Control.Carrier.Fresh.Strict import Control.Carrier.Reader import Control.Carrier.Resumable.Resume From 228f2d54c18de6dd7175a345f3a9d0200f05bffe Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Tue, 4 Feb 2020 18:27:34 -0500 Subject: [PATCH 234/235] Codegen now depends on ast. --- semantic-codegen/semantic-codegen.cabal | 1 + 1 file changed, 1 insertion(+) diff --git a/semantic-codegen/semantic-codegen.cabal b/semantic-codegen/semantic-codegen.cabal index 5285cc4e4..dc643b76e 100644 --- a/semantic-codegen/semantic-codegen.cabal +++ b/semantic-codegen/semantic-codegen.cabal @@ -50,6 +50,7 @@ library , bytestring ^>= 0.10.8.2 , tree-sitter ^>= 0.8 , fused-effects ^>= 1.0 + , semantic-ast , semantic-source ^>= 0.0.2 , template-haskell ^>= 2.15 , text ^>= 1.2.3.1 From 9cfa5726d2bda164d499a639b960bcb614c0ff64 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 5 Feb 2020 18:01:35 -0500 Subject: [PATCH 235/235] Bust the cache again. --- .github/workflows/haskell.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml index d1c4ff993..0aa41d2aa 100644 --- a/.github/workflows/haskell.yml +++ b/.github/workflows/haskell.yml @@ -37,7 +37,7 @@ jobs: name: Cache ~/.cabal/store with: path: ~/.cabal/store - key: ${{ runner.os }}-${{ matrix.ghc }}-v7-cabal-store + key: ${{ runner.os }}-${{ matrix.ghc }}-v8-cabal-store - uses: actions/cache@v1 name: Cache dist-newstyle