From bd17eaa282a1128544b9ab292c2809da18a50ad9 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 9 Apr 2018 16:11:55 -0400 Subject: [PATCH 001/148] Define tryAlignWith in Diffable. --- src/Diffing/Algorithm.hs | 38 +++++++++++++++++++++++++++++++++++++- 1 file changed, 37 insertions(+), 1 deletion(-) diff --git a/src/Diffing/Algorithm.hs b/src/Diffing/Algorithm.hs index 7b052e9c9..34c2f5c4e 100644 --- a/src/Diffing/Algorithm.hs +++ b/src/Diffing/Algorithm.hs @@ -2,10 +2,10 @@ {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- FIXME module Diffing.Algorithm where -import Prologue import Control.Monad.Free.Freer import Data.Diff import Data.Term +import Prologue -- | A single step in a diffing algorithm, parameterized by the types of terms, diffs, and the result of the applicable algorithm. data AlgorithmF term1 term2 result partial where @@ -142,6 +142,10 @@ class Diffable f where -> Algorithm term1 term2 result (f result) algorithmFor = genericAlgorithmFor + tryAlignWith :: Alternative g => (These a1 a2 -> g b) -> f a1 -> f a2 -> g (f b) + default tryAlignWith :: (Alternative g, Generic1 f, GDiffable (Rep1 f)) => (These a1 a2 -> g b) -> f a1 -> f a2 -> g (f b) + tryAlignWith f a b = to1 <$> gtryAlignWith f (from1 a) (from1 b) + -- | Construct an algorithm to diff against positions inside an @f@. -- -- This is very like 'traverse', with two key differences: @@ -189,6 +193,8 @@ genericComparableTo a1 a2 = gcomparableTo (from1 a1) (from1 a2) instance Apply Diffable fs => Diffable (Union fs) where algorithmFor u1 u2 = fromMaybe empty (apply2' (Proxy :: Proxy Diffable) (\ inj f1 f2 -> inj <$> algorithmFor f1 f2) u1 u2) + tryAlignWith f u1 u2 = fromMaybe empty (apply2' (Proxy :: Proxy Diffable) (\ inj t1 t2 -> inj <$> tryAlignWith f t1 t2) u1 u2) + subalgorithmFor blur focus = apply' (Proxy :: Proxy Diffable) (\ inj f -> inj <$> subalgorithmFor blur focus f) equivalentBySubterm = apply (Proxy :: Proxy Diffable) equivalentBySubterm @@ -201,18 +207,31 @@ instance Apply Diffable fs => Diffable (Union fs) where instance Diffable Maybe where algorithmFor = diffMaybe + tryAlignWith f (Just a1) (Just a2) = Just <$> f (These a1 a2) + tryAlignWith f (Just a1) Nothing = Just <$> f (This a1) + tryAlignWith f Nothing (Just a2) = Just <$> f (That a2) + tryAlignWith _ Nothing Nothing = pure Nothing + -- | Diff two lists using RWS. instance Diffable [] where algorithmFor = byRWS + tryAlignWith f (a1:as1) (a2:as2) = (:) <$> f (These a1 a2) <*> tryAlignWith f as1 as2 + tryAlignWith f [] as2 = traverse (f . That) as2 + tryAlignWith f as1 [] = traverse (f . This) as1 + -- | Diff two non-empty lists using RWS. instance Diffable NonEmpty where algorithmFor (a1:|as1) (a2:|as2) = (\ (a:as) -> a:|as) <$> byRWS (a1:as1) (a2:as2) + tryAlignWith f (a1:|as1) (a2:|as2) = (:|) <$> f (These a1 a2) <*> tryAlignWith f as1 as2 + -- | A generic type class for diffing two terms defined by the Generic1 interface. class GDiffable f where galgorithmFor :: f term1 -> f term2 -> Algorithm term1 term2 result (f result) + gtryAlignWith :: Alternative g => (These a1 a2 -> g b) -> f a1 -> f a2 -> g (f b) + gcomparableTo :: f term1 -> f term2 -> Bool gcomparableTo _ _ = True @@ -220,6 +239,8 @@ class GDiffable f where instance GDiffable f => GDiffable (M1 i c f) where galgorithmFor (M1 a1) (M1 a2) = M1 <$> galgorithmFor a1 a2 + gtryAlignWith f (M1 a) (M1 b) = M1 <$> gtryAlignWith f a b + gcomparableTo (M1 a1) (M1 a2) = gcomparableTo a1 a2 -- | Diff the fields of a product type. @@ -227,6 +248,8 @@ instance GDiffable f => GDiffable (M1 i c f) where instance (GDiffable f, GDiffable g) => GDiffable (f :*: g) where galgorithmFor (a1 :*: b1) (a2 :*: b2) = (:*:) <$> galgorithmFor a1 a2 <*> galgorithmFor b1 b2 + gtryAlignWith f (a1 :*: b1) (a2 :*: b2) = (:*:) <$> gtryAlignWith f a1 a2 <*> gtryAlignWith f b1 b2 + -- | Diff the constructors of a sum type. -- i.e. data Foo a = Foo a | Bar a (the 'Foo a' is captured by L1 and 'Bar a' is R1). instance (GDiffable f, GDiffable g) => GDiffable (f :+: g) where @@ -234,6 +257,11 @@ instance (GDiffable f, GDiffable g) => GDiffable (f :+: g) where galgorithmFor (R1 b1) (R1 b2) = R1 <$> galgorithmFor b1 b2 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 + gcomparableTo (L1 _) (L1 _) = True gcomparableTo (R1 _) (R1 _) = True gcomparableTo _ _ = False @@ -243,18 +271,26 @@ instance (GDiffable f, GDiffable g) => GDiffable (f :+: g) where instance GDiffable Par1 where galgorithmFor (Par1 a1) (Par1 a2) = Par1 <$> diff a1 a2 + gtryAlignWith f (Par1 a) (Par1 b) = Par1 <$> f (These a b) + -- | Diff two constant parameters (K1 is the Generic1 newtype representing type parameter constants). -- i.e. data Foo = Foo Int (the 'Int' is a constant parameter). instance Eq c => GDiffable (K1 i c) where galgorithmFor (K1 a1) (K1 a2) = guard (a1 == a2) $> K1 a1 + gtryAlignWith _ (K1 a) (K1 b) = guard (a == b) $> K1 b + -- | Diff two terms whose constructors contain 0 type parameters. -- i.e. data Foo = Foo. instance GDiffable U1 where galgorithmFor _ _ = pure U1 + gtryAlignWith _ _ _ = pure U1 + -- | Diff two 'Diffable' containers of parameters. instance Diffable f => GDiffable (Rec1 f) where galgorithmFor a1 a2 = Rec1 <$> algorithmFor (unRec1 a1) (unRec1 a2) + gtryAlignWith f (Rec1 a) (Rec1 b) = Rec1 <$> tryAlignWith f a b + {-# ANN module ("HLint: ignore Avoid return" :: String) #-} From a5f9cef5be28a2e1ef65c074671c2f45fb65680d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 9 Apr 2018 16:12:10 -0400 Subject: [PATCH 002/148] Use tryAlignWith in RWS. --- src/Diffing/Algorithm/RWS.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Diffing/Algorithm/RWS.hs b/src/Diffing/Algorithm/RWS.hs index ad2980455..00f2afdcd 100644 --- a/src/Diffing/Algorithm/RWS.hs +++ b/src/Diffing/Algorithm/RWS.hs @@ -14,16 +14,16 @@ module Diffing.Algorithm.RWS , equalTerms ) where -import Prologue -import Data.Align.Generic (galignWith) import Control.Monad.State.Strict import Data.Diff (DiffF(..), deleting, inserting, merge, replacing) import qualified Data.KdMap.Static as KdMap import Data.List (sortOn) import Data.Record import Data.Term as Term +import Diffing.Algorithm import Diffing.Algorithm.RWS.FeatureVector import Diffing.Algorithm.SES +import Prologue type Label f fields label = forall b. TermF f (Record fields) b -> label @@ -32,7 +32,7 @@ type Label f fields label = forall b. TermF f (Record fields) b -> label -- This is used both to determine whether two root terms can be compared in O(1), and, recursively, to determine whether two nodes are equal in O(n); thus, comparability is defined s.t. two terms are equal if they are recursively comparable subterm-wise. type ComparabilityRelation syntax ann1 ann2 = forall a b. TermF syntax ann1 a -> TermF syntax ann2 b -> Bool -rws :: (Foldable syntax, Functor syntax, GAlign syntax) +rws :: (Foldable syntax, Functor syntax, Diffable syntax) => ComparabilityRelation syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2)) -> (Term syntax (Record (FeatureVector ': fields1)) -> Term syntax (Record (FeatureVector ': fields2)) -> Bool) -> [Term syntax (Record (FeatureVector ': fields1))] @@ -159,13 +159,13 @@ equalTerms canCompare = go -- | Return an edit distance between two terms, up to a certain depth. -- -- Computes a constant-time approximation to the edit distance of a diff. This is done by comparing at most _m_ nodes, & assuming the rest are zero-cost. -editDistanceUpTo :: (GAlign syntax, Foldable syntax, Functor syntax) => Int -> Term syntax ann1 -> Term syntax ann2 -> Int +editDistanceUpTo :: (Diffable syntax, Foldable syntax, Functor syntax) => Int -> Term syntax ann1 -> Term syntax ann2 -> Int 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)) - approximateDiff a b = maybe (replacing a b) (merge (termAnnotation a, termAnnotation b)) (galignWith (Just . these deleting inserting approximateDiff) (termOut a) (termOut b)) + approximateDiff a b = maybe (replacing a b) (merge (termAnnotation a, termAnnotation b)) (tryAlignWith (Just . these deleting inserting approximateDiff) (termOut a) (termOut b)) -- Instances From f30460d36d1caf6186a1ec982f21568854b239dc Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 9 Apr 2018 16:12:38 -0400 Subject: [PATCH 003/148] Use tryAlignWith in the interpreter. --- src/Diffing/Interpreter.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/Diffing/Interpreter.hs b/src/Diffing/Interpreter.hs index 04ea43195..daeb336b5 100644 --- a/src/Diffing/Interpreter.hs +++ b/src/Diffing/Interpreter.hs @@ -3,8 +3,6 @@ module Diffing.Interpreter ( diffTerms ) where -import Prologue -import Data.Align.Generic (galignWith) import Analysis.Decorator import Control.Monad.Free.Freer import Data.Diff @@ -12,6 +10,7 @@ import Data.Record import Data.Term import Diffing.Algorithm import Diffing.Algorithm.RWS +import Prologue -- | Diff two à la carte terms recursively. diffTerms :: (Diffable syntax, Eq1 syntax, GAlign syntax, Show1 syntax, Traversable syntax) @@ -33,7 +32,7 @@ runAlgorithm :: forall syntax fields1 fields2 m result -> m result runAlgorithm = iterFreerA (\ yield step -> case step of Diffing.Algorithm.Diff t1 t2 -> runAlgorithm (algorithmForTerms t1 t2) <|> pure (replacing t1 t2) >>= yield - Linear (Term (In ann1 f1)) (Term (In ann2 f2)) -> merge (ann1, ann2) <$> galignWith (runAlgorithm . diffThese) f1 f2 >>= yield + Linear (Term (In ann1 f1)) (Term (In ann2 f2)) -> merge (ann1, ann2) <$> tryAlignWith (runAlgorithm . diffThese) f1 f2 >>= yield RWS as bs -> traverse (runAlgorithm . diffThese) (rws comparableTerms equivalentTerms as bs) >>= yield Delete a -> yield (deleting a) Insert b -> yield (inserting b) From 1dafdb27c44759ee80840be31db8fbd18bee5f8e Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 9 Apr 2018 16:13:46 -0400 Subject: [PATCH 004/148] :fire: some redundant GAlign constraints. --- src/Diffing/Interpreter.hs | 15 +++++++-------- src/Semantic/Util.hs | 1 - 2 files changed, 7 insertions(+), 9 deletions(-) diff --git a/src/Diffing/Interpreter.hs b/src/Diffing/Interpreter.hs index daeb336b5..cbbdc0c4f 100644 --- a/src/Diffing/Interpreter.hs +++ b/src/Diffing/Interpreter.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, GADTs, RankNTypes, ScopedTypeVariables, TypeOperators #-} +{-# LANGUAGE GADTs, RankNTypes, TypeOperators #-} module Diffing.Interpreter ( diffTerms ) where @@ -13,7 +13,7 @@ import Diffing.Algorithm.RWS import Prologue -- | Diff two à la carte terms recursively. -diffTerms :: (Diffable syntax, Eq1 syntax, GAlign syntax, Show1 syntax, Traversable syntax) +diffTerms :: (Diffable syntax, Eq1 syntax, Show1 syntax, Traversable syntax) => Term syntax (Record fields1) -> Term syntax (Record fields2) -> Diff syntax (Record fields1) (Record fields2) @@ -22,13 +22,12 @@ diffTerms t1 t2 = stripDiff (fromMaybe (replacing t1' t2') (runAlgorithm (diff t , defaultFeatureVectorDecorator constructorNameAndConstantFields t2) -- | Run an 'Algorithm' to completion in an 'Alternative' context using the supplied comparability & equivalence relations. -runAlgorithm :: forall syntax fields1 fields2 m result - . (Diffable syntax, Eq1 syntax, GAlign syntax, Traversable syntax, Alternative m, Monad m) +runAlgorithm :: (Diffable syntax, Eq1 syntax, Traversable syntax, Alternative m, Monad m) => Algorithm - (Term syntax (Record (FeatureVector ': fields1))) - (Term syntax (Record (FeatureVector ': fields2))) - (Diff syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2))) - result + (Term syntax (Record (FeatureVector ': fields1))) + (Term syntax (Record (FeatureVector ': fields2))) + (Diff syntax (Record (FeatureVector ': fields1)) (Record (FeatureVector ': fields2))) + result -> m result runAlgorithm = iterFreerA (\ yield step -> case step of Diffing.Algorithm.Diff t1 t2 -> runAlgorithm (algorithmForTerms t1 t2) <|> pure (replacing t1 t2) >>= yield diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index b9208fd88..c051de1ef 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -138,7 +138,6 @@ diffWithParser :: ( HasField fields Data.Span.Span , Show1 syntax , Traversable syntax , Diffable syntax - , GAlign syntax , HasDeclaration syntax , Members '[Distribute WrappedTask, Task] effs ) From dd884e7615951b94566d27a1e5b1c95005ecc399 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 9 Apr 2018 16:17:16 -0400 Subject: [PATCH 005/148] :fire: all the instances of GAlign. --- src/Data/Syntax.hs | 14 +-- src/Data/Syntax/Comment.hs | 2 +- src/Data/Syntax/Declaration.hs | 32 +++---- src/Data/Syntax/Expression.hs | 38 ++++---- src/Data/Syntax/Literal.hs | 36 ++++---- src/Data/Syntax/Statement.hs | 50 +++++----- src/Data/Syntax/Type.hs | 22 ++--- src/Language/Go/Syntax.hs | 42 ++++----- src/Language/Go/Type.hs | 6 +- src/Language/Markdown/Syntax.hs | 38 ++++---- src/Language/PHP/Syntax.hs | 110 +++++++++++----------- src/Language/Python/Syntax.hs | 11 +-- src/Language/Ruby/Syntax.hs | 12 +-- src/Language/TypeScript/Syntax.hs | 146 +++++++++++++++--------------- src/Prologue.hs | 1 - src/Semantic/Diff.hs | 2 +- 16 files changed, 280 insertions(+), 282 deletions(-) diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs index 5fe5f5de6..018e75c13 100644 --- a/src/Data/Syntax.hs +++ b/src/Data/Syntax.hs @@ -99,7 +99,7 @@ infixContext context left right operators = uncurry (&) <$> postContextualizeThr -- | An identifier of some other construct, whether a containing declaration (e.g. a class name) or a reference (e.g. a variable). newtype Identifier a = Identifier Name - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Identifier where liftEq = genericLiftEq instance Ord1 Identifier where liftCompare = genericLiftCompare @@ -113,7 +113,7 @@ instance FreeVariables1 Identifier where newtype Program a = Program [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Program where liftEq = genericLiftEq instance Ord1 Program where liftCompare = genericLiftCompare @@ -124,7 +124,7 @@ instance Evaluatable Program where -- | An accessibility modifier, e.g. private, public, protected, etc. newtype AccessibilityModifier a = AccessibilityModifier ByteString - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 AccessibilityModifier where liftEq = genericLiftEq instance Ord1 AccessibilityModifier where liftCompare = genericLiftCompare @@ -137,7 +137,7 @@ instance Evaluatable AccessibilityModifier -- -- This can be used to represent an implicit no-op, e.g. the alternative in an 'if' statement without an 'else'. data Empty a = Empty - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Empty where liftEq _ _ _ = True instance Ord1 Empty where liftCompare _ _ _ = EQ @@ -149,7 +149,7 @@ instance Evaluatable Empty where -- | A parenthesized expression or statement. All the languages we target support this concept. newtype Paren a = Paren a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Paren where liftEq = genericLiftEq instance Ord1 Paren where liftCompare = genericLiftCompare @@ -160,7 +160,7 @@ instance Evaluatable Paren where -- | Syntax representing a parsing or assignment error. data Error a = Error { errorCallStack :: ErrorStack, errorExpected :: [String], errorActual :: Maybe String, errorChildren :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Error where liftEq = genericLiftEq instance Ord1 Error where liftCompare = genericLiftCompare @@ -191,7 +191,7 @@ instance Ord ErrorStack where data Context a = Context { contextTerms :: NonEmpty a, contextSubject :: a } - deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Diffable Context where subalgorithmFor blur focus (Context n s) = Context <$> traverse blur n <*> focus s diff --git a/src/Data/Syntax/Comment.hs b/src/Data/Syntax/Comment.hs index 197474bd0..c59802c3f 100644 --- a/src/Data/Syntax/Comment.hs +++ b/src/Data/Syntax/Comment.hs @@ -7,7 +7,7 @@ import Diffing.Algorithm -- | An unnested comment (line or block). newtype Comment a = Comment { commentContent :: ByteString } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Comment where liftEq = genericLiftEq instance Ord1 Comment where liftCompare = genericLiftCompare diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 49f439a1d..1f4e299ff 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -7,7 +7,7 @@ import Diffing.Algorithm import Prologue data Function a = Function { functionContext :: ![a], functionName :: !a, functionParameters :: ![a], functionBody :: !a } - deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Diffable Function where equivalentBySubterm = Just . functionName @@ -29,7 +29,7 @@ instance Evaluatable Function where data Method a = Method { methodContext :: ![a], methodReceiver :: !a, methodName :: !a, methodParameters :: ![a], methodBody :: !a } - deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Diffable Method where equivalentBySubterm = Just . methodName @@ -51,7 +51,7 @@ instance Evaluatable Method where -- | A method signature in TypeScript or a method spec in Go. data MethodSignature a = MethodSignature { _methodSignatureContext :: ![a], _methodSignatureName :: !a, _methodSignatureParameters :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 MethodSignature where liftEq = genericLiftEq instance Ord1 MethodSignature where liftCompare = genericLiftCompare @@ -62,7 +62,7 @@ instance Evaluatable MethodSignature newtype RequiredParameter a = RequiredParameter { requiredParameter :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 RequiredParameter where liftEq = genericLiftEq instance Ord1 RequiredParameter where liftCompare = genericLiftCompare @@ -73,7 +73,7 @@ instance Evaluatable RequiredParameter newtype OptionalParameter a = OptionalParameter { optionalParameter :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 OptionalParameter where liftEq = genericLiftEq instance Ord1 OptionalParameter where liftCompare = genericLiftCompare @@ -88,7 +88,7 @@ instance Evaluatable OptionalParameter -- TODO: It would be really nice to have a more meaningful type contained in here than [a] -- | A declaration of possibly many variables such as var foo = 5, bar = 6 in JavaScript. newtype VariableDeclaration a = VariableDeclaration { variableDeclarations :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 VariableDeclaration where liftEq = genericLiftEq instance Ord1 VariableDeclaration where liftCompare = genericLiftCompare @@ -100,7 +100,7 @@ instance Evaluatable VariableDeclaration where -- | A TypeScript/Java style interface declaration to implement. data InterfaceDeclaration a = InterfaceDeclaration { interfaceDeclarationContext :: ![a], interfaceDeclarationIdentifier :: !a, interfaceDeclarationBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 InterfaceDeclaration where liftEq = genericLiftEq instance Ord1 InterfaceDeclaration where liftCompare = genericLiftCompare @@ -112,7 +112,7 @@ instance Evaluatable InterfaceDeclaration -- | A public field definition such as a field definition in a JavaScript class. data PublicFieldDefinition a = PublicFieldDefinition { publicFieldContext :: ![a], publicFieldPropertyName :: !a, publicFieldValue :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 PublicFieldDefinition where liftEq = genericLiftEq instance Ord1 PublicFieldDefinition where liftCompare = genericLiftCompare @@ -123,7 +123,7 @@ instance Evaluatable PublicFieldDefinition data Variable a = Variable { variableName :: !a, variableType :: !a, variableValue :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Variable where liftEq = genericLiftEq instance Ord1 Variable where liftCompare = genericLiftCompare @@ -133,7 +133,7 @@ instance Show1 Variable where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Variable data Class a = Class { classContext :: ![a], classIdentifier :: !a, classSuperclasses :: ![a], classBody :: !a } - deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Diffable Class where equivalentBySubterm = Just . classIdentifier @@ -154,7 +154,7 @@ instance Evaluatable Class where -- | A decorator in Python data Decorator a = Decorator { decoratorIdentifier :: !a, decoratorParamaters :: ![a], decoratorBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Decorator where liftEq = genericLiftEq instance Ord1 Decorator where liftCompare = genericLiftCompare @@ -168,7 +168,7 @@ instance Evaluatable Decorator -- | An ADT, i.e. a disjoint sum of products, like 'data' in Haskell, or 'enum' in Rust or Swift. data Datatype a = Datatype { datatypeName :: !a, datatypeConstructors :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Data.Syntax.Declaration.Datatype where liftEq = genericLiftEq instance Ord1 Data.Syntax.Declaration.Datatype where liftCompare = genericLiftCompare @@ -180,7 +180,7 @@ instance Evaluatable Data.Syntax.Declaration.Datatype -- | A single constructor in a datatype, or equally a 'struct' in C, Rust, or Swift. data Constructor a = Constructor { constructorName :: !a, constructorFields :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Data.Syntax.Declaration.Constructor where liftEq = genericLiftEq instance Ord1 Data.Syntax.Declaration.Constructor where liftCompare = genericLiftCompare @@ -192,7 +192,7 @@ instance Evaluatable Data.Syntax.Declaration.Constructor -- | Comprehension (e.g. ((a for b in c if a()) in Python) data Comprehension a = Comprehension { comprehensionValue :: !a, comprehensionBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Comprehension where liftEq = genericLiftEq instance Ord1 Comprehension where liftCompare = genericLiftCompare @@ -204,7 +204,7 @@ instance Evaluatable Comprehension -- | A declared type (e.g. `a []int` in Go). data Type a = Type { typeName :: !a, typeKind :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Type where liftEq = genericLiftEq instance Ord1 Type where liftCompare = genericLiftCompare @@ -216,7 +216,7 @@ instance Evaluatable Type -- | Type alias declarations in Javascript/Haskell, etc. data TypeAlias a = TypeAlias { typeAliasContext :: ![a], typeAliasIdentifier :: !a, typeAliasKind :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 TypeAlias where liftEq = genericLiftEq instance Ord1 TypeAlias where liftCompare = genericLiftCompare diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs index 8af42a5f3..6904e8009 100644 --- a/src/Data/Syntax/Expression.hs +++ b/src/Data/Syntax/Expression.hs @@ -10,7 +10,7 @@ import Prologue -- | 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 } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Call where liftEq = genericLiftEq instance Ord1 Call where liftCompare = genericLiftCompare @@ -28,7 +28,7 @@ data Comparison a | GreaterThanEqual !a !a | Equal !a !a | Comparison !a !a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Comparison where liftEq = genericLiftEq instance Ord1 Comparison where liftCompare = genericLiftCompare @@ -53,7 +53,7 @@ data Arithmetic a | Modulo !a !a | Power !a !a | Negate !a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Arithmetic where liftEq = genericLiftEq instance Ord1 Arithmetic where liftCompare = genericLiftCompare @@ -73,7 +73,7 @@ instance Evaluatable Arithmetic where data Match a = Matches !a !a | NotMatches !a !a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Match where liftEq = genericLiftEq instance Ord1 Match where liftCompare = genericLiftCompare @@ -88,7 +88,7 @@ data Boolean a | And !a !a | Not !a | XOr !a !a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Boolean where liftEq = genericLiftEq instance Ord1 Boolean where liftCompare = genericLiftCompare @@ -108,7 +108,7 @@ instance Evaluatable Boolean where -- | Javascript delete operator newtype Delete a = Delete a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Delete where liftEq = genericLiftEq instance Ord1 Delete where liftCompare = genericLiftCompare @@ -120,7 +120,7 @@ instance Evaluatable Delete -- | A sequence expression such as Javascript or C's comma operator. data SequenceExpression a = SequenceExpression { _firstExpression :: !a, _secondExpression :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 SequenceExpression where liftEq = genericLiftEq instance Ord1 SequenceExpression where liftCompare = genericLiftCompare @@ -132,7 +132,7 @@ instance Evaluatable SequenceExpression -- | Javascript void operator newtype Void a = Void a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Void where liftEq = genericLiftEq instance Ord1 Void where liftCompare = genericLiftCompare @@ -144,7 +144,7 @@ instance Evaluatable Void -- | Javascript typeof operator newtype Typeof a = Typeof a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Typeof where liftEq = genericLiftEq instance Ord1 Typeof where liftCompare = genericLiftCompare @@ -163,7 +163,7 @@ data Bitwise a | RShift !a !a | UnsignedRShift !a !a | Complement a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Bitwise where liftEq = genericLiftEq instance Ord1 Bitwise where liftCompare = genericLiftCompare @@ -185,7 +185,7 @@ instance Evaluatable Bitwise where -- | Member Access (e.g. a.b) data MemberAccess a = MemberAccess !a !a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 MemberAccess where liftEq = genericLiftEq instance Ord1 MemberAccess where liftCompare = genericLiftCompare @@ -200,7 +200,7 @@ instance Evaluatable MemberAccess where data Subscript a = Subscript !a ![a] | Member !a !a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Subscript where liftEq = genericLiftEq instance Ord1 Subscript where liftCompare = genericLiftCompare @@ -212,7 +212,7 @@ instance Evaluatable Subscript -- | Enumeration (e.g. a[1:10:1] in Python (start at index 1, stop at index 10, step 1 element from start to stop)) data Enumeration a = Enumeration { enumerationStart :: !a, enumerationEnd :: !a, enumerationStep :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Enumeration where liftEq = genericLiftEq instance Ord1 Enumeration where liftCompare = genericLiftCompare @@ -224,7 +224,7 @@ instance Evaluatable Enumeration -- | InstanceOf (e.g. a instanceof b in JavaScript data InstanceOf a = InstanceOf { instanceOfSubject :: !a, instanceOfObject :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 InstanceOf where liftEq = genericLiftEq instance Ord1 InstanceOf where liftCompare = genericLiftCompare @@ -236,7 +236,7 @@ instance Evaluatable InstanceOf -- | ScopeResolution (e.g. import a.b in Python or a::b in C++) newtype ScopeResolution a = ScopeResolution [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 ScopeResolution where liftEq = genericLiftEq instance Ord1 ScopeResolution where liftCompare = genericLiftCompare @@ -248,7 +248,7 @@ instance Evaluatable ScopeResolution -- | A non-null expression such as Typescript or Swift's ! expression. newtype NonNullExpression a = NonNullExpression { nonNullExpression :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 NonNullExpression where liftEq = genericLiftEq instance Ord1 NonNullExpression where liftCompare = genericLiftCompare @@ -260,7 +260,7 @@ instance Evaluatable NonNullExpression -- | An await expression in Javascript or C#. newtype Await a = Await { awaitSubject :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Await where liftEq = genericLiftEq instance Ord1 Await where liftCompare = genericLiftCompare @@ -272,7 +272,7 @@ instance Evaluatable Await -- | An object constructor call in Javascript, Java, etc. newtype New a = New { newSubject :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 New where liftEq = genericLiftEq instance Ord1 New where liftCompare = genericLiftCompare @@ -284,7 +284,7 @@ instance Evaluatable New -- | A cast expression to a specified type. data Cast a = Cast { castSubject :: !a, castType :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Cast where liftEq = genericLiftEq instance Ord1 Cast where liftCompare = genericLiftCompare diff --git a/src/Data/Syntax/Literal.hs b/src/Data/Syntax/Literal.hs index 73b2fdab7..310e4b14a 100644 --- a/src/Data/Syntax/Literal.hs +++ b/src/Data/Syntax/Literal.hs @@ -14,7 +14,7 @@ import Text.Read (readMaybe) -- Boolean newtype Boolean a = Boolean Bool - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) true :: Boolean a true = Boolean True @@ -34,7 +34,7 @@ instance Evaluatable Boolean where -- | A literal integer of unspecified width. No particular base is implied. newtype Integer a = Integer { integerContent :: ByteString } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Data.Syntax.Literal.Integer where liftEq = genericLiftEq instance Ord1 Data.Syntax.Literal.Integer where liftCompare = genericLiftCompare @@ -51,7 +51,7 @@ instance Evaluatable Data.Syntax.Literal.Integer where -- | A literal float of unspecified width. newtype Float a = Float { floatContent :: ByteString } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Data.Syntax.Literal.Float where liftEq = genericLiftEq instance Ord1 Data.Syntax.Literal.Float where liftCompare = genericLiftCompare @@ -65,7 +65,7 @@ instance Evaluatable Data.Syntax.Literal.Float where -- Rational literals e.g. `2/3r` newtype Rational a = Rational ByteString - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Data.Syntax.Literal.Rational where liftEq = genericLiftEq instance Ord1 Data.Syntax.Literal.Rational where liftCompare = genericLiftCompare @@ -80,7 +80,7 @@ instance Evaluatable Data.Syntax.Literal.Rational where -- Complex literals e.g. `3 + 2i` newtype Complex a = Complex ByteString - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Data.Syntax.Literal.Complex where liftEq = genericLiftEq instance Ord1 Data.Syntax.Literal.Complex where liftCompare = genericLiftCompare @@ -92,7 +92,7 @@ instance Evaluatable Complex -- Strings, symbols newtype String a = String { stringElements :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Data.Syntax.Literal.String where liftEq = genericLiftEq instance Ord1 Data.Syntax.Literal.String where liftCompare = genericLiftCompare @@ -106,7 +106,7 @@ instance Evaluatable Data.Syntax.Literal.String -- | An interpolation element within a string literal. newtype InterpolationElement a = InterpolationElement { interpolationBody :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 InterpolationElement where liftEq = genericLiftEq instance Ord1 InterpolationElement where liftCompare = genericLiftCompare @@ -118,7 +118,7 @@ instance Evaluatable InterpolationElement -- | A sequence of textual contents within a string literal. newtype TextElement a = TextElement { textElementContent :: ByteString } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 TextElement where liftEq = genericLiftEq instance Ord1 TextElement where liftCompare = genericLiftCompare @@ -128,7 +128,7 @@ instance Evaluatable TextElement where eval (TextElement x) = string x data Null a = Null - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Null where liftEq = genericLiftEq instance Ord1 Null where liftCompare = genericLiftCompare @@ -137,7 +137,7 @@ instance Show1 Null where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Null where eval = const null newtype Symbol a = Symbol { symbolContent :: ByteString } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Symbol where liftEq = genericLiftEq instance Ord1 Symbol where liftCompare = genericLiftCompare @@ -147,7 +147,7 @@ instance Evaluatable Symbol where eval (Symbol s) = symbol s newtype Regex a = Regex { regexContent :: ByteString } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Regex where liftEq = genericLiftEq instance Ord1 Regex where liftCompare = genericLiftCompare @@ -163,7 +163,7 @@ instance Evaluatable Regex -- Collections newtype Array a = Array { arrayElements :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Array where liftEq = genericLiftEq instance Ord1 Array where liftCompare = genericLiftCompare @@ -173,7 +173,7 @@ instance Evaluatable Array where eval (Array a) = array =<< traverse subtermValue a newtype Hash a = Hash { hashElements :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Hash where liftEq = genericLiftEq instance Ord1 Hash where liftCompare = genericLiftCompare @@ -183,7 +183,7 @@ instance Evaluatable Hash where eval = hashElements >>> traverse (subtermValue >=> asPair) >=> hash data KeyValue a = KeyValue { key :: !a, value :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 KeyValue where liftEq = genericLiftEq instance Ord1 KeyValue where liftCompare = genericLiftCompare @@ -194,7 +194,7 @@ instance Evaluatable KeyValue where join (kvPair <$> key <*> value) newtype Tuple a = Tuple { tupleContents :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Tuple where liftEq = genericLiftEq instance Ord1 Tuple where liftCompare = genericLiftCompare @@ -204,7 +204,7 @@ instance Evaluatable Tuple where eval (Tuple cs) = multiple =<< traverse subtermValue cs newtype Set a = Set { setElements :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Set where liftEq = genericLiftEq instance Ord1 Set where liftCompare = genericLiftCompare @@ -218,7 +218,7 @@ instance Evaluatable Set -- | A declared pointer (e.g. var pointer *int in Go) newtype Pointer a = Pointer a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Pointer where liftEq = genericLiftEq instance Ord1 Pointer where liftCompare = genericLiftCompare @@ -230,7 +230,7 @@ instance Evaluatable Pointer -- | A reference to a pointer's address (e.g. &pointer in Go) newtype Reference a = Reference a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Reference where liftEq = genericLiftEq instance Ord1 Reference where liftCompare = genericLiftCompare diff --git a/src/Data/Syntax/Statement.hs b/src/Data/Syntax/Statement.hs index 6400c1c50..b075e4bb5 100644 --- a/src/Data/Syntax/Statement.hs +++ b/src/Data/Syntax/Statement.hs @@ -9,7 +9,7 @@ import Prologue -- | Conditional. This must have an else block, which can be filled with some default value when omitted in the source, e.g. 'pure ()' for C-style if-without-else or 'pure Nothing' for Ruby-style, in both cases assuming some appropriate Applicative context into which the If will be lifted. data If a = If { ifCondition :: !a, ifThenBody :: !a, ifElseBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 If where liftEq = genericLiftEq instance Ord1 If where liftCompare = genericLiftCompare @@ -22,7 +22,7 @@ instance Evaluatable If where -- | Else statement. The else condition is any term, that upon successful completion, continues evaluation to the elseBody, e.g. `for ... else` in Python. data Else a = Else { elseCondition :: !a, elseBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Else where liftEq = genericLiftEq instance Ord1 Else where liftCompare = genericLiftCompare @@ -35,7 +35,7 @@ instance Evaluatable Else -- | Goto statement (e.g. `goto a` in Go). newtype Goto a = Goto { gotoLocation :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Goto where liftEq = genericLiftEq instance Ord1 Goto where liftCompare = genericLiftCompare @@ -47,7 +47,7 @@ instance Evaluatable Goto -- | A pattern-matching or computed jump control-flow statement, like 'switch' in C or JavaScript, or 'case' in Ruby or Haskell. data Match a = Match { matchSubject :: !a, matchPatterns :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Match where liftEq = genericLiftEq instance Ord1 Match where liftCompare = genericLiftCompare @@ -59,7 +59,7 @@ instance Evaluatable Match -- | A pattern in a pattern-matching or computed jump control-flow statement, like 'case' in C or JavaScript, 'when' in Ruby, or the left-hand side of '->' in the body of Haskell 'case' expressions. data Pattern a = Pattern { _pattern :: !a, patternBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Pattern where liftEq = genericLiftEq instance Ord1 Pattern where liftCompare = genericLiftCompare @@ -71,7 +71,7 @@ instance Evaluatable Pattern -- | A let statement or local binding, like 'a as b' or 'let a = b'. data Let a = Let { letVariable :: !a, letValue :: !a, letBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Let where liftEq = genericLiftEq instance Ord1 Let where liftCompare = genericLiftCompare @@ -88,7 +88,7 @@ instance Evaluatable Let where -- | Assignment to a variable or other lvalue. data Assignment a = Assignment { assignmentContext :: ![a], assignmentTarget :: !a, assignmentValue :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Assignment where liftEq = genericLiftEq instance Ord1 Assignment where liftCompare = genericLiftCompare @@ -101,7 +101,7 @@ instance Evaluatable Assignment where -- | Post increment operator (e.g. 1++ in Go, or i++ in C). newtype PostIncrement a = PostIncrement a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 PostIncrement where liftEq = genericLiftEq instance Ord1 PostIncrement where liftCompare = genericLiftCompare @@ -113,7 +113,7 @@ instance Evaluatable PostIncrement -- | Post decrement operator (e.g. 1-- in Go, or i-- in C). newtype PostDecrement a = PostDecrement a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 PostDecrement where liftEq = genericLiftEq instance Ord1 PostDecrement where liftCompare = genericLiftCompare @@ -126,7 +126,7 @@ instance Evaluatable PostDecrement -- Returns newtype Return a = Return a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Return where liftEq = genericLiftEq instance Ord1 Return where liftCompare = genericLiftCompare @@ -136,7 +136,7 @@ instance Evaluatable Return where eval (Return x) = subtermValue x newtype Yield a = Yield a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Yield where liftEq = genericLiftEq instance Ord1 Yield where liftCompare = genericLiftCompare @@ -147,7 +147,7 @@ instance Evaluatable Yield newtype Break a = Break a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Break where liftEq = genericLiftEq instance Ord1 Break where liftCompare = genericLiftCompare @@ -158,7 +158,7 @@ instance Evaluatable Break newtype Continue a = Continue a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Continue where liftEq = genericLiftEq instance Ord1 Continue where liftCompare = genericLiftCompare @@ -169,7 +169,7 @@ instance Evaluatable Continue newtype Retry a = Retry a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Retry where liftEq = genericLiftEq instance Ord1 Retry where liftCompare = genericLiftCompare @@ -180,7 +180,7 @@ instance Evaluatable Retry newtype NoOp a = NoOp a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 NoOp where liftEq = genericLiftEq instance Ord1 NoOp where liftCompare = genericLiftCompare @@ -192,7 +192,7 @@ instance Evaluatable NoOp where -- Loops data For a = For { forBefore :: !a, forCondition :: !a, forStep :: !a, forBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 For where liftEq = genericLiftEq instance Ord1 For where liftCompare = genericLiftCompare @@ -203,7 +203,7 @@ instance Evaluatable For where data ForEach a = ForEach { forEachBinding :: !a, forEachSubject :: !a, forEachBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 ForEach where liftEq = genericLiftEq instance Ord1 ForEach where liftCompare = genericLiftCompare @@ -214,7 +214,7 @@ instance Evaluatable ForEach data While a = While { whileCondition :: !a, whileBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 While where liftEq = genericLiftEq instance Ord1 While where liftCompare = genericLiftCompare @@ -224,7 +224,7 @@ instance Evaluatable While where eval While{..} = while (subtermValue whileCondition) (subtermValue whileBody) data DoWhile a = DoWhile { doWhileCondition :: !a, doWhileBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 DoWhile where liftEq = genericLiftEq instance Ord1 DoWhile where liftCompare = genericLiftCompare @@ -236,7 +236,7 @@ instance Evaluatable DoWhile where -- Exception handling newtype Throw a = Throw a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Throw where liftEq = genericLiftEq instance Ord1 Throw where liftCompare = genericLiftCompare @@ -247,7 +247,7 @@ instance Evaluatable Throw data Try a = Try { tryBody :: !a, tryCatch :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Try where liftEq = genericLiftEq instance Ord1 Try where liftCompare = genericLiftCompare @@ -258,7 +258,7 @@ instance Evaluatable Try data Catch a = Catch { catchException :: !a, catchBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Catch where liftEq = genericLiftEq instance Ord1 Catch where liftCompare = genericLiftCompare @@ -269,7 +269,7 @@ instance Evaluatable Catch newtype Finally a = Finally a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Finally where liftEq = genericLiftEq instance Ord1 Finally where liftCompare = genericLiftCompare @@ -283,7 +283,7 @@ instance Evaluatable Finally -- | ScopeEntry (e.g. `BEGIN {}` block in Ruby or Perl). newtype ScopeEntry a = ScopeEntry [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 ScopeEntry where liftEq = genericLiftEq instance Ord1 ScopeEntry where liftCompare = genericLiftCompare @@ -295,7 +295,7 @@ instance Evaluatable ScopeEntry -- | ScopeExit (e.g. `END {}` block in Ruby or Perl). newtype ScopeExit a = ScopeExit [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 ScopeExit where liftEq = genericLiftEq instance Ord1 ScopeExit where liftCompare = genericLiftCompare diff --git a/src/Data/Syntax/Type.hs b/src/Data/Syntax/Type.hs index 364ebd607..ab5d34e0d 100644 --- a/src/Data/Syntax/Type.hs +++ b/src/Data/Syntax/Type.hs @@ -6,7 +6,7 @@ import Diffing.Algorithm import Prologue hiding (Map) data Array a = Array { arraySize :: Maybe a, arrayElementType :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Array where liftEq = genericLiftEq instance Ord1 Array where liftCompare = genericLiftCompare @@ -18,7 +18,7 @@ instance Evaluatable Array -- TODO: What about type variables? re: FreeVariables1 data Annotation a = Annotation { annotationSubject :: !a, annotationType :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Annotation where liftEq = genericLiftEq instance Ord1 Annotation where liftCompare = genericLiftCompare @@ -30,7 +30,7 @@ instance Evaluatable Annotation where data Function a = Function { functionParameters :: [a], functionReturn :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Function where liftEq = genericLiftEq instance Ord1 Function where liftCompare = genericLiftCompare @@ -41,7 +41,7 @@ instance Evaluatable Function newtype Interface a = Interface [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Interface where liftEq = genericLiftEq instance Ord1 Interface where liftCompare = genericLiftCompare @@ -52,7 +52,7 @@ instance Evaluatable Interface data Map a = Map { mapKeyType :: a, mapElementType :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Map where liftEq = genericLiftEq instance Ord1 Map where liftCompare = genericLiftCompare @@ -63,7 +63,7 @@ instance Evaluatable Map newtype Parenthesized a = Parenthesized a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Parenthesized where liftEq = genericLiftEq instance Ord1 Parenthesized where liftCompare = genericLiftCompare @@ -74,7 +74,7 @@ instance Evaluatable Parenthesized newtype Pointer a = Pointer a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Pointer where liftEq = genericLiftEq instance Ord1 Pointer where liftCompare = genericLiftCompare @@ -85,7 +85,7 @@ instance Evaluatable Pointer newtype Product a = Product [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Product where liftEq = genericLiftEq instance Ord1 Product where liftCompare = genericLiftCompare @@ -96,7 +96,7 @@ instance Evaluatable Product data Readonly a = Readonly - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Readonly where liftEq = genericLiftEq instance Ord1 Readonly where liftCompare = genericLiftCompare @@ -107,7 +107,7 @@ instance Evaluatable Readonly newtype Slice a = Slice a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Slice where liftEq = genericLiftEq instance Ord1 Slice where liftCompare = genericLiftCompare @@ -118,7 +118,7 @@ instance Evaluatable Slice newtype TypeParameters a = TypeParameters [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 TypeParameters where liftEq = genericLiftEq instance Ord1 TypeParameters where liftCompare = genericLiftCompare diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index 65ba58046..290c30adf 100644 --- a/src/Language/Go/Syntax.hs +++ b/src/Language/Go/Syntax.hs @@ -31,7 +31,7 @@ resolveGoImport relImportPath = do -- -- If the list of symbols is empty copy everything to the calling environment. data Import a = Import { importFrom :: ImportPath, importWildcardToken :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Import where liftEq = genericLiftEq instance Ord1 Import where liftCompare = genericLiftCompare @@ -50,7 +50,7 @@ instance Evaluatable Import where -- -- If the list of symbols is empty copy and qualify everything to the calling environment. data QualifiedImport a = QualifiedImport { qualifiedImportFrom :: !ImportPath, qualifiedImportAlias :: !a} - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 QualifiedImport where liftEq = genericLiftEq instance Ord1 QualifiedImport where liftCompare = genericLiftCompare @@ -70,7 +70,7 @@ instance Evaluatable QualifiedImport where -- | Side effect only imports (no symbols made available to the calling environment). data SideEffectImport a = SideEffectImport { sideEffectImportFrom :: !ImportPath, sideEffectImportToken :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 SideEffectImport where liftEq = genericLiftEq instance Ord1 SideEffectImport where liftCompare = genericLiftCompare @@ -84,7 +84,7 @@ instance Evaluatable SideEffectImport where -- A composite literal in Go data Composite a = Composite { compositeType :: !a, compositeElement :: !a } - deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Composite where liftEq = genericLiftEq instance Ord1 Composite where liftCompare = genericLiftCompare @@ -95,7 +95,7 @@ instance Evaluatable Composite -- | A default pattern in a Go select or switch statement (e.g. `switch { default: s() }`). newtype DefaultPattern a = DefaultPattern { defaultPatternBody :: a } - deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 DefaultPattern where liftEq = genericLiftEq instance Ord1 DefaultPattern where liftCompare = genericLiftCompare @@ -106,7 +106,7 @@ instance Evaluatable DefaultPattern -- | A defer statement in Go (e.g. `defer x()`). newtype Defer a = Defer { deferBody :: a } - deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Defer where liftEq = genericLiftEq instance Ord1 Defer where liftCompare = genericLiftCompare @@ -117,7 +117,7 @@ instance Evaluatable Defer -- | A go statement (i.e. go routine) in Go (e.g. `go x()`). newtype Go a = Go { goBody :: a } - deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Go where liftEq = genericLiftEq instance Ord1 Go where liftCompare = genericLiftCompare @@ -128,7 +128,7 @@ instance Evaluatable Go -- | A label statement in Go (e.g. `label:continue`). data Label a = Label { _labelName :: !a, labelStatement :: !a } - deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Label where liftEq = genericLiftEq instance Ord1 Label where liftCompare = genericLiftCompare @@ -139,7 +139,7 @@ instance Evaluatable Label -- | A rune literal in Go (e.g. `'⌘'`). newtype Rune a = Rune { _runeLiteral :: ByteString } - deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) -- TODO: Implement Eval instance for Rune instance Evaluatable Rune @@ -150,7 +150,7 @@ instance Show1 Rune where liftShowsPrec = genericLiftShowsPrec -- | A select statement in Go (e.g. `select { case x := <-c: x() }` where each case is a send or receive operation on channels). newtype Select a = Select { selectCases :: a } - deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) -- TODO: Implement Eval instance for Select instance Evaluatable Select @@ -161,7 +161,7 @@ instance Show1 Select where liftShowsPrec = genericLiftShowsPrec -- | A send statement in Go (e.g. `channel <- value`). data Send a = Send { sendReceiver :: !a, sendValue :: !a } - deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Send where liftEq = genericLiftEq instance Ord1 Send where liftCompare = genericLiftCompare @@ -172,7 +172,7 @@ instance Evaluatable Send -- | A slice expression in Go (e.g. `a[1:4:3]` where a is a list, 1 is the low bound, 4 is the high bound, and 3 is the max capacity). data Slice a = Slice { sliceName :: !a, sliceLow :: !a, sliceHigh :: !a, sliceCapacity :: !a } - deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Slice where liftEq = genericLiftEq instance Ord1 Slice where liftCompare = genericLiftCompare @@ -183,7 +183,7 @@ instance Evaluatable Slice -- | A type switch statement in Go (e.g. `switch x.(type) { // cases }`). data TypeSwitch a = TypeSwitch { typeSwitchSubject :: !a, typeSwitchCases :: !a } - deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 TypeSwitch where liftEq = genericLiftEq instance Ord1 TypeSwitch where liftCompare = genericLiftCompare @@ -194,7 +194,7 @@ instance Evaluatable TypeSwitch -- | A type switch guard statement in a Go type switch statement (e.g. `switch i := x.(type) { // cases}`). newtype TypeSwitchGuard a = TypeSwitchGuard { typeSwitchGuardSubject :: a } - deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 TypeSwitchGuard where liftEq = genericLiftEq instance Ord1 TypeSwitchGuard where liftCompare = genericLiftCompare @@ -205,7 +205,7 @@ instance Evaluatable TypeSwitchGuard -- | A receive statement in a Go select statement (e.g. `case value := <-channel` ) data Receive a = Receive { receiveSubject :: !a, receiveExpression :: !a } - deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Receive where liftEq = genericLiftEq instance Ord1 Receive where liftCompare = genericLiftCompare @@ -216,7 +216,7 @@ instance Evaluatable Receive -- | A receive operator unary expression in Go (e.g. `<-channel` ) newtype ReceiveOperator a = ReceiveOperator a - deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 ReceiveOperator where liftEq = genericLiftEq instance Ord1 ReceiveOperator where liftCompare = genericLiftCompare @@ -227,7 +227,7 @@ instance Evaluatable ReceiveOperator -- | A field declaration in a Go struct type declaration. data Field a = Field { fieldContext :: ![a], fieldName :: !a } - deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Field where liftEq = genericLiftEq instance Ord1 Field where liftCompare = genericLiftCompare @@ -238,7 +238,7 @@ instance Evaluatable Field data Package a = Package { packageName :: !a, packageContents :: ![a] } - deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Package where liftEq = genericLiftEq instance Ord1 Package where liftCompare = genericLiftCompare @@ -250,7 +250,7 @@ instance Evaluatable Package where -- | A type assertion in Go (e.g. `x.(T)` where the value of `x` is not nil and is of type `T`). data TypeAssertion a = TypeAssertion { typeAssertionSubject :: !a, typeAssertionType :: !a } - deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 TypeAssertion where liftEq = genericLiftEq instance Ord1 TypeAssertion where liftCompare = genericLiftCompare @@ -261,7 +261,7 @@ instance Evaluatable TypeAssertion -- | A type conversion expression in Go (e.g. `T(x)` where `T` is a type and `x` is an expression that can be converted to type `T`). data TypeConversion a = TypeConversion { typeConversionType :: !a, typeConversionSubject :: !a } - deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 TypeConversion where liftEq = genericLiftEq instance Ord1 TypeConversion where liftCompare = genericLiftCompare @@ -272,7 +272,7 @@ instance Evaluatable TypeConversion -- | Variadic arguments and parameters in Go (e.g. parameter: `param ...Type`, argument: `Type...`). data Variadic a = Variadic { variadicContext :: [a], variadicIdentifier :: a } - deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Variadic where liftEq = genericLiftEq instance Ord1 Variadic where liftCompare = genericLiftCompare diff --git a/src/Language/Go/Type.hs b/src/Language/Go/Type.hs index b6292c5c0..7e7791917 100644 --- a/src/Language/Go/Type.hs +++ b/src/Language/Go/Type.hs @@ -7,7 +7,7 @@ import Diffing.Algorithm -- | A Bidirectional channel in Go (e.g. `chan`). newtype BidirectionalChannel a = BidirectionalChannel a - deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 BidirectionalChannel where liftEq = genericLiftEq instance Ord1 BidirectionalChannel where liftCompare = genericLiftCompare @@ -18,7 +18,7 @@ instance Evaluatable BidirectionalChannel -- | A Receive channel in Go (e.g. `<-chan`). newtype ReceiveChannel a = ReceiveChannel a - deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 ReceiveChannel where liftEq = genericLiftEq instance Ord1 ReceiveChannel where liftCompare = genericLiftCompare @@ -29,7 +29,7 @@ instance Evaluatable ReceiveChannel -- | A Send channel in Go (e.g. `chan<-`). newtype SendChannel a = SendChannel a - deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, FreeVariables1, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 SendChannel where liftEq = genericLiftEq instance Ord1 SendChannel where liftCompare = genericLiftCompare diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs index 60c2bc1ce..6f62485cc 100644 --- a/src/Language/Markdown/Syntax.hs +++ b/src/Language/Markdown/Syntax.hs @@ -5,7 +5,7 @@ import Prologue hiding (Text) import Diffing.Algorithm newtype Document a = Document [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Document where liftEq = genericLiftEq instance Ord1 Document where liftCompare = genericLiftCompare @@ -15,70 +15,70 @@ instance Show1 Document where liftShowsPrec = genericLiftShowsPrec -- Block elements newtype Paragraph a = Paragraph [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Paragraph where liftEq = genericLiftEq instance Ord1 Paragraph where liftCompare = genericLiftCompare instance Show1 Paragraph where liftShowsPrec = genericLiftShowsPrec data Heading a = Heading { headingLevel :: Int, headingContent :: [a], sectionContent :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Heading where liftEq = genericLiftEq instance Ord1 Heading where liftCompare = genericLiftCompare instance Show1 Heading where liftShowsPrec = genericLiftShowsPrec newtype UnorderedList a = UnorderedList [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 UnorderedList where liftEq = genericLiftEq instance Ord1 UnorderedList where liftCompare = genericLiftCompare instance Show1 UnorderedList where liftShowsPrec = genericLiftShowsPrec newtype OrderedList a = OrderedList [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 OrderedList where liftEq = genericLiftEq instance Ord1 OrderedList where liftCompare = genericLiftCompare instance Show1 OrderedList where liftShowsPrec = genericLiftShowsPrec newtype BlockQuote a = BlockQuote [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 BlockQuote where liftEq = genericLiftEq instance Ord1 BlockQuote where liftCompare = genericLiftCompare instance Show1 BlockQuote where liftShowsPrec = genericLiftShowsPrec data ThematicBreak a = ThematicBreak - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 ThematicBreak where liftEq = genericLiftEq instance Ord1 ThematicBreak where liftCompare = genericLiftCompare instance Show1 ThematicBreak where liftShowsPrec = genericLiftShowsPrec newtype HTMLBlock a = HTMLBlock ByteString - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 HTMLBlock where liftEq = genericLiftEq instance Ord1 HTMLBlock where liftCompare = genericLiftCompare instance Show1 HTMLBlock where liftShowsPrec = genericLiftShowsPrec newtype Table a = Table [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Table where liftEq = genericLiftEq instance Ord1 Table where liftCompare = genericLiftCompare instance Show1 Table where liftShowsPrec = genericLiftShowsPrec newtype TableRow a = TableRow [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 TableRow where liftEq = genericLiftEq instance Ord1 TableRow where liftCompare = genericLiftCompare instance Show1 TableRow where liftShowsPrec = genericLiftShowsPrec newtype TableCell a = TableCell [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 TableCell where liftEq = genericLiftEq instance Ord1 TableCell where liftCompare = genericLiftCompare @@ -88,56 +88,56 @@ instance Show1 TableCell where liftShowsPrec = genericLiftShowsPrec -- Inline elements newtype Strong a = Strong [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Strong where liftEq = genericLiftEq instance Ord1 Strong where liftCompare = genericLiftCompare instance Show1 Strong where liftShowsPrec = genericLiftShowsPrec newtype Emphasis a = Emphasis [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Emphasis where liftEq = genericLiftEq instance Ord1 Emphasis where liftCompare = genericLiftCompare instance Show1 Emphasis where liftShowsPrec = genericLiftShowsPrec newtype Text a = Text ByteString - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Text where liftEq = genericLiftEq instance Ord1 Text where liftCompare = genericLiftCompare instance Show1 Text where liftShowsPrec = genericLiftShowsPrec data Link a = Link { linkURL :: ByteString, linkTitle :: Maybe ByteString } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Link where liftEq = genericLiftEq instance Ord1 Link where liftCompare = genericLiftCompare instance Show1 Link where liftShowsPrec = genericLiftShowsPrec data Image a = Image { imageURL :: ByteString, imageTitle :: Maybe ByteString } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Image where liftEq = genericLiftEq instance Ord1 Image where liftCompare = genericLiftCompare instance Show1 Image where liftShowsPrec = genericLiftShowsPrec data Code a = Code { codeLanguage :: Maybe ByteString, codeContent :: ByteString } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Code where liftEq = genericLiftEq instance Ord1 Code where liftCompare = genericLiftCompare instance Show1 Code where liftShowsPrec = genericLiftShowsPrec data LineBreak a = LineBreak - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 LineBreak where liftEq = genericLiftEq instance Ord1 LineBreak where liftCompare = genericLiftCompare instance Show1 LineBreak where liftShowsPrec = genericLiftShowsPrec newtype Strikethrough a = Strikethrough [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Strikethrough where liftEq = genericLiftEq instance Ord1 Strikethrough where liftCompare = genericLiftCompare diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index 8ef31ebaf..81e1f9051 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -10,7 +10,7 @@ import Prelude hiding (fail) import Prologue hiding (Text) newtype Text a = Text ByteString - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Text where liftEq = genericLiftEq instance Ord1 Text where liftCompare = genericLiftCompare @@ -19,7 +19,7 @@ instance Evaluatable Text newtype VariableName a = VariableName a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 VariableName where liftEq = genericLiftEq instance Ord1 VariableName where liftCompare = genericLiftCompare @@ -57,7 +57,7 @@ doIncludeOnce pathTerm = do pure v newtype Require a = Require a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Require where liftEq = genericLiftEq instance Ord1 Require where liftCompare = genericLiftCompare @@ -68,7 +68,7 @@ instance Evaluatable Require where newtype RequireOnce a = RequireOnce a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 RequireOnce where liftEq = genericLiftEq instance Ord1 RequireOnce where liftCompare = genericLiftCompare @@ -79,7 +79,7 @@ instance Evaluatable RequireOnce where newtype Include a = Include a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Include where liftEq = genericLiftEq instance Ord1 Include where liftCompare = genericLiftCompare @@ -90,7 +90,7 @@ instance Evaluatable Include where newtype IncludeOnce a = IncludeOnce a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 IncludeOnce where liftEq = genericLiftEq instance Ord1 IncludeOnce where liftCompare = genericLiftCompare @@ -101,7 +101,7 @@ instance Evaluatable IncludeOnce where newtype ArrayElement a = ArrayElement a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 ArrayElement where liftEq = genericLiftEq instance Ord1 ArrayElement where liftCompare = genericLiftCompare @@ -109,7 +109,7 @@ instance Show1 ArrayElement where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ArrayElement newtype GlobalDeclaration a = GlobalDeclaration [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 GlobalDeclaration where liftEq = genericLiftEq instance Ord1 GlobalDeclaration where liftCompare = genericLiftCompare @@ -117,7 +117,7 @@ instance Show1 GlobalDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable GlobalDeclaration newtype SimpleVariable a = SimpleVariable a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 SimpleVariable where liftEq = genericLiftEq instance Ord1 SimpleVariable where liftCompare = genericLiftCompare @@ -127,7 +127,7 @@ instance Evaluatable SimpleVariable -- | TODO: Unify with TypeScript's PredefinedType newtype CastType a = CastType { _castType :: ByteString } - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 CastType where liftEq = genericLiftEq instance Ord1 CastType where liftCompare = genericLiftCompare @@ -135,7 +135,7 @@ instance Show1 CastType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable CastType newtype ErrorControl a = ErrorControl a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 ErrorControl where liftEq = genericLiftEq instance Ord1 ErrorControl where liftCompare = genericLiftCompare @@ -143,7 +143,7 @@ instance Show1 ErrorControl where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ErrorControl newtype Clone a = Clone a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Clone where liftEq = genericLiftEq instance Ord1 Clone where liftCompare = genericLiftCompare @@ -151,7 +151,7 @@ instance Show1 Clone where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Clone newtype ShellCommand a = ShellCommand ByteString - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 ShellCommand where liftEq = genericLiftEq instance Ord1 ShellCommand where liftCompare = genericLiftCompare @@ -160,7 +160,7 @@ instance Evaluatable ShellCommand -- | TODO: Combine with TypeScript update expression. newtype Update a = Update { _updateSubject :: a } - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Update where liftEq = genericLiftEq instance Ord1 Update where liftCompare = genericLiftCompare @@ -168,7 +168,7 @@ instance Show1 Update where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Update newtype NewVariable a = NewVariable [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 NewVariable where liftEq = genericLiftEq instance Ord1 NewVariable where liftCompare = genericLiftCompare @@ -176,7 +176,7 @@ instance Show1 NewVariable where liftShowsPrec = genericLiftShowsPrec instance Evaluatable NewVariable newtype RelativeScope a = RelativeScope ByteString - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 RelativeScope where liftEq = genericLiftEq instance Ord1 RelativeScope where liftCompare = genericLiftCompare @@ -184,7 +184,7 @@ instance Show1 RelativeScope where liftShowsPrec = genericLiftShowsPrec instance Evaluatable RelativeScope data QualifiedName a = QualifiedName !a !a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 QualifiedName where liftEq = genericLiftEq instance Ord1 QualifiedName where liftCompare = genericLiftCompare @@ -197,7 +197,7 @@ instance Evaluatable QualifiedName where newtype NamespaceName a = NamespaceName (NonEmpty a) - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 NamespaceName where liftEq = genericLiftEq instance Ord1 NamespaceName where liftCompare = genericLiftCompare @@ -211,7 +211,7 @@ instance Evaluatable NamespaceName where localEnv (mappend env) nam newtype ConstDeclaration a = ConstDeclaration [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 ConstDeclaration where liftEq = genericLiftEq instance Ord1 ConstDeclaration where liftCompare = genericLiftCompare @@ -219,7 +219,7 @@ instance Show1 ConstDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ConstDeclaration data ClassConstDeclaration a = ClassConstDeclaration a [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 ClassConstDeclaration where liftEq = genericLiftEq instance Ord1 ClassConstDeclaration where liftCompare = genericLiftCompare @@ -227,7 +227,7 @@ instance Show1 ClassConstDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ClassConstDeclaration newtype ClassInterfaceClause a = ClassInterfaceClause [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 ClassInterfaceClause where liftEq = genericLiftEq instance Ord1 ClassInterfaceClause where liftCompare = genericLiftCompare @@ -235,7 +235,7 @@ instance Show1 ClassInterfaceClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ClassInterfaceClause newtype ClassBaseClause a = ClassBaseClause a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 ClassBaseClause where liftEq = genericLiftEq instance Ord1 ClassBaseClause where liftCompare = genericLiftCompare @@ -244,7 +244,7 @@ instance Evaluatable ClassBaseClause newtype UseClause a = UseClause [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 UseClause where liftEq = genericLiftEq instance Ord1 UseClause where liftCompare = genericLiftCompare @@ -252,7 +252,7 @@ instance Show1 UseClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable UseClause newtype ReturnType a = ReturnType a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 ReturnType where liftEq = genericLiftEq instance Ord1 ReturnType where liftCompare = genericLiftCompare @@ -260,7 +260,7 @@ instance Show1 ReturnType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ReturnType newtype TypeDeclaration a = TypeDeclaration a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 TypeDeclaration where liftEq = genericLiftEq instance Ord1 TypeDeclaration where liftCompare = genericLiftCompare @@ -268,7 +268,7 @@ instance Show1 TypeDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TypeDeclaration newtype BaseTypeDeclaration a = BaseTypeDeclaration a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 BaseTypeDeclaration where liftEq = genericLiftEq instance Ord1 BaseTypeDeclaration where liftCompare = genericLiftCompare @@ -276,7 +276,7 @@ instance Show1 BaseTypeDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable BaseTypeDeclaration newtype ScalarType a = ScalarType ByteString - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 ScalarType where liftEq = genericLiftEq instance Ord1 ScalarType where liftCompare = genericLiftCompare @@ -284,7 +284,7 @@ instance Show1 ScalarType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ScalarType newtype EmptyIntrinsic a = EmptyIntrinsic a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 EmptyIntrinsic where liftEq = genericLiftEq instance Ord1 EmptyIntrinsic where liftCompare = genericLiftCompare @@ -292,7 +292,7 @@ instance Show1 EmptyIntrinsic where liftShowsPrec = genericLiftShowsPrec instance Evaluatable EmptyIntrinsic newtype ExitIntrinsic a = ExitIntrinsic a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 ExitIntrinsic where liftEq = genericLiftEq instance Ord1 ExitIntrinsic where liftCompare = genericLiftCompare @@ -300,7 +300,7 @@ instance Show1 ExitIntrinsic where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ExitIntrinsic newtype IssetIntrinsic a = IssetIntrinsic a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 IssetIntrinsic where liftEq = genericLiftEq instance Ord1 IssetIntrinsic where liftCompare = genericLiftCompare @@ -308,7 +308,7 @@ instance Show1 IssetIntrinsic where liftShowsPrec = genericLiftShowsPrec instance Evaluatable IssetIntrinsic newtype EvalIntrinsic a = EvalIntrinsic a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 EvalIntrinsic where liftEq = genericLiftEq instance Ord1 EvalIntrinsic where liftCompare = genericLiftCompare @@ -316,7 +316,7 @@ instance Show1 EvalIntrinsic where liftShowsPrec = genericLiftShowsPrec instance Evaluatable EvalIntrinsic newtype PrintIntrinsic a = PrintIntrinsic a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 PrintIntrinsic where liftEq = genericLiftEq instance Ord1 PrintIntrinsic where liftCompare = genericLiftCompare @@ -324,7 +324,7 @@ instance Show1 PrintIntrinsic where liftShowsPrec = genericLiftShowsPrec instance Evaluatable PrintIntrinsic newtype NamespaceAliasingClause a = NamespaceAliasingClause a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 NamespaceAliasingClause where liftEq = genericLiftEq instance Ord1 NamespaceAliasingClause where liftCompare = genericLiftCompare @@ -332,7 +332,7 @@ instance Show1 NamespaceAliasingClause where liftShowsPrec = genericLiftShowsPre instance Evaluatable NamespaceAliasingClause newtype NamespaceUseDeclaration a = NamespaceUseDeclaration [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 NamespaceUseDeclaration where liftEq = genericLiftEq instance Ord1 NamespaceUseDeclaration where liftCompare = genericLiftCompare @@ -340,7 +340,7 @@ instance Show1 NamespaceUseDeclaration where liftShowsPrec = genericLiftShowsPre instance Evaluatable NamespaceUseDeclaration newtype NamespaceUseClause a = NamespaceUseClause [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 NamespaceUseClause where liftEq = genericLiftEq instance Ord1 NamespaceUseClause where liftCompare = genericLiftCompare @@ -348,7 +348,7 @@ instance Show1 NamespaceUseClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable NamespaceUseClause newtype NamespaceUseGroupClause a = NamespaceUseGroupClause [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 NamespaceUseGroupClause where liftEq = genericLiftEq instance Ord1 NamespaceUseGroupClause where liftCompare = genericLiftCompare @@ -356,7 +356,7 @@ instance Show1 NamespaceUseGroupClause where liftShowsPrec = genericLiftShowsPre instance Evaluatable NamespaceUseGroupClause data Namespace a = Namespace { namespaceName :: a, namespaceBody :: a } - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Namespace where liftEq = genericLiftEq instance Ord1 Namespace where liftCompare = genericLiftCompare @@ -375,7 +375,7 @@ instance Evaluatable Namespace where go xs <* makeNamespace name addr [] data TraitDeclaration a = TraitDeclaration { traitName :: a, traitStatements :: [a] } - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 TraitDeclaration where liftEq = genericLiftEq instance Ord1 TraitDeclaration where liftCompare = genericLiftCompare @@ -383,7 +383,7 @@ instance Show1 TraitDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TraitDeclaration data AliasAs a = AliasAs { aliasAsName :: a, aliasAsModifier :: a, aliasAsClause :: a } - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 AliasAs where liftEq = genericLiftEq instance Ord1 AliasAs where liftCompare = genericLiftCompare @@ -391,7 +391,7 @@ instance Show1 AliasAs where liftShowsPrec = genericLiftShowsPrec instance Evaluatable AliasAs data InsteadOf a = InsteadOf a a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 InsteadOf where liftEq = genericLiftEq instance Ord1 InsteadOf where liftCompare = genericLiftCompare @@ -399,7 +399,7 @@ instance Show1 InsteadOf where liftShowsPrec = genericLiftShowsPrec instance Evaluatable InsteadOf newtype TraitUseSpecification a = TraitUseSpecification [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 TraitUseSpecification where liftEq = genericLiftEq instance Ord1 TraitUseSpecification where liftCompare = genericLiftCompare @@ -407,7 +407,7 @@ instance Show1 TraitUseSpecification where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TraitUseSpecification data TraitUseClause a = TraitUseClause [a] a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 TraitUseClause where liftEq = genericLiftEq instance Ord1 TraitUseClause where liftCompare = genericLiftCompare @@ -415,7 +415,7 @@ instance Show1 TraitUseClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TraitUseClause data DestructorDeclaration a = DestructorDeclaration [a] a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 DestructorDeclaration where liftEq = genericLiftEq instance Ord1 DestructorDeclaration where liftCompare = genericLiftCompare @@ -423,7 +423,7 @@ instance Show1 DestructorDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable DestructorDeclaration newtype Static a = Static ByteString - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Static where liftEq = genericLiftEq instance Ord1 Static where liftCompare = genericLiftCompare @@ -431,7 +431,7 @@ instance Show1 Static where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Static newtype ClassModifier a = ClassModifier ByteString - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 ClassModifier where liftEq = genericLiftEq instance Ord1 ClassModifier where liftCompare = genericLiftCompare @@ -439,7 +439,7 @@ instance Show1 ClassModifier where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ClassModifier data ConstructorDeclaration a = ConstructorDeclaration [a] [a] a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 ConstructorDeclaration where liftEq = genericLiftEq instance Ord1 ConstructorDeclaration where liftCompare = genericLiftCompare @@ -447,7 +447,7 @@ instance Show1 ConstructorDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ConstructorDeclaration data PropertyDeclaration a = PropertyDeclaration a [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 PropertyDeclaration where liftEq = genericLiftEq instance Ord1 PropertyDeclaration where liftCompare = genericLiftCompare @@ -455,7 +455,7 @@ instance Show1 PropertyDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable PropertyDeclaration data PropertyModifier a = PropertyModifier a a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 PropertyModifier where liftEq = genericLiftEq instance Ord1 PropertyModifier where liftCompare = genericLiftCompare @@ -463,7 +463,7 @@ instance Show1 PropertyModifier where liftShowsPrec = genericLiftShowsPrec instance Evaluatable PropertyModifier data InterfaceDeclaration a = InterfaceDeclaration a a [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 InterfaceDeclaration where liftEq = genericLiftEq instance Ord1 InterfaceDeclaration where liftCompare = genericLiftCompare @@ -471,7 +471,7 @@ instance Show1 InterfaceDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable InterfaceDeclaration newtype InterfaceBaseClause a = InterfaceBaseClause [a] - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 InterfaceBaseClause where liftEq = genericLiftEq instance Ord1 InterfaceBaseClause where liftCompare = genericLiftCompare @@ -479,7 +479,7 @@ instance Show1 InterfaceBaseClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable InterfaceBaseClause newtype Echo a = Echo a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Echo where liftEq = genericLiftEq instance Ord1 Echo where liftCompare = genericLiftCompare @@ -487,7 +487,7 @@ instance Show1 Echo where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Echo newtype Unset a = Unset a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Unset where liftEq = genericLiftEq instance Ord1 Unset where liftCompare = genericLiftCompare @@ -495,7 +495,7 @@ instance Show1 Unset where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Unset data Declare a = Declare a a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 Declare where liftEq = genericLiftEq instance Ord1 Declare where liftCompare = genericLiftCompare @@ -503,7 +503,7 @@ instance Show1 Declare where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Declare newtype DeclareDirective a = DeclareDirective a - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 DeclareDirective where liftEq = genericLiftEq instance Ord1 DeclareDirective where liftCompare = genericLiftCompare @@ -511,7 +511,7 @@ instance Show1 DeclareDirective where liftShowsPrec = genericLiftShowsPrec instance Evaluatable DeclareDirective newtype LabeledStatement a = LabeledStatement { _labeledStatementIdentifier :: a } - deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, GAlign, Generic1, Mergeable, Ord, Show, Traversable) + deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Generic1, Mergeable, Ord, Show, Traversable) instance Eq1 LabeledStatement where liftEq = genericLiftEq instance Ord1 LabeledStatement where liftCompare = genericLiftCompare diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index 831c65134..1a0790622 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -5,7 +5,6 @@ import Data.Abstract.Environment as Env import Data.Abstract.Evaluatable import qualified Data.Abstract.FreeVariables as FV import Data.Abstract.Module -import Data.Align.Generic import qualified Data.ByteString.Char8 as BC import Data.Functor.Classes.Generic import Data.List (intercalate) @@ -86,7 +85,7 @@ resolvePythonModules q = do -- -- If the list of symbols is empty copy everything to the calling environment. data Import a = Import { importFrom :: QualifiedName, importSymbols :: ![(Name, Name)] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Import where liftEq = genericLiftEq instance Ord1 Import where liftCompare = genericLiftCompare @@ -114,7 +113,7 @@ instance Evaluatable Import where newtype QualifiedImport a = QualifiedImport { qualifiedImportFrom :: QualifiedName } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 QualifiedImport where liftEq = genericLiftEq instance Ord1 QualifiedImport where liftCompare = genericLiftCompare @@ -140,7 +139,7 @@ instance Evaluatable QualifiedImport where makeNamespace name addr [] data QualifiedAliasedImport a = QualifiedAliasedImport { qualifiedAliasedImportFrom :: QualifiedName, qualifiedAliasedImportAlias :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 QualifiedAliasedImport where liftEq = genericLiftEq instance Ord1 QualifiedAliasedImport where liftCompare = genericLiftCompare @@ -165,7 +164,7 @@ instance Evaluatable QualifiedAliasedImport where -- | Ellipsis (used in splice expressions and alternatively can be used as a fill in expression, like `undefined` in Haskell) data Ellipsis a = Ellipsis - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Ellipsis where liftEq = genericLiftEq instance Ord1 Ellipsis where liftCompare = genericLiftCompare @@ -176,7 +175,7 @@ instance Evaluatable Ellipsis data Redirect a = Redirect !a !a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Redirect where liftEq = genericLiftEq instance Ord1 Redirect where liftCompare = genericLiftCompare diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index 47977d954..6bb40607c 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -37,7 +37,7 @@ cleanNameOrPath :: ByteString -> String cleanNameOrPath = BC.unpack . dropRelativePrefix . stripQuotes data Send a = Send { sendReceiver :: Maybe a, sendSelector :: a, sendArgs :: [a], sendBlock :: Maybe a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Send where liftEq = genericLiftEq instance Ord1 Send where liftCompare = genericLiftCompare @@ -53,7 +53,7 @@ instance Evaluatable Send where call func (map subtermValue sendArgs) -- TODO pass through sendBlock data Require a = Require { requireRelative :: Bool, requirePath :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Require where liftEq = genericLiftEq instance Ord1 Require where liftCompare = genericLiftCompare @@ -78,7 +78,7 @@ doRequire name = do newtype Load a = Load { loadArgs :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Load where liftEq = genericLiftEq instance Ord1 Load where liftCompare = genericLiftCompare @@ -104,7 +104,7 @@ doLoad path shouldWrap = do -- TODO: autoload data Class a = Class { classIdentifier :: !a, classSuperClasses :: ![a], classBody :: !a } - deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Diffable Class where equivalentBySubterm = Just . classIdentifier @@ -121,7 +121,7 @@ instance Evaluatable Class where subtermValue classBody <* makeNamespace name addr supers data Module a = Module { moduleIdentifier :: !a, moduleStatements :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Module where liftEq = genericLiftEq instance Ord1 Module where liftCompare = genericLiftCompare @@ -136,7 +136,7 @@ instance Evaluatable Module where data LowPrecedenceBoolean a = LowAnd !a !a | LowOr !a !a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Evaluatable LowPrecedenceBoolean where -- N.B. we have to use Monad rather than Applicative/Traversable on 'And' and 'Or' so that we don't evaluate both operands diff --git a/src/Language/TypeScript/Syntax.hs b/src/Language/TypeScript/Syntax.hs index 35e5c299b..8fa975e43 100644 --- a/src/Language/TypeScript/Syntax.hs +++ b/src/Language/TypeScript/Syntax.hs @@ -85,7 +85,7 @@ resolveTSModule path = maybe (Left searchPaths) Right <$> resolve searchPaths data Import a = Import { importSymbols :: ![(Name, Name)], importFrom :: ImportPath } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Import where liftEq = genericLiftEq instance Ord1 Import where liftCompare = genericLiftCompare @@ -103,7 +103,7 @@ instance Evaluatable Import where | otherwise = Env.overwrite symbols importedEnv data QualifiedAliasedImport a = QualifiedAliasedImport { qualifiedAliasedImportAlias :: !a, qualifiedAliasedImportFrom :: ImportPath } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 QualifiedAliasedImport where liftEq = genericLiftEq instance Ord1 QualifiedAliasedImport where liftCompare = genericLiftCompare @@ -120,7 +120,7 @@ instance Evaluatable QualifiedAliasedImport where unit newtype SideEffectImport a = SideEffectImport { sideEffectImportFrom :: ImportPath } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 SideEffectImport where liftEq = genericLiftEq instance Ord1 SideEffectImport where liftCompare = genericLiftCompare @@ -135,7 +135,7 @@ instance Evaluatable SideEffectImport where -- | Qualified Export declarations newtype QualifiedExport a = QualifiedExport { qualifiedExportSymbols :: [(Name, Name)] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 QualifiedExport where liftEq = genericLiftEq instance Ord1 QualifiedExport where liftCompare = genericLiftCompare @@ -151,7 +151,7 @@ instance Evaluatable QualifiedExport where -- | Qualified Export declarations that export from another module. data QualifiedExportFrom a = QualifiedExportFrom { qualifiedExportFrom :: ImportPath, qualifiedExportFromSymbols :: ![(Name, Name)]} - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 QualifiedExportFrom where liftEq = genericLiftEq instance Ord1 QualifiedExportFrom where liftCompare = genericLiftCompare @@ -172,7 +172,7 @@ instance Evaluatable QualifiedExportFrom where newtype DefaultExport a = DefaultExport { defaultExport :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 DefaultExport where liftEq = genericLiftEq instance Ord1 DefaultExport where liftCompare = genericLiftCompare @@ -183,7 +183,7 @@ instance Evaluatable DefaultExport where -- | Lookup type for a type-level key in a typescript map. data LookupType a = LookupType { lookupTypeIdentifier :: a, lookupTypeKey :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 LookupType where liftEq = genericLiftEq instance Ord1 LookupType where liftCompare = genericLiftCompare @@ -192,7 +192,7 @@ instance Evaluatable LookupType -- | ShorthandPropertyIdentifier used in object patterns such as var baz = { foo } to mean var baz = { foo: foo } newtype ShorthandPropertyIdentifier a = ShorthandPropertyIdentifier ByteString - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 ShorthandPropertyIdentifier where liftEq = genericLiftEq instance Ord1 ShorthandPropertyIdentifier where liftCompare = genericLiftCompare @@ -200,7 +200,7 @@ instance Show1 ShorthandPropertyIdentifier where liftShowsPrec = genericLiftShow instance Evaluatable ShorthandPropertyIdentifier data Union a = Union { _unionLeft :: !a, _unionRight :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Language.TypeScript.Syntax.Union where liftEq = genericLiftEq instance Ord1 Language.TypeScript.Syntax.Union where liftCompare = genericLiftCompare @@ -208,7 +208,7 @@ instance Show1 Language.TypeScript.Syntax.Union where liftShowsPrec = genericLif instance Evaluatable Language.TypeScript.Syntax.Union data Intersection a = Intersection { _intersectionLeft :: !a, _intersectionRight :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Intersection where liftEq = genericLiftEq instance Ord1 Intersection where liftCompare = genericLiftCompare @@ -216,7 +216,7 @@ instance Show1 Intersection where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Intersection data FunctionType a = FunctionType { _functionTypeParameters :: !a, _functionFormalParameters :: ![a], _functionType :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 FunctionType where liftEq = genericLiftEq instance Ord1 FunctionType where liftCompare = genericLiftCompare @@ -224,7 +224,7 @@ instance Show1 FunctionType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable FunctionType data AmbientFunction a = AmbientFunction { _ambientFunctionContext :: ![a], _ambientFunctionIdentifier :: !a, _ambientFunctionParameters :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 AmbientFunction where liftEq = genericLiftEq instance Ord1 AmbientFunction where liftCompare = genericLiftCompare @@ -232,7 +232,7 @@ instance Show1 AmbientFunction where liftShowsPrec = genericLiftShowsPrec instance Evaluatable AmbientFunction data ImportRequireClause a = ImportRequireClause { _importRequireIdentifier :: !a, _importRequireSubject :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 ImportRequireClause where liftEq = genericLiftEq instance Ord1 ImportRequireClause where liftCompare = genericLiftCompare @@ -240,7 +240,7 @@ instance Show1 ImportRequireClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ImportRequireClause newtype ImportClause a = ImportClause { _importClauseElements :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 ImportClause where liftEq = genericLiftEq instance Ord1 ImportClause where liftCompare = genericLiftCompare @@ -248,7 +248,7 @@ instance Show1 ImportClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ImportClause newtype Tuple a = Tuple { _tupleElements :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Tuple where liftEq = genericLiftEq instance Ord1 Tuple where liftCompare = genericLiftCompare @@ -258,7 +258,7 @@ instance Show1 Tuple where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Tuple data Constructor a = Constructor { _constructorTypeParameters :: !a, _constructorFormalParameters :: ![a], _constructorType :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Language.TypeScript.Syntax.Constructor where liftEq = genericLiftEq instance Ord1 Language.TypeScript.Syntax.Constructor where liftCompare = genericLiftCompare @@ -266,7 +266,7 @@ instance Show1 Language.TypeScript.Syntax.Constructor where liftShowsPrec = gene instance Evaluatable Language.TypeScript.Syntax.Constructor data TypeParameter a = TypeParameter { _typeParameter :: !a, _typeParameterConstraint :: !a, _typeParameterDefaultType :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 TypeParameter where liftEq = genericLiftEq instance Ord1 TypeParameter where liftCompare = genericLiftCompare @@ -274,7 +274,7 @@ instance Show1 TypeParameter where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TypeParameter data TypeAssertion a = TypeAssertion { _typeAssertionParameters :: !a, _typeAssertionExpression :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 TypeAssertion where liftEq = genericLiftEq instance Ord1 TypeAssertion where liftCompare = genericLiftCompare @@ -282,7 +282,7 @@ instance Show1 TypeAssertion where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TypeAssertion newtype Annotation a = Annotation { _annotationType :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Annotation where liftEq = genericLiftEq instance Ord1 Annotation where liftCompare = genericLiftCompare @@ -290,7 +290,7 @@ instance Show1 Annotation where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Annotation newtype Decorator a = Decorator { _decoratorTerm :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Decorator where liftEq = genericLiftEq instance Ord1 Decorator where liftCompare = genericLiftCompare @@ -298,7 +298,7 @@ instance Show1 Decorator where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Decorator newtype ComputedPropertyName a = ComputedPropertyName a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 ComputedPropertyName where liftEq = genericLiftEq instance Ord1 ComputedPropertyName where liftCompare = genericLiftCompare @@ -306,7 +306,7 @@ instance Show1 ComputedPropertyName where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ComputedPropertyName newtype Constraint a = Constraint { _constraintType :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Constraint where liftEq = genericLiftEq instance Ord1 Constraint where liftCompare = genericLiftCompare @@ -314,7 +314,7 @@ instance Show1 Constraint where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Constraint newtype DefaultType a = DefaultType { _defaultType :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 DefaultType where liftEq = genericLiftEq instance Ord1 DefaultType where liftCompare = genericLiftCompare @@ -322,7 +322,7 @@ instance Show1 DefaultType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable DefaultType newtype ParenthesizedType a = ParenthesizedType { _parenthesizedType :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 ParenthesizedType where liftEq = genericLiftEq instance Ord1 ParenthesizedType where liftCompare = genericLiftCompare @@ -330,7 +330,7 @@ instance Show1 ParenthesizedType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ParenthesizedType newtype PredefinedType a = PredefinedType { _predefinedType :: ByteString } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 PredefinedType where liftEq = genericLiftEq instance Ord1 PredefinedType where liftCompare = genericLiftCompare @@ -338,7 +338,7 @@ instance Show1 PredefinedType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable PredefinedType newtype TypeIdentifier a = TypeIdentifier ByteString - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 TypeIdentifier where liftEq = genericLiftEq instance Ord1 TypeIdentifier where liftCompare = genericLiftCompare @@ -346,7 +346,7 @@ instance Show1 TypeIdentifier where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TypeIdentifier data NestedIdentifier a = NestedIdentifier !a !a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 NestedIdentifier where liftEq = genericLiftEq instance Ord1 NestedIdentifier where liftCompare = genericLiftCompare @@ -354,7 +354,7 @@ instance Show1 NestedIdentifier where liftShowsPrec = genericLiftShowsPrec instance Evaluatable NestedIdentifier data NestedTypeIdentifier a = NestedTypeIdentifier !a !a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 NestedTypeIdentifier where liftEq = genericLiftEq instance Ord1 NestedTypeIdentifier where liftCompare = genericLiftCompare @@ -362,7 +362,7 @@ instance Show1 NestedTypeIdentifier where liftShowsPrec = genericLiftShowsPrec instance Evaluatable NestedTypeIdentifier data GenericType a = GenericType { _genericTypeIdentifier :: !a, _genericTypeArguments :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 GenericType where liftEq = genericLiftEq instance Ord1 GenericType where liftCompare = genericLiftCompare @@ -370,7 +370,7 @@ instance Show1 GenericType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable GenericType data TypePredicate a = TypePredicate { _typePredicateIdentifier :: !a, _typePredicateType :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 TypePredicate where liftEq = genericLiftEq instance Ord1 TypePredicate where liftCompare = genericLiftCompare @@ -378,7 +378,7 @@ instance Show1 TypePredicate where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TypePredicate newtype ObjectType a = ObjectType { _objectTypeElements :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 ObjectType where liftEq = genericLiftEq instance Ord1 ObjectType where liftCompare = genericLiftCompare @@ -386,7 +386,7 @@ instance Show1 ObjectType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ObjectType data With a = With { _withExpression :: !a, _withBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 With where liftEq = genericLiftEq instance Ord1 With where liftCompare = genericLiftCompare @@ -394,7 +394,7 @@ instance Show1 With where liftShowsPrec = genericLiftShowsPrec instance Evaluatable With newtype AmbientDeclaration a = AmbientDeclaration { _ambientDeclarationBody :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 AmbientDeclaration where liftEq = genericLiftEq instance Ord1 AmbientDeclaration where liftCompare = genericLiftCompare @@ -404,7 +404,7 @@ instance Evaluatable AmbientDeclaration where eval (AmbientDeclaration body) = subtermValue body data EnumDeclaration a = EnumDeclaration { _enumDeclarationIdentifier :: !a, _enumDeclarationBody :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 EnumDeclaration where liftEq = genericLiftEq instance Ord1 EnumDeclaration where liftCompare = genericLiftCompare @@ -412,7 +412,7 @@ instance Show1 EnumDeclaration where liftShowsPrec = genericLiftShowsPrec instance Evaluatable EnumDeclaration newtype ExtendsClause a = ExtendsClause { _extendsClauses :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 ExtendsClause where liftEq = genericLiftEq instance Ord1 ExtendsClause where liftCompare = genericLiftCompare @@ -420,7 +420,7 @@ instance Show1 ExtendsClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ExtendsClause newtype ArrayType a = ArrayType { _arrayType :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 ArrayType where liftEq = genericLiftEq instance Ord1 ArrayType where liftCompare = genericLiftCompare @@ -428,7 +428,7 @@ instance Show1 ArrayType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ArrayType newtype FlowMaybeType a = FlowMaybeType { _flowMaybeType :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 FlowMaybeType where liftEq = genericLiftEq instance Ord1 FlowMaybeType where liftCompare = genericLiftCompare @@ -436,7 +436,7 @@ instance Show1 FlowMaybeType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable FlowMaybeType newtype TypeQuery a = TypeQuery { _typeQuerySubject :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 TypeQuery where liftEq = genericLiftEq instance Ord1 TypeQuery where liftCompare = genericLiftCompare @@ -444,7 +444,7 @@ instance Show1 TypeQuery where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TypeQuery newtype IndexTypeQuery a = IndexTypeQuery { _indexTypeQuerySubject :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 IndexTypeQuery where liftEq = genericLiftEq instance Ord1 IndexTypeQuery where liftCompare = genericLiftCompare @@ -452,7 +452,7 @@ instance Show1 IndexTypeQuery where liftShowsPrec = genericLiftShowsPrec instance Evaluatable IndexTypeQuery newtype TypeArguments a = TypeArguments { _typeArguments :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 TypeArguments where liftEq = genericLiftEq instance Ord1 TypeArguments where liftCompare = genericLiftCompare @@ -460,7 +460,7 @@ instance Show1 TypeArguments where liftShowsPrec = genericLiftShowsPrec instance Evaluatable TypeArguments newtype ThisType a = ThisType ByteString - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 ThisType where liftEq = genericLiftEq instance Ord1 ThisType where liftCompare = genericLiftCompare @@ -468,7 +468,7 @@ instance Show1 ThisType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ThisType newtype ExistentialType a = ExistentialType ByteString - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 ExistentialType where liftEq = genericLiftEq instance Ord1 ExistentialType where liftCompare = genericLiftCompare @@ -476,7 +476,7 @@ instance Show1 ExistentialType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ExistentialType newtype LiteralType a = LiteralType { _literalTypeSubject :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 LiteralType where liftEq = genericLiftEq instance Ord1 LiteralType where liftCompare = genericLiftCompare @@ -484,7 +484,7 @@ instance Show1 LiteralType where liftShowsPrec = genericLiftShowsPrec instance Evaluatable LiteralType data PropertySignature a = PropertySignature { _modifiers :: ![a], _propertySignaturePropertyName :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 PropertySignature where liftEq = genericLiftEq instance Ord1 PropertySignature where liftCompare = genericLiftCompare @@ -492,7 +492,7 @@ instance Show1 PropertySignature where liftShowsPrec = genericLiftShowsPrec instance Evaluatable PropertySignature data CallSignature a = CallSignature { _callSignatureTypeParameters :: !a, _callSignatureParameters :: ![a], _callSignatureType :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 CallSignature where liftEq = genericLiftEq instance Ord1 CallSignature where liftCompare = genericLiftCompare @@ -501,7 +501,7 @@ instance Evaluatable CallSignature -- | Todo: Move type params and type to context data ConstructSignature a = ConstructSignature { _constructSignatureTypeParameters :: !a, _constructSignatureParameters :: ![a], _constructSignatureType :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 ConstructSignature where liftEq = genericLiftEq instance Ord1 ConstructSignature where liftCompare = genericLiftCompare @@ -509,7 +509,7 @@ instance Show1 ConstructSignature where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ConstructSignature data IndexSignature a = IndexSignature { _indexSignatureSubject :: a, _indexSignatureType :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 IndexSignature where liftEq = genericLiftEq instance Ord1 IndexSignature where liftCompare = genericLiftCompare @@ -517,7 +517,7 @@ instance Show1 IndexSignature where liftShowsPrec = genericLiftShowsPrec instance Evaluatable IndexSignature data AbstractMethodSignature a = AbstractMethodSignature { _abstractMethodSignatureContext :: ![a], _abstractMethodSignatureName :: !a, _abstractMethodSignatureParameters :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 AbstractMethodSignature where liftEq = genericLiftEq instance Ord1 AbstractMethodSignature where liftCompare = genericLiftCompare @@ -525,7 +525,7 @@ instance Show1 AbstractMethodSignature where liftShowsPrec = genericLiftShowsPre instance Evaluatable AbstractMethodSignature data Debugger a = Debugger - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Debugger where liftEq = genericLiftEq instance Ord1 Debugger where liftCompare = genericLiftCompare @@ -533,7 +533,7 @@ instance Show1 Debugger where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Debugger data ForOf a = ForOf { _forOfBinding :: !a, _forOfSubject :: !a, _forOfBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 ForOf where liftEq = genericLiftEq instance Ord1 ForOf where liftCompare = genericLiftCompare @@ -541,7 +541,7 @@ instance Show1 ForOf where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ForOf data This a = This - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 This where liftEq = genericLiftEq instance Ord1 This where liftCompare = genericLiftCompare @@ -549,7 +549,7 @@ instance Show1 This where liftShowsPrec = genericLiftShowsPrec instance Evaluatable This data LabeledStatement a = LabeledStatement { _labeledStatementIdentifier :: !a, _labeledStatementSubject :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 LabeledStatement where liftEq = genericLiftEq instance Ord1 LabeledStatement where liftCompare = genericLiftCompare @@ -557,7 +557,7 @@ instance Show1 LabeledStatement where liftShowsPrec = genericLiftShowsPrec instance Evaluatable LabeledStatement newtype Update a = Update { _updateSubject :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Update where liftEq = genericLiftEq instance Ord1 Update where liftCompare = genericLiftCompare @@ -565,7 +565,7 @@ instance Show1 Update where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Update data Module a = Module { moduleIdentifier :: !a, moduleStatements :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Module where liftEq = genericLiftEq instance Ord1 Module where liftCompare = genericLiftCompare @@ -580,7 +580,7 @@ instance Evaluatable Module where data InternalModule a = InternalModule { internalModuleIdentifier :: !a, internalModuleStatements :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 InternalModule where liftEq = genericLiftEq instance Ord1 InternalModule where liftCompare = genericLiftCompare @@ -594,7 +594,7 @@ instance Evaluatable InternalModule where data ImportAlias a = ImportAlias { _importAliasSubject :: !a, _importAlias :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 ImportAlias where liftEq = genericLiftEq instance Ord1 ImportAlias where liftCompare = genericLiftCompare @@ -602,7 +602,7 @@ instance Show1 ImportAlias where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ImportAlias data Super a = Super - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Super where liftEq = genericLiftEq instance Ord1 Super where liftCompare = genericLiftCompare @@ -610,7 +610,7 @@ instance Show1 Super where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Super data Undefined a = Undefined - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 Undefined where liftEq = genericLiftEq instance Ord1 Undefined where liftCompare = genericLiftCompare @@ -618,7 +618,7 @@ instance Show1 Undefined where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Undefined data ClassHeritage a = ClassHeritage { _classHeritageExtendsClause :: !a, _implementsClause :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 ClassHeritage where liftEq = genericLiftEq instance Ord1 ClassHeritage where liftCompare = genericLiftCompare @@ -626,7 +626,7 @@ instance Show1 ClassHeritage where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ClassHeritage data AbstractClass a = AbstractClass { _abstractClassIdentifier :: !a, _abstractClassTypeParameters :: !a, _classHeritage :: ![a], _classBody :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 AbstractClass where liftEq = genericLiftEq instance Ord1 AbstractClass where liftCompare = genericLiftCompare @@ -634,7 +634,7 @@ instance Show1 AbstractClass where liftShowsPrec = genericLiftShowsPrec instance Evaluatable AbstractClass data JsxElement a = JsxElement { _jsxOpeningElement :: !a, _jsxElements :: ![a], _jsxClosingElement :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 JsxElement where liftEq = genericLiftEq instance Ord1 JsxElement where liftCompare = genericLiftCompare @@ -642,7 +642,7 @@ instance Show1 JsxElement where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxElement newtype JsxText a = JsxText ByteString - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 JsxText where liftEq = genericLiftEq instance Ord1 JsxText where liftCompare = genericLiftCompare @@ -650,7 +650,7 @@ instance Show1 JsxText where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxText newtype JsxExpression a = JsxExpression { _jsxExpression :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 JsxExpression where liftEq = genericLiftEq instance Ord1 JsxExpression where liftCompare = genericLiftCompare @@ -658,7 +658,7 @@ instance Show1 JsxExpression where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxExpression data JsxOpeningElement a = JsxOpeningElement { _jsxOpeningElementIdentifier :: !a, _jsxAttributes :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 JsxOpeningElement where liftEq = genericLiftEq instance Ord1 JsxOpeningElement where liftCompare = genericLiftCompare @@ -666,7 +666,7 @@ instance Show1 JsxOpeningElement where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxOpeningElement newtype JsxClosingElement a = JsxClosingElement { _jsxClosingElementIdentifier :: a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 JsxClosingElement where liftEq = genericLiftEq instance Ord1 JsxClosingElement where liftCompare = genericLiftCompare @@ -674,7 +674,7 @@ instance Show1 JsxClosingElement where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxClosingElement data JsxSelfClosingElement a = JsxSelfClosingElement { _jsxSelfClosingElementIdentifier :: !a, _jsxSelfClosingElementAttributes :: ![a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 JsxSelfClosingElement where liftEq = genericLiftEq instance Ord1 JsxSelfClosingElement where liftCompare = genericLiftCompare @@ -682,7 +682,7 @@ instance Show1 JsxSelfClosingElement where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxSelfClosingElement data JsxAttribute a = JsxAttribute { _jsxAttributeTarget :: !a, _jsxAttributeValue :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 JsxAttribute where liftEq = genericLiftEq instance Ord1 JsxAttribute where liftCompare = genericLiftCompare @@ -690,7 +690,7 @@ instance Show1 JsxAttribute where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxAttribute newtype ImplementsClause a = ImplementsClause { _implementsClauseTypes :: [a] } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 ImplementsClause where liftEq = genericLiftEq instance Ord1 ImplementsClause where liftCompare = genericLiftCompare @@ -698,7 +698,7 @@ instance Show1 ImplementsClause where liftShowsPrec = genericLiftShowsPrec instance Evaluatable ImplementsClause data OptionalParameter a = OptionalParameter { _optionalParameterContext :: ![a], _optionalParameterSubject :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 OptionalParameter where liftEq = genericLiftEq instance Ord1 OptionalParameter where liftCompare = genericLiftCompare @@ -706,7 +706,7 @@ instance Show1 OptionalParameter where liftShowsPrec = genericLiftShowsPrec instance Evaluatable OptionalParameter data RequiredParameter a = RequiredParameter { _requiredParameterContext :: ![a], _requiredParameterSubject :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 RequiredParameter where liftEq = genericLiftEq instance Ord1 RequiredParameter where liftCompare = genericLiftCompare @@ -714,7 +714,7 @@ instance Show1 RequiredParameter where liftShowsPrec = genericLiftShowsPrec instance Evaluatable RequiredParameter data RestParameter a = RestParameter { _restParameterContext :: ![a], _restParameterSubject :: !a } - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 RestParameter where liftEq = genericLiftEq instance Ord1 RestParameter where liftCompare = genericLiftCompare @@ -722,7 +722,7 @@ instance Show1 RestParameter where liftShowsPrec = genericLiftShowsPrec instance Evaluatable RestParameter newtype JsxFragment a = JsxFragment [a] - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 JsxFragment where liftEq = genericLiftEq instance Ord1 JsxFragment where liftCompare = genericLiftCompare @@ -730,7 +730,7 @@ instance Show1 JsxFragment where liftShowsPrec = genericLiftShowsPrec instance Evaluatable JsxFragment data JsxNamespaceName a = JsxNamespaceName a a - deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1) instance Eq1 JsxNamespaceName where liftEq = genericLiftEq instance Ord1 JsxNamespaceName where liftCompare = genericLiftCompare diff --git a/src/Prologue.hs b/src/Prologue.hs index d927a1a4a..811684573 100644 --- a/src/Prologue.hs +++ b/src/Prologue.hs @@ -35,7 +35,6 @@ import Control.Monad as X hiding (fail, return, unless, when) import Control.Monad.Except as X (MonadError (..)) import Control.Monad.Fail as X (MonadFail (..)) import Data.Algebra as X -import Data.Align.Generic as X (GAlign) import Data.Bifoldable as X import Data.Bifunctor as X (Bifunctor (..)) import Data.Bitraversable as X diff --git a/src/Semantic/Diff.hs b/src/Semantic/Diff.hs index 350b9950a..7ed63cc98 100644 --- a/src/Semantic/Diff.hs +++ b/src/Semantic/Diff.hs @@ -28,7 +28,7 @@ diffBlobPairs renderer blobs = toOutput' <$> distributeFoldMap (WrapTask . diffB -- | A task to parse a pair of 'Blob's, diff them, and render the 'Diff'. diffBlobPair :: Members '[Distribute WrappedTask, Task, Telemetry, Exc SomeException, IO] effs => DiffRenderer output -> BlobPair -> Eff effs output diffBlobPair renderer blobs - | Just (SomeParser parser) <- someParser (Proxy :: Proxy '[ConstructorName, Diffable, Eq1, GAlign, HasDeclaration, IdentifierName, Show1, ToJSONFields1, Traversable]) <$> effectiveLanguage + | Just (SomeParser parser) <- someParser (Proxy :: Proxy '[ConstructorName, Diffable, Eq1, HasDeclaration, IdentifierName, Show1, ToJSONFields1, Traversable]) <$> effectiveLanguage = case renderer of ToCDiffRenderer -> run (WrapTask . (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob))) diffTerms renderToCDiff JSONDiffRenderer -> run (WrapTask . ( parse parser >=> decorate constructorLabel >=> decorate identifierLabel)) diffTerms renderJSONDiff From bfd2c6b210de925bb1e3d7431d4a7f5587726ea5 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 9 Apr 2018 16:18:12 -0400 Subject: [PATCH 006/148] :fire: Data.Align.Generic. --- semantic.cabal | 1 - src/Data/Align/Generic.hs | 79 --------------------------------------- 2 files changed, 80 deletions(-) delete mode 100644 src/Data/Align/Generic.hs diff --git a/semantic.cabal b/semantic.cabal index 97ab049a3..d8c102d77 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -66,7 +66,6 @@ library , Data.Abstract.Value -- General datatype definitions & generic algorithms , Data.Algebra - , Data.Align.Generic , Data.AST , Data.Blob , Data.Diff diff --git a/src/Data/Align/Generic.hs b/src/Data/Align/Generic.hs deleted file mode 100644 index 059e58ee5..000000000 --- a/src/Data/Align/Generic.hs +++ /dev/null @@ -1,79 +0,0 @@ -{-# LANGUAGE DataKinds, DefaultSignatures, TypeOperators, UndecidableInstances #-} -module Data.Align.Generic where - -import Control.Applicative -import Control.Monad -import Data.Functor (($>)) -import Data.List.NonEmpty (NonEmpty(..)) -import Data.Maybe (fromMaybe) -import Data.Proxy -import Data.These -import Data.Union -import GHC.Generics - --- | Functors which can be aligned (structure-unioning-ly zipped). The default implementation will operate generically over the constructors in the aligning type. -class GAlign f where - -- | Perform generic alignment of values of some functor, applying the given function to alignments of elements. - galignWith :: Alternative g => (These a1 a2 -> g b) -> f a1 -> f a2 -> g (f b) - default galignWith :: (Alternative g, Generic1 f, GAlign (Rep1 f)) => (These a1 a2 -> g b) -> f a1 -> f a2 -> g (f b) - galignWith f a b = to1 <$> galignWith f (from1 a) (from1 b) - -galign :: (Alternative g, GAlign f) => f a1 -> f a2 -> g (f (These a1 a2)) -galign = galignWith pure - --- 'Data.Align.Align' instances - -instance GAlign Maybe where - galignWith f (Just a1) (Just a2) = Just <$> f (These a1 a2) - galignWith f (Just a1) Nothing = Just <$> f (This a1) - galignWith f Nothing (Just a2) = Just <$> f (That a2) - galignWith _ Nothing Nothing = pure Nothing - -instance GAlign [] where - galignWith f (a1:as1) (a2:as2) = (:) <$> f (These a1 a2) <*> galignWith f as1 as2 - galignWith f [] as2 = traverse (f . That) as2 - galignWith f as1 [] = traverse (f . This) as1 - -instance GAlign NonEmpty where - galignWith f (a1:|as1) (a2:|as2) = (:|) <$> f (These a1 a2) <*> galignWith f as1 as2 - -instance Apply GAlign fs => GAlign (Union fs) where - galignWith f = (fromMaybe empty .) . apply2' (Proxy :: Proxy GAlign) (\ inj -> (fmap inj .) . galignWith f) - - --- Generics - --- | 'GAlign' over unit constructors. -instance GAlign U1 where - galignWith _ _ _ = pure U1 - --- | 'GAlign' over parameters. -instance GAlign Par1 where - galignWith f (Par1 a) (Par1 b) = Par1 <$> f (These a b) - --- | 'GAlign' over non-parameter fields. Only equal values are aligned. -instance Eq c => GAlign (K1 i c) where - galignWith _ (K1 a) (K1 b) = guard (a == b) $> K1 b - --- | 'GAlign' over applications over parameters. -instance GAlign f => GAlign (Rec1 f) where - galignWith f (Rec1 a) (Rec1 b) = Rec1 <$> galignWith f a b - --- | 'GAlign' over metainformation (constructor names, etc). -instance GAlign f => GAlign (M1 i c f) where - galignWith f (M1 a) (M1 b) = M1 <$> galignWith f a b - --- | 'GAlign' over sums. Returns 'Nothing' for disjoint constructors. -instance (GAlign f, GAlign g) => GAlign (f :+: g) where - galignWith f a b = case (a, b) of - (L1 a, L1 b) -> L1 <$> galignWith f a b - (R1 a, R1 b) -> R1 <$> galignWith f a b - _ -> empty - --- | 'GAlign' over products. -instance (GAlign f, GAlign g) => GAlign (f :*: g) where - galignWith f (a1 :*: b1) (a2 :*: b2) = (:*:) <$> galignWith f a1 a2 <*> galignWith f b1 b2 - --- | 'GAlign' over type compositions. -instance (Traversable f, Applicative f, GAlign g) => GAlign (f :.: g) where - galignWith f (Comp1 a) (Comp1 b) = Comp1 <$> sequenceA (galignWith f <$> a <*> b) From 0a282c63a099c706092ac6c5e825813d3d5adf9c Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 9 Apr 2018 16:21:44 -0400 Subject: [PATCH 007/148] =?UTF-8?q?We=20know=20this=20can=E2=80=99t=20happ?= =?UTF-8?q?en=20but=20ghc=20does=20not.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Diffing/Algorithm.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Diffing/Algorithm.hs b/src/Diffing/Algorithm.hs index 34c2f5c4e..b7ad776c8 100644 --- a/src/Diffing/Algorithm.hs +++ b/src/Diffing/Algorithm.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DataKinds, DefaultSignatures, GADTs, RankNTypes, TypeOperators, UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} -- FIXME module Diffing.Algorithm where import Control.Monad.Free.Freer @@ -222,7 +221,7 @@ instance Diffable [] where -- | Diff two non-empty lists using RWS. instance Diffable NonEmpty where - algorithmFor (a1:|as1) (a2:|as2) = (\ (a:as) -> a:|as) <$> byRWS (a1:as1) (a2:as2) + algorithmFor (a1:|as1) (a2:|as2) = nonEmpty <$> byRWS (a1:as1) (a2:as2) >>= maybe empty pure tryAlignWith f (a1:|as1) (a2:|as2) = (:|) <$> f (These a1 a2) <*> tryAlignWith f as1 as2 From 4459b26b0b652e63f1367378da912f85604011f4 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 9 Apr 2018 16:22:24 -0400 Subject: [PATCH 008/148] Tidy up the language extensions. --- src/Diffing/Algorithm.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Diffing/Algorithm.hs b/src/Diffing/Algorithm.hs index b7ad776c8..27a6fcb7f 100644 --- a/src/Diffing/Algorithm.hs +++ b/src/Diffing/Algorithm.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE DataKinds, DefaultSignatures, GADTs, RankNTypes, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DefaultSignatures, GADTs, TypeOperators, UndecidableInstances #-} module Diffing.Algorithm where import Control.Monad.Free.Freer From ebe142e2635ba86a622a9e18fd31dacfb0823112 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 9 Apr 2018 16:26:49 -0400 Subject: [PATCH 009/148] Define sequenceAlt generically. --- src/Data/Mergeable.hs | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/src/Data/Mergeable.hs b/src/Data/Mergeable.hs index ff8045699..b1e9a4d84 100644 --- a/src/Data/Mergeable.hs +++ b/src/Data/Mergeable.hs @@ -27,7 +27,8 @@ class Functor t => Mergeable t where -- | Sequnce a 'Mergeable' functor by 'merge'ing the 'Alternative' values. sequenceAlt :: Alternative f => t (f a) -> f (t a) - sequenceAlt = merge id + default sequenceAlt :: (Generic1 t, GMergeable (Rep1 t), Alternative f) => t (f a) -> f (t a) + sequenceAlt = genericSequenceAlt -- Instances @@ -48,37 +49,50 @@ instance Mergeable Identity where merge f = fmap Identity . f . runIdentity instance (Apply Functor fs, Apply Mergeable fs) => Mergeable (Union fs) where merge f = apply' (Proxy :: Proxy Mergeable) (\ reinj g -> reinj <$> merge f g) + sequenceAlt = apply' (Proxy :: Proxy Mergeable) (\ inj t -> inj <$> sequenceAlt t) -- Generics class GMergeable t where gmerge :: Alternative f => (a -> f b) -> t a -> f (t b) + gsequenceAlt :: Alternative f => t (f a) -> f (t a) genericMerge :: (Generic1 t, GMergeable (Rep1 t), Alternative f) => (a -> f b) -> t a -> f (t b) genericMerge f = fmap to1 . gmerge f . from1 +genericSequenceAlt :: (Generic1 t, GMergeable (Rep1 t), Alternative f) => t (f a) -> f (t a) +genericSequenceAlt = fmap to1 . gsequenceAlt . from1 + -- Instances instance GMergeable U1 where gmerge _ _ = pure U1 + gsequenceAlt _ = pure U1 instance GMergeable Par1 where gmerge f (Par1 a) = Par1 <$> f a + gsequenceAlt (Par1 a) = Par1 <$> a instance GMergeable (K1 i c) where gmerge _ (K1 a) = pure (K1 a) + gsequenceAlt (K1 a) = pure (K1 a) instance Mergeable f => GMergeable (Rec1 f) where gmerge f (Rec1 a) = Rec1 <$> merge f a + gsequenceAlt (Rec1 a) = Rec1 <$> sequenceAlt a instance GMergeable f => GMergeable (M1 i c f) where gmerge f (M1 a) = M1 <$> gmerge f a + gsequenceAlt (M1 a) = M1 <$> gsequenceAlt a instance (GMergeable f, GMergeable g) => GMergeable (f :+: g) where gmerge f (L1 a) = L1 <$> gmerge f a gmerge f (R1 b) = R1 <$> gmerge f b + gsequenceAlt (L1 a) = L1 <$> gsequenceAlt a + gsequenceAlt (R1 a) = R1 <$> gsequenceAlt a instance (GMergeable f, GMergeable g) => GMergeable (f :*: g) where gmerge f (a :*: b) = (:*:) <$> gmerge f a <*> gmerge f b + gsequenceAlt (a :*: b) = (:*:) <$> gsequenceAlt a <*> gsequenceAlt b From a26d56909982a63fbf07f3bf25b88462c5438849 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 9 Apr 2018 16:35:33 -0400 Subject: [PATCH 010/148] Give definitions of sequenceAlt for everything. --- src/Data/Mergeable.hs | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/src/Data/Mergeable.hs b/src/Data/Mergeable.hs index b1e9a4d84..a94797eba 100644 --- a/src/Data/Mergeable.hs +++ b/src/Data/Mergeable.hs @@ -37,15 +37,24 @@ instance Mergeable [] where merge f (x:xs) = ((:) <$> f x <|> pure id) <*> merge f xs merge _ [] = pure [] + sequenceAlt = foldr (\ x -> (((:) <$> x <|> pure id) <*>)) (pure []) + instance Mergeable NonEmpty where - merge f (x:|[]) = (:|) <$> f x <*> pure [] + merge f (x :|[]) = (:|) <$> f x <*> pure [] merge f (x1:|x2:xs) = (:|) <$> f x1 <*> merge f (x2 : xs) <|> merge f (x2:|xs) + sequenceAlt (x :|[]) = (:|) <$> x <*> pure [] + sequenceAlt (x1:|x2:xs) = (:|) <$> x1 <*> sequenceAlt (x2 : xs) <|> sequenceAlt (x2:|xs) + instance Mergeable Maybe where merge f (Just a) = Just <$> f a merge _ Nothing = pure empty -instance Mergeable Identity where merge f = fmap Identity . f . runIdentity + sequenceAlt = maybe (pure empty) (fmap Just) + +instance Mergeable Identity where + merge f = fmap Identity . f . runIdentity + sequenceAlt = fmap Identity . runIdentity instance (Apply Functor fs, Apply Mergeable fs) => Mergeable (Union fs) where merge f = apply' (Proxy :: Proxy Mergeable) (\ reinj g -> reinj <$> merge f g) From d863d282b17c4bd4f99ccb6985537cbae15ddb0c Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 9 Apr 2018 16:38:28 -0400 Subject: [PATCH 011/148] :fire: the Mergeable spec. --- semantic.cabal | 1 - test/Data/Mergeable/Spec.hs | 61 ------------------------------------- test/Spec.hs | 2 -- 3 files changed, 64 deletions(-) delete mode 100644 test/Data/Mergeable/Spec.hs diff --git a/semantic.cabal b/semantic.cabal index d8c102d77..faefe0898 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -237,7 +237,6 @@ test-suite test , Data.Diff.Spec , Data.Functor.Classes.Generic.Spec , Data.Functor.Listable - , Data.Mergeable.Spec , Data.Scientific.Spec , Data.Source.Spec , Data.Term.Spec diff --git a/test/Data/Mergeable/Spec.hs b/test/Data/Mergeable/Spec.hs deleted file mode 100644 index 92493e060..000000000 --- a/test/Data/Mergeable/Spec.hs +++ /dev/null @@ -1,61 +0,0 @@ -{-# LANGUAGE RankNTypes, ScopedTypeVariables #-} -module Data.Mergeable.Spec (spec) where - -import Control.Applicative (Alternative(..)) -import Data.Functor.Identity -import Data.Functor.Listable -import Data.Maybe (catMaybes) -import Data.Mergeable -import Test.Hspec -import Test.Hspec.LeanCheck -import Test.LeanCheck - -spec :: Spec -spec = parallel $ do - describe "[]" $ do - withAlternativeInstances sequenceAltLaws (tiers :: [Tier String]) - withAlternativeInstances mergeLaws (tiers :: [Tier String]) - describe "Maybe" $ do - withAlternativeInstances sequenceAltLaws (tiers :: [Tier (Maybe Char)]) - withAlternativeInstances mergeLaws (tiers :: [Tier (Maybe Char)]) - describe "Identity" $ do - withAlternativeInstances sequenceAltLaws (Identity `mapT` tiers :: [Tier (Identity Char)]) - withAlternativeInstances mergeLaws (Identity `mapT` tiers :: [Tier (Identity Char)]) - describe "ListableSyntax" $ do - withAlternativeInstances sequenceAltLaws (tiers :: [Tier (ListableSyntax Char)]) - withAlternativeInstances mergeLaws (tiers :: [Tier (ListableSyntax Char)]) - - prop "subsumes catMaybes/Just" $ - \ a -> sequenceAlt a `shouldBe` pure (catMaybes (a :: [Maybe Char])) - -mergeLaws :: forall f g a. (Mergeable f, Alternative g, Eq (g (f a)), Show (f a), Show (g (f a))) => [Tier (f a)] -> [Tier (Blind (a -> g a))] -> Spec -mergeLaws value function = describe "merge" $ do - prop "identity" . forAll value $ - \ a -> merge pure a `shouldNotBe` (empty :: g (f a)) - - prop "relationship with sequenceAlt" . forAll (value >< function) $ - \ (a, f) -> merge (getBlind f) a `shouldBe` sequenceAlt (fmap (getBlind f) a) - -sequenceAltLaws :: forall f g a. (Mergeable f, Alternative g, Eq (g (f a)), Show (f a), Show (g (f a))) => [Tier (f a)] -> [Tier (Blind (a -> g a))] -> Spec -sequenceAltLaws value function = describe "sequenceAlt" $ do - prop "identity" . forAll value $ - \ a -> sequenceAlt (pure <$> a) `shouldNotBe` (empty :: g (f a)) - - prop "relationship with merge" . forAll (productWith ((Blind .) . fmap . getBlind) function value :: [Tier (Blind (f (g a)))]) $ - \ a -> sequenceAlt (getBlind a) `shouldBe` merge id (getBlind a) - - -withAlternativeInstances :: forall f a. (Listable a, Eq (f a), Show (f a)) => (forall g. (Alternative g, Eq (g (f a)), Show (g (f a))) => [Tier (f a)] -> [Tier (Blind (a -> g a))] -> Spec) -> [Tier (f a)] -> Spec -withAlternativeInstances laws gen = do - describe "[]" $ laws gen (fmap const `mapT` tiers :: [Tier (Blind (a -> [a]))]) - describe "Maybe" $ laws gen (fmap const `mapT` tiers :: [Tier (Blind (a -> Maybe a))]) - - -newtype Blind a = Blind { getBlind :: a } - deriving Functor - -instance Listable a => Listable (Blind a) where - tiers = Blind `mapT` tiers - -instance Show (Blind a) where - showsPrec _ _ = showString "*" diff --git a/test/Spec.hs b/test/Spec.hs index eb8806085..642188c11 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -8,7 +8,6 @@ import qualified Analysis.TypeScript.Spec import qualified Assigning.Assignment.Spec import qualified Data.Diff.Spec import qualified Data.Functor.Classes.Generic.Spec -import qualified Data.Mergeable.Spec import qualified Data.Scientific.Spec import qualified Data.Source.Spec import qualified Data.Term.Spec @@ -36,7 +35,6 @@ main = hspec $ do describe "Assigning.Assignment" Assigning.Assignment.Spec.spec describe "Data.Diff" Data.Diff.Spec.spec describe "Data.Functor.Classes.Generic" Data.Functor.Classes.Generic.Spec.spec - describe "Data.Mergeable" Data.Mergeable.Spec.spec describe "Data.Scientific" Data.Scientific.Spec.spec describe "Data.Source" Data.Source.Spec.spec describe "Data.Term" Data.Term.Spec.spec From 45118d3a5432ad33c1ceac24f4de7fb04bd6a882 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 9 Apr 2018 16:38:44 -0400 Subject: [PATCH 012/148] :fire: merge, in favour of sequenceAlt. --- src/Data/Mergeable.hs | 36 ++---------------------------------- 1 file changed, 2 insertions(+), 34 deletions(-) diff --git a/src/Data/Mergeable.hs b/src/Data/Mergeable.hs index a94797eba..86b9f89a1 100644 --- a/src/Data/Mergeable.hs +++ b/src/Data/Mergeable.hs @@ -14,18 +14,9 @@ import GHC.Generics -- -- This is a kind of distributive law which produces (at least) the union of the two functors’ shapes; i.e. unlike 'Traversable', an 'empty' value in the inner functor does not produce an 'empty' result, and unlike 'Crosswalk', an 'empty' value in the outer functor does not produce an 'empty' result. -- --- For example, we can use 'merge' to select one side or the other of a diff node in 'Syntax', while correctly handling the fact that some patches don’t have any content for that side: --- --- @ --- let before = iter (\ (a :< s) -> cofree . (fst a :<) <$> sequenceAlt syntax) . fmap (maybeFst . unPatch) --- @ +-- For example, 'Data.Diff' uses 'sequenceAlt' to select one side or the other of a diff node, while correctly handling the fact that some patches don’t have any content for that side: class Functor t => Mergeable t where - -- | Merge a functor by mapping its elements into an 'Alternative' functor, combining them, and pushing the 'Mergeable' functor inside. - merge :: Alternative f => (a -> f b) -> t a -> f (t b) - default merge :: (Generic1 t, GMergeable (Rep1 t), Alternative f) => (a -> f b) -> t a -> f (t b) - merge = genericMerge - - -- | Sequnce a 'Mergeable' functor by 'merge'ing the 'Alternative' values. + -- | Sequnce a 'Mergeable' functor by merging the 'Alternative' values. sequenceAlt :: Alternative f => t (f a) -> f (t a) default sequenceAlt :: (Generic1 t, GMergeable (Rep1 t), Alternative f) => t (f a) -> f (t a) sequenceAlt = genericSequenceAlt @@ -34,42 +25,27 @@ class Functor t => Mergeable t where -- Instances instance Mergeable [] where - merge f (x:xs) = ((:) <$> f x <|> pure id) <*> merge f xs - merge _ [] = pure [] - sequenceAlt = foldr (\ x -> (((:) <$> x <|> pure id) <*>)) (pure []) instance Mergeable NonEmpty where - merge f (x :|[]) = (:|) <$> f x <*> pure [] - merge f (x1:|x2:xs) = (:|) <$> f x1 <*> merge f (x2 : xs) <|> merge f (x2:|xs) - sequenceAlt (x :|[]) = (:|) <$> x <*> pure [] sequenceAlt (x1:|x2:xs) = (:|) <$> x1 <*> sequenceAlt (x2 : xs) <|> sequenceAlt (x2:|xs) instance Mergeable Maybe where - merge f (Just a) = Just <$> f a - merge _ Nothing = pure empty - sequenceAlt = maybe (pure empty) (fmap Just) instance Mergeable Identity where - merge f = fmap Identity . f . runIdentity sequenceAlt = fmap Identity . runIdentity instance (Apply Functor fs, Apply Mergeable fs) => Mergeable (Union fs) where - merge f = apply' (Proxy :: Proxy Mergeable) (\ reinj g -> reinj <$> merge f g) sequenceAlt = apply' (Proxy :: Proxy Mergeable) (\ inj t -> inj <$> sequenceAlt t) -- Generics class GMergeable t where - gmerge :: Alternative f => (a -> f b) -> t a -> f (t b) gsequenceAlt :: Alternative f => t (f a) -> f (t a) -genericMerge :: (Generic1 t, GMergeable (Rep1 t), Alternative f) => (a -> f b) -> t a -> f (t b) -genericMerge f = fmap to1 . gmerge f . from1 - genericSequenceAlt :: (Generic1 t, GMergeable (Rep1 t), Alternative f) => t (f a) -> f (t a) genericSequenceAlt = fmap to1 . gsequenceAlt . from1 @@ -77,31 +53,23 @@ genericSequenceAlt = fmap to1 . gsequenceAlt . from1 -- Instances instance GMergeable U1 where - gmerge _ _ = pure U1 gsequenceAlt _ = pure U1 instance GMergeable Par1 where - gmerge f (Par1 a) = Par1 <$> f a gsequenceAlt (Par1 a) = Par1 <$> a instance GMergeable (K1 i c) where - gmerge _ (K1 a) = pure (K1 a) gsequenceAlt (K1 a) = pure (K1 a) instance Mergeable f => GMergeable (Rec1 f) where - gmerge f (Rec1 a) = Rec1 <$> merge f a gsequenceAlt (Rec1 a) = Rec1 <$> sequenceAlt a instance GMergeable f => GMergeable (M1 i c f) where - gmerge f (M1 a) = M1 <$> gmerge f a gsequenceAlt (M1 a) = M1 <$> gsequenceAlt a instance (GMergeable f, GMergeable g) => GMergeable (f :+: g) where - gmerge f (L1 a) = L1 <$> gmerge f a - gmerge f (R1 b) = R1 <$> gmerge f b gsequenceAlt (L1 a) = L1 <$> gsequenceAlt a gsequenceAlt (R1 a) = R1 <$> gsequenceAlt a instance (GMergeable f, GMergeable g) => GMergeable (f :*: g) where - gmerge f (a :*: b) = (:*:) <$> gmerge f a <*> gmerge f b gsequenceAlt (a :*: b) = (:*:) <$> gsequenceAlt a <*> gsequenceAlt b From 5aea6c2a22f28df479295c3f21926036f13d1049 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 9 Apr 2018 16:40:59 -0400 Subject: [PATCH 013/148] :fire: a redundant import. --- src/Language/Python/Syntax.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index 1a0790622..e2ff67056 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -9,7 +9,6 @@ import qualified Data.ByteString.Char8 as BC import Data.Functor.Classes.Generic import Data.List (intercalate) import qualified Data.List.NonEmpty as NonEmpty -import Data.Mergeable import Diffing.Algorithm import GHC.Generics import Prelude hiding (fail) From 20f200bfa9eb4195677f32ccfe0de0e16e15d9f3 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 9 Apr 2018 16:50:08 -0400 Subject: [PATCH 014/148] Fix typos. --- src/Data/Mergeable.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Data/Mergeable.hs b/src/Data/Mergeable.hs index 86b9f89a1..41703bb86 100644 --- a/src/Data/Mergeable.hs +++ b/src/Data/Mergeable.hs @@ -14,9 +14,9 @@ import GHC.Generics -- -- This is a kind of distributive law which produces (at least) the union of the two functors’ shapes; i.e. unlike 'Traversable', an 'empty' value in the inner functor does not produce an 'empty' result, and unlike 'Crosswalk', an 'empty' value in the outer functor does not produce an 'empty' result. -- --- For example, 'Data.Diff' uses 'sequenceAlt' to select one side or the other of a diff node, while correctly handling the fact that some patches don’t have any content for that side: +-- For example, 'Data.Diff' uses 'sequenceAlt' to select one side or the other of a diff node, while correctly handling the fact that some patches don’t have any content for that side. class Functor t => Mergeable t where - -- | Sequnce a 'Mergeable' functor by merging the 'Alternative' values. + -- | Sequence a 'Mergeable' functor by merging the 'Alternative' values. sequenceAlt :: Alternative f => t (f a) -> f (t a) default sequenceAlt :: (Generic1 t, GMergeable (Rep1 t), Alternative f) => t (f a) -> f (t a) sequenceAlt = genericSequenceAlt From 4bad0324cf772dc2a1e8e4d66928d16910619dce Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Thu, 24 May 2018 21:07:05 -0700 Subject: [PATCH 015/148] Attempt to always set gitHash --- semantic.cabal | 3 +++ src/Semantic/CLI.hs | 3 +++ 2 files changed, 6 insertions(+) diff --git a/semantic.cabal b/semantic.cabal index 21a28c40a..acea2f265 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -240,6 +240,9 @@ library else ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -O0 -j ghc-prof-options: -fprof-auto + default-extensions: CPP + if flag(release) + CPP-Options: -DRELEASE executable semantic hs-source-dirs: app diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 88cd521f1..75c8650c4 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -1,3 +1,6 @@ +#ifdef RELEASE +{-# OPTIONS_GHC -fforce-recomp #-} -- So that gitHash is correct. +#endif {-# LANGUAGE ApplicativeDo, RankNTypes, TemplateHaskell #-} module Semantic.CLI ( main From 7e63f87bc48f50093c3f813393770334097ea281 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Thu, 24 May 2018 21:22:09 -0700 Subject: [PATCH 016/148] Too slow --- semantic.cabal | 3 --- src/Semantic/CLI.hs | 2 -- 2 files changed, 5 deletions(-) diff --git a/semantic.cabal b/semantic.cabal index acea2f265..21a28c40a 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -240,9 +240,6 @@ library else ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-name-shadowing -O0 -j ghc-prof-options: -fprof-auto - default-extensions: CPP - if flag(release) - CPP-Options: -DRELEASE executable semantic hs-source-dirs: app diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs index 75c8650c4..6a9ac8427 100644 --- a/src/Semantic/CLI.hs +++ b/src/Semantic/CLI.hs @@ -1,6 +1,4 @@ -#ifdef RELEASE {-# OPTIONS_GHC -fforce-recomp #-} -- So that gitHash is correct. -#endif {-# LANGUAGE ApplicativeDo, RankNTypes, TemplateHaskell #-} module Semantic.CLI ( main From 0254ad676a14e3d5a7dc863b25ec4477f57023f8 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Wed, 23 May 2018 14:23:31 -0400 Subject: [PATCH 017/148] WIP: this works, but doesn't bracket or rethrow correctly. --- src/Parsing/TreeSitter.hs | 20 ++++++++++++++------ src/Semantic/IO.hs | 25 +++++++++++++++++++++++++ src/Semantic/Task.hs | 4 ++-- 3 files changed, 41 insertions(+), 8 deletions(-) diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs index d81c7876f..4e12b891a 100644 --- a/src/Parsing/TreeSitter.hs +++ b/src/Parsing/TreeSitter.hs @@ -8,6 +8,8 @@ import Prologue import Control.Concurrent.Async import Control.Monad +import Control.Monad.Effect +import Control.Monad.IO.Class import Data.AST (AST, Node (Node)) import Data.Blob import Data.ByteString.Unsafe (unsafeUseAsCStringLen) @@ -27,6 +29,10 @@ import qualified TreeSitter.Tree as TS newtype Timeout = Milliseconds Int +data ParseException = TimedOut deriving (Show, Typeable) + +instance Exception ParseException + -- Change this to putStrLn if you want to debug the locking/cancellation code. -- TODO: Someday we should run this all in Eff so that we can 'trace'. dbg :: String -> IO () @@ -49,13 +55,14 @@ runParser parser blobSource = unsafeUseAsCStringLen (sourceBytes blobSource) $ then pure Nothing else do TS.ts_tree_root_node_p treePtr rootPtr - fmap Just (peek rootPtr >>= anaM toAST) + ptr <- peek rootPtr + runM (fmap Just (anaM toAST ptr)) bracket acquire release go) -- | Parse 'Source' with the given 'TS.Language' and return its AST. -- Returns Nothing if the operation timed out. -parseToAST :: (Bounded grammar, Enum grammar) => Timeout -> Ptr TS.Language -> Blob -> IO (Maybe (AST [] grammar)) -parseToAST (Milliseconds s) language Blob{..} = bracket TS.ts_parser_new TS.ts_parser_delete $ \ parser -> do +parseToAST :: (Bounded grammar, Enum grammar, Members '[Exc SomeException, IO] effects) => Timeout -> Ptr TS.Language -> Blob -> Eff effects (Maybe (AST [] grammar)) +parseToAST (Milliseconds s) language Blob{..} = liftIO $ bracket TS.ts_parser_new TS.ts_parser_delete $ \ parser -> do let parserTimeout = s * 1000 TS.ts_parser_halt_on_error parser (CBool 1) @@ -68,13 +75,14 @@ parseToAST (Milliseconds s) language Blob{..} = bracket TS.ts_parser_new TS.ts_p -- If we get a Nothing back, then we failed, so we need to disable the parser, which -- will let the call to runParser terminate, cleaning up appropriately - when (isNothing res) (TS.ts_parser_set_enabled parser (CBool 0)) + when (isNothing res) $ + TS.ts_parser_set_enabled parser (CBool 0) pure (join res) -toAST :: forall grammar . (Bounded grammar, Enum grammar) => TS.Node -> IO (Base (AST [] grammar) TS.Node) -toAST node@TS.Node{..} = do +toAST :: forall grammar effects . (Bounded grammar, Enum grammar, Member IO effects) => TS.Node -> Eff effects (Base (AST [] grammar) TS.Node) +toAST node@TS.Node{..} = liftIO $ do let count = fromIntegral nodeChildCount children <- allocaArray count $ \ childNodesPtr -> do _ <- with nodeTSNode (\ nodePtr -> TS.ts_node_copy_child_nodes nodePtr childNodesPtr (fromIntegral count)) diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs index 76131337c..c6cd40d8e 100644 --- a/src/Semantic/IO.hs +++ b/src/Semantic/IO.hs @@ -274,6 +274,31 @@ catchException :: ( Exc.Exception e -> Eff r a catchException m handler = interpose pure (\ m yield -> send (Exc.try m) >>= either handler yield) m +-- type Arrow m (effects :: [* -> *]) a b = a -> m effects b +-- raiseHandler :: Effectful m => (Eff effectsA a -> Eff effectsB b) -> m effectsA a -> m effectsB b +-- send :: (Effectful m, Member eff e) => eff b -> m e b +-- interpose :: (Member eff e, Effectful m) +-- => Arrow m e a b +-- -> (forall v. eff v -> Arrow m e v b -> m e b) +-- -> m e a -> m e b + +masking :: Member IO r => Eff r a -> Eff r a +masking = interpose pure $ \m yield -> do + res <- send (Exc.mask_ m) + yield res + +bracket' :: (Members [Exc SomeException, IO] r) + => Eff r a + -> (a -> Eff r b) + -> (a -> Eff r c) + -> Eff r c +bracket' before after thing = do + a <- before + r <- thing a `catchError` (\(SomeException e) -> after a *> throwError (SomeException e)) + r <$ after a + + + -- | Lift an 'IO' action into 'Eff', catching and rethrowing any exceptions it throws into an 'Exc' effect. rethrowing :: ( Member (Exc SomeException) r , Member IO r diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs index 20132f7a9..08562da47 100644 --- a/src/Semantic/Task.hs +++ b/src/Semantic/Task.hs @@ -194,8 +194,8 @@ defaultTimeout = Milliseconds 5000 runParser :: Members '[Reader Options, Telemetry, Exc SomeException, IO, Trace] effs => Blob -> Parser term -> Eff effs term runParser blob@Blob{..} parser = case parser of ASTParser language -> - time "parse.tree_sitter_ast_parse" languageTag $ - IO.rethrowing (parseToAST defaultTimeout language blob) + time "parse.tree_sitter_ast_parse" languageTag $ do + parseToAST defaultTimeout language blob >>= maybeM (throwError (SomeException ParserTimedOut)) AssignmentParser parser assignment -> do From 6bd6e71d75c8822e77fb6a6ea416fdc7b656b2db Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 25 May 2018 11:37:16 -0400 Subject: [PATCH 018/148] Implement a correct bracket. --- src/Parsing/TreeSitter.hs | 20 +++++++-- src/Semantic/IO.hs | 86 ++++++++++++++------------------------- 2 files changed, 48 insertions(+), 58 deletions(-) diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs index 4e12b891a..a56267f80 100644 --- a/src/Parsing/TreeSitter.hs +++ b/src/Parsing/TreeSitter.hs @@ -4,9 +4,10 @@ module Parsing.TreeSitter , parseToAST ) where -import Prologue +import Prologue hiding (catchError, throwError) import Control.Concurrent.Async +import Control.Exception (throwIO) import Control.Monad import Control.Monad.Effect import Control.Monad.IO.Class @@ -20,6 +21,7 @@ import Data.Term import Foreign import Foreign.C.Types (CBool (..)) import Foreign.Marshal.Array (allocaArray) +import Semantic.IO hiding (Source) import System.Timeout import qualified TreeSitter.Language as TS @@ -59,10 +61,22 @@ runParser parser blobSource = unsafeUseAsCStringLen (sourceBytes blobSource) $ runM (fmap Just (anaM toAST ptr)) bracket acquire release go) +-- | The semantics of @bracket before after handler@ are as follows: +-- * Exceptions in @before@ and @after@ are thrown in IO. +-- * @after@ is called on IO exceptions in @handler@, and then rethrown in IO. +-- * If @handler@ completes successfully, @after@ is called +-- Call 'catchException' at the call site if you want to recover. +bracket' :: (Member IO r) => IO a -> (a -> IO b) -> (a -> Eff r c) -> Eff r c +bracket' before after action = do + a <- liftIO before + let cleanup = liftIO (after a) + res <- action a `catchException` (\(e :: SomeException) -> cleanup >> liftIO (throwIO e)) + res <$ cleanup + -- | Parse 'Source' with the given 'TS.Language' and return its AST. -- Returns Nothing if the operation timed out. -parseToAST :: (Bounded grammar, Enum grammar, Members '[Exc SomeException, IO] effects) => Timeout -> Ptr TS.Language -> Blob -> Eff effects (Maybe (AST [] grammar)) -parseToAST (Milliseconds s) language Blob{..} = liftIO $ bracket TS.ts_parser_new TS.ts_parser_delete $ \ parser -> do +parseToAST :: (Bounded grammar, Enum grammar, Member IO effects) => Timeout -> Ptr TS.Language -> Blob -> Eff effects (Maybe (AST [] grammar)) +parseToAST (Milliseconds s) language Blob{..} = bracket' TS.ts_parser_new TS.ts_parser_delete $ \ parser -> liftIO $ do let parserTimeout = s * 1000 TS.ts_parser_halt_on_error parser (CBool 1) diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs index c6cd40d8e..6e9a1f43c 100644 --- a/src/Semantic/IO.hs +++ b/src/Semantic/IO.hs @@ -1,35 +1,36 @@ {-# LANGUAGE DeriveAnyClass, DeriveDataTypeable, DuplicateRecordFields, GADTs, ScopedTypeVariables, TypeOperators, UndecidableInstances #-} module Semantic.IO -( readFile -, readFilePair -, isDirectory -, readBlobPairsFromHandle -, readBlobsFromHandle -, readProjectFromPaths -, readBlobsFromDir -, findFiles -, languageForFilePath -, NoLanguageForBlob(..) -, noLanguageForBlob -, readBlob -, readBlobs -, readBlobPairs -, readProject -, findFilesInDir -, write -, Handle(..) -, getHandle -, IO.IOMode(..) -, stdin -, stdout -, stderr -, openFileForReading -, Source(..) -, Destination(..) -, Files -, runFiles -, rethrowing -) where + ( Destination(..) + , Files + , Handle(..) + , IO.IOMode(..) + , NoLanguageForBlob(..) + , Source(..) + , catchException + , findFiles + , findFilesInDir + , getHandle + , isDirectory + , languageForFilePath + , noLanguageForBlob + , openFileForReading + , readBlob + , readBlobPairs + , readBlobPairsFromHandle + , readBlobs + , readBlobsFromDir + , readBlobsFromHandle + , readFile + , readFilePair + , readProject + , readProjectFromPaths + , rethrowing + , runFiles + , stderr + , stdin + , stdout + , write + ) where import qualified Control.Exception as Exc import Control.Monad.Effect @@ -274,31 +275,6 @@ catchException :: ( Exc.Exception e -> Eff r a catchException m handler = interpose pure (\ m yield -> send (Exc.try m) >>= either handler yield) m --- type Arrow m (effects :: [* -> *]) a b = a -> m effects b --- raiseHandler :: Effectful m => (Eff effectsA a -> Eff effectsB b) -> m effectsA a -> m effectsB b --- send :: (Effectful m, Member eff e) => eff b -> m e b --- interpose :: (Member eff e, Effectful m) --- => Arrow m e a b --- -> (forall v. eff v -> Arrow m e v b -> m e b) --- -> m e a -> m e b - -masking :: Member IO r => Eff r a -> Eff r a -masking = interpose pure $ \m yield -> do - res <- send (Exc.mask_ m) - yield res - -bracket' :: (Members [Exc SomeException, IO] r) - => Eff r a - -> (a -> Eff r b) - -> (a -> Eff r c) - -> Eff r c -bracket' before after thing = do - a <- before - r <- thing a `catchError` (\(SomeException e) -> after a *> throwError (SomeException e)) - r <$ after a - - - -- | Lift an 'IO' action into 'Eff', catching and rethrowing any exceptions it throws into an 'Exc' effect. rethrowing :: ( Member (Exc SomeException) r , Member IO r From b2aa29e6c6b1254afc5b53bae095f19db7604d6c Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 25 May 2018 12:28:56 -0400 Subject: [PATCH 019/148] :fire: dbg and just use `trace`. --- src/Parsing/TreeSitter.hs | 55 +++++++++++++++++++-------------------- 1 file changed, 27 insertions(+), 28 deletions(-) diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs index a56267f80..ee2d8fe99 100644 --- a/src/Parsing/TreeSitter.hs +++ b/src/Parsing/TreeSitter.hs @@ -4,12 +4,14 @@ module Parsing.TreeSitter , parseToAST ) where -import Prologue hiding (catchError, throwError) +import Prologue import Control.Concurrent.Async +import Control.Concurrent.MVar import Control.Exception (throwIO) import Control.Monad import Control.Monad.Effect +import Control.Monad.Effect.Trace import Control.Monad.IO.Class import Data.AST (AST, Node (Node)) import Data.Blob @@ -31,34 +33,28 @@ import qualified TreeSitter.Tree as TS newtype Timeout = Milliseconds Int -data ParseException = TimedOut deriving (Show, Typeable) +data Result grammar + = Failed + | Succeeded (AST [] grammar) -instance Exception ParseException - --- Change this to putStrLn if you want to debug the locking/cancellation code. --- TODO: Someday we should run this all in Eff so that we can 'trace'. -dbg :: String -> IO () -dbg = const (pure ()) - -runParser :: (Enum grammar, Bounded grammar) => Ptr TS.Parser -> Source -> IO (Maybe (AST [] grammar)) -runParser parser blobSource = unsafeUseAsCStringLen (sourceBytes blobSource) $ \ (source, len) -> +runParser :: (Enum grammar, Bounded grammar) => Ptr TS.Parser -> Source -> IO (Result grammar) +runParser parser blobSource = unsafeUseAsCStringLen (sourceBytes blobSource) $ \ (source, len) -> do alloca (\ rootPtr -> do let acquire = do - dbg "Starting parse" -- Change this to TS.ts_parser_loop_until_cancelled if you want to test out cancellation TS.ts_parser_parse_string parser nullPtr source len let release t - | t == nullPtr = dbg "Parse failed" - | otherwise = dbg "Parse completed" *> TS.ts_tree_delete t + | t == nullPtr = pure () + | otherwise = TS.ts_tree_delete t let go treePtr = do if treePtr == nullPtr - then pure Nothing + then pure Failed else do TS.ts_tree_root_node_p treePtr rootPtr ptr <- peek rootPtr - runM (fmap Just (anaM toAST ptr)) + runM (fmap Succeeded (anaM toAST ptr)) bracket acquire release go) -- | The semantics of @bracket before after handler@ are as follows: @@ -75,24 +71,27 @@ bracket' before after action = do -- | Parse 'Source' with the given 'TS.Language' and return its AST. -- Returns Nothing if the operation timed out. -parseToAST :: (Bounded grammar, Enum grammar, Member IO effects) => Timeout -> Ptr TS.Language -> Blob -> Eff effects (Maybe (AST [] grammar)) -parseToAST (Milliseconds s) language Blob{..} = bracket' TS.ts_parser_new TS.ts_parser_delete $ \ parser -> liftIO $ do +parseToAST :: (Bounded grammar, Enum grammar, Members '[Trace, IO] effects) => Timeout -> Ptr TS.Language -> Blob -> Eff effects (Maybe (AST [] grammar)) +parseToAST (Milliseconds s) language Blob{..} = bracket' TS.ts_parser_new TS.ts_parser_delete $ \ parser -> do let parserTimeout = s * 1000 - TS.ts_parser_halt_on_error parser (CBool 1) - TS.ts_parser_set_language parser language + liftIO $ do + TS.ts_parser_halt_on_error parser (CBool 1) + TS.ts_parser_set_language parser language - parsing <- async (runParser parser blobSource) + trace "tree-sitter: beginning parsing" + + parsing <- liftIO . async $ runParser parser blobSource -- Kick the parser off asynchronously and wait according to the provided timeout. - res <- timeout parserTimeout (wait parsing) + res <- liftIO . timeout parserTimeout $ wait parsing - -- If we get a Nothing back, then we failed, so we need to disable the parser, which - -- will let the call to runParser terminate, cleaning up appropriately - when (isNothing res) $ - TS.ts_parser_set_enabled parser (CBool 0) - - pure (join res) + case res of + Just Failed -> Nothing <$ trace "tree-sitter: parsing failed" + Just (Succeeded ast) -> Just ast <$ trace "tree-sitter: parsing succeeded" + Nothing -> do + trace "tree-sitter: parsing timed out" + Nothing <$ liftIO (TS.ts_parser_set_enabled parser (CBool 0)) toAST :: forall grammar effects . (Bounded grammar, Enum grammar, Member IO effects) => TS.Node -> Eff effects (Base (AST [] grammar) TS.Node) From 3e02366d143ff512433013a040ce8998a66059ff Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 25 May 2018 12:34:04 -0400 Subject: [PATCH 020/148] don't use Eff in `toAST` since it's just being called from IO. --- src/Parsing/TreeSitter.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs index ee2d8fe99..8b7b327ed 100644 --- a/src/Parsing/TreeSitter.hs +++ b/src/Parsing/TreeSitter.hs @@ -54,7 +54,7 @@ runParser parser blobSource = unsafeUseAsCStringLen (sourceBytes blobSource) $ else do TS.ts_tree_root_node_p treePtr rootPtr ptr <- peek rootPtr - runM (fmap Succeeded (anaM toAST ptr)) + Succeeded <$> anaM toAST ptr bracket acquire release go) -- | The semantics of @bracket before after handler@ are as follows: @@ -94,8 +94,8 @@ parseToAST (Milliseconds s) language Blob{..} = bracket' TS.ts_parser_new TS.ts_ Nothing <$ liftIO (TS.ts_parser_set_enabled parser (CBool 0)) -toAST :: forall grammar effects . (Bounded grammar, Enum grammar, Member IO effects) => TS.Node -> Eff effects (Base (AST [] grammar) TS.Node) -toAST node@TS.Node{..} = liftIO $ do +toAST :: forall grammar effects . (Bounded grammar, Enum grammar) => TS.Node -> IO (Base (AST [] grammar) TS.Node) +toAST node@TS.Node{..} = do let count = fromIntegral nodeChildCount children <- allocaArray count $ \ childNodesPtr -> do _ <- with nodeTSNode (\ nodePtr -> TS.ts_node_copy_child_nodes nodePtr childNodesPtr (fromIntegral count)) From bec56ece821e8b3052c4b3d33081d58ce3a86206 Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 25 May 2018 12:35:16 -0400 Subject: [PATCH 021/148] otiose 'do' --- src/Semantic/Task.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs index 08562da47..406df5bfd 100644 --- a/src/Semantic/Task.hs +++ b/src/Semantic/Task.hs @@ -194,7 +194,7 @@ defaultTimeout = Milliseconds 5000 runParser :: Members '[Reader Options, Telemetry, Exc SomeException, IO, Trace] effs => Blob -> Parser term -> Eff effs term runParser blob@Blob{..} parser = case parser of ASTParser language -> - time "parse.tree_sitter_ast_parse" languageTag $ do + time "parse.tree_sitter_ast_parse" languageTag $ parseToAST defaultTimeout language blob >>= maybeM (throwError (SomeException ParserTimedOut)) From 9b68986a93ddae7554f9915cedf991381dd7212b Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 25 May 2018 12:36:48 -0400 Subject: [PATCH 022/148] warnings --- src/Parsing/TreeSitter.hs | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs index 8b7b327ed..20e4a3ead 100644 --- a/src/Parsing/TreeSitter.hs +++ b/src/Parsing/TreeSitter.hs @@ -7,9 +7,7 @@ module Parsing.TreeSitter import Prologue import Control.Concurrent.Async -import Control.Concurrent.MVar import Control.Exception (throwIO) -import Control.Monad import Control.Monad.Effect import Control.Monad.Effect.Trace import Control.Monad.IO.Class @@ -94,7 +92,7 @@ parseToAST (Milliseconds s) language Blob{..} = bracket' TS.ts_parser_new TS.ts_ Nothing <$ liftIO (TS.ts_parser_set_enabled parser (CBool 0)) -toAST :: forall grammar effects . (Bounded grammar, Enum grammar) => TS.Node -> IO (Base (AST [] grammar) TS.Node) +toAST :: forall grammar . (Bounded grammar, Enum grammar) => TS.Node -> IO (Base (AST [] grammar) TS.Node) toAST node@TS.Node{..} = do let count = fromIntegral nodeChildCount children <- allocaArray count $ \ childNodesPtr -> do From 18723b2c1e4cc42dafda4b837cef77c6fd8f989f Mon Sep 17 00:00:00 2001 From: Patrick Thomson Date: Fri, 25 May 2018 13:02:03 -0400 Subject: [PATCH 023/148] dedent import list --- src/Semantic/IO.hs | 62 +++++++++++++++++++++++----------------------- 1 file changed, 31 insertions(+), 31 deletions(-) diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs index 6e9a1f43c..a4ccd5314 100644 --- a/src/Semantic/IO.hs +++ b/src/Semantic/IO.hs @@ -1,36 +1,36 @@ {-# LANGUAGE DeriveAnyClass, DeriveDataTypeable, DuplicateRecordFields, GADTs, ScopedTypeVariables, TypeOperators, UndecidableInstances #-} module Semantic.IO - ( Destination(..) - , Files - , Handle(..) - , IO.IOMode(..) - , NoLanguageForBlob(..) - , Source(..) - , catchException - , findFiles - , findFilesInDir - , getHandle - , isDirectory - , languageForFilePath - , noLanguageForBlob - , openFileForReading - , readBlob - , readBlobPairs - , readBlobPairsFromHandle - , readBlobs - , readBlobsFromDir - , readBlobsFromHandle - , readFile - , readFilePair - , readProject - , readProjectFromPaths - , rethrowing - , runFiles - , stderr - , stdin - , stdout - , write - ) where +( Destination(..) +, Files +, Handle(..) +, IO.IOMode(..) +, NoLanguageForBlob(..) +, Source(..) +, catchException +, findFiles +, findFilesInDir +, getHandle +, isDirectory +, languageForFilePath +, noLanguageForBlob +, openFileForReading +, readBlob +, readBlobPairs +, readBlobPairsFromHandle +, readBlobs +, readBlobsFromDir +, readBlobsFromHandle +, readFile +, readFilePair +, readProject +, readProjectFromPaths +, rethrowing +, runFiles +, stderr +, stdin +, stdout +, write +) where import qualified Control.Exception as Exc import Control.Monad.Effect From 8f183d5f8641fb3c4ff20858a5425c0590faffd6 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Fri, 25 May 2018 15:13:41 -0400 Subject: [PATCH 024/148] Represent Value as a normal ADT. --- src/Data/Abstract/Value.hs | 305 +++++++++---------------------------- 1 file changed, 71 insertions(+), 234 deletions(-) diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 43e8c72cc..a585dc7c4 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -11,198 +11,35 @@ import Data.Scientific (Scientific) import Data.Scientific.Exts import Data.Semigroup.Reducer import qualified Data.Set as Set -import Data.Sum -import Prologue hiding (TypeError, project) -import Prelude hiding (Float, Integer, String, Rational) -import qualified Prelude +import Prologue -type ValueConstructors location - = '[Array - , Boolean - , Class location - , Closure location - , Float - , Hash - , Integer - , KVPair - , Namespace location - , Null - , Rational - , String - , Symbol - , Tuple - , Unit - , Hole - ] - --- | Open union of primitive values that terms can be evaluated to. --- Fix by another name. -newtype Value location = Value (Sum (ValueConstructors location) (Value location)) +data Value location + = Closure PackageInfo ModuleInfo [Name] Label (Environment location) + | Unit + | Boolean Bool + | Integer (Number.Number Integer) + | Rational (Number.Number Rational) + | Float (Number.Number Scientific) + | String ByteString + | Symbol ByteString + | Tuple [Value location] + | Array [Value location] + | Class Name (Environment location) + | Namespace Name (Environment location) + | KVPair (Value location) (Value location) + | Hash [Value location] + | Null + | Hole deriving (Eq, Show, Ord) --- | Identical to 'inject', but wraps the resulting sub-entity in a 'Value'. -injValue :: (f :< ValueConstructors location) => f (Value location) -> Value location -injValue = Value . inject - --- | Identical to 'prj', but unwraps the argument out of its 'Value' wrapper. -prjValue :: (f :< ValueConstructors location) => Value location -> Maybe (f (Value location)) -prjValue (Value v) = project v - --- | Convenience function for projecting two values. -prjPair :: (f :< ValueConstructors location , g :< ValueConstructors location) - => (Value location, Value location) - -> Maybe (f (Value location), g (Value location)) -prjPair = bitraverse prjValue prjValue - --- TODO: Parameterize Value by the set of constructors s.t. each language can have a distinct value union. - --- | A function value consisting of a package & module info, a list of parameter 'Name's, a 'Label' to jump to the body of the function, and an 'Environment' of bindings captured by the body. -data Closure location value = Closure PackageInfo ModuleInfo [Name] Label (Environment location) - deriving (Eq, Generic1, Ord, Show) - -instance Eq location => Eq1 (Closure location) where liftEq = genericLiftEq -instance Ord location => Ord1 (Closure location) where liftCompare = genericLiftCompare -instance Show location => Show1 (Closure location) where liftShowsPrec = genericLiftShowsPrec - --- | The unit value. Typically used to represent the result of imperative statements. -data Unit value = Unit - deriving (Eq, Generic1, Ord, Show) - -instance Eq1 Unit where liftEq = genericLiftEq -instance Ord1 Unit where liftCompare = genericLiftCompare -instance Show1 Unit where liftShowsPrec = genericLiftShowsPrec - -data Hole value = Hole - deriving (Eq, Generic1, Ord, Show) - -instance Eq1 Hole where liftEq = genericLiftEq -instance Ord1 Hole where liftCompare = genericLiftCompare -instance Show1 Hole where liftShowsPrec = genericLiftShowsPrec - --- | Boolean values. -newtype Boolean value = Boolean { getBoolean :: Bool } - deriving (Eq, Generic1, Ord, Show) - -instance Eq1 Boolean where liftEq = genericLiftEq -instance Ord1 Boolean where liftCompare = genericLiftCompare -instance Show1 Boolean where liftShowsPrec = genericLiftShowsPrec - --- | Arbitrary-width integral values. -newtype Integer value = Integer (Number.Number Prelude.Integer) - deriving (Eq, Generic1, Ord, Show) - -instance Eq1 Integer where liftEq = genericLiftEq -instance Ord1 Integer where liftCompare = genericLiftCompare -instance Show1 Integer where liftShowsPrec = genericLiftShowsPrec - --- | Arbitrary-width rational values values. -newtype Rational value = Rational (Number.Number Prelude.Rational) - deriving (Eq, Generic1, Ord, Show) - -instance Eq1 Rational where liftEq = genericLiftEq -instance Ord1 Rational where liftCompare = genericLiftCompare -instance Show1 Rational where liftShowsPrec = genericLiftShowsPrec - --- | String values. -newtype String value = String ByteString - deriving (Eq, Generic1, Ord, Show) - -instance Eq1 String where liftEq = genericLiftEq -instance Ord1 String where liftCompare = genericLiftCompare -instance Show1 String where liftShowsPrec = genericLiftShowsPrec - --- | Possibly-interned Symbol values. --- TODO: Should this store a 'Text'? -newtype Symbol value = Symbol ByteString - deriving (Eq, Generic1, Ord, Show) - -instance Eq1 Symbol where liftEq = genericLiftEq -instance Ord1 Symbol where liftCompare = genericLiftCompare -instance Show1 Symbol where liftShowsPrec = genericLiftShowsPrec - --- | Float values. -newtype Float value = Float (Number.Number Scientific) - deriving (Eq, Generic1, Ord, Show) - -instance Eq1 Float where liftEq = genericLiftEq -instance Ord1 Float where liftCompare = genericLiftCompare -instance Show1 Float where liftShowsPrec = genericLiftShowsPrec - --- | Zero or more values. Fixed-size at interpretation time. --- TODO: Investigate whether we should use Vector for this. --- TODO: Should we have a Some type over a nonemmpty list? Or does this merit one? -newtype Tuple value = Tuple [value] - deriving (Eq, Generic1, Ord, Show) - -instance Eq1 Tuple where liftEq = genericLiftEq -instance Ord1 Tuple where liftCompare = genericLiftCompare -instance Show1 Tuple where liftShowsPrec = genericLiftShowsPrec - --- | Zero or more values. Dynamically resized as needed at interpretation time. --- TODO: Vector? Seq? -newtype Array value = Array [value] - deriving (Eq, Generic1, Ord, Show) - -instance Eq1 Array where liftEq = genericLiftEq -instance Ord1 Array where liftCompare = genericLiftCompare -instance Show1 Array where liftShowsPrec = genericLiftShowsPrec - --- | Class values. There will someday be a difference between classes and objects, --- but for the time being we're pretending all languages have prototypical inheritance. -data Class location value = Class - { _className :: Name - , _classScope :: Environment location - } deriving (Eq, Generic1, Ord, Show) - -instance Eq location => Eq1 (Class location) where liftEq = genericLiftEq -instance Ord location => Ord1 (Class location) where liftCompare = genericLiftCompare -instance Show location => Show1 (Class location) where liftShowsPrec = genericLiftShowsPrec - -data Namespace location value = Namespace - { namespaceName :: Name - , namespaceScope :: Environment location - } deriving (Eq, Generic1, Ord, Show) - -instance Eq location => Eq1 (Namespace location) where liftEq = genericLiftEq -instance Ord location => Ord1 (Namespace location) where liftCompare = genericLiftCompare -instance Show location => Show1 (Namespace location) where liftShowsPrec = genericLiftShowsPrec - -data KVPair value = KVPair value value - deriving (Eq, Generic1, Ord, Show) - -instance Eq1 KVPair where liftEq = genericLiftEq -instance Ord1 KVPair where liftCompare = genericLiftCompare -instance Show1 KVPair where liftShowsPrec = genericLiftShowsPrec - --- You would think this would be a @Map value value@ or a @[(value, value)]. --- You would be incorrect, as we can't derive a Generic1 instance for the above, --- and in addition a 'Map' representation would lose information given hash literals --- that assigned multiple values to one given key. Instead, this holds KVPair --- values. The smart constructor for hashes in 'AbstractValue' ensures that these are --- only populated with pairs. -newtype Hash value = Hash [value] - deriving (Eq, Generic1, Ord, Show) - -instance Eq1 Hash where liftEq = genericLiftEq -instance Ord1 Hash where liftCompare = genericLiftCompare -instance Show1 Hash where liftShowsPrec = genericLiftShowsPrec - -data Null value = Null - deriving (Eq, Generic1, Ord, Show) - -instance Eq1 Null where liftEq = genericLiftEq -instance Ord1 Null where liftCompare = genericLiftCompare -instance Show1 Null where liftShowsPrec = genericLiftShowsPrec - - instance Ord location => ValueRoots location (Value location) where valueRoots v - | Just (Closure _ _ _ _ env) <- prjValue v = Env.addresses env - | otherwise = mempty + | Closure _ _ _ _ env <- v = Env.addresses env + | otherwise = mempty instance AbstractHole (Value location) where - hole = injValue Hole + hole = Hole instance ( Members '[ Allocator location (Value location) , Reader (Environment location) @@ -222,11 +59,11 @@ instance ( Members '[ Allocator location (Value location) packageInfo <- currentPackage moduleInfo <- currentModule l <- label body - injValue . Closure packageInfo moduleInfo parameters l . Env.bind (foldr Set.delete freeVariables parameters) <$> getEnv + Closure packageInfo moduleInfo parameters l . Env.bind (foldr Set.delete freeVariables parameters) <$> getEnv call op params = do - case prjValue op of - Just (Closure packageInfo moduleInfo names label env) -> do + case op of + Closure packageInfo moduleInfo names label env -> do body <- goto label -- Evaluate the bindings and body with the closure’s package/module info in scope in order to -- charge them to the closure's origin. @@ -237,7 +74,7 @@ instance ( Members '[ Allocator location (Value location) assign a v Env.insert name a <$> rest) (pure env) (zip names params) localEnv (mergeEnvs bindings) (body `catchReturn` \ (Return value) -> pure value) - Nothing -> throwValueError (CallError op) + _ -> throwValueError (CallError op) -- | Construct a 'Value' wrapping the value arguments (if any). @@ -256,51 +93,51 @@ instance ( Members '[ Allocator location (Value location) , Show location ) => AbstractValue location (Value location) (Goto effects (Value location) ': effects) where - unit = pure . injValue $ Unit - integer = pure . injValue . Integer . Number.Integer - boolean = pure . injValue . Boolean - string = pure . injValue . String - float = pure . injValue . Float . Number.Decimal - symbol = pure . injValue . Symbol - rational = pure . injValue . Rational . Number.Ratio + unit = pure $ Unit + integer = pure . Integer . Number.Integer + boolean = pure . Boolean + string = pure . String + float = pure . Float . Number.Decimal + symbol = pure . Symbol + rational = pure . Rational . Number.Ratio - multiple = pure . injValue . Tuple - array = pure . injValue . Array + multiple = pure . Tuple + array = pure . Array - kvPair k = pure . injValue . KVPair k + kvPair k = pure . KVPair k - null = pure . injValue $ Null + null = pure $ Null asPair val - | Just (KVPair k v) <- prjValue val = pure (k, v) + | KVPair k v <- val = pure (k, v) | otherwise = throwValueError $ KeyValueError val - hash = pure . injValue . Hash . fmap (injValue . uncurry KVPair) + hash = pure . Hash . map (uncurry KVPair) - klass n [] env = pure . injValue $ Class n env + klass n [] env = pure $ Class n env klass n supers env = do product <- foldl mergeEnvs emptyEnv . catMaybes <$> traverse scopedEnvironment supers - pure . injValue $ Class n (mergeEnvs product env) + pure $ Class n (mergeEnvs product env) namespace n env = do maybeAddr <- lookupEnv n env' <- maybe (pure emptyEnv) (asNamespaceEnv <=< deref) maybeAddr - pure (injValue (Namespace n (Env.mergeNewer env' env))) + pure (Namespace n (Env.mergeNewer env' env)) where asNamespaceEnv v - | Just (Namespace _ env') <- prjValue v = pure env' - | otherwise = throwValueError $ NamespaceError ("expected " <> show v <> " to be a namespace") + | Namespace _ env' <- v = pure env' + | otherwise = throwValueError $ NamespaceError ("expected " <> show v <> " to be a namespace") scopedEnvironment o - | Just (Class _ env) <- prjValue o = pure (Just env) - | Just (Namespace _ env) <- prjValue o = pure (Just env) + | Class _ env <- o = pure (Just env) + | Namespace _ env <- o = pure (Just env) | otherwise = pure Nothing asString v - | Just (String n) <- prjValue v = pure n - | otherwise = throwValueError $ StringError v + | String n <- v = pure n + | otherwise = throwValueError $ StringError v ifthenelse cond if' else' = do - bool <- maybe (throwValueError (BoolError cond)) (pure . getBoolean) (prjValue cond) + bool <- case cond of { Boolean b -> pure b ; _ -> throwValueError (BoolError cond) } if bool then if' else else' index = go where @@ -308,26 +145,26 @@ instance ( Members '[ Allocator location (Value location) | ii > genericLength list = throwValueError (BoundsError list ii) | otherwise = pure (genericIndex list ii) go arr idx - | (Just (Array arr, Integer (Number.Integer i))) <- prjPair (arr, idx) = tryIdx arr i - | (Just (Tuple tup, Integer (Number.Integer i))) <- prjPair (arr, idx) = tryIdx tup i + | (Array arr, Integer (Number.Integer i)) <- (arr, idx) = tryIdx arr i + | (Tuple tup, Integer (Number.Integer i)) <- (arr, idx) = tryIdx tup i | otherwise = throwValueError (IndexError arr idx) liftNumeric f arg - | Just (Integer (Number.Integer i)) <- prjValue arg = integer $ f i - | Just (Float (Number.Decimal d)) <- prjValue arg = float $ f d - | Just (Rational (Number.Ratio r)) <- prjValue arg = rational $ f r + | Integer (Number.Integer i) <- arg = integer $ f i + | Float (Number.Decimal d) <- arg = float $ f d + | Rational (Number.Ratio r) <- arg = rational $ f r | otherwise = throwValueError (NumericError arg) liftNumeric2 f left right - | Just (Integer i, Integer j) <- prjPair pair = tentative f i j & specialize - | Just (Integer i, Rational j) <- prjPair pair = tentative f i j & specialize - | Just (Integer i, Float j) <- prjPair pair = tentative f i j & specialize - | Just (Rational i, Integer j) <- prjPair pair = tentative f i j & specialize - | Just (Rational i, Rational j) <- prjPair pair = tentative f i j & specialize - | Just (Rational i, Float j) <- prjPair pair = tentative f i j & specialize - | Just (Float i, Integer j) <- prjPair pair = tentative f i j & specialize - | Just (Float i, Rational j) <- prjPair pair = tentative f i j & specialize - | Just (Float i, Float j) <- prjPair pair = tentative f i j & specialize + | (Integer i, Integer j) <- pair = tentative f i j & specialize + | (Integer i, Rational j) <- pair = tentative f i j & specialize + | (Integer i, Float j) <- pair = tentative f i j & specialize + | (Rational i, Integer j) <- pair = tentative f i j & specialize + | (Rational i, Rational j) <- pair = tentative f i j & specialize + | (Rational i, Float j) <- pair = tentative f i j & specialize + | (Float i, Integer j) <- pair = tentative f i j & specialize + | (Float i, Rational j) <- pair = tentative f i j & specialize + | (Float i, Float j) <- pair = tentative f i j & specialize | otherwise = throwValueError (Numeric2Error left right) where tentative x i j = attemptUnsafeArithmetic (x i j) @@ -341,13 +178,13 @@ instance ( Members '[ Allocator location (Value location) pair = (left, right) liftComparison comparator left right - | Just (Integer (Number.Integer i), Integer (Number.Integer j)) <- prjPair pair = go i j - | Just (Integer (Number.Integer i), Float (Number.Decimal j)) <- prjPair pair = go (fromIntegral i) j - | Just (Float (Number.Decimal i), Integer (Number.Integer j)) <- prjPair pair = go i (fromIntegral j) - | Just (Float (Number.Decimal i), Float (Number.Decimal j)) <- prjPair pair = go i j - | Just (String i, String j) <- prjPair pair = go i j - | Just (Boolean i, Boolean j) <- prjPair pair = go i j - | Just (Unit, Unit) <- prjPair pair = boolean True + | (Integer (Number.Integer i), Integer (Number.Integer j)) <- pair = go i j + | (Integer (Number.Integer i), Float (Number.Decimal j)) <- pair = go (fromIntegral i) j + | (Float (Number.Decimal i), Integer (Number.Integer j)) <- pair = go i (fromIntegral j) + | (Float (Number.Decimal i), Float (Number.Decimal j)) <- pair = go i j + | (String i, String j) <- pair = go i j + | (Boolean i, Boolean j) <- pair = go i j + | (Unit, Unit) <- pair = boolean True | otherwise = throwValueError (ComparisonError left right) where -- Explicit type signature is necessary here because we're passing all sorts of things @@ -365,11 +202,11 @@ instance ( Members '[ Allocator location (Value location) liftBitwise operator target - | Just (Integer (Number.Integer i)) <- prjValue target = integer $ operator i + | Integer (Number.Integer i) <- target = integer $ operator i | otherwise = throwValueError (BitwiseError target) liftBitwise2 operator left right - | Just (Integer (Number.Integer i), Integer (Number.Integer j)) <- prjPair pair = integer $ operator i j + | (Integer (Number.Integer i), Integer (Number.Integer j)) <- pair = integer $ operator i j | otherwise = throwValueError (Bitwise2Error left right) where pair = (left, right) From ea94863148e1289daf81e7ffc0a9eb8cbb63a647 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 08:35:33 -0400 Subject: [PATCH 025/148] Fix a couple of hints. --- src/Data/Abstract/Value.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index a585dc7c4..107140d92 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -93,7 +93,7 @@ instance ( Members '[ Allocator location (Value location) , Show location ) => AbstractValue location (Value location) (Goto effects (Value location) ': effects) where - unit = pure $ Unit + unit = pure Unit integer = pure . Integer . Number.Integer boolean = pure . Boolean string = pure . String @@ -106,7 +106,7 @@ instance ( Members '[ Allocator location (Value location) kvPair k = pure . KVPair k - null = pure $ Null + null = pure Null asPair val | KVPair k v <- val = pure (k, v) From 2993c3588c67368a6bdfe019285803b94fca07e0 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 08:54:33 -0400 Subject: [PATCH 026/148] Correct the specs. --- test/Analysis/Python/Spec.hs | 6 +++--- test/Analysis/Ruby/Spec.hs | 22 +++++++++++----------- test/Analysis/TypeScript/Spec.hs | 2 +- test/Control/Abstract/Evaluator/Spec.hs | 4 ++-- test/SpecHelpers.hs | 11 ++++++++--- 5 files changed, 25 insertions(+), 20 deletions(-) diff --git a/test/Analysis/Python/Spec.hs b/test/Analysis/Python/Spec.hs index ae517e19b..657382f34 100644 --- a/test/Analysis/Python/Spec.hs +++ b/test/Analysis/Python/Spec.hs @@ -37,14 +37,14 @@ spec = parallel $ do it "subclasses" $ do ((res, _), _) <- evaluate "subclass.py" - res `shouldBe` Right [injValue (String "\"bar\"")] + res `shouldBe` Right [String "\"bar\""] it "handles multiple inheritance left-to-right" $ do ((res, _), _) <- evaluate "multiple_inheritance.py" - res `shouldBe` Right [injValue (String "\"foo!\"")] + res `shouldBe` Right [String "\"foo!\""] where - ns n = Just . Latest . Last . Just . injValue . Namespace n + ns n = Just . Latest . Last . Just . Namespace n addr = Address . Precise fixtures = "test/fixtures/python/analysis/" evaluate entry = evalPythonProject (fixtures <> entry) diff --git a/test/Analysis/Ruby/Spec.hs b/test/Analysis/Ruby/Spec.hs index 7ede7371f..af5512099 100644 --- a/test/Analysis/Ruby/Spec.hs +++ b/test/Analysis/Ruby/Spec.hs @@ -22,7 +22,7 @@ spec = parallel $ do describe "Ruby" $ do it "evaluates require_relative" $ do ((res, state), _) <- evaluate "main.rb" - res `shouldBe` Right [injValue (Value.Integer (Number.Integer 1))] + res `shouldBe` Right [Value.Integer (Number.Integer 1)] Env.names (environment state) `shouldContain` ["foo"] it "evaluates load" $ do @@ -36,47 +36,47 @@ spec = parallel $ do it "evaluates subclass" $ do ((res, state), _) <- evaluate "subclass.rb" - res `shouldBe` Right [injValue (String "\"\"")] + res `shouldBe` Right [String "\"\""] Env.names (environment state) `shouldContain` [ "Bar", "Foo" ] (derefQName (heap state) ("Bar" :| []) (environment state) >>= deNamespace) `shouldBe` Just ("Bar", ["baz", "foo", "inspect"]) it "evaluates modules" $ do ((res, state), _) <- evaluate "modules.rb" - res `shouldBe` Right [injValue (String "\"\"")] + res `shouldBe` Right [String "\"\""] Env.names (environment state) `shouldContain` [ "Bar" ] it "handles break correctly" $ do ((res, _), _) <- evaluate "break.rb" - res `shouldBe` Right [injValue (Value.Integer (Number.Integer 3))] + res `shouldBe` Right [Value.Integer (Number.Integer 3)] it "handles break correctly" $ do ((res, _), _) <- evaluate "next.rb" - res `shouldBe` Right [injValue (Value.Integer (Number.Integer 8))] + res `shouldBe` Right [Value.Integer (Number.Integer 8)] it "calls functions with arguments" $ do ((res, _), _) <- evaluate "call.rb" - res `shouldBe` Right [injValue (Value.Integer (Number.Integer 579))] + res `shouldBe` Right [Value.Integer (Number.Integer 579)] it "evaluates early return statements" $ do ((res, _), _) <- evaluate "early-return.rb" - res `shouldBe` Right [injValue (Value.Integer (Number.Integer 123))] + res `shouldBe` Right [Value.Integer (Number.Integer 123)] it "has prelude" $ do ((res, _), _) <- evaluate "preluded.rb" - res `shouldBe` Right [injValue (String "\"\"")] + res `shouldBe` Right [String "\"\""] it "evaluates __LINE__" $ do ((res, _), _) <- evaluate "line.rb" - res `shouldBe` Right [injValue (Value.Integer (Number.Integer 4))] + res `shouldBe` Right [Value.Integer (Number.Integer 4)] it "resolves builtins used in the prelude" $ do ((res, _), traces) <- evaluate "puts.rb" - res `shouldBe` Right [injValue Unit] + res `shouldBe` Right [Unit] traces `shouldContain` [ "\"hello\"" ] where - ns n = Just . Latest . Last . Just . injValue . Namespace n + ns n = Just . Latest . Last . Just . Namespace n addr = Address . Precise fixtures = "test/fixtures/ruby/analysis/" evaluate entry = evalRubyProject (fixtures <> entry) diff --git a/test/Analysis/TypeScript/Spec.hs b/test/Analysis/TypeScript/Spec.hs index 7558aa681..b53a93509 100644 --- a/test/Analysis/TypeScript/Spec.hs +++ b/test/Analysis/TypeScript/Spec.hs @@ -36,7 +36,7 @@ spec = parallel $ do it "evaluates early return statements" $ do ((res, _), _) <- evaluate "early-return.ts" - res `shouldBe` Right [injValue (Value.Float (Number.Decimal 123.0))] + res `shouldBe` Right [Value.Float (Number.Decimal 123.0)] where fixtures = "test/fixtures/typescript/analysis/" diff --git a/test/Control/Abstract/Evaluator/Spec.hs b/test/Control/Abstract/Evaluator/Spec.hs index 1c6a07744..b778beb9b 100644 --- a/test/Control/Abstract/Evaluator/Spec.hs +++ b/test/Control/Abstract/Evaluator/Spec.hs @@ -20,13 +20,13 @@ spec :: Spec spec = parallel $ do it "constructs integers" $ do (expected, _) <- evaluate (integer 123) - expected `shouldBe` Right (injValue (Value.Integer (Number.Integer 123))) + expected `shouldBe` Right (Value.Integer (Number.Integer 123)) it "calls functions" $ do (expected, _) <- evaluate $ do identity <- closure [name "x"] lowerBound (variable (name "x")) call identity [integer 123] - expected `shouldBe` Right (injValue (Value.Integer (Number.Integer 123))) + expected `shouldBe` Right (Value.Integer (Number.Integer 123)) evaluate = runM diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs index 9df506259..777f207c1 100644 --- a/test/SpecHelpers.hs +++ b/test/SpecHelpers.hs @@ -24,7 +24,7 @@ import Data.Abstract.FreeVariables as X import Data.Abstract.Heap as X import Data.Abstract.ModuleTable as X hiding (lookup) import Data.Abstract.Name as X -import Data.Abstract.Value (Namespace(..), Value, ValueError, injValue, prjValue, runValueError) +import Data.Abstract.Value (Value(..), ValueError, runValueError) import Data.Bifunctor (first) import Data.Blob as X import Data.ByteString.Builder (toLazyByteString) @@ -92,13 +92,18 @@ testEvaluating . runTermEvaluator @_ @Precise deNamespace :: Value Precise -> Maybe (Name, [Name]) -deNamespace = fmap (namespaceName &&& Env.names . namespaceScope) . prjValue @(Namespace Precise) +deNamespace (Namespace name scope) = Just (name, Env.names scope) +deNamespace _ = Nothing + +namespaceScope :: Value Precise -> Maybe (Environment Precise) +namespaceScope (Namespace _ scope) = Just scope +namespaceScope _ = Nothing derefQName :: Heap Precise (Cell Precise) (Value Precise) -> NonEmpty Name -> Environment Precise -> Maybe (Value Precise) derefQName heap = go where go (n1 :| ns) env = Env.lookup n1 env >>= flip heapLookup heap >>= getLast . unLatest >>= case ns of [] -> Just - (n2 : ns) -> fmap namespaceScope . prjValue @(Namespace Precise) >=> go (n2 :| ns) + (n2 : ns) -> namespaceScope >=> go (n2 :| ns) newtype Verbatim = Verbatim ByteString deriving (Eq) From a2135fda745f6c106aacdc9cca61cc96f44aaabe Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 09:35:03 -0400 Subject: [PATCH 027/148] =?UTF-8?q?Don=E2=80=99t=20use=20overloaded=20list?= =?UTF-8?q?s.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- test/Analysis/Go/Spec.hs | 1 - test/Analysis/PHP/Spec.hs | 1 - test/Analysis/Python/Spec.hs | 1 - test/Analysis/Ruby/Spec.hs | 2 -- test/Analysis/TypeScript/Spec.hs | 1 - 5 files changed, 6 deletions(-) diff --git a/test/Analysis/Go/Spec.hs b/test/Analysis/Go/Spec.hs index b42873e2f..d4fd89898 100644 --- a/test/Analysis/Go/Spec.hs +++ b/test/Analysis/Go/Spec.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedLists #-} module Analysis.Go.Spec (spec) where import Data.Abstract.Environment as Env diff --git a/test/Analysis/PHP/Spec.hs b/test/Analysis/PHP/Spec.hs index 84d785845..c4c12a19e 100644 --- a/test/Analysis/PHP/Spec.hs +++ b/test/Analysis/PHP/Spec.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedLists #-} module Analysis.PHP.Spec (spec) where import Data.Abstract.Environment as Env diff --git a/test/Analysis/Python/Spec.hs b/test/Analysis/Python/Spec.hs index 657382f34..b8f282187 100644 --- a/test/Analysis/Python/Spec.hs +++ b/test/Analysis/Python/Spec.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedLists, OverloadedStrings #-} module Analysis.Python.Spec (spec) where import Data.Abstract.Environment as Env diff --git a/test/Analysis/Ruby/Spec.hs b/test/Analysis/Ruby/Spec.hs index af5512099..0e1498cac 100644 --- a/test/Analysis/Ruby/Spec.hs +++ b/test/Analysis/Ruby/Spec.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE OverloadedLists #-} - module Analysis.Ruby.Spec (spec) where import Data.Abstract.Environment as Env diff --git a/test/Analysis/TypeScript/Spec.hs b/test/Analysis/TypeScript/Spec.hs index b53a93509..bb5a29b5b 100644 --- a/test/Analysis/TypeScript/Spec.hs +++ b/test/Analysis/TypeScript/Spec.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE OverloadedLists #-} module Analysis.TypeScript.Spec (spec) where import Control.Arrow ((&&&)) From 015b74cf4152712683f7babb1b9cb72e8bb2e5be Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 09:35:42 -0400 Subject: [PATCH 028/148] Give Value a term type parameter once more. --- src/Data/Abstract/Value.hs | 84 ++++++++++++------------- src/Semantic/Graph.hs | 8 +-- src/Semantic/Util.hs | 4 +- test/Analysis/Go/Spec.hs | 6 +- test/Analysis/PHP/Spec.hs | 6 +- test/Analysis/Python/Spec.hs | 2 +- test/Analysis/Ruby/Spec.hs | 4 +- test/Analysis/TypeScript/Spec.hs | 2 +- test/Control/Abstract/Evaluator/Spec.hs | 4 +- test/SpecHelpers.hs | 8 +-- 10 files changed, 64 insertions(+), 64 deletions(-) diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 107140d92..1adee18cc 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -13,7 +13,7 @@ import Data.Semigroup.Reducer import qualified Data.Set as Set import Prologue -data Value location +data Value location term = Closure PackageInfo ModuleInfo [Name] Label (Environment location) | Unit | Boolean Bool @@ -22,39 +22,39 @@ data Value location | Float (Number.Number Scientific) | String ByteString | Symbol ByteString - | Tuple [Value location] - | Array [Value location] + | Tuple [Value location term] + | Array [Value location term] | Class Name (Environment location) | Namespace Name (Environment location) - | KVPair (Value location) (Value location) - | Hash [Value location] + | KVPair (Value location term) (Value location term) + | Hash [Value location term] | Null | Hole deriving (Eq, Show, Ord) -instance Ord location => ValueRoots location (Value location) where +instance Ord location => ValueRoots location (Value location term) where valueRoots v | Closure _ _ _ _ env <- v = Env.addresses env | otherwise = mempty -instance AbstractHole (Value location) where +instance AbstractHole (Value location term) where hole = Hole -instance ( Members '[ Allocator location (Value location) +instance ( Members '[ Allocator location (Value location term) , Reader (Environment location) , Reader ModuleInfo , Reader PackageInfo - , Resumable (ValueError location) - , Return (Value location) + , Resumable (ValueError location term) + , Return (Value location term) , State (Environment location) - , State (Heap location (Cell location) (Value location)) + , State (Heap location (Cell location) (Value location term)) ] effects , Ord location - , Reducer (Value location) (Cell location (Value location)) + , Reducer (Value location term) (Cell location (Value location term)) , Show location ) - => AbstractFunction location (Value location) (Goto effects (Value location) ': effects) where + => AbstractFunction location (Value location term) (Goto effects (Value location term) ': effects) where closure parameters freeVariables body = do packageInfo <- currentPackage moduleInfo <- currentModule @@ -78,21 +78,21 @@ instance ( Members '[ Allocator location (Value location) -- | Construct a 'Value' wrapping the value arguments (if any). -instance ( Members '[ Allocator location (Value location) - , LoopControl (Value location) +instance ( Members '[ Allocator location (Value location term) + , LoopControl (Value location term) , Reader (Environment location) , Reader ModuleInfo , Reader PackageInfo - , Resumable (ValueError location) - , Return (Value location) + , Resumable (ValueError location term) + , Return (Value location term) , State (Environment location) - , State (Heap location (Cell location) (Value location)) + , State (Heap location (Cell location) (Value location term)) ] effects , Ord location - , Reducer (Value location) (Cell location (Value location)) + , Reducer (Value location term) (Cell location (Value location term)) , Show location ) - => AbstractValue location (Value location) (Goto effects (Value location) ': effects) where + => AbstractValue location (Value location term) (Goto effects (Value location term) ': effects) where unit = pure Unit integer = pure . Integer . Number.Integer boolean = pure . Boolean @@ -170,7 +170,7 @@ instance ( Members '[ Allocator location (Value location) tentative x i j = attemptUnsafeArithmetic (x i j) -- Dispatch whatever's contained inside a 'Number.SomeNumber' to its appropriate 'MonadValue' ctor - specialize :: (AbstractValue location (Value location) effects, Member (Resumable (ValueError location)) effects) => Either ArithException Number.SomeNumber -> Evaluator location (Value location) effects (Value location) + specialize :: (AbstractValue location (Value location term) effects, Member (Resumable (ValueError location term)) effects) => Either ArithException Number.SomeNumber -> Evaluator location (Value location term) effects (Value location term) specialize (Left exc) = throwValueError (ArithmeticError exc) specialize (Right (Number.SomeNumber (Number.Integer i))) = integer i specialize (Right (Number.SomeNumber (Number.Ratio r))) = rational r @@ -189,7 +189,7 @@ instance ( Members '[ Allocator location (Value location) where -- Explicit type signature is necessary here because we're passing all sorts of things -- to these comparison functions. - go :: (AbstractValue location (Value location) effects, Ord a) => a -> a -> Evaluator location (Value location) effects (Value location) + go :: (AbstractValue location (Value location term) effects, Ord a) => a -> a -> Evaluator location (Value location term) effects (Value location term) go l r = case comparator of Concrete f -> boolean (f l r) Generalized -> integer (orderingToInt (compare l r)) @@ -217,25 +217,25 @@ instance ( Members '[ Allocator location (Value location) -- | The type of exceptions that can be thrown when constructing values in 'Value'’s 'MonadValue' instance. -data ValueError location resume where - StringError :: Value location -> ValueError location ByteString - BoolError :: Value location -> ValueError location Bool - IndexError :: Value location -> Value location -> ValueError location (Value location) - NamespaceError :: Prelude.String -> ValueError location (Environment location) - CallError :: Value location -> ValueError location (Value location) - NumericError :: Value location -> ValueError location (Value location) - Numeric2Error :: Value location -> Value location -> ValueError location (Value location) - ComparisonError :: Value location -> Value location -> ValueError location (Value location) - BitwiseError :: Value location -> ValueError location (Value location) - Bitwise2Error :: Value location -> Value location -> ValueError location (Value location) - KeyValueError :: Value location -> ValueError location (Value location, Value location) +data ValueError location term resume where + StringError :: Value location term -> ValueError location term ByteString + BoolError :: Value location term -> ValueError location term Bool + IndexError :: Value location term -> Value location term -> ValueError location term (Value location term) + NamespaceError :: Prelude.String -> ValueError location term (Environment location) + CallError :: Value location term -> ValueError location term (Value location term) + NumericError :: Value location term -> ValueError location term (Value location term) + Numeric2Error :: Value location term -> Value location term -> ValueError location term (Value location term) + ComparisonError :: Value location term -> Value location term -> ValueError location term (Value location term) + BitwiseError :: Value location term -> ValueError location term (Value location term) + Bitwise2Error :: Value location term -> Value location term -> ValueError location term (Value location term) + KeyValueError :: Value location term -> ValueError location term (Value location term, Value location term) -- Indicates that we encountered an arithmetic exception inside Haskell-native number crunching. - ArithmeticError :: ArithException -> ValueError location (Value location) + ArithmeticError :: ArithException -> ValueError location term (Value location term) -- Out-of-bounds error - BoundsError :: [Value location] -> Prelude.Integer -> ValueError location (Value location) + BoundsError :: [Value location term] -> Prelude.Integer -> ValueError location term (Value location term) -instance Eq location => Eq1 (ValueError location) where +instance Eq location => Eq1 (ValueError location term) where liftEq _ (StringError a) (StringError b) = a == b liftEq _ (NamespaceError a) (NamespaceError b) = a == b liftEq _ (CallError a) (CallError b) = a == b @@ -249,15 +249,15 @@ instance Eq location => Eq1 (ValueError location) where liftEq _ (BoundsError a b) (BoundsError c d) = (a == c) && (b == d) liftEq _ _ _ = False -deriving instance Show location => Show (ValueError location resume) -instance Show location => Show1 (ValueError location) where +deriving instance Show location => Show (ValueError location term resume) +instance Show location => Show1 (ValueError location term) where liftShowsPrec _ _ = showsPrec -throwValueError :: Member (Resumable (ValueError location)) effects => ValueError location resume -> Evaluator location (Value location) effects resume +throwValueError :: Member (Resumable (ValueError location term)) effects => ValueError location term resume -> Evaluator location (Value location term) effects resume throwValueError = throwResumable -runValueError :: Effectful (m location (Value location)) => m location (Value location) (Resumable (ValueError location) ': effects) a -> m location (Value location) effects (Either (SomeExc (ValueError location)) a) +runValueError :: Effectful (m location (Value location term)) => m location (Value location term) (Resumable (ValueError location term) ': effects) a -> m location (Value location term) effects (Either (SomeExc (ValueError location term)) a) runValueError = runResumable -runValueErrorWith :: Effectful (m location (Value location)) => (forall resume . ValueError location resume -> m location (Value location) effects resume) -> m location (Value location) (Resumable (ValueError location) ': effects) a -> m location (Value location) effects a +runValueErrorWith :: Effectful (m location (Value location term)) => (forall resume . ValueError location term resume -> m location (Value location term) effects resume) -> m location (Value location term) (Resumable (ValueError location term) ': effects) a -> m location (Value location term) effects a runValueErrorWith = runResumableWith diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 7a0e5acde..684177422 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -62,13 +62,13 @@ runGraph graphType includePackages project . runIgnoringTrace . resumingLoadError . resumingUnspecialized - . resumingValueError . resumingEnvironmentError . resumingEvalError . resumingResolutionError . resumingAddressError + . runTermEvaluator @_ @_ @(Value (Located Precise) _) + . resumingValueError . graphing - . runTermEvaluator @_ @_ @(Value (Located Precise)) -- | Parse a list of files into a 'Package'. parsePackage :: Members '[Distribute WrappedTask, Files, Resolution, Task, Trace] effs @@ -129,7 +129,7 @@ resumingAddressError = runAddressErrorWith (\ err -> trace ("AddressError:" <> s UnallocatedAddress _ -> pure lowerBound UninitializedAddress _ -> pure hole) -resumingValueError :: (Members '[State (Environment location), Trace] effects, Show location) => Evaluator location (Value location) (Resumable (ValueError location) ': effects) a -> Evaluator location (Value location) effects a +resumingValueError :: (Members '[State (Environment location), Trace] effects, Show location) => TermEvaluator term location (Value location term) (Resumable (ValueError location term) ': effects) a -> TermEvaluator term location (Value location term) effects a resumingValueError = runValueErrorWith (\ err -> trace ("ValueError" <> show err) *> case err of CallError val -> pure val StringError val -> pure (pack (show val)) @@ -139,7 +139,7 @@ resumingValueError = runValueErrorWith (\ err -> trace ("ValueError" <> show err NumericError{} -> pure hole Numeric2Error{} -> pure hole ComparisonError{} -> pure hole - NamespaceError{} -> getEnv + NamespaceError{} -> TermEvaluator getEnv BitwiseError{} -> pure hole Bitwise2Error{} -> pure hole KeyValueError{} -> pure (hole, hole) diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 522ad0836..3a5c1fab0 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -39,13 +39,13 @@ justEvaluating . evaluating . runPrintingTrace . runLoadError - . runValueError . runUnspecialized . runResolutionError . runEnvironmentError . runEvalError . runAddressError . runTermEvaluator @_ @Precise + . runValueError evaluatingWithHoles = runM @@ -53,12 +53,12 @@ evaluatingWithHoles . runPrintingTrace . resumingLoadError . resumingUnspecialized - . resumingValueError . resumingEnvironmentError . resumingEvalError . resumingResolutionError . resumingAddressError . runTermEvaluator @_ @Precise + . resumingValueError checking = runM @_ @IO diff --git a/test/Analysis/Go/Spec.hs b/test/Analysis/Go/Spec.hs index d4fd89898..01cb1718d 100644 --- a/test/Analysis/Go/Spec.hs +++ b/test/Analysis/Go/Spec.hs @@ -2,9 +2,9 @@ module Analysis.Go.Spec (spec) where import Data.Abstract.Environment as Env import Data.Abstract.Evaluatable (EvalError(..)) -import qualified Language.Go.Assignment as Go +import Data.Abstract.Value import qualified Data.Language as Language - +import qualified Language.Go.Assignment as Go import SpecHelpers @@ -26,4 +26,4 @@ spec = parallel $ do where fixtures = "test/fixtures/go/analysis/" evaluate entry = evalGoProject (fixtures <> entry) - evalGoProject path = testEvaluating <$> evaluateProject goParser Language.Go Nothing path + evalGoProject path = testEvaluating . runTermEvaluator @_ @_ @(Value Precise Go.Term) <$> evaluateProject goParser Language.Go Nothing path diff --git a/test/Analysis/PHP/Spec.hs b/test/Analysis/PHP/Spec.hs index c4c12a19e..1417db94f 100644 --- a/test/Analysis/PHP/Spec.hs +++ b/test/Analysis/PHP/Spec.hs @@ -2,9 +2,9 @@ module Analysis.PHP.Spec (spec) where import Data.Abstract.Environment as Env import Data.Abstract.Evaluatable (EvalError(..)) -import qualified Language.PHP.Assignment as PHP +import Data.Abstract.Value import qualified Data.Language as Language - +import qualified Language.PHP.Assignment as PHP import SpecHelpers @@ -30,4 +30,4 @@ spec = parallel $ do where fixtures = "test/fixtures/php/analysis/" evaluate entry = evalPHPProject (fixtures <> entry) - evalPHPProject path = testEvaluating <$> evaluateProject phpParser Language.PHP Nothing path + evalPHPProject path = testEvaluating . runTermEvaluator @_ @_ @(Value Precise PHP.Term) <$> evaluateProject phpParser Language.PHP Nothing path diff --git a/test/Analysis/Python/Spec.hs b/test/Analysis/Python/Spec.hs index b8f282187..b13b468a0 100644 --- a/test/Analysis/Python/Spec.hs +++ b/test/Analysis/Python/Spec.hs @@ -47,4 +47,4 @@ spec = parallel $ do addr = Address . Precise fixtures = "test/fixtures/python/analysis/" evaluate entry = evalPythonProject (fixtures <> entry) - evalPythonProject path = testEvaluating <$> evaluateProject pythonParser Language.Python pythonPrelude path + evalPythonProject path = testEvaluating . runTermEvaluator @_ @_ @(Value Precise Python.Term) <$> evaluateProject pythonParser Language.Python pythonPrelude path diff --git a/test/Analysis/Ruby/Spec.hs b/test/Analysis/Ruby/Spec.hs index 0e1498cac..1bcfa99e1 100644 --- a/test/Analysis/Ruby/Spec.hs +++ b/test/Analysis/Ruby/Spec.hs @@ -29,7 +29,7 @@ spec = parallel $ do it "evaluates load with wrapper" $ do ((res, state), _) <- evaluate "load-wrap.rb" - res `shouldBe` Left (SomeExc (inject @(EnvironmentError (Value Precise)) (FreeVariable "foo"))) + res `shouldBe` Left (SomeExc (inject @(EnvironmentError (Value Precise Ruby.Term)) (FreeVariable "foo"))) Env.names (environment state) `shouldContain` [ "Object" ] it "evaluates subclass" $ do @@ -78,4 +78,4 @@ spec = parallel $ do addr = Address . Precise fixtures = "test/fixtures/ruby/analysis/" evaluate entry = evalRubyProject (fixtures <> entry) - evalRubyProject path = testEvaluating <$> evaluateProject rubyParser Language.Ruby rubyPrelude path + evalRubyProject path = testEvaluating . runTermEvaluator @_ @_ @(Value Precise Ruby.Term) <$> evaluateProject rubyParser Language.Ruby rubyPrelude path diff --git a/test/Analysis/TypeScript/Spec.hs b/test/Analysis/TypeScript/Spec.hs index bb5a29b5b..9e91a3a33 100644 --- a/test/Analysis/TypeScript/Spec.hs +++ b/test/Analysis/TypeScript/Spec.hs @@ -40,4 +40,4 @@ spec = parallel $ do where fixtures = "test/fixtures/typescript/analysis/" evaluate entry = evalTypeScriptProject (fixtures <> entry) - evalTypeScriptProject path = testEvaluating <$> evaluateProject typescriptParser Language.TypeScript Nothing path + evalTypeScriptProject path = testEvaluating . runTermEvaluator @_ @_ @(Value Precise TypeScript.Term) <$> evaluateProject typescriptParser Language.TypeScript Nothing path diff --git a/test/Control/Abstract/Evaluator/Spec.hs b/test/Control/Abstract/Evaluator/Spec.hs index b778beb9b..e45311872 100644 --- a/test/Control/Abstract/Evaluator/Spec.hs +++ b/test/Control/Abstract/Evaluator/Spec.hs @@ -31,7 +31,7 @@ spec = parallel $ do evaluate = runM . fmap (first reassociate) - . evaluating @Precise @(Value Precise) + . evaluating @Precise @(Value Precise ()) . runReader (PackageInfo (name "test") Nothing mempty) . runReader (ModuleInfo "test/Control/Abstract/Evaluator/Spec.hs") . Value.runValueError @@ -44,7 +44,7 @@ evaluate . runState (Gotos lowerBound) . runGoto Gotos getGotos -newtype Gotos effects = Gotos { getGotos :: GotoTable (State (Gotos effects) ': effects) (Value Precise) } +newtype Gotos effects = Gotos { getGotos :: GotoTable (State (Gotos effects) ': effects) (Value Precise ()) } reassociate :: Either Prelude.String (Either (SomeExc exc1) (Either (SomeExc exc2) (Either (SomeExc exc3) result))) -> Either (SomeExc (Sum '[Const Prelude.String, exc1, exc2, exc3])) result reassociate (Left s) = Left (SomeExc (inject (Const s))) diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs index 777f207c1..de40a3d11 100644 --- a/test/SpecHelpers.hs +++ b/test/SpecHelpers.hs @@ -8,6 +8,7 @@ module SpecHelpers , deNamespace , derefQName , verbatim +, TermEvaluator(..) , Verbatim(..) ) where @@ -89,17 +90,16 @@ testEvaluating . runEnvironmentError . runEvalError . runAddressError - . runTermEvaluator @_ @Precise -deNamespace :: Value Precise -> Maybe (Name, [Name]) +deNamespace :: Value Precise term -> Maybe (Name, [Name]) deNamespace (Namespace name scope) = Just (name, Env.names scope) deNamespace _ = Nothing -namespaceScope :: Value Precise -> Maybe (Environment Precise) +namespaceScope :: Value Precise term -> Maybe (Environment Precise) namespaceScope (Namespace _ scope) = Just scope namespaceScope _ = Nothing -derefQName :: Heap Precise (Cell Precise) (Value Precise) -> NonEmpty Name -> Environment Precise -> Maybe (Value Precise) +derefQName :: Heap Precise (Cell Precise) (Value Precise term) -> NonEmpty Name -> Environment Precise -> Maybe (Value Precise term) derefQName heap = go where go (n1 :| ns) env = Env.lookup n1 env >>= flip heapLookup heap >>= getLast . unLatest >>= case ns of [] -> Just From b888ff3d9e1aa9d6985b6e6a5395a53b57d06d77 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 09:45:40 -0400 Subject: [PATCH 029/148] Generalize runReturn & runLoopControl. --- src/Control/Abstract/Evaluator.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/Control/Abstract/Evaluator.hs b/src/Control/Abstract/Evaluator.hs index f8c623573..5e1b613bc 100644 --- a/src/Control/Abstract/Evaluator.hs +++ b/src/Control/Abstract/Evaluator.hs @@ -16,6 +16,7 @@ module Control.Abstract.Evaluator import Control.Monad.Effect as X import Control.Monad.Effect.Fresh as X +import Control.Monad.Effect.Internal import Control.Monad.Effect.NonDet as X import Control.Monad.Effect.Reader as X import Control.Monad.Effect.Resumable as X @@ -49,8 +50,8 @@ earlyReturn = send . Return catchReturn :: Member (Return value) effects => Evaluator location value effects a -> (forall x . Return value x -> Evaluator location value effects a) -> Evaluator location value effects a catchReturn action handler = interpose pure (\ ret _ -> handler ret) action -runReturn :: Evaluator location value (Return value ': effects) value -> Evaluator location value effects value -runReturn = relay pure (\ (Return value) _ -> pure value) +runReturn :: Effectful (m location value) => m location value (Return value ': effects) value -> m location value effects value +runReturn = raiseHandler (relay pure (\ (Return value) _ -> pure value)) -- | Effects for control flow around loops (breaking and continuing). @@ -70,7 +71,7 @@ throwContinue = send . Continue catchLoopControl :: Member (LoopControl value) effects => Evaluator location value effects a -> (forall x . LoopControl value x -> Evaluator location value effects a) -> Evaluator location value effects a catchLoopControl action handler = interpose pure (\ control _ -> handler control) action -runLoopControl :: Evaluator location value (LoopControl value ': effects) value -> Evaluator location value effects value -runLoopControl = relay pure (\ eff _ -> case eff of +runLoopControl :: Effectful (m location value) => m location value (LoopControl value ': effects) value -> m location value effects value +runLoopControl = raiseHandler (relay pure (\ eff _ -> case eff of Break value -> pure value - Continue value -> pure value) + Continue value -> pure value)) From ed8127d23dcede77a9b9fa735fb36b2b457ab5c5 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 09:49:45 -0400 Subject: [PATCH 030/148] Generalize runAllocator. --- src/Control/Abstract/Heap.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index 846b533c1..c8768bc49 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -22,6 +22,7 @@ module Control.Abstract.Heap import Control.Abstract.Addressable import Control.Abstract.Environment import Control.Abstract.Evaluator +import Control.Monad.Effect.Internal import Data.Abstract.Address import Data.Abstract.Environment import Data.Abstract.Heap @@ -120,10 +121,10 @@ data Allocator location value return where Alloc :: Name -> Allocator location value (Address location value) Deref :: Address location value -> Allocator location value value -runAllocator :: (Addressable location effects, Members '[Resumable (AddressError location value), State (Heap location (Cell location) value)] effects) => Evaluator location value (Allocator location value ': effects) a -> Evaluator location value effects a -runAllocator = interpret (\ eff -> case eff of - Alloc name -> Address <$> allocCell name - Deref addr -> heapLookup addr <$> get >>= maybeM (throwResumable (UnallocatedAddress addr)) >>= derefCell addr >>= maybeM (throwResumable (UninitializedAddress addr))) +runAllocator :: (Addressable location effects, Effectful (m location value), Members '[Resumable (AddressError location value), State (Heap location (Cell location) value)] effects) => m location value (Allocator location value ': effects) a -> m location value effects a +runAllocator = raiseHandler (interpret (\ eff -> case eff of + Alloc name -> lowerEff $ Address <$> allocCell name + Deref addr -> lowerEff $ heapLookup addr <$> get >>= maybeM (throwResumable (UnallocatedAddress addr)) >>= derefCell addr >>= maybeM (throwResumable (UninitializedAddress addr)))) data AddressError location value resume where From 49de5d3357be3b42fc935d2b5bc936f53086e10b Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 09:51:58 -0400 Subject: [PATCH 031/148] Generalize runGoto. --- src/Control/Abstract/Goto.hs | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/src/Control/Abstract/Goto.hs b/src/Control/Abstract/Goto.hs index 21d37aa4d..7e8b3bc2b 100644 --- a/src/Control/Abstract/Goto.hs +++ b/src/Control/Abstract/Goto.hs @@ -9,7 +9,7 @@ module Control.Abstract.Goto ) where import Control.Abstract.Evaluator -import Control.Monad.Effect (Eff) +import Control.Monad.Effect.Internal import qualified Data.IntMap as IntMap import Prelude hiding (fail) import Prologue @@ -54,24 +54,26 @@ data Goto effects value return where -- @ -- -- Callers can then evaluate the high-level 'Goto' effect by passing @Gotos@ and @getGotos@ to 'runGoto'. -runGoto :: Members '[ Fail - , Fresh - , State table - ] effects +runGoto :: ( Effectful (m location value) + , Members '[ Fail + , Fresh + , State table + ] effects + ) => (GotoTable effects value -> table) -> (table -> GotoTable effects value) - -> Evaluator location value (Goto effects value ': effects) a - -> Evaluator location value effects a -runGoto from to = interpret (\ goto -> do + -> m location value (Goto effects value ': effects) a + -> m location value effects a +runGoto from to = raiseHandler (interpret (\ goto -> do table <- to <$> getTable case goto of Label action -> do supremum <- fresh supremum <$ putTable (from (IntMap.insert supremum action table)) - Goto label -> maybeM (raiseEff (fail ("unknown label: " <> show label))) (IntMap.lookup label table)) + Goto label -> maybeM (raiseEff (fail ("unknown label: " <> show label))) (IntMap.lookup label table))) -getTable :: Member (State table) effects => Evaluator location value effects table +getTable :: (Effectful m, Member (State table) effects) => m effects table getTable = get -putTable :: Member (State table) effects => table -> Evaluator location value effects () +putTable :: (Effectful m, Member (State table) effects) => table -> m effects () putTable = put From a01e723b3190738eda8b93e550616fb617c99ce4 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 09:55:01 -0400 Subject: [PATCH 032/148] Run ValueErrors in TermEvaluator. --- src/Data/Abstract/Value.hs | 2 +- test/Analysis/Go/Spec.hs | 3 +-- test/Analysis/PHP/Spec.hs | 3 +-- test/Analysis/Python/Spec.hs | 2 +- test/Analysis/Ruby/Spec.hs | 5 +++-- test/Analysis/TypeScript/Spec.hs | 2 +- test/Control/Abstract/Evaluator/Spec.hs | 2 ++ test/SpecHelpers.hs | 3 ++- 8 files changed, 12 insertions(+), 10 deletions(-) diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 1adee18cc..e3af88ff3 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -256,7 +256,7 @@ instance Show location => Show1 (ValueError location term) where throwValueError :: Member (Resumable (ValueError location term)) effects => ValueError location term resume -> Evaluator location (Value location term) effects resume throwValueError = throwResumable -runValueError :: Effectful (m location (Value location term)) => m location (Value location term) (Resumable (ValueError location term) ': effects) a -> m location (Value location term) effects (Either (SomeExc (ValueError location term)) a) +runValueError :: TermEvaluator term location (Value location term) (Resumable (ValueError location term) ': effects) a -> TermEvaluator term location (Value location term) effects (Either (SomeExc (ValueError location term)) a) runValueError = runResumable runValueErrorWith :: Effectful (m location (Value location term)) => (forall resume . ValueError location term resume -> m location (Value location term) effects resume) -> m location (Value location term) (Resumable (ValueError location term) ': effects) a -> m location (Value location term) effects a diff --git a/test/Analysis/Go/Spec.hs b/test/Analysis/Go/Spec.hs index 01cb1718d..b0b43cd97 100644 --- a/test/Analysis/Go/Spec.hs +++ b/test/Analysis/Go/Spec.hs @@ -2,7 +2,6 @@ module Analysis.Go.Spec (spec) where import Data.Abstract.Environment as Env import Data.Abstract.Evaluatable (EvalError(..)) -import Data.Abstract.Value import qualified Data.Language as Language import qualified Language.Go.Assignment as Go import SpecHelpers @@ -26,4 +25,4 @@ spec = parallel $ do where fixtures = "test/fixtures/go/analysis/" evaluate entry = evalGoProject (fixtures <> entry) - evalGoProject path = testEvaluating . runTermEvaluator @_ @_ @(Value Precise Go.Term) <$> evaluateProject goParser Language.Go Nothing path + evalGoProject path = testEvaluating <$> evaluateProject goParser Language.Go Nothing path diff --git a/test/Analysis/PHP/Spec.hs b/test/Analysis/PHP/Spec.hs index 1417db94f..b5cc1a545 100644 --- a/test/Analysis/PHP/Spec.hs +++ b/test/Analysis/PHP/Spec.hs @@ -2,7 +2,6 @@ module Analysis.PHP.Spec (spec) where import Data.Abstract.Environment as Env import Data.Abstract.Evaluatable (EvalError(..)) -import Data.Abstract.Value import qualified Data.Language as Language import qualified Language.PHP.Assignment as PHP import SpecHelpers @@ -30,4 +29,4 @@ spec = parallel $ do where fixtures = "test/fixtures/php/analysis/" evaluate entry = evalPHPProject (fixtures <> entry) - evalPHPProject path = testEvaluating . runTermEvaluator @_ @_ @(Value Precise PHP.Term) <$> evaluateProject phpParser Language.PHP Nothing path + evalPHPProject path = testEvaluating <$> evaluateProject phpParser Language.PHP Nothing path diff --git a/test/Analysis/Python/Spec.hs b/test/Analysis/Python/Spec.hs index b13b468a0..b8f282187 100644 --- a/test/Analysis/Python/Spec.hs +++ b/test/Analysis/Python/Spec.hs @@ -47,4 +47,4 @@ spec = parallel $ do addr = Address . Precise fixtures = "test/fixtures/python/analysis/" evaluate entry = evalPythonProject (fixtures <> entry) - evalPythonProject path = testEvaluating . runTermEvaluator @_ @_ @(Value Precise Python.Term) <$> evaluateProject pythonParser Language.Python pythonPrelude path + evalPythonProject path = testEvaluating <$> evaluateProject pythonParser Language.Python pythonPrelude path diff --git a/test/Analysis/Ruby/Spec.hs b/test/Analysis/Ruby/Spec.hs index 1bcfa99e1..1f8b235cb 100644 --- a/test/Analysis/Ruby/Spec.hs +++ b/test/Analysis/Ruby/Spec.hs @@ -4,6 +4,7 @@ import Data.Abstract.Environment as Env import Data.Abstract.Evaluatable import Data.Abstract.Value as Value import Data.Abstract.Number as Number +import Data.AST import Control.Monad.Effect (SomeExc(..)) import Data.List.NonEmpty (NonEmpty(..)) import Data.Map @@ -29,7 +30,7 @@ spec = parallel $ do it "evaluates load with wrapper" $ do ((res, state), _) <- evaluate "load-wrap.rb" - res `shouldBe` Left (SomeExc (inject @(EnvironmentError (Value Precise Ruby.Term)) (FreeVariable "foo"))) + res `shouldBe` Left (SomeExc (inject @(EnvironmentError (Value Precise (Quieterm (Sum Ruby.Syntax) (Record Location)))) (FreeVariable "foo"))) Env.names (environment state) `shouldContain` [ "Object" ] it "evaluates subclass" $ do @@ -78,4 +79,4 @@ spec = parallel $ do addr = Address . Precise fixtures = "test/fixtures/ruby/analysis/" evaluate entry = evalRubyProject (fixtures <> entry) - evalRubyProject path = testEvaluating . runTermEvaluator @_ @_ @(Value Precise Ruby.Term) <$> evaluateProject rubyParser Language.Ruby rubyPrelude path + evalRubyProject path = testEvaluating <$> evaluateProject rubyParser Language.Ruby rubyPrelude path diff --git a/test/Analysis/TypeScript/Spec.hs b/test/Analysis/TypeScript/Spec.hs index 9e91a3a33..bb5a29b5b 100644 --- a/test/Analysis/TypeScript/Spec.hs +++ b/test/Analysis/TypeScript/Spec.hs @@ -40,4 +40,4 @@ spec = parallel $ do where fixtures = "test/fixtures/typescript/analysis/" evaluate entry = evalTypeScriptProject (fixtures <> entry) - evalTypeScriptProject path = testEvaluating . runTermEvaluator @_ @_ @(Value Precise TypeScript.Term) <$> evaluateProject typescriptParser Language.TypeScript Nothing path + evalTypeScriptProject path = testEvaluating <$> evaluateProject typescriptParser Language.TypeScript Nothing path diff --git a/test/Control/Abstract/Evaluator/Spec.hs b/test/Control/Abstract/Evaluator/Spec.hs index e45311872..9f083f977 100644 --- a/test/Control/Abstract/Evaluator/Spec.hs +++ b/test/Control/Abstract/Evaluator/Spec.hs @@ -34,7 +34,9 @@ evaluate . evaluating @Precise @(Value Precise ()) . runReader (PackageInfo (name "test") Nothing mempty) . runReader (ModuleInfo "test/Control/Abstract/Evaluator/Spec.hs") + . runTermEvaluator @() @Precise @(Value Precise ()) . Value.runValueError + . TermEvaluator @() @Precise @(Value Precise ()) . runEnvironmentError . runAddressError . runAllocator diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs index de40a3d11..834d3d7dc 100644 --- a/test/SpecHelpers.hs +++ b/test/SpecHelpers.hs @@ -84,12 +84,13 @@ testEvaluating . fmap (first reassociate) . evaluating . runLoadError - . runValueError . runUnspecialized . runResolutionError . runEnvironmentError . runEvalError . runAddressError + . runTermEvaluator @_ @_ @(Value Precise _) + . runValueError deNamespace :: Value Precise term -> Maybe (Name, [Name]) deNamespace (Namespace name scope) = Just (name, Env.names scope) From d7cc70ec063dd8c32639d2b860f31772cb1f06e6 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 10:04:53 -0400 Subject: [PATCH 033/148] Define a datatype naming builtins. --- src/Control/Abstract/Primitive.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index a557018b7..7d8eae830 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -13,6 +13,9 @@ import Data.Semigroup.Reducer hiding (unit) import Data.Semilattice.Lower import Prologue +data Builtin = Print + deriving (Eq, Ord, Show) + builtin :: ( HasCallStack , Members '[ Allocator location value , Reader (Environment location) From 46d871a98a6e3ab8404835d986d32d59cc3bec27 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 10:08:36 -0400 Subject: [PATCH 034/148] Define a helper to derive printable names from Builtins. --- src/Control/Abstract/Primitive.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 7d8eae830..f29c1ab73 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -9,6 +9,7 @@ import Control.Abstract.Value import Data.Abstract.Environment import Data.Abstract.Name import Data.ByteString.Char8 (pack, unpack) +import Data.Char import Data.Semigroup.Reducer hiding (unit) import Data.Semilattice.Lower import Prologue @@ -16,6 +17,12 @@ import Prologue data Builtin = Print deriving (Eq, Ord, Show) +builtinName :: Builtin -> Name +builtinName = name . pack . ("__semantic_" <>) . headToLower . show + where headToLower (c:cs) = toLower c : cs + headToLower "" = "" + + builtin :: ( HasCallStack , Members '[ Allocator location value , Reader (Environment location) From fd548475cfee06c12bc3f4b2f4c998f267d9f9e9 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 10:09:11 -0400 Subject: [PATCH 035/148] Define builtins using Builtin. --- src/Control/Abstract/Primitive.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index f29c1ab73..236b752d3 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -34,13 +34,13 @@ builtin :: ( HasCallStack , Ord location , Reducer value (Cell location value) ) - => String + => Builtin -> Evaluator location value effects value -> Evaluator location value effects () -builtin n def = withCurrentCallStack callStack $ do - let name' = name ("__semantic_" <> pack n) - addr <- alloc name' - modifyEnv (insert name' addr) +builtin b def = withCurrentCallStack callStack $ do + let name = builtinName b + addr <- alloc name + modifyEnv (insert name addr) def >>= assign addr lambda :: (AbstractFunction location value effects, Member Fresh effects) @@ -68,4 +68,4 @@ defineBuiltins :: ( AbstractValue location value effects ) => Evaluator location value effects () defineBuiltins = - builtin "print" (lambda lowerBound (\ v -> variable v >>= asString >>= trace . unpack >> unit)) + builtin Print (lambda lowerBound (\ v -> variable v >>= asString >>= trace . unpack >> unit)) From cb10c3decf72f3c9c75344a10eb9a2e2595ac287 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 10:09:30 -0400 Subject: [PATCH 036/148] Derive Bounded & Enum instances for Builtin. --- src/Control/Abstract/Primitive.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 236b752d3..857ede9c4 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -15,7 +15,7 @@ import Data.Semilattice.Lower import Prologue data Builtin = Print - deriving (Eq, Ord, Show) + deriving (Bounded, Enum, Eq, Ord, Show) builtinName :: Builtin -> Name builtinName = name . pack . ("__semantic_" <>) . headToLower . show From fc5600e23c760d3bb5ad84e996143b151bdd913b Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 10:40:44 -0400 Subject: [PATCH 037/148] Define a Primitive effect. --- src/Control/Abstract/Primitive.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 857ede9c4..47c567b0d 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE GADTs #-} module Control.Abstract.Primitive where import Control.Abstract.Addressable @@ -69,3 +70,7 @@ defineBuiltins :: ( AbstractValue location value effects => Evaluator location value effects () defineBuiltins = builtin Print (lambda lowerBound (\ v -> variable v >>= asString >>= trace . unpack >> unit)) + + +data Primitive value result where + Prim :: Builtin -> Primitive value value From aea17bb2ec29d5d40a23fd420c85f6f26d30a18e Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 10:43:00 -0400 Subject: [PATCH 038/148] Define a handler for Primitive effects. --- src/Control/Abstract/Primitive.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 47c567b0d..feb0dcf70 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs #-} +{-# LANGUAGE DataKinds, GADTs, TypeOperators #-} module Control.Abstract.Primitive where import Control.Abstract.Addressable @@ -74,3 +74,6 @@ defineBuiltins = data Primitive value result where Prim :: Builtin -> Primitive value value + +runPrimitive :: (Builtin -> Evaluator location value effects value) -> Evaluator location value (Primitive value ': effects) a -> Evaluator location value effects a +runPrimitive handler = interpret (\ (Prim builtin) -> handler builtin) From 116f64eb7529f18f0a0cf992921701d8f44f7927 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 10:44:07 -0400 Subject: [PATCH 039/148] Define a smart constructor for Primitive requests. --- src/Control/Abstract/Primitive.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index feb0dcf70..d07bc3850 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -72,6 +72,9 @@ defineBuiltins = builtin Print (lambda lowerBound (\ v -> variable v >>= asString >>= trace . unpack >> unit)) +prim :: Member (Primitive value) effects => Builtin -> Evaluator location value effects value +prim = send . Prim + data Primitive value result where Prim :: Builtin -> Primitive value value From 9d36699682791f5df481ab31631d242f96147b5e Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 10:48:17 -0400 Subject: [PATCH 040/148] Primitive requests take parameters. --- src/Control/Abstract/Primitive.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index d07bc3850..9add8cba8 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -72,11 +72,11 @@ defineBuiltins = builtin Print (lambda lowerBound (\ v -> variable v >>= asString >>= trace . unpack >> unit)) -prim :: Member (Primitive value) effects => Builtin -> Evaluator location value effects value -prim = send . Prim +prim :: Member (Primitive value) effects => Builtin -> [value] -> Evaluator location value effects value +prim builtin params = send (Prim builtin params) data Primitive value result where - Prim :: Builtin -> Primitive value value + Prim :: Builtin -> [value] -> Primitive value value -runPrimitive :: (Builtin -> Evaluator location value effects value) -> Evaluator location value (Primitive value ': effects) a -> Evaluator location value effects a -runPrimitive handler = interpret (\ (Prim builtin) -> handler builtin) +runPrimitive :: (Builtin -> [value] -> Evaluator location value effects value) -> Evaluator location value (Primitive value ': effects) a -> Evaluator location value effects a +runPrimitive handler = interpret (\ (Prim builtin params) -> handler builtin params) From 3fcdae3ac8b42fa2eb765da2d0adaf85ea996930 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 10:51:24 -0400 Subject: [PATCH 041/148] :memo: prim. --- src/Control/Abstract/Primitive.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 9add8cba8..1eb262f18 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -72,6 +72,7 @@ defineBuiltins = builtin Print (lambda lowerBound (\ v -> variable v >>= asString >>= trace . unpack >> unit)) +-- | Call a 'Builtin' with parameters. prim :: Member (Primitive value) effects => Builtin -> [value] -> Evaluator location value effects value prim builtin params = send (Prim builtin params) From 54988fa3df7b7b2d5b5fe3cdd6f4811cae331e62 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 10:52:29 -0400 Subject: [PATCH 042/148] lambda assumes no free variables. --- src/Control/Abstract/Primitive.hs | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 1eb262f18..440466c77 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -45,12 +45,11 @@ builtin b def = withCurrentCallStack callStack $ do def >>= assign addr lambda :: (AbstractFunction location value effects, Member Fresh effects) - => Set Name - -> (Name -> Evaluator location value effects value) + => (Name -> Evaluator location value effects value) -> Evaluator location value effects value -lambda fvs body = do +lambda body = do var <- nameI <$> fresh - closure [var] fvs (body var) + closure [var] lowerBound (body var) defineBuiltins :: ( AbstractValue location value effects , HasCallStack @@ -69,7 +68,7 @@ defineBuiltins :: ( AbstractValue location value effects ) => Evaluator location value effects () defineBuiltins = - builtin Print (lambda lowerBound (\ v -> variable v >>= asString >>= trace . unpack >> unit)) + builtin Print (lambda (\ v -> variable v >>= asString >>= trace . unpack >> unit)) -- | Call a 'Builtin' with parameters. From 22e01c9ed383c45b6d04b0ac33114f54f33e7860 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 10:58:27 -0400 Subject: [PATCH 043/148] Define builtin behaviours in runPrimitive. --- src/Control/Abstract/Primitive.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 440466c77..5e0cebe70 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -78,5 +78,6 @@ prim builtin params = send (Prim builtin params) data Primitive value result where Prim :: Builtin -> [value] -> Primitive value value -runPrimitive :: (Builtin -> [value] -> Evaluator location value effects value) -> Evaluator location value (Primitive value ': effects) a -> Evaluator location value effects a -runPrimitive handler = interpret (\ (Prim builtin params) -> handler builtin params) +runPrimitive :: (AbstractValue location value effects, Member Trace effects) => Evaluator location value (Primitive value ': effects) a -> Evaluator location value effects a +runPrimitive = interpret (\ (Prim builtin params) -> case builtin of + Print -> traverse (asString >=> trace . unpack) params >> unit) From 0d034f5ddcf56291d08a64048668d829fc44b999 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 11:14:01 -0400 Subject: [PATCH 044/148] Builtins are indexed by their argument/return types. --- src/Control/Abstract/Primitive.hs | 23 ++++++++++++++--------- 1 file changed, 14 insertions(+), 9 deletions(-) diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 5e0cebe70..8794d2370 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -15,10 +15,15 @@ import Data.Semigroup.Reducer hiding (unit) import Data.Semilattice.Lower import Prologue -data Builtin = Print - deriving (Bounded, Enum, Eq, Ord, Show) +data Builtin args result where + Print :: Builtin String () -builtinName :: Builtin -> Name +deriving instance Eq (Builtin args result) +deriving instance Ord (Builtin args result) +deriving instance Show (Builtin args result) + + +builtinName :: Builtin args result -> Name builtinName = name . pack . ("__semantic_" <>) . headToLower . show where headToLower (c:cs) = toLower c : cs headToLower "" = "" @@ -35,7 +40,7 @@ builtin :: ( HasCallStack , Ord location , Reducer value (Cell location value) ) - => Builtin + => Builtin args result -> Evaluator location value effects value -> Evaluator location value effects () builtin b def = withCurrentCallStack callStack $ do @@ -72,12 +77,12 @@ defineBuiltins = -- | Call a 'Builtin' with parameters. -prim :: Member (Primitive value) effects => Builtin -> [value] -> Evaluator location value effects value +prim :: (Effectful m, Member Primitive effects) => Builtin args result -> args -> m effects result prim builtin params = send (Prim builtin params) -data Primitive value result where - Prim :: Builtin -> [value] -> Primitive value value +data Primitive result where + Prim :: Builtin args result -> args -> Primitive result -runPrimitive :: (AbstractValue location value effects, Member Trace effects) => Evaluator location value (Primitive value ': effects) a -> Evaluator location value effects a +runPrimitive :: (Effectful m, Member Trace effects) => m (Primitive ': effects) a -> m effects a runPrimitive = interpret (\ (Prim builtin params) -> case builtin of - Print -> traverse (asString >=> trace . unpack) params >> unit) + Print -> trace params) From 20f918e7f7a791f5fa169e59ea2bc47f290e8031 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 11:16:51 -0400 Subject: [PATCH 045/148] evaluatePackageBody provides a Primitive effect. --- src/Data/Abstract/Evaluatable.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index c24ba25ce..708f057b4 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -96,7 +96,7 @@ evaluatePackageWith :: forall location term value inner inner' outer ] outer , Recursive term , inner ~ (Goto inner' value ': inner') - , inner' ~ (LoopControl value ': Return value ': Allocator location value ': Reader ModuleInfo ': Modules location value ': State (Gotos location value (Reader Span ': Reader PackageInfo ': outer)) ': Reader Span ': Reader PackageInfo ': outer) + , inner' ~ (Primitive ': LoopControl value ': Return value ': Allocator location value ': Reader ModuleInfo ': Modules location value ': State (Gotos location value (Reader Span ': Reader PackageInfo ': outer)) ': Reader Span ': Reader PackageInfo ': outer) ) => (SubtermAlgebra Module term (TermEvaluator term location value inner value) -> SubtermAlgebra Module term (TermEvaluator term location value inner value)) -> (SubtermAlgebra (Base term) term (TermEvaluator term location value inner (ValueRef value)) -> SubtermAlgebra (Base term) term (TermEvaluator term location value inner (ValueRef value))) @@ -124,6 +124,7 @@ evaluatePackageWith analyzeModule analyzeTerm package . raiseHandler runAllocator . raiseHandler runReturn . raiseHandler runLoopControl + . runPrimitive . raiseHandler (runGoto Gotos getGotos) evaluateEntryPoint :: ModulePath -> Maybe Name -> TermEvaluator term location value (Modules location value ': State (Gotos location value (Reader Span ': Reader PackageInfo ': outer)) ': Reader Span ': Reader PackageInfo ': outer) value @@ -148,7 +149,7 @@ evaluatePackageWith analyzeModule analyzeTerm package | otherwise = Exports.toEnvironment ports `mergeEnvs` overwrite (Exports.aliases ports) env pairValueWithEnv action = flip (,) <$> action <*> (filterEnv <$> TermEvaluator getExports <*> TermEvaluator getEnv) -newtype Gotos location value outer = Gotos { getGotos :: GotoTable (LoopControl value ': Return value ': Allocator location value ': Reader ModuleInfo ': Modules location value ': State (Gotos location value outer) ': outer) value } +newtype Gotos location value outer = Gotos { getGotos :: GotoTable (Primitive ': LoopControl value ': Return value ': Allocator location value ': Reader ModuleInfo ': Modules location value ': State (Gotos location value outer) ': outer) value } deriving (Lower) From ef9ef17c3b7b058db0c27828dd1e929a21b1ec64 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 11:22:32 -0400 Subject: [PATCH 046/148] defineBuiltins wraps the Prim effect. --- src/Control/Abstract/Primitive.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 8794d2370..e9e7063f4 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -60,20 +60,20 @@ defineBuiltins :: ( AbstractValue location value effects , HasCallStack , Members '[ Allocator location value , Fresh + , Primitive , Reader (Environment location) , Reader ModuleInfo , Reader Span , Resumable (EnvironmentError value) , State (Environment location) , State (Heap location (Cell location) value) - , Trace ] effects , Ord location , Reducer value (Cell location value) ) => Evaluator location value effects () defineBuiltins = - builtin Print (lambda (\ v -> variable v >>= asString >>= trace . unpack >> unit)) + builtin Print (lambda (\ v -> variable v >>= asString >>= prim Print . unpack >> unit)) -- | Call a 'Builtin' with parameters. From e9d9ebe4669dccea53cf195325369ea92d095273 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 11:23:10 -0400 Subject: [PATCH 047/148] Correct some alignment. --- src/Data/Abstract/Evaluatable.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 708f057b4..f793fff90 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -98,7 +98,7 @@ evaluatePackageWith :: forall location term value inner inner' outer , inner ~ (Goto inner' value ': inner') , inner' ~ (Primitive ': LoopControl value ': Return value ': Allocator location value ': Reader ModuleInfo ': Modules location value ': State (Gotos location value (Reader Span ': Reader PackageInfo ': outer)) ': Reader Span ': Reader PackageInfo ': outer) ) - => (SubtermAlgebra Module term (TermEvaluator term location value inner value) -> SubtermAlgebra Module term (TermEvaluator term location value inner value)) + => (SubtermAlgebra Module term (TermEvaluator term location value inner value) -> SubtermAlgebra Module term (TermEvaluator term location value inner value)) -> (SubtermAlgebra (Base term) term (TermEvaluator term location value inner (ValueRef value)) -> SubtermAlgebra (Base term) term (TermEvaluator term location value inner (ValueRef value))) -> Package term -> TermEvaluator term location value outer [value] From 916a325d85d2b589112cb002421cb97d18ba655a Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 11:47:14 -0400 Subject: [PATCH 048/148] Define a ClosureBody datatype. --- src/Data/Abstract/Value.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index e3af88ff3..92737c7fe 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -32,6 +32,10 @@ data Value location term | Hole deriving (Eq, Show, Ord) +data ClosureBody = Label Label + deriving (Eq, Show, Ord) + + instance Ord location => ValueRoots location (Value location term) where valueRoots v | Closure _ _ _ _ env <- v = Env.addresses env From 517c9305ecc0f39450583757c0e3c36d69918517 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 11:49:09 -0400 Subject: [PATCH 049/148] Use ClosureBody to define Closure. --- src/Data/Abstract/Value.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 92737c7fe..2a118f4e6 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -1,7 +1,7 @@ {-# LANGUAGE GADTs, RankNTypes, TypeOperators, UndecidableInstances #-} module Data.Abstract.Value where -import Control.Abstract +import Control.Abstract hiding (Label) import Data.Abstract.Environment (Environment, emptyEnv, mergeEnvs) import qualified Data.Abstract.Environment as Env import Data.Abstract.Name @@ -14,7 +14,7 @@ import qualified Data.Set as Set import Prologue data Value location term - = Closure PackageInfo ModuleInfo [Name] Label (Environment location) + = Closure PackageInfo ModuleInfo [Name] ClosureBody (Environment location) | Unit | Boolean Bool | Integer (Number.Number Integer) @@ -32,7 +32,7 @@ data Value location term | Hole deriving (Eq, Show, Ord) -data ClosureBody = Label Label +data ClosureBody = Label Int deriving (Eq, Show, Ord) @@ -63,11 +63,11 @@ instance ( Members '[ Allocator location (Value location term) packageInfo <- currentPackage moduleInfo <- currentModule l <- label body - Closure packageInfo moduleInfo parameters l . Env.bind (foldr Set.delete freeVariables parameters) <$> getEnv + Closure packageInfo moduleInfo parameters (Label l) . Env.bind (foldr Set.delete freeVariables parameters) <$> getEnv call op params = do case op of - Closure packageInfo moduleInfo names label env -> do + Closure packageInfo moduleInfo names (Label label) env -> do body <- goto label -- Evaluate the bindings and body with the closure’s package/module info in scope in order to -- charge them to the closure's origin. From d0e07f76b82acbc05caf04ec011c58214e24a7fc Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 11:51:26 -0400 Subject: [PATCH 050/148] Sort the deriving clause. --- src/Data/Abstract/Value.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 2a118f4e6..97cdafa27 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -30,7 +30,7 @@ data Value location term | Hash [Value location term] | Null | Hole - deriving (Eq, Show, Ord) + deriving (Eq, Ord, Show) data ClosureBody = Label Int deriving (Eq, Show, Ord) From 5116d52da7cb47f5f4cd8d1908800d1a321a68c5 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 11:52:05 -0400 Subject: [PATCH 051/148] Define an existential abstraction over Builtin. --- src/Control/Abstract/Primitive.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index e9e7063f4..d26f454b6 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -86,3 +86,9 @@ data Primitive result where runPrimitive :: (Effectful m, Member Trace effects) => m (Primitive ': effects) a -> m effects a runPrimitive = interpret (\ (Prim builtin params) -> case builtin of Print -> trace params) + + +data SomeBuiltin where + SomeBuiltin :: Builtin arg return -> SomeBuiltin + +deriving instance Show SomeBuiltin From 71c1e50c0b101e87502dce8d8d44a1d1baf3579a Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 11:52:31 -0400 Subject: [PATCH 052/148] Define an Eq instance for SomeBuiltin. --- src/Control/Abstract/Primitive.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index d26f454b6..6b3ce0f4f 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -91,4 +91,7 @@ runPrimitive = interpret (\ (Prim builtin params) -> case builtin of data SomeBuiltin where SomeBuiltin :: Builtin arg return -> SomeBuiltin +instance Eq SomeBuiltin where + SomeBuiltin Print == SomeBuiltin Print = True + deriving instance Show SomeBuiltin From 4406c84ba03b8f0f655ccab9608b4114bd57a898 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 11:52:58 -0400 Subject: [PATCH 053/148] Define an Ord instance for SomeBuiltin. --- src/Control/Abstract/Primitive.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 6b3ce0f4f..fbd5c5434 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -94,4 +94,7 @@ data SomeBuiltin where instance Eq SomeBuiltin where SomeBuiltin Print == SomeBuiltin Print = True +instance Ord SomeBuiltin where + SomeBuiltin Print `compare` SomeBuiltin Print = EQ + deriving instance Show SomeBuiltin From 385882faae6030db2b70f41f09d3e34c92dd5cc5 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 11:54:34 -0400 Subject: [PATCH 054/148] Sort this deriving clause too. --- src/Data/Abstract/Value.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 97cdafa27..bd662b87d 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -33,7 +33,7 @@ data Value location term deriving (Eq, Ord, Show) data ClosureBody = Label Int - deriving (Eq, Show, Ord) + deriving (Eq, Ord, Show) instance Ord location => ValueRoots location (Value location term) where From 6f0570c8283a5c43ff64ed0aeb49b7564d186dd7 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 11:55:46 -0400 Subject: [PATCH 055/148] Rename the term parameter to body. --- src/Data/Abstract/Value.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index bd662b87d..1ed66f938 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -13,7 +13,7 @@ import Data.Semigroup.Reducer import qualified Data.Set as Set import Prologue -data Value location term +data Value location body = Closure PackageInfo ModuleInfo [Name] ClosureBody (Environment location) | Unit | Boolean Bool @@ -22,12 +22,12 @@ data Value location term | Float (Number.Number Scientific) | String ByteString | Symbol ByteString - | Tuple [Value location term] - | Array [Value location term] + | Tuple [Value location body] + | Array [Value location body] | Class Name (Environment location) | Namespace Name (Environment location) - | KVPair (Value location term) (Value location term) - | Hash [Value location term] + | KVPair (Value location body) (Value location body) + | Hash [Value location body] | Null | Hole deriving (Eq, Ord, Show) From 88d651da7f6c275957e0a9b2a8f9a80ce8a322a6 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 11:56:17 -0400 Subject: [PATCH 056/148] ClosureBody receives the body parameter. --- src/Data/Abstract/Value.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 1ed66f938..6fd44994f 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -14,7 +14,7 @@ import qualified Data.Set as Set import Prologue data Value location body - = Closure PackageInfo ModuleInfo [Name] ClosureBody (Environment location) + = Closure PackageInfo ModuleInfo [Name] (ClosureBody body) (Environment location) | Unit | Boolean Bool | Integer (Number.Number Integer) @@ -32,7 +32,7 @@ data Value location body | Hole deriving (Eq, Ord, Show) -data ClosureBody = Label Int +data ClosureBody body = Label Int deriving (Eq, Ord, Show) From 301f84a7cf3bc71431d461330afa155eda07fe05 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 11:57:30 -0400 Subject: [PATCH 057/148] Rename the body parameter across the board. --- src/Data/Abstract/Value.hs | 74 +++++++++++++++++++------------------- 1 file changed, 37 insertions(+), 37 deletions(-) diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 6fd44994f..7c7bd2b12 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -36,29 +36,29 @@ data ClosureBody body = Label Int deriving (Eq, Ord, Show) -instance Ord location => ValueRoots location (Value location term) where +instance Ord location => ValueRoots location (Value location body) where valueRoots v | Closure _ _ _ _ env <- v = Env.addresses env | otherwise = mempty -instance AbstractHole (Value location term) where +instance AbstractHole (Value location body) where hole = Hole -instance ( Members '[ Allocator location (Value location term) +instance ( Members '[ Allocator location (Value location body) , Reader (Environment location) , Reader ModuleInfo , Reader PackageInfo - , Resumable (ValueError location term) - , Return (Value location term) + , Resumable (ValueError location body) + , Return (Value location body) , State (Environment location) - , State (Heap location (Cell location) (Value location term)) + , State (Heap location (Cell location) (Value location body)) ] effects , Ord location - , Reducer (Value location term) (Cell location (Value location term)) + , Reducer (Value location body) (Cell location (Value location body)) , Show location ) - => AbstractFunction location (Value location term) (Goto effects (Value location term) ': effects) where + => AbstractFunction location (Value location body) (Goto effects (Value location body) ': effects) where closure parameters freeVariables body = do packageInfo <- currentPackage moduleInfo <- currentModule @@ -82,21 +82,21 @@ instance ( Members '[ Allocator location (Value location term) -- | Construct a 'Value' wrapping the value arguments (if any). -instance ( Members '[ Allocator location (Value location term) - , LoopControl (Value location term) +instance ( Members '[ Allocator location (Value location body) + , LoopControl (Value location body) , Reader (Environment location) , Reader ModuleInfo , Reader PackageInfo - , Resumable (ValueError location term) - , Return (Value location term) + , Resumable (ValueError location body) + , Return (Value location body) , State (Environment location) - , State (Heap location (Cell location) (Value location term)) + , State (Heap location (Cell location) (Value location body)) ] effects , Ord location - , Reducer (Value location term) (Cell location (Value location term)) + , Reducer (Value location body) (Cell location (Value location body)) , Show location ) - => AbstractValue location (Value location term) (Goto effects (Value location term) ': effects) where + => AbstractValue location (Value location body) (Goto effects (Value location body) ': effects) where unit = pure Unit integer = pure . Integer . Number.Integer boolean = pure . Boolean @@ -174,7 +174,7 @@ instance ( Members '[ Allocator location (Value location term) tentative x i j = attemptUnsafeArithmetic (x i j) -- Dispatch whatever's contained inside a 'Number.SomeNumber' to its appropriate 'MonadValue' ctor - specialize :: (AbstractValue location (Value location term) effects, Member (Resumable (ValueError location term)) effects) => Either ArithException Number.SomeNumber -> Evaluator location (Value location term) effects (Value location term) + specialize :: (AbstractValue location (Value location body) effects, Member (Resumable (ValueError location body)) effects) => Either ArithException Number.SomeNumber -> Evaluator location (Value location body) effects (Value location body) specialize (Left exc) = throwValueError (ArithmeticError exc) specialize (Right (Number.SomeNumber (Number.Integer i))) = integer i specialize (Right (Number.SomeNumber (Number.Ratio r))) = rational r @@ -193,7 +193,7 @@ instance ( Members '[ Allocator location (Value location term) where -- Explicit type signature is necessary here because we're passing all sorts of things -- to these comparison functions. - go :: (AbstractValue location (Value location term) effects, Ord a) => a -> a -> Evaluator location (Value location term) effects (Value location term) + go :: (AbstractValue location (Value location body) effects, Ord a) => a -> a -> Evaluator location (Value location body) effects (Value location body) go l r = case comparator of Concrete f -> boolean (f l r) Generalized -> integer (orderingToInt (compare l r)) @@ -221,25 +221,25 @@ instance ( Members '[ Allocator location (Value location term) -- | The type of exceptions that can be thrown when constructing values in 'Value'’s 'MonadValue' instance. -data ValueError location term resume where - StringError :: Value location term -> ValueError location term ByteString - BoolError :: Value location term -> ValueError location term Bool - IndexError :: Value location term -> Value location term -> ValueError location term (Value location term) - NamespaceError :: Prelude.String -> ValueError location term (Environment location) - CallError :: Value location term -> ValueError location term (Value location term) - NumericError :: Value location term -> ValueError location term (Value location term) - Numeric2Error :: Value location term -> Value location term -> ValueError location term (Value location term) - ComparisonError :: Value location term -> Value location term -> ValueError location term (Value location term) - BitwiseError :: Value location term -> ValueError location term (Value location term) - Bitwise2Error :: Value location term -> Value location term -> ValueError location term (Value location term) - KeyValueError :: Value location term -> ValueError location term (Value location term, Value location term) +data ValueError location body resume where + StringError :: Value location body -> ValueError location body ByteString + BoolError :: Value location body -> ValueError location body Bool + IndexError :: Value location body -> Value location body -> ValueError location body (Value location body) + NamespaceError :: Prelude.String -> ValueError location body (Environment location) + CallError :: Value location body -> ValueError location body (Value location body) + NumericError :: Value location body -> ValueError location body (Value location body) + Numeric2Error :: Value location body -> Value location body -> ValueError location body (Value location body) + ComparisonError :: Value location body -> Value location body -> ValueError location body (Value location body) + BitwiseError :: Value location body -> ValueError location body (Value location body) + Bitwise2Error :: Value location body -> Value location body -> ValueError location body (Value location body) + KeyValueError :: Value location body -> ValueError location body (Value location body, Value location body) -- Indicates that we encountered an arithmetic exception inside Haskell-native number crunching. - ArithmeticError :: ArithException -> ValueError location term (Value location term) + ArithmeticError :: ArithException -> ValueError location body (Value location body) -- Out-of-bounds error - BoundsError :: [Value location term] -> Prelude.Integer -> ValueError location term (Value location term) + BoundsError :: [Value location body] -> Prelude.Integer -> ValueError location body (Value location body) -instance Eq location => Eq1 (ValueError location term) where +instance Eq location => Eq1 (ValueError location body) where liftEq _ (StringError a) (StringError b) = a == b liftEq _ (NamespaceError a) (NamespaceError b) = a == b liftEq _ (CallError a) (CallError b) = a == b @@ -253,15 +253,15 @@ instance Eq location => Eq1 (ValueError location term) where liftEq _ (BoundsError a b) (BoundsError c d) = (a == c) && (b == d) liftEq _ _ _ = False -deriving instance Show location => Show (ValueError location term resume) -instance Show location => Show1 (ValueError location term) where +deriving instance Show location => Show (ValueError location body resume) +instance Show location => Show1 (ValueError location body) where liftShowsPrec _ _ = showsPrec -throwValueError :: Member (Resumable (ValueError location term)) effects => ValueError location term resume -> Evaluator location (Value location term) effects resume +throwValueError :: Member (Resumable (ValueError location body)) effects => ValueError location body resume -> Evaluator location (Value location body) effects resume throwValueError = throwResumable -runValueError :: TermEvaluator term location (Value location term) (Resumable (ValueError location term) ': effects) a -> TermEvaluator term location (Value location term) effects (Either (SomeExc (ValueError location term)) a) +runValueError :: TermEvaluator term location (Value location body) (Resumable (ValueError location body) ': effects) a -> TermEvaluator term location (Value location body) effects (Either (SomeExc (ValueError location body)) a) runValueError = runResumable -runValueErrorWith :: Effectful (m location (Value location term)) => (forall resume . ValueError location term resume -> m location (Value location term) effects resume) -> m location (Value location term) (Resumable (ValueError location term) ': effects) a -> m location (Value location term) effects a +runValueErrorWith :: Effectful (m location (Value location body)) => (forall resume . ValueError location body resume -> m location (Value location body) effects resume) -> m location (Value location body) (Resumable (ValueError location body) ': effects) a -> m location (Value location body) effects a runValueErrorWith = runResumableWith From b0ef2ddd6661fb6c0475ff8c009e25c2153e48ef Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 11:58:12 -0400 Subject: [PATCH 058/148] Generalize runValueError. --- src/Data/Abstract/Value.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 7c7bd2b12..2e95c55fc 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -260,7 +260,7 @@ instance Show location => Show1 (ValueError location body) where throwValueError :: Member (Resumable (ValueError location body)) effects => ValueError location body resume -> Evaluator location (Value location body) effects resume throwValueError = throwResumable -runValueError :: TermEvaluator term location (Value location body) (Resumable (ValueError location body) ': effects) a -> TermEvaluator term location (Value location body) effects (Either (SomeExc (ValueError location body)) a) +runValueError :: Effectful (m location (Value location body)) => m location (Value location body) (Resumable (ValueError location body) ': effects) a -> m location (Value location body) effects (Either (SomeExc (ValueError location body)) a) runValueError = runResumable runValueErrorWith :: Effectful (m location (Value location body)) => (forall resume . ValueError location body resume -> m location (Value location body) effects resume) -> m location (Value location body) (Resumable (ValueError location body) ': effects) a -> m location (Value location body) effects a From 99e0bcc9c35153ad6fce143a8d97706e92c57bec Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 11:58:55 -0400 Subject: [PATCH 059/148] ClosureBody takes the location parameter. --- src/Data/Abstract/Value.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 2e95c55fc..26fa644cc 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -14,7 +14,7 @@ import qualified Data.Set as Set import Prologue data Value location body - = Closure PackageInfo ModuleInfo [Name] (ClosureBody body) (Environment location) + = Closure PackageInfo ModuleInfo [Name] (ClosureBody location body) (Environment location) | Unit | Boolean Bool | Integer (Number.Number Integer) @@ -32,7 +32,7 @@ data Value location body | Hole deriving (Eq, Ord, Show) -data ClosureBody body = Label Int +data ClosureBody location body = Label Int deriving (Eq, Ord, Show) From fb3f6fdc76f83d73cf181ced1e56ba552a4075f0 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 11:59:31 -0400 Subject: [PATCH 060/148] Rename the ClosureBody constructor. --- src/Data/Abstract/Value.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 26fa644cc..702908ffc 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -1,7 +1,7 @@ {-# LANGUAGE GADTs, RankNTypes, TypeOperators, UndecidableInstances #-} module Data.Abstract.Value where -import Control.Abstract hiding (Label) +import Control.Abstract import Data.Abstract.Environment (Environment, emptyEnv, mergeEnvs) import qualified Data.Abstract.Environment as Env import Data.Abstract.Name @@ -32,7 +32,7 @@ data Value location body | Hole deriving (Eq, Ord, Show) -data ClosureBody location body = Label Int +data ClosureBody location body = ClosureBody Label deriving (Eq, Ord, Show) @@ -63,11 +63,11 @@ instance ( Members '[ Allocator location (Value location body) packageInfo <- currentPackage moduleInfo <- currentModule l <- label body - Closure packageInfo moduleInfo parameters (Label l) . Env.bind (foldr Set.delete freeVariables parameters) <$> getEnv + Closure packageInfo moduleInfo parameters (ClosureBody l) . Env.bind (foldr Set.delete freeVariables parameters) <$> getEnv call op params = do case op of - Closure packageInfo moduleInfo names (Label label) env -> do + Closure packageInfo moduleInfo names (ClosureBody label) env -> do body <- goto label -- Evaluate the bindings and body with the closure’s package/module info in scope in order to -- charge them to the closure's origin. From bc14bf10b5b3535a0f681d3ebd7f9de262602461 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 12:22:56 -0400 Subject: [PATCH 061/148] Move most of the value introduction forms into a new AbstractIntro typeclass. --- src/Control/Abstract/Value.hs | 73 ++++++++++++++++++----------------- src/Data/Abstract/Type.hs | 35 +++++++++-------- src/Data/Abstract/Value.hs | 35 +++++++++-------- 3 files changed, 76 insertions(+), 67 deletions(-) diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index a3add57f0..1af710767 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -1,6 +1,7 @@ {-# LANGUAGE GADTs, Rank2Types #-} module Control.Abstract.Value ( AbstractValue(..) +, AbstractIntro(..) , AbstractFunction(..) , AbstractHole(..) , Comparator(..) @@ -55,17 +56,47 @@ class Show value => AbstractFunction location value effects where call :: value -> [Evaluator location value effects value] -> Evaluator location value effects value --- | A 'Monad' abstracting the evaluation of (and under) binding constructs (functions, methods, etc). --- --- This allows us to abstract the choice of whether to evaluate under binders for different value types. -class AbstractFunction location value effects => AbstractValue location value effects where +class Show value => AbstractIntro value where -- | Construct an abstract unit value. -- TODO: This might be the same as the empty tuple for some value types unit :: Evaluator location value effects value + -- | Construct an abstract boolean value. + boolean :: Bool -> Evaluator location value effects value + + -- | Construct an abstract string value. + string :: ByteString -> Evaluator location value effects value + + -- | Construct a self-evaluating symbol value. + -- TODO: Should these be interned in some table to provide stronger uniqueness guarantees? + symbol :: ByteString -> Evaluator location value effects value + -- | Construct an abstract integral value. integer :: Integer -> Evaluator location value effects value + -- | Construct a floating-point value. + float :: Scientific -> Evaluator location value effects value + + -- | Construct a rational value. + rational :: Rational -> Evaluator location value effects value + + -- | Construct an N-ary tuple of multiple (possibly-disjoint) values + multiple :: [value] -> Evaluator location value effects value + + -- | Construct a key-value pair for use in a hash. + kvPair :: value -> value -> Evaluator location value effects value + + -- | Construct a hash out of pairs. + hash :: [(value, value)] -> Evaluator location value effects value + + -- | Construct the nil/null datatype. + null :: Evaluator location value effects value + + +-- | A 'Monad' abstracting the evaluation of (and under) binding constructs (functions, methods, etc). +-- +-- This allows us to abstract the choice of whether to evaluate under binders for different value types. +class (AbstractFunction location value effects, AbstractIntro value) => AbstractValue location value effects where -- | Lift a unary operator over a 'Num' to a function on 'value's. liftNumeric :: (forall a . Num a => a -> a) -> (value -> Evaluator location value effects value) @@ -90,46 +121,18 @@ class AbstractFunction location value effects => AbstractValue location value ef liftBitwise2 :: (forall a . (Integral a, Bits a) => a -> a -> a) -> (value -> value -> Evaluator location value effects value) - -- | Construct an abstract boolean value. - boolean :: Bool -> Evaluator location value effects value - - -- | Construct an abstract string value. - string :: ByteString -> Evaluator location value effects value - - -- | Construct a self-evaluating symbol value. - -- TODO: Should these be interned in some table to provide stronger uniqueness guarantees? - symbol :: ByteString -> Evaluator location value effects value - - -- | Construct a floating-point value. - float :: Scientific -> Evaluator location value effects value - - -- | Construct a rational value. - rational :: Rational -> Evaluator location value effects value - - -- | Construct an N-ary tuple of multiple (possibly-disjoint) values - multiple :: [value] -> Evaluator location value effects value - -- | Construct an array of zero or more values. array :: [value] -> Evaluator location value effects value - -- | Construct a key-value pair for use in a hash. - kvPair :: value -> value -> Evaluator location value effects value - - -- | Extract the contents of a key-value pair as a tuple. - asPair :: value -> Evaluator location value effects (value, value) - - -- | Construct a hash out of pairs. - hash :: [(value, value)] -> Evaluator location value effects value - -- | Extract a 'ByteString' from a given value. asString :: value -> Evaluator location value effects ByteString + -- | Extract the contents of a key-value pair as a tuple. + asPair :: value -> Evaluator location value effects (value, value) + -- | Eliminate boolean values. TODO: s/boolean/truthy ifthenelse :: value -> Evaluator location value effects a -> Evaluator location value effects a -> Evaluator location value effects a - -- | Construct the nil/null datatype. - null :: Evaluator location value effects value - -- | @index x i@ computes @x[i]@, with zero-indexing. index :: value -> value -> Evaluator location value effects value diff --git a/src/Data/Abstract/Type.hs b/src/Data/Abstract/Type.hs index 5f381f3eb..3073cc4c3 100644 --- a/src/Data/Abstract/Type.hs +++ b/src/Data/Abstract/Type.hs @@ -101,6 +101,21 @@ instance Ord location => ValueRoots location Type where instance AbstractHole Type where hole = Hole +instance AbstractIntro Type where + unit = pure Unit + integer _ = pure Int + boolean _ = pure Bool + string _ = pure String + float _ = pure Float + symbol _ = pure Symbol + rational _ = pure Rational + multiple = pure . zeroOrMoreProduct + hash = pure . Hash + kvPair k v = pure (k :* v) + + null = pure Null + + instance ( Members '[ Allocator location Type , Fresh , NonDet @@ -146,27 +161,15 @@ instance ( Members '[ Allocator location Type , Reducer Type (Cell location Type) ) => AbstractValue location Type effects where - unit = pure Unit - integer _ = pure Int - boolean _ = pure Bool - string _ = pure String - float _ = pure Float - symbol _ = pure Symbol - rational _ = pure Rational - multiple = pure . zeroOrMoreProduct - array fields = do - var <- fresh - Array <$> foldr (\ t1 -> (unify t1 =<<)) (pure (Var var)) fields - hash = pure . Hash - kvPair k v = pure (k :* v) - - null = pure Null - klass _ _ _ = pure Object namespace _ _ = pure Unit scopedEnvironment _ = pure (Just emptyEnv) + array fields = do + var <- fresh + Array <$> foldr (\ t1 -> (unify t1 =<<)) (pure (Var var)) fields + asString t = unify t String $> "" asPair t = do t1 <- fresh diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 702908ffc..22434d97c 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -81,6 +81,24 @@ instance ( Members '[ Allocator location (Value location body) _ -> throwValueError (CallError op) +instance Show location => AbstractIntro (Value location body) where + unit = pure Unit + integer = pure . Integer . Number.Integer + boolean = pure . Boolean + string = pure . String + float = pure . Float . Number.Decimal + symbol = pure . Symbol + rational = pure . Rational . Number.Ratio + + multiple = pure . Tuple + + kvPair k = pure . KVPair k + hash = pure . Hash . map (uncurry KVPair) + + null = pure Null + + + -- | Construct a 'Value' wrapping the value arguments (if any). instance ( Members '[ Allocator location (Value location body) , LoopControl (Value location body) @@ -97,26 +115,11 @@ instance ( Members '[ Allocator location (Value location body) , Show location ) => AbstractValue location (Value location body) (Goto effects (Value location body) ': effects) where - unit = pure Unit - integer = pure . Integer . Number.Integer - boolean = pure . Boolean - string = pure . String - float = pure . Float . Number.Decimal - symbol = pure . Symbol - rational = pure . Rational . Number.Ratio - - multiple = pure . Tuple - array = pure . Array - - kvPair k = pure . KVPair k - - null = pure Null - asPair val | KVPair k v <- val = pure (k, v) | otherwise = throwValueError $ KeyValueError val - hash = pure . Hash . map (uncurry KVPair) + array = pure . Array klass n [] env = pure $ Class n env klass n supers env = do From 471a732e789863a0e54651ee267ae2c4c191159d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 12:36:49 -0400 Subject: [PATCH 062/148] AbstractIntro methods are all pure. --- src/Control/Abstract/Primitive.hs | 2 +- src/Control/Abstract/Value.hs | 26 +++++++++--------- src/Data/Abstract/Evaluatable.hs | 8 +++--- src/Data/Abstract/Type.hs | 22 ++++++++-------- src/Data/Abstract/Value.hs | 44 +++++++++++++++---------------- src/Data/Syntax.hs | 2 +- src/Data/Syntax/Comment.hs | 2 +- src/Data/Syntax/Declaration.hs | 4 +-- src/Data/Syntax/Directive.hs | 4 +-- src/Data/Syntax/Expression.hs | 4 +-- src/Data/Syntax/Literal.hs | 20 +++++++------- src/Data/Syntax/Statement.hs | 2 +- src/Language/Go/Syntax.hs | 6 ++--- src/Language/PHP/Syntax.hs | 2 +- src/Language/Python/Syntax.hs | 8 +++--- src/Language/Ruby/Syntax.hs | 6 ++--- src/Language/TypeScript/Syntax.hs | 13 +++++---- 17 files changed, 86 insertions(+), 89 deletions(-) diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index fbd5c5434..6c31145e3 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -73,7 +73,7 @@ defineBuiltins :: ( AbstractValue location value effects ) => Evaluator location value effects () defineBuiltins = - builtin Print (lambda (\ v -> variable v >>= asString >>= prim Print . unpack >> unit)) + builtin Print (lambda (\ v -> variable v >>= asString >>= prim Print . unpack >> pure unit)) -- | Call a 'Builtin' with parameters. diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index 1af710767..86b05e408 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -59,38 +59,38 @@ class Show value => AbstractFunction location value effects where class Show value => AbstractIntro value where -- | Construct an abstract unit value. -- TODO: This might be the same as the empty tuple for some value types - unit :: Evaluator location value effects value + unit :: value -- | Construct an abstract boolean value. - boolean :: Bool -> Evaluator location value effects value + boolean :: Bool -> value -- | Construct an abstract string value. - string :: ByteString -> Evaluator location value effects value + string :: ByteString -> value -- | Construct a self-evaluating symbol value. -- TODO: Should these be interned in some table to provide stronger uniqueness guarantees? - symbol :: ByteString -> Evaluator location value effects value + symbol :: ByteString -> value -- | Construct an abstract integral value. - integer :: Integer -> Evaluator location value effects value + integer :: Integer -> value -- | Construct a floating-point value. - float :: Scientific -> Evaluator location value effects value + float :: Scientific -> value -- | Construct a rational value. - rational :: Rational -> Evaluator location value effects value + rational :: Rational -> value -- | Construct an N-ary tuple of multiple (possibly-disjoint) values - multiple :: [value] -> Evaluator location value effects value + multiple :: [value] -> value -- | Construct a key-value pair for use in a hash. - kvPair :: value -> value -> Evaluator location value effects value + kvPair :: value -> value -> value -- | Construct a hash out of pairs. - hash :: [(value, value)] -> Evaluator location value effects value + hash :: [(value, value)] -> value -- | Construct the nil/null datatype. - null :: Evaluator location value effects value + null :: value -- | A 'Monad' abstracting the evaluation of (and under) binding constructs (functions, methods, etc). @@ -181,7 +181,7 @@ while :: AbstractValue location value effects -> Evaluator location value effects value while cond body = loop $ \ continue -> do this <- cond - ifthenelse this (body *> continue) unit + ifthenelse this (body *> continue) (pure unit) -- | Do-while loop, built on top of while. doWhile :: AbstractValue location value effects @@ -190,7 +190,7 @@ doWhile :: AbstractValue location value effects -> Evaluator location value effects value doWhile body cond = loop $ \ continue -> body *> do this <- cond - ifthenelse this continue unit + ifthenelse this continue (pure unit) makeNamespace :: ( AbstractValue location value effects , Member (State (Environment location)) effects diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index f793fff90..804bfe3e4 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -129,11 +129,11 @@ evaluatePackageWith analyzeModule analyzeTerm package evaluateEntryPoint :: ModulePath -> Maybe Name -> TermEvaluator term location value (Modules location value ': State (Gotos location value (Reader Span ': Reader PackageInfo ': outer)) ': Reader Span ': Reader PackageInfo ': outer) value evaluateEntryPoint m sym = runInModule (ModuleInfo m) . TermEvaluator $ do - v <- maybe unit (pure . snd) <$> require m - maybe v ((`call` []) <=< variable) sym + v <- maybe unit snd <$> require m + maybe (pure v) ((`call` []) <=< variable) sym evalPrelude prelude = raiseHandler (runModules (runTermEvaluator . evalModule)) $ do - _ <- runInModule moduleInfoFromCallStack (TermEvaluator (defineBuiltins *> unit)) + _ <- runInModule moduleInfoFromCallStack (TermEvaluator (defineBuiltins $> unit)) fst <$> evalModule prelude withPrelude Nothing a = a @@ -234,4 +234,4 @@ instance Evaluatable s => Evaluatable (TermF s a) where --- 3. Only the last statement’s return value is returned. instance Evaluatable [] where -- 'nonEmpty' and 'foldMap1' enable us to return the last statement’s result instead of 'unit' for non-empty lists. - eval = maybe (Rval <$> unit) (runApp . foldMap1 (App . subtermRef)) . nonEmpty + eval = maybe (pure (Rval unit)) (runApp . foldMap1 (App . subtermRef)) . nonEmpty diff --git a/src/Data/Abstract/Type.hs b/src/Data/Abstract/Type.hs index 3073cc4c3..f8d898315 100644 --- a/src/Data/Abstract/Type.hs +++ b/src/Data/Abstract/Type.hs @@ -102,18 +102,18 @@ instance AbstractHole Type where hole = Hole instance AbstractIntro Type where - unit = pure Unit - integer _ = pure Int - boolean _ = pure Bool - string _ = pure String - float _ = pure Float - symbol _ = pure Symbol - rational _ = pure Rational - multiple = pure . zeroOrMoreProduct - hash = pure . Hash - kvPair k v = pure (k :* v) + unit = Unit + integer _ = Int + boolean _ = Bool + string _ = String + float _ = Float + symbol _ = Symbol + rational _ = Rational + multiple = zeroOrMoreProduct + hash = Hash + kvPair k v = k :* v - null = pure Null + null = Null instance ( Members '[ Allocator location Type diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 22434d97c..3e5a3d62b 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -82,20 +82,20 @@ instance ( Members '[ Allocator location (Value location body) instance Show location => AbstractIntro (Value location body) where - unit = pure Unit - integer = pure . Integer . Number.Integer - boolean = pure . Boolean - string = pure . String - float = pure . Float . Number.Decimal - symbol = pure . Symbol - rational = pure . Rational . Number.Ratio + unit = Unit + integer = Integer . Number.Integer + boolean = Boolean + string = String + float = Float . Number.Decimal + symbol = Symbol + rational = Rational . Number.Ratio - multiple = pure . Tuple + multiple = Tuple - kvPair k = pure . KVPair k - hash = pure . Hash . map (uncurry KVPair) + kvPair k = KVPair k + hash = Hash . map (uncurry KVPair) - null = pure Null + null = Null @@ -157,9 +157,9 @@ instance ( Members '[ Allocator location (Value location body) | otherwise = throwValueError (IndexError arr idx) liftNumeric f arg - | Integer (Number.Integer i) <- arg = integer $ f i - | Float (Number.Decimal d) <- arg = float $ f d - | Rational (Number.Ratio r) <- arg = rational $ f r + | Integer (Number.Integer i) <- arg = pure . integer $ f i + | Float (Number.Decimal d) <- arg = pure . float $ f d + | Rational (Number.Ratio r) <- arg = pure . rational $ f r | otherwise = throwValueError (NumericError arg) liftNumeric2 f left right @@ -179,9 +179,9 @@ instance ( Members '[ Allocator location (Value location body) -- Dispatch whatever's contained inside a 'Number.SomeNumber' to its appropriate 'MonadValue' ctor specialize :: (AbstractValue location (Value location body) effects, Member (Resumable (ValueError location body)) effects) => Either ArithException Number.SomeNumber -> Evaluator location (Value location body) effects (Value location body) specialize (Left exc) = throwValueError (ArithmeticError exc) - specialize (Right (Number.SomeNumber (Number.Integer i))) = integer i - specialize (Right (Number.SomeNumber (Number.Ratio r))) = rational r - specialize (Right (Number.SomeNumber (Number.Decimal d))) = float d + specialize (Right (Number.SomeNumber (Number.Integer i))) = pure $ integer i + specialize (Right (Number.SomeNumber (Number.Ratio r))) = pure $ rational r + specialize (Right (Number.SomeNumber (Number.Decimal d))) = pure $ float d pair = (left, right) liftComparison comparator left right @@ -191,15 +191,15 @@ instance ( Members '[ Allocator location (Value location body) | (Float (Number.Decimal i), Float (Number.Decimal j)) <- pair = go i j | (String i, String j) <- pair = go i j | (Boolean i, Boolean j) <- pair = go i j - | (Unit, Unit) <- pair = boolean True + | (Unit, Unit) <- pair = pure $ boolean True | otherwise = throwValueError (ComparisonError left right) where -- Explicit type signature is necessary here because we're passing all sorts of things -- to these comparison functions. go :: (AbstractValue location (Value location body) effects, Ord a) => a -> a -> Evaluator location (Value location body) effects (Value location body) go l r = case comparator of - Concrete f -> boolean (f l r) - Generalized -> integer (orderingToInt (compare l r)) + Concrete f -> pure $ boolean (f l r) + Generalized -> pure $ integer (orderingToInt (compare l r)) -- Map from [LT, EQ, GT] to [-1, 0, 1] orderingToInt :: Ordering -> Prelude.Integer @@ -209,11 +209,11 @@ instance ( Members '[ Allocator location (Value location body) liftBitwise operator target - | Integer (Number.Integer i) <- target = integer $ operator i + | Integer (Number.Integer i) <- target = pure . integer $ operator i | otherwise = throwValueError (BitwiseError target) liftBitwise2 operator left right - | (Integer (Number.Integer i), Integer (Number.Integer j)) <- pair = integer $ operator i j + | (Integer (Number.Integer i), Integer (Number.Integer j)) <- pair = pure . integer $ operator i j | otherwise = throwValueError (Bitwise2Error left right) where pair = (left, right) diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs index 22adb07dc..a24baafd9 100644 --- a/src/Data/Syntax.hs +++ b/src/Data/Syntax.hs @@ -158,7 +158,7 @@ instance Ord1 Empty where liftCompare _ _ _ = EQ instance Show1 Empty where liftShowsPrec _ _ _ _ = showString "Empty" instance Evaluatable Empty where - eval _ = Rval <$> unit + eval _ = pure (Rval unit) -- | Syntax representing a parsing or assignment error. diff --git a/src/Data/Syntax/Comment.hs b/src/Data/Syntax/Comment.hs index f265c9a2b..5ca97adc8 100644 --- a/src/Data/Syntax/Comment.hs +++ b/src/Data/Syntax/Comment.hs @@ -19,7 +19,7 @@ instance ToJSONFields1 Comment where toJSONFields1 f@Comment{..} = withChildren f ["contents" .= unpack commentContent ] instance Evaluatable Comment where - eval _ = Rval <$> unit + eval _ = pure (Rval unit) -- TODO: nested comment types -- TODO: documentation comment types diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index e4b6866a2..c58f90b09 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -112,8 +112,8 @@ instance Show1 VariableDeclaration where liftShowsPrec = genericLiftShowsPrec instance ToJSONFields1 VariableDeclaration instance Evaluatable VariableDeclaration where - eval (VariableDeclaration []) = Rval <$> unit - eval (VariableDeclaration decs) = Rval <$> (multiple =<< traverse subtermValue decs) + eval (VariableDeclaration []) = pure (Rval unit) + eval (VariableDeclaration decs) = Rval . multiple <$> (traverse subtermValue decs) instance Declarations a => Declarations (VariableDeclaration a) where declaredName (VariableDeclaration vars) = case vars of diff --git a/src/Data/Syntax/Directive.hs b/src/Data/Syntax/Directive.hs index 08bcc375b..32c175da9 100644 --- a/src/Data/Syntax/Directive.hs +++ b/src/Data/Syntax/Directive.hs @@ -20,7 +20,7 @@ instance Show1 File where liftShowsPrec = genericLiftShowsPrec instance ToJSONFields1 File instance Evaluatable File where - eval File = Rval <$> (currentModule >>= string . BC.pack . modulePath) + eval File = Rval . string . BC.pack . modulePath <$> currentModule -- A line directive like the Ruby constant `__LINE__`. @@ -34,4 +34,4 @@ instance Show1 Line where liftShowsPrec = genericLiftShowsPrec instance ToJSONFields1 Line instance Evaluatable Line where - eval Line = Rval <$> (currentSpan >>= integer . fromIntegral . posLine . spanStart) + eval Line = Rval . integer . fromIntegral . posLine . spanStart <$> currentSpan diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs index 9c5d46d20..b87f00289 100644 --- a/src/Data/Syntax/Expression.hs +++ b/src/Data/Syntax/Expression.hs @@ -119,8 +119,8 @@ instance Evaluatable Boolean where go (Or a b) = do cond <- a ifthenelse cond (pure cond) b - go (Not a) = a >>= asBool >>= boolean . not - go (XOr a b) = liftA2 (/=) (a >>= asBool) (b >>= asBool) >>= boolean + go (Not a) = a >>= fmap (boolean . not) . asBool + go (XOr a b) = boolean <$> (liftA2 (/=) (a >>= asBool) (b >>= asBool)) -- | Javascript delete operator newtype Delete a = Delete a diff --git a/src/Data/Syntax/Literal.hs b/src/Data/Syntax/Literal.hs index c466e7bce..0e265d805 100644 --- a/src/Data/Syntax/Literal.hs +++ b/src/Data/Syntax/Literal.hs @@ -27,7 +27,7 @@ instance Ord1 Boolean where liftCompare = genericLiftCompare instance Show1 Boolean where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Boolean where - eval (Boolean x) = Rval <$> boolean x + eval (Boolean x) = pure (Rval (boolean x)) instance ToJSONFields1 Boolean where toJSONFields1 (Boolean b) = noChildren [ "value" .= b ] @@ -45,7 +45,7 @@ instance Show1 Data.Syntax.Literal.Integer where liftShowsPrec = genericLiftShow instance Evaluatable Data.Syntax.Literal.Integer where -- TODO: This instance probably shouldn't have readInteger? eval (Data.Syntax.Literal.Integer x) = - Rval <$> (integer =<< maybeM (throwEvalError (IntegerFormatError x)) (fst <$> readInteger x)) + Rval . integer <$> maybeM (throwEvalError (IntegerFormatError x)) (fst <$> readInteger x) instance ToJSONFields1 Data.Syntax.Literal.Integer where toJSONFields1 (Integer i) = noChildren ["asString" .= unpack i] @@ -65,7 +65,7 @@ instance Show1 Data.Syntax.Literal.Float where liftShowsPrec = genericLiftShowsP instance Evaluatable Data.Syntax.Literal.Float where eval (Float s) = - Rval <$> (float =<< either (const (throwEvalError (FloatFormatError s))) pure (parseScientific s)) + Rval . float <$> either (const (throwEvalError (FloatFormatError s))) pure (parseScientific s) instance ToJSONFields1 Float where toJSONFields1 (Float f) = noChildren ["asString" .= unpack f] @@ -83,7 +83,7 @@ instance Evaluatable Data.Syntax.Literal.Rational where let trimmed = B.takeWhile (/= 'r') r parsed = readMaybe @Prelude.Integer (unpack trimmed) - in Rval <$> (rational =<< maybe (throwEvalError (RationalFormatError r)) (pure . toRational) parsed) + in Rval . rational <$> maybe (throwEvalError (RationalFormatError r)) (pure . toRational) parsed instance ToJSONFields1 Data.Syntax.Literal.Rational where toJSONFields1 (Rational r) = noChildren ["asString" .= unpack r] @@ -143,7 +143,7 @@ instance ToJSONFields1 TextElement where toJSONFields1 (TextElement c) = noChildren ["asString" .= unpack c] instance Evaluatable TextElement where - eval (TextElement x) = Rval <$> string x + eval (TextElement x) = pure (Rval (string x)) data Null a = Null deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) @@ -152,7 +152,7 @@ instance Eq1 Null where liftEq = genericLiftEq instance Ord1 Null where liftCompare = genericLiftCompare instance Show1 Null where liftShowsPrec = genericLiftShowsPrec -instance Evaluatable Null where eval _ = Rval <$> null +instance Evaluatable Null where eval _ = pure (Rval null) instance ToJSONFields1 Null @@ -166,7 +166,7 @@ instance Show1 Symbol where liftShowsPrec = genericLiftShowsPrec instance ToJSONFields1 Symbol instance Evaluatable Symbol where - eval (Symbol s) = Rval <$> symbol s + eval (Symbol s) = pure (Rval (symbol s)) newtype Regex a = Regex { regexContent :: ByteString } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) @@ -210,7 +210,7 @@ instance Show1 Hash where liftShowsPrec = genericLiftShowsPrec instance ToJSONFields1 Hash instance Evaluatable Hash where - eval t = Rval <$> (traverse (subtermValue >=> asPair) (hashElements t) >>= hash) + eval t = Rval . hash <$> traverse (subtermValue >=> asPair) (hashElements t) data KeyValue a = KeyValue { key :: !a, value :: !a } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) @@ -223,7 +223,7 @@ instance ToJSONFields1 KeyValue instance Evaluatable KeyValue where eval (fmap subtermValue -> KeyValue{..}) = - Rval <$> join (kvPair <$> key <*> value) + Rval <$> (kvPair <$> key <*> value) instance ToJSONFields1 Tuple @@ -235,7 +235,7 @@ instance Ord1 Tuple where liftCompare = genericLiftCompare instance Show1 Tuple where liftShowsPrec = genericLiftShowsPrec instance Evaluatable Tuple where - eval (Tuple cs) = Rval <$> (multiple =<< traverse subtermValue cs) + eval (Tuple cs) = Rval . multiple <$> traverse subtermValue cs newtype Set a = Set { setElements :: [a] } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) diff --git a/src/Data/Syntax/Statement.hs b/src/Data/Syntax/Statement.hs index 2e748adb6..d329c0509 100644 --- a/src/Data/Syntax/Statement.hs +++ b/src/Data/Syntax/Statement.hs @@ -231,7 +231,7 @@ instance Show1 NoOp where liftShowsPrec = genericLiftShowsPrec instance ToJSONFields1 NoOp instance Evaluatable NoOp where - eval _ = Rval <$> unit + eval _ = pure (Rval unit) -- Loops diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index 4d4c9d11f..8242b49df 100644 --- a/src/Language/Go/Syntax.hs +++ b/src/Language/Go/Syntax.hs @@ -71,7 +71,7 @@ instance Evaluatable Import where traceResolve (unPath importPath) path importedEnv <- maybe emptyEnv fst <$> isolate (require path) modifyEnv (mergeEnvs importedEnv) - Rval <$> unit + pure (Rval unit) -- | Qualified Import declarations (symbols are qualified in calling environment). @@ -96,7 +96,7 @@ instance Evaluatable QualifiedImport where importedEnv <- maybe emptyEnv fst <$> isolate (require p) modifyEnv (mergeEnvs importedEnv) makeNamespace alias addr Nothing - Rval <$> unit + pure (Rval unit) -- | Side effect only imports (no symbols made available to the calling environment). data SideEffectImport a = SideEffectImport { sideEffectImportFrom :: !ImportPath, sideEffectImportToken :: !a } @@ -113,7 +113,7 @@ instance Evaluatable SideEffectImport where paths <- resolveGoImport importPath traceResolve (unPath importPath) paths for_ paths $ \path -> isolate (require path) - Rval <$> unit + pure (Rval unit) -- A composite literal in Go data Composite a = Composite { compositeType :: !a, compositeElement :: !a } diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index 29abe803a..12b1f01f3 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -71,7 +71,7 @@ include pathTerm f = do name <- subtermValue pathTerm >>= asString path <- resolvePHPName name traceResolve name path - (importedEnv, v) <- isolate (f path) >>= maybeM ((,) emptyEnv <$> unit) + (importedEnv, v) <- isolate (f path) $> (emptyEnv, unit) modifyEnv (mergeEnvs importedEnv) pure (Rval v) diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index 5358af741..4d26143a5 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -119,7 +119,7 @@ instance Evaluatable Import where let path = NonEmpty.last modulePaths importedEnv <- maybe emptyEnv fst <$> isolate (require path) modifyEnv (mergeEnvs (select importedEnv)) - Rval <$> unit + pure (Rval unit) where select importedEnv | Prologue.null xs = importedEnv @@ -142,8 +142,7 @@ evalQualifiedImport :: ( AbstractValue location value effects evalQualifiedImport name path = letrec' name $ \addr -> do importedEnv <- maybe emptyEnv fst <$> isolate (require path) modifyEnv (mergeEnvs importedEnv) - void $ makeNamespace name addr Nothing - unit + unit <$ makeNamespace name addr Nothing newtype QualifiedImport a = QualifiedImport { qualifiedImportFrom :: QualifiedName } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) @@ -192,8 +191,7 @@ instance Evaluatable QualifiedAliasedImport where let path = NonEmpty.last modulePaths importedEnv <- maybe emptyEnv fst <$> isolate (require path) modifyEnv (mergeEnvs importedEnv) - void $ makeNamespace alias addr Nothing - unit) + unit <$ makeNamespace alias addr Nothing) -- | Ellipsis (used in splice expressions and alternatively can be used as a fill in expression, like `undefined` in Haskell) data Ellipsis a = Ellipsis diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index 56e8532ef..b7bbacbc7 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -85,8 +85,8 @@ doRequire :: ( AbstractValue location value effects doRequire path = do result <- join <$> lookupModule path case result of - Nothing -> (,) . maybe emptyEnv fst <$> load path <*> boolean True - Just (env, _) -> (,) env <$> boolean False + Nothing -> (,) . maybe emptyEnv fst <$> load path <*> pure (boolean True) + Just (env, _) -> pure (env, boolean False) newtype Load a = Load { loadArgs :: [a] } @@ -124,7 +124,7 @@ doLoad path shouldWrap = do traceResolve path path' importedEnv <- maybe emptyEnv fst <$> isolate (load path') unless shouldWrap $ modifyEnv (mergeEnvs importedEnv) - boolean Prelude.True -- load always returns true. http://ruby-doc.org/core-2.5.0/Kernel.html#method-i-load + pure (boolean Prelude.True) -- load always returns true. http://ruby-doc.org/core-2.5.0/Kernel.html#method-i-load -- TODO: autoload diff --git a/src/Language/TypeScript/Syntax.hs b/src/Language/TypeScript/Syntax.hs index a2657e029..74bb08c29 100644 --- a/src/Language/TypeScript/Syntax.hs +++ b/src/Language/TypeScript/Syntax.hs @@ -150,8 +150,7 @@ evalRequire :: ( AbstractValue location value effects evalRequire modulePath alias = letrec' alias $ \addr -> do importedEnv <- maybe emptyEnv fst <$> isolate (require modulePath) modifyEnv (mergeEnvs importedEnv) - void $ makeNamespace alias addr Nothing - unit + unit <$ makeNamespace alias addr Nothing data Import a = Import { importSymbols :: ![(Name, Name)], importFrom :: ImportPath } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) @@ -167,7 +166,7 @@ instance Evaluatable Import where eval (Import symbols importPath) = do modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions importedEnv <- maybe emptyEnv fst <$> isolate (require modulePath) - modifyEnv (mergeEnvs (renamed importedEnv)) *> (Rval <$> unit) + modifyEnv (mergeEnvs (renamed importedEnv)) *> (pure (Rval unit)) where renamed importedEnv | Prologue.null symbols = importedEnv @@ -217,7 +216,7 @@ instance Evaluatable SideEffectImport where eval (SideEffectImport importPath) = do modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions void $ isolate (require modulePath) - Rval <$> unit + pure (Rval unit) -- | Qualified Export declarations @@ -235,7 +234,7 @@ instance Evaluatable QualifiedExport where -- Insert the aliases with no addresses. for_ exportSymbols $ \(name, alias) -> addExport name alias Nothing - Rval <$> unit + pure (Rval unit) -- | Qualified Export declarations that export from another module. @@ -256,7 +255,7 @@ instance Evaluatable QualifiedExportFrom where for_ exportSymbols $ \(name, alias) -> do let address = Env.lookup name importedEnv maybe (throwEvalError $ ExportError modulePath name) (addExport name alias . Just) address - Rval <$> unit + pure (Rval unit) newtype DefaultExport a = DefaultExport { defaultExport :: a } deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) @@ -277,7 +276,7 @@ instance Evaluatable DefaultExport where addExport name name Nothing void $ modifyEnv (Env.insert name addr) Nothing -> throwEvalError DefaultExportError - Rval <$> unit + pure (Rval unit) -- | Lookup type for a type-level key in a typescript map. From 0de3bb8ccc1be1eeea0da619ceadd86f516a7262 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 13:45:24 -0400 Subject: [PATCH 063/148] :fire: a redundant effect. --- src/Data/Abstract/Value.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 3e5a3d62b..33da80785 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -46,7 +46,6 @@ instance AbstractHole (Value location body) where hole = Hole instance ( Members '[ Allocator location (Value location body) - , Reader (Environment location) , Reader ModuleInfo , Reader PackageInfo , Resumable (ValueError location body) From 02d38ca076298826d5d5d162c84d3ad7aa526834 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 13:48:49 -0400 Subject: [PATCH 064/148] Only import what we need from Text.Show.Pretty. --- src/Semantic/Util.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 3a5c1fab0..2d5317d21 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -27,7 +27,7 @@ import Semantic.Graph import Semantic.IO as IO import Semantic.Task import Text.Show (showListWith) -import Text.Show.Pretty +import Text.Show.Pretty (ppShow) import qualified Language.Python.Assignment as Python import qualified Language.Ruby.Assignment as Ruby From 60ea60f67b10af7d630ef9d1d6d834b5f22d9afa Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 13:48:58 -0400 Subject: [PATCH 065/148] :fire: evaluatingWithHoles. --- src/Semantic/Util.hs | 14 -------------- 1 file changed, 14 deletions(-) diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index 2d5317d21..dbe2d5377 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -47,19 +47,6 @@ justEvaluating . runTermEvaluator @_ @Precise . runValueError -evaluatingWithHoles - = runM - . evaluating - . runPrintingTrace - . resumingLoadError - . resumingUnspecialized - . resumingEnvironmentError - . resumingEvalError - . resumingResolutionError - . resumingAddressError - . runTermEvaluator @_ @Precise - . resumingValueError - checking = runM @_ @IO . evaluating @@ -80,7 +67,6 @@ evalRubyProject path = justEvaluating =<< evaluateProject rubyParser Language.Ru evalPHPProject path = justEvaluating =<< evaluateProject phpParser Language.PHP Nothing path evalPythonProject path = justEvaluating =<< evaluateProject pythonParser Language.Python pythonPrelude path evalJavaScriptProject path = justEvaluating =<< evaluateProject typescriptParser Language.JavaScript javaScriptPrelude path -evalTypeScriptProjectQuietly path = evaluatingWithHoles =<< evaluateProject typescriptParser Language.TypeScript Nothing path evalTypeScriptProject path = justEvaluating =<< evaluateProject typescriptParser Language.TypeScript Nothing path typecheckGoFile path = checking =<< evaluateProjectWithCaching goParser Language.Go Nothing path From 282c02fbbd68ad39d287348180fa6398918f1146 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 14:11:08 -0400 Subject: [PATCH 066/148] Embed the evaluating action into the closure body. --- src/Data/Abstract/Value.hs | 31 ++++++++++++++++++++----------- src/Semantic/Graph.hs | 6 +++--- src/Semantic/Util.hs | 2 +- test/SpecHelpers.hs | 2 +- 4 files changed, 25 insertions(+), 16 deletions(-) diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 33da80785..b0188e29b 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -6,6 +6,7 @@ import Data.Abstract.Environment (Environment, emptyEnv, mergeEnvs) import qualified Data.Abstract.Environment as Env import Data.Abstract.Name import qualified Data.Abstract.Number as Number +import Data.Coerce import Data.List (genericIndex, genericLength) import Data.Scientific (Scientific) import Data.Scientific.Exts @@ -32,8 +33,16 @@ data Value location body | Hole deriving (Eq, Ord, Show) -data ClosureBody location body = ClosureBody Label - deriving (Eq, Ord, Show) +data ClosureBody location body = ClosureBody (body (Value location body)) + +instance Eq (ClosureBody location body) where + _ == _ = True + +instance Ord (ClosureBody location body) where + _ `compare` _ = EQ + +instance Show (ClosureBody location body) where + showsPrec d (ClosureBody _) = showsUnaryWith (const showChar) "ClosureBody" d '_' instance Ord location => ValueRoots location (Value location body) where @@ -45,7 +54,8 @@ instance Ord location => ValueRoots location (Value location body) where instance AbstractHole (Value location body) where hole = Hole -instance ( Members '[ Allocator location (Value location body) +instance ( Coercible body (Eff effects) + , Members '[ Allocator location (Value location body) , Reader ModuleInfo , Reader PackageInfo , Resumable (ValueError location body) @@ -57,17 +67,15 @@ instance ( Members '[ Allocator location (Value location body) , Reducer (Value location body) (Cell location (Value location body)) , Show location ) - => AbstractFunction location (Value location body) (Goto effects (Value location body) ': effects) where + => AbstractFunction location (Value location body) effects where closure parameters freeVariables body = do packageInfo <- currentPackage moduleInfo <- currentModule - l <- label body - Closure packageInfo moduleInfo parameters (ClosureBody l) . Env.bind (foldr Set.delete freeVariables parameters) <$> getEnv + Closure packageInfo moduleInfo parameters (ClosureBody (coerce (lowerEff body))) . Env.bind (foldr Set.delete freeVariables parameters) <$> getEnv call op params = do case op of - Closure packageInfo moduleInfo names (ClosureBody label) env -> do - body <- goto label + Closure packageInfo moduleInfo names (ClosureBody body) env -> do -- Evaluate the bindings and body with the closure’s package/module info in scope in order to -- charge them to the closure's origin. withCurrentPackage packageInfo . withCurrentModule moduleInfo $ do @@ -76,7 +84,7 @@ instance ( Members '[ Allocator location (Value location body) a <- alloc name assign a v Env.insert name a <$> rest) (pure env) (zip names params) - localEnv (mergeEnvs bindings) (body `catchReturn` \ (Return value) -> pure value) + localEnv (mergeEnvs bindings) (raiseEff (coerce body) `catchReturn` \ (Return value) -> pure value) _ -> throwValueError (CallError op) @@ -99,7 +107,8 @@ instance Show location => AbstractIntro (Value location body) where -- | Construct a 'Value' wrapping the value arguments (if any). -instance ( Members '[ Allocator location (Value location body) +instance ( Coercible body (Eff effects) + , Members '[ Allocator location (Value location body) , LoopControl (Value location body) , Reader (Environment location) , Reader ModuleInfo @@ -113,7 +122,7 @@ instance ( Members '[ Allocator location (Value location body) , Reducer (Value location body) (Cell location (Value location body)) , Show location ) - => AbstractValue location (Value location body) (Goto effects (Value location body) ': effects) where + => AbstractValue location (Value location body) effects where asPair val | KVPair k v <- val = pure (k, v) | otherwise = throwValueError $ KeyValueError val diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 684177422..b89ecbb4c 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -66,8 +66,8 @@ runGraph graphType includePackages project . resumingEvalError . resumingResolutionError . resumingAddressError - . runTermEvaluator @_ @_ @(Value (Located Precise) _) . resumingValueError + . runTermEvaluator @_ @_ @(Value (Located Precise) (Eff _)) . graphing -- | Parse a list of files into a 'Package'. @@ -129,7 +129,7 @@ resumingAddressError = runAddressErrorWith (\ err -> trace ("AddressError:" <> s UnallocatedAddress _ -> pure lowerBound UninitializedAddress _ -> pure hole) -resumingValueError :: (Members '[State (Environment location), Trace] effects, Show location) => TermEvaluator term location (Value location term) (Resumable (ValueError location term) ': effects) a -> TermEvaluator term location (Value location term) effects a +resumingValueError :: (Members '[State (Environment location), Trace] effects, Show location) => Evaluator location (Value location body) (Resumable (ValueError location body) ': effects) a -> Evaluator location (Value location body) effects a resumingValueError = runValueErrorWith (\ err -> trace ("ValueError" <> show err) *> case err of CallError val -> pure val StringError val -> pure (pack (show val)) @@ -139,7 +139,7 @@ resumingValueError = runValueErrorWith (\ err -> trace ("ValueError" <> show err NumericError{} -> pure hole Numeric2Error{} -> pure hole ComparisonError{} -> pure hole - NamespaceError{} -> TermEvaluator getEnv + NamespaceError{} -> getEnv BitwiseError{} -> pure hole Bitwise2Error{} -> pure hole KeyValueError{} -> pure (hole, hole) diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index dbe2d5377..e032419de 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -44,7 +44,7 @@ justEvaluating . runEnvironmentError . runEvalError . runAddressError - . runTermEvaluator @_ @Precise + . runTermEvaluator @_ @Precise @(Value Precise (Eff _)) . runValueError checking diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs index 834d3d7dc..49eec19db 100644 --- a/test/SpecHelpers.hs +++ b/test/SpecHelpers.hs @@ -89,8 +89,8 @@ testEvaluating . runEnvironmentError . runEvalError . runAddressError - . runTermEvaluator @_ @_ @(Value Precise _) . runValueError + . runTermEvaluator @_ @_ @(Value Precise (Eff _)) deNamespace :: Value Precise term -> Maybe (Name, [Name]) deNamespace (Namespace name scope) = Just (name, Env.names scope) From c3999b6acf452ea8cf927ce81fc7ce3a3847bbda Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 14:12:48 -0400 Subject: [PATCH 067/148] :fire: the Gotos effect in evaluatePackageWith. --- src/Data/Abstract/Evaluatable.hs | 15 ++++----------- 1 file changed, 4 insertions(+), 11 deletions(-) diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 804bfe3e4..884e2514b 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -78,9 +78,9 @@ type EvaluatableConstraints location term value effects = -- | Evaluate a given package. -evaluatePackageWith :: forall location term value inner inner' outer +evaluatePackageWith :: forall location term value inner outer -- FIXME: It’d be nice if we didn’t have to mention 'Addressable' here at all, but 'Located' locations require knowledge of 'currentModule' to run. Can we fix that? If not, can we factor this effect list out? - . ( Addressable location (Reader ModuleInfo ': Modules location value ': State (Gotos location value (Reader Span ': Reader PackageInfo ': outer)) ': Reader Span ': Reader PackageInfo ': outer) + . ( Addressable location (Reader ModuleInfo ': Modules location value ': Reader Span ': Reader PackageInfo ': outer) , Evaluatable (Base term) , EvaluatableConstraints location term value inner , Members '[ Fail @@ -95,8 +95,7 @@ evaluatePackageWith :: forall location term value inner inner' outer , Trace ] outer , Recursive term - , inner ~ (Goto inner' value ': inner') - , inner' ~ (Primitive ': LoopControl value ': Return value ': Allocator location value ': Reader ModuleInfo ': Modules location value ': State (Gotos location value (Reader Span ': Reader PackageInfo ': outer)) ': Reader Span ': Reader PackageInfo ': outer) + , inner ~ (Primitive ': LoopControl value ': Return value ': Allocator location value ': Reader ModuleInfo ': Modules location value ': Reader Span ': Reader PackageInfo ': outer) ) => (SubtermAlgebra Module term (TermEvaluator term location value inner value) -> SubtermAlgebra Module term (TermEvaluator term location value inner value)) -> (SubtermAlgebra (Base term) term (TermEvaluator term location value inner (ValueRef value)) -> SubtermAlgebra (Base term) term (TermEvaluator term location value inner (ValueRef value))) @@ -105,8 +104,6 @@ evaluatePackageWith :: forall location term value inner inner' outer evaluatePackageWith analyzeModule analyzeTerm package = runReader (packageInfo package) . runReader lowerBound - . fmap fst - . runState (lowerBound :: Gotos location value (Reader Span ': Reader PackageInfo ': outer)) . runReader (packageModules (packageBody package)) . withPrelude (packagePrelude (packageBody package)) . raiseHandler (runModules (runTermEvaluator . evalModule)) @@ -125,9 +122,8 @@ evaluatePackageWith analyzeModule analyzeTerm package . raiseHandler runReturn . raiseHandler runLoopControl . runPrimitive - . raiseHandler (runGoto Gotos getGotos) - evaluateEntryPoint :: ModulePath -> Maybe Name -> TermEvaluator term location value (Modules location value ': State (Gotos location value (Reader Span ': Reader PackageInfo ': outer)) ': Reader Span ': Reader PackageInfo ': outer) value + evaluateEntryPoint :: ModulePath -> Maybe Name -> TermEvaluator term location value (Modules location value ': Reader Span ': Reader PackageInfo ': outer) value evaluateEntryPoint m sym = runInModule (ModuleInfo m) . TermEvaluator $ do v <- maybe unit snd <$> require m maybe (pure v) ((`call` []) <=< variable) sym @@ -149,9 +145,6 @@ evaluatePackageWith analyzeModule analyzeTerm package | otherwise = Exports.toEnvironment ports `mergeEnvs` overwrite (Exports.aliases ports) env pairValueWithEnv action = flip (,) <$> action <*> (filterEnv <$> TermEvaluator getExports <*> TermEvaluator getEnv) -newtype Gotos location value outer = Gotos { getGotos :: GotoTable (Primitive ': LoopControl value ': Return value ': Allocator location value ': Reader ModuleInfo ': Modules location value ': State (Gotos location value outer) ': outer) value } - deriving (Lower) - -- | Isolate the given action with an empty global environment and exports. isolate :: Members '[State (Environment location), State (Exports location)] effects => Evaluator location value effects a -> Evaluator location value effects a From b3b47a34df7ef313b9751dda10dc8e1709304c9e Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 14:42:46 -0400 Subject: [PATCH 068/148] :fire: Goto. --- semantic.cabal | 1 - src/Control/Abstract.hs | 1 - src/Control/Abstract/Goto.hs | 79 ------------------------- test/Control/Abstract/Evaluator/Spec.hs | 7 --- 4 files changed, 88 deletions(-) delete mode 100644 src/Control/Abstract/Goto.hs diff --git a/semantic.cabal b/semantic.cabal index 21a28c40a..c9173ab45 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -42,7 +42,6 @@ library , Control.Abstract.Environment , Control.Abstract.Evaluator , Control.Abstract.Exports - , Control.Abstract.Goto , Control.Abstract.Heap , Control.Abstract.Matching , Control.Abstract.Modules diff --git a/src/Control/Abstract.hs b/src/Control/Abstract.hs index a8b00273d..8347be485 100644 --- a/src/Control/Abstract.hs +++ b/src/Control/Abstract.hs @@ -9,7 +9,6 @@ import Control.Abstract.Environment as X import Control.Abstract.Evaluator as X import Control.Abstract.Exports as X import Control.Abstract.Heap as X -import Control.Abstract.Goto as X import Control.Abstract.Modules as X import Control.Abstract.Primitive as X import Control.Abstract.Roots as X diff --git a/src/Control/Abstract/Goto.hs b/src/Control/Abstract/Goto.hs deleted file mode 100644 index 7e8b3bc2b..000000000 --- a/src/Control/Abstract/Goto.hs +++ /dev/null @@ -1,79 +0,0 @@ -{-# LANGUAGE GADTs, TypeOperators #-} -module Control.Abstract.Goto -( GotoTable -, Label -, label -, goto -, Goto(..) -, runGoto -) where - -import Control.Abstract.Evaluator -import Control.Monad.Effect.Internal -import qualified Data.IntMap as IntMap -import Prelude hiding (fail) -import Prologue - -type GotoTable inner value = IntMap.IntMap (Eff (Goto inner value ': inner) value) - --- | The type of labels. --- TODO: This should be rolled into 'Name' and tracked in the environment, both so that we can abstract over labels like any other location, and so that we can garbage collect unreachable labels. -type Label = Int - - --- | Allocate a 'Label' for the given @term@. --- --- Labels must be allocated before being jumped to with 'goto', but are suitable for nonlocal jumps; thus, they can be used to implement coroutines, exception handling, call with current continuation, and other esoteric control mechanisms. -label :: Evaluator location value (Goto effects value ': effects) value -> Evaluator location value (Goto effects value ': effects) Label -label = send . Label . lowerEff - --- | “Jump” to a previously-allocated 'Label' (retrieving the @term@ at which it points, which can then be evaluated. -goto :: Label -> Evaluator location value (Goto effects value ': effects) (Evaluator location value (Goto effects value ': effects) value) -goto = fmap raiseEff . send . Goto - - --- | 'Goto' effects embed an 'Eff' action which can be run in the environment under the 'Goto' itself. --- --- It’s tempting to try to use a 'Member' constraint to require a 'Goto' effect: --- --- @ --- foo :: Member (Goto effects a) effects => Eff effects a --- @ --- --- However, using this type would require that the type of the effect list include a reference to itself, which is forbidden by the occurs check: we wouldn’t be able to write a handler for 'Goto' if it could be used at that type. Instead, one can either use a smaller, statically known effect list inside the 'Goto', e.g. @Member (Goto outer) inner@ where @outer@ is a suffix of @inner@ (and with some massaging to raise the @outer@ actions into the @inner@ context), or use 'Goto' when it’s statically known to be the head of the list: @Eff (Goto rest a ': rest) b@. In either case, the 'Eff' actions embedded in the effect are themselves able to contain further 'Goto' effects, -data Goto effects value return where - Label :: Eff (Goto effects value ': effects) value -> Goto effects value Label - Goto :: Label -> Goto effects value (Eff (Goto effects value ': effects) value) - --- | Run a 'Goto' effect in terms of a 'State' effect holding a 'GotoTable', accessed via wrap/unwrap functions. --- --- The wrap/unwrap functions are necessary in order for ghc to be able to typecheck the table, since it necessarily contains references to its own effect list. Since @GotoTable (… ': State (GotoTable … value) ': …) value@ can’t be written, and a recursive type equality constraint won’t typecheck, callers will need to employ a @newtype@ to break the self-reference. The effect list of the table the @newtype@ contains will include all of the effects between the 'Goto' effect and the 'State' effect (including the 'State' but not the 'Goto'). E.g. if the 'State' is the next effect, a valid wrapper would be∷ --- --- @ --- newtype Gotos effects value = Gotos { getGotos :: GotoTable (State (Gotos effects value) ': effects) value } --- @ --- --- Callers can then evaluate the high-level 'Goto' effect by passing @Gotos@ and @getGotos@ to 'runGoto'. -runGoto :: ( Effectful (m location value) - , Members '[ Fail - , Fresh - , State table - ] effects - ) - => (GotoTable effects value -> table) - -> (table -> GotoTable effects value) - -> m location value (Goto effects value ': effects) a - -> m location value effects a -runGoto from to = raiseHandler (interpret (\ goto -> do - table <- to <$> getTable - case goto of - Label action -> do - supremum <- fresh - supremum <$ putTable (from (IntMap.insert supremum action table)) - Goto label -> maybeM (raiseEff (fail ("unknown label: " <> show label))) (IntMap.lookup label table))) - -getTable :: (Effectful m, Member (State table) effects) => m effects table -getTable = get - -putTable :: (Effectful m, Member (State table) effects) => table -> m effects () -putTable = put diff --git a/test/Control/Abstract/Evaluator/Spec.hs b/test/Control/Abstract/Evaluator/Spec.hs index 9f083f977..e6cfb00b7 100644 --- a/test/Control/Abstract/Evaluator/Spec.hs +++ b/test/Control/Abstract/Evaluator/Spec.hs @@ -34,19 +34,12 @@ evaluate . evaluating @Precise @(Value Precise ()) . runReader (PackageInfo (name "test") Nothing mempty) . runReader (ModuleInfo "test/Control/Abstract/Evaluator/Spec.hs") - . runTermEvaluator @() @Precise @(Value Precise ()) . Value.runValueError - . TermEvaluator @() @Precise @(Value Precise ()) . runEnvironmentError . runAddressError . runAllocator . runReturn . runLoopControl - . fmap fst - . runState (Gotos lowerBound) - . runGoto Gotos getGotos - -newtype Gotos effects = Gotos { getGotos :: GotoTable (State (Gotos effects) ': effects) (Value Precise ()) } reassociate :: Either Prelude.String (Either (SomeExc exc1) (Either (SomeExc exc2) (Either (SomeExc exc3) result))) -> Either (SomeExc (Sum '[Const Prelude.String, exc1, exc2, exc3])) result reassociate (Left s) = Left (SomeExc (inject (Const s))) From 89b90496b746781a67e5ae6d782ecb5b0532ab9a Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 14:47:20 -0400 Subject: [PATCH 069/148] =?UTF-8?q?Don=E2=80=99t=20qualify=20this=20name.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- test/Control/Abstract/Evaluator/Spec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Control/Abstract/Evaluator/Spec.hs b/test/Control/Abstract/Evaluator/Spec.hs index e6cfb00b7..7c3838d72 100644 --- a/test/Control/Abstract/Evaluator/Spec.hs +++ b/test/Control/Abstract/Evaluator/Spec.hs @@ -34,7 +34,7 @@ evaluate . evaluating @Precise @(Value Precise ()) . runReader (PackageInfo (name "test") Nothing mempty) . runReader (ModuleInfo "test/Control/Abstract/Evaluator/Spec.hs") - . Value.runValueError + . runValueError . runEnvironmentError . runAddressError . runAllocator From cc02cfd8eb941886c2fbccdc26610393407d9ddd Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 14:47:42 -0400 Subject: [PATCH 070/148] AbstractIntro is pure. --- test/Control/Abstract/Evaluator/Spec.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/Control/Abstract/Evaluator/Spec.hs b/test/Control/Abstract/Evaluator/Spec.hs index 7c3838d72..f46e969c8 100644 --- a/test/Control/Abstract/Evaluator/Spec.hs +++ b/test/Control/Abstract/Evaluator/Spec.hs @@ -19,13 +19,13 @@ import SpecHelpers hiding (reassociate) spec :: Spec spec = parallel $ do it "constructs integers" $ do - (expected, _) <- evaluate (integer 123) + (expected, _) <- evaluate (pure (integer 123)) expected `shouldBe` Right (Value.Integer (Number.Integer 123)) it "calls functions" $ do (expected, _) <- evaluate $ do identity <- closure [name "x"] lowerBound (variable (name "x")) - call identity [integer 123] + call identity [pure (integer 123)] expected `shouldBe` Right (Value.Integer (Number.Integer 123)) evaluate From f0c220906a5a5cf2bcdbb6887a9220369061875b Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 14:48:00 -0400 Subject: [PATCH 071/148] Partially apply Eff in the tests. --- test/Analysis/Ruby/Spec.hs | 2 +- test/Control/Abstract/Evaluator/Spec.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/test/Analysis/Ruby/Spec.hs b/test/Analysis/Ruby/Spec.hs index 1f8b235cb..46089bfbd 100644 --- a/test/Analysis/Ruby/Spec.hs +++ b/test/Analysis/Ruby/Spec.hs @@ -30,7 +30,7 @@ spec = parallel $ do it "evaluates load with wrapper" $ do ((res, state), _) <- evaluate "load-wrap.rb" - res `shouldBe` Left (SomeExc (inject @(EnvironmentError (Value Precise (Quieterm (Sum Ruby.Syntax) (Record Location)))) (FreeVariable "foo"))) + res `shouldBe` Left (SomeExc (inject @(EnvironmentError (Value Precise (Eff _))) (FreeVariable "foo"))) Env.names (environment state) `shouldContain` [ "Object" ] it "evaluates subclass" $ do diff --git a/test/Control/Abstract/Evaluator/Spec.hs b/test/Control/Abstract/Evaluator/Spec.hs index f46e969c8..ddfb4c016 100644 --- a/test/Control/Abstract/Evaluator/Spec.hs +++ b/test/Control/Abstract/Evaluator/Spec.hs @@ -31,7 +31,7 @@ spec = parallel $ do evaluate = runM . fmap (first reassociate) - . evaluating @Precise @(Value Precise ()) + . evaluating @Precise @(Value Precise (Eff _)) . runReader (PackageInfo (name "test") Nothing mempty) . runReader (ModuleInfo "test/Control/Abstract/Evaluator/Spec.hs") . runValueError From d08802f688e86582fbcc389221ee02c9c073872b Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 14:53:20 -0400 Subject: [PATCH 072/148] Spacing. --- src/Data/Abstract/Value.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index b0188e29b..93f81e3ee 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -105,7 +105,6 @@ instance Show location => AbstractIntro (Value location body) where null = Null - -- | Construct a 'Value' wrapping the value arguments (if any). instance ( Coercible body (Eff effects) , Members '[ Allocator location (Value location body) From 484b956ce789ba25fd6961e16e57f1b69c3035f7 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 15:09:10 -0400 Subject: [PATCH 073/148] Add a module for holes. --- semantic.cabal | 1 + src/Control/Abstract/Hole.hs | 1 + 2 files changed, 2 insertions(+) create mode 100644 src/Control/Abstract/Hole.hs diff --git a/semantic.cabal b/semantic.cabal index c9173ab45..fbc35daf1 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -43,6 +43,7 @@ library , Control.Abstract.Evaluator , Control.Abstract.Exports , Control.Abstract.Heap + , Control.Abstract.Hole , Control.Abstract.Matching , Control.Abstract.Modules , Control.Abstract.Primitive diff --git a/src/Control/Abstract/Hole.hs b/src/Control/Abstract/Hole.hs new file mode 100644 index 000000000..32539968c --- /dev/null +++ b/src/Control/Abstract/Hole.hs @@ -0,0 +1 @@ +module Control.Abstract.Hole where From b26c9babbcc7290ed4dc57d7f1e480ae2a8fb184 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 15:09:49 -0400 Subject: [PATCH 074/148] Move AbstractHole into its own module. --- src/Control/Abstract.hs | 1 + src/Control/Abstract/Hole.hs | 3 +++ src/Control/Abstract/Value.hs | 5 ----- 3 files changed, 4 insertions(+), 5 deletions(-) diff --git a/src/Control/Abstract.hs b/src/Control/Abstract.hs index 8347be485..681a3dd13 100644 --- a/src/Control/Abstract.hs +++ b/src/Control/Abstract.hs @@ -9,6 +9,7 @@ import Control.Abstract.Environment as X import Control.Abstract.Evaluator as X import Control.Abstract.Exports as X import Control.Abstract.Heap as X +import Control.Abstract.Hole as X import Control.Abstract.Modules as X import Control.Abstract.Primitive as X import Control.Abstract.Roots as X diff --git a/src/Control/Abstract/Hole.hs b/src/Control/Abstract/Hole.hs index 32539968c..4120e26f8 100644 --- a/src/Control/Abstract/Hole.hs +++ b/src/Control/Abstract/Hole.hs @@ -1 +1,4 @@ module Control.Abstract.Hole where + +class AbstractHole a where + hole :: a diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index 86b05e408..c7d2b6d4c 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -3,7 +3,6 @@ module Control.Abstract.Value ( AbstractValue(..) , AbstractIntro(..) , AbstractFunction(..) -, AbstractHole(..) , Comparator(..) , asBool , while @@ -42,10 +41,6 @@ data Comparator = Concrete (forall a . Ord a => a -> a -> Bool) | Generalized -class AbstractHole value where - hole :: value - - class Show value => AbstractFunction location value effects where -- | Build a closure (a binder like a lambda or method definition). closure :: [Name] -- ^ The parameter names. From 4d2b235fc6a43a92bc908caa8fdd4f78bb82e4cd Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 15:12:40 -0400 Subject: [PATCH 075/148] Stub in a datatype for holes. --- src/Control/Abstract/Hole.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Control/Abstract/Hole.hs b/src/Control/Abstract/Hole.hs index 4120e26f8..98039f216 100644 --- a/src/Control/Abstract/Hole.hs +++ b/src/Control/Abstract/Hole.hs @@ -2,3 +2,7 @@ module Control.Abstract.Hole where class AbstractHole a where hole :: a + + +data Hole a = Partial | Total a + deriving (Foldable, Functor, Eq, Ord, Show, Traversable) From f9d7eb467745bdaa4b7a3c01479ada08af13a665 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 15:16:36 -0400 Subject: [PATCH 076/148] Generalize relocate. --- src/Control/Abstract/Addressable.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Control/Abstract/Addressable.hs b/src/Control/Abstract/Addressable.hs index ccadd1736..6f1db9544 100644 --- a/src/Control/Abstract/Addressable.hs +++ b/src/Control/Abstract/Addressable.hs @@ -39,5 +39,5 @@ instance (Addressable location effects, Members '[Reader ModuleInfo, Reader Pack allocCell name = relocate (Located <$> allocCell name <*> currentPackage <*> currentModule) derefCell (Address (Located loc _ _)) = relocate . derefCell (Address loc) -relocate :: Evaluator location value effects a -> Evaluator (Located location) value effects a +relocate :: Evaluator location1 value effects a -> Evaluator location2 value effects a relocate = raiseEff . lowerEff From 9feb1fe4a572c82abdbd3a1d8c0704384ab733f2 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 15:17:55 -0400 Subject: [PATCH 077/148] Define an Addressable instance for Hole. --- src/Control/Abstract/Addressable.hs | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/src/Control/Abstract/Addressable.hs b/src/Control/Abstract/Addressable.hs index 6f1db9544..dfd82b1cb 100644 --- a/src/Control/Abstract/Addressable.hs +++ b/src/Control/Abstract/Addressable.hs @@ -5,6 +5,7 @@ module Control.Abstract.Addressable import Control.Abstract.Context import Control.Abstract.Evaluator +import Control.Abstract.Hole import Data.Abstract.Address import Data.Abstract.Name import Prologue @@ -39,5 +40,12 @@ instance (Addressable location effects, Members '[Reader ModuleInfo, Reader Pack allocCell name = relocate (Located <$> allocCell name <*> currentPackage <*> currentModule) derefCell (Address (Located loc _ _)) = relocate . derefCell (Address loc) +instance Addressable location effects => Addressable (Hole location) effects where + type Cell (Hole location) = Cell location + + allocCell name = relocate (Total <$> allocCell name) + derefCell (Address (Total loc)) = relocate . derefCell (Address loc) + derefCell (Address Partial) = const (pure Nothing) + relocate :: Evaluator location1 value effects a -> Evaluator location2 value effects a relocate = raiseEff . lowerEff From c92e6cf0058e5c664873ae1dd9940e0ae53e78ff Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 15:19:01 -0400 Subject: [PATCH 078/148] Define an AbstractHole instance for Hole. --- src/Control/Abstract/Hole.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Control/Abstract/Hole.hs b/src/Control/Abstract/Hole.hs index 98039f216..08619842f 100644 --- a/src/Control/Abstract/Hole.hs +++ b/src/Control/Abstract/Hole.hs @@ -6,3 +6,6 @@ class AbstractHole a where data Hole a = Partial | Total a deriving (Foldable, Functor, Eq, Ord, Show, Traversable) + +instance AbstractHole (Hole a) where + hole = Partial From d0e8b8eae30bc115c08b1312e703867c200c8061 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 15:27:02 -0400 Subject: [PATCH 079/148] Define a helper to convert Holes to Maybes. --- src/Control/Abstract/Hole.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Control/Abstract/Hole.hs b/src/Control/Abstract/Hole.hs index 08619842f..04ada8531 100644 --- a/src/Control/Abstract/Hole.hs +++ b/src/Control/Abstract/Hole.hs @@ -9,3 +9,7 @@ data Hole a = Partial | Total a instance AbstractHole (Hole a) where hole = Partial + +toMaybe :: Hole a -> Maybe a +toMaybe Partial = Nothing +toMaybe (Total a) = Just a From 0354dc5330b7b1f17ecbeedb5c852c345f63e7a0 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 15:29:24 -0400 Subject: [PATCH 080/148] Resume EnvironmentError at location, not value. --- src/Analysis/Abstract/Caching.hs | 2 +- src/Analysis/Abstract/Graph.hs | 16 ++++++++-------- src/Control/Abstract/Environment.hs | 18 +++++++++--------- src/Control/Abstract/Heap.hs | 4 ++-- src/Control/Abstract/Primitive.hs | 2 +- src/Control/Abstract/Value.hs | 4 ++-- src/Data/Abstract/Evaluatable.hs | 2 +- src/Language/PHP/Syntax.hs | 2 +- src/Semantic/Graph.hs | 4 ++-- 9 files changed, 27 insertions(+), 27 deletions(-) diff --git a/src/Analysis/Abstract/Caching.hs b/src/Analysis/Abstract/Caching.hs index 8001ec6e1..4f0ccc35f 100644 --- a/src/Analysis/Abstract/Caching.hs +++ b/src/Analysis/Abstract/Caching.hs @@ -87,7 +87,7 @@ convergingModules :: ( AbstractValue location value effects , Reader (Environment location) , Reader (Live location value) , Resumable (AddressError location value) - , Resumable (EnvironmentError value) + , Resumable (EnvironmentError location) , State (Cache term location (Cell location) value) , State (Environment location) , State (Heap location (Cell location) value) diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs index 92fb73528..182e8be58 100644 --- a/src/Analysis/Abstract/Graph.hs +++ b/src/Analysis/Abstract/Graph.hs @@ -52,15 +52,15 @@ style = (defaultStyle (byteString . vertexName)) -- | Add vertices to the graph for evaluated identifiers. graphingTerms :: ( Element Syntax.Identifier syntax - , Members '[ Reader (Environment (Located location)) + , Members '[ Reader (Environment (Hole (Located location))) , Reader ModuleInfo - , State (Environment (Located location)) + , State (Environment (Hole (Located location))) , State (Graph Vertex) ] effects , term ~ Term (Sum syntax) ann ) - => SubtermAlgebra (Base term) term (TermEvaluator term (Located location) value effects a) - -> SubtermAlgebra (Base term) term (TermEvaluator term (Located location) value effects a) + => SubtermAlgebra (Base term) term (TermEvaluator term (Hole (Located location)) value effects a) + -> SubtermAlgebra (Base term) term (TermEvaluator term (Hole (Located location)) value effects a) graphingTerms recur term@(In _ syntax) = do case project syntax of Just (Syntax.Identifier name) -> do @@ -125,14 +125,14 @@ moduleInclusion v = do appendGraph (vertex (moduleVertex m) `connect` vertex v) -- | Add an edge from the passed variable name to the module it originated within. -variableDefinition :: ( Member (Reader (Environment (Located location))) effects - , Member (State (Environment (Located location))) effects +variableDefinition :: ( Member (Reader (Environment (Hole (Located location)))) effects + , Member (State (Environment (Hole (Located location)))) effects , Member (State (Graph Vertex)) effects ) => Name - -> TermEvaluator term (Located location) value effects () + -> TermEvaluator term (Hole (Located location)) value effects () variableDefinition name = do - graph <- maybe lowerBound (vertex . moduleVertex . locationModule . unAddress) <$> TermEvaluator (lookupEnv name) + graph <- maybe lowerBound (maybe lowerBound (vertex . moduleVertex . locationModule) . toMaybe . unAddress) <$> TermEvaluator (lookupEnv name) appendGraph (vertex (Variable (unName name)) `connect` graph) appendGraph :: (Effectful m, Member (State (Graph Vertex)) effects) => Graph Vertex -> m effects () diff --git a/src/Control/Abstract/Environment.hs b/src/Control/Abstract/Environment.hs index 08cb9b4db..dd500f3ff 100644 --- a/src/Control/Abstract/Environment.hs +++ b/src/Control/Abstract/Environment.hs @@ -71,19 +71,19 @@ lookupEnv name = (<|>) <$> (Env.lookup name <$> getEnv) <*> (Env.lookup name <$> -- | Errors involving the environment. -data EnvironmentError value return where - FreeVariable :: Name -> EnvironmentError value value +data EnvironmentError location return where + FreeVariable :: Name -> EnvironmentError location location -deriving instance Eq (EnvironmentError value return) -deriving instance Show (EnvironmentError value return) -instance Show1 (EnvironmentError value) where liftShowsPrec _ _ = showsPrec -instance Eq1 (EnvironmentError value) where liftEq _ (FreeVariable n1) (FreeVariable n2) = n1 == n2 +deriving instance Eq (EnvironmentError location return) +deriving instance Show (EnvironmentError location return) +instance Show1 (EnvironmentError location) where liftShowsPrec _ _ = showsPrec +instance Eq1 (EnvironmentError location) where liftEq _ (FreeVariable n1) (FreeVariable n2) = n1 == n2 -freeVariableError :: Member (Resumable (EnvironmentError value)) effects => Name -> Evaluator location value effects value +freeVariableError :: Member (Resumable (EnvironmentError location)) effects => Name -> Evaluator location value effects location freeVariableError = throwResumable . FreeVariable -runEnvironmentError :: Effectful (m location value) => m location value (Resumable (EnvironmentError value) ': effects) a -> m location value effects (Either (SomeExc (EnvironmentError value)) a) +runEnvironmentError :: Effectful (m location value) => m location value (Resumable (EnvironmentError location) ': effects) a -> m location value effects (Either (SomeExc (EnvironmentError location)) a) runEnvironmentError = runResumable -runEnvironmentErrorWith :: Effectful (m location value) => (forall resume . EnvironmentError value resume -> m location value effects resume) -> m location value (Resumable (EnvironmentError value) ': effects) a -> m location value effects a +runEnvironmentErrorWith :: Effectful (m location value) => (forall resume . EnvironmentError location resume -> m location value effects resume) -> m location value (Resumable (EnvironmentError location) ': effects) a -> m location value effects a runEnvironmentErrorWith = runResumableWith diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index c8768bc49..f19d7c5ad 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -106,13 +106,13 @@ letrec' name body = do -- | Look up and dereference the given 'Name', throwing an exception for free variables. variable :: Members '[ Allocator location value , Reader (Environment location) - , Resumable (EnvironmentError value) + , Resumable (EnvironmentError location) , State (Environment location) , State (Heap location (Cell location) value) ] effects => Name -> Evaluator location value effects value -variable name = lookupEnv name >>= maybe (freeVariableError name) deref +variable name = lookupEnv name >>= maybeM (Address <$> freeVariableError name) >>= deref -- Effects diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 6c31145e3..404b1dc07 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -64,7 +64,7 @@ defineBuiltins :: ( AbstractValue location value effects , Reader (Environment location) , Reader ModuleInfo , Reader Span - , Resumable (EnvironmentError value) + , Resumable (EnvironmentError location) , State (Environment location) , State (Heap location (Cell location) value) ] effects diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index c7d2b6d4c..d9fd68e55 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -221,7 +221,7 @@ evaluateInScopedEnv scopedEnvTerm term = do value :: ( AbstractValue location value effects , Members '[ Allocator location value , Reader (Environment location) - , Resumable (EnvironmentError value) + , Resumable (EnvironmentError location) , State (Environment location) , State (Heap location (Cell location) value) ] effects @@ -236,7 +236,7 @@ value (Rval val) = pure val subtermValue :: ( AbstractValue location value effects , Members '[ Allocator location value , Reader (Environment location) - , Resumable (EnvironmentError value) + , Resumable (EnvironmentError location) , State (Environment location) , State (Heap location (Cell location) value) ] effects diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 884e2514b..6d347f178 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -62,7 +62,7 @@ type EvaluatableConstraints location term value effects = , Reader ModuleInfo , Reader PackageInfo , Reader Span - , Resumable (EnvironmentError value) + , Resumable (EnvironmentError location) , Resumable EvalError , Resumable ResolutionError , Resumable (Unspecialized value) diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index 12b1f01f3..9070eb1f6 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -57,7 +57,7 @@ include :: ( AbstractValue location value effects , Modules location value , Reader (Environment location) , Resumable ResolutionError - , Resumable (EnvironmentError value) + , Resumable (EnvironmentError location) , State (Environment location) , State (Exports location) , State (Heap location (Cell location) value) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index b89ecbb4c..1f35bac52 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -67,7 +67,7 @@ runGraph graphType includePackages project . resumingResolutionError . resumingAddressError . resumingValueError - . runTermEvaluator @_ @_ @(Value (Located Precise) (Eff _)) + . runTermEvaluator @_ @_ @(Value (Hole (Located Precise)) (Eff _)) . graphing -- | Parse a list of files into a 'Package'. @@ -145,7 +145,7 @@ resumingValueError = runValueErrorWith (\ err -> trace ("ValueError" <> show err KeyValueError{} -> pure (hole, hole) ArithmeticError{} -> pure hole) -resumingEnvironmentError :: AbstractHole value => Evaluator location value (Resumable (EnvironmentError value) ': effects) a -> Evaluator location value effects (a, [Name]) +resumingEnvironmentError :: AbstractHole location => Evaluator location value (Resumable (EnvironmentError location) ': effects) a -> Evaluator location value effects (a, [Name]) resumingEnvironmentError = runState [] . reinterpret (\ (Resumable (FreeVariable name)) -> modify' (name :) $> hole) From 7b02e3e64fa7c26928ea33a3fdf75b31ebb46d8b Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 15:30:19 -0400 Subject: [PATCH 081/148] Correct the EnvironmentError application. --- test/Analysis/Ruby/Spec.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/Analysis/Ruby/Spec.hs b/test/Analysis/Ruby/Spec.hs index 46089bfbd..68d1d4996 100644 --- a/test/Analysis/Ruby/Spec.hs +++ b/test/Analysis/Ruby/Spec.hs @@ -30,7 +30,7 @@ spec = parallel $ do it "evaluates load with wrapper" $ do ((res, state), _) <- evaluate "load-wrap.rb" - res `shouldBe` Left (SomeExc (inject @(EnvironmentError (Value Precise (Eff _))) (FreeVariable "foo"))) + res `shouldBe` Left (SomeExc (inject @(EnvironmentError Precise) (FreeVariable "foo"))) Env.names (environment state) `shouldContain` [ "Object" ] it "evaluates subclass" $ do From 038d3d07ebaf392e0c2aaf9b3e0e8e9415ebb2d2 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 15:44:48 -0400 Subject: [PATCH 082/148] Test the return values --- test/Analysis/PHP/Spec.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/test/Analysis/PHP/Spec.hs b/test/Analysis/PHP/Spec.hs index b5cc1a545..619136202 100644 --- a/test/Analysis/PHP/Spec.hs +++ b/test/Analysis/PHP/Spec.hs @@ -1,5 +1,6 @@ module Analysis.PHP.Spec (spec) where +import Control.Abstract import Data.Abstract.Environment as Env import Data.Abstract.Evaluatable (EvalError(..)) import qualified Data.Language as Language @@ -11,12 +12,14 @@ spec :: Spec spec = parallel $ do describe "PHP" $ do it "evaluates include and require" $ do - env <- environment . snd . fst <$> evaluate "main.php" - Env.names env `shouldBe` [ "bar", "foo" ] + ((res, state), _) <- evaluate "main.php" + res `shouldBe` Right [unit] + Env.names (environment state) `shouldBe` [ "bar", "foo" ] it "evaluates include_once and require_once" $ do - env <- environment . snd . fst <$> evaluate "main_once.php" - Env.names env `shouldBe` [ "bar", "foo" ] + ((res, state), _) <- evaluate "main_once.php" + res `shouldBe` Right [unit] + Env.names (environment state) `shouldBe` [ "bar", "foo" ] it "evaluates namespaces" $ do ((_, state), _) <- evaluate "namespaces.php" From fe055534402a7448359916c7a85201390e2849b8 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 15:49:20 -0400 Subject: [PATCH 083/148] :fire: the Primitive machinery & redefine Builtin as plain old data. --- src/Control/Abstract/Primitive.hs | 41 +++++-------------------------- src/Data/Abstract/Evaluatable.hs | 3 +-- 2 files changed, 7 insertions(+), 37 deletions(-) diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 404b1dc07..5148ff88e 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -15,15 +15,10 @@ import Data.Semigroup.Reducer hiding (unit) import Data.Semilattice.Lower import Prologue -data Builtin args result where - Print :: Builtin String () +data Builtin = Print + deriving (Bounded, Enum, Eq, Ord, Show) -deriving instance Eq (Builtin args result) -deriving instance Ord (Builtin args result) -deriving instance Show (Builtin args result) - - -builtinName :: Builtin args result -> Name +builtinName :: Builtin -> Name builtinName = name . pack . ("__semantic_" <>) . headToLower . show where headToLower (c:cs) = toLower c : cs headToLower "" = "" @@ -40,7 +35,7 @@ builtin :: ( HasCallStack , Ord location , Reducer value (Cell location value) ) - => Builtin args result + => Builtin -> Evaluator location value effects value -> Evaluator location value effects () builtin b def = withCurrentCallStack callStack $ do @@ -60,41 +55,17 @@ defineBuiltins :: ( AbstractValue location value effects , HasCallStack , Members '[ Allocator location value , Fresh - , Primitive , Reader (Environment location) , Reader ModuleInfo , Reader Span , Resumable (EnvironmentError location) , State (Environment location) , State (Heap location (Cell location) value) + , Trace ] effects , Ord location , Reducer value (Cell location value) ) => Evaluator location value effects () defineBuiltins = - builtin Print (lambda (\ v -> variable v >>= asString >>= prim Print . unpack >> pure unit)) - - --- | Call a 'Builtin' with parameters. -prim :: (Effectful m, Member Primitive effects) => Builtin args result -> args -> m effects result -prim builtin params = send (Prim builtin params) - -data Primitive result where - Prim :: Builtin args result -> args -> Primitive result - -runPrimitive :: (Effectful m, Member Trace effects) => m (Primitive ': effects) a -> m effects a -runPrimitive = interpret (\ (Prim builtin params) -> case builtin of - Print -> trace params) - - -data SomeBuiltin where - SomeBuiltin :: Builtin arg return -> SomeBuiltin - -instance Eq SomeBuiltin where - SomeBuiltin Print == SomeBuiltin Print = True - -instance Ord SomeBuiltin where - SomeBuiltin Print `compare` SomeBuiltin Print = EQ - -deriving instance Show SomeBuiltin + builtin Print (lambda (\ v -> variable v >>= asString >>= trace . unpack >> pure unit)) diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 6d347f178..510b18bd7 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -95,7 +95,7 @@ evaluatePackageWith :: forall location term value inner outer , Trace ] outer , Recursive term - , inner ~ (Primitive ': LoopControl value ': Return value ': Allocator location value ': Reader ModuleInfo ': Modules location value ': Reader Span ': Reader PackageInfo ': outer) + , inner ~ (LoopControl value ': Return value ': Allocator location value ': Reader ModuleInfo ': Modules location value ': Reader Span ': Reader PackageInfo ': outer) ) => (SubtermAlgebra Module term (TermEvaluator term location value inner value) -> SubtermAlgebra Module term (TermEvaluator term location value inner value)) -> (SubtermAlgebra (Base term) term (TermEvaluator term location value inner (ValueRef value)) -> SubtermAlgebra (Base term) term (TermEvaluator term location value inner (ValueRef value))) @@ -121,7 +121,6 @@ evaluatePackageWith analyzeModule analyzeTerm package . raiseHandler runAllocator . raiseHandler runReturn . raiseHandler runLoopControl - . runPrimitive evaluateEntryPoint :: ModulePath -> Maybe Name -> TermEvaluator term location value (Modules location value ': Reader Span ': Reader PackageInfo ': outer) value evaluateEntryPoint m sym = runInModule (ModuleInfo m) . TermEvaluator $ do From ddc1cc1c77df7a173247f29ed4271027cb2d6997 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 15:50:58 -0400 Subject: [PATCH 084/148] Restore builtins to their original simplicity. --- src/Control/Abstract/Primitive.hs | 22 ++++++---------------- 1 file changed, 6 insertions(+), 16 deletions(-) diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 5148ff88e..693e1304d 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -10,20 +10,10 @@ import Control.Abstract.Value import Data.Abstract.Environment import Data.Abstract.Name import Data.ByteString.Char8 (pack, unpack) -import Data.Char import Data.Semigroup.Reducer hiding (unit) import Data.Semilattice.Lower import Prologue -data Builtin = Print - deriving (Bounded, Enum, Eq, Ord, Show) - -builtinName :: Builtin -> Name -builtinName = name . pack . ("__semantic_" <>) . headToLower . show - where headToLower (c:cs) = toLower c : cs - headToLower "" = "" - - builtin :: ( HasCallStack , Members '[ Allocator location value , Reader (Environment location) @@ -35,13 +25,13 @@ builtin :: ( HasCallStack , Ord location , Reducer value (Cell location value) ) - => Builtin + => String -> Evaluator location value effects value -> Evaluator location value effects () -builtin b def = withCurrentCallStack callStack $ do - let name = builtinName b - addr <- alloc name - modifyEnv (insert name addr) +builtin s def = withCurrentCallStack callStack $ do + let name' = name (pack ("__semantic_" <> s)) + addr <- alloc name' + modifyEnv (insert name' addr) def >>= assign addr lambda :: (AbstractFunction location value effects, Member Fresh effects) @@ -68,4 +58,4 @@ defineBuiltins :: ( AbstractValue location value effects ) => Evaluator location value effects () defineBuiltins = - builtin Print (lambda (\ v -> variable v >>= asString >>= trace . unpack >> pure unit)) + builtin "print" (lambda (\ v -> variable v >>= asString >>= trace . unpack >> pure unit)) From e516836d1c025afaf078d3e290cc2fec27a52c74 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 15:53:35 -0400 Subject: [PATCH 085/148] Move array back up. --- src/Data/Abstract/Type.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Data/Abstract/Type.hs b/src/Data/Abstract/Type.hs index f8d898315..224ec8a6c 100644 --- a/src/Data/Abstract/Type.hs +++ b/src/Data/Abstract/Type.hs @@ -161,15 +161,15 @@ instance ( Members '[ Allocator location Type , Reducer Type (Cell location Type) ) => AbstractValue location Type effects where + array fields = do + var <- fresh + Array <$> foldr (\ t1 -> (unify t1 =<<)) (pure (Var var)) fields + klass _ _ _ = pure Object namespace _ _ = pure Unit scopedEnvironment _ = pure (Just emptyEnv) - array fields = do - var <- fresh - Array <$> foldr (\ t1 -> (unify t1 =<<)) (pure (Var var)) fields - asString t = unify t String $> "" asPair t = do t1 <- fresh From bc15f318ad9dcea9c79bfbd9620c1c8f0ede5811 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 15:56:24 -0400 Subject: [PATCH 086/148] This had been down one. --- src/Control/Abstract/Value.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index d9fd68e55..d422f53be 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -119,12 +119,12 @@ class (AbstractFunction location value effects, AbstractIntro value) => Abstract -- | Construct an array of zero or more values. array :: [value] -> Evaluator location value effects value - -- | Extract a 'ByteString' from a given value. - asString :: value -> Evaluator location value effects ByteString - -- | Extract the contents of a key-value pair as a tuple. asPair :: value -> Evaluator location value effects (value, value) + -- | Extract a 'ByteString' from a given value. + asString :: value -> Evaluator location value effects ByteString + -- | Eliminate boolean values. TODO: s/boolean/truthy ifthenelse :: value -> Evaluator location value effects a -> Evaluator location value effects a -> Evaluator location value effects a From 8dce61ab3fcb1a585701a21b7af1f174e6067f06 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 16:04:21 -0400 Subject: [PATCH 087/148] Whoops. --- src/Language/PHP/Syntax.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index 9070eb1f6..1660856be 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -71,7 +71,7 @@ include pathTerm f = do name <- subtermValue pathTerm >>= asString path <- resolvePHPName name traceResolve name path - (importedEnv, v) <- isolate (f path) $> (emptyEnv, unit) + (importedEnv, v) <- isolate (f path) >>= maybeM (pure (emptyEnv, unit)) modifyEnv (mergeEnvs importedEnv) pure (Rval v) From 0f3c7df8d1b669d5161d5cb3bc1553bc5165bbf1 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 16:05:03 -0400 Subject: [PATCH 088/148] These are probably integers. --- test/Analysis/PHP/Spec.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/Analysis/PHP/Spec.hs b/test/Analysis/PHP/Spec.hs index 619136202..9481449fe 100644 --- a/test/Analysis/PHP/Spec.hs +++ b/test/Analysis/PHP/Spec.hs @@ -13,12 +13,12 @@ spec = parallel $ do describe "PHP" $ do it "evaluates include and require" $ do ((res, state), _) <- evaluate "main.php" - res `shouldBe` Right [unit] + res `shouldBe` Right [integer 1] Env.names (environment state) `shouldBe` [ "bar", "foo" ] it "evaluates include_once and require_once" $ do ((res, state), _) <- evaluate "main_once.php" - res `shouldBe` Right [unit] + res `shouldBe` Right [integer 1] Env.names (environment state) `shouldBe` [ "bar", "foo" ] it "evaluates namespaces" $ do From 6b780d297da232d865cd8e5efdfb4df798faafef Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 16:06:25 -0400 Subject: [PATCH 089/148] Revert "These are probably integers." This reverts commit d2a74b2a4ca1472976abfccc09601c60840c1761. --- test/Analysis/PHP/Spec.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/Analysis/PHP/Spec.hs b/test/Analysis/PHP/Spec.hs index 9481449fe..619136202 100644 --- a/test/Analysis/PHP/Spec.hs +++ b/test/Analysis/PHP/Spec.hs @@ -13,12 +13,12 @@ spec = parallel $ do describe "PHP" $ do it "evaluates include and require" $ do ((res, state), _) <- evaluate "main.php" - res `shouldBe` Right [integer 1] + res `shouldBe` Right [unit] Env.names (environment state) `shouldBe` [ "bar", "foo" ] it "evaluates include_once and require_once" $ do ((res, state), _) <- evaluate "main_once.php" - res `shouldBe` Right [integer 1] + res `shouldBe` Right [unit] Env.names (environment state) `shouldBe` [ "bar", "foo" ] it "evaluates namespaces" $ do From 2eda13fc75659510b409899316aac20624dd7cb9 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 16:14:51 -0400 Subject: [PATCH 090/148] :fire: --- src/Control/Abstract/Primitive.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 693e1304d..542996c68 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE DataKinds, GADTs, TypeOperators #-} module Control.Abstract.Primitive where import Control.Abstract.Addressable From 40226332ab68325123a54cf5741baa27b84ce4ce Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 16:16:55 -0400 Subject: [PATCH 091/148] Placate hlint. --- src/Data/Abstract/Evaluatable.hs | 2 +- src/Data/Abstract/Value.hs | 4 ++-- src/Data/Syntax/Declaration.hs | 2 +- src/Data/Syntax/Expression.hs | 2 +- src/Language/TypeScript/Syntax.hs | 2 +- 5 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 510b18bd7..4b2676b2c 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ConstraintKinds, DefaultSignatures, GADTs, GeneralizedNewtypeDeriving, RankNTypes, ScopedTypeVariables, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE ConstraintKinds, DefaultSignatures, GADTs, RankNTypes, ScopedTypeVariables, TypeOperators, UndecidableInstances #-} module Data.Abstract.Evaluatable ( module X , Evaluatable(..) diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 93f81e3ee..91e671aa2 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -33,7 +33,7 @@ data Value location body | Hole deriving (Eq, Ord, Show) -data ClosureBody location body = ClosureBody (body (Value location body)) +newtype ClosureBody location body = ClosureBody (body (Value location body)) instance Eq (ClosureBody location body) where _ == _ = True @@ -99,7 +99,7 @@ instance Show location => AbstractIntro (Value location body) where multiple = Tuple - kvPair k = KVPair k + kvPair = KVPair hash = Hash . map (uncurry KVPair) null = Null diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index c58f90b09..6ae8173e6 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -113,7 +113,7 @@ instance ToJSONFields1 VariableDeclaration instance Evaluatable VariableDeclaration where eval (VariableDeclaration []) = pure (Rval unit) - eval (VariableDeclaration decs) = Rval . multiple <$> (traverse subtermValue decs) + eval (VariableDeclaration decs) = Rval . multiple <$> traverse subtermValue decs instance Declarations a => Declarations (VariableDeclaration a) where declaredName (VariableDeclaration vars) = case vars of diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs index b87f00289..9c8c2e215 100644 --- a/src/Data/Syntax/Expression.hs +++ b/src/Data/Syntax/Expression.hs @@ -120,7 +120,7 @@ instance Evaluatable Boolean where cond <- a ifthenelse cond (pure cond) b go (Not a) = a >>= fmap (boolean . not) . asBool - go (XOr a b) = boolean <$> (liftA2 (/=) (a >>= asBool) (b >>= asBool)) + go (XOr a b) = boolean <$> liftA2 (/=) (a >>= asBool) (b >>= asBool) -- | Javascript delete operator newtype Delete a = Delete a diff --git a/src/Language/TypeScript/Syntax.hs b/src/Language/TypeScript/Syntax.hs index 74bb08c29..152723cdc 100644 --- a/src/Language/TypeScript/Syntax.hs +++ b/src/Language/TypeScript/Syntax.hs @@ -166,7 +166,7 @@ instance Evaluatable Import where eval (Import symbols importPath) = do modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions importedEnv <- maybe emptyEnv fst <$> isolate (require modulePath) - modifyEnv (mergeEnvs (renamed importedEnv)) *> (pure (Rval unit)) + modifyEnv (mergeEnvs (renamed importedEnv)) $> Rval unit where renamed importedEnv | Prologue.null symbols = importedEnv From 10897b43946dcfe9375b7c992481a493f6834ef1 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 28 May 2018 16:24:04 -0400 Subject: [PATCH 092/148] Use a counter to determine identity of closure bodies. --- src/Data/Abstract/Value.hs | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 91e671aa2..5e5c726a4 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -33,16 +33,16 @@ data Value location body | Hole deriving (Eq, Ord, Show) -newtype ClosureBody location body = ClosureBody (body (Value location body)) +data ClosureBody location body = ClosureBody { closureBodyId :: Int, closureBody :: body (Value location body) } instance Eq (ClosureBody location body) where - _ == _ = True + (==) = (==) `on` closureBodyId instance Ord (ClosureBody location body) where - _ `compare` _ = EQ + compare = compare `on` closureBodyId instance Show (ClosureBody location body) where - showsPrec d (ClosureBody _) = showsUnaryWith (const showChar) "ClosureBody" d '_' + showsPrec d (ClosureBody i _) = showsBinaryWith showsPrec (const showChar) "ClosureBody" d i '_' instance Ord location => ValueRoots location (Value location body) where @@ -56,6 +56,7 @@ instance AbstractHole (Value location body) where instance ( Coercible body (Eff effects) , Members '[ Allocator location (Value location body) + , Fresh , Reader ModuleInfo , Reader PackageInfo , Resumable (ValueError location body) @@ -71,11 +72,12 @@ instance ( Coercible body (Eff effects) closure parameters freeVariables body = do packageInfo <- currentPackage moduleInfo <- currentModule - Closure packageInfo moduleInfo parameters (ClosureBody (coerce (lowerEff body))) . Env.bind (foldr Set.delete freeVariables parameters) <$> getEnv + i <- fresh + Closure packageInfo moduleInfo parameters (ClosureBody i (coerce (lowerEff body))) . Env.bind (foldr Set.delete freeVariables parameters) <$> getEnv call op params = do case op of - Closure packageInfo moduleInfo names (ClosureBody body) env -> do + Closure packageInfo moduleInfo names (ClosureBody _ body) env -> do -- Evaluate the bindings and body with the closure’s package/module info in scope in order to -- charge them to the closure's origin. withCurrentPackage packageInfo . withCurrentModule moduleInfo $ do @@ -108,6 +110,7 @@ instance Show location => AbstractIntro (Value location body) where -- | Construct a 'Value' wrapping the value arguments (if any). instance ( Coercible body (Eff effects) , Members '[ Allocator location (Value location body) + , Fresh , LoopControl (Value location body) , Reader (Environment location) , Reader ModuleInfo From 8b24f01f499bdc40594a3750b0ac204c5832cb39 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 29 May 2018 09:16:03 -0400 Subject: [PATCH 093/148] Use Member instead of Members in EvaluatableConstraints. --- src/Data/Abstract/Evaluatable.hs | 33 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 17 deletions(-) diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 4b2676b2c..915696b07 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -55,23 +55,22 @@ type EvaluatableConstraints location term value effects = ( AbstractValue location value effects , Declarations term , FreeVariables term - , Members '[ Allocator location value - , LoopControl value - , Modules location value - , Reader (Environment location) - , Reader ModuleInfo - , Reader PackageInfo - , Reader Span - , Resumable (EnvironmentError location) - , Resumable EvalError - , Resumable ResolutionError - , Resumable (Unspecialized value) - , Return value - , State (Environment location) - , State (Exports location) - , State (Heap location (Cell location) value) - , Trace - ] effects + , Member (Allocator location value) effects + , Member (LoopControl value) effects + , Member (Modules location value) effects + , Member (Reader (Environment location)) effects + , Member (Reader ModuleInfo) effects + , Member (Reader PackageInfo) effects + , Member (Reader Span) effects + , Member (Resumable (EnvironmentError location)) effects + , Member (Resumable EvalError) effects + , Member (Resumable ResolutionError) effects + , Member (Resumable (Unspecialized value)) effects + , Member (Return value) effects + , Member (State (Environment location)) effects + , Member (State (Exports location)) effects + , Member (State (Heap location (Cell location) value)) effects + , Member Trace effects , Ord location , Reducer value (Cell location value) ) From f5572e41ca3451aca48229ee532135bc8667de7f Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 29 May 2018 12:09:09 -0400 Subject: [PATCH 094/148] Use Member instead of Members everywhere! --- src/Analysis/Abstract/Caching.hs | 42 +++++++++--------- src/Analysis/Abstract/Collecting.hs | 5 +-- src/Analysis/Abstract/Graph.hs | 34 +++++++------- src/Analysis/Abstract/Tracing.hs | 9 ++-- src/Control/Abstract/Addressable.hs | 2 +- src/Control/Abstract/Configuration.hs | 2 +- src/Control/Abstract/Context.hs | 4 +- src/Control/Abstract/Environment.hs | 4 +- src/Control/Abstract/Heap.hs | 38 ++++++++-------- src/Control/Abstract/Modules.hs | 8 ++-- src/Control/Abstract/Primitive.hs | 31 ++++++------- src/Control/Abstract/Value.hs | 20 ++++----- src/Data/Abstract/Evaluatable.hs | 23 +++++----- src/Data/Abstract/Type.hs | 31 ++++++------- src/Data/Abstract/Value.hs | 38 ++++++++-------- src/Language/Go/Syntax.hs | 12 ++--- src/Language/PHP/Syntax.hs | 24 +++++----- src/Language/Python/Syntax.hs | 23 +++++----- src/Language/Ruby/Syntax.hs | 23 +++++----- src/Language/TypeScript/Syntax.hs | 64 +++++++++++++-------------- src/Rendering/Graph.hs | 4 +- src/Semantic/AST.hs | 4 +- src/Semantic/Diff.hs | 10 ++--- src/Semantic/Distribute.hs | 2 +- src/Semantic/Graph.hs | 10 ++--- src/Semantic/IO.hs | 2 +- src/Semantic/Parse.hs | 6 +-- src/Semantic/Resolution.hs | 2 +- src/Semantic/Task.hs | 4 +- src/Semantic/Telemetry.hs | 2 +- test/Rendering/TOC/Spec.hs | 3 +- 31 files changed, 228 insertions(+), 258 deletions(-) diff --git a/src/Analysis/Abstract/Caching.hs b/src/Analysis/Abstract/Caching.hs index 4f0ccc35f..b43cedb72 100644 --- a/src/Analysis/Abstract/Caching.hs +++ b/src/Analysis/Abstract/Caching.hs @@ -33,7 +33,7 @@ lookupCache :: (Cacheable term location (Cell location) value, Member (State (Ca lookupCache configuration = cacheLookup configuration <$> get -- | Run an action, caching its result and 'Heap' under the given configuration. -cachingConfiguration :: (Cacheable term location (Cell location) value, Members '[State (Cache term location (Cell location) value), State (Heap location (Cell location) value)] effects) +cachingConfiguration :: (Cacheable term location (Cell location) value, Member (State (Cache term location (Cell location) value)) effects, Member (State (Heap location (Cell location) value)) effects) => Configuration term location (Cell location) value -> Set (Cached location (Cell location) value) -> TermEvaluator term location value effects (ValueRef value) @@ -58,14 +58,13 @@ isolateCache action = putCache lowerBound *> action *> get -- | Analyze a term using the in-cache as an oracle & storing the results of the analysis in the out-cache. cachingTerms :: ( Cacheable term location (Cell location) value , Corecursive term - , Members '[ Fresh - , NonDet - , Reader (Cache term location (Cell location) value) - , Reader (Live location value) - , State (Cache term location (Cell location) value) - , State (Environment location) - , State (Heap location (Cell location) value) - ] effects + , Member (Fresh) effects + , Member (NonDet) effects + , Member (Reader (Cache term location (Cell location) value)) effects + , Member (Reader (Live location value)) effects + , Member (State (Cache term location (Cell location) value)) effects + , Member (State (Environment location)) effects + , Member (State (Heap location (Cell location) value)) effects ) => SubtermAlgebra (Base term) term (TermEvaluator term location value effects (ValueRef value)) -> SubtermAlgebra (Base term) term (TermEvaluator term location value effects (ValueRef value)) @@ -80,18 +79,17 @@ cachingTerms recur term = do convergingModules :: ( AbstractValue location value effects , Cacheable term location (Cell location) value - , Members '[ Allocator location value - , Fresh - , NonDet - , Reader (Cache term location (Cell location) value) - , Reader (Environment location) - , Reader (Live location value) - , Resumable (AddressError location value) - , Resumable (EnvironmentError location) - , State (Cache term location (Cell location) value) - , State (Environment location) - , State (Heap location (Cell location) value) - ] effects + , Member (Allocator location value) effects + , Member (Fresh) effects + , Member (NonDet) effects + , Member (Reader (Cache term location (Cell location) value)) effects + , Member (Reader (Environment location)) effects + , Member (Reader (Live location value)) effects + , Member (Resumable (AddressError location value)) effects + , Member (Resumable (EnvironmentError location)) effects + , Member (State (Cache term location (Cell location) value)) effects + , Member (State (Environment location)) effects + , Member (State (Heap location (Cell location) value)) effects ) => SubtermAlgebra Module term (TermEvaluator term location value effects value) -> SubtermAlgebra Module term (TermEvaluator term location value effects value) @@ -128,7 +126,7 @@ converge seed f = loop seed loop x' -- | Nondeterministically write each of a collection of stores & return their associated results. -scatter :: (Foldable t, Members '[NonDet, State (Heap location (Cell location) value)] effects) => t (Cached location (Cell location) value) -> TermEvaluator term location value effects (ValueRef value) +scatter :: (Foldable t, Member NonDet effects, Member (State (Heap location (Cell location) value)) effects) => t (Cached location (Cell location) value) -> TermEvaluator term location value effects (ValueRef value) scatter = foldMapA (\ (Cached value heap') -> TermEvaluator (putHeap heap') $> value) diff --git a/src/Analysis/Abstract/Collecting.hs b/src/Analysis/Abstract/Collecting.hs index 4fc67638d..2b3a33353 100644 --- a/src/Analysis/Abstract/Collecting.hs +++ b/src/Analysis/Abstract/Collecting.hs @@ -12,9 +12,8 @@ import Prologue -- | An analysis performing GC after every instruction. collectingTerms :: ( Foldable (Cell location) - , Members '[ Reader (Live location value) - , State (Heap location (Cell location) value) - ] effects + , Member (Reader (Live location value)) effects + , Member (State (Heap location (Cell location) value)) effects , Ord location , ValueRoots location value ) diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs index 182e8be58..f76fdd8a6 100644 --- a/src/Analysis/Abstract/Graph.hs +++ b/src/Analysis/Abstract/Graph.hs @@ -52,11 +52,10 @@ style = (defaultStyle (byteString . vertexName)) -- | Add vertices to the graph for evaluated identifiers. graphingTerms :: ( Element Syntax.Identifier syntax - , Members '[ Reader (Environment (Hole (Located location))) - , Reader ModuleInfo - , State (Environment (Hole (Located location))) - , State (Graph Vertex) - ] effects + , Member (Reader (Environment (Hole (Located location)))) effects + , Member (Reader ModuleInfo) effects + , Member (State (Environment (Hole (Located location)))) effects + , Member (State (Graph Vertex)) effects , term ~ Term (Sum syntax) ann ) => SubtermAlgebra (Base term) term (TermEvaluator term (Hole (Located location)) value effects a) @@ -69,20 +68,19 @@ graphingTerms recur term@(In _ syntax) = do _ -> pure () recur term -graphingPackages :: Members '[ Reader ModuleInfo - , Reader PackageInfo - , State (Graph Vertex) - ] effects +graphingPackages :: ( Member (Reader PackageInfo) effects + , Member (State (Graph Vertex)) effects + ) => SubtermAlgebra Module term (TermEvaluator term location value effects a) -> SubtermAlgebra Module term (TermEvaluator term location value effects a) graphingPackages recur m = packageInclusion (moduleVertex (moduleInfo m)) *> recur m -- | Add vertices to the graph for evaluated modules and the packages containing them. graphingModules :: forall term location value effects a - . Members '[ Modules location value - , Reader ModuleInfo - , State (Graph Vertex) - ] effects + . ( Member (Modules location value) effects + , Member (Reader ModuleInfo) effects + , Member (State (Graph Vertex)) effects + ) => SubtermAlgebra Module term (TermEvaluator term location value effects a) -> SubtermAlgebra Module term (TermEvaluator term location value effects a) graphingModules recur m = interpose @(Modules location value) pure (\ m yield -> case m of @@ -100,9 +98,8 @@ moduleVertex = Module . BC.pack . modulePath -- | Add an edge from the current package to the passed vertex. packageInclusion :: ( Effectful m - , Members '[ Reader PackageInfo - , State (Graph Vertex) - ] effects + , Member (Reader PackageInfo) effects + , Member (State (Graph Vertex)) effects , Monad (m effects) ) => Vertex @@ -113,9 +110,8 @@ packageInclusion v = do -- | Add an edge from the current module to the passed vertex. moduleInclusion :: ( Effectful m - , Members '[ Reader ModuleInfo - , State (Graph Vertex) - ] effects + , Member (Reader ModuleInfo) effects + , Member (State (Graph Vertex)) effects , Monad (m effects) ) => Vertex diff --git a/src/Analysis/Abstract/Tracing.hs b/src/Analysis/Abstract/Tracing.hs index 79a878819..62d43d152 100644 --- a/src/Analysis/Abstract/Tracing.hs +++ b/src/Analysis/Abstract/Tracing.hs @@ -13,11 +13,10 @@ import Prologue -- -- Instantiating @trace@ to @[]@ yields a linear trace analysis, while @Set@ yields a reachable state analysis. tracingTerms :: ( Corecursive term - , Members '[ Reader (Live location value) - , State (Environment location) - , State (Heap location (Cell location) value) - , Writer (trace (Configuration term location (Cell location) value)) - ] effects + , Member (Reader (Live location value)) effects + , Member (State (Environment location)) effects + , Member (State (Heap location (Cell location) value)) effects + , Member (Writer (trace (Configuration term location (Cell location) value))) effects , Reducer (Configuration term location (Cell location) value) (trace (Configuration term location (Cell location) value)) ) => trace (Configuration term location (Cell location) value) diff --git a/src/Control/Abstract/Addressable.hs b/src/Control/Abstract/Addressable.hs index dfd82b1cb..afe6bfad5 100644 --- a/src/Control/Abstract/Addressable.hs +++ b/src/Control/Abstract/Addressable.hs @@ -34,7 +34,7 @@ instance Member NonDet effects => Addressable Monovariant effects where derefCell _ = traverse (foldMapA pure) . nonEmpty . toList -- | 'Located' locations allocate & dereference using the underlying location, contextualizing locations with the current 'PackageInfo' & 'ModuleInfo'. -instance (Addressable location effects, Members '[Reader ModuleInfo, Reader PackageInfo] effects) => Addressable (Located location) effects where +instance (Addressable location effects, Member (Reader ModuleInfo) effects, Member (Reader PackageInfo) effects) => Addressable (Located location) effects where type Cell (Located location) = Cell location allocCell name = relocate (Located <$> allocCell name <*> currentPackage <*> currentModule) diff --git a/src/Control/Abstract/Configuration.hs b/src/Control/Abstract/Configuration.hs index 37a97033a..4ff37c9c3 100644 --- a/src/Control/Abstract/Configuration.hs +++ b/src/Control/Abstract/Configuration.hs @@ -12,5 +12,5 @@ import Control.Abstract.TermEvaluator import Data.Abstract.Configuration -- | Get the current 'Configuration' with a passed-in term. -getConfiguration :: Members '[Reader (Live location value), State (Environment location), State (Heap location (Cell location) value)] effects => term -> TermEvaluator term location value effects (Configuration term location (Cell location) value) +getConfiguration :: (Member (Reader (Live location value)) effects, Member (State (Environment location)) effects, Member (State (Heap location (Cell location) value)) effects) => term -> TermEvaluator term location value effects (Configuration term location (Cell location) value) getConfiguration term = Configuration term <$> TermEvaluator askRoots <*> TermEvaluator getEnv <*> TermEvaluator getHeap diff --git a/src/Control/Abstract/Context.hs b/src/Control/Abstract/Context.hs index e764f341a..bf1184697 100644 --- a/src/Control/Abstract/Context.hs +++ b/src/Control/Abstract/Context.hs @@ -45,11 +45,11 @@ withCurrentSpan = local . const -- | Run an action with locally-replaced 'ModuleInfo' & 'Span' derived from the passed 'SrcLoc'. -withCurrentSrcLoc :: (Effectful m, Members '[Reader ModuleInfo, Reader Span] effects) => SrcLoc -> m effects a -> m effects a +withCurrentSrcLoc :: (Effectful m, Member (Reader ModuleInfo) effects, Member (Reader Span) effects) => SrcLoc -> m effects a -> m effects a withCurrentSrcLoc loc = withCurrentModule (moduleInfoFromSrcLoc loc) . withCurrentSpan (spanFromSrcLoc loc) -- | Run an action with locally replaced 'ModuleInfo' & 'Span' derived from the Haskell call stack. -- -- This is suitable for contextualizing builtins & other functionality intended for use from client code but defined in Haskell source. -withCurrentCallStack :: (Effectful m, Members '[Reader ModuleInfo, Reader Span] effects) => CallStack -> m effects a -> m effects a +withCurrentCallStack :: (Effectful m, Member (Reader ModuleInfo) effects, Member (Reader Span) effects) => CallStack -> m effects a -> m effects a withCurrentCallStack = maybe id (withCurrentSrcLoc . snd) . listToMaybe . getCallStack diff --git a/src/Control/Abstract/Environment.hs b/src/Control/Abstract/Environment.hs index dd500f3ff..a2306cabf 100644 --- a/src/Control/Abstract/Environment.hs +++ b/src/Control/Abstract/Environment.hs @@ -51,7 +51,7 @@ withDefaultEnvironment e = local (const e) -- | Obtain an environment that is the composition of the current and default environments. -- Useful for debugging. -fullEnvironment :: Members '[Reader (Environment location), State (Environment location)] effects => Evaluator location value effects (Environment location) +fullEnvironment :: (Member (Reader (Environment location)) effects, Member (State (Environment location)) effects) => Evaluator location value effects (Environment location) fullEnvironment = mergeEnvs <$> getEnv <*> defaultEnvironment -- | Run an action with a locally-modified environment. @@ -66,7 +66,7 @@ localize :: Member (State (Environment location)) effects => Evaluator location localize = localEnv id -- | Look a 'Name' up in the current environment, trying the default environment if no value is found. -lookupEnv :: Members '[Reader (Environment location), State (Environment location)] effects => Name -> Evaluator location value effects (Maybe (Address location value)) +lookupEnv :: (Member (Reader (Environment location)) effects, Member (State (Environment location)) effects) => Name -> Evaluator location value effects (Maybe (Address location value)) lookupEnv name = (<|>) <$> (Env.lookup name <$> getEnv) <*> (Env.lookup name <$> defaultEnvironment) diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index f19d7c5ad..05eec53e0 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -63,20 +63,19 @@ assign address = modifyHeap . heapInsert address -- | Look up or allocate an address for a 'Name'. -lookupOrAlloc :: Members '[ Allocator location value - , Reader (Environment location) - , State (Environment location) - ] effects +lookupOrAlloc :: ( Member (Allocator location value) effects + , Member (Reader (Environment location)) effects + , Member (State (Environment location)) effects + ) => Name -> Evaluator location value effects (Address location value) lookupOrAlloc name = lookupEnv name >>= maybe (alloc name) pure -letrec :: ( Members '[ Allocator location value - , Reader (Environment location) - , State (Environment location) - , State (Heap location (Cell location) value) - ] effects +letrec :: ( Member (Allocator location value) effects + , Member (Reader (Environment location)) effects + , Member (State (Environment location)) effects + , Member (State (Heap location (Cell location) value)) effects , Ord location , Reducer value (Cell location value) ) @@ -90,10 +89,10 @@ letrec name body = do pure (v, addr) -- Lookup/alloc a name passing the address to a body evaluated in a new local environment. -letrec' :: Members '[ Allocator location value - , Reader (Environment location) - , State (Environment location) - ] effects +letrec' :: ( Member (Allocator location value) effects + , Member (Reader (Environment location)) effects + , Member (State (Environment location)) effects + ) => Name -> (Address location value -> Evaluator location value effects value) -> Evaluator location value effects value @@ -104,12 +103,11 @@ letrec' name body = do -- | Look up and dereference the given 'Name', throwing an exception for free variables. -variable :: Members '[ Allocator location value - , Reader (Environment location) - , Resumable (EnvironmentError location) - , State (Environment location) - , State (Heap location (Cell location) value) - ] effects +variable :: ( Member (Allocator location value) effects + , Member (Reader (Environment location)) effects + , Member (Resumable (EnvironmentError location)) effects + , Member (State (Environment location)) effects + ) => Name -> Evaluator location value effects value variable name = lookupEnv name >>= maybeM (Address <$> freeVariableError name) >>= deref @@ -121,7 +119,7 @@ data Allocator location value return where Alloc :: Name -> Allocator location value (Address location value) Deref :: Address location value -> Allocator location value value -runAllocator :: (Addressable location effects, Effectful (m location value), Members '[Resumable (AddressError location value), State (Heap location (Cell location) value)] effects) => m location value (Allocator location value ': effects) a -> m location value effects a +runAllocator :: (Addressable location effects, Effectful (m location value), Member (Resumable (AddressError location value)) effects, Member (State (Heap location (Cell location) value)) effects) => m location value (Allocator location value ': effects) a -> m location value effects a runAllocator = raiseHandler (interpret (\ eff -> case eff of Alloc name -> lowerEff $ Address <$> allocCell name Deref addr -> lowerEff $ heapLookup addr <$> get >>= maybeM (throwResumable (UnallocatedAddress addr)) >>= derefCell addr >>= maybeM (throwResumable (UninitializedAddress addr)))) diff --git a/src/Control/Abstract/Modules.hs b/src/Control/Abstract/Modules.hs index 89a9c9e88..5ce3a3da0 100644 --- a/src/Control/Abstract/Modules.hs +++ b/src/Control/Abstract/Modules.hs @@ -60,10 +60,10 @@ sendModules :: Member (Modules location value) effects => Modules location value sendModules = send runModules :: forall term location value effects a - . Members '[ Resumable (LoadError location value) - , State (ModuleTable (Maybe (Environment location, value))) - , Trace - ] effects + . ( Member (Resumable (LoadError location value)) effects + , Member (State (ModuleTable (Maybe (Environment location, value)))) effects + , Member Trace effects + ) => (Module term -> Evaluator location value (Modules location value ': effects) (Environment location, value)) -> Evaluator location value (Modules location value ': effects) a -> Evaluator location value (Reader (ModuleTable [Module term]) ': effects) a diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 542996c68..f0b280bec 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -14,13 +14,11 @@ import Data.Semilattice.Lower import Prologue builtin :: ( HasCallStack - , Members '[ Allocator location value - , Reader (Environment location) - , Reader ModuleInfo - , Reader Span - , State (Environment location) - , State (Heap location (Cell location) value) - ] effects + , Member (Allocator location value) effects + , Member (Reader ModuleInfo) effects + , Member (Reader Span) effects + , Member (State (Environment location)) effects + , Member (State (Heap location (Cell location) value)) effects , Ord location , Reducer value (Cell location value) ) @@ -42,16 +40,15 @@ lambda body = do defineBuiltins :: ( AbstractValue location value effects , HasCallStack - , Members '[ Allocator location value - , Fresh - , Reader (Environment location) - , Reader ModuleInfo - , Reader Span - , Resumable (EnvironmentError location) - , State (Environment location) - , State (Heap location (Cell location) value) - , Trace - ] effects + , Member (Allocator location value) effects + , Member Fresh effects + , Member (Reader (Environment location)) effects + , Member (Reader ModuleInfo) effects + , Member (Reader Span) effects + , Member (Resumable (EnvironmentError location)) effects + , Member (State (Environment location)) effects + , Member (State (Heap location (Cell location) value)) effects + , Member Trace effects , Ord location , Reducer value (Cell location value) ) diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index d422f53be..893da6b67 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -219,12 +219,10 @@ evaluateInScopedEnv scopedEnvTerm term = do -- | Evaluates a 'Value' returning the referenced value value :: ( AbstractValue location value effects - , Members '[ Allocator location value - , Reader (Environment location) - , Resumable (EnvironmentError location) - , State (Environment location) - , State (Heap location (Cell location) value) - ] effects + , Member (Allocator location value) effects + , Member (Reader (Environment location)) effects + , Member (Resumable (EnvironmentError location)) effects + , Member (State (Environment location)) effects ) => ValueRef value -> Evaluator location value effects value @@ -234,12 +232,10 @@ value (Rval val) = pure val -- | Evaluates a 'Subterm' to its rval subtermValue :: ( AbstractValue location value effects - , Members '[ Allocator location value - , Reader (Environment location) - , Resumable (EnvironmentError location) - , State (Environment location) - , State (Heap location (Cell location) value) - ] effects + , Member (Allocator location value) effects + , Member (Reader (Environment location)) effects + , Member (Resumable (EnvironmentError location)) effects + , Member (State (Environment location)) effects ) => Subterm term (Evaluator location value effects (ValueRef value)) -> Evaluator location value effects value diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 915696b07..8b87f5dc6 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -82,17 +82,16 @@ evaluatePackageWith :: forall location term value inner outer . ( Addressable location (Reader ModuleInfo ': Modules location value ': Reader Span ': Reader PackageInfo ': outer) , Evaluatable (Base term) , EvaluatableConstraints location term value inner - , Members '[ Fail - , Fresh - , Reader (Environment location) - , Resumable (AddressError location value) - , Resumable (LoadError location value) - , State (Environment location) - , State (Exports location) - , State (Heap location (Cell location) value) - , State (ModuleTable (Maybe (Environment location, value))) - , Trace - ] outer + , Member Fail outer + , Member Fresh outer + , Member (Reader (Environment location)) outer + , Member (Resumable (AddressError location value)) outer + , Member (Resumable (LoadError location value)) outer + , Member (State (Environment location)) outer + , Member (State (Exports location)) outer + , Member (State (Heap location (Cell location) value)) outer + , Member (State (ModuleTable (Maybe (Environment location, value)))) outer + , Member Trace outer , Recursive term , inner ~ (LoopControl value ': Return value ': Allocator location value ': Reader ModuleInfo ': Modules location value ': Reader Span ': Reader PackageInfo ': outer) ) @@ -145,7 +144,7 @@ evaluatePackageWith analyzeModule analyzeTerm package -- | Isolate the given action with an empty global environment and exports. -isolate :: Members '[State (Environment location), State (Exports location)] effects => Evaluator location value effects a -> Evaluator location value effects a +isolate :: (Member (State (Environment location)) effects, Member (State (Exports location)) effects) => Evaluator location value effects a -> Evaluator location value effects a isolate = withEnv lowerBound . withExports lowerBound traceResolve :: (Show a, Show b, Member Trace effects) => a -> b -> Evaluator location value effects () diff --git a/src/Data/Abstract/Type.hs b/src/Data/Abstract/Type.hs index 224ec8a6c..9d7e6ed54 100644 --- a/src/Data/Abstract/Type.hs +++ b/src/Data/Abstract/Type.hs @@ -116,15 +116,12 @@ instance AbstractIntro Type where null = Null -instance ( Members '[ Allocator location Type - , Fresh - , NonDet - , Reader (Environment location) - , Resumable TypeError - , Return Type - , State (Environment location) - , State (Heap location (Cell location) Type) - ] effects +instance ( Member (Allocator location Type) effects + , Member Fresh effects + , Member (Resumable TypeError) effects + , Member (Return Type) effects + , Member (State (Environment location)) effects + , Member (State (Heap location (Cell location) Type)) effects , Ord location , Reducer Type (Cell location Type) ) @@ -148,15 +145,13 @@ instance ( Members '[ Allocator location Type -- | Discard the value arguments (if any), constructing a 'Type' instead. -instance ( Members '[ Allocator location Type - , Fresh - , NonDet - , Reader (Environment location) - , Resumable TypeError - , Return Type - , State (Environment location) - , State (Heap location (Cell location) Type) - ] effects +instance ( Member (Allocator location Type) effects + , Member Fresh effects + , Member NonDet effects + , Member (Resumable TypeError) effects + , Member (Return Type) effects + , Member (State (Environment location)) effects + , Member (State (Heap location (Cell location) Type)) effects , Ord location , Reducer Type (Cell location Type) ) diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 5e5c726a4..b15db00f7 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -55,15 +55,14 @@ instance AbstractHole (Value location body) where hole = Hole instance ( Coercible body (Eff effects) - , Members '[ Allocator location (Value location body) - , Fresh - , Reader ModuleInfo - , Reader PackageInfo - , Resumable (ValueError location body) - , Return (Value location body) - , State (Environment location) - , State (Heap location (Cell location) (Value location body)) - ] effects + , Member (Allocator location (Value location body)) effects + , Member Fresh effects + , Member (Reader ModuleInfo) effects + , Member (Reader PackageInfo) effects + , Member (Resumable (ValueError location body)) effects + , Member (Return (Value location body)) effects + , Member (State (Environment location)) effects + , Member (State (Heap location (Cell location) (Value location body))) effects , Ord location , Reducer (Value location body) (Cell location (Value location body)) , Show location @@ -109,17 +108,16 @@ instance Show location => AbstractIntro (Value location body) where -- | Construct a 'Value' wrapping the value arguments (if any). instance ( Coercible body (Eff effects) - , Members '[ Allocator location (Value location body) - , Fresh - , LoopControl (Value location body) - , Reader (Environment location) - , Reader ModuleInfo - , Reader PackageInfo - , Resumable (ValueError location body) - , Return (Value location body) - , State (Environment location) - , State (Heap location (Cell location) (Value location body)) - ] effects + , Member (Allocator location (Value location body)) effects + , Member Fresh effects + , Member (LoopControl (Value location body)) effects + , Member (Reader (Environment location)) effects + , Member (Reader ModuleInfo) effects + , Member (Reader PackageInfo) effects + , Member (Resumable (ValueError location body)) effects + , Member (Return (Value location body)) effects + , Member (State (Environment location)) effects + , Member (State (Heap location (Cell location) (Value location body))) effects , Ord location , Reducer (Value location body) (Cell location (Value location body)) , Show location diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index 8242b49df..66bf3b13e 100644 --- a/src/Language/Go/Syntax.hs +++ b/src/Language/Go/Syntax.hs @@ -28,12 +28,12 @@ importPath str = let path = stripQuotes str in ImportPath (BC.unpack path) (path defaultAlias :: ImportPath -> Name defaultAlias = name . BC.pack . takeFileName . unPath -resolveGoImport :: Members '[ Modules location value - , Reader ModuleInfo - , Reader Package.PackageInfo - , Resumable ResolutionError - , Trace - ] effects +resolveGoImport :: ( Member (Modules location value) effects + , Member (Reader ModuleInfo) effects + , Member (Reader Package.PackageInfo) effects + , Member (Resumable ResolutionError) effects + , Member Trace effects + ) => ImportPath -> Evaluator location value effects [ModulePath] resolveGoImport (ImportPath path Relative) = do diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index 1660856be..424a06ba6 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -41,9 +41,9 @@ instance Evaluatable VariableName -- file, the complete contents of the included file are treated as though it -- were defined inside that function. -resolvePHPName :: Members '[ Modules location value - , Resumable ResolutionError - ] effects +resolvePHPName :: ( Member (Modules location value) effects + , Member (Resumable ResolutionError) effects + ) => ByteString -> Evaluator location value effects ModulePath resolvePHPName n = do @@ -53,16 +53,14 @@ resolvePHPName n = do toName = BC.unpack . dropRelativePrefix . stripQuotes include :: ( AbstractValue location value effects - , Members '[ Allocator location value - , Modules location value - , Reader (Environment location) - , Resumable ResolutionError - , Resumable (EnvironmentError location) - , State (Environment location) - , State (Exports location) - , State (Heap location (Cell location) value) - , Trace - ] effects + , Member (Allocator location value) effects + , Member (Modules location value) effects + , Member (Reader (Environment location)) effects + , Member (Resumable ResolutionError) effects + , Member (Resumable (EnvironmentError location)) effects + , Member (State (Environment location)) effects + , Member (State (Exports location)) effects + , Member Trace effects ) => Subterm term (Evaluator location value effects (ValueRef value)) -> (ModulePath -> Evaluator location value effects (Maybe (Environment location, value))) diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index 4d26143a5..c9b8365a4 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -52,11 +52,11 @@ relativeQualifiedName prefix paths = RelativeQualifiedName (BC.unpack prefix) (J -- Subsequent imports of `parent.two` or `parent.three` will execute -- `parent/two/__init__.py` and -- `parent/three/__init__.py` respectively. -resolvePythonModules :: Members '[ Modules location value - , Reader ModuleInfo - , Resumable ResolutionError - , Trace - ] effects +resolvePythonModules :: ( Member (Modules location value) effects + , Member (Reader ModuleInfo) effects + , Member (Resumable ResolutionError) effects + , Member Trace effects + ) => QualifiedName -> Evaluator location value effects (NonEmpty ModulePath) resolvePythonModules q = do @@ -128,13 +128,12 @@ instance Evaluatable Import where -- Evaluate a qualified import evalQualifiedImport :: ( AbstractValue location value effects - , Members '[ Allocator location value - , Modules location value - , Reader (Environment location) - , State (Environment location) - , State (Exports location) - , State (Heap location (Cell location) value) - ] effects + , Member (Allocator location value) effects + , Member (Modules location value) effects + , Member (Reader (Environment location)) effects + , Member (State (Environment location)) effects + , Member (State (Exports location)) effects + , Member (State (Heap location (Cell location) value)) effects , Ord location , Reducer.Reducer value (Cell location value) ) diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index b7bbacbc7..82d190616 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -17,9 +17,9 @@ import System.FilePath.Posix -- TODO: Fully sort out ruby require/load mechanics -- -- require "json" -resolveRubyName :: Members '[ Modules location value - , Resumable ResolutionError - ] effects +resolveRubyName :: ( Member (Modules location value) effects + , Member (Resumable ResolutionError) effects + ) => ByteString -> Evaluator location value effects M.ModulePath resolveRubyName name = do @@ -29,9 +29,9 @@ resolveRubyName name = do maybe (throwResumable $ NotFoundError name' paths Language.Ruby) pure modulePath -- load "/root/src/file.rb" -resolveRubyPath :: Members '[ Modules location value - , Resumable ResolutionError - ] effects +resolveRubyPath :: ( Member (Modules location value) effects + , Member (Resumable ResolutionError) effects + ) => ByteString -> Evaluator location value effects M.ModulePath resolveRubyPath path = do @@ -109,12 +109,11 @@ instance Evaluatable Load where eval (Load _) = raiseEff (fail "invalid argument supplied to load, path is required") doLoad :: ( AbstractValue location value effects - , Members '[ Modules location value - , Resumable ResolutionError - , State (Environment location) - , State (Exports location) - , Trace - ] effects + , Member (Modules location value) effects + , Member (Resumable ResolutionError) effects + , Member (State (Environment location)) effects + , Member (State (Exports location)) effects + , Member Trace effects ) => ByteString -> Bool diff --git a/src/Language/TypeScript/Syntax.hs b/src/Language/TypeScript/Syntax.hs index 152723cdc..cd7d7cd88 100644 --- a/src/Language/TypeScript/Syntax.hs +++ b/src/Language/TypeScript/Syntax.hs @@ -37,12 +37,12 @@ toName = name . BC.pack . unPath -- -- NB: TypeScript has a couple of different strategies, but the main one (and the -- only one we support) mimics Node.js. -resolveWithNodejsStrategy :: Members '[ Modules location value - , Reader M.ModuleInfo - , Reader PackageInfo - , Resumable ResolutionError - , Trace - ] effects +resolveWithNodejsStrategy :: ( Member (Modules location value) effects + , Member (Reader M.ModuleInfo) effects + , Member (Reader PackageInfo) effects + , Member (Resumable ResolutionError) effects + , Member Trace effects + ) => ImportPath -> [String] -> Evaluator location value effects M.ModulePath @@ -56,12 +56,12 @@ resolveWithNodejsStrategy (ImportPath path NonRelative) exts = resolveNonRelativ -- /root/src/moduleB.ts -- /root/src/moduleB/package.json (if it specifies a "types" property) -- /root/src/moduleB/index.ts -resolveRelativePath :: Members '[ Modules location value - , Reader M.ModuleInfo - , Reader PackageInfo - , Resumable ResolutionError - , Trace - ] effects +resolveRelativePath :: ( Member (Modules location value) effects + , Member (Reader M.ModuleInfo) effects + , Member (Reader PackageInfo) effects + , Member (Resumable ResolutionError) effects + , Member Trace effects + ) => FilePath -> [String] -> Evaluator location value effects M.ModulePath @@ -84,12 +84,12 @@ resolveRelativePath relImportPath exts = do -- -- /root/node_modules/moduleB.ts, etc -- /node_modules/moduleB.ts, etc -resolveNonRelativePath :: Members '[ Modules location value - , Reader M.ModuleInfo - , Reader PackageInfo - , Resumable ResolutionError - , Trace - ] effects +resolveNonRelativePath :: ( Member (Modules location value) effects + , Member (Reader M.ModuleInfo) effects + , Member (Reader PackageInfo) effects + , Member (Resumable ResolutionError) effects + , Member Trace effects + ) => FilePath -> [String] -> Evaluator location value effects M.ModulePath @@ -109,13 +109,13 @@ resolveNonRelativePath name exts = do notFound xs = throwResumable $ NotFoundError name xs Language.TypeScript -- | Resolve a module name to a ModulePath. -resolveModule :: Members '[ Modules location value - , Reader PackageInfo - , Trace - ] effects - => FilePath -- ^ Module path used as directory to search in - -> [String] -- ^ File extensions to look for - -> Evaluator location value effects (Either [FilePath] M.ModulePath) +resolveModule :: ( Member (Modules location value) effects + , Member (Reader PackageInfo) effects + , Member Trace effects + ) + => FilePath -- ^ Module path used as directory to search in + -> [String] -- ^ File extensions to look for + -> Evaluator location value effects (Either [FilePath] M.ModulePath) resolveModule path' exts = do let path = makeRelative "." path' PackageInfo{..} <- currentPackage @@ -133,14 +133,12 @@ javascriptExtensions :: [String] javascriptExtensions = ["js"] evalRequire :: ( AbstractValue location value effects - , Members '[ Allocator location value - , Modules location value - , Reader (Environment location) - , State (Environment location) - , State (Exports location) - , State (Heap location (Cell location) value) - , Trace - ] effects + , Member (Allocator location value) effects + , Member (Modules location value) effects + , Member (Reader (Environment location)) effects + , Member (State (Environment location)) effects + , Member (State (Exports location)) effects + , Member (State (Heap location (Cell location) value)) effects , Ord location , Reducer value (Cell location value) ) diff --git a/src/Rendering/Graph.hs b/src/Rendering/Graph.hs index b1a0d3e1b..39feeda26 100644 --- a/src/Rendering/Graph.hs +++ b/src/Rendering/Graph.hs @@ -28,7 +28,7 @@ runGraph :: Eff '[Fresh, Reader (Graph vertex)] (Graph vertex) -> Graph vertex runGraph = run . runReader mempty . runFresh 0 -termAlgebra :: (ConstructorName syntax, Foldable syntax, Members '[Fresh, Reader (Graph (Vertex tag))] effs) +termAlgebra :: (ConstructorName syntax, Foldable syntax, Member Fresh effs, Member (Reader (Graph (Vertex tag))) effs) => tag -> TermF syntax ann (Eff effs (Graph (Vertex tag))) -> Eff effs (Graph (Vertex tag)) @@ -63,7 +63,7 @@ data DiffTag = Deleted | Inserted | Merged class ToTreeGraph vertex t | t -> vertex where - toTreeGraph :: Members '[Fresh, Reader (Graph vertex)] effs => t (Eff effs (Graph vertex)) -> Eff effs (Graph vertex) + toTreeGraph :: (Member Fresh effs, Member (Reader (Graph vertex)) effs) => t (Eff effs (Graph vertex)) -> Eff effs (Graph vertex) instance (ConstructorName syntax, Foldable syntax) => ToTreeGraph (Vertex ()) (TermF syntax ann) where toTreeGraph = termAlgebra () diff --git a/src/Semantic/AST.hs b/src/Semantic/AST.hs index 5feb46a36..7df7beca9 100644 --- a/src/Semantic/AST.hs +++ b/src/Semantic/AST.hs @@ -16,7 +16,7 @@ data SomeAST where withSomeAST :: (forall grammar . Show grammar => AST [] grammar -> a) -> SomeAST -> a withSomeAST f (SomeAST ast) = f ast -astParseBlob :: Members '[Task, Exc SomeException] effs => Blob -> Eff effs SomeAST +astParseBlob :: (Member (Exc SomeException) effs, Member Task effs) => Blob -> Eff effs SomeAST astParseBlob blob@Blob{..} | Just (SomeASTParser parser) <- someASTParser <$> blobLanguage = SomeAST <$> parse parser blob @@ -26,7 +26,7 @@ astParseBlob blob@Blob{..} data ASTFormat = SExpression | JSON | Show deriving (Show) -runASTParse :: Members '[Distribute WrappedTask, Task, Exc SomeException] effects => ASTFormat -> [Blob] -> Eff effects F.Builder +runASTParse :: (Member (Distribute WrappedTask) effects, Member Task effects) => ASTFormat -> [Blob] -> Eff effects F.Builder runASTParse SExpression = distributeFoldMap (WrapTask . (astParseBlob >=> withSomeAST (serialize (F.SExpression F.ByShow)))) runASTParse Show = distributeFoldMap (WrapTask . (astParseBlob >=> withSomeAST (serialize F.Show))) runASTParse JSON = distributeFoldMap (\ blob -> WrapTask (astParseBlob blob >>= withSomeAST (render (renderJSONAST blob)))) >=> serialize F.JSON diff --git a/src/Semantic/Diff.hs b/src/Semantic/Diff.hs index 70caaabac..e6012cbb5 100644 --- a/src/Semantic/Diff.hs +++ b/src/Semantic/Diff.hs @@ -20,7 +20,7 @@ import Semantic.Stat as Stat import Semantic.Task as Task import Serializing.Format -runDiff :: Members '[Distribute WrappedTask, Task, Telemetry, Exc SomeException, IO] effs => DiffRenderer output -> [BlobPair] -> Eff effs Builder +runDiff :: (Member (Distribute WrappedTask) effs, Member Task effs) => DiffRenderer output -> [BlobPair] -> Eff effs Builder runDiff ToCDiffRenderer = withParsedBlobPairs (decorate . declarationAlgebra) (render . renderToCDiff) >=> serialize JSON runDiff JSONDiffRenderer = withParsedBlobPairs (const (decorate constructorLabel >=> decorate identifierLabel)) (render . renderJSONDiff) >=> serialize JSON runDiff SExpressionDiffRenderer = withParsedBlobPairs (const pure) (const (serialize (SExpression ByConstructorName))) @@ -33,24 +33,24 @@ data SomeTermPair typeclasses ann where withSomeTermPair :: (forall syntax . ApplyAll typeclasses syntax => Join These (Term syntax ann) -> a) -> SomeTermPair typeclasses ann -> a withSomeTermPair with (SomeTermPair terms) = with terms -diffBlobTOCPairs :: Members '[Distribute WrappedTask, Task, Telemetry, Exc SomeException, IO] effs => [BlobPair] -> Eff effs ([TOCSummary], [TOCSummary]) +diffBlobTOCPairs :: Member (Distribute WrappedTask) effs => [BlobPair] -> Eff effs ([TOCSummary], [TOCSummary]) diffBlobTOCPairs = withParsedBlobPairs (decorate . declarationAlgebra) (render . renderRPCToCDiff) type CanDiff syntax = (ConstructorName syntax, Diffable syntax, Eq1 syntax, GAlign syntax, HasDeclaration syntax, IdentifierName syntax, Hashable1 syntax, Show1 syntax, ToJSONFields1 syntax, Traversable syntax) -withParsedBlobPairs :: (Members '[Distribute WrappedTask, Exc SomeException, IO, Task, Telemetry] effs, Monoid output) +withParsedBlobPairs :: (Member (Distribute WrappedTask) effs, Monoid output) => (forall syntax . CanDiff syntax => Blob -> Term syntax (Record Location) -> TaskEff (Term syntax (Record fields))) -> (forall syntax . CanDiff syntax => BlobPair -> Diff syntax (Record fields) (Record fields) -> TaskEff output) -> [BlobPair] -> Eff effs output withParsedBlobPairs decorate render = distributeFoldMap (\ blobs -> WrapTask (withParsedBlobPair decorate blobs >>= withSomeTermPair (diffTerms blobs >=> render blobs))) - where diffTerms :: (Diffable syntax, Eq1 syntax, GAlign syntax, Hashable1 syntax, Traversable syntax, Members '[IO, Task, Telemetry] effs) => BlobPair -> Join These (Term syntax (Record fields)) -> Eff effs (Diff syntax (Record fields) (Record fields)) + where diffTerms :: (Diffable syntax, Eq1 syntax, GAlign syntax, Hashable1 syntax, Traversable syntax, Member IO effs, Member Task effs, Member Telemetry effs) => BlobPair -> Join These (Term syntax (Record fields)) -> Eff effs (Diff syntax (Record fields) (Record fields)) diffTerms blobs terms = time "diff" languageTag $ do diff <- diff (runJoin terms) diff <$ writeStat (Stat.count "diff.nodes" (bilength diff) languageTag) where languageTag = languageTagForBlobPair blobs -withParsedBlobPair :: Members '[Distribute WrappedTask, Exc SomeException, Task] effs +withParsedBlobPair :: (Member (Distribute WrappedTask) effs, Member (Exc SomeException) effs) => (forall syntax . (CanDiff syntax) => Blob -> Term syntax (Record Location) -> TaskEff (Term syntax (Record fields))) -> BlobPair -> Eff effs (SomeTermPair '[ConstructorName, Diffable, Eq1, GAlign, HasDeclaration, Hashable1, IdentifierName, Show1, ToJSONFields1, Traversable] (Record fields)) diff --git a/src/Semantic/Distribute.hs b/src/Semantic/Distribute.hs index 6cf5aa14b..af176b2d2 100644 --- a/src/Semantic/Distribute.hs +++ b/src/Semantic/Distribute.hs @@ -39,6 +39,6 @@ data Distribute task output where -- | Evaluate a 'Distribute' effect concurrently. -runDistribute :: Members '[Exc SomeException, IO] effs => (forall output . task output -> IO (Either SomeException output)) -> Eff (Distribute task ': effs) a -> Eff effs a +runDistribute :: (Member (Exc SomeException) effs, Member IO effs) => (forall output . task output -> IO (Either SomeException output)) -> Eff (Distribute task ': effs) a -> Eff effs a runDistribute action = interpret (\ (Distribute tasks) -> liftIO (Async.mapConcurrently action tasks) >>= either throwError pure . sequenceA . withStrategy (parTraversable (parTraversable rseq))) diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 1f35bac52..51de9ae49 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -39,7 +39,7 @@ import Semantic.Task as Task data GraphType = ImportGraph | CallGraph -runGraph :: Members '[Distribute WrappedTask, Files, Resolution, Task, Exc SomeException, Telemetry, Trace] effs +runGraph :: ( Member (Distribute WrappedTask) effs, Member (Exc SomeException) effs, Member Files effs, Member Resolution effs, Member Task effs, Member Trace effs) => GraphType -> Bool -> Project @@ -71,7 +71,7 @@ runGraph graphType includePackages project . graphing -- | Parse a list of files into a 'Package'. -parsePackage :: Members '[Distribute WrappedTask, Files, Resolution, Task, Trace] effs +parsePackage :: (Member (Distribute WrappedTask) effs, Member Files effs, Member Resolution effs, Member Task effs, Member Trace effs) => Parser term -- ^ A parser. -> Maybe File -- ^ Prelude (optional). -> Project -- ^ Project to parse into a package. @@ -87,11 +87,11 @@ parsePackage parser preludeFile project@Project{..} = do n = name (projectName project) -- | Parse all files in a project into 'Module's. - parseModules :: Members '[Distribute WrappedTask, Files, Task] effs => Parser term -> Project -> Eff effs [Module term] + parseModules :: Member (Distribute WrappedTask) effs => Parser term -> Project -> Eff effs [Module term] parseModules parser Project{..} = distributeFor (projectEntryPoints <> projectFiles) (WrapTask . parseModule parser (Just projectRootDir)) -- | Parse a file into a 'Module'. -parseModule :: Members '[Files, Task] effs => Parser term -> Maybe FilePath -> File -> Eff effs (Module term) +parseModule :: (Member Files effs, Member Task effs) => Parser term -> Maybe FilePath -> File -> Eff effs (Module term) parseModule parser rootDir file = do blob <- readBlob file moduleForBlob rootDir blob <$> parse parser blob @@ -129,7 +129,7 @@ resumingAddressError = runAddressErrorWith (\ err -> trace ("AddressError:" <> s UnallocatedAddress _ -> pure lowerBound UninitializedAddress _ -> pure hole) -resumingValueError :: (Members '[State (Environment location), Trace] effects, Show location) => Evaluator location (Value location body) (Resumable (ValueError location body) ': effects) a -> Evaluator location (Value location body) effects a +resumingValueError :: (Member (State (Environment location)) effects, Member Trace effects, Show location) => Evaluator location (Value location body) (Resumable (ValueError location body) ': effects) a -> Evaluator location (Value location body) effects a resumingValueError = runValueErrorWith (\ err -> trace ("ValueError" <> show err) *> case err of CallError val -> pure val StringError val -> pure (pack (show val)) diff --git a/src/Semantic/IO.hs b/src/Semantic/IO.hs index 76131337c..d2af785e9 100644 --- a/src/Semantic/IO.hs +++ b/src/Semantic/IO.hs @@ -251,7 +251,7 @@ data Files out where Write :: Destination -> B.Builder -> Files () -- | Run a 'Files' effect in 'IO'. -runFiles :: Members '[Exc SomeException, IO] effs => Eff (Files ': effs) a -> Eff effs a +runFiles :: (Member (Exc SomeException) effs, Member IO effs) => Eff (Files ': effs) a -> Eff effs a runFiles = interpret $ \ files -> case files of Read (FromPath path) -> rethrowing (readBlobFromPath path) Read (FromHandle handle) -> rethrowing (readBlobsFromHandle handle) diff --git a/src/Semantic/Parse.hs b/src/Semantic/Parse.hs index 3444da9e7..122c037bf 100644 --- a/src/Semantic/Parse.hs +++ b/src/Semantic/Parse.hs @@ -18,7 +18,7 @@ import Semantic.IO (noLanguageForBlob) import Semantic.Task import Serializing.Format -runParse :: Members '[Distribute WrappedTask, Task, Exc SomeException] effs => TermRenderer output -> [Blob] -> Eff effs Builder +runParse :: (Member (Distribute WrappedTask) effs, Member Task effs) => TermRenderer output -> [Blob] -> Eff effs Builder runParse JSONTermRenderer = withParsedBlobs (\ blob -> decorate constructorLabel >=> decorate identifierLabel >=> render (renderJSONTerm blob)) >=> serialize JSON runParse SExpressionTermRenderer = withParsedBlobs (const (serialize (SExpression ByConstructorName))) runParse ShowTermRenderer = withParsedBlobs (const (serialize Show)) @@ -27,8 +27,8 @@ runParse ImportsTermRenderer = withParsedBlobs (\ blob -> decorate (dec runParse (SymbolsTermRenderer fields) = withParsedBlobs (\ blob -> decorate (declarationAlgebra blob) >=> render (renderSymbolTerms . renderToSymbols fields blob)) >=> serialize JSON runParse DOTTermRenderer = withParsedBlobs (const (render renderTreeGraph)) >=> serialize (DOT (termStyle "terms")) -withParsedBlobs :: (Members '[Distribute WrappedTask, Task, Exc SomeException] effs, Monoid output) => (forall syntax . (ConstructorName syntax, Foldable syntax, Functor syntax, HasDeclaration syntax, HasPackageDef syntax, IdentifierName syntax, Show1 syntax, ToJSONFields1 syntax) => Blob -> Term syntax (Record Location) -> TaskEff output) -> [Blob] -> Eff effs output +withParsedBlobs :: (Member (Distribute WrappedTask) effs, Monoid output) => (forall syntax . (ConstructorName syntax, Foldable syntax, Functor syntax, HasDeclaration syntax, HasPackageDef syntax, IdentifierName syntax, Show1 syntax, ToJSONFields1 syntax) => Blob -> Term syntax (Record Location) -> TaskEff output) -> [Blob] -> Eff effs output withParsedBlobs render = distributeFoldMap (\ blob -> WrapTask (parseSomeBlob blob >>= withSomeTerm (render blob))) -parseSomeBlob :: Members '[Task, Exc SomeException] effs => Blob -> Eff effs (SomeTerm '[ConstructorName, Foldable, Functor, HasDeclaration, HasPackageDef, IdentifierName, Show1, ToJSONFields1] (Record Location)) +parseSomeBlob :: (Member (Exc SomeException) effs, Member Task effs) => Blob -> Eff effs (SomeTerm '[ConstructorName, Foldable, Functor, HasDeclaration, HasPackageDef, IdentifierName, Show1, ToJSONFields1] (Record Location)) parseSomeBlob blob@Blob{..} = maybe (noLanguageForBlob blobPath) (flip parse blob . someParser) blobLanguage diff --git a/src/Semantic/Resolution.hs b/src/Semantic/Resolution.hs index 52b14028f..438af10c3 100644 --- a/src/Semantic/Resolution.hs +++ b/src/Semantic/Resolution.hs @@ -39,7 +39,7 @@ data Resolution output where NodeJSResolution :: FilePath -> Text -> [FilePath] -> Resolution (Map FilePath FilePath) NoResolution :: Resolution (Map FilePath FilePath) -runResolution :: Members '[Files] effs => Eff (Resolution ': effs) a -> Eff effs a +runResolution :: Member Files effs => Eff (Resolution ': effs) a -> Eff effs a runResolution = interpret $ \ res -> case res of NodeJSResolution dir prop excludeDirs -> nodeJSResolutionMap dir prop excludeDirs NoResolution -> pure Map.empty diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs index 20132f7a9..b27d12d74 100644 --- a/src/Semantic/Task.hs +++ b/src/Semantic/Task.hs @@ -167,7 +167,7 @@ data Task output where Serialize :: Format input -> input -> Task Builder -- | Run a 'Task' effect by performing the actions in 'IO'. -runTaskF :: Members '[Reader Options, Telemetry, Exc SomeException, Trace, IO] effs => Eff (Task ': effs) a -> Eff effs a +runTaskF :: (Member (Exc SomeException) effs, Member IO effs, Member (Reader Options) effs, Member Telemetry effs, Member Trace effs) => Eff (Task ': effs) a -> Eff effs a runTaskF = interpret $ \ task -> case task of Parse parser blob -> runParser blob parser Analyze interpret analysis -> pure (interpret analysis) @@ -191,7 +191,7 @@ defaultTimeout :: Timeout defaultTimeout = Milliseconds 5000 -- | Parse a 'Blob' in 'IO'. -runParser :: Members '[Reader Options, Telemetry, Exc SomeException, IO, Trace] effs => Blob -> Parser term -> Eff effs term +runParser :: (Member (Exc SomeException) effs, Member IO effs, Member (Reader Options) effs, Member Telemetry effs, Member Trace effs) => Blob -> Parser term -> Eff effs term runParser blob@Blob{..} parser = case parser of ASTParser language -> time "parse.tree_sitter_ast_parse" languageTag $ diff --git a/src/Semantic/Telemetry.hs b/src/Semantic/Telemetry.hs index ed1389b38..2e4a393bf 100644 --- a/src/Semantic/Telemetry.hs +++ b/src/Semantic/Telemetry.hs @@ -23,7 +23,7 @@ writeStat :: Member Telemetry effs => Stat -> Eff effs () writeStat stat = send (WriteStat stat) -- | A task which measures and stats the timing of another task. -time :: Members '[Telemetry, IO] effs => String -> [(String, String)] -> Eff effs output -> Eff effs output +time :: (Member IO effs, Member Telemetry effs) => String -> [(String, String)] -> Eff effs output -> Eff effs output time statName tags task = do (a, stat) <- withTiming statName tags task a <$ writeStat stat diff --git a/test/Rendering/TOC/Spec.hs b/test/Rendering/TOC/Spec.hs index cb6e7d41d..c791482bf 100644 --- a/test/Rendering/TOC/Spec.hs +++ b/test/Rendering/TOC/Spec.hs @@ -243,7 +243,8 @@ diffWithParser :: ( HasField fields Data.Span.Span , GAlign syntax , HasDeclaration syntax , Hashable1 syntax - , Members '[Distribute WrappedTask, Task] effs + , Member (Distribute WrappedTask) effects + , Member Task effects ) => Parser (Term syntax (Record fields)) -> BlobPair From 09a5fdd0593e8ee287a778909a1bf80c4913980e Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 29 May 2018 12:12:34 -0400 Subject: [PATCH 095/148] Bump effects to :fire: Members. --- vendor/effects | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vendor/effects b/vendor/effects index 4b4f2956d..adec65af3 160000 --- a/vendor/effects +++ b/vendor/effects @@ -1 +1 @@ -Subproject commit 4b4f2956d8a4d5542990431a1d0a5735f48f917e +Subproject commit adec65af304cc31681ce02111985aa73e1f11cf5 From d869fa4ec8d6080126d705f0510ca1922f81cbf4 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 29 May 2018 12:14:19 -0400 Subject: [PATCH 096/148] :fire: some redundant constraints. --- src/Analysis/Abstract/Caching.hs | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/Analysis/Abstract/Caching.hs b/src/Analysis/Abstract/Caching.hs index b43cedb72..13e76a502 100644 --- a/src/Analysis/Abstract/Caching.hs +++ b/src/Analysis/Abstract/Caching.hs @@ -58,8 +58,7 @@ isolateCache action = putCache lowerBound *> action *> get -- | Analyze a term using the in-cache as an oracle & storing the results of the analysis in the out-cache. cachingTerms :: ( Cacheable term location (Cell location) value , Corecursive term - , Member (Fresh) effects - , Member (NonDet) effects + , Member NonDet effects , Member (Reader (Cache term location (Cell location) value)) effects , Member (Reader (Live location value)) effects , Member (State (Cache term location (Cell location) value)) effects @@ -80,12 +79,11 @@ cachingTerms recur term = do convergingModules :: ( AbstractValue location value effects , Cacheable term location (Cell location) value , Member (Allocator location value) effects - , Member (Fresh) effects - , Member (NonDet) effects + , Member Fresh effects + , Member NonDet effects , Member (Reader (Cache term location (Cell location) value)) effects , Member (Reader (Environment location)) effects , Member (Reader (Live location value)) effects - , Member (Resumable (AddressError location value)) effects , Member (Resumable (EnvironmentError location)) effects , Member (State (Cache term location (Cell location) value)) effects , Member (State (Environment location)) effects From 44da174cf96e65a41bff2a784912e7b46fc71344 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 29 May 2018 12:14:46 -0400 Subject: [PATCH 097/148] :fire: a couple more uses of Members. --- 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 20e4a3ead..8ad708b39 100644 --- a/src/Parsing/TreeSitter.hs +++ b/src/Parsing/TreeSitter.hs @@ -69,7 +69,7 @@ bracket' before after action = do -- | Parse 'Source' with the given 'TS.Language' and return its AST. -- Returns Nothing if the operation timed out. -parseToAST :: (Bounded grammar, Enum grammar, Members '[Trace, IO] effects) => Timeout -> Ptr TS.Language -> Blob -> Eff effects (Maybe (AST [] grammar)) +parseToAST :: (Bounded grammar, Enum grammar, Member IO effects, Member Trace effects) => Timeout -> Ptr TS.Language -> Blob -> Eff effects (Maybe (AST [] grammar)) parseToAST (Milliseconds s) language Blob{..} = bracket' TS.ts_parser_new TS.ts_parser_delete $ \ parser -> do let parserTimeout = s * 1000 From 81032f34ecbf79144f51c280146b45d57e5381a6 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 29 May 2018 12:26:36 -0400 Subject: [PATCH 098/148] Whoops. --- test/Rendering/TOC/Spec.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/Rendering/TOC/Spec.hs b/test/Rendering/TOC/Spec.hs index c791482bf..35d1c92db 100644 --- a/test/Rendering/TOC/Spec.hs +++ b/test/Rendering/TOC/Spec.hs @@ -243,8 +243,8 @@ diffWithParser :: ( HasField fields Data.Span.Span , GAlign syntax , HasDeclaration syntax , Hashable1 syntax - , Member (Distribute WrappedTask) effects - , Member Task effects + , Member (Distribute WrappedTask) effs + , Member Task effs ) => Parser (Term syntax (Record fields)) -> BlobPair From 8a147f1d56394e7ea606afa6c1bb6bf162d5f0e7 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 29 May 2018 12:52:00 -0400 Subject: [PATCH 099/148] Weaken the constraints on beforeTerm/afterTerm to Foldable. --- src/Data/Diff.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Data/Diff.hs b/src/Data/Diff.hs index f92bf1837..a364d94d1 100644 --- a/src/Data/Diff.hs +++ b/src/Data/Diff.hs @@ -89,13 +89,13 @@ diffPatches = para $ \ diff -> case diff of -- | Recover the before state of a diff. -beforeTerm :: (Mergeable syntax, Traversable syntax) => Diff syntax ann1 ann2 -> Maybe (Term syntax ann1) +beforeTerm :: (Foldable syntax, Mergeable syntax) => Diff syntax ann1 ann2 -> Maybe (Term syntax ann1) beforeTerm = cata $ \ diff -> case diff of Patch patch -> (before patch >>= \ (In a l) -> termIn a <$> sequenceAlt l) <|> (after patch >>= asum) Merge (In (a, _) l) -> termIn a <$> sequenceAlt l -- | Recover the after state of a diff. -afterTerm :: (Mergeable syntax, Traversable syntax) => Diff syntax ann1 ann2 -> Maybe (Term syntax ann2) +afterTerm :: (Foldable syntax, Mergeable syntax) => Diff syntax ann1 ann2 -> Maybe (Term syntax ann2) afterTerm = cata $ \ diff -> case diff of Patch patch -> (after patch >>= \ (In b r) -> termIn b <$> sequenceAlt r) <|> (before patch >>= asum) Merge (In (_, b) r) -> termIn b <$> sequenceAlt r From 6796f13efe82fdb39ee1911ea18cebdc4dbbf3cb Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Tue, 29 May 2018 13:35:39 -0700 Subject: [PATCH 100/148] First pass at Generic toJSONFields1 --- src/Data/JSON/Fields.hs | 73 +++++++++++++++++++++++++++++++++++++---- 1 file changed, 67 insertions(+), 6 deletions(-) diff --git a/src/Data/JSON/Fields.hs b/src/Data/JSON/Fields.hs index bf4a56d8b..bf144c508 100644 --- a/src/Data/JSON/Fields.hs +++ b/src/Data/JSON/Fields.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE DefaultSignatures, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE DefaultSignatures, MultiParamTypeClasses, TypeOperators, UndecidableInstances, GADTs #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} -- FIXME module Data.JSON.Fields ( JSONFields (..) , JSONFields1 (..) @@ -9,17 +10,19 @@ module Data.JSON.Fields , withChildren ) where -import Data.Aeson -import Data.Sum (Apply(..), Sum) -import Prologue +import Data.Aeson +import Data.Sum (Apply (..), Sum) +import qualified Data.Text as Text +import qualified Data.Text.Encoding as Text +import Prologue class ToJSONFields a where toJSONFields :: KeyValue kv => a -> [kv] class ToJSONFields1 f where toJSONFields1 :: (KeyValue kv, ToJSON a) => f a -> [kv] - default toJSONFields1 :: (KeyValue kv, ToJSON a, Foldable f) => f a -> [kv] - toJSONFields1 f = ["children" .= toList f] + default toJSONFields1 :: (KeyValue kv, ToJSON a, GToJSONFields1 (Rep1 f), Generic1 f) => f a -> [kv] + toJSONFields1 = gtoJSONFields1 . from1 withChildren :: (KeyValue kv, ToJSON a, Foldable f) => f a -> [kv] -> [kv] withChildren f ks = ("children" .= toList f) : ks @@ -67,3 +70,61 @@ instance (ToJSON a, ToJSONFields1 f) => ToJSONFields (JSONFields1 f a) where instance (ToJSON a, ToJSONFields1 f) => ToJSON (JSONFields1 f a) where toJSON = object . toJSONFields1 . unJSONFields1 toEncoding = pairs . mconcat . toJSONFields1 . unJSONFields1 + + +class GToJSONFields1 f where + gtoJSONFields1 :: (KeyValue kv, ToJSON a) => f a -> [kv] + +instance GToJSONFields1 f => GToJSONFields1 (M1 D c f) where + gtoJSONFields1 = gtoJSONFields1 . unM1 + +instance GToJSONFields1 f => GToJSONFields1 (M1 C c f) where + gtoJSONFields1 = gtoJSONFields1 . unM1 + +instance GToJSONFields1 U1 where + gtoJSONFields1 _ = [] + +instance (Selector c, GToJSONFields1' f) => GToJSONFields1 (M1 S c f) where + gtoJSONFields1 m1 = let json = gtoJSON (unM1 m1) in case selName m1 of + "" -> [ "children" .= json ] + n -> [ Text.pack n .= json ] + +class GToJSONFields1' f where + gtoJSON :: ToJSON a => f a -> SomeJSON + +instance GToJSONFields1' Par1 where + gtoJSON = SomeJSON . unPar1 + +instance ToJSON1 f => GToJSONFields1' (Rec1 f) where + gtoJSON = SomeJSON . SomeJSON1 . unRec1 + +instance ToJSON k => GToJSONFields1' (K1 r k) where + gtoJSON = SomeJSON . unK1 + +instance (GToJSONFields1 f, GToJSONFields1 g) => GToJSONFields1 (f :+: g) where + gtoJSONFields1 (L1 l) = gtoJSONFields1 l + gtoJSONFields1 (R1 r) = gtoJSONFields1 r + +instance (GToJSONFields1 f, GToJSONFields1 g) => GToJSONFields1 (f :*: g) where + gtoJSONFields1 (x :*: y) = gtoJSONFields1 x <> gtoJSONFields1 y + + +-- TODO: Fix this orphan instance. +instance ToJSON ByteString where + toJSON = toJSON . Text.decodeUtf8 + toEncoding = toEncoding . Text.decodeUtf8 + + +data SomeJSON where + SomeJSON :: ToJSON a => a -> SomeJSON + +instance ToJSON SomeJSON where + toJSON (SomeJSON a) = toJSON a + toEncoding (SomeJSON a) = toEncoding a + +data SomeJSON1 where + SomeJSON1 :: (ToJSON1 f, ToJSON a) => f a -> SomeJSON1 + +instance ToJSON SomeJSON1 where + toJSON (SomeJSON1 fa) = toJSON1 fa + toEncoding (SomeJSON1 fa) = toEncoding1 fa From dbc70de4046f4502b6e0d5ffdc08eef58b4ef16a Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Tue, 29 May 2018 13:35:53 -0700 Subject: [PATCH 101/148] Custom ToJSON for Name --- src/Data/Abstract/Name.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/Data/Abstract/Name.hs b/src/Data/Abstract/Name.hs index 46bf635ee..80f507824 100644 --- a/src/Data/Abstract/Name.hs +++ b/src/Data/Abstract/Name.hs @@ -6,11 +6,13 @@ module Data.Abstract.Name , unName ) where +import Data.Aeson import qualified Data.ByteString.Char8 as BC import qualified Data.Char as Char +import Data.JSON.Fields () +import Data.String import qualified Data.Text as Text import qualified Data.Text.Encoding as Text -import Data.String import Prologue -- | The type of variable names. @@ -53,3 +55,7 @@ instance Show Name where instance Hashable Name where hashWithSalt salt (Name name) = hashWithSalt salt name hashWithSalt salt (I i) = salt `hashWithSalt` (1 :: Int) `hashWithSalt` i + +instance ToJSON Name where + toJSON = toJSON . Text.decodeUtf8 . unName + toEncoding = toEncoding . Text.decodeUtf8 . unName From 9a8c117515e5588c4f5c012f940f3b9c6882c99c Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Tue, 29 May 2018 13:36:02 -0700 Subject: [PATCH 102/148] Custom ToJSON for Identifier --- src/Data/Syntax.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs index 6cbc8a201..bdc1eca09 100644 --- a/src/Data/Syntax.hs +++ b/src/Data/Syntax.hs @@ -109,7 +109,8 @@ instance Ord1 Identifier where liftCompare = genericLiftCompare instance Show1 Identifier where liftShowsPrec = genericLiftShowsPrec -- Propagating the identifier name into JSON is handled with the IdentifierName analysis. -instance ToJSONFields1 Identifier +instance ToJSONFields1 Identifier where + toJSONFields1 (Identifier name) = [ "name" .= name ] instance Evaluatable Identifier where eval (Identifier name) = pure (LvalLocal name) From eef8d34d43478d91d710cad0475bc7edb50718f3 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Tue, 29 May 2018 13:36:15 -0700 Subject: [PATCH 103/148] Need a few toJSON instances here --- src/Language/Go/Syntax.hs | 5 +++-- src/Language/Python/Syntax.hs | 12 +++++++----- src/Language/TypeScript/Syntax.hs | 5 +++-- 3 files changed, 13 insertions(+), 9 deletions(-) diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index c37a784f8..e9105ccf6 100644 --- a/src/Language/Go/Syntax.hs +++ b/src/Language/Go/Syntax.hs @@ -5,6 +5,7 @@ import Data.Abstract.Evaluatable import Data.Abstract.Module import qualified Data.Abstract.Package as Package import Data.Abstract.Path +import Data.Aeson import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import Data.JSON.Fields @@ -13,10 +14,10 @@ import Prologue import System.FilePath.Posix data Relative = Relative | NonRelative - deriving (Eq, Generic, Hashable, Ord, Show) + deriving (Eq, Generic, Hashable, Ord, Show, ToJSON) data ImportPath = ImportPath { unPath :: FilePath, pathIsRelative :: Relative } - deriving (Eq, Generic, Hashable, Ord, Show) + deriving (Eq, Generic, Hashable, Ord, Show, ToJSON) importPath :: ByteString -> ImportPath importPath str = let path = stripQuotes str in ImportPath (BC.unpack path) (pathType path) diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index 1aa99d740..fa54d53ef 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -4,23 +4,25 @@ module Language.Python.Syntax where import Data.Abstract.Environment as Env import Data.Abstract.Evaluatable import Data.Abstract.Module -import qualified Data.ByteString.Char8 as BC +import Data.Aeson +import Data.Align.Generic import Data.Functor.Classes.Generic import Data.JSON.Fields -import qualified Data.Language as Language -import qualified Data.List.NonEmpty as NonEmpty -import qualified Data.Semigroup.Reducer as Reducer import Data.Mergeable import Diffing.Algorithm import GHC.Generics import Prelude hiding (fail) import Prologue import System.FilePath.Posix +import qualified Data.ByteString.Char8 as BC +import qualified Data.Language as Language +import qualified Data.List.NonEmpty as NonEmpty +import qualified Data.Semigroup.Reducer as Reducer data QualifiedName = QualifiedName (NonEmpty FilePath) | RelativeQualifiedName FilePath (Maybe QualifiedName) - deriving (Eq, Generic, Hashable, Ord, Show) + deriving (Eq, Generic, Hashable, Ord, Show, ToJSON) qualifiedName :: NonEmpty ByteString -> QualifiedName qualifiedName xs = QualifiedName (BC.unpack <$> xs) diff --git a/src/Language/TypeScript/Syntax.hs b/src/Language/TypeScript/Syntax.hs index 8fa467554..22e8c5d0b 100644 --- a/src/Language/TypeScript/Syntax.hs +++ b/src/Language/TypeScript/Syntax.hs @@ -6,6 +6,7 @@ import Data.Abstract.Evaluatable import qualified Data.Abstract.Module as M import Data.Abstract.Package import Data.Abstract.Path +import Data.Aeson import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import Data.JSON.Fields @@ -18,10 +19,10 @@ import Prologue import System.FilePath.Posix data Relative = Relative | NonRelative - deriving (Eq, Generic, Hashable, Ord, Show) + deriving (Eq, Generic, Hashable, Ord, Show, ToJSON) data ImportPath = ImportPath { unPath :: FilePath, pathIsRelative :: Relative } - deriving (Eq, Generic, Hashable, Ord, Show) + deriving (Eq, Generic, Hashable, Ord, Show, ToJSON) importPath :: ByteString -> ImportPath importPath str = let path = stripQuotes str in ImportPath (BC.unpack path) (pathType path) From d8438461770838eb696687228c47797b07145d92 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Tue, 29 May 2018 13:36:27 -0700 Subject: [PATCH 104/148] Call the top node "tree" --- src/Rendering/JSON.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Rendering/JSON.hs b/src/Rendering/JSON.hs index 733eea92e..7ecaf84aa 100644 --- a/src/Rendering/JSON.hs +++ b/src/Rendering/JSON.hs @@ -52,8 +52,8 @@ data JSONTerm a = JSONTerm { jsonTermBlob :: Blob, jsonTerm :: a } deriving (Eq, Show) instance ToJSON a => ToJSON (JSONTerm a) where - toJSON JSONTerm{..} = object ("programNode" .= jsonTerm : toJSONFields jsonTermBlob) - toEncoding JSONTerm{..} = pairs (fold ("programNode" .= jsonTerm : toJSONFields jsonTermBlob)) + toJSON JSONTerm{..} = object ("tree" .= jsonTerm : toJSONFields jsonTermBlob) + toEncoding JSONTerm{..} = pairs (fold ("tree" .= jsonTerm : toJSONFields jsonTermBlob)) renderJSONAST :: ToJSON a => Blob -> a -> JSON "trees" SomeJSON From bda6dd29d6b46e8adefa7c186737d4c23d08e71f Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Tue, 29 May 2018 13:36:36 -0700 Subject: [PATCH 105/148] Call it term instead of category --- src/Analysis/ConstructorName.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Analysis/ConstructorName.hs b/src/Analysis/ConstructorName.hs index 39473b755..d476cb986 100644 --- a/src/Analysis/ConstructorName.hs +++ b/src/Analysis/ConstructorName.hs @@ -24,7 +24,7 @@ instance Show ConstructorLabel where showsPrec _ (ConstructorLabel s) = showString (unpack s) instance ToJSONFields ConstructorLabel where - toJSONFields (ConstructorLabel s) = [ "category" .= decodeUtf8 s ] + toJSONFields (ConstructorLabel s) = [ "term" .= decodeUtf8 s ] -- | A typeclass to retrieve the name of the data constructor for a value. From 6acb7ffa2168600680bf82583fec57a69af6811e Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Tue, 29 May 2018 13:36:46 -0700 Subject: [PATCH 106/148] Give our List constructors a real name in output --- src/Analysis/ConstructorName.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/Analysis/ConstructorName.hs b/src/Analysis/ConstructorName.hs index d476cb986..85942ed9f 100644 --- a/src/Analysis/ConstructorName.hs +++ b/src/Analysis/ConstructorName.hs @@ -40,8 +40,7 @@ instance Apply ConstructorName fs => ConstructorNameWithStrategy 'Custom (Sum fs constructorNameWithStrategy _ = apply @ConstructorName constructorName instance ConstructorNameWithStrategy 'Custom [] where - constructorNameWithStrategy _ [] = "[]" - constructorNameWithStrategy _ _ = "" + constructorNameWithStrategy _ _ = "ExpressionList" data Strategy = Default | Custom From a9f132a1065839ff81d93515276242fe97a45f43 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Tue, 29 May 2018 13:36:54 -0700 Subject: [PATCH 107/148] No need for identifierLabel now --- src/Semantic/Parse.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Semantic/Parse.hs b/src/Semantic/Parse.hs index 122c037bf..66c477ae3 100644 --- a/src/Semantic/Parse.hs +++ b/src/Semantic/Parse.hs @@ -19,7 +19,7 @@ import Semantic.Task import Serializing.Format runParse :: (Member (Distribute WrappedTask) effs, Member Task effs) => TermRenderer output -> [Blob] -> Eff effs Builder -runParse JSONTermRenderer = withParsedBlobs (\ blob -> decorate constructorLabel >=> decorate identifierLabel >=> render (renderJSONTerm blob)) >=> serialize JSON +runParse JSONTermRenderer = withParsedBlobs (\ blob -> decorate constructorLabel >=> render (renderJSONTerm blob)) >=> serialize JSON runParse SExpressionTermRenderer = withParsedBlobs (const (serialize (SExpression ByConstructorName))) runParse ShowTermRenderer = withParsedBlobs (const (serialize Show)) runParse TagsTermRenderer = withParsedBlobs (\ blob -> decorate (declarationAlgebra blob) >=> render (renderToTags blob)) >=> serialize JSON From dc18598e12d57d8bd265c0187c2fde8781de31d6 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Tue, 29 May 2018 13:41:19 -0700 Subject: [PATCH 108/148] Don't need this --- src/Data/Abstract/Name.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Data/Abstract/Name.hs b/src/Data/Abstract/Name.hs index 80f507824..0c2a73f25 100644 --- a/src/Data/Abstract/Name.hs +++ b/src/Data/Abstract/Name.hs @@ -9,7 +9,6 @@ module Data.Abstract.Name import Data.Aeson import qualified Data.ByteString.Char8 as BC import qualified Data.Char as Char -import Data.JSON.Fields () import Data.String import qualified Data.Text as Text import qualified Data.Text.Encoding as Text From 86bc2da6ceb4b73f6b5e83d2ad3a58c3ac7ff3e6 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Tue, 29 May 2018 13:49:46 -0700 Subject: [PATCH 109/148] Whoops, need to drop this --- src/Language/Python/Syntax.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index fa54d53ef..b156ec724 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -5,7 +5,6 @@ import Data.Abstract.Environment as Env import Data.Abstract.Evaluatable import Data.Abstract.Module import Data.Aeson -import Data.Align.Generic import Data.Functor.Classes.Generic import Data.JSON.Fields import Data.Mergeable From d47a06d47ffd76ecb98aa23e08905ed3e160291b Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Tue, 29 May 2018 13:49:55 -0700 Subject: [PATCH 110/148] :fire: IdentifierName --- semantic.cabal | 1 - src/Analysis/IdentifierName.hs | 60 ---------------------------------- src/Semantic/Diff.hs | 9 +++-- src/Semantic/Parse.hs | 5 ++- 4 files changed, 6 insertions(+), 69 deletions(-) delete mode 100644 src/Analysis/IdentifierName.hs diff --git a/semantic.cabal b/semantic.cabal index 1aa7f9d1f..359b385eb 100644 --- a/semantic.cabal +++ b/semantic.cabal @@ -29,7 +29,6 @@ library , Analysis.CyclomaticComplexity , Analysis.Decorator , Analysis.Declaration - , Analysis.IdentifierName , Analysis.PackageDef -- Semantic assignment , Assigning.Assignment diff --git a/src/Analysis/IdentifierName.hs b/src/Analysis/IdentifierName.hs deleted file mode 100644 index f98d13fef..000000000 --- a/src/Analysis/IdentifierName.hs +++ /dev/null @@ -1,60 +0,0 @@ -{-# LANGUAGE ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} -module Analysis.IdentifierName -( IdentifierName(..) -, IdentifierLabel(..) -, identifierLabel -) where - -import Data.Abstract.Name (unName) -import Data.Aeson -import Data.JSON.Fields -import Data.Sum -import qualified Data.Syntax -import Data.Term -import Data.Text.Encoding (decodeUtf8) -import Prologue - --- | Compute a 'IdentifierLabel' label for a 'Term'. -identifierLabel :: IdentifierName syntax => TermF syntax a b -> Maybe IdentifierLabel -identifierLabel (In _ s) = IdentifierLabel <$> identifierName s - -newtype IdentifierLabel = IdentifierLabel ByteString - deriving (Show) - -instance ToJSONFields IdentifierLabel where - toJSONFields (IdentifierLabel s) = [ "name" .= decodeUtf8 s ] - - --- | A typeclass to retrieve the name of syntax identifiers. --- --- This typeclass employs the Advanced Overlap techniques designed by Oleg Kiselyov & Simon Peyton Jones: https://wiki.haskell.org/GHC/AdvancedOverlap; see also src/Analysis/Declaration.hs for discussion of the details of the mechanism. -class IdentifierName syntax where - identifierName :: syntax a -> Maybe ByteString - -instance (IdentifierNameStrategy syntax ~ strategy, IdentifierNameWithStrategy strategy syntax) => IdentifierName syntax where - identifierName = identifierNameWithStrategy (Proxy :: Proxy strategy) - -class CustomIdentifierName syntax where - customIdentifierName :: syntax a -> Maybe ByteString - -instance Apply IdentifierName fs => CustomIdentifierName (Sum fs) where - customIdentifierName = apply @IdentifierName identifierName - -instance CustomIdentifierName Data.Syntax.Identifier where - customIdentifierName (Data.Syntax.Identifier name) = Just (unName name) - -data Strategy = Default | Custom - -type family IdentifierNameStrategy syntax where - IdentifierNameStrategy (Sum _) = 'Custom - IdentifierNameStrategy Data.Syntax.Identifier = 'Custom - IdentifierNameStrategy syntax = 'Default - -class IdentifierNameWithStrategy (strategy :: Strategy) syntax where - identifierNameWithStrategy :: proxy strategy -> syntax a -> Maybe ByteString - -instance IdentifierNameWithStrategy 'Default syntax where - identifierNameWithStrategy _ _ = Nothing - -instance (CustomIdentifierName syntax) => IdentifierNameWithStrategy 'Custom syntax where - identifierNameWithStrategy _ = customIdentifierName diff --git a/src/Semantic/Diff.hs b/src/Semantic/Diff.hs index 1627ac36e..bfe9b616b 100644 --- a/src/Semantic/Diff.hs +++ b/src/Semantic/Diff.hs @@ -2,7 +2,6 @@ module Semantic.Diff where import Analysis.ConstructorName (ConstructorName, constructorLabel) -import Analysis.IdentifierName (IdentifierName, identifierLabel) import Analysis.Declaration (HasDeclaration, declarationAlgebra) import Data.AST import Data.Blob @@ -22,7 +21,7 @@ import Serializing.Format runDiff :: (Member (Distribute WrappedTask) effs, Member Task effs) => DiffRenderer output -> [BlobPair] -> Eff effs Builder runDiff ToCDiffRenderer = withParsedBlobPairs (decorate . declarationAlgebra) (render . renderToCDiff) >=> serialize JSON -runDiff JSONDiffRenderer = withParsedBlobPairs (const (decorate constructorLabel >=> decorate identifierLabel)) (render . renderJSONDiff) >=> serialize JSON +runDiff JSONDiffRenderer = withParsedBlobPairs (const (decorate constructorLabel)) (render . renderJSONDiff) >=> serialize JSON runDiff SExpressionDiffRenderer = withParsedBlobPairs (const pure) (const (serialize (SExpression ByConstructorName))) runDiff ShowDiffRenderer = withParsedBlobPairs (const pure) (const (serialize Show)) runDiff DOTDiffRenderer = withParsedBlobPairs (const pure) (const (render renderTreeGraph)) >=> serialize (DOT (diffStyle "diffs")) @@ -36,7 +35,7 @@ withSomeTermPair with (SomeTermPair terms) = with terms diffBlobTOCPairs :: Member (Distribute WrappedTask) effs => [BlobPair] -> Eff effs ([TOCSummary], [TOCSummary]) diffBlobTOCPairs = withParsedBlobPairs (decorate . declarationAlgebra) (render . renderRPCToCDiff) -type CanDiff syntax = (ConstructorName syntax, Diffable syntax, Eq1 syntax, HasDeclaration syntax, IdentifierName syntax, Hashable1 syntax, Show1 syntax, ToJSONFields1 syntax, Traversable syntax) +type CanDiff syntax = (ConstructorName syntax, Diffable syntax, Eq1 syntax, HasDeclaration syntax, Hashable1 syntax, Show1 syntax, ToJSONFields1 syntax, Traversable syntax) withParsedBlobPairs :: (Member (Distribute WrappedTask) effs, Monoid output) => (forall syntax . CanDiff syntax => Blob -> Term syntax (Record Location) -> TaskEff (Term syntax (Record fields))) @@ -53,8 +52,8 @@ withParsedBlobPairs decorate render = distributeFoldMap (\ blobs -> WrapTask (wi withParsedBlobPair :: (Member (Distribute WrappedTask) effs, Member (Exc SomeException) effs) => (forall syntax . (CanDiff syntax) => Blob -> Term syntax (Record Location) -> TaskEff (Term syntax (Record fields))) -> BlobPair - -> Eff effs (SomeTermPair '[ConstructorName, Diffable, Eq1, HasDeclaration, Hashable1, IdentifierName, Show1, ToJSONFields1, Traversable] (Record fields)) + -> Eff effs (SomeTermPair '[ConstructorName, Diffable, Eq1, HasDeclaration, Hashable1, Show1, ToJSONFields1, Traversable] (Record fields)) withParsedBlobPair decorate blobs - | Just (SomeParser parser) <- someParser @'[ConstructorName, Diffable, Eq1, HasDeclaration, Hashable1, IdentifierName, Show1, ToJSONFields1, Traversable] <$> languageForBlobPair blobs + | Just (SomeParser parser) <- someParser @'[ConstructorName, Diffable, Eq1, HasDeclaration, Hashable1, Show1, ToJSONFields1, Traversable] <$> languageForBlobPair blobs = SomeTermPair <$> distributeFor blobs (\ blob -> WrapTask (parse parser blob >>= decorate blob)) | otherwise = noLanguageForBlob (pathForBlobPair blobs) diff --git a/src/Semantic/Parse.hs b/src/Semantic/Parse.hs index 66c477ae3..9179748ae 100644 --- a/src/Semantic/Parse.hs +++ b/src/Semantic/Parse.hs @@ -2,7 +2,6 @@ module Semantic.Parse where import Analysis.ConstructorName (ConstructorName, constructorLabel) -import Analysis.IdentifierName (IdentifierName, identifierLabel) import Analysis.Declaration (HasDeclaration, declarationAlgebra) import Analysis.PackageDef (HasPackageDef, packageDefAlgebra) import Data.AST @@ -27,8 +26,8 @@ runParse ImportsTermRenderer = withParsedBlobs (\ blob -> decorate (dec runParse (SymbolsTermRenderer fields) = withParsedBlobs (\ blob -> decorate (declarationAlgebra blob) >=> render (renderSymbolTerms . renderToSymbols fields blob)) >=> serialize JSON runParse DOTTermRenderer = withParsedBlobs (const (render renderTreeGraph)) >=> serialize (DOT (termStyle "terms")) -withParsedBlobs :: (Member (Distribute WrappedTask) effs, Monoid output) => (forall syntax . (ConstructorName syntax, Foldable syntax, Functor syntax, HasDeclaration syntax, HasPackageDef syntax, IdentifierName syntax, Show1 syntax, ToJSONFields1 syntax) => Blob -> Term syntax (Record Location) -> TaskEff output) -> [Blob] -> Eff effs output +withParsedBlobs :: (Member (Distribute WrappedTask) effs, Monoid output) => (forall syntax . (ConstructorName syntax, Foldable syntax, Functor syntax, HasDeclaration syntax, HasPackageDef syntax, Show1 syntax, ToJSONFields1 syntax) => Blob -> Term syntax (Record Location) -> TaskEff output) -> [Blob] -> Eff effs output withParsedBlobs render = distributeFoldMap (\ blob -> WrapTask (parseSomeBlob blob >>= withSomeTerm (render blob))) -parseSomeBlob :: (Member (Exc SomeException) effs, Member Task effs) => Blob -> Eff effs (SomeTerm '[ConstructorName, Foldable, Functor, HasDeclaration, HasPackageDef, IdentifierName, Show1, ToJSONFields1] (Record Location)) +parseSomeBlob :: (Member (Exc SomeException) effs, Member Task effs) => Blob -> Eff effs (SomeTerm '[ConstructorName, Foldable, Functor, HasDeclaration, HasPackageDef, Show1, ToJSONFields1] (Record Location)) parseSomeBlob blob@Blob{..} = maybe (noLanguageForBlob blobPath) (flip parse blob . someParser) blobLanguage From 2d08451d87998871a3d2cd41d0daa66a1ae18b5e Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Tue, 29 May 2018 14:25:31 -0700 Subject: [PATCH 111/148] Call [] Statements --- src/Analysis/ConstructorName.hs | 2 +- test/Semantic/CLI/Spec.hs | 8 +-- test/Semantic/Spec.hs | 2 +- .../go/corpus/array-types.diffA-B.txt | 10 ++-- .../go/corpus/array-types.diffB-A.txt | 10 ++-- .../fixtures/go/corpus/array-types.parseA.txt | 10 ++-- .../fixtures/go/corpus/array-types.parseB.txt | 10 ++-- .../array-with-implicit-length.diffA-B.txt | 4 +- .../array-with-implicit-length.diffB-A.txt | 4 +- .../array-with-implicit-length.parseA.txt | 4 +- .../array-with-implicit-length.parseB.txt | 4 +- .../corpus/assignment-statements.diffA-B.txt | 18 +++--- .../corpus/assignment-statements.diffB-A.txt | 18 +++--- .../corpus/assignment-statements.parseA.txt | 14 ++--- .../corpus/assignment-statements.parseB.txt | 14 ++--- .../go/corpus/binary-expressions.diffA-B.txt | 4 +- .../go/corpus/binary-expressions.diffB-A.txt | 4 +- .../go/corpus/binary-expressions.parseA.txt | 4 +- .../go/corpus/binary-expressions.parseB.txt | 4 +- .../go/corpus/call-expressions.diffA-B.txt | 14 ++--- .../go/corpus/call-expressions.diffB-A.txt | 14 ++--- .../go/corpus/call-expressions.parseA.txt | 12 ++-- .../go/corpus/call-expressions.parseB.txt | 10 ++-- .../go/corpus/case-statements.diffA-B.txt | 26 ++++----- .../go/corpus/case-statements.diffB-A.txt | 26 ++++----- .../go/corpus/case-statements.parseA.txt | 4 +- .../go/corpus/case-statements.parseB.txt | 24 ++++---- .../go/corpus/channel-types.diffA-B.txt | 8 +-- .../go/corpus/channel-types.diffB-A.txt | 8 +-- .../go/corpus/channel-types.parseA.txt | 6 +- .../go/corpus/channel-types.parseB.txt | 6 +- test/fixtures/go/corpus/comment.diffA-B.txt | 2 +- test/fixtures/go/corpus/comment.diffB-A.txt | 2 +- test/fixtures/go/corpus/comment.parseA.txt | 2 +- test/fixtures/go/corpus/comment.parseB.txt | 2 +- .../const-declarations-with-types.diffA-B.txt | 6 +- .../const-declarations-with-types.diffB-A.txt | 6 +- .../const-declarations-with-types.parseA.txt | 4 +- .../const-declarations-with-types.parseB.txt | 6 +- ...nst-declarations-without-types.diffA-B.txt | 6 +- ...nst-declarations-without-types.diffB-A.txt | 6 +- ...onst-declarations-without-types.parseA.txt | 2 +- ...onst-declarations-without-types.parseB.txt | 6 +- .../const-with-implicit-values.diffA-B.txt | 12 ++-- .../const-with-implicit-values.diffB-A.txt | 12 ++-- .../const-with-implicit-values.parseA.txt | 8 +-- .../const-with-implicit-values.parseB.txt | 8 +-- .../go/corpus/constructors.diffA-B.txt | 8 +-- .../go/corpus/constructors.diffB-A.txt | 8 +-- .../go/corpus/constructors.parseA.txt | 8 +-- .../go/corpus/constructors.parseB.txt | 8 +-- .../go/corpus/float-literals.diffA-B.txt | 4 +- .../go/corpus/float-literals.diffB-A.txt | 4 +- .../go/corpus/float-literals.parseA.txt | 4 +- .../go/corpus/float-literals.parseB.txt | 4 +- .../go/corpus/for-statements.diffA-B.txt | 56 +++++++++--------- .../go/corpus/for-statements.diffB-A.txt | 58 +++++++++---------- .../go/corpus/for-statements.parseA.txt | 34 +++++------ .../go/corpus/for-statements.parseB.txt | 34 +++++------ .../corpus/function-declarations.diffA-B.txt | 46 +++++++-------- .../corpus/function-declarations.diffB-A.txt | 52 ++++++++--------- .../corpus/function-declarations.parseA.txt | 42 +++++++------- .../corpus/function-declarations.parseB.txt | 46 +++++++-------- .../go/corpus/function-literals.diffA-B.txt | 12 ++-- .../go/corpus/function-literals.diffB-A.txt | 12 ++-- .../go/corpus/function-literals.parseA.txt | 12 ++-- .../go/corpus/function-literals.parseB.txt | 12 ++-- .../go/corpus/function-types.diffA-B.txt | 20 +++---- .../go/corpus/function-types.diffB-A.txt | 20 +++---- .../go/corpus/function-types.parseA.txt | 18 +++--- .../go/corpus/function-types.parseB.txt | 18 +++--- .../go-and-defer-statements.diffA-B.txt | 8 +-- .../go-and-defer-statements.diffB-A.txt | 8 +-- .../corpus/go-and-defer-statements.parseA.txt | 8 +-- .../corpus/go-and-defer-statements.parseB.txt | 8 +-- .../grouped-import-declarations.diffA-B.txt | 6 +- .../grouped-import-declarations.diffB-A.txt | 6 +- .../grouped-import-declarations.parseA.txt | 6 +- .../grouped-import-declarations.parseB.txt | 6 +- .../grouped-var-declarations.diffA-B.txt | 4 +- .../grouped-var-declarations.diffB-A.txt | 4 +- .../grouped-var-declarations.parseA.txt | 4 +- .../grouped-var-declarations.parseB.txt | 4 +- .../go/corpus/if-statements.diffA-B.txt | 40 ++++++------- .../go/corpus/if-statements.diffB-A.txt | 40 ++++++------- .../go/corpus/if-statements.parseA.txt | 38 ++++++------ .../go/corpus/if-statements.parseB.txt | 34 +++++------ .../go/corpus/imaginary-literals.diffA-B.txt | 4 +- .../go/corpus/imaginary-literals.diffB-A.txt | 4 +- .../go/corpus/imaginary-literals.parseA.txt | 4 +- .../go/corpus/imaginary-literals.parseB.txt | 4 +- .../go/corpus/import-statements.diffA-B.txt | 6 +- .../go/corpus/import-statements.diffB-A.txt | 6 +- .../go/corpus/import-statements.parseA.txt | 6 +- .../go/corpus/import-statements.parseB.txt | 6 +- ...increment-decrement-statements.diffA-B.txt | 4 +- ...increment-decrement-statements.diffB-A.txt | 4 +- .../increment-decrement-statements.parseA.txt | 4 +- .../increment-decrement-statements.parseB.txt | 4 +- .../go/corpus/int-literals.diffA-B.txt | 4 +- .../go/corpus/int-literals.diffB-A.txt | 4 +- .../go/corpus/int-literals.parseA.txt | 4 +- .../go/corpus/int-literals.parseB.txt | 4 +- .../go/corpus/interface-types.diffA-B.txt | 20 +++---- .../go/corpus/interface-types.diffB-A.txt | 20 +++---- .../go/corpus/interface-types.parseA.txt | 20 +++---- .../go/corpus/interface-types.parseB.txt | 20 +++---- .../go/corpus/label-statements.diffA-B.txt | 6 +- .../go/corpus/label-statements.diffB-A.txt | 6 +- .../go/corpus/label-statements.parseA.txt | 6 +- .../go/corpus/label-statements.parseB.txt | 6 +- .../go/corpus/map-literals.diffA-B.txt | 4 +- .../go/corpus/map-literals.diffB-A.txt | 4 +- .../go/corpus/map-literals.parseA.txt | 4 +- .../go/corpus/map-literals.parseB.txt | 4 +- test/fixtures/go/corpus/map-types.diffA-B.txt | 4 +- test/fixtures/go/corpus/map-types.diffB-A.txt | 4 +- test/fixtures/go/corpus/map-types.parseA.txt | 4 +- test/fixtures/go/corpus/map-types.parseB.txt | 4 +- .../go/corpus/method-declarations.diffA-B.txt | 40 ++++++------- .../go/corpus/method-declarations.diffB-A.txt | 40 ++++++------- .../go/corpus/method-declarations.parseA.txt | 36 ++++++------ .../go/corpus/method-declarations.parseB.txt | 40 ++++++------- .../modifying-struct-fields.diffA-B.txt | 4 +- .../modifying-struct-fields.diffB-A.txt | 4 +- .../corpus/modifying-struct-fields.parseA.txt | 4 +- .../corpus/modifying-struct-fields.parseB.txt | 4 +- ...ameter-declarations-with-types.diffA-B.txt | 12 ++-- ...ameter-declarations-with-types.diffB-A.txt | 12 ++-- ...rameter-declarations-with-types.parseA.txt | 12 ++-- ...rameter-declarations-with-types.parseB.txt | 12 ++-- .../go/corpus/pointer-types.diffA-B.txt | 4 +- .../go/corpus/pointer-types.diffB-A.txt | 4 +- .../go/corpus/pointer-types.parseA.txt | 4 +- .../go/corpus/pointer-types.parseB.txt | 4 +- .../go/corpus/qualified-types.diffA-B.txt | 4 +- .../go/corpus/qualified-types.diffB-A.txt | 4 +- .../go/corpus/qualified-types.parseA.txt | 4 +- .../go/corpus/qualified-types.parseB.txt | 4 +- .../go/corpus/rune-literals.diffA-B.txt | 2 +- .../go/corpus/rune-literals.diffB-A.txt | 2 +- .../go/corpus/rune-literals.parseA.txt | 2 +- .../go/corpus/rune-literals.parseB.txt | 2 +- .../go/corpus/select-statements.diffA-B.txt | 32 +++++----- .../go/corpus/select-statements.diffB-A.txt | 32 +++++----- .../go/corpus/select-statements.parseA.txt | 26 ++++----- .../go/corpus/select-statements.parseB.txt | 22 +++---- .../corpus/selector-expressions.diffA-B.txt | 4 +- .../corpus/selector-expressions.diffB-A.txt | 4 +- .../go/corpus/selector-expressions.parseA.txt | 4 +- .../go/corpus/selector-expressions.parseB.txt | 4 +- .../go/corpus/send-statements.diffA-B.txt | 2 +- .../go/corpus/send-statements.diffB-A.txt | 2 +- .../go/corpus/send-statements.parseA.txt | 2 +- .../go/corpus/send-statements.parseB.txt | 2 +- .../corpus/short-var-declarations.diffA-B.txt | 6 +- .../corpus/short-var-declarations.diffB-A.txt | 6 +- .../corpus/short-var-declarations.parseA.txt | 6 +- .../corpus/short-var-declarations.parseB.txt | 6 +- .../single-import-declarations.diffA-B.txt | 4 +- .../single-import-declarations.diffB-A.txt | 4 +- .../single-import-declarations.parseA.txt | 4 +- .../single-import-declarations.parseB.txt | 4 +- ...gle-line-function-declarations.diffA-B.txt | 24 ++++---- ...gle-line-function-declarations.diffB-A.txt | 24 ++++---- ...ngle-line-function-declarations.parseA.txt | 24 ++++---- ...ngle-line-function-declarations.parseB.txt | 24 ++++---- .../go/corpus/slice-expressions.diffA-B.txt | 4 +- .../go/corpus/slice-expressions.diffB-A.txt | 4 +- .../go/corpus/slice-expressions.parseA.txt | 4 +- .../go/corpus/slice-expressions.parseB.txt | 4 +- .../go/corpus/slice-literals.diffA-B.txt | 10 ++-- .../go/corpus/slice-literals.diffB-A.txt | 11 ++-- .../go/corpus/slice-literals.parseA.txt | 10 ++-- .../go/corpus/slice-literals.parseB.txt | 10 ++-- .../go/corpus/slice-types.diffA-B.txt | 8 +-- .../go/corpus/slice-types.diffB-A.txt | 8 +-- .../fixtures/go/corpus/slice-types.parseA.txt | 8 +-- .../fixtures/go/corpus/slice-types.parseB.txt | 8 +-- .../go/corpus/string-literals.diffA-B.txt | 4 +- .../go/corpus/string-literals.diffB-A.txt | 4 +- .../go/corpus/string-literals.parseA.txt | 4 +- .../go/corpus/string-literals.parseB.txt | 4 +- .../struct-field-declarations.diffA-B.txt | 6 +- .../struct-field-declarations.diffB-A.txt | 6 +- .../struct-field-declarations.parseA.txt | 6 +- .../struct-field-declarations.parseB.txt | 6 +- .../go/corpus/struct-literals.diffA-B.txt | 12 ++-- .../go/corpus/struct-literals.diffB-A.txt | 12 ++-- .../go/corpus/struct-literals.parseA.txt | 12 ++-- .../go/corpus/struct-literals.parseB.txt | 12 ++-- .../go/corpus/struct-types.diffA-B.txt | 24 ++++---- .../go/corpus/struct-types.diffB-A.txt | 24 ++++---- .../go/corpus/struct-types.parseA.txt | 24 ++++---- .../go/corpus/struct-types.parseB.txt | 24 ++++---- .../go/corpus/switch-statements.diffA-B.txt | 16 ++--- .../go/corpus/switch-statements.diffB-A.txt | 14 ++--- .../go/corpus/switch-statements.parseA.txt | 12 ++-- .../go/corpus/switch-statements.parseB.txt | 12 ++-- .../go/corpus/type-aliases.diffA-B.txt | 4 +- .../go/corpus/type-aliases.diffB-A.txt | 4 +- .../go/corpus/type-aliases.parseA.txt | 4 +- .../go/corpus/type-aliases.parseB.txt | 4 +- .../type-assertion-expressions.diffA-B.txt | 2 +- .../type-assertion-expressions.diffB-A.txt | 2 +- .../type-assertion-expressions.parseA.txt | 2 +- .../type-assertion-expressions.parseB.txt | 2 +- .../type-conversion-expressions.diffA-B.txt | 12 ++-- .../type-conversion-expressions.diffB-A.txt | 12 ++-- .../type-conversion-expressions.parseA.txt | 12 ++-- .../type-conversion-expressions.parseB.txt | 12 ++-- .../go/corpus/type-declarations.diffA-B.txt | 20 +++---- .../go/corpus/type-declarations.diffB-A.txt | 20 +++---- .../go/corpus/type-declarations.parseA.txt | 20 +++---- .../go/corpus/type-declarations.parseB.txt | 20 +++---- .../corpus/type-switch-statements.diffA-B.txt | 38 ++++++------ .../corpus/type-switch-statements.diffB-A.txt | 38 ++++++------ .../corpus/type-switch-statements.parseA.txt | 36 ++++++------ .../corpus/type-switch-statements.parseB.txt | 38 ++++++------ .../go/corpus/unary-expressions.diffA-B.txt | 6 +- .../go/corpus/unary-expressions.diffB-A.txt | 6 +- .../go/corpus/unary-expressions.parseA.txt | 6 +- .../go/corpus/unary-expressions.parseB.txt | 6 +- ...clarations-with-no-expressions.diffA-B.txt | 12 ++-- ...clarations-with-no-expressions.diffB-A.txt | 12 ++-- ...eclarations-with-no-expressions.parseA.txt | 12 ++-- ...eclarations-with-no-expressions.parseB.txt | 12 ++-- .../var-declarations-with-types.diffA-B.txt | 10 ++-- .../var-declarations-with-types.diffB-A.txt | 10 ++-- .../var-declarations-with-types.parseA.txt | 10 ++-- .../var-declarations-with-types.parseB.txt | 10 ++-- ...var-declarations-without-types.diffA-B.txt | 6 +- ...var-declarations-without-types.diffB-A.txt | 6 +- .../var-declarations-without-types.parseA.txt | 2 +- .../var-declarations-without-types.parseB.txt | 6 +- ...variadic-function-declarations.diffA-B.txt | 14 ++--- ...variadic-function-declarations.diffB-A.txt | 14 ++--- .../variadic-function-declarations.parseA.txt | 14 ++--- .../variadic-function-declarations.parseB.txt | 14 ++--- .../corpus/anonymous-function.diffA-B.txt | 2 +- .../corpus/anonymous-function.diffB-A.txt | 2 +- .../corpus/anonymous-function.parseA.txt | 2 +- .../corpus/anonymous-function.parseB.txt | 2 +- ...onymous-parameterless-function.diffA-B.txt | 2 +- ...onymous-parameterless-function.diffB-A.txt | 2 +- ...nonymous-parameterless-function.parseA.txt | 2 +- ...nonymous-parameterless-function.parseB.txt | 2 +- .../corpus/arrow-function.diffA-B.txt | 2 +- .../corpus/arrow-function.diffB-A.txt | 2 +- .../corpus/arrow-function.parseA.txt | 2 +- .../corpus/arrow-function.parseB.txt | 2 +- .../javascript/corpus/break.diffA-B.txt | 4 +- .../javascript/corpus/break.diffB-A.txt | 4 +- .../javascript/corpus/break.parseA.txt | 4 +- .../javascript/corpus/break.parseB.txt | 4 +- .../corpus/chained-callbacks.diffA-B.txt | 2 +- .../corpus/chained-callbacks.diffB-A.txt | 2 +- .../corpus/chained-callbacks.parseA.txt | 2 +- .../corpus/chained-callbacks.parseB.txt | 2 +- .../javascript/corpus/class.diffA-B.txt | 14 ++--- .../javascript/corpus/class.diffB-A.txt | 8 +-- .../javascript/corpus/class.parseA.txt | 8 +-- .../javascript/corpus/class.parseB.txt | 8 +-- .../javascript/corpus/continue.diffA-B.txt | 4 +- .../javascript/corpus/continue.diffB-A.txt | 4 +- .../javascript/corpus/continue.parseA.txt | 4 +- .../javascript/corpus/continue.parseB.txt | 4 +- .../corpus/do-while-statement.diffA-B.txt | 2 +- .../corpus/do-while-statement.diffB-A.txt | 2 +- .../corpus/do-while-statement.parseA.txt | 2 +- .../corpus/do-while-statement.parseB.txt | 2 +- .../javascript/corpus/export.diffA-B.txt | 6 +- .../javascript/corpus/export.diffB-A.txt | 6 +- .../javascript/corpus/export.parseA.txt | 4 +- .../javascript/corpus/export.parseB.txt | 4 +- .../corpus/for-in-statement.diffA-B.txt | 2 +- .../corpus/for-in-statement.diffB-A.txt | 2 +- .../corpus/for-in-statement.parseA.txt | 2 +- .../corpus/for-in-statement.parseB.txt | 2 +- .../for-loop-with-in-statement.diffA-B.txt | 2 +- .../for-loop-with-in-statement.diffB-A.txt | 2 +- .../for-loop-with-in-statement.parseA.txt | 2 +- .../for-loop-with-in-statement.parseB.txt | 2 +- .../corpus/for-of-statement.diffA-B.txt | 2 +- .../corpus/for-of-statement.diffB-A.txt | 2 +- .../corpus/for-of-statement.parseA.txt | 2 +- .../corpus/for-of-statement.parseB.txt | 2 +- .../corpus/for-statement.diffA-B.txt | 2 +- .../corpus/for-statement.diffB-A.txt | 2 +- .../corpus/for-statement.parseA.txt | 2 +- .../corpus/for-statement.parseB.txt | 2 +- .../corpus/function-call-args.diffA-B.txt | 2 +- .../corpus/function-call-args.diffB-A.txt | 2 +- .../corpus/function-call-args.parseA.txt | 2 +- .../corpus/function-call-args.parseB.txt | 2 +- .../javascript/corpus/function.diffA-B.txt | 2 +- .../javascript/corpus/function.diffB-A.txt | 2 +- .../javascript/corpus/function.parseA.txt | 2 +- .../javascript/corpus/function.parseB.txt | 2 +- .../corpus/generator-function.diffA-B.txt | 2 +- .../corpus/generator-function.diffB-A.txt | 2 +- .../corpus/generator-function.parseA.txt | 2 +- .../corpus/generator-function.parseB.txt | 2 +- .../javascript/corpus/if-else.diffA-B.txt | 4 +- .../javascript/corpus/if-else.diffB-A.txt | 4 +- .../javascript/corpus/if-else.parseB.txt | 4 +- .../fixtures/javascript/corpus/if.diffA-B.txt | 2 +- .../fixtures/javascript/corpus/if.diffB-A.txt | 2 +- test/fixtures/javascript/corpus/if.parseA.txt | 2 +- test/fixtures/javascript/corpus/if.parseB.txt | 2 +- .../javascript/corpus/import.diffA-B.txt | 8 +-- .../javascript/corpus/import.diffB-A.txt | 8 +-- .../javascript/corpus/import.parseA.txt | 4 +- .../javascript/corpus/import.parseB.txt | 4 +- .../corpus/named-function.diffA-B.txt | 2 +- .../corpus/named-function.diffB-A.txt | 2 +- .../corpus/named-function.parseA.txt | 2 +- .../corpus/named-function.parseB.txt | 2 +- .../nested-do-while-in-function.diffA-B.txt | 4 +- .../nested-do-while-in-function.diffB-A.txt | 4 +- .../nested-do-while-in-function.parseA.txt | 4 +- .../nested-do-while-in-function.parseB.txt | 4 +- .../corpus/nested-functions.diffA-B.txt | 4 +- .../corpus/nested-functions.diffB-A.txt | 4 +- .../corpus/nested-functions.parseA.txt | 4 +- .../corpus/nested-functions.parseB.txt | 4 +- .../corpus/objects-with-methods.diffA-B.txt | 2 +- .../corpus/objects-with-methods.diffB-A.txt | 2 +- .../corpus/objects-with-methods.parseA.txt | 2 +- .../corpus/objects-with-methods.parseB.txt | 2 +- .../corpus/switch-statement.diffA-B.txt | 8 +-- .../corpus/switch-statement.diffB-A.txt | 8 +-- .../corpus/switch-statement.parseA.txt | 8 +-- .../corpus/switch-statement.parseB.txt | 8 +-- .../corpus/try-statement.diffA-B.txt | 6 +- .../corpus/try-statement.diffB-A.txt | 6 +- .../corpus/try-statement.parseA.txt | 6 +- .../corpus/try-statement.parseB.txt | 6 +- .../corpus/while-statement.diffA-B.txt | 2 +- .../corpus/while-statement.diffB-A.txt | 2 +- .../corpus/while-statement.parseA.txt | 2 +- .../corpus/while-statement.parseB.txt | 2 +- .../javascript/corpus/yield.diffA-B.txt | 2 +- .../javascript/corpus/yield.diffB-A.txt | 2 +- .../javascript/corpus/yield.parseA.txt | 2 +- .../javascript/corpus/yield.parseB.txt | 2 +- .../python/corpus/assignment.diffA-B.txt | 10 ++-- .../python/corpus/assignment.diffB-A.txt | 8 +-- .../python/corpus/assignment.parseA.txt | 6 +- .../python/corpus/assignment.parseB.txt | 6 +- .../corpus/concatenated-string.diffA-B.txt | 2 +- .../corpus/concatenated-string.diffB-A.txt | 2 +- .../corpus/concatenated-string.parseA.txt | 2 +- .../corpus/concatenated-string.parseB.txt | 2 +- .../corpus/decorated-definition.diffA-B.txt | 8 +-- .../corpus/decorated-definition.diffB-A.txt | 8 +-- .../corpus/decorated-definition.parseA.txt | 6 +- .../corpus/decorated-definition.parseB.txt | 4 +- .../dictionary-comprehension.diffA-B.txt | 8 +-- .../dictionary-comprehension.diffB-A.txt | 8 +-- .../dictionary-comprehension.parseA.txt | 6 +- .../dictionary-comprehension.parseB.txt | 6 +- .../corpus/expression-statement.diffA-B.txt | 4 +- .../corpus/expression-statement.diffB-A.txt | 6 +- .../corpus/expression-statement.parseA.txt | 4 +- .../corpus/expression-statement.parseB.txt | 4 +- .../python/corpus/for-statement.diffA-B.txt | 12 ++-- .../python/corpus/for-statement.diffB-A.txt | 18 +++--- .../python/corpus/for-statement.parseA.txt | 10 ++-- .../python/corpus/for-statement.parseB.txt | 10 ++-- .../corpus/generator-expression.diffA-B.txt | 4 +- .../corpus/generator-expression.diffB-A.txt | 4 +- .../corpus/generator-expression.parseA.txt | 4 +- .../corpus/generator-expression.parseB.txt | 4 +- .../python/corpus/if-statement.diffA-B.txt | 6 +- .../python/corpus/if-statement.diffB-A.txt | 6 +- .../python/corpus/if-statement.parseA.txt | 6 +- .../python/corpus/if-statement.parseB.txt | 2 +- .../corpus/import-statement.diffA-B.txt | 4 +- .../corpus/import-statement.diffB-A.txt | 4 +- .../python/corpus/import-statement.parseA.txt | 4 +- .../python/corpus/import-statement.parseB.txt | 2 +- .../corpus/list-comprehension.diffA-B.txt | 10 ++-- .../corpus/list-comprehension.diffB-A.txt | 10 ++-- .../corpus/list-comprehension.parseA.txt | 6 +- .../corpus/list-comprehension.parseB.txt | 8 +-- .../python/corpus/raise-statement.diffA-B.txt | 6 +- .../python/corpus/raise-statement.diffB-A.txt | 6 +- .../python/corpus/raise-statement.parseA.txt | 4 +- .../python/corpus/raise-statement.parseB.txt | 4 +- .../corpus/return-statement.diffA-B.txt | 4 +- .../corpus/return-statement.diffB-A.txt | 4 +- .../python/corpus/return-statement.parseA.txt | 2 +- .../python/corpus/return-statement.parseB.txt | 2 +- .../corpus/set-comprehension.diffA-B.txt | 4 +- .../corpus/set-comprehension.diffB-A.txt | 4 +- .../corpus/set-comprehension.parseA.txt | 4 +- .../corpus/set-comprehension.parseB.txt | 4 +- .../python/corpus/try-statement.diffA-B.txt | 26 ++++----- .../python/corpus/try-statement.diffB-A.txt | 26 ++++----- .../python/corpus/try-statement.parseA.txt | 16 ++--- .../python/corpus/try-statement.parseB.txt | 10 ++-- .../python/corpus/while-statement.diffA-B.txt | 2 +- .../python/corpus/while-statement.diffB-A.txt | 2 +- .../python/corpus/while-statement.parseA.txt | 2 +- .../python/corpus/while-statement.parseB.txt | 2 +- .../python/corpus/with-statement.diffA-B.txt | 2 +- .../python/corpus/with-statement.diffB-A.txt | 2 +- .../python/corpus/with-statement.parseA.txt | 2 +- .../python/corpus/with-statement.parseB.txt | 2 +- test/fixtures/python/corpus/with.diffA-B.txt | 10 ++-- test/fixtures/python/corpus/with.diffB-A.txt | 10 ++-- test/fixtures/python/corpus/with.parseA.txt | 4 +- test/fixtures/python/corpus/with.parseB.txt | 8 +-- test/fixtures/ruby/corpus/begin.diffA-B.txt | 4 +- test/fixtures/ruby/corpus/begin.diffB-A.txt | 4 +- test/fixtures/ruby/corpus/begin.parseA.txt | 4 +- test/fixtures/ruby/corpus/begin.parseB.txt | 2 +- .../ruby/corpus/chained-string.parseA.txt | 2 +- test/fixtures/ruby/corpus/class.diffA-B.txt | 4 +- test/fixtures/ruby/corpus/class.diffB-A.txt | 4 +- test/fixtures/ruby/corpus/class.parseA.txt | 4 +- test/fixtures/ruby/corpus/class.parseB.txt | 2 +- test/fixtures/ruby/corpus/else.diffA-B.txt | 4 +- test/fixtures/ruby/corpus/else.diffB-A.txt | 4 +- test/fixtures/ruby/corpus/else.parseA.txt | 4 +- test/fixtures/ruby/corpus/else.parseB.txt | 2 +- test/fixtures/ruby/corpus/elsif.diffA-B.txt | 4 +- test/fixtures/ruby/corpus/elsif.diffB-A.txt | 5 +- test/fixtures/ruby/corpus/elsif.parseA.txt | 4 +- test/fixtures/ruby/corpus/elsif.parseB.txt | 4 +- test/fixtures/ruby/corpus/ensure.diffA-B.txt | 4 +- test/fixtures/ruby/corpus/ensure.diffB-A.txt | 4 +- test/fixtures/ruby/corpus/ensure.parseA.txt | 4 +- test/fixtures/ruby/corpus/ensure.parseB.txt | 2 +- test/fixtures/ruby/corpus/for.diffA-B.txt | 10 ++-- test/fixtures/ruby/corpus/for.diffB-A.txt | 8 +-- test/fixtures/ruby/corpus/for.parseA.txt | 8 +-- test/fixtures/ruby/corpus/for.parseB.txt | 2 +- test/fixtures/ruby/corpus/if.diffA-B.txt | 7 ++- test/fixtures/ruby/corpus/if.diffB-A.txt | 6 +- test/fixtures/ruby/corpus/if.parseA.txt | 4 +- test/fixtures/ruby/corpus/if.parseB.txt | 4 +- .../corpus/lambda-dash-rocket.diffA-B.txt | 2 +- .../corpus/lambda-dash-rocket.diffB-A.txt | 2 +- .../ruby/corpus/lambda-dash-rocket.parseA.txt | 2 +- test/fixtures/ruby/corpus/lambda.diffA-B.txt | 8 +-- test/fixtures/ruby/corpus/lambda.diffB-A.txt | 8 +-- test/fixtures/ruby/corpus/lambda.parseA.txt | 8 +-- ...thod-declaration-keyword-param.diffA-B.txt | 2 +- ...thod-declaration-keyword-param.diffB-A.txt | 2 +- ...ethod-declaration-keyword-param.parseA.txt | 2 +- ...ethod-declaration-keyword-param.parseB.txt | 2 +- ...thod-declaration-param-default.diffA-B.txt | 2 +- ...thod-declaration-param-default.diffB-A.txt | 2 +- ...ethod-declaration-param-default.parseA.txt | 2 +- ...ethod-declaration-param-default.parseB.txt | 2 +- .../method-declaration-params.diffA-B.txt | 2 +- .../method-declaration-params.diffB-A.txt | 2 +- .../method-declaration-params.parseA.txt | 2 +- .../method-declaration-params.parseB.txt | 2 +- ...aration-required-keyword-param.diffA-B.txt | 2 +- ...aration-required-keyword-param.diffB-A.txt | 2 +- ...laration-required-keyword-param.parseA.txt | 2 +- ...laration-required-keyword-param.parseB.txt | 2 +- ...thod-declaration-unnamed-param.diffA-B.txt | 2 +- ...thod-declaration-unnamed-param.diffB-A.txt | 2 +- ...ethod-declaration-unnamed-param.parseA.txt | 2 +- ...ethod-declaration-unnamed-param.parseB.txt | 2 +- .../corpus/method-declaration.diffA-B.txt | 2 +- .../corpus/method-declaration.diffB-A.txt | 3 +- .../ruby/corpus/method-declaration.parseA.txt | 2 +- .../ruby/corpus/method-declaration.parseB.txt | 2 +- test/fixtures/ruby/corpus/methods.parseA.txt | 16 ++--- test/fixtures/ruby/corpus/misc.parseA.txt | 6 +- test/fixtures/ruby/corpus/module.diffA-B.txt | 2 +- test/fixtures/ruby/corpus/module.diffB-A.txt | 2 +- test/fixtures/ruby/corpus/module.parseB.txt | 2 +- .../corpus/multiple-assignments.diffA-B.txt | 18 +++--- .../corpus/multiple-assignments.diffB-A.txt | 18 +++--- .../corpus/multiple-assignments.parseA.txt | 18 +++--- .../corpus/multiple-assignments.parseB.txt | 2 +- test/fixtures/ruby/corpus/next.parseA.txt | 2 +- .../ruby/corpus/rescue-empty.diffA-B.txt | 6 +- .../ruby/corpus/rescue-empty.diffB-A.txt | 6 +- .../ruby/corpus/rescue-empty.parseA.txt | 6 +- .../ruby/corpus/rescue-empty.parseB.txt | 4 +- .../ruby/corpus/rescue-last-ex.diffA-B.txt | 10 ++-- .../ruby/corpus/rescue-last-ex.diffB-A.txt | 10 ++-- .../ruby/corpus/rescue-last-ex.parseA.txt | 10 ++-- .../ruby/corpus/rescue-last-ex.parseB.txt | 8 +-- test/fixtures/ruby/corpus/rescue.diffA-B.txt | 36 ++++++------ test/fixtures/ruby/corpus/rescue.diffB-A.txt | 36 ++++++------ test/fixtures/ruby/corpus/rescue.parseA.txt | 30 +++++----- test/fixtures/ruby/corpus/rescue.parseB.txt | 6 +- .../ruby/corpus/singleton-class.parseA.txt | 2 +- test/fixtures/ruby/corpus/unless.diffA-B.txt | 5 +- test/fixtures/ruby/corpus/unless.diffB-A.txt | 4 +- test/fixtures/ruby/corpus/unless.parseA.txt | 2 +- test/fixtures/ruby/corpus/unless.parseB.txt | 4 +- test/fixtures/ruby/corpus/until.diffA-B.txt | 2 +- test/fixtures/ruby/corpus/until.diffB-A.txt | 2 +- test/fixtures/ruby/corpus/until.parseA.txt | 2 +- .../ruby/corpus/when-else.diffA-B.txt | 12 ++-- .../ruby/corpus/when-else.diffB-A.txt | 12 ++-- .../fixtures/ruby/corpus/when-else.parseA.txt | 12 ++-- .../fixtures/ruby/corpus/when-else.parseB.txt | 6 +- test/fixtures/ruby/corpus/when.diffA-B.txt | 16 ++--- test/fixtures/ruby/corpus/when.diffB-A.txt | 17 +++--- test/fixtures/ruby/corpus/when.parseA.txt | 12 ++-- test/fixtures/ruby/corpus/when.parseB.txt | 10 ++-- test/fixtures/ruby/corpus/while.diffA-B.txt | 2 +- test/fixtures/ruby/corpus/while.diffB-A.txt | 2 +- test/fixtures/ruby/corpus/while.parseA.txt | 2 +- .../corpus/ambient-declarations.diffA-B.txt | 4 +- .../corpus/ambient-declarations.diffB-A.txt | 4 +- .../corpus/ambient-declarations.parseA.txt | 2 +- .../corpus/ambient-declarations.parseB.txt | 4 +- .../corpus/ambient-exports.diffA-B.txt | 4 +- .../corpus/ambient-exports.diffB-A.txt | 4 +- .../corpus/ambient-exports.parseA.txt | 2 +- .../corpus/ambient-exports.parseB.txt | 2 +- .../corpus/anonymous-function.diffA-B.txt | 2 +- .../corpus/anonymous-function.diffB-A.txt | 2 +- .../corpus/anonymous-function.parseA.txt | 2 +- .../corpus/anonymous-function.parseB.txt | 2 +- ...onymous-parameterless-function.diffA-B.txt | 2 +- ...onymous-parameterless-function.diffB-A.txt | 2 +- ...nonymous-parameterless-function.parseA.txt | 2 +- ...nonymous-parameterless-function.parseB.txt | 2 +- .../corpus/arrow-function.diffA-B.txt | 2 +- .../corpus/arrow-function.diffB-A.txt | 2 +- .../corpus/arrow-function.parseA.txt | 2 +- .../corpus/arrow-function.parseB.txt | 2 +- .../typescript/corpus/break.diffA-B.txt | 4 +- .../typescript/corpus/break.diffB-A.txt | 4 +- .../typescript/corpus/break.parseA.txt | 4 +- .../typescript/corpus/break.parseB.txt | 4 +- .../corpus/chained-callbacks.diffA-B.txt | 2 +- .../corpus/chained-callbacks.diffB-A.txt | 2 +- .../corpus/chained-callbacks.parseA.txt | 2 +- .../corpus/chained-callbacks.parseB.txt | 2 +- .../typescript/corpus/class.diffA-B.txt | 14 ++--- .../typescript/corpus/class.diffB-A.txt | 8 +-- .../typescript/corpus/class.parseA.txt | 8 +-- .../typescript/corpus/class.parseB.txt | 8 +-- .../typescript/corpus/continue.diffA-B.txt | 4 +- .../typescript/corpus/continue.diffB-A.txt | 4 +- .../typescript/corpus/continue.parseA.txt | 4 +- .../typescript/corpus/continue.parseB.txt | 4 +- .../corpus/do-while-statement.diffA-B.txt | 2 +- .../corpus/do-while-statement.diffB-A.txt | 2 +- .../corpus/do-while-statement.parseA.txt | 2 +- .../corpus/do-while-statement.parseB.txt | 2 +- .../typescript/corpus/export.diffA-B.txt | 6 +- .../typescript/corpus/export.diffB-A.txt | 6 +- .../typescript/corpus/export.parseA.txt | 4 +- .../typescript/corpus/export.parseB.txt | 4 +- .../corpus/for-in-statement.diffA-B.txt | 2 +- .../corpus/for-in-statement.diffB-A.txt | 2 +- .../corpus/for-in-statement.parseA.txt | 2 +- .../corpus/for-in-statement.parseB.txt | 2 +- .../for-loop-with-in-statement.diffA-B.txt | 2 +- .../for-loop-with-in-statement.diffB-A.txt | 2 +- .../for-loop-with-in-statement.parseA.txt | 2 +- .../for-loop-with-in-statement.parseB.txt | 2 +- .../corpus/for-of-statement.diffA-B.txt | 2 +- .../corpus/for-of-statement.diffB-A.txt | 2 +- .../corpus/for-of-statement.parseA.txt | 2 +- .../corpus/for-of-statement.parseB.txt | 2 +- .../corpus/for-statement.diffA-B.txt | 2 +- .../corpus/for-statement.diffB-A.txt | 2 +- .../corpus/for-statement.parseA.txt | 2 +- .../corpus/for-statement.parseB.txt | 2 +- .../corpus/function-call-args.diffA-B.txt | 2 +- .../corpus/function-call-args.diffB-A.txt | 2 +- .../corpus/function-call-args.parseA.txt | 2 +- .../corpus/function-call-args.parseB.txt | 2 +- .../typescript/corpus/function.diffA-B.txt | 2 +- .../typescript/corpus/function.diffB-A.txt | 2 +- .../typescript/corpus/function.parseA.txt | 2 +- .../typescript/corpus/function.parseB.txt | 2 +- .../corpus/generator-function.diffA-B.txt | 2 +- .../corpus/generator-function.diffB-A.txt | 2 +- .../corpus/generator-function.parseA.txt | 2 +- .../corpus/generator-function.parseB.txt | 2 +- .../typescript/corpus/if-else.diffA-B.txt | 4 +- .../typescript/corpus/if-else.diffB-A.txt | 4 +- .../typescript/corpus/if-else.parseB.txt | 4 +- .../fixtures/typescript/corpus/if.diffA-B.txt | 2 +- .../fixtures/typescript/corpus/if.diffB-A.txt | 2 +- test/fixtures/typescript/corpus/if.parseA.txt | 2 +- test/fixtures/typescript/corpus/if.parseB.txt | 2 +- .../typescript/corpus/import.diffA-B.txt | 8 +-- .../typescript/corpus/import.diffB-A.txt | 8 +-- .../typescript/corpus/import.parseA.txt | 4 +- .../typescript/corpus/import.parseB.txt | 4 +- .../corpus/method-definition.diffA-B.txt | 2 +- .../corpus/method-definition.diffB-A.txt | 2 +- .../corpus/method-definition.parseA.txt | 2 +- .../corpus/method-definition.parseB.txt | 2 +- .../corpus/named-function.diffA-B.txt | 2 +- .../corpus/named-function.diffB-A.txt | 2 +- .../corpus/named-function.parseA.txt | 2 +- .../corpus/named-function.parseB.txt | 2 +- .../nested-do-while-in-function.diffA-B.txt | 4 +- .../nested-do-while-in-function.diffB-A.txt | 4 +- .../nested-do-while-in-function.parseA.txt | 4 +- .../nested-do-while-in-function.parseB.txt | 4 +- .../corpus/nested-functions.diffA-B.txt | 4 +- .../corpus/nested-functions.diffB-A.txt | 4 +- .../corpus/nested-functions.parseA.txt | 4 +- .../corpus/nested-functions.parseB.txt | 4 +- .../corpus/objects-with-methods.diffA-B.txt | 2 +- .../corpus/objects-with-methods.diffB-A.txt | 2 +- .../corpus/objects-with-methods.parseA.txt | 2 +- .../corpus/objects-with-methods.parseB.txt | 2 +- .../public-field-definition.diffA-B.txt | 2 +- .../public-field-definition.diffB-A.txt | 2 +- .../corpus/public-field-definition.parseA.txt | 2 +- .../corpus/public-field-definition.parseB.txt | 2 +- .../corpus/switch-statement.diffA-B.txt | 8 +-- .../corpus/switch-statement.diffB-A.txt | 8 +-- .../corpus/switch-statement.parseA.txt | 8 +-- .../corpus/switch-statement.parseB.txt | 8 +-- .../corpus/try-statement.diffA-B.txt | 6 +- .../corpus/try-statement.diffB-A.txt | 6 +- .../corpus/try-statement.parseA.txt | 6 +- .../corpus/try-statement.parseB.txt | 6 +- .../corpus/while-statement.diffA-B.txt | 2 +- .../corpus/while-statement.diffB-A.txt | 2 +- .../corpus/while-statement.parseA.txt | 2 +- .../corpus/while-statement.parseB.txt | 2 +- .../typescript/corpus/yield.diffA-B.txt | 2 +- .../typescript/corpus/yield.diffB-A.txt | 2 +- .../typescript/corpus/yield.parseA.txt | 2 +- .../typescript/corpus/yield.parseB.txt | 2 +- 637 files changed, 2233 insertions(+), 2227 deletions(-) diff --git a/src/Analysis/ConstructorName.hs b/src/Analysis/ConstructorName.hs index 85942ed9f..678c883d0 100644 --- a/src/Analysis/ConstructorName.hs +++ b/src/Analysis/ConstructorName.hs @@ -40,7 +40,7 @@ instance Apply ConstructorName fs => ConstructorNameWithStrategy 'Custom (Sum fs constructorNameWithStrategy _ = apply @ConstructorName constructorName instance ConstructorNameWithStrategy 'Custom [] where - constructorNameWithStrategy _ _ = "ExpressionList" + constructorNameWithStrategy _ _ = "Statements" data Strategy = Default | Custom diff --git a/test/Semantic/CLI/Spec.hs b/test/Semantic/CLI/Spec.hs index 8c1483077..c864571a9 100644 --- a/test/Semantic/CLI/Spec.hs +++ b/test/Semantic/CLI/Spec.hs @@ -41,8 +41,8 @@ parseFixtures = pathMode' = [File "test/fixtures/ruby/corpus/and-or.A.rb" (Just Ruby), File "test/fixtures/ruby/corpus/and-or.B.rb" (Just Ruby)] sExpressionParseTreeOutput = "(Program\n (LowAnd\n (Send\n (Identifier))\n (Send\n (Identifier))))\n" - jsonParseTreeOutput = "{\"trees\":[{\"programNode\":{\"category\":\"Program\",\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]},\"children\":[{\"category\":\"LowAnd\",\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]},\"children\":[{\"category\":\"Send\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]},\"children\":[{\"name\":\"foo\",\"category\":\"Identifier\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]},\"children\":[]}]},{\"category\":\"Send\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]},\"children\":[{\"name\":\"bar\",\"category\":\"Identifier\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]},\"children\":[]}]}]}]},\"path\":\"test/fixtures/ruby/corpus/and-or.A.rb\",\"language\":\"Ruby\"}]}\n" - jsonParseTreeOutput' = "{\"trees\":[{\"programNode\":{\"category\":\"Program\",\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]},\"children\":[{\"category\":\"LowAnd\",\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]},\"children\":[{\"category\":\"Send\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]},\"children\":[{\"name\":\"foo\",\"category\":\"Identifier\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]},\"children\":[]}]},{\"category\":\"Send\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]},\"children\":[{\"name\":\"bar\",\"category\":\"Identifier\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]},\"children\":[]}]}]}]},\"path\":\"test/fixtures/ruby/corpus/and-or.A.rb\",\"language\":\"Ruby\"},{\"programNode\":{\"category\":\"Program\",\"sourceRange\":[0,24],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]},\"children\":[{\"category\":\"LowOr\",\"sourceRange\":[0,10],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,11]},\"children\":[{\"category\":\"Send\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]},\"children\":[{\"name\":\"foo\",\"category\":\"Identifier\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]},\"children\":[]}]},{\"category\":\"Send\",\"sourceRange\":[7,10],\"sourceSpan\":{\"start\":[1,8],\"end\":[1,11]},\"children\":[{\"name\":\"bar\",\"category\":\"Identifier\",\"sourceRange\":[7,10],\"sourceSpan\":{\"start\":[1,8],\"end\":[1,11]},\"children\":[]}]}]},{\"category\":\"LowAnd\",\"sourceRange\":[11,23],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,13]},\"children\":[{\"category\":\"LowOr\",\"sourceRange\":[11,17],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,7]},\"children\":[{\"category\":\"Send\",\"sourceRange\":[11,12],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,2]},\"children\":[{\"name\":\"a\",\"category\":\"Identifier\",\"sourceRange\":[11,12],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,2]},\"children\":[]}]},{\"category\":\"Send\",\"sourceRange\":[16,17],\"sourceSpan\":{\"start\":[2,6],\"end\":[2,7]},\"children\":[{\"name\":\"b\",\"category\":\"Identifier\",\"sourceRange\":[16,17],\"sourceSpan\":{\"start\":[2,6],\"end\":[2,7]},\"children\":[]}]}]},{\"category\":\"Send\",\"sourceRange\":[22,23],\"sourceSpan\":{\"start\":[2,12],\"end\":[2,13]},\"children\":[{\"name\":\"c\",\"category\":\"Identifier\",\"sourceRange\":[22,23],\"sourceSpan\":{\"start\":[2,12],\"end\":[2,13]},\"children\":[]}]}]}]},\"path\":\"test/fixtures/ruby/corpus/and-or.B.rb\",\"language\":\"Ruby\"}]}\n" + jsonParseTreeOutput = "{\"trees\":[{\"tree\":{\"term\":\"Program\",\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]},\"children\":[{\"term\":\"LowAnd\",\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]},\"children\":{\"term\":\"Send\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]},\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]},\"name\":\"foo\"},\"sendArgs\":[],\"sendBlock\":null},\"children\":{\"term\":\"Send\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]},\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]},\"name\":\"bar\"},\"sendArgs\":[],\"sendBlock\":null}}]},\"path\":\"test/fixtures/ruby/corpus/and-or.A.rb\",\"language\":\"Ruby\"}]}\n" + jsonParseTreeOutput' = "{\"trees\":[{\"tree\":{\"term\":\"Program\",\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]},\"children\":[{\"term\":\"LowAnd\",\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]},\"children\":{\"term\":\"Send\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]},\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]},\"name\":\"foo\"},\"sendArgs\":[],\"sendBlock\":null},\"children\":{\"term\":\"Send\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]},\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]},\"name\":\"bar\"},\"sendArgs\":[],\"sendBlock\":null}}]},\"path\":\"test/fixtures/ruby/corpus/and-or.A.rb\",\"language\":\"Ruby\"},{\"tree\":{\"term\":\"Program\",\"sourceRange\":[0,24],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]},\"children\":[{\"term\":\"LowOr\",\"sourceRange\":[0,10],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,11]},\"children\":{\"term\":\"Send\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]},\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]},\"name\":\"foo\"},\"sendArgs\":[],\"sendBlock\":null},\"children\":{\"term\":\"Send\",\"sourceRange\":[7,10],\"sourceSpan\":{\"start\":[1,8],\"end\":[1,11]},\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"sourceRange\":[7,10],\"sourceSpan\":{\"start\":[1,8],\"end\":[1,11]},\"name\":\"bar\"},\"sendArgs\":[],\"sendBlock\":null}},{\"term\":\"LowAnd\",\"sourceRange\":[11,23],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,13]},\"children\":{\"term\":\"LowOr\",\"sourceRange\":[11,17],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,7]},\"children\":{\"term\":\"Send\",\"sourceRange\":[11,12],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,2]},\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"sourceRange\":[11,12],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,2]},\"name\":\"a\"},\"sendArgs\":[],\"sendBlock\":null},\"children\":{\"term\":\"Send\",\"sourceRange\":[16,17],\"sourceSpan\":{\"start\":[2,6],\"end\":[2,7]},\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"sourceRange\":[16,17],\"sourceSpan\":{\"start\":[2,6],\"end\":[2,7]},\"name\":\"b\"},\"sendArgs\":[],\"sendBlock\":null}},\"children\":{\"term\":\"Send\",\"sourceRange\":[22,23],\"sourceSpan\":{\"start\":[2,12],\"end\":[2,13]},\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"sourceRange\":[22,23],\"sourceSpan\":{\"start\":[2,12],\"end\":[2,13]},\"name\":\"c\"},\"sendArgs\":[],\"sendBlock\":null}}]},\"path\":\"test/fixtures/ruby/corpus/and-or.B.rb\",\"language\":\"Ruby\"}]}\n" emptyJsonParseTreeOutput = "{\"trees\":[]}\n" symbolsOutput = "{\"files\":[{\"path\":\"test/fixtures/ruby/corpus/method-declaration.A.rb\",\"symbols\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"kind\":\"Method\",\"symbol\":\"foo\"}],\"language\":\"Ruby\"}]}\n" tagsOutput = "[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"path\":\"test/fixtures/ruby/corpus/method-declaration.A.rb\",\"kind\":\"Method\",\"symbol\":\"foo\",\"line\":\"def foo\",\"language\":\"Ruby\"}]\n" @@ -56,6 +56,6 @@ diffFixtures = ] where pathMode = [both (File "test/fixtures/ruby/corpus/method-declaration.A.rb" (Just Ruby)) (File "test/fixtures/ruby/corpus/method-declaration.B.rb" (Just Ruby))] - jsonOutput = "{\"diffs\":[{\"diff\":{\"merge\":{\"before\":{\"category\":\"Program\",\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"after\":{\"category\":\"Program\",\"sourceRange\":[0,21],\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}},\"children\":[{\"merge\":{\"before\":{\"category\":\"Method\",\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}},\"after\":{\"category\":\"Method\",\"sourceRange\":[0,20],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}},\"children\":[{\"merge\":{\"before\":{\"category\":\"Empty\",\"sourceRange\":[0,0],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,1]}},\"after\":{\"category\":\"Empty\",\"sourceRange\":[0,0],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,1]}},\"children\":[]}},{\"patch\":{\"replace\":[{\"category\":\"Identifier\",\"children\":[],\"name\":\"foo\",\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"category\":\"Identifier\",\"children\":[],\"name\":\"bar\",\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}]}},{\"patch\":{\"insert\":{\"category\":\"Identifier\",\"children\":[],\"name\":\"a\",\"sourceRange\":[8,9],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,10]}}}},{\"merge\":{\"before\":{\"category\":\"[]\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,4]}},\"after\":{\"category\":\"\",\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}},\"children\":[{\"patch\":{\"insert\":{\"category\":\"Send\",\"children\":[{\"patch\":{\"insert\":{\"category\":\"Identifier\",\"children\":[],\"name\":\"baz\",\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}}}}],\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}}}}]}}]}}]}},\"stat\":{\"path\":\"test/fixtures/ruby/corpus/method-declaration.A.rb -> test/fixtures/ruby/corpus/method-declaration.B.rb\",\"replace\":[{\"path\":\"test/fixtures/ruby/corpus/method-declaration.A.rb\",\"language\":\"Ruby\"},{\"path\":\"test/fixtures/ruby/corpus/method-declaration.B.rb\",\"language\":\"Ruby\"}]}}]}\n" - sExpressionOutput = "(Program\n (Method\n (Empty)\n { (Identifier)\n ->(Identifier) }\n {+(Identifier)+}\n (\n {+(Send\n {+(Identifier)+})+})))\n" + jsonOutput = "{\"diffs\":[{\"diff\":{\"merge\":{\"before\":{\"term\":\"Program\",\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"after\":{\"term\":\"Program\",\"sourceRange\":[0,21],\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}},\"children\":[{\"merge\":{\"before\":{\"term\":\"Method\",\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}},\"after\":{\"term\":\"Method\",\"sourceRange\":[0,20],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}},\"methodContext\":[],\"methodReceiver\":{\"merge\":{\"before\":{\"term\":\"Empty\",\"sourceRange\":[0,0],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,1]}},\"after\":{\"term\":\"Empty\",\"sourceRange\":[0,0],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,1]}}}},\"methodName\":{\"patch\":{\"replace\":[{\"term\":\"Identifier\",\"name\":\"foo\",\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"term\":\"Identifier\",\"name\":\"bar\",\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}]}},\"methodParameters\":[{\"patch\":{\"insert\":{\"term\":\"Identifier\",\"name\":\"a\",\"sourceRange\":[8,9],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,10]}}}}],\"methodBody\":{\"merge\":{\"before\":{\"term\":\"Statements\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,4]}},\"after\":{\"term\":\"Statements\",\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}},\"children\":[{\"patch\":{\"insert\":{\"term\":\"Send\",\"sourceRange\":[13,16],\"sendReceiver\":null,\"sendBlock\":null,\"sendArgs\":[],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]},\"sendSelector\":{\"patch\":{\"insert\":{\"term\":\"Identifier\",\"name\":\"baz\",\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}}}}}}}]}}}}]}},\"stat\":{\"path\":\"test/fixtures/ruby/corpus/method-declaration.A.rb -> test/fixtures/ruby/corpus/method-declaration.B.rb\",\"replace\":[{\"path\":\"test/fixtures/ruby/corpus/method-declaration.A.rb\",\"language\":\"Ruby\"},{\"path\":\"test/fixtures/ruby/corpus/method-declaration.B.rb\",\"language\":\"Ruby\"}]}}]}\n" + sExpressionOutput = "(Program\n (Method\n (Empty)\n { (Identifier)\n ->(Identifier) }\n {+(Identifier)+}\n (Statements\n {+(Send\n {+(Identifier)+})+})))\n" tocOutput = "{\"changes\":{\"test/fixtures/ruby/corpus/method-declaration.A.rb -> test/fixtures/ruby/corpus/method-declaration.B.rb\":[{\"span\":{\"start\":[1,1],\"end\":[3,4]},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"modified\"}]},\"errors\":{}}\n" diff --git a/test/Semantic/Spec.hs b/test/Semantic/Spec.hs index abacf6598..b620a92a6 100644 --- a/test/Semantic/Spec.hs +++ b/test/Semantic/Spec.hs @@ -18,6 +18,6 @@ spec = parallel $ do it "renders with the specified renderer" $ do output <- fmap runBuilder . runTask $ runParse SExpressionTermRenderer [methodsBlob] - output `shouldBe` "(Program\n (Method\n (Empty)\n (Identifier)\n ([])))\n" + output `shouldBe` "(Program\n (Method\n (Empty)\n (Identifier)\n (Statements)))\n" where methodsBlob = Blob "def foo\nend\n" "methods.rb" (Just Ruby) diff --git a/test/fixtures/go/corpus/array-types.diffA-B.txt b/test/fixtures/go/corpus/array-types.diffA-B.txt index 08453d71a..56be1c980 100644 --- a/test/fixtures/go/corpus/array-types.diffA-B.txt +++ b/test/fixtures/go/corpus/array-types.diffA-B.txt @@ -4,9 +4,9 @@ (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Type (Identifier) (Array @@ -17,7 +17,7 @@ ->(Integer) }) { (Identifier) ->(Identifier) }))) - ( + (Statements (Type { (Identifier) ->(Identifier) } @@ -28,7 +28,7 @@ { (Integer) ->(Integer) } (Identifier))))) - ( + (Statements (Type { (Identifier) ->(Identifier) } diff --git a/test/fixtures/go/corpus/array-types.diffB-A.txt b/test/fixtures/go/corpus/array-types.diffB-A.txt index 08453d71a..56be1c980 100644 --- a/test/fixtures/go/corpus/array-types.diffB-A.txt +++ b/test/fixtures/go/corpus/array-types.diffB-A.txt @@ -4,9 +4,9 @@ (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Type (Identifier) (Array @@ -17,7 +17,7 @@ ->(Integer) }) { (Identifier) ->(Identifier) }))) - ( + (Statements (Type { (Identifier) ->(Identifier) } @@ -28,7 +28,7 @@ { (Integer) ->(Integer) } (Identifier))))) - ( + (Statements (Type { (Identifier) ->(Identifier) } diff --git a/test/fixtures/go/corpus/array-types.parseA.txt b/test/fixtures/go/corpus/array-types.parseA.txt index b549b8739..84a768d0e 100644 --- a/test/fixtures/go/corpus/array-types.parseA.txt +++ b/test/fixtures/go/corpus/array-types.parseA.txt @@ -4,9 +4,9 @@ (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Type (Identifier) (Array @@ -14,7 +14,7 @@ (Integer) (Integer)) (Identifier)))) - ( + (Statements (Type (Identifier) (Array @@ -22,7 +22,7 @@ (Array (Integer) (Identifier))))) - ( + (Statements (Type (Identifier) (Array diff --git a/test/fixtures/go/corpus/array-types.parseB.txt b/test/fixtures/go/corpus/array-types.parseB.txt index b549b8739..84a768d0e 100644 --- a/test/fixtures/go/corpus/array-types.parseB.txt +++ b/test/fixtures/go/corpus/array-types.parseB.txt @@ -4,9 +4,9 @@ (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Type (Identifier) (Array @@ -14,7 +14,7 @@ (Integer) (Integer)) (Identifier)))) - ( + (Statements (Type (Identifier) (Array @@ -22,7 +22,7 @@ (Array (Integer) (Identifier))))) - ( + (Statements (Type (Identifier) (Array diff --git a/test/fixtures/go/corpus/array-with-implicit-length.diffA-B.txt b/test/fixtures/go/corpus/array-with-implicit-length.diffA-B.txt index 86a1afb3e..c7bcedee0 100644 --- a/test/fixtures/go/corpus/array-with-implicit-length.diffA-B.txt +++ b/test/fixtures/go/corpus/array-with-implicit-length.diffA-B.txt @@ -4,13 +4,13 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment (Identifier) (Composite (Array (Identifier)) - ( + (Statements {+(Integer)+} {+(Integer)+} { (Integer) diff --git a/test/fixtures/go/corpus/array-with-implicit-length.diffB-A.txt b/test/fixtures/go/corpus/array-with-implicit-length.diffB-A.txt index 0a6a38f42..cc7f5639b 100644 --- a/test/fixtures/go/corpus/array-with-implicit-length.diffB-A.txt +++ b/test/fixtures/go/corpus/array-with-implicit-length.diffB-A.txt @@ -4,13 +4,13 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment (Identifier) (Composite (Array (Identifier)) - ( + (Statements {+(Integer)+} { (Integer) ->(Integer) } diff --git a/test/fixtures/go/corpus/array-with-implicit-length.parseA.txt b/test/fixtures/go/corpus/array-with-implicit-length.parseA.txt index 3d66382a0..d6cb95c51 100644 --- a/test/fixtures/go/corpus/array-with-implicit-length.parseA.txt +++ b/test/fixtures/go/corpus/array-with-implicit-length.parseA.txt @@ -4,13 +4,13 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment (Identifier) (Composite (Array (Identifier)) - ( + (Statements (Integer) (Integer) (Integer)))))) diff --git a/test/fixtures/go/corpus/array-with-implicit-length.parseB.txt b/test/fixtures/go/corpus/array-with-implicit-length.parseB.txt index 3d66382a0..d6cb95c51 100644 --- a/test/fixtures/go/corpus/array-with-implicit-length.parseB.txt +++ b/test/fixtures/go/corpus/array-with-implicit-length.parseB.txt @@ -4,13 +4,13 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment (Identifier) (Composite (Array (Identifier)) - ( + (Statements (Integer) (Integer) (Integer)))))) diff --git a/test/fixtures/go/corpus/assignment-statements.diffA-B.txt b/test/fixtures/go/corpus/assignment-statements.diffA-B.txt index a6bc14a38..124828615 100644 --- a/test/fixtures/go/corpus/assignment-statements.diffA-B.txt +++ b/test/fixtures/go/corpus/assignment-statements.diffA-B.txt @@ -4,25 +4,25 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment { (Identifier) ->(Identifier) } (Integer)) (Assignment - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) }) (Plus - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) }) - ( + (Statements (Integer) (Integer)))) {+(Assignment @@ -68,13 +68,13 @@ {+(Integer)+})+})+})+} {+(Assignment {+(Identifier)+} - {+( + {+(Statements {+(Pointer {+(Identifier)+})+} {+(Reference {+(Composite {+(Identifier)+} - {+( + {+(Statements {+(KeyValue {+(Identifier)+} {+(Integer)+})+})+})+})+})+})+} @@ -121,13 +121,13 @@ {-(Integer)-})-})-})-} {-(Assignment {-(Identifier)-} - {-( + {-(Statements {-(Pointer {-(Identifier)-})-} {-(Reference {-(Composite {-(Identifier)-} - {-( + {-(Statements {-(KeyValue {-(Identifier)-} {-(Integer)-})-})-})-})-})-})-}))) diff --git a/test/fixtures/go/corpus/assignment-statements.diffB-A.txt b/test/fixtures/go/corpus/assignment-statements.diffB-A.txt index a6bc14a38..124828615 100644 --- a/test/fixtures/go/corpus/assignment-statements.diffB-A.txt +++ b/test/fixtures/go/corpus/assignment-statements.diffB-A.txt @@ -4,25 +4,25 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment { (Identifier) ->(Identifier) } (Integer)) (Assignment - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) }) (Plus - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) }) - ( + (Statements (Integer) (Integer)))) {+(Assignment @@ -68,13 +68,13 @@ {+(Integer)+})+})+})+} {+(Assignment {+(Identifier)+} - {+( + {+(Statements {+(Pointer {+(Identifier)+})+} {+(Reference {+(Composite {+(Identifier)+} - {+( + {+(Statements {+(KeyValue {+(Identifier)+} {+(Integer)+})+})+})+})+})+})+} @@ -121,13 +121,13 @@ {-(Integer)-})-})-})-} {-(Assignment {-(Identifier)-} - {-( + {-(Statements {-(Pointer {-(Identifier)-})-} {-(Reference {-(Composite {-(Identifier)-} - {-( + {-(Statements {-(KeyValue {-(Identifier)-} {-(Integer)-})-})-})-})-})-})-}))) diff --git a/test/fixtures/go/corpus/assignment-statements.parseA.txt b/test/fixtures/go/corpus/assignment-statements.parseA.txt index 532358d02..b791f8bea 100644 --- a/test/fixtures/go/corpus/assignment-statements.parseA.txt +++ b/test/fixtures/go/corpus/assignment-statements.parseA.txt @@ -4,20 +4,20 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) (Integer)) (Assignment - ( + (Statements (Identifier) (Identifier)) (Plus - ( + (Statements (Identifier) (Identifier)) - ( + (Statements (Integer) (Integer)))) (Assignment @@ -63,13 +63,13 @@ (Integer)))) (Assignment (Identifier) - ( + (Statements (Pointer (Identifier)) (Reference (Composite (Identifier) - ( + (Statements (KeyValue (Identifier) (Integer)))))))))) diff --git a/test/fixtures/go/corpus/assignment-statements.parseB.txt b/test/fixtures/go/corpus/assignment-statements.parseB.txt index 532358d02..b791f8bea 100644 --- a/test/fixtures/go/corpus/assignment-statements.parseB.txt +++ b/test/fixtures/go/corpus/assignment-statements.parseB.txt @@ -4,20 +4,20 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) (Integer)) (Assignment - ( + (Statements (Identifier) (Identifier)) (Plus - ( + (Statements (Identifier) (Identifier)) - ( + (Statements (Integer) (Integer)))) (Assignment @@ -63,13 +63,13 @@ (Integer)))) (Assignment (Identifier) - ( + (Statements (Pointer (Identifier)) (Reference (Composite (Identifier) - ( + (Statements (KeyValue (Identifier) (Integer)))))))))) diff --git a/test/fixtures/go/corpus/binary-expressions.diffA-B.txt b/test/fixtures/go/corpus/binary-expressions.diffA-B.txt index 87826e83a..b917e06f7 100644 --- a/test/fixtures/go/corpus/binary-expressions.diffA-B.txt +++ b/test/fixtures/go/corpus/binary-expressions.diffA-B.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Context (Comment) (Or diff --git a/test/fixtures/go/corpus/binary-expressions.diffB-A.txt b/test/fixtures/go/corpus/binary-expressions.diffB-A.txt index 87826e83a..b917e06f7 100644 --- a/test/fixtures/go/corpus/binary-expressions.diffB-A.txt +++ b/test/fixtures/go/corpus/binary-expressions.diffB-A.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Context (Comment) (Or diff --git a/test/fixtures/go/corpus/binary-expressions.parseA.txt b/test/fixtures/go/corpus/binary-expressions.parseA.txt index cf4a2e6fc..44e685fd0 100644 --- a/test/fixtures/go/corpus/binary-expressions.parseA.txt +++ b/test/fixtures/go/corpus/binary-expressions.parseA.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Context (Comment) (Or diff --git a/test/fixtures/go/corpus/binary-expressions.parseB.txt b/test/fixtures/go/corpus/binary-expressions.parseB.txt index cf4a2e6fc..44e685fd0 100644 --- a/test/fixtures/go/corpus/binary-expressions.parseB.txt +++ b/test/fixtures/go/corpus/binary-expressions.parseB.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Context (Comment) (Or diff --git a/test/fixtures/go/corpus/call-expressions.diffA-B.txt b/test/fixtures/go/corpus/call-expressions.diffA-B.txt index 55b943cf5..3c48543b6 100644 --- a/test/fixtures/go/corpus/call-expressions.diffA-B.txt +++ b/test/fixtures/go/corpus/call-expressions.diffA-B.txt @@ -4,12 +4,12 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Call { (Identifier) ->(Identifier) } - ( + (Statements (Identifier) (Variadic (Identifier))) @@ -17,25 +17,25 @@ (Call { (Identifier) ->(Identifier) } - ( + (Statements (Identifier) (Identifier)) (Empty)) {+(Call {+(Identifier)+} - {+( + {+(Statements {+(Identifier)+} {+(Variadic {+(Identifier)+})+})+} {+(Empty)+})+} {-(Call {-(Identifier)-} - {-( + {-(Statements {-(Identifier)-} {-(Variadic {-(Identifier)-})-})-} {-(Empty)-})-} {-(Call {-(Identifier)-} - {-([])-} + {-(Statements)-} {-(Empty)-})-}))) diff --git a/test/fixtures/go/corpus/call-expressions.diffB-A.txt b/test/fixtures/go/corpus/call-expressions.diffB-A.txt index 890ada670..2c96f544d 100644 --- a/test/fixtures/go/corpus/call-expressions.diffB-A.txt +++ b/test/fixtures/go/corpus/call-expressions.diffB-A.txt @@ -4,12 +4,12 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Call { (Identifier) ->(Identifier) } - ( + (Statements (Identifier) (Variadic (Identifier))) @@ -17,13 +17,13 @@ (Call { (Identifier) ->(Identifier) } - ( + (Statements (Identifier) (Identifier)) (Empty)) {+(Call {+(Identifier)+} - {+( + {+(Statements {+(Identifier)+} {+(Variadic {+(Identifier)+})+})+} @@ -31,8 +31,8 @@ (Call { (Identifier) ->(Identifier) } - {+([])+} - {-( + {+(Statements)+} + {-(Statements {-(Identifier)-} {-(Variadic {-(Identifier)-})-})-} diff --git a/test/fixtures/go/corpus/call-expressions.parseA.txt b/test/fixtures/go/corpus/call-expressions.parseA.txt index f53821488..d3a17acc0 100644 --- a/test/fixtures/go/corpus/call-expressions.parseA.txt +++ b/test/fixtures/go/corpus/call-expressions.parseA.txt @@ -4,29 +4,29 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Call (Identifier) - ( + (Statements (Identifier) (Variadic (Identifier))) (Empty)) (Call (Identifier) - ( + (Statements (Identifier) (Identifier)) (Empty)) (Call (Identifier) - ( + (Statements (Identifier) (Variadic (Identifier))) (Empty)) (Call (Identifier) - ([]) + (Statements) (Empty))))) diff --git a/test/fixtures/go/corpus/call-expressions.parseB.txt b/test/fixtures/go/corpus/call-expressions.parseB.txt index 6487b619b..405ccd9f8 100644 --- a/test/fixtures/go/corpus/call-expressions.parseB.txt +++ b/test/fixtures/go/corpus/call-expressions.parseB.txt @@ -4,24 +4,24 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Call (Identifier) - ( + (Statements (Identifier) (Variadic (Identifier))) (Empty)) (Call (Identifier) - ( + (Statements (Identifier) (Identifier)) (Empty)) (Call (Identifier) - ( + (Statements (Identifier) (Variadic (Identifier))) diff --git a/test/fixtures/go/corpus/case-statements.diffA-B.txt b/test/fixtures/go/corpus/case-statements.diffA-B.txt index 9cc79540d..fff31dbb0 100644 --- a/test/fixtures/go/corpus/case-statements.diffA-B.txt +++ b/test/fixtures/go/corpus/case-statements.diffA-B.txt @@ -4,44 +4,44 @@ (Function (Empty) (Identifier) - ([]) + (Statements) { (Match {-(Empty)-} - {-([])-}) - ->( + {-(Statements)-}) + ->(Statements {+(Match - {+([])+} + {+(Statements)+} {+(Pattern {+(Identifier)+} {+(Call {+(Identifier)+} - {+([])+} + {+(Statements)+} {+(Empty)+})+})+})+} {+(Match - {+( + {+(Statements {+(Identifier)+})+} - {+( + {+(Statements {+(Pattern - {+( + {+(Statements {+(Integer)+} {+(Integer)+})+} - {+( + {+(Statements {+(Call {+(Identifier)+} - {+([])+} + {+(Statements)+} {+(Empty)+})+} {+(Call {+(Identifier)+} - {+([])+} + {+(Statements)+} {+(Empty)+})+} {+(Pattern {+(Identifier)+} {+(Empty)+})+})+})+} {+(DefaultPattern - {+( + {+(Statements {+(Call {+(Identifier)+} - {+([])+} + {+(Statements)+} {+(Empty)+})+} {+(Break {+(Empty)+})+})+})+})+})+}) })) diff --git a/test/fixtures/go/corpus/case-statements.diffB-A.txt b/test/fixtures/go/corpus/case-statements.diffB-A.txt index 4aa746b3d..58e3ab7f4 100644 --- a/test/fixtures/go/corpus/case-statements.diffB-A.txt +++ b/test/fixtures/go/corpus/case-statements.diffB-A.txt @@ -4,44 +4,44 @@ (Function (Empty) (Identifier) - ([]) - { ( + (Statements) + { (Statements {-(Match - {-([])-} + {-(Statements)-} {-(Pattern {-(Identifier)-} {-(Call {-(Identifier)-} - {-([])-} + {-(Statements)-} {-(Empty)-})-})-})-} {-(Match - {-( + {-(Statements {-(Identifier)-})-} - {-( + {-(Statements {-(Pattern - {-( + {-(Statements {-(Integer)-} {-(Integer)-})-} - {-( + {-(Statements {-(Call {-(Identifier)-} - {-([])-} + {-(Statements)-} {-(Empty)-})-} {-(Call {-(Identifier)-} - {-([])-} + {-(Statements)-} {-(Empty)-})-} {-(Pattern {-(Identifier)-} {-(Empty)-})-})-})-} {-(DefaultPattern - {-( + {-(Statements {-(Call {-(Identifier)-} - {-([])-} + {-(Statements)-} {-(Empty)-})-} {-(Break {-(Empty)-})-})-})-})-})-}) ->(Match {+(Empty)+} - {+([])+}) })) + {+(Statements)+}) })) diff --git a/test/fixtures/go/corpus/case-statements.parseA.txt b/test/fixtures/go/corpus/case-statements.parseA.txt index 980232bc1..b5290544a 100644 --- a/test/fixtures/go/corpus/case-statements.parseA.txt +++ b/test/fixtures/go/corpus/case-statements.parseA.txt @@ -4,7 +4,7 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Match (Empty) - ([])))) + (Statements)))) diff --git a/test/fixtures/go/corpus/case-statements.parseB.txt b/test/fixtures/go/corpus/case-statements.parseB.txt index 1110f6725..30ac23d2c 100644 --- a/test/fixtures/go/corpus/case-statements.parseB.txt +++ b/test/fixtures/go/corpus/case-statements.parseB.txt @@ -4,41 +4,41 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Match - ([]) + (Statements) (Pattern (Identifier) (Call (Identifier) - ([]) + (Statements) (Empty)))) (Match - ( + (Statements (Identifier)) - ( + (Statements (Pattern - ( + (Statements (Integer) (Integer)) - ( + (Statements (Call (Identifier) - ([]) + (Statements) (Empty)) (Call (Identifier) - ([]) + (Statements) (Empty)) (Pattern (Identifier) (Empty)))) (DefaultPattern - ( + (Statements (Call (Identifier) - ([]) + (Statements) (Empty)) (Break (Empty))))))))) diff --git a/test/fixtures/go/corpus/channel-types.diffA-B.txt b/test/fixtures/go/corpus/channel-types.diffA-B.txt index 2f198a1aa..d5317887d 100644 --- a/test/fixtures/go/corpus/channel-types.diffA-B.txt +++ b/test/fixtures/go/corpus/channel-types.diffA-B.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements {+(Type {+(Identifier)+} {+(BidirectionalChannel @@ -17,7 +17,7 @@ {+(SendChannel {+(Constructor {+(Empty)+} - {+([])+})+})+})+})+} + {+(Statements)+})+})+})+})+} (Type { (Identifier) ->(Identifier) } @@ -44,7 +44,7 @@ {-(SendChannel {-(Constructor {-(Empty)-} - {-([])-})-})-})-})-} + {-(Statements)-})-})-})-})-} {-(Type {-(Identifier)-} {-(SendChannel diff --git a/test/fixtures/go/corpus/channel-types.diffB-A.txt b/test/fixtures/go/corpus/channel-types.diffB-A.txt index d79b712da..51a49dc4b 100644 --- a/test/fixtures/go/corpus/channel-types.diffB-A.txt +++ b/test/fixtures/go/corpus/channel-types.diffB-A.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements {+(Type {+(Identifier)+} {+(BidirectionalChannel @@ -17,7 +17,7 @@ {+(SendChannel {+(Constructor {+(Empty)+} - {+([])+})+})+})+})+} + {+(Statements)+})+})+})+})+} {+(Type {+(Identifier)+} {+(SendChannel @@ -45,7 +45,7 @@ {-(SendChannel {-(Constructor {-(Empty)-} - {-([])-})-})-})-})-} + {-(Statements)-})-})-})-})-} {-(Type {-(Identifier)-} {-(SendChannel diff --git a/test/fixtures/go/corpus/channel-types.parseA.txt b/test/fixtures/go/corpus/channel-types.parseA.txt index 942edbd92..1396ee35f 100644 --- a/test/fixtures/go/corpus/channel-types.parseA.txt +++ b/test/fixtures/go/corpus/channel-types.parseA.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Type (Identifier) (BidirectionalChannel @@ -17,7 +17,7 @@ (SendChannel (Constructor (Empty) - ([]))))) + (Statements))))) (Type (Identifier) (SendChannel diff --git a/test/fixtures/go/corpus/channel-types.parseB.txt b/test/fixtures/go/corpus/channel-types.parseB.txt index 942edbd92..1396ee35f 100644 --- a/test/fixtures/go/corpus/channel-types.parseB.txt +++ b/test/fixtures/go/corpus/channel-types.parseB.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Type (Identifier) (BidirectionalChannel @@ -17,7 +17,7 @@ (SendChannel (Constructor (Empty) - ([]))))) + (Statements))))) (Type (Identifier) (SendChannel diff --git a/test/fixtures/go/corpus/comment.diffA-B.txt b/test/fixtures/go/corpus/comment.diffA-B.txt index 96549b84b..58437db7e 100644 --- a/test/fixtures/go/corpus/comment.diffA-B.txt +++ b/test/fixtures/go/corpus/comment.diffA-B.txt @@ -4,7 +4,7 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Context { (Comment) ->(Comment) } diff --git a/test/fixtures/go/corpus/comment.diffB-A.txt b/test/fixtures/go/corpus/comment.diffB-A.txt index 96549b84b..58437db7e 100644 --- a/test/fixtures/go/corpus/comment.diffB-A.txt +++ b/test/fixtures/go/corpus/comment.diffB-A.txt @@ -4,7 +4,7 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Context { (Comment) ->(Comment) } diff --git a/test/fixtures/go/corpus/comment.parseA.txt b/test/fixtures/go/corpus/comment.parseA.txt index f58487c8e..5972880e0 100644 --- a/test/fixtures/go/corpus/comment.parseA.txt +++ b/test/fixtures/go/corpus/comment.parseA.txt @@ -4,7 +4,7 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Context (Comment) (Empty)))) diff --git a/test/fixtures/go/corpus/comment.parseB.txt b/test/fixtures/go/corpus/comment.parseB.txt index f58487c8e..5972880e0 100644 --- a/test/fixtures/go/corpus/comment.parseB.txt +++ b/test/fixtures/go/corpus/comment.parseB.txt @@ -4,7 +4,7 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Context (Comment) (Empty)))) diff --git a/test/fixtures/go/corpus/const-declarations-with-types.diffA-B.txt b/test/fixtures/go/corpus/const-declarations-with-types.diffA-B.txt index c5d1763f7..25059d86c 100644 --- a/test/fixtures/go/corpus/const-declarations-with-types.diffA-B.txt +++ b/test/fixtures/go/corpus/const-declarations-with-types.diffA-B.txt @@ -4,16 +4,16 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment (Annotation - ( + (Statements { (Identifier) ->(Identifier) } {+(Identifier)+}) { (Identifier) ->(Identifier) }) { (Integer) - ->( + ->(Statements {+(Integer)+} {+(Integer)+}) }))) diff --git a/test/fixtures/go/corpus/const-declarations-with-types.diffB-A.txt b/test/fixtures/go/corpus/const-declarations-with-types.diffB-A.txt index 58fad7073..409f37825 100644 --- a/test/fixtures/go/corpus/const-declarations-with-types.diffB-A.txt +++ b/test/fixtures/go/corpus/const-declarations-with-types.diffB-A.txt @@ -4,16 +4,16 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment (Annotation - ( + (Statements { (Identifier) ->(Identifier) } {-(Identifier)-}) { (Identifier) ->(Identifier) }) - { ( + { (Statements {-(Integer)-} {-(Integer)-}) ->(Integer) }))) diff --git a/test/fixtures/go/corpus/const-declarations-with-types.parseA.txt b/test/fixtures/go/corpus/const-declarations-with-types.parseA.txt index ee7fdc4f9..83a22058d 100644 --- a/test/fixtures/go/corpus/const-declarations-with-types.parseA.txt +++ b/test/fixtures/go/corpus/const-declarations-with-types.parseA.txt @@ -4,10 +4,10 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment (Annotation - ( + (Statements (Identifier)) (Identifier)) (Integer)))) diff --git a/test/fixtures/go/corpus/const-declarations-with-types.parseB.txt b/test/fixtures/go/corpus/const-declarations-with-types.parseB.txt index 481f6d749..23d0ec50b 100644 --- a/test/fixtures/go/corpus/const-declarations-with-types.parseB.txt +++ b/test/fixtures/go/corpus/const-declarations-with-types.parseB.txt @@ -4,13 +4,13 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment (Annotation - ( + (Statements (Identifier) (Identifier)) (Identifier)) - ( + (Statements (Integer) (Integer))))) diff --git a/test/fixtures/go/corpus/const-declarations-without-types.diffA-B.txt b/test/fixtures/go/corpus/const-declarations-without-types.diffA-B.txt index e1320a947..2d984aebb 100644 --- a/test/fixtures/go/corpus/const-declarations-without-types.diffA-B.txt +++ b/test/fixtures/go/corpus/const-declarations-without-types.diffA-B.txt @@ -4,13 +4,13 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment { (Identifier) - ->( + ->(Statements {+(Identifier)+} {+(Identifier)+}) } { (Integer) - ->( + ->(Statements {+(Integer)+} {+(Integer)+}) }))) diff --git a/test/fixtures/go/corpus/const-declarations-without-types.diffB-A.txt b/test/fixtures/go/corpus/const-declarations-without-types.diffB-A.txt index 6d0e73d9d..06f1fa789 100644 --- a/test/fixtures/go/corpus/const-declarations-without-types.diffB-A.txt +++ b/test/fixtures/go/corpus/const-declarations-without-types.diffB-A.txt @@ -4,13 +4,13 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment - { ( + { (Statements {-(Identifier)-} {-(Identifier)-}) ->(Identifier) } - { ( + { (Statements {-(Integer)-} {-(Integer)-}) ->(Integer) }))) diff --git a/test/fixtures/go/corpus/const-declarations-without-types.parseA.txt b/test/fixtures/go/corpus/const-declarations-without-types.parseA.txt index 9d343e9ba..d49580f45 100644 --- a/test/fixtures/go/corpus/const-declarations-without-types.parseA.txt +++ b/test/fixtures/go/corpus/const-declarations-without-types.parseA.txt @@ -4,7 +4,7 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment (Identifier) (Integer)))) diff --git a/test/fixtures/go/corpus/const-declarations-without-types.parseB.txt b/test/fixtures/go/corpus/const-declarations-without-types.parseB.txt index ac7eb7599..bbacb990a 100644 --- a/test/fixtures/go/corpus/const-declarations-without-types.parseB.txt +++ b/test/fixtures/go/corpus/const-declarations-without-types.parseB.txt @@ -4,11 +4,11 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment - ( + (Statements (Identifier) (Identifier)) - ( + (Statements (Integer) (Integer))))) diff --git a/test/fixtures/go/corpus/const-with-implicit-values.diffA-B.txt b/test/fixtures/go/corpus/const-with-implicit-values.diffA-B.txt index 20efc4b51..a9e14b08e 100644 --- a/test/fixtures/go/corpus/const-with-implicit-values.diffA-B.txt +++ b/test/fixtures/go/corpus/const-with-implicit-values.diffA-B.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements {+(Assignment {+(Identifier)+} {+(Identifier)+})+} @@ -13,13 +13,13 @@ { (Identifier) ->(Identifier) } { (Identifier) - ->([]) }) + ->(Statements) }) {+(Assignment {+(Identifier)+} - {+([])+})+} + {+(Statements)+})+} {-(Assignment {-(Identifier)-} - {-([])-})-} + {-(Statements)-})-} {-(Assignment {-(Identifier)-} - {-([])-})-}))) + {-(Statements)-})-}))) diff --git a/test/fixtures/go/corpus/const-with-implicit-values.diffB-A.txt b/test/fixtures/go/corpus/const-with-implicit-values.diffB-A.txt index 20efc4b51..a9e14b08e 100644 --- a/test/fixtures/go/corpus/const-with-implicit-values.diffB-A.txt +++ b/test/fixtures/go/corpus/const-with-implicit-values.diffB-A.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements {+(Assignment {+(Identifier)+} {+(Identifier)+})+} @@ -13,13 +13,13 @@ { (Identifier) ->(Identifier) } { (Identifier) - ->([]) }) + ->(Statements) }) {+(Assignment {+(Identifier)+} - {+([])+})+} + {+(Statements)+})+} {-(Assignment {-(Identifier)-} - {-([])-})-} + {-(Statements)-})-} {-(Assignment {-(Identifier)-} - {-([])-})-}))) + {-(Statements)-})-}))) diff --git a/test/fixtures/go/corpus/const-with-implicit-values.parseA.txt b/test/fixtures/go/corpus/const-with-implicit-values.parseA.txt index 9e234e834..d74622291 100644 --- a/test/fixtures/go/corpus/const-with-implicit-values.parseA.txt +++ b/test/fixtures/go/corpus/const-with-implicit-values.parseA.txt @@ -4,14 +4,14 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) (Identifier)) (Assignment (Identifier) - ([])) + (Statements)) (Assignment (Identifier) - ([]))))) + (Statements))))) diff --git a/test/fixtures/go/corpus/const-with-implicit-values.parseB.txt b/test/fixtures/go/corpus/const-with-implicit-values.parseB.txt index 9e234e834..d74622291 100644 --- a/test/fixtures/go/corpus/const-with-implicit-values.parseB.txt +++ b/test/fixtures/go/corpus/const-with-implicit-values.parseB.txt @@ -4,14 +4,14 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) (Identifier)) (Assignment (Identifier) - ([])) + (Statements)) (Assignment (Identifier) - ([]))))) + (Statements))))) diff --git a/test/fixtures/go/corpus/constructors.diffA-B.txt b/test/fixtures/go/corpus/constructors.diffA-B.txt index d50283017..7ff5225d7 100644 --- a/test/fixtures/go/corpus/constructors.diffA-B.txt +++ b/test/fixtures/go/corpus/constructors.diffA-B.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Call (Identifier) (SendChannel @@ -14,7 +14,7 @@ (Empty)) (Call (Identifier) - ( + (Statements (SendChannel { (Identifier) ->(Identifier) }) @@ -24,7 +24,7 @@ (Empty)) (Call (Identifier) - ( + (Statements (SendChannel { (Identifier) ->(Identifier) }) diff --git a/test/fixtures/go/corpus/constructors.diffB-A.txt b/test/fixtures/go/corpus/constructors.diffB-A.txt index d50283017..7ff5225d7 100644 --- a/test/fixtures/go/corpus/constructors.diffB-A.txt +++ b/test/fixtures/go/corpus/constructors.diffB-A.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Call (Identifier) (SendChannel @@ -14,7 +14,7 @@ (Empty)) (Call (Identifier) - ( + (Statements (SendChannel { (Identifier) ->(Identifier) }) @@ -24,7 +24,7 @@ (Empty)) (Call (Identifier) - ( + (Statements (SendChannel { (Identifier) ->(Identifier) }) diff --git a/test/fixtures/go/corpus/constructors.parseA.txt b/test/fixtures/go/corpus/constructors.parseA.txt index 62a19364a..67a463345 100644 --- a/test/fixtures/go/corpus/constructors.parseA.txt +++ b/test/fixtures/go/corpus/constructors.parseA.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Call (Identifier) (SendChannel @@ -13,7 +13,7 @@ (Empty)) (Call (Identifier) - ( + (Statements (SendChannel (Identifier)) (Minus @@ -22,7 +22,7 @@ (Empty)) (Call (Identifier) - ( + (Statements (SendChannel (Identifier)) (Integer) diff --git a/test/fixtures/go/corpus/constructors.parseB.txt b/test/fixtures/go/corpus/constructors.parseB.txt index 62a19364a..67a463345 100644 --- a/test/fixtures/go/corpus/constructors.parseB.txt +++ b/test/fixtures/go/corpus/constructors.parseB.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Call (Identifier) (SendChannel @@ -13,7 +13,7 @@ (Empty)) (Call (Identifier) - ( + (Statements (SendChannel (Identifier)) (Minus @@ -22,7 +22,7 @@ (Empty)) (Call (Identifier) - ( + (Statements (SendChannel (Identifier)) (Integer) diff --git a/test/fixtures/go/corpus/float-literals.diffA-B.txt b/test/fixtures/go/corpus/float-literals.diffA-B.txt index a66af57a0..07225a1f4 100644 --- a/test/fixtures/go/corpus/float-literals.diffA-B.txt +++ b/test/fixtures/go/corpus/float-literals.diffA-B.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) { (Float) diff --git a/test/fixtures/go/corpus/float-literals.diffB-A.txt b/test/fixtures/go/corpus/float-literals.diffB-A.txt index a66af57a0..07225a1f4 100644 --- a/test/fixtures/go/corpus/float-literals.diffB-A.txt +++ b/test/fixtures/go/corpus/float-literals.diffB-A.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) { (Float) diff --git a/test/fixtures/go/corpus/float-literals.parseA.txt b/test/fixtures/go/corpus/float-literals.parseA.txt index b1c15a990..1bb8f4561 100644 --- a/test/fixtures/go/corpus/float-literals.parseA.txt +++ b/test/fixtures/go/corpus/float-literals.parseA.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) (Float)) diff --git a/test/fixtures/go/corpus/float-literals.parseB.txt b/test/fixtures/go/corpus/float-literals.parseB.txt index b1c15a990..1bb8f4561 100644 --- a/test/fixtures/go/corpus/float-literals.parseB.txt +++ b/test/fixtures/go/corpus/float-literals.parseB.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) (Float)) diff --git a/test/fixtures/go/corpus/for-statements.diffA-B.txt b/test/fixtures/go/corpus/for-statements.diffA-B.txt index 02cbf7287..34a068f3f 100644 --- a/test/fixtures/go/corpus/for-statements.diffA-B.txt +++ b/test/fixtures/go/corpus/for-statements.diffA-B.txt @@ -4,26 +4,26 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (For (Empty) (Empty) (Empty) - ( + (Statements (Call (Identifier) - ([]) + (Statements) (Empty)) (Goto (Identifier)))) {+(ForEach {+(Identifier)+} {+(Identifier)+} - {+( + {+(Statements {+(Call {+(Identifier)+} - {+([])+} + {+(Statements)+} {+(Empty)+})+} {+(Break {+(Identifier)+})+})+})+} @@ -31,10 +31,10 @@ {+(Empty)+} {+(Empty)+} {+(Empty)+} - {+( + {+(Statements {+(Call {+(Identifier)+} - {+([])+} + {+(Statements)+} {+(Empty)+})+} {+(Continue {+(Identifier)+})+})+})+} @@ -53,10 +53,10 @@ { (PostIncrement {-(Identifier)-}) ->(Empty) } - ( + (Statements (Call (Identifier) - ([]) + (Statements) (Empty)) {+(Continue {+(Empty)+})+} @@ -66,7 +66,7 @@ {+(Empty)+} {+(Empty)+} {+(Empty)+} - {+( + {+(Statements {+(Call {+(Identifier)+} {+(Identifier)+} @@ -74,24 +74,24 @@ {+(Break {+(Empty)+})+})+})+} {+(ForEach - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+} {+(Identifier)+} {+(Call {+(Identifier)+} - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+} {+(Empty)+})+})+} {+(ForEach - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+} {+(Identifier)+} {+(Call {+(Identifier)+} - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+} {+(Empty)+})+})+} @@ -103,12 +103,12 @@ {+(Empty)+} {+(Call {+(Identifier)+} - {+([])+} + {+(Statements)+} {+(Empty)+})+})+} {+(ForEach {+(Empty)+} {+(Identifier)+} - {+([])+})+} + {+(Statements)+})+} {-(For {-(LessThan {-(Identifier)-} @@ -116,10 +116,10 @@ {-(PostIncrement {-(Identifier)-})-} {-(Empty)-} - {-( + {-(Statements {-(Call {-(Identifier)-} - {-([])-} + {-(Statements)-} {-(Empty)-})-} {-(Continue {-(Identifier)-})-})-})-} @@ -127,17 +127,17 @@ {-(Empty)-} {-(Empty)-} {-(Empty)-} - {-( + {-(Statements {-(Call {-(Identifier)-} - {-([])-} + {-(Statements)-} {-(Empty)-})-} {-(Continue {-(Empty)-})-})-})-} {-(ForEach {-(Identifier)-} {-(Identifier)-} - {-( + {-(Statements {-(Call {-(Identifier)-} {-(Identifier)-} @@ -145,24 +145,24 @@ {-(Break {-(Empty)-})-})-})-} {-(ForEach - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} {-(Identifier)-} {-(Call {-(Identifier)-} - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} {-(Empty)-})-})-} {-(ForEach - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} {-(Identifier)-} {-(Call {-(Identifier)-} - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} {-(Empty)-})-})-} @@ -174,9 +174,9 @@ {-(Empty)-} {-(Call {-(Identifier)-} - {-([])-} + {-(Statements)-} {-(Empty)-})-})-} {-(ForEach {-(Empty)-} {-(Identifier)-} - {-([])-})-}))) + {-(Statements)-})-}))) diff --git a/test/fixtures/go/corpus/for-statements.diffB-A.txt b/test/fixtures/go/corpus/for-statements.diffB-A.txt index b5425f99e..702a21acd 100644 --- a/test/fixtures/go/corpus/for-statements.diffB-A.txt +++ b/test/fixtures/go/corpus/for-statements.diffB-A.txt @@ -4,16 +4,16 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (For (Empty) (Empty) (Empty) - ( + (Statements (Call (Identifier) - ([]) + (Statements) (Empty)) (Goto (Identifier)))) @@ -26,10 +26,10 @@ {+(Integer)+})+} {+(PostIncrement {+(Identifier)+})+} - {+( + {+(Statements {+(Call {+(Identifier)+} - {+([])+} + {+(Statements)+} {+(Empty)+})+} {+(Break {+(Identifier)+})+})+})+} @@ -40,10 +40,10 @@ {+(PostIncrement {+(Identifier)+})+} {+(Empty)+} - {+( + {+(Statements {+(Call {+(Identifier)+} - {+([])+} + {+(Statements)+} {+(Empty)+})+} {+(Continue {+(Identifier)+})+})+})+} @@ -51,44 +51,44 @@ {+(Empty)+} {+(Empty)+} {+(Empty)+} - {+( + {+(Statements {+(Call {+(Identifier)+} - {+([])+} + {+(Statements)+} {+(Empty)+})+} {+(Continue {+(Empty)+})+})+})+} (ForEach (Identifier) (Identifier) - ( + (Statements (Call (Identifier) {+(Identifier)+} - {-([])-} + {-(Statements)-} (Empty)) (Break { (Identifier) ->(Empty) }))) {+(ForEach - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+} {+(Identifier)+} {+(Call {+(Identifier)+} - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+} {+(Empty)+})+})+} {+(ForEach - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+} {+(Identifier)+} {+(Call {+(Identifier)+} - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+} {+(Empty)+})+})+} @@ -100,20 +100,20 @@ {+(Empty)+} {+(Call {+(Identifier)+} - {+([])+} + {+(Statements)+} {+(Empty)+})+})+} {+(ForEach {+(Empty)+} {+(Identifier)+} - {+([])+})+} + {+(Statements)+})+} {-(For {-(Empty)-} {-(Empty)-} {-(Empty)-} - {-( + {-(Statements {-(Call {-(Identifier)-} - {-([])-} + {-(Statements)-} {-(Empty)-})-} {-(Continue {-(Identifier)-})-})-})-} @@ -124,10 +124,10 @@ {-(PostIncrement {-(Identifier)-})-} {-(Empty)-} - {-( + {-(Statements {-(Call {-(Identifier)-} - {-([])-} + {-(Statements)-} {-(Empty)-})-} {-(Continue {-(Empty)-})-})-})-} @@ -135,7 +135,7 @@ {-(Empty)-} {-(Empty)-} {-(Empty)-} - {-( + {-(Statements {-(Call {-(Identifier)-} {-(Identifier)-} @@ -143,24 +143,24 @@ {-(Break {-(Empty)-})-})-})-} {-(ForEach - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} {-(Identifier)-} {-(Call {-(Identifier)-} - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} {-(Empty)-})-})-} {-(ForEach - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} {-(Identifier)-} {-(Call {-(Identifier)-} - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} {-(Empty)-})-})-} @@ -172,9 +172,9 @@ {-(Empty)-} {-(Call {-(Identifier)-} - {-([])-} + {-(Statements)-} {-(Empty)-})-})-} {-(ForEach {-(Empty)-} {-(Identifier)-} - {-([])-})-}))) + {-(Statements)-})-}))) diff --git a/test/fixtures/go/corpus/for-statements.parseA.txt b/test/fixtures/go/corpus/for-statements.parseA.txt index 74701793f..5f6668119 100644 --- a/test/fixtures/go/corpus/for-statements.parseA.txt +++ b/test/fixtures/go/corpus/for-statements.parseA.txt @@ -4,16 +4,16 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (For (Empty) (Empty) (Empty) - ( + (Statements (Call (Identifier) - ([]) + (Statements) (Empty)) (Goto (Identifier)))) @@ -26,10 +26,10 @@ (Integer)) (PostIncrement (Identifier)) - ( + (Statements (Call (Identifier) - ([]) + (Statements) (Empty)) (Break (Identifier)))) @@ -40,10 +40,10 @@ (PostIncrement (Identifier)) (Empty) - ( + (Statements (Call (Identifier) - ([]) + (Statements) (Empty)) (Continue (Identifier)))) @@ -51,17 +51,17 @@ (Empty) (Empty) (Empty) - ( + (Statements (Call (Identifier) - ([]) + (Statements) (Empty)) (Continue (Empty)))) (ForEach (Identifier) (Identifier) - ( + (Statements (Call (Identifier) (Identifier) @@ -69,24 +69,24 @@ (Break (Empty)))) (ForEach - ( + (Statements (Identifier) (Identifier)) (Identifier) (Call (Identifier) - ( + (Statements (Identifier) (Identifier)) (Empty))) (ForEach - ( + (Statements (Identifier) (Identifier)) (Identifier) (Call (Identifier) - ( + (Statements (Identifier) (Identifier)) (Empty))) @@ -98,9 +98,9 @@ (Empty) (Call (Identifier) - ([]) + (Statements) (Empty))) (ForEach (Empty) (Identifier) - ([]))))) + (Statements))))) diff --git a/test/fixtures/go/corpus/for-statements.parseB.txt b/test/fixtures/go/corpus/for-statements.parseB.txt index 56c7408ab..93ce681f2 100644 --- a/test/fixtures/go/corpus/for-statements.parseB.txt +++ b/test/fixtures/go/corpus/for-statements.parseB.txt @@ -4,26 +4,26 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (For (Empty) (Empty) (Empty) - ( + (Statements (Call (Identifier) - ([]) + (Statements) (Empty)) (Goto (Identifier)))) (ForEach (Identifier) (Identifier) - ( + (Statements (Call (Identifier) - ([]) + (Statements) (Empty)) (Break (Identifier)))) @@ -31,10 +31,10 @@ (Empty) (Empty) (Empty) - ( + (Statements (Call (Identifier) - ([]) + (Statements) (Empty)) (Continue (Identifier)))) @@ -45,10 +45,10 @@ (PostIncrement (Identifier)) (Empty) - ( + (Statements (Call (Identifier) - ([]) + (Statements) (Empty)) (Continue (Empty)))) @@ -56,7 +56,7 @@ (Empty) (Empty) (Empty) - ( + (Statements (Call (Identifier) (Identifier) @@ -64,24 +64,24 @@ (Break (Empty)))) (ForEach - ( + (Statements (Identifier) (Identifier)) (Identifier) (Call (Identifier) - ( + (Statements (Identifier) (Identifier)) (Empty))) (ForEach - ( + (Statements (Identifier) (Identifier)) (Identifier) (Call (Identifier) - ( + (Statements (Identifier) (Identifier)) (Empty))) @@ -93,9 +93,9 @@ (Empty) (Call (Identifier) - ([]) + (Statements) (Empty))) (ForEach (Empty) (Identifier) - ([]))))) + (Statements))))) diff --git a/test/fixtures/go/corpus/function-declarations.diffA-B.txt b/test/fixtures/go/corpus/function-declarations.diffA-B.txt index 475dc3cc7..f65f31e62 100644 --- a/test/fixtures/go/corpus/function-declarations.diffA-B.txt +++ b/test/fixtures/go/corpus/function-declarations.diffA-B.txt @@ -4,57 +4,57 @@ (Function (Empty) (Identifier) - ([]) - ([])) + (Statements) + (Statements)) (Function (Empty) { (Identifier) ->(Identifier) } - ([]) - ([])) + (Statements) + (Statements)) (Function (Identifier) { (Identifier) ->(Identifier) } - ( - ( + (Statements + (Statements (Identifier) (Identifier)) - ( + (Statements (Identifier) (Identifier) (Identifier) (Identifier))) - ([])) + (Statements)) (Function (Empty) { (Identifier) ->(Identifier) } - ([]) - ( - ( + (Statements) + (Statements + (Statements (Identifier)) - ( + (Statements (Identifier))) - ([])) + (Statements)) (Function (Empty) { (Identifier) ->(Identifier) } - ([]) - ( - ( + (Statements) + (Statements + (Statements (Identifier) (Identifier)) - ( + (Statements (Identifier) (Identifier))) - ([])) + (Statements)) {+(Function {+(Empty)+} {+(Identifier)+} - {+([])+} - {+([])+} + {+(Statements)+} + {+(Statements)+} {+(NoOp {+(Empty)+})+})+} (Function @@ -62,17 +62,17 @@ ->(Identifier) } { (Identifier) ->(Identifier) } - ([]) + (Statements) (Empty)) (Function (Empty) { (Identifier) ->(Identifier) } - ( + (Statements (Identifier) (Pointer (Identifier))) (Context (Comment) (Empty)) - ([]))) + (Statements))) diff --git a/test/fixtures/go/corpus/function-declarations.diffB-A.txt b/test/fixtures/go/corpus/function-declarations.diffB-A.txt index b17bc908b..1056ed0be 100644 --- a/test/fixtures/go/corpus/function-declarations.diffB-A.txt +++ b/test/fixtures/go/corpus/function-declarations.diffB-A.txt @@ -4,88 +4,88 @@ (Function (Empty) (Identifier) - ([]) - ([])) + (Statements) + (Statements)) (Function (Empty) { (Identifier) ->(Identifier) } - ([]) - ([])) + (Statements) + (Statements)) (Function (Identifier) { (Identifier) ->(Identifier) } - ( - ( + (Statements + (Statements (Identifier) (Identifier)) - ( + (Statements (Identifier) (Identifier) (Identifier) (Identifier))) - ([])) + (Statements)) (Function (Empty) { (Identifier) ->(Identifier) } - ([]) - ( - ( + (Statements) + (Statements + (Statements (Identifier)) - ( + (Statements (Identifier))) - ([])) + (Statements)) (Function (Empty) { (Identifier) ->(Identifier) } - ([]) - ( - ( + (Statements) + (Statements + (Statements (Identifier) (Identifier)) - ( + (Statements (Identifier) (Identifier))) - ([])) + (Statements)) {+(Function {+(Identifier)+} {+(Identifier)+} - {+([])+} + {+(Statements)+} {+(Empty)+})+} {+(Function {+(Empty)+} {+(Identifier)+} - {+( + {+(Statements {+(Identifier)+} {+(Pointer {+(Identifier)+})+})+} {+(Context {+(Comment)+} {+(Empty)+})+} - {+([])+})+} + {+(Statements)+})+} {-(Function {-(Empty)-} {-(Identifier)-} - {-([])-} - {-([])-} + {-(Statements)-} + {-(Statements)-} {-(NoOp {-(Empty)-})-})-} {-(Function {-(Identifier)-} {-(Identifier)-} - {-([])-} + {-(Statements)-} {-(Empty)-})-} {-(Function {-(Empty)-} {-(Identifier)-} - {-( + {-(Statements {-(Identifier)-} {-(Pointer {-(Identifier)-})-})-} {-(Context {-(Comment)-} {-(Empty)-})-} - {-([])-})-}) + {-(Statements)-})-}) diff --git a/test/fixtures/go/corpus/function-declarations.parseA.txt b/test/fixtures/go/corpus/function-declarations.parseA.txt index 8038aba6e..452629f0e 100644 --- a/test/fixtures/go/corpus/function-declarations.parseA.txt +++ b/test/fixtures/go/corpus/function-declarations.parseA.txt @@ -4,61 +4,61 @@ (Function (Empty) (Identifier) - ([]) - ([])) + (Statements) + (Statements)) (Function (Empty) (Identifier) - ([]) - ([])) + (Statements) + (Statements)) (Function (Identifier) (Identifier) - ( - ( + (Statements + (Statements (Identifier) (Identifier)) - ( + (Statements (Identifier) (Identifier) (Identifier) (Identifier))) - ([])) + (Statements)) (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Identifier)) - ( + (Statements (Identifier))) - ([])) + (Statements)) (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Identifier) (Identifier)) - ( + (Statements (Identifier) (Identifier))) - ([])) + (Statements)) (Function (Identifier) (Identifier) - ([]) + (Statements) (Empty)) (Function (Empty) (Identifier) - ( + (Statements (Identifier) (Pointer (Identifier))) (Context (Comment) (Empty)) - ([]))) + (Statements))) diff --git a/test/fixtures/go/corpus/function-declarations.parseB.txt b/test/fixtures/go/corpus/function-declarations.parseB.txt index 0c2eb34f5..8c9ffbe9a 100644 --- a/test/fixtures/go/corpus/function-declarations.parseB.txt +++ b/test/fixtures/go/corpus/function-declarations.parseB.txt @@ -4,68 +4,68 @@ (Function (Empty) (Identifier) - ([]) - ([])) + (Statements) + (Statements)) (Function (Empty) (Identifier) - ([]) - ([])) + (Statements) + (Statements)) (Function (Identifier) (Identifier) - ( - ( + (Statements + (Statements (Identifier) (Identifier)) - ( + (Statements (Identifier) (Identifier) (Identifier) (Identifier))) - ([])) + (Statements)) (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Identifier)) - ( + (Statements (Identifier))) - ([])) + (Statements)) (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Identifier) (Identifier)) - ( + (Statements (Identifier) (Identifier))) - ([])) + (Statements)) (Function (Empty) (Identifier) - ([]) - ([]) + (Statements) + (Statements) (NoOp (Empty))) (Function (Identifier) (Identifier) - ([]) + (Statements) (Empty)) (Function (Empty) (Identifier) - ( + (Statements (Identifier) (Pointer (Identifier))) (Context (Comment) (Empty)) - ([]))) + (Statements))) diff --git a/test/fixtures/go/corpus/function-literals.diffA-B.txt b/test/fixtures/go/corpus/function-literals.diffA-B.txt index cc274008c..92470cd71 100644 --- a/test/fixtures/go/corpus/function-literals.diffA-B.txt +++ b/test/fixtures/go/corpus/function-literals.diffA-B.txt @@ -4,25 +4,25 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment (Identifier) (Function (Empty) (Empty) - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) }) - ( - ( + (Statements + (Statements { (Identifier) ->(Identifier) }) - ( + (Statements { (Identifier) ->(Identifier) })) (Return - ( + (Statements (Integer) (Integer))))))) diff --git a/test/fixtures/go/corpus/function-literals.diffB-A.txt b/test/fixtures/go/corpus/function-literals.diffB-A.txt index cc274008c..92470cd71 100644 --- a/test/fixtures/go/corpus/function-literals.diffB-A.txt +++ b/test/fixtures/go/corpus/function-literals.diffB-A.txt @@ -4,25 +4,25 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment (Identifier) (Function (Empty) (Empty) - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) }) - ( - ( + (Statements + (Statements { (Identifier) ->(Identifier) }) - ( + (Statements { (Identifier) ->(Identifier) })) (Return - ( + (Statements (Integer) (Integer))))))) diff --git a/test/fixtures/go/corpus/function-literals.parseA.txt b/test/fixtures/go/corpus/function-literals.parseA.txt index 31c68c5ff..978efb513 100644 --- a/test/fixtures/go/corpus/function-literals.parseA.txt +++ b/test/fixtures/go/corpus/function-literals.parseA.txt @@ -4,21 +4,21 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment (Identifier) (Function (Empty) (Empty) - ( + (Statements (Identifier) (Identifier)) - ( - ( + (Statements + (Statements (Identifier)) - ( + (Statements (Identifier))) (Return - ( + (Statements (Integer) (Integer))))))) diff --git a/test/fixtures/go/corpus/function-literals.parseB.txt b/test/fixtures/go/corpus/function-literals.parseB.txt index 31c68c5ff..978efb513 100644 --- a/test/fixtures/go/corpus/function-literals.parseB.txt +++ b/test/fixtures/go/corpus/function-literals.parseB.txt @@ -4,21 +4,21 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment (Identifier) (Function (Empty) (Empty) - ( + (Statements (Identifier) (Identifier)) - ( - ( + (Statements + (Statements (Identifier)) - ( + (Statements (Identifier))) (Return - ( + (Statements (Integer) (Integer))))))) diff --git a/test/fixtures/go/corpus/function-types.diffA-B.txt b/test/fixtures/go/corpus/function-types.diffA-B.txt index d925a1d60..8a7463671 100644 --- a/test/fixtures/go/corpus/function-types.diffA-B.txt +++ b/test/fixtures/go/corpus/function-types.diffA-B.txt @@ -4,13 +4,13 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Type { (Identifier) ->(Identifier) } (Function - ( + (Statements { (Identifier) ->(Identifier) }) { (Identifier) @@ -19,18 +19,18 @@ { (Identifier) ->(Identifier) } (Function - ( - {-( + (Statements + {-(Statements {-(Identifier)-})-} - ( + (Statements (Identifier)) - {+( + {+(Statements {+(Identifier)+})+}) - ( - ( + (Statements + (Statements {+(BidirectionalChannel {+(Identifier)+})+} {-(Identifier)-}) - ( + (Statements (Identifier))) (Empty)))))) diff --git a/test/fixtures/go/corpus/function-types.diffB-A.txt b/test/fixtures/go/corpus/function-types.diffB-A.txt index 70807059c..27129ae93 100644 --- a/test/fixtures/go/corpus/function-types.diffB-A.txt +++ b/test/fixtures/go/corpus/function-types.diffB-A.txt @@ -4,13 +4,13 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Type { (Identifier) ->(Identifier) } (Function - ( + (Statements { (Identifier) ->(Identifier) }) { (Identifier) @@ -19,18 +19,18 @@ { (Identifier) ->(Identifier) } (Function - ( - {-( + (Statements + {-(Statements {-(Identifier)-})-} - ( + (Statements (Identifier)) - {+( + {+(Statements {+(Identifier)+})+}) - ( - ( + (Statements + (Statements {+(Identifier)+} {-(BidirectionalChannel {-(Identifier)-})-}) - ( + (Statements (Identifier))) (Empty)))))) diff --git a/test/fixtures/go/corpus/function-types.parseA.txt b/test/fixtures/go/corpus/function-types.parseA.txt index 302111d2d..71ca93ab6 100644 --- a/test/fixtures/go/corpus/function-types.parseA.txt +++ b/test/fixtures/go/corpus/function-types.parseA.txt @@ -4,25 +4,25 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Type (Identifier) (Function - ( + (Statements (Identifier)) (Identifier))) (Type (Identifier) (Function - ( - ( + (Statements + (Statements (Identifier)) - ( + (Statements (Identifier))) - ( - ( + (Statements + (Statements (Identifier)) - ( + (Statements (Identifier))) (Empty)))))) diff --git a/test/fixtures/go/corpus/function-types.parseB.txt b/test/fixtures/go/corpus/function-types.parseB.txt index a00ba801b..2221de55b 100644 --- a/test/fixtures/go/corpus/function-types.parseB.txt +++ b/test/fixtures/go/corpus/function-types.parseB.txt @@ -4,26 +4,26 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Type (Identifier) (Function - ( + (Statements (Identifier)) (Identifier))) (Type (Identifier) (Function - ( - ( + (Statements + (Statements (Identifier)) - ( + (Statements (Identifier))) - ( - ( + (Statements + (Statements (BidirectionalChannel (Identifier))) - ( + (Statements (Identifier))) (Empty)))))) diff --git a/test/fixtures/go/corpus/go-and-defer-statements.diffA-B.txt b/test/fixtures/go/corpus/go-and-defer-statements.diffA-B.txt index 2df88fd8c..6e514bb12 100644 --- a/test/fixtures/go/corpus/go-and-defer-statements.diffA-B.txt +++ b/test/fixtures/go/corpus/go-and-defer-statements.diffA-B.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Defer (Call (MemberAccess @@ -13,7 +13,7 @@ ->(Identifier) } { (Identifier) ->(Identifier) }) - ([]) + (Statements) (Empty))) (Go (Call @@ -22,5 +22,5 @@ ->(Identifier) } { (Identifier) ->(Identifier) }) - ([]) + (Statements) (Empty)))))) diff --git a/test/fixtures/go/corpus/go-and-defer-statements.diffB-A.txt b/test/fixtures/go/corpus/go-and-defer-statements.diffB-A.txt index 2df88fd8c..6e514bb12 100644 --- a/test/fixtures/go/corpus/go-and-defer-statements.diffB-A.txt +++ b/test/fixtures/go/corpus/go-and-defer-statements.diffB-A.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Defer (Call (MemberAccess @@ -13,7 +13,7 @@ ->(Identifier) } { (Identifier) ->(Identifier) }) - ([]) + (Statements) (Empty))) (Go (Call @@ -22,5 +22,5 @@ ->(Identifier) } { (Identifier) ->(Identifier) }) - ([]) + (Statements) (Empty)))))) diff --git a/test/fixtures/go/corpus/go-and-defer-statements.parseA.txt b/test/fixtures/go/corpus/go-and-defer-statements.parseA.txt index 1210e7076..328d1ff21 100644 --- a/test/fixtures/go/corpus/go-and-defer-statements.parseA.txt +++ b/test/fixtures/go/corpus/go-and-defer-statements.parseA.txt @@ -4,19 +4,19 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Defer (Call (MemberAccess (Identifier) (Identifier)) - ([]) + (Statements) (Empty))) (Go (Call (MemberAccess (Identifier) (Identifier)) - ([]) + (Statements) (Empty)))))) diff --git a/test/fixtures/go/corpus/go-and-defer-statements.parseB.txt b/test/fixtures/go/corpus/go-and-defer-statements.parseB.txt index 1210e7076..328d1ff21 100644 --- a/test/fixtures/go/corpus/go-and-defer-statements.parseB.txt +++ b/test/fixtures/go/corpus/go-and-defer-statements.parseB.txt @@ -4,19 +4,19 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Defer (Call (MemberAccess (Identifier) (Identifier)) - ([]) + (Statements) (Empty))) (Go (Call (MemberAccess (Identifier) (Identifier)) - ([]) + (Statements) (Empty)))))) diff --git a/test/fixtures/go/corpus/grouped-import-declarations.diffA-B.txt b/test/fixtures/go/corpus/grouped-import-declarations.diffA-B.txt index d5e6076f3..1a203ec98 100644 --- a/test/fixtures/go/corpus/grouped-import-declarations.diffA-B.txt +++ b/test/fixtures/go/corpus/grouped-import-declarations.diffA-B.txt @@ -1,7 +1,7 @@ (Program (Package (Identifier)) - ( + (Statements {+(QualifiedImport {+(Identifier)+})+} {+(Import @@ -17,5 +17,5 @@ (Function (Empty) (Identifier) - ([]) - ([]))) + (Statements) + (Statements))) diff --git a/test/fixtures/go/corpus/grouped-import-declarations.diffB-A.txt b/test/fixtures/go/corpus/grouped-import-declarations.diffB-A.txt index d5e6076f3..1a203ec98 100644 --- a/test/fixtures/go/corpus/grouped-import-declarations.diffB-A.txt +++ b/test/fixtures/go/corpus/grouped-import-declarations.diffB-A.txt @@ -1,7 +1,7 @@ (Program (Package (Identifier)) - ( + (Statements {+(QualifiedImport {+(Identifier)+})+} {+(Import @@ -17,5 +17,5 @@ (Function (Empty) (Identifier) - ([]) - ([]))) + (Statements) + (Statements))) diff --git a/test/fixtures/go/corpus/grouped-import-declarations.parseA.txt b/test/fixtures/go/corpus/grouped-import-declarations.parseA.txt index a42c1120b..3056c74a1 100644 --- a/test/fixtures/go/corpus/grouped-import-declarations.parseA.txt +++ b/test/fixtures/go/corpus/grouped-import-declarations.parseA.txt @@ -1,7 +1,7 @@ (Program (Package (Identifier)) - ( + (Statements (QualifiedImport (Identifier)) (Import @@ -11,5 +11,5 @@ (Function (Empty) (Identifier) - ([]) - ([]))) + (Statements) + (Statements))) diff --git a/test/fixtures/go/corpus/grouped-import-declarations.parseB.txt b/test/fixtures/go/corpus/grouped-import-declarations.parseB.txt index a42c1120b..3056c74a1 100644 --- a/test/fixtures/go/corpus/grouped-import-declarations.parseB.txt +++ b/test/fixtures/go/corpus/grouped-import-declarations.parseB.txt @@ -1,7 +1,7 @@ (Program (Package (Identifier)) - ( + (Statements (QualifiedImport (Identifier)) (Import @@ -11,5 +11,5 @@ (Function (Empty) (Identifier) - ([]) - ([]))) + (Statements) + (Statements))) diff --git a/test/fixtures/go/corpus/grouped-var-declarations.diffA-B.txt b/test/fixtures/go/corpus/grouped-var-declarations.diffA-B.txt index 7c9cb8c9a..34b5a2048 100644 --- a/test/fixtures/go/corpus/grouped-var-declarations.diffA-B.txt +++ b/test/fixtures/go/corpus/grouped-var-declarations.diffA-B.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment { (Identifier) ->(Identifier) } diff --git a/test/fixtures/go/corpus/grouped-var-declarations.diffB-A.txt b/test/fixtures/go/corpus/grouped-var-declarations.diffB-A.txt index 7c9cb8c9a..34b5a2048 100644 --- a/test/fixtures/go/corpus/grouped-var-declarations.diffB-A.txt +++ b/test/fixtures/go/corpus/grouped-var-declarations.diffB-A.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment { (Identifier) ->(Identifier) } diff --git a/test/fixtures/go/corpus/grouped-var-declarations.parseA.txt b/test/fixtures/go/corpus/grouped-var-declarations.parseA.txt index 4275a124d..e2b812db4 100644 --- a/test/fixtures/go/corpus/grouped-var-declarations.parseA.txt +++ b/test/fixtures/go/corpus/grouped-var-declarations.parseA.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) (Integer)) diff --git a/test/fixtures/go/corpus/grouped-var-declarations.parseB.txt b/test/fixtures/go/corpus/grouped-var-declarations.parseB.txt index 4275a124d..e2b812db4 100644 --- a/test/fixtures/go/corpus/grouped-var-declarations.parseB.txt +++ b/test/fixtures/go/corpus/grouped-var-declarations.parseB.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) (Integer)) diff --git a/test/fixtures/go/corpus/if-statements.diffA-B.txt b/test/fixtures/go/corpus/if-statements.diffA-B.txt index 9010006ab..85aa397a7 100644 --- a/test/fixtures/go/corpus/if-statements.diffA-B.txt +++ b/test/fixtures/go/corpus/if-statements.diffA-B.txt @@ -4,52 +4,52 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (If - ( + (Statements (Call { (Identifier) ->(Identifier) } - ([]) + (Statements) (Empty))) (Call (Identifier) - ([]) + (Statements) (Empty)) (Empty)) (If - ( + (Statements (Assignment { (Identifier) ->(Identifier) } (Call (Identifier) - ([]) + (Statements) (Empty))) (Identifier)) (Call (Identifier) - ([]) + (Statements) (Empty)) (Empty)) (If - ( + (Statements (Call { (Identifier) ->(Identifier) } - ([]) + (Statements) (Empty))) (Call (Identifier) - ([]) + (Statements) (Empty)) (Call (Identifier) - ([]) + (Statements) (Empty))) (If - ( + (Statements (Assignment (Identifier) { (Integer) @@ -60,12 +60,12 @@ (Call { (Identifier) ->(Identifier) } - ([]) + (Statements) (Empty)) {+(Context {+(Comment)+} (If - ( + (Statements (LessThan (Identifier) { (Integer) @@ -73,22 +73,22 @@ (Call { (Identifier) ->(Identifier) } - ([]) + (Statements) (Empty)) { (Context {-(Comment)-} {-(If - {-( + {-(Statements {-(Call {-(Identifier)-} - {-([])-} + {-(Statements)-} {-(Empty)-})-})-} {-(Call {-(Identifier)-} - {-([])-} + {-(Statements)-} {-(Empty)-})-} {-(Empty)-})-}) ->(Call {+(Identifier)+} - {+([])+} + {+(Statements)+} {+(Empty)+}) }))+})))) diff --git a/test/fixtures/go/corpus/if-statements.diffB-A.txt b/test/fixtures/go/corpus/if-statements.diffB-A.txt index a815344d1..5dfcda691 100644 --- a/test/fixtures/go/corpus/if-statements.diffB-A.txt +++ b/test/fixtures/go/corpus/if-statements.diffB-A.txt @@ -4,52 +4,52 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (If - ( + (Statements (Call { (Identifier) ->(Identifier) } - ([]) + (Statements) (Empty))) (Call (Identifier) - ([]) + (Statements) (Empty)) (Empty)) (If - ( + (Statements (Assignment { (Identifier) ->(Identifier) } (Call (Identifier) - ([]) + (Statements) (Empty))) (Identifier)) (Call (Identifier) - ([]) + (Statements) (Empty)) (Empty)) (If - ( + (Statements (Call { (Identifier) ->(Identifier) } - ([]) + (Statements) (Empty))) (Call (Identifier) - ([]) + (Statements) (Empty)) (Call (Identifier) - ([]) + (Statements) (Empty))) (If - ( + (Statements (Assignment (Identifier) { (Integer) @@ -60,12 +60,12 @@ (Call { (Identifier) ->(Identifier) } - ([]) + (Statements) (Empty)) {-(Context {-(Comment)-} (If - ( + (Statements (LessThan (Identifier) { (Integer) @@ -73,22 +73,22 @@ (Call { (Identifier) ->(Identifier) } - ([]) + (Statements) (Empty)) { (Call {-(Identifier)-} - {-([])-} + {-(Statements)-} {-(Empty)-}) ->(Context {+(Comment)+} {+(If - {+( + {+(Statements {+(Call {+(Identifier)+} - {+([])+} + {+(Statements)+} {+(Empty)+})+})+} {+(Call {+(Identifier)+} - {+([])+} + {+(Statements)+} {+(Empty)+})+} {+(Empty)+})+}) }))-})))) diff --git a/test/fixtures/go/corpus/if-statements.parseA.txt b/test/fixtures/go/corpus/if-statements.parseA.txt index ef33b5738..1736450cf 100644 --- a/test/fixtures/go/corpus/if-statements.parseA.txt +++ b/test/fixtures/go/corpus/if-statements.parseA.txt @@ -4,49 +4,49 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (If - ( + (Statements (Call (Identifier) - ([]) + (Statements) (Empty))) (Call (Identifier) - ([]) + (Statements) (Empty)) (Empty)) (If - ( + (Statements (Assignment (Identifier) (Call (Identifier) - ([]) + (Statements) (Empty))) (Identifier)) (Call (Identifier) - ([]) + (Statements) (Empty)) (Empty)) (If - ( + (Statements (Call (Identifier) - ([]) + (Statements) (Empty))) (Call (Identifier) - ([]) + (Statements) (Empty)) (Call (Identifier) - ([]) + (Statements) (Empty))) (If - ( + (Statements (Assignment (Identifier) (Integer)) @@ -55,27 +55,27 @@ (Integer))) (Call (Identifier) - ([]) + (Statements) (Empty)) (If - ( + (Statements (LessThan (Identifier) (Integer))) (Call (Identifier) - ([]) + (Statements) (Empty)) (Context (Comment) (If - ( + (Statements (Call (Identifier) - ([]) + (Statements) (Empty))) (Call (Identifier) - ([]) + (Statements) (Empty)) (Empty)))))))) diff --git a/test/fixtures/go/corpus/if-statements.parseB.txt b/test/fixtures/go/corpus/if-statements.parseB.txt index 42d082648..57ddb0dc8 100644 --- a/test/fixtures/go/corpus/if-statements.parseB.txt +++ b/test/fixtures/go/corpus/if-statements.parseB.txt @@ -4,49 +4,49 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (If - ( + (Statements (Call (Identifier) - ([]) + (Statements) (Empty))) (Call (Identifier) - ([]) + (Statements) (Empty)) (Empty)) (If - ( + (Statements (Assignment (Identifier) (Call (Identifier) - ([]) + (Statements) (Empty))) (Identifier)) (Call (Identifier) - ([]) + (Statements) (Empty)) (Empty)) (If - ( + (Statements (Call (Identifier) - ([]) + (Statements) (Empty))) (Call (Identifier) - ([]) + (Statements) (Empty)) (Call (Identifier) - ([]) + (Statements) (Empty))) (If - ( + (Statements (Assignment (Identifier) (Integer)) @@ -55,20 +55,20 @@ (Integer))) (Call (Identifier) - ([]) + (Statements) (Empty)) (Context (Comment) (If - ( + (Statements (LessThan (Identifier) (Integer))) (Call (Identifier) - ([]) + (Statements) (Empty)) (Call (Identifier) - ([]) + (Statements) (Empty)))))))) diff --git a/test/fixtures/go/corpus/imaginary-literals.diffA-B.txt b/test/fixtures/go/corpus/imaginary-literals.diffA-B.txt index e4b43e22b..5effba7cf 100644 --- a/test/fixtures/go/corpus/imaginary-literals.diffA-B.txt +++ b/test/fixtures/go/corpus/imaginary-literals.diffA-B.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) { (Complex) diff --git a/test/fixtures/go/corpus/imaginary-literals.diffB-A.txt b/test/fixtures/go/corpus/imaginary-literals.diffB-A.txt index e4b43e22b..5effba7cf 100644 --- a/test/fixtures/go/corpus/imaginary-literals.diffB-A.txt +++ b/test/fixtures/go/corpus/imaginary-literals.diffB-A.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) { (Complex) diff --git a/test/fixtures/go/corpus/imaginary-literals.parseA.txt b/test/fixtures/go/corpus/imaginary-literals.parseA.txt index c21f33e57..f7a8584b2 100644 --- a/test/fixtures/go/corpus/imaginary-literals.parseA.txt +++ b/test/fixtures/go/corpus/imaginary-literals.parseA.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) (Complex)) diff --git a/test/fixtures/go/corpus/imaginary-literals.parseB.txt b/test/fixtures/go/corpus/imaginary-literals.parseB.txt index c21f33e57..f7a8584b2 100644 --- a/test/fixtures/go/corpus/imaginary-literals.parseB.txt +++ b/test/fixtures/go/corpus/imaginary-literals.parseB.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) (Complex)) diff --git a/test/fixtures/go/corpus/import-statements.diffA-B.txt b/test/fixtures/go/corpus/import-statements.diffA-B.txt index 5b08d8e40..7a7da2e36 100644 --- a/test/fixtures/go/corpus/import-statements.diffA-B.txt +++ b/test/fixtures/go/corpus/import-statements.diffA-B.txt @@ -1,7 +1,7 @@ (Program (Package (Identifier)) - ( + (Statements (Comment) (Comment) { (QualifiedImport @@ -12,5 +12,5 @@ (Function (Empty) (Identifier) - ([]) - ([]))) + (Statements) + (Statements))) diff --git a/test/fixtures/go/corpus/import-statements.diffB-A.txt b/test/fixtures/go/corpus/import-statements.diffB-A.txt index 5b08d8e40..7a7da2e36 100644 --- a/test/fixtures/go/corpus/import-statements.diffB-A.txt +++ b/test/fixtures/go/corpus/import-statements.diffB-A.txt @@ -1,7 +1,7 @@ (Program (Package (Identifier)) - ( + (Statements (Comment) (Comment) { (QualifiedImport @@ -12,5 +12,5 @@ (Function (Empty) (Identifier) - ([]) - ([]))) + (Statements) + (Statements))) diff --git a/test/fixtures/go/corpus/import-statements.parseA.txt b/test/fixtures/go/corpus/import-statements.parseA.txt index 0c4964ed1..3dee6a1dc 100644 --- a/test/fixtures/go/corpus/import-statements.parseA.txt +++ b/test/fixtures/go/corpus/import-statements.parseA.txt @@ -1,7 +1,7 @@ (Program (Package (Identifier)) - ( + (Statements (Comment) (Comment) (QualifiedImport @@ -10,5 +10,5 @@ (Function (Empty) (Identifier) - ([]) - ([]))) + (Statements) + (Statements))) diff --git a/test/fixtures/go/corpus/import-statements.parseB.txt b/test/fixtures/go/corpus/import-statements.parseB.txt index 0c4964ed1..3dee6a1dc 100644 --- a/test/fixtures/go/corpus/import-statements.parseB.txt +++ b/test/fixtures/go/corpus/import-statements.parseB.txt @@ -1,7 +1,7 @@ (Program (Package (Identifier)) - ( + (Statements (Comment) (Comment) (QualifiedImport @@ -10,5 +10,5 @@ (Function (Empty) (Identifier) - ([]) - ([]))) + (Statements) + (Statements))) diff --git a/test/fixtures/go/corpus/increment-decrement-statements.diffA-B.txt b/test/fixtures/go/corpus/increment-decrement-statements.diffA-B.txt index e0f5fb1fa..45abdcf05 100644 --- a/test/fixtures/go/corpus/increment-decrement-statements.diffA-B.txt +++ b/test/fixtures/go/corpus/increment-decrement-statements.diffA-B.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (PostIncrement { (Identifier) ->(Identifier) }) diff --git a/test/fixtures/go/corpus/increment-decrement-statements.diffB-A.txt b/test/fixtures/go/corpus/increment-decrement-statements.diffB-A.txt index dcc538a29..3235fddb4 100644 --- a/test/fixtures/go/corpus/increment-decrement-statements.diffB-A.txt +++ b/test/fixtures/go/corpus/increment-decrement-statements.diffB-A.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (PostIncrement { (Identifier) ->(Identifier) }) diff --git a/test/fixtures/go/corpus/increment-decrement-statements.parseA.txt b/test/fixtures/go/corpus/increment-decrement-statements.parseA.txt index 0871ed54c..31efb99ab 100644 --- a/test/fixtures/go/corpus/increment-decrement-statements.parseA.txt +++ b/test/fixtures/go/corpus/increment-decrement-statements.parseA.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (PostIncrement (Identifier)) (PostDecrement diff --git a/test/fixtures/go/corpus/increment-decrement-statements.parseB.txt b/test/fixtures/go/corpus/increment-decrement-statements.parseB.txt index 8f8b3d7d8..3a5c0c90e 100644 --- a/test/fixtures/go/corpus/increment-decrement-statements.parseB.txt +++ b/test/fixtures/go/corpus/increment-decrement-statements.parseB.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (PostIncrement (Identifier)) (PostIncrement diff --git a/test/fixtures/go/corpus/int-literals.diffA-B.txt b/test/fixtures/go/corpus/int-literals.diffA-B.txt index b67722ecc..0509a4b55 100644 --- a/test/fixtures/go/corpus/int-literals.diffA-B.txt +++ b/test/fixtures/go/corpus/int-literals.diffA-B.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) { (Integer) diff --git a/test/fixtures/go/corpus/int-literals.diffB-A.txt b/test/fixtures/go/corpus/int-literals.diffB-A.txt index b67722ecc..0509a4b55 100644 --- a/test/fixtures/go/corpus/int-literals.diffB-A.txt +++ b/test/fixtures/go/corpus/int-literals.diffB-A.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) { (Integer) diff --git a/test/fixtures/go/corpus/int-literals.parseA.txt b/test/fixtures/go/corpus/int-literals.parseA.txt index 994737fb0..866d153dd 100644 --- a/test/fixtures/go/corpus/int-literals.parseA.txt +++ b/test/fixtures/go/corpus/int-literals.parseA.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) (Integer)) diff --git a/test/fixtures/go/corpus/int-literals.parseB.txt b/test/fixtures/go/corpus/int-literals.parseB.txt index 994737fb0..866d153dd 100644 --- a/test/fixtures/go/corpus/int-literals.parseB.txt +++ b/test/fixtures/go/corpus/int-literals.parseB.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) (Integer)) diff --git a/test/fixtures/go/corpus/interface-types.diffA-B.txt b/test/fixtures/go/corpus/interface-types.diffA-B.txt index 2706e9160..7dd0e89fb 100644 --- a/test/fixtures/go/corpus/interface-types.diffA-B.txt +++ b/test/fixtures/go/corpus/interface-types.diffA-B.txt @@ -4,15 +4,15 @@ (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Type { (Identifier) ->(Identifier) } (Interface - ([])))) - ( + (Statements)))) + (Statements (Type { (Identifier) ->(Identifier) } @@ -20,12 +20,12 @@ (MemberAccess (Identifier) (Identifier))))) - ( + (Statements (Type { (Identifier) ->(Identifier) } (Interface - ( + (Statements (Identifier) (MemberAccess (Identifier) @@ -33,12 +33,12 @@ (MethodSignature (Identifier) (Identifier) - ( + (Statements (Identifier) (Identifier))))))) (Context (Comment) - ( + (Statements (Type { (Identifier) ->(Identifier) } @@ -47,4 +47,4 @@ (Empty) { (Identifier) ->(Identifier) } - ([]))))))))) + (Statements))))))))) diff --git a/test/fixtures/go/corpus/interface-types.diffB-A.txt b/test/fixtures/go/corpus/interface-types.diffB-A.txt index 2706e9160..7dd0e89fb 100644 --- a/test/fixtures/go/corpus/interface-types.diffB-A.txt +++ b/test/fixtures/go/corpus/interface-types.diffB-A.txt @@ -4,15 +4,15 @@ (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Type { (Identifier) ->(Identifier) } (Interface - ([])))) - ( + (Statements)))) + (Statements (Type { (Identifier) ->(Identifier) } @@ -20,12 +20,12 @@ (MemberAccess (Identifier) (Identifier))))) - ( + (Statements (Type { (Identifier) ->(Identifier) } (Interface - ( + (Statements (Identifier) (MemberAccess (Identifier) @@ -33,12 +33,12 @@ (MethodSignature (Identifier) (Identifier) - ( + (Statements (Identifier) (Identifier))))))) (Context (Comment) - ( + (Statements (Type { (Identifier) ->(Identifier) } @@ -47,4 +47,4 @@ (Empty) { (Identifier) ->(Identifier) } - ([]))))))))) + (Statements))))))))) diff --git a/test/fixtures/go/corpus/interface-types.parseA.txt b/test/fixtures/go/corpus/interface-types.parseA.txt index 10cf5b569..4c29cbcbc 100644 --- a/test/fixtures/go/corpus/interface-types.parseA.txt +++ b/test/fixtures/go/corpus/interface-types.parseA.txt @@ -4,25 +4,25 @@ (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Type (Identifier) (Interface - ([])))) - ( + (Statements)))) + (Statements (Type (Identifier) (Interface (MemberAccess (Identifier) (Identifier))))) - ( + (Statements (Type (Identifier) (Interface - ( + (Statements (Identifier) (MemberAccess (Identifier) @@ -30,16 +30,16 @@ (MethodSignature (Identifier) (Identifier) - ( + (Statements (Identifier) (Identifier))))))) (Context (Comment) - ( + (Statements (Type (Identifier) (Interface (MethodSignature (Empty) (Identifier) - ([]))))))))) + (Statements))))))))) diff --git a/test/fixtures/go/corpus/interface-types.parseB.txt b/test/fixtures/go/corpus/interface-types.parseB.txt index 10cf5b569..4c29cbcbc 100644 --- a/test/fixtures/go/corpus/interface-types.parseB.txt +++ b/test/fixtures/go/corpus/interface-types.parseB.txt @@ -4,25 +4,25 @@ (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Type (Identifier) (Interface - ([])))) - ( + (Statements)))) + (Statements (Type (Identifier) (Interface (MemberAccess (Identifier) (Identifier))))) - ( + (Statements (Type (Identifier) (Interface - ( + (Statements (Identifier) (MemberAccess (Identifier) @@ -30,16 +30,16 @@ (MethodSignature (Identifier) (Identifier) - ( + (Statements (Identifier) (Identifier))))))) (Context (Comment) - ( + (Statements (Type (Identifier) (Interface (MethodSignature (Empty) (Identifier) - ([]))))))))) + (Statements))))))))) diff --git a/test/fixtures/go/corpus/label-statements.diffA-B.txt b/test/fixtures/go/corpus/label-statements.diffA-B.txt index cc3154157..2b1b97ef6 100644 --- a/test/fixtures/go/corpus/label-statements.diffA-B.txt +++ b/test/fixtures/go/corpus/label-statements.diffA-B.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Label { (Identifier) ->(Identifier) } @@ -29,7 +29,7 @@ (Integer)) (PostIncrement (Identifier)) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/go/corpus/label-statements.diffB-A.txt b/test/fixtures/go/corpus/label-statements.diffB-A.txt index cc3154157..2b1b97ef6 100644 --- a/test/fixtures/go/corpus/label-statements.diffB-A.txt +++ b/test/fixtures/go/corpus/label-statements.diffB-A.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Label { (Identifier) ->(Identifier) } @@ -29,7 +29,7 @@ (Integer)) (PostIncrement (Identifier)) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/go/corpus/label-statements.parseA.txt b/test/fixtures/go/corpus/label-statements.parseA.txt index 6d8a80f9a..c99e5541c 100644 --- a/test/fixtures/go/corpus/label-statements.parseA.txt +++ b/test/fixtures/go/corpus/label-statements.parseA.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Label (Identifier) (NoOp @@ -25,7 +25,7 @@ (Integer)) (PostIncrement (Identifier)) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/go/corpus/label-statements.parseB.txt b/test/fixtures/go/corpus/label-statements.parseB.txt index 6d8a80f9a..c99e5541c 100644 --- a/test/fixtures/go/corpus/label-statements.parseB.txt +++ b/test/fixtures/go/corpus/label-statements.parseB.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Label (Identifier) (NoOp @@ -25,7 +25,7 @@ (Integer)) (PostIncrement (Identifier)) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/go/corpus/map-literals.diffA-B.txt b/test/fixtures/go/corpus/map-literals.diffA-B.txt index aedcf1301..bb2ce33a2 100644 --- a/test/fixtures/go/corpus/map-literals.diffA-B.txt +++ b/test/fixtures/go/corpus/map-literals.diffA-B.txt @@ -4,7 +4,7 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment (Identifier) (Composite @@ -12,7 +12,7 @@ (Identifier) { (Identifier) ->(Identifier) }) - ( + (Statements (KeyValue { (TextElement) ->(TextElement) } diff --git a/test/fixtures/go/corpus/map-literals.diffB-A.txt b/test/fixtures/go/corpus/map-literals.diffB-A.txt index aedcf1301..bb2ce33a2 100644 --- a/test/fixtures/go/corpus/map-literals.diffB-A.txt +++ b/test/fixtures/go/corpus/map-literals.diffB-A.txt @@ -4,7 +4,7 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment (Identifier) (Composite @@ -12,7 +12,7 @@ (Identifier) { (Identifier) ->(Identifier) }) - ( + (Statements (KeyValue { (TextElement) ->(TextElement) } diff --git a/test/fixtures/go/corpus/map-literals.parseA.txt b/test/fixtures/go/corpus/map-literals.parseA.txt index 425fccca1..f3f8dcb3c 100644 --- a/test/fixtures/go/corpus/map-literals.parseA.txt +++ b/test/fixtures/go/corpus/map-literals.parseA.txt @@ -4,14 +4,14 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment (Identifier) (Composite (Map (Identifier) (Identifier)) - ( + (Statements (KeyValue (TextElement) (TextElement)) diff --git a/test/fixtures/go/corpus/map-literals.parseB.txt b/test/fixtures/go/corpus/map-literals.parseB.txt index 425fccca1..f3f8dcb3c 100644 --- a/test/fixtures/go/corpus/map-literals.parseB.txt +++ b/test/fixtures/go/corpus/map-literals.parseB.txt @@ -4,14 +4,14 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment (Identifier) (Composite (Map (Identifier) (Identifier)) - ( + (Statements (KeyValue (TextElement) (TextElement)) diff --git a/test/fixtures/go/corpus/map-types.diffA-B.txt b/test/fixtures/go/corpus/map-types.diffA-B.txt index 9155512d9..11c405f5e 100644 --- a/test/fixtures/go/corpus/map-types.diffA-B.txt +++ b/test/fixtures/go/corpus/map-types.diffA-B.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Type (Identifier) (Map diff --git a/test/fixtures/go/corpus/map-types.diffB-A.txt b/test/fixtures/go/corpus/map-types.diffB-A.txt index 9155512d9..11c405f5e 100644 --- a/test/fixtures/go/corpus/map-types.diffB-A.txt +++ b/test/fixtures/go/corpus/map-types.diffB-A.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Type (Identifier) (Map diff --git a/test/fixtures/go/corpus/map-types.parseA.txt b/test/fixtures/go/corpus/map-types.parseA.txt index 62dd40845..6128e1b82 100644 --- a/test/fixtures/go/corpus/map-types.parseA.txt +++ b/test/fixtures/go/corpus/map-types.parseA.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Type (Identifier) (Map diff --git a/test/fixtures/go/corpus/map-types.parseB.txt b/test/fixtures/go/corpus/map-types.parseB.txt index 62dd40845..6128e1b82 100644 --- a/test/fixtures/go/corpus/map-types.parseB.txt +++ b/test/fixtures/go/corpus/map-types.parseB.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Type (Identifier) (Map diff --git a/test/fixtures/go/corpus/method-declarations.diffA-B.txt b/test/fixtures/go/corpus/method-declarations.diffA-B.txt index 0ae61f435..847454e0e 100644 --- a/test/fixtures/go/corpus/method-declarations.diffA-B.txt +++ b/test/fixtures/go/corpus/method-declarations.diffA-B.txt @@ -4,38 +4,38 @@ (Function (Empty) (Identifier) - ([]) - ([])) + (Statements) + (Statements)) (Method (Empty) (Identifier) { (Identifier) ->(Identifier) } - ([]) + (Statements) (Empty)) (Method - ( + (Statements (Identifier)) - ( + (Statements (Identifier) { (Identifier) ->(Identifier) }) (Identifier) - ( + (Statements (Identifier) { (Identifier) ->(Identifier) }) - ([])) + (Statements)) (Method - ( + (Statements (Identifier)) - ( + (Statements (Identifier) (Pointer (Identifier))) { (Identifier) ->(Identifier) } - ([]) + (Statements) (Return (Call (MemberAccess @@ -55,7 +55,7 @@ {+(MemberAccess {+(Identifier)+} {+(Identifier)+})+} - {+( + {+(Statements {+(MemberAccess {+(Identifier)+} {+(Identifier)+})+} @@ -68,7 +68,7 @@ {+(MemberAccess {+(Identifier)+} {+(Identifier)+})+} - {+( + {+(Statements {+(MemberAccess {+(Identifier)+} {+(Identifier)+})+} @@ -86,18 +86,18 @@ {+(Identifier)+}) }) (Empty)))) (Method - ([]) - ( + (Statements) + (Statements { (Identifier) ->(Identifier) } (Pointer (Identifier))) (Identifier) - ( + (Statements (Identifier) { (Identifier) ->(Identifier) }) - ( + (Statements (Assignment (MemberAccess (Identifier) @@ -117,17 +117,17 @@ (Identifier)) (Identifier))))) (Method - ( + (Statements (Identifier)) - ( + (Statements (Identifier) (Pointer (Identifier))) (Identifier) - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) } (Identifier)) - ([]))) + (Statements))) diff --git a/test/fixtures/go/corpus/method-declarations.diffB-A.txt b/test/fixtures/go/corpus/method-declarations.diffB-A.txt index e751ae62c..6329377d8 100644 --- a/test/fixtures/go/corpus/method-declarations.diffB-A.txt +++ b/test/fixtures/go/corpus/method-declarations.diffB-A.txt @@ -4,38 +4,38 @@ (Function (Empty) (Identifier) - ([]) - ([])) + (Statements) + (Statements)) (Method (Empty) (Identifier) { (Identifier) ->(Identifier) } - ([]) + (Statements) (Empty)) (Method - ( + (Statements (Identifier)) - ( + (Statements (Identifier) { (Identifier) ->(Identifier) }) (Identifier) - ( + (Statements (Identifier) { (Identifier) ->(Identifier) }) - ([])) + (Statements)) (Method - ( + (Statements (Identifier)) - ( + (Statements (Identifier) (Pointer (Identifier))) { (Identifier) ->(Identifier) } - ([]) + (Statements) (Return (Call (MemberAccess @@ -48,7 +48,7 @@ {-(MemberAccess {-(Identifier)-} {-(Identifier)-})-} - {-( + {-(Statements {-(MemberAccess {-(Identifier)-} {-(Identifier)-})-} @@ -61,7 +61,7 @@ {-(MemberAccess {-(Identifier)-} {-(Identifier)-})-} - {-( + {-(Statements {-(MemberAccess {-(Identifier)-} {-(Identifier)-})-} @@ -86,18 +86,18 @@ {+(Identifier)+})+}) }) (Empty)))) (Method - ([]) - ( + (Statements) + (Statements { (Identifier) ->(Identifier) } (Pointer (Identifier))) (Identifier) - ( + (Statements (Identifier) { (Identifier) ->(Identifier) }) - ( + (Statements (Assignment (MemberAccess (Identifier) @@ -117,17 +117,17 @@ (Identifier)) (Identifier))))) (Method - ( + (Statements (Identifier)) - ( + (Statements (Identifier) (Pointer (Identifier))) (Identifier) - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) } (Identifier)) - ([]))) + (Statements))) diff --git a/test/fixtures/go/corpus/method-declarations.parseA.txt b/test/fixtures/go/corpus/method-declarations.parseA.txt index e50a11066..9fced1d8c 100644 --- a/test/fixtures/go/corpus/method-declarations.parseA.txt +++ b/test/fixtures/go/corpus/method-declarations.parseA.txt @@ -4,34 +4,34 @@ (Function (Empty) (Identifier) - ([]) - ([])) + (Statements) + (Statements)) (Method (Empty) (Identifier) (Identifier) - ([]) + (Statements) (Empty)) (Method - ( + (Statements (Identifier)) - ( + (Statements (Identifier) (Identifier)) (Identifier) - ( + (Statements (Identifier) (Identifier)) - ([])) + (Statements)) (Method - ( + (Statements (Identifier)) - ( + (Statements (Identifier) (Pointer (Identifier))) (Identifier) - ([]) + (Statements) (Return (Call (MemberAccess @@ -54,16 +54,16 @@ (Identifier)))) (Empty)))) (Method - ([]) - ( + (Statements) + (Statements (Identifier) (Pointer (Identifier))) (Identifier) - ( + (Statements (Identifier) (Identifier)) - ( + (Statements (Assignment (MemberAccess (Identifier) @@ -83,15 +83,15 @@ (Identifier)) (Identifier))))) (Method - ( + (Statements (Identifier)) - ( + (Statements (Identifier) (Pointer (Identifier))) (Identifier) - ( + (Statements (Identifier) (Identifier) (Identifier)) - ([]))) + (Statements))) diff --git a/test/fixtures/go/corpus/method-declarations.parseB.txt b/test/fixtures/go/corpus/method-declarations.parseB.txt index d1d7704b8..1185a4db2 100644 --- a/test/fixtures/go/corpus/method-declarations.parseB.txt +++ b/test/fixtures/go/corpus/method-declarations.parseB.txt @@ -4,34 +4,34 @@ (Function (Empty) (Identifier) - ([]) - ([])) + (Statements) + (Statements)) (Method (Empty) (Identifier) (Identifier) - ([]) + (Statements) (Empty)) (Method - ( + (Statements (Identifier)) - ( + (Statements (Identifier) (Identifier)) (Identifier) - ( + (Statements (Identifier) (Identifier)) - ([])) + (Statements)) (Method - ( + (Statements (Identifier)) - ( + (Statements (Identifier) (Pointer (Identifier))) (Identifier) - ([]) + (Statements) (Return (Call (MemberAccess @@ -44,7 +44,7 @@ (MemberAccess (Identifier) (Identifier)) - ( + (Statements (MemberAccess (Identifier) (Identifier)) @@ -57,7 +57,7 @@ (MemberAccess (Identifier) (Identifier)) - ( + (Statements (MemberAccess (Identifier) (Identifier)) @@ -68,16 +68,16 @@ (Identifier))) (Empty)))) (Method - ([]) - ( + (Statements) + (Statements (Identifier) (Pointer (Identifier))) (Identifier) - ( + (Statements (Identifier) (Identifier)) - ( + (Statements (Assignment (MemberAccess (Identifier) @@ -97,15 +97,15 @@ (Identifier)) (Identifier))))) (Method - ( + (Statements (Identifier)) - ( + (Statements (Identifier) (Pointer (Identifier))) (Identifier) - ( + (Statements (Identifier) (Identifier) (Identifier)) - ([]))) + (Statements))) diff --git a/test/fixtures/go/corpus/modifying-struct-fields.diffA-B.txt b/test/fixtures/go/corpus/modifying-struct-fields.diffA-B.txt index 62c3996ee..8f06d89dd 100644 --- a/test/fixtures/go/corpus/modifying-struct-fields.diffA-B.txt +++ b/test/fixtures/go/corpus/modifying-struct-fields.diffA-B.txt @@ -4,13 +4,13 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment (Identifier) (Reference (Composite (Identifier) - ( + (Statements (KeyValue { (Identifier) ->(Identifier) } diff --git a/test/fixtures/go/corpus/modifying-struct-fields.diffB-A.txt b/test/fixtures/go/corpus/modifying-struct-fields.diffB-A.txt index 8e85bfbbc..239eeee8e 100644 --- a/test/fixtures/go/corpus/modifying-struct-fields.diffB-A.txt +++ b/test/fixtures/go/corpus/modifying-struct-fields.diffB-A.txt @@ -4,13 +4,13 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment (Identifier) (Reference (Composite (Identifier) - ( + (Statements (KeyValue { (Identifier) ->(Identifier) } diff --git a/test/fixtures/go/corpus/modifying-struct-fields.parseA.txt b/test/fixtures/go/corpus/modifying-struct-fields.parseA.txt index 7db48260f..9a8d9a7e4 100644 --- a/test/fixtures/go/corpus/modifying-struct-fields.parseA.txt +++ b/test/fixtures/go/corpus/modifying-struct-fields.parseA.txt @@ -4,13 +4,13 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment (Identifier) (Reference (Composite (Identifier) - ( + (Statements (KeyValue (Identifier) (Identifier)))))))) diff --git a/test/fixtures/go/corpus/modifying-struct-fields.parseB.txt b/test/fixtures/go/corpus/modifying-struct-fields.parseB.txt index f3b7bff5d..79a74af4a 100644 --- a/test/fixtures/go/corpus/modifying-struct-fields.parseB.txt +++ b/test/fixtures/go/corpus/modifying-struct-fields.parseB.txt @@ -4,13 +4,13 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment (Identifier) (Reference (Composite (Identifier) - ( + (Statements (KeyValue (Identifier) (Call diff --git a/test/fixtures/go/corpus/parameter-declarations-with-types.diffA-B.txt b/test/fixtures/go/corpus/parameter-declarations-with-types.diffA-B.txt index 673ed5806..43e79de42 100644 --- a/test/fixtures/go/corpus/parameter-declarations-with-types.diffA-B.txt +++ b/test/fixtures/go/corpus/parameter-declarations-with-types.diffA-B.txt @@ -4,20 +4,20 @@ (Function (Empty) (Identifier) - ([]) - ([])) + (Statements) + (Statements)) (Function (Empty) (Identifier) - ( - ( + (Statements + (Statements { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) }) - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) })) - ([]))) + (Statements))) diff --git a/test/fixtures/go/corpus/parameter-declarations-with-types.diffB-A.txt b/test/fixtures/go/corpus/parameter-declarations-with-types.diffB-A.txt index 673ed5806..43e79de42 100644 --- a/test/fixtures/go/corpus/parameter-declarations-with-types.diffB-A.txt +++ b/test/fixtures/go/corpus/parameter-declarations-with-types.diffB-A.txt @@ -4,20 +4,20 @@ (Function (Empty) (Identifier) - ([]) - ([])) + (Statements) + (Statements)) (Function (Empty) (Identifier) - ( - ( + (Statements + (Statements { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) }) - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) })) - ([]))) + (Statements))) diff --git a/test/fixtures/go/corpus/parameter-declarations-with-types.parseA.txt b/test/fixtures/go/corpus/parameter-declarations-with-types.parseA.txt index 63501f187..dcbdb5c2b 100644 --- a/test/fixtures/go/corpus/parameter-declarations-with-types.parseA.txt +++ b/test/fixtures/go/corpus/parameter-declarations-with-types.parseA.txt @@ -4,16 +4,16 @@ (Function (Empty) (Identifier) - ([]) - ([])) + (Statements) + (Statements)) (Function (Empty) (Identifier) - ( - ( + (Statements + (Statements (Identifier) (Identifier)) - ( + (Statements (Identifier) (Identifier))) - ([]))) + (Statements))) diff --git a/test/fixtures/go/corpus/parameter-declarations-with-types.parseB.txt b/test/fixtures/go/corpus/parameter-declarations-with-types.parseB.txt index 63501f187..dcbdb5c2b 100644 --- a/test/fixtures/go/corpus/parameter-declarations-with-types.parseB.txt +++ b/test/fixtures/go/corpus/parameter-declarations-with-types.parseB.txt @@ -4,16 +4,16 @@ (Function (Empty) (Identifier) - ([]) - ([])) + (Statements) + (Statements)) (Function (Empty) (Identifier) - ( - ( + (Statements + (Statements (Identifier) (Identifier)) - ( + (Statements (Identifier) (Identifier))) - ([]))) + (Statements))) diff --git a/test/fixtures/go/corpus/pointer-types.diffA-B.txt b/test/fixtures/go/corpus/pointer-types.diffA-B.txt index 3497ebf29..15cb6604f 100644 --- a/test/fixtures/go/corpus/pointer-types.diffA-B.txt +++ b/test/fixtures/go/corpus/pointer-types.diffA-B.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Type (Identifier) (Pointer diff --git a/test/fixtures/go/corpus/pointer-types.diffB-A.txt b/test/fixtures/go/corpus/pointer-types.diffB-A.txt index 3497ebf29..15cb6604f 100644 --- a/test/fixtures/go/corpus/pointer-types.diffB-A.txt +++ b/test/fixtures/go/corpus/pointer-types.diffB-A.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Type (Identifier) (Pointer diff --git a/test/fixtures/go/corpus/pointer-types.parseA.txt b/test/fixtures/go/corpus/pointer-types.parseA.txt index 48e791de6..cd4e58bbf 100644 --- a/test/fixtures/go/corpus/pointer-types.parseA.txt +++ b/test/fixtures/go/corpus/pointer-types.parseA.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Type (Identifier) (Pointer diff --git a/test/fixtures/go/corpus/pointer-types.parseB.txt b/test/fixtures/go/corpus/pointer-types.parseB.txt index 48e791de6..cd4e58bbf 100644 --- a/test/fixtures/go/corpus/pointer-types.parseB.txt +++ b/test/fixtures/go/corpus/pointer-types.parseB.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Type (Identifier) (Pointer diff --git a/test/fixtures/go/corpus/qualified-types.diffA-B.txt b/test/fixtures/go/corpus/qualified-types.diffA-B.txt index 784a7dd3f..8ad11b154 100644 --- a/test/fixtures/go/corpus/qualified-types.diffA-B.txt +++ b/test/fixtures/go/corpus/qualified-types.diffA-B.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Type { (Identifier) ->(Identifier) } diff --git a/test/fixtures/go/corpus/qualified-types.diffB-A.txt b/test/fixtures/go/corpus/qualified-types.diffB-A.txt index 784a7dd3f..8ad11b154 100644 --- a/test/fixtures/go/corpus/qualified-types.diffB-A.txt +++ b/test/fixtures/go/corpus/qualified-types.diffB-A.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Type { (Identifier) ->(Identifier) } diff --git a/test/fixtures/go/corpus/qualified-types.parseA.txt b/test/fixtures/go/corpus/qualified-types.parseA.txt index 5c8495ebd..2659648a1 100644 --- a/test/fixtures/go/corpus/qualified-types.parseA.txt +++ b/test/fixtures/go/corpus/qualified-types.parseA.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Type (Identifier) (MemberAccess diff --git a/test/fixtures/go/corpus/qualified-types.parseB.txt b/test/fixtures/go/corpus/qualified-types.parseB.txt index 5c8495ebd..2659648a1 100644 --- a/test/fixtures/go/corpus/qualified-types.parseB.txt +++ b/test/fixtures/go/corpus/qualified-types.parseB.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Type (Identifier) (MemberAccess diff --git a/test/fixtures/go/corpus/rune-literals.diffA-B.txt b/test/fixtures/go/corpus/rune-literals.diffA-B.txt index 6c82ffa99..bf009a8d1 100644 --- a/test/fixtures/go/corpus/rune-literals.diffA-B.txt +++ b/test/fixtures/go/corpus/rune-literals.diffA-B.txt @@ -1,7 +1,7 @@ (Program (Package (Identifier)) - ( + (Statements (Assignment (Identifier) { (Rune) diff --git a/test/fixtures/go/corpus/rune-literals.diffB-A.txt b/test/fixtures/go/corpus/rune-literals.diffB-A.txt index 6c82ffa99..bf009a8d1 100644 --- a/test/fixtures/go/corpus/rune-literals.diffB-A.txt +++ b/test/fixtures/go/corpus/rune-literals.diffB-A.txt @@ -1,7 +1,7 @@ (Program (Package (Identifier)) - ( + (Statements (Assignment (Identifier) { (Rune) diff --git a/test/fixtures/go/corpus/rune-literals.parseA.txt b/test/fixtures/go/corpus/rune-literals.parseA.txt index 180677c60..90ad8d2dd 100644 --- a/test/fixtures/go/corpus/rune-literals.parseA.txt +++ b/test/fixtures/go/corpus/rune-literals.parseA.txt @@ -1,7 +1,7 @@ (Program (Package (Identifier)) - ( + (Statements (Assignment (Identifier) (Rune)) diff --git a/test/fixtures/go/corpus/rune-literals.parseB.txt b/test/fixtures/go/corpus/rune-literals.parseB.txt index 180677c60..90ad8d2dd 100644 --- a/test/fixtures/go/corpus/rune-literals.parseB.txt +++ b/test/fixtures/go/corpus/rune-literals.parseB.txt @@ -1,7 +1,7 @@ (Program (Package (Identifier)) - ( + (Statements (Assignment (Identifier) (Rune)) diff --git a/test/fixtures/go/corpus/select-statements.diffA-B.txt b/test/fixtures/go/corpus/select-statements.diffA-B.txt index 87681ac99..12ebaa2dd 100644 --- a/test/fixtures/go/corpus/select-statements.diffA-B.txt +++ b/test/fixtures/go/corpus/select-statements.diffA-B.txt @@ -4,10 +4,10 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Select - ( + (Statements (Pattern (Receive { (Identifier) @@ -38,7 +38,7 @@ { (Integer) ->(Integer) } (Empty)))) - ( + (Statements (Call (Identifier) (Integer) @@ -46,14 +46,14 @@ {+(PostIncrement {+(Identifier)+})+} {+(If - {+( + {+(Statements {+(Identifier)+})+} - {+( + {+(Statements {+(Send {+(Identifier)+} {+(Composite {+(Identifier)+} - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+})+})+} {+(Return @@ -62,14 +62,14 @@ {-(PostDecrement {-(Identifier)-})-} {-(If - {-( + {-(Statements {-(Identifier)-})-} - {-( + {-(Statements {-(Send {-(Identifier)-} {-(Composite {-(Identifier)-} - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-})-})-} {-(Return @@ -77,25 +77,25 @@ {-(Empty)-})-})) (Pattern (DefaultPattern - ([])) + (Statements)) (Return (Empty))))) (Select - ( + (Statements (Pattern (Receive (Empty) (ReceiveOperator { (Identifier) ->(Identifier) })) - ([])) + (Statements)) (Pattern (Receive (Empty) (ReceiveOperator (Identifier))) - ([])) + (Statements)) {-(Pattern {-(DefaultPattern - {-([])-})-} - {-([])-})-}))))) + {-(Statements)-})-} + {-(Statements)-})-}))))) diff --git a/test/fixtures/go/corpus/select-statements.diffB-A.txt b/test/fixtures/go/corpus/select-statements.diffB-A.txt index 565ac4a6b..e1fdedccb 100644 --- a/test/fixtures/go/corpus/select-statements.diffB-A.txt +++ b/test/fixtures/go/corpus/select-statements.diffB-A.txt @@ -4,10 +4,10 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Select - ( + (Statements (Pattern (Receive { (Identifier) @@ -38,7 +38,7 @@ { (Integer) ->(Integer) } (Empty)))) - ( + (Statements (Call (Identifier) (Integer) @@ -46,14 +46,14 @@ {+(PostDecrement {+(Identifier)+})+} {+(If - {+( + {+(Statements {+(Identifier)+})+} - {+( + {+(Statements {+(Send {+(Identifier)+} {+(Composite {+(Identifier)+} - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+})+})+} {+(Return @@ -62,14 +62,14 @@ {-(PostIncrement {-(Identifier)-})-} {-(If - {-( + {-(Statements {-(Identifier)-})-} - {-( + {-(Statements {-(Send {-(Identifier)-} {-(Composite {-(Identifier)-} - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-})-})-} {-(Return @@ -77,25 +77,25 @@ {-(Empty)-})-})) (Pattern (DefaultPattern - ([])) + (Statements)) (Return (Empty))))) (Select - ( + (Statements (Pattern (Receive (Empty) (ReceiveOperator { (Identifier) ->(Identifier) })) - ([])) + (Statements)) (Pattern (Receive (Empty) (ReceiveOperator (Identifier))) - ([])) + (Statements)) {+(Pattern {+(DefaultPattern - {+([])+})+} - {+([])+})+}))))) + {+(Statements)+})+} + {+(Statements)+})+}))))) diff --git a/test/fixtures/go/corpus/select-statements.parseA.txt b/test/fixtures/go/corpus/select-statements.parseA.txt index ec7db5725..7674928c7 100644 --- a/test/fixtures/go/corpus/select-statements.parseA.txt +++ b/test/fixtures/go/corpus/select-statements.parseA.txt @@ -4,10 +4,10 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Select - ( + (Statements (Pattern (Receive (Identifier) @@ -35,7 +35,7 @@ (Identifier)) (Integer) (Empty)))) - ( + (Statements (Call (Identifier) (Integer) @@ -43,14 +43,14 @@ (PostDecrement (Identifier)) (If - ( + (Statements (Identifier)) - ( + (Statements (Send (Identifier) (Composite (Identifier) - ( + (Statements (Identifier) (Identifier)))) (Return @@ -58,24 +58,24 @@ (Empty)))) (Pattern (DefaultPattern - ([])) + (Statements)) (Return (Empty))))) (Select - ( + (Statements (Pattern (Receive (Empty) (ReceiveOperator (Identifier))) - ([])) + (Statements)) (Pattern (Receive (Empty) (ReceiveOperator (Identifier))) - ([])) + (Statements)) (Pattern (DefaultPattern - ([])) - ([]))))))) + (Statements)) + (Statements))))))) diff --git a/test/fixtures/go/corpus/select-statements.parseB.txt b/test/fixtures/go/corpus/select-statements.parseB.txt index a7a341b50..e5ed101b4 100644 --- a/test/fixtures/go/corpus/select-statements.parseB.txt +++ b/test/fixtures/go/corpus/select-statements.parseB.txt @@ -4,10 +4,10 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Select - ( + (Statements (Pattern (Receive (Identifier) @@ -35,7 +35,7 @@ (Identifier)) (Integer) (Empty)))) - ( + (Statements (Call (Identifier) (Integer) @@ -43,14 +43,14 @@ (PostIncrement (Identifier)) (If - ( + (Statements (Identifier)) - ( + (Statements (Send (Identifier) (Composite (Identifier) - ( + (Statements (Identifier) (Identifier)))) (Return @@ -58,20 +58,20 @@ (Empty)))) (Pattern (DefaultPattern - ([])) + (Statements)) (Return (Empty))))) (Select - ( + (Statements (Pattern (Receive (Empty) (ReceiveOperator (Identifier))) - ([])) + (Statements)) (Pattern (Receive (Empty) (ReceiveOperator (Identifier))) - ([]))))))) + (Statements))))))) diff --git a/test/fixtures/go/corpus/selector-expressions.diffA-B.txt b/test/fixtures/go/corpus/selector-expressions.diffA-B.txt index 11ad10899..7930ef495 100644 --- a/test/fixtures/go/corpus/selector-expressions.diffA-B.txt +++ b/test/fixtures/go/corpus/selector-expressions.diffA-B.txt @@ -4,7 +4,7 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Call (MemberAccess (MemberAccess @@ -14,5 +14,5 @@ ->(Identifier) }) { (Identifier) ->(Identifier) }) - ([]) + (Statements) (Empty)))) diff --git a/test/fixtures/go/corpus/selector-expressions.diffB-A.txt b/test/fixtures/go/corpus/selector-expressions.diffB-A.txt index 11ad10899..7930ef495 100644 --- a/test/fixtures/go/corpus/selector-expressions.diffB-A.txt +++ b/test/fixtures/go/corpus/selector-expressions.diffB-A.txt @@ -4,7 +4,7 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Call (MemberAccess (MemberAccess @@ -14,5 +14,5 @@ ->(Identifier) }) { (Identifier) ->(Identifier) }) - ([]) + (Statements) (Empty)))) diff --git a/test/fixtures/go/corpus/selector-expressions.parseA.txt b/test/fixtures/go/corpus/selector-expressions.parseA.txt index 4970dc10b..6635631f2 100644 --- a/test/fixtures/go/corpus/selector-expressions.parseA.txt +++ b/test/fixtures/go/corpus/selector-expressions.parseA.txt @@ -4,12 +4,12 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Call (MemberAccess (MemberAccess (Identifier) (Identifier)) (Identifier)) - ([]) + (Statements) (Empty)))) diff --git a/test/fixtures/go/corpus/selector-expressions.parseB.txt b/test/fixtures/go/corpus/selector-expressions.parseB.txt index 4970dc10b..6635631f2 100644 --- a/test/fixtures/go/corpus/selector-expressions.parseB.txt +++ b/test/fixtures/go/corpus/selector-expressions.parseB.txt @@ -4,12 +4,12 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Call (MemberAccess (MemberAccess (Identifier) (Identifier)) (Identifier)) - ([]) + (Statements) (Empty)))) diff --git a/test/fixtures/go/corpus/send-statements.diffA-B.txt b/test/fixtures/go/corpus/send-statements.diffA-B.txt index 3cf96b18b..41e14f0e0 100644 --- a/test/fixtures/go/corpus/send-statements.diffA-B.txt +++ b/test/fixtures/go/corpus/send-statements.diffA-B.txt @@ -4,7 +4,7 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Send { (Identifier) ->(Identifier) } diff --git a/test/fixtures/go/corpus/send-statements.diffB-A.txt b/test/fixtures/go/corpus/send-statements.diffB-A.txt index 3cf96b18b..41e14f0e0 100644 --- a/test/fixtures/go/corpus/send-statements.diffB-A.txt +++ b/test/fixtures/go/corpus/send-statements.diffB-A.txt @@ -4,7 +4,7 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Send { (Identifier) ->(Identifier) } diff --git a/test/fixtures/go/corpus/send-statements.parseA.txt b/test/fixtures/go/corpus/send-statements.parseA.txt index fe49f874b..82d99394b 100644 --- a/test/fixtures/go/corpus/send-statements.parseA.txt +++ b/test/fixtures/go/corpus/send-statements.parseA.txt @@ -4,7 +4,7 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Send (Identifier) (Integer)))) diff --git a/test/fixtures/go/corpus/send-statements.parseB.txt b/test/fixtures/go/corpus/send-statements.parseB.txt index fe49f874b..82d99394b 100644 --- a/test/fixtures/go/corpus/send-statements.parseB.txt +++ b/test/fixtures/go/corpus/send-statements.parseB.txt @@ -4,7 +4,7 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Send (Identifier) (Integer)))) diff --git a/test/fixtures/go/corpus/short-var-declarations.diffA-B.txt b/test/fixtures/go/corpus/short-var-declarations.diffA-B.txt index 4ea66cfea..b7a258c18 100644 --- a/test/fixtures/go/corpus/short-var-declarations.diffA-B.txt +++ b/test/fixtures/go/corpus/short-var-declarations.diffA-B.txt @@ -4,14 +4,14 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) }) - ( + (Statements { (Integer) ->(Integer) } { (Integer) diff --git a/test/fixtures/go/corpus/short-var-declarations.diffB-A.txt b/test/fixtures/go/corpus/short-var-declarations.diffB-A.txt index 4ea66cfea..b7a258c18 100644 --- a/test/fixtures/go/corpus/short-var-declarations.diffB-A.txt +++ b/test/fixtures/go/corpus/short-var-declarations.diffB-A.txt @@ -4,14 +4,14 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) }) - ( + (Statements { (Integer) ->(Integer) } { (Integer) diff --git a/test/fixtures/go/corpus/short-var-declarations.parseA.txt b/test/fixtures/go/corpus/short-var-declarations.parseA.txt index ac7eb7599..bbacb990a 100644 --- a/test/fixtures/go/corpus/short-var-declarations.parseA.txt +++ b/test/fixtures/go/corpus/short-var-declarations.parseA.txt @@ -4,11 +4,11 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment - ( + (Statements (Identifier) (Identifier)) - ( + (Statements (Integer) (Integer))))) diff --git a/test/fixtures/go/corpus/short-var-declarations.parseB.txt b/test/fixtures/go/corpus/short-var-declarations.parseB.txt index ac7eb7599..bbacb990a 100644 --- a/test/fixtures/go/corpus/short-var-declarations.parseB.txt +++ b/test/fixtures/go/corpus/short-var-declarations.parseB.txt @@ -4,11 +4,11 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment - ( + (Statements (Identifier) (Identifier)) - ( + (Statements (Integer) (Integer))))) diff --git a/test/fixtures/go/corpus/single-import-declarations.diffA-B.txt b/test/fixtures/go/corpus/single-import-declarations.diffA-B.txt index 708a431ba..838735730 100644 --- a/test/fixtures/go/corpus/single-import-declarations.diffA-B.txt +++ b/test/fixtures/go/corpus/single-import-declarations.diffA-B.txt @@ -16,5 +16,5 @@ (Function (Empty) (Identifier) - ([]) - ([]))) + (Statements) + (Statements))) diff --git a/test/fixtures/go/corpus/single-import-declarations.diffB-A.txt b/test/fixtures/go/corpus/single-import-declarations.diffB-A.txt index 708a431ba..838735730 100644 --- a/test/fixtures/go/corpus/single-import-declarations.diffB-A.txt +++ b/test/fixtures/go/corpus/single-import-declarations.diffB-A.txt @@ -16,5 +16,5 @@ (Function (Empty) (Identifier) - ([]) - ([]))) + (Statements) + (Statements))) diff --git a/test/fixtures/go/corpus/single-import-declarations.parseA.txt b/test/fixtures/go/corpus/single-import-declarations.parseA.txt index 7e5f7cc1b..dc96d2e05 100644 --- a/test/fixtures/go/corpus/single-import-declarations.parseA.txt +++ b/test/fixtures/go/corpus/single-import-declarations.parseA.txt @@ -10,5 +10,5 @@ (Function (Empty) (Identifier) - ([]) - ([]))) + (Statements) + (Statements))) diff --git a/test/fixtures/go/corpus/single-import-declarations.parseB.txt b/test/fixtures/go/corpus/single-import-declarations.parseB.txt index 7e5f7cc1b..dc96d2e05 100644 --- a/test/fixtures/go/corpus/single-import-declarations.parseB.txt +++ b/test/fixtures/go/corpus/single-import-declarations.parseB.txt @@ -10,5 +10,5 @@ (Function (Empty) (Identifier) - ([]) - ([]))) + (Statements) + (Statements))) diff --git a/test/fixtures/go/corpus/single-line-function-declarations.diffA-B.txt b/test/fixtures/go/corpus/single-line-function-declarations.diffA-B.txt index 3f4cf0364..f18abdfa2 100644 --- a/test/fixtures/go/corpus/single-line-function-declarations.diffA-B.txt +++ b/test/fixtures/go/corpus/single-line-function-declarations.diffA-B.txt @@ -4,42 +4,42 @@ (Function (Empty) (Identifier) - ([]) - ([])) + (Statements) + (Statements)) (Function (Empty) { (Identifier) ->(Identifier) } - ([]) + (Statements) (Call (Identifier) - ([]) + (Statements) (Empty))) (Function (Empty) { (Identifier) ->(Identifier) } - ([]) - ( + (Statements) + (Statements (Call (Identifier) - ([]) + (Statements) (Empty)) (Call (Identifier) - ([]) + (Statements) (Empty)))) (Function (Empty) { (Identifier) ->(Identifier) } - ([]) - ( + (Statements) + (Statements (Call (Identifier) - ([]) + (Statements) (Empty)) (Call (Identifier) - ([]) + (Statements) (Empty))))) diff --git a/test/fixtures/go/corpus/single-line-function-declarations.diffB-A.txt b/test/fixtures/go/corpus/single-line-function-declarations.diffB-A.txt index 3f4cf0364..f18abdfa2 100644 --- a/test/fixtures/go/corpus/single-line-function-declarations.diffB-A.txt +++ b/test/fixtures/go/corpus/single-line-function-declarations.diffB-A.txt @@ -4,42 +4,42 @@ (Function (Empty) (Identifier) - ([]) - ([])) + (Statements) + (Statements)) (Function (Empty) { (Identifier) ->(Identifier) } - ([]) + (Statements) (Call (Identifier) - ([]) + (Statements) (Empty))) (Function (Empty) { (Identifier) ->(Identifier) } - ([]) - ( + (Statements) + (Statements (Call (Identifier) - ([]) + (Statements) (Empty)) (Call (Identifier) - ([]) + (Statements) (Empty)))) (Function (Empty) { (Identifier) ->(Identifier) } - ([]) - ( + (Statements) + (Statements (Call (Identifier) - ([]) + (Statements) (Empty)) (Call (Identifier) - ([]) + (Statements) (Empty))))) diff --git a/test/fixtures/go/corpus/single-line-function-declarations.parseA.txt b/test/fixtures/go/corpus/single-line-function-declarations.parseA.txt index 5040892e4..d7e7e69ec 100644 --- a/test/fixtures/go/corpus/single-line-function-declarations.parseA.txt +++ b/test/fixtures/go/corpus/single-line-function-declarations.parseA.txt @@ -4,39 +4,39 @@ (Function (Empty) (Identifier) - ([]) - ([])) + (Statements) + (Statements)) (Function (Empty) (Identifier) - ([]) + (Statements) (Call (Identifier) - ([]) + (Statements) (Empty))) (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Call (Identifier) - ([]) + (Statements) (Empty)) (Call (Identifier) - ([]) + (Statements) (Empty)))) (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Call (Identifier) - ([]) + (Statements) (Empty)) (Call (Identifier) - ([]) + (Statements) (Empty))))) diff --git a/test/fixtures/go/corpus/single-line-function-declarations.parseB.txt b/test/fixtures/go/corpus/single-line-function-declarations.parseB.txt index 5040892e4..d7e7e69ec 100644 --- a/test/fixtures/go/corpus/single-line-function-declarations.parseB.txt +++ b/test/fixtures/go/corpus/single-line-function-declarations.parseB.txt @@ -4,39 +4,39 @@ (Function (Empty) (Identifier) - ([]) - ([])) + (Statements) + (Statements)) (Function (Empty) (Identifier) - ([]) + (Statements) (Call (Identifier) - ([]) + (Statements) (Empty))) (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Call (Identifier) - ([]) + (Statements) (Empty)) (Call (Identifier) - ([]) + (Statements) (Empty)))) (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Call (Identifier) - ([]) + (Statements) (Empty)) (Call (Identifier) - ([]) + (Statements) (Empty))))) diff --git a/test/fixtures/go/corpus/slice-expressions.diffA-B.txt b/test/fixtures/go/corpus/slice-expressions.diffA-B.txt index 8307a41d4..afdd3980e 100644 --- a/test/fixtures/go/corpus/slice-expressions.diffA-B.txt +++ b/test/fixtures/go/corpus/slice-expressions.diffA-B.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Slice (Identifier) { (Integer) diff --git a/test/fixtures/go/corpus/slice-expressions.diffB-A.txt b/test/fixtures/go/corpus/slice-expressions.diffB-A.txt index 1a7a99db8..0f1c22f17 100644 --- a/test/fixtures/go/corpus/slice-expressions.diffB-A.txt +++ b/test/fixtures/go/corpus/slice-expressions.diffB-A.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Slice (Identifier) { (Integer) diff --git a/test/fixtures/go/corpus/slice-expressions.parseA.txt b/test/fixtures/go/corpus/slice-expressions.parseA.txt index d9eaae91c..b7271293b 100644 --- a/test/fixtures/go/corpus/slice-expressions.parseA.txt +++ b/test/fixtures/go/corpus/slice-expressions.parseA.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Slice (Identifier) (Integer) diff --git a/test/fixtures/go/corpus/slice-expressions.parseB.txt b/test/fixtures/go/corpus/slice-expressions.parseB.txt index b00c0ccee..5b69a0f3c 100644 --- a/test/fixtures/go/corpus/slice-expressions.parseB.txt +++ b/test/fixtures/go/corpus/slice-expressions.parseB.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Slice (Identifier) (Integer) diff --git a/test/fixtures/go/corpus/slice-literals.diffA-B.txt b/test/fixtures/go/corpus/slice-literals.diffA-B.txt index 5ce5551f4..f0dd4b87f 100644 --- a/test/fixtures/go/corpus/slice-literals.diffA-B.txt +++ b/test/fixtures/go/corpus/slice-literals.diffA-B.txt @@ -4,21 +4,21 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) (Composite (Slice (Identifier)) - ( + (Statements {+(TextElement)+}))) (Assignment (Identifier) (Composite (Slice (Identifier)) - ( + (Statements { (TextElement) ->(TextElement) }))) (Assignment @@ -26,7 +26,7 @@ (Composite (Slice (Identifier)) - ( + (Statements { (TextElement) ->(TextElement) } { (TextElement) diff --git a/test/fixtures/go/corpus/slice-literals.diffB-A.txt b/test/fixtures/go/corpus/slice-literals.diffB-A.txt index 03b13cc4f..221351ea1 100644 --- a/test/fixtures/go/corpus/slice-literals.diffB-A.txt +++ b/test/fixtures/go/corpus/slice-literals.diffB-A.txt @@ -4,20 +4,21 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) (Composite (Slice (Identifier)) - ({-(TextElement)-}))) + (Statements + {-(TextElement)-}))) (Assignment (Identifier) (Composite (Slice (Identifier)) - ( + (Statements { (TextElement) ->(TextElement) }))) (Assignment @@ -25,7 +26,7 @@ (Composite (Slice (Identifier)) - ( + (Statements { (TextElement) ->(TextElement) } { (TextElement) diff --git a/test/fixtures/go/corpus/slice-literals.parseA.txt b/test/fixtures/go/corpus/slice-literals.parseA.txt index 620dca48d..9434a9460 100644 --- a/test/fixtures/go/corpus/slice-literals.parseA.txt +++ b/test/fixtures/go/corpus/slice-literals.parseA.txt @@ -4,26 +4,26 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) (Composite (Slice (Identifier)) - ([]))) + (Statements))) (Assignment (Identifier) (Composite (Slice (Identifier)) - ( + (Statements (TextElement)))) (Assignment (Identifier) (Composite (Slice (Identifier)) - ( + (Statements (TextElement) (TextElement))))))) diff --git a/test/fixtures/go/corpus/slice-literals.parseB.txt b/test/fixtures/go/corpus/slice-literals.parseB.txt index eae07dd5d..c9e74f4fc 100644 --- a/test/fixtures/go/corpus/slice-literals.parseB.txt +++ b/test/fixtures/go/corpus/slice-literals.parseB.txt @@ -4,27 +4,27 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) (Composite (Slice (Identifier)) - ( + (Statements (TextElement)))) (Assignment (Identifier) (Composite (Slice (Identifier)) - ( + (Statements (TextElement)))) (Assignment (Identifier) (Composite (Slice (Identifier)) - ( + (Statements (TextElement) (TextElement))))))) diff --git a/test/fixtures/go/corpus/slice-types.diffA-B.txt b/test/fixtures/go/corpus/slice-types.diffA-B.txt index 966dd0e14..f546172ad 100644 --- a/test/fixtures/go/corpus/slice-types.diffA-B.txt +++ b/test/fixtures/go/corpus/slice-types.diffA-B.txt @@ -4,16 +4,16 @@ (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Type (Identifier) (Slice { (Identifier) ->(Slice {+(Identifier)+}) }))) - ( + (Statements (Type (Identifier) (Slice diff --git a/test/fixtures/go/corpus/slice-types.diffB-A.txt b/test/fixtures/go/corpus/slice-types.diffB-A.txt index 06278c610..2686dc34a 100644 --- a/test/fixtures/go/corpus/slice-types.diffB-A.txt +++ b/test/fixtures/go/corpus/slice-types.diffB-A.txt @@ -4,16 +4,16 @@ (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Type (Identifier) (Slice { (Slice {-(Identifier)-}) ->(Identifier) }))) - ( + (Statements (Type (Identifier) (Slice diff --git a/test/fixtures/go/corpus/slice-types.parseA.txt b/test/fixtures/go/corpus/slice-types.parseA.txt index 93cddcbbe..bbed0bb87 100644 --- a/test/fixtures/go/corpus/slice-types.parseA.txt +++ b/test/fixtures/go/corpus/slice-types.parseA.txt @@ -4,14 +4,14 @@ (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Type (Identifier) (Slice (Identifier)))) - ( + (Statements (Type (Identifier) (Slice diff --git a/test/fixtures/go/corpus/slice-types.parseB.txt b/test/fixtures/go/corpus/slice-types.parseB.txt index a3763ecde..5573c3321 100644 --- a/test/fixtures/go/corpus/slice-types.parseB.txt +++ b/test/fixtures/go/corpus/slice-types.parseB.txt @@ -4,15 +4,15 @@ (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Type (Identifier) (Slice (Slice (Identifier))))) - ( + (Statements (Type (Identifier) (Slice diff --git a/test/fixtures/go/corpus/string-literals.diffA-B.txt b/test/fixtures/go/corpus/string-literals.diffA-B.txt index 53d365c92..1046acf29 100644 --- a/test/fixtures/go/corpus/string-literals.diffA-B.txt +++ b/test/fixtures/go/corpus/string-literals.diffA-B.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) { (TextElement) diff --git a/test/fixtures/go/corpus/string-literals.diffB-A.txt b/test/fixtures/go/corpus/string-literals.diffB-A.txt index 53d365c92..1046acf29 100644 --- a/test/fixtures/go/corpus/string-literals.diffB-A.txt +++ b/test/fixtures/go/corpus/string-literals.diffB-A.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) { (TextElement) diff --git a/test/fixtures/go/corpus/string-literals.parseA.txt b/test/fixtures/go/corpus/string-literals.parseA.txt index f3a68c9c6..9f0a2a1b2 100644 --- a/test/fixtures/go/corpus/string-literals.parseA.txt +++ b/test/fixtures/go/corpus/string-literals.parseA.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) (TextElement)) diff --git a/test/fixtures/go/corpus/string-literals.parseB.txt b/test/fixtures/go/corpus/string-literals.parseB.txt index f3a68c9c6..9f0a2a1b2 100644 --- a/test/fixtures/go/corpus/string-literals.parseB.txt +++ b/test/fixtures/go/corpus/string-literals.parseB.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) (TextElement)) diff --git a/test/fixtures/go/corpus/struct-field-declarations.diffA-B.txt b/test/fixtures/go/corpus/struct-field-declarations.diffA-B.txt index ac17285aa..cbc6a9a3b 100644 --- a/test/fixtures/go/corpus/struct-field-declarations.diffA-B.txt +++ b/test/fixtures/go/corpus/struct-field-declarations.diffA-B.txt @@ -4,15 +4,15 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Type (Identifier) (Constructor (Empty) (Field (Identifier) - ( + (Statements { (Identifier) ->(Identifier) } {+(Identifier)+}))))))) diff --git a/test/fixtures/go/corpus/struct-field-declarations.diffB-A.txt b/test/fixtures/go/corpus/struct-field-declarations.diffB-A.txt index 9dc3c0f9a..94db2fd9f 100644 --- a/test/fixtures/go/corpus/struct-field-declarations.diffB-A.txt +++ b/test/fixtures/go/corpus/struct-field-declarations.diffB-A.txt @@ -4,15 +4,15 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Type (Identifier) (Constructor (Empty) (Field (Identifier) - ( + (Statements { (Identifier) ->(Identifier) } {-(Identifier)-}))))))) diff --git a/test/fixtures/go/corpus/struct-field-declarations.parseA.txt b/test/fixtures/go/corpus/struct-field-declarations.parseA.txt index ad90da591..405ca456d 100644 --- a/test/fixtures/go/corpus/struct-field-declarations.parseA.txt +++ b/test/fixtures/go/corpus/struct-field-declarations.parseA.txt @@ -4,13 +4,13 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Type (Identifier) (Constructor (Empty) (Field (Identifier) - ( + (Statements (Identifier)))))))) diff --git a/test/fixtures/go/corpus/struct-field-declarations.parseB.txt b/test/fixtures/go/corpus/struct-field-declarations.parseB.txt index 46a242423..42235b5b4 100644 --- a/test/fixtures/go/corpus/struct-field-declarations.parseB.txt +++ b/test/fixtures/go/corpus/struct-field-declarations.parseB.txt @@ -4,14 +4,14 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Type (Identifier) (Constructor (Empty) (Field (Identifier) - ( + (Statements (Identifier) (Identifier)))))))) diff --git a/test/fixtures/go/corpus/struct-literals.diffA-B.txt b/test/fixtures/go/corpus/struct-literals.diffA-B.txt index 5013d8da4..7b90f5a0e 100644 --- a/test/fixtures/go/corpus/struct-literals.diffA-B.txt +++ b/test/fixtures/go/corpus/struct-literals.diffA-B.txt @@ -4,14 +4,14 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) (Composite { (Identifier) ->(Identifier) } - ( + (Statements (KeyValue (Identifier) (TextElement)) @@ -26,9 +26,9 @@ (Field { (Identifier) ->(Identifier) } - ( + (Statements (Identifier)))) - ( + (Statements (KeyValue { (Identifier) ->(Identifier) } @@ -41,4 +41,4 @@ (Identifier) { (Identifier) ->(Identifier) }) - ([])))))) + (Statements)))))) diff --git a/test/fixtures/go/corpus/struct-literals.diffB-A.txt b/test/fixtures/go/corpus/struct-literals.diffB-A.txt index 5013d8da4..7b90f5a0e 100644 --- a/test/fixtures/go/corpus/struct-literals.diffB-A.txt +++ b/test/fixtures/go/corpus/struct-literals.diffB-A.txt @@ -4,14 +4,14 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) (Composite { (Identifier) ->(Identifier) } - ( + (Statements (KeyValue (Identifier) (TextElement)) @@ -26,9 +26,9 @@ (Field { (Identifier) ->(Identifier) } - ( + (Statements (Identifier)))) - ( + (Statements (KeyValue { (Identifier) ->(Identifier) } @@ -41,4 +41,4 @@ (Identifier) { (Identifier) ->(Identifier) }) - ([])))))) + (Statements)))))) diff --git a/test/fixtures/go/corpus/struct-literals.parseA.txt b/test/fixtures/go/corpus/struct-literals.parseA.txt index f2df790f7..e8f5c9e73 100644 --- a/test/fixtures/go/corpus/struct-literals.parseA.txt +++ b/test/fixtures/go/corpus/struct-literals.parseA.txt @@ -4,13 +4,13 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) (Composite (Identifier) - ( + (Statements (KeyValue (Identifier) (TextElement)) @@ -24,9 +24,9 @@ (Empty) (Field (Identifier) - ( + (Statements (Identifier)))) - ( + (Statements (KeyValue (Identifier) (Integer))))) @@ -36,4 +36,4 @@ (MemberAccess (Identifier) (Identifier)) - ([])))))) + (Statements)))))) diff --git a/test/fixtures/go/corpus/struct-literals.parseB.txt b/test/fixtures/go/corpus/struct-literals.parseB.txt index f2df790f7..e8f5c9e73 100644 --- a/test/fixtures/go/corpus/struct-literals.parseB.txt +++ b/test/fixtures/go/corpus/struct-literals.parseB.txt @@ -4,13 +4,13 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Identifier) (Composite (Identifier) - ( + (Statements (KeyValue (Identifier) (TextElement)) @@ -24,9 +24,9 @@ (Empty) (Field (Identifier) - ( + (Statements (Identifier)))) - ( + (Statements (KeyValue (Identifier) (Integer))))) @@ -36,4 +36,4 @@ (MemberAccess (Identifier) (Identifier)) - ([])))))) + (Statements)))))) diff --git a/test/fixtures/go/corpus/struct-types.diffA-B.txt b/test/fixtures/go/corpus/struct-types.diffA-B.txt index 91dc8b9bf..1861a7c71 100644 --- a/test/fixtures/go/corpus/struct-types.diffA-B.txt +++ b/test/fixtures/go/corpus/struct-types.diffA-B.txt @@ -4,16 +4,16 @@ (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Type { (Identifier) ->(Identifier) } (Constructor (Empty) - ([])))) - ( + (Statements)))) + (Statements (Type { (Identifier) ->(Identifier) } @@ -21,8 +21,8 @@ (Empty) (Field (Identifier) - ([]))))) - ( + (Statements))))) + (Statements (Type { (Identifier) ->(Identifier) } @@ -30,23 +30,23 @@ (Empty) (Field (Identifier) - ( + (Statements (Identifier) (Identifier)))))) - ( + (Statements (Type { (Identifier) ->(Identifier) } (Constructor (Empty) - ( + (Statements (Field - ( + (Statements (MemberAccess (Identifier) (Identifier)))) (Field (Identifier) (TextElement) - ( + (Statements (Identifier)))))))))) diff --git a/test/fixtures/go/corpus/struct-types.diffB-A.txt b/test/fixtures/go/corpus/struct-types.diffB-A.txt index 91dc8b9bf..1861a7c71 100644 --- a/test/fixtures/go/corpus/struct-types.diffB-A.txt +++ b/test/fixtures/go/corpus/struct-types.diffB-A.txt @@ -4,16 +4,16 @@ (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Type { (Identifier) ->(Identifier) } (Constructor (Empty) - ([])))) - ( + (Statements)))) + (Statements (Type { (Identifier) ->(Identifier) } @@ -21,8 +21,8 @@ (Empty) (Field (Identifier) - ([]))))) - ( + (Statements))))) + (Statements (Type { (Identifier) ->(Identifier) } @@ -30,23 +30,23 @@ (Empty) (Field (Identifier) - ( + (Statements (Identifier) (Identifier)))))) - ( + (Statements (Type { (Identifier) ->(Identifier) } (Constructor (Empty) - ( + (Statements (Field - ( + (Statements (MemberAccess (Identifier) (Identifier)))) (Field (Identifier) (TextElement) - ( + (Statements (Identifier)))))))))) diff --git a/test/fixtures/go/corpus/struct-types.parseA.txt b/test/fixtures/go/corpus/struct-types.parseA.txt index 992beeb54..7abd634c1 100644 --- a/test/fixtures/go/corpus/struct-types.parseA.txt +++ b/test/fixtures/go/corpus/struct-types.parseA.txt @@ -4,45 +4,45 @@ (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Type (Identifier) (Constructor (Empty) - ([])))) - ( + (Statements)))) + (Statements (Type (Identifier) (Constructor (Empty) (Field (Identifier) - ([]))))) - ( + (Statements))))) + (Statements (Type (Identifier) (Constructor (Empty) (Field (Identifier) - ( + (Statements (Identifier) (Identifier)))))) - ( + (Statements (Type (Identifier) (Constructor (Empty) - ( + (Statements (Field - ( + (Statements (MemberAccess (Identifier) (Identifier)))) (Field (Identifier) (TextElement) - ( + (Statements (Identifier)))))))))) diff --git a/test/fixtures/go/corpus/struct-types.parseB.txt b/test/fixtures/go/corpus/struct-types.parseB.txt index 992beeb54..7abd634c1 100644 --- a/test/fixtures/go/corpus/struct-types.parseB.txt +++ b/test/fixtures/go/corpus/struct-types.parseB.txt @@ -4,45 +4,45 @@ (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Type (Identifier) (Constructor (Empty) - ([])))) - ( + (Statements)))) + (Statements (Type (Identifier) (Constructor (Empty) (Field (Identifier) - ([]))))) - ( + (Statements))))) + (Statements (Type (Identifier) (Constructor (Empty) (Field (Identifier) - ( + (Statements (Identifier) (Identifier)))))) - ( + (Statements (Type (Identifier) (Constructor (Empty) - ( + (Statements (Field - ( + (Statements (MemberAccess (Identifier) (Identifier)))) (Field (Identifier) (TextElement) - ( + (Statements (Identifier)))))))))) diff --git a/test/fixtures/go/corpus/switch-statements.diffA-B.txt b/test/fixtures/go/corpus/switch-statements.diffA-B.txt index f64cd3be8..599316453 100644 --- a/test/fixtures/go/corpus/switch-statements.diffA-B.txt +++ b/test/fixtures/go/corpus/switch-statements.diffA-B.txt @@ -4,10 +4,10 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Match - ([]) - ( + (Statements) + (Statements (Pattern (LessThan { (Identifier) @@ -16,7 +16,7 @@ ->(Identifier) }) (Call (Identifier) - ([]) + (Statements) (Empty))) {+(Pattern {+(LessThan @@ -24,7 +24,7 @@ {+(Identifier)+})+} {+(Call {+(Identifier)+} - {+([])+} + {+(Statements)+} {+(Empty)+})+})+} {+(Pattern {+(Equal @@ -32,7 +32,7 @@ {+(Integer)+})+} {+(Call {+(Identifier)+} - {+([])+} + {+(Statements)+} {+(Empty)+})+})+} {-(Pattern {-(LessThan @@ -42,7 +42,7 @@ {-(Comment)-} {-(Call {-(Identifier)-} - {-([])-} + {-(Statements)-} {-(Empty)-})-})-})-} {-(Context {-(Comment)-} @@ -52,5 +52,5 @@ {-(Integer)-})-} {-(Call {-(Identifier)-} - {-([])-} + {-(Statements)-} {-(Empty)-})-})-})-})))) diff --git a/test/fixtures/go/corpus/switch-statements.diffB-A.txt b/test/fixtures/go/corpus/switch-statements.diffB-A.txt index bb02af14b..99347a9a8 100644 --- a/test/fixtures/go/corpus/switch-statements.diffB-A.txt +++ b/test/fixtures/go/corpus/switch-statements.diffB-A.txt @@ -4,10 +4,10 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Match - ([]) - ( + (Statements) + (Statements (Pattern (LessThan { (Identifier) @@ -16,7 +16,7 @@ ->(Identifier) }) (Call (Identifier) - ([]) + (Statements) (Empty))) {+(Pattern {+(LessThan @@ -26,7 +26,7 @@ {+(Comment)+} {+(Call {+(Identifier)+} - {+([])+} + {+(Statements)+} {+(Empty)+})+})+})+} {+(Context {+(Comment)+} @@ -40,7 +40,7 @@ (Call { (Identifier) ->(Identifier) } - ([]) + (Statements) (Empty))))+} {-(Pattern {-(Equal @@ -48,5 +48,5 @@ {-(Integer)-})-} {-(Call {-(Identifier)-} - {-([])-} + {-(Statements)-} {-(Empty)-})-})-})))) diff --git a/test/fixtures/go/corpus/switch-statements.parseA.txt b/test/fixtures/go/corpus/switch-statements.parseA.txt index 987e3b538..ecd260c88 100644 --- a/test/fixtures/go/corpus/switch-statements.parseA.txt +++ b/test/fixtures/go/corpus/switch-statements.parseA.txt @@ -4,17 +4,17 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Match - ([]) - ( + (Statements) + (Statements (Pattern (LessThan (Identifier) (Identifier)) (Call (Identifier) - ([]) + (Statements) (Empty))) (Pattern (LessThan @@ -24,7 +24,7 @@ (Comment) (Call (Identifier) - ([]) + (Statements) (Empty)))) (Context (Comment) @@ -34,5 +34,5 @@ (Integer)) (Call (Identifier) - ([]) + (Statements) (Empty)))))))) diff --git a/test/fixtures/go/corpus/switch-statements.parseB.txt b/test/fixtures/go/corpus/switch-statements.parseB.txt index bc7b21c50..5b18abbb1 100644 --- a/test/fixtures/go/corpus/switch-statements.parseB.txt +++ b/test/fixtures/go/corpus/switch-statements.parseB.txt @@ -4,17 +4,17 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Match - ([]) - ( + (Statements) + (Statements (Pattern (LessThan (Identifier) (Identifier)) (Call (Identifier) - ([]) + (Statements) (Empty))) (Pattern (LessThan @@ -22,7 +22,7 @@ (Identifier)) (Call (Identifier) - ([]) + (Statements) (Empty))) (Pattern (Equal @@ -30,5 +30,5 @@ (Integer)) (Call (Identifier) - ([]) + (Statements) (Empty))))))) diff --git a/test/fixtures/go/corpus/type-aliases.diffA-B.txt b/test/fixtures/go/corpus/type-aliases.diffA-B.txt index 880222665..8e8ad3ef7 100644 --- a/test/fixtures/go/corpus/type-aliases.diffA-B.txt +++ b/test/fixtures/go/corpus/type-aliases.diffA-B.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (TypeAlias { (Identifier) ->(Identifier) } diff --git a/test/fixtures/go/corpus/type-aliases.diffB-A.txt b/test/fixtures/go/corpus/type-aliases.diffB-A.txt index 880222665..8e8ad3ef7 100644 --- a/test/fixtures/go/corpus/type-aliases.diffB-A.txt +++ b/test/fixtures/go/corpus/type-aliases.diffB-A.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (TypeAlias { (Identifier) ->(Identifier) } diff --git a/test/fixtures/go/corpus/type-aliases.parseA.txt b/test/fixtures/go/corpus/type-aliases.parseA.txt index 93e9fca3c..a8036faee 100644 --- a/test/fixtures/go/corpus/type-aliases.parseA.txt +++ b/test/fixtures/go/corpus/type-aliases.parseA.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (TypeAlias (Identifier) (Slice diff --git a/test/fixtures/go/corpus/type-aliases.parseB.txt b/test/fixtures/go/corpus/type-aliases.parseB.txt index 93e9fca3c..a8036faee 100644 --- a/test/fixtures/go/corpus/type-aliases.parseB.txt +++ b/test/fixtures/go/corpus/type-aliases.parseB.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (TypeAlias (Identifier) (Slice diff --git a/test/fixtures/go/corpus/type-assertion-expressions.diffA-B.txt b/test/fixtures/go/corpus/type-assertion-expressions.diffA-B.txt index 147c06c4d..55b905eb6 100644 --- a/test/fixtures/go/corpus/type-assertion-expressions.diffA-B.txt +++ b/test/fixtures/go/corpus/type-assertion-expressions.diffA-B.txt @@ -4,7 +4,7 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (TypeAssertion { (Identifier) ->(Identifier) } diff --git a/test/fixtures/go/corpus/type-assertion-expressions.diffB-A.txt b/test/fixtures/go/corpus/type-assertion-expressions.diffB-A.txt index 147c06c4d..55b905eb6 100644 --- a/test/fixtures/go/corpus/type-assertion-expressions.diffB-A.txt +++ b/test/fixtures/go/corpus/type-assertion-expressions.diffB-A.txt @@ -4,7 +4,7 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (TypeAssertion { (Identifier) ->(Identifier) } diff --git a/test/fixtures/go/corpus/type-assertion-expressions.parseA.txt b/test/fixtures/go/corpus/type-assertion-expressions.parseA.txt index 258a6ee23..2b9a80548 100644 --- a/test/fixtures/go/corpus/type-assertion-expressions.parseA.txt +++ b/test/fixtures/go/corpus/type-assertion-expressions.parseA.txt @@ -4,7 +4,7 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (TypeAssertion (Identifier) (MemberAccess diff --git a/test/fixtures/go/corpus/type-assertion-expressions.parseB.txt b/test/fixtures/go/corpus/type-assertion-expressions.parseB.txt index 258a6ee23..2b9a80548 100644 --- a/test/fixtures/go/corpus/type-assertion-expressions.parseB.txt +++ b/test/fixtures/go/corpus/type-assertion-expressions.parseB.txt @@ -4,7 +4,7 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (TypeAssertion (Identifier) (MemberAccess diff --git a/test/fixtures/go/corpus/type-conversion-expressions.diffA-B.txt b/test/fixtures/go/corpus/type-conversion-expressions.diffA-B.txt index 842fc63b1..bf3f4ef5a 100644 --- a/test/fixtures/go/corpus/type-conversion-expressions.diffA-B.txt +++ b/test/fixtures/go/corpus/type-conversion-expressions.diffA-B.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Pointer (Call (Identifier) @@ -31,27 +31,27 @@ ->(Identifier) }) (TypeConversion (Function - ([]) + (Statements) (Empty)) { (Identifier) ->(Identifier) }) (TypeConversion (Parenthesized (Function - ([]) + (Statements) (Empty))) { (Identifier) ->(Identifier) }) (TypeConversion (Parenthesized (Function - ([]) + (Statements) (Identifier))) { (Identifier) ->(Identifier) }) (TypeConversion (Function - ([]) + (Statements) (Identifier)) { (Identifier) ->(Identifier) }) diff --git a/test/fixtures/go/corpus/type-conversion-expressions.diffB-A.txt b/test/fixtures/go/corpus/type-conversion-expressions.diffB-A.txt index 842fc63b1..bf3f4ef5a 100644 --- a/test/fixtures/go/corpus/type-conversion-expressions.diffB-A.txt +++ b/test/fixtures/go/corpus/type-conversion-expressions.diffB-A.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Pointer (Call (Identifier) @@ -31,27 +31,27 @@ ->(Identifier) }) (TypeConversion (Function - ([]) + (Statements) (Empty)) { (Identifier) ->(Identifier) }) (TypeConversion (Parenthesized (Function - ([]) + (Statements) (Empty))) { (Identifier) ->(Identifier) }) (TypeConversion (Parenthesized (Function - ([]) + (Statements) (Identifier))) { (Identifier) ->(Identifier) }) (TypeConversion (Function - ([]) + (Statements) (Identifier)) { (Identifier) ->(Identifier) }) diff --git a/test/fixtures/go/corpus/type-conversion-expressions.parseA.txt b/test/fixtures/go/corpus/type-conversion-expressions.parseA.txt index 65591da46..5d85a36ae 100644 --- a/test/fixtures/go/corpus/type-conversion-expressions.parseA.txt +++ b/test/fixtures/go/corpus/type-conversion-expressions.parseA.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Pointer (Call (Identifier) @@ -27,24 +27,24 @@ (Identifier)) (TypeConversion (Function - ([]) + (Statements) (Empty)) (Identifier)) (TypeConversion (Parenthesized (Function - ([]) + (Statements) (Empty))) (Identifier)) (TypeConversion (Parenthesized (Function - ([]) + (Statements) (Identifier))) (Identifier)) (TypeConversion (Function - ([]) + (Statements) (Identifier)) (Identifier)) (TypeConversion diff --git a/test/fixtures/go/corpus/type-conversion-expressions.parseB.txt b/test/fixtures/go/corpus/type-conversion-expressions.parseB.txt index 65591da46..5d85a36ae 100644 --- a/test/fixtures/go/corpus/type-conversion-expressions.parseB.txt +++ b/test/fixtures/go/corpus/type-conversion-expressions.parseB.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Pointer (Call (Identifier) @@ -27,24 +27,24 @@ (Identifier)) (TypeConversion (Function - ([]) + (Statements) (Empty)) (Identifier)) (TypeConversion (Parenthesized (Function - ([]) + (Statements) (Empty))) (Identifier)) (TypeConversion (Parenthesized (Function - ([]) + (Statements) (Identifier))) (Identifier)) (TypeConversion (Function - ([]) + (Statements) (Identifier)) (Identifier)) (TypeConversion diff --git a/test/fixtures/go/corpus/type-declarations.diffA-B.txt b/test/fixtures/go/corpus/type-declarations.diffA-B.txt index 49febe748..5b29285f2 100644 --- a/test/fixtures/go/corpus/type-declarations.diffA-B.txt +++ b/test/fixtures/go/corpus/type-declarations.diffA-B.txt @@ -4,15 +4,15 @@ (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Type { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) })) - ( + (Statements (Type { (Identifier) ->(Identifier) } @@ -23,7 +23,7 @@ ->(Identifier) } { (Identifier) ->(Identifier) })) - ( + (Statements (Context (Comment) (Type @@ -31,24 +31,24 @@ ->(Identifier) } (Constructor (Empty) - ( + (Statements (Field (Identifier) - ( + (Statements (Identifier))) (Field (Identifier) - ( + (Statements (Identifier))) (Field (Identifier) - ( + (Statements (Identifier))))))) (Type { (Identifier) ->(Identifier) } (Interface - ([]))) + (Statements))) (Context (Comment) (Empty)))))) diff --git a/test/fixtures/go/corpus/type-declarations.diffB-A.txt b/test/fixtures/go/corpus/type-declarations.diffB-A.txt index 49febe748..5b29285f2 100644 --- a/test/fixtures/go/corpus/type-declarations.diffB-A.txt +++ b/test/fixtures/go/corpus/type-declarations.diffB-A.txt @@ -4,15 +4,15 @@ (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Type { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) })) - ( + (Statements (Type { (Identifier) ->(Identifier) } @@ -23,7 +23,7 @@ ->(Identifier) } { (Identifier) ->(Identifier) })) - ( + (Statements (Context (Comment) (Type @@ -31,24 +31,24 @@ ->(Identifier) } (Constructor (Empty) - ( + (Statements (Field (Identifier) - ( + (Statements (Identifier))) (Field (Identifier) - ( + (Statements (Identifier))) (Field (Identifier) - ( + (Statements (Identifier))))))) (Type { (Identifier) ->(Identifier) } (Interface - ([]))) + (Statements))) (Context (Comment) (Empty)))))) diff --git a/test/fixtures/go/corpus/type-declarations.parseA.txt b/test/fixtures/go/corpus/type-declarations.parseA.txt index e663d8172..48b9b35ed 100644 --- a/test/fixtures/go/corpus/type-declarations.parseA.txt +++ b/test/fixtures/go/corpus/type-declarations.parseA.txt @@ -4,43 +4,43 @@ (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Type (Identifier) (Identifier))) - ( + (Statements (Type (Identifier) (Identifier)) (Type (Identifier) (Identifier))) - ( + (Statements (Context (Comment) (Type (Identifier) (Constructor (Empty) - ( + (Statements (Field (Identifier) - ( + (Statements (Identifier))) (Field (Identifier) - ( + (Statements (Identifier))) (Field (Identifier) - ( + (Statements (Identifier))))))) (Type (Identifier) (Interface - ([]))) + (Statements))) (Context (Comment) (Empty)))))) diff --git a/test/fixtures/go/corpus/type-declarations.parseB.txt b/test/fixtures/go/corpus/type-declarations.parseB.txt index e663d8172..48b9b35ed 100644 --- a/test/fixtures/go/corpus/type-declarations.parseB.txt +++ b/test/fixtures/go/corpus/type-declarations.parseB.txt @@ -4,43 +4,43 @@ (Function (Empty) (Identifier) - ([]) - ( - ( + (Statements) + (Statements + (Statements (Type (Identifier) (Identifier))) - ( + (Statements (Type (Identifier) (Identifier)) (Type (Identifier) (Identifier))) - ( + (Statements (Context (Comment) (Type (Identifier) (Constructor (Empty) - ( + (Statements (Field (Identifier) - ( + (Statements (Identifier))) (Field (Identifier) - ( + (Statements (Identifier))) (Field (Identifier) - ( + (Statements (Identifier))))))) (Type (Identifier) (Interface - ([]))) + (Statements))) (Context (Comment) (Empty)))))) diff --git a/test/fixtures/go/corpus/type-switch-statements.diffA-B.txt b/test/fixtures/go/corpus/type-switch-statements.diffA-B.txt index 4eb71a89b..f4e2d27ae 100644 --- a/test/fixtures/go/corpus/type-switch-statements.diffA-B.txt +++ b/test/fixtures/go/corpus/type-switch-statements.diffA-B.txt @@ -4,10 +4,10 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (TypeSwitch - ( + (Statements (Assignment { (Identifier) ->(Identifier) } @@ -16,15 +16,15 @@ (TypeSwitchGuard { (Identifier) ->(Identifier) })) - ( + (Statements (Pattern - ( + (Statements (Identifier) (Pointer (MemberAccess (Identifier) (Identifier)))) - ([])) + (Statements)) (Context (Comment) (Pattern @@ -32,7 +32,7 @@ (Identifier)) (Call (Identifier) - ([]) + (Statements) (Empty)))) (Pattern (Pointer @@ -41,18 +41,18 @@ (Empty))) {+(Pattern {+(DefaultPattern - {+([])+})+} + {+(Statements)+})+} {+(Break {+(Empty)+})+})+})) (TypeSwitch - ( + (Statements (TypeSwitchGuard - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) }))) - ( + (Statements (Pattern { (Identifier) ->(Identifier) } @@ -60,7 +60,7 @@ (MemberAccess (Identifier) (Identifier)) - ( + (Statements { (TextElement) ->(TextElement) } { (Times @@ -77,7 +77,7 @@ (MemberAccess (Identifier) (Identifier)) - ( + (Statements { (TextElement) ->(TextElement) } { (DividedBy @@ -89,7 +89,7 @@ (Empty))) (Pattern (Identifier) - ( + (Statements (Assignment { (Identifier) ->(Identifier) } @@ -104,7 +104,7 @@ (MemberAccess (Identifier) (Identifier)) - ( + (Statements (TextElement) (Plus (Slice @@ -124,13 +124,13 @@ (Empty)))) (Pattern (DefaultPattern - ([])) - ([])))) + (Statements)) + (Statements)))) (TypeSwitch (Empty) - ( + (Statements (TypeSwitchGuard - ( + (Statements (Identifier) { (Identifier) ->(Identifier) })) diff --git a/test/fixtures/go/corpus/type-switch-statements.diffB-A.txt b/test/fixtures/go/corpus/type-switch-statements.diffB-A.txt index 5a6bda542..cfb3afcfd 100644 --- a/test/fixtures/go/corpus/type-switch-statements.diffB-A.txt +++ b/test/fixtures/go/corpus/type-switch-statements.diffB-A.txt @@ -4,10 +4,10 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (TypeSwitch - ( + (Statements (Assignment { (Identifier) ->(Identifier) } @@ -16,15 +16,15 @@ (TypeSwitchGuard { (Identifier) ->(Identifier) })) - ( + (Statements (Pattern - ( + (Statements (Identifier) (Pointer (MemberAccess (Identifier) (Identifier)))) - ([])) + (Statements)) (Context (Comment) (Pattern @@ -32,7 +32,7 @@ (Identifier)) (Call (Identifier) - ([]) + (Statements) (Empty)))) (Pattern (Pointer @@ -41,18 +41,18 @@ (Empty))) {-(Pattern {-(DefaultPattern - {-([])-})-} + {-(Statements)-})-} {-(Break {-(Empty)-})-})-})) (TypeSwitch - ( + (Statements (TypeSwitchGuard - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) }))) - ( + (Statements (Pattern { (Identifier) ->(Identifier) } @@ -60,7 +60,7 @@ (MemberAccess (Identifier) (Identifier)) - ( + (Statements { (TextElement) ->(TextElement) } { (DividedBy @@ -77,7 +77,7 @@ (MemberAccess (Identifier) (Identifier)) - ( + (Statements { (TextElement) ->(TextElement) } { (Times @@ -89,7 +89,7 @@ (Empty))) (Pattern (Identifier) - ( + (Statements (Assignment { (Identifier) ->(Identifier) } @@ -104,7 +104,7 @@ (MemberAccess (Identifier) (Identifier)) - ( + (Statements (TextElement) (Plus (Slice @@ -124,13 +124,13 @@ (Empty)))) (Pattern (DefaultPattern - ([])) - ([])))) + (Statements)) + (Statements)))) (TypeSwitch (Empty) - ( + (Statements (TypeSwitchGuard - ( + (Statements (Identifier) { (Identifier) ->(Identifier) })) diff --git a/test/fixtures/go/corpus/type-switch-statements.parseA.txt b/test/fixtures/go/corpus/type-switch-statements.parseA.txt index 95bb86176..e3d29707a 100644 --- a/test/fixtures/go/corpus/type-switch-statements.parseA.txt +++ b/test/fixtures/go/corpus/type-switch-statements.parseA.txt @@ -4,24 +4,24 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (TypeSwitch - ( + (Statements (Assignment (Identifier) (Identifier)) (TypeSwitchGuard (Identifier))) - ( + (Statements (Pattern - ( + (Statements (Identifier) (Pointer (MemberAccess (Identifier) (Identifier)))) - ([])) + (Statements)) (Context (Comment) (Pattern @@ -29,7 +29,7 @@ (Identifier)) (Call (Identifier) - ([]) + (Statements) (Empty)))) (Pattern (Pointer @@ -37,19 +37,19 @@ (Break (Empty))))) (TypeSwitch - ( + (Statements (TypeSwitchGuard - ( + (Statements (Identifier) (Identifier)))) - ( + (Statements (Pattern (Identifier) (Call (MemberAccess (Identifier) (Identifier)) - ( + (Statements (TextElement) (Times (Identifier) @@ -61,7 +61,7 @@ (MemberAccess (Identifier) (Identifier)) - ( + (Statements (TextElement) (DividedBy (Integer) @@ -69,7 +69,7 @@ (Empty))) (Pattern (Identifier) - ( + (Statements (Assignment (Identifier) (DividedBy @@ -82,7 +82,7 @@ (MemberAccess (Identifier) (Identifier)) - ( + (Statements (TextElement) (Plus (Slice @@ -98,13 +98,13 @@ (Empty)))) (Pattern (DefaultPattern - ([])) - ([])))) + (Statements)) + (Statements)))) (TypeSwitch (Empty) - ( + (Statements (TypeSwitchGuard - ( + (Statements (Identifier) (Identifier))) (Context diff --git a/test/fixtures/go/corpus/type-switch-statements.parseB.txt b/test/fixtures/go/corpus/type-switch-statements.parseB.txt index 765e00fee..28ff0d9fa 100644 --- a/test/fixtures/go/corpus/type-switch-statements.parseB.txt +++ b/test/fixtures/go/corpus/type-switch-statements.parseB.txt @@ -4,24 +4,24 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (TypeSwitch - ( + (Statements (Assignment (Identifier) (Identifier)) (TypeSwitchGuard (Identifier))) - ( + (Statements (Pattern - ( + (Statements (Identifier) (Pointer (MemberAccess (Identifier) (Identifier)))) - ([])) + (Statements)) (Context (Comment) (Pattern @@ -29,7 +29,7 @@ (Identifier)) (Call (Identifier) - ([]) + (Statements) (Empty)))) (Pattern (Pointer @@ -38,23 +38,23 @@ (Empty))) (Pattern (DefaultPattern - ([])) + (Statements)) (Break (Empty))))) (TypeSwitch - ( + (Statements (TypeSwitchGuard - ( + (Statements (Identifier) (Identifier)))) - ( + (Statements (Pattern (Identifier) (Call (MemberAccess (Identifier) (Identifier)) - ( + (Statements (TextElement) (DividedBy (Integer) @@ -66,7 +66,7 @@ (MemberAccess (Identifier) (Identifier)) - ( + (Statements (TextElement) (Times (Identifier) @@ -74,7 +74,7 @@ (Empty))) (Pattern (Identifier) - ( + (Statements (Assignment (Identifier) (DividedBy @@ -87,7 +87,7 @@ (MemberAccess (Identifier) (Identifier)) - ( + (Statements (TextElement) (Plus (Slice @@ -103,13 +103,13 @@ (Empty)))) (Pattern (DefaultPattern - ([])) - ([])))) + (Statements)) + (Statements)))) (TypeSwitch (Empty) - ( + (Statements (TypeSwitchGuard - ( + (Statements (Identifier) (Identifier))) (Context diff --git a/test/fixtures/go/corpus/unary-expressions.diffA-B.txt b/test/fixtures/go/corpus/unary-expressions.diffA-B.txt index 755b66ffd..6aab2877a 100644 --- a/test/fixtures/go/corpus/unary-expressions.diffA-B.txt +++ b/test/fixtures/go/corpus/unary-expressions.diffA-B.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements { (Identifier) ->(Identifier) } (Negate @@ -19,7 +19,7 @@ (Call { (Identifier) ->(Identifier) } - ([]) + (Statements) (Empty))) (Complement { (Identifier) diff --git a/test/fixtures/go/corpus/unary-expressions.diffB-A.txt b/test/fixtures/go/corpus/unary-expressions.diffB-A.txt index 755b66ffd..6aab2877a 100644 --- a/test/fixtures/go/corpus/unary-expressions.diffB-A.txt +++ b/test/fixtures/go/corpus/unary-expressions.diffB-A.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements { (Identifier) ->(Identifier) } (Negate @@ -19,7 +19,7 @@ (Call { (Identifier) ->(Identifier) } - ([]) + (Statements) (Empty))) (Complement { (Identifier) diff --git a/test/fixtures/go/corpus/unary-expressions.parseA.txt b/test/fixtures/go/corpus/unary-expressions.parseA.txt index 9d88c4f54..a2e7539b7 100644 --- a/test/fixtures/go/corpus/unary-expressions.parseA.txt +++ b/test/fixtures/go/corpus/unary-expressions.parseA.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Identifier) (Negate (Identifier)) @@ -15,7 +15,7 @@ (Pointer (Call (Identifier) - ([]) + (Statements) (Empty))) (Complement (Identifier)) diff --git a/test/fixtures/go/corpus/unary-expressions.parseB.txt b/test/fixtures/go/corpus/unary-expressions.parseB.txt index 9d88c4f54..a2e7539b7 100644 --- a/test/fixtures/go/corpus/unary-expressions.parseB.txt +++ b/test/fixtures/go/corpus/unary-expressions.parseB.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Identifier) (Negate (Identifier)) @@ -15,7 +15,7 @@ (Pointer (Call (Identifier) - ([]) + (Statements) (Empty))) (Complement (Identifier)) diff --git a/test/fixtures/go/corpus/var-declarations-with-no-expressions.diffA-B.txt b/test/fixtures/go/corpus/var-declarations-with-no-expressions.diffA-B.txt index ea0b92855..be19067c9 100644 --- a/test/fixtures/go/corpus/var-declarations-with-no-expressions.diffA-B.txt +++ b/test/fixtures/go/corpus/var-declarations-with-no-expressions.diffA-B.txt @@ -4,21 +4,21 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Annotation - ( + (Statements { (Identifier) ->(Identifier) }) (Identifier)) - ([])) + (Statements)) (Assignment (Annotation - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) }) (Identifier)) - ([]))))) + (Statements))))) diff --git a/test/fixtures/go/corpus/var-declarations-with-no-expressions.diffB-A.txt b/test/fixtures/go/corpus/var-declarations-with-no-expressions.diffB-A.txt index ea0b92855..be19067c9 100644 --- a/test/fixtures/go/corpus/var-declarations-with-no-expressions.diffB-A.txt +++ b/test/fixtures/go/corpus/var-declarations-with-no-expressions.diffB-A.txt @@ -4,21 +4,21 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Annotation - ( + (Statements { (Identifier) ->(Identifier) }) (Identifier)) - ([])) + (Statements)) (Assignment (Annotation - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) }) (Identifier)) - ([]))))) + (Statements))))) diff --git a/test/fixtures/go/corpus/var-declarations-with-no-expressions.parseA.txt b/test/fixtures/go/corpus/var-declarations-with-no-expressions.parseA.txt index 7fa95fd6b..11418eaae 100644 --- a/test/fixtures/go/corpus/var-declarations-with-no-expressions.parseA.txt +++ b/test/fixtures/go/corpus/var-declarations-with-no-expressions.parseA.txt @@ -4,18 +4,18 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Annotation - ( + (Statements (Identifier)) (Identifier)) - ([])) + (Statements)) (Assignment (Annotation - ( + (Statements (Identifier) (Identifier)) (Identifier)) - ([]))))) + (Statements))))) diff --git a/test/fixtures/go/corpus/var-declarations-with-no-expressions.parseB.txt b/test/fixtures/go/corpus/var-declarations-with-no-expressions.parseB.txt index 7fa95fd6b..11418eaae 100644 --- a/test/fixtures/go/corpus/var-declarations-with-no-expressions.parseB.txt +++ b/test/fixtures/go/corpus/var-declarations-with-no-expressions.parseB.txt @@ -4,18 +4,18 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Annotation - ( + (Statements (Identifier)) (Identifier)) - ([])) + (Statements)) (Assignment (Annotation - ( + (Statements (Identifier) (Identifier)) (Identifier)) - ([]))))) + (Statements))))) diff --git a/test/fixtures/go/corpus/var-declarations-with-types.diffA-B.txt b/test/fixtures/go/corpus/var-declarations-with-types.diffA-B.txt index aee121c85..a54f8d86c 100644 --- a/test/fixtures/go/corpus/var-declarations-with-types.diffA-B.txt +++ b/test/fixtures/go/corpus/var-declarations-with-types.diffA-B.txt @@ -4,23 +4,23 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Annotation - ( + (Statements { (Identifier) ->(Identifier) }) (Identifier)) (Integer)) (Assignment (Annotation - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) }) (Identifier)) - ( + (Statements (Integer) (Integer)))))) diff --git a/test/fixtures/go/corpus/var-declarations-with-types.diffB-A.txt b/test/fixtures/go/corpus/var-declarations-with-types.diffB-A.txt index aee121c85..a54f8d86c 100644 --- a/test/fixtures/go/corpus/var-declarations-with-types.diffB-A.txt +++ b/test/fixtures/go/corpus/var-declarations-with-types.diffB-A.txt @@ -4,23 +4,23 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Annotation - ( + (Statements { (Identifier) ->(Identifier) }) (Identifier)) (Integer)) (Assignment (Annotation - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) ->(Identifier) }) (Identifier)) - ( + (Statements (Integer) (Integer)))))) diff --git a/test/fixtures/go/corpus/var-declarations-with-types.parseA.txt b/test/fixtures/go/corpus/var-declarations-with-types.parseA.txt index abf186d40..9118982be 100644 --- a/test/fixtures/go/corpus/var-declarations-with-types.parseA.txt +++ b/test/fixtures/go/corpus/var-declarations-with-types.parseA.txt @@ -4,20 +4,20 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Annotation - ( + (Statements (Identifier)) (Identifier)) (Integer)) (Assignment (Annotation - ( + (Statements (Identifier) (Identifier)) (Identifier)) - ( + (Statements (Integer) (Integer)))))) diff --git a/test/fixtures/go/corpus/var-declarations-with-types.parseB.txt b/test/fixtures/go/corpus/var-declarations-with-types.parseB.txt index abf186d40..9118982be 100644 --- a/test/fixtures/go/corpus/var-declarations-with-types.parseB.txt +++ b/test/fixtures/go/corpus/var-declarations-with-types.parseB.txt @@ -4,20 +4,20 @@ (Function (Empty) (Identifier) - ([]) - ( + (Statements) + (Statements (Assignment (Annotation - ( + (Statements (Identifier)) (Identifier)) (Integer)) (Assignment (Annotation - ( + (Statements (Identifier) (Identifier)) (Identifier)) - ( + (Statements (Integer) (Integer)))))) diff --git a/test/fixtures/go/corpus/var-declarations-without-types.diffA-B.txt b/test/fixtures/go/corpus/var-declarations-without-types.diffA-B.txt index e1320a947..2d984aebb 100644 --- a/test/fixtures/go/corpus/var-declarations-without-types.diffA-B.txt +++ b/test/fixtures/go/corpus/var-declarations-without-types.diffA-B.txt @@ -4,13 +4,13 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment { (Identifier) - ->( + ->(Statements {+(Identifier)+} {+(Identifier)+}) } { (Integer) - ->( + ->(Statements {+(Integer)+} {+(Integer)+}) }))) diff --git a/test/fixtures/go/corpus/var-declarations-without-types.diffB-A.txt b/test/fixtures/go/corpus/var-declarations-without-types.diffB-A.txt index 6d0e73d9d..06f1fa789 100644 --- a/test/fixtures/go/corpus/var-declarations-without-types.diffB-A.txt +++ b/test/fixtures/go/corpus/var-declarations-without-types.diffB-A.txt @@ -4,13 +4,13 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment - { ( + { (Statements {-(Identifier)-} {-(Identifier)-}) ->(Identifier) } - { ( + { (Statements {-(Integer)-} {-(Integer)-}) ->(Integer) }))) diff --git a/test/fixtures/go/corpus/var-declarations-without-types.parseA.txt b/test/fixtures/go/corpus/var-declarations-without-types.parseA.txt index 9d343e9ba..d49580f45 100644 --- a/test/fixtures/go/corpus/var-declarations-without-types.parseA.txt +++ b/test/fixtures/go/corpus/var-declarations-without-types.parseA.txt @@ -4,7 +4,7 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment (Identifier) (Integer)))) diff --git a/test/fixtures/go/corpus/var-declarations-without-types.parseB.txt b/test/fixtures/go/corpus/var-declarations-without-types.parseB.txt index ac7eb7599..bbacb990a 100644 --- a/test/fixtures/go/corpus/var-declarations-without-types.parseB.txt +++ b/test/fixtures/go/corpus/var-declarations-without-types.parseB.txt @@ -4,11 +4,11 @@ (Function (Empty) (Identifier) - ([]) + (Statements) (Assignment - ( + (Statements (Identifier) (Identifier)) - ( + (Statements (Integer) (Integer))))) diff --git a/test/fixtures/go/corpus/variadic-function-declarations.diffA-B.txt b/test/fixtures/go/corpus/variadic-function-declarations.diffA-B.txt index 55d85d88f..06b29737e 100644 --- a/test/fixtures/go/corpus/variadic-function-declarations.diffA-B.txt +++ b/test/fixtures/go/corpus/variadic-function-declarations.diffA-B.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ([])) + (Statements) + (Statements)) (Function (Empty) { (Identifier) @@ -14,7 +14,7 @@ (Pointer (Identifier)) (Identifier)) - ([])) + (Statements)) (Function (Empty) { (Identifier) @@ -22,15 +22,15 @@ (Variadic (Identifier) (Empty)) - ([])) + (Statements)) (Function (Empty) { (Identifier) ->(Identifier) } - ( - ( + (Statements + (Statements (Identifier)) (Variadic (Identifier) (Empty))) - ([]))) + (Statements))) diff --git a/test/fixtures/go/corpus/variadic-function-declarations.diffB-A.txt b/test/fixtures/go/corpus/variadic-function-declarations.diffB-A.txt index 55d85d88f..06b29737e 100644 --- a/test/fixtures/go/corpus/variadic-function-declarations.diffB-A.txt +++ b/test/fixtures/go/corpus/variadic-function-declarations.diffB-A.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ([])) + (Statements) + (Statements)) (Function (Empty) { (Identifier) @@ -14,7 +14,7 @@ (Pointer (Identifier)) (Identifier)) - ([])) + (Statements)) (Function (Empty) { (Identifier) @@ -22,15 +22,15 @@ (Variadic (Identifier) (Empty)) - ([])) + (Statements)) (Function (Empty) { (Identifier) ->(Identifier) } - ( - ( + (Statements + (Statements (Identifier)) (Variadic (Identifier) (Empty))) - ([]))) + (Statements))) diff --git a/test/fixtures/go/corpus/variadic-function-declarations.parseA.txt b/test/fixtures/go/corpus/variadic-function-declarations.parseA.txt index a19e52973..0ab7e414e 100644 --- a/test/fixtures/go/corpus/variadic-function-declarations.parseA.txt +++ b/test/fixtures/go/corpus/variadic-function-declarations.parseA.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ([])) + (Statements) + (Statements)) (Function (Empty) (Identifier) @@ -13,21 +13,21 @@ (Pointer (Identifier)) (Identifier)) - ([])) + (Statements)) (Function (Empty) (Identifier) (Variadic (Identifier) (Empty)) - ([])) + (Statements)) (Function (Empty) (Identifier) - ( - ( + (Statements + (Statements (Identifier)) (Variadic (Identifier) (Empty))) - ([]))) + (Statements))) diff --git a/test/fixtures/go/corpus/variadic-function-declarations.parseB.txt b/test/fixtures/go/corpus/variadic-function-declarations.parseB.txt index a19e52973..0ab7e414e 100644 --- a/test/fixtures/go/corpus/variadic-function-declarations.parseB.txt +++ b/test/fixtures/go/corpus/variadic-function-declarations.parseB.txt @@ -4,8 +4,8 @@ (Function (Empty) (Identifier) - ([]) - ([])) + (Statements) + (Statements)) (Function (Empty) (Identifier) @@ -13,21 +13,21 @@ (Pointer (Identifier)) (Identifier)) - ([])) + (Statements)) (Function (Empty) (Identifier) (Variadic (Identifier) (Empty)) - ([])) + (Statements)) (Function (Empty) (Identifier) - ( - ( + (Statements + (Statements (Identifier)) (Variadic (Identifier) (Empty))) - ([]))) + (Statements))) diff --git a/test/fixtures/javascript/corpus/anonymous-function.diffA-B.txt b/test/fixtures/javascript/corpus/anonymous-function.diffA-B.txt index 7d647cf4c..a413f45aa 100644 --- a/test/fixtures/javascript/corpus/anonymous-function.diffA-B.txt +++ b/test/fixtures/javascript/corpus/anonymous-function.diffA-B.txt @@ -24,7 +24,7 @@ {+(Assignment {+(Identifier)+} {+(Empty)+})+})+} - ( + (Statements (Return { (Plus {-(Identifier)-} diff --git a/test/fixtures/javascript/corpus/anonymous-function.diffB-A.txt b/test/fixtures/javascript/corpus/anonymous-function.diffB-A.txt index 378fb36fa..14e2117e6 100644 --- a/test/fixtures/javascript/corpus/anonymous-function.diffB-A.txt +++ b/test/fixtures/javascript/corpus/anonymous-function.diffB-A.txt @@ -24,7 +24,7 @@ {-(Assignment {-(Identifier)-} {-(Empty)-})-})-} - ( + (Statements (Return { (Times {-(Identifier)-} diff --git a/test/fixtures/javascript/corpus/anonymous-function.parseA.txt b/test/fixtures/javascript/corpus/anonymous-function.parseA.txt index b16aad149..410fa0126 100644 --- a/test/fixtures/javascript/corpus/anonymous-function.parseA.txt +++ b/test/fixtures/javascript/corpus/anonymous-function.parseA.txt @@ -17,7 +17,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Plus (Identifier) diff --git a/test/fixtures/javascript/corpus/anonymous-function.parseB.txt b/test/fixtures/javascript/corpus/anonymous-function.parseB.txt index a04c5cd22..f4cf6bbd8 100644 --- a/test/fixtures/javascript/corpus/anonymous-function.parseB.txt +++ b/test/fixtures/javascript/corpus/anonymous-function.parseB.txt @@ -17,7 +17,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Times (Identifier) diff --git a/test/fixtures/javascript/corpus/anonymous-parameterless-function.diffA-B.txt b/test/fixtures/javascript/corpus/anonymous-parameterless-function.diffA-B.txt index b2b1fd3d9..33fc55d49 100644 --- a/test/fixtures/javascript/corpus/anonymous-parameterless-function.diffA-B.txt +++ b/test/fixtures/javascript/corpus/anonymous-parameterless-function.diffA-B.txt @@ -3,7 +3,7 @@ (Empty) (Empty) (Empty) - ( + (Statements (Return { (TextElement) ->(TextElement) })))) diff --git a/test/fixtures/javascript/corpus/anonymous-parameterless-function.diffB-A.txt b/test/fixtures/javascript/corpus/anonymous-parameterless-function.diffB-A.txt index b2b1fd3d9..33fc55d49 100644 --- a/test/fixtures/javascript/corpus/anonymous-parameterless-function.diffB-A.txt +++ b/test/fixtures/javascript/corpus/anonymous-parameterless-function.diffB-A.txt @@ -3,7 +3,7 @@ (Empty) (Empty) (Empty) - ( + (Statements (Return { (TextElement) ->(TextElement) })))) diff --git a/test/fixtures/javascript/corpus/anonymous-parameterless-function.parseA.txt b/test/fixtures/javascript/corpus/anonymous-parameterless-function.parseA.txt index 84537c07d..bb24b8ce4 100644 --- a/test/fixtures/javascript/corpus/anonymous-parameterless-function.parseA.txt +++ b/test/fixtures/javascript/corpus/anonymous-parameterless-function.parseA.txt @@ -3,6 +3,6 @@ (Empty) (Empty) (Empty) - ( + (Statements (Return (TextElement))))) diff --git a/test/fixtures/javascript/corpus/anonymous-parameterless-function.parseB.txt b/test/fixtures/javascript/corpus/anonymous-parameterless-function.parseB.txt index 84537c07d..bb24b8ce4 100644 --- a/test/fixtures/javascript/corpus/anonymous-parameterless-function.parseB.txt +++ b/test/fixtures/javascript/corpus/anonymous-parameterless-function.parseB.txt @@ -3,6 +3,6 @@ (Empty) (Empty) (Empty) - ( + (Statements (Return (TextElement))))) diff --git a/test/fixtures/javascript/corpus/arrow-function.diffA-B.txt b/test/fixtures/javascript/corpus/arrow-function.diffA-B.txt index 1edf8182d..600b385ff 100644 --- a/test/fixtures/javascript/corpus/arrow-function.diffA-B.txt +++ b/test/fixtures/javascript/corpus/arrow-function.diffA-B.txt @@ -17,7 +17,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return { (Identifier) ->(Identifier) })))) diff --git a/test/fixtures/javascript/corpus/arrow-function.diffB-A.txt b/test/fixtures/javascript/corpus/arrow-function.diffB-A.txt index 1edf8182d..600b385ff 100644 --- a/test/fixtures/javascript/corpus/arrow-function.diffB-A.txt +++ b/test/fixtures/javascript/corpus/arrow-function.diffB-A.txt @@ -17,7 +17,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return { (Identifier) ->(Identifier) })))) diff --git a/test/fixtures/javascript/corpus/arrow-function.parseA.txt b/test/fixtures/javascript/corpus/arrow-function.parseA.txt index 1bced8e40..e178c9e7c 100644 --- a/test/fixtures/javascript/corpus/arrow-function.parseA.txt +++ b/test/fixtures/javascript/corpus/arrow-function.parseA.txt @@ -17,6 +17,6 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Identifier))))) diff --git a/test/fixtures/javascript/corpus/arrow-function.parseB.txt b/test/fixtures/javascript/corpus/arrow-function.parseB.txt index 1bced8e40..e178c9e7c 100644 --- a/test/fixtures/javascript/corpus/arrow-function.parseB.txt +++ b/test/fixtures/javascript/corpus/arrow-function.parseB.txt @@ -17,6 +17,6 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Identifier))))) diff --git a/test/fixtures/javascript/corpus/break.diffA-B.txt b/test/fixtures/javascript/corpus/break.diffA-B.txt index eff385027..46eb71902 100644 --- a/test/fixtures/javascript/corpus/break.diffA-B.txt +++ b/test/fixtures/javascript/corpus/break.diffA-B.txt @@ -8,12 +8,12 @@ (Float)) (Update (Identifier)) - ( + (Statements (If (StrictEqual (Identifier) (Float)) - ( + (Statements {+(Continue {+(Empty)+})+} {-(Break diff --git a/test/fixtures/javascript/corpus/break.diffB-A.txt b/test/fixtures/javascript/corpus/break.diffB-A.txt index 745ef1761..44e6c7bdc 100644 --- a/test/fixtures/javascript/corpus/break.diffB-A.txt +++ b/test/fixtures/javascript/corpus/break.diffB-A.txt @@ -8,12 +8,12 @@ (Float)) (Update (Identifier)) - ( + (Statements (If (StrictEqual (Identifier) (Float)) - ( + (Statements {+(Break {+(Empty)+})+} {-(Continue diff --git a/test/fixtures/javascript/corpus/break.parseA.txt b/test/fixtures/javascript/corpus/break.parseA.txt index e927cd94c..c0af1c973 100644 --- a/test/fixtures/javascript/corpus/break.parseA.txt +++ b/test/fixtures/javascript/corpus/break.parseA.txt @@ -8,12 +8,12 @@ (Float)) (Update (Identifier)) - ( + (Statements (If (StrictEqual (Identifier) (Float)) - ( + (Statements (Break (Empty))) (Empty)) diff --git a/test/fixtures/javascript/corpus/break.parseB.txt b/test/fixtures/javascript/corpus/break.parseB.txt index 9618a22b5..0c30ef033 100644 --- a/test/fixtures/javascript/corpus/break.parseB.txt +++ b/test/fixtures/javascript/corpus/break.parseB.txt @@ -8,12 +8,12 @@ (Float)) (Update (Identifier)) - ( + (Statements (If (StrictEqual (Identifier) (Float)) - ( + (Statements (Continue (Empty))) (Empty)) diff --git a/test/fixtures/javascript/corpus/chained-callbacks.diffA-B.txt b/test/fixtures/javascript/corpus/chained-callbacks.diffA-B.txt index f88bc58c9..ba36adf30 100644 --- a/test/fixtures/javascript/corpus/chained-callbacks.diffA-B.txt +++ b/test/fixtures/javascript/corpus/chained-callbacks.diffA-B.txt @@ -15,7 +15,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (MemberAccess { (Identifier) diff --git a/test/fixtures/javascript/corpus/chained-callbacks.diffB-A.txt b/test/fixtures/javascript/corpus/chained-callbacks.diffB-A.txt index f88bc58c9..ba36adf30 100644 --- a/test/fixtures/javascript/corpus/chained-callbacks.diffB-A.txt +++ b/test/fixtures/javascript/corpus/chained-callbacks.diffB-A.txt @@ -15,7 +15,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (MemberAccess { (Identifier) diff --git a/test/fixtures/javascript/corpus/chained-callbacks.parseA.txt b/test/fixtures/javascript/corpus/chained-callbacks.parseA.txt index f54ff9ba2..a6043e559 100644 --- a/test/fixtures/javascript/corpus/chained-callbacks.parseA.txt +++ b/test/fixtures/javascript/corpus/chained-callbacks.parseA.txt @@ -14,7 +14,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (MemberAccess (Identifier) diff --git a/test/fixtures/javascript/corpus/chained-callbacks.parseB.txt b/test/fixtures/javascript/corpus/chained-callbacks.parseB.txt index f54ff9ba2..a6043e559 100644 --- a/test/fixtures/javascript/corpus/chained-callbacks.parseB.txt +++ b/test/fixtures/javascript/corpus/chained-callbacks.parseB.txt @@ -14,7 +14,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (MemberAccess (Identifier) diff --git a/test/fixtures/javascript/corpus/class.diffA-B.txt b/test/fixtures/javascript/corpus/class.diffA-B.txt index 4d6f8621d..c1fd07f93 100644 --- a/test/fixtures/javascript/corpus/class.diffA-B.txt +++ b/test/fixtures/javascript/corpus/class.diffA-B.txt @@ -1,7 +1,7 @@ (Program (Class (Identifier) - ( + (Statements {+(Method {+(Empty)+} {+(Empty)+} @@ -16,7 +16,7 @@ {+(Assignment {+(Identifier)+} {+(Empty)+})+})+} - {+( + {+(Statements {+(Return {+(Identifier)+})+})+})+} {+(Method @@ -33,7 +33,7 @@ {+(Assignment {+(Identifier)+} {+(Empty)+})+})+} - {+( + {+(Statements {+(Return {+(Identifier)+})+})+})+} {+(Method @@ -50,7 +50,7 @@ {+(Assignment {+(Identifier)+} {+(Empty)+})+})+} - {+( + {+(Statements {+(Return {+(Identifier)+})+})+})+} {-(PublicFieldDefinition @@ -73,7 +73,7 @@ {-(Assignment {-(Identifier)-} {-(Empty)-})-})-} - {-( + {-(Statements {-(Return {-(Identifier)-})-})-})-} {-(Method @@ -90,7 +90,7 @@ {-(Assignment {-(Identifier)-} {-(Empty)-})-})-} - {-( + {-(Statements {-(Return {-(Identifier)-})-})-})-} {-(Method @@ -107,6 +107,6 @@ {-(Assignment {-(Identifier)-} {-(Empty)-})-})-} - {-( + {-(Statements {-(Return {-(Identifier)-})-})-})-}))) diff --git a/test/fixtures/javascript/corpus/class.diffB-A.txt b/test/fixtures/javascript/corpus/class.diffB-A.txt index 0ecccd650..f4214b7cc 100644 --- a/test/fixtures/javascript/corpus/class.diffB-A.txt +++ b/test/fixtures/javascript/corpus/class.diffB-A.txt @@ -1,7 +1,7 @@ (Program (Class (Identifier) - ( + (Statements {+(PublicFieldDefinition {+(Empty)+} {+(Empty)+} @@ -23,7 +23,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Identifier)))) (Method @@ -41,7 +41,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Identifier)))) (Method @@ -59,6 +59,6 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Identifier))))))) diff --git a/test/fixtures/javascript/corpus/class.parseA.txt b/test/fixtures/javascript/corpus/class.parseA.txt index 34abae5a2..1d34cdb49 100644 --- a/test/fixtures/javascript/corpus/class.parseA.txt +++ b/test/fixtures/javascript/corpus/class.parseA.txt @@ -1,7 +1,7 @@ (Program (Class (Identifier) - ( + (Statements (PublicFieldDefinition (Empty) (Empty) @@ -22,7 +22,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Identifier)))) (Method @@ -39,7 +39,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Identifier)))) (Method @@ -56,6 +56,6 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Identifier))))))) diff --git a/test/fixtures/javascript/corpus/class.parseB.txt b/test/fixtures/javascript/corpus/class.parseB.txt index 7a85e6797..3bde6e0b0 100644 --- a/test/fixtures/javascript/corpus/class.parseB.txt +++ b/test/fixtures/javascript/corpus/class.parseB.txt @@ -1,7 +1,7 @@ (Program (Class (Identifier) - ( + (Statements (Method (Empty) (Empty) @@ -16,7 +16,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Identifier)))) (Method @@ -33,7 +33,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Identifier)))) (Method @@ -50,6 +50,6 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Identifier))))))) diff --git a/test/fixtures/javascript/corpus/continue.diffA-B.txt b/test/fixtures/javascript/corpus/continue.diffA-B.txt index 745ef1761..44e6c7bdc 100644 --- a/test/fixtures/javascript/corpus/continue.diffA-B.txt +++ b/test/fixtures/javascript/corpus/continue.diffA-B.txt @@ -8,12 +8,12 @@ (Float)) (Update (Identifier)) - ( + (Statements (If (StrictEqual (Identifier) (Float)) - ( + (Statements {+(Break {+(Empty)+})+} {-(Continue diff --git a/test/fixtures/javascript/corpus/continue.diffB-A.txt b/test/fixtures/javascript/corpus/continue.diffB-A.txt index eff385027..46eb71902 100644 --- a/test/fixtures/javascript/corpus/continue.diffB-A.txt +++ b/test/fixtures/javascript/corpus/continue.diffB-A.txt @@ -8,12 +8,12 @@ (Float)) (Update (Identifier)) - ( + (Statements (If (StrictEqual (Identifier) (Float)) - ( + (Statements {+(Continue {+(Empty)+})+} {-(Break diff --git a/test/fixtures/javascript/corpus/continue.parseA.txt b/test/fixtures/javascript/corpus/continue.parseA.txt index 9618a22b5..0c30ef033 100644 --- a/test/fixtures/javascript/corpus/continue.parseA.txt +++ b/test/fixtures/javascript/corpus/continue.parseA.txt @@ -8,12 +8,12 @@ (Float)) (Update (Identifier)) - ( + (Statements (If (StrictEqual (Identifier) (Float)) - ( + (Statements (Continue (Empty))) (Empty)) diff --git a/test/fixtures/javascript/corpus/continue.parseB.txt b/test/fixtures/javascript/corpus/continue.parseB.txt index e927cd94c..c0af1c973 100644 --- a/test/fixtures/javascript/corpus/continue.parseB.txt +++ b/test/fixtures/javascript/corpus/continue.parseB.txt @@ -8,12 +8,12 @@ (Float)) (Update (Identifier)) - ( + (Statements (If (StrictEqual (Identifier) (Float)) - ( + (Statements (Break (Empty))) (Empty)) diff --git a/test/fixtures/javascript/corpus/do-while-statement.diffA-B.txt b/test/fixtures/javascript/corpus/do-while-statement.diffA-B.txt index 30c06d609..5935813f5 100644 --- a/test/fixtures/javascript/corpus/do-while-statement.diffA-B.txt +++ b/test/fixtures/javascript/corpus/do-while-statement.diffA-B.txt @@ -2,7 +2,7 @@ (DoWhile { (Boolean) ->(Boolean) } - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/javascript/corpus/do-while-statement.diffB-A.txt b/test/fixtures/javascript/corpus/do-while-statement.diffB-A.txt index 30c06d609..5935813f5 100644 --- a/test/fixtures/javascript/corpus/do-while-statement.diffB-A.txt +++ b/test/fixtures/javascript/corpus/do-while-statement.diffB-A.txt @@ -2,7 +2,7 @@ (DoWhile { (Boolean) ->(Boolean) } - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/javascript/corpus/do-while-statement.parseA.txt b/test/fixtures/javascript/corpus/do-while-statement.parseA.txt index 92c41b1a1..a75cc5e53 100644 --- a/test/fixtures/javascript/corpus/do-while-statement.parseA.txt +++ b/test/fixtures/javascript/corpus/do-while-statement.parseA.txt @@ -1,7 +1,7 @@ (Program (DoWhile (Boolean) - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/javascript/corpus/do-while-statement.parseB.txt b/test/fixtures/javascript/corpus/do-while-statement.parseB.txt index 92c41b1a1..a75cc5e53 100644 --- a/test/fixtures/javascript/corpus/do-while-statement.parseB.txt +++ b/test/fixtures/javascript/corpus/do-while-statement.parseB.txt @@ -1,7 +1,7 @@ (Program (DoWhile (Boolean) - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/javascript/corpus/export.diffA-B.txt b/test/fixtures/javascript/corpus/export.diffA-B.txt index 4e6aea904..d820a0e81 100644 --- a/test/fixtures/javascript/corpus/export.diffA-B.txt +++ b/test/fixtures/javascript/corpus/export.diffA-B.txt @@ -52,13 +52,13 @@ {+(Empty)+} {+(Empty)+} {+(Identifier)+} - {+([])+})+})+} + {+(Statements)+})+})+} (DefaultExport (Function (Empty) (Empty) (Empty) - ([]))) + (Statements))) {+(QualifiedExport)+} {+(DefaultExport {+(TextElement)+})+} @@ -69,7 +69,7 @@ {-(Empty)-} {-(Empty)-} {-(Identifier)-} - {-([])-})-})-} + {-(Statements)-})-})-} {-(QualifiedExport)-} {-(DefaultExport {-(TextElement)-})-} diff --git a/test/fixtures/javascript/corpus/export.diffB-A.txt b/test/fixtures/javascript/corpus/export.diffB-A.txt index c0d98eefd..fca2269b7 100644 --- a/test/fixtures/javascript/corpus/export.diffB-A.txt +++ b/test/fixtures/javascript/corpus/export.diffB-A.txt @@ -55,19 +55,19 @@ {-(Empty)-} {-(Empty)-} {-(Identifier)-} - {-([])-})-})-} + {-(Statements)-})-})-} (DefaultExport (Function (Empty) (Empty) (Empty) - ([]))) + (Statements))) {+(DefaultExport {+(Function {+(Empty)+} {+(Empty)+} {+(Identifier)+} - {+([])+})+})+} + {+(Statements)+})+})+} { (QualifiedExport) ->(QualifiedExport) } (DefaultExport diff --git a/test/fixtures/javascript/corpus/export.parseA.txt b/test/fixtures/javascript/corpus/export.parseA.txt index 5e293e404..c65411988 100644 --- a/test/fixtures/javascript/corpus/export.parseA.txt +++ b/test/fixtures/javascript/corpus/export.parseA.txt @@ -40,13 +40,13 @@ (Empty) (Empty) (Empty) - ([]))) + (Statements))) (DefaultExport (Function (Empty) (Empty) (Identifier) - ([]))) + (Statements))) (QualifiedExport) (DefaultExport (TextElement)) diff --git a/test/fixtures/javascript/corpus/export.parseB.txt b/test/fixtures/javascript/corpus/export.parseB.txt index 12ec54bef..a04091e87 100644 --- a/test/fixtures/javascript/corpus/export.parseB.txt +++ b/test/fixtures/javascript/corpus/export.parseB.txt @@ -40,13 +40,13 @@ (Empty) (Empty) (Identifier) - ([]))) + (Statements))) (DefaultExport (Function (Empty) (Empty) (Empty) - ([]))) + (Statements))) (QualifiedExport) (DefaultExport (TextElement)) diff --git a/test/fixtures/javascript/corpus/for-in-statement.diffA-B.txt b/test/fixtures/javascript/corpus/for-in-statement.diffA-B.txt index 4faf0ca9a..7f4c7fe4a 100644 --- a/test/fixtures/javascript/corpus/for-in-statement.diffA-B.txt +++ b/test/fixtures/javascript/corpus/for-in-statement.diffA-B.txt @@ -4,7 +4,7 @@ ->(Identifier) } { (Identifier) ->(Identifier) } - ( + (Statements (Call { (Identifier) ->(Identifier) } diff --git a/test/fixtures/javascript/corpus/for-in-statement.diffB-A.txt b/test/fixtures/javascript/corpus/for-in-statement.diffB-A.txt index 4faf0ca9a..7f4c7fe4a 100644 --- a/test/fixtures/javascript/corpus/for-in-statement.diffB-A.txt +++ b/test/fixtures/javascript/corpus/for-in-statement.diffB-A.txt @@ -4,7 +4,7 @@ ->(Identifier) } { (Identifier) ->(Identifier) } - ( + (Statements (Call { (Identifier) ->(Identifier) } diff --git a/test/fixtures/javascript/corpus/for-in-statement.parseA.txt b/test/fixtures/javascript/corpus/for-in-statement.parseA.txt index c41e5a7f1..79a82b79a 100644 --- a/test/fixtures/javascript/corpus/for-in-statement.parseA.txt +++ b/test/fixtures/javascript/corpus/for-in-statement.parseA.txt @@ -2,7 +2,7 @@ (ForEach (Identifier) (Identifier) - ( + (Statements (Call (Identifier) (Empty))))) diff --git a/test/fixtures/javascript/corpus/for-in-statement.parseB.txt b/test/fixtures/javascript/corpus/for-in-statement.parseB.txt index c41e5a7f1..79a82b79a 100644 --- a/test/fixtures/javascript/corpus/for-in-statement.parseB.txt +++ b/test/fixtures/javascript/corpus/for-in-statement.parseB.txt @@ -2,7 +2,7 @@ (ForEach (Identifier) (Identifier) - ( + (Statements (Call (Identifier) (Empty))))) diff --git a/test/fixtures/javascript/corpus/for-loop-with-in-statement.diffA-B.txt b/test/fixtures/javascript/corpus/for-loop-with-in-statement.diffA-B.txt index dcd085128..e3184832c 100644 --- a/test/fixtures/javascript/corpus/for-loop-with-in-statement.diffA-B.txt +++ b/test/fixtures/javascript/corpus/for-loop-with-in-statement.diffA-B.txt @@ -13,7 +13,7 @@ (Identifier)) (Update (Identifier)) - ( + (Statements (Call { (Identifier) ->(Identifier) } diff --git a/test/fixtures/javascript/corpus/for-loop-with-in-statement.diffB-A.txt b/test/fixtures/javascript/corpus/for-loop-with-in-statement.diffB-A.txt index dcd085128..e3184832c 100644 --- a/test/fixtures/javascript/corpus/for-loop-with-in-statement.diffB-A.txt +++ b/test/fixtures/javascript/corpus/for-loop-with-in-statement.diffB-A.txt @@ -13,7 +13,7 @@ (Identifier)) (Update (Identifier)) - ( + (Statements (Call { (Identifier) ->(Identifier) } diff --git a/test/fixtures/javascript/corpus/for-loop-with-in-statement.parseA.txt b/test/fixtures/javascript/corpus/for-loop-with-in-statement.parseA.txt index 09777939f..0c1d70fb4 100644 --- a/test/fixtures/javascript/corpus/for-loop-with-in-statement.parseA.txt +++ b/test/fixtures/javascript/corpus/for-loop-with-in-statement.parseA.txt @@ -12,7 +12,7 @@ (Identifier)) (Update (Identifier)) - ( + (Statements (Call (Identifier) (Empty))))) diff --git a/test/fixtures/javascript/corpus/for-loop-with-in-statement.parseB.txt b/test/fixtures/javascript/corpus/for-loop-with-in-statement.parseB.txt index 09777939f..0c1d70fb4 100644 --- a/test/fixtures/javascript/corpus/for-loop-with-in-statement.parseB.txt +++ b/test/fixtures/javascript/corpus/for-loop-with-in-statement.parseB.txt @@ -12,7 +12,7 @@ (Identifier)) (Update (Identifier)) - ( + (Statements (Call (Identifier) (Empty))))) diff --git a/test/fixtures/javascript/corpus/for-of-statement.diffA-B.txt b/test/fixtures/javascript/corpus/for-of-statement.diffA-B.txt index 9886795f9..f5e052f79 100644 --- a/test/fixtures/javascript/corpus/for-of-statement.diffA-B.txt +++ b/test/fixtures/javascript/corpus/for-of-statement.diffA-B.txt @@ -4,7 +4,7 @@ ->(Identifier) } { (Identifier) ->(Identifier) } - ( + (Statements (Call (Identifier) { (Identifier) diff --git a/test/fixtures/javascript/corpus/for-of-statement.diffB-A.txt b/test/fixtures/javascript/corpus/for-of-statement.diffB-A.txt index 9886795f9..f5e052f79 100644 --- a/test/fixtures/javascript/corpus/for-of-statement.diffB-A.txt +++ b/test/fixtures/javascript/corpus/for-of-statement.diffB-A.txt @@ -4,7 +4,7 @@ ->(Identifier) } { (Identifier) ->(Identifier) } - ( + (Statements (Call (Identifier) { (Identifier) diff --git a/test/fixtures/javascript/corpus/for-of-statement.parseA.txt b/test/fixtures/javascript/corpus/for-of-statement.parseA.txt index 025a1cf60..3c9704a36 100644 --- a/test/fixtures/javascript/corpus/for-of-statement.parseA.txt +++ b/test/fixtures/javascript/corpus/for-of-statement.parseA.txt @@ -2,7 +2,7 @@ (ForOf (Identifier) (Identifier) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/javascript/corpus/for-of-statement.parseB.txt b/test/fixtures/javascript/corpus/for-of-statement.parseB.txt index 025a1cf60..3c9704a36 100644 --- a/test/fixtures/javascript/corpus/for-of-statement.parseB.txt +++ b/test/fixtures/javascript/corpus/for-of-statement.parseB.txt @@ -2,7 +2,7 @@ (ForOf (Identifier) (Identifier) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/javascript/corpus/for-statement.diffA-B.txt b/test/fixtures/javascript/corpus/for-statement.diffA-B.txt index 42df10b93..1cf044616 100644 --- a/test/fixtures/javascript/corpus/for-statement.diffA-B.txt +++ b/test/fixtures/javascript/corpus/for-statement.diffA-B.txt @@ -13,7 +13,7 @@ ->(Float) }) (Update (Identifier)) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/javascript/corpus/for-statement.diffB-A.txt b/test/fixtures/javascript/corpus/for-statement.diffB-A.txt index 42df10b93..1cf044616 100644 --- a/test/fixtures/javascript/corpus/for-statement.diffB-A.txt +++ b/test/fixtures/javascript/corpus/for-statement.diffB-A.txt @@ -13,7 +13,7 @@ ->(Float) }) (Update (Identifier)) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/javascript/corpus/for-statement.parseA.txt b/test/fixtures/javascript/corpus/for-statement.parseA.txt index 4874a22fc..fe2179965 100644 --- a/test/fixtures/javascript/corpus/for-statement.parseA.txt +++ b/test/fixtures/javascript/corpus/for-statement.parseA.txt @@ -12,7 +12,7 @@ (Float)) (Update (Identifier)) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/javascript/corpus/for-statement.parseB.txt b/test/fixtures/javascript/corpus/for-statement.parseB.txt index 4874a22fc..fe2179965 100644 --- a/test/fixtures/javascript/corpus/for-statement.parseB.txt +++ b/test/fixtures/javascript/corpus/for-statement.parseB.txt @@ -12,7 +12,7 @@ (Float)) (Update (Identifier)) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/javascript/corpus/function-call-args.diffA-B.txt b/test/fixtures/javascript/corpus/function-call-args.diffA-B.txt index cb4b6e2d9..9ab5e70c0 100644 --- a/test/fixtures/javascript/corpus/function-call-args.diffA-B.txt +++ b/test/fixtures/javascript/corpus/function-call-args.diffA-B.txt @@ -29,7 +29,7 @@ {+(Assignment {+(Identifier)+} {+(Empty)+})+})+} - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/javascript/corpus/function-call-args.diffB-A.txt b/test/fixtures/javascript/corpus/function-call-args.diffB-A.txt index 194e964af..46e0b5c06 100644 --- a/test/fixtures/javascript/corpus/function-call-args.diffB-A.txt +++ b/test/fixtures/javascript/corpus/function-call-args.diffB-A.txt @@ -29,7 +29,7 @@ {-(Assignment {-(Identifier)-} {-(Empty)-})-})-} - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/javascript/corpus/function-call-args.parseA.txt b/test/fixtures/javascript/corpus/function-call-args.parseA.txt index 3f9ef783e..ed0d71201 100644 --- a/test/fixtures/javascript/corpus/function-call-args.parseA.txt +++ b/test/fixtures/javascript/corpus/function-call-args.parseA.txt @@ -21,7 +21,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/javascript/corpus/function-call-args.parseB.txt b/test/fixtures/javascript/corpus/function-call-args.parseB.txt index 3f9ef783e..ed0d71201 100644 --- a/test/fixtures/javascript/corpus/function-call-args.parseB.txt +++ b/test/fixtures/javascript/corpus/function-call-args.parseB.txt @@ -21,7 +21,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/javascript/corpus/function.diffA-B.txt b/test/fixtures/javascript/corpus/function.diffA-B.txt index 268dd2b35..ad894be7c 100644 --- a/test/fixtures/javascript/corpus/function.diffA-B.txt +++ b/test/fixtures/javascript/corpus/function.diffA-B.txt @@ -17,7 +17,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements { (Identifier) ->(Identifier) })) (Empty)) diff --git a/test/fixtures/javascript/corpus/function.diffB-A.txt b/test/fixtures/javascript/corpus/function.diffB-A.txt index 268dd2b35..ad894be7c 100644 --- a/test/fixtures/javascript/corpus/function.diffB-A.txt +++ b/test/fixtures/javascript/corpus/function.diffB-A.txt @@ -17,7 +17,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements { (Identifier) ->(Identifier) })) (Empty)) diff --git a/test/fixtures/javascript/corpus/function.parseA.txt b/test/fixtures/javascript/corpus/function.parseA.txt index 7b52e977a..4059c4550 100644 --- a/test/fixtures/javascript/corpus/function.parseA.txt +++ b/test/fixtures/javascript/corpus/function.parseA.txt @@ -17,6 +17,6 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Identifier))) (Empty)) diff --git a/test/fixtures/javascript/corpus/function.parseB.txt b/test/fixtures/javascript/corpus/function.parseB.txt index 7b52e977a..4059c4550 100644 --- a/test/fixtures/javascript/corpus/function.parseB.txt +++ b/test/fixtures/javascript/corpus/function.parseB.txt @@ -17,6 +17,6 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Identifier))) (Empty)) diff --git a/test/fixtures/javascript/corpus/generator-function.diffA-B.txt b/test/fixtures/javascript/corpus/generator-function.diffA-B.txt index 65f3d8507..2f4f58433 100644 --- a/test/fixtures/javascript/corpus/generator-function.diffA-B.txt +++ b/test/fixtures/javascript/corpus/generator-function.diffA-B.txt @@ -18,7 +18,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Yield (Empty)) (Yield diff --git a/test/fixtures/javascript/corpus/generator-function.diffB-A.txt b/test/fixtures/javascript/corpus/generator-function.diffB-A.txt index 65f3d8507..2f4f58433 100644 --- a/test/fixtures/javascript/corpus/generator-function.diffB-A.txt +++ b/test/fixtures/javascript/corpus/generator-function.diffB-A.txt @@ -18,7 +18,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Yield (Empty)) (Yield diff --git a/test/fixtures/javascript/corpus/generator-function.parseA.txt b/test/fixtures/javascript/corpus/generator-function.parseA.txt index d86eafa99..fd25c91b3 100644 --- a/test/fixtures/javascript/corpus/generator-function.parseA.txt +++ b/test/fixtures/javascript/corpus/generator-function.parseA.txt @@ -17,7 +17,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Yield (Empty)) (Yield diff --git a/test/fixtures/javascript/corpus/generator-function.parseB.txt b/test/fixtures/javascript/corpus/generator-function.parseB.txt index d86eafa99..fd25c91b3 100644 --- a/test/fixtures/javascript/corpus/generator-function.parseB.txt +++ b/test/fixtures/javascript/corpus/generator-function.parseB.txt @@ -17,7 +17,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Yield (Empty)) (Yield diff --git a/test/fixtures/javascript/corpus/if-else.diffA-B.txt b/test/fixtures/javascript/corpus/if-else.diffA-B.txt index 8d402c80e..41281f5e5 100644 --- a/test/fixtures/javascript/corpus/if-else.diffA-B.txt +++ b/test/fixtures/javascript/corpus/if-else.diffA-B.txt @@ -8,7 +8,7 @@ { (Identifier) ->(Identifier) } { (Identifier) - ->( + ->(Statements {+(Identifier)+}) } (If { (Identifier) @@ -19,7 +19,7 @@ { (Identifier) ->(Identifier) } { (Identifier) - ->( + ->(Statements {+(Identifier)+}) } { (Identifier) ->(Identifier) }))))) diff --git a/test/fixtures/javascript/corpus/if-else.diffB-A.txt b/test/fixtures/javascript/corpus/if-else.diffB-A.txt index 514f0cd36..a7e842460 100644 --- a/test/fixtures/javascript/corpus/if-else.diffB-A.txt +++ b/test/fixtures/javascript/corpus/if-else.diffB-A.txt @@ -7,7 +7,7 @@ (If { (Identifier) ->(Identifier) } - { ( + { (Statements {-(Identifier)-}) ->(Identifier) } (If @@ -18,7 +18,7 @@ (If { (Identifier) ->(Identifier) } - { ( + { (Statements {-(Identifier)-}) ->(Identifier) } { (Identifier) diff --git a/test/fixtures/javascript/corpus/if-else.parseB.txt b/test/fixtures/javascript/corpus/if-else.parseB.txt index 3a8f90cf1..2402f8fd0 100644 --- a/test/fixtures/javascript/corpus/if-else.parseB.txt +++ b/test/fixtures/javascript/corpus/if-else.parseB.txt @@ -4,13 +4,13 @@ (Identifier) (If (Identifier) - ( + (Statements (Identifier)) (If (Identifier) (Identifier) (If (Identifier) - ( + (Statements (Identifier)) (Identifier)))))) diff --git a/test/fixtures/javascript/corpus/if.diffA-B.txt b/test/fixtures/javascript/corpus/if.diffA-B.txt index 2a90eee30..329dbee61 100644 --- a/test/fixtures/javascript/corpus/if.diffA-B.txt +++ b/test/fixtures/javascript/corpus/if.diffA-B.txt @@ -4,7 +4,7 @@ ->(MemberAccess {+(Identifier)+} {+(Identifier)+}) } - ( + (Statements (Call (Identifier) { (Identifier) diff --git a/test/fixtures/javascript/corpus/if.diffB-A.txt b/test/fixtures/javascript/corpus/if.diffB-A.txt index a6742d0e3..58379f889 100644 --- a/test/fixtures/javascript/corpus/if.diffB-A.txt +++ b/test/fixtures/javascript/corpus/if.diffB-A.txt @@ -4,7 +4,7 @@ {-(Identifier)-} {-(Identifier)-}) ->(Identifier) } - ( + (Statements (Call (Identifier) { (Identifier) diff --git a/test/fixtures/javascript/corpus/if.parseA.txt b/test/fixtures/javascript/corpus/if.parseA.txt index 23bee3aca..c319b1eb0 100644 --- a/test/fixtures/javascript/corpus/if.parseA.txt +++ b/test/fixtures/javascript/corpus/if.parseA.txt @@ -1,7 +1,7 @@ (Program (If (Identifier) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/javascript/corpus/if.parseB.txt b/test/fixtures/javascript/corpus/if.parseB.txt index 82a81394a..4c23c44b9 100644 --- a/test/fixtures/javascript/corpus/if.parseB.txt +++ b/test/fixtures/javascript/corpus/if.parseB.txt @@ -3,7 +3,7 @@ (MemberAccess (Identifier) (Identifier)) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/javascript/corpus/import.diffA-B.txt b/test/fixtures/javascript/corpus/import.diffA-B.txt index 9e5c75bdc..f817f812a 100644 --- a/test/fixtures/javascript/corpus/import.diffA-B.txt +++ b/test/fixtures/javascript/corpus/import.diffA-B.txt @@ -6,10 +6,10 @@ ->(Import) } {+(Import)+} {+(Import)+} -{+( +{+(Statements {+(Import)+} {+(Import)+})+} -{+( +{+(Statements {+(Import)+} {+(QualifiedAliasedImport {+(Identifier)+})+})+} @@ -19,10 +19,10 @@ {-(Import)-} {-(Import)-} {-(Import)-} -{-( +{-(Statements {-(Import)-} {-(Import)-})-} -{-( +{-(Statements {-(Import)-} {-(QualifiedAliasedImport {-(Identifier)-})-})-} diff --git a/test/fixtures/javascript/corpus/import.diffB-A.txt b/test/fixtures/javascript/corpus/import.diffB-A.txt index 7bcd92f6a..d9ef4348b 100644 --- a/test/fixtures/javascript/corpus/import.diffB-A.txt +++ b/test/fixtures/javascript/corpus/import.diffB-A.txt @@ -5,10 +5,10 @@ {+(Import)+} {+(Import)+} {+(Import)+} -{+( +{+(Statements {+(Import)+} {+(Import)+})+} -{+( +{+(Statements {+(Import)+} {+(QualifiedAliasedImport {+(Identifier)+})+})+} @@ -19,10 +19,10 @@ {-(Import)-} {-(Import)-} {-(Import)-} -{-( +{-(Statements {-(Import)-} {-(Import)-})-} -{-( +{-(Statements {-(Import)-} {-(QualifiedAliasedImport {-(Identifier)-})-})-} diff --git a/test/fixtures/javascript/corpus/import.parseA.txt b/test/fixtures/javascript/corpus/import.parseA.txt index 037e1c7c8..069afffe6 100644 --- a/test/fixtures/javascript/corpus/import.parseA.txt +++ b/test/fixtures/javascript/corpus/import.parseA.txt @@ -5,10 +5,10 @@ (Import) (Import) (Import) - ( + (Statements (Import) (Import)) - ( + (Statements (Import) (QualifiedAliasedImport (Identifier))) diff --git a/test/fixtures/javascript/corpus/import.parseB.txt b/test/fixtures/javascript/corpus/import.parseB.txt index 037e1c7c8..069afffe6 100644 --- a/test/fixtures/javascript/corpus/import.parseB.txt +++ b/test/fixtures/javascript/corpus/import.parseB.txt @@ -5,10 +5,10 @@ (Import) (Import) (Import) - ( + (Statements (Import) (Import)) - ( + (Statements (Import) (QualifiedAliasedImport (Identifier))) diff --git a/test/fixtures/javascript/corpus/named-function.diffA-B.txt b/test/fixtures/javascript/corpus/named-function.diffA-B.txt index 097c4555b..aec245b08 100644 --- a/test/fixtures/javascript/corpus/named-function.diffA-B.txt +++ b/test/fixtures/javascript/corpus/named-function.diffA-B.txt @@ -18,7 +18,7 @@ {-(Assignment {-(Identifier)-} {-(Empty)-})-})-} - ( + (Statements {+(Return {+(Boolean)+})+} {-(Identifier)-})) diff --git a/test/fixtures/javascript/corpus/named-function.diffB-A.txt b/test/fixtures/javascript/corpus/named-function.diffB-A.txt index 0b02b2e5a..8ac7047e0 100644 --- a/test/fixtures/javascript/corpus/named-function.diffB-A.txt +++ b/test/fixtures/javascript/corpus/named-function.diffB-A.txt @@ -18,7 +18,7 @@ {+(Assignment {+(Identifier)+} {+(Empty)+})+})+} - ( + (Statements {+(Identifier)+} {-(Return {-(Boolean)-})-})) diff --git a/test/fixtures/javascript/corpus/named-function.parseA.txt b/test/fixtures/javascript/corpus/named-function.parseA.txt index 6f4b7d301..a0596d5bd 100644 --- a/test/fixtures/javascript/corpus/named-function.parseA.txt +++ b/test/fixtures/javascript/corpus/named-function.parseA.txt @@ -17,6 +17,6 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Identifier))) (Empty)) diff --git a/test/fixtures/javascript/corpus/named-function.parseB.txt b/test/fixtures/javascript/corpus/named-function.parseB.txt index fbad167d9..96d3c4033 100644 --- a/test/fixtures/javascript/corpus/named-function.parseB.txt +++ b/test/fixtures/javascript/corpus/named-function.parseB.txt @@ -3,7 +3,7 @@ (Empty) (Empty) (Identifier) - ( + (Statements (Return (Boolean)))) (Empty)) diff --git a/test/fixtures/javascript/corpus/nested-do-while-in-function.diffA-B.txt b/test/fixtures/javascript/corpus/nested-do-while-in-function.diffA-B.txt index c7eea5548..00dd2f4a3 100644 --- a/test/fixtures/javascript/corpus/nested-do-while-in-function.diffA-B.txt +++ b/test/fixtures/javascript/corpus/nested-do-while-in-function.diffA-B.txt @@ -17,11 +17,11 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (DoWhile { (Identifier) ->(Identifier) } - ( + (Statements (Call (Identifier) { (Identifier) diff --git a/test/fixtures/javascript/corpus/nested-do-while-in-function.diffB-A.txt b/test/fixtures/javascript/corpus/nested-do-while-in-function.diffB-A.txt index c7eea5548..00dd2f4a3 100644 --- a/test/fixtures/javascript/corpus/nested-do-while-in-function.diffB-A.txt +++ b/test/fixtures/javascript/corpus/nested-do-while-in-function.diffB-A.txt @@ -17,11 +17,11 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (DoWhile { (Identifier) ->(Identifier) } - ( + (Statements (Call (Identifier) { (Identifier) diff --git a/test/fixtures/javascript/corpus/nested-do-while-in-function.parseA.txt b/test/fixtures/javascript/corpus/nested-do-while-in-function.parseA.txt index 440deb76f..618761627 100644 --- a/test/fixtures/javascript/corpus/nested-do-while-in-function.parseA.txt +++ b/test/fixtures/javascript/corpus/nested-do-while-in-function.parseA.txt @@ -17,10 +17,10 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (DoWhile (Identifier) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/javascript/corpus/nested-do-while-in-function.parseB.txt b/test/fixtures/javascript/corpus/nested-do-while-in-function.parseB.txt index 440deb76f..618761627 100644 --- a/test/fixtures/javascript/corpus/nested-do-while-in-function.parseB.txt +++ b/test/fixtures/javascript/corpus/nested-do-while-in-function.parseB.txt @@ -17,10 +17,10 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (DoWhile (Identifier) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/javascript/corpus/nested-functions.diffA-B.txt b/test/fixtures/javascript/corpus/nested-functions.diffA-B.txt index 0b3c286a9..2a221fcdd 100644 --- a/test/fixtures/javascript/corpus/nested-functions.diffA-B.txt +++ b/test/fixtures/javascript/corpus/nested-functions.diffA-B.txt @@ -17,7 +17,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Function (Empty) (Empty) @@ -36,7 +36,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/javascript/corpus/nested-functions.diffB-A.txt b/test/fixtures/javascript/corpus/nested-functions.diffB-A.txt index 0b3c286a9..2a221fcdd 100644 --- a/test/fixtures/javascript/corpus/nested-functions.diffB-A.txt +++ b/test/fixtures/javascript/corpus/nested-functions.diffB-A.txt @@ -17,7 +17,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Function (Empty) (Empty) @@ -36,7 +36,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/javascript/corpus/nested-functions.parseA.txt b/test/fixtures/javascript/corpus/nested-functions.parseA.txt index 0955c8914..bba0968bd 100644 --- a/test/fixtures/javascript/corpus/nested-functions.parseA.txt +++ b/test/fixtures/javascript/corpus/nested-functions.parseA.txt @@ -17,7 +17,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Function (Empty) (Empty) @@ -36,7 +36,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/javascript/corpus/nested-functions.parseB.txt b/test/fixtures/javascript/corpus/nested-functions.parseB.txt index 0955c8914..bba0968bd 100644 --- a/test/fixtures/javascript/corpus/nested-functions.parseB.txt +++ b/test/fixtures/javascript/corpus/nested-functions.parseB.txt @@ -17,7 +17,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Function (Empty) (Empty) @@ -36,7 +36,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/javascript/corpus/objects-with-methods.diffA-B.txt b/test/fixtures/javascript/corpus/objects-with-methods.diffA-B.txt index e7766878f..9c40be32f 100644 --- a/test/fixtures/javascript/corpus/objects-with-methods.diffA-B.txt +++ b/test/fixtures/javascript/corpus/objects-with-methods.diffA-B.txt @@ -22,7 +22,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return { (Plus {-(Identifier)-} diff --git a/test/fixtures/javascript/corpus/objects-with-methods.diffB-A.txt b/test/fixtures/javascript/corpus/objects-with-methods.diffB-A.txt index 6d87f8b53..914db2372 100644 --- a/test/fixtures/javascript/corpus/objects-with-methods.diffB-A.txt +++ b/test/fixtures/javascript/corpus/objects-with-methods.diffB-A.txt @@ -22,7 +22,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return { (Minus {-(Identifier)-} diff --git a/test/fixtures/javascript/corpus/objects-with-methods.parseA.txt b/test/fixtures/javascript/corpus/objects-with-methods.parseA.txt index d3d5e4345..618957d0f 100644 --- a/test/fixtures/javascript/corpus/objects-with-methods.parseA.txt +++ b/test/fixtures/javascript/corpus/objects-with-methods.parseA.txt @@ -21,7 +21,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Plus (Identifier) diff --git a/test/fixtures/javascript/corpus/objects-with-methods.parseB.txt b/test/fixtures/javascript/corpus/objects-with-methods.parseB.txt index b8747c6ea..8acf4faff 100644 --- a/test/fixtures/javascript/corpus/objects-with-methods.parseB.txt +++ b/test/fixtures/javascript/corpus/objects-with-methods.parseB.txt @@ -21,7 +21,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Minus (Identifier) diff --git a/test/fixtures/javascript/corpus/switch-statement.diffA-B.txt b/test/fixtures/javascript/corpus/switch-statement.diffA-B.txt index e72d89a5b..3883f69c5 100644 --- a/test/fixtures/javascript/corpus/switch-statement.diffA-B.txt +++ b/test/fixtures/javascript/corpus/switch-statement.diffA-B.txt @@ -2,18 +2,18 @@ (Match { (Float) ->(Float) } - ( + (Statements (Pattern (Float) - ( + (Statements (Float))) (Pattern (Float) - ( + (Statements { (Float) ->(Float) })) (Pattern (Float) - ( + (Statements (Float))))) (Empty)) diff --git a/test/fixtures/javascript/corpus/switch-statement.diffB-A.txt b/test/fixtures/javascript/corpus/switch-statement.diffB-A.txt index e72d89a5b..3883f69c5 100644 --- a/test/fixtures/javascript/corpus/switch-statement.diffB-A.txt +++ b/test/fixtures/javascript/corpus/switch-statement.diffB-A.txt @@ -2,18 +2,18 @@ (Match { (Float) ->(Float) } - ( + (Statements (Pattern (Float) - ( + (Statements (Float))) (Pattern (Float) - ( + (Statements { (Float) ->(Float) })) (Pattern (Float) - ( + (Statements (Float))))) (Empty)) diff --git a/test/fixtures/javascript/corpus/switch-statement.parseA.txt b/test/fixtures/javascript/corpus/switch-statement.parseA.txt index 7d77dcfad..3e597d106 100644 --- a/test/fixtures/javascript/corpus/switch-statement.parseA.txt +++ b/test/fixtures/javascript/corpus/switch-statement.parseA.txt @@ -1,17 +1,17 @@ (Program (Match (Float) - ( + (Statements (Pattern (Float) - ( + (Statements (Float))) (Pattern (Float) - ( + (Statements (Float))) (Pattern (Float) - ( + (Statements (Float))))) (Empty)) diff --git a/test/fixtures/javascript/corpus/switch-statement.parseB.txt b/test/fixtures/javascript/corpus/switch-statement.parseB.txt index 7d77dcfad..3e597d106 100644 --- a/test/fixtures/javascript/corpus/switch-statement.parseB.txt +++ b/test/fixtures/javascript/corpus/switch-statement.parseB.txt @@ -1,17 +1,17 @@ (Program (Match (Float) - ( + (Statements (Pattern (Float) - ( + (Statements (Float))) (Pattern (Float) - ( + (Statements (Float))) (Pattern (Float) - ( + (Statements (Float))))) (Empty)) diff --git a/test/fixtures/javascript/corpus/try-statement.diffA-B.txt b/test/fixtures/javascript/corpus/try-statement.diffA-B.txt index a1448e34d..a7241e603 100644 --- a/test/fixtures/javascript/corpus/try-statement.diffA-B.txt +++ b/test/fixtures/javascript/corpus/try-statement.diffA-B.txt @@ -1,14 +1,14 @@ (Program (Try - ( + (Statements (Identifier)) (Catch (Empty) - ( + (Statements { (Identifier) ->(Identifier) })) (Finally - ( + (Statements { (Identifier) ->(Identifier) }))) (Empty)) diff --git a/test/fixtures/javascript/corpus/try-statement.diffB-A.txt b/test/fixtures/javascript/corpus/try-statement.diffB-A.txt index a1448e34d..a7241e603 100644 --- a/test/fixtures/javascript/corpus/try-statement.diffB-A.txt +++ b/test/fixtures/javascript/corpus/try-statement.diffB-A.txt @@ -1,14 +1,14 @@ (Program (Try - ( + (Statements (Identifier)) (Catch (Empty) - ( + (Statements { (Identifier) ->(Identifier) })) (Finally - ( + (Statements { (Identifier) ->(Identifier) }))) (Empty)) diff --git a/test/fixtures/javascript/corpus/try-statement.parseA.txt b/test/fixtures/javascript/corpus/try-statement.parseA.txt index 7224cc157..22e10b492 100644 --- a/test/fixtures/javascript/corpus/try-statement.parseA.txt +++ b/test/fixtures/javascript/corpus/try-statement.parseA.txt @@ -1,12 +1,12 @@ (Program (Try - ( + (Statements (Identifier)) (Catch (Empty) - ( + (Statements (Identifier))) (Finally - ( + (Statements (Identifier)))) (Empty)) diff --git a/test/fixtures/javascript/corpus/try-statement.parseB.txt b/test/fixtures/javascript/corpus/try-statement.parseB.txt index 7224cc157..22e10b492 100644 --- a/test/fixtures/javascript/corpus/try-statement.parseB.txt +++ b/test/fixtures/javascript/corpus/try-statement.parseB.txt @@ -1,12 +1,12 @@ (Program (Try - ( + (Statements (Identifier)) (Catch (Empty) - ( + (Statements (Identifier))) (Finally - ( + (Statements (Identifier)))) (Empty)) diff --git a/test/fixtures/javascript/corpus/while-statement.diffA-B.txt b/test/fixtures/javascript/corpus/while-statement.diffA-B.txt index 7ecf81cea..6c6581fbe 100644 --- a/test/fixtures/javascript/corpus/while-statement.diffA-B.txt +++ b/test/fixtures/javascript/corpus/while-statement.diffA-B.txt @@ -2,7 +2,7 @@ (While { (Identifier) ->(Identifier) } - ( + (Statements (Call { (Identifier) ->(Identifier) } diff --git a/test/fixtures/javascript/corpus/while-statement.diffB-A.txt b/test/fixtures/javascript/corpus/while-statement.diffB-A.txt index 7ecf81cea..6c6581fbe 100644 --- a/test/fixtures/javascript/corpus/while-statement.diffB-A.txt +++ b/test/fixtures/javascript/corpus/while-statement.diffB-A.txt @@ -2,7 +2,7 @@ (While { (Identifier) ->(Identifier) } - ( + (Statements (Call { (Identifier) ->(Identifier) } diff --git a/test/fixtures/javascript/corpus/while-statement.parseA.txt b/test/fixtures/javascript/corpus/while-statement.parseA.txt index 384062c49..41960b042 100644 --- a/test/fixtures/javascript/corpus/while-statement.parseA.txt +++ b/test/fixtures/javascript/corpus/while-statement.parseA.txt @@ -1,7 +1,7 @@ (Program (While (Identifier) - ( + (Statements (Call (Identifier) (Empty)))) diff --git a/test/fixtures/javascript/corpus/while-statement.parseB.txt b/test/fixtures/javascript/corpus/while-statement.parseB.txt index 384062c49..41960b042 100644 --- a/test/fixtures/javascript/corpus/while-statement.parseB.txt +++ b/test/fixtures/javascript/corpus/while-statement.parseB.txt @@ -1,7 +1,7 @@ (Program (While (Identifier) - ( + (Statements (Call (Identifier) (Empty)))) diff --git a/test/fixtures/javascript/corpus/yield.diffA-B.txt b/test/fixtures/javascript/corpus/yield.diffA-B.txt index 1737c04ee..ccde7b2d7 100644 --- a/test/fixtures/javascript/corpus/yield.diffA-B.txt +++ b/test/fixtures/javascript/corpus/yield.diffA-B.txt @@ -3,7 +3,7 @@ (Empty) (Empty) (Identifier) - ( + (Statements (VariableDeclaration (Assignment (Empty) diff --git a/test/fixtures/javascript/corpus/yield.diffB-A.txt b/test/fixtures/javascript/corpus/yield.diffB-A.txt index 56edbe9a9..d7dd3fc20 100644 --- a/test/fixtures/javascript/corpus/yield.diffB-A.txt +++ b/test/fixtures/javascript/corpus/yield.diffB-A.txt @@ -3,7 +3,7 @@ (Empty) (Empty) (Identifier) - ( + (Statements (VariableDeclaration (Assignment (Empty) diff --git a/test/fixtures/javascript/corpus/yield.parseA.txt b/test/fixtures/javascript/corpus/yield.parseA.txt index 0a4c7dcc9..47d764d16 100644 --- a/test/fixtures/javascript/corpus/yield.parseA.txt +++ b/test/fixtures/javascript/corpus/yield.parseA.txt @@ -3,7 +3,7 @@ (Empty) (Empty) (Identifier) - ( + (Statements (VariableDeclaration (Assignment (Empty) diff --git a/test/fixtures/javascript/corpus/yield.parseB.txt b/test/fixtures/javascript/corpus/yield.parseB.txt index 85816f2b8..54eada74e 100644 --- a/test/fixtures/javascript/corpus/yield.parseB.txt +++ b/test/fixtures/javascript/corpus/yield.parseB.txt @@ -3,7 +3,7 @@ (Empty) (Empty) (Identifier) - ( + (Statements (VariableDeclaration (Assignment (Empty) diff --git a/test/fixtures/python/corpus/assignment.diffA-B.txt b/test/fixtures/python/corpus/assignment.diffA-B.txt index c1c74f5af..105306e81 100644 --- a/test/fixtures/python/corpus/assignment.diffA-B.txt +++ b/test/fixtures/python/corpus/assignment.diffA-B.txt @@ -1,9 +1,9 @@ (Program {+(Assignment - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+} - {+( + {+(Statements {+(Integer)+} {+(Integer)+})+})+} (Assignment @@ -11,15 +11,15 @@ ->(Identifier) } (Integer)) (Assignment - { ( + { (Statements {-(Identifier)-} {-(Identifier)-}) ->(Identifier) } - ( + (Statements (Integer) (Integer))) {-(Assignment {-(Identifier)-} - {-( + {-(Statements {-(Integer)-} {-(Integer)-})-})-}) diff --git a/test/fixtures/python/corpus/assignment.diffB-A.txt b/test/fixtures/python/corpus/assignment.diffB-A.txt index bf818d4b1..3f7d8e47a 100644 --- a/test/fixtures/python/corpus/assignment.diffB-A.txt +++ b/test/fixtures/python/corpus/assignment.diffB-A.txt @@ -3,16 +3,16 @@ {+(Identifier)+} {+(Integer)+})+} (Assignment - ( + (Statements (Identifier) (Identifier)) - ( + (Statements {-(Integer)-} (Integer) {+(Integer)+})) {+(Assignment {+(Identifier)+} - {+( + {+(Statements {+(Integer)+} {+(Integer)+})+})+} {-(Assignment @@ -20,6 +20,6 @@ {-(Integer)-})-} {-(Assignment {-(Identifier)-} - {-( + {-(Statements {-(Integer)-} {-(Integer)-})-})-}) diff --git a/test/fixtures/python/corpus/assignment.parseA.txt b/test/fixtures/python/corpus/assignment.parseA.txt index d93fb0821..f0ffb8e02 100644 --- a/test/fixtures/python/corpus/assignment.parseA.txt +++ b/test/fixtures/python/corpus/assignment.parseA.txt @@ -3,14 +3,14 @@ (Identifier) (Integer)) (Assignment - ( + (Statements (Identifier) (Identifier)) - ( + (Statements (Integer) (Integer))) (Assignment (Identifier) - ( + (Statements (Integer) (Integer)))) diff --git a/test/fixtures/python/corpus/assignment.parseB.txt b/test/fixtures/python/corpus/assignment.parseB.txt index 38f765e34..bff44b92e 100644 --- a/test/fixtures/python/corpus/assignment.parseB.txt +++ b/test/fixtures/python/corpus/assignment.parseB.txt @@ -1,9 +1,9 @@ (Program (Assignment - ( + (Statements (Identifier) (Identifier)) - ( + (Statements (Integer) (Integer))) (Assignment @@ -11,6 +11,6 @@ (Integer)) (Assignment (Identifier) - ( + (Statements (Integer) (Integer)))) diff --git a/test/fixtures/python/corpus/concatenated-string.diffA-B.txt b/test/fixtures/python/corpus/concatenated-string.diffA-B.txt index d52ae0d35..e7430694b 100644 --- a/test/fixtures/python/corpus/concatenated-string.diffA-B.txt +++ b/test/fixtures/python/corpus/concatenated-string.diffA-B.txt @@ -1,5 +1,5 @@ (Program - ( + (Statements {-(TextElement)-} (TextElement) {+(TextElement)+} diff --git a/test/fixtures/python/corpus/concatenated-string.diffB-A.txt b/test/fixtures/python/corpus/concatenated-string.diffB-A.txt index 4387d6826..eccb0b1a1 100644 --- a/test/fixtures/python/corpus/concatenated-string.diffB-A.txt +++ b/test/fixtures/python/corpus/concatenated-string.diffB-A.txt @@ -1,5 +1,5 @@ (Program - ( + (Statements {-(TextElement)-} (TextElement) { (TextElement) diff --git a/test/fixtures/python/corpus/concatenated-string.parseA.txt b/test/fixtures/python/corpus/concatenated-string.parseA.txt index de9e080d5..acb17c616 100644 --- a/test/fixtures/python/corpus/concatenated-string.parseA.txt +++ b/test/fixtures/python/corpus/concatenated-string.parseA.txt @@ -1,5 +1,5 @@ (Program - ( + (Statements (TextElement) (TextElement) (TextElement))) diff --git a/test/fixtures/python/corpus/concatenated-string.parseB.txt b/test/fixtures/python/corpus/concatenated-string.parseB.txt index 64ca8c93b..fa4a37766 100644 --- a/test/fixtures/python/corpus/concatenated-string.parseB.txt +++ b/test/fixtures/python/corpus/concatenated-string.parseB.txt @@ -1,5 +1,5 @@ (Program - ( + (Statements (TextElement) (TextElement) (TextElement) diff --git a/test/fixtures/python/corpus/decorated-definition.diffA-B.txt b/test/fixtures/python/corpus/decorated-definition.diffA-B.txt index f0a6b4fb2..510db5649 100644 --- a/test/fixtures/python/corpus/decorated-definition.diffA-B.txt +++ b/test/fixtures/python/corpus/decorated-definition.diffA-B.txt @@ -6,7 +6,7 @@ ->(Identifier) } (Decorator (Identifier) - ([]) + (Statements) (Decorator { (Identifier) ->(Identifier) } @@ -16,12 +16,12 @@ { (Identifier) ->(Identifier) } {+(Identifier)+} - {-( + {-(Statements {-(Integer)-} {-(Integer)-})-} (Decorator (Identifier) - {+( + {+(Statements {+(Integer)+} {+(Assignment {+(Identifier)+} @@ -39,7 +39,7 @@ {-(Identifier)-} {-(Decorator {-(Identifier)-} - {-( + {-(Statements {-(Integer)-} {-(Assignment {-(Identifier)-} diff --git a/test/fixtures/python/corpus/decorated-definition.diffB-A.txt b/test/fixtures/python/corpus/decorated-definition.diffB-A.txt index 85a7a6104..bb3125542 100644 --- a/test/fixtures/python/corpus/decorated-definition.diffB-A.txt +++ b/test/fixtures/python/corpus/decorated-definition.diffB-A.txt @@ -6,7 +6,7 @@ ->(Identifier) } (Decorator (Identifier) - ([]) + (Statements) (Decorator { (Identifier) ->(Identifier) } @@ -15,7 +15,7 @@ (Decorator { (Identifier) ->(Identifier) } - {+( + {+(Statements {+(Integer)+} {+(Integer)+})+} {-(Identifier)-} @@ -24,7 +24,7 @@ {+(Assignment {+(Identifier)+} {+(Boolean)+})+} - {-( + {-(Statements {-(Integer)-} {-(Assignment {-(Identifier)-} @@ -44,7 +44,7 @@ {+(Identifier)+} {+(Decorator {+(Identifier)+} - {+( + {+(Statements {+(Integer)+} {+(Assignment {+(Identifier)+} diff --git a/test/fixtures/python/corpus/decorated-definition.parseA.txt b/test/fixtures/python/corpus/decorated-definition.parseA.txt index df00a660f..2250469bd 100644 --- a/test/fixtures/python/corpus/decorated-definition.parseA.txt +++ b/test/fixtures/python/corpus/decorated-definition.parseA.txt @@ -5,13 +5,13 @@ (Identifier) (Decorator (Identifier) - ([]) + (Statements) (Decorator (Identifier) (Integer) (Decorator (Identifier) - ( + (Statements (Integer) (Integer)) (Decorator @@ -27,7 +27,7 @@ (Identifier) (Decorator (Identifier) - ( + (Statements (Integer) (Assignment (Identifier) diff --git a/test/fixtures/python/corpus/decorated-definition.parseB.txt b/test/fixtures/python/corpus/decorated-definition.parseB.txt index d52f95e20..25ce8eb60 100644 --- a/test/fixtures/python/corpus/decorated-definition.parseB.txt +++ b/test/fixtures/python/corpus/decorated-definition.parseB.txt @@ -5,7 +5,7 @@ (Identifier) (Decorator (Identifier) - ([]) + (Statements) (Decorator (Identifier) (Identifier) @@ -14,7 +14,7 @@ (Identifier) (Decorator (Identifier) - ( + (Statements (Integer) (Assignment (Identifier) diff --git a/test/fixtures/python/corpus/dictionary-comprehension.diffA-B.txt b/test/fixtures/python/corpus/dictionary-comprehension.diffA-B.txt index 44b5c82b0..dc0803e7d 100644 --- a/test/fixtures/python/corpus/dictionary-comprehension.diffA-B.txt +++ b/test/fixtures/python/corpus/dictionary-comprehension.diffA-B.txt @@ -5,8 +5,8 @@ ->(Identifier) } { (Identifier) ->(Identifier) }) - ( - {+( + (Statements + {+(Statements {+(Identifier)+} {+(Identifier)+})+} { (Identifier) @@ -18,10 +18,10 @@ ->(Identifier) } { (Identifier) ->(Integer) }) - ( + (Statements {+(Identifier)+} {+(Identifier)+} - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} {-(Identifier)-}))) diff --git a/test/fixtures/python/corpus/dictionary-comprehension.diffB-A.txt b/test/fixtures/python/corpus/dictionary-comprehension.diffB-A.txt index 932512545..80382a5a3 100644 --- a/test/fixtures/python/corpus/dictionary-comprehension.diffB-A.txt +++ b/test/fixtures/python/corpus/dictionary-comprehension.diffB-A.txt @@ -5,10 +5,10 @@ ->(Identifier) } { (Identifier) ->(Identifier) }) - ( + (Statements {+(Identifier)+} {+(Identifier)+} - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} {-(Identifier)-})) @@ -18,8 +18,8 @@ ->(Identifier) } { (Integer) ->(Identifier) }) - ( - {+( + (Statements + {+(Statements {+(Identifier)+} {+(Identifier)+})+} { (Identifier) diff --git a/test/fixtures/python/corpus/dictionary-comprehension.parseA.txt b/test/fixtures/python/corpus/dictionary-comprehension.parseA.txt index 3cdfe0873..49a09e8d8 100644 --- a/test/fixtures/python/corpus/dictionary-comprehension.parseA.txt +++ b/test/fixtures/python/corpus/dictionary-comprehension.parseA.txt @@ -3,15 +3,15 @@ (KeyValue (Identifier) (Identifier)) - ( + (Statements (Identifier) (Identifier))) (Comprehension (KeyValue (Identifier) (Identifier)) - ( - ( + (Statements + (Statements (Identifier) (Identifier)) (Identifier)))) diff --git a/test/fixtures/python/corpus/dictionary-comprehension.parseB.txt b/test/fixtures/python/corpus/dictionary-comprehension.parseB.txt index a4da21d92..51e66945f 100644 --- a/test/fixtures/python/corpus/dictionary-comprehension.parseB.txt +++ b/test/fixtures/python/corpus/dictionary-comprehension.parseB.txt @@ -3,8 +3,8 @@ (KeyValue (Identifier) (Identifier)) - ( - ( + (Statements + (Statements (Identifier) (Identifier)) (Identifier))) @@ -12,6 +12,6 @@ (KeyValue (Identifier) (Integer)) - ( + (Statements (Identifier) (Identifier)))) diff --git a/test/fixtures/python/corpus/expression-statement.diffA-B.txt b/test/fixtures/python/corpus/expression-statement.diffA-B.txt index 260608ca3..ea55a1130 100644 --- a/test/fixtures/python/corpus/expression-statement.diffA-B.txt +++ b/test/fixtures/python/corpus/expression-statement.diffA-B.txt @@ -3,12 +3,12 @@ {-(Plus {-(Identifier)-} {-(Identifier)-})-} - ( + (Statements (Integer) (Integer) (Integer)) {+(Identifier)+} - ( + (Statements {+(Integer)+} (Integer) (Integer) diff --git a/test/fixtures/python/corpus/expression-statement.diffB-A.txt b/test/fixtures/python/corpus/expression-statement.diffB-A.txt index 1bbccbc08..f4b01c082 100644 --- a/test/fixtures/python/corpus/expression-statement.diffB-A.txt +++ b/test/fixtures/python/corpus/expression-statement.diffB-A.txt @@ -3,16 +3,16 @@ {+(Plus {+(Identifier)+} {+(Identifier)+})+} - ( + (Statements (Integer) (Integer) (Integer)) -{+( +{+(Statements {+(Integer)+} {+(Integer)+} {+(Integer)+})+} {-(Identifier)-} -{-( +{-(Statements {-(Integer)-} {-(Integer)-} {-(Integer)-})-} diff --git a/test/fixtures/python/corpus/expression-statement.parseA.txt b/test/fixtures/python/corpus/expression-statement.parseA.txt index 2a804df06..c0bc3ce18 100644 --- a/test/fixtures/python/corpus/expression-statement.parseA.txt +++ b/test/fixtures/python/corpus/expression-statement.parseA.txt @@ -3,11 +3,11 @@ (Plus (Identifier) (Identifier)) - ( + (Statements (Integer) (Integer) (Integer)) - ( + (Statements (Integer) (Integer) (Integer))) diff --git a/test/fixtures/python/corpus/expression-statement.parseB.txt b/test/fixtures/python/corpus/expression-statement.parseB.txt index 34dabf60b..e93d92934 100644 --- a/test/fixtures/python/corpus/expression-statement.parseB.txt +++ b/test/fixtures/python/corpus/expression-statement.parseB.txt @@ -1,10 +1,10 @@ (Program - ( + (Statements (Integer) (Integer) (Integer)) (Identifier) - ( + (Statements (Integer) (Integer) (Integer)) diff --git a/test/fixtures/python/corpus/for-statement.diffA-B.txt b/test/fixtures/python/corpus/for-statement.diffA-B.txt index b8d3a9af4..7513a42ec 100644 --- a/test/fixtures/python/corpus/for-statement.diffA-B.txt +++ b/test/fixtures/python/corpus/for-statement.diffA-B.txt @@ -8,27 +8,27 @@ {+(Integer)+})+} {+(Tuple {+(Integer)+})+})+} - {+( + {+(Statements {+(Identifier)+})+})+} (Else (ForEach - ( + (Statements (Identifier) { (Identifier) ->(Identifier) }) (Identifier) - ( + (Statements (Call (Identifier) (Identifier) (Empty)) (ForEach - ( + (Statements (Identifier) { (Identifier) ->(Identifier) }) (Identifier) - ( + (Statements (Call (Identifier) (Identifier) @@ -47,5 +47,5 @@ {-(Integer)-})-} {-(Tuple {-(Integer)-})-})-} - {-( + {-(Statements {-(Identifier)-})-})-}) diff --git a/test/fixtures/python/corpus/for-statement.diffB-A.txt b/test/fixtures/python/corpus/for-statement.diffB-A.txt index b1a038936..19dd5c34f 100644 --- a/test/fixtures/python/corpus/for-statement.diffB-A.txt +++ b/test/fixtures/python/corpus/for-statement.diffB-A.txt @@ -1,21 +1,21 @@ (Program {+(Else {+(ForEach - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+} {+(Identifier)+} - {+( + {+(Statements {+(Call {+(Identifier)+} {+(Identifier)+} {+(Empty)+})+} {+(ForEach - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+} {+(Identifier)+} - {+( + {+(Statements {+(Call {+(Identifier)+} {+(Identifier)+} @@ -34,26 +34,26 @@ (Integer)) (Tuple (Integer))) - ( + (Statements { (Identifier) ->(Identifier) })) {-(Else {-(ForEach - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} {-(Identifier)-} - {-( + {-(Statements {-(Call {-(Identifier)-} {-(Identifier)-} {-(Empty)-})-} {-(ForEach - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} {-(Identifier)-} - {-( + {-(Statements {-(Call {-(Identifier)-} {-(Identifier)-} diff --git a/test/fixtures/python/corpus/for-statement.parseA.txt b/test/fixtures/python/corpus/for-statement.parseA.txt index 6811bf720..59e599336 100644 --- a/test/fixtures/python/corpus/for-statement.parseA.txt +++ b/test/fixtures/python/corpus/for-statement.parseA.txt @@ -1,21 +1,21 @@ (Program (Else (ForEach - ( + (Statements (Identifier) (Identifier)) (Identifier) - ( + (Statements (Call (Identifier) (Identifier) (Empty)) (ForEach - ( + (Statements (Identifier) (Identifier)) (Identifier) - ( + (Statements (Call (Identifier) (Identifier) @@ -33,5 +33,5 @@ (Integer)) (Tuple (Integer))) - ( + (Statements (Identifier)))) diff --git a/test/fixtures/python/corpus/for-statement.parseB.txt b/test/fixtures/python/corpus/for-statement.parseB.txt index eb71bd86b..d48c01f77 100644 --- a/test/fixtures/python/corpus/for-statement.parseB.txt +++ b/test/fixtures/python/corpus/for-statement.parseB.txt @@ -8,25 +8,25 @@ (Integer)) (Tuple (Integer))) - ( + (Statements (Identifier))) (Else (ForEach - ( + (Statements (Identifier) (Identifier)) (Identifier) - ( + (Statements (Call (Identifier) (Identifier) (Empty)) (ForEach - ( + (Statements (Identifier) (Identifier)) (Identifier) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/python/corpus/generator-expression.diffA-B.txt b/test/fixtures/python/corpus/generator-expression.diffA-B.txt index 3484c5288..34837f585 100644 --- a/test/fixtures/python/corpus/generator-expression.diffA-B.txt +++ b/test/fixtures/python/corpus/generator-expression.diffA-B.txt @@ -2,7 +2,7 @@ (Comprehension { (Identifier) ->(Identifier) } - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) @@ -12,7 +12,7 @@ ->(Plus {+(Identifier)+} {+(Integer)+}) } - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) diff --git a/test/fixtures/python/corpus/generator-expression.diffB-A.txt b/test/fixtures/python/corpus/generator-expression.diffB-A.txt index d199e6c54..7cbbefea7 100644 --- a/test/fixtures/python/corpus/generator-expression.diffB-A.txt +++ b/test/fixtures/python/corpus/generator-expression.diffB-A.txt @@ -2,7 +2,7 @@ (Comprehension { (Identifier) ->(Identifier) } - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) @@ -12,7 +12,7 @@ {-(Identifier)-} {-(Integer)-}) ->(Identifier) } - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) diff --git a/test/fixtures/python/corpus/generator-expression.parseA.txt b/test/fixtures/python/corpus/generator-expression.parseA.txt index 5d0fe51fe..926348cdc 100644 --- a/test/fixtures/python/corpus/generator-expression.parseA.txt +++ b/test/fixtures/python/corpus/generator-expression.parseA.txt @@ -1,11 +1,11 @@ (Program (Comprehension (Identifier) - ( + (Statements (Identifier) (Identifier))) (Comprehension (Identifier) - ( + (Statements (Identifier) (Identifier)))) diff --git a/test/fixtures/python/corpus/generator-expression.parseB.txt b/test/fixtures/python/corpus/generator-expression.parseB.txt index 4d04bd87e..d5f7c1f64 100644 --- a/test/fixtures/python/corpus/generator-expression.parseB.txt +++ b/test/fixtures/python/corpus/generator-expression.parseB.txt @@ -1,13 +1,13 @@ (Program (Comprehension (Identifier) - ( + (Statements (Identifier) (Identifier))) (Comprehension (Plus (Identifier) (Integer)) - ( + (Statements (Identifier) (Identifier)))) diff --git a/test/fixtures/python/corpus/if-statement.diffA-B.txt b/test/fixtures/python/corpus/if-statement.diffA-B.txt index 4df75d39b..73708da79 100644 --- a/test/fixtures/python/corpus/if-statement.diffA-B.txt +++ b/test/fixtures/python/corpus/if-statement.diffA-B.txt @@ -2,16 +2,16 @@ (If { (Identifier) ->(Identifier) } - ( + (Statements {+(Identifier)+} (Identifier) {-(Identifier)-}) { (If {-(Identifier)-} - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-}) ->(Empty) })) diff --git a/test/fixtures/python/corpus/if-statement.diffB-A.txt b/test/fixtures/python/corpus/if-statement.diffB-A.txt index f054256a7..c604cad8a 100644 --- a/test/fixtures/python/corpus/if-statement.diffB-A.txt +++ b/test/fixtures/python/corpus/if-statement.diffB-A.txt @@ -2,16 +2,16 @@ (If { (Identifier) ->(Identifier) } - ( + (Statements {-(Identifier)-} (Identifier) {+(Identifier)+}) { (Empty) ->(If {+(Identifier)+} - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+} - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+}) })) diff --git a/test/fixtures/python/corpus/if-statement.parseA.txt b/test/fixtures/python/corpus/if-statement.parseA.txt index fb5df2197..97223d23b 100644 --- a/test/fixtures/python/corpus/if-statement.parseA.txt +++ b/test/fixtures/python/corpus/if-statement.parseA.txt @@ -1,14 +1,14 @@ (Program (If (Identifier) - ( + (Statements (Identifier) (Identifier)) (If (Identifier) - ( + (Statements (Identifier) (Identifier)) - ( + (Statements (Identifier) (Identifier))))) diff --git a/test/fixtures/python/corpus/if-statement.parseB.txt b/test/fixtures/python/corpus/if-statement.parseB.txt index 7bde4e191..14179ed8a 100644 --- a/test/fixtures/python/corpus/if-statement.parseB.txt +++ b/test/fixtures/python/corpus/if-statement.parseB.txt @@ -1,7 +1,7 @@ (Program (If (Identifier) - ( + (Statements (Identifier) (Identifier)) (Empty))) diff --git a/test/fixtures/python/corpus/import-statement.diffA-B.txt b/test/fixtures/python/corpus/import-statement.diffA-B.txt index 5ded7d2a8..b6263e2ee 100644 --- a/test/fixtures/python/corpus/import-statement.diffA-B.txt +++ b/test/fixtures/python/corpus/import-statement.diffA-B.txt @@ -1,5 +1,5 @@ (Program - ( + (Statements {+(QualifiedImport)+} (QualifiedImport) {-(QualifiedAliasedImport @@ -7,7 +7,7 @@ {+(QualifiedAliasedImport {+(Identifier)+})+} {+(QualifiedImport)+} -{-( +{-(Statements {-(QualifiedAliasedImport {-(Identifier)-})-} {-(QualifiedImport)-})-} diff --git a/test/fixtures/python/corpus/import-statement.diffB-A.txt b/test/fixtures/python/corpus/import-statement.diffB-A.txt index 0ee92833f..66546a122 100644 --- a/test/fixtures/python/corpus/import-statement.diffB-A.txt +++ b/test/fixtures/python/corpus/import-statement.diffB-A.txt @@ -1,10 +1,10 @@ (Program - ( + (Statements {-(QualifiedImport)-} (QualifiedImport) {+(QualifiedAliasedImport {+(Identifier)+})+}) -{+( +{+(Statements {+(QualifiedAliasedImport {+(Identifier)+})+} {+(QualifiedImport)+})+} diff --git a/test/fixtures/python/corpus/import-statement.parseA.txt b/test/fixtures/python/corpus/import-statement.parseA.txt index e6a5033b1..cd5a2f551 100644 --- a/test/fixtures/python/corpus/import-statement.parseA.txt +++ b/test/fixtures/python/corpus/import-statement.parseA.txt @@ -1,9 +1,9 @@ (Program - ( + (Statements (QualifiedImport) (QualifiedAliasedImport (Identifier))) - ( + (Statements (QualifiedAliasedImport (Identifier)) (QualifiedImport)) diff --git a/test/fixtures/python/corpus/import-statement.parseB.txt b/test/fixtures/python/corpus/import-statement.parseB.txt index 39daaa1db..ff6acffe2 100644 --- a/test/fixtures/python/corpus/import-statement.parseB.txt +++ b/test/fixtures/python/corpus/import-statement.parseB.txt @@ -1,5 +1,5 @@ (Program - ( + (Statements (QualifiedImport) (QualifiedImport)) (QualifiedAliasedImport diff --git a/test/fixtures/python/corpus/list-comprehension.diffA-B.txt b/test/fixtures/python/corpus/list-comprehension.diffA-B.txt index a5801dc53..a47830074 100644 --- a/test/fixtures/python/corpus/list-comprehension.diffA-B.txt +++ b/test/fixtures/python/corpus/list-comprehension.diffA-B.txt @@ -2,14 +2,14 @@ (Comprehension { (Identifier) ->(Identifier) } - ( - {+( + (Statements + {+(Statements {+(Identifier)+} {+(Identifier)+})+} {+(Call {+(Identifier)+} {+(Empty)+})+} - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+} {+(Call @@ -22,10 +22,10 @@ ->(Plus {+(Identifier)+} {+(Integer)+}) } - ( + (Statements {+(Identifier)+} {+(Identifier)+} - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} {-(Identifier)-}))) diff --git a/test/fixtures/python/corpus/list-comprehension.diffB-A.txt b/test/fixtures/python/corpus/list-comprehension.diffB-A.txt index a3c181151..fc4c064af 100644 --- a/test/fixtures/python/corpus/list-comprehension.diffB-A.txt +++ b/test/fixtures/python/corpus/list-comprehension.diffB-A.txt @@ -2,16 +2,16 @@ (Comprehension { (Identifier) ->(Identifier) } - ( + (Statements {+(Identifier)+} {+(Identifier)+} - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} {-(Call {-(Identifier)-} {-(Empty)-})-} - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} {-(Call @@ -22,8 +22,8 @@ {-(Identifier)-} {-(Integer)-}) ->(Identifier) } - ( - {+( + (Statements + {+(Statements {+(Identifier)+} {+(Identifier)+})+} { (Identifier) diff --git a/test/fixtures/python/corpus/list-comprehension.parseA.txt b/test/fixtures/python/corpus/list-comprehension.parseA.txt index dd0a83238..927e76638 100644 --- a/test/fixtures/python/corpus/list-comprehension.parseA.txt +++ b/test/fixtures/python/corpus/list-comprehension.parseA.txt @@ -1,13 +1,13 @@ (Program (Comprehension (Identifier) - ( + (Statements (Identifier) (Identifier))) (Comprehension (Identifier) - ( - ( + (Statements + (Statements (Identifier) (Identifier)) (Identifier)))) diff --git a/test/fixtures/python/corpus/list-comprehension.parseB.txt b/test/fixtures/python/corpus/list-comprehension.parseB.txt index de2c92ee8..59256c488 100644 --- a/test/fixtures/python/corpus/list-comprehension.parseB.txt +++ b/test/fixtures/python/corpus/list-comprehension.parseB.txt @@ -1,14 +1,14 @@ (Program (Comprehension (Identifier) - ( - ( + (Statements + (Statements (Identifier) (Identifier)) (Call (Identifier) (Empty)) - ( + (Statements (Identifier) (Identifier)) (Call @@ -18,6 +18,6 @@ (Plus (Identifier) (Integer)) - ( + (Statements (Identifier) (Identifier)))) diff --git a/test/fixtures/python/corpus/raise-statement.diffA-B.txt b/test/fixtures/python/corpus/raise-statement.diffA-B.txt index 35e466cf8..a05bf8019 100644 --- a/test/fixtures/python/corpus/raise-statement.diffA-B.txt +++ b/test/fixtures/python/corpus/raise-statement.diffA-B.txt @@ -5,21 +5,21 @@ {+(TextElement)+} {+(Empty)+})+})+} {+(Throw - {+( + {+(Statements {+(Call {+(Identifier)+} {+(TextElement)+} {+(Empty)+})+} {+(Identifier)+})+})+} (Throw - ([])) + (Statements)) {-(Throw {-(Call {-(Identifier)-} {-(TextElement)-} {-(Empty)-})-})-} {-(Throw - {-( + {-(Statements {-(Call {-(Identifier)-} {-(TextElement)-} diff --git a/test/fixtures/python/corpus/raise-statement.diffB-A.txt b/test/fixtures/python/corpus/raise-statement.diffB-A.txt index 48863f31f..2217380cb 100644 --- a/test/fixtures/python/corpus/raise-statement.diffB-A.txt +++ b/test/fixtures/python/corpus/raise-statement.diffB-A.txt @@ -5,21 +5,21 @@ {-(TextElement)-} {-(Empty)-})-})-} {-(Throw - {-( + {-(Statements {-(Call {-(Identifier)-} {-(TextElement)-} {-(Empty)-})-} {-(Identifier)-})-})-} (Throw - ([])) + (Statements)) {+(Throw {+(Call {+(Identifier)+} {+(TextElement)+} {+(Empty)+})+})+} {+(Throw - {+( + {+(Statements {+(Call {+(Identifier)+} {+(TextElement)+} diff --git a/test/fixtures/python/corpus/raise-statement.parseA.txt b/test/fixtures/python/corpus/raise-statement.parseA.txt index b0ba84d68..c3f6865e0 100644 --- a/test/fixtures/python/corpus/raise-statement.parseA.txt +++ b/test/fixtures/python/corpus/raise-statement.parseA.txt @@ -1,13 +1,13 @@ (Program (Throw - ([])) + (Statements)) (Throw (Call (Identifier) (TextElement) (Empty))) (Throw - ( + (Statements (Call (Identifier) (TextElement) diff --git a/test/fixtures/python/corpus/raise-statement.parseB.txt b/test/fixtures/python/corpus/raise-statement.parseB.txt index 07853776a..2f21ece90 100644 --- a/test/fixtures/python/corpus/raise-statement.parseB.txt +++ b/test/fixtures/python/corpus/raise-statement.parseB.txt @@ -5,11 +5,11 @@ (TextElement) (Empty))) (Throw - ( + (Statements (Call (Identifier) (TextElement) (Empty)) (Identifier))) (Throw - ([]))) + (Statements))) diff --git a/test/fixtures/python/corpus/return-statement.diffA-B.txt b/test/fixtures/python/corpus/return-statement.diffA-B.txt index 0798a925c..b346595d2 100644 --- a/test/fixtures/python/corpus/return-statement.diffA-B.txt +++ b/test/fixtures/python/corpus/return-statement.diffA-B.txt @@ -1,6 +1,6 @@ (Program {+(Return - {+( + {+(Statements {+(Plus {+(Identifier)+} {+(Identifier)+})+} @@ -8,7 +8,7 @@ (Return (Empty)) (Return - { ( + { (Statements {-(Plus {-(Identifier)-} {-(Identifier)-})-} diff --git a/test/fixtures/python/corpus/return-statement.diffB-A.txt b/test/fixtures/python/corpus/return-statement.diffB-A.txt index d9a15a3d4..44783eaaa 100644 --- a/test/fixtures/python/corpus/return-statement.diffB-A.txt +++ b/test/fixtures/python/corpus/return-statement.diffB-A.txt @@ -1,6 +1,6 @@ (Program {-(Return - {-( + {-(Statements {-(Plus {-(Identifier)-} {-(Identifier)-})-} @@ -10,7 +10,7 @@ (Return { (Not {-(Identifier)-}) - ->( + ->(Statements {+(Plus {+(Identifier)+} {+(Identifier)+})+} diff --git a/test/fixtures/python/corpus/return-statement.parseA.txt b/test/fixtures/python/corpus/return-statement.parseA.txt index db83de41e..581590159 100644 --- a/test/fixtures/python/corpus/return-statement.parseA.txt +++ b/test/fixtures/python/corpus/return-statement.parseA.txt @@ -2,7 +2,7 @@ (Return (Empty)) (Return - ( + (Statements (Plus (Identifier) (Identifier)) diff --git a/test/fixtures/python/corpus/return-statement.parseB.txt b/test/fixtures/python/corpus/return-statement.parseB.txt index 10e570c6b..bf6bee6ed 100644 --- a/test/fixtures/python/corpus/return-statement.parseB.txt +++ b/test/fixtures/python/corpus/return-statement.parseB.txt @@ -1,6 +1,6 @@ (Program (Return - ( + (Statements (Plus (Identifier) (Identifier)) diff --git a/test/fixtures/python/corpus/set-comprehension.diffA-B.txt b/test/fixtures/python/corpus/set-comprehension.diffA-B.txt index 3484c5288..34837f585 100644 --- a/test/fixtures/python/corpus/set-comprehension.diffA-B.txt +++ b/test/fixtures/python/corpus/set-comprehension.diffA-B.txt @@ -2,7 +2,7 @@ (Comprehension { (Identifier) ->(Identifier) } - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) @@ -12,7 +12,7 @@ ->(Plus {+(Identifier)+} {+(Integer)+}) } - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) diff --git a/test/fixtures/python/corpus/set-comprehension.diffB-A.txt b/test/fixtures/python/corpus/set-comprehension.diffB-A.txt index d199e6c54..7cbbefea7 100644 --- a/test/fixtures/python/corpus/set-comprehension.diffB-A.txt +++ b/test/fixtures/python/corpus/set-comprehension.diffB-A.txt @@ -2,7 +2,7 @@ (Comprehension { (Identifier) ->(Identifier) } - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) @@ -12,7 +12,7 @@ {-(Identifier)-} {-(Integer)-}) ->(Identifier) } - ( + (Statements { (Identifier) ->(Identifier) } { (Identifier) diff --git a/test/fixtures/python/corpus/set-comprehension.parseA.txt b/test/fixtures/python/corpus/set-comprehension.parseA.txt index 5d0fe51fe..926348cdc 100644 --- a/test/fixtures/python/corpus/set-comprehension.parseA.txt +++ b/test/fixtures/python/corpus/set-comprehension.parseA.txt @@ -1,11 +1,11 @@ (Program (Comprehension (Identifier) - ( + (Statements (Identifier) (Identifier))) (Comprehension (Identifier) - ( + (Statements (Identifier) (Identifier)))) diff --git a/test/fixtures/python/corpus/set-comprehension.parseB.txt b/test/fixtures/python/corpus/set-comprehension.parseB.txt index 4d04bd87e..d5f7c1f64 100644 --- a/test/fixtures/python/corpus/set-comprehension.parseB.txt +++ b/test/fixtures/python/corpus/set-comprehension.parseB.txt @@ -1,13 +1,13 @@ (Program (Comprehension (Identifier) - ( + (Statements (Identifier) (Identifier))) (Comprehension (Plus (Identifier) (Integer)) - ( + (Statements (Identifier) (Identifier)))) diff --git a/test/fixtures/python/corpus/try-statement.diffA-B.txt b/test/fixtures/python/corpus/try-statement.diffA-B.txt index ab0d4b8a8..386b10bc4 100644 --- a/test/fixtures/python/corpus/try-statement.diffA-B.txt +++ b/test/fixtures/python/corpus/try-statement.diffA-B.txt @@ -6,39 +6,39 @@ {+(Identifier)+})+} {-(Identifier)-} {-(Catch - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-} {-(Identifier)-})-} - {-([])-})-} + {-(Statements)-})-} {-(Catch {-(Let {-(Identifier)-} {-(Identifier)-} {-(Empty)-})-} - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-})-} {-(Catch - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-} {-(Identifier)-} {-(Identifier)-})-} - {-([])-})-} + {-(Statements)-})-} {-(Catch - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} - {-([])-})-}) + {-(Statements)-})-}) (Try { (Identifier) ->(Identifier) } {+(Catch - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+} - {+([])+})+} + {+(Statements)+})+} {+(Catch {+(Let {+(Identifier)+} @@ -46,16 +46,16 @@ {+(Empty)+})+} {+(Identifier)+})+} {+(Catch - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+} {+(Identifier)+})+} - {+([])+})+} + {+(Statements)+})+} {+(Catch {+(Identifier)+} - {+([])+})+} + {+(Statements)+})+} {-(Identifier)-} {-(Finally - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-})-})) diff --git a/test/fixtures/python/corpus/try-statement.diffB-A.txt b/test/fixtures/python/corpus/try-statement.diffB-A.txt index 50f6d6864..6505dab19 100644 --- a/test/fixtures/python/corpus/try-statement.diffB-A.txt +++ b/test/fixtures/python/corpus/try-statement.diffB-A.txt @@ -4,31 +4,31 @@ ->(Identifier) } {+(Identifier)+} {+(Catch - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+} {+(Identifier)+})+} - {+([])+})+} + {+(Statements)+})+} {+(Catch {+(Let {+(Identifier)+} {+(Identifier)+} {+(Empty)+})+} - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+})+} {+(Catch - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+} {+(Identifier)+} {+(Identifier)+})+} - {+([])+})+} + {+(Statements)+})+} {+(Catch - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+} - {+([])+})+} + {+(Statements)+})+} {-(Finally {-(Identifier)-})-}) (Try @@ -36,14 +36,14 @@ ->(Identifier) } {+(Identifier)+} {+(Finally - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+})+} {-(Catch - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} - {-([])-})-} + {-(Statements)-})-} {-(Catch {-(Let {-(Identifier)-} @@ -51,11 +51,11 @@ {-(Empty)-})-} {-(Identifier)-})-} {-(Catch - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-} {-(Identifier)-})-} - {-([])-})-} + {-(Statements)-})-} {-(Catch {-(Identifier)-} - {-([])-})-})) + {-(Statements)-})-})) diff --git a/test/fixtures/python/corpus/try-statement.parseA.txt b/test/fixtures/python/corpus/try-statement.parseA.txt index 027fdec43..57f428a7f 100644 --- a/test/fixtures/python/corpus/try-statement.parseA.txt +++ b/test/fixtures/python/corpus/try-statement.parseA.txt @@ -3,35 +3,35 @@ (Identifier) (Identifier) (Catch - ( + (Statements (Identifier) (Identifier) (Identifier)) - ([])) + (Statements)) (Catch (Let (Identifier) (Identifier) (Empty)) - ( + (Statements (Identifier) (Identifier))) (Catch - ( + (Statements (Identifier) (Identifier) (Identifier) (Identifier)) - ([])) + (Statements)) (Catch - ( + (Statements (Identifier) (Identifier)) - ([]))) + (Statements))) (Try (Identifier) (Identifier) (Finally - ( + (Statements (Identifier) (Identifier))))) diff --git a/test/fixtures/python/corpus/try-statement.parseB.txt b/test/fixtures/python/corpus/try-statement.parseB.txt index 77180043b..1eefadf9b 100644 --- a/test/fixtures/python/corpus/try-statement.parseB.txt +++ b/test/fixtures/python/corpus/try-statement.parseB.txt @@ -6,10 +6,10 @@ (Try (Identifier) (Catch - ( + (Statements (Identifier) (Identifier)) - ([])) + (Statements)) (Catch (Let (Identifier) @@ -17,11 +17,11 @@ (Empty)) (Identifier)) (Catch - ( + (Statements (Identifier) (Identifier) (Identifier)) - ([])) + (Statements)) (Catch (Identifier) - ([])))) + (Statements)))) diff --git a/test/fixtures/python/corpus/while-statement.diffA-B.txt b/test/fixtures/python/corpus/while-statement.diffA-B.txt index c49fe2352..29439f949 100644 --- a/test/fixtures/python/corpus/while-statement.diffA-B.txt +++ b/test/fixtures/python/corpus/while-statement.diffA-B.txt @@ -2,7 +2,7 @@ (While { (Identifier) ->(Identifier) } - ( + (Statements {-(NoOp {-(Empty)-})-} (Break diff --git a/test/fixtures/python/corpus/while-statement.diffB-A.txt b/test/fixtures/python/corpus/while-statement.diffB-A.txt index bce43a580..8fde658c7 100644 --- a/test/fixtures/python/corpus/while-statement.diffB-A.txt +++ b/test/fixtures/python/corpus/while-statement.diffB-A.txt @@ -2,7 +2,7 @@ (While { (Identifier) ->(Identifier) } - ( + (Statements {+(NoOp {+(Empty)+})+} (Break diff --git a/test/fixtures/python/corpus/while-statement.parseA.txt b/test/fixtures/python/corpus/while-statement.parseA.txt index 8fd702c80..bdfdc70cc 100644 --- a/test/fixtures/python/corpus/while-statement.parseA.txt +++ b/test/fixtures/python/corpus/while-statement.parseA.txt @@ -1,7 +1,7 @@ (Program (While (Identifier) - ( + (Statements (NoOp (Empty)) (Break diff --git a/test/fixtures/python/corpus/while-statement.parseB.txt b/test/fixtures/python/corpus/while-statement.parseB.txt index 7db912d69..05289b27e 100644 --- a/test/fixtures/python/corpus/while-statement.parseB.txt +++ b/test/fixtures/python/corpus/while-statement.parseB.txt @@ -1,7 +1,7 @@ (Program (While (Identifier) - ( + (Statements (Break (Empty)) (Continue diff --git a/test/fixtures/python/corpus/with-statement.diffA-B.txt b/test/fixtures/python/corpus/with-statement.diffA-B.txt index 7e25d1e9e..aad270979 100644 --- a/test/fixtures/python/corpus/with-statement.diffA-B.txt +++ b/test/fixtures/python/corpus/with-statement.diffA-B.txt @@ -4,6 +4,6 @@ ->(Identifier) } { (Identifier) ->(Identifier) } - ( + (Statements { (Identifier) ->(Identifier) }))) diff --git a/test/fixtures/python/corpus/with-statement.diffB-A.txt b/test/fixtures/python/corpus/with-statement.diffB-A.txt index 7e25d1e9e..aad270979 100644 --- a/test/fixtures/python/corpus/with-statement.diffB-A.txt +++ b/test/fixtures/python/corpus/with-statement.diffB-A.txt @@ -4,6 +4,6 @@ ->(Identifier) } { (Identifier) ->(Identifier) } - ( + (Statements { (Identifier) ->(Identifier) }))) diff --git a/test/fixtures/python/corpus/with-statement.parseA.txt b/test/fixtures/python/corpus/with-statement.parseA.txt index 9491e1fd5..bc2fe3e49 100644 --- a/test/fixtures/python/corpus/with-statement.parseA.txt +++ b/test/fixtures/python/corpus/with-statement.parseA.txt @@ -2,5 +2,5 @@ (Let (Identifier) (Identifier) - ( + (Statements (Identifier)))) diff --git a/test/fixtures/python/corpus/with-statement.parseB.txt b/test/fixtures/python/corpus/with-statement.parseB.txt index 9491e1fd5..bc2fe3e49 100644 --- a/test/fixtures/python/corpus/with-statement.parseB.txt +++ b/test/fixtures/python/corpus/with-statement.parseB.txt @@ -2,5 +2,5 @@ (Let (Identifier) (Identifier) - ( + (Statements (Identifier)))) diff --git a/test/fixtures/python/corpus/with.diffA-B.txt b/test/fixtures/python/corpus/with.diffA-B.txt index cbe67a91b..201cc0ac9 100644 --- a/test/fixtures/python/corpus/with.diffA-B.txt +++ b/test/fixtures/python/corpus/with.diffA-B.txt @@ -10,18 +10,18 @@ ->(MemberAccess {+(Identifier)+} {+(Identifier)+}) } - ( + (Statements (Assignment (Identifier) (Boolean)) {-(ForEach {-(Identifier)-} {-(Identifier)-} - {-( + {-(Statements {-(Assignment {-(Identifier)-} {-(Boolean)-})-})-})-})) -{+( +{+(Statements {+(Let {+(Empty)+} {+(Call @@ -32,7 +32,7 @@ {+(TextElement)+} {+(Identifier)+} {+(Empty)+})+} - {+([])+})+} + {+(Statements)+})+} {+(Let {+(Empty)+} {+(Call @@ -43,5 +43,5 @@ {+(TextElement)+} {+(Identifier)+} {+(Empty)+})+} - {+( + {+(Statements {+(Identifier)+})+})+})+}) diff --git a/test/fixtures/python/corpus/with.diffB-A.txt b/test/fixtures/python/corpus/with.diffB-A.txt index 66585dba9..0171c4924 100644 --- a/test/fixtures/python/corpus/with.diffB-A.txt +++ b/test/fixtures/python/corpus/with.diffB-A.txt @@ -10,18 +10,18 @@ {+(Identifier)+} {+(TextElement)+} {+(Empty)+}) } - ( + (Statements (Assignment (Identifier) (Boolean)) {+(ForEach {+(Identifier)+} {+(Identifier)+} - {+( + {+(Statements {+(Assignment {+(Identifier)+} {+(Boolean)+})+})+})+})) -{-( +{-(Statements {-(Let {-(Empty)-} {-(Call @@ -32,7 +32,7 @@ {-(TextElement)-} {-(Identifier)-} {-(Empty)-})-} - {-([])-})-} + {-(Statements)-})-} {-(Let {-(Empty)-} {-(Call @@ -43,5 +43,5 @@ {-(TextElement)-} {-(Identifier)-} {-(Empty)-})-} - {-( + {-(Statements {-(Identifier)-})-})-})-}) diff --git a/test/fixtures/python/corpus/with.parseA.txt b/test/fixtures/python/corpus/with.parseA.txt index b417c619c..edc854479 100644 --- a/test/fixtures/python/corpus/with.parseA.txt +++ b/test/fixtures/python/corpus/with.parseA.txt @@ -6,14 +6,14 @@ (Identifier) (TextElement) (Empty)) - ( + (Statements (Assignment (Identifier) (Boolean)) (ForEach (Identifier) (Identifier) - ( + (Statements (Assignment (Identifier) (Boolean))))))) diff --git a/test/fixtures/python/corpus/with.parseB.txt b/test/fixtures/python/corpus/with.parseB.txt index 44dbdfaee..23dcb54a1 100644 --- a/test/fixtures/python/corpus/with.parseB.txt +++ b/test/fixtures/python/corpus/with.parseB.txt @@ -4,11 +4,11 @@ (MemberAccess (Identifier) (Identifier)) - ( + (Statements (Assignment (Identifier) (Boolean)))) - ( + (Statements (Let (Empty) (Call @@ -19,7 +19,7 @@ (TextElement) (Identifier) (Empty)) - ([])) + (Statements)) (Let (Empty) (Call @@ -30,5 +30,5 @@ (TextElement) (Identifier) (Empty)) - ( + (Statements (Identifier))))) diff --git a/test/fixtures/ruby/corpus/begin.diffA-B.txt b/test/fixtures/ruby/corpus/begin.diffA-B.txt index 1bec5bc39..4f983b578 100644 --- a/test/fixtures/ruby/corpus/begin.diffA-B.txt +++ b/test/fixtures/ruby/corpus/begin.diffA-B.txt @@ -2,9 +2,9 @@ (Method (Empty) (Identifier) - ( + (Statements (Try - { ([]) + { (Statements) ->(Send {+(Identifier)+} {+(TextElement)+}) })))) diff --git a/test/fixtures/ruby/corpus/begin.diffB-A.txt b/test/fixtures/ruby/corpus/begin.diffB-A.txt index 49fcd5397..623e25948 100644 --- a/test/fixtures/ruby/corpus/begin.diffB-A.txt +++ b/test/fixtures/ruby/corpus/begin.diffB-A.txt @@ -2,9 +2,9 @@ (Method (Empty) (Identifier) - ( + (Statements (Try { (Send {-(Identifier)-} {-(TextElement)-}) - ->([]) })))) + ->(Statements) })))) diff --git a/test/fixtures/ruby/corpus/begin.parseA.txt b/test/fixtures/ruby/corpus/begin.parseA.txt index 29c538f66..806a217d3 100644 --- a/test/fixtures/ruby/corpus/begin.parseA.txt +++ b/test/fixtures/ruby/corpus/begin.parseA.txt @@ -2,6 +2,6 @@ (Method (Empty) (Identifier) - ( + (Statements (Try - ([]))))) + (Statements))))) diff --git a/test/fixtures/ruby/corpus/begin.parseB.txt b/test/fixtures/ruby/corpus/begin.parseB.txt index b59119d4d..41a6a6fb2 100644 --- a/test/fixtures/ruby/corpus/begin.parseB.txt +++ b/test/fixtures/ruby/corpus/begin.parseB.txt @@ -2,7 +2,7 @@ (Method (Empty) (Identifier) - ( + (Statements (Try (Send (Identifier) diff --git a/test/fixtures/ruby/corpus/chained-string.parseA.txt b/test/fixtures/ruby/corpus/chained-string.parseA.txt index 13446218a..19e02b4a3 100644 --- a/test/fixtures/ruby/corpus/chained-string.parseA.txt +++ b/test/fixtures/ruby/corpus/chained-string.parseA.txt @@ -1,4 +1,4 @@ (Program - ( + (Statements (TextElement) (TextElement))) diff --git a/test/fixtures/ruby/corpus/class.diffA-B.txt b/test/fixtures/ruby/corpus/class.diffA-B.txt index 6a81deb4f..55399d0a4 100644 --- a/test/fixtures/ruby/corpus/class.diffA-B.txt +++ b/test/fixtures/ruby/corpus/class.diffA-B.txt @@ -5,9 +5,9 @@ (Method (Empty) (Identifier) - ([]))) + (Statements))) {-(Class {-(ScopeResolution {-(Identifier)-} {-(Identifier)-})-} - {-([])-})-}) + {-(Statements)-})-}) diff --git a/test/fixtures/ruby/corpus/class.diffB-A.txt b/test/fixtures/ruby/corpus/class.diffB-A.txt index 06b31c46d..ab35adee4 100644 --- a/test/fixtures/ruby/corpus/class.diffB-A.txt +++ b/test/fixtures/ruby/corpus/class.diffB-A.txt @@ -5,9 +5,9 @@ (Method (Empty) (Identifier) - ([]))) + (Statements))) {+(Class {+(ScopeResolution {+(Identifier)+} {+(Identifier)+})+} - {+([])+})+}) + {+(Statements)+})+}) diff --git a/test/fixtures/ruby/corpus/class.parseA.txt b/test/fixtures/ruby/corpus/class.parseA.txt index ad160990d..f6d5f0629 100644 --- a/test/fixtures/ruby/corpus/class.parseA.txt +++ b/test/fixtures/ruby/corpus/class.parseA.txt @@ -5,9 +5,9 @@ (Method (Empty) (Identifier) - ([]))) + (Statements))) (Class (ScopeResolution (Identifier) (Identifier)) - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/class.parseB.txt b/test/fixtures/ruby/corpus/class.parseB.txt index d50a18324..5b8137020 100644 --- a/test/fixtures/ruby/corpus/class.parseB.txt +++ b/test/fixtures/ruby/corpus/class.parseB.txt @@ -4,4 +4,4 @@ (Method (Empty) (Identifier) - ([])))) + (Statements)))) diff --git a/test/fixtures/ruby/corpus/else.diffA-B.txt b/test/fixtures/ruby/corpus/else.diffA-B.txt index 5749e4f84..d6cdeb537 100644 --- a/test/fixtures/ruby/corpus/else.diffA-B.txt +++ b/test/fixtures/ruby/corpus/else.diffA-B.txt @@ -1,10 +1,10 @@ (Program (Try - ( + (Statements (Send (Identifier)) (Else (Empty) - { ([]) + { (Statements) ->(Send {+(Identifier)+}) })))) diff --git a/test/fixtures/ruby/corpus/else.diffB-A.txt b/test/fixtures/ruby/corpus/else.diffB-A.txt index 147cfbfbd..0b124ce02 100644 --- a/test/fixtures/ruby/corpus/else.diffB-A.txt +++ b/test/fixtures/ruby/corpus/else.diffB-A.txt @@ -1,10 +1,10 @@ (Program (Try - ( + (Statements (Send (Identifier)) (Else (Empty) { (Send {-(Identifier)-}) - ->([]) })))) + ->(Statements) })))) diff --git a/test/fixtures/ruby/corpus/else.parseA.txt b/test/fixtures/ruby/corpus/else.parseA.txt index edf25207d..1db3bb723 100644 --- a/test/fixtures/ruby/corpus/else.parseA.txt +++ b/test/fixtures/ruby/corpus/else.parseA.txt @@ -1,8 +1,8 @@ (Program (Try - ( + (Statements (Send (Identifier)) (Else (Empty) - ([]))))) + (Statements))))) diff --git a/test/fixtures/ruby/corpus/else.parseB.txt b/test/fixtures/ruby/corpus/else.parseB.txt index 28eaf190d..53227067f 100644 --- a/test/fixtures/ruby/corpus/else.parseB.txt +++ b/test/fixtures/ruby/corpus/else.parseB.txt @@ -1,6 +1,6 @@ (Program (Try - ( + (Statements (Send (Identifier)) (Else diff --git a/test/fixtures/ruby/corpus/elsif.diffA-B.txt b/test/fixtures/ruby/corpus/elsif.diffA-B.txt index 7e659a08e..1b0d86d2d 100644 --- a/test/fixtures/ruby/corpus/elsif.diffA-B.txt +++ b/test/fixtures/ruby/corpus/elsif.diffA-B.txt @@ -2,13 +2,13 @@ (If (Send (Identifier)) - ( + (Statements (Send (Identifier))) (If (Send (Identifier)) - ( + (Statements {+(Send {+(Identifier)+})+}) (Empty)))) diff --git a/test/fixtures/ruby/corpus/elsif.diffB-A.txt b/test/fixtures/ruby/corpus/elsif.diffB-A.txt index d5e8d9b3f..46dc82c55 100644 --- a/test/fixtures/ruby/corpus/elsif.diffB-A.txt +++ b/test/fixtures/ruby/corpus/elsif.diffB-A.txt @@ -2,12 +2,13 @@ (If (Send (Identifier)) - ( + (Statements (Send (Identifier))) (If (Send (Identifier)) - ({-(Send + (Statements + {-(Send {-(Identifier)-})-}) (Empty)))) diff --git a/test/fixtures/ruby/corpus/elsif.parseA.txt b/test/fixtures/ruby/corpus/elsif.parseA.txt index 0dfc7558b..dcb8c47b7 100644 --- a/test/fixtures/ruby/corpus/elsif.parseA.txt +++ b/test/fixtures/ruby/corpus/elsif.parseA.txt @@ -2,11 +2,11 @@ (If (Send (Identifier)) - ( + (Statements (Send (Identifier))) (If (Send (Identifier)) - ([]) + (Statements) (Empty)))) diff --git a/test/fixtures/ruby/corpus/elsif.parseB.txt b/test/fixtures/ruby/corpus/elsif.parseB.txt index 88c665a03..2ef63a59e 100644 --- a/test/fixtures/ruby/corpus/elsif.parseB.txt +++ b/test/fixtures/ruby/corpus/elsif.parseB.txt @@ -2,13 +2,13 @@ (If (Send (Identifier)) - ( + (Statements (Send (Identifier))) (If (Send (Identifier)) - ( + (Statements (Send (Identifier))) (Empty)))) diff --git a/test/fixtures/ruby/corpus/ensure.diffA-B.txt b/test/fixtures/ruby/corpus/ensure.diffA-B.txt index f2eca4a32..c47d54df8 100644 --- a/test/fixtures/ruby/corpus/ensure.diffA-B.txt +++ b/test/fixtures/ruby/corpus/ensure.diffA-B.txt @@ -1,9 +1,9 @@ (Program (Try - ( + (Statements (Send (Identifier)) (Finally - { ([]) + { (Statements) ->(Send {+(Identifier)+}) })))) diff --git a/test/fixtures/ruby/corpus/ensure.diffB-A.txt b/test/fixtures/ruby/corpus/ensure.diffB-A.txt index 9264966b3..5c8fe9c24 100644 --- a/test/fixtures/ruby/corpus/ensure.diffB-A.txt +++ b/test/fixtures/ruby/corpus/ensure.diffB-A.txt @@ -1,9 +1,9 @@ (Program (Try - ( + (Statements (Send (Identifier)) (Finally { (Send {-(Identifier)-}) - ->([]) })))) + ->(Statements) })))) diff --git a/test/fixtures/ruby/corpus/ensure.parseA.txt b/test/fixtures/ruby/corpus/ensure.parseA.txt index 524c181ef..d9ac44bc3 100644 --- a/test/fixtures/ruby/corpus/ensure.parseA.txt +++ b/test/fixtures/ruby/corpus/ensure.parseA.txt @@ -1,7 +1,7 @@ (Program (Try - ( + (Statements (Send (Identifier)) (Finally - ([]))))) + (Statements))))) diff --git a/test/fixtures/ruby/corpus/ensure.parseB.txt b/test/fixtures/ruby/corpus/ensure.parseB.txt index 3f3ef470b..2dbf9e402 100644 --- a/test/fixtures/ruby/corpus/ensure.parseB.txt +++ b/test/fixtures/ruby/corpus/ensure.parseB.txt @@ -1,6 +1,6 @@ (Program (Try - ( + (Statements (Send (Identifier)) (Finally diff --git a/test/fixtures/ruby/corpus/for.diffA-B.txt b/test/fixtures/ruby/corpus/for.diffA-B.txt index d2865da18..0b93f83b4 100644 --- a/test/fixtures/ruby/corpus/for.diffA-B.txt +++ b/test/fixtures/ruby/corpus/for.diffA-B.txt @@ -1,6 +1,6 @@ (Program {+(ForEach - {+( + {+(Statements {+(Send {+(Identifier)+})+})+} {+(Array @@ -12,7 +12,7 @@ {+(Send {+(Identifier)+})+})+})+} {-(ForEach - {-( + {-(Statements {-(Send {-(Identifier)-})-})-} {-(Send @@ -20,7 +20,7 @@ {-(Send {-(Identifier)-})-})-} {-(ForEach - {-( + {-(Statements {-(Send {-(Identifier)-})-} {-(Send @@ -30,7 +30,7 @@ {-(Send {-(Identifier)-})-})-} {-(ForEach - {-( + {-(Statements {-(Send {-(Identifier)-})-})-} {-(Enumeration @@ -39,7 +39,7 @@ {-(Empty)-})-} {-(Boolean)-})-} {-(ForEach - {-( + {-(Statements {-(Send {-(Identifier)-})-} {-(Send diff --git a/test/fixtures/ruby/corpus/for.diffB-A.txt b/test/fixtures/ruby/corpus/for.diffB-A.txt index a0356bb13..330945146 100644 --- a/test/fixtures/ruby/corpus/for.diffB-A.txt +++ b/test/fixtures/ruby/corpus/for.diffB-A.txt @@ -1,6 +1,6 @@ (Program {+(ForEach - {+( + {+(Statements {+(Send {+(Identifier)+})+})+} {+(Send @@ -8,7 +8,7 @@ {+(Send {+(Identifier)+})+})+} (ForEach - ( + (Statements (Send { (Identifier) ->(Identifier) }) @@ -26,7 +26,7 @@ {-(Send {-(Identifier)-})-})) {+(ForEach - {+( + {+(Statements {+(Send {+(Identifier)+})+})+} {+(Enumeration @@ -35,7 +35,7 @@ {+(Empty)+})+} {+(Boolean)+})+} {+(ForEach - {+( + {+(Statements {+(Send {+(Identifier)+})+} {+(Send diff --git a/test/fixtures/ruby/corpus/for.parseA.txt b/test/fixtures/ruby/corpus/for.parseA.txt index 6f91ae369..5fdbf737a 100644 --- a/test/fixtures/ruby/corpus/for.parseA.txt +++ b/test/fixtures/ruby/corpus/for.parseA.txt @@ -1,6 +1,6 @@ (Program (ForEach - ( + (Statements (Send (Identifier))) (Send @@ -8,7 +8,7 @@ (Send (Identifier))) (ForEach - ( + (Statements (Send (Identifier)) (Send @@ -18,7 +18,7 @@ (Send (Identifier))) (ForEach - ( + (Statements (Send (Identifier))) (Enumeration @@ -27,7 +27,7 @@ (Empty)) (Boolean)) (ForEach - ( + (Statements (Send (Identifier)) (Send diff --git a/test/fixtures/ruby/corpus/for.parseB.txt b/test/fixtures/ruby/corpus/for.parseB.txt index 30ed78a02..cedbfe26c 100644 --- a/test/fixtures/ruby/corpus/for.parseB.txt +++ b/test/fixtures/ruby/corpus/for.parseB.txt @@ -1,6 +1,6 @@ (Program (ForEach - ( + (Statements (Send (Identifier))) (Array diff --git a/test/fixtures/ruby/corpus/if.diffA-B.txt b/test/fixtures/ruby/corpus/if.diffA-B.txt index dd8865faf..9ef5ed990 100644 --- a/test/fixtures/ruby/corpus/if.diffA-B.txt +++ b/test/fixtures/ruby/corpus/if.diffA-B.txt @@ -3,12 +3,13 @@ (Send { (Identifier) ->(Identifier) }) - ({-(Send + (Statements + {-(Send {-(Identifier)-})-}) { (If {-(Send {-(Identifier)-})-} - {-( + {-(Statements {-(Send {-(Identifier)-})-})-} {-(Send @@ -17,5 +18,5 @@ {+(If {+(Send {+(Identifier)+})+} - {+([])+} + {+(Statements)+} {+(Empty)+})+}) diff --git a/test/fixtures/ruby/corpus/if.diffB-A.txt b/test/fixtures/ruby/corpus/if.diffB-A.txt index f310c46c9..f16730bd8 100644 --- a/test/fixtures/ruby/corpus/if.diffB-A.txt +++ b/test/fixtures/ruby/corpus/if.diffB-A.txt @@ -3,14 +3,14 @@ (Send { (Identifier) ->(Identifier) }) - ( + (Statements {+(Send {+(Identifier)+})+}) { (Empty) ->(If {+(Send {+(Identifier)+})+} - {+( + {+(Statements {+(Send {+(Identifier)+})+})+} {+(Send @@ -18,5 +18,5 @@ {-(If {-(Send {-(Identifier)-})-} - {-([])-} + {-(Statements)-} {-(Empty)-})-}) diff --git a/test/fixtures/ruby/corpus/if.parseA.txt b/test/fixtures/ruby/corpus/if.parseA.txt index 1f437cf11..41430c07e 100644 --- a/test/fixtures/ruby/corpus/if.parseA.txt +++ b/test/fixtures/ruby/corpus/if.parseA.txt @@ -2,13 +2,13 @@ (If (Send (Identifier)) - ( + (Statements (Send (Identifier))) (If (Send (Identifier)) - ( + (Statements (Send (Identifier))) (Send diff --git a/test/fixtures/ruby/corpus/if.parseB.txt b/test/fixtures/ruby/corpus/if.parseB.txt index 1c33d88a2..c023a1d11 100644 --- a/test/fixtures/ruby/corpus/if.parseB.txt +++ b/test/fixtures/ruby/corpus/if.parseB.txt @@ -2,10 +2,10 @@ (If (Send (Identifier)) - ([]) + (Statements) (Empty)) (If (Send (Identifier)) - ([]) + (Statements) (Empty))) diff --git a/test/fixtures/ruby/corpus/lambda-dash-rocket.diffA-B.txt b/test/fixtures/ruby/corpus/lambda-dash-rocket.diffA-B.txt index 080b2d9a9..e6c297e5d 100644 --- a/test/fixtures/ruby/corpus/lambda-dash-rocket.diffA-B.txt +++ b/test/fixtures/ruby/corpus/lambda-dash-rocket.diffA-B.txt @@ -6,7 +6,7 @@ {-(Identifier)-} (Function (Empty) - { ( + { (Statements {-(Integer)-} {-(Integer)-}) ->(Send diff --git a/test/fixtures/ruby/corpus/lambda-dash-rocket.diffB-A.txt b/test/fixtures/ruby/corpus/lambda-dash-rocket.diffB-A.txt index 2476cec06..6abae706a 100644 --- a/test/fixtures/ruby/corpus/lambda-dash-rocket.diffB-A.txt +++ b/test/fixtures/ruby/corpus/lambda-dash-rocket.diffB-A.txt @@ -8,6 +8,6 @@ (Empty) { (Send {-(Identifier)-}) - ->( + ->(Statements {+(Integer)+} {+(Integer)+}) }))) diff --git a/test/fixtures/ruby/corpus/lambda-dash-rocket.parseA.txt b/test/fixtures/ruby/corpus/lambda-dash-rocket.parseA.txt index f927c0597..ff5b12b04 100644 --- a/test/fixtures/ruby/corpus/lambda-dash-rocket.parseA.txt +++ b/test/fixtures/ruby/corpus/lambda-dash-rocket.parseA.txt @@ -6,6 +6,6 @@ (Identifier) (Function (Empty) - ( + (Statements (Integer) (Integer))))) diff --git a/test/fixtures/ruby/corpus/lambda.diffA-B.txt b/test/fixtures/ruby/corpus/lambda.diffA-B.txt index 67d452c63..a432cec2e 100644 --- a/test/fixtures/ruby/corpus/lambda.diffA-B.txt +++ b/test/fixtures/ruby/corpus/lambda.diffA-B.txt @@ -4,7 +4,7 @@ (Function (Empty) {+(Identifier)+} - { ([]) + { (Statements) ->(Plus {+(Identifier)+} {+(Integer)+}) })) @@ -26,7 +26,7 @@ {-(Empty)-} {-(Function {-(Empty)-} - {-([])-})-})-} + {-(Statements)-})-})-} {-(Function {-(Empty)-} {-(Function @@ -43,9 +43,9 @@ {-(Empty)-} {-(Identifier)-} {-(Identifier)-} - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} {-(Function {-(Empty)-} - {-([])-})-})-}) + {-(Statements)-})-})-}) diff --git a/test/fixtures/ruby/corpus/lambda.diffB-A.txt b/test/fixtures/ruby/corpus/lambda.diffB-A.txt index 1f25ddb9c..df872e722 100644 --- a/test/fixtures/ruby/corpus/lambda.diffB-A.txt +++ b/test/fixtures/ruby/corpus/lambda.diffB-A.txt @@ -7,7 +7,7 @@ { (Plus {-(Identifier)-} {-(Integer)-}) - ->([]) })) + ->(Statements) })) {+(Send {+(Identifier)+} {+(Function @@ -26,7 +26,7 @@ {+(Empty)+} {+(Function {+(Empty)+} - {+([])+})+})+} + {+(Statements)+})+})+} {+(Function {+(Empty)+} {+(Function @@ -43,9 +43,9 @@ {+(Empty)+} {+(Identifier)+} {+(Identifier)+} - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+} {+(Function {+(Empty)+} - {+([])+})+})+}) + {+(Statements)+})+})+}) diff --git a/test/fixtures/ruby/corpus/lambda.parseA.txt b/test/fixtures/ruby/corpus/lambda.parseA.txt index bbfaf8869..b88439a6a 100644 --- a/test/fixtures/ruby/corpus/lambda.parseA.txt +++ b/test/fixtures/ruby/corpus/lambda.parseA.txt @@ -3,7 +3,7 @@ (Identifier) (Function (Empty) - ([]))) + (Statements))) (Send (Identifier) (Function @@ -22,7 +22,7 @@ (Empty) (Function (Empty) - ([]))) + (Statements))) (Function (Empty) (Function @@ -39,9 +39,9 @@ (Empty) (Identifier) (Identifier) - ( + (Statements (Identifier) (Identifier)) (Function (Empty) - ([])))) + (Statements)))) diff --git a/test/fixtures/ruby/corpus/method-declaration-keyword-param.diffA-B.txt b/test/fixtures/ruby/corpus/method-declaration-keyword-param.diffA-B.txt index bebe36af5..53a62bc41 100644 --- a/test/fixtures/ruby/corpus/method-declaration-keyword-param.diffA-B.txt +++ b/test/fixtures/ruby/corpus/method-declaration-keyword-param.diffA-B.txt @@ -3,4 +3,4 @@ (Empty) (Identifier) {+(Identifier)+} - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/method-declaration-keyword-param.diffB-A.txt b/test/fixtures/ruby/corpus/method-declaration-keyword-param.diffB-A.txt index e37b12b67..94e20230e 100644 --- a/test/fixtures/ruby/corpus/method-declaration-keyword-param.diffB-A.txt +++ b/test/fixtures/ruby/corpus/method-declaration-keyword-param.diffB-A.txt @@ -3,4 +3,4 @@ (Empty) (Identifier) {-(Identifier)-} - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/method-declaration-keyword-param.parseA.txt b/test/fixtures/ruby/corpus/method-declaration-keyword-param.parseA.txt index 0db11f8a0..298d2bcd8 100644 --- a/test/fixtures/ruby/corpus/method-declaration-keyword-param.parseA.txt +++ b/test/fixtures/ruby/corpus/method-declaration-keyword-param.parseA.txt @@ -2,4 +2,4 @@ (Method (Empty) (Identifier) - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/method-declaration-keyword-param.parseB.txt b/test/fixtures/ruby/corpus/method-declaration-keyword-param.parseB.txt index e1d159a2f..d37ef9a8c 100644 --- a/test/fixtures/ruby/corpus/method-declaration-keyword-param.parseB.txt +++ b/test/fixtures/ruby/corpus/method-declaration-keyword-param.parseB.txt @@ -3,4 +3,4 @@ (Empty) (Identifier) (Identifier) - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/method-declaration-param-default.diffA-B.txt b/test/fixtures/ruby/corpus/method-declaration-param-default.diffA-B.txt index bebe36af5..53a62bc41 100644 --- a/test/fixtures/ruby/corpus/method-declaration-param-default.diffA-B.txt +++ b/test/fixtures/ruby/corpus/method-declaration-param-default.diffA-B.txt @@ -3,4 +3,4 @@ (Empty) (Identifier) {+(Identifier)+} - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/method-declaration-param-default.diffB-A.txt b/test/fixtures/ruby/corpus/method-declaration-param-default.diffB-A.txt index e37b12b67..94e20230e 100644 --- a/test/fixtures/ruby/corpus/method-declaration-param-default.diffB-A.txt +++ b/test/fixtures/ruby/corpus/method-declaration-param-default.diffB-A.txt @@ -3,4 +3,4 @@ (Empty) (Identifier) {-(Identifier)-} - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/method-declaration-param-default.parseA.txt b/test/fixtures/ruby/corpus/method-declaration-param-default.parseA.txt index 0db11f8a0..298d2bcd8 100644 --- a/test/fixtures/ruby/corpus/method-declaration-param-default.parseA.txt +++ b/test/fixtures/ruby/corpus/method-declaration-param-default.parseA.txt @@ -2,4 +2,4 @@ (Method (Empty) (Identifier) - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/method-declaration-param-default.parseB.txt b/test/fixtures/ruby/corpus/method-declaration-param-default.parseB.txt index e1d159a2f..d37ef9a8c 100644 --- a/test/fixtures/ruby/corpus/method-declaration-param-default.parseB.txt +++ b/test/fixtures/ruby/corpus/method-declaration-param-default.parseB.txt @@ -3,4 +3,4 @@ (Empty) (Identifier) (Identifier) - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/method-declaration-params.diffA-B.txt b/test/fixtures/ruby/corpus/method-declaration-params.diffA-B.txt index c8ecdbe0b..e54025850 100644 --- a/test/fixtures/ruby/corpus/method-declaration-params.diffA-B.txt +++ b/test/fixtures/ruby/corpus/method-declaration-params.diffA-B.txt @@ -5,4 +5,4 @@ (Identifier) {+(Identifier)+} {+(Identifier)+} - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/method-declaration-params.diffB-A.txt b/test/fixtures/ruby/corpus/method-declaration-params.diffB-A.txt index 8238f40c4..e2a20b25c 100644 --- a/test/fixtures/ruby/corpus/method-declaration-params.diffB-A.txt +++ b/test/fixtures/ruby/corpus/method-declaration-params.diffB-A.txt @@ -5,4 +5,4 @@ (Identifier) {-(Identifier)-} {-(Identifier)-} - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/method-declaration-params.parseA.txt b/test/fixtures/ruby/corpus/method-declaration-params.parseA.txt index e1d159a2f..d37ef9a8c 100644 --- a/test/fixtures/ruby/corpus/method-declaration-params.parseA.txt +++ b/test/fixtures/ruby/corpus/method-declaration-params.parseA.txt @@ -3,4 +3,4 @@ (Empty) (Identifier) (Identifier) - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/method-declaration-params.parseB.txt b/test/fixtures/ruby/corpus/method-declaration-params.parseB.txt index 8bc5e1951..3ba89843c 100644 --- a/test/fixtures/ruby/corpus/method-declaration-params.parseB.txt +++ b/test/fixtures/ruby/corpus/method-declaration-params.parseB.txt @@ -5,4 +5,4 @@ (Identifier) (Identifier) (Identifier) - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/method-declaration-required-keyword-param.diffA-B.txt b/test/fixtures/ruby/corpus/method-declaration-required-keyword-param.diffA-B.txt index bebe36af5..53a62bc41 100644 --- a/test/fixtures/ruby/corpus/method-declaration-required-keyword-param.diffA-B.txt +++ b/test/fixtures/ruby/corpus/method-declaration-required-keyword-param.diffA-B.txt @@ -3,4 +3,4 @@ (Empty) (Identifier) {+(Identifier)+} - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/method-declaration-required-keyword-param.diffB-A.txt b/test/fixtures/ruby/corpus/method-declaration-required-keyword-param.diffB-A.txt index e37b12b67..94e20230e 100644 --- a/test/fixtures/ruby/corpus/method-declaration-required-keyword-param.diffB-A.txt +++ b/test/fixtures/ruby/corpus/method-declaration-required-keyword-param.diffB-A.txt @@ -3,4 +3,4 @@ (Empty) (Identifier) {-(Identifier)-} - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/method-declaration-required-keyword-param.parseA.txt b/test/fixtures/ruby/corpus/method-declaration-required-keyword-param.parseA.txt index 0db11f8a0..298d2bcd8 100644 --- a/test/fixtures/ruby/corpus/method-declaration-required-keyword-param.parseA.txt +++ b/test/fixtures/ruby/corpus/method-declaration-required-keyword-param.parseA.txt @@ -2,4 +2,4 @@ (Method (Empty) (Identifier) - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/method-declaration-required-keyword-param.parseB.txt b/test/fixtures/ruby/corpus/method-declaration-required-keyword-param.parseB.txt index e1d159a2f..d37ef9a8c 100644 --- a/test/fixtures/ruby/corpus/method-declaration-required-keyword-param.parseB.txt +++ b/test/fixtures/ruby/corpus/method-declaration-required-keyword-param.parseB.txt @@ -3,4 +3,4 @@ (Empty) (Identifier) (Identifier) - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/method-declaration-unnamed-param.diffA-B.txt b/test/fixtures/ruby/corpus/method-declaration-unnamed-param.diffA-B.txt index 72c9961f7..5518ef711 100644 --- a/test/fixtures/ruby/corpus/method-declaration-unnamed-param.diffA-B.txt +++ b/test/fixtures/ruby/corpus/method-declaration-unnamed-param.diffA-B.txt @@ -4,4 +4,4 @@ (Identifier) (Identifier) {+(Empty)+} - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/method-declaration-unnamed-param.diffB-A.txt b/test/fixtures/ruby/corpus/method-declaration-unnamed-param.diffB-A.txt index 50487c8b0..27239ae3f 100644 --- a/test/fixtures/ruby/corpus/method-declaration-unnamed-param.diffB-A.txt +++ b/test/fixtures/ruby/corpus/method-declaration-unnamed-param.diffB-A.txt @@ -4,4 +4,4 @@ (Identifier) (Identifier) {-(Empty)-} - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/method-declaration-unnamed-param.parseA.txt b/test/fixtures/ruby/corpus/method-declaration-unnamed-param.parseA.txt index e1d159a2f..d37ef9a8c 100644 --- a/test/fixtures/ruby/corpus/method-declaration-unnamed-param.parseA.txt +++ b/test/fixtures/ruby/corpus/method-declaration-unnamed-param.parseA.txt @@ -3,4 +3,4 @@ (Empty) (Identifier) (Identifier) - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/method-declaration-unnamed-param.parseB.txt b/test/fixtures/ruby/corpus/method-declaration-unnamed-param.parseB.txt index 8d306c54e..9d41bda94 100644 --- a/test/fixtures/ruby/corpus/method-declaration-unnamed-param.parseB.txt +++ b/test/fixtures/ruby/corpus/method-declaration-unnamed-param.parseB.txt @@ -4,4 +4,4 @@ (Identifier) (Identifier) (Empty) - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/method-declaration.diffA-B.txt b/test/fixtures/ruby/corpus/method-declaration.diffA-B.txt index 7592bf4e4..6dfccf172 100644 --- a/test/fixtures/ruby/corpus/method-declaration.diffA-B.txt +++ b/test/fixtures/ruby/corpus/method-declaration.diffA-B.txt @@ -4,6 +4,6 @@ { (Identifier) ->(Identifier) } {+(Identifier)+} - ( + (Statements {+(Send {+(Identifier)+})+}))) diff --git a/test/fixtures/ruby/corpus/method-declaration.diffB-A.txt b/test/fixtures/ruby/corpus/method-declaration.diffB-A.txt index ef50f5e7d..61ab57f96 100644 --- a/test/fixtures/ruby/corpus/method-declaration.diffB-A.txt +++ b/test/fixtures/ruby/corpus/method-declaration.diffB-A.txt @@ -4,5 +4,6 @@ { (Identifier) ->(Identifier) } {-(Identifier)-} - ({-(Send + (Statements + {-(Send {-(Identifier)-})-}))) diff --git a/test/fixtures/ruby/corpus/method-declaration.parseA.txt b/test/fixtures/ruby/corpus/method-declaration.parseA.txt index 0db11f8a0..298d2bcd8 100644 --- a/test/fixtures/ruby/corpus/method-declaration.parseA.txt +++ b/test/fixtures/ruby/corpus/method-declaration.parseA.txt @@ -2,4 +2,4 @@ (Method (Empty) (Identifier) - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/method-declaration.parseB.txt b/test/fixtures/ruby/corpus/method-declaration.parseB.txt index acf2aca5b..958ef8851 100644 --- a/test/fixtures/ruby/corpus/method-declaration.parseB.txt +++ b/test/fixtures/ruby/corpus/method-declaration.parseB.txt @@ -3,6 +3,6 @@ (Empty) (Identifier) (Identifier) - ( + (Statements (Send (Identifier))))) diff --git a/test/fixtures/ruby/corpus/methods.parseA.txt b/test/fixtures/ruby/corpus/methods.parseA.txt index 546f73f91..f9c8a1f04 100644 --- a/test/fixtures/ruby/corpus/methods.parseA.txt +++ b/test/fixtures/ruby/corpus/methods.parseA.txt @@ -2,16 +2,16 @@ (Method (Empty) (Identifier) - ([])) + (Statements)) (Method (Empty) (Identifier) - ([])) + (Statements)) (Method (Empty) (Identifier) (Identifier) - ([])) + (Statements)) (Method (Empty) (Identifier) @@ -19,24 +19,24 @@ (Identifier) (Identifier) (Empty) - ([])) + (Statements)) (Method (Empty) (Identifier) (Identifier) - ([])) + (Statements)) (Method (Empty) (Identifier) (Identifier) - ([])) + (Statements)) (Method (Identifier) (Identifier) - ([])) + (Statements)) (Method (Identifier) (Identifier) (Identifier) (Identifier) - ([]))) + (Statements))) diff --git a/test/fixtures/ruby/corpus/misc.parseA.txt b/test/fixtures/ruby/corpus/misc.parseA.txt index f494f4f8f..e51f4e761 100644 --- a/test/fixtures/ruby/corpus/misc.parseA.txt +++ b/test/fixtures/ruby/corpus/misc.parseA.txt @@ -5,7 +5,7 @@ (Identifier)) (Function (Empty) - ([]))) + (Statements))) (Send (Send (Identifier)) @@ -15,7 +15,7 @@ (Identifier) (Identifier) (Identifier) - ([]))) + (Statements))) (Send (Identifier) (Send @@ -23,5 +23,5 @@ (Function (Empty) (Identifier) - ([]))) + (Statements))) (Identifier)) diff --git a/test/fixtures/ruby/corpus/module.diffA-B.txt b/test/fixtures/ruby/corpus/module.diffA-B.txt index e93001b3e..8f0937a13 100644 --- a/test/fixtures/ruby/corpus/module.diffA-B.txt +++ b/test/fixtures/ruby/corpus/module.diffA-B.txt @@ -4,7 +4,7 @@ {+(Method {+(Empty)+} {+(Identifier)+} - {+([])+})+}) + {+(Statements)+})+}) {-(Module {-(ScopeResolution {-(Identifier)-} diff --git a/test/fixtures/ruby/corpus/module.diffB-A.txt b/test/fixtures/ruby/corpus/module.diffB-A.txt index 84fecbdc2..06b13c3c9 100644 --- a/test/fixtures/ruby/corpus/module.diffB-A.txt +++ b/test/fixtures/ruby/corpus/module.diffB-A.txt @@ -4,7 +4,7 @@ {-(Method {-(Empty)-} {-(Identifier)-} - {-([])-})-}) + {-(Statements)-})-}) {+(Module {+(ScopeResolution {+(Identifier)+} diff --git a/test/fixtures/ruby/corpus/module.parseB.txt b/test/fixtures/ruby/corpus/module.parseB.txt index cbd787a15..b73290959 100644 --- a/test/fixtures/ruby/corpus/module.parseB.txt +++ b/test/fixtures/ruby/corpus/module.parseB.txt @@ -4,4 +4,4 @@ (Method (Empty) (Identifier) - ([])))) + (Statements)))) diff --git a/test/fixtures/ruby/corpus/multiple-assignments.diffA-B.txt b/test/fixtures/ruby/corpus/multiple-assignments.diffA-B.txt index 7c735abdd..bbd4b921c 100644 --- a/test/fixtures/ruby/corpus/multiple-assignments.diffA-B.txt +++ b/test/fixtures/ruby/corpus/multiple-assignments.diffA-B.txt @@ -1,6 +1,6 @@ (Program (Assignment - ( + (Statements (Identifier) { (Identifier) ->(Identifier) } @@ -10,40 +10,40 @@ (Integer) (Integer))) {-(Assignment - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} {-(Array {-(Integer)-} {-(Integer)-})-})-} {-(Assignment - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} {-(Array {-(Integer)-} {-(Integer)-})-})-} {-(Assignment - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} {-(Array {-(Integer)-} {-(Integer)-})-})-} {-(Assignment - {-( + {-(Statements {-(Identifier)-} {-(Identifier)-})-} {-(Identifier)-})-} {-(Assignment - {-( + {-(Statements {-(Send {-(Identifier)-} {-(Identifier)-})-} {-(Send {-(Identifier)-} {-(Identifier)-})-})-} - {-( + {-(Statements {-(Send {-(Send {-(Identifier)-})-} @@ -53,8 +53,8 @@ {-(Identifier)-})-} {-(Identifier)-})-})-})-} {-(Assignment - {-( - {-( + {-(Statements + {-(Statements {-(Identifier)-} {-(Identifier)-})-})-} {-(Identifier)-})-}) diff --git a/test/fixtures/ruby/corpus/multiple-assignments.diffB-A.txt b/test/fixtures/ruby/corpus/multiple-assignments.diffB-A.txt index e6f8ba6d8..1eda9f932 100644 --- a/test/fixtures/ruby/corpus/multiple-assignments.diffB-A.txt +++ b/test/fixtures/ruby/corpus/multiple-assignments.diffB-A.txt @@ -1,6 +1,6 @@ (Program (Assignment - ( + (Statements (Identifier) { (Identifier) ->(Identifier) } @@ -10,40 +10,40 @@ (Integer) (Integer))) {+(Assignment - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+} {+(Array {+(Integer)+} {+(Integer)+})+})+} {+(Assignment - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+} {+(Array {+(Integer)+} {+(Integer)+})+})+} {+(Assignment - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+} {+(Array {+(Integer)+} {+(Integer)+})+})+} {+(Assignment - {+( + {+(Statements {+(Identifier)+} {+(Identifier)+})+} {+(Identifier)+})+} {+(Assignment - {+( + {+(Statements {+(Send {+(Identifier)+} {+(Identifier)+})+} {+(Send {+(Identifier)+} {+(Identifier)+})+})+} - {+( + {+(Statements {+(Send {+(Send {+(Identifier)+})+} @@ -53,8 +53,8 @@ {+(Identifier)+})+} {+(Identifier)+})+})+})+} {+(Assignment - {+( - {+( + {+(Statements + {+(Statements {+(Identifier)+} {+(Identifier)+})+})+} {+(Identifier)+})+}) diff --git a/test/fixtures/ruby/corpus/multiple-assignments.parseA.txt b/test/fixtures/ruby/corpus/multiple-assignments.parseA.txt index 406650c2d..ea1fb4950 100644 --- a/test/fixtures/ruby/corpus/multiple-assignments.parseA.txt +++ b/test/fixtures/ruby/corpus/multiple-assignments.parseA.txt @@ -1,6 +1,6 @@ (Program (Assignment - ( + (Statements (Identifier) (Identifier) (Identifier)) @@ -9,40 +9,40 @@ (Integer) (Integer))) (Assignment - ( + (Statements (Identifier) (Identifier)) (Array (Integer) (Integer))) (Assignment - ( + (Statements (Identifier) (Identifier)) (Array (Integer) (Integer))) (Assignment - ( + (Statements (Identifier) (Identifier)) (Array (Integer) (Integer))) (Assignment - ( + (Statements (Identifier) (Identifier)) (Identifier)) (Assignment - ( + (Statements (Send (Identifier) (Identifier)) (Send (Identifier) (Identifier))) - ( + (Statements (Send (Send (Identifier)) @@ -52,8 +52,8 @@ (Identifier)) (Identifier)))) (Assignment - ( - ( + (Statements + (Statements (Identifier) (Identifier))) (Identifier))) diff --git a/test/fixtures/ruby/corpus/multiple-assignments.parseB.txt b/test/fixtures/ruby/corpus/multiple-assignments.parseB.txt index 1a12b19b5..166f46fdb 100644 --- a/test/fixtures/ruby/corpus/multiple-assignments.parseB.txt +++ b/test/fixtures/ruby/corpus/multiple-assignments.parseB.txt @@ -1,6 +1,6 @@ (Program (Assignment - ( + (Statements (Identifier) (Identifier)) (Array diff --git a/test/fixtures/ruby/corpus/next.parseA.txt b/test/fixtures/ruby/corpus/next.parseA.txt index 16cc87aba..c6a6b22b9 100644 --- a/test/fixtures/ruby/corpus/next.parseA.txt +++ b/test/fixtures/ruby/corpus/next.parseA.txt @@ -1,6 +1,6 @@ (Program (ForEach - ( + (Statements (Send (Identifier))) (Send diff --git a/test/fixtures/ruby/corpus/rescue-empty.diffA-B.txt b/test/fixtures/ruby/corpus/rescue-empty.diffA-B.txt index f0d3e467c..0c35e8b0e 100644 --- a/test/fixtures/ruby/corpus/rescue-empty.diffA-B.txt +++ b/test/fixtures/ruby/corpus/rescue-empty.diffA-B.txt @@ -1,10 +1,10 @@ (Program (Try - ( + (Statements (Send (Identifier)) (Catch - ([]) - { ([]) + (Statements) + { (Statements) ->(Send {+(Identifier)+}) })))) diff --git a/test/fixtures/ruby/corpus/rescue-empty.diffB-A.txt b/test/fixtures/ruby/corpus/rescue-empty.diffB-A.txt index 73cad3bfc..9c21fe36d 100644 --- a/test/fixtures/ruby/corpus/rescue-empty.diffB-A.txt +++ b/test/fixtures/ruby/corpus/rescue-empty.diffB-A.txt @@ -1,10 +1,10 @@ (Program (Try - ( + (Statements (Send (Identifier)) (Catch - ([]) + (Statements) { (Send {-(Identifier)-}) - ->([]) })))) + ->(Statements) })))) diff --git a/test/fixtures/ruby/corpus/rescue-empty.parseA.txt b/test/fixtures/ruby/corpus/rescue-empty.parseA.txt index 519796778..142f19085 100644 --- a/test/fixtures/ruby/corpus/rescue-empty.parseA.txt +++ b/test/fixtures/ruby/corpus/rescue-empty.parseA.txt @@ -1,8 +1,8 @@ (Program (Try - ( + (Statements (Send (Identifier)) (Catch - ([]) - ([]))))) + (Statements) + (Statements))))) diff --git a/test/fixtures/ruby/corpus/rescue-empty.parseB.txt b/test/fixtures/ruby/corpus/rescue-empty.parseB.txt index c7bc8332d..5b9052323 100644 --- a/test/fixtures/ruby/corpus/rescue-empty.parseB.txt +++ b/test/fixtures/ruby/corpus/rescue-empty.parseB.txt @@ -1,9 +1,9 @@ (Program (Try - ( + (Statements (Send (Identifier)) (Catch - ([]) + (Statements) (Send (Identifier)))))) diff --git a/test/fixtures/ruby/corpus/rescue-last-ex.diffA-B.txt b/test/fixtures/ruby/corpus/rescue-last-ex.diffA-B.txt index 8b0da7220..a1842467f 100644 --- a/test/fixtures/ruby/corpus/rescue-last-ex.diffA-B.txt +++ b/test/fixtures/ruby/corpus/rescue-last-ex.diffA-B.txt @@ -1,15 +1,15 @@ (Program (Try - ( + (Statements (Send (Identifier)) (Catch - ( - ( + (Statements + (Statements (Identifier)) - ( + (Statements (Send (Identifier)))) - { ([]) + { (Statements) ->(Send {+(Identifier)+}) })))) diff --git a/test/fixtures/ruby/corpus/rescue-last-ex.diffB-A.txt b/test/fixtures/ruby/corpus/rescue-last-ex.diffB-A.txt index a639d31c5..25678b843 100644 --- a/test/fixtures/ruby/corpus/rescue-last-ex.diffB-A.txt +++ b/test/fixtures/ruby/corpus/rescue-last-ex.diffB-A.txt @@ -1,15 +1,15 @@ (Program (Try - ( + (Statements (Send (Identifier)) (Catch - ( - ( + (Statements + (Statements (Identifier)) - ( + (Statements (Send (Identifier)))) { (Send {-(Identifier)-}) - ->([]) })))) + ->(Statements) })))) diff --git a/test/fixtures/ruby/corpus/rescue-last-ex.parseA.txt b/test/fixtures/ruby/corpus/rescue-last-ex.parseA.txt index 89713222d..a7585b32b 100644 --- a/test/fixtures/ruby/corpus/rescue-last-ex.parseA.txt +++ b/test/fixtures/ruby/corpus/rescue-last-ex.parseA.txt @@ -1,13 +1,13 @@ (Program (Try - ( + (Statements (Send (Identifier)) (Catch - ( - ( + (Statements + (Statements (Identifier)) - ( + (Statements (Send (Identifier)))) - ([]))))) + (Statements))))) diff --git a/test/fixtures/ruby/corpus/rescue-last-ex.parseB.txt b/test/fixtures/ruby/corpus/rescue-last-ex.parseB.txt index eb5ee6c1c..2aa62b05c 100644 --- a/test/fixtures/ruby/corpus/rescue-last-ex.parseB.txt +++ b/test/fixtures/ruby/corpus/rescue-last-ex.parseB.txt @@ -1,13 +1,13 @@ (Program (Try - ( + (Statements (Send (Identifier)) (Catch - ( - ( + (Statements + (Statements (Identifier)) - ( + (Statements (Send (Identifier)))) (Send diff --git a/test/fixtures/ruby/corpus/rescue.diffA-B.txt b/test/fixtures/ruby/corpus/rescue.diffA-B.txt index cd45faf3c..47e0ced9b 100644 --- a/test/fixtures/ruby/corpus/rescue.diffA-B.txt +++ b/test/fixtures/ruby/corpus/rescue.diffA-B.txt @@ -1,29 +1,29 @@ (Program {+(Try - {+( + {+(Statements {+(Send {+(Identifier)+})+} {+(Catch - {+( - {+( + {+(Statements + {+(Statements {+(Send {+(Identifier)+})+})+})+} {+(Send {+(Identifier)+})+})+})+})+} {-(Try - {-( + {-(Statements {-(Send {-(Identifier)-})-} {-(Catch - {-( - {-( + {-(Statements + {-(Statements {-(Identifier)-})-})-} {-(Catch - {-( - {-( + {-(Statements + {-(Statements {-(Identifier)-} {-(Identifier)-})-} - {-( + {-(Statements {-(Send {-(Identifier)-})-})-})-} {-(Send @@ -38,25 +38,25 @@ {-(Method {-(Empty)-} {-(Identifier)-} - {-( + {-(Statements {-(Catch - {-( - {-( + {-(Statements + {-(Statements {-(Identifier)-})-})-} {-(Catch - {-( - {-( + {-(Statements + {-(Statements {-(Identifier)-} {-(Identifier)-})-} - {-( + {-(Statements {-(Send {-(Identifier)-})-})-})-} - {-([])-})-})-} + {-(Statements)-})-})-} {-(Else {-(Empty)-} - {-([])-})-} + {-(Statements)-})-} {-(Finally - {-([])-})-})-})-} + {-(Statements)-})-})-})-} {-(Try {-(Send {-(Identifier)-})-} diff --git a/test/fixtures/ruby/corpus/rescue.diffB-A.txt b/test/fixtures/ruby/corpus/rescue.diffB-A.txt index 806ebf354..2dbe5f598 100644 --- a/test/fixtures/ruby/corpus/rescue.diffB-A.txt +++ b/test/fixtures/ruby/corpus/rescue.diffB-A.txt @@ -1,18 +1,18 @@ (Program {+(Try - {+( + {+(Statements {+(Send {+(Identifier)+})+} {+(Catch - {+( - {+( + {+(Statements + {+(Statements {+(Identifier)+})+})+} {+(Catch - {+( - {+( + {+(Statements + {+(Statements {+(Identifier)+} {+(Identifier)+})+} - {+( + {+(Statements {+(Send {+(Identifier)+})+})+})+} {+(Send @@ -27,32 +27,32 @@ {+(Method {+(Empty)+} {+(Identifier)+} - {+( + {+(Statements {+(Catch - {+( - {+( + {+(Statements + {+(Statements {+(Identifier)+})+})+} {+(Catch - {+( - {+( + {+(Statements + {+(Statements {+(Identifier)+} {+(Identifier)+})+} - {+( + {+(Statements {+(Send {+(Identifier)+})+})+})+} - {+([])+})+})+} + {+(Statements)+})+})+} {+(Else {+(Empty)+} - {+([])+})+} + {+(Statements)+})+} {+(Finally - {+([])+})+})+})+} + {+(Statements)+})+})+})+} (Try - { ( + { (Statements {-(Send {-(Identifier)-})-} {-(Catch - {-( - {-( + {-(Statements + {-(Statements {-(Send {-(Identifier)-})-})-})-} {-(Send diff --git a/test/fixtures/ruby/corpus/rescue.parseA.txt b/test/fixtures/ruby/corpus/rescue.parseA.txt index 9b906f35f..c3b90edec 100644 --- a/test/fixtures/ruby/corpus/rescue.parseA.txt +++ b/test/fixtures/ruby/corpus/rescue.parseA.txt @@ -1,18 +1,18 @@ (Program (Try - ( + (Statements (Send (Identifier)) (Catch - ( - ( + (Statements + (Statements (Identifier))) (Catch - ( - ( + (Statements + (Statements (Identifier) (Identifier)) - ( + (Statements (Send (Identifier)))) (Send @@ -27,25 +27,25 @@ (Method (Empty) (Identifier) - ( + (Statements (Catch - ( - ( + (Statements + (Statements (Identifier))) (Catch - ( - ( + (Statements + (Statements (Identifier) (Identifier)) - ( + (Statements (Send (Identifier)))) - ([]))) + (Statements))) (Else (Empty) - ([])) + (Statements)) (Finally - ([])))) + (Statements)))) (Try (Send (Identifier)) diff --git a/test/fixtures/ruby/corpus/rescue.parseB.txt b/test/fixtures/ruby/corpus/rescue.parseB.txt index be7a76a73..d5a5ed658 100644 --- a/test/fixtures/ruby/corpus/rescue.parseB.txt +++ b/test/fixtures/ruby/corpus/rescue.parseB.txt @@ -1,11 +1,11 @@ (Program (Try - ( + (Statements (Send (Identifier)) (Catch - ( - ( + (Statements + (Statements (Send (Identifier)))) (Send diff --git a/test/fixtures/ruby/corpus/singleton-class.parseA.txt b/test/fixtures/ruby/corpus/singleton-class.parseA.txt index f80075b5a..2d718006d 100644 --- a/test/fixtures/ruby/corpus/singleton-class.parseA.txt +++ b/test/fixtures/ruby/corpus/singleton-class.parseA.txt @@ -1,7 +1,7 @@ (Program (Class (Identifier) - ([])) + (Statements)) (Class (ScopeResolution (Identifier) diff --git a/test/fixtures/ruby/corpus/unless.diffA-B.txt b/test/fixtures/ruby/corpus/unless.diffA-B.txt index e5b543018..ad44d6732 100644 --- a/test/fixtures/ruby/corpus/unless.diffA-B.txt +++ b/test/fixtures/ruby/corpus/unless.diffA-B.txt @@ -4,7 +4,8 @@ (Send { (Identifier) ->(Identifier) })) - ({-(Send + (Statements + {-(Send {-(Identifier)-})-}) { (Send {-(Identifier)-}) @@ -13,5 +14,5 @@ {+(Not {+(Send {+(Identifier)+})+})+} - {+([])+} + {+(Statements)+} {+(Empty)+})+}) diff --git a/test/fixtures/ruby/corpus/unless.diffB-A.txt b/test/fixtures/ruby/corpus/unless.diffB-A.txt index ccf5e5da4..4ee118f9d 100644 --- a/test/fixtures/ruby/corpus/unless.diffB-A.txt +++ b/test/fixtures/ruby/corpus/unless.diffB-A.txt @@ -4,7 +4,7 @@ (Send { (Identifier) ->(Identifier) })) - ( + (Statements {+(Send {+(Identifier)+})+}) { (Empty) @@ -14,5 +14,5 @@ {-(Not {-(Send {-(Identifier)-})-})-} - {-([])-} + {-(Statements)-} {-(Empty)-})-}) diff --git a/test/fixtures/ruby/corpus/unless.parseA.txt b/test/fixtures/ruby/corpus/unless.parseA.txt index e219ada22..81b87e968 100644 --- a/test/fixtures/ruby/corpus/unless.parseA.txt +++ b/test/fixtures/ruby/corpus/unless.parseA.txt @@ -3,7 +3,7 @@ (Not (Send (Identifier))) - ( + (Statements (Send (Identifier))) (Send diff --git a/test/fixtures/ruby/corpus/unless.parseB.txt b/test/fixtures/ruby/corpus/unless.parseB.txt index ac70e7130..0d627eb22 100644 --- a/test/fixtures/ruby/corpus/unless.parseB.txt +++ b/test/fixtures/ruby/corpus/unless.parseB.txt @@ -3,11 +3,11 @@ (Not (Send (Identifier))) - ([]) + (Statements) (Empty)) (If (Not (Send (Identifier))) - ([]) + (Statements) (Empty))) diff --git a/test/fixtures/ruby/corpus/until.diffA-B.txt b/test/fixtures/ruby/corpus/until.diffA-B.txt index 3e78b93db..fc6b6b977 100644 --- a/test/fixtures/ruby/corpus/until.diffA-B.txt +++ b/test/fixtures/ruby/corpus/until.diffA-B.txt @@ -3,7 +3,7 @@ (Not (Send (Identifier))) - { ([]) + { (Statements) ->(Send {+(Identifier)+}) }) {-(While diff --git a/test/fixtures/ruby/corpus/until.diffB-A.txt b/test/fixtures/ruby/corpus/until.diffB-A.txt index c9a208953..f6f7e3d00 100644 --- a/test/fixtures/ruby/corpus/until.diffB-A.txt +++ b/test/fixtures/ruby/corpus/until.diffB-A.txt @@ -5,7 +5,7 @@ (Identifier))) { (Send {-(Identifier)-}) - ->([]) }) + ->(Statements) }) {+(While {+(Not {+(Send diff --git a/test/fixtures/ruby/corpus/until.parseA.txt b/test/fixtures/ruby/corpus/until.parseA.txt index 42514e560..2c714334f 100644 --- a/test/fixtures/ruby/corpus/until.parseA.txt +++ b/test/fixtures/ruby/corpus/until.parseA.txt @@ -3,7 +3,7 @@ (Not (Send (Identifier))) - ([])) + (Statements)) (While (Not (Send diff --git a/test/fixtures/ruby/corpus/when-else.diffA-B.txt b/test/fixtures/ruby/corpus/when-else.diffA-B.txt index 67b5a3187..5fe140f15 100644 --- a/test/fixtures/ruby/corpus/when-else.diffA-B.txt +++ b/test/fixtures/ruby/corpus/when-else.diffA-B.txt @@ -2,24 +2,24 @@ (Match (Send (Identifier)) - ( + (Statements (Pattern - ( + (Statements (Send { (Identifier) ->(Identifier) })) - ( + (Statements {+(Send {+(Identifier)+})+} {+(Send {+(Identifier)+})+} {-(Pattern - {-( + {-(Statements {-(Send {-(Identifier)-})-} {-(Send {-(Identifier)-})-})-} - {-( + {-(Statements {-(Send {-(Identifier)-})-} - {-([])-})-})-}))))) + {-(Statements)-})-})-}))))) diff --git a/test/fixtures/ruby/corpus/when-else.diffB-A.txt b/test/fixtures/ruby/corpus/when-else.diffB-A.txt index 51de319d1..a663a07f4 100644 --- a/test/fixtures/ruby/corpus/when-else.diffB-A.txt +++ b/test/fixtures/ruby/corpus/when-else.diffB-A.txt @@ -2,23 +2,23 @@ (Match (Send (Identifier)) - ( + (Statements (Pattern - ( + (Statements (Send { (Identifier) ->(Identifier) })) - ( + (Statements {+(Pattern - {+( + {+(Statements {+(Send {+(Identifier)+})+} {+(Send {+(Identifier)+})+})+} - {+( + {+(Statements {+(Send {+(Identifier)+})+} - {+([])+})+})+} + {+(Statements)+})+})+} {-(Send {-(Identifier)-})-} {-(Send diff --git a/test/fixtures/ruby/corpus/when-else.parseA.txt b/test/fixtures/ruby/corpus/when-else.parseA.txt index 9eae0374a..9a0b2fe67 100644 --- a/test/fixtures/ruby/corpus/when-else.parseA.txt +++ b/test/fixtures/ruby/corpus/when-else.parseA.txt @@ -2,19 +2,19 @@ (Match (Send (Identifier)) - ( + (Statements (Pattern - ( + (Statements (Send (Identifier))) - ( + (Statements (Pattern - ( + (Statements (Send (Identifier)) (Send (Identifier))) - ( + (Statements (Send (Identifier)) - ([])))))))) + (Statements)))))))) diff --git a/test/fixtures/ruby/corpus/when-else.parseB.txt b/test/fixtures/ruby/corpus/when-else.parseB.txt index 4e0a1bc49..0bf7a8e0b 100644 --- a/test/fixtures/ruby/corpus/when-else.parseB.txt +++ b/test/fixtures/ruby/corpus/when-else.parseB.txt @@ -2,12 +2,12 @@ (Match (Send (Identifier)) - ( + (Statements (Pattern - ( + (Statements (Send (Identifier))) - ( + (Statements (Send (Identifier)) (Send diff --git a/test/fixtures/ruby/corpus/when.diffA-B.txt b/test/fixtures/ruby/corpus/when.diffA-B.txt index 431220686..424b74924 100644 --- a/test/fixtures/ruby/corpus/when.diffA-B.txt +++ b/test/fixtures/ruby/corpus/when.diffA-B.txt @@ -2,28 +2,28 @@ (Match (Send (Identifier)) - ( + (Statements (Pattern - ( + (Statements (Send (Identifier))) - ( + (Statements {+(Send {+(Identifier)+})+} {+(Pattern - {+( + {+(Statements {+(Send {+(Identifier)+})+} {+(Send {+(Identifier)+})+})+} - {+( + {+(Statements {+(Send {+(Identifier)+})+})+})+})))) {-(Match {-(Empty)-} - {-( + {-(Statements {-(Pattern - {-( + {-(Statements {-(Boolean)-})-} - {-( + {-(Statements {-(TextElement)-})-})-})-})-}) diff --git a/test/fixtures/ruby/corpus/when.diffB-A.txt b/test/fixtures/ruby/corpus/when.diffB-A.txt index 3f8fc05fe..85c2ab01e 100644 --- a/test/fixtures/ruby/corpus/when.diffB-A.txt +++ b/test/fixtures/ruby/corpus/when.diffB-A.txt @@ -2,27 +2,28 @@ (Match (Send (Identifier)) - ( + (Statements (Pattern - ( + (Statements (Send (Identifier))) - ({-(Send + (Statements + {-(Send {-(Identifier)-})-} {-(Pattern - {-( + {-(Statements {-(Send {-(Identifier)-})-} {-(Send {-(Identifier)-})-})-} - {-( + {-(Statements {-(Send {-(Identifier)-})-})-})-})))) {+(Match {+(Empty)+} - {+( + {+(Statements {+(Pattern - {+( + {+(Statements {+(Boolean)+})+} - {+( + {+(Statements {+(TextElement)+})+})+})+})+}) diff --git a/test/fixtures/ruby/corpus/when.parseA.txt b/test/fixtures/ruby/corpus/when.parseA.txt index 2533c0c85..d4fda449b 100644 --- a/test/fixtures/ruby/corpus/when.parseA.txt +++ b/test/fixtures/ruby/corpus/when.parseA.txt @@ -2,17 +2,17 @@ (Match (Send (Identifier)) - ( + (Statements (Pattern - ( + (Statements (Send (Identifier))) - ([])))) + (Statements)))) (Match (Empty) - ( + (Statements (Pattern - ( + (Statements (Boolean)) - ( + (Statements (TextElement)))))) diff --git a/test/fixtures/ruby/corpus/when.parseB.txt b/test/fixtures/ruby/corpus/when.parseB.txt index 3c10f0c37..9e2ad6051 100644 --- a/test/fixtures/ruby/corpus/when.parseB.txt +++ b/test/fixtures/ruby/corpus/when.parseB.txt @@ -2,20 +2,20 @@ (Match (Send (Identifier)) - ( + (Statements (Pattern - ( + (Statements (Send (Identifier))) - ( + (Statements (Send (Identifier)) (Pattern - ( + (Statements (Send (Identifier)) (Send (Identifier))) - ( + (Statements (Send (Identifier))))))))) diff --git a/test/fixtures/ruby/corpus/while.diffA-B.txt b/test/fixtures/ruby/corpus/while.diffA-B.txt index 5687ca0cc..6d36323a9 100644 --- a/test/fixtures/ruby/corpus/while.diffA-B.txt +++ b/test/fixtures/ruby/corpus/while.diffA-B.txt @@ -2,7 +2,7 @@ (While (Send (Identifier)) - { ([]) + { (Statements) ->(Send {+(Identifier)+}) }) {-(While diff --git a/test/fixtures/ruby/corpus/while.diffB-A.txt b/test/fixtures/ruby/corpus/while.diffB-A.txt index 969590f00..9ae46e79c 100644 --- a/test/fixtures/ruby/corpus/while.diffB-A.txt +++ b/test/fixtures/ruby/corpus/while.diffB-A.txt @@ -4,7 +4,7 @@ (Identifier)) { (Send {-(Identifier)-}) - ->([]) }) + ->(Statements) }) {+(While {+(Send {+(Identifier)+})+} diff --git a/test/fixtures/ruby/corpus/while.parseA.txt b/test/fixtures/ruby/corpus/while.parseA.txt index 6ae0c7011..4f8aa8649 100644 --- a/test/fixtures/ruby/corpus/while.parseA.txt +++ b/test/fixtures/ruby/corpus/while.parseA.txt @@ -2,7 +2,7 @@ (While (Send (Identifier)) - ([])) + (Statements)) (While (Send (Identifier)) diff --git a/test/fixtures/typescript/corpus/ambient-declarations.diffA-B.txt b/test/fixtures/typescript/corpus/ambient-declarations.diffA-B.txt index d3b4fd144..aa4d45b54 100644 --- a/test/fixtures/typescript/corpus/ambient-declarations.diffA-B.txt +++ b/test/fixtures/typescript/corpus/ambient-declarations.diffA-B.txt @@ -13,7 +13,7 @@ {-(TypeIdentifier)-})-} {-(Identifier)-} {-(Empty)-}) - ->([]) })) + ->(Statements) })) (AmbientDeclaration { (VariableDeclaration {-(Assignment @@ -99,7 +99,7 @@ (AmbientDeclaration (Class (Identifier) - ( + (Statements (MethodSignature (Empty) (Empty) diff --git a/test/fixtures/typescript/corpus/ambient-declarations.diffB-A.txt b/test/fixtures/typescript/corpus/ambient-declarations.diffB-A.txt index 496fe1411..2ec101943 100644 --- a/test/fixtures/typescript/corpus/ambient-declarations.diffB-A.txt +++ b/test/fixtures/typescript/corpus/ambient-declarations.diffB-A.txt @@ -92,7 +92,7 @@ {-(AmbientDeclaration {-(Class {-(Identifier)-} - {-([])-})-})-} + {-(Statements)-})-})-} {-(AmbientDeclaration {-(InterfaceDeclaration {-(Empty)-} @@ -102,7 +102,7 @@ (AmbientDeclaration (Class (Identifier) - ( + (Statements (MethodSignature (Empty) (Empty) diff --git a/test/fixtures/typescript/corpus/ambient-declarations.parseA.txt b/test/fixtures/typescript/corpus/ambient-declarations.parseA.txt index 751229398..f028e9b5b 100644 --- a/test/fixtures/typescript/corpus/ambient-declarations.parseA.txt +++ b/test/fixtures/typescript/corpus/ambient-declarations.parseA.txt @@ -89,7 +89,7 @@ (AmbientDeclaration (Class (Identifier) - ( + (Statements (MethodSignature (Empty) (Empty) diff --git a/test/fixtures/typescript/corpus/ambient-declarations.parseB.txt b/test/fixtures/typescript/corpus/ambient-declarations.parseB.txt index 769d3757c..0d0519272 100644 --- a/test/fixtures/typescript/corpus/ambient-declarations.parseB.txt +++ b/test/fixtures/typescript/corpus/ambient-declarations.parseB.txt @@ -5,7 +5,7 @@ (AmbientDeclaration (Class (Identifier) - ([]))) + (Statements))) (AmbientDeclaration (InterfaceDeclaration (Empty) @@ -15,7 +15,7 @@ (AmbientDeclaration (Class (Identifier) - ( + (Statements (MethodSignature (Empty) (Empty) diff --git a/test/fixtures/typescript/corpus/ambient-exports.diffA-B.txt b/test/fixtures/typescript/corpus/ambient-exports.diffA-B.txt index fda31a882..400442a30 100644 --- a/test/fixtures/typescript/corpus/ambient-exports.diffA-B.txt +++ b/test/fixtures/typescript/corpus/ambient-exports.diffA-B.txt @@ -2,7 +2,7 @@ (DefaultExport { (Class {-(Identifier)-} - {-([])-}) + {-(Statements)-}) ->(Function {+(Empty)+} {+(Empty)+} @@ -23,7 +23,7 @@ {+(Assignment {+(Identifier)+} {+(Empty)+})+})+} - {+( + {+(Statements {+(Return {+(Hash {+(ShorthandPropertyIdentifier)+} diff --git a/test/fixtures/typescript/corpus/ambient-exports.diffB-A.txt b/test/fixtures/typescript/corpus/ambient-exports.diffB-A.txt index afbaad04f..ac045fe1e 100644 --- a/test/fixtures/typescript/corpus/ambient-exports.diffB-A.txt +++ b/test/fixtures/typescript/corpus/ambient-exports.diffB-A.txt @@ -20,11 +20,11 @@ {-(Assignment {-(Identifier)-} {-(Empty)-})-})-} - {-( + {-(Statements {-(Return {-(Hash {-(ShorthandPropertyIdentifier)-} {-(ShorthandPropertyIdentifier)-})-})-})-}) ->(Class {+(Identifier)+} - {+([])+}) })) + {+(Statements)+}) })) diff --git a/test/fixtures/typescript/corpus/ambient-exports.parseA.txt b/test/fixtures/typescript/corpus/ambient-exports.parseA.txt index 3f6f3d427..29e69c225 100644 --- a/test/fixtures/typescript/corpus/ambient-exports.parseA.txt +++ b/test/fixtures/typescript/corpus/ambient-exports.parseA.txt @@ -2,4 +2,4 @@ (DefaultExport (Class (Identifier) - ([])))) + (Statements)))) diff --git a/test/fixtures/typescript/corpus/ambient-exports.parseB.txt b/test/fixtures/typescript/corpus/ambient-exports.parseB.txt index c95a6be19..daab22e4f 100644 --- a/test/fixtures/typescript/corpus/ambient-exports.parseB.txt +++ b/test/fixtures/typescript/corpus/ambient-exports.parseB.txt @@ -20,7 +20,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Hash (ShorthandPropertyIdentifier) diff --git a/test/fixtures/typescript/corpus/anonymous-function.diffA-B.txt b/test/fixtures/typescript/corpus/anonymous-function.diffA-B.txt index 7d647cf4c..a413f45aa 100644 --- a/test/fixtures/typescript/corpus/anonymous-function.diffA-B.txt +++ b/test/fixtures/typescript/corpus/anonymous-function.diffA-B.txt @@ -24,7 +24,7 @@ {+(Assignment {+(Identifier)+} {+(Empty)+})+})+} - ( + (Statements (Return { (Plus {-(Identifier)-} diff --git a/test/fixtures/typescript/corpus/anonymous-function.diffB-A.txt b/test/fixtures/typescript/corpus/anonymous-function.diffB-A.txt index 378fb36fa..14e2117e6 100644 --- a/test/fixtures/typescript/corpus/anonymous-function.diffB-A.txt +++ b/test/fixtures/typescript/corpus/anonymous-function.diffB-A.txt @@ -24,7 +24,7 @@ {-(Assignment {-(Identifier)-} {-(Empty)-})-})-} - ( + (Statements (Return { (Times {-(Identifier)-} diff --git a/test/fixtures/typescript/corpus/anonymous-function.parseA.txt b/test/fixtures/typescript/corpus/anonymous-function.parseA.txt index b16aad149..410fa0126 100644 --- a/test/fixtures/typescript/corpus/anonymous-function.parseA.txt +++ b/test/fixtures/typescript/corpus/anonymous-function.parseA.txt @@ -17,7 +17,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Plus (Identifier) diff --git a/test/fixtures/typescript/corpus/anonymous-function.parseB.txt b/test/fixtures/typescript/corpus/anonymous-function.parseB.txt index a04c5cd22..f4cf6bbd8 100644 --- a/test/fixtures/typescript/corpus/anonymous-function.parseB.txt +++ b/test/fixtures/typescript/corpus/anonymous-function.parseB.txt @@ -17,7 +17,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Times (Identifier) diff --git a/test/fixtures/typescript/corpus/anonymous-parameterless-function.diffA-B.txt b/test/fixtures/typescript/corpus/anonymous-parameterless-function.diffA-B.txt index b2b1fd3d9..33fc55d49 100644 --- a/test/fixtures/typescript/corpus/anonymous-parameterless-function.diffA-B.txt +++ b/test/fixtures/typescript/corpus/anonymous-parameterless-function.diffA-B.txt @@ -3,7 +3,7 @@ (Empty) (Empty) (Empty) - ( + (Statements (Return { (TextElement) ->(TextElement) })))) diff --git a/test/fixtures/typescript/corpus/anonymous-parameterless-function.diffB-A.txt b/test/fixtures/typescript/corpus/anonymous-parameterless-function.diffB-A.txt index b2b1fd3d9..33fc55d49 100644 --- a/test/fixtures/typescript/corpus/anonymous-parameterless-function.diffB-A.txt +++ b/test/fixtures/typescript/corpus/anonymous-parameterless-function.diffB-A.txt @@ -3,7 +3,7 @@ (Empty) (Empty) (Empty) - ( + (Statements (Return { (TextElement) ->(TextElement) })))) diff --git a/test/fixtures/typescript/corpus/anonymous-parameterless-function.parseA.txt b/test/fixtures/typescript/corpus/anonymous-parameterless-function.parseA.txt index 84537c07d..bb24b8ce4 100644 --- a/test/fixtures/typescript/corpus/anonymous-parameterless-function.parseA.txt +++ b/test/fixtures/typescript/corpus/anonymous-parameterless-function.parseA.txt @@ -3,6 +3,6 @@ (Empty) (Empty) (Empty) - ( + (Statements (Return (TextElement))))) diff --git a/test/fixtures/typescript/corpus/anonymous-parameterless-function.parseB.txt b/test/fixtures/typescript/corpus/anonymous-parameterless-function.parseB.txt index 84537c07d..bb24b8ce4 100644 --- a/test/fixtures/typescript/corpus/anonymous-parameterless-function.parseB.txt +++ b/test/fixtures/typescript/corpus/anonymous-parameterless-function.parseB.txt @@ -3,6 +3,6 @@ (Empty) (Empty) (Empty) - ( + (Statements (Return (TextElement))))) diff --git a/test/fixtures/typescript/corpus/arrow-function.diffA-B.txt b/test/fixtures/typescript/corpus/arrow-function.diffA-B.txt index 1edf8182d..600b385ff 100644 --- a/test/fixtures/typescript/corpus/arrow-function.diffA-B.txt +++ b/test/fixtures/typescript/corpus/arrow-function.diffA-B.txt @@ -17,7 +17,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return { (Identifier) ->(Identifier) })))) diff --git a/test/fixtures/typescript/corpus/arrow-function.diffB-A.txt b/test/fixtures/typescript/corpus/arrow-function.diffB-A.txt index 1edf8182d..600b385ff 100644 --- a/test/fixtures/typescript/corpus/arrow-function.diffB-A.txt +++ b/test/fixtures/typescript/corpus/arrow-function.diffB-A.txt @@ -17,7 +17,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return { (Identifier) ->(Identifier) })))) diff --git a/test/fixtures/typescript/corpus/arrow-function.parseA.txt b/test/fixtures/typescript/corpus/arrow-function.parseA.txt index 1bced8e40..e178c9e7c 100644 --- a/test/fixtures/typescript/corpus/arrow-function.parseA.txt +++ b/test/fixtures/typescript/corpus/arrow-function.parseA.txt @@ -17,6 +17,6 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Identifier))))) diff --git a/test/fixtures/typescript/corpus/arrow-function.parseB.txt b/test/fixtures/typescript/corpus/arrow-function.parseB.txt index 1bced8e40..e178c9e7c 100644 --- a/test/fixtures/typescript/corpus/arrow-function.parseB.txt +++ b/test/fixtures/typescript/corpus/arrow-function.parseB.txt @@ -17,6 +17,6 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Identifier))))) diff --git a/test/fixtures/typescript/corpus/break.diffA-B.txt b/test/fixtures/typescript/corpus/break.diffA-B.txt index eff385027..46eb71902 100644 --- a/test/fixtures/typescript/corpus/break.diffA-B.txt +++ b/test/fixtures/typescript/corpus/break.diffA-B.txt @@ -8,12 +8,12 @@ (Float)) (Update (Identifier)) - ( + (Statements (If (StrictEqual (Identifier) (Float)) - ( + (Statements {+(Continue {+(Empty)+})+} {-(Break diff --git a/test/fixtures/typescript/corpus/break.diffB-A.txt b/test/fixtures/typescript/corpus/break.diffB-A.txt index 745ef1761..44e6c7bdc 100644 --- a/test/fixtures/typescript/corpus/break.diffB-A.txt +++ b/test/fixtures/typescript/corpus/break.diffB-A.txt @@ -8,12 +8,12 @@ (Float)) (Update (Identifier)) - ( + (Statements (If (StrictEqual (Identifier) (Float)) - ( + (Statements {+(Break {+(Empty)+})+} {-(Continue diff --git a/test/fixtures/typescript/corpus/break.parseA.txt b/test/fixtures/typescript/corpus/break.parseA.txt index e927cd94c..c0af1c973 100644 --- a/test/fixtures/typescript/corpus/break.parseA.txt +++ b/test/fixtures/typescript/corpus/break.parseA.txt @@ -8,12 +8,12 @@ (Float)) (Update (Identifier)) - ( + (Statements (If (StrictEqual (Identifier) (Float)) - ( + (Statements (Break (Empty))) (Empty)) diff --git a/test/fixtures/typescript/corpus/break.parseB.txt b/test/fixtures/typescript/corpus/break.parseB.txt index 9618a22b5..0c30ef033 100644 --- a/test/fixtures/typescript/corpus/break.parseB.txt +++ b/test/fixtures/typescript/corpus/break.parseB.txt @@ -8,12 +8,12 @@ (Float)) (Update (Identifier)) - ( + (Statements (If (StrictEqual (Identifier) (Float)) - ( + (Statements (Continue (Empty))) (Empty)) diff --git a/test/fixtures/typescript/corpus/chained-callbacks.diffA-B.txt b/test/fixtures/typescript/corpus/chained-callbacks.diffA-B.txt index f88bc58c9..ba36adf30 100644 --- a/test/fixtures/typescript/corpus/chained-callbacks.diffA-B.txt +++ b/test/fixtures/typescript/corpus/chained-callbacks.diffA-B.txt @@ -15,7 +15,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (MemberAccess { (Identifier) diff --git a/test/fixtures/typescript/corpus/chained-callbacks.diffB-A.txt b/test/fixtures/typescript/corpus/chained-callbacks.diffB-A.txt index f88bc58c9..ba36adf30 100644 --- a/test/fixtures/typescript/corpus/chained-callbacks.diffB-A.txt +++ b/test/fixtures/typescript/corpus/chained-callbacks.diffB-A.txt @@ -15,7 +15,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (MemberAccess { (Identifier) diff --git a/test/fixtures/typescript/corpus/chained-callbacks.parseA.txt b/test/fixtures/typescript/corpus/chained-callbacks.parseA.txt index f54ff9ba2..a6043e559 100644 --- a/test/fixtures/typescript/corpus/chained-callbacks.parseA.txt +++ b/test/fixtures/typescript/corpus/chained-callbacks.parseA.txt @@ -14,7 +14,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (MemberAccess (Identifier) diff --git a/test/fixtures/typescript/corpus/chained-callbacks.parseB.txt b/test/fixtures/typescript/corpus/chained-callbacks.parseB.txt index f54ff9ba2..a6043e559 100644 --- a/test/fixtures/typescript/corpus/chained-callbacks.parseB.txt +++ b/test/fixtures/typescript/corpus/chained-callbacks.parseB.txt @@ -14,7 +14,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (MemberAccess (Identifier) diff --git a/test/fixtures/typescript/corpus/class.diffA-B.txt b/test/fixtures/typescript/corpus/class.diffA-B.txt index dab5d8cb8..e5098c83c 100644 --- a/test/fixtures/typescript/corpus/class.diffA-B.txt +++ b/test/fixtures/typescript/corpus/class.diffA-B.txt @@ -10,7 +10,7 @@ (ExtendsClause { (TypeIdentifier) ->(TypeIdentifier) }) - ( + (Statements {+(Method {+(Empty)+} {+(Empty)+} @@ -25,7 +25,7 @@ {+(Assignment {+(Identifier)+} {+(Empty)+})+})+} - {+( + {+(Statements {+(Return {+(Identifier)+})+})+})+} {+(Method @@ -42,7 +42,7 @@ {+(Assignment {+(Identifier)+} {+(Empty)+})+})+} - {+( + {+(Statements {+(Return {+(Identifier)+})+})+})+} {+(Method @@ -59,7 +59,7 @@ {+(Assignment {+(Identifier)+} {+(Empty)+})+})+} - {+( + {+(Statements {+(Return {+(Identifier)+})+})+})+} {-(PublicFieldDefinition @@ -82,7 +82,7 @@ {-(Assignment {-(Identifier)-} {-(Empty)-})-})-} - {-( + {-(Statements {-(Return {-(Identifier)-})-})-})-} {-(Method @@ -99,7 +99,7 @@ {-(Assignment {-(Identifier)-} {-(Empty)-})-})-} - {-( + {-(Statements {-(Return {-(Identifier)-})-})-})-} {-(Method @@ -116,6 +116,6 @@ {-(Assignment {-(Identifier)-} {-(Empty)-})-})-} - {-( + {-(Statements {-(Return {-(Identifier)-})-})-})-}))) diff --git a/test/fixtures/typescript/corpus/class.diffB-A.txt b/test/fixtures/typescript/corpus/class.diffB-A.txt index 85ae83908..25a835604 100644 --- a/test/fixtures/typescript/corpus/class.diffB-A.txt +++ b/test/fixtures/typescript/corpus/class.diffB-A.txt @@ -10,7 +10,7 @@ (ExtendsClause { (TypeIdentifier) ->(TypeIdentifier) }) - ( + (Statements {+(PublicFieldDefinition {+(Empty)+} {+(Empty)+} @@ -32,7 +32,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Identifier)))) (Method @@ -50,7 +50,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Identifier)))) (Method @@ -68,6 +68,6 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Identifier))))))) diff --git a/test/fixtures/typescript/corpus/class.parseA.txt b/test/fixtures/typescript/corpus/class.parseA.txt index 2626ef337..0d3c5096e 100644 --- a/test/fixtures/typescript/corpus/class.parseA.txt +++ b/test/fixtures/typescript/corpus/class.parseA.txt @@ -7,7 +7,7 @@ (Identifier) (ExtendsClause (TypeIdentifier)) - ( + (Statements (PublicFieldDefinition (Empty) (Empty) @@ -28,7 +28,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Identifier)))) (Method @@ -45,7 +45,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Identifier)))) (Method @@ -62,6 +62,6 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Identifier))))))) diff --git a/test/fixtures/typescript/corpus/class.parseB.txt b/test/fixtures/typescript/corpus/class.parseB.txt index ff695c7d8..79c19acf2 100644 --- a/test/fixtures/typescript/corpus/class.parseB.txt +++ b/test/fixtures/typescript/corpus/class.parseB.txt @@ -7,7 +7,7 @@ (Identifier) (ExtendsClause (TypeIdentifier)) - ( + (Statements (Method (Empty) (Empty) @@ -22,7 +22,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Identifier)))) (Method @@ -39,7 +39,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Identifier)))) (Method @@ -56,6 +56,6 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Identifier))))))) diff --git a/test/fixtures/typescript/corpus/continue.diffA-B.txt b/test/fixtures/typescript/corpus/continue.diffA-B.txt index 745ef1761..44e6c7bdc 100644 --- a/test/fixtures/typescript/corpus/continue.diffA-B.txt +++ b/test/fixtures/typescript/corpus/continue.diffA-B.txt @@ -8,12 +8,12 @@ (Float)) (Update (Identifier)) - ( + (Statements (If (StrictEqual (Identifier) (Float)) - ( + (Statements {+(Break {+(Empty)+})+} {-(Continue diff --git a/test/fixtures/typescript/corpus/continue.diffB-A.txt b/test/fixtures/typescript/corpus/continue.diffB-A.txt index eff385027..46eb71902 100644 --- a/test/fixtures/typescript/corpus/continue.diffB-A.txt +++ b/test/fixtures/typescript/corpus/continue.diffB-A.txt @@ -8,12 +8,12 @@ (Float)) (Update (Identifier)) - ( + (Statements (If (StrictEqual (Identifier) (Float)) - ( + (Statements {+(Continue {+(Empty)+})+} {-(Break diff --git a/test/fixtures/typescript/corpus/continue.parseA.txt b/test/fixtures/typescript/corpus/continue.parseA.txt index 9618a22b5..0c30ef033 100644 --- a/test/fixtures/typescript/corpus/continue.parseA.txt +++ b/test/fixtures/typescript/corpus/continue.parseA.txt @@ -8,12 +8,12 @@ (Float)) (Update (Identifier)) - ( + (Statements (If (StrictEqual (Identifier) (Float)) - ( + (Statements (Continue (Empty))) (Empty)) diff --git a/test/fixtures/typescript/corpus/continue.parseB.txt b/test/fixtures/typescript/corpus/continue.parseB.txt index e927cd94c..c0af1c973 100644 --- a/test/fixtures/typescript/corpus/continue.parseB.txt +++ b/test/fixtures/typescript/corpus/continue.parseB.txt @@ -8,12 +8,12 @@ (Float)) (Update (Identifier)) - ( + (Statements (If (StrictEqual (Identifier) (Float)) - ( + (Statements (Break (Empty))) (Empty)) diff --git a/test/fixtures/typescript/corpus/do-while-statement.diffA-B.txt b/test/fixtures/typescript/corpus/do-while-statement.diffA-B.txt index 30c06d609..5935813f5 100644 --- a/test/fixtures/typescript/corpus/do-while-statement.diffA-B.txt +++ b/test/fixtures/typescript/corpus/do-while-statement.diffA-B.txt @@ -2,7 +2,7 @@ (DoWhile { (Boolean) ->(Boolean) } - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/typescript/corpus/do-while-statement.diffB-A.txt b/test/fixtures/typescript/corpus/do-while-statement.diffB-A.txt index 30c06d609..5935813f5 100644 --- a/test/fixtures/typescript/corpus/do-while-statement.diffB-A.txt +++ b/test/fixtures/typescript/corpus/do-while-statement.diffB-A.txt @@ -2,7 +2,7 @@ (DoWhile { (Boolean) ->(Boolean) } - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/typescript/corpus/do-while-statement.parseA.txt b/test/fixtures/typescript/corpus/do-while-statement.parseA.txt index 92c41b1a1..a75cc5e53 100644 --- a/test/fixtures/typescript/corpus/do-while-statement.parseA.txt +++ b/test/fixtures/typescript/corpus/do-while-statement.parseA.txt @@ -1,7 +1,7 @@ (Program (DoWhile (Boolean) - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/typescript/corpus/do-while-statement.parseB.txt b/test/fixtures/typescript/corpus/do-while-statement.parseB.txt index 92c41b1a1..a75cc5e53 100644 --- a/test/fixtures/typescript/corpus/do-while-statement.parseB.txt +++ b/test/fixtures/typescript/corpus/do-while-statement.parseB.txt @@ -1,7 +1,7 @@ (Program (DoWhile (Boolean) - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/typescript/corpus/export.diffA-B.txt b/test/fixtures/typescript/corpus/export.diffA-B.txt index 4e6aea904..d820a0e81 100644 --- a/test/fixtures/typescript/corpus/export.diffA-B.txt +++ b/test/fixtures/typescript/corpus/export.diffA-B.txt @@ -52,13 +52,13 @@ {+(Empty)+} {+(Empty)+} {+(Identifier)+} - {+([])+})+})+} + {+(Statements)+})+})+} (DefaultExport (Function (Empty) (Empty) (Empty) - ([]))) + (Statements))) {+(QualifiedExport)+} {+(DefaultExport {+(TextElement)+})+} @@ -69,7 +69,7 @@ {-(Empty)-} {-(Empty)-} {-(Identifier)-} - {-([])-})-})-} + {-(Statements)-})-})-} {-(QualifiedExport)-} {-(DefaultExport {-(TextElement)-})-} diff --git a/test/fixtures/typescript/corpus/export.diffB-A.txt b/test/fixtures/typescript/corpus/export.diffB-A.txt index c0d98eefd..fca2269b7 100644 --- a/test/fixtures/typescript/corpus/export.diffB-A.txt +++ b/test/fixtures/typescript/corpus/export.diffB-A.txt @@ -55,19 +55,19 @@ {-(Empty)-} {-(Empty)-} {-(Identifier)-} - {-([])-})-})-} + {-(Statements)-})-})-} (DefaultExport (Function (Empty) (Empty) (Empty) - ([]))) + (Statements))) {+(DefaultExport {+(Function {+(Empty)+} {+(Empty)+} {+(Identifier)+} - {+([])+})+})+} + {+(Statements)+})+})+} { (QualifiedExport) ->(QualifiedExport) } (DefaultExport diff --git a/test/fixtures/typescript/corpus/export.parseA.txt b/test/fixtures/typescript/corpus/export.parseA.txt index 5e293e404..c65411988 100644 --- a/test/fixtures/typescript/corpus/export.parseA.txt +++ b/test/fixtures/typescript/corpus/export.parseA.txt @@ -40,13 +40,13 @@ (Empty) (Empty) (Empty) - ([]))) + (Statements))) (DefaultExport (Function (Empty) (Empty) (Identifier) - ([]))) + (Statements))) (QualifiedExport) (DefaultExport (TextElement)) diff --git a/test/fixtures/typescript/corpus/export.parseB.txt b/test/fixtures/typescript/corpus/export.parseB.txt index 12ec54bef..a04091e87 100644 --- a/test/fixtures/typescript/corpus/export.parseB.txt +++ b/test/fixtures/typescript/corpus/export.parseB.txt @@ -40,13 +40,13 @@ (Empty) (Empty) (Identifier) - ([]))) + (Statements))) (DefaultExport (Function (Empty) (Empty) (Empty) - ([]))) + (Statements))) (QualifiedExport) (DefaultExport (TextElement)) diff --git a/test/fixtures/typescript/corpus/for-in-statement.diffA-B.txt b/test/fixtures/typescript/corpus/for-in-statement.diffA-B.txt index 4faf0ca9a..7f4c7fe4a 100644 --- a/test/fixtures/typescript/corpus/for-in-statement.diffA-B.txt +++ b/test/fixtures/typescript/corpus/for-in-statement.diffA-B.txt @@ -4,7 +4,7 @@ ->(Identifier) } { (Identifier) ->(Identifier) } - ( + (Statements (Call { (Identifier) ->(Identifier) } diff --git a/test/fixtures/typescript/corpus/for-in-statement.diffB-A.txt b/test/fixtures/typescript/corpus/for-in-statement.diffB-A.txt index 4faf0ca9a..7f4c7fe4a 100644 --- a/test/fixtures/typescript/corpus/for-in-statement.diffB-A.txt +++ b/test/fixtures/typescript/corpus/for-in-statement.diffB-A.txt @@ -4,7 +4,7 @@ ->(Identifier) } { (Identifier) ->(Identifier) } - ( + (Statements (Call { (Identifier) ->(Identifier) } diff --git a/test/fixtures/typescript/corpus/for-in-statement.parseA.txt b/test/fixtures/typescript/corpus/for-in-statement.parseA.txt index c41e5a7f1..79a82b79a 100644 --- a/test/fixtures/typescript/corpus/for-in-statement.parseA.txt +++ b/test/fixtures/typescript/corpus/for-in-statement.parseA.txt @@ -2,7 +2,7 @@ (ForEach (Identifier) (Identifier) - ( + (Statements (Call (Identifier) (Empty))))) diff --git a/test/fixtures/typescript/corpus/for-in-statement.parseB.txt b/test/fixtures/typescript/corpus/for-in-statement.parseB.txt index c41e5a7f1..79a82b79a 100644 --- a/test/fixtures/typescript/corpus/for-in-statement.parseB.txt +++ b/test/fixtures/typescript/corpus/for-in-statement.parseB.txt @@ -2,7 +2,7 @@ (ForEach (Identifier) (Identifier) - ( + (Statements (Call (Identifier) (Empty))))) diff --git a/test/fixtures/typescript/corpus/for-loop-with-in-statement.diffA-B.txt b/test/fixtures/typescript/corpus/for-loop-with-in-statement.diffA-B.txt index dcd085128..e3184832c 100644 --- a/test/fixtures/typescript/corpus/for-loop-with-in-statement.diffA-B.txt +++ b/test/fixtures/typescript/corpus/for-loop-with-in-statement.diffA-B.txt @@ -13,7 +13,7 @@ (Identifier)) (Update (Identifier)) - ( + (Statements (Call { (Identifier) ->(Identifier) } diff --git a/test/fixtures/typescript/corpus/for-loop-with-in-statement.diffB-A.txt b/test/fixtures/typescript/corpus/for-loop-with-in-statement.diffB-A.txt index dcd085128..e3184832c 100644 --- a/test/fixtures/typescript/corpus/for-loop-with-in-statement.diffB-A.txt +++ b/test/fixtures/typescript/corpus/for-loop-with-in-statement.diffB-A.txt @@ -13,7 +13,7 @@ (Identifier)) (Update (Identifier)) - ( + (Statements (Call { (Identifier) ->(Identifier) } diff --git a/test/fixtures/typescript/corpus/for-loop-with-in-statement.parseA.txt b/test/fixtures/typescript/corpus/for-loop-with-in-statement.parseA.txt index 09777939f..0c1d70fb4 100644 --- a/test/fixtures/typescript/corpus/for-loop-with-in-statement.parseA.txt +++ b/test/fixtures/typescript/corpus/for-loop-with-in-statement.parseA.txt @@ -12,7 +12,7 @@ (Identifier)) (Update (Identifier)) - ( + (Statements (Call (Identifier) (Empty))))) diff --git a/test/fixtures/typescript/corpus/for-loop-with-in-statement.parseB.txt b/test/fixtures/typescript/corpus/for-loop-with-in-statement.parseB.txt index 09777939f..0c1d70fb4 100644 --- a/test/fixtures/typescript/corpus/for-loop-with-in-statement.parseB.txt +++ b/test/fixtures/typescript/corpus/for-loop-with-in-statement.parseB.txt @@ -12,7 +12,7 @@ (Identifier)) (Update (Identifier)) - ( + (Statements (Call (Identifier) (Empty))))) diff --git a/test/fixtures/typescript/corpus/for-of-statement.diffA-B.txt b/test/fixtures/typescript/corpus/for-of-statement.diffA-B.txt index 9886795f9..f5e052f79 100644 --- a/test/fixtures/typescript/corpus/for-of-statement.diffA-B.txt +++ b/test/fixtures/typescript/corpus/for-of-statement.diffA-B.txt @@ -4,7 +4,7 @@ ->(Identifier) } { (Identifier) ->(Identifier) } - ( + (Statements (Call (Identifier) { (Identifier) diff --git a/test/fixtures/typescript/corpus/for-of-statement.diffB-A.txt b/test/fixtures/typescript/corpus/for-of-statement.diffB-A.txt index 9886795f9..f5e052f79 100644 --- a/test/fixtures/typescript/corpus/for-of-statement.diffB-A.txt +++ b/test/fixtures/typescript/corpus/for-of-statement.diffB-A.txt @@ -4,7 +4,7 @@ ->(Identifier) } { (Identifier) ->(Identifier) } - ( + (Statements (Call (Identifier) { (Identifier) diff --git a/test/fixtures/typescript/corpus/for-of-statement.parseA.txt b/test/fixtures/typescript/corpus/for-of-statement.parseA.txt index 025a1cf60..3c9704a36 100644 --- a/test/fixtures/typescript/corpus/for-of-statement.parseA.txt +++ b/test/fixtures/typescript/corpus/for-of-statement.parseA.txt @@ -2,7 +2,7 @@ (ForOf (Identifier) (Identifier) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/typescript/corpus/for-of-statement.parseB.txt b/test/fixtures/typescript/corpus/for-of-statement.parseB.txt index 025a1cf60..3c9704a36 100644 --- a/test/fixtures/typescript/corpus/for-of-statement.parseB.txt +++ b/test/fixtures/typescript/corpus/for-of-statement.parseB.txt @@ -2,7 +2,7 @@ (ForOf (Identifier) (Identifier) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/typescript/corpus/for-statement.diffA-B.txt b/test/fixtures/typescript/corpus/for-statement.diffA-B.txt index 42df10b93..1cf044616 100644 --- a/test/fixtures/typescript/corpus/for-statement.diffA-B.txt +++ b/test/fixtures/typescript/corpus/for-statement.diffA-B.txt @@ -13,7 +13,7 @@ ->(Float) }) (Update (Identifier)) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/typescript/corpus/for-statement.diffB-A.txt b/test/fixtures/typescript/corpus/for-statement.diffB-A.txt index 42df10b93..1cf044616 100644 --- a/test/fixtures/typescript/corpus/for-statement.diffB-A.txt +++ b/test/fixtures/typescript/corpus/for-statement.diffB-A.txt @@ -13,7 +13,7 @@ ->(Float) }) (Update (Identifier)) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/typescript/corpus/for-statement.parseA.txt b/test/fixtures/typescript/corpus/for-statement.parseA.txt index 4874a22fc..fe2179965 100644 --- a/test/fixtures/typescript/corpus/for-statement.parseA.txt +++ b/test/fixtures/typescript/corpus/for-statement.parseA.txt @@ -12,7 +12,7 @@ (Float)) (Update (Identifier)) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/typescript/corpus/for-statement.parseB.txt b/test/fixtures/typescript/corpus/for-statement.parseB.txt index 4874a22fc..fe2179965 100644 --- a/test/fixtures/typescript/corpus/for-statement.parseB.txt +++ b/test/fixtures/typescript/corpus/for-statement.parseB.txt @@ -12,7 +12,7 @@ (Float)) (Update (Identifier)) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/typescript/corpus/function-call-args.diffA-B.txt b/test/fixtures/typescript/corpus/function-call-args.diffA-B.txt index cb4b6e2d9..9ab5e70c0 100644 --- a/test/fixtures/typescript/corpus/function-call-args.diffA-B.txt +++ b/test/fixtures/typescript/corpus/function-call-args.diffA-B.txt @@ -29,7 +29,7 @@ {+(Assignment {+(Identifier)+} {+(Empty)+})+})+} - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/typescript/corpus/function-call-args.diffB-A.txt b/test/fixtures/typescript/corpus/function-call-args.diffB-A.txt index 194e964af..46e0b5c06 100644 --- a/test/fixtures/typescript/corpus/function-call-args.diffB-A.txt +++ b/test/fixtures/typescript/corpus/function-call-args.diffB-A.txt @@ -29,7 +29,7 @@ {-(Assignment {-(Identifier)-} {-(Empty)-})-})-} - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/typescript/corpus/function-call-args.parseA.txt b/test/fixtures/typescript/corpus/function-call-args.parseA.txt index 3f9ef783e..ed0d71201 100644 --- a/test/fixtures/typescript/corpus/function-call-args.parseA.txt +++ b/test/fixtures/typescript/corpus/function-call-args.parseA.txt @@ -21,7 +21,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/typescript/corpus/function-call-args.parseB.txt b/test/fixtures/typescript/corpus/function-call-args.parseB.txt index 3f9ef783e..ed0d71201 100644 --- a/test/fixtures/typescript/corpus/function-call-args.parseB.txt +++ b/test/fixtures/typescript/corpus/function-call-args.parseB.txt @@ -21,7 +21,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/typescript/corpus/function.diffA-B.txt b/test/fixtures/typescript/corpus/function.diffA-B.txt index a37e4e145..90c7297b0 100644 --- a/test/fixtures/typescript/corpus/function.diffA-B.txt +++ b/test/fixtures/typescript/corpus/function.diffA-B.txt @@ -25,7 +25,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements { (Identifier) ->(Identifier) })) (Empty)) diff --git a/test/fixtures/typescript/corpus/function.diffB-A.txt b/test/fixtures/typescript/corpus/function.diffB-A.txt index fa75d27e7..a3184822d 100644 --- a/test/fixtures/typescript/corpus/function.diffB-A.txt +++ b/test/fixtures/typescript/corpus/function.diffB-A.txt @@ -25,7 +25,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements { (Identifier) ->(Identifier) })) (Empty)) diff --git a/test/fixtures/typescript/corpus/function.parseA.txt b/test/fixtures/typescript/corpus/function.parseA.txt index 38ae68db9..b98eff32c 100644 --- a/test/fixtures/typescript/corpus/function.parseA.txt +++ b/test/fixtures/typescript/corpus/function.parseA.txt @@ -22,6 +22,6 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Identifier))) (Empty)) diff --git a/test/fixtures/typescript/corpus/function.parseB.txt b/test/fixtures/typescript/corpus/function.parseB.txt index 7db16df9e..493f1a5fc 100644 --- a/test/fixtures/typescript/corpus/function.parseB.txt +++ b/test/fixtures/typescript/corpus/function.parseB.txt @@ -18,6 +18,6 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Identifier))) (Empty)) diff --git a/test/fixtures/typescript/corpus/generator-function.diffA-B.txt b/test/fixtures/typescript/corpus/generator-function.diffA-B.txt index 65f3d8507..2f4f58433 100644 --- a/test/fixtures/typescript/corpus/generator-function.diffA-B.txt +++ b/test/fixtures/typescript/corpus/generator-function.diffA-B.txt @@ -18,7 +18,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Yield (Empty)) (Yield diff --git a/test/fixtures/typescript/corpus/generator-function.diffB-A.txt b/test/fixtures/typescript/corpus/generator-function.diffB-A.txt index 65f3d8507..2f4f58433 100644 --- a/test/fixtures/typescript/corpus/generator-function.diffB-A.txt +++ b/test/fixtures/typescript/corpus/generator-function.diffB-A.txt @@ -18,7 +18,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Yield (Empty)) (Yield diff --git a/test/fixtures/typescript/corpus/generator-function.parseA.txt b/test/fixtures/typescript/corpus/generator-function.parseA.txt index d86eafa99..fd25c91b3 100644 --- a/test/fixtures/typescript/corpus/generator-function.parseA.txt +++ b/test/fixtures/typescript/corpus/generator-function.parseA.txt @@ -17,7 +17,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Yield (Empty)) (Yield diff --git a/test/fixtures/typescript/corpus/generator-function.parseB.txt b/test/fixtures/typescript/corpus/generator-function.parseB.txt index d86eafa99..fd25c91b3 100644 --- a/test/fixtures/typescript/corpus/generator-function.parseB.txt +++ b/test/fixtures/typescript/corpus/generator-function.parseB.txt @@ -17,7 +17,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Yield (Empty)) (Yield diff --git a/test/fixtures/typescript/corpus/if-else.diffA-B.txt b/test/fixtures/typescript/corpus/if-else.diffA-B.txt index 8d402c80e..41281f5e5 100644 --- a/test/fixtures/typescript/corpus/if-else.diffA-B.txt +++ b/test/fixtures/typescript/corpus/if-else.diffA-B.txt @@ -8,7 +8,7 @@ { (Identifier) ->(Identifier) } { (Identifier) - ->( + ->(Statements {+(Identifier)+}) } (If { (Identifier) @@ -19,7 +19,7 @@ { (Identifier) ->(Identifier) } { (Identifier) - ->( + ->(Statements {+(Identifier)+}) } { (Identifier) ->(Identifier) }))))) diff --git a/test/fixtures/typescript/corpus/if-else.diffB-A.txt b/test/fixtures/typescript/corpus/if-else.diffB-A.txt index 514f0cd36..a7e842460 100644 --- a/test/fixtures/typescript/corpus/if-else.diffB-A.txt +++ b/test/fixtures/typescript/corpus/if-else.diffB-A.txt @@ -7,7 +7,7 @@ (If { (Identifier) ->(Identifier) } - { ( + { (Statements {-(Identifier)-}) ->(Identifier) } (If @@ -18,7 +18,7 @@ (If { (Identifier) ->(Identifier) } - { ( + { (Statements {-(Identifier)-}) ->(Identifier) } { (Identifier) diff --git a/test/fixtures/typescript/corpus/if-else.parseB.txt b/test/fixtures/typescript/corpus/if-else.parseB.txt index 3a8f90cf1..2402f8fd0 100644 --- a/test/fixtures/typescript/corpus/if-else.parseB.txt +++ b/test/fixtures/typescript/corpus/if-else.parseB.txt @@ -4,13 +4,13 @@ (Identifier) (If (Identifier) - ( + (Statements (Identifier)) (If (Identifier) (Identifier) (If (Identifier) - ( + (Statements (Identifier)) (Identifier)))))) diff --git a/test/fixtures/typescript/corpus/if.diffA-B.txt b/test/fixtures/typescript/corpus/if.diffA-B.txt index 2a90eee30..329dbee61 100644 --- a/test/fixtures/typescript/corpus/if.diffA-B.txt +++ b/test/fixtures/typescript/corpus/if.diffA-B.txt @@ -4,7 +4,7 @@ ->(MemberAccess {+(Identifier)+} {+(Identifier)+}) } - ( + (Statements (Call (Identifier) { (Identifier) diff --git a/test/fixtures/typescript/corpus/if.diffB-A.txt b/test/fixtures/typescript/corpus/if.diffB-A.txt index a6742d0e3..58379f889 100644 --- a/test/fixtures/typescript/corpus/if.diffB-A.txt +++ b/test/fixtures/typescript/corpus/if.diffB-A.txt @@ -4,7 +4,7 @@ {-(Identifier)-} {-(Identifier)-}) ->(Identifier) } - ( + (Statements (Call (Identifier) { (Identifier) diff --git a/test/fixtures/typescript/corpus/if.parseA.txt b/test/fixtures/typescript/corpus/if.parseA.txt index 23bee3aca..c319b1eb0 100644 --- a/test/fixtures/typescript/corpus/if.parseA.txt +++ b/test/fixtures/typescript/corpus/if.parseA.txt @@ -1,7 +1,7 @@ (Program (If (Identifier) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/typescript/corpus/if.parseB.txt b/test/fixtures/typescript/corpus/if.parseB.txt index 82a81394a..4c23c44b9 100644 --- a/test/fixtures/typescript/corpus/if.parseB.txt +++ b/test/fixtures/typescript/corpus/if.parseB.txt @@ -3,7 +3,7 @@ (MemberAccess (Identifier) (Identifier)) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/typescript/corpus/import.diffA-B.txt b/test/fixtures/typescript/corpus/import.diffA-B.txt index ae75bfbfd..d0fcad063 100644 --- a/test/fixtures/typescript/corpus/import.diffA-B.txt +++ b/test/fixtures/typescript/corpus/import.diffA-B.txt @@ -6,10 +6,10 @@ ->(Import) } {+(Import)+} {+(Import)+} -{+( +{+(Statements {+(Import)+} {+(Import)+})+} -{+( +{+(Statements {+(Import)+} {+(QualifiedAliasedImport {+(Identifier)+})+})+} @@ -19,10 +19,10 @@ {-(Import)-} {-(Import)-} {-(Import)-} -{-( +{-(Statements {-(Import)-} {-(Import)-})-} -{-( +{-(Statements {-(Import)-} {-(QualifiedAliasedImport {-(Identifier)-})-})-} diff --git a/test/fixtures/typescript/corpus/import.diffB-A.txt b/test/fixtures/typescript/corpus/import.diffB-A.txt index 475d4a5ee..cc1429eee 100644 --- a/test/fixtures/typescript/corpus/import.diffB-A.txt +++ b/test/fixtures/typescript/corpus/import.diffB-A.txt @@ -5,10 +5,10 @@ {+(Import)+} {+(Import)+} {+(Import)+} -{+( +{+(Statements {+(Import)+} {+(Import)+})+} -{+( +{+(Statements {+(Import)+} {+(QualifiedAliasedImport {+(Identifier)+})+})+} @@ -21,10 +21,10 @@ {-(Import)-} {-(Import)-} {-(Import)-} -{-( +{-(Statements {-(Import)-} {-(Import)-})-} -{-( +{-(Statements {-(Import)-} {-(QualifiedAliasedImport {-(Identifier)-})-})-} diff --git a/test/fixtures/typescript/corpus/import.parseA.txt b/test/fixtures/typescript/corpus/import.parseA.txt index 4301638e4..0441b60eb 100644 --- a/test/fixtures/typescript/corpus/import.parseA.txt +++ b/test/fixtures/typescript/corpus/import.parseA.txt @@ -5,10 +5,10 @@ (Import) (Import) (Import) - ( + (Statements (Import) (Import)) - ( + (Statements (Import) (QualifiedAliasedImport (Identifier))) diff --git a/test/fixtures/typescript/corpus/import.parseB.txt b/test/fixtures/typescript/corpus/import.parseB.txt index 037e1c7c8..069afffe6 100644 --- a/test/fixtures/typescript/corpus/import.parseB.txt +++ b/test/fixtures/typescript/corpus/import.parseB.txt @@ -5,10 +5,10 @@ (Import) (Import) (Import) - ( + (Statements (Import) (Import)) - ( + (Statements (Import) (QualifiedAliasedImport (Identifier))) diff --git a/test/fixtures/typescript/corpus/method-definition.diffA-B.txt b/test/fixtures/typescript/corpus/method-definition.diffA-B.txt index 558fc034e..8c1179c02 100644 --- a/test/fixtures/typescript/corpus/method-definition.diffA-B.txt +++ b/test/fixtures/typescript/corpus/method-definition.diffA-B.txt @@ -12,4 +12,4 @@ {-(TypeIdentifier)-})-} (Empty) (Identifier) - ([])))) + (Statements)))) diff --git a/test/fixtures/typescript/corpus/method-definition.diffB-A.txt b/test/fixtures/typescript/corpus/method-definition.diffB-A.txt index dcf092e33..de3d7407c 100644 --- a/test/fixtures/typescript/corpus/method-definition.diffB-A.txt +++ b/test/fixtures/typescript/corpus/method-definition.diffB-A.txt @@ -11,4 +11,4 @@ ->(TypeIdentifier) }) (Empty) (Identifier) - ([])))) + (Statements)))) diff --git a/test/fixtures/typescript/corpus/method-definition.parseA.txt b/test/fixtures/typescript/corpus/method-definition.parseA.txt index 0791b7882..be3406a4f 100644 --- a/test/fixtures/typescript/corpus/method-definition.parseA.txt +++ b/test/fixtures/typescript/corpus/method-definition.parseA.txt @@ -9,4 +9,4 @@ (TypeIdentifier)) (Empty) (Identifier) - ([])))) + (Statements)))) diff --git a/test/fixtures/typescript/corpus/method-definition.parseB.txt b/test/fixtures/typescript/corpus/method-definition.parseB.txt index 3ca2b792c..5f149585f 100644 --- a/test/fixtures/typescript/corpus/method-definition.parseB.txt +++ b/test/fixtures/typescript/corpus/method-definition.parseB.txt @@ -9,4 +9,4 @@ (PredefinedType)) (Empty) (Identifier) - ([])))) + (Statements)))) diff --git a/test/fixtures/typescript/corpus/named-function.diffA-B.txt b/test/fixtures/typescript/corpus/named-function.diffA-B.txt index 097c4555b..aec245b08 100644 --- a/test/fixtures/typescript/corpus/named-function.diffA-B.txt +++ b/test/fixtures/typescript/corpus/named-function.diffA-B.txt @@ -18,7 +18,7 @@ {-(Assignment {-(Identifier)-} {-(Empty)-})-})-} - ( + (Statements {+(Return {+(Boolean)+})+} {-(Identifier)-})) diff --git a/test/fixtures/typescript/corpus/named-function.diffB-A.txt b/test/fixtures/typescript/corpus/named-function.diffB-A.txt index 0b02b2e5a..8ac7047e0 100644 --- a/test/fixtures/typescript/corpus/named-function.diffB-A.txt +++ b/test/fixtures/typescript/corpus/named-function.diffB-A.txt @@ -18,7 +18,7 @@ {+(Assignment {+(Identifier)+} {+(Empty)+})+})+} - ( + (Statements {+(Identifier)+} {-(Return {-(Boolean)-})-})) diff --git a/test/fixtures/typescript/corpus/named-function.parseA.txt b/test/fixtures/typescript/corpus/named-function.parseA.txt index 6f4b7d301..a0596d5bd 100644 --- a/test/fixtures/typescript/corpus/named-function.parseA.txt +++ b/test/fixtures/typescript/corpus/named-function.parseA.txt @@ -17,6 +17,6 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Identifier))) (Empty)) diff --git a/test/fixtures/typescript/corpus/named-function.parseB.txt b/test/fixtures/typescript/corpus/named-function.parseB.txt index fbad167d9..96d3c4033 100644 --- a/test/fixtures/typescript/corpus/named-function.parseB.txt +++ b/test/fixtures/typescript/corpus/named-function.parseB.txt @@ -3,7 +3,7 @@ (Empty) (Empty) (Identifier) - ( + (Statements (Return (Boolean)))) (Empty)) diff --git a/test/fixtures/typescript/corpus/nested-do-while-in-function.diffA-B.txt b/test/fixtures/typescript/corpus/nested-do-while-in-function.diffA-B.txt index c7eea5548..00dd2f4a3 100644 --- a/test/fixtures/typescript/corpus/nested-do-while-in-function.diffA-B.txt +++ b/test/fixtures/typescript/corpus/nested-do-while-in-function.diffA-B.txt @@ -17,11 +17,11 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (DoWhile { (Identifier) ->(Identifier) } - ( + (Statements (Call (Identifier) { (Identifier) diff --git a/test/fixtures/typescript/corpus/nested-do-while-in-function.diffB-A.txt b/test/fixtures/typescript/corpus/nested-do-while-in-function.diffB-A.txt index c7eea5548..00dd2f4a3 100644 --- a/test/fixtures/typescript/corpus/nested-do-while-in-function.diffB-A.txt +++ b/test/fixtures/typescript/corpus/nested-do-while-in-function.diffB-A.txt @@ -17,11 +17,11 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (DoWhile { (Identifier) ->(Identifier) } - ( + (Statements (Call (Identifier) { (Identifier) diff --git a/test/fixtures/typescript/corpus/nested-do-while-in-function.parseA.txt b/test/fixtures/typescript/corpus/nested-do-while-in-function.parseA.txt index 440deb76f..618761627 100644 --- a/test/fixtures/typescript/corpus/nested-do-while-in-function.parseA.txt +++ b/test/fixtures/typescript/corpus/nested-do-while-in-function.parseA.txt @@ -17,10 +17,10 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (DoWhile (Identifier) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/typescript/corpus/nested-do-while-in-function.parseB.txt b/test/fixtures/typescript/corpus/nested-do-while-in-function.parseB.txt index 440deb76f..618761627 100644 --- a/test/fixtures/typescript/corpus/nested-do-while-in-function.parseB.txt +++ b/test/fixtures/typescript/corpus/nested-do-while-in-function.parseB.txt @@ -17,10 +17,10 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (DoWhile (Identifier) - ( + (Statements (Call (Identifier) (Identifier) diff --git a/test/fixtures/typescript/corpus/nested-functions.diffA-B.txt b/test/fixtures/typescript/corpus/nested-functions.diffA-B.txt index 0b3c286a9..2a221fcdd 100644 --- a/test/fixtures/typescript/corpus/nested-functions.diffA-B.txt +++ b/test/fixtures/typescript/corpus/nested-functions.diffA-B.txt @@ -17,7 +17,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Function (Empty) (Empty) @@ -36,7 +36,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/typescript/corpus/nested-functions.diffB-A.txt b/test/fixtures/typescript/corpus/nested-functions.diffB-A.txt index 0b3c286a9..2a221fcdd 100644 --- a/test/fixtures/typescript/corpus/nested-functions.diffB-A.txt +++ b/test/fixtures/typescript/corpus/nested-functions.diffB-A.txt @@ -17,7 +17,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Function (Empty) (Empty) @@ -36,7 +36,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/typescript/corpus/nested-functions.parseA.txt b/test/fixtures/typescript/corpus/nested-functions.parseA.txt index 0955c8914..bba0968bd 100644 --- a/test/fixtures/typescript/corpus/nested-functions.parseA.txt +++ b/test/fixtures/typescript/corpus/nested-functions.parseA.txt @@ -17,7 +17,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Function (Empty) (Empty) @@ -36,7 +36,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/typescript/corpus/nested-functions.parseB.txt b/test/fixtures/typescript/corpus/nested-functions.parseB.txt index 0955c8914..bba0968bd 100644 --- a/test/fixtures/typescript/corpus/nested-functions.parseB.txt +++ b/test/fixtures/typescript/corpus/nested-functions.parseB.txt @@ -17,7 +17,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Function (Empty) (Empty) @@ -36,7 +36,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Call (MemberAccess (Identifier) diff --git a/test/fixtures/typescript/corpus/objects-with-methods.diffA-B.txt b/test/fixtures/typescript/corpus/objects-with-methods.diffA-B.txt index e7766878f..9c40be32f 100644 --- a/test/fixtures/typescript/corpus/objects-with-methods.diffA-B.txt +++ b/test/fixtures/typescript/corpus/objects-with-methods.diffA-B.txt @@ -22,7 +22,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return { (Plus {-(Identifier)-} diff --git a/test/fixtures/typescript/corpus/objects-with-methods.diffB-A.txt b/test/fixtures/typescript/corpus/objects-with-methods.diffB-A.txt index 6d87f8b53..914db2372 100644 --- a/test/fixtures/typescript/corpus/objects-with-methods.diffB-A.txt +++ b/test/fixtures/typescript/corpus/objects-with-methods.diffB-A.txt @@ -22,7 +22,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return { (Minus {-(Identifier)-} diff --git a/test/fixtures/typescript/corpus/objects-with-methods.parseA.txt b/test/fixtures/typescript/corpus/objects-with-methods.parseA.txt index d3d5e4345..618957d0f 100644 --- a/test/fixtures/typescript/corpus/objects-with-methods.parseA.txt +++ b/test/fixtures/typescript/corpus/objects-with-methods.parseA.txt @@ -21,7 +21,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Plus (Identifier) diff --git a/test/fixtures/typescript/corpus/objects-with-methods.parseB.txt b/test/fixtures/typescript/corpus/objects-with-methods.parseB.txt index b8747c6ea..8acf4faff 100644 --- a/test/fixtures/typescript/corpus/objects-with-methods.parseB.txt +++ b/test/fixtures/typescript/corpus/objects-with-methods.parseB.txt @@ -21,7 +21,7 @@ (Assignment (Identifier) (Empty))) - ( + (Statements (Return (Minus (Identifier) diff --git a/test/fixtures/typescript/corpus/public-field-definition.diffA-B.txt b/test/fixtures/typescript/corpus/public-field-definition.diffA-B.txt index cfe226e03..155fe53f0 100644 --- a/test/fixtures/typescript/corpus/public-field-definition.diffA-B.txt +++ b/test/fixtures/typescript/corpus/public-field-definition.diffA-B.txt @@ -1,7 +1,7 @@ (Program (Class (Identifier) - ( + (Statements (PublicFieldDefinition (Empty) (Readonly) diff --git a/test/fixtures/typescript/corpus/public-field-definition.diffB-A.txt b/test/fixtures/typescript/corpus/public-field-definition.diffB-A.txt index 3286f2749..3fb59ca0b 100644 --- a/test/fixtures/typescript/corpus/public-field-definition.diffB-A.txt +++ b/test/fixtures/typescript/corpus/public-field-definition.diffB-A.txt @@ -1,7 +1,7 @@ (Program (Class (Identifier) - ( + (Statements (PublicFieldDefinition (Empty) (Readonly) diff --git a/test/fixtures/typescript/corpus/public-field-definition.parseA.txt b/test/fixtures/typescript/corpus/public-field-definition.parseA.txt index 0250fd3ec..2076494be 100644 --- a/test/fixtures/typescript/corpus/public-field-definition.parseA.txt +++ b/test/fixtures/typescript/corpus/public-field-definition.parseA.txt @@ -1,7 +1,7 @@ (Program (Class (Identifier) - ( + (Statements (PublicFieldDefinition (Empty) (Readonly) diff --git a/test/fixtures/typescript/corpus/public-field-definition.parseB.txt b/test/fixtures/typescript/corpus/public-field-definition.parseB.txt index 7651e2fc0..1bec273f5 100644 --- a/test/fixtures/typescript/corpus/public-field-definition.parseB.txt +++ b/test/fixtures/typescript/corpus/public-field-definition.parseB.txt @@ -1,7 +1,7 @@ (Program (Class (Identifier) - ( + (Statements (PublicFieldDefinition (Empty) (Readonly) diff --git a/test/fixtures/typescript/corpus/switch-statement.diffA-B.txt b/test/fixtures/typescript/corpus/switch-statement.diffA-B.txt index e72d89a5b..3883f69c5 100644 --- a/test/fixtures/typescript/corpus/switch-statement.diffA-B.txt +++ b/test/fixtures/typescript/corpus/switch-statement.diffA-B.txt @@ -2,18 +2,18 @@ (Match { (Float) ->(Float) } - ( + (Statements (Pattern (Float) - ( + (Statements (Float))) (Pattern (Float) - ( + (Statements { (Float) ->(Float) })) (Pattern (Float) - ( + (Statements (Float))))) (Empty)) diff --git a/test/fixtures/typescript/corpus/switch-statement.diffB-A.txt b/test/fixtures/typescript/corpus/switch-statement.diffB-A.txt index e72d89a5b..3883f69c5 100644 --- a/test/fixtures/typescript/corpus/switch-statement.diffB-A.txt +++ b/test/fixtures/typescript/corpus/switch-statement.diffB-A.txt @@ -2,18 +2,18 @@ (Match { (Float) ->(Float) } - ( + (Statements (Pattern (Float) - ( + (Statements (Float))) (Pattern (Float) - ( + (Statements { (Float) ->(Float) })) (Pattern (Float) - ( + (Statements (Float))))) (Empty)) diff --git a/test/fixtures/typescript/corpus/switch-statement.parseA.txt b/test/fixtures/typescript/corpus/switch-statement.parseA.txt index 7d77dcfad..3e597d106 100644 --- a/test/fixtures/typescript/corpus/switch-statement.parseA.txt +++ b/test/fixtures/typescript/corpus/switch-statement.parseA.txt @@ -1,17 +1,17 @@ (Program (Match (Float) - ( + (Statements (Pattern (Float) - ( + (Statements (Float))) (Pattern (Float) - ( + (Statements (Float))) (Pattern (Float) - ( + (Statements (Float))))) (Empty)) diff --git a/test/fixtures/typescript/corpus/switch-statement.parseB.txt b/test/fixtures/typescript/corpus/switch-statement.parseB.txt index 7d77dcfad..3e597d106 100644 --- a/test/fixtures/typescript/corpus/switch-statement.parseB.txt +++ b/test/fixtures/typescript/corpus/switch-statement.parseB.txt @@ -1,17 +1,17 @@ (Program (Match (Float) - ( + (Statements (Pattern (Float) - ( + (Statements (Float))) (Pattern (Float) - ( + (Statements (Float))) (Pattern (Float) - ( + (Statements (Float))))) (Empty)) diff --git a/test/fixtures/typescript/corpus/try-statement.diffA-B.txt b/test/fixtures/typescript/corpus/try-statement.diffA-B.txt index a1448e34d..a7241e603 100644 --- a/test/fixtures/typescript/corpus/try-statement.diffA-B.txt +++ b/test/fixtures/typescript/corpus/try-statement.diffA-B.txt @@ -1,14 +1,14 @@ (Program (Try - ( + (Statements (Identifier)) (Catch (Empty) - ( + (Statements { (Identifier) ->(Identifier) })) (Finally - ( + (Statements { (Identifier) ->(Identifier) }))) (Empty)) diff --git a/test/fixtures/typescript/corpus/try-statement.diffB-A.txt b/test/fixtures/typescript/corpus/try-statement.diffB-A.txt index a1448e34d..a7241e603 100644 --- a/test/fixtures/typescript/corpus/try-statement.diffB-A.txt +++ b/test/fixtures/typescript/corpus/try-statement.diffB-A.txt @@ -1,14 +1,14 @@ (Program (Try - ( + (Statements (Identifier)) (Catch (Empty) - ( + (Statements { (Identifier) ->(Identifier) })) (Finally - ( + (Statements { (Identifier) ->(Identifier) }))) (Empty)) diff --git a/test/fixtures/typescript/corpus/try-statement.parseA.txt b/test/fixtures/typescript/corpus/try-statement.parseA.txt index 7224cc157..22e10b492 100644 --- a/test/fixtures/typescript/corpus/try-statement.parseA.txt +++ b/test/fixtures/typescript/corpus/try-statement.parseA.txt @@ -1,12 +1,12 @@ (Program (Try - ( + (Statements (Identifier)) (Catch (Empty) - ( + (Statements (Identifier))) (Finally - ( + (Statements (Identifier)))) (Empty)) diff --git a/test/fixtures/typescript/corpus/try-statement.parseB.txt b/test/fixtures/typescript/corpus/try-statement.parseB.txt index 7224cc157..22e10b492 100644 --- a/test/fixtures/typescript/corpus/try-statement.parseB.txt +++ b/test/fixtures/typescript/corpus/try-statement.parseB.txt @@ -1,12 +1,12 @@ (Program (Try - ( + (Statements (Identifier)) (Catch (Empty) - ( + (Statements (Identifier))) (Finally - ( + (Statements (Identifier)))) (Empty)) diff --git a/test/fixtures/typescript/corpus/while-statement.diffA-B.txt b/test/fixtures/typescript/corpus/while-statement.diffA-B.txt index 7ecf81cea..6c6581fbe 100644 --- a/test/fixtures/typescript/corpus/while-statement.diffA-B.txt +++ b/test/fixtures/typescript/corpus/while-statement.diffA-B.txt @@ -2,7 +2,7 @@ (While { (Identifier) ->(Identifier) } - ( + (Statements (Call { (Identifier) ->(Identifier) } diff --git a/test/fixtures/typescript/corpus/while-statement.diffB-A.txt b/test/fixtures/typescript/corpus/while-statement.diffB-A.txt index 7ecf81cea..6c6581fbe 100644 --- a/test/fixtures/typescript/corpus/while-statement.diffB-A.txt +++ b/test/fixtures/typescript/corpus/while-statement.diffB-A.txt @@ -2,7 +2,7 @@ (While { (Identifier) ->(Identifier) } - ( + (Statements (Call { (Identifier) ->(Identifier) } diff --git a/test/fixtures/typescript/corpus/while-statement.parseA.txt b/test/fixtures/typescript/corpus/while-statement.parseA.txt index 384062c49..41960b042 100644 --- a/test/fixtures/typescript/corpus/while-statement.parseA.txt +++ b/test/fixtures/typescript/corpus/while-statement.parseA.txt @@ -1,7 +1,7 @@ (Program (While (Identifier) - ( + (Statements (Call (Identifier) (Empty)))) diff --git a/test/fixtures/typescript/corpus/while-statement.parseB.txt b/test/fixtures/typescript/corpus/while-statement.parseB.txt index 384062c49..41960b042 100644 --- a/test/fixtures/typescript/corpus/while-statement.parseB.txt +++ b/test/fixtures/typescript/corpus/while-statement.parseB.txt @@ -1,7 +1,7 @@ (Program (While (Identifier) - ( + (Statements (Call (Identifier) (Empty)))) diff --git a/test/fixtures/typescript/corpus/yield.diffA-B.txt b/test/fixtures/typescript/corpus/yield.diffA-B.txt index 1737c04ee..ccde7b2d7 100644 --- a/test/fixtures/typescript/corpus/yield.diffA-B.txt +++ b/test/fixtures/typescript/corpus/yield.diffA-B.txt @@ -3,7 +3,7 @@ (Empty) (Empty) (Identifier) - ( + (Statements (VariableDeclaration (Assignment (Empty) diff --git a/test/fixtures/typescript/corpus/yield.diffB-A.txt b/test/fixtures/typescript/corpus/yield.diffB-A.txt index 56edbe9a9..d7dd3fc20 100644 --- a/test/fixtures/typescript/corpus/yield.diffB-A.txt +++ b/test/fixtures/typescript/corpus/yield.diffB-A.txt @@ -3,7 +3,7 @@ (Empty) (Empty) (Identifier) - ( + (Statements (VariableDeclaration (Assignment (Empty) diff --git a/test/fixtures/typescript/corpus/yield.parseA.txt b/test/fixtures/typescript/corpus/yield.parseA.txt index 0a4c7dcc9..47d764d16 100644 --- a/test/fixtures/typescript/corpus/yield.parseA.txt +++ b/test/fixtures/typescript/corpus/yield.parseA.txt @@ -3,7 +3,7 @@ (Empty) (Empty) (Identifier) - ( + (Statements (VariableDeclaration (Assignment (Empty) diff --git a/test/fixtures/typescript/corpus/yield.parseB.txt b/test/fixtures/typescript/corpus/yield.parseB.txt index 85816f2b8..54eada74e 100644 --- a/test/fixtures/typescript/corpus/yield.parseB.txt +++ b/test/fixtures/typescript/corpus/yield.parseB.txt @@ -3,7 +3,7 @@ (Empty) (Empty) (Identifier) - ( + (Statements (VariableDeclaration (Assignment (Empty) From 84117e4fe919f629184fe6a1079846426b2bb9ce Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 08:03:30 -0400 Subject: [PATCH 112/148] Define roots in terms of addresses. --- src/Data/Abstract/Environment.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Abstract/Environment.hs b/src/Data/Abstract/Environment.hs index 924df9d4a..a029c5c84 100644 --- a/src/Data/Abstract/Environment.hs +++ b/src/Data/Abstract/Environment.hs @@ -119,7 +119,7 @@ overwrite pairs env = unpairs $ mapMaybe lookupAndAlias pairs -- -- Unbound names are silently dropped. roots :: (Ord location, Foldable t) => Environment location -> t Name -> Live location value -roots env = foldMap (maybe mempty liveSingleton . flip lookup env) +roots env names = addresses (bind names env) addresses :: Ord location => Environment location -> Live location value addresses = fromAddresses . map snd . pairs From 4ae5cb5f4e3b19d154f9965135f3fc14b828b430 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 08:03:38 -0400 Subject: [PATCH 113/148] =?UTF-8?q?:fire:=20Live=E2=80=99s=20value=20param?= =?UTF-8?q?eter.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Analysis/Abstract/Caching.hs | 4 ++-- src/Analysis/Abstract/Collecting.hs | 10 +++++----- src/Analysis/Abstract/Tracing.hs | 2 +- src/Control/Abstract/Configuration.hs | 2 +- src/Control/Abstract/Roots.hs | 4 ++-- src/Control/Abstract/Value.hs | 2 +- src/Data/Abstract/Configuration.hs | 2 +- src/Data/Abstract/Environment.hs | 4 ++-- src/Data/Abstract/Heap.hs | 2 +- src/Data/Abstract/Live.hs | 18 +++++++++--------- 10 files changed, 25 insertions(+), 25 deletions(-) diff --git a/src/Analysis/Abstract/Caching.hs b/src/Analysis/Abstract/Caching.hs index 13e76a502..07b7402ef 100644 --- a/src/Analysis/Abstract/Caching.hs +++ b/src/Analysis/Abstract/Caching.hs @@ -60,7 +60,7 @@ cachingTerms :: ( Cacheable term location (Cell location) value , Corecursive term , Member NonDet effects , Member (Reader (Cache term location (Cell location) value)) effects - , Member (Reader (Live location value)) effects + , Member (Reader (Live location)) effects , Member (State (Cache term location (Cell location) value)) effects , Member (State (Environment location)) effects , Member (State (Heap location (Cell location) value)) effects @@ -83,7 +83,7 @@ convergingModules :: ( AbstractValue location value effects , Member NonDet effects , Member (Reader (Cache term location (Cell location) value)) effects , Member (Reader (Environment location)) effects - , Member (Reader (Live location value)) effects + , Member (Reader (Live location)) effects , Member (Resumable (EnvironmentError location)) effects , Member (State (Cache term location (Cell location) value)) effects , Member (State (Environment location)) effects diff --git a/src/Analysis/Abstract/Collecting.hs b/src/Analysis/Abstract/Collecting.hs index 2b3a33353..521574d6e 100644 --- a/src/Analysis/Abstract/Collecting.hs +++ b/src/Analysis/Abstract/Collecting.hs @@ -12,7 +12,7 @@ import Prologue -- | An analysis performing GC after every instruction. collectingTerms :: ( Foldable (Cell location) - , Member (Reader (Live location value)) effects + , Member (Reader (Live location)) effects , Member (State (Heap location (Cell location) value)) effects , Ord location , ValueRoots location value @@ -29,7 +29,7 @@ gc :: ( Ord location , Foldable (Cell location) , ValueRoots location value ) - => Live location value -- ^ The set of addresses to consider rooted. + => Live location -- ^ The set of addresses to consider rooted. -> Heap location (Cell location) value -- ^ A heap to collect unreachable addresses within. -> Heap location (Cell location) value -- ^ A garbage-collected heap. gc roots heap = heapRestrict heap (reachable roots heap) @@ -39,9 +39,9 @@ reachable :: ( Ord location , Foldable (Cell location) , ValueRoots location value ) - => Live location value -- ^ The set of root addresses. + => Live location -- ^ The set of root addresses. -> Heap location (Cell location) value -- ^ The heap to trace addresses through. - -> Live location value -- ^ The set of addresses reachable from the root set. + -> Live location -- ^ The set of addresses reachable from the root set. reachable roots heap = go mempty roots where go seen set = case liveSplit set of Nothing -> seen @@ -50,5 +50,5 @@ reachable roots heap = go mempty roots _ -> seen) -providingLiveSet :: Effectful (m location value) => m location value (Reader (Live location value) ': effects) a -> m location value effects a +providingLiveSet :: Effectful (m location value) => m location value (Reader (Live location) ': effects) a -> m location value effects a providingLiveSet = runReader lowerBound diff --git a/src/Analysis/Abstract/Tracing.hs b/src/Analysis/Abstract/Tracing.hs index 62d43d152..d0919b42b 100644 --- a/src/Analysis/Abstract/Tracing.hs +++ b/src/Analysis/Abstract/Tracing.hs @@ -13,7 +13,7 @@ import Prologue -- -- Instantiating @trace@ to @[]@ yields a linear trace analysis, while @Set@ yields a reachable state analysis. tracingTerms :: ( Corecursive term - , Member (Reader (Live location value)) effects + , Member (Reader (Live location)) effects , Member (State (Environment location)) effects , Member (State (Heap location (Cell location) value)) effects , Member (Writer (trace (Configuration term location (Cell location) value))) effects diff --git a/src/Control/Abstract/Configuration.hs b/src/Control/Abstract/Configuration.hs index 4ff37c9c3..42bb8eec2 100644 --- a/src/Control/Abstract/Configuration.hs +++ b/src/Control/Abstract/Configuration.hs @@ -12,5 +12,5 @@ import Control.Abstract.TermEvaluator import Data.Abstract.Configuration -- | Get the current 'Configuration' with a passed-in term. -getConfiguration :: (Member (Reader (Live location value)) effects, Member (State (Environment location)) effects, Member (State (Heap location (Cell location) value)) effects) => term -> TermEvaluator term location value effects (Configuration term location (Cell location) value) +getConfiguration :: (Member (Reader (Live location)) effects, Member (State (Environment location)) effects, Member (State (Heap location (Cell location) value)) effects) => term -> TermEvaluator term location value effects (Configuration term location (Cell location) value) getConfiguration term = Configuration term <$> TermEvaluator askRoots <*> TermEvaluator getEnv <*> TermEvaluator getHeap diff --git a/src/Control/Abstract/Roots.hs b/src/Control/Abstract/Roots.hs index 375940ef4..4c5277258 100644 --- a/src/Control/Abstract/Roots.hs +++ b/src/Control/Abstract/Roots.hs @@ -9,9 +9,9 @@ import Data.Abstract.Live import Prologue -- | Retrieve the local 'Live' set. -askRoots :: Member (Reader (Live location value)) effects => Evaluator location value effects (Live location value) +askRoots :: Member (Reader (Live location)) effects => Evaluator location value effects (Live location) askRoots = ask -- | Run a computation with the given 'Live' set added to the local root set. -extraRoots :: (Member (Reader (Live location value)) effects, Ord location) => Live location value -> Evaluator location value effects a -> Evaluator location value effects a +extraRoots :: (Member (Reader (Live location)) effects, Ord location) => Live location -> Evaluator location value effects a -> Evaluator location value effects a extraRoots roots = local (<> roots) diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index 893da6b67..ff418bbf6 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -245,4 +245,4 @@ subtermValue = value <=< subtermRef -- | Value types, e.g. closures, which can root a set of addresses. class ValueRoots location value where -- | Compute the set of addresses rooted by a given value. - valueRoots :: value -> Live location value + valueRoots :: value -> Live location diff --git a/src/Data/Abstract/Configuration.hs b/src/Data/Abstract/Configuration.hs index 72913421b..fe8e1f9fa 100644 --- a/src/Data/Abstract/Configuration.hs +++ b/src/Data/Abstract/Configuration.hs @@ -7,7 +7,7 @@ import Data.Abstract.Live -- | A single point in a program’s execution. data Configuration term location cell value = Configuration { configurationTerm :: term -- ^ The “instruction,” i.e. the current term to evaluate. - , configurationRoots :: Live location value -- ^ The set of rooted addresses. + , configurationRoots :: Live location -- ^ The set of rooted addresses. , configurationEnvironment :: Environment location -- ^ The environment binding any free variables in 'configurationTerm'. , configurationHeap :: Heap location cell value -- ^ The heap of values. } diff --git a/src/Data/Abstract/Environment.hs b/src/Data/Abstract/Environment.hs index a029c5c84..06d74ffd3 100644 --- a/src/Data/Abstract/Environment.hs +++ b/src/Data/Abstract/Environment.hs @@ -118,10 +118,10 @@ overwrite pairs env = unpairs $ mapMaybe lookupAndAlias pairs -- | Retrieve the 'Live' set of addresses to which the given free variable names are bound. -- -- Unbound names are silently dropped. -roots :: (Ord location, Foldable t) => Environment location -> t Name -> Live location value +roots :: (Ord location, Foldable t) => Environment location -> t Name -> Live location roots env names = addresses (bind names env) -addresses :: Ord location => Environment location -> Live location value +addresses :: Ord location => Environment location -> Live location addresses = fromAddresses . map snd . pairs diff --git a/src/Data/Abstract/Heap.hs b/src/Data/Abstract/Heap.hs index a383a5e42..d438e3423 100644 --- a/src/Data/Abstract/Heap.hs +++ b/src/Data/Abstract/Heap.hs @@ -33,7 +33,7 @@ heapSize :: Heap location cell value -> Int heapSize = Monoidal.size . unHeap -- | Restrict a 'Heap' to only those 'Address'es in the given 'Live' set (in essence garbage collecting the rest). -heapRestrict :: Ord location => Heap location cell value -> Live location value -> Heap location cell value +heapRestrict :: Ord location => Heap location cell value -> Live location -> Heap location cell value heapRestrict (Heap m) roots = Heap (Monoidal.filterWithKey (\ address _ -> Address address `liveMember` roots) m) diff --git a/src/Data/Abstract/Live.hs b/src/Data/Abstract/Live.hs index 930350395..db7a67f6e 100644 --- a/src/Data/Abstract/Live.hs +++ b/src/Data/Abstract/Live.hs @@ -7,36 +7,36 @@ import Data.Set as Set import Prologue -- | A set of live addresses (whether roots or reachable). -newtype Live location value = Live { unLive :: Set location } +newtype Live location = Live { unLive :: Set location } deriving (Eq, Lower, Monoid, Ord, Semigroup) -fromAddresses :: (Foldable t, Ord location) => t (Address location value) -> Live location value +fromAddresses :: (Foldable t, Ord location) => t (Address location value) -> Live location fromAddresses = Prologue.foldr liveInsert lowerBound -- | Construct a 'Live' set containing only the given address. -liveSingleton :: Address location value -> Live location value +liveSingleton :: Address location value -> Live location liveSingleton = Live . Set.singleton . unAddress -- | Insert an address into a 'Live' set. -liveInsert :: Ord location => Address location value -> Live location value -> Live location value +liveInsert :: Ord location => Address location value -> Live location -> Live location liveInsert addr = Live . Set.insert (unAddress addr) . unLive -- | Delete an address from a 'Live' set, if present. -liveDelete :: Ord location => Address location value -> Live location value -> Live location value +liveDelete :: Ord location => Address location value -> Live location -> Live location liveDelete addr = Live . Set.delete (unAddress addr) . unLive -- | Compute the (asymmetric) difference of two 'Live' sets, i.e. delete every element of the second set from the first set. -liveDifference :: Ord location => Live location value -> Live location value -> Live location value +liveDifference :: Ord location => Live location -> Live location -> Live location liveDifference = fmap Live . (Set.difference `on` unLive) -- | Test whether an 'Address' is in a 'Live' set. -liveMember :: Ord location => Address location value -> Live location value -> Bool +liveMember :: Ord location => Address location value -> Live location -> Bool liveMember addr = Set.member (unAddress addr) . unLive -- | Decompose a 'Live' set into a pair of one member address and the remaining set, or 'Nothing' if empty. -liveSplit :: Live location value -> Maybe (Address location value, Live location value) +liveSplit :: Live location -> Maybe (Address location value, Live location) liveSplit = fmap (bimap Address Live) . Set.minView . unLive -instance Show location => Show (Live location value) where +instance Show location => Show (Live location) where showsPrec d = showsUnaryWith showsPrec "Live" d . Set.toList . unLive From dcdcf52bea78c53d96ce7cb980f79679afcc4018 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 08:05:23 -0400 Subject: [PATCH 114/148] Live takes locations, not addresses. --- src/Analysis/Abstract/Collecting.hs | 3 ++- src/Data/Abstract/Environment.hs | 2 +- src/Data/Abstract/Heap.hs | 4 ++-- src/Data/Abstract/Live.hs | 25 ++++++++++++------------- 4 files changed, 17 insertions(+), 17 deletions(-) diff --git a/src/Analysis/Abstract/Collecting.hs b/src/Analysis/Abstract/Collecting.hs index 521574d6e..87f0f2d42 100644 --- a/src/Analysis/Abstract/Collecting.hs +++ b/src/Analysis/Abstract/Collecting.hs @@ -5,6 +5,7 @@ module Analysis.Abstract.Collecting ) where import Control.Abstract +import Data.Abstract.Address import Data.Abstract.Heap import Data.Abstract.Live import Data.Semilattice.Lower @@ -45,7 +46,7 @@ reachable :: ( Ord location reachable roots heap = go mempty roots where go seen set = case liveSplit set of Nothing -> seen - Just (a, as) -> go (liveInsert a seen) (case heapLookupAll a heap of + Just (a, as) -> go (liveInsert a seen) (case heapLookupAll (Address a) heap of Just values -> liveDifference (foldr ((<>) . valueRoots) mempty values <> as) seen _ -> seen) diff --git a/src/Data/Abstract/Environment.hs b/src/Data/Abstract/Environment.hs index 06d74ffd3..326a97b63 100644 --- a/src/Data/Abstract/Environment.hs +++ b/src/Data/Abstract/Environment.hs @@ -122,7 +122,7 @@ roots :: (Ord location, Foldable t) => Environment location -> t Name -> Live lo roots env names = addresses (bind names env) addresses :: Ord location => Environment location -> Live location -addresses = fromAddresses . map snd . pairs +addresses = fromAddresses . map (unAddress . snd) . pairs instance Lower (Environment location) where lowerBound = emptyEnv diff --git a/src/Data/Abstract/Heap.hs b/src/Data/Abstract/Heap.hs index d438e3423..67ce5fff5 100644 --- a/src/Data/Abstract/Heap.hs +++ b/src/Data/Abstract/Heap.hs @@ -32,9 +32,9 @@ heapInit (Address address) cell (Heap h) = Heap (Monoidal.insert address cell h) heapSize :: Heap location cell value -> Int heapSize = Monoidal.size . unHeap --- | Restrict a 'Heap' to only those 'Address'es in the given 'Live' set (in essence garbage collecting the rest). +-- | Restrict a 'Heap' to only those addresses in the given 'Live' set (in essence garbage collecting the rest). heapRestrict :: Ord location => Heap location cell value -> Live location -> Heap location cell value -heapRestrict (Heap m) roots = Heap (Monoidal.filterWithKey (\ address _ -> Address address `liveMember` roots) m) +heapRestrict (Heap m) roots = Heap (Monoidal.filterWithKey (\ address _ -> address `liveMember` roots) m) instance (Ord location, Reducer value (cell value)) => Reducer (Address location value, value) (Heap location cell value) where diff --git a/src/Data/Abstract/Live.hs b/src/Data/Abstract/Live.hs index db7a67f6e..38b103cac 100644 --- a/src/Data/Abstract/Live.hs +++ b/src/Data/Abstract/Live.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DataKinds, GeneralizedNewtypeDeriving, TypeFamilies, TypeOperators #-} module Data.Abstract.Live where -import Data.Abstract.Address import Data.Semilattice.Lower import Data.Set as Set import Prologue @@ -10,32 +9,32 @@ import Prologue newtype Live location = Live { unLive :: Set location } deriving (Eq, Lower, Monoid, Ord, Semigroup) -fromAddresses :: (Foldable t, Ord location) => t (Address location value) -> Live location +fromAddresses :: (Foldable t, Ord location) => t location -> Live location fromAddresses = Prologue.foldr liveInsert lowerBound -- | Construct a 'Live' set containing only the given address. -liveSingleton :: Address location value -> Live location -liveSingleton = Live . Set.singleton . unAddress +liveSingleton :: location -> Live location +liveSingleton = Live . Set.singleton -- | Insert an address into a 'Live' set. -liveInsert :: Ord location => Address location value -> Live location -> Live location -liveInsert addr = Live . Set.insert (unAddress addr) . unLive +liveInsert :: Ord location => location -> Live location -> Live location +liveInsert addr = Live . Set.insert addr . unLive -- | Delete an address from a 'Live' set, if present. -liveDelete :: Ord location => Address location value -> Live location -> Live location -liveDelete addr = Live . Set.delete (unAddress addr) . unLive +liveDelete :: Ord location => location -> Live location -> Live location +liveDelete addr = Live . Set.delete addr . unLive -- | Compute the (asymmetric) difference of two 'Live' sets, i.e. delete every element of the second set from the first set. liveDifference :: Ord location => Live location -> Live location -> Live location liveDifference = fmap Live . (Set.difference `on` unLive) --- | Test whether an 'Address' is in a 'Live' set. -liveMember :: Ord location => Address location value -> Live location -> Bool -liveMember addr = Set.member (unAddress addr) . unLive +-- | Test whether an address is in a 'Live' set. +liveMember :: Ord location => location -> Live location -> Bool +liveMember addr = Set.member addr . unLive -- | Decompose a 'Live' set into a pair of one member address and the remaining set, or 'Nothing' if empty. -liveSplit :: Live location -> Maybe (Address location value, Live location) -liveSplit = fmap (bimap Address Live) . Set.minView . unLive +liveSplit :: Live location -> Maybe (location, Live location) +liveSplit = fmap (fmap Live) . Set.minView . unLive instance Show location => Show (Live location) where From da3e9ad59c4132e1e8c3546789ca31918ca7f5c8 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 08:13:55 -0400 Subject: [PATCH 115/148] The Environment operates on locations. --- src/Control/Abstract/Environment.hs | 2 +- src/Control/Abstract/Heap.hs | 4 ++-- src/Control/Abstract/Primitive.hs | 3 ++- src/Data/Abstract/Environment.hs | 19 +++++++++---------- src/Data/Abstract/Exports.hs | 2 +- src/Data/Abstract/Type.hs | 3 ++- src/Data/Abstract/Value.hs | 3 ++- src/Data/Syntax/Declaration.hs | 9 +++++---- src/Data/Syntax/Statement.hs | 5 +++-- src/Language/TypeScript/Syntax.hs | 7 ++++--- 10 files changed, 31 insertions(+), 26 deletions(-) diff --git a/src/Control/Abstract/Environment.hs b/src/Control/Abstract/Environment.hs index a2306cabf..cc8445c2b 100644 --- a/src/Control/Abstract/Environment.hs +++ b/src/Control/Abstract/Environment.hs @@ -67,7 +67,7 @@ localize = localEnv id -- | Look a 'Name' up in the current environment, trying the default environment if no value is found. lookupEnv :: (Member (Reader (Environment location)) effects, Member (State (Environment location)) effects) => Name -> Evaluator location value effects (Maybe (Address location value)) -lookupEnv name = (<|>) <$> (Env.lookup name <$> getEnv) <*> (Env.lookup name <$> defaultEnvironment) +lookupEnv name = (<|>) <$> (fmap Address . Env.lookup name <$> getEnv) <*> (fmap Address . Env.lookup name <$> defaultEnvironment) -- | Errors involving the environment. diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index 05eec53e0..800bbd214 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -84,7 +84,7 @@ letrec :: ( Member (Allocator location value) effects -> Evaluator location value effects (value, Address location value) letrec name body = do addr <- lookupOrAlloc name - v <- localEnv (insert name addr) body + v <- localEnv (insert name (unAddress addr)) body assign addr v pure (v, addr) @@ -99,7 +99,7 @@ letrec' :: ( Member (Allocator location value) effects letrec' name body = do addr <- lookupOrAlloc name v <- localEnv id (body addr) - v <$ modifyEnv (insert name addr) + v <$ modifyEnv (insert name (unAddress addr)) -- | Look up and dereference the given 'Name', throwing an exception for free variables. diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index f0b280bec..be680dcb9 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -6,6 +6,7 @@ import Control.Abstract.Environment import Control.Abstract.Evaluator import Control.Abstract.Heap import Control.Abstract.Value +import Data.Abstract.Address import Data.Abstract.Environment import Data.Abstract.Name import Data.ByteString.Char8 (pack, unpack) @@ -28,7 +29,7 @@ builtin :: ( HasCallStack builtin s def = withCurrentCallStack callStack $ do let name' = name (pack ("__semantic_" <> s)) addr <- alloc name' - modifyEnv (insert name' addr) + modifyEnv (insert name' (unAddress addr)) def >>= assign addr lambda :: (AbstractFunction location value effects, Member Fresh effects) diff --git a/src/Data/Abstract/Environment.hs b/src/Data/Abstract/Environment.hs index 326a97b63..7c5838f69 100644 --- a/src/Data/Abstract/Environment.hs +++ b/src/Data/Abstract/Environment.hs @@ -18,7 +18,6 @@ module Data.Abstract.Environment , roots ) where -import Data.Abstract.Address import Data.Abstract.Live import Data.Abstract.Name import Data.Align @@ -72,22 +71,22 @@ mergeNewer (Environment a) (Environment b) = -- -- >>> pairs shadowed -- [("foo",Precise 1)] -pairs :: Environment location -> [(Name, Address location value)] -pairs = map (second Address) . Map.toList . fold . unEnvironment +pairs :: Environment location -> [(Name, location)] +pairs = Map.toList . fold . unEnvironment -unpairs :: [(Name, Address location value)] -> Environment location -unpairs = Environment . pure . Map.fromList . map (second unAddress) +unpairs :: [(Name, location)] -> Environment location +unpairs = Environment . pure . Map.fromList -- | Lookup a 'Name' in the environment. -- -- >>> lookup (name "foo") shadowed -- Just (Precise 1) -lookup :: Name -> Environment location -> Maybe (Address location value) -lookup k = fmap Address . foldMapA (Map.lookup k) . unEnvironment +lookup :: Name -> Environment location -> Maybe location +lookup name = foldMapA (Map.lookup name) . unEnvironment -- | Insert a 'Name' in the environment. -insert :: Name -> Address location value -> Environment location -> Environment location -insert name (Address value) (Environment (a :| as)) = Environment (Map.insert name value a :| as) +insert :: Name -> location -> Environment location -> Environment location +insert name addr (Environment (a :| as)) = Environment (Map.insert name addr a :| as) -- | Remove a 'Name' from the environment. -- @@ -122,7 +121,7 @@ roots :: (Ord location, Foldable t) => Environment location -> t Name -> Live lo roots env names = addresses (bind names env) addresses :: Ord location => Environment location -> Live location -addresses = fromAddresses . map (unAddress . snd) . pairs +addresses = fromAddresses . map snd . pairs instance Lower (Environment location) where lowerBound = emptyEnv diff --git a/src/Data/Abstract/Exports.hs b/src/Data/Abstract/Exports.hs index 4c71e508d..405c8bba8 100644 --- a/src/Data/Abstract/Exports.hs +++ b/src/Data/Abstract/Exports.hs @@ -23,7 +23,7 @@ null :: Exports location -> Bool null = Map.null . unExports toEnvironment :: Exports location -> Environment location -toEnvironment exports = unpairs (mapMaybe (traverse (fmap Address)) (toList (unExports exports))) +toEnvironment exports = unpairs (mapMaybe sequenceA (toList (unExports exports))) insert :: Name -> Name -> Maybe (Address location value) -> Exports location -> Exports location insert name alias address = Exports . Map.insert name (alias, unAddress <$> address) . unExports diff --git a/src/Data/Abstract/Type.hs b/src/Data/Abstract/Type.hs index 9d7e6ed54..1166d7d60 100644 --- a/src/Data/Abstract/Type.hs +++ b/src/Data/Abstract/Type.hs @@ -8,6 +8,7 @@ module Data.Abstract.Type ) where import Control.Abstract +import Data.Abstract.Address import Data.Abstract.Environment as Env import Data.Semigroup.Foldable (foldMap1) import Data.Semigroup.Reducer (Reducer) @@ -131,7 +132,7 @@ instance ( Member (Allocator location Type) effects a <- alloc name tvar <- Var <$> fresh assign a tvar - bimap (Env.insert name a) (tvar :) <$> rest) (pure (emptyEnv, [])) names + bimap (Env.insert name (unAddress a)) (tvar :) <$> rest) (pure (emptyEnv, [])) names (zeroOrMoreProduct tvars :->) <$> localEnv (mergeEnvs env) (body `catchReturn` \ (Return value) -> pure value) call op params = do diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index b15db00f7..a358a1fde 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -2,6 +2,7 @@ module Data.Abstract.Value where import Control.Abstract +import Data.Abstract.Address import Data.Abstract.Environment (Environment, emptyEnv, mergeEnvs) import qualified Data.Abstract.Environment as Env import Data.Abstract.Name @@ -84,7 +85,7 @@ instance ( Coercible body (Eff effects) v <- param a <- alloc name assign a v - Env.insert name a <$> rest) (pure env) (zip names params) + Env.insert name (unAddress a) <$> rest) (pure env) (zip names params) localEnv (mergeEnvs bindings) (raiseEff (coerce body) `catchReturn` \ (Return value) -> pure value) _ -> throwValueError (CallError op) diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 7b3d618bb..b3bc43d4e 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances #-} module Data.Syntax.Declaration where +import Data.Abstract.Address import qualified Data.Abstract.Environment as Env import Data.Abstract.Evaluatable import Data.JSON.Fields @@ -27,7 +28,7 @@ instance Evaluatable Function where eval Function{..} = do name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm functionName) (v, addr) <- letrec name (closure (paramNames functionParameters) (Set.fromList (freeVariables functionBody)) (subtermValue functionBody)) - modifyEnv (Env.insert name addr) + modifyEnv (Env.insert name (unAddress addr)) pure (Rval v) where paramNames = foldMap (freeVariables . subterm) @@ -53,7 +54,7 @@ instance Evaluatable Method where eval Method{..} = do name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm methodName) (v, addr) <- letrec name (closure (paramNames methodParameters) (Set.fromList (freeVariables methodBody)) (subtermValue methodBody)) - modifyEnv (Env.insert name addr) + modifyEnv (Env.insert name (unAddress addr)) pure (Rval v) where paramNames = foldMap (freeVariables . subterm) @@ -187,7 +188,7 @@ instance Evaluatable Class where void $ subtermValue classBody classEnv <- Env.head <$> getEnv klass name supers classEnv - Rval <$> (v <$ modifyEnv (Env.insert name addr)) + Rval <$> (v <$ modifyEnv (Env.insert name (unAddress addr))) -- | A decorator in Python data Decorator a = Decorator { decoratorIdentifier :: !a, decoratorParamaters :: ![a], decoratorBody :: !a } @@ -278,7 +279,7 @@ instance Evaluatable TypeAlias where v <- subtermValue typeAliasKind addr <- lookupOrAlloc name assign addr v - Rval <$> (modifyEnv (Env.insert name addr) $> v) + Rval <$> (modifyEnv (Env.insert name (unAddress addr)) $> v) instance Declarations a => Declarations (TypeAlias a) where declaredName TypeAlias{..} = declaredName typeAliasIdentifier diff --git a/src/Data/Syntax/Statement.hs b/src/Data/Syntax/Statement.hs index aee3158db..02d4b5837 100644 --- a/src/Data/Syntax/Statement.hs +++ b/src/Data/Syntax/Statement.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances, ViewPatterns #-} module Data.Syntax.Statement where +import Data.Abstract.Address import qualified Data.Abstract.Environment as Env import Data.Abstract.Evaluatable import Data.ByteString.Char8 (unpack) @@ -95,7 +96,7 @@ instance Evaluatable Let where eval Let{..} = do name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm letVariable) addr <- snd <$> letrec name (subtermValue letValue) - Rval <$> localEnv (Env.insert name addr) (subtermValue letBody) + Rval <$> localEnv (Env.insert name (unAddress addr)) (subtermValue letBody) -- Assignment @@ -119,7 +120,7 @@ instance Evaluatable Assignment where LvalLocal nam -> do addr <- lookupOrAlloc nam assign addr rhs - modifyEnv (Env.insert nam addr) + modifyEnv (Env.insert nam (unAddress addr)) LvalMember _ _ -> -- we don't yet support mutable object properties: pure () diff --git a/src/Language/TypeScript/Syntax.hs b/src/Language/TypeScript/Syntax.hs index 8fa467554..5f4e9d3b1 100644 --- a/src/Language/TypeScript/Syntax.hs +++ b/src/Language/TypeScript/Syntax.hs @@ -1,6 +1,7 @@ {-# LANGUAGE DeriveAnyClass #-} module Language.TypeScript.Syntax where +import Data.Abstract.Address import qualified Data.Abstract.Environment as Env import Data.Abstract.Evaluatable import qualified Data.Abstract.Module as M @@ -252,7 +253,7 @@ instance Evaluatable QualifiedExportFrom where -- Look up addresses in importedEnv and insert the aliases with addresses into the exports. for_ exportSymbols $ \(name, alias) -> do let address = Env.lookup name importedEnv - maybe (throwEvalError $ ExportError modulePath name) (addExport name alias . Just) address + maybe (throwEvalError $ ExportError modulePath name) (addExport name alias . Just . Address) address pure (Rval unit) newtype DefaultExport a = DefaultExport { defaultExport :: a } @@ -272,7 +273,7 @@ instance Evaluatable DefaultExport where addr <- lookupOrAlloc name assign addr v addExport name name Nothing - void $ modifyEnv (Env.insert name addr) + void $ modifyEnv (Env.insert name (unAddress addr)) Nothing -> throwEvalError DefaultExportError pure (Rval unit) @@ -852,7 +853,7 @@ instance Evaluatable AbstractClass where void $ subtermValue classBody classEnv <- Env.head <$> getEnv klass name supers classEnv - Rval <$> (v <$ modifyEnv (Env.insert name addr)) + Rval <$> (v <$ modifyEnv (Env.insert name (unAddress addr))) data JsxElement a = JsxElement { _jsxOpeningElement :: !a, _jsxElements :: ![a], _jsxClosingElement :: !a } From 74067b20c2fc8c8d268e7bc86817d7cdf9cf59c9 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 08:14:57 -0400 Subject: [PATCH 116/148] Exports operates on locations. --- src/Control/Abstract/Exports.hs | 2 +- src/Data/Abstract/Exports.hs | 9 ++++----- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/src/Control/Abstract/Exports.hs b/src/Control/Abstract/Exports.hs index e31e8d376..b9c8a307d 100644 --- a/src/Control/Abstract/Exports.hs +++ b/src/Control/Abstract/Exports.hs @@ -26,7 +26,7 @@ modifyExports = modify' -- | Add an export to the global export state. addExport :: Member (State (Exports location)) effects => Name -> Name -> Maybe (Address location value) -> Evaluator location value effects () -addExport name alias = modifyExports . insert name alias +addExport name alias = modifyExports . insert name alias . fmap unAddress -- | Sets the global export state for the lifetime of the given action. withExports :: Member (State (Exports location)) effects => Exports location -> Evaluator location value effects a -> Evaluator location value effects a diff --git a/src/Data/Abstract/Exports.hs b/src/Data/Abstract/Exports.hs index 405c8bba8..413b5fdef 100644 --- a/src/Data/Abstract/Exports.hs +++ b/src/Data/Abstract/Exports.hs @@ -7,13 +7,12 @@ module Data.Abstract.Exports , toEnvironment ) where -import Prelude hiding (null) -import Prologue hiding (null) -import Data.Abstract.Address import Data.Abstract.Environment (Environment, unpairs) import Data.Abstract.Name import qualified Data.Map as Map import Data.Semilattice.Lower +import Prelude hiding (null) +import Prologue hiding (null) -- | A map of export names to an alias & address tuple. newtype Exports location = Exports { unExports :: Map.Map Name (Name, Maybe location) } @@ -25,8 +24,8 @@ null = Map.null . unExports toEnvironment :: Exports location -> Environment location toEnvironment exports = unpairs (mapMaybe sequenceA (toList (unExports exports))) -insert :: Name -> Name -> Maybe (Address location value) -> Exports location -> Exports location -insert name alias address = Exports . Map.insert name (alias, unAddress <$> address) . unExports +insert :: Name -> Name -> Maybe location -> Exports location -> Exports location +insert name alias address = Exports . Map.insert name (alias, address) . unExports -- TODO: Should we filter for duplicates here? aliases :: Exports location -> [(Name, Name)] From 0624afe6267e2ba22f5c8424e1b16a97f1de5cfb Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 08:17:22 -0400 Subject: [PATCH 117/148] Heap operates on locations. --- src/Analysis/Abstract/Collecting.hs | 3 +-- src/Control/Abstract/Heap.hs | 4 ++-- src/Data/Abstract/Heap.hs | 21 ++++++++++----------- 3 files changed, 13 insertions(+), 15 deletions(-) diff --git a/src/Analysis/Abstract/Collecting.hs b/src/Analysis/Abstract/Collecting.hs index 87f0f2d42..521574d6e 100644 --- a/src/Analysis/Abstract/Collecting.hs +++ b/src/Analysis/Abstract/Collecting.hs @@ -5,7 +5,6 @@ module Analysis.Abstract.Collecting ) where import Control.Abstract -import Data.Abstract.Address import Data.Abstract.Heap import Data.Abstract.Live import Data.Semilattice.Lower @@ -46,7 +45,7 @@ reachable :: ( Ord location reachable roots heap = go mempty roots where go seen set = case liveSplit set of Nothing -> seen - Just (a, as) -> go (liveInsert a seen) (case heapLookupAll (Address a) heap of + Just (a, as) -> go (liveInsert a seen) (case heapLookupAll a heap of Just values -> liveDifference (foldr ((<>) . valueRoots) mempty values <> as) seen _ -> seen) diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index 800bbd214..3a563b409 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -59,7 +59,7 @@ assign :: ( Member (State (Heap location (Cell location) value)) effects => Address location value -> value -> Evaluator location value effects () -assign address = modifyHeap . heapInsert address +assign address = modifyHeap . heapInsert (unAddress address) -- | Look up or allocate an address for a 'Name'. @@ -122,7 +122,7 @@ data Allocator location value return where runAllocator :: (Addressable location effects, Effectful (m location value), Member (Resumable (AddressError location value)) effects, Member (State (Heap location (Cell location) value)) effects) => m location value (Allocator location value ': effects) a -> m location value effects a runAllocator = raiseHandler (interpret (\ eff -> case eff of Alloc name -> lowerEff $ Address <$> allocCell name - Deref addr -> lowerEff $ heapLookup addr <$> get >>= maybeM (throwResumable (UnallocatedAddress addr)) >>= derefCell addr >>= maybeM (throwResumable (UninitializedAddress addr)))) + Deref addr -> lowerEff $ heapLookup (unAddress addr) <$> get >>= maybeM (throwResumable (UnallocatedAddress addr)) >>= derefCell addr >>= maybeM (throwResumable (UninitializedAddress addr)))) data AddressError location value resume where diff --git a/src/Data/Abstract/Heap.hs b/src/Data/Abstract/Heap.hs index 67ce5fff5..bc3bbce91 100644 --- a/src/Data/Abstract/Heap.hs +++ b/src/Data/Abstract/Heap.hs @@ -1,7 +1,6 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Data.Abstract.Heap where -import Data.Abstract.Address import Data.Abstract.Live import qualified Data.Map.Monoidal as Monoidal import Data.Semigroup.Reducer @@ -13,20 +12,20 @@ newtype Heap location cell value = Heap { unHeap :: Monoidal.Map location (cell deriving (Eq, Foldable, Functor, Lower, Monoid, Ord, Semigroup, Traversable) -- | Look up the cell of values for an 'Address' in a 'Heap', if any. -heapLookup :: Ord location => Address location value -> Heap location cell value -> Maybe (cell value) -heapLookup (Address address) = Monoidal.lookup address . unHeap +heapLookup :: Ord location => location -> Heap location cell value -> Maybe (cell value) +heapLookup address = Monoidal.lookup address . unHeap -- | Look up the list of values stored for a given address, if any. -heapLookupAll :: (Ord location, Foldable cell) => Address location value -> Heap location cell value -> Maybe [value] +heapLookupAll :: (Ord location, Foldable cell) => location -> Heap location cell value -> Maybe [value] heapLookupAll address = fmap toList . heapLookup address -- | Append a value onto the cell for a given address, inserting a new cell if none existed. -heapInsert :: (Ord location, Reducer value (cell value)) => Address location value -> value -> Heap location cell value -> Heap location cell value +heapInsert :: (Ord location, Reducer value (cell value)) => location -> value -> Heap location cell value -> Heap location cell value heapInsert address value = flip snoc (address, value) -- | Manually insert a cell into the heap at a given address. -heapInit :: Ord location => Address location value -> cell value -> Heap location cell value -> Heap location cell value -heapInit (Address address) cell (Heap h) = Heap (Monoidal.insert address cell h) +heapInit :: Ord location => location -> cell value -> Heap location cell value -> Heap location cell value +heapInit address cell (Heap h) = Heap (Monoidal.insert address cell h) -- | The number of addresses extant in a 'Heap'. heapSize :: Heap location cell value -> Int @@ -37,10 +36,10 @@ heapRestrict :: Ord location => Heap location cell value -> Live location -> He heapRestrict (Heap m) roots = Heap (Monoidal.filterWithKey (\ address _ -> address `liveMember` roots) m) -instance (Ord location, Reducer value (cell value)) => Reducer (Address location value, value) (Heap location cell value) where - unit = Heap . unit . first unAddress - cons (Address key, a) (Heap heap) = Heap (cons (key, a) heap) - snoc (Heap heap) (Address key, a) = Heap (snoc heap (key, a)) +instance (Ord location, Reducer value (cell value)) => Reducer (location, value) (Heap location cell value) where + unit = Heap . unit + cons (addr, a) (Heap heap) = Heap (cons (addr, a) heap) + snoc (Heap heap) (addr, a) = Heap (snoc heap (addr, a)) instance (Show location, Show (cell value)) => Show (Heap location cell value) where showsPrec d = showsUnaryWith showsPrec "Heap" d . Monoidal.pairs . unHeap From 319bee9f9103f1e1f247fa102ea82d92fd440a83 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 08:18:28 -0400 Subject: [PATCH 118/148] Rename bind to intersect. --- src/Data/Abstract/Environment.hs | 8 ++++---- src/Data/Abstract/Value.hs | 2 +- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/src/Data/Abstract/Environment.hs b/src/Data/Abstract/Environment.hs index 7c5838f69..bed4ffbdc 100644 --- a/src/Data/Abstract/Environment.hs +++ b/src/Data/Abstract/Environment.hs @@ -1,7 +1,7 @@ module Data.Abstract.Environment ( Environment(..) , addresses - , bind + , intersect , delete , head , emptyEnv @@ -99,8 +99,8 @@ trim :: Environment location -> Environment location trim (Environment (a :| as)) = Environment (a :| filtered) where filtered = filter (not . Map.null) as -bind :: Foldable t => t Name -> Environment location -> Environment location -bind names env = unpairs (mapMaybe lookupName (toList names)) +intersect :: Foldable t => t Name -> Environment location -> Environment location +intersect names env = unpairs (mapMaybe lookupName (toList names)) where lookupName name = (,) name <$> lookup name env @@ -118,7 +118,7 @@ overwrite pairs env = unpairs $ mapMaybe lookupAndAlias pairs -- -- Unbound names are silently dropped. roots :: (Ord location, Foldable t) => Environment location -> t Name -> Live location -roots env names = addresses (bind names env) +roots env names = addresses (intersect names env) addresses :: Ord location => Environment location -> Live location addresses = fromAddresses . map snd . pairs diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index a358a1fde..87060d202 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -73,7 +73,7 @@ instance ( Coercible body (Eff effects) packageInfo <- currentPackage moduleInfo <- currentModule i <- fresh - Closure packageInfo moduleInfo parameters (ClosureBody i (coerce (lowerEff body))) . Env.bind (foldr Set.delete freeVariables parameters) <$> getEnv + Closure packageInfo moduleInfo parameters (ClosureBody i (coerce (lowerEff body))) . Env.intersect (foldr Set.delete freeVariables parameters) <$> getEnv call op params = do case op of From 51075cfa9dabdbf00e055b2752c6af96d929b6de Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 08:20:11 -0400 Subject: [PATCH 119/148] Define a bind function to bind names in the environment. --- src/Control/Abstract/Environment.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Control/Abstract/Environment.hs b/src/Control/Abstract/Environment.hs index cc8445c2b..9457ba9e1 100644 --- a/src/Control/Abstract/Environment.hs +++ b/src/Control/Abstract/Environment.hs @@ -11,6 +11,7 @@ module Control.Abstract.Environment , localEnv , localize , lookupEnv +, bind , EnvironmentError(..) , freeVariableError , runEnvironmentError @@ -69,6 +70,9 @@ localize = localEnv id lookupEnv :: (Member (Reader (Environment location)) effects, Member (State (Environment location)) effects) => Name -> Evaluator location value effects (Maybe (Address location value)) lookupEnv name = (<|>) <$> (fmap Address . Env.lookup name <$> getEnv) <*> (fmap Address . Env.lookup name <$> defaultEnvironment) +bind :: Member (State (Environment location)) effects => Name -> Address location value -> Evaluator location value effects () +bind name = modifyEnv . Env.insert name . unAddress + -- | Errors involving the environment. data EnvironmentError location return where From b01f1ebbf48c5eb20de432ba173d1c34af0ef29d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 08:24:00 -0400 Subject: [PATCH 120/148] Use bind instead of manually inserting into the environment. --- src/Control/Abstract/Heap.hs | 2 +- src/Control/Abstract/Primitive.hs | 4 +--- src/Data/Syntax/Declaration.hs | 9 ++++----- src/Data/Syntax/Statement.hs | 2 +- src/Language/TypeScript/Syntax.hs | 4 ++-- 5 files changed, 9 insertions(+), 12 deletions(-) diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index 3a563b409..22e6ba5eb 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -99,7 +99,7 @@ letrec' :: ( Member (Allocator location value) effects letrec' name body = do addr <- lookupOrAlloc name v <- localEnv id (body addr) - v <$ modifyEnv (insert name (unAddress addr)) + v <$ bind name addr -- | Look up and dereference the given 'Name', throwing an exception for free variables. diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index be680dcb9..7ef5458f9 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -6,8 +6,6 @@ import Control.Abstract.Environment import Control.Abstract.Evaluator import Control.Abstract.Heap import Control.Abstract.Value -import Data.Abstract.Address -import Data.Abstract.Environment import Data.Abstract.Name import Data.ByteString.Char8 (pack, unpack) import Data.Semigroup.Reducer hiding (unit) @@ -29,7 +27,7 @@ builtin :: ( HasCallStack builtin s def = withCurrentCallStack callStack $ do let name' = name (pack ("__semantic_" <> s)) addr <- alloc name' - modifyEnv (insert name' (unAddress addr)) + bind name' addr def >>= assign addr lambda :: (AbstractFunction location value effects, Member Fresh effects) diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index b3bc43d4e..34f5f0ce2 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances #-} module Data.Syntax.Declaration where -import Data.Abstract.Address import qualified Data.Abstract.Environment as Env import Data.Abstract.Evaluatable import Data.JSON.Fields @@ -28,7 +27,7 @@ instance Evaluatable Function where eval Function{..} = do name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm functionName) (v, addr) <- letrec name (closure (paramNames functionParameters) (Set.fromList (freeVariables functionBody)) (subtermValue functionBody)) - modifyEnv (Env.insert name (unAddress addr)) + bind name addr pure (Rval v) where paramNames = foldMap (freeVariables . subterm) @@ -54,7 +53,7 @@ instance Evaluatable Method where eval Method{..} = do name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm methodName) (v, addr) <- letrec name (closure (paramNames methodParameters) (Set.fromList (freeVariables methodBody)) (subtermValue methodBody)) - modifyEnv (Env.insert name (unAddress addr)) + bind name addr pure (Rval v) where paramNames = foldMap (freeVariables . subterm) @@ -188,7 +187,7 @@ instance Evaluatable Class where void $ subtermValue classBody classEnv <- Env.head <$> getEnv klass name supers classEnv - Rval <$> (v <$ modifyEnv (Env.insert name (unAddress addr))) + Rval v <$ bind name addr -- | A decorator in Python data Decorator a = Decorator { decoratorIdentifier :: !a, decoratorParamaters :: ![a], decoratorBody :: !a } @@ -279,7 +278,7 @@ instance Evaluatable TypeAlias where v <- subtermValue typeAliasKind addr <- lookupOrAlloc name assign addr v - Rval <$> (modifyEnv (Env.insert name (unAddress addr)) $> v) + Rval v <$ bind name addr instance Declarations a => Declarations (TypeAlias a) where declaredName TypeAlias{..} = declaredName typeAliasIdentifier diff --git a/src/Data/Syntax/Statement.hs b/src/Data/Syntax/Statement.hs index 02d4b5837..38550c71e 100644 --- a/src/Data/Syntax/Statement.hs +++ b/src/Data/Syntax/Statement.hs @@ -120,7 +120,7 @@ instance Evaluatable Assignment where LvalLocal nam -> do addr <- lookupOrAlloc nam assign addr rhs - modifyEnv (Env.insert nam (unAddress addr)) + bind nam addr LvalMember _ _ -> -- we don't yet support mutable object properties: pure () diff --git a/src/Language/TypeScript/Syntax.hs b/src/Language/TypeScript/Syntax.hs index 5f4e9d3b1..79c1b53b5 100644 --- a/src/Language/TypeScript/Syntax.hs +++ b/src/Language/TypeScript/Syntax.hs @@ -273,7 +273,7 @@ instance Evaluatable DefaultExport where addr <- lookupOrAlloc name assign addr v addExport name name Nothing - void $ modifyEnv (Env.insert name (unAddress addr)) + void $ bind name addr Nothing -> throwEvalError DefaultExportError pure (Rval unit) @@ -853,7 +853,7 @@ instance Evaluatable AbstractClass where void $ subtermValue classBody classEnv <- Env.head <$> getEnv klass name supers classEnv - Rval <$> (v <$ modifyEnv (Env.insert name (unAddress addr))) + Rval v <$ bind name addr data JsxElement a = JsxElement { _jsxOpeningElement :: !a, _jsxElements :: ![a], _jsxClosingElement :: !a } From 2daed4c1f9823c5eb0a8d8888d1b30484d27979f Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 08:26:56 -0400 Subject: [PATCH 121/148] Define a helper to bind all from an environment. --- src/Control/Abstract/Environment.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Control/Abstract/Environment.hs b/src/Control/Abstract/Environment.hs index 9457ba9e1..932d73e29 100644 --- a/src/Control/Abstract/Environment.hs +++ b/src/Control/Abstract/Environment.hs @@ -12,6 +12,7 @@ module Control.Abstract.Environment , localize , lookupEnv , bind +, bindAll , EnvironmentError(..) , freeVariableError , runEnvironmentError @@ -73,6 +74,9 @@ lookupEnv name = (<|>) <$> (fmap Address . Env.lookup name <$> getEnv) <*> (fmap bind :: Member (State (Environment location)) effects => Name -> Address location value -> Evaluator location value effects () bind name = modifyEnv . Env.insert name . unAddress +bindAll :: Member (State (Environment location)) effects => Environment location -> Evaluator location value effects () +bindAll = foldr ((>>) . uncurry bind . second Address) (pure ()) . pairs + -- | Errors involving the environment. data EnvironmentError location return where From b42e17aa95b021e9db19b64662fe3e17b57b8cab Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 08:33:02 -0400 Subject: [PATCH 122/148] bindAll instead of modifying the env. --- src/Language/Go/Syntax.hs | 4 ++-- src/Language/PHP/Syntax.hs | 2 +- src/Language/Python/Syntax.hs | 6 +++--- src/Language/Ruby/Syntax.hs | 4 ++-- src/Language/TypeScript/Syntax.hs | 4 ++-- 5 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index c37a784f8..af200e6dc 100644 --- a/src/Language/Go/Syntax.hs +++ b/src/Language/Go/Syntax.hs @@ -70,7 +70,7 @@ instance Evaluatable Import where for_ paths $ \path -> do traceResolve (unPath importPath) path importedEnv <- maybe emptyEnv fst <$> isolate (require path) - modifyEnv (mergeEnvs importedEnv) + bindAll importedEnv pure (Rval unit) @@ -94,7 +94,7 @@ instance Evaluatable QualifiedImport where for_ paths $ \p -> do traceResolve (unPath importPath) p importedEnv <- maybe emptyEnv fst <$> isolate (require p) - modifyEnv (mergeEnvs importedEnv) + bindAll importedEnv makeNamespace alias addr Nothing pure (Rval unit) diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index 28094cc45..e150d6016 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -70,7 +70,7 @@ include pathTerm f = do path <- resolvePHPName name traceResolve name path (importedEnv, v) <- isolate (f path) >>= maybeM (pure (emptyEnv, unit)) - modifyEnv (mergeEnvs importedEnv) + bindAll importedEnv pure (Rval v) newtype Require a = Require a diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index 1aa99d740..a6899b1f0 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -117,7 +117,7 @@ instance Evaluatable Import where -- Last module path is the one we want to import let path = NonEmpty.last modulePaths importedEnv <- maybe emptyEnv fst <$> isolate (require path) - modifyEnv (mergeEnvs (select importedEnv)) + bindAll (select importedEnv) pure (Rval unit) where select importedEnv @@ -139,7 +139,7 @@ evalQualifiedImport :: ( AbstractValue location value effects => Name -> ModulePath -> Evaluator location value effects value evalQualifiedImport name path = letrec' name $ \addr -> do importedEnv <- maybe emptyEnv fst <$> isolate (require path) - modifyEnv (mergeEnvs importedEnv) + bindAll importedEnv unit <$ makeNamespace name addr Nothing newtype QualifiedImport a = QualifiedImport { qualifiedImportFrom :: QualifiedName } @@ -188,7 +188,7 @@ instance Evaluatable QualifiedAliasedImport where Rval <$> letrec' alias (\addr -> do let path = NonEmpty.last modulePaths importedEnv <- maybe emptyEnv fst <$> isolate (require path) - modifyEnv (mergeEnvs importedEnv) + bindAll importedEnv unit <$ makeNamespace alias addr Nothing) -- | Ellipsis (used in splice expressions and alternatively can be used as a fill in expression, like `undefined` in Haskell) diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index ddc1db58d..1cf25970a 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -74,7 +74,7 @@ instance Evaluatable Require where path <- resolveRubyName name traceResolve name path (importedEnv, v) <- isolate (doRequire path) - modifyEnv (`mergeNewer` importedEnv) + bindAll importedEnv pure (Rval v) -- Returns True if the file was loaded, False if it was already loaded. http://ruby-doc.org/core-2.5.0/Kernel.html#method-i-require doRequire :: ( AbstractValue location value effects @@ -122,7 +122,7 @@ doLoad path shouldWrap = do path' <- resolveRubyPath path traceResolve path path' importedEnv <- maybe emptyEnv fst <$> isolate (load path') - unless shouldWrap $ modifyEnv (mergeEnvs importedEnv) + unless shouldWrap $ bindAll importedEnv pure (boolean Prelude.True) -- load always returns true. http://ruby-doc.org/core-2.5.0/Kernel.html#method-i-load -- TODO: autoload diff --git a/src/Language/TypeScript/Syntax.hs b/src/Language/TypeScript/Syntax.hs index 79c1b53b5..b02f466a1 100644 --- a/src/Language/TypeScript/Syntax.hs +++ b/src/Language/TypeScript/Syntax.hs @@ -148,7 +148,7 @@ evalRequire :: ( AbstractValue location value effects -> Evaluator location value effects value evalRequire modulePath alias = letrec' alias $ \addr -> do importedEnv <- maybe emptyEnv fst <$> isolate (require modulePath) - modifyEnv (mergeEnvs importedEnv) + bindAll importedEnv unit <$ makeNamespace alias addr Nothing data Import a = Import { importSymbols :: ![(Name, Name)], importFrom :: ImportPath } @@ -165,7 +165,7 @@ instance Evaluatable Import where eval (Import symbols importPath) = do modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions importedEnv <- maybe emptyEnv fst <$> isolate (require modulePath) - modifyEnv (mergeEnvs (renamed importedEnv)) $> Rval unit + bindAll (renamed importedEnv) $> Rval unit where renamed importedEnv | Prologue.null symbols = importedEnv From a4353e1797793c4bb0831ad5f11ed87fbd8ea506 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 08:33:23 -0400 Subject: [PATCH 123/148] =?UTF-8?q?Don=E2=80=99t=20export=20modifyEnv.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Control/Abstract/Environment.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Control/Abstract/Environment.hs b/src/Control/Abstract/Environment.hs index 932d73e29..fcd1592ae 100644 --- a/src/Control/Abstract/Environment.hs +++ b/src/Control/Abstract/Environment.hs @@ -3,7 +3,6 @@ module Control.Abstract.Environment ( Environment , getEnv , putEnv -, modifyEnv , withEnv , defaultEnvironment , withDefaultEnvironment From 703275d404dc9be25a41f653e755bc8351accfef Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 08:35:46 -0400 Subject: [PATCH 124/148] =?UTF-8?q?Don=E2=80=99t=20export=20defaultEnviron?= =?UTF-8?q?ment.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Control/Abstract/Environment.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Control/Abstract/Environment.hs b/src/Control/Abstract/Environment.hs index fcd1592ae..0fa058c33 100644 --- a/src/Control/Abstract/Environment.hs +++ b/src/Control/Abstract/Environment.hs @@ -4,7 +4,6 @@ module Control.Abstract.Environment , getEnv , putEnv , withEnv -, defaultEnvironment , withDefaultEnvironment , fullEnvironment , localEnv From 99e75c2636ed1a9aae7cd83d35c08740ee3c7c30 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 08:37:40 -0400 Subject: [PATCH 125/148] :fire: localize. --- src/Control/Abstract/Environment.hs | 5 ----- src/Control/Abstract/Value.hs | 2 +- 2 files changed, 1 insertion(+), 6 deletions(-) diff --git a/src/Control/Abstract/Environment.hs b/src/Control/Abstract/Environment.hs index 0fa058c33..8ed7344b4 100644 --- a/src/Control/Abstract/Environment.hs +++ b/src/Control/Abstract/Environment.hs @@ -7,7 +7,6 @@ module Control.Abstract.Environment , withDefaultEnvironment , fullEnvironment , localEnv -, localize , lookupEnv , bind , bindAll @@ -61,10 +60,6 @@ localEnv f a = do result <- a result <$ modifyEnv Env.pop --- | Run a computation in a new local environment. -localize :: Member (State (Environment location)) effects => Evaluator location value effects a -> Evaluator location value effects a -localize = localEnv id - -- | Look a 'Name' up in the current environment, trying the default environment if no value is found. lookupEnv :: (Member (Reader (Environment location)) effects, Member (State (Environment location)) effects) => Name -> Evaluator location value effects (Maybe (Address location value)) lookupEnv name = (<|>) <$> (fmap Address . Env.lookup name <$> getEnv) <*> (fmap Address . Env.lookup name <$> defaultEnvironment) diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index ff418bbf6..137146e7c 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -167,7 +167,7 @@ forLoop :: ( AbstractValue location value effects -> Evaluator location value effects value -- ^ Body -> Evaluator location value effects value forLoop initial cond step body = - localize (initial *> while cond (body *> step)) + localEnv id (initial *> while cond (body *> step)) -- | The fundamental looping primitive, built on top of 'ifthenelse'. while :: AbstractValue location value effects From 8bde888c7974d0f002f14907e140f1b003f4c58e Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 08:39:05 -0400 Subject: [PATCH 126/148] Define a locally helper to bind a new environment. --- src/Control/Abstract/Environment.hs | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/Control/Abstract/Environment.hs b/src/Control/Abstract/Environment.hs index 8ed7344b4..38b9d60d0 100644 --- a/src/Control/Abstract/Environment.hs +++ b/src/Control/Abstract/Environment.hs @@ -10,6 +10,7 @@ module Control.Abstract.Environment , lookupEnv , bind , bindAll +, locally , EnvironmentError(..) , freeVariableError , runEnvironmentError @@ -70,6 +71,12 @@ bind name = modifyEnv . Env.insert name . unAddress bindAll :: Member (State (Environment location)) effects => Environment location -> Evaluator location value effects () bindAll = foldr ((>>) . uncurry bind . second Address) (pure ()) . pairs +locally :: Member (State (Environment location)) effects => Evaluator location value effects a -> Evaluator location value effects a +locally a = do + modifyEnv Env.push + a' <- a + a' <$ modifyEnv Env.pop + -- | Errors involving the environment. data EnvironmentError location return where From f91d81df505cf20c3091594ff5e514ad9514102e Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 08:39:53 -0400 Subject: [PATCH 127/148] Use locally instead of localEnv id. --- src/Control/Abstract/Heap.hs | 2 +- src/Control/Abstract/Value.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index 22e6ba5eb..b1e1ee371 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -98,7 +98,7 @@ letrec' :: ( Member (Allocator location value) effects -> Evaluator location value effects value letrec' name body = do addr <- lookupOrAlloc name - v <- localEnv id (body addr) + v <- locally (body addr) v <$ bind name addr diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index 137146e7c..5c8d04e1f 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -167,7 +167,7 @@ forLoop :: ( AbstractValue location value effects -> Evaluator location value effects value -- ^ Body -> Evaluator location value effects value forLoop initial cond step body = - localEnv id (initial *> while cond (body *> step)) + locally (initial *> while cond (body *> step)) -- | The fundamental looping primitive, built on top of 'ifthenelse'. while :: AbstractValue location value effects From 3226a1bc39ef2328fcc9c5b41bc4d3b30f303986 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 08:45:00 -0400 Subject: [PATCH 128/148] Use locally instead of localEnv. --- src/Control/Abstract/Heap.hs | 3 +-- src/Control/Abstract/Value.hs | 2 +- src/Data/Abstract/Type.hs | 2 +- src/Data/Abstract/Value.hs | 2 +- src/Data/Syntax/Statement.hs | 4 +--- 5 files changed, 5 insertions(+), 8 deletions(-) diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index b1e1ee371..7759c6854 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -24,7 +24,6 @@ import Control.Abstract.Environment import Control.Abstract.Evaluator import Control.Monad.Effect.Internal import Data.Abstract.Address -import Data.Abstract.Environment import Data.Abstract.Heap import Data.Abstract.Name import Data.Semigroup.Reducer @@ -84,7 +83,7 @@ letrec :: ( Member (Allocator location value) effects -> Evaluator location value effects (value, Address location value) letrec name body = do addr <- lookupOrAlloc name - v <- localEnv (insert name (unAddress addr)) body + v <- locally (bind name addr *> body) assign addr v pure (v, addr) diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index 5c8d04e1f..29c210ec8 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -214,7 +214,7 @@ evaluateInScopedEnv :: ( AbstractValue location value effects -> Evaluator location value effects value evaluateInScopedEnv scopedEnvTerm term = do scopedEnv <- scopedEnvTerm >>= scopedEnvironment - maybe term (flip localEnv term . mergeEnvs) scopedEnv + maybe term (\ env -> locally (bindAll env *> term)) scopedEnv -- | Evaluates a 'Value' returning the referenced value diff --git a/src/Data/Abstract/Type.hs b/src/Data/Abstract/Type.hs index 1166d7d60..77b9e579f 100644 --- a/src/Data/Abstract/Type.hs +++ b/src/Data/Abstract/Type.hs @@ -133,7 +133,7 @@ instance ( Member (Allocator location Type) effects tvar <- Var <$> fresh assign a tvar bimap (Env.insert name (unAddress a)) (tvar :) <$> rest) (pure (emptyEnv, [])) names - (zeroOrMoreProduct tvars :->) <$> localEnv (mergeEnvs env) (body `catchReturn` \ (Return value) -> pure value) + (zeroOrMoreProduct tvars :->) <$> locally (bindAll env *> body `catchReturn` \ (Return value) -> pure value) call op params = do tvar <- fresh diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 87060d202..320fd31b2 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -86,7 +86,7 @@ instance ( Coercible body (Eff effects) a <- alloc name assign a v Env.insert name (unAddress a) <$> rest) (pure env) (zip names params) - localEnv (mergeEnvs bindings) (raiseEff (coerce body) `catchReturn` \ (Return value) -> pure value) + locally (bindAll bindings *> raiseEff (coerce body) `catchReturn` \ (Return value) -> pure value) _ -> throwValueError (CallError op) diff --git a/src/Data/Syntax/Statement.hs b/src/Data/Syntax/Statement.hs index 38550c71e..cea29f2f1 100644 --- a/src/Data/Syntax/Statement.hs +++ b/src/Data/Syntax/Statement.hs @@ -1,8 +1,6 @@ {-# LANGUAGE DeriveAnyClass, MultiParamTypeClasses, ScopedTypeVariables, UndecidableInstances, ViewPatterns #-} module Data.Syntax.Statement where -import Data.Abstract.Address -import qualified Data.Abstract.Environment as Env import Data.Abstract.Evaluatable import Data.ByteString.Char8 (unpack) import Data.JSON.Fields @@ -96,7 +94,7 @@ instance Evaluatable Let where eval Let{..} = do name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm letVariable) addr <- snd <$> letrec name (subtermValue letValue) - Rval <$> localEnv (Env.insert name (unAddress addr)) (subtermValue letBody) + Rval <$> locally (bind name addr *> subtermValue letBody) -- Assignment From cb5b786f35e8edb31518b7ee31c2b486744f4218 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 08:45:44 -0400 Subject: [PATCH 129/148] :fire localEnv. --- src/Control/Abstract/Environment.hs | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/src/Control/Abstract/Environment.hs b/src/Control/Abstract/Environment.hs index 38b9d60d0..31c774aa5 100644 --- a/src/Control/Abstract/Environment.hs +++ b/src/Control/Abstract/Environment.hs @@ -6,7 +6,6 @@ module Control.Abstract.Environment , withEnv , withDefaultEnvironment , fullEnvironment -, localEnv , lookupEnv , bind , bindAll @@ -54,13 +53,6 @@ withDefaultEnvironment e = local (const e) fullEnvironment :: (Member (Reader (Environment location)) effects, Member (State (Environment location)) effects) => Evaluator location value effects (Environment location) fullEnvironment = mergeEnvs <$> getEnv <*> defaultEnvironment --- | Run an action with a locally-modified environment. -localEnv :: Member (State (Environment location)) effects => (Environment location -> Environment location) -> Evaluator location value effects a -> Evaluator location value effects a -localEnv f a = do - modifyEnv (f . Env.push) - result <- a - result <$ modifyEnv Env.pop - -- | Look a 'Name' up in the current environment, trying the default environment if no value is found. lookupEnv :: (Member (Reader (Environment location)) effects, Member (State (Environment location)) effects) => Name -> Evaluator location value effects (Maybe (Address location value)) lookupEnv name = (<|>) <$> (fmap Address . Env.lookup name <$> getEnv) <*> (fmap Address . Env.lookup name <$> defaultEnvironment) @@ -71,6 +63,7 @@ bind name = modifyEnv . Env.insert name . unAddress bindAll :: Member (State (Environment location)) effects => Environment location -> Evaluator location value effects () bindAll = foldr ((>>) . uncurry bind . second Address) (pure ()) . pairs +-- | Run an action in a new local environment. locally :: Member (State (Environment location)) effects => Evaluator location value effects a -> Evaluator location value effects a locally a = do modifyEnv Env.push From 756cade411d1e20e1c12bfd88c3ab74d708575bd Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 09:01:13 -0400 Subject: [PATCH 130/148] Fix the doctests. --- src/Data/Abstract/Environment.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Data/Abstract/Environment.hs b/src/Data/Abstract/Environment.hs index bed4ffbdc..fff753569 100644 --- a/src/Data/Abstract/Environment.hs +++ b/src/Data/Abstract/Environment.hs @@ -28,8 +28,9 @@ import Prelude hiding (head, lookup) import Prologue -- $setup --- >>> let bright = push (insert (name "foo") (Address (Precise 0)) emptyEnv) --- >>> let shadowed = insert (name "foo") (Address (Precise 1)) bright +-- >>> import Data.Abstract.Address +-- >>> let bright = push (insert (name "foo") (Precise 0) emptyEnv) +-- >>> let shadowed = insert (name "foo") (Precise 1) bright -- | A LIFO stack of maps of names to addresses, representing a lexically-scoped evaluation environment. -- All behaviors can be assumed to be frontmost-biased: looking up "a" will check the most specific From a6934f5dfa679e946891b07821621481e729ce2b Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 09:02:35 -0400 Subject: [PATCH 131/148] Placate hlint. --- src/Data/Abstract/Environment.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Abstract/Environment.hs b/src/Data/Abstract/Environment.hs index fff753569..d408fb902 100644 --- a/src/Data/Abstract/Environment.hs +++ b/src/Data/Abstract/Environment.hs @@ -119,7 +119,7 @@ overwrite pairs env = unpairs $ mapMaybe lookupAndAlias pairs -- -- Unbound names are silently dropped. roots :: (Ord location, Foldable t) => Environment location -> t Name -> Live location -roots env names = addresses (intersect names env) +roots env names = addresses (names `intersect` env) addresses :: Ord location => Environment location -> Live location addresses = fromAddresses . map snd . pairs From cfe6be3bd578b8405217ee023dc2eba7fc9451c2 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 09:06:57 -0400 Subject: [PATCH 132/148] :fire: fullEnvironment. --- src/Control/Abstract/Environment.hs | 6 ------ 1 file changed, 6 deletions(-) diff --git a/src/Control/Abstract/Environment.hs b/src/Control/Abstract/Environment.hs index 31c774aa5..7a8cb4cfc 100644 --- a/src/Control/Abstract/Environment.hs +++ b/src/Control/Abstract/Environment.hs @@ -5,7 +5,6 @@ module Control.Abstract.Environment , putEnv , withEnv , withDefaultEnvironment -, fullEnvironment , lookupEnv , bind , bindAll @@ -48,11 +47,6 @@ defaultEnvironment = ask withDefaultEnvironment :: Member (Reader (Environment location)) effects => Environment location -> Evaluator location value effects a -> Evaluator location value effects a withDefaultEnvironment e = local (const e) --- | Obtain an environment that is the composition of the current and default environments. --- Useful for debugging. -fullEnvironment :: (Member (Reader (Environment location)) effects, Member (State (Environment location)) effects) => Evaluator location value effects (Environment location) -fullEnvironment = mergeEnvs <$> getEnv <*> defaultEnvironment - -- | Look a 'Name' up in the current environment, trying the default environment if no value is found. lookupEnv :: (Member (Reader (Environment location)) effects, Member (State (Environment location)) effects) => Name -> Evaluator location value effects (Maybe (Address location value)) lookupEnv name = (<|>) <$> (fmap Address . Env.lookup name <$> getEnv) <*> (fmap Address . Env.lookup name <$> defaultEnvironment) From 01b30e5ae137ea85bd162248cf5c2c2a45031926 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 09:10:36 -0400 Subject: [PATCH 133/148] :fire: the Eq1, Ord1, & Show1 instances for Address. --- src/Data/Abstract/Address.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/Data/Abstract/Address.hs b/src/Data/Abstract/Address.hs index 16deab806..ee3e41d8d 100644 --- a/src/Data/Abstract/Address.hs +++ b/src/Data/Abstract/Address.hs @@ -14,10 +14,6 @@ import Prologue newtype Address location value = Address { unAddress :: location } deriving (Eq, Ord) -instance Eq location => Eq1 (Address location) where liftEq _ a b = unAddress a == unAddress b -instance Ord location => Ord1 (Address location) where liftCompare _ a b = unAddress a `compare` unAddress b -instance Show location => Show1 (Address location) where liftShowsPrec _ _ = showsPrec - instance Show location => Show (Address location value) where showsPrec d = showsPrec d . unAddress From dcf4b9abc754095a06e753820ab74c7f61e9cd02 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 09:16:12 -0400 Subject: [PATCH 134/148] :memo: bind/bindAll. --- src/Control/Abstract/Environment.hs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/Control/Abstract/Environment.hs b/src/Control/Abstract/Environment.hs index 7a8cb4cfc..79781a3a2 100644 --- a/src/Control/Abstract/Environment.hs +++ b/src/Control/Abstract/Environment.hs @@ -51,9 +51,11 @@ withDefaultEnvironment e = local (const e) lookupEnv :: (Member (Reader (Environment location)) effects, Member (State (Environment location)) effects) => Name -> Evaluator location value effects (Maybe (Address location value)) lookupEnv name = (<|>) <$> (fmap Address . Env.lookup name <$> getEnv) <*> (fmap Address . Env.lookup name <$> defaultEnvironment) +-- | Bind a 'Name' to an 'Address' in the current scope. bind :: Member (State (Environment location)) effects => Name -> Address location value -> Evaluator location value effects () bind name = modifyEnv . Env.insert name . unAddress +-- | Bind all of the names from an 'Environment' in the current scope. bindAll :: Member (State (Environment location)) effects => Environment location -> Evaluator location value effects () bindAll = foldr ((>>) . uncurry bind . second Address) (pure ()) . pairs From 89ae7740ed43380ff22dc58bed9ada23efeed55d Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 09:25:32 -0400 Subject: [PATCH 135/148] Use location instead of Address in the heap/env interfaces. --- src/Analysis/Abstract/Graph.hs | 2 +- src/Control/Abstract/Addressable.hs | 8 +++---- src/Control/Abstract/Environment.hs | 11 ++++----- src/Control/Abstract/Heap.hs | 37 ++++++++++++++--------------- src/Control/Abstract/Value.hs | 3 +-- src/Data/Abstract/Type.hs | 3 +-- src/Data/Abstract/Value.hs | 3 +-- 7 files changed, 31 insertions(+), 36 deletions(-) diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs index f76fdd8a6..c86a2319b 100644 --- a/src/Analysis/Abstract/Graph.hs +++ b/src/Analysis/Abstract/Graph.hs @@ -128,7 +128,7 @@ variableDefinition :: ( Member (Reader (Environment (Hole (Located location)))) => Name -> TermEvaluator term (Hole (Located location)) value effects () variableDefinition name = do - graph <- maybe lowerBound (maybe lowerBound (vertex . moduleVertex . locationModule) . toMaybe . unAddress) <$> TermEvaluator (lookupEnv name) + graph <- maybe lowerBound (maybe lowerBound (vertex . moduleVertex . locationModule) . toMaybe) <$> TermEvaluator (lookupEnv name) appendGraph (vertex (Variable (unName name)) `connect` graph) appendGraph :: (Effectful m, Member (State (Graph Vertex)) effects) => Graph Vertex -> m effects () diff --git a/src/Control/Abstract/Addressable.hs b/src/Control/Abstract/Addressable.hs index afe6bfad5..32bcff542 100644 --- a/src/Control/Abstract/Addressable.hs +++ b/src/Control/Abstract/Addressable.hs @@ -16,7 +16,7 @@ class (Ord location, Show location) => Addressable location effects where type family Cell location :: * -> * allocCell :: Name -> Evaluator location value effects location - derefCell :: Address location value -> Cell location value -> Evaluator location value effects (Maybe value) + derefCell :: location -> Cell location value -> Evaluator location value effects (Maybe value) -- | 'Precise' locations are always allocated a fresh 'Address', and dereference to the 'Latest' value written. @@ -38,14 +38,14 @@ instance (Addressable location effects, Member (Reader ModuleInfo) effects, Memb type Cell (Located location) = Cell location allocCell name = relocate (Located <$> allocCell name <*> currentPackage <*> currentModule) - derefCell (Address (Located loc _ _)) = relocate . derefCell (Address loc) + derefCell (Located loc _ _) = relocate . derefCell loc instance Addressable location effects => Addressable (Hole location) effects where type Cell (Hole location) = Cell location allocCell name = relocate (Total <$> allocCell name) - derefCell (Address (Total loc)) = relocate . derefCell (Address loc) - derefCell (Address Partial) = const (pure Nothing) + derefCell (Total loc) = relocate . derefCell loc + derefCell Partial = const (pure Nothing) relocate :: Evaluator location1 value effects a -> Evaluator location2 value effects a relocate = raiseEff . lowerEff diff --git a/src/Control/Abstract/Environment.hs b/src/Control/Abstract/Environment.hs index 79781a3a2..cedc445b1 100644 --- a/src/Control/Abstract/Environment.hs +++ b/src/Control/Abstract/Environment.hs @@ -16,7 +16,6 @@ module Control.Abstract.Environment ) where import Control.Abstract.Evaluator -import Data.Abstract.Address import Data.Abstract.Environment as Env import Data.Abstract.Name import Prologue @@ -48,16 +47,16 @@ withDefaultEnvironment :: Member (Reader (Environment location)) effects => Envi withDefaultEnvironment e = local (const e) -- | Look a 'Name' up in the current environment, trying the default environment if no value is found. -lookupEnv :: (Member (Reader (Environment location)) effects, Member (State (Environment location)) effects) => Name -> Evaluator location value effects (Maybe (Address location value)) -lookupEnv name = (<|>) <$> (fmap Address . Env.lookup name <$> getEnv) <*> (fmap Address . Env.lookup name <$> defaultEnvironment) +lookupEnv :: (Member (Reader (Environment location)) effects, Member (State (Environment location)) effects) => Name -> Evaluator location value effects (Maybe location) +lookupEnv name = (<|>) <$> (Env.lookup name <$> getEnv) <*> (Env.lookup name <$> defaultEnvironment) -- | Bind a 'Name' to an 'Address' in the current scope. -bind :: Member (State (Environment location)) effects => Name -> Address location value -> Evaluator location value effects () -bind name = modifyEnv . Env.insert name . unAddress +bind :: Member (State (Environment location)) effects => Name -> location -> Evaluator location value effects () +bind name = modifyEnv . Env.insert name -- | Bind all of the names from an 'Environment' in the current scope. bindAll :: Member (State (Environment location)) effects => Environment location -> Evaluator location value effects () -bindAll = foldr ((>>) . uncurry bind . second Address) (pure ()) . pairs +bindAll = foldr ((>>) . uncurry bind) (pure ()) . pairs -- | Run an action in a new local environment. locally :: Member (State (Environment location)) effects => Evaluator location value effects a -> Evaluator location value effects a diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index 7759c6854..236611176 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE GADTs, RankNTypes, TypeFamilies, TypeOperators, UndecidableInstances #-} +{-# LANGUAGE GADTs, RankNTypes, ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} module Control.Abstract.Heap ( Heap , getHeap @@ -23,7 +23,6 @@ import Control.Abstract.Addressable import Control.Abstract.Environment import Control.Abstract.Evaluator import Control.Monad.Effect.Internal -import Data.Abstract.Address import Data.Abstract.Heap import Data.Abstract.Name import Data.Semigroup.Reducer @@ -42,23 +41,23 @@ modifyHeap :: Member (State (Heap location (Cell location) value)) effects => (H modifyHeap = modify' -alloc :: Member (Allocator location value) effects => Name -> Evaluator location value effects (Address location value) -alloc = send . Alloc +alloc :: forall location value effects . Member (Allocator location value) effects => Name -> Evaluator location value effects location +alloc = send . Alloc @location @value --- | Dereference the given 'Address'in the heap, or fail if the address is uninitialized. -deref :: Member (Allocator location value) effects => Address location value -> Evaluator location value effects value +-- | Dereference the given address in the heap, or fail if the address is uninitialized. +deref :: Member (Allocator location value) effects => location -> Evaluator location value effects value deref = send . Deref --- | Write a value to the given 'Address' in the 'Store'. +-- | Write a value to the given address in the 'Store'. assign :: ( Member (State (Heap location (Cell location) value)) effects , Ord location , Reducer value (Cell location value) ) - => Address location value + => location -> value -> Evaluator location value effects () -assign address = modifyHeap . heapInsert (unAddress address) +assign address = modifyHeap . heapInsert address -- | Look up or allocate an address for a 'Name'. @@ -67,7 +66,7 @@ lookupOrAlloc :: ( Member (Allocator location value) effects , Member (State (Environment location)) effects ) => Name - -> Evaluator location value effects (Address location value) + -> Evaluator location value effects location lookupOrAlloc name = lookupEnv name >>= maybe (alloc name) pure @@ -80,7 +79,7 @@ letrec :: ( Member (Allocator location value) effects ) => Name -> Evaluator location value effects value - -> Evaluator location value effects (value, Address location value) + -> Evaluator location value effects (value, location) letrec name body = do addr <- lookupOrAlloc name v <- locally (bind name addr *> body) @@ -93,7 +92,7 @@ letrec' :: ( Member (Allocator location value) effects , Member (State (Environment location)) effects ) => Name - -> (Address location value -> Evaluator location value effects value) + -> (location -> Evaluator location value effects value) -> Evaluator location value effects value letrec' name body = do addr <- lookupOrAlloc name @@ -109,24 +108,24 @@ variable :: ( Member (Allocator location value) effects ) => Name -> Evaluator location value effects value -variable name = lookupEnv name >>= maybeM (Address <$> freeVariableError name) >>= deref +variable name = lookupEnv name >>= maybeM (freeVariableError name) >>= deref -- Effects data Allocator location value return where - Alloc :: Name -> Allocator location value (Address location value) - Deref :: Address location value -> Allocator location value value + Alloc :: Name -> Allocator location value location + Deref :: location -> Allocator location value value runAllocator :: (Addressable location effects, Effectful (m location value), Member (Resumable (AddressError location value)) effects, Member (State (Heap location (Cell location) value)) effects) => m location value (Allocator location value ': effects) a -> m location value effects a runAllocator = raiseHandler (interpret (\ eff -> case eff of - Alloc name -> lowerEff $ Address <$> allocCell name - Deref addr -> lowerEff $ heapLookup (unAddress addr) <$> get >>= maybeM (throwResumable (UnallocatedAddress addr)) >>= derefCell addr >>= maybeM (throwResumable (UninitializedAddress addr)))) + Alloc name -> lowerEff $ allocCell name + Deref addr -> lowerEff $ heapLookup addr <$> get >>= maybeM (throwResumable (UnallocatedAddress addr)) >>= derefCell addr >>= maybeM (throwResumable (UninitializedAddress addr)))) data AddressError location value resume where - UnallocatedAddress :: Address location value -> AddressError location value (Cell location value) - UninitializedAddress :: Address location value -> AddressError location value value + UnallocatedAddress :: location -> AddressError location value (Cell location value) + UninitializedAddress :: location -> AddressError location value value deriving instance Eq location => Eq (AddressError location value resume) deriving instance Show location => Show (AddressError location value resume) diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index 29c210ec8..9b9c41895 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -19,7 +19,6 @@ import Control.Abstract.Addressable import Control.Abstract.Environment import Control.Abstract.Evaluator import Control.Abstract.Heap -import Data.Abstract.Address (Address) import Data.Abstract.Environment as Env import Data.Abstract.Live (Live) import Data.Abstract.Name @@ -194,7 +193,7 @@ makeNamespace :: ( AbstractValue location value effects , Reducer value (Cell location value) ) => Name - -> Address location value + -> location -> Maybe value -> Evaluator location value effects value makeNamespace name addr super = do diff --git a/src/Data/Abstract/Type.hs b/src/Data/Abstract/Type.hs index 77b9e579f..dd946b7ea 100644 --- a/src/Data/Abstract/Type.hs +++ b/src/Data/Abstract/Type.hs @@ -8,7 +8,6 @@ module Data.Abstract.Type ) where import Control.Abstract -import Data.Abstract.Address import Data.Abstract.Environment as Env import Data.Semigroup.Foldable (foldMap1) import Data.Semigroup.Reducer (Reducer) @@ -132,7 +131,7 @@ instance ( Member (Allocator location Type) effects a <- alloc name tvar <- Var <$> fresh assign a tvar - bimap (Env.insert name (unAddress a)) (tvar :) <$> rest) (pure (emptyEnv, [])) names + bimap (Env.insert name a) (tvar :) <$> rest) (pure (emptyEnv, [])) names (zeroOrMoreProduct tvars :->) <$> locally (bindAll env *> body `catchReturn` \ (Return value) -> pure value) call op params = do diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 320fd31b2..9fd0c70a0 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -2,7 +2,6 @@ module Data.Abstract.Value where import Control.Abstract -import Data.Abstract.Address import Data.Abstract.Environment (Environment, emptyEnv, mergeEnvs) import qualified Data.Abstract.Environment as Env import Data.Abstract.Name @@ -85,7 +84,7 @@ instance ( Coercible body (Eff effects) v <- param a <- alloc name assign a v - Env.insert name (unAddress a) <$> rest) (pure env) (zip names params) + Env.insert name a <$> rest) (pure env) (zip names params) locally (bindAll bindings *> raiseEff (coerce body) `catchReturn` \ (Return value) -> pure value) _ -> throwValueError (CallError op) From 61d5ba6c416e2be353fdfe9cbe5621ca5b263bde Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 09:26:31 -0400 Subject: [PATCH 136/148] Use location instead of Address in the Exports interface. --- src/Control/Abstract/Exports.hs | 5 ++--- src/Language/TypeScript/Syntax.hs | 3 +-- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/src/Control/Abstract/Exports.hs b/src/Control/Abstract/Exports.hs index b9c8a307d..1c35c7838 100644 --- a/src/Control/Abstract/Exports.hs +++ b/src/Control/Abstract/Exports.hs @@ -8,7 +8,6 @@ module Control.Abstract.Exports ) where import Control.Abstract.Evaluator -import Data.Abstract.Address import Data.Abstract.Exports import Data.Abstract.Name @@ -25,8 +24,8 @@ modifyExports :: Member (State (Exports location)) effects => (Exports location modifyExports = modify' -- | Add an export to the global export state. -addExport :: Member (State (Exports location)) effects => Name -> Name -> Maybe (Address location value) -> Evaluator location value effects () -addExport name alias = modifyExports . insert name alias . fmap unAddress +addExport :: Member (State (Exports location)) effects => Name -> Name -> Maybe location -> Evaluator location value effects () +addExport name alias = modifyExports . insert name alias -- | Sets the global export state for the lifetime of the given action. withExports :: Member (State (Exports location)) effects => Exports location -> Evaluator location value effects a -> Evaluator location value effects a diff --git a/src/Language/TypeScript/Syntax.hs b/src/Language/TypeScript/Syntax.hs index b02f466a1..ad3369522 100644 --- a/src/Language/TypeScript/Syntax.hs +++ b/src/Language/TypeScript/Syntax.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DeriveAnyClass #-} module Language.TypeScript.Syntax where -import Data.Abstract.Address import qualified Data.Abstract.Environment as Env import Data.Abstract.Evaluatable import qualified Data.Abstract.Module as M @@ -253,7 +252,7 @@ instance Evaluatable QualifiedExportFrom where -- Look up addresses in importedEnv and insert the aliases with addresses into the exports. for_ exportSymbols $ \(name, alias) -> do let address = Env.lookup name importedEnv - maybe (throwEvalError $ ExportError modulePath name) (addExport name alias . Just . Address) address + maybe (throwEvalError $ ExportError modulePath name) (addExport name alias . Just) address pure (Rval unit) newtype DefaultExport a = DefaultExport { defaultExport :: a } From a44f2b2f86796dcc78e4c8269476d855c6d3164e Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 09:28:03 -0400 Subject: [PATCH 137/148] Correct some doc comments. --- src/Control/Abstract/Addressable.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Control/Abstract/Addressable.hs b/src/Control/Abstract/Addressable.hs index 32bcff542..b9ff059d4 100644 --- a/src/Control/Abstract/Addressable.hs +++ b/src/Control/Abstract/Addressable.hs @@ -10,7 +10,7 @@ import Data.Abstract.Address import Data.Abstract.Name import Prologue --- | Defines allocation and dereferencing of 'Address'es in a 'Heap'. +-- | Defines allocation and dereferencing of addresses. class (Ord location, Show location) => Addressable location effects where -- | The type into which stored values will be written for a given location type. type family Cell location :: * -> * @@ -19,14 +19,14 @@ class (Ord location, Show location) => Addressable location effects where derefCell :: location -> Cell location value -> Evaluator location value effects (Maybe value) --- | 'Precise' locations are always allocated a fresh 'Address', and dereference to the 'Latest' value written. +-- | 'Precise' locations are always allocated a fresh address, and dereference to the 'Latest' value written. instance Member Fresh effects => Addressable Precise effects where type Cell Precise = Latest allocCell _ = Precise <$> fresh derefCell _ = pure . getLast . unLatest --- | 'Monovariant' locations allocate one 'Address' per unique variable name, and dereference once per stored value, nondeterministically. +-- | 'Monovariant' locations allocate one address per unique variable name, and dereference once per stored value, nondeterministically. instance Member NonDet effects => Addressable Monovariant effects where type Cell Monovariant = All From 8f7979d7fb595321427813457cfe91f9f5093bcb Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 09:29:05 -0400 Subject: [PATCH 138/148] :fire: Address. --- src/Data/Abstract/Address.hs | 8 -------- 1 file changed, 8 deletions(-) diff --git a/src/Data/Abstract/Address.hs b/src/Data/Abstract/Address.hs index ee3e41d8d..dd9c88b19 100644 --- a/src/Data/Abstract/Address.hs +++ b/src/Data/Abstract/Address.hs @@ -10,14 +10,6 @@ import Data.Semilattice.Lower import Data.Set as Set import Prologue --- | An abstract address with a @location@ pointing to a variable of type @value@. -newtype Address location value = Address { unAddress :: location } - deriving (Eq, Ord) - -instance Show location => Show (Address location value) where - showsPrec d = showsPrec d . unAddress - - -- | '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 } deriving (Eq, Ord) From 04b43477c90a38ba5489995fa5aeb6ea574975bf Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 09:46:30 -0400 Subject: [PATCH 139/148] :fire: a reference to Address in the spec. --- test/Analysis/Ruby/Spec.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/test/Analysis/Ruby/Spec.hs b/test/Analysis/Ruby/Spec.hs index 68d1d4996..5b9743906 100644 --- a/test/Analysis/Ruby/Spec.hs +++ b/test/Analysis/Ruby/Spec.hs @@ -76,7 +76,6 @@ spec = parallel $ do where ns n = Just . Latest . Last . Just . Namespace n - addr = Address . Precise fixtures = "test/fixtures/ruby/analysis/" evaluate entry = evalRubyProject (fixtures <> entry) evalRubyProject path = testEvaluating <$> evaluateProject rubyParser Language.Ruby rubyPrelude path From f9b29f143e733fb636864f20d9e43d020fcdbf4e Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 09:46:56 -0400 Subject: [PATCH 140/148] And another. --- test/Analysis/Python/Spec.hs | 1 - 1 file changed, 1 deletion(-) diff --git a/test/Analysis/Python/Spec.hs b/test/Analysis/Python/Spec.hs index b8f282187..9bd89b98c 100644 --- a/test/Analysis/Python/Spec.hs +++ b/test/Analysis/Python/Spec.hs @@ -44,7 +44,6 @@ spec = parallel $ do where ns n = Just . Latest . Last . Just . Namespace n - addr = Address . Precise fixtures = "test/fixtures/python/analysis/" evaluate entry = evalPythonProject (fixtures <> entry) evalPythonProject path = testEvaluating <$> evaluateProject pythonParser Language.Python pythonPrelude path From e9880781e5baf045447af02380de82e910dc86df Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 09:51:08 -0400 Subject: [PATCH 141/148] Make sure we can load the Address module. --- test/Doctests.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/Doctests.hs b/test/Doctests.hs index 965f0bbe9..395677757 100644 --- a/test/Doctests.hs +++ b/test/Doctests.hs @@ -6,7 +6,8 @@ import System.Environment import Test.DocTest defaultFiles = - [ "src/Data/Abstract/Environment.hs" + [ "src/Data/Abstract/Address.hs" + , "src/Data/Abstract/Environment.hs" , "src/Data/Abstract/Name.hs" , "src/Data/Range.hs" , "src/Data/Semigroup/App.hs" From 8fcffd08377dddb7f2b251b790451755452a901b Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 09:55:32 -0400 Subject: [PATCH 142/148] Rename the location type parameter to address. --- src/Analysis/Abstract/Caching.hs | 86 ++++++++--------- src/Analysis/Abstract/Collecting.hs | 40 ++++---- src/Analysis/Abstract/Dead.hs | 14 +-- src/Analysis/Abstract/Evaluating.hs | 40 ++++---- src/Analysis/Abstract/Graph.hs | 28 +++--- src/Analysis/Abstract/Tracing.hs | 20 ++-- src/Control/Abstract/Addressable.hs | 26 +++--- src/Control/Abstract/Configuration.hs | 2 +- src/Control/Abstract/Environment.hs | 38 ++++---- src/Control/Abstract/Evaluator.hs | 20 ++-- src/Control/Abstract/Exports.hs | 10 +- src/Control/Abstract/Heap.hs | 92 +++++++++--------- src/Control/Abstract/Modules.hs | 68 +++++++------- src/Control/Abstract/Primitive.hs | 38 ++++---- src/Control/Abstract/Roots.hs | 4 +- src/Control/Abstract/TermEvaluator.hs | 6 +- src/Control/Abstract/Value.hs | 128 +++++++++++++------------- src/Data/Abstract/Address.hs | 4 +- src/Data/Abstract/Cache.hs | 18 ++-- src/Data/Abstract/Configuration.hs | 10 +- src/Data/Abstract/Environment.hs | 40 ++++---- src/Data/Abstract/Evaluatable.hs | 64 ++++++------- src/Data/Abstract/Exports.hs | 12 +-- src/Data/Abstract/Heap.hs | 18 ++-- src/Data/Abstract/Live.hs | 18 ++-- src/Data/Abstract/Type.hs | 26 +++--- src/Data/Abstract/Value.hs | 114 +++++++++++------------ src/Language/Go/Syntax.hs | 4 +- src/Language/PHP/Syntax.hs | 24 ++--- src/Language/Python/Syntax.hs | 24 ++--- src/Language/Ruby/Syntax.hs | 24 ++--- src/Language/TypeScript/Syntax.hs | 36 ++++---- src/Semantic/Graph.hs | 16 ++-- src/Semantic/Task.hs | 4 +- 34 files changed, 558 insertions(+), 558 deletions(-) diff --git a/src/Analysis/Abstract/Caching.hs b/src/Analysis/Abstract/Caching.hs index 07b7402ef..be0cc40c6 100644 --- a/src/Analysis/Abstract/Caching.hs +++ b/src/Analysis/Abstract/Caching.hs @@ -13,60 +13,60 @@ import Data.Semilattice.Lower import Prologue -- | Look up the set of values for a given configuration in the in-cache. -consultOracle :: (Cacheable term location (Cell location) value, Member (Reader (Cache term location (Cell location) value)) effects) - => Configuration term location (Cell location) value - -> TermEvaluator term location value effects (Set (Cached location (Cell location) value)) +consultOracle :: (Cacheable term address (Cell address) value, Member (Reader (Cache term address (Cell address) value)) effects) + => Configuration term address (Cell address) value + -> TermEvaluator term address value effects (Set (Cached address (Cell address) value)) consultOracle configuration = fromMaybe mempty . cacheLookup configuration <$> ask -- | Run an action with the given in-cache. -withOracle :: Member (Reader (Cache term location (Cell location) value)) effects - => Cache term location (Cell location) value - -> TermEvaluator term location value effects a - -> TermEvaluator term location value effects a +withOracle :: Member (Reader (Cache term address (Cell address) value)) effects + => Cache term address (Cell address) value + -> TermEvaluator term address value effects a + -> TermEvaluator term address value effects a withOracle cache = local (const cache) -- | Look up the set of values for a given configuration in the out-cache. -lookupCache :: (Cacheable term location (Cell location) value, Member (State (Cache term location (Cell location) value)) effects) - => Configuration term location (Cell location) value - -> TermEvaluator term location value effects (Maybe (Set (Cached location (Cell location) value))) +lookupCache :: (Cacheable term address (Cell address) value, Member (State (Cache term address (Cell address) value)) effects) + => Configuration term address (Cell address) value + -> TermEvaluator term address value effects (Maybe (Set (Cached address (Cell address) value))) lookupCache configuration = cacheLookup configuration <$> get -- | Run an action, caching its result and 'Heap' under the given configuration. -cachingConfiguration :: (Cacheable term location (Cell location) value, Member (State (Cache term location (Cell location) value)) effects, Member (State (Heap location (Cell location) value)) effects) - => Configuration term location (Cell location) value - -> Set (Cached location (Cell location) value) - -> TermEvaluator term location value effects (ValueRef value) - -> TermEvaluator term location value effects (ValueRef value) +cachingConfiguration :: (Cacheable term address (Cell address) value, Member (State (Cache term address (Cell address) value)) effects, Member (State (Heap address (Cell address) value)) effects) + => Configuration term address (Cell address) value + -> Set (Cached address (Cell address) value) + -> TermEvaluator term address value effects (ValueRef value) + -> TermEvaluator term address value effects (ValueRef value) cachingConfiguration configuration values action = do modify' (cacheSet configuration values) result <- Cached <$> action <*> TermEvaluator getHeap cachedValue result <$ modify' (cacheInsert configuration result) -putCache :: Member (State (Cache term location (Cell location) value)) effects - => Cache term location (Cell location) value - -> TermEvaluator term location value effects () +putCache :: Member (State (Cache term address (Cell address) value)) effects + => Cache term address (Cell address) value + -> TermEvaluator term address value effects () putCache = put -- | Run an action starting from an empty out-cache, and return the out-cache afterwards. -isolateCache :: Member (State (Cache term location (Cell location) value)) effects - => TermEvaluator term location value effects a - -> TermEvaluator term location value effects (Cache term location (Cell location) value) +isolateCache :: Member (State (Cache term address (Cell address) value)) effects + => TermEvaluator term address value effects a + -> TermEvaluator term address value effects (Cache term address (Cell address) value) isolateCache action = putCache lowerBound *> action *> get -- | Analyze a term using the in-cache as an oracle & storing the results of the analysis in the out-cache. -cachingTerms :: ( Cacheable term location (Cell location) value +cachingTerms :: ( Cacheable term address (Cell address) value , Corecursive term , Member NonDet effects - , Member (Reader (Cache term location (Cell location) value)) effects - , Member (Reader (Live location)) effects - , Member (State (Cache term location (Cell location) value)) effects - , Member (State (Environment location)) effects - , Member (State (Heap location (Cell location) value)) effects + , Member (Reader (Cache term address (Cell address) value)) effects + , Member (Reader (Live address)) effects + , Member (State (Cache term address (Cell address) value)) effects + , Member (State (Environment address)) effects + , Member (State (Heap address (Cell address) value)) effects ) - => SubtermAlgebra (Base term) term (TermEvaluator term location value effects (ValueRef value)) - -> SubtermAlgebra (Base term) term (TermEvaluator term location value effects (ValueRef value)) + => SubtermAlgebra (Base term) term (TermEvaluator term address value effects (ValueRef value)) + -> SubtermAlgebra (Base term) term (TermEvaluator term address value effects (ValueRef value)) cachingTerms recur term = do c <- getConfiguration (embedSubterm term) cached <- lookupCache c @@ -76,21 +76,21 @@ cachingTerms recur term = do pairs <- consultOracle c cachingConfiguration c pairs (recur term) -convergingModules :: ( AbstractValue location value effects - , Cacheable term location (Cell location) value - , Member (Allocator location value) effects +convergingModules :: ( AbstractValue address value effects + , Cacheable term address (Cell address) value + , Member (Allocator address value) effects , Member Fresh effects , Member NonDet effects - , Member (Reader (Cache term location (Cell location) value)) effects - , Member (Reader (Environment location)) effects - , Member (Reader (Live location)) effects - , Member (Resumable (EnvironmentError location)) effects - , Member (State (Cache term location (Cell location) value)) effects - , Member (State (Environment location)) effects - , Member (State (Heap location (Cell location) value)) effects + , Member (Reader (Cache term address (Cell address) value)) effects + , Member (Reader (Environment address)) effects + , Member (Reader (Live address)) effects + , Member (Resumable (EnvironmentError address)) effects + , Member (State (Cache term address (Cell address) value)) effects + , Member (State (Environment address)) effects + , Member (State (Heap address (Cell address) value)) effects ) - => SubtermAlgebra Module term (TermEvaluator term location value effects value) - -> SubtermAlgebra Module term (TermEvaluator term location value effects value) + => SubtermAlgebra Module term (TermEvaluator term address value effects value) + -> SubtermAlgebra Module term (TermEvaluator term address value effects value) convergingModules recur m = do c <- getConfiguration (subterm (moduleBody m)) -- Convergence here is predicated upon an Eq instance, not α-equivalence @@ -124,11 +124,11 @@ converge seed f = loop seed loop x' -- | Nondeterministically write each of a collection of stores & return their associated results. -scatter :: (Foldable t, Member NonDet effects, Member (State (Heap location (Cell location) value)) effects) => t (Cached location (Cell location) value) -> TermEvaluator term location value effects (ValueRef value) +scatter :: (Foldable t, Member NonDet effects, Member (State (Heap address (Cell address) value)) effects) => t (Cached address (Cell address) value) -> TermEvaluator term address value effects (ValueRef value) scatter = foldMapA (\ (Cached value heap') -> TermEvaluator (putHeap heap') $> value) -caching :: Alternative f => TermEvaluator term location value (NonDet ': Reader (Cache term location (Cell location) value) ': State (Cache term location (Cell location) value) ': effects) a -> TermEvaluator term location value effects (f a, Cache term location (Cell location) value) +caching :: Alternative f => TermEvaluator term address value (NonDet ': Reader (Cache term address (Cell address) value) ': State (Cache term address (Cell address) value) ': effects) a -> TermEvaluator term address value effects (f a, Cache term address (Cell address) value) caching = runState lowerBound . runReader lowerBound diff --git a/src/Analysis/Abstract/Collecting.hs b/src/Analysis/Abstract/Collecting.hs index 521574d6e..33f48ca6d 100644 --- a/src/Analysis/Abstract/Collecting.hs +++ b/src/Analysis/Abstract/Collecting.hs @@ -11,37 +11,37 @@ import Data.Semilattice.Lower import Prologue -- | An analysis performing GC after every instruction. -collectingTerms :: ( Foldable (Cell location) - , Member (Reader (Live location)) effects - , Member (State (Heap location (Cell location) value)) effects - , Ord location - , ValueRoots location value +collectingTerms :: ( Foldable (Cell address) + , Member (Reader (Live address)) effects + , Member (State (Heap address (Cell address) value)) effects + , Ord address + , ValueRoots address value ) - => SubtermAlgebra (Base term) term (TermEvaluator term location value effects value) - -> SubtermAlgebra (Base term) term (TermEvaluator term location value effects value) + => SubtermAlgebra (Base term) term (TermEvaluator term address value effects value) + -> SubtermAlgebra (Base term) term (TermEvaluator term address value effects value) collectingTerms recur term = do roots <- TermEvaluator askRoots v <- recur term v <$ TermEvaluator (modifyHeap (gc (roots <> valueRoots v))) -- | Collect any addresses in the heap not rooted in or reachable from the given 'Live' set. -gc :: ( Ord location - , Foldable (Cell location) - , ValueRoots location value +gc :: ( Ord address + , Foldable (Cell address) + , ValueRoots address value ) - => Live location -- ^ The set of addresses to consider rooted. - -> Heap location (Cell location) value -- ^ A heap to collect unreachable addresses within. - -> Heap location (Cell location) value -- ^ A garbage-collected heap. + => Live address -- ^ The set of addresses to consider rooted. + -> Heap address (Cell address) value -- ^ A heap to collect unreachable addresses within. + -> Heap address (Cell address) value -- ^ A garbage-collected heap. gc roots heap = heapRestrict heap (reachable roots heap) -- | Compute the set of addresses reachable from a given root set in a given heap. -reachable :: ( Ord location - , Foldable (Cell location) - , ValueRoots location value +reachable :: ( Ord address + , Foldable (Cell address) + , ValueRoots address value ) - => Live location -- ^ The set of root addresses. - -> Heap location (Cell location) value -- ^ The heap to trace addresses through. - -> Live location -- ^ The set of addresses reachable from the root set. + => Live address -- ^ The set of root addresses. + -> Heap address (Cell address) value -- ^ The heap to trace addresses through. + -> Live address -- ^ The set of addresses reachable from the root set. reachable roots heap = go mempty roots where go seen set = case liveSplit set of Nothing -> seen @@ -50,5 +50,5 @@ reachable roots heap = go mempty roots _ -> seen) -providingLiveSet :: Effectful (m location value) => m location value (Reader (Live location) ': effects) a -> m location value effects a +providingLiveSet :: Effectful (m address value) => m address value (Reader (Live address) ': effects) a -> m address value effects a providingLiveSet = runReader lowerBound diff --git a/src/Analysis/Abstract/Dead.hs b/src/Analysis/Abstract/Dead.hs index 83cbe645b..3528e4ad5 100644 --- a/src/Analysis/Abstract/Dead.hs +++ b/src/Analysis/Abstract/Dead.hs @@ -20,11 +20,11 @@ newtype Dead term = Dead { unDead :: Set term } deriving instance Ord term => Reducer term (Dead term) -- | Update the current 'Dead' set. -killAll :: Member (State (Dead term)) effects => Dead term -> TermEvaluator term location value effects () +killAll :: Member (State (Dead term)) effects => Dead term -> TermEvaluator term address value effects () killAll = put -- | Revive a single term, removing it from the current 'Dead' set. -revive :: (Member (State (Dead term)) effects, Ord term) => term -> TermEvaluator term location value effects () +revive :: (Member (State (Dead term)) effects, Ord term) => term -> TermEvaluator term address value effects () revive t = modify' (Dead . delete t . unDead) -- | Compute the set of all subterms recursively. @@ -36,8 +36,8 @@ revivingTerms :: ( Corecursive term , Member (State (Dead term)) effects , Ord term ) - => SubtermAlgebra (Base term) term (TermEvaluator term location value effects a) - -> SubtermAlgebra (Base term) term (TermEvaluator term location value effects a) + => SubtermAlgebra (Base term) term (TermEvaluator term address value effects a) + -> SubtermAlgebra (Base term) term (TermEvaluator term address value effects a) revivingTerms recur term = revive (embedSubterm term) *> recur term killingModules :: ( Foldable (Base term) @@ -45,9 +45,9 @@ killingModules :: ( Foldable (Base term) , Ord term , Recursive term ) - => SubtermAlgebra Module term (TermEvaluator term location value effects a) - -> SubtermAlgebra Module term (TermEvaluator term location value effects a) + => SubtermAlgebra Module term (TermEvaluator term address value effects a) + -> SubtermAlgebra Module term (TermEvaluator term address value effects a) killingModules recur m = killAll (subterms (subterm (moduleBody m))) *> recur m -providingDeadSet :: TermEvaluator term location value (State (Dead term) ': effects) a -> TermEvaluator term location value effects (a, Dead term) +providingDeadSet :: TermEvaluator term address value (State (Dead term) ': effects) a -> TermEvaluator term address value effects (a, Dead term) providingDeadSet = runState lowerBound diff --git a/src/Analysis/Abstract/Evaluating.hs b/src/Analysis/Abstract/Evaluating.hs index 3cc429c3d..694719380 100644 --- a/src/Analysis/Abstract/Evaluating.hs +++ b/src/Analysis/Abstract/Evaluating.hs @@ -8,34 +8,34 @@ import Control.Abstract import Data.Semilattice.Lower -- | An analysis evaluating @term@s to @value@s with a list of @effects@ using 'Evaluatable', and producing incremental results of type @a@. -data EvaluatingState location value = EvaluatingState - { environment :: Environment location - , heap :: Heap location (Cell location) value - , modules :: ModuleTable (Maybe (Environment location, value)) - , exports :: Exports location +data EvaluatingState address value = EvaluatingState + { environment :: Environment address + , heap :: Heap address (Cell address) value + , modules :: ModuleTable (Maybe (Environment address, value)) + , exports :: Exports address } -deriving instance (Eq (Cell location value), Eq location, Eq value) => Eq (EvaluatingState location value) -deriving instance (Ord (Cell location value), Ord location, Ord value) => Ord (EvaluatingState location value) -deriving instance (Show (Cell location value), Show location, Show value) => Show (EvaluatingState location value) +deriving instance (Eq (Cell address value), Eq address, Eq value) => Eq (EvaluatingState address value) +deriving instance (Ord (Cell address value), Ord address, Ord value) => Ord (EvaluatingState address value) +deriving instance (Show (Cell address value), Show address, Show value) => Show (EvaluatingState address value) -evaluating :: Evaluator location value +evaluating :: Evaluator address value ( Fail ': Fresh - ': Reader (Environment location) - ': State (Environment location) - ': State (Heap location (Cell location) value) - ': State (ModuleTable (Maybe (Environment location, value))) - ': State (Exports location) + ': Reader (Environment address) + ': State (Environment address) + ': State (Heap address (Cell address) value) + ': State (ModuleTable (Maybe (Environment address, value))) + ': State (Exports address) ': effects) result - -> Evaluator location value effects (Either String result, EvaluatingState location value) + -> Evaluator address value effects (Either String result, EvaluatingState address value) evaluating = fmap (\ ((((result, env), heap), modules), exports) -> (result, EvaluatingState env heap modules exports)) - . runState lowerBound -- State (Exports location) - . runState lowerBound -- State (ModuleTable (Maybe (Environment location, value))) - . runState lowerBound -- State (Heap location (Cell location) value) - . runState lowerBound -- State (Environment location) - . runReader lowerBound -- Reader (Environment location) + . runState lowerBound -- State (Exports address) + . runState lowerBound -- State (ModuleTable (Maybe (Environment address, value))) + . runState lowerBound -- State (Heap address (Cell address) value) + . runState lowerBound -- State (Environment address) + . runReader lowerBound -- Reader (Environment address) . runFresh 0 . runFail diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs index c86a2319b..aa847a808 100644 --- a/src/Analysis/Abstract/Graph.hs +++ b/src/Analysis/Abstract/Graph.hs @@ -52,14 +52,14 @@ style = (defaultStyle (byteString . vertexName)) -- | Add vertices to the graph for evaluated identifiers. graphingTerms :: ( Element Syntax.Identifier syntax - , Member (Reader (Environment (Hole (Located location)))) effects + , Member (Reader (Environment (Hole (Located address)))) effects , Member (Reader ModuleInfo) effects - , Member (State (Environment (Hole (Located location)))) effects + , Member (State (Environment (Hole (Located address)))) effects , Member (State (Graph Vertex)) effects , term ~ Term (Sum syntax) ann ) - => SubtermAlgebra (Base term) term (TermEvaluator term (Hole (Located location)) value effects a) - -> SubtermAlgebra (Base term) term (TermEvaluator term (Hole (Located location)) value effects a) + => SubtermAlgebra (Base term) term (TermEvaluator term (Hole (Located address)) value effects a) + -> SubtermAlgebra (Base term) term (TermEvaluator term (Hole (Located address)) value effects a) graphingTerms recur term@(In _ syntax) = do case project syntax of Just (Syntax.Identifier name) -> do @@ -71,19 +71,19 @@ graphingTerms recur term@(In _ syntax) = do graphingPackages :: ( Member (Reader PackageInfo) effects , Member (State (Graph Vertex)) effects ) - => SubtermAlgebra Module term (TermEvaluator term location value effects a) - -> SubtermAlgebra Module term (TermEvaluator term location value effects a) + => SubtermAlgebra Module term (TermEvaluator term address value effects a) + -> SubtermAlgebra Module term (TermEvaluator term address value effects a) graphingPackages recur m = packageInclusion (moduleVertex (moduleInfo m)) *> recur m -- | Add vertices to the graph for evaluated modules and the packages containing them. -graphingModules :: forall term location value effects a - . ( Member (Modules location value) effects +graphingModules :: forall term address value effects a + . ( Member (Modules address value) effects , Member (Reader ModuleInfo) effects , Member (State (Graph Vertex)) effects ) - => SubtermAlgebra Module term (TermEvaluator term location value effects a) - -> SubtermAlgebra Module term (TermEvaluator term location value effects a) -graphingModules recur m = interpose @(Modules location value) pure (\ m yield -> case m of + => SubtermAlgebra Module term (TermEvaluator term address value effects a) + -> SubtermAlgebra Module term (TermEvaluator term address value effects a) +graphingModules recur m = interpose @(Modules address value) pure (\ m yield -> case m of Load path -> moduleInclusion (moduleVertex (ModuleInfo path)) >> send m >>= yield Lookup path -> moduleInclusion (moduleVertex (ModuleInfo path)) >> send m >>= yield _ -> send m >>= yield) @@ -121,12 +121,12 @@ moduleInclusion v = do appendGraph (vertex (moduleVertex m) `connect` vertex v) -- | Add an edge from the passed variable name to the module it originated within. -variableDefinition :: ( Member (Reader (Environment (Hole (Located location)))) effects - , Member (State (Environment (Hole (Located location)))) effects +variableDefinition :: ( Member (Reader (Environment (Hole (Located address)))) effects + , Member (State (Environment (Hole (Located address)))) effects , Member (State (Graph Vertex)) effects ) => Name - -> TermEvaluator term (Hole (Located location)) value effects () + -> TermEvaluator term (Hole (Located address)) value effects () variableDefinition name = do graph <- maybe lowerBound (maybe lowerBound (vertex . moduleVertex . locationModule) . toMaybe) <$> TermEvaluator (lookupEnv name) appendGraph (vertex (Variable (unName name)) `connect` graph) diff --git a/src/Analysis/Abstract/Tracing.hs b/src/Analysis/Abstract/Tracing.hs index d0919b42b..80b35d067 100644 --- a/src/Analysis/Abstract/Tracing.hs +++ b/src/Analysis/Abstract/Tracing.hs @@ -13,19 +13,19 @@ import Prologue -- -- Instantiating @trace@ to @[]@ yields a linear trace analysis, while @Set@ yields a reachable state analysis. tracingTerms :: ( Corecursive term - , Member (Reader (Live location)) effects - , Member (State (Environment location)) effects - , Member (State (Heap location (Cell location) value)) effects - , Member (Writer (trace (Configuration term location (Cell location) value))) effects - , Reducer (Configuration term location (Cell location) value) (trace (Configuration term location (Cell location) value)) + , Member (Reader (Live address)) effects + , Member (State (Environment address)) effects + , Member (State (Heap address (Cell address) value)) effects + , Member (Writer (trace (Configuration term address (Cell address) value))) effects + , Reducer (Configuration term address (Cell address) value) (trace (Configuration term address (Cell address) value)) ) - => trace (Configuration term location (Cell location) value) - -> SubtermAlgebra (Base term) term (TermEvaluator term location value effects a) - -> SubtermAlgebra (Base term) term (TermEvaluator term location value effects a) + => trace (Configuration term address (Cell address) value) + -> SubtermAlgebra (Base term) term (TermEvaluator term address value effects a) + -> SubtermAlgebra (Base term) term (TermEvaluator term address value effects a) tracingTerms proxy recur term = getConfiguration (embedSubterm term) >>= trace . (`asTypeOf` proxy) . Reducer.unit >> recur term -trace :: Member (Writer (trace (Configuration term location (Cell location) value))) effects => trace (Configuration term location (Cell location) value) -> TermEvaluator term location value effects () +trace :: Member (Writer (trace (Configuration term address (Cell address) value))) effects => trace (Configuration term address (Cell address) value) -> TermEvaluator term address value effects () trace = tell -tracing :: Monoid (trace (Configuration term location (Cell location) value)) => TermEvaluator term location value (Writer (trace (Configuration term location (Cell location) value)) ': effects) a -> TermEvaluator term location value effects (a, trace (Configuration term location (Cell location) value)) +tracing :: Monoid (trace (Configuration term address (Cell address) value)) => TermEvaluator term address value (Writer (trace (Configuration term address (Cell address) value)) ': effects) a -> TermEvaluator term address value effects (a, trace (Configuration term address (Cell address) value)) tracing = runWriter diff --git a/src/Control/Abstract/Addressable.hs b/src/Control/Abstract/Addressable.hs index b9ff059d4..a995af468 100644 --- a/src/Control/Abstract/Addressable.hs +++ b/src/Control/Abstract/Addressable.hs @@ -11,41 +11,41 @@ import Data.Abstract.Name import Prologue -- | Defines allocation and dereferencing of addresses. -class (Ord location, Show location) => Addressable location effects where - -- | The type into which stored values will be written for a given location type. - type family Cell location :: * -> * +class (Ord address, Show address) => Addressable address effects where + -- | The type into which stored values will be written for a given address type. + type family Cell address :: * -> * - allocCell :: Name -> Evaluator location value effects location - derefCell :: location -> Cell location value -> Evaluator location value effects (Maybe value) + allocCell :: Name -> Evaluator address value effects address + derefCell :: address -> Cell address value -> Evaluator address value effects (Maybe value) --- | 'Precise' locations are always allocated a fresh address, and dereference to the 'Latest' value written. +-- | 'Precise' addresses are always allocated a fresh address, and dereference to the 'Latest' value written. instance Member Fresh effects => Addressable Precise effects where type Cell Precise = Latest allocCell _ = Precise <$> fresh derefCell _ = pure . getLast . unLatest --- | 'Monovariant' locations allocate one address per unique variable name, and dereference once per stored value, nondeterministically. +-- | 'Monovariant' addresses allocate one address per unique variable name, and dereference once per stored value, nondeterministically. instance Member NonDet effects => Addressable Monovariant effects where type Cell Monovariant = All allocCell = pure . Monovariant derefCell _ = traverse (foldMapA pure) . nonEmpty . toList --- | 'Located' locations allocate & dereference using the underlying location, contextualizing locations with the current 'PackageInfo' & 'ModuleInfo'. -instance (Addressable location effects, Member (Reader ModuleInfo) effects, Member (Reader PackageInfo) effects) => Addressable (Located location) effects where - type Cell (Located location) = Cell location +-- | 'Located' addresses allocate & dereference using the underlying address, contextualizing addresses with the current 'PackageInfo' & 'ModuleInfo'. +instance (Addressable address effects, Member (Reader ModuleInfo) effects, Member (Reader PackageInfo) effects) => Addressable (Located address) effects where + type Cell (Located address) = Cell address allocCell name = relocate (Located <$> allocCell name <*> currentPackage <*> currentModule) derefCell (Located loc _ _) = relocate . derefCell loc -instance Addressable location effects => Addressable (Hole location) effects where - type Cell (Hole location) = Cell location +instance Addressable address effects => Addressable (Hole address) effects where + type Cell (Hole address) = Cell address allocCell name = relocate (Total <$> allocCell name) derefCell (Total loc) = relocate . derefCell loc derefCell Partial = const (pure Nothing) -relocate :: Evaluator location1 value effects a -> Evaluator location2 value effects a +relocate :: Evaluator address1 value effects a -> Evaluator address2 value effects a relocate = raiseEff . lowerEff diff --git a/src/Control/Abstract/Configuration.hs b/src/Control/Abstract/Configuration.hs index 42bb8eec2..764168d8e 100644 --- a/src/Control/Abstract/Configuration.hs +++ b/src/Control/Abstract/Configuration.hs @@ -12,5 +12,5 @@ import Control.Abstract.TermEvaluator import Data.Abstract.Configuration -- | Get the current 'Configuration' with a passed-in term. -getConfiguration :: (Member (Reader (Live location)) effects, Member (State (Environment location)) effects, Member (State (Heap location (Cell location) value)) effects) => term -> TermEvaluator term location value effects (Configuration term location (Cell location) value) +getConfiguration :: (Member (Reader (Live address)) effects, Member (State (Environment address)) effects, Member (State (Heap address (Cell address) value)) effects) => term -> TermEvaluator term address value effects (Configuration term address (Cell address) value) getConfiguration term = Configuration term <$> TermEvaluator askRoots <*> TermEvaluator getEnv <*> TermEvaluator getHeap diff --git a/src/Control/Abstract/Environment.hs b/src/Control/Abstract/Environment.hs index cedc445b1..5b7c31af8 100644 --- a/src/Control/Abstract/Environment.hs +++ b/src/Control/Abstract/Environment.hs @@ -21,45 +21,45 @@ import Data.Abstract.Name import Prologue -- | Retrieve the environment. -getEnv :: Member (State (Environment location)) effects => Evaluator location value effects (Environment location) +getEnv :: Member (State (Environment address)) effects => Evaluator address value effects (Environment address) getEnv = get -- | Set the environment. -putEnv :: Member (State (Environment location)) effects => Environment location -> Evaluator location value effects () +putEnv :: Member (State (Environment address)) effects => Environment address -> Evaluator address value effects () putEnv = put -- | Update the global environment. -modifyEnv :: Member (State (Environment location)) effects => (Environment location -> Environment location) -> Evaluator location value effects () +modifyEnv :: Member (State (Environment address)) effects => (Environment address -> Environment address) -> Evaluator address value effects () modifyEnv = modify' -- | Sets the environment for the lifetime of the given action. -withEnv :: Member (State (Environment location)) effects => Environment location -> Evaluator location value effects a -> Evaluator location value effects a +withEnv :: Member (State (Environment address)) effects => Environment address -> Evaluator address value effects a -> Evaluator address value effects a withEnv = localState . const -- | Retrieve the default environment. -defaultEnvironment :: Member (Reader (Environment location)) effects => Evaluator location value effects (Environment location) +defaultEnvironment :: Member (Reader (Environment address)) effects => Evaluator address value effects (Environment address) defaultEnvironment = ask -- | Set the default environment for the lifetime of an action. -- Usually only invoked in a top-level evaluation function. -withDefaultEnvironment :: Member (Reader (Environment location)) effects => Environment location -> Evaluator location value effects a -> Evaluator location value effects a +withDefaultEnvironment :: Member (Reader (Environment address)) effects => Environment address -> Evaluator address value effects a -> Evaluator address value effects a withDefaultEnvironment e = local (const e) -- | Look a 'Name' up in the current environment, trying the default environment if no value is found. -lookupEnv :: (Member (Reader (Environment location)) effects, Member (State (Environment location)) effects) => Name -> Evaluator location value effects (Maybe location) +lookupEnv :: (Member (Reader (Environment address)) effects, Member (State (Environment address)) effects) => Name -> Evaluator address value effects (Maybe address) lookupEnv name = (<|>) <$> (Env.lookup name <$> getEnv) <*> (Env.lookup name <$> defaultEnvironment) -- | Bind a 'Name' to an 'Address' in the current scope. -bind :: Member (State (Environment location)) effects => Name -> location -> Evaluator location value effects () +bind :: Member (State (Environment address)) effects => Name -> address -> Evaluator address value effects () bind name = modifyEnv . Env.insert name -- | Bind all of the names from an 'Environment' in the current scope. -bindAll :: Member (State (Environment location)) effects => Environment location -> Evaluator location value effects () +bindAll :: Member (State (Environment address)) effects => Environment address -> Evaluator address value effects () bindAll = foldr ((>>) . uncurry bind) (pure ()) . pairs -- | Run an action in a new local environment. -locally :: Member (State (Environment location)) effects => Evaluator location value effects a -> Evaluator location value effects a +locally :: Member (State (Environment address)) effects => Evaluator address value effects a -> Evaluator address value effects a locally a = do modifyEnv Env.push a' <- a @@ -67,19 +67,19 @@ locally a = do -- | Errors involving the environment. -data EnvironmentError location return where - FreeVariable :: Name -> EnvironmentError location location +data EnvironmentError address return where + FreeVariable :: Name -> EnvironmentError address address -deriving instance Eq (EnvironmentError location return) -deriving instance Show (EnvironmentError location return) -instance Show1 (EnvironmentError location) where liftShowsPrec _ _ = showsPrec -instance Eq1 (EnvironmentError location) where liftEq _ (FreeVariable n1) (FreeVariable n2) = n1 == n2 +deriving instance Eq (EnvironmentError address return) +deriving instance Show (EnvironmentError address return) +instance Show1 (EnvironmentError address) where liftShowsPrec _ _ = showsPrec +instance Eq1 (EnvironmentError address) where liftEq _ (FreeVariable n1) (FreeVariable n2) = n1 == n2 -freeVariableError :: Member (Resumable (EnvironmentError location)) effects => Name -> Evaluator location value effects location +freeVariableError :: Member (Resumable (EnvironmentError address)) effects => Name -> Evaluator address value effects address freeVariableError = throwResumable . FreeVariable -runEnvironmentError :: Effectful (m location value) => m location value (Resumable (EnvironmentError location) ': effects) a -> m location value effects (Either (SomeExc (EnvironmentError location)) a) +runEnvironmentError :: Effectful (m address value) => m address value (Resumable (EnvironmentError address) ': effects) a -> m address value effects (Either (SomeExc (EnvironmentError address)) a) runEnvironmentError = runResumable -runEnvironmentErrorWith :: Effectful (m location value) => (forall resume . EnvironmentError location resume -> m location value effects resume) -> m location value (Resumable (EnvironmentError location) ': effects) a -> m location value effects a +runEnvironmentErrorWith :: Effectful (m address value) => (forall resume . EnvironmentError address resume -> m address value effects resume) -> m address value (Resumable (EnvironmentError address) ': effects) a -> m address value effects a runEnvironmentErrorWith = runResumableWith diff --git a/src/Control/Abstract/Evaluator.hs b/src/Control/Abstract/Evaluator.hs index 5e1b613bc..95cd9391e 100644 --- a/src/Control/Abstract/Evaluator.hs +++ b/src/Control/Abstract/Evaluator.hs @@ -24,15 +24,15 @@ import Control.Monad.Effect.State as X import Control.Monad.Effect.Trace as X import Prologue --- | An 'Evaluator' is a thin wrapper around 'Eff' with (phantom) type parameters for the location, term, and value types. +-- | An 'Evaluator' is a thin wrapper around 'Eff' with (phantom) type parameters for the address, term, and value types. -- -- These parameters enable us to constrain the types of effects using them s.t. we can avoid both ambiguous types when they aren’t mentioned outside of the context, and lengthy, redundant annotations on the use sites of functions employing these effects. -- -- These effects will typically include the environment, heap, module table, etc. effects necessary for evaluation of modules and terms, but may also include any other effects so long as they’re eventually handled. -newtype Evaluator location value effects a = Evaluator { runEvaluator :: Eff effects a } +newtype Evaluator address value effects a = Evaluator { runEvaluator :: Eff effects a } deriving (Applicative, Effectful, Functor, Monad) -deriving instance Member NonDet effects => Alternative (Evaluator location value effects) +deriving instance Member NonDet effects => Alternative (Evaluator address value effects) -- Effects @@ -44,13 +44,13 @@ data Return value resume where deriving instance Eq value => Eq (Return value a) deriving instance Show value => Show (Return value a) -earlyReturn :: Member (Return value) effects => value -> Evaluator location value effects value +earlyReturn :: Member (Return value) effects => value -> Evaluator address value effects value earlyReturn = send . Return -catchReturn :: Member (Return value) effects => Evaluator location value effects a -> (forall x . Return value x -> Evaluator location value effects a) -> Evaluator location value effects a +catchReturn :: Member (Return value) effects => Evaluator address value effects a -> (forall x . Return value x -> Evaluator address value effects a) -> Evaluator address value effects a catchReturn action handler = interpose pure (\ ret _ -> handler ret) action -runReturn :: Effectful (m location value) => m location value (Return value ': effects) value -> m location value effects value +runReturn :: Effectful (m address value) => m address value (Return value ': effects) value -> m address value effects value runReturn = raiseHandler (relay pure (\ (Return value) _ -> pure value)) @@ -62,16 +62,16 @@ data LoopControl value resume where deriving instance Eq value => Eq (LoopControl value a) deriving instance Show value => Show (LoopControl value a) -throwBreak :: Member (LoopControl value) effects => value -> Evaluator location value effects value +throwBreak :: Member (LoopControl value) effects => value -> Evaluator address value effects value throwBreak = send . Break -throwContinue :: Member (LoopControl value) effects => value -> Evaluator location value effects value +throwContinue :: Member (LoopControl value) effects => value -> Evaluator address value effects value throwContinue = send . Continue -catchLoopControl :: Member (LoopControl value) effects => Evaluator location value effects a -> (forall x . LoopControl value x -> Evaluator location value effects a) -> Evaluator location value effects a +catchLoopControl :: Member (LoopControl value) effects => Evaluator address value effects a -> (forall x . LoopControl value x -> Evaluator address value effects a) -> Evaluator address value effects a catchLoopControl action handler = interpose pure (\ control _ -> handler control) action -runLoopControl :: Effectful (m location value) => m location value (LoopControl value ': effects) value -> m location value effects value +runLoopControl :: Effectful (m address value) => m address value (LoopControl value ': effects) value -> m address value effects value runLoopControl = raiseHandler (relay pure (\ eff _ -> case eff of Break value -> pure value Continue value -> pure value)) diff --git a/src/Control/Abstract/Exports.hs b/src/Control/Abstract/Exports.hs index 1c35c7838..5ad8bc1f3 100644 --- a/src/Control/Abstract/Exports.hs +++ b/src/Control/Abstract/Exports.hs @@ -12,21 +12,21 @@ import Data.Abstract.Exports import Data.Abstract.Name -- | Get the global export state. -getExports :: Member (State (Exports location)) effects => Evaluator location value effects (Exports location) +getExports :: Member (State (Exports address)) effects => Evaluator address value effects (Exports address) getExports = get -- | Set the global export state. -putExports :: Member (State (Exports location)) effects => Exports location -> Evaluator location value effects () +putExports :: Member (State (Exports address)) effects => Exports address -> Evaluator address value effects () putExports = put -- | Update the global export state. -modifyExports :: Member (State (Exports location)) effects => (Exports location -> Exports location) -> Evaluator location value effects () +modifyExports :: Member (State (Exports address)) effects => (Exports address -> Exports address) -> Evaluator address value effects () modifyExports = modify' -- | Add an export to the global export state. -addExport :: Member (State (Exports location)) effects => Name -> Name -> Maybe location -> Evaluator location value effects () +addExport :: Member (State (Exports address)) effects => Name -> Name -> Maybe address -> Evaluator address value effects () addExport name alias = modifyExports . insert name alias -- | Sets the global export state for the lifetime of the given action. -withExports :: Member (State (Exports location)) effects => Exports location -> Evaluator location value effects a -> Evaluator location value effects a +withExports :: Member (State (Exports address)) effects => Exports address -> Evaluator address value effects a -> Evaluator address value effects a withExports = localState . const diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index 236611176..93a615dbf 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -29,57 +29,57 @@ import Data.Semigroup.Reducer import Prologue -- | Retrieve the heap. -getHeap :: Member (State (Heap location (Cell location) value)) effects => Evaluator location value effects (Heap location (Cell location) value) +getHeap :: Member (State (Heap address (Cell address) value)) effects => Evaluator address value effects (Heap address (Cell address) value) getHeap = get -- | Set the heap. -putHeap :: Member (State (Heap location (Cell location) value)) effects => Heap location (Cell location) value -> Evaluator location value effects () +putHeap :: Member (State (Heap address (Cell address) value)) effects => Heap address (Cell address) value -> Evaluator address value effects () putHeap = put -- | Update the heap. -modifyHeap :: Member (State (Heap location (Cell location) value)) effects => (Heap location (Cell location) value -> Heap location (Cell location) value) -> Evaluator location value effects () +modifyHeap :: Member (State (Heap address (Cell address) value)) effects => (Heap address (Cell address) value -> Heap address (Cell address) value) -> Evaluator address value effects () modifyHeap = modify' -alloc :: forall location value effects . Member (Allocator location value) effects => Name -> Evaluator location value effects location -alloc = send . Alloc @location @value +alloc :: forall address value effects . Member (Allocator address value) effects => Name -> Evaluator address value effects address +alloc = send . Alloc @address @value -- | Dereference the given address in the heap, or fail if the address is uninitialized. -deref :: Member (Allocator location value) effects => location -> Evaluator location value effects value +deref :: Member (Allocator address value) effects => address -> Evaluator address value effects value deref = send . Deref -- | Write a value to the given address in the 'Store'. -assign :: ( Member (State (Heap location (Cell location) value)) effects - , Ord location - , Reducer value (Cell location value) +assign :: ( Member (State (Heap address (Cell address) value)) effects + , Ord address + , Reducer value (Cell address value) ) - => location + => address -> value - -> Evaluator location value effects () + -> Evaluator address value effects () assign address = modifyHeap . heapInsert address -- | Look up or allocate an address for a 'Name'. -lookupOrAlloc :: ( Member (Allocator location value) effects - , Member (Reader (Environment location)) effects - , Member (State (Environment location)) effects +lookupOrAlloc :: ( Member (Allocator address value) effects + , Member (Reader (Environment address)) effects + , Member (State (Environment address)) effects ) => Name - -> Evaluator location value effects location + -> Evaluator address value effects address lookupOrAlloc name = lookupEnv name >>= maybe (alloc name) pure -letrec :: ( Member (Allocator location value) effects - , Member (Reader (Environment location)) effects - , Member (State (Environment location)) effects - , Member (State (Heap location (Cell location) value)) effects - , Ord location - , Reducer value (Cell location value) +letrec :: ( Member (Allocator address value) effects + , Member (Reader (Environment address)) effects + , Member (State (Environment address)) effects + , Member (State (Heap address (Cell address) value)) effects + , Ord address + , Reducer value (Cell address value) ) => Name - -> Evaluator location value effects value - -> Evaluator location value effects (value, location) + -> Evaluator address value effects value + -> Evaluator address value effects (value, address) letrec name body = do addr <- lookupOrAlloc name v <- locally (bind name addr *> body) @@ -87,13 +87,13 @@ letrec name body = do pure (v, addr) -- Lookup/alloc a name passing the address to a body evaluated in a new local environment. -letrec' :: ( Member (Allocator location value) effects - , Member (Reader (Environment location)) effects - , Member (State (Environment location)) effects +letrec' :: ( Member (Allocator address value) effects + , Member (Reader (Environment address)) effects + , Member (State (Environment address)) effects ) => Name - -> (location -> Evaluator location value effects value) - -> Evaluator location value effects value + -> (address -> Evaluator address value effects value) + -> Evaluator address value effects value letrec' name body = do addr <- lookupOrAlloc name v <- locally (body addr) @@ -101,44 +101,44 @@ letrec' name body = do -- | Look up and dereference the given 'Name', throwing an exception for free variables. -variable :: ( Member (Allocator location value) effects - , Member (Reader (Environment location)) effects - , Member (Resumable (EnvironmentError location)) effects - , Member (State (Environment location)) effects +variable :: ( Member (Allocator address value) effects + , Member (Reader (Environment address)) effects + , Member (Resumable (EnvironmentError address)) effects + , Member (State (Environment address)) effects ) => Name - -> Evaluator location value effects value + -> Evaluator address value effects value variable name = lookupEnv name >>= maybeM (freeVariableError name) >>= deref -- Effects -data Allocator location value return where - Alloc :: Name -> Allocator location value location - Deref :: location -> Allocator location value value +data Allocator address value return where + Alloc :: Name -> Allocator address value address + Deref :: address -> Allocator address value value -runAllocator :: (Addressable location effects, Effectful (m location value), Member (Resumable (AddressError location value)) effects, Member (State (Heap location (Cell location) value)) effects) => m location value (Allocator location value ': effects) a -> m location value effects a +runAllocator :: (Addressable address effects, Effectful (m address value), Member (Resumable (AddressError address value)) effects, Member (State (Heap address (Cell address) value)) effects) => m address value (Allocator address value ': effects) a -> m address value effects a runAllocator = raiseHandler (interpret (\ eff -> case eff of Alloc name -> lowerEff $ allocCell name Deref addr -> lowerEff $ heapLookup addr <$> get >>= maybeM (throwResumable (UnallocatedAddress addr)) >>= derefCell addr >>= maybeM (throwResumable (UninitializedAddress addr)))) -data AddressError location value resume where - UnallocatedAddress :: location -> AddressError location value (Cell location value) - UninitializedAddress :: location -> AddressError location value value +data AddressError address value resume where + UnallocatedAddress :: address -> AddressError address value (Cell address value) + UninitializedAddress :: address -> AddressError address value value -deriving instance Eq location => Eq (AddressError location value resume) -deriving instance Show location => Show (AddressError location value resume) -instance Show location => Show1 (AddressError location value) where +deriving instance Eq address => Eq (AddressError address value resume) +deriving instance Show address => Show (AddressError address value resume) +instance Show address => Show1 (AddressError address value) where liftShowsPrec _ _ = showsPrec -instance Eq location => Eq1 (AddressError location value) where +instance Eq address => Eq1 (AddressError address value) where liftEq _ (UninitializedAddress a) (UninitializedAddress b) = a == b liftEq _ (UnallocatedAddress a) (UnallocatedAddress b) = a == b liftEq _ _ _ = False -runAddressError :: Effectful (m location value) => m location value (Resumable (AddressError location value) ': effects) a -> m location value effects (Either (SomeExc (AddressError location value)) a) +runAddressError :: Effectful (m address value) => m address value (Resumable (AddressError address value) ': effects) a -> m address value effects (Either (SomeExc (AddressError address value)) a) runAddressError = runResumable -runAddressErrorWith :: Effectful (m location value) => (forall resume . AddressError location value resume -> m location value effects resume) -> m location value (Resumable (AddressError location value) ': effects) a -> m location value effects a +runAddressErrorWith :: Effectful (m address value) => (forall resume . AddressError address value resume -> m address value effects resume) -> m address value (Resumable (AddressError address value) ': effects) a -> m address value effects a runAddressErrorWith = runResumableWith diff --git a/src/Control/Abstract/Modules.hs b/src/Control/Abstract/Modules.hs index 5ce3a3da0..fb22b61bd 100644 --- a/src/Control/Abstract/Modules.hs +++ b/src/Control/Abstract/Modules.hs @@ -26,49 +26,49 @@ import Data.Language import Prologue -- | Retrieve an evaluated module, if any. The outer 'Maybe' indicates whether we’ve begun loading the module or not, while the inner 'Maybe' indicates whether we’ve completed loading it or not. Thus, @Nothing@ means we’ve never tried to load it, @Just Nothing@ means we’ve started but haven’t yet finished loading it, and @Just (Just (env, value))@ indicates the result of a completed load. -lookupModule :: Member (Modules location value) effects => ModulePath -> Evaluator location value effects (Maybe (Maybe (Environment location, value))) +lookupModule :: Member (Modules address value) effects => ModulePath -> Evaluator address value effects (Maybe (Maybe (Environment address, value))) lookupModule = send . Lookup -- | Resolve a list of module paths to a possible module table entry. -resolve :: Member (Modules location value) effects => [FilePath] -> Evaluator location value effects (Maybe ModulePath) +resolve :: Member (Modules address value) effects => [FilePath] -> Evaluator address value effects (Maybe ModulePath) resolve = sendModules . Resolve -listModulesInDir :: Member (Modules location value) effects => FilePath -> Evaluator location value effects [ModulePath] +listModulesInDir :: Member (Modules address value) effects => FilePath -> Evaluator address value effects [ModulePath] listModulesInDir = sendModules . List -- | Require/import another module by name and return its environment and value. -- -- Looks up the module's name in the cache of evaluated modules first, returns if found, otherwise loads/evaluates the module. -require :: Member (Modules location value) effects => ModulePath -> Evaluator location value effects (Maybe (Environment location, value)) +require :: Member (Modules address value) effects => ModulePath -> Evaluator address value effects (Maybe (Environment address, value)) require path = lookupModule path >>= maybeM (load path) -- | Load another module by name and return its environment and value. -- -- Always loads/evaluates. -load :: Member (Modules location value) effects => ModulePath -> Evaluator location value effects (Maybe (Environment location, value)) +load :: Member (Modules address value) effects => ModulePath -> Evaluator address value effects (Maybe (Environment address, value)) load = send . Load -data Modules location value return where - Load :: ModulePath -> Modules location value (Maybe (Environment location, value)) - Lookup :: ModulePath -> Modules location value (Maybe (Maybe (Environment location, value))) - Resolve :: [FilePath] -> Modules location value (Maybe ModulePath) - List :: FilePath -> Modules location value [ModulePath] +data Modules address value return where + Load :: ModulePath -> Modules address value (Maybe (Environment address, value)) + Lookup :: ModulePath -> Modules address value (Maybe (Maybe (Environment address, value))) + Resolve :: [FilePath] -> Modules address value (Maybe ModulePath) + List :: FilePath -> Modules address value [ModulePath] -sendModules :: Member (Modules location value) effects => Modules location value return -> Evaluator location value effects return +sendModules :: Member (Modules address value) effects => Modules address value return -> Evaluator address value effects return sendModules = send -runModules :: forall term location value effects a - . ( Member (Resumable (LoadError location value)) effects - , Member (State (ModuleTable (Maybe (Environment location, value)))) effects +runModules :: forall term address value effects a + . ( Member (Resumable (LoadError address value)) effects + , Member (State (ModuleTable (Maybe (Environment address, value)))) effects , Member Trace effects ) - => (Module term -> Evaluator location value (Modules location value ': effects) (Environment location, value)) - -> Evaluator location value (Modules location value ': effects) a - -> Evaluator location value (Reader (ModuleTable [Module term]) ': effects) a + => (Module term -> Evaluator address value (Modules address value ': effects) (Environment address, value)) + -> Evaluator address value (Modules address value ': effects) a + -> Evaluator address value (Reader (ModuleTable [Module term]) ': effects) a runModules evaluateModule = go - where go :: forall a . Evaluator location value (Modules location value ': effects) a -> Evaluator location value (Reader (ModuleTable [Module term]) ': effects) a + where go :: forall a . Evaluator address value (Modules address value ': effects) a -> Evaluator address value (Reader (ModuleTable [Module term]) ': effects) a go = reinterpret (\ m -> case m of Load name -> askModuleTable @term >>= maybe (moduleNotFound name) (runMerging . foldMap (Merging . evalAndCache)) . ModuleTable.lookup name where @@ -89,49 +89,49 @@ runModules evaluateModule = go pure (find isMember names) List dir -> modulePathsInDir dir <$> askModuleTable @term) -getModuleTable :: Member (State (ModuleTable (Maybe (Environment location, value)))) effects => Evaluator location value effects (ModuleTable (Maybe (Environment location, value))) +getModuleTable :: Member (State (ModuleTable (Maybe (Environment address, value)))) effects => Evaluator address value effects (ModuleTable (Maybe (Environment address, value))) getModuleTable = get -cacheModule :: Member (State (ModuleTable (Maybe (Environment location, value)))) effects => ModulePath -> Maybe (Environment location, value) -> Evaluator location value effects (Maybe (Environment location, value)) +cacheModule :: Member (State (ModuleTable (Maybe (Environment address, value)))) effects => ModulePath -> Maybe (Environment address, value) -> Evaluator address value effects (Maybe (Environment address, value)) cacheModule path result = modify' (ModuleTable.insert path result) $> result -askModuleTable :: Member (Reader (ModuleTable [Module term])) effects => Evaluator location value effects (ModuleTable [Module term]) +askModuleTable :: Member (Reader (ModuleTable [Module term])) effects => Evaluator address value effects (ModuleTable [Module term]) askModuleTable = ask -newtype Merging m location value = Merging { runMerging :: m (Maybe (Environment location, value)) } +newtype Merging m address value = Merging { runMerging :: m (Maybe (Environment address, value)) } -instance Applicative m => Semigroup (Merging m location value) where +instance Applicative m => Semigroup (Merging m address value) where Merging a <> Merging b = Merging (merge <$> a <*> b) where merge a b = mergeJusts <$> a <*> b <|> a <|> b mergeJusts (env1, _) (env2, v) = (mergeEnvs env1 env2, v) -instance Applicative m => Monoid (Merging m location value) where +instance Applicative m => Monoid (Merging m address value) where mappend = (<>) mempty = Merging (pure Nothing) -- | An error thrown when loading a module from the list of provided modules. Indicates we weren't able to find a module with the given name. -data LoadError location value resume where - ModuleNotFound :: ModulePath -> LoadError location value (Maybe (Environment location, value)) +data LoadError address value resume where + ModuleNotFound :: ModulePath -> LoadError address value (Maybe (Environment address, value)) -deriving instance Eq (LoadError location value resume) -deriving instance Show (LoadError location value resume) -instance Show1 (LoadError location value) where +deriving instance Eq (LoadError address value resume) +deriving instance Show (LoadError address value resume) +instance Show1 (LoadError address value) where liftShowsPrec _ _ = showsPrec -instance Eq1 (LoadError location value) where +instance Eq1 (LoadError address value) where liftEq _ (ModuleNotFound a) (ModuleNotFound b) = a == b -moduleNotFound :: Member (Resumable (LoadError location value)) effects => ModulePath -> Evaluator location value effects (Maybe (Environment location, value)) +moduleNotFound :: Member (Resumable (LoadError address value)) effects => ModulePath -> Evaluator address value effects (Maybe (Environment address, value)) moduleNotFound = throwResumable . ModuleNotFound -resumeLoadError :: Member (Resumable (LoadError location value)) effects => Evaluator location value effects a -> (forall resume . LoadError location value resume -> Evaluator location value effects resume) -> Evaluator location value effects a +resumeLoadError :: Member (Resumable (LoadError address value)) effects => Evaluator address value effects a -> (forall resume . LoadError address value resume -> Evaluator address value effects resume) -> Evaluator address value effects a resumeLoadError = catchResumable -runLoadError :: Effectful (m location value) => m location value (Resumable (LoadError location value) ': effects) a -> m location value effects (Either (SomeExc (LoadError location value)) a) +runLoadError :: Effectful (m address value) => m address value (Resumable (LoadError address value) ': effects) a -> m address value effects (Either (SomeExc (LoadError address value)) a) runLoadError = runResumable -runLoadErrorWith :: Effectful (m location value) => (forall resume . LoadError location value resume -> m location value effects resume) -> m location value (Resumable (LoadError location value) ': effects) a -> m location value effects a +runLoadErrorWith :: Effectful (m address value) => (forall resume . LoadError address value resume -> m address value effects resume) -> m address value (Resumable (LoadError address value) ': effects) a -> m address value effects a runLoadErrorWith = runResumableWith diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 7ef5458f9..003363867 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -13,44 +13,44 @@ import Data.Semilattice.Lower import Prologue builtin :: ( HasCallStack - , Member (Allocator location value) effects + , Member (Allocator address value) effects , Member (Reader ModuleInfo) effects , Member (Reader Span) effects - , Member (State (Environment location)) effects - , Member (State (Heap location (Cell location) value)) effects - , Ord location - , Reducer value (Cell location value) + , Member (State (Environment address)) effects + , Member (State (Heap address (Cell address) value)) effects + , Ord address + , Reducer value (Cell address value) ) => String - -> Evaluator location value effects value - -> Evaluator location value effects () + -> Evaluator address value effects value + -> Evaluator address value effects () builtin s def = withCurrentCallStack callStack $ do let name' = name (pack ("__semantic_" <> s)) addr <- alloc name' bind name' addr def >>= assign addr -lambda :: (AbstractFunction location value effects, Member Fresh effects) - => (Name -> Evaluator location value effects value) - -> Evaluator location value effects value +lambda :: (AbstractFunction address value effects, Member Fresh effects) + => (Name -> Evaluator address value effects value) + -> Evaluator address value effects value lambda body = do var <- nameI <$> fresh closure [var] lowerBound (body var) -defineBuiltins :: ( AbstractValue location value effects +defineBuiltins :: ( AbstractValue address value effects , HasCallStack - , Member (Allocator location value) effects + , Member (Allocator address value) effects , Member Fresh effects - , Member (Reader (Environment location)) effects + , Member (Reader (Environment address)) effects , Member (Reader ModuleInfo) effects , Member (Reader Span) effects - , Member (Resumable (EnvironmentError location)) effects - , Member (State (Environment location)) effects - , Member (State (Heap location (Cell location) value)) effects + , Member (Resumable (EnvironmentError address)) effects + , Member (State (Environment address)) effects + , Member (State (Heap address (Cell address) value)) effects , Member Trace effects - , Ord location - , Reducer value (Cell location value) + , Ord address + , Reducer value (Cell address value) ) - => Evaluator location value effects () + => Evaluator address value effects () defineBuiltins = builtin "print" (lambda (\ v -> variable v >>= asString >>= trace . unpack >> pure unit)) diff --git a/src/Control/Abstract/Roots.hs b/src/Control/Abstract/Roots.hs index 4c5277258..ccc07e3ca 100644 --- a/src/Control/Abstract/Roots.hs +++ b/src/Control/Abstract/Roots.hs @@ -9,9 +9,9 @@ import Data.Abstract.Live import Prologue -- | Retrieve the local 'Live' set. -askRoots :: Member (Reader (Live location)) effects => Evaluator location value effects (Live location) +askRoots :: Member (Reader (Live address)) effects => Evaluator address value effects (Live address) askRoots = ask -- | Run a computation with the given 'Live' set added to the local root set. -extraRoots :: (Member (Reader (Live location)) effects, Ord location) => Live location -> Evaluator location value effects a -> Evaluator location value effects a +extraRoots :: (Member (Reader (Live address)) effects, Ord address) => Live address -> Evaluator address value effects a -> Evaluator address value effects a extraRoots roots = local (<> roots) diff --git a/src/Control/Abstract/TermEvaluator.hs b/src/Control/Abstract/TermEvaluator.hs index dfeecc343..40912ad44 100644 --- a/src/Control/Abstract/TermEvaluator.hs +++ b/src/Control/Abstract/TermEvaluator.hs @@ -19,11 +19,11 @@ import Prologue -- | Evaluators specialized to some specific term type. -- -- This is used to constrain the term type so that inference for analyses can resolve it correctly, but should not be used for any of the term-agonstic machinery like builtins, Evaluatable instances, the mechanics of the heap & environment, etc. -newtype TermEvaluator term location value effects a = TermEvaluator { runTermEvaluator :: Evaluator location value effects a } +newtype TermEvaluator term address value effects a = TermEvaluator { runTermEvaluator :: Evaluator address value effects a } deriving (Applicative, Effectful, Functor, Monad) -deriving instance Member NonDet effects => Alternative (TermEvaluator term location value effects) +deriving instance Member NonDet effects => Alternative (TermEvaluator term address value effects) -raiseHandler :: (Evaluator location value effects a -> Evaluator location value effects' a') -> (TermEvaluator term location value effects a -> TermEvaluator term location value effects' a') +raiseHandler :: (Evaluator address value effects a -> Evaluator address value effects' a') -> (TermEvaluator term address value effects a -> TermEvaluator term address value effects' a') raiseHandler f = TermEvaluator . f . runTermEvaluator diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index 9b9c41895..9ee24f8b9 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -40,14 +40,14 @@ data Comparator = Concrete (forall a . Ord a => a -> a -> Bool) | Generalized -class Show value => AbstractFunction location value effects where +class Show value => AbstractFunction address value effects where -- | Build a closure (a binder like a lambda or method definition). closure :: [Name] -- ^ The parameter names. -> Set Name -- ^ The set of free variables to close over. - -> Evaluator location value effects value -- ^ The evaluator for the body of the closure. - -> Evaluator location value effects value + -> Evaluator address value effects value -- ^ The evaluator for the body of the closure. + -> Evaluator address value effects value -- | Evaluate an application (like a function call). - call :: value -> [Evaluator location value effects value] -> Evaluator location value effects value + call :: value -> [Evaluator address value effects value] -> Evaluator address value effects value class Show value => AbstractIntro value where @@ -90,112 +90,112 @@ class Show value => AbstractIntro value where -- | A 'Monad' abstracting the evaluation of (and under) binding constructs (functions, methods, etc). -- -- This allows us to abstract the choice of whether to evaluate under binders for different value types. -class (AbstractFunction location value effects, AbstractIntro value) => AbstractValue location value effects where +class (AbstractFunction address value effects, AbstractIntro value) => AbstractValue address value effects where -- | Lift a unary operator over a 'Num' to a function on 'value's. liftNumeric :: (forall a . Num a => a -> a) - -> (value -> Evaluator location value effects value) + -> (value -> Evaluator address value effects value) -- | Lift a pair of binary operators to a function on 'value's. -- You usually pass the same operator as both arguments, except in the cases where -- Haskell provides different functions for integral and fractional operations, such -- as division, exponentiation, and modulus. liftNumeric2 :: (forall a b. Number a -> Number b -> SomeNumber) - -> (value -> value -> Evaluator location value effects value) + -> (value -> value -> Evaluator address value effects value) -- | Lift a Comparator (usually wrapping a function like == or <=) to a function on values. - liftComparison :: Comparator -> (value -> value -> Evaluator location value effects value) + liftComparison :: Comparator -> (value -> value -> Evaluator address value effects value) -- | Lift a unary bitwise operator to values. This is usually 'complement'. liftBitwise :: (forall a . Bits a => a -> a) - -> (value -> Evaluator location value effects value) + -> (value -> Evaluator address value effects value) -- | Lift a binary bitwise operator to values. The Integral constraint is -- necessary to satisfy implementation details of Haskell left/right shift, -- but it's fine, since these are only ever operating on integral values. liftBitwise2 :: (forall a . (Integral a, Bits a) => a -> a -> a) - -> (value -> value -> Evaluator location value effects value) + -> (value -> value -> Evaluator address value effects value) -- | Construct an array of zero or more values. - array :: [value] -> Evaluator location value effects value + array :: [value] -> Evaluator address value effects value -- | Extract the contents of a key-value pair as a tuple. - asPair :: value -> Evaluator location value effects (value, value) + asPair :: value -> Evaluator address value effects (value, value) -- | Extract a 'ByteString' from a given value. - asString :: value -> Evaluator location value effects ByteString + asString :: value -> Evaluator address value effects ByteString -- | Eliminate boolean values. TODO: s/boolean/truthy - ifthenelse :: value -> Evaluator location value effects a -> Evaluator location value effects a -> Evaluator location value effects a + ifthenelse :: value -> Evaluator address value effects a -> Evaluator address value effects a -> Evaluator address value effects a -- | @index x i@ computes @x[i]@, with zero-indexing. - index :: value -> value -> Evaluator location value effects value + index :: value -> value -> Evaluator address value effects value -- | Build a class value from a name and environment. klass :: Name -- ^ The new class's identifier -> [value] -- ^ A list of superclasses - -> Environment location -- ^ The environment to capture - -> Evaluator location value effects value + -> Environment address -- ^ The environment to capture + -> Evaluator address value effects value -- | Build a namespace value from a name and environment stack -- -- Namespaces model closures with monoidal environments. namespace :: Name -- ^ The namespace's identifier - -> Environment location -- ^ The environment to mappend - -> Evaluator location value effects value + -> Environment address -- ^ The environment to mappend + -> Evaluator address value effects value -- | Extract the environment from any scoped object (e.g. classes, namespaces, etc). - scopedEnvironment :: value -> Evaluator location value effects (Maybe (Environment location)) + scopedEnvironment :: value -> Evaluator address value effects (Maybe (Environment address)) -- | Primitive looping combinator, approximately equivalent to 'fix'. This should be used in place of direct recursion, as it allows abstraction over recursion. -- -- The function argument takes an action which recurs through the loop. - loop :: (Evaluator location value effects value -> Evaluator location value effects value) -> Evaluator location value effects value + loop :: (Evaluator address value effects value -> Evaluator address value effects value) -> Evaluator address value effects value -- | Extract a 'Bool' from a given value. -asBool :: AbstractValue location value effects => value -> Evaluator location value effects Bool +asBool :: AbstractValue address value effects => value -> Evaluator address value effects Bool asBool value = ifthenelse value (pure True) (pure False) -- | C-style for loops. -forLoop :: ( AbstractValue location value effects - , Member (State (Environment location)) effects +forLoop :: ( AbstractValue address value effects + , Member (State (Environment address)) effects ) - => Evaluator location value effects value -- ^ Initial statement - -> Evaluator location value effects value -- ^ Condition - -> Evaluator location value effects value -- ^ Increment/stepper - -> Evaluator location value effects value -- ^ Body - -> Evaluator location value effects value + => Evaluator address value effects value -- ^ Initial statement + -> Evaluator address value effects value -- ^ Condition + -> Evaluator address value effects value -- ^ Increment/stepper + -> Evaluator address value effects value -- ^ Body + -> Evaluator address value effects value forLoop initial cond step body = locally (initial *> while cond (body *> step)) -- | The fundamental looping primitive, built on top of 'ifthenelse'. -while :: AbstractValue location value effects - => Evaluator location value effects value - -> Evaluator location value effects value - -> Evaluator location value effects value +while :: AbstractValue address value effects + => Evaluator address value effects value + -> Evaluator address value effects value + -> Evaluator address value effects value while cond body = loop $ \ continue -> do this <- cond ifthenelse this (body *> continue) (pure unit) -- | Do-while loop, built on top of while. -doWhile :: AbstractValue location value effects - => Evaluator location value effects value - -> Evaluator location value effects value - -> Evaluator location value effects value +doWhile :: AbstractValue address value effects + => Evaluator address value effects value + -> Evaluator address value effects value + -> Evaluator address value effects value doWhile body cond = loop $ \ continue -> body *> do this <- cond ifthenelse this continue (pure unit) -makeNamespace :: ( AbstractValue location value effects - , Member (State (Environment location)) effects - , Member (State (Heap location (Cell location) value)) effects - , Ord location - , Reducer value (Cell location value) +makeNamespace :: ( AbstractValue address value effects + , Member (State (Environment address)) effects + , Member (State (Heap address (Cell address) value)) effects + , Ord address + , Reducer value (Cell address value) ) => Name - -> location + -> address -> Maybe value - -> Evaluator location value effects value + -> Evaluator address value effects value makeNamespace name addr super = do superEnv <- maybe (pure (Just lowerBound)) scopedEnvironment super let env' = fromMaybe lowerBound superEnv @@ -205,43 +205,43 @@ makeNamespace name addr super = do -- | Evaluate a term within the context of the scoped environment of 'scopedEnvTerm'. -evaluateInScopedEnv :: ( AbstractValue location value effects - , Member (State (Environment location)) effects +evaluateInScopedEnv :: ( AbstractValue address value effects + , Member (State (Environment address)) effects ) - => Evaluator location value effects value - -> Evaluator location value effects value - -> Evaluator location value effects value + => Evaluator address value effects value + -> Evaluator address value effects value + -> Evaluator address value effects value evaluateInScopedEnv scopedEnvTerm term = do scopedEnv <- scopedEnvTerm >>= scopedEnvironment maybe term (\ env -> locally (bindAll env *> term)) scopedEnv -- | Evaluates a 'Value' returning the referenced value -value :: ( AbstractValue location value effects - , Member (Allocator location value) effects - , Member (Reader (Environment location)) effects - , Member (Resumable (EnvironmentError location)) effects - , Member (State (Environment location)) effects +value :: ( AbstractValue address value effects + , Member (Allocator address value) effects + , Member (Reader (Environment address)) effects + , Member (Resumable (EnvironmentError address)) effects + , Member (State (Environment address)) effects ) => ValueRef value - -> Evaluator location value effects value + -> Evaluator address value effects value value (LvalLocal var) = variable var value (LvalMember obj prop) = evaluateInScopedEnv (pure obj) (variable prop) value (Rval val) = pure val -- | Evaluates a 'Subterm' to its rval -subtermValue :: ( AbstractValue location value effects - , Member (Allocator location value) effects - , Member (Reader (Environment location)) effects - , Member (Resumable (EnvironmentError location)) effects - , Member (State (Environment location)) effects +subtermValue :: ( AbstractValue address value effects + , Member (Allocator address value) effects + , Member (Reader (Environment address)) effects + , Member (Resumable (EnvironmentError address)) effects + , Member (State (Environment address)) effects ) - => Subterm term (Evaluator location value effects (ValueRef value)) - -> Evaluator location value effects value + => Subterm term (Evaluator address value effects (ValueRef value)) + -> Evaluator address value effects value subtermValue = value <=< subtermRef -- | Value types, e.g. closures, which can root a set of addresses. -class ValueRoots location value where +class ValueRoots address value where -- | Compute the set of addresses rooted by a given value. - valueRoots :: value -> Live location + valueRoots :: value -> Live address diff --git a/src/Data/Abstract/Address.hs b/src/Data/Abstract/Address.hs index dd9c88b19..112098b38 100644 --- a/src/Data/Abstract/Address.hs +++ b/src/Data/Abstract/Address.hs @@ -26,8 +26,8 @@ instance Show Monovariant where showsPrec d = showsUnaryWith showsPrec "Monovariant" d . unMonovariant -data Located location = Located - { location :: location +data Located address = Located + { location :: address , locationPackage :: {-# UNPACK #-} !PackageInfo , locationModule :: !ModuleInfo } diff --git a/src/Data/Abstract/Cache.hs b/src/Data/Abstract/Cache.hs index 07487b216..c8833edbb 100644 --- a/src/Data/Abstract/Cache.hs +++ b/src/Data/Abstract/Cache.hs @@ -9,30 +9,30 @@ import Data.Semilattice.Lower import Prologue -- | A map of 'Configuration's to 'Set's of resulting values & 'Heap's. -newtype Cache term location cell value = Cache { unCache :: Monoidal.Map (Configuration term location cell value) (Set (Cached location cell value)) } - deriving (Eq, Lower, Monoid, Ord, Reducer (Configuration term location cell value, Cached location cell value), Semigroup) +newtype Cache term address cell value = Cache { unCache :: Monoidal.Map (Configuration term address cell value) (Set (Cached address cell value)) } + deriving (Eq, Lower, Monoid, Ord, Reducer (Configuration term address cell value, Cached address cell value), Semigroup) -data Cached location cell value = Cached +data Cached address cell value = Cached { cachedValue :: ValueRef value - , cachedHeap :: Heap location cell value + , cachedHeap :: Heap address cell value } deriving (Eq, Ord, Show) -type Cacheable term location cell value = (Ord (cell value), Ord location, Ord term, Ord value) +type Cacheable term address cell value = (Ord (cell value), Ord address, Ord term, Ord value) -- | Look up the resulting value & 'Heap' for a given 'Configuration'. -cacheLookup :: Cacheable term location cell value => Configuration term location cell value -> Cache term location cell value -> Maybe (Set (Cached location cell value)) +cacheLookup :: Cacheable term address cell value => Configuration term address cell value -> Cache term address cell value -> Maybe (Set (Cached address cell value)) cacheLookup key = Monoidal.lookup key . unCache -- | Set the resulting value & 'Heap' for a given 'Configuration', overwriting any previous entry. -cacheSet :: Cacheable term location cell value => Configuration term location cell value -> Set (Cached location cell value) -> Cache term location cell value -> Cache term location cell value +cacheSet :: Cacheable term address cell value => Configuration term address cell value -> Set (Cached address cell value) -> Cache term address cell value -> Cache term address cell value cacheSet key value = Cache . Monoidal.insert key value . unCache -- | Insert the resulting value & 'Heap' for a given 'Configuration', appending onto any previous entry. -cacheInsert :: Cacheable term location cell value => Configuration term location cell value -> Cached location cell value -> Cache term location cell value -> Cache term location cell value +cacheInsert :: Cacheable term address cell value => Configuration term address cell value -> Cached address cell value -> Cache term address cell value -> Cache term address cell value cacheInsert = curry cons -instance (Show term, Show location, Show (cell value), Show value) => Show (Cache term location cell value) where +instance (Show term, Show address, Show (cell value), Show value) => Show (Cache term address cell value) where showsPrec d = showsUnaryWith showsPrec "Cache" d . map (second toList) . Monoidal.pairs . unCache diff --git a/src/Data/Abstract/Configuration.hs b/src/Data/Abstract/Configuration.hs index fe8e1f9fa..0d2f89471 100644 --- a/src/Data/Abstract/Configuration.hs +++ b/src/Data/Abstract/Configuration.hs @@ -5,10 +5,10 @@ import Data.Abstract.Heap import Data.Abstract.Live -- | A single point in a program’s execution. -data Configuration term location cell value = Configuration - { configurationTerm :: term -- ^ The “instruction,” i.e. the current term to evaluate. - , configurationRoots :: Live location -- ^ The set of rooted addresses. - , configurationEnvironment :: Environment location -- ^ The environment binding any free variables in 'configurationTerm'. - , configurationHeap :: Heap location cell value -- ^ The heap of values. +data Configuration term address cell value = Configuration + { configurationTerm :: term -- ^ The “instruction,” i.e. the current term to evaluate. + , configurationRoots :: Live address -- ^ The set of rooted addresses. + , configurationEnvironment :: Environment address -- ^ The environment binding any free variables in 'configurationTerm'. + , configurationHeap :: Heap address cell value -- ^ The heap of values. } deriving (Eq, Ord, Show) diff --git a/src/Data/Abstract/Environment.hs b/src/Data/Abstract/Environment.hs index d408fb902..e3076cf63 100644 --- a/src/Data/Abstract/Environment.hs +++ b/src/Data/Abstract/Environment.hs @@ -35,32 +35,32 @@ import Prologue -- | A LIFO stack of maps of names to addresses, representing a lexically-scoped evaluation environment. -- All behaviors can be assumed to be frontmost-biased: looking up "a" will check the most specific -- scope for "a", then the next, and so on. -newtype Environment location = Environment { unEnvironment :: NonEmpty (Map.Map Name location) } +newtype Environment address = Environment { unEnvironment :: NonEmpty (Map.Map Name address) } deriving (Eq, Ord) -mergeEnvs :: Environment location -> Environment location -> Environment location +mergeEnvs :: Environment address -> Environment address -> Environment address mergeEnvs (Environment (a :| as)) (Environment (b :| bs)) = Environment ((<>) a b :| alignWith (mergeThese (<>)) as bs) -emptyEnv :: Environment location +emptyEnv :: Environment address emptyEnv = Environment (lowerBound :| []) -- | Make and enter a new empty scope in the given environment. -push :: Environment location -> Environment location +push :: Environment address -> Environment address push (Environment (a :| as)) = Environment (mempty :| a : as) -- | Remove the frontmost scope. -pop :: Environment location -> Environment location +pop :: Environment address -> Environment address pop (Environment (_ :| [])) = emptyEnv pop (Environment (_ :| a : as)) = Environment (a :| as) -- | Drop all scopes save for the frontmost one. -head :: Environment location -> Environment location +head :: Environment address -> Environment address head (Environment (a :| _)) = Environment (a :| []) -- | Take the union of two environments. When duplicate keys are found in the -- name to address map, the second definition wins. -mergeNewer :: Environment location -> Environment location -> Environment location +mergeNewer :: Environment address -> Environment address -> Environment address mergeNewer (Environment a) (Environment b) = Environment (NonEmpty.fromList . reverse $ alignWith (mergeThese combine) (reverse as) (reverse bs)) where @@ -72,45 +72,45 @@ mergeNewer (Environment a) (Environment b) = -- -- >>> pairs shadowed -- [("foo",Precise 1)] -pairs :: Environment location -> [(Name, location)] +pairs :: Environment address -> [(Name, address)] pairs = Map.toList . fold . unEnvironment -unpairs :: [(Name, location)] -> Environment location +unpairs :: [(Name, address)] -> Environment address unpairs = Environment . pure . Map.fromList -- | Lookup a 'Name' in the environment. -- -- >>> lookup (name "foo") shadowed -- Just (Precise 1) -lookup :: Name -> Environment location -> Maybe location +lookup :: Name -> Environment address -> Maybe address lookup name = foldMapA (Map.lookup name) . unEnvironment -- | Insert a 'Name' in the environment. -insert :: Name -> location -> Environment location -> Environment location +insert :: Name -> address -> Environment address -> Environment address insert name addr (Environment (a :| as)) = Environment (Map.insert name addr a :| as) -- | Remove a 'Name' from the environment. -- -- >>> delete (name "foo") shadowed -- Environment [] -delete :: Name -> Environment location -> Environment location +delete :: Name -> Environment address -> Environment address delete name = trim . Environment . fmap (Map.delete name) . unEnvironment -trim :: Environment location -> Environment location +trim :: Environment address -> Environment address trim (Environment (a :| as)) = Environment (a :| filtered) where filtered = filter (not . Map.null) as -intersect :: Foldable t => t Name -> Environment location -> Environment location +intersect :: Foldable t => t Name -> Environment address -> Environment address intersect names env = unpairs (mapMaybe lookupName (toList names)) where lookupName name = (,) name <$> lookup name env -- | Get all bound 'Name's in an environment. -names :: Environment location -> [Name] +names :: Environment address -> [Name] names = fmap fst . pairs -- | Lookup and alias name-value bindings from an environment. -overwrite :: [(Name, Name)] -> Environment location -> Environment location +overwrite :: [(Name, Name)] -> Environment address -> Environment address overwrite pairs env = unpairs $ mapMaybe lookupAndAlias pairs where lookupAndAlias (oldName, newName) = (,) newName <$> lookup oldName env @@ -118,14 +118,14 @@ overwrite pairs env = unpairs $ mapMaybe lookupAndAlias pairs -- | Retrieve the 'Live' set of addresses to which the given free variable names are bound. -- -- Unbound names are silently dropped. -roots :: (Ord location, Foldable t) => Environment location -> t Name -> Live location +roots :: (Ord address, Foldable t) => Environment address -> t Name -> Live address roots env names = addresses (names `intersect` env) -addresses :: Ord location => Environment location -> Live location +addresses :: Ord address => Environment address -> Live address addresses = fromAddresses . map snd . pairs -instance Lower (Environment location) where lowerBound = emptyEnv +instance Lower (Environment address) where lowerBound = emptyEnv -instance Show location => Show (Environment location) where +instance Show address => Show (Environment address) where showsPrec d = showsUnaryWith showsPrec "Environment" d . pairs diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 8b87f5dc6..ca2a5a611 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -44,61 +44,61 @@ import Prologue -- | 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 Evaluatable constr where - eval :: ( EvaluatableConstraints location term value effects + eval :: ( EvaluatableConstraints address term value effects , Member Fail effects ) - => SubtermAlgebra constr term (Evaluator location value effects (ValueRef value)) - default eval :: (Member (Resumable (Unspecialized value)) effects, Show1 constr) => SubtermAlgebra constr term (Evaluator location value effects (ValueRef value)) + => SubtermAlgebra constr term (Evaluator address value effects (ValueRef value)) + default eval :: (Member (Resumable (Unspecialized value)) effects, Show1 constr) => SubtermAlgebra constr term (Evaluator address value effects (ValueRef value)) eval expr = throwResumable (Unspecialized ("Eval unspecialized for " ++ liftShowsPrec (const (const id)) (const id) 0 expr "")) -type EvaluatableConstraints location term value effects = - ( AbstractValue location value effects +type EvaluatableConstraints address term value effects = + ( AbstractValue address value effects , Declarations term , FreeVariables term - , Member (Allocator location value) effects + , Member (Allocator address value) effects , Member (LoopControl value) effects - , Member (Modules location value) effects - , Member (Reader (Environment location)) effects + , Member (Modules address value) effects + , Member (Reader (Environment address)) effects , Member (Reader ModuleInfo) effects , Member (Reader PackageInfo) effects , Member (Reader Span) effects - , Member (Resumable (EnvironmentError location)) effects + , Member (Resumable (EnvironmentError address)) effects , Member (Resumable EvalError) effects , Member (Resumable ResolutionError) effects , Member (Resumable (Unspecialized value)) effects , Member (Return value) effects - , Member (State (Environment location)) effects - , Member (State (Exports location)) effects - , Member (State (Heap location (Cell location) value)) effects + , Member (State (Environment address)) effects + , Member (State (Exports address)) effects + , Member (State (Heap address (Cell address) value)) effects , Member Trace effects - , Ord location - , Reducer value (Cell location value) + , Ord address + , Reducer value (Cell address value) ) -- | Evaluate a given package. -evaluatePackageWith :: forall location term value inner outer - -- FIXME: It’d be nice if we didn’t have to mention 'Addressable' here at all, but 'Located' locations require knowledge of 'currentModule' to run. Can we fix that? If not, can we factor this effect list out? - . ( Addressable location (Reader ModuleInfo ': Modules location value ': Reader Span ': Reader PackageInfo ': outer) +evaluatePackageWith :: forall address term value inner outer + -- FIXME: It’d be nice if we didn’t have to mention 'Addressable' here at all, but 'Located' addresses require knowledge of 'currentModule' to run. Can we fix that? If not, can we factor this effect list out? + . ( Addressable address (Reader ModuleInfo ': Modules address value ': Reader Span ': Reader PackageInfo ': outer) , Evaluatable (Base term) - , EvaluatableConstraints location term value inner + , EvaluatableConstraints address term value inner , Member Fail outer , Member Fresh outer - , Member (Reader (Environment location)) outer - , Member (Resumable (AddressError location value)) outer - , Member (Resumable (LoadError location value)) outer - , Member (State (Environment location)) outer - , Member (State (Exports location)) outer - , Member (State (Heap location (Cell location) value)) outer - , Member (State (ModuleTable (Maybe (Environment location, value)))) outer + , Member (Reader (Environment address)) outer + , Member (Resumable (AddressError address value)) outer + , Member (Resumable (LoadError address value)) outer + , Member (State (Environment address)) outer + , Member (State (Exports address)) outer + , Member (State (Heap address (Cell address) value)) outer + , Member (State (ModuleTable (Maybe (Environment address, value)))) outer , Member Trace outer , Recursive term - , inner ~ (LoopControl value ': Return value ': Allocator location value ': Reader ModuleInfo ': Modules location value ': Reader Span ': Reader PackageInfo ': outer) + , inner ~ (LoopControl value ': Return value ': Allocator address value ': Reader ModuleInfo ': Modules address value ': Reader Span ': Reader PackageInfo ': outer) ) - => (SubtermAlgebra Module term (TermEvaluator term location value inner value) -> SubtermAlgebra Module term (TermEvaluator term location value inner value)) - -> (SubtermAlgebra (Base term) term (TermEvaluator term location value inner (ValueRef value)) -> SubtermAlgebra (Base term) term (TermEvaluator term location value inner (ValueRef value))) + => (SubtermAlgebra Module term (TermEvaluator term address value inner value) -> SubtermAlgebra Module term (TermEvaluator term address value inner value)) + -> (SubtermAlgebra (Base term) term (TermEvaluator term address value inner (ValueRef value)) -> SubtermAlgebra (Base term) term (TermEvaluator term address value inner (ValueRef value))) -> Package term - -> TermEvaluator term location value outer [value] + -> TermEvaluator term address value outer [value] evaluatePackageWith analyzeModule analyzeTerm package = runReader (packageInfo package) . runReader lowerBound @@ -120,7 +120,7 @@ evaluatePackageWith analyzeModule analyzeTerm package . raiseHandler runReturn . raiseHandler runLoopControl - evaluateEntryPoint :: ModulePath -> Maybe Name -> TermEvaluator term location value (Modules location value ': Reader Span ': Reader PackageInfo ': outer) value + evaluateEntryPoint :: ModulePath -> Maybe Name -> TermEvaluator term address value (Modules address value ': Reader Span ': Reader PackageInfo ': outer) value evaluateEntryPoint m sym = runInModule (ModuleInfo m) . TermEvaluator $ do v <- maybe unit snd <$> require m maybe (pure v) ((`call` []) <=< variable) sym @@ -144,10 +144,10 @@ evaluatePackageWith analyzeModule analyzeTerm package -- | Isolate the given action with an empty global environment and exports. -isolate :: (Member (State (Environment location)) effects, Member (State (Exports location)) effects) => Evaluator location value effects a -> Evaluator location value effects a +isolate :: (Member (State (Environment address)) effects, Member (State (Exports address)) effects) => Evaluator address value effects a -> Evaluator address value effects a isolate = withEnv lowerBound . withExports lowerBound -traceResolve :: (Show a, Show b, Member Trace effects) => a -> b -> Evaluator location value effects () +traceResolve :: (Show a, Show b, Member Trace effects) => a -> b -> Evaluator address value effects () traceResolve name path = trace ("resolved " <> show name <> " -> " <> show path) diff --git a/src/Data/Abstract/Exports.hs b/src/Data/Abstract/Exports.hs index 413b5fdef..f3df8174d 100644 --- a/src/Data/Abstract/Exports.hs +++ b/src/Data/Abstract/Exports.hs @@ -15,22 +15,22 @@ import Prelude hiding (null) import Prologue hiding (null) -- | A map of export names to an alias & address tuple. -newtype Exports location = Exports { unExports :: Map.Map Name (Name, Maybe location) } +newtype Exports address = Exports { unExports :: Map.Map Name (Name, Maybe address) } deriving (Eq, Lower, Monoid, Ord, Semigroup) -null :: Exports location -> Bool +null :: Exports address -> Bool null = Map.null . unExports -toEnvironment :: Exports location -> Environment location +toEnvironment :: Exports address -> Environment address toEnvironment exports = unpairs (mapMaybe sequenceA (toList (unExports exports))) -insert :: Name -> Name -> Maybe location -> Exports location -> Exports location +insert :: Name -> Name -> Maybe address -> Exports address -> Exports address insert name alias address = Exports . Map.insert name (alias, address) . unExports -- TODO: Should we filter for duplicates here? -aliases :: Exports location -> [(Name, Name)] +aliases :: Exports address -> [(Name, Name)] aliases = Map.toList . fmap fst . unExports -instance Show location => Show (Exports location) where +instance Show address => Show (Exports address) where showsPrec d = showsUnaryWith showsPrec "Exports" d . Map.toList . unExports diff --git a/src/Data/Abstract/Heap.hs b/src/Data/Abstract/Heap.hs index bc3bbce91..1b4aea41d 100644 --- a/src/Data/Abstract/Heap.hs +++ b/src/Data/Abstract/Heap.hs @@ -8,38 +8,38 @@ import Data.Semilattice.Lower import Prologue -- | A map of addresses onto cells holding their values. -newtype Heap location cell value = Heap { unHeap :: Monoidal.Map location (cell value) } +newtype Heap address cell value = Heap { unHeap :: Monoidal.Map address (cell value) } deriving (Eq, Foldable, Functor, Lower, Monoid, Ord, Semigroup, Traversable) -- | Look up the cell of values for an 'Address' in a 'Heap', if any. -heapLookup :: Ord location => location -> Heap location cell value -> Maybe (cell value) +heapLookup :: Ord address => address -> Heap address cell value -> Maybe (cell value) heapLookup address = Monoidal.lookup address . unHeap -- | Look up the list of values stored for a given address, if any. -heapLookupAll :: (Ord location, Foldable cell) => location -> Heap location cell value -> Maybe [value] +heapLookupAll :: (Ord address, Foldable cell) => address -> Heap address cell value -> Maybe [value] heapLookupAll address = fmap toList . heapLookup address -- | Append a value onto the cell for a given address, inserting a new cell if none existed. -heapInsert :: (Ord location, Reducer value (cell value)) => location -> value -> Heap location cell value -> Heap location cell value +heapInsert :: (Ord address, Reducer value (cell value)) => address -> value -> Heap address cell value -> Heap address cell value heapInsert address value = flip snoc (address, value) -- | Manually insert a cell into the heap at a given address. -heapInit :: Ord location => location -> cell value -> Heap location cell value -> Heap location cell value +heapInit :: Ord address => address -> cell value -> Heap address cell value -> Heap address cell value heapInit address cell (Heap h) = Heap (Monoidal.insert address cell h) -- | The number of addresses extant in a 'Heap'. -heapSize :: Heap location cell value -> Int +heapSize :: Heap address cell value -> Int heapSize = Monoidal.size . unHeap -- | Restrict a 'Heap' to only those addresses in the given 'Live' set (in essence garbage collecting the rest). -heapRestrict :: Ord location => Heap location cell value -> Live location -> Heap location cell value +heapRestrict :: Ord address => Heap address cell value -> Live address -> Heap address cell value heapRestrict (Heap m) roots = Heap (Monoidal.filterWithKey (\ address _ -> address `liveMember` roots) m) -instance (Ord location, Reducer value (cell value)) => Reducer (location, value) (Heap location cell value) where +instance (Ord address, Reducer value (cell value)) => Reducer (address, value) (Heap address cell value) where unit = Heap . unit cons (addr, a) (Heap heap) = Heap (cons (addr, a) heap) snoc (Heap heap) (addr, a) = Heap (snoc heap (addr, a)) -instance (Show location, Show (cell value)) => Show (Heap location cell value) where +instance (Show address, Show (cell value)) => Show (Heap address cell value) where showsPrec d = showsUnaryWith showsPrec "Heap" d . Monoidal.pairs . unHeap diff --git a/src/Data/Abstract/Live.hs b/src/Data/Abstract/Live.hs index 38b103cac..f75dedf1e 100644 --- a/src/Data/Abstract/Live.hs +++ b/src/Data/Abstract/Live.hs @@ -6,36 +6,36 @@ import Data.Set as Set import Prologue -- | A set of live addresses (whether roots or reachable). -newtype Live location = Live { unLive :: Set location } +newtype Live address = Live { unLive :: Set address } deriving (Eq, Lower, Monoid, Ord, Semigroup) -fromAddresses :: (Foldable t, Ord location) => t location -> Live location +fromAddresses :: (Foldable t, Ord address) => t address -> Live address fromAddresses = Prologue.foldr liveInsert lowerBound -- | Construct a 'Live' set containing only the given address. -liveSingleton :: location -> Live location +liveSingleton :: address -> Live address liveSingleton = Live . Set.singleton -- | Insert an address into a 'Live' set. -liveInsert :: Ord location => location -> Live location -> Live location +liveInsert :: Ord address => address -> Live address -> Live address liveInsert addr = Live . Set.insert addr . unLive -- | Delete an address from a 'Live' set, if present. -liveDelete :: Ord location => location -> Live location -> Live location +liveDelete :: Ord address => address -> Live address -> Live address liveDelete addr = Live . Set.delete addr . unLive -- | Compute the (asymmetric) difference of two 'Live' sets, i.e. delete every element of the second set from the first set. -liveDifference :: Ord location => Live location -> Live location -> Live location +liveDifference :: Ord address => Live address -> Live address -> Live address liveDifference = fmap Live . (Set.difference `on` unLive) -- | Test whether an address is in a 'Live' set. -liveMember :: Ord location => location -> Live location -> Bool +liveMember :: Ord address => address -> Live address -> Bool liveMember addr = Set.member addr . unLive -- | Decompose a 'Live' set into a pair of one member address and the remaining set, or 'Nothing' if empty. -liveSplit :: Live location -> Maybe (location, Live location) +liveSplit :: Live address -> Maybe (address, Live address) liveSplit = fmap (fmap Live) . Set.minView . unLive -instance Show location => Show (Live location) where +instance Show address => Show (Live address) where showsPrec d = showsUnaryWith showsPrec "Live" d . Set.toList . unLive diff --git a/src/Data/Abstract/Type.hs b/src/Data/Abstract/Type.hs index dd946b7ea..ea16910f2 100644 --- a/src/Data/Abstract/Type.hs +++ b/src/Data/Abstract/Type.hs @@ -94,7 +94,7 @@ unify t1 t2 | t1 == t2 = pure t2 | otherwise = throwResumable (UnificationError t1 t2) -instance Ord location => ValueRoots location Type where +instance Ord address => ValueRoots address Type where valueRoots _ = mempty @@ -116,16 +116,16 @@ instance AbstractIntro Type where null = Null -instance ( Member (Allocator location Type) effects +instance ( Member (Allocator address Type) effects , Member Fresh effects , Member (Resumable TypeError) effects , Member (Return Type) effects - , Member (State (Environment location)) effects - , Member (State (Heap location (Cell location) Type)) effects - , Ord location - , Reducer Type (Cell location Type) + , Member (State (Environment address)) effects + , Member (State (Heap address (Cell address) Type)) effects + , Ord address + , Reducer Type (Cell address Type) ) - => AbstractFunction location Type effects where + => AbstractFunction address Type effects where closure names _ body = do (env, tvars) <- foldr (\ name rest -> do a <- alloc name @@ -145,17 +145,17 @@ instance ( Member (Allocator location Type) effects -- | Discard the value arguments (if any), constructing a 'Type' instead. -instance ( Member (Allocator location Type) effects +instance ( Member (Allocator address Type) effects , Member Fresh effects , Member NonDet effects , Member (Resumable TypeError) effects , Member (Return Type) effects - , Member (State (Environment location)) effects - , Member (State (Heap location (Cell location) Type)) effects - , Ord location - , Reducer Type (Cell location Type) + , Member (State (Environment address)) effects + , Member (State (Heap address (Cell address) Type)) effects + , Ord address + , Reducer Type (Cell address Type) ) - => AbstractValue location Type effects where + => AbstractValue address Type effects where array fields = do var <- fresh Array <$> foldr (\ t1 -> (unify t1 =<<)) (pure (Var var)) fields diff --git a/src/Data/Abstract/Value.hs b/src/Data/Abstract/Value.hs index 9fd0c70a0..493bc455f 100644 --- a/src/Data/Abstract/Value.hs +++ b/src/Data/Abstract/Value.hs @@ -14,8 +14,8 @@ import Data.Semigroup.Reducer import qualified Data.Set as Set import Prologue -data Value location body - = Closure PackageInfo ModuleInfo [Name] (ClosureBody location body) (Environment location) +data Value address body + = Closure PackageInfo ModuleInfo [Name] (ClosureBody address body) (Environment address) | Unit | Boolean Bool | Integer (Number.Number Integer) @@ -23,51 +23,51 @@ data Value location body | Float (Number.Number Scientific) | String ByteString | Symbol ByteString - | Tuple [Value location body] - | Array [Value location body] - | Class Name (Environment location) - | Namespace Name (Environment location) - | KVPair (Value location body) (Value location body) - | Hash [Value location body] + | Tuple [Value address body] + | Array [Value address body] + | Class Name (Environment address) + | Namespace Name (Environment address) + | KVPair (Value address body) (Value address body) + | Hash [Value address body] | Null | Hole deriving (Eq, Ord, Show) -data ClosureBody location body = ClosureBody { closureBodyId :: Int, closureBody :: body (Value location body) } +data ClosureBody address body = ClosureBody { closureBodyId :: Int, closureBody :: body (Value address body) } -instance Eq (ClosureBody location body) where +instance Eq (ClosureBody address body) where (==) = (==) `on` closureBodyId -instance Ord (ClosureBody location body) where +instance Ord (ClosureBody address body) where compare = compare `on` closureBodyId -instance Show (ClosureBody location body) where +instance Show (ClosureBody address body) where showsPrec d (ClosureBody i _) = showsBinaryWith showsPrec (const showChar) "ClosureBody" d i '_' -instance Ord location => ValueRoots location (Value location body) where +instance Ord address => ValueRoots address (Value address body) where valueRoots v | Closure _ _ _ _ env <- v = Env.addresses env | otherwise = mempty -instance AbstractHole (Value location body) where +instance AbstractHole (Value address body) where hole = Hole instance ( Coercible body (Eff effects) - , Member (Allocator location (Value location body)) effects + , Member (Allocator address (Value address body)) effects , Member Fresh effects , Member (Reader ModuleInfo) effects , Member (Reader PackageInfo) effects - , Member (Resumable (ValueError location body)) effects - , Member (Return (Value location body)) effects - , Member (State (Environment location)) effects - , Member (State (Heap location (Cell location) (Value location body))) effects - , Ord location - , Reducer (Value location body) (Cell location (Value location body)) - , Show location + , Member (Resumable (ValueError address body)) effects + , Member (Return (Value address body)) effects + , Member (State (Environment address)) effects + , Member (State (Heap address (Cell address) (Value address body))) effects + , Ord address + , Reducer (Value address body) (Cell address (Value address body)) + , Show address ) - => AbstractFunction location (Value location body) effects where + => AbstractFunction address (Value address body) effects where closure parameters freeVariables body = do packageInfo <- currentPackage moduleInfo <- currentModule @@ -89,7 +89,7 @@ instance ( Coercible body (Eff effects) _ -> throwValueError (CallError op) -instance Show location => AbstractIntro (Value location body) where +instance Show address => AbstractIntro (Value address body) where unit = Unit integer = Integer . Number.Integer boolean = Boolean @@ -108,21 +108,21 @@ instance Show location => AbstractIntro (Value location body) where -- | Construct a 'Value' wrapping the value arguments (if any). instance ( Coercible body (Eff effects) - , Member (Allocator location (Value location body)) effects + , Member (Allocator address (Value address body)) effects , Member Fresh effects - , Member (LoopControl (Value location body)) effects - , Member (Reader (Environment location)) effects + , Member (LoopControl (Value address body)) effects + , Member (Reader (Environment address)) effects , Member (Reader ModuleInfo) effects , Member (Reader PackageInfo) effects - , Member (Resumable (ValueError location body)) effects - , Member (Return (Value location body)) effects - , Member (State (Environment location)) effects - , Member (State (Heap location (Cell location) (Value location body))) effects - , Ord location - , Reducer (Value location body) (Cell location (Value location body)) - , Show location + , Member (Resumable (ValueError address body)) effects + , Member (Return (Value address body)) effects + , Member (State (Environment address)) effects + , Member (State (Heap address (Cell address) (Value address body))) effects + , Ord address + , Reducer (Value address body) (Cell address (Value address body)) + , Show address ) - => AbstractValue location (Value location body) effects where + => AbstractValue address (Value address body) effects where asPair val | KVPair k v <- val = pure (k, v) | otherwise = throwValueError $ KeyValueError val @@ -185,7 +185,7 @@ instance ( Coercible body (Eff effects) tentative x i j = attemptUnsafeArithmetic (x i j) -- Dispatch whatever's contained inside a 'Number.SomeNumber' to its appropriate 'MonadValue' ctor - specialize :: (AbstractValue location (Value location body) effects, Member (Resumable (ValueError location body)) effects) => Either ArithException Number.SomeNumber -> Evaluator location (Value location body) effects (Value location body) + specialize :: (AbstractValue address (Value address body) effects, Member (Resumable (ValueError address body)) effects) => Either ArithException Number.SomeNumber -> Evaluator address (Value address body) effects (Value address body) specialize (Left exc) = throwValueError (ArithmeticError exc) specialize (Right (Number.SomeNumber (Number.Integer i))) = pure $ integer i specialize (Right (Number.SomeNumber (Number.Ratio r))) = pure $ rational r @@ -204,7 +204,7 @@ instance ( Coercible body (Eff effects) where -- Explicit type signature is necessary here because we're passing all sorts of things -- to these comparison functions. - go :: (AbstractValue location (Value location body) effects, Ord a) => a -> a -> Evaluator location (Value location body) effects (Value location body) + go :: (AbstractValue address (Value address body) effects, Ord a) => a -> a -> Evaluator address (Value address body) effects (Value address body) go l r = case comparator of Concrete f -> pure $ boolean (f l r) Generalized -> pure $ integer (orderingToInt (compare l r)) @@ -232,25 +232,25 @@ instance ( Coercible body (Eff effects) -- | The type of exceptions that can be thrown when constructing values in 'Value'’s 'MonadValue' instance. -data ValueError location body resume where - StringError :: Value location body -> ValueError location body ByteString - BoolError :: Value location body -> ValueError location body Bool - IndexError :: Value location body -> Value location body -> ValueError location body (Value location body) - NamespaceError :: Prelude.String -> ValueError location body (Environment location) - CallError :: Value location body -> ValueError location body (Value location body) - NumericError :: Value location body -> ValueError location body (Value location body) - Numeric2Error :: Value location body -> Value location body -> ValueError location body (Value location body) - ComparisonError :: Value location body -> Value location body -> ValueError location body (Value location body) - BitwiseError :: Value location body -> ValueError location body (Value location body) - Bitwise2Error :: Value location body -> Value location body -> ValueError location body (Value location body) - KeyValueError :: Value location body -> ValueError location body (Value location body, Value location body) +data ValueError address body resume where + StringError :: Value address body -> ValueError address body ByteString + BoolError :: Value address body -> ValueError address body Bool + IndexError :: Value address body -> Value address body -> ValueError address body (Value address body) + NamespaceError :: Prelude.String -> ValueError address body (Environment address) + CallError :: Value address body -> ValueError address body (Value address body) + NumericError :: Value address body -> ValueError address body (Value address body) + Numeric2Error :: Value address body -> Value address body -> ValueError address body (Value address body) + ComparisonError :: Value address body -> Value address body -> ValueError address body (Value address body) + BitwiseError :: Value address body -> ValueError address body (Value address body) + Bitwise2Error :: Value address body -> Value address body -> ValueError address body (Value address body) + KeyValueError :: Value address body -> ValueError address body (Value address body, Value address body) -- Indicates that we encountered an arithmetic exception inside Haskell-native number crunching. - ArithmeticError :: ArithException -> ValueError location body (Value location body) + ArithmeticError :: ArithException -> ValueError address body (Value address body) -- Out-of-bounds error - BoundsError :: [Value location body] -> Prelude.Integer -> ValueError location body (Value location body) + BoundsError :: [Value address body] -> Prelude.Integer -> ValueError address body (Value address body) -instance Eq location => Eq1 (ValueError location body) where +instance Eq address => Eq1 (ValueError address body) where liftEq _ (StringError a) (StringError b) = a == b liftEq _ (NamespaceError a) (NamespaceError b) = a == b liftEq _ (CallError a) (CallError b) = a == b @@ -264,15 +264,15 @@ instance Eq location => Eq1 (ValueError location body) where liftEq _ (BoundsError a b) (BoundsError c d) = (a == c) && (b == d) liftEq _ _ _ = False -deriving instance Show location => Show (ValueError location body resume) -instance Show location => Show1 (ValueError location body) where +deriving instance Show address => Show (ValueError address body resume) +instance Show address => Show1 (ValueError address body) where liftShowsPrec _ _ = showsPrec -throwValueError :: Member (Resumable (ValueError location body)) effects => ValueError location body resume -> Evaluator location (Value location body) effects resume +throwValueError :: Member (Resumable (ValueError address body)) effects => ValueError address body resume -> Evaluator address (Value address body) effects resume throwValueError = throwResumable -runValueError :: Effectful (m location (Value location body)) => m location (Value location body) (Resumable (ValueError location body) ': effects) a -> m location (Value location body) effects (Either (SomeExc (ValueError location body)) a) +runValueError :: Effectful (m address (Value address body)) => m address (Value address body) (Resumable (ValueError address body) ': effects) a -> m address (Value address body) effects (Either (SomeExc (ValueError address body)) a) runValueError = runResumable -runValueErrorWith :: Effectful (m location (Value location body)) => (forall resume . ValueError location body resume -> m location (Value location body) effects resume) -> m location (Value location body) (Resumable (ValueError location body) ': effects) a -> m location (Value location body) effects a +runValueErrorWith :: Effectful (m address (Value address body)) => (forall resume . ValueError address body resume -> m address (Value address body) effects resume) -> m address (Value address body) (Resumable (ValueError address body) ': effects) a -> m address (Value address body) effects a runValueErrorWith = runResumableWith diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index af200e6dc..b7ca2ab16 100644 --- a/src/Language/Go/Syntax.hs +++ b/src/Language/Go/Syntax.hs @@ -28,14 +28,14 @@ importPath str = let path = stripQuotes str in ImportPath (BC.unpack path) (path defaultAlias :: ImportPath -> Name defaultAlias = name . BC.pack . takeFileName . unPath -resolveGoImport :: ( Member (Modules location value) effects +resolveGoImport :: ( Member (Modules address value) effects , Member (Reader ModuleInfo) effects , Member (Reader Package.PackageInfo) effects , Member (Resumable ResolutionError) effects , Member Trace effects ) => ImportPath - -> Evaluator location value effects [ModulePath] + -> Evaluator address value effects [ModulePath] resolveGoImport (ImportPath path Relative) = do ModuleInfo{..} <- currentModule paths <- listModulesInDir (joinPaths (takeDirectory modulePath) path) diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index e150d6016..66d023d6e 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -41,30 +41,30 @@ instance Evaluatable VariableName -- file, the complete contents of the included file are treated as though it -- were defined inside that function. -resolvePHPName :: ( Member (Modules location value) effects +resolvePHPName :: ( Member (Modules address value) effects , Member (Resumable ResolutionError) effects ) => ByteString - -> Evaluator location value effects ModulePath + -> Evaluator address value effects ModulePath resolvePHPName n = do modulePath <- resolve [name] maybe (throwResumable $ NotFoundError name [name] Language.PHP) pure modulePath where name = toName n toName = BC.unpack . dropRelativePrefix . stripQuotes -include :: ( AbstractValue location value effects - , Member (Allocator location value) effects - , Member (Modules location value) effects - , Member (Reader (Environment location)) effects +include :: ( AbstractValue address value effects + , Member (Allocator address value) effects + , Member (Modules address value) effects + , Member (Reader (Environment address)) effects , Member (Resumable ResolutionError) effects - , Member (Resumable (EnvironmentError location)) effects - , Member (State (Environment location)) effects - , Member (State (Exports location)) effects + , Member (Resumable (EnvironmentError address)) effects + , Member (State (Environment address)) effects + , Member (State (Exports address)) effects , Member Trace effects ) - => Subterm term (Evaluator location value effects (ValueRef value)) - -> (ModulePath -> Evaluator location value effects (Maybe (Environment location, value))) - -> Evaluator location value effects (ValueRef value) + => Subterm term (Evaluator address value effects (ValueRef value)) + -> (ModulePath -> Evaluator address value effects (Maybe (Environment address, value))) + -> Evaluator address value effects (ValueRef value) include pathTerm f = do name <- subtermValue pathTerm >>= asString path <- resolvePHPName name diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index a6899b1f0..03593fb99 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -51,13 +51,13 @@ relativeQualifiedName prefix paths = RelativeQualifiedName (BC.unpack prefix) (J -- Subsequent imports of `parent.two` or `parent.three` will execute -- `parent/two/__init__.py` and -- `parent/three/__init__.py` respectively. -resolvePythonModules :: ( Member (Modules location value) effects +resolvePythonModules :: ( Member (Modules address value) effects , Member (Reader ModuleInfo) effects , Member (Resumable ResolutionError) effects , Member Trace effects ) => QualifiedName - -> Evaluator location value effects (NonEmpty ModulePath) + -> Evaluator address value effects (NonEmpty ModulePath) resolvePythonModules q = do relRootDir <- rootDir q <$> currentModule for (moduleNames q) $ \name -> do @@ -126,17 +126,17 @@ instance Evaluatable Import where -- Evaluate a qualified import -evalQualifiedImport :: ( AbstractValue location value effects - , Member (Allocator location value) effects - , Member (Modules location value) effects - , Member (Reader (Environment location)) effects - , Member (State (Environment location)) effects - , Member (State (Exports location)) effects - , Member (State (Heap location (Cell location) value)) effects - , Ord location - , Reducer.Reducer value (Cell location value) +evalQualifiedImport :: ( AbstractValue address value effects + , Member (Allocator address value) effects + , Member (Modules address value) effects + , Member (Reader (Environment address)) effects + , Member (State (Environment address)) effects + , Member (State (Exports address)) effects + , Member (State (Heap address (Cell address) value)) effects + , Ord address + , Reducer.Reducer value (Cell address value) ) - => Name -> ModulePath -> Evaluator location value effects value + => Name -> ModulePath -> Evaluator address value effects value evalQualifiedImport name path = letrec' name $ \addr -> do importedEnv <- maybe emptyEnv fst <$> isolate (require path) bindAll importedEnv diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index 1cf25970a..862d41eb7 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -17,11 +17,11 @@ import System.FilePath.Posix -- TODO: Fully sort out ruby require/load mechanics -- -- require "json" -resolveRubyName :: ( Member (Modules location value) effects +resolveRubyName :: ( Member (Modules address value) effects , Member (Resumable ResolutionError) effects ) => ByteString - -> Evaluator location value effects M.ModulePath + -> Evaluator address value effects M.ModulePath resolveRubyName name = do let name' = cleanNameOrPath name let paths = [name' <.> "rb"] @@ -29,11 +29,11 @@ resolveRubyName name = do maybe (throwResumable $ NotFoundError name' paths Language.Ruby) pure modulePath -- load "/root/src/file.rb" -resolveRubyPath :: ( Member (Modules location value) effects +resolveRubyPath :: ( Member (Modules address value) effects , Member (Resumable ResolutionError) effects ) => ByteString - -> Evaluator location value effects M.ModulePath + -> Evaluator address value effects M.ModulePath resolveRubyPath path = do let name' = cleanNameOrPath path modulePath <- resolve [name'] @@ -77,11 +77,11 @@ instance Evaluatable Require where bindAll importedEnv pure (Rval v) -- Returns True if the file was loaded, False if it was already loaded. http://ruby-doc.org/core-2.5.0/Kernel.html#method-i-require -doRequire :: ( AbstractValue location value effects - , Member (Modules location value) effects +doRequire :: ( AbstractValue address value effects + , Member (Modules address value) effects ) => M.ModulePath - -> Evaluator location value effects (Environment location, value) + -> Evaluator address value effects (Environment address, value) doRequire path = do result <- join <$> lookupModule path case result of @@ -108,16 +108,16 @@ instance Evaluatable Load where Rval <$> doLoad path shouldWrap eval (Load _) = raiseEff (fail "invalid argument supplied to load, path is required") -doLoad :: ( AbstractValue location value effects - , Member (Modules location value) effects +doLoad :: ( AbstractValue address value effects + , Member (Modules address value) effects , Member (Resumable ResolutionError) effects - , Member (State (Environment location)) effects - , Member (State (Exports location)) effects + , Member (State (Environment address)) effects + , Member (State (Exports address)) effects , Member Trace effects ) => ByteString -> Bool - -> Evaluator location value effects value + -> Evaluator address value effects value doLoad path shouldWrap = do path' <- resolveRubyPath path traceResolve path path' diff --git a/src/Language/TypeScript/Syntax.hs b/src/Language/TypeScript/Syntax.hs index ad3369522..6260cbc6b 100644 --- a/src/Language/TypeScript/Syntax.hs +++ b/src/Language/TypeScript/Syntax.hs @@ -37,7 +37,7 @@ toName = name . BC.pack . unPath -- -- NB: TypeScript has a couple of different strategies, but the main one (and the -- only one we support) mimics Node.js. -resolveWithNodejsStrategy :: ( Member (Modules location value) effects +resolveWithNodejsStrategy :: ( Member (Modules address value) effects , Member (Reader M.ModuleInfo) effects , Member (Reader PackageInfo) effects , Member (Resumable ResolutionError) effects @@ -45,7 +45,7 @@ resolveWithNodejsStrategy :: ( Member (Modules location value) effects ) => ImportPath -> [String] - -> Evaluator location value effects M.ModulePath + -> Evaluator address value effects M.ModulePath resolveWithNodejsStrategy (ImportPath path Relative) exts = resolveRelativePath path exts resolveWithNodejsStrategy (ImportPath path NonRelative) exts = resolveNonRelativePath path exts @@ -56,7 +56,7 @@ resolveWithNodejsStrategy (ImportPath path NonRelative) exts = resolveNonRelativ -- /root/src/moduleB.ts -- /root/src/moduleB/package.json (if it specifies a "types" property) -- /root/src/moduleB/index.ts -resolveRelativePath :: ( Member (Modules location value) effects +resolveRelativePath :: ( Member (Modules address value) effects , Member (Reader M.ModuleInfo) effects , Member (Reader PackageInfo) effects , Member (Resumable ResolutionError) effects @@ -64,7 +64,7 @@ resolveRelativePath :: ( Member (Modules location value) effects ) => FilePath -> [String] - -> Evaluator location value effects M.ModulePath + -> Evaluator address value effects M.ModulePath resolveRelativePath relImportPath exts = do M.ModuleInfo{..} <- currentModule let relRootDir = takeDirectory modulePath @@ -84,7 +84,7 @@ resolveRelativePath relImportPath exts = do -- -- /root/node_modules/moduleB.ts, etc -- /node_modules/moduleB.ts, etc -resolveNonRelativePath :: ( Member (Modules location value) effects +resolveNonRelativePath :: ( Member (Modules address value) effects , Member (Reader M.ModuleInfo) effects , Member (Reader PackageInfo) effects , Member (Resumable ResolutionError) effects @@ -92,7 +92,7 @@ resolveNonRelativePath :: ( Member (Modules location value) effects ) => FilePath -> [String] - -> Evaluator location value effects M.ModulePath + -> Evaluator address value effects M.ModulePath resolveNonRelativePath name exts = do M.ModuleInfo{..} <- currentModule go "." modulePath mempty @@ -109,13 +109,13 @@ resolveNonRelativePath name exts = do notFound xs = throwResumable $ NotFoundError name xs Language.TypeScript -- | Resolve a module name to a ModulePath. -resolveModule :: ( Member (Modules location value) effects +resolveModule :: ( Member (Modules address value) effects , Member (Reader PackageInfo) effects , Member Trace effects ) => FilePath -- ^ Module path used as directory to search in -> [String] -- ^ File extensions to look for - -> Evaluator location value effects (Either [FilePath] M.ModulePath) + -> Evaluator address value effects (Either [FilePath] M.ModulePath) resolveModule path' exts = do let path = makeRelative "." path' PackageInfo{..} <- currentPackage @@ -132,19 +132,19 @@ typescriptExtensions = ["ts", "tsx", "d.ts"] javascriptExtensions :: [String] javascriptExtensions = ["js"] -evalRequire :: ( AbstractValue location value effects - , Member (Allocator location value) effects - , Member (Modules location value) effects - , Member (Reader (Environment location)) effects - , Member (State (Environment location)) effects - , Member (State (Exports location)) effects - , Member (State (Heap location (Cell location) value)) effects - , Ord location - , Reducer value (Cell location value) +evalRequire :: ( AbstractValue address value effects + , Member (Allocator address value) effects + , Member (Modules address value) effects + , Member (Reader (Environment address)) effects + , Member (State (Environment address)) effects + , Member (State (Exports address)) effects + , Member (State (Heap address (Cell address) value)) effects + , Ord address + , Reducer value (Cell address value) ) => M.ModulePath -> Name - -> Evaluator location value effects value + -> Evaluator address value effects value evalRequire modulePath alias = letrec' alias $ \addr -> do importedEnv <- maybe emptyEnv fst <$> isolate (require modulePath) bindAll importedEnv diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 51de9ae49..32f2c0be4 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -100,8 +100,8 @@ parseModule parser rootDir file = do withTermSpans :: ( HasField fields Span , Member (Reader Span) effects ) - => SubtermAlgebra (TermF syntax (Record fields)) term (TermEvaluator term location value effects a) - -> SubtermAlgebra (TermF syntax (Record fields)) term (TermEvaluator term location value effects a) + => SubtermAlgebra (TermF syntax (Record fields)) term (TermEvaluator term address value effects a) + -> SubtermAlgebra (TermF syntax (Record fields)) term (TermEvaluator term address value effects a) withTermSpans recur term = withCurrentSpan (getField (termFAnnotation term)) (recur term) resumingResolutionError :: (Applicative (m effects), Effectful m, Member Trace effects) => m (Resumable ResolutionError ': effects) a -> m effects a @@ -109,10 +109,10 @@ resumingResolutionError = runResolutionErrorWith (\ err -> trace ("ResolutionErr NotFoundError nameToResolve _ _ -> pure nameToResolve GoImportError pathToResolve -> pure [pathToResolve]) -resumingLoadError :: Member Trace effects => Evaluator location value (Resumable (LoadError location value) ': effects) a -> Evaluator location value effects a +resumingLoadError :: Member Trace effects => Evaluator address value (Resumable (LoadError address value) ': effects) a -> Evaluator address value effects a resumingLoadError = runLoadErrorWith (\ (ModuleNotFound path) -> trace ("LoadError: " <> path) $> Nothing) -resumingEvalError :: Member Trace effects => Evaluator location value (Resumable EvalError ': effects) a -> Evaluator location value effects a +resumingEvalError :: Member Trace effects => Evaluator address value (Resumable EvalError ': effects) a -> Evaluator address value effects a resumingEvalError = runEvalErrorWith (\ err -> trace ("EvalError" <> show err) *> case err of DefaultExportError{} -> pure () ExportError{} -> pure () @@ -121,15 +121,15 @@ resumingEvalError = runEvalErrorWith (\ err -> trace ("EvalError" <> show err) * RationalFormatError{} -> pure 0 FreeVariablesError names -> pure (fromMaybeLast "unknown" names)) -resumingUnspecialized :: (Member Trace effects, AbstractHole value) => Evaluator location value (Resumable (Unspecialized value) ': effects) a -> Evaluator location value effects a +resumingUnspecialized :: (Member Trace effects, AbstractHole value) => Evaluator address value (Resumable (Unspecialized value) ': effects) a -> Evaluator address value effects a resumingUnspecialized = runUnspecializedWith (\ err@(Unspecialized _) -> trace ("Unspecialized:" <> show err) $> Rval hole) -resumingAddressError :: (AbstractHole value, Lower (Cell location value), Member Trace effects, Show location) => Evaluator location value (Resumable (AddressError location value) ': effects) a -> Evaluator location value effects a +resumingAddressError :: (AbstractHole value, Lower (Cell address value), Member Trace effects, Show address) => Evaluator address value (Resumable (AddressError address value) ': effects) a -> Evaluator address value effects a resumingAddressError = runAddressErrorWith (\ err -> trace ("AddressError:" <> show err) *> case err of UnallocatedAddress _ -> pure lowerBound UninitializedAddress _ -> pure hole) -resumingValueError :: (Member (State (Environment location)) effects, Member Trace effects, Show location) => Evaluator location (Value location body) (Resumable (ValueError location body) ': effects) a -> Evaluator location (Value location body) effects a +resumingValueError :: (Member (State (Environment address)) effects, Member Trace effects, Show address) => Evaluator address (Value address body) (Resumable (ValueError address body) ': effects) a -> Evaluator address (Value address body) effects a resumingValueError = runValueErrorWith (\ err -> trace ("ValueError" <> show err) *> case err of CallError val -> pure val StringError val -> pure (pack (show val)) @@ -145,7 +145,7 @@ resumingValueError = runValueErrorWith (\ err -> trace ("ValueError" <> show err KeyValueError{} -> pure (hole, hole) ArithmeticError{} -> pure hole) -resumingEnvironmentError :: AbstractHole location => Evaluator location value (Resumable (EnvironmentError location) ': effects) a -> Evaluator location value effects (a, [Name]) +resumingEnvironmentError :: AbstractHole address => Evaluator address value (Resumable (EnvironmentError address) ': effects) a -> Evaluator address value effects (a, [Name]) resumingEnvironmentError = runState [] . reinterpret (\ (Resumable (FreeVariable name)) -> modify' (name :) $> hole) diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs index 2781e3fc5..bd86a3f49 100644 --- a/src/Semantic/Task.hs +++ b/src/Semantic/Task.hs @@ -104,7 +104,7 @@ parse :: Member Task effs => Parser term -> Blob -> Eff effs term parse parser = send . Parse parser -- | A task running some 'Analysis.TermEvaluator' to completion. -analyze :: Member Task effs => (Analysis.TermEvaluator term location value effects a -> result) -> Analysis.TermEvaluator term location value effects a -> Eff effs result +analyze :: Member Task effs => (Analysis.TermEvaluator term address value effects a -> result) -> Analysis.TermEvaluator term address value effects a -> Eff effs result analyze interpret analysis = send (Analyze interpret analysis) -- | A task which decorates a 'Term' with values computed using the supplied 'RAlgebra' function. @@ -160,7 +160,7 @@ runTraceInTelemetry = interpret (\ (Trace str) -> writeLog Debug str []) -- | An effect describing high-level tasks to be performed. data Task output where Parse :: Parser term -> Blob -> Task term - Analyze :: (Analysis.TermEvaluator term location value effects a -> result) -> Analysis.TermEvaluator term location value effects a -> Task result + Analyze :: (Analysis.TermEvaluator term address value effects a -> result) -> Analysis.TermEvaluator term address value effects a -> Task result Decorate :: Functor f => RAlgebra (TermF f (Record fields)) (Term f (Record fields)) field -> Term f (Record fields) -> Task (Term f (Record (field ': fields))) Diff :: (Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax) => These (Term syntax (Record fields1)) (Term syntax (Record fields2)) -> Task (Diff syntax (Record fields1) (Record fields2)) Render :: Renderer input output -> input -> Task output From 52e8502970bbb7803439b80d1054710ade3506d7 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Wed, 30 May 2018 10:03:40 -0400 Subject: [PATCH 143/148] =?UTF-8?q?Rename=20Located=E2=80=99s=20fields=20t?= =?UTF-8?q?o=20address=E2=80=A6.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Analysis/Abstract/Graph.hs | 2 +- src/Data/Abstract/Address.hs | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs index aa847a808..970b7cef3 100644 --- a/src/Analysis/Abstract/Graph.hs +++ b/src/Analysis/Abstract/Graph.hs @@ -128,7 +128,7 @@ variableDefinition :: ( Member (Reader (Environment (Hole (Located address)))) e => Name -> TermEvaluator term (Hole (Located address)) value effects () variableDefinition name = do - graph <- maybe lowerBound (maybe lowerBound (vertex . moduleVertex . locationModule) . toMaybe) <$> TermEvaluator (lookupEnv name) + graph <- maybe lowerBound (maybe lowerBound (vertex . moduleVertex . addressModule) . toMaybe) <$> TermEvaluator (lookupEnv name) appendGraph (vertex (Variable (unName name)) `connect` graph) appendGraph :: (Effectful m, Member (State (Graph Vertex)) effects) => Graph Vertex -> m effects () diff --git a/src/Data/Abstract/Address.hs b/src/Data/Abstract/Address.hs index 112098b38..d5eb863ff 100644 --- a/src/Data/Abstract/Address.hs +++ b/src/Data/Abstract/Address.hs @@ -27,9 +27,9 @@ instance Show Monovariant where data Located address = Located - { location :: address - , locationPackage :: {-# UNPACK #-} !PackageInfo - , locationModule :: !ModuleInfo + { address :: address + , addressPackage :: {-# UNPACK #-} !PackageInfo + , addressModule :: !ModuleInfo } deriving (Eq, Ord, Show) From cc3a6c1a520d91c8b208a82185072defbe60b1b7 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Wed, 30 May 2018 09:39:38 -0700 Subject: [PATCH 144/148] :fire: ConstructorLabel and constructorLabel --- src/Analysis/ConstructorName.hs | 21 ------------- src/Data/JSON/Fields.hs | 54 +++++++++++++++++++++++---------- src/Semantic/Diff.hs | 4 +-- src/Semantic/Parse.hs | 4 +-- 4 files changed, 42 insertions(+), 41 deletions(-) diff --git a/src/Analysis/ConstructorName.hs b/src/Analysis/ConstructorName.hs index 678c883d0..df233b44f 100644 --- a/src/Analysis/ConstructorName.hs +++ b/src/Analysis/ConstructorName.hs @@ -1,32 +1,11 @@ {-# LANGUAGE ScopedTypeVariables, TypeFamilies, TypeOperators, UndecidableInstances #-} module Analysis.ConstructorName ( ConstructorName(..) -, ConstructorLabel(..) -, constructorLabel ) where -import Data.Aeson -import Data.ByteString.Char8 (ByteString, pack, unpack) -import Data.JSON.Fields import Data.Sum -import Data.Term -import Data.Text.Encoding (decodeUtf8) import Prologue --- | Compute a 'ConstructorLabel' label for a 'Term'. -constructorLabel :: ConstructorName syntax => TermF syntax a b -> ConstructorLabel -constructorLabel (In _ s) = ConstructorLabel $ pack (constructorName s) - - -newtype ConstructorLabel = ConstructorLabel { unConstructorLabel :: ByteString } - -instance Show ConstructorLabel where - showsPrec _ (ConstructorLabel s) = showString (unpack s) - -instance ToJSONFields ConstructorLabel where - toJSONFields (ConstructorLabel s) = [ "term" .= decodeUtf8 s ] - - -- | A typeclass to retrieve the name of the data constructor for a value. -- -- This typeclass employs the Advanced Overlap techniques designed by Oleg Kiselyov & Simon Peyton Jones: https://wiki.haskell.org/GHC/AdvancedOverlap; see also src/Analysis/Declaration.hs for discussion of the details of the mechanism. diff --git a/src/Data/JSON/Fields.hs b/src/Data/JSON/Fields.hs index bf144c508..99690b9cf 100644 --- a/src/Data/JSON/Fields.hs +++ b/src/Data/JSON/Fields.hs @@ -21,8 +21,9 @@ class ToJSONFields a where class ToJSONFields1 f where toJSONFields1 :: (KeyValue kv, ToJSON a) => f a -> [kv] - default toJSONFields1 :: (KeyValue kv, ToJSON a, GToJSONFields1 (Rep1 f), Generic1 f) => f a -> [kv] - toJSONFields1 = gtoJSONFields1 . from1 + default toJSONFields1 :: (KeyValue kv, ToJSON a, GToJSONFields1 (Rep1 f), GConstructorName1 (Rep1 f), Generic1 f) => f a -> [kv] + toJSONFields1 s = let r = from1 s in + "term" .= gconstructorName1 r : gtoJSONFields1 r withChildren :: (KeyValue kv, ToJSON a, Foldable f) => f a -> [kv] -> [kv] withChildren f ks = ("children" .= toList f) : ks @@ -72,6 +73,25 @@ instance (ToJSON a, ToJSONFields1 f) => ToJSON (JSONFields1 f a) where toEncoding = pairs . mconcat . toJSONFields1 . unJSONFields1 +-- | A typeclass to retrieve the name of a data constructor. +class GConstructorName1 f where + gconstructorName1 :: f a -> String + +instance Apply GConstructorName1 fs => GConstructorName1 (Sum fs) where + gconstructorName1 = apply @GConstructorName1 gconstructorName1 + +instance GConstructorName1 f => GConstructorName1 (M1 D c f) where + gconstructorName1 = gconstructorName1 . unM1 + +instance Constructor c => GConstructorName1 (M1 C c f) where + gconstructorName1 = conName + +instance (GConstructorName1 f, GConstructorName1 g) => GConstructorName1 (f :+: g) where + gconstructorName1 (L1 l) = gconstructorName1 l + gconstructorName1 (R1 r) = gconstructorName1 r + + +-- | A typeclass to calculate a list of 'KeyValue's describing the record selector names and associated values on a datatype. class GToJSONFields1 f where gtoJSONFields1 :: (KeyValue kv, ToJSON a) => f a -> [kv] @@ -84,22 +104,11 @@ instance GToJSONFields1 f => GToJSONFields1 (M1 C c f) where instance GToJSONFields1 U1 where gtoJSONFields1 _ = [] -instance (Selector c, GToJSONFields1' f) => GToJSONFields1 (M1 S c f) where - gtoJSONFields1 m1 = let json = gtoJSON (unM1 m1) in case selName m1 of +instance (Selector c, GSelectorJSONValue1 f) => GToJSONFields1 (M1 S c f) where + gtoJSONFields1 m1 = case selName m1 of "" -> [ "children" .= json ] n -> [ Text.pack n .= json ] - -class GToJSONFields1' f where - gtoJSON :: ToJSON a => f a -> SomeJSON - -instance GToJSONFields1' Par1 where - gtoJSON = SomeJSON . unPar1 - -instance ToJSON1 f => GToJSONFields1' (Rec1 f) where - gtoJSON = SomeJSON . SomeJSON1 . unRec1 - -instance ToJSON k => GToJSONFields1' (K1 r k) where - gtoJSON = SomeJSON . unK1 + where json = gselectorJSONValue1 (unM1 m1) instance (GToJSONFields1 f, GToJSONFields1 g) => GToJSONFields1 (f :+: g) where gtoJSONFields1 (L1 l) = gtoJSONFields1 l @@ -108,6 +117,19 @@ instance (GToJSONFields1 f, GToJSONFields1 g) => GToJSONFields1 (f :+: g) where instance (GToJSONFields1 f, GToJSONFields1 g) => GToJSONFields1 (f :*: g) where gtoJSONFields1 (x :*: y) = gtoJSONFields1 x <> gtoJSONFields1 y +-- | A typeclass to retrieve the JSON 'Value' of a record selector. +class GSelectorJSONValue1 f where + gselectorJSONValue1 :: ToJSON a => f a -> SomeJSON + +instance GSelectorJSONValue1 Par1 where + gselectorJSONValue1 = SomeJSON . unPar1 + +instance ToJSON1 f => GSelectorJSONValue1 (Rec1 f) where + gselectorJSONValue1 = SomeJSON . SomeJSON1 . unRec1 + +instance ToJSON k => GSelectorJSONValue1 (K1 r k) where + gselectorJSONValue1 = SomeJSON . unK1 + -- TODO: Fix this orphan instance. instance ToJSON ByteString where diff --git a/src/Semantic/Diff.hs b/src/Semantic/Diff.hs index bfe9b616b..8e9046794 100644 --- a/src/Semantic/Diff.hs +++ b/src/Semantic/Diff.hs @@ -1,7 +1,7 @@ {-# LANGUAGE ConstraintKinds, GADTs, RankNTypes, ScopedTypeVariables #-} module Semantic.Diff where -import Analysis.ConstructorName (ConstructorName, constructorLabel) +import Analysis.ConstructorName (ConstructorName) import Analysis.Declaration (HasDeclaration, declarationAlgebra) import Data.AST import Data.Blob @@ -21,7 +21,7 @@ import Serializing.Format runDiff :: (Member (Distribute WrappedTask) effs, Member Task effs) => DiffRenderer output -> [BlobPair] -> Eff effs Builder runDiff ToCDiffRenderer = withParsedBlobPairs (decorate . declarationAlgebra) (render . renderToCDiff) >=> serialize JSON -runDiff JSONDiffRenderer = withParsedBlobPairs (const (decorate constructorLabel)) (render . renderJSONDiff) >=> serialize JSON +runDiff JSONDiffRenderer = withParsedBlobPairs (const pure) (render . renderJSONDiff) >=> serialize JSON runDiff SExpressionDiffRenderer = withParsedBlobPairs (const pure) (const (serialize (SExpression ByConstructorName))) runDiff ShowDiffRenderer = withParsedBlobPairs (const pure) (const (serialize Show)) runDiff DOTDiffRenderer = withParsedBlobPairs (const pure) (const (render renderTreeGraph)) >=> serialize (DOT (diffStyle "diffs")) diff --git a/src/Semantic/Parse.hs b/src/Semantic/Parse.hs index 9179748ae..a6e54ece0 100644 --- a/src/Semantic/Parse.hs +++ b/src/Semantic/Parse.hs @@ -1,7 +1,7 @@ {-# LANGUAGE GADTs, RankNTypes #-} module Semantic.Parse where -import Analysis.ConstructorName (ConstructorName, constructorLabel) +import Analysis.ConstructorName (ConstructorName) import Analysis.Declaration (HasDeclaration, declarationAlgebra) import Analysis.PackageDef (HasPackageDef, packageDefAlgebra) import Data.AST @@ -18,7 +18,7 @@ import Semantic.Task import Serializing.Format runParse :: (Member (Distribute WrappedTask) effs, Member Task effs) => TermRenderer output -> [Blob] -> Eff effs Builder -runParse JSONTermRenderer = withParsedBlobs (\ blob -> decorate constructorLabel >=> render (renderJSONTerm blob)) >=> serialize JSON +runParse JSONTermRenderer = withParsedBlobs (render . renderJSONTerm) >=> serialize JSON runParse SExpressionTermRenderer = withParsedBlobs (const (serialize (SExpression ByConstructorName))) runParse ShowTermRenderer = withParsedBlobs (const (serialize Show)) runParse TagsTermRenderer = withParsedBlobs (\ blob -> decorate (declarationAlgebra blob) >=> render (renderToTags blob)) >=> serialize JSON From 92aa9e7d9b16732e5532f3b207b0a484334498a7 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Wed, 30 May 2018 09:40:01 -0700 Subject: [PATCH 145/148] Derive ToJSONFields1 for Identifier --- src/Data/Syntax.hs | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs index bdc1eca09..460ce1417 100644 --- a/src/Data/Syntax.hs +++ b/src/Data/Syntax.hs @@ -101,17 +101,13 @@ infixContext context left right operators = uncurry (&) <$> postContextualizeThr -- Common -- | An identifier of some other construct, whether a containing declaration (e.g. a class name) or a reference (e.g. a variable). -newtype Identifier a = Identifier Name - deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable) +newtype Identifier a = Identifier { name :: Name } + deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, ToJSONFields1) instance Eq1 Identifier where liftEq = genericLiftEq instance Ord1 Identifier where liftCompare = genericLiftCompare instance Show1 Identifier where liftShowsPrec = genericLiftShowsPrec --- Propagating the identifier name into JSON is handled with the IdentifierName analysis. -instance ToJSONFields1 Identifier where - toJSONFields1 (Identifier name) = [ "name" .= name ] - instance Evaluatable Identifier where eval (Identifier name) = pure (LvalLocal name) From c2fb5c6091767d31e6e1398fc69e40b9ff7bcdb3 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Wed, 30 May 2018 09:40:18 -0700 Subject: [PATCH 146/148] Derive a couple more ToJSONFields1 instances --- src/Data/Syntax.hs | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs index 460ce1417..17c707714 100644 --- a/src/Data/Syntax.hs +++ b/src/Data/Syntax.hs @@ -117,28 +117,26 @@ instance FreeVariables1 Identifier where instance Declarations1 Identifier where liftDeclaredName _ (Identifier x) = pure x + newtype Program a = Program [a] - deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, ToJSONFields1) instance Eq1 Program where liftEq = genericLiftEq instance Ord1 Program where liftCompare = genericLiftCompare instance Show1 Program where liftShowsPrec = genericLiftShowsPrec -instance ToJSONFields1 Program - instance Evaluatable Program where eval (Program xs) = eval xs + -- | An accessibility modifier, e.g. private, public, protected, etc. newtype AccessibilityModifier a = AccessibilityModifier ByteString - deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1) + deriving (Diffable, Eq, Foldable, Functor, Generic1, Hashable1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1, ToJSONFields1) instance Eq1 AccessibilityModifier where liftEq = genericLiftEq instance Ord1 AccessibilityModifier where liftCompare = genericLiftCompare instance Show1 AccessibilityModifier where liftShowsPrec = genericLiftShowsPrec -instance ToJSONFields1 AccessibilityModifier - -- TODO: Implement Eval instance for AccessibilityModifier instance Evaluatable AccessibilityModifier From 5d4c47e11ea353d73206a7a2cf5879b60fa26fe3 Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Wed, 30 May 2018 09:40:31 -0700 Subject: [PATCH 147/148] Swap order for human readability - annotations last --- src/Data/Term.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Data/Term.hs b/src/Data/Term.hs index 4354c7d7e..cc9cd700f 100644 --- a/src/Data/Term.hs +++ b/src/Data/Term.hs @@ -121,7 +121,7 @@ instance (ToJSONFields a, ToJSONFields1 f) => ToJSONFields (Term f a) where toJSONFields = toJSONFields . unTerm instance (ToJSON b, ToJSONFields a, ToJSONFields1 f) => ToJSONFields (TermF f a b) where - toJSONFields (In a f) = toJSONFields a <> toJSONFields1 f + toJSONFields (In a f) = toJSONFields1 f <> toJSONFields a instance (ToJSON b, ToJSONFields a, ToJSONFields1 f) => ToJSON (TermF f a b) where toJSON = object . toJSONFields From ddc4923e88c55fa05ae73c623b659722f2f6a22f Mon Sep 17 00:00:00 2001 From: Timothy Clem Date: Wed, 30 May 2018 09:53:01 -0700 Subject: [PATCH 148/148] Fix tests --- test/Semantic/CLI/Spec.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test/Semantic/CLI/Spec.hs b/test/Semantic/CLI/Spec.hs index c864571a9..f0799501e 100644 --- a/test/Semantic/CLI/Spec.hs +++ b/test/Semantic/CLI/Spec.hs @@ -41,8 +41,8 @@ parseFixtures = pathMode' = [File "test/fixtures/ruby/corpus/and-or.A.rb" (Just Ruby), File "test/fixtures/ruby/corpus/and-or.B.rb" (Just Ruby)] sExpressionParseTreeOutput = "(Program\n (LowAnd\n (Send\n (Identifier))\n (Send\n (Identifier))))\n" - jsonParseTreeOutput = "{\"trees\":[{\"tree\":{\"term\":\"Program\",\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]},\"children\":[{\"term\":\"LowAnd\",\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]},\"children\":{\"term\":\"Send\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]},\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]},\"name\":\"foo\"},\"sendArgs\":[],\"sendBlock\":null},\"children\":{\"term\":\"Send\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]},\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]},\"name\":\"bar\"},\"sendArgs\":[],\"sendBlock\":null}}]},\"path\":\"test/fixtures/ruby/corpus/and-or.A.rb\",\"language\":\"Ruby\"}]}\n" - jsonParseTreeOutput' = "{\"trees\":[{\"tree\":{\"term\":\"Program\",\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]},\"children\":[{\"term\":\"LowAnd\",\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]},\"children\":{\"term\":\"Send\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]},\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]},\"name\":\"foo\"},\"sendArgs\":[],\"sendBlock\":null},\"children\":{\"term\":\"Send\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]},\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]},\"name\":\"bar\"},\"sendArgs\":[],\"sendBlock\":null}}]},\"path\":\"test/fixtures/ruby/corpus/and-or.A.rb\",\"language\":\"Ruby\"},{\"tree\":{\"term\":\"Program\",\"sourceRange\":[0,24],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]},\"children\":[{\"term\":\"LowOr\",\"sourceRange\":[0,10],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,11]},\"children\":{\"term\":\"Send\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]},\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]},\"name\":\"foo\"},\"sendArgs\":[],\"sendBlock\":null},\"children\":{\"term\":\"Send\",\"sourceRange\":[7,10],\"sourceSpan\":{\"start\":[1,8],\"end\":[1,11]},\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"sourceRange\":[7,10],\"sourceSpan\":{\"start\":[1,8],\"end\":[1,11]},\"name\":\"bar\"},\"sendArgs\":[],\"sendBlock\":null}},{\"term\":\"LowAnd\",\"sourceRange\":[11,23],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,13]},\"children\":{\"term\":\"LowOr\",\"sourceRange\":[11,17],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,7]},\"children\":{\"term\":\"Send\",\"sourceRange\":[11,12],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,2]},\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"sourceRange\":[11,12],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,2]},\"name\":\"a\"},\"sendArgs\":[],\"sendBlock\":null},\"children\":{\"term\":\"Send\",\"sourceRange\":[16,17],\"sourceSpan\":{\"start\":[2,6],\"end\":[2,7]},\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"sourceRange\":[16,17],\"sourceSpan\":{\"start\":[2,6],\"end\":[2,7]},\"name\":\"b\"},\"sendArgs\":[],\"sendBlock\":null}},\"children\":{\"term\":\"Send\",\"sourceRange\":[22,23],\"sourceSpan\":{\"start\":[2,12],\"end\":[2,13]},\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"sourceRange\":[22,23],\"sourceSpan\":{\"start\":[2,12],\"end\":[2,13]},\"name\":\"c\"},\"sendArgs\":[],\"sendBlock\":null}}]},\"path\":\"test/fixtures/ruby/corpus/and-or.B.rb\",\"language\":\"Ruby\"}]}\n" + jsonParseTreeOutput = "{\"trees\":[{\"tree\":{\"term\":\"Program\",\"children\":[{\"term\":\"LowAnd\",\"children\":{\"term\":\"Send\",\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"name\":\"foo\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},\"sendArgs\":[],\"sendBlock\":null,\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},\"children\":{\"term\":\"Send\",\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"name\":\"bar\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}},\"sendArgs\":[],\"sendBlock\":null,\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}},\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}},\"path\":\"test/fixtures/ruby/corpus/and-or.A.rb\",\"language\":\"Ruby\"}]}\n" + jsonParseTreeOutput' = "{\"trees\":[{\"tree\":{\"term\":\"Program\",\"children\":[{\"term\":\"LowAnd\",\"children\":{\"term\":\"Send\",\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"name\":\"foo\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},\"sendArgs\":[],\"sendBlock\":null,\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},\"children\":{\"term\":\"Send\",\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"name\":\"bar\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}},\"sendArgs\":[],\"sendBlock\":null,\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,12]}},\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,12]}}],\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,1]}},\"path\":\"test/fixtures/ruby/corpus/and-or.A.rb\",\"language\":\"Ruby\"},{\"tree\":{\"term\":\"Program\",\"children\":[{\"term\":\"LowOr\",\"children\":{\"term\":\"Send\",\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"name\":\"foo\",\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},\"sendArgs\":[],\"sendBlock\":null,\"sourceRange\":[0,3],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,4]}},\"children\":{\"term\":\"Send\",\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"name\":\"bar\",\"sourceRange\":[7,10],\"sourceSpan\":{\"start\":[1,8],\"end\":[1,11]}},\"sendArgs\":[],\"sendBlock\":null,\"sourceRange\":[7,10],\"sourceSpan\":{\"start\":[1,8],\"end\":[1,11]}},\"sourceRange\":[0,10],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,11]}},{\"term\":\"LowAnd\",\"children\":{\"term\":\"LowOr\",\"children\":{\"term\":\"Send\",\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"name\":\"a\",\"sourceRange\":[11,12],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,2]}},\"sendArgs\":[],\"sendBlock\":null,\"sourceRange\":[11,12],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,2]}},\"children\":{\"term\":\"Send\",\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"name\":\"b\",\"sourceRange\":[16,17],\"sourceSpan\":{\"start\":[2,6],\"end\":[2,7]}},\"sendArgs\":[],\"sendBlock\":null,\"sourceRange\":[16,17],\"sourceSpan\":{\"start\":[2,6],\"end\":[2,7]}},\"sourceRange\":[11,17],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,7]}},\"children\":{\"term\":\"Send\",\"sendReceiver\":null,\"sendSelector\":{\"term\":\"Identifier\",\"name\":\"c\",\"sourceRange\":[22,23],\"sourceSpan\":{\"start\":[2,12],\"end\":[2,13]}},\"sendArgs\":[],\"sendBlock\":null,\"sourceRange\":[22,23],\"sourceSpan\":{\"start\":[2,12],\"end\":[2,13]}},\"sourceRange\":[11,23],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,13]}}],\"sourceRange\":[0,24],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"path\":\"test/fixtures/ruby/corpus/and-or.B.rb\",\"language\":\"Ruby\"}]}\n" emptyJsonParseTreeOutput = "{\"trees\":[]}\n" symbolsOutput = "{\"files\":[{\"path\":\"test/fixtures/ruby/corpus/method-declaration.A.rb\",\"symbols\":[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"kind\":\"Method\",\"symbol\":\"foo\"}],\"language\":\"Ruby\"}]}\n" tagsOutput = "[{\"span\":{\"start\":[1,1],\"end\":[2,4]},\"path\":\"test/fixtures/ruby/corpus/method-declaration.A.rb\",\"kind\":\"Method\",\"symbol\":\"foo\",\"line\":\"def foo\",\"language\":\"Ruby\"}]\n" @@ -56,6 +56,6 @@ diffFixtures = ] where pathMode = [both (File "test/fixtures/ruby/corpus/method-declaration.A.rb" (Just Ruby)) (File "test/fixtures/ruby/corpus/method-declaration.B.rb" (Just Ruby))] - jsonOutput = "{\"diffs\":[{\"diff\":{\"merge\":{\"before\":{\"term\":\"Program\",\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"after\":{\"term\":\"Program\",\"sourceRange\":[0,21],\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}},\"children\":[{\"merge\":{\"before\":{\"term\":\"Method\",\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}},\"after\":{\"term\":\"Method\",\"sourceRange\":[0,20],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}},\"methodContext\":[],\"methodReceiver\":{\"merge\":{\"before\":{\"term\":\"Empty\",\"sourceRange\":[0,0],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,1]}},\"after\":{\"term\":\"Empty\",\"sourceRange\":[0,0],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,1]}}}},\"methodName\":{\"patch\":{\"replace\":[{\"term\":\"Identifier\",\"name\":\"foo\",\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"term\":\"Identifier\",\"name\":\"bar\",\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}]}},\"methodParameters\":[{\"patch\":{\"insert\":{\"term\":\"Identifier\",\"name\":\"a\",\"sourceRange\":[8,9],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,10]}}}}],\"methodBody\":{\"merge\":{\"before\":{\"term\":\"Statements\",\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,4]}},\"after\":{\"term\":\"Statements\",\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}},\"children\":[{\"patch\":{\"insert\":{\"term\":\"Send\",\"sourceRange\":[13,16],\"sendReceiver\":null,\"sendBlock\":null,\"sendArgs\":[],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]},\"sendSelector\":{\"patch\":{\"insert\":{\"term\":\"Identifier\",\"name\":\"baz\",\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}}}}}}}]}}}}]}},\"stat\":{\"path\":\"test/fixtures/ruby/corpus/method-declaration.A.rb -> test/fixtures/ruby/corpus/method-declaration.B.rb\",\"replace\":[{\"path\":\"test/fixtures/ruby/corpus/method-declaration.A.rb\",\"language\":\"Ruby\"},{\"path\":\"test/fixtures/ruby/corpus/method-declaration.B.rb\",\"language\":\"Ruby\"}]}}]}\n" + jsonOutput = "{\"diffs\":[{\"diff\":{\"merge\":{\"term\":\"Program\",\"children\":[{\"merge\":{\"term\":\"Method\",\"methodContext\":[],\"methodReceiver\":{\"merge\":{\"term\":\"Empty\",\"before\":{\"sourceRange\":[0,0],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,1]}},\"after\":{\"sourceRange\":[0,0],\"sourceSpan\":{\"start\":[1,1],\"end\":[1,1]}}}},\"methodName\":{\"patch\":{\"replace\":[{\"term\":\"Identifier\",\"name\":\"foo\",\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}},{\"term\":\"Identifier\",\"name\":\"bar\",\"sourceRange\":[4,7],\"sourceSpan\":{\"start\":[1,5],\"end\":[1,8]}}]}},\"methodParameters\":[{\"patch\":{\"insert\":{\"term\":\"Identifier\",\"name\":\"a\",\"sourceRange\":[8,9],\"sourceSpan\":{\"start\":[1,9],\"end\":[1,10]}}}}],\"methodBody\":{\"merge\":{\"children\":[{\"patch\":{\"insert\":{\"term\":\"Send\",\"sourceRange\":[13,16],\"sendReceiver\":null,\"sendBlock\":null,\"sendArgs\":[],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]},\"sendSelector\":{\"patch\":{\"insert\":{\"term\":\"Identifier\",\"name\":\"baz\",\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}}}}}}}],\"before\":{\"sourceRange\":[8,11],\"sourceSpan\":{\"start\":[2,1],\"end\":[2,4]}},\"after\":{\"sourceRange\":[13,16],\"sourceSpan\":{\"start\":[2,3],\"end\":[2,6]}}}},\"before\":{\"sourceRange\":[0,11],\"sourceSpan\":{\"start\":[1,1],\"end\":[2,4]}},\"after\":{\"sourceRange\":[0,20],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,4]}}}}],\"before\":{\"sourceRange\":[0,12],\"sourceSpan\":{\"start\":[1,1],\"end\":[3,1]}},\"after\":{\"sourceRange\":[0,21],\"sourceSpan\":{\"start\":[1,1],\"end\":[4,1]}}}},\"stat\":{\"path\":\"test/fixtures/ruby/corpus/method-declaration.A.rb -> test/fixtures/ruby/corpus/method-declaration.B.rb\",\"replace\":[{\"path\":\"test/fixtures/ruby/corpus/method-declaration.A.rb\",\"language\":\"Ruby\"},{\"path\":\"test/fixtures/ruby/corpus/method-declaration.B.rb\",\"language\":\"Ruby\"}]}}]}\n" sExpressionOutput = "(Program\n (Method\n (Empty)\n { (Identifier)\n ->(Identifier) }\n {+(Identifier)+}\n (Statements\n {+(Send\n {+(Identifier)+})+})))\n" tocOutput = "{\"changes\":{\"test/fixtures/ruby/corpus/method-declaration.A.rb -> test/fixtures/ruby/corpus/method-declaration.B.rb\":[{\"span\":{\"start\":[1,1],\"end\":[3,4]},\"category\":\"Method\",\"term\":\"bar\",\"changeType\":\"modified\"}]},\"errors\":{}}\n"