Hello community, here is the log from the commit of package ghc-haskell-tools-ast for openSUSE:Factory checked in at 2017-08-31 20:55:51 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-haskell-tools-ast (Old) and /work/SRC/openSUSE:Factory/.ghc-haskell-tools-ast.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-haskell-tools-ast" Thu Aug 31 20:55:51 2017 rev:2 rq:513368 version:0.8.0.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-haskell-tools-ast/ghc-haskell-tools-ast.changes 2017-04-12 18:06:42.482625143 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-haskell-tools-ast.new/ghc-haskell-tools-ast.changes 2017-08-31 20:55:52.724346149 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:03:15 UTC 2017 - psimons@suse.com + +- Update to version 0.8.0.0. + +------------------------------------------------------------------- Old: ---- haskell-tools-ast-0.5.0.0.tar.gz New: ---- haskell-tools-ast-0.8.0.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-haskell-tools-ast.spec ++++++ --- /var/tmp/diff_new_pack.QbZwND/_old 2017-08-31 20:55:53.640217466 +0200 +++ /var/tmp/diff_new_pack.QbZwND/_new 2017-08-31 20:55:53.644216904 +0200 @@ -18,7 +18,7 @@ %global pkg_name haskell-tools-ast Name: ghc-%{pkg_name} -Version: 0.5.0.0 +Version: 0.8.0.0 Release: 0 Summary: Haskell AST for efficient tooling License: BSD-3-Clause ++++++ haskell-tools-ast-0.5.0.0.tar.gz -> haskell-tools-ast-0.8.0.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Ann.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Ann.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Ann.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Ann.hs 2017-05-03 22:13:55.000000000 +0200 @@ -166,7 +166,7 @@ , HasRange (SpanInfo stage) , HasRange (ListInfo stage) , HasRange (OptionalInfo stage) - ) + ) => SourceInfo stage where -- | UType of source info for normal AST elements data SpanInfo stage :: * @@ -182,13 +182,13 @@ data ListInfo RangeStage = ListPos { _listBefore :: String , _listAfter :: String , _listDefaultSep :: String - , _listIndented :: Bool - , _listPos :: SrcLoc + , _listIndented :: Maybe [Bool] + , _listPos :: SrcLoc } deriving (Data) data OptionalInfo RangeStage = OptionalPos { _optionalBefore :: String - , _optionalAfter :: String - , _optionalPos :: SrcLoc + , _optionalAfter :: String + , _optionalPos :: SrcLoc } deriving (Data) @@ -207,13 +207,13 @@ data ListInfo NormRangeStage = NormListInfo { _normListBefore :: String , _normListAfter :: String , _normListDefaultSep :: String - , _normListIndented :: Bool - , _normListSpan :: SrcSpan + , _normListIndented :: Maybe [Bool] + , _normListSpan :: SrcSpan } deriving (Data) data OptionalInfo NormRangeStage = NormOptInfo { _normOptBefore :: String - , _normOptAfter :: String - , _normOptSpan :: SrcSpan + , _normOptAfter :: String + , _normOptSpan :: SrcSpan } deriving (Data) @@ -228,8 +228,8 @@ -- | A short form of showing a range, without file name, for debugging purposes. shortShowSpan :: SrcSpan -> String -shortShowSpan (UnhelpfulSpan _) = "??-??" -shortShowSpan sp@(RealSrcSpan _) +shortShowSpan (UnhelpfulSpan _) = "??-??" +shortShowSpan sp@(RealSrcSpan _) = shortShowLoc (srcSpanStart sp) ++ "-" ++ shortShowLoc (srcSpanEnd sp) -- | A short form of showing a range, without file name, for debugging purposes. @@ -239,7 +239,7 @@ -- | A class for marking a source information stage. All programs, regardless of -- correct Haskell programs or not, must go through these stages to be refactored. -class SourceInfo stage +class SourceInfo stage => RangeInfo stage where nodeSpan :: Simple Lens (SpanInfo stage) GHC.SrcSpan listPos :: Simple Lens (ListInfo stage) GHC.SrcLoc @@ -253,40 +253,40 @@ -- * Annotations -- | Semantic and source code related information for an AST node. -data NodeInfo sema src +data NodeInfo sema src = NodeInfo { _semanticInfo :: sema , _sourceInfo :: src } deriving (Eq, Show, Data) - + makeReferences ''NodeInfo -- | An element of the AST keeping extra information. data Ann elem dom stage -- The type parameters are organized this way because we want the annotation type to --- be more flexible, but the annotation is the first parameter because it eases +-- be more flexible, but the annotation is the first parameter because it eases -- pattern matching. = Ann { _annotation :: NodeInfo (SemanticInfo dom elem) (SpanInfo stage) -- ^ The extra information for the AST part , _element :: elem dom stage -- ^ The original AST part } - + makeReferences ''Ann -- | A list of AST elements -data AnnListG elem dom stage = AnnListG { _annListAnnot :: NodeInfo (SemanticInfo dom (AnnListG elem)) (ListInfo stage) +data AnnListG elem dom stage = AnnListG { _annListAnnot :: NodeInfo (SemanticInfo dom (AnnListG elem)) (ListInfo stage) , _annListElems :: [Ann elem dom stage] } makeReferences ''AnnListG - -annList :: Traversal (AnnListG e d s) (AnnListG e d s) (Ann e d s) (Ann e d s) + +annList :: Traversal (AnnListG e d s) (AnnListG e d s) (Ann e d s) (Ann e d s) annList = annListElems & traversal -- | An optional AST element data AnnMaybeG elem dom stage = AnnMaybeG { _annMaybeAnnot :: NodeInfo (SemanticInfo dom (AnnMaybeG elem)) (OptionalInfo stage) , _annMaybe :: Maybe (Ann elem dom stage) } - + makeReferences ''AnnMaybeG class HasSourceInfo e where @@ -304,8 +304,8 @@ instance HasSourceInfo (AnnMaybeG elem dom stage) where type SourceInfoType (AnnMaybeG elem dom stage) = OptionalInfo stage srcInfo = annMaybeAnnot & sourceInfo - -annJust :: Partial (AnnMaybeG e d s) (AnnMaybeG e d s) (Ann e d s) (Ann e d s) + +annJust :: Partial (AnnMaybeG e d s) (AnnMaybeG e d s) (Ann e d s) (Ann e d s) annJust = annMaybe & just -- | An empty list of AST elements @@ -366,7 +366,7 @@ setRange sp = annMaybeAnnot & sourceInfo .- setRange sp -- | A class for changing semantic information throught the AST. -class ApplySemaChange cls where +class ApplySemaChange cls where appSemaChange :: SemaTrf f dom1 dom2 -> SemanticInfo' dom1 cls -> f (SemanticInfo' dom2 cls) instance ApplySemaChange SameInfoNameCls where appSemaChange = trfSemaNameCls @@ -377,7 +377,7 @@ instance ApplySemaChange SameInfoDefaultCls where appSemaChange = trfSemaDefault -- | A class for traversing semantic information in an AST -class ApplySemaChange (SemaInfoClassify a) +class ApplySemaChange (SemaInfoClassify a) => SemanticTraversal a where semaTraverse :: Monad f => SemaTrf f dom1 dom2 -> a dom1 st -> f (a dom2 st) @@ -412,26 +412,25 @@ } instance SourceInfoTraversal e => SourceInfoTraversal (Ann e) where - sourceInfoTraverse trf (Ann (NodeInfo sema src) e) + sourceInfoTraverse trf (Ann (NodeInfo sema src) e) = Ann <$> (NodeInfo sema <$> trfSpanInfo trf src) <*> sourceInfoTraverse trf e - sourceInfoTraverseDown trf desc asc (Ann (NodeInfo sema src) e) + sourceInfoTraverseDown trf desc asc (Ann (NodeInfo sema src) e) = Ann <$> (NodeInfo sema <$> trfSpanInfo trf src) <*> (desc *> sourceInfoTraverseDown trf desc asc e <* asc) - sourceInfoTraverseUp trf desc asc (Ann (NodeInfo sema src) e) + sourceInfoTraverseUp trf desc asc (Ann (NodeInfo sema src) e) = flip Ann <$> (desc *> sourceInfoTraverseUp trf desc asc e <* asc) <*> (NodeInfo sema <$> trfSpanInfo trf src) instance SourceInfoTraversal e => SourceInfoTraversal (AnnListG e) where - sourceInfoTraverse trf (AnnListG (NodeInfo sema src) e) + sourceInfoTraverse trf (AnnListG (NodeInfo sema src) e) = AnnListG <$> (NodeInfo sema <$> trfListInfo trf src) <*> mapM (sourceInfoTraverse trf) e - sourceInfoTraverseDown trf desc asc (AnnListG (NodeInfo sema src) e) + sourceInfoTraverseDown trf desc asc (AnnListG (NodeInfo sema src) e) = AnnListG <$> (NodeInfo sema <$> trfListInfo trf src) <*> (desc *> mapM (sourceInfoTraverseDown trf desc asc) e <* asc) - sourceInfoTraverseUp trf desc asc (AnnListG (NodeInfo sema src) e) + sourceInfoTraverseUp trf desc asc (AnnListG (NodeInfo sema src) e) = flip AnnListG <$> (desc *> mapM (sourceInfoTraverseUp trf desc asc) e <* asc) <*> (NodeInfo sema <$> trfListInfo trf src) instance SourceInfoTraversal e => SourceInfoTraversal (AnnMaybeG e) where - sourceInfoTraverse trf (AnnMaybeG (NodeInfo sema src) e) + sourceInfoTraverse trf (AnnMaybeG (NodeInfo sema src) e) = AnnMaybeG <$> (NodeInfo sema <$> trfOptionalInfo trf src) <*> sequence (fmap (sourceInfoTraverse trf) e) - sourceInfoTraverseDown trf desc asc (AnnMaybeG (NodeInfo sema src) e) + sourceInfoTraverseDown trf desc asc (AnnMaybeG (NodeInfo sema src) e) = AnnMaybeG <$> (NodeInfo sema <$> trfOptionalInfo trf src) <*> (desc *> sequence (fmap (sourceInfoTraverseDown trf desc asc) e) <* asc) - sourceInfoTraverseUp trf desc asc (AnnMaybeG (NodeInfo sema src) e) + sourceInfoTraverseUp trf desc asc (AnnMaybeG (NodeInfo sema src) e) = flip AnnMaybeG <$> (desc *> sequence (fmap (sourceInfoTraverseUp trf desc asc) e) <* asc) <*> (NodeInfo sema <$> trfOptionalInfo trf src) - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Helpers.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Helpers.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Helpers.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Helpers.hs 2017-05-22 15:12:54.000000000 +0200 @@ -1,6 +1,6 @@ -{-# LANGUAGE FlexibleContexts - , LambdaCase - , RankNTypes +{-# LANGUAGE FlexibleContexts + , LambdaCase + , RankNTypes , ScopedTypeVariables , TypeFamilies , FlexibleInstances @@ -29,14 +29,18 @@ import Language.Haskell.Tools.AST.Representation.Patterns (UPattern) import Language.Haskell.Tools.AST.Representation.Types (UType(..)) import Language.Haskell.Tools.AST.SemaInfoTypes (Scope) - + -- | Does the import declaration import only the explicitly listed elements? importIsExact :: Ann UImportDecl dom stage -> Bool -importIsExact = isJust . (^? importSpec&annJust&importSpecList) +importIsExact = isJust . (^? importSpec&annJust&importSpecList) + +-- | Does the import declaration import all elements that are not excluded explicitly? +importIsHiding :: Ann UImportDecl dom stage -> Bool +importIsHiding = isJust . (^? importSpec&annJust&importSpecHiding) -- | Accesses the name of a function or value binding bindingName :: Simple Traversal (Ann UValueBind dom stage) (Ann UQualifiedName dom stage) -bindingName = (valBindPat&patternName&simpleName +bindingName = (valBindPat&patternName&simpleName &+& funBindMatches&annList&matchLhs &(matchLhsName&simpleName &+& matchLhsOperator&operatorName)) @@ -62,9 +66,9 @@ semantics = annotation&semanticInfo -- | Get all nodes that contain a given source range -nodesContaining :: (HasRange (inner dom stage), Biplate (node dom stage) (inner dom stage)) +nodesContaining :: (HasRange (inner dom stage), Biplate (node dom stage) (inner dom stage)) => RealSrcSpan -> Simple Traversal (node dom stage) (inner dom stage) -nodesContaining rng = biplateRef & filtered (isInside rng) +nodesContaining rng = biplateRef & filtered (isInside rng) -- | Return true if the node contains a given range isInside :: HasRange (inner dom stage) => RealSrcSpan -> inner dom stage -> Bool @@ -72,26 +76,26 @@ _ -> False -- | Get all nodes that are contained in a given source range -nodesContained :: (HasRange (inner dom stage), Biplate (node dom stage) (inner dom stage)) +nodesContained :: (HasRange (inner dom stage), Biplate (node dom stage) (inner dom stage)) => RealSrcSpan -> Simple Traversal (node dom stage) (inner dom stage) -nodesContained rng = biplateRef & filtered (isContained rng) +nodesContained rng = biplateRef & filtered (isContained rng) -- | Return true if the node contains a given range isContained :: HasRange (inner dom stage) => RealSrcSpan -> inner dom stage -> Bool isContained rng nd = case getRange nd of RealSrcSpan sp -> rng `containsSpan` sp _ -> False --- | Get the nodes that have exactly the given range -nodesWithRange :: (Biplate (Ann node dom stage) (Ann inner dom stage), SourceInfo stage) +-- | Get the nodes that have exactly the given range +nodesWithRange :: (Biplate (Ann node dom stage) (Ann inner dom stage), SourceInfo stage) => RealSrcSpan -> Simple Traversal (Ann node dom stage) (Ann inner dom stage) -nodesWithRange rng = biplateRef & filtered (hasRange rng) - where -- True, if the node has the given range +nodesWithRange rng = biplateRef & filtered (hasRange rng) + where -- True, if the node has the given range hasRange :: SourceInfo stage => RealSrcSpan -> Ann inner dom stage -> Bool hasRange rng node = case getRange node of RealSrcSpan sp -> sp == rng _ -> False --- | Get the shortest source range that contains the given -getNodeContaining :: (Biplate (Ann node dom stage) (Ann inner dom stage), SourceInfo stage, HasRange (Ann inner dom stage)) +-- | Get the shortest source range that contains the given +getNodeContaining :: (Biplate (Ann node dom stage) (Ann inner dom stage), SourceInfo stage, HasRange (Ann inner dom stage)) => RealSrcSpan -> Ann node dom stage -> Maybe (Ann inner dom stage) getNodeContaining sp node = case node ^? nodesContaining sp of [] -> Nothing @@ -110,22 +114,22 @@ elementName :: Simple Traversal (Ann elem dom st) (Ann UQualifiedName dom st) instance NamedElement UDecl where - elementName = (declHead & declHeadNames) + elementName = (declHead & declHeadNames) &+& (declTypeFamily & tfHead & declHeadNames) &+& (declValBind & bindingName) &+& (declName & simpleName) &+& (declPatSyn & patLhs & (patName & simpleName &+& patSynOp & operatorName)) instance NamedElement ULocalBind where - elementName = localVal&bindingName - &+& localSig&tsName&annList&simpleName + elementName = localVal&bindingName + &+& localSig&tsName&annList&simpleName &+& localFixity&fixityOperators&annList&operatorName inScope :: GHC.Name -> Scope -> Bool -inScope n sc = any (n `elem`) sc +inScope n sc = any ((n `elem`) . map fst) sc -- * Pattern synonyms for annotated lists and maybes - + pattern AnnList :: [Ann elem dom stage] -> AnnListG elem dom stage pattern AnnList elems <- AnnListG _ elems @@ -133,4 +137,4 @@ pattern AnnNothing <- AnnMaybeG _ Nothing pattern AnnJust :: Ann elem dom stage -> AnnMaybeG elem dom stage -pattern AnnJust elem <- AnnMaybeG _ (Just elem) \ No newline at end of file +pattern AnnJust elem <- AnnMaybeG _ (Just elem) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/Data.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/Data.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/Data.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/Data.hs 2017-05-17 10:56:30.000000000 +0200 @@ -80,6 +80,7 @@ deriving instance (Domain dom, SourceInfo stage) => Data (UBracket dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (UTopLevelPragma dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (URule dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (URuleVar dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (UAnnotationSubject dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (UMinimalFormula dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (UExprPragma dom stage) @@ -108,6 +109,7 @@ deriving instance (Domain dom, SourceInfo stage) => Data (ULanguageExtension dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (UMatchLhs dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (UInlinePragma dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (USpecializePragma dom stage) -- ULiteral deriving instance (Domain dom, SourceInfo stage) => Data (ULiteral dom stage) @@ -133,4 +135,4 @@ deriving instance (Domain dom, SourceInfo stage) => Data (LineNumber dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (UPhaseControl dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (PhaseNumber dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (PhaseInvert dom stage) \ No newline at end of file +deriving instance (Domain dom, SourceInfo stage) => Data (PhaseInvert dom stage) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/Eq.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/Eq.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/Eq.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/Eq.hs 2017-05-17 10:56:30.000000000 +0200 @@ -83,6 +83,7 @@ deriving instance Eq (UBracket dom stage) deriving instance Eq (UTopLevelPragma dom stage) deriving instance Eq (URule dom stage) +deriving instance Eq (URuleVar dom stage) deriving instance Eq (UAnnotationSubject dom stage) deriving instance Eq (UMinimalFormula dom stage) deriving instance Eq (UExprPragma dom stage) @@ -111,6 +112,7 @@ deriving instance Eq (ULanguageExtension dom stage) deriving instance Eq (UMatchLhs dom stage) deriving instance Eq (UInlinePragma dom stage) +deriving instance Eq (USpecializePragma dom stage) -- ULiteral deriving instance Eq (ULiteral dom stage) @@ -136,4 +138,4 @@ deriving instance Eq (LineNumber dom stage) deriving instance Eq (UPhaseControl dom stage) deriving instance Eq (PhaseNumber dom stage) -deriving instance Eq (PhaseInvert dom stage) \ No newline at end of file +deriving instance Eq (PhaseInvert dom stage) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/Generic.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/Generic.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/Generic.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/Generic.hs 2017-05-17 10:56:30.000000000 +0200 @@ -80,6 +80,7 @@ deriving instance Domain dom => Generic (UBracket dom stage) deriving instance Domain dom => Generic (UTopLevelPragma dom stage) deriving instance Domain dom => Generic (URule dom stage) +deriving instance Domain dom => Generic (URuleVar dom stage) deriving instance Domain dom => Generic (UAnnotationSubject dom stage) deriving instance Domain dom => Generic (UMinimalFormula dom stage) deriving instance Domain dom => Generic (UExprPragma dom stage) @@ -108,6 +109,7 @@ deriving instance Domain dom => Generic (ULanguageExtension dom stage) deriving instance Domain dom => Generic (UMatchLhs dom stage) deriving instance Domain dom => Generic (UInlinePragma dom stage) +deriving instance Domain dom => Generic (USpecializePragma dom stage) -- Literal @@ -134,4 +136,4 @@ deriving instance Domain dom => Generic (LineNumber dom stage) deriving instance Domain dom => Generic (UPhaseControl dom stage) deriving instance Domain dom => Generic (PhaseNumber dom stage) -deriving instance Domain dom => Generic (PhaseInvert dom stage) \ No newline at end of file +deriving instance Domain dom => Generic (PhaseInvert dom stage) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/SemanticTraversal.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/SemanticTraversal.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/SemanticTraversal.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/SemanticTraversal.hs 2017-05-17 10:56:30.000000000 +0200 @@ -76,6 +76,7 @@ deriveSemanticTraversal ''UBracket deriveSemanticTraversal ''UTopLevelPragma deriveSemanticTraversal ''URule +deriveSemanticTraversal ''URuleVar deriveSemanticTraversal ''UAnnotationSubject deriveSemanticTraversal ''UMinimalFormula deriveSemanticTraversal ''UExprPragma @@ -106,6 +107,7 @@ deriveSemanticTraversal ''UCaseRhs' deriveSemanticTraversal ''UGuardedCaseRhs' deriveSemanticTraversal ''UInlinePragma +deriveSemanticTraversal ''USpecializePragma -- ULiteral deriveSemanticTraversal ''ULiteral diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/Show.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/Show.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/Show.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/Show.hs 2017-05-17 10:56:30.000000000 +0200 @@ -21,7 +21,7 @@ instance (Show (e dom stage)) => Show (AnnMaybeG e dom stage) where show (AnnMaybeG _ e) = show e - + instance (Show (e dom stage)) => Show (AnnListG e dom stage) where show (AnnListG _ e) = show e @@ -83,6 +83,7 @@ deriving instance Show (UBracket dom stage) deriving instance Show (UTopLevelPragma dom stage) deriving instance Show (URule dom stage) +deriving instance Show (URuleVar dom stage) deriving instance Show (UAnnotationSubject dom stage) deriving instance Show (UMinimalFormula dom stage) deriving instance Show (UExprPragma dom stage) @@ -111,6 +112,7 @@ deriving instance Show (ULanguageExtension dom stage) deriving instance Show (UMatchLhs dom stage) deriving instance Show (UInlinePragma dom stage) +deriving instance Show (USpecializePragma dom stage) -- ULiteral @@ -137,4 +139,4 @@ deriving instance Show (LineNumber dom stage) deriving instance Show (UPhaseControl dom stage) deriving instance Show (PhaseNumber dom stage) -deriving instance Show (PhaseInvert dom stage) \ No newline at end of file +deriving instance Show (PhaseInvert dom stage) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/SourceInfoTraversal.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/SourceInfoTraversal.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/SourceInfoTraversal.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/SourceInfoTraversal.hs 2017-05-17 10:56:30.000000000 +0200 @@ -76,6 +76,7 @@ deriveSourceInfoTraversal ''UBracket deriveSourceInfoTraversal ''UTopLevelPragma deriveSourceInfoTraversal ''URule +deriveSourceInfoTraversal ''URuleVar deriveSourceInfoTraversal ''UAnnotationSubject deriveSourceInfoTraversal ''UMinimalFormula deriveSourceInfoTraversal ''UExprPragma @@ -106,6 +107,7 @@ deriveSourceInfoTraversal ''UCaseRhs' deriveSourceInfoTraversal ''UGuardedCaseRhs' deriveSourceInfoTraversal ''UInlinePragma +deriveSourceInfoTraversal ''USpecializePragma -- ULiteral deriveSourceInfoTraversal ''ULiteral diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/References.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/References.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/References.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/References.hs 2017-05-03 22:13:55.000000000 +0200 @@ -66,6 +66,7 @@ $(toASTReferences (makeReferences ''UInstanceHead)) $(toASTReferences (makeReferences ''UTypeEqn)) $(toASTReferences (makeReferences ''URule)) +$(toASTReferences (makeReferences ''URuleVar)) $(toASTReferences (makeReferences ''UOverlapPragma)) $(toASTReferences (makeReferences ''UCallConv)) $(toASTReferences (makeReferences ''USafety)) @@ -139,4 +140,3 @@ $(toASTReferences (makeReferences ''UQualifiedName)) $(toASTReferences (makeReferences ''UNamePart)) $(toASTReferences (makeReferences ''UStringNode)) - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Binds.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Binds.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Binds.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Binds.hs 2017-05-03 22:13:55.000000000 +0200 @@ -12,17 +12,17 @@ = USimpleBind { _valBindPat :: Ann UPattern dom stage , _valBindRhs :: Ann URhs dom stage , _valBindLocals :: AnnMaybeG ULocalBinds dom stage - } -- ^ Non-function binding (@ v = "12" @) + } -- ^ Non-function binding (@ v = "12" @) -- TODO: use one name for a function instead of names in each match | UFunBind { _funBindMatches :: AnnListG UMatch dom stage } -- ^ Function binding (@ f 0 = 1; f x = x @). All matches must have the same name. --- | Clause of function binding +-- | Clause of function binding data UMatch dom stage = UMatch { _matchLhs :: Ann UMatchLhs dom stage , _matchRhs :: Ann URhs dom stage , _matchBinds :: AnnMaybeG ULocalBinds dom stage - } + } -- | Something on the left side of the match data UMatchLhs dom stage @@ -34,12 +34,12 @@ , _matchLhsRhs :: Ann UPattern dom stage , _matchLhsArgs :: AnnListG UPattern dom stage } -- ^ An infix match lhs for an operator (@ a + b @) - --- | Local bindings attached to a declaration (@ where x = 42 @) + +-- | Local bindings attached to a declaration (@ where x = 42 @) data ULocalBinds dom stage = ULocalBinds { _localBinds :: AnnListG ULocalBind dom stage } - + -- | Bindings that are enabled in local blocks (where or let). data ULocalBind dom stage -- TODO: check that no other signature can be inside a local binding @@ -51,13 +51,13 @@ } -- ^ A local fixity declaration | ULocalInline { _localInline :: Ann UInlinePragma dom stage } -- ^ A local inline pragma - + -- | A type signature (@ f :: Int -> Int @) data UTypeSignature dom stage = UTypeSignature { _tsName :: AnnListG UName dom stage , _tsType :: Ann UType dom stage - } - + } + -- * Fixities -- | A fixity signature (@ infixl 5 +, - @). @@ -72,10 +72,10 @@ = AssocNone -- ^ non-associative operator (declared with @infix@) | AssocLeft -- ^ left-associative operator (declared with @infixl@) | AssocRight -- ^ right-associative operator (declared with @infixr@) - + -- | Numeric precedence of an operator data Precedence dom stage - = Precedence { _precedenceValue :: Int } + = Precedence { _precedenceValue :: Int } -- | Right hand side of a value binding (possible with guards): (@ = 3 @ or @ | x == 1 = 3; | otherwise = 4 @) data URhs dom stage @@ -83,12 +83,12 @@ } -- ^ An unguarded right-hand-side (@ = 3 @) | UGuardedRhss { _rhsGuards :: AnnListG UGuardedRhs dom stage } -- ^ An unguarded right-hand-side (@ | x == 1 = 3; | otherwise = 4 @) - --- | A guarded right-hand side of a value binding (@ | x > 3 = 2 @) + +-- | A guarded right-hand side of a value binding (@ | x > 3 = 2 @) data UGuardedRhs dom stage = UGuardedRhs { _guardStmts :: AnnListG URhsGuard dom stage -- ^ Cannot be empty. , _guardExpr :: Ann UExpr dom stage - } + } -- | Guards for value bindings and pattern matches (@ Just v <- x, v > 1 @) data URhsGuard dom stage @@ -118,12 +118,12 @@ -- | Controls the activation of a rewrite rule (@ [1] @) data UPhaseControl dom stage = UPhaseControl { _phaseUntil :: AnnMaybeG PhaseInvert dom stage - , _phaseNumber :: Ann PhaseNumber dom stage - } + , _phaseNumber :: AnnMaybeG PhaseNumber dom stage + } -- | Phase number for rewrite rules data PhaseNumber dom stage = PhaseNumber { _phaseNum :: Integer } -- | A tilde that marks the inversion of the phase number -data PhaseInvert dom stage = PhaseInvert \ No newline at end of file +data PhaseInvert dom stage = PhaseInvert diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Decls.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Decls.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Decls.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Decls.hs 2017-05-17 13:32:17.000000000 +0200 @@ -1,4 +1,4 @@ --- | Representation of Haskell AST definitions. These include definition of data types, classes, instances and so on. +-- | Representation of Haskell AST definitions. These include definition of data types, classes, instances and so on. -- The definition of value bindings are in the Binds module. module Language.Haskell.Tools.AST.Representation.Decls where @@ -21,7 +21,7 @@ | UTypeFamilyDecl { _declTypeFamily :: Ann UTypeFamily dom stage } -- ^ A type family declaration ( @type family F x@ ) | UClosedTypeFamilyDecl { _declHead :: Ann UDeclHead dom stage - , _declKind :: AnnMaybeG UKindConstraint dom stage + , _declSpec :: AnnMaybeG UTypeFamilySpec dom stage , _declDecl :: AnnListG UTypeEqn dom stage -- ^ cannot be empty } -- ^ A closed type family declaration | UDataDecl { _declNewtype :: Ann UDataOrNewtypeKeyword dom stage @@ -29,7 +29,7 @@ , _declHead :: Ann UDeclHead dom stage , _declCons :: AnnListG UConDecl dom stage , _declDeriving :: AnnMaybeG UDeriving dom stage - } -- ^ A data or newtype declaration. Empty data type declarations without + } -- ^ A data or newtype declaration. Empty data type declarations without -- where keyword are always belong to DataDecl. | UGDataDecl { _declNewtype :: Ann UDataOrNewtypeKeyword dom stage , _declCtx :: AnnMaybeG UContext dom stage @@ -78,11 +78,11 @@ | UForeignImport { _declCallConv :: Ann UCallConv dom stage , _declSafety :: AnnMaybeG USafety dom stage , _declName :: Ann UName dom stage - , _declType :: Ann UType dom stage + , _declForeignType :: Ann UType dom stage } -- ^ Foreign import (@ foreign import _foo :: Int -> IO Int @) | UForeignExport { _declCallConv :: Ann UCallConv dom stage , _declName :: Ann UName dom stage - , _declType :: Ann UType dom stage + , _declForeignType :: Ann UType dom stage } -- ^ Foreign export (@ foreign export ccall _foo :: Int -> IO Int @) | UPragmaDecl { _declPragma :: Ann UTopLevelPragma dom stage } -- ^ Top-level pragmas @@ -112,18 +112,20 @@ data UClassBody dom stage = UClassBody { _cbElements :: AnnListG UClassElement dom stage } - --- | Members of a class declaration + +-- | Members of a class declaration data UClassElement dom stage = UClsSig { _ceTypeSig :: Ann UTypeSignature dom stage } -- ^ Signature: @ f :: A -> B @ + | UClsFixity { _clsFixity :: Ann UFixitySignature dom stage + } -- ^ Fixity signature in class: @ infixl 1 >>- @ | UClsDef { _ceBind :: Ann UValueBind dom stage } -- ^ Default binding: @ f x = "aaa" @ | UClsTypeFam { _ceTypeFam :: Ann UTypeFamily dom stage - } -- ^ Declaration of an associated type synonym: @ type T x :: * @ + } -- ^ Declaration of an associated type synonym: @ type T x :: * @ | UClsTypeDef { _ceHead :: Ann UDeclHead dom stage , _ceKind :: Ann UType dom stage - } -- ^ Default choice for type synonym: @ type T x = TE @ or @ type instance T x = TE @ + } -- ^ Default choice for type synonym: @ type T x = TE @ or @ type instance T x = TE @ | UClsDefSig { _ceName :: Ann UName dom stage , _ceType :: Ann UType dom stage } -- ^ Default signature (by using @DefaultSignatures@): @ default _enum :: (Generic a, GEnum (Rep a)) => [a] @ @@ -136,7 +138,7 @@ -- } -- ^ Pattern signature in a class declaration (by using @PatternSynonyms@) -- * Type class instances - + -- | The instance declaration rule, which is, roughly, the part of the instance declaration before the where keyword. data UInstanceRule dom stage = UInstanceRule { _irVars :: AnnMaybeG (AnnListG UTyVar) dom stage @@ -149,7 +151,7 @@ = UInstanceHeadCon { _ihConName :: Ann UName dom stage } -- ^ Type or class name | UInstanceHeadInfix { _ihLeftOp :: Ann UType dom stage - , _ihOperator :: Ann UName dom stage + , _ihOperator :: Ann UOperator dom stage } -- ^ Infix application of the type/class name to the left operand | UInstanceHeadParen { _ihHead :: Ann UInstanceHead dom stage } -- ^ Parenthesized instance head @@ -185,11 +187,13 @@ } -- ^ Specialize instance pragma (no phase selection is allowed) | UInlineInstance { _instanceInline :: Ann UInlinePragma dom stage } -- ^ Inline-like pragma in a class instance + | UInstanceSpecialize { _specializeInstance :: Ann USpecializePragma dom stage + } -- ^ Specialize pragma -- not supported yet -- | UInstBodyPatSyn { _instBodyPatSyn :: Ann UPatternSynonym dom stage -- } -- ^ A pattern synonym in a class instance --- | Overlap pragmas. Can be applied to class declarations and class instance declarations. +-- | Overlap pragmas. Can be applied to class declarations and class instance declarations. data UOverlapPragma dom stage = UEnableOverlap -- ^ @OVERLAP@ pragma | UDisableOverlap -- ^ @NO_OVERLAP@ pragma @@ -218,7 +222,7 @@ -- | Injectivity annotation for type families (@ = r | r -> a @) data UInjectivityAnn dom stage - = UInjectivityAnn { _injAnnRes :: Ann UName dom stage + = UInjectivityAnn { _injAnnRes :: Ann UTyVar dom stage , _injAnnDeps :: AnnListG UName dom stage } @@ -233,9 +237,11 @@ -- | GADT constructor declaration (@ D1 :: { val :: Int } -> T String @) data UGadtConDecl dom stage = UGadtConDecl { _gadtConNames :: AnnListG UName dom stage + , _gadtConTypeArgs :: AnnListG UTyVar dom stage + , _gadtConTypeCtx :: AnnMaybeG UContext dom stage , _gadtConType :: Ann UGadtConType dom stage } - + -- | The @data@ or the @newtype@ keyword to define ADTs. data UDataOrNewtypeKeyword dom stage = UDataKeyword @@ -249,36 +255,42 @@ , _gadtConResultType :: Ann UType dom stage } --- | A list of functional dependencies: @ | a -> b, c -> d @ separated by commas +-- | A list of functional dependencies: @ | a -> b, c -> d @ separated by commas data UFunDeps dom stage = UFunDeps { _funDeps :: AnnListG UFunDep dom stage - } - --- | A functional dependency, given on the form @l1 ... ln -> r1 ... rn@ + } + +-- | A functional dependency, given on the form @l1 ... ln -> r1 ... rn@ data UFunDep dom stage = UFunDep { _funDepLhs :: AnnListG UName dom stage , _funDepRhs :: AnnListG UName dom stage } - + -- | A constructor declaration for a datatype data UConDecl dom stage - = UConDecl { _conDeclName :: Ann UName dom stage + = UConDecl { _conTypeArgs :: AnnListG UTyVar dom stage + , _conTypeCtx :: AnnMaybeG UContext dom stage + , _conDeclName :: Ann UName dom stage , _conDeclArgs :: AnnListG UType dom stage } -- ^ Ordinary data constructor (@ C t1 t2 @) - | URecordDecl { _conDeclName :: Ann UName dom stage + | URecordDecl { _conTypeArgs :: AnnListG UTyVar dom stage + , _conTypeCtx :: AnnMaybeG UContext dom stage + , _conDeclName :: Ann UName dom stage , _conDeclFields :: AnnListG UFieldDecl dom stage } -- ^ Record data constructor (@ C { _n1 :: t1, _n2 :: t2 } @) - | UInfixConDecl { _conDeclLhs :: Ann UType dom stage + | UInfixConDecl { _conTypeArgs :: AnnListG UTyVar dom stage + , _conTypeCtx :: AnnMaybeG UContext dom stage + , _conDeclLhs :: Ann UType dom stage , _conDeclOp :: Ann UOperator dom stage , _conDeclRhs :: Ann UType dom stage } -- ^ Infix data constructor (@ t1 :+: t2 @) - + -- | Field declaration (@ fld :: Int @) data UFieldDecl dom stage = UFieldDecl { _fieldNames :: AnnListG UName dom stage , _fieldType :: Ann UType dom stage } - + -- | A deriving clause following a data type declaration. (@ deriving Show @ or @ deriving (Show, Eq) @) data UDeriving dom stage = UDerivingOne { _oneDerived :: Ann UInstanceHead dom stage } @@ -290,7 +302,7 @@ data UPatternTypeSignature dom stage = UPatternTypeSignature { _patSigName :: Ann UName dom stage , _patSigType :: Ann UType dom stage - } + } -- | Pattern synonyms: @ pattern Arrow t1 t2 = App "->" [t1, t2] @ data UPatternSynonym dom stage @@ -325,7 +337,7 @@ = UPatSynWhere { _patOpposite :: AnnListG UMatch dom stage } -- * Foreign imports - + -- | Call conventions of foreign functions data UCallConv dom stage = UStdCall @@ -359,10 +371,10 @@ = URulePragma { _pragmaRule :: AnnListG URule dom stage } -- ^ A pragma that introduces source rewrite rules (@ {-# RULES "map/map" [2] forall f g xs. map f (map g xs) = map (f.g) xs #-} @) | UDeprPragma { _pragmaObjects :: AnnListG UName dom stage - , _pragmaMessage :: Ann UStringNode dom stage + , _deprMessage :: AnnListG UStringNode dom stage } -- ^ A pragma that marks definitions as deprecated (@ {-# DEPRECATED f "f will be replaced by g" @) | UWarningPragma { _pragmaObjects :: AnnListG UName dom stage - , _pragmaMessage :: Ann UStringNode dom stage + , _warnMessage :: AnnListG UStringNode dom stage } -- ^ A pragma that marks definitions as deprecated (@ {-# WARNING unsafePerformIO "you should know what you are doing" @) | UAnnPragma { _annotationSubject :: Ann UAnnotationSubject dom stage , _annotateExpr :: Ann UExpr dom stage @@ -372,7 +384,10 @@ | ULinePragma { _pragmaLineNum :: Ann LineNumber dom stage , _pragmaFileName :: AnnMaybeG UStringNode dom stage } -- ^ A pragma for maintaining line numbers in generated sources (@ {-# LINE 123 "somefile" #-} @) - | USpecializePragma { _pragmaPhase :: AnnMaybeG UPhaseControl dom stage + | USpecializeDecl { _specializePragma :: Ann USpecializePragma dom stage } + +data USpecializePragma dom stage + = USpecializePragma { _pragmaPhase :: AnnMaybeG UPhaseControl dom stage , _specializeDef :: Ann UName dom stage , _specializeType :: AnnListG UType dom stage } -- ^ A pragma that tells the compiler that a polymorph function should be optimized for a given type (@ {-# SPECIALISE f :: Int -> b -> b #-} @) @@ -381,12 +396,20 @@ data URule dom stage = URule { _ruleName :: Ann UStringNode dom stage -- ^ User name of the rule , _rulePhase :: AnnMaybeG UPhaseControl dom stage -- ^ The compilation phases in which the rule can be applied - , _ruleBounded :: AnnListG UTyVar dom stage -- ^ Variables bound in the rule + , _ruleBounded :: AnnListG URuleVar dom stage -- ^ Variables bound in the rule , _ruleLhs :: Ann UExpr dom stage -- ^ The transformed expression , _ruleRhs :: Ann UExpr dom stage -- ^ The resulting expression } - --- | Annotation allows you to connect an expression to any declaration. + +-- | A variable for a rewrite rule. With or without type signature. +data URuleVar dom stage + = URuleVar { _ruleVarName :: Ann UName dom stage + } -- ^ A simple rule variable + | USigRuleVar { _ruleVarName :: Ann UName dom stage + , _ruleVarType :: Ann UType dom stage + } -- ^ A rule variable with signature + +-- | Annotation allows you to connect an expression to any declaration. data UAnnotationSubject dom stage = UNameAnnotation { _annotateName :: Ann UName dom stage } -- ^ The definition with the given name is annotated @@ -407,4 +430,4 @@ -- | A line number for a line pragma. data LineNumber dom stage - = LineNumber { _lineNumber :: Int } + = LineNumber { _lineNumber :: Int } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Exprs.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Exprs.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Exprs.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Exprs.hs 2017-05-03 22:13:55.000000000 +0200 @@ -12,7 +12,7 @@ -- | Haskell expressions data UExpr dom stage - = UVar { _exprName :: Ann UName dom stage + = UVar { _exprName :: Ann UName dom stage } -- ^ A variable or a data constructor (@ a @) | ULit { _exprLit :: Ann ULiteral dom stage } -- ^ Literal expression (@ 42 @) @@ -116,7 +116,7 @@ | UStaticPtr { _exprInner :: Ann UExpr dom stage } -- ^ Static pointer expression (@ static e @). The inner expression must be closed (cannot have variables bound outside) -- XML expressions omitted - + -- | Field update expressions data UFieldUpdate dom stage = UNormalFieldUpdate { _fieldName :: Ann UName dom stage @@ -126,7 +126,7 @@ } -- ^ Update the field to the value of the same name (@ x @) | UFieldWildcard { _fieldWildcard :: Ann UFieldWildcard dom stage } -- ^ Update the fields of the bounded names to their values (@ .. @). Must be the last initializer. Cannot be used in a record update expression. - + -- | Marker for a field wildcard. Only needed to attach semantic information in a type-safe way. data UFieldWildcard dom stage = FldWildcard @@ -135,7 +135,7 @@ = Present { _tupSecExpr :: Ann UExpr dom stage } -- ^ An existing element in a tuple section | Missing -- ^ A missing element in a tuple section - + -- | Clause of case expression (@ Just x -> x + 1 @) data UAlt' expr dom stage = UAlt { _altPattern :: Ann UPattern dom stage @@ -145,7 +145,7 @@ type UAlt = UAlt' UExpr type UCmdAlt = UAlt' UCmd - + -- | Right hand side of a match (possible with guards): (@ -> 3 @ or @ | x == 1 -> 3; | otherwise -> 4 @) data UCaseRhs' expr dom stage = UUnguardedCaseRhs { _rhsCaseExpr :: Ann expr dom stage @@ -154,15 +154,15 @@ } -- ^ Guarded right-hand sides of a pattern match (@ | x == 1 -> 3; | otherwise -> 4 @) type UCaseRhs = UCaseRhs' UExpr type UCmdCaseRhs = UCaseRhs' UCmd - --- | A guarded right-hand side of pattern matches binding (@ | x > 3 -> 2 @) + +-- | A guarded right-hand side of pattern matches binding (@ | x > 3 -> 2 @) data UGuardedCaseRhs' expr dom stage = UGuardedCaseRhs { _caseGuardStmts :: AnnListG URhsGuard dom stage -- ^ Cannot be empty. , _caseGuardExpr :: Ann expr dom stage - } + } type UGuardedCaseRhs = UGuardedCaseRhs' UExpr type UCmdGuardedCaseRhs = UGuardedCaseRhs' UCmd - + -- | Pragmas that can be applied to expressions data UExprPragma dom stage = UCorePragma { _pragmaStr :: Ann UStringNode dom stage @@ -179,12 +179,12 @@ , _srFromCol :: Ann Number dom stage , _srToLine :: Ann Number dom stage , _srToCol :: Ann Number dom stage - } + } data Number dom stage - = Number { _numberInteger :: Integer + = Number { _numberInteger :: Integer } - + -- * Arrows data UCmd dom stage @@ -204,7 +204,7 @@ } -- ^ An infix command application | ULambdaCmd { _cmdBindings :: AnnListG UPattern dom stage -- ^ at least one , _cmdInner :: Ann UCmd dom stage - } -- ^ A lambda command + } -- ^ A lambda command | UParenCmd { _cmdInner :: Ann UCmd dom stage } -- ^ A parenthesized command | UCaseCmd { _cmdExpr :: Ann UExpr dom stage diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Kinds.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Kinds.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Kinds.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Kinds.hs 2017-05-17 10:56:30.000000000 +0200 @@ -2,13 +2,14 @@ module Language.Haskell.Tools.AST.Representation.Kinds where import Language.Haskell.Tools.AST.Ann (Ann, AnnListG) -import Language.Haskell.Tools.AST.Representation.Names (UName) +import Language.Haskell.Tools.AST.Representation.Names (UName, UOperator) +import {-# SOURCE #-} Language.Haskell.Tools.AST.Representation.Types (UType) -- | Kind constraint (@ :: * -> * @) data UKindConstraint dom stage - = UKindConstraint { _kindConstr :: Ann UKind dom stage + = UKindConstraint { _kindConstr :: Ann UKind dom stage } - + -- | Haskell kinds data UKind dom stage = UStarKind -- ^ @*@, the kind of types @@ -21,22 +22,30 @@ | UVarKind { _kindVar :: Ann UName dom stage } -- ^ Kind variable (using @PolyKinds@ extension) | UAppKind { _kindAppFun :: Ann UKind dom stage - , _kindAppArg :: Ann UKind dom stage + , _kindAppArg :: Ann UKind dom stage } -- ^ Kind application (@ k1 k2 @) + | UInfixAppKind { _kindLhs ::Ann UKind dom stage + , _kindAppOp :: Ann UOperator dom stage + , _kindRhs :: Ann UKind dom stage + } -- ^ Infix kind application (@ k1 ~> k2 @) | UListKind { _kindElem :: Ann UKind dom stage } -- ^ A list kind (@ [k] @) + | UTupleKind { _kindElems :: AnnListG UKind dom stage + } -- ^ A tuple kind (@ (Symbol, *) @) | UPromotedKind { _kindPromoted :: Ann (UPromoted UKind) dom stage } -- ^ A promoted kind (@ '(k1,k2,k3) @) + | UTypeKind { _kindType :: Ann UType dom stage + } -- ^ A type on the kind level with @TypeInType@ data UPromoted t dom stage - = UPromotedInt { _promotedIntValue :: Integer + = UPromotedInt { _promotedIntValue :: Integer } -- ^ Numeric value promoted to the kind level. - | UPromotedString { _promotedStringValue :: String + | UPromotedString { _promotedStringValue :: String } -- ^ String value promoted to the kind level. - | UPromotedCon { _promotedConName :: Ann UName dom stage + | UPromotedCon { _promotedConName :: Ann UName dom stage } -- ^ A data constructor value promoted to the kind level. - | UPromotedList { _promotedElements :: AnnListG t dom stage + | UPromotedList { _promotedElements :: AnnListG t dom stage } -- ^ A list of elements as a kind. - | UPromotedTuple { _promotedElements :: AnnListG t dom stage + | UPromotedTuple { _promotedElements :: AnnListG t dom stage } -- ^ A tuple of elements as a kind. - | UPromotedUnit -- ^ Kind of the unit value @()@. \ No newline at end of file + | UPromotedUnit -- ^ Kind of the unit value @()@. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Names.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Names.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Names.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Names.hs 2017-05-03 22:13:55.000000000 +0200 @@ -6,39 +6,39 @@ -- | Simple AST elements of Haskell module Language.Haskell.Tools.AST.Representation.Names where - + import Language.Haskell.Tools.AST.Ann (Ann, AnnListG(..)) data UOperator dom stage - = UBacktickOp { _operatorName :: Ann UQualifiedName dom stage + = UBacktickOp { _operatorName :: Ann UQualifiedName dom stage } -- ^ A normal name used as an operator with backticks: @ a `mod` b @ - | UNormalOp { _operatorName :: Ann UQualifiedName dom stage + | UNormalOp { _operatorName :: Ann UQualifiedName dom stage } -- ^ A normal operator used as an operator. data UName dom stage - = UParenName { _simpleName :: Ann UQualifiedName dom stage + = UParenName { _simpleName :: Ann UQualifiedName dom stage } -- ^ Parenthesized name: @ foldl (+) 0 @ - | UNormalName { _simpleName :: Ann UQualifiedName dom stage + | UNormalName { _simpleName :: Ann UQualifiedName dom stage } -- ^ A normal, non-operator name. - | UImplicitName { _simpleName :: Ann UQualifiedName dom stage + | UImplicitName { _simpleName :: Ann UQualifiedName dom stage } -- ^ Implicit name: @ ?var @ -- | Possible qualified names. Contains also implicit names. -- Linear implicit parameter: @%x@. Non-linear implicit parameter: @?x@. data UQualifiedName dom stage = UQualifiedName { _qualifiers :: AnnListG UNamePart dom stage - , _unqualifiedName :: Ann UNamePart dom stage - } + , _unqualifiedName :: Ann UNamePart dom stage + } nameFromList :: AnnListG UNamePart dom stage -> UQualifiedName dom stage -nameFromList (AnnListG a xs) | not (null xs) - = UQualifiedName (AnnListG a (init xs)) (last xs) +nameFromList (AnnListG a xs) | not (null xs) + = UQualifiedName (AnnListG a (init xs)) (last xs) nameFromList _ = error "nameFromList: empty list" - --- | Parts of a qualified name. + +-- | Parts of a qualified name. data UNamePart dom stage - = UNamePart { _simpleNameStr :: String } - + = UNamePart { _simpleNameStr :: String } + -- | Program elements formatted as string literals (import packages, pragma texts) data UStringNode dom stage - = UStringNode { _stringNodeStr :: String } + = UStringNode { _stringNodeStr :: String } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Types.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Types.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Types.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Types.hs 2017-05-03 22:13:55.000000000 +0200 @@ -65,10 +65,8 @@ -- One or more assertions data UContext dom stage - = UContextOne { _contextAssertion :: Ann UAssertion dom stage - } -- ^ One assertion (@ C a => ... @) - | UContextMulti { _contextAssertions :: AnnListG UAssertion dom stage - } -- ^ A set of assertions (@ (C1 a, C2 b) => ... @, but can be one: @ (C a) => ... @) + = UContext { _contextAssertion :: Ann UAssertion dom stage + } -- ^ Assertions with the fat arrow (@ C a => ... @) -- | A single assertion in the context data UAssertion dom stage @@ -82,5 +80,6 @@ | UImplicitAssert { _assertImplVar :: Ann UName dom stage , _assertImplType :: Ann UType dom stage } -- ^ Assertion for implicit parameter binding (@ ?cmp :: a -> a -> Bool @) - - \ No newline at end of file + | UTupleAssert { _innerAsserts :: AnnListG UAssertion dom stage + } -- ^ Multiple assertions in one (@ (Ord a, Show a) @) + | UWildcardAssert -- ^ Wildcard assertion (@ _ @), enabled by @PartialTypeSignatures@ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Types.hs-boot new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Types.hs-boot --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Types.hs-boot 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Types.hs-boot 2017-05-03 22:13:55.000000000 +0200 @@ -0,0 +1,6 @@ +{-# LANGUAGE RoleAnnotations #-} +-- | Representation of Haskell types +module Language.Haskell.Tools.AST.Representation.Types where + +type role UType nominal nominal +data UType dom stage diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/SemaInfoClasses.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/SemaInfoClasses.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/SemaInfoClasses.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/SemaInfoClasses.hs 2017-05-22 15:12:54.000000000 +0200 @@ -4,7 +4,7 @@ , TypeFamilies , UndecidableInstances #-} -module Language.Haskell.Tools.AST.SemaInfoClasses where +module Language.Haskell.Tools.AST.SemaInfoClasses (module Language.Haskell.Tools.AST.SemaInfoClasses, UsageSpec(..)) where import GHC import Id as GHC (Id, idName) @@ -33,7 +33,7 @@ semanticsName = fmap idName . (^? cnameInfo) instance HasNameInfo dom => HasNameInfo' (Ann UQualifiedName dom st) where - semanticsName = semanticsName . (^. annotation&semanticInfo) + semanticsName = semanticsName . (^. annotation&semanticInfo) -- * Information about typed names @@ -47,7 +47,7 @@ semanticsId = (^. cnameInfo) instance HasIdInfo dom => HasIdInfo' (Ann UQualifiedName dom st) where - semanticsId = semanticsId . (^. annotation&semanticInfo) + semanticsId = semanticsId . (^. annotation&semanticInfo) -- * Fixity information @@ -61,7 +61,7 @@ semanticsFixity = (^. cnameFixity) instance HasFixityInfo dom => HasFixityInfo' (Ann UQualifiedName dom st) where - semanticsFixity = semanticsFixity . (^. annotation&semanticInfo) + semanticsFixity = semanticsFixity . (^. annotation&semanticInfo) -- * Scope information @@ -81,10 +81,10 @@ semanticsScope = (^. exprScopedLocals) instance HasScopeInfo dom => HasScopeInfo' (Ann UExpr dom st) where - semanticsScope = semanticsScope . (^. annotation&semanticInfo) + semanticsScope = semanticsScope . (^. annotation&semanticInfo) instance HasScopeInfo dom => HasScopeInfo' (Ann UQualifiedName dom st) where - semanticsScope = semanticsScope . (^. annotation&semanticInfo) + semanticsScope = semanticsScope . (^. annotation&semanticInfo) -- * Information about names being defined @@ -101,7 +101,7 @@ semanticsDefining = (^. cnameIsDefined) instance HasDefiningInfo dom => HasDefiningInfo' (Ann UQualifiedName dom st) where - semanticsDefining = semanticsDefining . (^. annotation&semanticInfo) + semanticsDefining = semanticsDefining . (^. annotation&semanticInfo) -- * Information about source info in sema @@ -117,6 +117,7 @@ class HasModuleInfo' si where semanticsModule :: si -> GHC.Module + semanticsDynFlags :: si -> GHC.DynFlags isBootModule :: si -> Bool semanticsImplicitImports :: si -> [GHC.Name] semanticsPrelOrphanInsts :: si -> [ClsInst] @@ -124,6 +125,7 @@ instance HasModuleInfo' (AST.ModuleInfo GHC.Name) where semanticsModule = (^. defModuleName) + semanticsDynFlags = (^. defDynFlags) isBootModule = (^. defIsBootModule) semanticsImplicitImports = (^. implicitNames) semanticsPrelOrphanInsts = (^. prelOrphanInsts) @@ -131,22 +133,24 @@ instance HasModuleInfo' (AST.ModuleInfo GHC.Id) where semanticsModule = (^. defModuleName) + semanticsDynFlags = (^. defDynFlags) isBootModule = (^. defIsBootModule) semanticsImplicitImports = map idName . (^. implicitNames) semanticsPrelOrphanInsts = (^. prelOrphanInsts) semanticsPrelFamInsts = (^. prelFamInsts) instance HasModuleInfo dom => HasModuleInfo' (Ann UModule dom st) where - semanticsModule = semanticsModule . (^. annotation&semanticInfo) - isBootModule = isBootModule . (^. annotation&semanticInfo) - semanticsImplicitImports = semanticsImplicitImports . (^. annotation&semanticInfo) - semanticsPrelOrphanInsts = semanticsPrelOrphanInsts . (^. annotation&semanticInfo) - semanticsPrelFamInsts = semanticsPrelFamInsts . (^. annotation&semanticInfo) + semanticsModule = semanticsModule . (^. annotation&semanticInfo) + semanticsDynFlags = semanticsDynFlags . (^. annotation&semanticInfo) + isBootModule = isBootModule . (^. annotation&semanticInfo) + semanticsImplicitImports = semanticsImplicitImports . (^. annotation&semanticInfo) + semanticsPrelOrphanInsts = semanticsPrelOrphanInsts . (^. annotation&semanticInfo) + semanticsPrelFamInsts = semanticsPrelFamInsts . (^. annotation&semanticInfo) -- * Information about imports type HasImportInfo dom = (Domain dom, HasImportInfo' (SemanticInfo dom AST.UImportDecl)) - + class HasImportInfo' si where semanticsImportedModule :: si -> GHC.Module semanticsAvailable :: si -> [GHC.Name] @@ -169,16 +173,16 @@ semanticsFamInsts = (^. importedFamInsts) instance HasImportInfo dom => HasImportInfo' (Ann UImportDecl dom st) where - semanticsImportedModule = semanticsImportedModule . (^. annotation&semanticInfo) - semanticsAvailable = semanticsAvailable . (^. annotation&semanticInfo) - semanticsImported = semanticsImported . (^. annotation&semanticInfo) - semanticsOrphanInsts = semanticsOrphanInsts . (^. annotation&semanticInfo) - semanticsFamInsts = semanticsFamInsts . (^. annotation&semanticInfo) + semanticsImportedModule = semanticsImportedModule . (^. annotation&semanticInfo) + semanticsAvailable = semanticsAvailable . (^. annotation&semanticInfo) + semanticsImported = semanticsImported . (^. annotation&semanticInfo) + semanticsOrphanInsts = semanticsOrphanInsts . (^. annotation&semanticInfo) + semanticsFamInsts = semanticsFamInsts . (^. annotation&semanticInfo) --- * Information about implicitely bounded fields +-- * Information about implicitly bounded fields type HasImplicitFieldsInfo dom = (Domain dom, HasImplicitFieldsInfo' (SemanticInfo dom AST.UFieldWildcard)) - + class HasImplicitFieldsInfo' si where semanticsImplicitFlds :: si -> [(GHC.Name, GHC.Name)] @@ -186,7 +190,7 @@ semanticsImplicitFlds = (^. implicitFieldBindings) instance HasImplicitFieldsInfo dom => HasImplicitFieldsInfo' (Ann UFieldWildcard dom st) where - semanticsImplicitFlds = semanticsImplicitFlds . (^. annotation&semanticInfo) + semanticsImplicitFlds = semanticsImplicitFlds . (^. annotation&semanticInfo) -- * AST elements with no information diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/SemaInfoTypes.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/SemaInfoTypes.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/SemaInfoTypes.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/SemaInfoTypes.hs 2017-05-22 15:12:54.000000000 +0200 @@ -1,18 +1,18 @@ {-# LANGUAGE DeriveDataTypeable - , StandaloneDeriving - , TemplateHaskell + , StandaloneDeriving + , TemplateHaskell , UndecidableInstances , FlexibleContexts , FlexibleInstances #-} module Language.Haskell.Tools.AST.SemaInfoTypes - ( -- types + ( -- types NoSemanticInfo, ScopeInfo, NameInfo, CNameInfo, ModuleInfo, ImportInfo, ImplicitFieldInfo - , Scope + , Scope, UsageSpec(..) -- references , exprScopedLocals, nameScopedLocals, nameIsDefined, nameInfo, ambiguousName, nameLocation , implicitName, cnameScopedLocals, cnameIsDefined, cnameInfo, cnameFixity - , defModuleName, defIsBootModule, implicitNames, importedModule, availableNames, importedNames + , defModuleName, defDynFlags, defIsBootModule, implicitNames, importedModule, availableNames, importedNames , implicitFieldBindings, importedOrphanInsts, importedFamInsts, prelOrphanInsts, prelFamInsts -- creator functions , mkNoSemanticInfo, mkScopeInfo, mkNameInfo, mkAmbiguousNameInfo, mkImplicitNameInfo, mkCNameInfo @@ -20,6 +20,7 @@ ) where import BasicTypes as GHC +import DynFlags as GHC import FamInstEnv as GHC import Id as GHC import InstEnv as GHC @@ -34,18 +35,30 @@ import Control.Reference -type Scope = [[Name]] +type Scope = [[(Name, Maybe [UsageSpec])]] --- | Semantic info type for any node not +data UsageSpec = UsageSpec { usageQualified :: Bool + , usageQualifier :: String + , usageAs :: String + } + deriving (Eq, Data) + +instance Outputable UsageSpec where + ppr (UsageSpec q useQ asQ) + = GHC.text $ (if q then "qualified " else "") ++ "as " ++ (if useQ == asQ || q then asQ else asQ ++ " or " ++ useQ) + pprPrec _ (UsageSpec q useQ asQ) + = GHC.text $ (if q then "qualified " else "") ++ "as " ++ (if useQ == asQ || q then asQ else asQ ++ " or " ++ useQ) + +-- | Semantic info type for any node not -- carrying additional semantic information -data NoSemanticInfo = NoSemanticInfo +data NoSemanticInfo = NoSemanticInfo deriving (Eq, Data) mkNoSemanticInfo :: NoSemanticInfo mkNoSemanticInfo = NoSemanticInfo -- | Info for expressions that tells which definitions are in scope -data ScopeInfo = ScopeInfo { _exprScopedLocals :: Scope +data ScopeInfo = ScopeInfo { _exprScopedLocals :: Scope } deriving (Eq, Data) @@ -57,7 +70,7 @@ data NameInfo n = NameInfo { _nameScopedLocals :: Scope , _nameIsDefined :: Bool , _nameInfo :: n - } + } | AmbiguousNameInfo { _nameScopedLocals :: Scope , _nameIsDefined :: Bool , _ambiguousName :: RdrName @@ -96,24 +109,33 @@ mkCNameInfo = CNameInfo -- | Info for the module element -data ModuleInfo n = ModuleInfo { _defModuleName :: GHC.Module +data ModuleInfo n = ModuleInfo { _defModuleName :: GHC.Module + , _defDynFlags :: DynFlags -- ^ The compilation flags that are set up when the module was compiled , _defIsBootModule :: Bool -- ^ True if this module is created from a hs-boot file - , _implicitNames :: [n] -- ^ Implicitely imported names - , _prelOrphanInsts :: [ClsInst] -- ^ Class instances implicitely passed from Prelude. - , _prelFamInsts :: [FamInst] -- ^ Family instances implicitely passed from Prelude. - } + , _implicitNames :: [n] -- ^ implicitly imported names + , _prelOrphanInsts :: [ClsInst] -- ^ Class instances implicitly passed from Prelude. + , _prelFamInsts :: [FamInst] -- ^ Family instances implicitly passed from Prelude. + } deriving Data +instance Data DynFlags where + gunfold k z c = error "Cannot construct dyn flags" + toConstr _ = dynFlagsCon + dataTypeOf _ = dynFlagsType + +dynFlagsType = mkDataType "DynFlags.DynFlags" [dynFlagsCon] +dynFlagsCon = mkConstr dynFlagsType "DynFlags" [] Prefix + -- | Creates semantic information for the module element -mkModuleInfo :: GHC.Module -> Bool -> [n] -> [ClsInst] -> [FamInst] -> ModuleInfo n +mkModuleInfo :: GHC.Module -> DynFlags -> Bool -> [n] -> [ClsInst] -> [FamInst] -> ModuleInfo n mkModuleInfo = ModuleInfo -- | Info corresponding to an import declaration data ImportInfo n = ImportInfo { _importedModule :: GHC.Module -- ^ The name and package of the imported module , _availableNames :: [n] -- ^ Names available from the imported module , _importedNames :: [n] -- ^ Names actually imported from the module. - , _importedOrphanInsts :: [ClsInst] -- ^ Class instances implicitely passed. - , _importedFamInsts :: [FamInst] -- ^ Family instances implicitely passed. + , _importedOrphanInsts :: [ClsInst] -- ^ Class instances implicitly passed. + , _importedFamInsts :: [FamInst] -- ^ Family instances implicitly passed. } deriving Data @@ -125,8 +147,8 @@ mkImportInfo = ImportInfo -- | Info corresponding to an record-wildcard -data ImplicitFieldInfo = ImplicitFieldInfo { _implicitFieldBindings :: [(Name, Name)] -- ^ The implicitely bounded names - } +data ImplicitFieldInfo = ImplicitFieldInfo { _implicitFieldBindings :: [(Name, Name)] -- ^ The implicitly bounded names + } deriving (Eq, Data) -- | Creates semantic information for a wildcard field binding @@ -145,13 +167,13 @@ show (CNameInfo locals defined nameInfo fixity) = "(CNameInfo " ++ showSDocUnsafe (ppr locals) ++ " " ++ show defined ++ " " ++ showSDocUnsafe (ppr nameInfo) ++ showSDocUnsafe (ppr fixity) ++ ")" instance Outputable n => Show (ModuleInfo n) where - show (ModuleInfo mod isboot imp clsInsts famInsts) - = "(ModuleInfo " ++ showSDocUnsafe (ppr mod) ++ " " ++ show isboot ++ " " ++ showSDocUnsafe (ppr imp) ++ " " + show (ModuleInfo mod _ isboot imp clsInsts famInsts) + = "(ModuleInfo " ++ showSDocUnsafe (ppr mod) ++ " " ++ show isboot ++ " " ++ showSDocUnsafe (ppr imp) ++ " " ++ showSDocUnsafe (ppr clsInsts) ++ " " ++ showSDocUnsafe (ppr famInsts) ++ ")" instance Outputable n => Show (ImportInfo n) where - show (ImportInfo mod avail imported clsInsts famInsts) - = "(ImportInfo " ++ showSDocUnsafe (ppr mod) ++ " " ++ showSDocUnsafe (ppr avail) ++ " " ++ showSDocUnsafe (ppr imported) ++ " " + show (ImportInfo mod avail imported clsInsts famInsts) + = "(ImportInfo " ++ showSDocUnsafe (ppr mod) ++ " " ++ showSDocUnsafe (ppr avail) ++ " " ++ showSDocUnsafe (ppr imported) ++ " " ++ showSDocUnsafe (ppr clsInsts) ++ " " ++ showSDocUnsafe (ppr famInsts) ++ ")" instance Show ImplicitFieldInfo where @@ -192,10 +214,9 @@ traverse _ (ImplicitNameInfo locals defined nameInfo span) = pure $ ImplicitNameInfo locals defined nameInfo span instance Traversable ModuleInfo where - traverse f (ModuleInfo mod isboot imp clsInsts famInsts) - = ModuleInfo mod isboot <$> traverse f imp <*> pure clsInsts <*> pure famInsts + traverse f (ModuleInfo mod dfs isboot imp clsInsts famInsts) + = ModuleInfo mod dfs isboot <$> traverse f imp <*> pure clsInsts <*> pure famInsts instance Traversable ImportInfo where - traverse f (ImportInfo mod avail imps clsInsts famInsts) + traverse f (ImportInfo mod avail imps clsInsts famInsts) = ImportInfo mod <$> traverse f avail <*> traverse f imps <*> pure clsInsts <*> pure famInsts - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Utils/OrdSrcSpan.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Utils/OrdSrcSpan.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Utils/OrdSrcSpan.hs 2017-01-31 20:47:40.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Utils/OrdSrcSpan.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,30 +0,0 @@ --- | A wrapper for SrcSpans that is ordered. -module Language.Haskell.Tools.AST.Utils.OrdSrcSpan where - -import FastString (FastString) -import SrcLoc - --- | Wraps the SrcSpan into an ordered source span -ordSrcSpan :: SrcSpan -> OrdSrcSpan -ordSrcSpan (RealSrcSpan sp) = OrdSrcSpan sp -ordSrcSpan (UnhelpfulSpan fs) = NoOrdSrcSpan fs - --- | Unwrap the ordered source span -fromOrdSrcSpan :: OrdSrcSpan -> SrcSpan -fromOrdSrcSpan (OrdSrcSpan sp) = RealSrcSpan sp -fromOrdSrcSpan (NoOrdSrcSpan fs) = UnhelpfulSpan fs - --- | A wrapper for SrcSpans that is ordered. -data OrdSrcSpan - = OrdSrcSpan RealSrcSpan - | NoOrdSrcSpan FastString - deriving (Show, Eq) - -instance Ord OrdSrcSpan where - compare (NoOrdSrcSpan _) (NoOrdSrcSpan _) = EQ - compare (OrdSrcSpan _) (NoOrdSrcSpan _) = GT - compare (NoOrdSrcSpan _) (OrdSrcSpan _) = LT - compare (OrdSrcSpan rsp1) (OrdSrcSpan rsp2) - = compare (realSrcSpanStart rsp1) (realSrcSpanStart rsp2) - `mappend` compare (realSrcSpanEnd rsp1) (realSrcSpanEnd rsp2) - \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST.hs 2017-05-03 22:13:55.000000000 +0200 @@ -1,7 +1,7 @@ -- | A custom AST representation for Haskell tools. -- Different layers of the AST are recursive, to separate them into modules -- we introduced source imports. -module Language.Haskell.Tools.AST +module Language.Haskell.Tools.AST ( module Language.Haskell.Tools.AST.References , module Language.Haskell.Tools.AST.Helpers , module Language.Haskell.Tools.AST.Representation.Modules @@ -16,7 +16,6 @@ , module Language.Haskell.Tools.AST.Representation.Literals , module Language.Haskell.Tools.AST.Representation.Names , module Language.Haskell.Tools.AST.Ann - , module Language.Haskell.Tools.AST.Utils.OrdSrcSpan , module Language.Haskell.Tools.AST.SemaInfoClasses ) where @@ -37,4 +36,3 @@ import Language.Haskell.Tools.AST.Representation.TH import Language.Haskell.Tools.AST.Representation.Types import Language.Haskell.Tools.AST.SemaInfoClasses -import Language.Haskell.Tools.AST.Utils.OrdSrcSpan diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/haskell-tools-ast.cabal new/haskell-tools-ast-0.8.0.0/haskell-tools-ast.cabal --- old/haskell-tools-ast-0.5.0.0/haskell-tools-ast.cabal 2017-01-31 20:57:34.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/haskell-tools-ast.cabal 2017-07-01 12:34:40.000000000 +0200 @@ -1,5 +1,5 @@ name: haskell-tools-ast -version: 0.5.0.0 +version: 0.8.0.0 synopsis: Haskell AST for efficient tooling description: A representation of a Haskell Syntax tree that contain source-related and semantic annotations. These annotations help developer tools to work with the defined program. The source information enables refactoring and program transformation tools to change the source code without losing the original format (layout, comments) of the source. Semantic information helps analyzing the program. The representation is different from the GHC's syntax tree. It contains information from all representations in GHC (different version of syntax trees, lexical and module-level information). The module is split up to put the representation of different language elements into different modules. Additionally, it contains the representation of semantic and source annotations, helper functions and generated instances for the representation of language elements. Because langauge elements may refer each other (there can be a pattern inside an expression in case of a pattern match and an expression inside a pattern if view patterns are enabled), we use hs-boot files to break up dependency cycles. @@ -13,13 +13,13 @@ cabal-version: >=1.10 library - ghc-options: -O2 + ghc-options: -O2 exposed-modules: Language.Haskell.Tools.AST , Language.Haskell.Tools.AST.References , Language.Haskell.Tools.AST.Helpers , Language.Haskell.Tools.AST.Ann , Language.Haskell.Tools.AST.SemaInfoTypes - , Language.Haskell.Tools.AST.SemaInfoClasses + , Language.Haskell.Tools.AST.SemaInfoClasses other-modules: Language.Haskell.Tools.AST.Representation.Modules , Language.Haskell.Tools.AST.Representation.TH @@ -34,7 +34,6 @@ , Language.Haskell.Tools.AST.Representation.Names , Language.Haskell.Tools.AST.MakeASTReferences - , Language.Haskell.Tools.AST.Utils.OrdSrcSpan , Language.Haskell.Tools.AST.Utils.GHCInstances , Language.Haskell.Tools.AST.Instances @@ -46,11 +45,11 @@ , Language.Haskell.Tools.AST.Instances.SourceInfoTraversal , Language.Haskell.Tools.AST.TH.SemanticTraversal , Language.Haskell.Tools.AST.TH.SourceInfoTraversal - + build-depends: base >= 4.9 && < 4.10 , ghc >= 8.0 && < 8.1 , references >= 0.3 && < 0.4 , uniplate >= 1.6 && < 1.7 , mtl >= 2.2 && < 2.3 , template-haskell >= 2.11 && < 2.12 - default-language: Haskell2010 \ No newline at end of file + default-language: Haskell2010