haskell-tools-ast 0.2.0.0 → 1.1.1.0
raw patch · 53 files changed
Files
- Language/Haskell/Tools/AST.hs +32/−21
- Language/Haskell/Tools/AST/Ann.hs +184/−180
- Language/Haskell/Tools/AST/Base.hs +0/−121
- Language/Haskell/Tools/AST/Base.hs-boot +0/−5
- Language/Haskell/Tools/AST/Binds.hs +0/−151
- Language/Haskell/Tools/AST/Binds.hs-boot +0/−11
- Language/Haskell/Tools/AST/Decls.hs +0/−299
- Language/Haskell/Tools/AST/Exprs.hs +0/−220
- Language/Haskell/Tools/AST/Exprs.hs-boot +0/−11
- Language/Haskell/Tools/AST/Helpers.hs +88/−136
- Language/Haskell/Tools/AST/Instances.hs +5/−6
- Language/Haskell/Tools/AST/Instances/ClassyPlate.hs +169/−0
- Language/Haskell/Tools/AST/Instances/Data.hs +154/−114
- Language/Haskell/Tools/AST/Instances/Eq.hs +0/−137
- Language/Haskell/Tools/AST/Instances/Generic.hs +131/−120
- Language/Haskell/Tools/AST/Instances/SemanticTraversal.hs +119/−112
- Language/Haskell/Tools/AST/Instances/Show.hs +0/−138
- Language/Haskell/Tools/AST/Instances/SourceInfoTraversal.hs +119/−112
- Language/Haskell/Tools/AST/Kinds.hs +0/−38
- Language/Haskell/Tools/AST/Literals.hs +0/−29
- Language/Haskell/Tools/AST/MakeASTReferences.hs +26/−0
- Language/Haskell/Tools/AST/Modules.hs +0/−96
- Language/Haskell/Tools/AST/Modules.hs-boot +0/−8
- Language/Haskell/Tools/AST/Patterns.hs +0/−70
- Language/Haskell/Tools/AST/References.hs +142/−117
- Language/Haskell/Tools/AST/Representation/Binds.hs +129/−0
- Language/Haskell/Tools/AST/Representation/Binds.hs-boot +12/−0
- Language/Haskell/Tools/AST/Representation/Decls.hs +448/−0
- Language/Haskell/Tools/AST/Representation/Exprs.hs +234/−0
- Language/Haskell/Tools/AST/Representation/Exprs.hs-boot +15/−0
- Language/Haskell/Tools/AST/Representation/Kinds.hs +51/−0
- Language/Haskell/Tools/AST/Representation/Literals.hs +26/−0
- Language/Haskell/Tools/AST/Representation/Modules.hs +107/−0
- Language/Haskell/Tools/AST/Representation/Modules.hs-boot +9/−0
- Language/Haskell/Tools/AST/Representation/Names.hs +42/−0
- Language/Haskell/Tools/AST/Representation/Names.hs-boot +6/−0
- Language/Haskell/Tools/AST/Representation/Patterns.hs +74/−0
- Language/Haskell/Tools/AST/Representation/Stmts.hs +43/−0
- Language/Haskell/Tools/AST/Representation/TH.hs +40/−0
- Language/Haskell/Tools/AST/Representation/TH.hs-boot +12/−0
- Language/Haskell/Tools/AST/Representation/Types.hs +87/−0
- Language/Haskell/Tools/AST/Representation/Types.hs-boot +7/−0
- Language/Haskell/Tools/AST/SemaInfoClasses.hs +126/−27
- Language/Haskell/Tools/AST/SemaInfoTypes.hs +171/−63
- Language/Haskell/Tools/AST/Stmts.hs +0/−38
- Language/Haskell/Tools/AST/TH.hs +0/−41
- Language/Haskell/Tools/AST/TH.hs-boot +0/−11
- Language/Haskell/Tools/AST/TH/SemanticTraversal.hs +21/−21
- Language/Haskell/Tools/AST/TH/SourceInfoTraversal.hs +20/−20
- Language/Haskell/Tools/AST/Types.hs +0/−87
- Language/Haskell/Tools/AST/Utils/GHCInstances.hs +9/−2
- Language/Haskell/Tools/AST/Utils/OrdSrcSpan.hs +0/−30
- haskell-tools-ast.cabal +32/−28
Language/Haskell/Tools/AST.hs view
@@ -1,27 +1,38 @@ -- | 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 Exported +module Language.Haskell.Tools.AST + ( module Language.Haskell.Tools.AST.References + , module Language.Haskell.Tools.AST.Helpers + , module Language.Haskell.Tools.AST.Representation.Modules + , module Language.Haskell.Tools.AST.Representation.TH + , module Language.Haskell.Tools.AST.Representation.Decls + , module Language.Haskell.Tools.AST.Representation.Binds + , module Language.Haskell.Tools.AST.Representation.Exprs + , module Language.Haskell.Tools.AST.Representation.Stmts + , module Language.Haskell.Tools.AST.Representation.Patterns + , module Language.Haskell.Tools.AST.Representation.Types + , module Language.Haskell.Tools.AST.Representation.Kinds + , 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.SemaInfoClasses ) where -import Language.Haskell.Tools.AST.Instances - -import Language.Haskell.Tools.AST.References as Exported -import Language.Haskell.Tools.AST.Helpers as Exported +import Language.Haskell.Tools.AST.Instances () -import Language.Haskell.Tools.AST.Modules as Exported -import Language.Haskell.Tools.AST.TH as Exported -import Language.Haskell.Tools.AST.Decls as Exported -import Language.Haskell.Tools.AST.Binds as Exported -import Language.Haskell.Tools.AST.Exprs as Exported -import Language.Haskell.Tools.AST.Stmts as Exported -import Language.Haskell.Tools.AST.Patterns as Exported -import Language.Haskell.Tools.AST.Types as Exported -import Language.Haskell.Tools.AST.Kinds as Exported -import Language.Haskell.Tools.AST.Literals as Exported -import Language.Haskell.Tools.AST.Base as Exported -import Language.Haskell.Tools.AST.Ann as Exported -import Language.Haskell.Tools.AST.Utils.OrdSrcSpan as Exported -import Language.Haskell.Tools.AST.SemaInfoTypes as Exported -import Language.Haskell.Tools.AST.SemaInfoClasses as Exported+import Language.Haskell.Tools.AST.Ann +import Language.Haskell.Tools.AST.Helpers +import Language.Haskell.Tools.AST.References +import Language.Haskell.Tools.AST.Representation.Binds +import Language.Haskell.Tools.AST.Representation.Decls +import Language.Haskell.Tools.AST.Representation.Exprs +import Language.Haskell.Tools.AST.Representation.Kinds +import Language.Haskell.Tools.AST.Representation.Literals +import Language.Haskell.Tools.AST.Representation.Modules +import Language.Haskell.Tools.AST.Representation.Names +import Language.Haskell.Tools.AST.Representation.Patterns +import Language.Haskell.Tools.AST.Representation.Stmts +import Language.Haskell.Tools.AST.Representation.TH +import Language.Haskell.Tools.AST.Representation.Types +import Language.Haskell.Tools.AST.SemaInfoClasses
Language/Haskell/Tools/AST/Ann.hs view
@@ -1,35 +1,33 @@-{-# LANGUAGE FlexibleInstances - , FlexibleContexts - , TemplateHaskell - , DeriveDataTypeable - , StandaloneDeriving - , KindSignatures - , TypeFamilies - , MultiParamTypeClasses - , UndecidableInstances - , AllowAmbiguousTypes - , TypeApplications - , ScopedTypeVariables - #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} + -- | Parts of AST representation for keeping extra data module Language.Haskell.Tools.AST.Ann where -import Data.Data -import Control.Monad.Identity import Control.Reference -import SrcLoc as GHC +import Data.Data +import FastString import Id as GHC -import qualified Name as GHC -import RdrName -import Module -import Id -import Outputable -import Language.Haskell.Tools.AST.Utils.GHCInstances import Language.Haskell.Tools.AST.SemaInfoTypes +import Language.Haskell.Tools.AST.Utils.GHCInstances () +import qualified Name as GHC +import SrcLoc as GHC +import HsExtension -import {-# SOURCE #-} Language.Haskell.Tools.AST.Modules as AST -import {-# SOURCE #-} Language.Haskell.Tools.AST.Base as AST -import {-# SOURCE #-} Language.Haskell.Tools.AST.Exprs as AST +import {-# SOURCE #-} Language.Haskell.Tools.AST.Representation.Exprs as AST +import {-# SOURCE #-} Language.Haskell.Tools.AST.Representation.Modules as AST +import {-# SOURCE #-} Language.Haskell.Tools.AST.Representation.Names as AST +import Language.Haskell.Tools.AST.Representation.Literals as AST -- * Annotation type resolution @@ -74,83 +72,60 @@ type SemanticInfo (domain :: *) (node :: * -> * -> *) = SemanticInfo' domain (SemaInfoClassify node) -data SameInfoNameCls -data SameInfoExprCls -data SameInfoImportCls -data SameInfoModuleCls -data SameInfoDefaultCls -data SameInfoWildcardCls +data SemaInfoNameCls +data SemaInfoLitCls +data SemaInfoExprCls +data SemaInfoImportCls +data SemaInfoModuleCls +data SemaInfoDefaultCls +data SemaInfoWildcardCls type family SemaInfoClassify (node :: * -> * -> *) where - SemaInfoClassify QualifiedName = SameInfoNameCls - SemaInfoClassify Expr = SameInfoExprCls - SemaInfoClassify ImportDecl = SameInfoImportCls - SemaInfoClassify AST.Module = SameInfoModuleCls - SemaInfoClassify FieldWildcard = SameInfoWildcardCls - SemaInfoClassify a = SameInfoDefaultCls + SemaInfoClassify UQualifiedName = SemaInfoNameCls + SemaInfoClassify ULiteral = SemaInfoLitCls + SemaInfoClassify UExpr = SemaInfoExprCls + SemaInfoClassify UImportDecl = SemaInfoImportCls + SemaInfoClassify AST.UModule = SemaInfoModuleCls + SemaInfoClassify UFieldWildcard = SemaInfoWildcardCls + SemaInfoClassify a = SemaInfoDefaultCls type family SemanticInfo' (domain :: *) (nodecls :: *) -type instance SemanticInfo' (Dom n) SameInfoNameCls = NameInfo n -type instance SemanticInfo' (Dom n) SameInfoExprCls = ScopeInfo -type instance SemanticInfo' (Dom n) SameInfoImportCls = ImportInfo n -type instance SemanticInfo' (Dom n) SameInfoModuleCls = ModuleInfo GHC.Name -type instance SemanticInfo' (Dom n) SameInfoWildcardCls = ImplicitFieldInfo -type instance SemanticInfo' (Dom n) SameInfoDefaultCls = NoSemanticInfo - -type instance SemanticInfo' IdDom SameInfoNameCls = CNameInfo -type instance SemanticInfo' IdDom SameInfoExprCls = ScopeInfo -type instance SemanticInfo' IdDom SameInfoImportCls = ImportInfo GHC.Id -type instance SemanticInfo' IdDom SameInfoModuleCls = ModuleInfo GHC.Id -type instance SemanticInfo' IdDom SameInfoWildcardCls = ImplicitFieldInfo -type instance SemanticInfo' IdDom SameInfoDefaultCls = NoSemanticInfo +type instance SemanticInfo' (Dom n) SemaInfoNameCls = NameInfo n +type instance SemanticInfo' (Dom n) SemaInfoLitCls = PreLiteralInfo +type instance SemanticInfo' (Dom n) SemaInfoExprCls = ScopeInfo +type instance SemanticInfo' (Dom n) SemaInfoImportCls = ImportInfo n +type instance SemanticInfo' (Dom n) SemaInfoModuleCls = ModuleInfo GhcRn +type instance SemanticInfo' (Dom n) SemaInfoWildcardCls = ImplicitFieldInfo +type instance SemanticInfo' (Dom n) SemaInfoDefaultCls = NoSemanticInfo --- | Class for domain configuration markers -class ( Typeable d - , Data d - , SemanticInfo' d SameInfoDefaultCls ~ NoSemanticInfo - , Data (SemanticInfo' d SameInfoNameCls) - , Data (SemanticInfo' d SameInfoExprCls) - , Data (SemanticInfo' d SameInfoImportCls) - , Data (SemanticInfo' d SameInfoModuleCls) - , Data (SemanticInfo' d SameInfoWildcardCls) - , Show (SemanticInfo' d SameInfoNameCls) - , Show (SemanticInfo' d SameInfoExprCls) - , Show (SemanticInfo' d SameInfoImportCls) - , Show (SemanticInfo' d SameInfoModuleCls) - , Show (SemanticInfo' d SameInfoWildcardCls) - ) => Domain d where +type instance SemanticInfo' IdDom SemaInfoNameCls = CNameInfo +type instance SemanticInfo' IdDom SemaInfoExprCls = ScopeInfo +type instance SemanticInfo' IdDom SemaInfoLitCls = LiteralInfo +type instance SemanticInfo' IdDom SemaInfoImportCls = ImportInfo GhcTc +type instance SemanticInfo' IdDom SemaInfoModuleCls = ModuleInfo GhcTc +type instance SemanticInfo' IdDom SemaInfoWildcardCls = ImplicitFieldInfo +type instance SemanticInfo' IdDom SemaInfoDefaultCls = NoSemanticInfo -- | A semantic domain for the AST. The semantic domain maps semantic information for -- the different types of nodes in the AST. The kind of semantic domain for an AST --- depends on which stages of the compilation did it pass. However after transforming --- the GHC representation to our AST, the domain keeps the same. +-- depends on which stages of the compilation it passed. However after transforming +-- the GHC representation to our AST, the domain stays the same. -- The domain is not applied to the AST elements that are generated while refactoring. -instance ( Typeable d - , Data d - , SemanticInfo' d SameInfoDefaultCls ~ NoSemanticInfo - , Data (SemanticInfo' d SameInfoNameCls) - , Data (SemanticInfo' d SameInfoExprCls) - , Data (SemanticInfo' d SameInfoImportCls) - , Data (SemanticInfo' d SameInfoModuleCls) - , Data (SemanticInfo' d SameInfoWildcardCls) - , Show (SemanticInfo' d SameInfoNameCls) - , Show (SemanticInfo' d SameInfoExprCls) - , Show (SemanticInfo' d SameInfoImportCls) - , Show (SemanticInfo' d SameInfoModuleCls) - , Show (SemanticInfo' d SameInfoWildcardCls) - ) => Domain d where - - -class ( Data (SemanticInfo' d (SemaInfoClassify e)) - , Show (SemanticInfo' d (SemaInfoClassify e)) - , Domain d - ) => DomainWith e d where +type Domain d = ( Typeable d + , Data d + , SemanticInfo' d SemaInfoDefaultCls ~ NoSemanticInfo + , Data (SemanticInfo' d SemaInfoNameCls) + , Data (SemanticInfo' d SemaInfoLitCls) + , Data (SemanticInfo' d SemaInfoExprCls) + , Data (SemanticInfo' d SemaInfoImportCls) + , Data (SemanticInfo' d SemaInfoModuleCls) + , Data (SemanticInfo' d SemaInfoWildcardCls) + ) -instance ( Data (SemanticInfo' d (SemaInfoClassify e)) - , Show (SemanticInfo' d (SemaInfoClassify e)) - , Domain d - ) => DomainWith e d where +type DomainWith e d = ( Data (SemanticInfo' d (SemaInfoClassify e)) + , Domain d + ) -- | Extracts or modifies the concrete range corresponding to a given source info. -- In case of lists and optional elements, it may not contain the elements inside. @@ -164,19 +139,16 @@ , Data (SpanInfo stage) , Data (ListInfo stage) , Data (OptionalInfo stage) - , Show (SpanInfo stage) - , Show (ListInfo stage) - , Show (OptionalInfo stage) , HasRange (SpanInfo stage) , HasRange (ListInfo stage) , HasRange (OptionalInfo stage) - ) - => SourceInfo stage where - -- | Type of source info for normal AST elements + ) => SourceInfo stage where + + -- | UType of source info for normal AST elements data SpanInfo stage :: * - -- | Type of source info for lists of AST elements + -- | UType of source info for lists of AST elements data ListInfo stage :: * - -- | Type of source info for optional AST elements + -- | UType of source info for optional AST elements data OptionalInfo stage :: * @@ -186,13 +158,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) @@ -211,13 +183,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) @@ -232,10 +204,15 @@ -- | 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) +shortShowSpanWithFile :: SrcSpan -> String +shortShowSpanWithFile (UnhelpfulSpan _) = "?? ??-??" +shortShowSpanWithFile sp@(RealSrcSpan rsp) + = unpackFS (srcSpanFile rsp) ++ " " ++ shortShowLoc (srcSpanStart sp) ++ "-" ++ shortShowLoc (srcSpanEnd sp) + -- | A short form of showing a range, without file name, for debugging purposes. shortShowLoc :: SrcLoc -> String shortShowLoc (UnhelpfulLoc _) = "??" @@ -243,7 +220,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 @@ -256,57 +233,83 @@ -- * Annotations +-- | Semantic and source code related information for an AST node. +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 +instance SourceInfo src => Eq (Ann elem dom src) where + a == b = getRange a == getRange b +makeReferences ''Ann + -- | A list of AST elements -data AnnList elem dom stage = AnnList { _annListAnnot :: NodeInfo (SemanticInfo dom (AnnList elem)) (ListInfo stage) - , _annListElems :: [Ann elem dom stage] - } - -makeReferences ''AnnList - -annList :: Traversal (AnnList e d s) (AnnList e d s) (Ann e d s) (Ann e d s) +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 = annListElems & traversal -- | An optional AST element -data AnnMaybe elem dom stage = AnnMaybe { _annMaybeAnnot :: NodeInfo (SemanticInfo dom (AnnMaybe elem)) (OptionalInfo stage) - , _annMaybe :: Maybe (Ann elem dom stage) - } - -makeReferences ''AnnMaybe - -annJust :: Partial (AnnMaybe e d s) (AnnMaybe e d s) (Ann e d s) (Ann e d s) +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 + type SourceInfoType e :: * + srcInfo :: Simple Lens e (SourceInfoType e) + +instance HasSourceInfo (Ann elem dom stage) where + type SourceInfoType (Ann elem dom stage) = SpanInfo stage + srcInfo = annotation & sourceInfo + +instance HasSourceInfo (AnnListG elem dom stage) where + type SourceInfoType (AnnListG elem dom stage) = ListInfo stage + srcInfo = annListAnnot & sourceInfo + +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 = annMaybe & just -- | An empty list of AST elements -annNil :: NodeInfo (SemanticInfo d (AnnList e)) (ListInfo s) -> AnnList e d s -annNil a = AnnList a [] +annNil :: NodeInfo (SemanticInfo d (AnnListG e)) (ListInfo s) -> AnnListG e d s +annNil a = AnnListG a [] -isAnnNothing :: AnnMaybe e d s -> Bool -isAnnNothing (AnnMaybe _ Nothing) = True -isAnnNothing (AnnMaybe _ _) = False +isAnnNothing :: AnnMaybeG e d s -> Bool +isAnnNothing (AnnMaybeG _ Nothing) = True +isAnnNothing (AnnMaybeG _ _) = False -isAnnJust :: AnnMaybe e d s -> Bool -isAnnJust (AnnMaybe _ (Just _)) = True -isAnnJust (AnnMaybe _ _) = False +isAnnJust :: AnnMaybeG e d s -> Bool +isAnnJust (AnnMaybeG _ (Just _)) = True +isAnnJust (AnnMaybeG _ _) = False -annLength :: AnnList e d s -> Int -annLength (AnnList _ ls) = length ls +annLength :: AnnListG e d s -> Int +annLength (AnnListG _ ls) = length ls -- | A non-existing AST part -annNothing :: NodeInfo (SemanticInfo d (AnnMaybe e)) (OptionalInfo s) -> AnnMaybe e d s -annNothing a = AnnMaybe a Nothing - +annNothing :: NodeInfo (SemanticInfo d (AnnMaybeG e)) (OptionalInfo s) -> AnnMaybeG e d s +annNothing a = AnnMaybeG a Nothing -- * Info types @@ -338,47 +341,49 @@ getRange (Ann a _) = getRange (a ^. sourceInfo) setRange sp = annotation & sourceInfo .- setRange sp -instance SourceInfo stage => HasRange (AnnList elem dom stage) where - getRange (AnnList a _) = getRange (a ^. sourceInfo) +instance SourceInfo stage => HasRange (AnnListG elem dom stage) where + getRange (AnnListG a _) = getRange (a ^. sourceInfo) setRange sp = annListAnnot & sourceInfo .- setRange sp -instance SourceInfo stage => HasRange (AnnMaybe elem dom stage) where - getRange (AnnMaybe a _) = getRange (a ^. sourceInfo) +instance SourceInfo stage => HasRange (AnnMaybeG elem dom stage) where + getRange (AnnMaybeG a _) = getRange (a ^. sourceInfo) 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 -instance ApplySemaChange SameInfoExprCls where appSemaChange = trfSemaExprCls -instance ApplySemaChange SameInfoImportCls where appSemaChange = trfSemaImportCls -instance ApplySemaChange SameInfoModuleCls where appSemaChange = trfSemaModuleCls -instance ApplySemaChange SameInfoWildcardCls where appSemaChange = trfSemaWildcardCls -instance ApplySemaChange SameInfoDefaultCls where appSemaChange = trfSemaDefault +instance ApplySemaChange SemaInfoNameCls where appSemaChange = trfSemaNameCls +instance ApplySemaChange SemaInfoLitCls where appSemaChange = trfSemaLitCls +instance ApplySemaChange SemaInfoExprCls where appSemaChange = trfSemaExprCls +instance ApplySemaChange SemaInfoImportCls where appSemaChange = trfSemaImportCls +instance ApplySemaChange SemaInfoModuleCls where appSemaChange = trfSemaModuleCls +instance ApplySemaChange SemaInfoWildcardCls where appSemaChange = trfSemaWildcardCls +instance ApplySemaChange SemaInfoDefaultCls 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) -- | A transformation on the possible semantic informations for a given domain -data SemaTrf f dom1 dom2 = SemaTrf { trfSemaNameCls :: SemanticInfo' dom1 SameInfoNameCls -> f (SemanticInfo' dom2 SameInfoNameCls) - , trfSemaExprCls :: SemanticInfo' dom1 SameInfoExprCls -> f (SemanticInfo' dom2 SameInfoExprCls) - , trfSemaImportCls :: SemanticInfo' dom1 SameInfoImportCls -> f (SemanticInfo' dom2 SameInfoImportCls) - , trfSemaModuleCls :: SemanticInfo' dom1 SameInfoModuleCls -> f (SemanticInfo' dom2 SameInfoModuleCls) - , trfSemaWildcardCls :: SemanticInfo' dom1 SameInfoWildcardCls -> f (SemanticInfo' dom2 SameInfoWildcardCls) - , trfSemaDefault :: SemanticInfo' dom1 SameInfoDefaultCls -> f (SemanticInfo' dom2 SameInfoDefaultCls) +data SemaTrf f dom1 dom2 = SemaTrf { trfSemaNameCls :: SemanticInfo' dom1 SemaInfoNameCls -> f (SemanticInfo' dom2 SemaInfoNameCls) + , trfSemaExprCls :: SemanticInfo' dom1 SemaInfoExprCls -> f (SemanticInfo' dom2 SemaInfoExprCls) + , trfSemaLitCls :: SemanticInfo' dom1 SemaInfoLitCls -> f (SemanticInfo' dom2 SemaInfoLitCls) + , trfSemaImportCls :: SemanticInfo' dom1 SemaInfoImportCls -> f (SemanticInfo' dom2 SemaInfoImportCls) + , trfSemaModuleCls :: SemanticInfo' dom1 SemaInfoModuleCls -> f (SemanticInfo' dom2 SemaInfoModuleCls) + , trfSemaWildcardCls :: SemanticInfo' dom1 SemaInfoWildcardCls -> f (SemanticInfo' dom2 SemaInfoWildcardCls) + , trfSemaDefault :: SemanticInfo' dom1 SemaInfoDefaultCls -> f (SemanticInfo' dom2 SemaInfoDefaultCls) } instance forall e . (ApplySemaChange (SemaInfoClassify e), SemanticTraversal e) => SemanticTraversal (Ann e) where semaTraverse f (Ann (NodeInfo sema src) e) = Ann <$> (NodeInfo <$> appSemaChange @(SemaInfoClassify e) f sema <*> pure src) <*> semaTraverse f e -instance (ApplySemaChange (SemaInfoClassify e), SemanticTraversal e) => SemanticTraversal (AnnList e) where - semaTraverse f (AnnList (NodeInfo sema src) e) = AnnList <$> (NodeInfo <$> trfSemaDefault f sema <*> pure src) <*> mapM (semaTraverse f) e +instance (ApplySemaChange (SemaInfoClassify e), SemanticTraversal e) => SemanticTraversal (AnnListG e) where + semaTraverse f (AnnListG (NodeInfo sema src) e) = AnnListG <$> (NodeInfo <$> trfSemaDefault f sema <*> pure src) <*> mapM (semaTraverse f) e -instance (ApplySemaChange (SemaInfoClassify e), SemanticTraversal e) => SemanticTraversal (AnnMaybe e) where - semaTraverse f (AnnMaybe (NodeInfo sema src) e) = AnnMaybe <$> (NodeInfo <$> trfSemaDefault f sema <*> pure src) <*> sequence (fmap (semaTraverse f) e) +instance (ApplySemaChange (SemaInfoClassify e), SemanticTraversal e) => SemanticTraversal (AnnMaybeG e) where + semaTraverse f (AnnMaybeG (NodeInfo sema src) e) = AnnMaybeG <$> (NodeInfo <$> trfSemaDefault f sema <*> pure src) <*> sequence (fmap (semaTraverse f) e) -- | A class for traversing source information in an AST class SourceInfoTraversal a where @@ -393,26 +398,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 (AnnList e) where - sourceInfoTraverse trf (AnnList (NodeInfo sema src) e) - = AnnList <$> (NodeInfo sema <$> trfListInfo trf src) <*> mapM (sourceInfoTraverse trf) e - sourceInfoTraverseDown trf desc asc (AnnList (NodeInfo sema src) e) - = AnnList <$> (NodeInfo sema <$> trfListInfo trf src) <*> (desc *> mapM (sourceInfoTraverseDown trf desc asc) e <* asc) - sourceInfoTraverseUp trf desc asc (AnnList (NodeInfo sema src) e) - = flip AnnList <$> (desc *> mapM (sourceInfoTraverseUp trf desc asc) e <* asc) <*> (NodeInfo sema <$> trfListInfo trf src) - -instance SourceInfoTraversal e => SourceInfoTraversal (AnnMaybe e) where - sourceInfoTraverse trf (AnnMaybe (NodeInfo sema src) e) - = AnnMaybe <$> (NodeInfo sema <$> trfOptionalInfo trf src) <*> sequence (fmap (sourceInfoTraverse trf) e) - sourceInfoTraverseDown trf desc asc (AnnMaybe (NodeInfo sema src) e) - = AnnMaybe <$> (NodeInfo sema <$> trfOptionalInfo trf src) <*> (desc *> sequence (fmap (sourceInfoTraverseDown trf desc asc) e) <* asc) - sourceInfoTraverseUp trf desc asc (AnnMaybe (NodeInfo sema src) e) - = flip AnnMaybe <$> (desc *> sequence (fmap (sourceInfoTraverseUp trf desc asc) e) <* asc) <*> (NodeInfo sema <$> trfOptionalInfo trf src) +instance SourceInfoTraversal e => SourceInfoTraversal (AnnListG e) where + 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) + = AnnListG <$> (NodeInfo sema <$> trfListInfo trf src) <*> (desc *> mapM (sourceInfoTraverseDown trf desc asc) e <* asc) + 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) + = AnnMaybeG <$> (NodeInfo sema <$> trfOptionalInfo trf src) <*> sequence (fmap (sourceInfoTraverse trf) 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) + = flip AnnMaybeG <$> (desc *> sequence (fmap (sourceInfoTraverseUp trf desc asc) e) <* asc) <*> (NodeInfo sema <$> trfOptionalInfo trf src)
− Language/Haskell/Tools/AST/Base.hs
@@ -1,121 +0,0 @@- -{-# LANGUAGE TypeFamilies - , MultiParamTypeClasses - , FlexibleInstances - #-} - --- | Simple AST elements of Haskell -module Language.Haskell.Tools.AST.Base where - -import Language.Haskell.Tools.AST.Ann - -data Operator dom stage - = BacktickOp { _operatorName :: Ann QualifiedName dom stage } -- ^ Backtick operator name: @ a `mod` b @ - | NormalOp { _operatorName :: Ann QualifiedName dom stage } - -data Name dom stage - = ParenName { _simpleName :: Ann QualifiedName dom stage } -- ^ Parenthesized name: @ foldl (+) 0 @ - | NormalName { _simpleName :: Ann QualifiedName dom stage } - | ImplicitName { _simpleName :: Ann QualifiedName dom stage } -- ^ Implicit name: @ ?var @ - --- | Possible qualified names. Contains also implicit names. --- Linear implicit parameter: @%x@. Non-linear implicit parameter: @?x@. -data QualifiedName dom stage - = QualifiedName { _qualifiers :: AnnList UnqualName dom stage - , _unqualifiedName :: Ann UnqualName dom stage - } - -nameFromList :: AnnList UnqualName dom stage -> QualifiedName dom stage -nameFromList (AnnList a xs) | not (null xs) - = QualifiedName (AnnList a (init xs)) (last xs) -nameFromList _ = error "nameFromList: empty list" - --- | Parts of a qualified name. -data UnqualName dom stage - = UnqualName { _simpleNameStr :: String } - --- | Program elements formatted as string literals (import packages, pragma texts) -data StringNode dom stage - = StringNode { _stringNodeStr :: String } - --- | The name of a module -data ModuleName dom stage = ModuleName { _moduleNameString :: String } - --- | The @data@ or the @newtype@ keyword to define ADTs. -data DataOrNewtypeKeyword dom stage - = DataKeyword - | NewtypeKeyword - --- | Keywords @do@ or @mdo@ to start a do-block -data DoKind dom stage - = DoKeyword - | MDoKeyword - --- | The @type@ keyword used to qualify that the type and not the constructor of the same name is referred -data TypeKeyword dom stage = TypeKeyword - --- | Recognised overlaps for overlap pragmas. Can be applied to class declarations and class instance declarations. -data OverlapPragma dom stage - = EnableOverlap -- ^ @OVERLAP@ pragma - | DisableOverlap -- ^ @NO_OVERLAP@ pragma - | Overlappable -- ^ @OVERLAPPABLE@ pragma - | Overlapping -- ^ @OVERLAPPING@ pragma - | Overlaps -- ^ @OVERLAPS@ pragma - | IncoherentOverlap -- ^ @INCOHERENT@ pragma - --- | Call conventions of foreign functions -data CallConv dom stage - = StdCall - | CCall - | CPlusPlus - | DotNet - | Jvm - | Js - | JavaScript - | CApi - -data ArrowAppl dom stage - = LeftAppl -- ^ Left arrow application: @-<@ - | RightAppl -- ^ Right arrow application: @>-@ - | LeftHighApp -- ^ Left arrow high application: @-<<@ - | RightHighApp -- ^ Right arrow high application: @>>-@ - --- | Safety annotations for foreign calls -data Safety dom stage - = Safe - | ThreadSafe - | Unsafe - | Interruptible - --- | Associativity of an operator. -data Assoc dom stage - = AssocNone -- ^ non-associative operator (declared with @infix@) - | AssocLeft -- ^ left-associative operator (declared with @infixl@) - | AssocRight -- ^ right-associative operator (declared with @infixr@) - -data Role dom stage - = Nominal - | Representational - | Phantom - -data ConlikeAnnot dom stage = ConlikeAnnot - --- | Numeric precedence of an operator -data Precedence dom stage - = Precedence { _precedenceValue :: Int } - -data LineNumber dom stage - = LineNumber { _lineNumber :: Int } - --- | Controls the activation of a rewrite rule (@ [1] @) -data PhaseControl dom stage - = PhaseControl { _phaseUntil :: AnnMaybe PhaseInvert dom stage - , _phaseNumber :: Ann 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
− Language/Haskell/Tools/AST/Base.hs-boot
@@ -1,5 +0,0 @@-{-# LANGUAGE RoleAnnotations #-} -module Language.Haskell.Tools.AST.Base where - -type role QualifiedName nominal nominal -data QualifiedName dom stage
− Language/Haskell/Tools/AST/Binds.hs
@@ -1,151 +0,0 @@--- | Representation of Haskell AST value and function bindings (both local and top-level) -module Language.Haskell.Tools.AST.Binds where - -import Language.Haskell.Tools.AST.Ann -import Language.Haskell.Tools.AST.Base -import Language.Haskell.Tools.AST.Patterns -import Language.Haskell.Tools.AST.Exprs -import Language.Haskell.Tools.AST.Types -import Language.Haskell.Tools.AST.Literals -import {-# SOURCE #-} Language.Haskell.Tools.AST.TH - --- | Value binding for top-level and local bindings -data ValueBind dom stage - = SimpleBind { _valBindPat :: Ann Pattern dom stage - , _valBindRhs :: Ann Rhs dom stage - , _valBindLocals :: AnnMaybe LocalBinds dom stage - } -- ^ Non-function binding (@ v = "12" @) - -- TODO: use one name for a function instead of names in each match - | FunBind { _funBindMatches :: AnnList Match dom stage - } -- ^ Function binding (@ f 0 = 1; f x = x @). All matches must have the same name. - --- | Clause of function (or value) binding -data Match dom stage - = Match { _matchLhs :: Ann MatchLhs dom stage - , _matchRhs :: Ann Rhs dom stage - , _matchBinds :: AnnMaybe LocalBinds dom stage - } - --- | Something on the left side of the match -data MatchLhs dom stage - = NormalLhs { _matchLhsName :: Ann Name dom stage - , _matchLhsArgs :: AnnList Pattern dom stage - } - | InfixLhs { _matchLhsLhs :: Ann Pattern dom stage - , _matchLhsOperator :: Ann Operator dom stage - , _matchLhsRhs :: Ann Pattern dom stage - , _matchLhsArgs :: AnnList Pattern dom stage - } - --- | Local bindings attached to a declaration (@ where x = 42 @) -data LocalBinds dom stage - = LocalBinds { _localBinds :: AnnList LocalBind dom stage - } - --- | Bindings that are enabled in local blocks (where or let). -data LocalBind dom stage - = LocalValBind { _localVal :: Ann ValueBind dom stage - } - -- TODO: check that no other signature can be inside a local binding - | LocalSignature { _localSig :: Ann TypeSignature dom stage - } - | LocalFixity { _localFixity :: Ann FixitySignature dom stage - } - --- | A type signature (@ _f :: Int -> Int @) -data TypeSignature dom stage - = TypeSignature { _tsName :: AnnList Name dom stage - , _tsType :: Ann Type dom stage - } - --- | A fixity signature (@ infixl 5 +, - @). -data FixitySignature dom stage - = FixitySignature { _fixityAssoc :: Ann Assoc dom stage - , _fixityPrecedence :: Ann Precedence dom stage - , _fixityOperators :: AnnList Operator dom stage - } - --- | Right hand side of a value binding (possible with guards): (@ = 3 @ or @ | x == 1 = 3; | otherwise = 4 @) -data Rhs dom stage - = UnguardedRhs { _rhsExpr :: Ann Expr dom stage - } - | GuardedRhss { _rhsGuards :: AnnList GuardedRhs dom stage - } - --- | A guarded right-hand side of a value binding (@ | x > 3 = 2 @) -data GuardedRhs dom stage - = GuardedRhs { _guardStmts :: AnnList RhsGuard dom stage -- ^ Cannot be empty. - , _guardExpr :: Ann Expr dom stage - } - --- | Guards for value bindings and pattern matches (@ Just v <- x, v > 1 @) -data RhsGuard dom stage - = GuardBind { _guardPat :: Ann Pattern dom stage - , _guardRhs :: Ann Expr dom stage - } - | GuardLet { _guardBinds :: AnnList LocalBind dom stage - } - | GuardCheck { _guardCheck :: Ann Expr dom stage - } - --- * Pragmas - --- | Top level pragmas -data TopLevelPragma dom stage - = RulePragma { _pragmaRule :: AnnList Rule dom stage - } - | DeprPragma { _pragmaObjects :: AnnList Name dom stage - , _pragmaMessage :: Ann StringNode dom stage - } - | WarningPragma { _pragmaObjects :: AnnList Name dom stage - , _pragmaMessage :: Ann StringNode dom stage - } - | AnnPragma { _annotationSubject :: Ann AnnotationSubject dom stage - , _annotateExpr :: Ann Expr dom stage - } - | InlinePragma { _pragmaConlike :: AnnMaybe ConlikeAnnot dom stage - , _pragmaPhase :: AnnMaybe PhaseControl dom stage - , _inlineDef :: Ann Name dom stage - } - | NoInlinePragma { _pragmaConlike :: AnnMaybe ConlikeAnnot dom stage - , _pragmaPhase :: AnnMaybe PhaseControl dom stage - , _noInlineDef :: Ann Name dom stage - } - | InlinablePragma { _pragmaPhase :: AnnMaybe PhaseControl dom stage - , _inlinableDef :: Ann Name dom stage - } - | LinePragma { _pragmaLineNum :: Ann LineNumber dom stage - , _pragmaFileName :: AnnMaybe StringNode dom stage - } - | SpecializePragma { _pragmaPhase :: AnnMaybe PhaseControl dom stage - , _specializeDef :: Ann Name dom stage - , _specializeType :: AnnList Type dom stage - } - --- | A rewrite rule (@ "map/map" forall f g xs. map f (map g xs) = map (f.g) xs @) -data Rule dom stage - = Rule { _ruleName :: Ann StringNode dom stage -- ^ User name of the rule - , _rulePhase :: AnnMaybe PhaseControl dom stage -- ^ The compilation phases in which the rule can be applied - , _ruleBounded :: AnnList TyVar dom stage -- ^ Variables bound in the rule - , _ruleLhs :: Ann Expr dom stage -- ^ The transformed expression - , _ruleRhs :: Ann Expr dom stage -- ^ The resulting expression - } - --- | Annotation allows you to connect an expression to any declaration. -data AnnotationSubject dom stage - = NameAnnotation { _annotateName :: Ann Name dom stage - } -- ^ The definition with the given name is annotated - | TypeAnnotation { _annotateName :: Ann Name dom stage - } -- ^ A type with the given name is annotated - | ModuleAnnotation -- ^ The whole module is annotated - --- | Formulas of minimal annotations declaring which functions should be defined. -data MinimalFormula dom stage - = MinimalName { _minimalName :: Ann Name dom stage - } - | MinimalParen { _minimalInner :: Ann MinimalFormula dom stage - } - | MinimalOr { _minimalOrs :: AnnList MinimalFormula dom stage - } -- ^ One of the minimal formulas are needed (@ min1 | min2 @) - | MinimalAnd { _minimalAnds :: AnnList MinimalFormula dom stage - } -- ^ Both of the minimal formulas are needed (@ min1 , min2 @)
− Language/Haskell/Tools/AST/Binds.hs-boot
@@ -1,11 +0,0 @@-{-# LANGUAGE RoleAnnotations #-} -module Language.Haskell.Tools.AST.Binds where - -type role LocalBind nominal nominal -data LocalBind dom stage - -type role LocalBinds nominal nominal -data LocalBinds dom stage - -type role RhsGuard nominal nominal -data RhsGuard dom stage
− Language/Haskell/Tools/AST/Decls.hs
@@ -1,299 +0,0 @@--- | 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.Decls where - -import Language.Haskell.Tools.AST.Binds -import Language.Haskell.Tools.AST.Types -import Language.Haskell.Tools.AST.Patterns -import Language.Haskell.Tools.AST.Kinds -import Language.Haskell.Tools.AST.Exprs -import Language.Haskell.Tools.AST.Base -import Language.Haskell.Tools.AST.Literals -import Language.Haskell.Tools.AST.Ann -import {-# SOURCE #-} Language.Haskell.Tools.AST.TH - - --- | Haskell declaration -data Decl dom stage - = TypeDecl { _declHead :: Ann DeclHead dom stage - , _declType :: Ann Type dom stage - } -- ^ A type synonym ( @type String = [Char]@ ) - | TypeFamilyDecl { _declTypeFamily :: Ann TypeFamily dom stage - } - | ClosedTypeFamilyDecl { _declHead :: Ann DeclHead dom stage - , _declKind :: AnnMaybe KindConstraint dom stage - , _declDecl :: AnnList TypeEqn dom stage -- ^ cannot be empty - } -- ^ A closed type family declaration - | DataDecl { _declNewtype :: Ann DataOrNewtypeKeyword dom stage - , _declCtx :: AnnMaybe Context dom stage - , _declHead :: Ann DeclHead dom stage - , _declCons :: AnnList ConDecl dom stage - , _declDeriving :: AnnMaybe Deriving dom stage - } -- ^ A data or newtype declaration. Empty data type declarations without - -- where keyword are always belong to DataDecl. - | GDataDecl { _declNewtype :: Ann DataOrNewtypeKeyword dom stage - , _declCtx :: AnnMaybe Context dom stage - , _declHead :: Ann DeclHead dom stage - , _declKind :: AnnMaybe KindConstraint dom stage - , _declGadt :: AnnList GadtConDecl dom stage - , _declDeriving :: AnnMaybe Deriving dom stage - } -- ^ A data or newtype declaration. - | TypeInstDecl { _declInstance :: Ann InstanceRule dom stage - , _declAssignedType :: Ann Type dom stage - } -- ^ Type instance declaration (@ type instance Fam T = AssignedT @) - | DataInstDecl { _declNewtype :: Ann DataOrNewtypeKeyword dom stage - , _declInstance :: Ann InstanceRule dom stage - , _declCons :: AnnList ConDecl dom stage - , _declDeriving :: AnnMaybe Deriving dom stage - } -- ^ Data instance declaration (@ data instance Fam T = Con1 | Con2 @) - | GDataInstDecl { _declNewtype :: Ann DataOrNewtypeKeyword dom stage - , _declInstance :: Ann InstanceRule dom stage - , _declKind :: AnnMaybe KindConstraint dom stage - , _declGadt :: AnnList GadtConDecl dom stage - } -- ^ Gadt style data instance declaration (@ data instance Fam T where ... @) - | ClassDecl { _declCtx :: AnnMaybe Context dom stage - , _declHead :: Ann DeclHead dom stage - , _declFunDeps :: AnnMaybe FunDeps dom stage - , _declBody :: AnnMaybe ClassBody dom stage - } -- ^ Type class declaration (@ class X a [where f = ...] @) - | InstDecl { _declOverlap :: AnnMaybe OverlapPragma dom stage - , _declInstRule :: Ann InstanceRule dom stage - , _declInstDecl :: AnnMaybe InstBody dom stage - } -- ^ Instance declaration (@ instance X T [where f = ...] @) - | PatternSynonymDecl { _declPatSyn :: Ann PatternSynonym dom stage - } -- ^ Pattern synonyms (@ pattern Arrow t1 t2 = App "->" [t1, t2] @) - | DerivDecl { _declOverlap :: AnnMaybe OverlapPragma dom stage - , _declInstRule :: Ann InstanceRule dom stage - } -- ^ Standalone deriving declaration (@ deriving instance X T @) - | FixityDecl { _declFixity :: Ann FixitySignature dom stage - } -- ^ Fixity declaration (@ infixl 5 +, - @) - | DefaultDecl { _declTypes :: AnnList Type dom stage - } -- ^ Default types (@ default (T1, T2) @) - | TypeSigDecl { _declTypeSig :: Ann TypeSignature dom stage - } -- ^ Type signature declaration (@ _f :: Int -> Int @) - | PatTypeSigDecl { _declPatTypeSig :: Ann PatternTypeSignature dom stage - } -- ^ Type signature declaration (@ _f :: Int -> Int @) - | ValueBinding { _declValBind :: Ann ValueBind dom stage - } -- ^ Function binding (@ f x = 12 @) - | ForeignImport { _declCallConv :: Ann CallConv dom stage - , _declSafety :: AnnMaybe Safety dom stage - , _declName :: Ann Name dom stage - , _declType :: Ann Type dom stage - } -- ^ Foreign import (@ foreign import _foo :: Int -> IO Int @) - | ForeignExport { _declCallConv :: Ann CallConv dom stage - , _declName :: Ann Name dom stage - , _declType :: Ann Type dom stage - } -- ^ foreign export (@ foreign export ccall _foo :: Int -> IO Int @) - | PragmaDecl { _declPragma :: Ann TopLevelPragma dom stage - } -- ^ top level pragmas - | RoleDecl { _declRoleType :: Ann QualifiedName dom stage - , _declRoles :: AnnList Role dom stage - } -- ^ role annotations (@ type role Ptr representational @) - | SpliceDecl { _declSplice :: Ann Splice dom stage - } -- ^ A Template Haskell splice declaration (@ $(generateDecls) @) - --- | Open type and data families -data TypeFamily dom stage - = TypeFamily { _tfHead :: Ann DeclHead dom stage - , _tfSpec :: AnnMaybe TypeFamilySpec dom stage - } -- ^ A type family declaration (@ type family A _a :: * -> * @) - | DataFamily { _tfHead :: Ann DeclHead dom stage - , _tfKind :: AnnMaybe KindConstraint dom stage - } -- ^ Data family declaration - --- | Type family specification with kinds specification and injectivity. -data TypeFamilySpec dom stage - = TypeFamilyKind { _tfSpecKind :: Ann KindConstraint dom stage - } - | TypeFamilyInjectivity { _tfInjectivity :: Ann InjectivityAnn dom stage - } - --- | Injectivity annotation for type families (@ = r | r -> a @) -data InjectivityAnn dom stage - = InjectivityAnn { _injAnnRes :: Ann Name dom stage - , _injAnnDeps :: AnnList Name dom stage - } - --- | The list of declarations that can appear in a typeclass -data ClassBody dom stage - = ClassBody { _cbElements :: AnnList ClassElement dom stage - } - --- | Members of a class declaration -data ClassElement dom stage - = ClsSig { _ceTypeSig :: Ann TypeSignature dom stage - } -- ^ Signature: @ _f :: A -> B @ - | ClsDef { _ceBind :: Ann ValueBind dom stage - } -- ^ Default binding: @ f x = "aaa" @ - | ClsTypeFam { _ceTypeFam :: Ann TypeFamily dom stage - } -- ^ Declaration of an associated type synonym: @ type T _x :: * @ - | ClsTypeDef { _ceHead :: Ann DeclHead dom stage - , _ceKind :: Ann Type dom stage - } -- ^ Default choice for type synonym: @ type T x = TE @ or @ type instance T x = TE @ - | ClsDefSig { _ceName :: Ann Name dom stage - , _ceType :: Ann Type dom stage - } -- ^ Default signature (by using @DefaultSignatures@): @ default _enum :: (Generic a, GEnum (Rep a)) => [a] @ - | ClsMinimal { _pragmaFormula :: Ann MinimalFormula dom stage - } -- ^ Minimal pragma: @ {-# MINIMAL (==) | (/=) #-} @ - - -- not supported yet (GHC 7.10.3) - | ClsPatSig { _cePatSig :: Ann PatternTypeSignature dom stage - } -- ^ Pattern signature in a class declaration (by using @PatternSynonyms@) - --- The declared (possibly parameterized) type (@ A x :+: B y @). -data DeclHead dom stage - = DeclHead { _dhName :: Ann Name dom stage - } -- ^ Type or class name - | DHParen { _dhBody :: Ann DeclHead dom stage - } -- ^ Parenthesized type - | DHApp { _dhAppFun :: Ann DeclHead dom stage - , _dhAppOperand :: Ann TyVar dom stage - } -- ^ Type application - | DHInfix { _dhLeft :: Ann TyVar dom stage - , _dhOperator :: Ann Operator dom stage - , _dhRight :: Ann TyVar dom stage - } -- ^ Infix application of the type/class name to the left operand - --- | Instance body is the implementation of the class functions (@ where a x = 1; b x = 2 @) -data InstBody dom stage - = InstBody { _instBodyDecls :: AnnList InstBodyDecl dom stage - } - --- | Declarations inside an instance declaration. -data InstBodyDecl dom stage - = InstBodyNormalDecl { _instBodyDeclFunbind :: Ann ValueBind dom stage - } -- ^ A normal declaration (@ f x = 12 @) - | InstBodyTypeSig { _instBodyTypeSig :: Ann TypeSignature dom stage - } -- ^ Type signature in instance definition with @InstanceSigs@ - | InstBodyTypeDecl { _instBodyTypeEqn :: Ann TypeEqn dom stage - } -- ^ An associated type definition (@ type A X = B @) - | InstBodyDataDecl { _instBodyDataNew :: Ann DataOrNewtypeKeyword dom stage - , _instBodyLhsType :: Ann InstanceRule dom stage - , _instBodyDataCons :: AnnList ConDecl dom stage - , _instBodyDerivings :: AnnMaybe Deriving dom stage - } -- ^ An associated data type implementation (@ data A X = C1 | C2 @) - | InstBodyGadtDataDecl { _instBodyDataNew :: Ann DataOrNewtypeKeyword dom stage - , _instBodyLhsType :: Ann InstanceRule dom stage - , _instBodyDataKind :: AnnMaybe KindConstraint dom stage - , _instBodyGadtCons :: AnnList GadtConDecl dom stage - , _instBodyDerivings :: AnnMaybe Deriving dom stage - } -- ^ An associated data type implemented using GADT style - | SpecializeInstance { _specializeInstanceType :: Ann Type dom stage - } -- ^ Specialize instance pragma (no phase selection is allowed) - -- not supported yet - | InstBodyPatSyn { _instBodyPatSyn :: Ann PatternSynonym dom stage - } -- ^ A pattern synonym in a class instance - --- | GADT constructor declaration (@ _D1 :: { _val :: Int } -> T String @) -data GadtConDecl dom stage - = GadtConDecl { _gadtConNames :: AnnList Name dom stage - , _gadtConType :: Ann GadtConType dom stage - } - --- | Type of GADT constructors (can be record types: @{ _val :: Int }@) -data GadtConType dom stage - = GadtNormalType { _gadtConNormalType :: Ann Type dom stage - } - | GadtRecordType { _gadtConRecordFields :: AnnList FieldDecl dom stage - , _gadtConResultType :: Ann Type dom stage - } - --- | A list of functional dependencies: @ | a -> b, c -> d @ separated by commas -data FunDeps dom stage - = FunDeps { _funDeps :: AnnList FunDep dom stage - } - --- | A functional dependency, given on the form @l1 ... ln -> r1 ... rn@ -data FunDep dom stage - = FunDep { _funDepLhs :: AnnList Name dom stage - , _funDepRhs :: AnnList Name dom stage - } - --- | A constructor declaration for a datatype -data ConDecl dom stage - = ConDecl { _conDeclName :: Ann Name dom stage - , _conDeclArgs :: AnnList Type dom stage - } -- ^ ordinary data constructor (@ C t1 t2 @) - | RecordDecl { _conDeclName :: Ann Name dom stage - , _conDeclFields :: AnnList FieldDecl dom stage - } -- ^ record data constructor (@ C { _n1 :: t1, _n2 :: t2 } @) - | InfixConDecl { _conDeclLhs :: Ann Type dom stage - , _conDeclOp :: Ann Operator dom stage - , _conDeclRhs :: Ann Type dom stage - } -- ^ infix data constructor (@ t1 :+: t2 @) - --- | Field declaration (@ _fld :: Int @) -data FieldDecl dom stage - = FieldDecl { _fieldNames :: AnnList Name dom stage - , _fieldType :: Ann Type dom stage - } - --- | A deriving clause following a data type declaration. (@ deriving Show @ or @ deriving (Show, Eq) @) -data Deriving dom stage - = DerivingOne { _oneDerived :: Ann InstanceHead dom stage } - | Derivings { _allDerived :: AnnList InstanceHead dom stage } - --- | The instance declaration rule, which is, roughly, the part of the instance declaration before the where keyword. -data InstanceRule dom stage - = InstanceRule { _irVars :: AnnMaybe (AnnList TyVar) dom stage - , _irCtx :: AnnMaybe Context dom stage - , _irHead :: Ann InstanceHead dom stage - } - | InstanceParen { _irRule :: Ann InstanceRule dom stage - } - --- | The specification of the class instance declaration -data InstanceHead dom stage - = InstanceHeadCon { _ihConName :: Ann Name dom stage - } -- ^ Type or class name - | InstanceHeadInfix { _ihLeftOp :: Ann Type dom stage - , _ihOperator :: Ann Name dom stage - } -- ^ Infix application of the type/class name to the left operand - | InstanceHeadParen { _ihHead :: Ann InstanceHead dom stage - } -- ^ Parenthesized instance head - | InstanceHeadApp { _ihFun :: Ann InstanceHead dom stage - , _ihType :: Ann Type dom stage - } -- ^ Application to one more type - --- | Type equations as found in closed type families (@ T A = S @) -data TypeEqn dom stage - = TypeEqn { _teLhs :: Ann Type dom stage - , _teRhs :: Ann Type dom stage - } - --- | A pattern type signature (@ pattern p :: Int -> T @) -data PatternTypeSignature dom stage - = PatternTypeSignature { _patSigName :: Ann Name dom stage - , _patSigType :: Ann Type dom stage - } - --- | Pattern synonyms: @ pattern Arrow t1 t2 = App "->" [t1, t2] @ -data PatternSynonym dom stage - = PatternSynonym { _patLhs :: Ann PatSynLhs dom stage - , _patRhs :: Ann PatSynRhs dom stage - } - --- | Left hand side of a pattern synonym -data PatSynLhs dom stage - = NormalPatSyn { _patName :: Ann Name dom stage - , _patArgs :: AnnList Name dom stage - } - | InfixPatSyn { _patSynLhs :: Ann Name dom stage - , _patSynOp :: Ann Operator dom stage - , _patSynRhs :: Ann Name dom stage - } - | RecordPatSyn { _patName :: Ann Name dom stage - , _patArgs :: AnnList Name dom stage - } - --- | Right-hand side of pattern synonym -data PatSynRhs dom stage - = BidirectionalPatSyn { _patRhsPat :: Ann Pattern dom stage - , _patRhsOpposite :: AnnMaybe PatSynWhere dom stage - } -- ^ @ pattern Int = App "Int" [] @ or @ pattern Int <- App "Int" [] where Int = App "Int" [] @ - | OneDirectionalPatSyn { _patRhsPat :: Ann Pattern dom stage - } -- ^ @ pattern Int <- App "Int" [] @ - --- | Where clause of pattern synonym (explicit expression direction) -data PatSynWhere dom stage - = PatSynWhere { _patOpposite :: AnnList Match dom stage }
− Language/Haskell/Tools/AST/Exprs.hs
@@ -1,220 +0,0 @@--- | Representation of Haskell expressions -module Language.Haskell.Tools.AST.Exprs where - -import Language.Haskell.Tools.AST.Ann -import Language.Haskell.Tools.AST.Base -import Language.Haskell.Tools.AST.Literals -import Language.Haskell.Tools.AST.Types -import Language.Haskell.Tools.AST.Patterns -import Language.Haskell.Tools.AST.Stmts -import {-# SOURCE #-} Language.Haskell.Tools.AST.TH -import {-# SOURCE #-} Language.Haskell.Tools.AST.Binds (LocalBind, LocalBinds, RhsGuard) - --- | Haskell expressions -data Expr dom stage - = Var { _exprName :: Ann Name dom stage - } -- ^ A variable or a data constructor (@ a @) - | Lit { _exprLit :: Ann Literal dom stage - } -- ^ Primitive literal - | InfixApp { _exprLhs :: Ann Expr dom stage - , _exprOperator :: Ann Operator dom stage - , _exprRhs :: Ann Expr dom stage - } -- ^ Infix operator application (@ a + b @) - | PrefixApp { _exprOperator :: Ann Operator dom stage - , _exprRhs :: Ann Expr dom stage - } -- ^ Prefix operator application (@ -x @) - | App { _exprFun :: Ann Expr dom stage - , _exprArg :: Ann Expr dom stage - } -- ^ Function application (@ f 4 @) - -- unary minus omitted - | Lambda { _exprBindings :: AnnList Pattern dom stage -- ^ at least one - , _exprInner :: Ann Expr dom stage - } -- ^ Lambda expression (@ \a b -> a + b @) - | Let { _exprFunBind :: AnnList LocalBind dom stage -- ^ nonempty - , _exprInner :: Ann Expr dom stage - } -- ^ Local binding (@ let x = 2; y = 3 in e x y @) - | If { _exprCond :: Ann Expr dom stage - , _exprThen :: Ann Expr dom stage - , _exprElse :: Ann Expr dom stage - } -- ^ If expression (@ if a then b else c @) - | MultiIf { _exprIfAlts :: AnnList GuardedCaseRhs dom stage - } -- ^ Multi way if expressions with @MultiWayIf@ extension (@ if | guard1 -> expr1; guard2 -> expr2 @) - | Case { _exprCase :: Ann Expr dom stage - , _exprAlts :: AnnList Alt dom stage - } -- ^ Pattern matching expression (@ case expr of pat1 -> expr1; pat2 -> expr2 @) - | Do { _doKind :: Ann DoKind dom stage - , _exprStmts :: AnnList Stmt dom stage - } -- ^ Do-notation expressions (@ do x <- act1; act2 @) - | Tuple { _tupleElems :: AnnList Expr dom stage - } -- ^ Tuple expression (@ (e1, e2, e3) @) - | UnboxedTuple { _tupleElems :: AnnList Expr dom stage - } -- ^ Unboxed tuple expression (@ (# e1, e2, e3 #) @) - | TupleSection { _tupleSectionElems :: AnnList TupSecElem dom stage - } -- ^ Tuple section, enabled with @TupleSections@ (@ (a,,b) @). One of the elements must be missing. - | UnboxedTupSec { _tupleSectionElems :: AnnList TupSecElem dom stage - } - | List { _listElems :: AnnList Expr dom stage - } -- ^ List expression: @[1,2,3]@ - | ParArray { _listElems :: AnnList Expr dom stage - } -- ^ Parallel array expression: @[: 1,2,3 :]@ - | Paren { _exprInner :: Ann Expr dom stage - } - | LeftSection { _exprLhs :: Ann Expr dom stage - , _exprOperator :: Ann Operator dom stage - } -- ^ Left operator section: @(1+)@ - | RightSection { _exprOperator :: Ann Operator dom stage - , _exprRhs :: Ann Expr dom stage - } -- ^ Right operator section: @(+1)@ - | RecCon { _exprRecName :: Ann Name dom stage - , _exprRecFields :: AnnList FieldUpdate dom stage - } -- ^ Record value construction: @Point { x = 3, y = -2 }@ - | RecUpdate { _exprInner :: Ann Expr dom stage - , _exprRecFields :: AnnList FieldUpdate dom stage - } -- ^ Record value update: @p1 { x = 3, y = -2 }@ - | Enum { _enumFrom :: Ann Expr dom stage - , _enumThen :: AnnMaybe Expr dom stage - , _enumTo :: AnnMaybe Expr dom stage - } -- ^ Enumeration expression (@ [1,3..10] @) - | ParArrayEnum { _enumFrom :: Ann Expr dom stage - , _enumThen :: AnnMaybe Expr dom stage - , _enumToFix :: Ann Expr dom stage - } -- ^ Parallel array enumeration (@ [: 1,3 .. 10 :] @) - | ListComp { _compExpr :: Ann Expr dom stage - , _compBody :: AnnList ListCompBody dom stage -- ^ Can only have 1 element without @ParallelListComp@ - } -- ^ List comprehension (@ [ (x, y) | x <- xs | y <- ys ] @) - | ParArrayComp { _compExpr :: Ann Expr dom stage - , _compBody :: AnnList ListCompBody dom stage - } -- ^ Parallel array comprehensions @ [: (x, y) | x <- xs , y <- ys :] @ enabled by @ParallelArrays@ - | TypeSig { _exprInner :: Ann Expr dom stage - , _exprSig :: Ann Type dom stage - } -- ^ Explicit type signature (@ _x :: Int @) - | ExplTypeApp { _exprInner :: Ann Expr dom stage - , _exprType :: Ann Type dom stage - } -- ^ Explicit type application (@ show \@Integer (read "5") @) - | VarQuote { _quotedName :: Ann Name dom stage - } -- ^ @'x@ for template haskell reifying of expressions - | TypeQuote { _quotedName :: Ann Name dom stage - } -- ^ @''T@ for template haskell reifying of types - | BracketExpr { _bracket :: Ann Bracket dom stage - } -- ^ Template haskell bracket expression - | Splice { _innerExpr :: Ann Splice dom stage - } -- ^ Template haskell splice expression, for example: @$(gen a)@ or @$x@ - | QuasiQuoteExpr { _exprQQ :: Ann QuasiQuote dom stage - } -- ^ Template haskell quasi-quotation: @[$quoter|str]@ - | ExprPragma { _exprPragma :: Ann ExprPragma dom stage - } - -- Arrows - | Proc { _procPattern :: Ann Pattern dom stage - , _procExpr :: Ann Cmd dom stage - } -- ^ Arrow definition: @proc a -> f -< a+1@ - | ArrowApp { _exprLhs :: Ann Expr dom stage - , _arrowAppl :: Ann ArrowAppl dom stage - , _exprRhs :: Ann Expr dom stage - } -- ^ Arrow application: @f -< a+1@ - | LamCase { _exprAlts :: AnnList Alt dom stage - } -- ^ Lambda case ( @\case 0 -> 1; 1 -> 2@ ) - | StaticPtr { _exprInner :: Ann Expr 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 FieldUpdate dom stage - = NormalFieldUpdate { _fieldName :: Ann Name dom stage - , _fieldValue :: Ann Expr dom stage - } -- ^ Update of a field (@ x = 1 @) - | FieldPun { _fieldUpdateName :: Ann Name dom stage - } -- ^ Update the field to the value of the same name (@ x @) - | FieldWildcard { _fieldWildcard :: Ann FieldWildcard 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 FieldWildcard dom stage = FldWildcard - --- | An element of a tuple section that can be an expression or missing (indicating a value from a parameter) -data TupSecElem dom stage - = Present { _tupSecExpr :: Ann Expr dom stage - } -- ^ An existing element in a tuple section - | Missing -- ^ A missing element in a tuple section - --- | Clause of case expression -data Alt' expr dom stage - = Alt { _altPattern :: Ann Pattern dom stage - , _altRhs :: Ann (CaseRhs' expr) dom stage - , _altBinds :: AnnMaybe LocalBinds dom stage - } -type Alt = Alt' Expr -type CmdAlt = Alt' Cmd - - --- | Right hand side of a match (possible with guards): (@ = 3 @ or @ | x == 1 = 3; | otherwise = 4 @) -data CaseRhs' expr dom stage - = UnguardedCaseRhs { _rhsCaseExpr :: Ann expr dom stage - } - | GuardedCaseRhss { _rhsCaseGuards :: AnnList (GuardedCaseRhs' expr) dom stage - } -type CaseRhs = CaseRhs' Expr -type CmdCaseRhs = CaseRhs' Cmd - --- | A guarded right-hand side of pattern matches binding (@ | x > 3 -> 2 @) -data GuardedCaseRhs' expr dom stage - = GuardedCaseRhs { _caseGuardStmts :: AnnList RhsGuard dom stage -- ^ Cannot be empty. - , _caseGuardExpr :: Ann expr dom stage - } -type GuardedCaseRhs = GuardedCaseRhs' Expr -type CmdGuardedCaseRhs = GuardedCaseRhs' Cmd - --- | Pragmas that can be applied to expressions -data ExprPragma dom stage - = CorePragma { _pragmaStr :: Ann StringNode dom stage - } - | SccPragma { _pragmaStr :: Ann StringNode dom stage - } - | GeneratedPragma { _pragmaSrcRange :: Ann SourceRange dom stage - } - --- | In-AST source ranges (for generated pragmas) -data SourceRange dom stage - = SourceRange { _srFileName :: Ann StringNode dom stage - , _srFromLine :: Ann Number dom stage - , _srFromCol :: Ann Number dom stage - , _srToLine :: Ann Number dom stage - , _srToCol :: Ann Number dom stage - } - -data Number dom stage - = Number { _numberInteger :: Integer - } - -data Cmd dom stage - = ArrowAppCmd { _cmdLhs :: Ann Expr dom stage - , _cmdArrowOp :: Ann ArrowAppl dom stage - , _cmdRhs :: Ann Expr dom stage - } - | ArrowFormCmd { _cmdExpr :: Ann Expr dom stage - , _cmdInnerCmds :: AnnList Cmd dom stage - } - | AppCmd { _cmdInnerCmd :: Ann Cmd dom stage - , _cmdApplied :: Ann Expr dom stage - } - | InfixCmd { _cmdLeftCmd :: Ann Cmd dom stage - , _cmdOperator :: Ann Name dom stage - , _cmdRightCmd :: Ann Cmd dom stage - } - | LambdaCmd { _cmdBindings :: AnnList Pattern dom stage -- ^ at least one - , _cmdInner :: Ann Cmd dom stage - } - | ParenCmd { _cmdInner :: Ann Cmd dom stage - } - | CaseCmd { _cmdExpr :: Ann Expr dom stage - , _cmdAlts :: AnnList CmdAlt dom stage - } - | IfCmd { _cmdExpr :: Ann Expr dom stage - , _cmdThen :: Ann Cmd dom stage - , _cmdElse :: Ann Cmd dom stage - } - | LetCmd { _cmdBinds :: AnnList LocalBind dom stage -- ^ nonempty - , _cmdInner :: Ann Cmd dom stage - } - | DoCmd { _cmdStmts :: AnnList (Stmt' Cmd) dom stage - } -
− Language/Haskell/Tools/AST/Exprs.hs-boot
@@ -1,11 +0,0 @@-{-# LANGUAGE RoleAnnotations #-} -module Language.Haskell.Tools.AST.Exprs where - -type role Expr nominal nominal -data Expr dom stage - -type role Cmd nominal nominal -data Cmd dom stage - -type role FieldWildcard phantom phantom -data FieldWildcard dom stage
Language/Haskell/Tools/AST/Helpers.hs view
@@ -1,143 +1,71 @@-{-# LANGUAGE FlexibleContexts - , LambdaCase - , RankNTypes - , ScopedTypeVariables - , TypeFamilies - #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} + -- | Helper functions for using the AST. module Language.Haskell.Tools.AST.Helpers where +import qualified Name as GHC (Name) import SrcLoc -import qualified Name as GHC -import Control.Reference hiding (element) -import Control.Monad -import Data.List -import Data.Maybe -import Data.Function hiding ((&)) -import Data.Generics.Uniplate.Operations +import Control.Reference +import Data.Function (($), (.), on) +import Data.Generics.Uniplate.Operations (Biplate(..)) +import Data.List (elem, any, minimumBy) +import Data.Maybe (Maybe(..), isJust) import Language.Haskell.Tools.AST.Ann -import Language.Haskell.Tools.AST.Modules -import Language.Haskell.Tools.AST.Decls -import Language.Haskell.Tools.AST.Binds -import Language.Haskell.Tools.AST.Types -import Language.Haskell.Tools.AST.Base import Language.Haskell.Tools.AST.References -import Language.Haskell.Tools.AST.SemaInfoTypes - -import Debug.Trace - -ordByOccurrence :: QualifiedName dom stage -> QualifiedName dom stage -> Ordering -ordByOccurrence = compare `on` nameElements +import Language.Haskell.Tools.AST.Representation.Binds (ULocalBind, UValueBind) +import Language.Haskell.Tools.AST.Representation.Decls (UDeclHead, UDecl) +import Language.Haskell.Tools.AST.Representation.Modules (UImportDecl) +import Language.Haskell.Tools.AST.Representation.Names (UQualifiedName) +import Language.Haskell.Tools.AST.Representation.Patterns (UPattern) +import Language.Haskell.Tools.AST.Representation.Types (UType(..)) +import Language.Haskell.Tools.AST.SemaInfoTypes (Scope) --- | The occurrence of the name. -nameString :: QualifiedName dom stage -> String -nameString = intercalate "." . nameElements +-- | Does the import declaration import only the explicitly listed elements? +importIsExact :: Ann UImportDecl dom stage -> Bool +importIsExact = isJust . (^? importSpec&annJust&importSpecList) --- | The qualifiers and the unqualified name -nameElements :: QualifiedName dom stage -> [String] -nameElements n = (n ^? qualifiers&annList&element&simpleNameStr) - ++ [n ^. unqualifiedName&element&simpleNameStr] +-- | Does the import declaration import all elements that are not excluded explicitly? +importIsHiding :: Ann UImportDecl dom stage -> Bool +importIsHiding = isJust . (^? importSpec&annJust&importSpecHiding) --- | The qualifier of the name -nameQualifier :: QualifiedName dom stage -> [String] -nameQualifier n = n ^? qualifiers&annList&element&simpleNameStr - --- | Does the import declaration import only the explicitly listed elements? -importIsExact :: ImportDecl dom stage -> Bool -importIsExact = isJust . (^? importSpec&annJust&element&importSpecList) - --- | Does the import declaration has a 'hiding' clause? -importIsHiding :: ImportDecl dom stage -> Bool -importIsHiding = isJust . (^? importSpec&annJust&element&importSpecHiding) - --- | All elements that are explicitly listed to be imported in the import declaration -importExacts :: Simple Traversal (ImportDecl dom stage) (IESpec dom stage) -importExacts = importSpec&annJust&element&importSpecList&annList&element +-- | Accesses the name of a function or value binding +bindingName :: Simple Traversal (Ann UValueBind dom stage) (Ann UQualifiedName dom stage) +bindingName = (valBindPat&patternName&simpleName + &+& funBindMatches&annList&matchLhs + &(matchLhsName&simpleName &+& matchLhsOperator&operatorName)) --- | All elements that are hidden in an import -importHidings :: Simple Traversal (ImportDecl dom stage) (IESpec dom stage) -importHidings = importSpec&annJust&element&importSpecList&annList&element - --- | Possible qualifiers to use imported definitions -importQualifiers :: ImportDecl dom stage -> [[String]] -importQualifiers imp - = (if isAnnNothing (imp ^. importQualified) then [[]] else []) - ++ [imp ^? importAs&annJust&element&importRename&element&moduleNameString] - -bindingName :: (SemanticInfo dom QualifiedName ~ ni) => Simple Traversal (Ann ValueBind dom stage) ni -bindingName = element&(valBindPat&element&patternName&element&simpleName - &+& funBindMatches&annList&element&matchLhs&element - &(matchLhsName&element&simpleName &+& matchLhsOperator&element&operatorName)) - &semantics - -declHeadNames :: Simple Traversal (Ann DeclHead dom stage) (Ann QualifiedName dom stage) -declHeadNames = element & (dhName&element&simpleName &+& dhBody&declHeadNames &+& dhAppFun&declHeadNames &+& dhOperator&element&operatorName) +-- | Accesses that name of a declaration through the declaration head. +declHeadNames :: Simple Traversal (Ann UDeclHead dom stage) (Ann UQualifiedName dom stage) +declHeadNames = (dhName&simpleName &+& dhBody&declHeadNames &+& dhAppFun&declHeadNames &+& dhOperator&operatorName) - -typeParams :: Simple Traversal (Ann Type dom stage) (Ann Type dom stage) +-- | A reference to access type arguments to a type constructor call that may be universally qualified +-- or parenthesized. +typeParams :: Simple Traversal (Ann UType dom stage) (Ann UType dom stage) typeParams = fromTraversal typeParamsTrav - where typeParamsTrav f (Ann a (TyFun p r)) = Ann a <$> (TyFun <$> f p <*> typeParamsTrav f r) - typeParamsTrav f (Ann a (TyForall vs t)) = Ann a <$> (TyForall vs <$> typeParamsTrav f t) - typeParamsTrav f (Ann a (TyCtx ctx t)) = Ann a <$> (TyCtx ctx <$> typeParamsTrav f t) - typeParamsTrav f (Ann a (TyParen t)) = Ann a <$> (TyParen <$> typeParamsTrav f t) + where typeParamsTrav f (Ann a (UTyFun p r)) = Ann a <$> (UTyFun <$> f p <*> typeParamsTrav f r) + typeParamsTrav f (Ann a (UTyForall vs t)) = Ann a <$> (UTyForall vs <$> typeParamsTrav f t) + typeParamsTrav f (Ann a (UTyCtx ctx t)) = Ann a <$> (UTyCtx ctx <$> typeParamsTrav f t) + typeParamsTrav f (Ann a (UTyParen t)) = Ann a <$> (UTyParen <$> typeParamsTrav f t) typeParamsTrav f t = f t - +valBindPats :: Simple Traversal (Ann UValueBind dom stage) (Ann UPattern dom stage) +valBindPats = valBindPat &+& funBindMatches & annList & matchLhs & (matchLhsArgs & annList &+& matchLhsLhs &+& matchLhsRhs) + -- | Access the semantic information of an AST node. semantics :: Simple Lens (Ann elem dom stage) (SemanticInfo dom elem) semantics = annotation&semanticInfo -dhNames :: (SemanticInfo dom QualifiedName ~ k) => Simple Traversal (Ann DeclHead dom stage) k -dhNames = declHeadNames & semantics - --- | A type class for transformations that work on both top-level and local definitions -class BindingElem d where - sigBind :: Simple Partial (d dom stage) (Ann TypeSignature dom stage) - valBind :: Simple Partial (d dom stage) (Ann ValueBind dom stage) - createTypeSig :: Ann TypeSignature dom stage -> d dom stage - createBinding :: Ann ValueBind dom stage -> d dom stage - isTypeSig :: d dom stage -> Bool - isBinding :: d dom stage -> Bool - -instance BindingElem Decl where - sigBind = declTypeSig - valBind = declValBind - createTypeSig = TypeSigDecl - createBinding = ValueBinding - isTypeSig (TypeSigDecl _) = True - isTypeSig _ = False - isBinding (ValueBinding _) = True - isBinding _ = False - -instance BindingElem LocalBind where - sigBind = localSig - valBind = localVal - createTypeSig = LocalSignature - createBinding = LocalValBind - isTypeSig (LocalSignature _) = True - isTypeSig _ = False - isBinding (LocalValBind _) = True - isBinding _ = False - -bindName :: (BindingElem d, SemanticInfo dom QualifiedName ~ k) => Simple Traversal (d dom stage) k -bindName = valBind&bindingName &+& sigBind&element&tsName&annList&element&simpleName&semantics - -valBindsInList :: BindingElem d => Simple Traversal (AnnList d dom stage) (Ann ValueBind dom stage) -valBindsInList = annList & element & valBind - -getValBindInList :: (BindingElem d, SourceInfo stage) => RealSrcSpan -> AnnList d dom stage -> Maybe (Ann ValueBind dom stage) -getValBindInList sp ls = case ls ^? valBindsInList & filtered (isInside sp) of - [] -> Nothing - [n] -> Just n - _ -> error "getValBindInList: Multiple nodes" - -- | Get all nodes that contain a given source range -nodesContaining :: (HasRange (inner dom stage), Biplate (node dom stage) (inner dom stage), SourceInfo 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 @@ -145,42 +73,66 @@ _ -> False -- | Get all nodes that are contained in a given source range -nodesContained :: (HasRange (inner dom stage), Biplate (node dom stage) (inner dom stage), SourceInfo 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) - --- | 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 +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 results -> Just $ minimumBy (compareRangeLength `on` getRange) results --- | Compares two NESTED source spans based on their lengths +-- | Compares two source spans based on their lengths. Can only used for NESTED spans. compareRangeLength :: SrcSpan -> SrcSpan -> Ordering compareRangeLength (RealSrcSpan sp1) (RealSrcSpan sp2) = (lineDiff sp1 `compare` lineDiff sp2) `mappend` (colDiff sp1 `compare` colDiff sp2) where lineDiff sp = srcLocLine (realSrcSpanStart sp) - srcLocLine (realSrcSpanEnd sp) colDiff sp = srcLocCol (realSrcSpanStart sp) - srcLocCol (realSrcSpanEnd sp) -getNode :: (Biplate (Ann node dom stage) (Ann inner dom stage), SourceInfo stage) - => RealSrcSpan -> Ann node dom stage -> Ann inner dom stage -getNode sp node = case node ^? nodesWithRange sp of - [] -> error "getNode: The node cannot be found" - [n] -> n - _ -> error "getNode: Multiple nodes" +-- | A class to access the names of named elements. Have to locate where does the AST element store its name. +-- The returned name will be the one that was marked isDefining. +class NamedElement elem where + elementName :: Simple Traversal (Ann elem dom st) (Ann UQualifiedName dom st) + +instance NamedElement UDecl where + elementName = (declHead & declHeadNames) + &+& (declTypeFamily & tfHead & declHeadNames) + &+& (declValBind & bindingName) + &+& (declName & simpleName) + &+& (declTypeSig & tsName & annList & simpleName) + &+& (declPatSyn & patLhs & (patName & simpleName &+& patSynOp & operatorName)) + +instance NamedElement ULocalBind where + elementName = localVal&bindingName + &+& localSig&tsName&annList&simpleName + &+& localFixity&fixityOperators&annList&operatorName + +inScope :: GHC.Name -> Scope -> Bool +inScope n sc = any ((n `elem`) . map (^. _1)) sc + +-- * Pattern synonyms for annotated lists and maybes + +pattern AnnList :: [Ann elem dom stage] -> AnnListG elem dom stage +pattern AnnList elems <- AnnListG _ elems + +pattern AnnNothing :: AnnMaybeG elem dom stage +pattern AnnNothing <- AnnMaybeG _ Nothing + +pattern AnnJust :: Ann elem dom stage -> AnnMaybeG elem dom stage +pattern AnnJust elem <- AnnMaybeG _ (Just elem)
Language/Haskell/Tools/AST/Instances.hs view
@@ -1,9 +1,8 @@ -- | All derived instances for AST elements module Language.Haskell.Tools.AST.Instances where -import Language.Haskell.Tools.AST.Instances.Data -import Language.Haskell.Tools.AST.Instances.Eq -import Language.Haskell.Tools.AST.Instances.Show -import Language.Haskell.Tools.AST.Instances.Generic -import Language.Haskell.Tools.AST.Instances.SourceInfoTraversal -import Language.Haskell.Tools.AST.Instances.SemanticTraversal +import Language.Haskell.Tools.AST.Instances.Data () +import Language.Haskell.Tools.AST.Instances.Generic () +import Language.Haskell.Tools.AST.Instances.SemanticTraversal () +import Language.Haskell.Tools.AST.Instances.SourceInfoTraversal () +import Language.Haskell.Tools.AST.Instances.ClassyPlate ()
+ Language/Haskell/Tools/AST/Instances/ClassyPlate.hs view
@@ -0,0 +1,169 @@+-- don't show warnings, Template Haskell generated code contains unused variables +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-unused-matches #-} + +-- | Generating instances for traversing the semantic information of the Haskell Representation +module Language.Haskell.Tools.AST.Instances.ClassyPlate where + +import Data.Generics.ClassyPlate.TH + +import Language.Haskell.Tools.AST.Ann +import Language.Haskell.Tools.AST.Instances.Data () +import Language.Haskell.Tools.AST.Instances.Generic () + +import Language.Haskell.Tools.AST.Representation.Binds +import Language.Haskell.Tools.AST.Representation.Decls +import Language.Haskell.Tools.AST.Representation.Exprs +import Language.Haskell.Tools.AST.Representation.Kinds +import Language.Haskell.Tools.AST.Representation.Literals +import Language.Haskell.Tools.AST.Representation.Modules +import Language.Haskell.Tools.AST.Representation.Names +import Language.Haskell.Tools.AST.Representation.Patterns +import Language.Haskell.Tools.AST.Representation.Stmts +import Language.Haskell.Tools.AST.Representation.TH +import Language.Haskell.Tools.AST.Representation.Types + +makeClassyPlateConfig OnlyDirect [Right '_annotation] ''Ann +makeClassyPlateConfig OnlyDirect [Right '_annMaybeAnnot] ''AnnMaybeG +makeClassyPlateConfig OnlyDirect [Right '_annListAnnot] ''AnnListG + +makeClassyPlateConfig OnlyDirect [] ''Maybe +makeClassyPlateConfig OnlyDirect [] ''[] + +-- Modules +makeClassyPlateConfig OnlyDirect [] ''UModule +makeClassyPlateConfig OnlyDirect [] ''UModuleHead +makeClassyPlateConfig OnlyDirect [] ''UExportSpecs +makeClassyPlateConfig OnlyDirect [] ''UExportSpec +makeClassyPlateConfig OnlyDirect [] ''UIESpec +makeClassyPlateConfig OnlyDirect [] ''USubSpec +makeClassyPlateConfig OnlyDirect [] ''UModulePragma +makeClassyPlateConfig OnlyDirect [] ''UFilePragma +makeClassyPlateConfig OnlyDirect [] ''UImportDecl +makeClassyPlateConfig OnlyDirect [] ''UImportSpec +makeClassyPlateConfig OnlyDirect [] ''UImportModifier +makeClassyPlateConfig OnlyDirect [] ''UImportQualified +makeClassyPlateConfig OnlyDirect [] ''UImportSource +makeClassyPlateConfig OnlyDirect [] ''UImportSafe +makeClassyPlateConfig OnlyDirect [] ''UTypeNamespace +makeClassyPlateConfig OnlyDirect [] ''UImportRenaming + +-- Declarations +makeClassyPlateConfig OnlyDirect [] ''UDecl +makeClassyPlateConfig OnlyDirect [] ''UClassBody +makeClassyPlateConfig OnlyDirect [] ''UClassElement +makeClassyPlateConfig OnlyDirect [] ''UDeclHead +makeClassyPlateConfig OnlyDirect [] ''UInstBody +makeClassyPlateConfig OnlyDirect [] ''UInstBodyDecl +makeClassyPlateConfig OnlyDirect [] ''UGadtConDecl +makeClassyPlateConfig OnlyDirect [] ''UGadtConType +makeClassyPlateConfig OnlyDirect [] ''UFieldWildcard +makeClassyPlateConfig OnlyDirect [] ''UFunDeps +makeClassyPlateConfig OnlyDirect [] ''UFunDep +makeClassyPlateConfig OnlyDirect [] ''UConDecl +makeClassyPlateConfig OnlyDirect [] ''UFieldDecl +makeClassyPlateConfig OnlyDirect [] ''UDeriving +makeClassyPlateConfig OnlyDirect [] ''UDeriveStrategy +makeClassyPlateConfig OnlyDirect [] ''UInstanceRule +makeClassyPlateConfig OnlyDirect [] ''UInstanceHead +makeClassyPlateConfig OnlyDirect [] ''UTypeEqn +makeClassyPlateConfig OnlyDirect [] ''UKindConstraint +makeClassyPlateConfig OnlyDirect [] ''UTyVar +makeClassyPlateConfig OnlyDirect [] ''UType +makeClassyPlateConfig OnlyDirect [] ''UKind +makeClassyPlateConfig OnlyDirect [] ''UContext +makeClassyPlateConfig OnlyDirect [] ''UAssertion +makeClassyPlateConfig OnlyDirect [] ''UExpr +makeClassyPlateConfig OnlyDirect [] ''UCompStmt +makeClassyPlateConfig OnlyDirect [] ''UValueBind +makeClassyPlateConfig OnlyDirect [] ''UPattern +makeClassyPlateConfig OnlyDirect [] ''UPatternField +makeClassyPlateConfig OnlyDirect [] ''USplice +makeClassyPlateConfig OnlyDirect [Right '_qqString] ''QQString +makeClassyPlateConfig OnlyDirect [] ''UMatch +makeClassyPlateConfig OnlyDirect [] ''URhs +makeClassyPlateConfig OnlyDirect [] ''UGuardedRhs +makeClassyPlateConfig OnlyDirect [] ''UFieldUpdate +makeClassyPlateConfig OnlyDirect [] ''UBracket +makeClassyPlateConfig OnlyDirect [] ''UTopLevelPragma +makeClassyPlateConfig OnlyDirect [] ''URule +makeClassyPlateConfig OnlyDirect [] ''URuleVar +makeClassyPlateConfig OnlyDirect [] ''UAnnotationSubject +makeClassyPlateConfig OnlyDirect [] ''UMinimalFormula +makeClassyPlateConfig OnlyDirect [] ''UExprPragma +makeClassyPlateConfig OnlyDirect [] ''USourceRange +makeClassyPlateConfig OnlyDirect [Right '_numberInteger] ''Number +makeClassyPlateConfig OnlyDirect [] ''UQuasiQuote +makeClassyPlateConfig OnlyDirect [] ''URhsGuard +makeClassyPlateConfig OnlyDirect [] ''ULocalBind +makeClassyPlateConfig OnlyDirect [] ''ULocalBinds +makeClassyPlateConfig OnlyDirect [] ''UFixitySignature +makeClassyPlateConfig OnlyDirect [] ''UTypeSignature +makeClassyPlateConfig OnlyDirect [] ''UListCompBody +makeClassyPlateConfig OnlyDirect [] ''UTupSecElem +makeClassyPlateConfig OnlyDirect [] ''UTypeFamily +makeClassyPlateConfig OnlyDirect [] ''UTypeFamilySpec +makeClassyPlateConfig OnlyDirect [] ''UInjectivityAnn +makeClassyPlateConfig OnlyDirect [] ''UPatternSynonym +makeClassyPlateConfig OnlyDirect [] ''UPatSynRhs +makeClassyPlateConfig OnlyDirect [] ''UPatSynLhs +makeClassyPlateConfig OnlyDirect [] ''UPatSynWhere +makeClassyPlateConfig OnlyDirect [] ''UPatternTypeSignature +makeClassyPlateConfig OnlyDirect [] ''URole +makeClassyPlateConfig OnlyDirect [] ''UCmd +makeClassyPlateConfig OnlyDirect [Right '_langExt] ''ULanguageExtension +makeClassyPlateConfig OnlyDirect [] ''UMatchLhs +makeClassyPlateConfig OnlyDirect [] ''UStmt' +makeClassyPlateConfig OnlyDirect [] ''UAlt' +makeClassyPlateConfig OnlyDirect [] ''UCaseRhs' +makeClassyPlateConfig OnlyDirect [] ''UGuardedCaseRhs' +makeClassyPlateConfig OnlyDirect [] ''UInlinePragma +makeClassyPlateConfig OnlyDirect [] ''USpecializePragma +makeClassyPlateConfig OnlyDirect [] ''UUnboxedSumPlaceHolder + +-- ULiteral +makeClassyPlateConfig OnlyDirect [ Right '_charLitValue + , Right '_stringLitValue + , Right '_intLitValue + , Right '_fracLitValue + , Right '_intLitValue + , Right '_intLitValue + , Right '_floatLitValue + , Right '_floatLitValue + , Right '_charLitValue + , Right '_stringLitValue + ] ''ULiteral +makeClassyPlateConfig OnlyDirect [ Right '_promotedIntValue + , Right '_promotedStringValue + ] ''UPromoted + +-- Base +makeClassyPlateConfig OnlyDirect [] ''UOperator +makeClassyPlateConfig OnlyDirect [] ''UName +makeClassyPlateConfig OnlyDirect [] ''UQualifiedName +makeClassyPlateConfig OnlyDirect [Right '_moduleNameString] ''UModuleName +makeClassyPlateConfig OnlyDirect [Right '_simpleNameStr] ''UNamePart +makeClassyPlateConfig OnlyDirect [Right '_stringNodeStr] ''UStringNode +makeClassyPlateConfig OnlyDirect [] ''UDataOrNewtypeKeyword +makeClassyPlateConfig OnlyDirect [] ''UDoKind +makeClassyPlateConfig OnlyDirect [] ''TypeKeyword +makeClassyPlateConfig OnlyDirect [] ''UOverlapPragma +makeClassyPlateConfig OnlyDirect [] ''UCallConv +makeClassyPlateConfig OnlyDirect [] ''UArrowAppl +makeClassyPlateConfig OnlyDirect [] ''USafety +makeClassyPlateConfig OnlyDirect [] ''UConlikeAnnot +makeClassyPlateConfig OnlyDirect [] ''Assoc +makeClassyPlateConfig OnlyDirect [Right '_precedenceValue] ''Precedence +makeClassyPlateConfig OnlyDirect [Right '_lineNumber] ''LineNumber +makeClassyPlateConfig OnlyDirect [] ''UPhaseControl +makeClassyPlateConfig OnlyDirect [Right '_phaseNum] ''PhaseNumber +makeClassyPlateConfig OnlyDirect [] ''PhaseInvert
Language/Haskell/Tools/AST/Instances/Data.hs view
@@ -1,134 +1,174 @@ -- | Data instances for Haskell AST (used for generics) -{-# LANGUAGE FlexibleContexts, StandaloneDeriving, DeriveDataTypeable #-} -module Language.Haskell.Tools.AST.Instances.Data where +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} +module Language.Haskell.Tools.AST.Instances.Data () where + import Data.Data -import Language.Haskell.Tools.AST.Modules -import Language.Haskell.Tools.AST.TH -import Language.Haskell.Tools.AST.Decls -import Language.Haskell.Tools.AST.Binds -import Language.Haskell.Tools.AST.Exprs -import Language.Haskell.Tools.AST.Stmts -import Language.Haskell.Tools.AST.Patterns -import Language.Haskell.Tools.AST.Types -import Language.Haskell.Tools.AST.Kinds -import Language.Haskell.Tools.AST.Literals -import Language.Haskell.Tools.AST.Base import Language.Haskell.Tools.AST.Ann +import Language.Haskell.Tools.AST.Representation.Binds +import Language.Haskell.Tools.AST.Representation.Decls +import Language.Haskell.Tools.AST.Representation.Exprs +import Language.Haskell.Tools.AST.Representation.Kinds (UPromoted(..), UKind(..), UKindConstraint(..)) +import Language.Haskell.Tools.AST.Representation.Literals (ULiteral(..)) +import Language.Haskell.Tools.AST.Representation.Modules +import Language.Haskell.Tools.AST.Representation.Names +import Language.Haskell.Tools.AST.Representation.Patterns (UPatternField(..), UPattern(..)) +import Language.Haskell.Tools.AST.Representation.Stmts +import Language.Haskell.Tools.AST.Representation.TH +import Language.Haskell.Tools.AST.Representation.Types --- Annotations -deriving instance (DomainWith e dom, SourceInfo stage, Typeable e, Data (e dom stage)) => Data (Ann e dom stage) -deriving instance (DomainWith e dom, SourceInfo stage, Typeable e, Data (e dom stage)) => Data (AnnMaybe e dom stage) -deriving instance (DomainWith e dom, SourceInfo stage, Typeable e, Data (e dom stage)) => Data (AnnList e dom stage) +-- Making the annotation an opaque attribute in annotated elements. +-- Needed because otherwise uniplate traverses the annotations, resulting in unnecessary +-- evaluation and storage. +instance (DomainWith e dom, SourceInfo stage, Typeable e, Data (e dom stage)) + => Data (Ann e dom stage) where + gfoldl k z (Ann annot elem) = z (Ann annot) `k` elem -- ANNOT IS HIDDEN + gunfold k z c = case constrIndex c of 1 -> k (k (z Ann)) + toConstr (Ann{}) = con_Ann + dataTypeOf _ = ty_Ann + +con_Ann = mkConstr ty_Ann "Ann" [] Prefix +ty_Ann = mkDataType "Language.Haskell.Tools.AST.Ann.Ann" [con_Ann] + +instance (DomainWith e dom, SourceInfo stage, Typeable e, Data (e dom stage)) + => Data (AnnMaybeG e dom stage) where + gfoldl k z (AnnMaybeG annot elem) = z (AnnMaybeG annot) `k` elem -- ANNOT IS HIDDEN + gunfold k z c = case constrIndex c of 1 -> k (k (z AnnMaybeG)) + toConstr (AnnMaybeG{}) = con_AnnMaybeG + dataTypeOf _ = ty_AnnMaybeG + +con_AnnMaybeG = mkConstr ty_AnnMaybeG "AnnMaybeG" [] Prefix +ty_AnnMaybeG = mkDataType "Language.Haskell.Tools.AST.Ann.AnnMaybeG" [con_AnnMaybeG] + +instance (DomainWith e dom, SourceInfo stage, Typeable e, Data (e dom stage)) + => Data (AnnListG e dom stage) where + gfoldl k z (AnnListG annot elem) = z (AnnListG annot) `k` elem -- ANNOT IS HIDDEN + gunfold k z c = case constrIndex c of 1 -> k (k (z AnnListG)) + toConstr (AnnListG{}) = con_AnnListG + dataTypeOf _ = ty_AnnListG + +con_AnnListG = mkConstr ty_AnnListG "AnnListG" [] Prefix +ty_AnnListG = mkDataType "Language.Haskell.Tools.AST.Ann.AnnListG" [con_AnnListG] + -- Modules -deriving instance (Domain dom, SourceInfo stage) => Data (Module dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (ModuleHead dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (ExportSpecList dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (ExportSpec dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (IESpec dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (SubSpec dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (ModulePragma dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (FilePragma dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (ImportDecl dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (ImportSpec dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (ImportQualified dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (ImportSource dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (ImportSafe dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (TypeNamespace dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (ImportRenaming dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UModule dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UModuleHead dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UExportSpecs dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UExportSpec dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UIESpec dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (USubSpec dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UModulePragma dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UFilePragma dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UImportDecl dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UImportSpec dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UImportModifier dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UImportQualified dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UImportSource dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UImportSafe dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UTypeNamespace dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UImportRenaming dom stage) -- Declarations -deriving instance (Domain dom, SourceInfo stage) => Data (Decl dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (ClassBody dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (ClassElement dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (DeclHead dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (InstBody dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (InstBodyDecl dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (GadtConDecl dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (GadtConType dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (FieldWildcard dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (FunDeps dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (FunDep dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (ConDecl dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (FieldDecl dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (Deriving dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (InstanceRule dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (InstanceHead dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (TypeEqn dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (KindConstraint dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (TyVar dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (Type dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (Kind dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (Context dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (Assertion dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (Expr dom stage) -deriving instance (DomainWith expr dom, SourceInfo stage, Typeable expr, Data (expr dom stage)) => Data (Stmt' expr dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (CompStmt dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (ValueBind dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (Pattern dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (PatternField dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (Splice dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UDecl dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UClassBody dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UClassElement dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UDeclHead dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UInstBody dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UInstBodyDecl dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UGadtConDecl dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UGadtConType dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UFieldWildcard dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UFunDeps dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UFunDep dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UConDecl dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UFieldDecl dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UDeriving dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UDeriveStrategy dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UInstanceRule dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UInstanceHead dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UTypeEqn dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UKindConstraint dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UTyVar dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UType dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UKind dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UContext dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UAssertion dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UExpr dom stage) +deriving instance (DomainWith expr dom, SourceInfo stage, Typeable expr, Data (expr dom stage)) => Data (UStmt' expr dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UCompStmt dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UValueBind dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UPattern dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UPatternField dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (USplice dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (QQString dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (Match dom stage) -deriving instance (DomainWith expr dom, SourceInfo stage, Typeable expr, Data (expr dom stage)) => Data (Alt' expr dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (Rhs dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (GuardedRhs dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (FieldUpdate dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (Bracket dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (TopLevelPragma dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (Rule dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (AnnotationSubject dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (MinimalFormula dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (ExprPragma dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (SourceRange dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UMatch dom stage) +deriving instance (DomainWith expr dom, SourceInfo stage, Typeable expr, Data (expr dom stage)) => Data (UAlt' expr dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (URhs dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UGuardedRhs dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UFieldUpdate dom stage) +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) +deriving instance (Domain dom, SourceInfo stage) => Data (USourceRange dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (Number dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (QuasiQuote dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (RhsGuard dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (LocalBind dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (LocalBinds dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (FixitySignature dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (TypeSignature dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (ListCompBody dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (TupSecElem dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (TypeFamily dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (TypeFamilySpec dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (InjectivityAnn dom stage) -deriving instance (DomainWith expr dom, SourceInfo stage, Typeable expr, Data (expr dom stage)) => Data (CaseRhs' expr dom stage) -deriving instance (DomainWith expr dom, SourceInfo stage, Typeable expr, Data (expr dom stage))=> Data (GuardedCaseRhs' expr dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (PatternSynonym dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (PatSynRhs dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (PatSynLhs dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (PatSynWhere dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (PatternTypeSignature dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (Role dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (Cmd dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (LanguageExtension dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (MatchLhs dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UQuasiQuote dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (URhsGuard dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (ULocalBind dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (ULocalBinds dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UFixitySignature dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UTypeSignature dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UListCompBody dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UTupSecElem dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UTypeFamily dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UTypeFamilySpec dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UInjectivityAnn dom stage) +deriving instance (DomainWith expr dom, SourceInfo stage, Typeable expr, Data (expr dom stage)) => Data (UCaseRhs' expr dom stage) +deriving instance (DomainWith expr dom, SourceInfo stage, Typeable expr, Data (expr dom stage))=> Data (UGuardedCaseRhs' expr dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UPatternSynonym dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UPatSynRhs dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UPatSynLhs dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UPatSynWhere dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UPatternTypeSignature dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (URole dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UCmd dom stage) +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) +deriving instance (Domain dom, SourceInfo stage) => Data (UUnboxedSumPlaceHolder dom stage) --- Literal -deriving instance (Domain dom, SourceInfo stage) => Data (Literal dom stage) -deriving instance (DomainWith k dom, SourceInfo stage, Typeable k, Data (k dom stage)) => Data (Promoted k dom stage) +-- ULiteral +deriving instance (Domain dom, SourceInfo stage) => Data (ULiteral dom stage) +deriving instance (DomainWith k dom, SourceInfo stage, Typeable k, Data (k dom stage)) => Data (UPromoted k dom stage) -- Base -deriving instance (Domain dom, SourceInfo stage) => Data (Operator dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (Name dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (QualifiedName dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (ModuleName dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (UnqualName dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (StringNode dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (DataOrNewtypeKeyword dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (DoKind dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UOperator dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UName dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UQualifiedName dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UModuleName dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UNamePart dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UStringNode dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UDataOrNewtypeKeyword dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UDoKind dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (TypeKeyword dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (OverlapPragma dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (CallConv dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (ArrowAppl dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (Safety dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (ConlikeAnnot dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UOverlapPragma dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UCallConv dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UArrowAppl dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (USafety dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (UConlikeAnnot dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (Assoc dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (Precedence dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (LineNumber dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (PhaseControl 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)+deriving instance (Domain dom, SourceInfo stage) => Data (PhaseInvert dom stage)
− Language/Haskell/Tools/AST/Instances/Eq.hs
@@ -1,137 +0,0 @@--- | Equality check of AST nodes that ignore the source and semantic information. -{-# LANGUAGE FlexibleContexts, StandaloneDeriving #-} -module Language.Haskell.Tools.AST.Instances.Eq where - -import Language.Haskell.Tools.AST.Modules -import Language.Haskell.Tools.AST.TH -import Language.Haskell.Tools.AST.Decls -import Language.Haskell.Tools.AST.Binds -import Language.Haskell.Tools.AST.Exprs -import Language.Haskell.Tools.AST.Stmts -import Language.Haskell.Tools.AST.Patterns -import Language.Haskell.Tools.AST.Types -import Language.Haskell.Tools.AST.Kinds -import Language.Haskell.Tools.AST.Literals -import Language.Haskell.Tools.AST.Base -import Language.Haskell.Tools.AST.Ann - --- Annotations -instance (Eq (e dom stage)) => Eq (Ann e dom stage) where - Ann _ e1 == Ann _ e2 = e1 == e2 - -instance (Eq (e dom stage)) => Eq (AnnMaybe e dom stage) where - AnnMaybe _ e1 == AnnMaybe _ e2 = e1 == e2 - -instance (Eq (e dom stage)) => Eq (AnnList e dom stage) where - AnnList _ e1 == AnnList _ e2 = e1 == e2 - --- Modules -deriving instance Eq (Module dom stage) -deriving instance Eq (ModuleHead dom stage) -deriving instance Eq (ExportSpecList dom stage) -deriving instance Eq (ExportSpec dom stage) -deriving instance Eq (IESpec dom stage) -deriving instance Eq (SubSpec dom stage) -deriving instance Eq (ModulePragma dom stage) -deriving instance Eq (FilePragma dom stage) -deriving instance Eq (ImportDecl dom stage) -deriving instance Eq (ImportSpec dom stage) -deriving instance Eq (ImportQualified dom stage) -deriving instance Eq (ImportSource dom stage) -deriving instance Eq (ImportSafe dom stage) -deriving instance Eq (TypeNamespace dom stage) -deriving instance Eq (ImportRenaming dom stage) - --- Declarations -deriving instance Eq (Decl dom stage) -deriving instance Eq (ClassBody dom stage) -deriving instance Eq (ClassElement dom stage) -deriving instance Eq (DeclHead dom stage) -deriving instance Eq (InstBody dom stage) -deriving instance Eq (InstBodyDecl dom stage) -deriving instance Eq (GadtConDecl dom stage) -deriving instance Eq (GadtConType dom stage) -deriving instance Eq (FieldWildcard dom stage) -deriving instance Eq (FunDeps dom stage) -deriving instance Eq (FunDep dom stage) -deriving instance Eq (ConDecl dom stage) -deriving instance Eq (FieldDecl dom stage) -deriving instance Eq (Deriving dom stage) -deriving instance Eq (InstanceRule dom stage) -deriving instance Eq (InstanceHead dom stage) -deriving instance Eq (TypeEqn dom stage) -deriving instance Eq (KindConstraint dom stage) -deriving instance Eq (TyVar dom stage) -deriving instance Eq (Type dom stage) -deriving instance Eq (Kind dom stage) -deriving instance Eq (Context dom stage) -deriving instance Eq (Assertion dom stage) -deriving instance Eq (Expr dom stage) -deriving instance Eq (expr dom stage) => Eq (Stmt' expr dom stage) -deriving instance Eq (CompStmt dom stage) -deriving instance Eq (ValueBind dom stage) -deriving instance Eq (Pattern dom stage) -deriving instance Eq (PatternField dom stage) -deriving instance Eq (Splice dom stage) -deriving instance Eq (QQString dom stage) -deriving instance Eq (Match dom stage) -deriving instance Eq (expr dom stage) => Eq (Alt' expr dom stage) -deriving instance Eq (Rhs dom stage) -deriving instance Eq (GuardedRhs dom stage) -deriving instance Eq (FieldUpdate dom stage) -deriving instance Eq (Bracket dom stage) -deriving instance Eq (TopLevelPragma dom stage) -deriving instance Eq (Rule dom stage) -deriving instance Eq (AnnotationSubject dom stage) -deriving instance Eq (MinimalFormula dom stage) -deriving instance Eq (ExprPragma dom stage) -deriving instance Eq (SourceRange dom stage) -deriving instance Eq (Number dom stage) -deriving instance Eq (QuasiQuote dom stage) -deriving instance Eq (RhsGuard dom stage) -deriving instance Eq (LocalBind dom stage) -deriving instance Eq (LocalBinds dom stage) -deriving instance Eq (FixitySignature dom stage) -deriving instance Eq (TypeSignature dom stage) -deriving instance Eq (ListCompBody dom stage) -deriving instance Eq (TupSecElem dom stage) -deriving instance Eq (TypeFamily dom stage) -deriving instance Eq (TypeFamilySpec dom stage) -deriving instance Eq (InjectivityAnn dom stage) -deriving instance Eq (expr dom stage) => Eq (CaseRhs' expr dom stage) -deriving instance Eq (expr dom stage) => Eq (GuardedCaseRhs' expr dom stage) -deriving instance Eq (PatternSynonym dom stage) -deriving instance Eq (PatSynRhs dom stage) -deriving instance Eq (PatSynLhs dom stage) -deriving instance Eq (PatSynWhere dom stage) -deriving instance Eq (PatternTypeSignature dom stage) -deriving instance Eq (Role dom stage) -deriving instance Eq (Cmd dom stage) -deriving instance Eq (LanguageExtension dom stage) -deriving instance Eq (MatchLhs dom stage) - --- Literal -deriving instance Eq (Literal dom stage) -deriving instance Eq (k dom stage) => Eq (Promoted k dom stage) - --- Base -deriving instance Eq (Operator dom stage) -deriving instance Eq (Name dom stage) -deriving instance Eq (QualifiedName dom stage) -deriving instance Eq (ModuleName dom stage) -deriving instance Eq (UnqualName dom stage) -deriving instance Eq (StringNode dom stage) -deriving instance Eq (DataOrNewtypeKeyword dom stage) -deriving instance Eq (DoKind dom stage) -deriving instance Eq (TypeKeyword dom stage) -deriving instance Eq (OverlapPragma dom stage) -deriving instance Eq (CallConv dom stage) -deriving instance Eq (ArrowAppl dom stage) -deriving instance Eq (Safety dom stage) -deriving instance Eq (ConlikeAnnot dom stage) -deriving instance Eq (Assoc dom stage) -deriving instance Eq (Precedence dom stage) -deriving instance Eq (LineNumber dom stage) -deriving instance Eq (PhaseControl dom stage) -deriving instance Eq (PhaseNumber dom stage) -deriving instance Eq (PhaseInvert dom stage)
Language/Haskell/Tools/AST/Instances/Generic.hs view
@@ -1,135 +1,146 @@ -- | Generic instance for Haskell AST representation -{-# LANGUAGE FlexibleContexts, StandaloneDeriving, DeriveGeneric #-} -module Language.Haskell.Tools.AST.Instances.Generic where +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} -import GHC.Generics +module Language.Haskell.Tools.AST.Instances.Generic () where -import Language.Haskell.Tools.AST.Modules -import Language.Haskell.Tools.AST.TH -import Language.Haskell.Tools.AST.Decls -import Language.Haskell.Tools.AST.Binds -import Language.Haskell.Tools.AST.Exprs -import Language.Haskell.Tools.AST.Stmts -import Language.Haskell.Tools.AST.Patterns -import Language.Haskell.Tools.AST.Types -import Language.Haskell.Tools.AST.Kinds -import Language.Haskell.Tools.AST.Literals -import Language.Haskell.Tools.AST.Base +import GHC.Generics (Generic(..)) + import Language.Haskell.Tools.AST.Ann +import Language.Haskell.Tools.AST.Representation.Binds +import Language.Haskell.Tools.AST.Representation.Decls +import Language.Haskell.Tools.AST.Representation.Exprs +import Language.Haskell.Tools.AST.Representation.Kinds (UPromoted(..), UKind(..), UKindConstraint(..)) +import Language.Haskell.Tools.AST.Representation.Literals (ULiteral(..)) +import Language.Haskell.Tools.AST.Representation.Modules +import Language.Haskell.Tools.AST.Representation.Names +import Language.Haskell.Tools.AST.Representation.Patterns (UPatternField(..), UPattern(..)) +import Language.Haskell.Tools.AST.Representation.Stmts +import Language.Haskell.Tools.AST.Representation.TH +import Language.Haskell.Tools.AST.Representation.Types -- Annotations -deriving instance (Domain dom, SourceInfo stage, Generic (e dom stage)) => Generic (Ann e dom stage) -deriving instance (Domain dom, SourceInfo stage, Generic (e dom stage)) => Generic (AnnMaybe e dom stage) -deriving instance (Domain dom, SourceInfo stage, Generic (e dom stage)) => Generic (AnnList e dom stage) +deriving instance Domain dom => Generic (Ann e dom stage) +deriving instance Domain dom => Generic (AnnMaybeG e dom stage) +deriving instance Domain dom => Generic (AnnListG e dom stage) -- Modules -deriving instance (Domain dom, SourceInfo stage) => Generic (Module dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (ModuleHead dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (ExportSpecList dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (ExportSpec dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (IESpec dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (SubSpec dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (ModulePragma dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (FilePragma dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (ImportDecl dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (ImportSpec dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (ImportQualified dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (ImportSource dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (ImportSafe dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (TypeNamespace dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (ImportRenaming dom stage) +deriving instance Domain dom => Generic (UModule dom stage) +deriving instance Domain dom => Generic (UModuleHead dom stage) +deriving instance Domain dom => Generic (UExportSpecs dom stage) +deriving instance Domain dom => Generic (UExportSpec dom stage) +deriving instance Domain dom => Generic (UIESpec dom stage) +deriving instance Domain dom => Generic (USubSpec dom stage) +deriving instance Domain dom => Generic (UModulePragma dom stage) +deriving instance Domain dom => Generic (UFilePragma dom stage) +deriving instance Domain dom => Generic (UImportDecl dom stage) +deriving instance Domain dom => Generic (UImportSpec dom stage) +deriving instance Domain dom => Generic (UImportModifier dom stage) +deriving instance Domain dom => Generic (UImportQualified dom stage) +deriving instance Domain dom => Generic (UImportSource dom stage) +deriving instance Domain dom => Generic (UImportSafe dom stage) +deriving instance Domain dom => Generic (UTypeNamespace dom stage) +deriving instance Domain dom => Generic (UImportRenaming dom stage) -- Declarations -deriving instance (Domain dom, SourceInfo stage) => Generic (Decl dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (ClassBody dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (ClassElement dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (DeclHead dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (InstBody dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (InstBodyDecl dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (GadtConDecl dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (GadtConType dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (FieldWildcard dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (FunDeps dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (FunDep dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (ConDecl dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (FieldDecl dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (Deriving dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (InstanceRule dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (InstanceHead dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (TypeEqn dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (KindConstraint dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (TyVar dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (Type dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (Kind dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (Context dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (Assertion dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (Expr dom stage) -deriving instance (Domain dom, SourceInfo stage, Generic (expr dom stage)) => Generic (Stmt' expr dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (CompStmt dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (ValueBind dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (Pattern dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (PatternField dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (Splice dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (QQString dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (Match dom stage) -deriving instance (Domain dom, SourceInfo stage, Generic (expr dom stage)) => Generic (Alt' expr dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (Rhs dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (GuardedRhs dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (FieldUpdate dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (Bracket dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (TopLevelPragma dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (Rule dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (AnnotationSubject dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (MinimalFormula dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (ExprPragma dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (SourceRange dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (Number dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (QuasiQuote dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (RhsGuard dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (LocalBind dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (LocalBinds dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (FixitySignature dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (TypeSignature dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (ListCompBody dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (TupSecElem dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (TypeFamily dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (TypeFamilySpec dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (InjectivityAnn dom stage) -deriving instance (Domain dom, SourceInfo stage, Generic (expr dom stage)) => Generic (CaseRhs' expr dom stage) -deriving instance (Domain dom, SourceInfo stage, Generic (expr dom stage)) => Generic (GuardedCaseRhs' expr dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (PatternSynonym dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (PatSynRhs dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (PatSynLhs dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (PatSynWhere dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (PatternTypeSignature dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (Role dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (Cmd dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (LanguageExtension dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (MatchLhs dom stage) +deriving instance Domain dom => Generic (UDecl dom stage) +deriving instance Domain dom => Generic (UClassBody dom stage) +deriving instance Domain dom => Generic (UClassElement dom stage) +deriving instance Domain dom => Generic (UDeclHead dom stage) +deriving instance Domain dom => Generic (UInstBody dom stage) +deriving instance Domain dom => Generic (UInstBodyDecl dom stage) +deriving instance Domain dom => Generic (UGadtConDecl dom stage) +deriving instance Domain dom => Generic (UGadtConType dom stage) +deriving instance Domain dom => Generic (UFieldWildcard dom stage) +deriving instance Domain dom => Generic (UFunDeps dom stage) +deriving instance Domain dom => Generic (UFunDep dom stage) +deriving instance Domain dom => Generic (UConDecl dom stage) +deriving instance Domain dom => Generic (UFieldDecl dom stage) +deriving instance Domain dom => Generic (UDeriving dom stage) +deriving instance Domain dom => Generic (UDeriveStrategy dom stage) +deriving instance Domain dom => Generic (UInstanceRule dom stage) +deriving instance Domain dom => Generic (UInstanceHead dom stage) +deriving instance Domain dom => Generic (UTypeEqn dom stage) +deriving instance Domain dom => Generic (UKindConstraint dom stage) +deriving instance Domain dom => Generic (UTyVar dom stage) +deriving instance Domain dom => Generic (UType dom stage) +deriving instance Domain dom => Generic (UKind dom stage) +deriving instance Domain dom => Generic (UContext dom stage) +deriving instance Domain dom => Generic (UAssertion dom stage) +deriving instance Domain dom => Generic (UExpr dom stage) +deriving instance Domain dom => Generic (UStmt' expr dom stage) +deriving instance Domain dom => Generic (UCompStmt dom stage) +deriving instance Domain dom => Generic (UValueBind dom stage) +deriving instance Domain dom => Generic (UPattern dom stage) +deriving instance Domain dom => Generic (UPatternField dom stage) +deriving instance Domain dom => Generic (USplice dom stage) +deriving instance Domain dom => Generic (QQString dom stage) +deriving instance Domain dom => Generic (UMatch dom stage) +deriving instance Domain dom => Generic (UAlt' expr dom stage) +deriving instance Domain dom => Generic (URhs dom stage) +deriving instance Domain dom => Generic (UGuardedRhs dom stage) +deriving instance Domain dom => Generic (UFieldUpdate dom stage) +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) +deriving instance Domain dom => Generic (USourceRange dom stage) +deriving instance Domain dom => Generic (Number dom stage) +deriving instance Domain dom => Generic (UQuasiQuote dom stage) +deriving instance Domain dom => Generic (URhsGuard dom stage) +deriving instance Domain dom => Generic (ULocalBind dom stage) +deriving instance Domain dom => Generic (ULocalBinds dom stage) +deriving instance Domain dom => Generic (UFixitySignature dom stage) +deriving instance Domain dom => Generic (UTypeSignature dom stage) +deriving instance Domain dom => Generic (UListCompBody dom stage) +deriving instance Domain dom => Generic (UTupSecElem dom stage) +deriving instance Domain dom => Generic (UTypeFamily dom stage) +deriving instance Domain dom => Generic (UTypeFamilySpec dom stage) +deriving instance Domain dom => Generic (UInjectivityAnn dom stage) +deriving instance Domain dom => Generic (UCaseRhs' expr dom stage) +deriving instance Domain dom => Generic (UGuardedCaseRhs' expr dom stage) +deriving instance Domain dom => Generic (UPatternSynonym dom stage) +deriving instance Domain dom => Generic (UPatSynRhs dom stage) +deriving instance Domain dom => Generic (UPatSynLhs dom stage) +deriving instance Domain dom => Generic (UPatSynWhere dom stage) +deriving instance Domain dom => Generic (UPatternTypeSignature dom stage) +deriving instance Domain dom => Generic (URole dom stage) +deriving instance Domain dom => Generic (UCmd dom stage) +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) +deriving instance Domain dom => Generic (UUnboxedSumPlaceHolder dom stage) -- Literal -deriving instance (Domain dom, SourceInfo stage) => Generic (Literal dom stage) -deriving instance (Domain dom, SourceInfo stage, Generic (k dom stage)) => Generic (Promoted k dom stage) +deriving instance Domain dom => Generic (ULiteral dom stage) +deriving instance Domain dom => Generic (UPromoted k dom stage) -- Base -deriving instance (Domain dom, SourceInfo stage) => Generic (Operator dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (Name dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (QualifiedName dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (ModuleName dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (UnqualName dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (StringNode dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (DataOrNewtypeKeyword dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (DoKind dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (TypeKeyword dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (OverlapPragma dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (CallConv dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (ArrowAppl dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (Safety dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (ConlikeAnnot dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (Assoc dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (Precedence dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (LineNumber dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (PhaseControl dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (PhaseNumber dom stage) -deriving instance (Domain dom, SourceInfo stage) => Generic (PhaseInvert dom stage)+deriving instance Domain dom => Generic (UOperator dom stage) +deriving instance Domain dom => Generic (UName dom stage) +deriving instance Domain dom => Generic (UQualifiedName dom stage) +deriving instance Domain dom => Generic (UModuleName dom stage) +deriving instance Domain dom => Generic (UNamePart dom stage) +deriving instance Domain dom => Generic (UStringNode dom stage) +deriving instance Domain dom => Generic (UDataOrNewtypeKeyword dom stage) +deriving instance Domain dom => Generic (UDoKind dom stage) +deriving instance Domain dom => Generic (TypeKeyword dom stage) +deriving instance Domain dom => Generic (UOverlapPragma dom stage) +deriving instance Domain dom => Generic (UCallConv dom stage) +deriving instance Domain dom => Generic (UArrowAppl dom stage) +deriving instance Domain dom => Generic (USafety dom stage) +deriving instance Domain dom => Generic (UConlikeAnnot dom stage) +deriving instance Domain dom => Generic (Assoc dom stage) +deriving instance Domain dom => Generic (Precedence dom stage) +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)
Language/Haskell/Tools/AST/Instances/SemanticTraversal.hs view
@@ -1,132 +1,139 @@+-- don't show warnings, Template Haskell generated code contains unused variables +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-unused-matches #-} + -- | Generating instances for traversing the semantic information of the Haskell Representation -{-# LANGUAGE TemplateHaskell - #-} -module Language.Haskell.Tools.AST.Instances.SemanticTraversal where +module Language.Haskell.Tools.AST.Instances.SemanticTraversal () where -import Language.Haskell.Tools.AST.TH.SemanticTraversal import Control.Applicative +import Language.Haskell.Tools.AST.TH.SemanticTraversal -import Language.Haskell.Tools.AST.Modules -import Language.Haskell.Tools.AST.TH -import Language.Haskell.Tools.AST.Decls -import Language.Haskell.Tools.AST.Binds -import Language.Haskell.Tools.AST.Exprs -import Language.Haskell.Tools.AST.Stmts -import Language.Haskell.Tools.AST.Patterns -import Language.Haskell.Tools.AST.Types -import Language.Haskell.Tools.AST.Kinds -import Language.Haskell.Tools.AST.Literals -import Language.Haskell.Tools.AST.Base -import Language.Haskell.Tools.AST.Ann +import Language.Haskell.Tools.AST.Representation.Binds +import Language.Haskell.Tools.AST.Representation.Decls +import Language.Haskell.Tools.AST.Representation.Exprs +import Language.Haskell.Tools.AST.Representation.Kinds +import Language.Haskell.Tools.AST.Representation.Literals +import Language.Haskell.Tools.AST.Representation.Modules +import Language.Haskell.Tools.AST.Representation.Names +import Language.Haskell.Tools.AST.Representation.Patterns +import Language.Haskell.Tools.AST.Representation.Stmts +import Language.Haskell.Tools.AST.Representation.TH +import Language.Haskell.Tools.AST.Representation.Types -- Modules -deriveSemanticTraversal ''Module -deriveSemanticTraversal ''ModuleHead -deriveSemanticTraversal ''ExportSpecList -deriveSemanticTraversal ''ExportSpec -deriveSemanticTraversal ''IESpec -deriveSemanticTraversal ''SubSpec -deriveSemanticTraversal ''ModulePragma -deriveSemanticTraversal ''FilePragma -deriveSemanticTraversal ''ImportDecl -deriveSemanticTraversal ''ImportSpec -deriveSemanticTraversal ''ImportQualified -deriveSemanticTraversal ''ImportSource -deriveSemanticTraversal ''ImportSafe -deriveSemanticTraversal ''TypeNamespace -deriveSemanticTraversal ''ImportRenaming +deriveSemanticTraversal ''UModule +deriveSemanticTraversal ''UModuleHead +deriveSemanticTraversal ''UExportSpecs +deriveSemanticTraversal ''UExportSpec +deriveSemanticTraversal ''UIESpec +deriveSemanticTraversal ''USubSpec +deriveSemanticTraversal ''UModulePragma +deriveSemanticTraversal ''UFilePragma +deriveSemanticTraversal ''UImportDecl +deriveSemanticTraversal ''UImportSpec +deriveSemanticTraversal ''UImportModifier +deriveSemanticTraversal ''UImportQualified +deriveSemanticTraversal ''UImportSource +deriveSemanticTraversal ''UImportSafe +deriveSemanticTraversal ''UTypeNamespace +deriveSemanticTraversal ''UImportRenaming -- Declarations -deriveSemanticTraversal ''Decl -deriveSemanticTraversal ''ClassBody -deriveSemanticTraversal ''ClassElement -deriveSemanticTraversal ''DeclHead -deriveSemanticTraversal ''InstBody -deriveSemanticTraversal ''InstBodyDecl -deriveSemanticTraversal ''GadtConDecl -deriveSemanticTraversal ''GadtConType -deriveSemanticTraversal ''FieldWildcard -deriveSemanticTraversal ''FunDeps -deriveSemanticTraversal ''FunDep -deriveSemanticTraversal ''ConDecl -deriveSemanticTraversal ''FieldDecl -deriveSemanticTraversal ''Deriving -deriveSemanticTraversal ''InstanceRule -deriveSemanticTraversal ''InstanceHead -deriveSemanticTraversal ''TypeEqn -deriveSemanticTraversal ''KindConstraint -deriveSemanticTraversal ''TyVar -deriveSemanticTraversal ''Type -deriveSemanticTraversal ''Kind -deriveSemanticTraversal ''Context -deriveSemanticTraversal ''Assertion -deriveSemanticTraversal ''Expr -deriveSemanticTraversal ''CompStmt -deriveSemanticTraversal ''ValueBind -deriveSemanticTraversal ''Pattern -deriveSemanticTraversal ''PatternField -deriveSemanticTraversal ''Splice +deriveSemanticTraversal ''UDecl +deriveSemanticTraversal ''UClassBody +deriveSemanticTraversal ''UClassElement +deriveSemanticTraversal ''UDeclHead +deriveSemanticTraversal ''UInstBody +deriveSemanticTraversal ''UInstBodyDecl +deriveSemanticTraversal ''UGadtConDecl +deriveSemanticTraversal ''UGadtConType +deriveSemanticTraversal ''UFieldWildcard +deriveSemanticTraversal ''UFunDeps +deriveSemanticTraversal ''UFunDep +deriveSemanticTraversal ''UConDecl +deriveSemanticTraversal ''UFieldDecl +deriveSemanticTraversal ''UDeriving +deriveSemanticTraversal ''UDeriveStrategy +deriveSemanticTraversal ''UInstanceRule +deriveSemanticTraversal ''UInstanceHead +deriveSemanticTraversal ''UTypeEqn +deriveSemanticTraversal ''UKindConstraint +deriveSemanticTraversal ''UTyVar +deriveSemanticTraversal ''UType +deriveSemanticTraversal ''UKind +deriveSemanticTraversal ''UContext +deriveSemanticTraversal ''UAssertion +deriveSemanticTraversal ''UExpr +deriveSemanticTraversal ''UCompStmt +deriveSemanticTraversal ''UValueBind +deriveSemanticTraversal ''UPattern +deriveSemanticTraversal ''UPatternField +deriveSemanticTraversal ''USplice deriveSemanticTraversal ''QQString -deriveSemanticTraversal ''Match -deriveSemanticTraversal ''Rhs -deriveSemanticTraversal ''GuardedRhs -deriveSemanticTraversal ''FieldUpdate -deriveSemanticTraversal ''Bracket -deriveSemanticTraversal ''TopLevelPragma -deriveSemanticTraversal ''Rule -deriveSemanticTraversal ''AnnotationSubject -deriveSemanticTraversal ''MinimalFormula -deriveSemanticTraversal ''ExprPragma -deriveSemanticTraversal ''SourceRange +deriveSemanticTraversal ''UMatch +deriveSemanticTraversal ''URhs +deriveSemanticTraversal ''UGuardedRhs +deriveSemanticTraversal ''UFieldUpdate +deriveSemanticTraversal ''UBracket +deriveSemanticTraversal ''UTopLevelPragma +deriveSemanticTraversal ''URule +deriveSemanticTraversal ''URuleVar +deriveSemanticTraversal ''UAnnotationSubject +deriveSemanticTraversal ''UMinimalFormula +deriveSemanticTraversal ''UExprPragma +deriveSemanticTraversal ''USourceRange deriveSemanticTraversal ''Number -deriveSemanticTraversal ''QuasiQuote -deriveSemanticTraversal ''RhsGuard -deriveSemanticTraversal ''LocalBind -deriveSemanticTraversal ''LocalBinds -deriveSemanticTraversal ''FixitySignature -deriveSemanticTraversal ''TypeSignature -deriveSemanticTraversal ''ListCompBody -deriveSemanticTraversal ''TupSecElem -deriveSemanticTraversal ''TypeFamily -deriveSemanticTraversal ''TypeFamilySpec -deriveSemanticTraversal ''InjectivityAnn -deriveSemanticTraversal ''PatternSynonym -deriveSemanticTraversal ''PatSynRhs -deriveSemanticTraversal ''PatSynLhs -deriveSemanticTraversal ''PatSynWhere -deriveSemanticTraversal ''PatternTypeSignature -deriveSemanticTraversal ''Role -deriveSemanticTraversal ''Cmd -deriveSemanticTraversal ''LanguageExtension -deriveSemanticTraversal ''MatchLhs -deriveSemanticTraversal ''Stmt' -deriveSemanticTraversal ''Alt' -deriveSemanticTraversal ''CaseRhs' -deriveSemanticTraversal ''GuardedCaseRhs' +deriveSemanticTraversal ''UQuasiQuote +deriveSemanticTraversal ''URhsGuard +deriveSemanticTraversal ''ULocalBind +deriveSemanticTraversal ''ULocalBinds +deriveSemanticTraversal ''UFixitySignature +deriveSemanticTraversal ''UTypeSignature +deriveSemanticTraversal ''UListCompBody +deriveSemanticTraversal ''UTupSecElem +deriveSemanticTraversal ''UTypeFamily +deriveSemanticTraversal ''UTypeFamilySpec +deriveSemanticTraversal ''UInjectivityAnn +deriveSemanticTraversal ''UPatternSynonym +deriveSemanticTraversal ''UPatSynRhs +deriveSemanticTraversal ''UPatSynLhs +deriveSemanticTraversal ''UPatSynWhere +deriveSemanticTraversal ''UPatternTypeSignature +deriveSemanticTraversal ''URole +deriveSemanticTraversal ''UCmd +deriveSemanticTraversal ''ULanguageExtension +deriveSemanticTraversal ''UMatchLhs +deriveSemanticTraversal ''UStmt' +deriveSemanticTraversal ''UAlt' +deriveSemanticTraversal ''UCaseRhs' +deriveSemanticTraversal ''UGuardedCaseRhs' +deriveSemanticTraversal ''UInlinePragma +deriveSemanticTraversal ''USpecializePragma +deriveSemanticTraversal ''UUnboxedSumPlaceHolder --- Literal -deriveSemanticTraversal ''Literal -deriveSemanticTraversal ''Promoted +-- ULiteral +deriveSemanticTraversal ''ULiteral +deriveSemanticTraversal ''UPromoted -- Base -deriveSemanticTraversal ''Operator -deriveSemanticTraversal ''Name -deriveSemanticTraversal ''QualifiedName -deriveSemanticTraversal ''ModuleName -deriveSemanticTraversal ''UnqualName -deriveSemanticTraversal ''StringNode -deriveSemanticTraversal ''DataOrNewtypeKeyword -deriveSemanticTraversal ''DoKind +deriveSemanticTraversal ''UOperator +deriveSemanticTraversal ''UName +deriveSemanticTraversal ''UQualifiedName +deriveSemanticTraversal ''UModuleName +deriveSemanticTraversal ''UNamePart +deriveSemanticTraversal ''UStringNode +deriveSemanticTraversal ''UDataOrNewtypeKeyword +deriveSemanticTraversal ''UDoKind deriveSemanticTraversal ''TypeKeyword -deriveSemanticTraversal ''OverlapPragma -deriveSemanticTraversal ''CallConv -deriveSemanticTraversal ''ArrowAppl -deriveSemanticTraversal ''Safety -deriveSemanticTraversal ''ConlikeAnnot +deriveSemanticTraversal ''UOverlapPragma +deriveSemanticTraversal ''UCallConv +deriveSemanticTraversal ''UArrowAppl +deriveSemanticTraversal ''USafety +deriveSemanticTraversal ''UConlikeAnnot deriveSemanticTraversal ''Assoc deriveSemanticTraversal ''Precedence deriveSemanticTraversal ''LineNumber -deriveSemanticTraversal ''PhaseControl +deriveSemanticTraversal ''UPhaseControl deriveSemanticTraversal ''PhaseNumber deriveSemanticTraversal ''PhaseInvert
− Language/Haskell/Tools/AST/Instances/Show.hs
@@ -1,138 +0,0 @@--- | Show instance for Haskell AST representation ignoring source and semantic information -{-# LANGUAGE FlexibleContexts, StandaloneDeriving #-} -module Language.Haskell.Tools.AST.Instances.Show where - -import Language.Haskell.Tools.AST.Modules -import Language.Haskell.Tools.AST.TH -import Language.Haskell.Tools.AST.Decls -import Language.Haskell.Tools.AST.Binds -import Language.Haskell.Tools.AST.Exprs -import Language.Haskell.Tools.AST.Stmts -import Language.Haskell.Tools.AST.Patterns -import Language.Haskell.Tools.AST.Types -import Language.Haskell.Tools.AST.Kinds -import Language.Haskell.Tools.AST.Literals -import Language.Haskell.Tools.AST.Base -import Language.Haskell.Tools.AST.Ann - --- Annotations -instance (Show (e dom stage)) => Show (Ann e dom stage) where - show (Ann _ e) = show e - -instance (Show (e dom stage)) => Show (AnnMaybe e dom stage) where - show (AnnMaybe _ e) = show e - -instance (Show (e dom stage)) => Show (AnnList e dom stage) where - show (AnnList _ e) = show e - --- Modules -deriving instance Show (Module dom stage) -deriving instance Show (ModuleHead dom stage) -deriving instance Show (ExportSpecList dom stage) -deriving instance Show (ExportSpec dom stage) -deriving instance Show (IESpec dom stage) -deriving instance Show (SubSpec dom stage) -deriving instance Show (ModulePragma dom stage) -deriving instance Show (FilePragma dom stage) -deriving instance Show (ImportDecl dom stage) -deriving instance Show (ImportSpec dom stage) -deriving instance Show (ImportQualified dom stage) -deriving instance Show (ImportSource dom stage) -deriving instance Show (ImportSafe dom stage) -deriving instance Show (TypeNamespace dom stage) -deriving instance Show (ImportRenaming dom stage) - --- Declarations -deriving instance Show (Decl dom stage) -deriving instance Show (ClassBody dom stage) -deriving instance Show (ClassElement dom stage) -deriving instance Show (DeclHead dom stage) -deriving instance Show (InstBody dom stage) -deriving instance Show (InstBodyDecl dom stage) -deriving instance Show (GadtConDecl dom stage) -deriving instance Show (GadtConType dom stage) -deriving instance Show (FieldWildcard dom stage) -deriving instance Show (FunDeps dom stage) -deriving instance Show (FunDep dom stage) -deriving instance Show (ConDecl dom stage) -deriving instance Show (FieldDecl dom stage) -deriving instance Show (Deriving dom stage) -deriving instance Show (InstanceRule dom stage) -deriving instance Show (InstanceHead dom stage) -deriving instance Show (TypeEqn dom stage) -deriving instance Show (KindConstraint dom stage) -deriving instance Show (TyVar dom stage) -deriving instance Show (Type dom stage) -deriving instance Show (Kind dom stage) -deriving instance Show (Context dom stage) -deriving instance Show (Assertion dom stage) -deriving instance Show (Expr dom stage) -deriving instance Show (expr dom stage) => Show (Stmt' expr dom stage) -deriving instance Show (CompStmt dom stage) -deriving instance Show (ValueBind dom stage) -deriving instance Show (Pattern dom stage) -deriving instance Show (PatternField dom stage) -deriving instance Show (Splice dom stage) -deriving instance Show (QQString dom stage) -deriving instance Show (Match dom stage) -deriving instance Show (expr dom stage) => Show (Alt' expr dom stage) -deriving instance Show (Rhs dom stage) -deriving instance Show (GuardedRhs dom stage) -deriving instance Show (FieldUpdate dom stage) -deriving instance Show (Bracket dom stage) -deriving instance Show (TopLevelPragma dom stage) -deriving instance Show (Rule dom stage) -deriving instance Show (AnnotationSubject dom stage) -deriving instance Show (MinimalFormula dom stage) -deriving instance Show (ExprPragma dom stage) -deriving instance Show (SourceRange dom stage) -deriving instance Show (Number dom stage) -deriving instance Show (QuasiQuote dom stage) -deriving instance Show (RhsGuard dom stage) -deriving instance Show (LocalBind dom stage) -deriving instance Show (LocalBinds dom stage) -deriving instance Show (FixitySignature dom stage) -deriving instance Show (TypeSignature dom stage) -deriving instance Show (ListCompBody dom stage) -deriving instance Show (TupSecElem dom stage) -deriving instance Show (TypeFamily dom stage) -deriving instance Show (TypeFamilySpec dom stage) -deriving instance Show (InjectivityAnn dom stage) -deriving instance Show (expr dom stage) => Show (CaseRhs' expr dom stage) -deriving instance Show (expr dom stage) => Show (GuardedCaseRhs' expr dom stage) -deriving instance Show (PatternSynonym dom stage) -deriving instance Show (PatSynRhs dom stage) -deriving instance Show (PatSynLhs dom stage) -deriving instance Show (PatSynWhere dom stage) -deriving instance Show (PatternTypeSignature dom stage) -deriving instance Show (Role dom stage) -deriving instance Show (Cmd dom stage) -deriving instance Show (LanguageExtension dom stage) -deriving instance Show (MatchLhs dom stage) - - --- Literal -deriving instance Show (Literal dom stage) -deriving instance Show (k dom stage) => Show (Promoted k dom stage) - --- Base -deriving instance Show (Operator dom stage) -deriving instance Show (Name dom stage) -deriving instance Show (QualifiedName dom stage) -deriving instance Show (ModuleName dom stage) -deriving instance Show (UnqualName dom stage) -deriving instance Show (StringNode dom stage) -deriving instance Show (DataOrNewtypeKeyword dom stage) -deriving instance Show (DoKind dom stage) -deriving instance Show (TypeKeyword dom stage) -deriving instance Show (OverlapPragma dom stage) -deriving instance Show (CallConv dom stage) -deriving instance Show (ArrowAppl dom stage) -deriving instance Show (Safety dom stage) -deriving instance Show (ConlikeAnnot dom stage) -deriving instance Show (Assoc dom stage) -deriving instance Show (Precedence dom stage) -deriving instance Show (LineNumber dom stage) -deriving instance Show (PhaseControl dom stage) -deriving instance Show (PhaseNumber dom stage) -deriving instance Show (PhaseInvert dom stage)
Language/Haskell/Tools/AST/Instances/SourceInfoTraversal.hs view
@@ -1,132 +1,139 @@+-- don't show warnings, Template Haskell generated code contains unused variables +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-unused-matches #-} + -- | Generating instances for traversing the semantic information of the Haskell Representation -{-# LANGUAGE TemplateHaskell - #-} -module Language.Haskell.Tools.AST.Instances.SourceInfoTraversal where +module Language.Haskell.Tools.AST.Instances.SourceInfoTraversal () where -import Language.Haskell.Tools.AST.TH.SourceInfoTraversal import Control.Applicative +import Language.Haskell.Tools.AST.TH.SourceInfoTraversal -import Language.Haskell.Tools.AST.Modules -import Language.Haskell.Tools.AST.TH -import Language.Haskell.Tools.AST.Decls -import Language.Haskell.Tools.AST.Binds -import Language.Haskell.Tools.AST.Exprs -import Language.Haskell.Tools.AST.Stmts -import Language.Haskell.Tools.AST.Patterns -import Language.Haskell.Tools.AST.Types -import Language.Haskell.Tools.AST.Kinds -import Language.Haskell.Tools.AST.Literals -import Language.Haskell.Tools.AST.Base -import Language.Haskell.Tools.AST.Ann +import Language.Haskell.Tools.AST.Representation.Binds +import Language.Haskell.Tools.AST.Representation.Decls +import Language.Haskell.Tools.AST.Representation.Exprs +import Language.Haskell.Tools.AST.Representation.Kinds +import Language.Haskell.Tools.AST.Representation.Literals +import Language.Haskell.Tools.AST.Representation.Modules +import Language.Haskell.Tools.AST.Representation.Names +import Language.Haskell.Tools.AST.Representation.Patterns +import Language.Haskell.Tools.AST.Representation.Stmts +import Language.Haskell.Tools.AST.Representation.TH +import Language.Haskell.Tools.AST.Representation.Types -- Modules -deriveSourceInfoTraversal ''Module -deriveSourceInfoTraversal ''ModuleHead -deriveSourceInfoTraversal ''ExportSpecList -deriveSourceInfoTraversal ''ExportSpec -deriveSourceInfoTraversal ''IESpec -deriveSourceInfoTraversal ''SubSpec -deriveSourceInfoTraversal ''ModulePragma -deriveSourceInfoTraversal ''FilePragma -deriveSourceInfoTraversal ''ImportDecl -deriveSourceInfoTraversal ''ImportSpec -deriveSourceInfoTraversal ''ImportQualified -deriveSourceInfoTraversal ''ImportSource -deriveSourceInfoTraversal ''ImportSafe -deriveSourceInfoTraversal ''TypeNamespace -deriveSourceInfoTraversal ''ImportRenaming +deriveSourceInfoTraversal ''UModule +deriveSourceInfoTraversal ''UModuleHead +deriveSourceInfoTraversal ''UExportSpecs +deriveSourceInfoTraversal ''UExportSpec +deriveSourceInfoTraversal ''UIESpec +deriveSourceInfoTraversal ''USubSpec +deriveSourceInfoTraversal ''UModulePragma +deriveSourceInfoTraversal ''UFilePragma +deriveSourceInfoTraversal ''UImportDecl +deriveSourceInfoTraversal ''UImportSpec +deriveSourceInfoTraversal ''UImportModifier +deriveSourceInfoTraversal ''UImportQualified +deriveSourceInfoTraversal ''UImportSource +deriveSourceInfoTraversal ''UImportSafe +deriveSourceInfoTraversal ''UTypeNamespace +deriveSourceInfoTraversal ''UImportRenaming -- Declarations -deriveSourceInfoTraversal ''Decl -deriveSourceInfoTraversal ''ClassBody -deriveSourceInfoTraversal ''ClassElement -deriveSourceInfoTraversal ''DeclHead -deriveSourceInfoTraversal ''InstBody -deriveSourceInfoTraversal ''InstBodyDecl -deriveSourceInfoTraversal ''GadtConDecl -deriveSourceInfoTraversal ''GadtConType -deriveSourceInfoTraversal ''FieldWildcard -deriveSourceInfoTraversal ''FunDeps -deriveSourceInfoTraversal ''FunDep -deriveSourceInfoTraversal ''ConDecl -deriveSourceInfoTraversal ''FieldDecl -deriveSourceInfoTraversal ''Deriving -deriveSourceInfoTraversal ''InstanceRule -deriveSourceInfoTraversal ''InstanceHead -deriveSourceInfoTraversal ''TypeEqn -deriveSourceInfoTraversal ''KindConstraint -deriveSourceInfoTraversal ''TyVar -deriveSourceInfoTraversal ''Type -deriveSourceInfoTraversal ''Kind -deriveSourceInfoTraversal ''Context -deriveSourceInfoTraversal ''Assertion -deriveSourceInfoTraversal ''Expr -deriveSourceInfoTraversal ''CompStmt -deriveSourceInfoTraversal ''ValueBind -deriveSourceInfoTraversal ''Pattern -deriveSourceInfoTraversal ''PatternField -deriveSourceInfoTraversal ''Splice +deriveSourceInfoTraversal ''UDecl +deriveSourceInfoTraversal ''UClassBody +deriveSourceInfoTraversal ''UClassElement +deriveSourceInfoTraversal ''UDeclHead +deriveSourceInfoTraversal ''UInstBody +deriveSourceInfoTraversal ''UInstBodyDecl +deriveSourceInfoTraversal ''UGadtConDecl +deriveSourceInfoTraversal ''UGadtConType +deriveSourceInfoTraversal ''UFieldWildcard +deriveSourceInfoTraversal ''UFunDeps +deriveSourceInfoTraversal ''UFunDep +deriveSourceInfoTraversal ''UConDecl +deriveSourceInfoTraversal ''UFieldDecl +deriveSourceInfoTraversal ''UDeriving +deriveSourceInfoTraversal ''UDeriveStrategy +deriveSourceInfoTraversal ''UInstanceRule +deriveSourceInfoTraversal ''UInstanceHead +deriveSourceInfoTraversal ''UTypeEqn +deriveSourceInfoTraversal ''UKindConstraint +deriveSourceInfoTraversal ''UTyVar +deriveSourceInfoTraversal ''UType +deriveSourceInfoTraversal ''UKind +deriveSourceInfoTraversal ''UContext +deriveSourceInfoTraversal ''UAssertion +deriveSourceInfoTraversal ''UExpr +deriveSourceInfoTraversal ''UCompStmt +deriveSourceInfoTraversal ''UValueBind +deriveSourceInfoTraversal ''UPattern +deriveSourceInfoTraversal ''UPatternField +deriveSourceInfoTraversal ''USplice deriveSourceInfoTraversal ''QQString -deriveSourceInfoTraversal ''Match -deriveSourceInfoTraversal ''Rhs -deriveSourceInfoTraversal ''GuardedRhs -deriveSourceInfoTraversal ''FieldUpdate -deriveSourceInfoTraversal ''Bracket -deriveSourceInfoTraversal ''TopLevelPragma -deriveSourceInfoTraversal ''Rule -deriveSourceInfoTraversal ''AnnotationSubject -deriveSourceInfoTraversal ''MinimalFormula -deriveSourceInfoTraversal ''ExprPragma -deriveSourceInfoTraversal ''SourceRange +deriveSourceInfoTraversal ''UMatch +deriveSourceInfoTraversal ''URhs +deriveSourceInfoTraversal ''UGuardedRhs +deriveSourceInfoTraversal ''UFieldUpdate +deriveSourceInfoTraversal ''UBracket +deriveSourceInfoTraversal ''UTopLevelPragma +deriveSourceInfoTraversal ''URule +deriveSourceInfoTraversal ''URuleVar +deriveSourceInfoTraversal ''UAnnotationSubject +deriveSourceInfoTraversal ''UMinimalFormula +deriveSourceInfoTraversal ''UExprPragma +deriveSourceInfoTraversal ''USourceRange deriveSourceInfoTraversal ''Number -deriveSourceInfoTraversal ''QuasiQuote -deriveSourceInfoTraversal ''RhsGuard -deriveSourceInfoTraversal ''LocalBind -deriveSourceInfoTraversal ''LocalBinds -deriveSourceInfoTraversal ''FixitySignature -deriveSourceInfoTraversal ''TypeSignature -deriveSourceInfoTraversal ''ListCompBody -deriveSourceInfoTraversal ''TupSecElem -deriveSourceInfoTraversal ''TypeFamily -deriveSourceInfoTraversal ''TypeFamilySpec -deriveSourceInfoTraversal ''InjectivityAnn -deriveSourceInfoTraversal ''PatternSynonym -deriveSourceInfoTraversal ''PatSynRhs -deriveSourceInfoTraversal ''PatSynLhs -deriveSourceInfoTraversal ''PatSynWhere -deriveSourceInfoTraversal ''PatternTypeSignature -deriveSourceInfoTraversal ''Role -deriveSourceInfoTraversal ''Cmd -deriveSourceInfoTraversal ''LanguageExtension -deriveSourceInfoTraversal ''MatchLhs -deriveSourceInfoTraversal ''Stmt' -deriveSourceInfoTraversal ''Alt' -deriveSourceInfoTraversal ''CaseRhs' -deriveSourceInfoTraversal ''GuardedCaseRhs' +deriveSourceInfoTraversal ''UQuasiQuote +deriveSourceInfoTraversal ''URhsGuard +deriveSourceInfoTraversal ''ULocalBind +deriveSourceInfoTraversal ''ULocalBinds +deriveSourceInfoTraversal ''UFixitySignature +deriveSourceInfoTraversal ''UTypeSignature +deriveSourceInfoTraversal ''UListCompBody +deriveSourceInfoTraversal ''UTupSecElem +deriveSourceInfoTraversal ''UTypeFamily +deriveSourceInfoTraversal ''UTypeFamilySpec +deriveSourceInfoTraversal ''UInjectivityAnn +deriveSourceInfoTraversal ''UPatternSynonym +deriveSourceInfoTraversal ''UPatSynRhs +deriveSourceInfoTraversal ''UPatSynLhs +deriveSourceInfoTraversal ''UPatSynWhere +deriveSourceInfoTraversal ''UPatternTypeSignature +deriveSourceInfoTraversal ''URole +deriveSourceInfoTraversal ''UCmd +deriveSourceInfoTraversal ''ULanguageExtension +deriveSourceInfoTraversal ''UMatchLhs +deriveSourceInfoTraversal ''UStmt' +deriveSourceInfoTraversal ''UAlt' +deriveSourceInfoTraversal ''UCaseRhs' +deriveSourceInfoTraversal ''UGuardedCaseRhs' +deriveSourceInfoTraversal ''UInlinePragma +deriveSourceInfoTraversal ''USpecializePragma +deriveSourceInfoTraversal ''UUnboxedSumPlaceHolder --- Literal -deriveSourceInfoTraversal ''Literal -deriveSourceInfoTraversal ''Promoted +-- ULiteral +deriveSourceInfoTraversal ''ULiteral +deriveSourceInfoTraversal ''UPromoted -- Base -deriveSourceInfoTraversal ''Operator -deriveSourceInfoTraversal ''Name -deriveSourceInfoTraversal ''QualifiedName -deriveSourceInfoTraversal ''ModuleName -deriveSourceInfoTraversal ''UnqualName -deriveSourceInfoTraversal ''StringNode -deriveSourceInfoTraversal ''DataOrNewtypeKeyword -deriveSourceInfoTraversal ''DoKind +deriveSourceInfoTraversal ''UOperator +deriveSourceInfoTraversal ''UName +deriveSourceInfoTraversal ''UQualifiedName +deriveSourceInfoTraversal ''UModuleName +deriveSourceInfoTraversal ''UNamePart +deriveSourceInfoTraversal ''UStringNode +deriveSourceInfoTraversal ''UDataOrNewtypeKeyword +deriveSourceInfoTraversal ''UDoKind deriveSourceInfoTraversal ''TypeKeyword -deriveSourceInfoTraversal ''OverlapPragma -deriveSourceInfoTraversal ''CallConv -deriveSourceInfoTraversal ''ArrowAppl -deriveSourceInfoTraversal ''Safety -deriveSourceInfoTraversal ''ConlikeAnnot +deriveSourceInfoTraversal ''UOverlapPragma +deriveSourceInfoTraversal ''UCallConv +deriveSourceInfoTraversal ''UArrowAppl +deriveSourceInfoTraversal ''USafety +deriveSourceInfoTraversal ''UConlikeAnnot deriveSourceInfoTraversal ''Assoc deriveSourceInfoTraversal ''Precedence deriveSourceInfoTraversal ''LineNumber -deriveSourceInfoTraversal ''PhaseControl +deriveSourceInfoTraversal ''UPhaseControl deriveSourceInfoTraversal ''PhaseNumber deriveSourceInfoTraversal ''PhaseInvert
− Language/Haskell/Tools/AST/Kinds.hs
@@ -1,38 +0,0 @@--- | Representation of Haskell Kinds -module Language.Haskell.Tools.AST.Kinds where - -import Language.Haskell.Tools.AST.Literals -import Language.Haskell.Tools.AST.Ann -import Language.Haskell.Tools.AST.Base - --- | Kind constraint (@ :: * -> * @) -data KindConstraint dom stage - = KindConstraint { _kindConstr :: Ann Kind dom stage - } - --- | Haskell kinds -data Kind dom stage - = KindStar -- ^ @*@, the kind of types - | KindUnbox -- ^ @#@, the kind of unboxed types - | KindFn { _kindLeft :: Ann Kind dom stage - , _kindRight :: Ann Kind dom stage - } -- ^ @->@, the kind of type constructor - | KindParen { _kindParen :: Ann Kind dom stage - } -- ^ A parenthesised kind - | KindVar { _kindVar :: Ann Name dom stage - } -- ^ kind variable (using @PolyKinds@ extension) - | KindApp { _kindAppFun :: Ann Kind dom stage - , _kindAppArg :: Ann Kind dom stage - } -- ^ Kind application (@ k1 k2 @) - | KindList { _kindElem :: Ann Kind dom stage - } -- ^ A list kind (@ [k] @) - | KindPromoted { _kindPromoted :: Ann (Promoted Kind) dom stage - } -- ^ A promoted kind (@ '(k1,k2,k3) @) - -data Promoted t dom stage - = PromotedInt { _promotedIntValue :: Integer } - | PromotedString { _promotedStringValue :: String } - | PromotedCon { _promotedConName :: Ann Name dom stage } - | PromotedList { _promotedElements :: AnnList t dom stage } - | PromotedTuple { _promotedElements :: AnnList t dom stage } - | PromotedUnit
− Language/Haskell/Tools/AST/Literals.hs
@@ -1,29 +0,0 @@--- | Representation of Haskell literals -module Language.Haskell.Tools.AST.Literals where - -import Language.Haskell.Tools.AST.Ann -import Language.Haskell.Tools.AST.Base - --- | Haskell literals -data Literal dom stage - = CharLit { _charLitValue :: Char - } -- ^ Character literal: @'c'@ - | StringLit { _stringLitValue :: String - } -- ^ String literal: @"abc"@ - | IntLit { _intLitValue :: Integer - } -- ^ Integer literal: @12@ - | FracLit { _fracLitValue :: Rational - } -- ^ Fractional literal: @3.14@ - | PrimIntLit { _intLitValue :: Integer - } -- ^ Primitive integer literal (of type @Int#@): @32#@ - | PrimWordLit { _intLitValue :: Integer - } -- ^ Primitive word literal (of type @Word#@): @32##@ - | PrimFloatLit { _floatLitValue :: Rational - } -- ^ Primitive float literal (of type @Float#@): @3.14#@ - | PrimDoubleLit { _floatLitValue :: Rational - } -- ^ Primitive double literal (of type @Double#@): @3.14##@ - | PrimCharLit { _charLitValue :: Char - } -- ^ Primitive character literal (of type @Char#@): @'c'#@ - | PrimStringLit { _stringLitValue :: String - } -- ^ Prmitive string literal (of type @Addr#@): @"xxx"#@ -
+ Language/Haskell/Tools/AST/MakeASTReferences.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+ +-- | Contains a transformation to alter the references generated by the template haskell +-- function @makeReferences@. +module Language.Haskell.Tools.AST.MakeASTReferences where + +import Control.Reference ((&)) +import Language.Haskell.TH +import Language.Haskell.Tools.AST.Ann (Ann, element) + +-- | Change the generated references to have the context of an annotated element. +-- Modifies the types according to the changes. This trasformation makes all +-- generated references monomorphic. +toASTReferences :: Q [Dec] -> Q [Dec] +toASTReferences = fmap (map $ \case + SigD name (ForallT vars ctx (refType `AppT` (ctxOrig `AppT` dom `AppT` stage) + `AppT` _ + `AppT` fldOrig + `AppT` _)) + -> SigD name (ForallT vars ctx (refType `AppT` (ConT ''Ann `AppT` ctxOrig `AppT` dom `AppT` stage) + `AppT` (ConT ''Ann `AppT` ctxOrig `AppT` dom `AppT` stage) + `AppT` fldOrig + `AppT` fldOrig)) + ValD pat (NormalB e) locs -> ValD pat (NormalB (InfixE (Just (VarE 'element)) (VarE '(&)) (Just e))) locs + d -> d)
− Language/Haskell/Tools/AST/Modules.hs
@@ -1,96 +0,0 @@--- | Representation of Haskell modules, imports and exports. Also contains file-level pragmas. -module Language.Haskell.Tools.AST.Modules where - -import Language.Haskell.Tools.AST.Ann -import Language.Haskell.Tools.AST.Base -import Language.Haskell.Tools.AST.Exprs -import Language.Haskell.Tools.AST.Binds -import Language.Haskell.Tools.AST.Decls - --- | The representation of a haskell module, that is a separate compilation unit. --- It may or may not have a header. -data Module dom stage - = Module { _filePragmas :: AnnList FilePragma dom stage - , _modHead :: AnnMaybe ModuleHead dom stage - , _modImports :: AnnList ImportDecl dom stage - , _modDecl :: AnnList Decl dom stage - } - --- | Module declaration with name and (optional) exports -data ModuleHead dom stage - = ModuleHead { _mhName :: Ann ModuleName dom stage - , _mhExports :: AnnMaybe ExportSpecList dom stage - , _mhPragma :: AnnMaybe ModulePragma dom stage - } - --- | A list of export specifications surrounded by parentheses -data ExportSpecList dom stage - = ExportSpecList { _espExports :: AnnList ExportSpec dom stage } - --- | Export specifier -data ExportSpec dom stage - = DeclExport { _exportDecl :: Ann IESpec dom stage - } -- ^ Export a name and related names - | ModuleExport { _exportModuleName :: Ann ModuleName dom stage - } -- ^ The export of an imported module (@ module A @) - --- | Marks a name to be imported or exported with related names (subspecifier) -data IESpec dom stage - = IESpec { _ieName :: Ann Name dom stage - , _ieSubspec :: AnnMaybe SubSpec dom stage - } - --- | Marks how related names will be imported or exported with a given name -data SubSpec dom stage - = SubSpecAll -- @(..)@: a class exported with all of its methods, or a datatype exported with all of its constructors. - | SubSpecList { _essList :: AnnList Name dom stage } -- @(a,b,c)@: a class exported with some of its methods, or a datatype exported with some of its constructors. - --- | Pragmas that must be used before defining the module -data FilePragma dom stage - = LanguagePragma { _lpPragmas :: AnnList LanguageExtension dom stage - } -- ^ LANGUAGE pragmdom stage - | OptionsPragma { _opStr :: Ann StringNode dom stage - } -- ^ OPTIONS pragma, possibly qualified with a tool, e.g. OPTIONS_GHC - --- | Pragmas that must be used after the module head -data ModulePragma dom stage - = ModuleWarningPragma { _modWarningStr :: AnnList StringNode dom stage - } -- ^ a warning pragma attached to the module - | ModuleDeprecatedPragma { _modDeprecatedPragma :: AnnList StringNode dom stage - } -- ^ a deprecated pragma attached to the module - --- | The name of the enabled language extension, for example (@ LambdaCase @) -data LanguageExtension dom stage = LanguageExtension { _langExt :: String } - --- | An import declaration: @import Module.Name@ -data ImportDecl dom stage - = ImportDecl { _importSource :: AnnMaybe ImportSource dom stage - , _importQualified :: AnnMaybe ImportQualified dom stage - , _importSafe :: AnnMaybe ImportSafe dom stage - , _importPkg :: AnnMaybe StringNode dom stage - , _importModule :: Ann ModuleName dom stage - , _importAs :: AnnMaybe ImportRenaming dom stage - , _importSpec :: AnnMaybe ImportSpec dom stage - } - --- | Restriction on the imported names -data ImportSpec dom stage - = ImportSpecList { _importSpecList :: AnnList IESpec dom stage - } -- ^ Restrict the import definition to ONLY import the listed names - | ImportSpecHiding { _importSpecHiding :: AnnList IESpec dom stage - } -- ^ Restrict the import definition to DONT import the listed names - --- | Marks the import as qualified: @qualified@ -data ImportQualified dom stage = ImportQualified - --- | Marks the import as source: @{-# SOURCE #-}@ -data ImportSource dom stage = ImportSource - --- | Marks the import as safe: @safe@ -data ImportSafe dom stage = ImportSafe - --- | Marks an imported name to belong to the type namespace: @type@ -data TypeNamespace dom stage = TypeNamespace - --- | Renaming imports (@ as A @) -data ImportRenaming dom stage = ImportRenaming { _importRename :: Ann ModuleName dom stage }
− Language/Haskell/Tools/AST/Modules.hs-boot
@@ -1,8 +0,0 @@-{-# LANGUAGE RoleAnnotations #-} -module Language.Haskell.Tools.AST.Modules where - -type role Module nominal nominal -data Module dom stage - -type role ImportDecl nominal nominal -data ImportDecl dom stage
− Language/Haskell/Tools/AST/Patterns.hs
@@ -1,70 +0,0 @@--- | Representation of Haskell patterns -module Language.Haskell.Tools.AST.Patterns where - -import Language.Haskell.Tools.AST.Ann -import Language.Haskell.Tools.AST.Base -import Language.Haskell.Tools.AST.Literals -import Language.Haskell.Tools.AST.Types -import {-# SOURCE #-} Language.Haskell.Tools.AST.Exprs (Expr, FieldWildcard) -import {-# SOURCE #-} Language.Haskell.Tools.AST.TH - - --- | Representation of patterns for pattern bindings -data Pattern dom stage - = VarPat { _patternName :: Ann Name dom stage - } -- ^ Pattern name binding - | LitPat { _patternLiteral :: Ann Literal dom stage - } -- ^ Literal pattern - | InfixPat { _patternLhs :: Ann Pattern dom stage - , _patternOperator :: Ann Operator dom stage - , _patternRhs :: Ann Pattern dom stage - } -- ^ Infix constructor application pattern (@ a :+: b @) - | AppPat { _patternName :: Ann Name dom stage - , _patternArgs :: AnnList Pattern dom stage - } -- ^ Constructor application pattern (@ Point x y @) - | TuplePat { _patternElems :: AnnList Pattern dom stage - } -- ^ Tuple pattern (@ (x,y) @) - | UnboxTuplePat { _patternElems :: AnnList Pattern dom stage - } -- ^ Unboxed tuple pattern (@ (# x, y #) @) - | ListPat { _patternElems :: AnnList Pattern dom stage - } -- ^ List pattern (@ [1,2,a,x] @) - | ParArrPat { _patternElems :: AnnList Pattern dom stage - } -- ^ Parallel array pattern (@ [:1,2,a,x:] @) - | ParenPat { _patternInner :: Ann Pattern dom stage - } -- ^ Parenthesised patterns - | RecPat { _patternName :: Ann Name dom stage - , _patternFields :: AnnList PatternField dom stage - } -- ^ Record pattern (@ Point { x = 3, y } @) - | AsPat { _patternName :: Ann Name dom stage - , _patternInner :: Ann Pattern dom stage - } -- ^ As-pattern (explicit name binding) (@ ls\@(hd:_) @) - | WildPat -- ^ Wildcard pattern: (@ _ @) - | IrrPat { _patternInner :: Ann Pattern dom stage - } -- ^ Irrefutable pattern (@ ~(x:_) @) - | BangPat { _patternInner :: Ann Pattern dom stage - } -- ^ Bang pattern (@ !x @) - | TypeSigPat { _patternInner :: Ann Pattern dom stage - , _patternType :: Ann Type dom stage - } -- ^ Pattern with explicit type signature (@ __ :: Int @) - | ViewPat { _patternExpr :: Ann Expr dom stage - , _patternInner :: Ann Pattern dom stage - } -- ^ View pattern (@ f -> Just 1 @) - -- regular list pattern omitted - -- xml patterns omitted - | SplicePat { _patternSplice :: Ann Splice dom stage - } -- ^ Splice patterns: @$(generateX inp)@ - | QuasiQuotePat { _patQQ :: Ann QuasiQuote dom stage - } -- ^ Quasi-quoted patterns: @[| 1 + 2 |]@ - | NPlusKPat { _patternName :: Ann Name dom stage - , _patternLit :: Ann Literal dom stage - } - --- Field specification of a record pattern -data PatternField dom stage - = NormalFieldPattern { _fieldPatternName :: Ann Name dom stage - , _fieldPattern :: Ann Pattern dom stage - } -- ^ Named field pattern (@ p = Point 3 2 @) - | FieldPunPattern { _fieldPatternName :: Ann Name dom stage - } -- ^ Named field pun (@ p @) - | FieldWildcardPattern { _fieldPatternWildcard :: Ann FieldWildcard dom stage - } -- ^ Wildcard field pattern (@ .. @)
Language/Haskell/Tools/AST/References.hs view
@@ -1,124 +1,149 @@-{-# LANGUAGE FlexibleContexts, TemplateHaskell #-} --- Generated references for handling the custom AST +-- don't show warnings, Template Haskell generated code contains unused variables +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fno-warn-unused-matches #-} + +-- | Generated references for AST elements. module Language.Haskell.Tools.AST.References where -import Control.Reference +import Control.Reference hiding (element) +import Language.Haskell.Tools.AST.MakeASTReferences -import Language.Haskell.Tools.AST.Modules -import Language.Haskell.Tools.AST.TH -import Language.Haskell.Tools.AST.Decls -import Language.Haskell.Tools.AST.Binds -import Language.Haskell.Tools.AST.Exprs -import Language.Haskell.Tools.AST.Stmts -import Language.Haskell.Tools.AST.Patterns -import Language.Haskell.Tools.AST.Types -import Language.Haskell.Tools.AST.Kinds -import Language.Haskell.Tools.AST.Literals -import Language.Haskell.Tools.AST.Base -import Language.Haskell.Tools.AST.Ann +import Language.Haskell.Tools.AST.Representation.Binds +import Language.Haskell.Tools.AST.Representation.Decls +import Language.Haskell.Tools.AST.Representation.Exprs +import Language.Haskell.Tools.AST.Representation.Kinds +import Language.Haskell.Tools.AST.Representation.Literals +import Language.Haskell.Tools.AST.Representation.Modules +import Language.Haskell.Tools.AST.Representation.Names +import Language.Haskell.Tools.AST.Representation.Patterns +import Language.Haskell.Tools.AST.Representation.Stmts +import Language.Haskell.Tools.AST.Representation.TH +import Language.Haskell.Tools.AST.Representation.Types --- Modules -makeReferences ''Module -makeReferences ''ModuleHead -makeReferences ''ExportSpecList -makeReferences ''ExportSpec -makeReferences ''IESpec -makeReferences ''SubSpec -makeReferences ''ModulePragma -makeReferences ''ImportDecl -makeReferences ''ImportSpec -makeReferences ''ImportQualified -makeReferences ''ImportSource -makeReferences ''ImportSafe -makeReferences ''TypeNamespace -makeReferences ''ImportRenaming +-- * Modules +$(toASTReferences (makeReferences ''UModule)) +$(toASTReferences (makeReferences ''UModuleHead)) +$(toASTReferences (makeReferences ''UExportSpecs)) +$(toASTReferences (makeReferences ''UExportSpec)) +$(toASTReferences (makeReferences ''UIESpec)) +$(toASTReferences (makeReferences ''USubSpec)) +$(toASTReferences (makeReferences ''UModulePragma)) +$(toASTReferences (makeReferences ''UFilePragma)) +$(toASTReferences (makeReferences ''UImportDecl)) +$(toASTReferences (makeReferences ''UImportSpec)) +$(toASTReferences (makeReferences ''UImportQualified)) +$(toASTReferences (makeReferences ''UImportSource)) +$(toASTReferences (makeReferences ''UImportSafe)) +$(toASTReferences (makeReferences ''UTypeNamespace)) +$(toASTReferences (makeReferences ''UImportRenaming)) +$(toASTReferences (makeReferences ''UModuleName)) +$(toASTReferences (makeReferences ''ULanguageExtension)) +$(toASTReferences (makeReferences ''TypeKeyword)) --- Declarations -makeReferences ''Decl -makeReferences ''ClassBody -makeReferences ''ClassElement -makeReferences ''DeclHead -makeReferences ''InstBody -makeReferences ''InstBodyDecl -makeReferences ''GadtConDecl -makeReferences ''GadtConType -makeReferences ''FunDeps -makeReferences ''FunDep -makeReferences ''ConDecl -makeReferences ''FieldDecl -makeReferences ''Deriving -makeReferences ''InstanceRule -makeReferences ''InstanceHead -makeReferences ''TypeEqn -makeReferences ''KindConstraint -makeReferences ''TyVar -makeReferences ''Type -makeReferences ''Kind -makeReferences ''Context -makeReferences ''Assertion -makeReferences ''Expr -makeReferences ''Stmt' -makeReferences ''CompStmt -makeReferences ''ValueBind -makeReferences ''Pattern -makeReferences ''PatternField -makeReferences ''Splice -makeReferences ''QQString -makeReferences ''Match -makeReferences ''Alt' -makeReferences ''Rhs -makeReferences ''GuardedRhs -makeReferences ''FieldUpdate -makeReferences ''Bracket -makeReferences ''TopLevelPragma -makeReferences ''Rule -makeReferences ''AnnotationSubject -makeReferences ''MinimalFormula -makeReferences ''ExprPragma -makeReferences ''SourceRange -makeReferences ''Number -makeReferences ''QuasiQuote -makeReferences ''RhsGuard -makeReferences ''LocalBind -makeReferences ''LocalBinds -makeReferences ''FixitySignature -makeReferences ''TypeSignature -makeReferences ''ListCompBody -makeReferences ''TupSecElem -makeReferences ''TypeFamily -makeReferences ''TypeFamilySpec -makeReferences ''InjectivityAnn -makeReferences ''CaseRhs' -makeReferences ''GuardedCaseRhs' -makeReferences ''PatternSynonym -makeReferences ''PatSynRhs -makeReferences ''PatSynLhs -makeReferences ''PatSynWhere -makeReferences ''PatternTypeSignature -makeReferences ''Role -makeReferences ''LanguageExtension -makeReferences ''MatchLhs +-- * Declarations +$(toASTReferences (makeReferences ''UDecl)) +$(toASTReferences (makeReferences ''UClassBody)) +$(toASTReferences (makeReferences ''UClassElement)) +$(toASTReferences (makeReferences ''UDeclHead)) +$(toASTReferences (makeReferences ''UInstBody)) +$(toASTReferences (makeReferences ''UInstBodyDecl)) +$(toASTReferences (makeReferences ''UTypeFamily)) +$(toASTReferences (makeReferences ''UTypeFamilySpec)) +$(toASTReferences (makeReferences ''UInjectivityAnn)) +$(toASTReferences (makeReferences ''UDataOrNewtypeKeyword)) +$(toASTReferences (makeReferences ''UGadtConDecl)) +$(toASTReferences (makeReferences ''UGadtConType)) +$(toASTReferences (makeReferences ''UPatternSynonym)) +$(toASTReferences (makeReferences ''UPatSynRhs)) +$(toASTReferences (makeReferences ''UPatSynLhs)) +$(toASTReferences (makeReferences ''UPatSynWhere)) +$(toASTReferences (makeReferences ''UPatternTypeSignature)) +$(toASTReferences (makeReferences ''URole)) +$(toASTReferences (makeReferences ''UFunDeps)) +$(toASTReferences (makeReferences ''UFunDep)) +$(toASTReferences (makeReferences ''UConDecl)) +$(toASTReferences (makeReferences ''UFieldDecl)) +$(toASTReferences (makeReferences ''UDeriving)) +$(toASTReferences (makeReferences ''UDeriveStrategy)) +$(toASTReferences (makeReferences ''UInstanceRule)) +$(toASTReferences (makeReferences ''UInstanceHead)) +$(toASTReferences (makeReferences ''UTypeEqn)) +$(toASTReferences (makeReferences ''URule)) +$(toASTReferences (makeReferences ''URuleVar)) +$(toASTReferences (makeReferences ''UOverlapPragma)) +$(toASTReferences (makeReferences ''UCallConv)) +$(toASTReferences (makeReferences ''USafety)) +$(toASTReferences (makeReferences ''UPhaseControl)) +$(toASTReferences (makeReferences ''PhaseNumber)) +$(toASTReferences (makeReferences ''PhaseInvert)) +$(toASTReferences (makeReferences ''UTopLevelPragma)) +$(toASTReferences (makeReferences ''UAnnotationSubject)) +$(toASTReferences (makeReferences ''UMinimalFormula)) +$(toASTReferences (makeReferences ''USourceRange)) +$(toASTReferences (makeReferences ''Number)) +$(toASTReferences (makeReferences ''UUnboxedSumPlaceHolder)) +$(toASTReferences (makeReferences ''USpecializePragma)) --- Literal -makeReferences ''Literal -makeReferences ''Promoted --- Base -makeReferences ''Operator -makeReferences ''Name -makeReferences ''QualifiedName -makeReferences ''ModuleName -makeReferences ''UnqualName -makeReferences ''StringNode -makeReferences ''DataOrNewtypeKeyword -makeReferences ''DoKind -makeReferences ''TypeKeyword -makeReferences ''OverlapPragma -makeReferences ''CallConv -makeReferences ''ArrowAppl -makeReferences ''Safety -makeReferences ''Assoc -makeReferences ''Precedence -makeReferences ''PhaseControl -makeReferences ''PhaseNumber -makeReferences ''PhaseInvert+-- * Binds +$(toASTReferences (makeReferences ''UMatch)) +$(toASTReferences (makeReferences ''URhs)) +$(toASTReferences (makeReferences ''UGuardedRhs)) +$(toASTReferences (makeReferences ''URhsGuard)) +$(toASTReferences (makeReferences ''ULocalBind)) +$(toASTReferences (makeReferences ''ULocalBinds)) +$(toASTReferences (makeReferences ''UFixitySignature)) +$(toASTReferences (makeReferences ''Assoc)) +$(toASTReferences (makeReferences ''Precedence)) +$(toASTReferences (makeReferences ''UTypeSignature)) +$(toASTReferences (makeReferences ''UMatchLhs)) + +-- * Kinds +$(toASTReferences (makeReferences ''UKindConstraint)) + +-- * Types +$(toASTReferences (makeReferences ''UValueBind)) +$(toASTReferences (makeReferences ''UTyVar)) +$(toASTReferences (makeReferences ''UType)) +$(toASTReferences (makeReferences ''UKind)) +$(toASTReferences (makeReferences ''UContext)) +$(toASTReferences (makeReferences ''UAssertion)) + +-- * Expressions +$(toASTReferences (makeReferences ''UExpr)) +$(toASTReferences (makeReferences ''UAlt')) +$(toASTReferences (makeReferences ''UFieldUpdate)) +$(toASTReferences (makeReferences ''UTupSecElem)) +$(toASTReferences (makeReferences ''UExprPragma)) +$(toASTReferences (makeReferences ''UCaseRhs')) +$(toASTReferences (makeReferences ''UGuardedCaseRhs')) +$(toASTReferences (makeReferences ''UArrowAppl)) + +-- * Statements +$(toASTReferences (makeReferences ''UStmt')) +$(toASTReferences (makeReferences ''UCompStmt)) +$(toASTReferences (makeReferences ''UListCompBody)) +$(toASTReferences (makeReferences ''UDoKind)) +$(toASTReferences (makeReferences ''UCmd)) + +-- * Patterns +$(toASTReferences (makeReferences ''UPattern)) +$(toASTReferences (makeReferences ''UPatternField)) + +-- * Template Haskell +$(toASTReferences (makeReferences ''USplice)) +$(toASTReferences (makeReferences ''UQuasiQuote)) +$(toASTReferences (makeReferences ''QQString)) +$(toASTReferences (makeReferences ''UBracket)) + +-- * Literals +$(toASTReferences (makeReferences ''ULiteral)) +$(toASTReferences (makeReferences ''UPromoted)) + +-- * Names +$(toASTReferences (makeReferences ''UOperator)) +$(toASTReferences (makeReferences ''UName)) +$(toASTReferences (makeReferences ''UQualifiedName)) +$(toASTReferences (makeReferences ''UNamePart)) +$(toASTReferences (makeReferences ''UStringNode))
+ Language/Haskell/Tools/AST/Representation/Binds.hs view
@@ -0,0 +1,129 @@+-- | Representation of Haskell AST value and function bindings (both local and top-level) +module Language.Haskell.Tools.AST.Representation.Binds where + +import Language.Haskell.Tools.AST.Ann (Ann, AnnListG, AnnMaybeG) +import Language.Haskell.Tools.AST.Representation.Exprs (UExpr) +import Language.Haskell.Tools.AST.Representation.Names (UName, UOperator) +import Language.Haskell.Tools.AST.Representation.Patterns (UPattern) +import Language.Haskell.Tools.AST.Representation.Types (UType) + +-- | Value binding for top-level and local bindings +data UValueBind dom stage + = USimpleBind { _valBindPat :: Ann UPattern dom stage + , _valBindRhs :: Ann URhs dom stage + , _valBindLocals :: AnnMaybeG ULocalBinds dom stage + } -- ^ 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 +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 + = UNormalLhs { _matchLhsName :: Ann UName dom stage + , _matchLhsArgs :: AnnListG UPattern dom stage + } -- ^ A match lhs with the function name and parameter names (@ f a b @) + | UInfixLhs { _matchLhsLhs :: Ann UPattern dom stage + , _matchLhsOperator :: Ann UOperator dom stage + , _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 @) +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 + = ULocalValBind { _localVal :: Ann UValueBind dom stage + } -- ^ A local binding for a value + | ULocalSignature { _localSig :: Ann UTypeSignature dom stage + } -- ^ A local type signature + | ULocalFixity { _localFixity :: Ann UFixitySignature dom stage + } -- ^ 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 +, - @). +data UFixitySignature dom stage + = UFixitySignature { _fixityAssoc :: Ann Assoc dom stage + , _fixityPrecedence :: AnnMaybeG Precedence dom stage + , _fixityOperators :: AnnListG UOperator dom stage + } + +-- | Associativity of an operator. +data Assoc dom stage + = 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 } + +-- | Right hand side of a value binding (possible with guards): (@ = 3 @ or @ | x == 1 = 3; | otherwise = 4 @) +data URhs dom stage + = UUnguardedRhs { _rhsExpr :: Ann UExpr dom stage + } -- ^ 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 @) +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 + = UGuardBind { _guardPat :: Ann UPattern dom stage + , _guardRhs :: Ann UExpr dom stage + } -- ^ A bind statement in a pattern guard (@ Just v <- x @) + | UGuardLet { _guardBinds :: AnnListG ULocalBind dom stage + } -- ^ A let statement in a pattern guard (@ let x = 3 @) + | UGuardCheck { _guardCheck :: Ann UExpr dom stage + } -- ^ An expression to check for a pattern guard + +-- | Pragmas that control how the definitions will be inlined +data UInlinePragma dom stage + = UInlinePragma { _inlineConlike :: AnnMaybeG UConlikeAnnot dom stage + , _inlinePhase :: AnnMaybeG UPhaseControl dom stage + , _inlineDef :: Ann UName dom stage + } -- ^ A pragma that marks a function for inlining to the compiler (@ {-# INLINE thenUs #-} @) + | UNoInlinePragma { _noInlineDef :: Ann UName dom stage + } -- ^ A pragma that forbids a function from being inlined by the compiler (@ {-# NOINLINE f #-} @) + | UInlinablePragma { _inlinePhase :: AnnMaybeG UPhaseControl dom stage + , _inlinableDef :: Ann UName dom stage + } -- ^ A pragma that marks a function that it may be inlined by the compiler (@ {-# INLINABLE thenUs #-} @) + +-- | A @CONLIKE@ modifier for an @INLINE@ pragma. +data UConlikeAnnot dom stage = UConlikeAnnot + +-- | Controls the activation of a rewrite rule (@ [1] @) +data UPhaseControl dom stage + = UPhaseControl { _phaseUntil :: AnnMaybeG PhaseInvert 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
+ Language/Haskell/Tools/AST/Representation/Binds.hs-boot view
@@ -0,0 +1,12 @@+{-# LANGUAGE RoleAnnotations #-} + +module Language.Haskell.Tools.AST.Representation.Binds where + +type role ULocalBind nominal nominal +data ULocalBind dom stage + +type role ULocalBinds nominal nominal +data ULocalBinds dom stage + +type role URhsGuard nominal nominal +data URhsGuard dom stage
+ Language/Haskell/Tools/AST/Representation/Decls.hs view
@@ -0,0 +1,448 @@+-- | 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 + +import Language.Haskell.Tools.AST.Ann (Ann, AnnListG, AnnMaybeG) +import Language.Haskell.Tools.AST.Representation.Binds +import Language.Haskell.Tools.AST.Representation.Exprs (UExpr) +import Language.Haskell.Tools.AST.Representation.Kinds (UKindConstraint) +import Language.Haskell.Tools.AST.Representation.Names +import Language.Haskell.Tools.AST.Representation.Patterns (UPattern) +import {-# SOURCE #-} Language.Haskell.Tools.AST.Representation.TH (USplice) +import Language.Haskell.Tools.AST.Representation.Types (UContext, UType, UTyVar) + +-- * Declarations + +-- | Haskell declarationw +data UDecl dom stage + = UTypeDecl { _declHead :: Ann UDeclHead dom stage + , _declType :: Ann UType dom stage + } -- ^ A type synonym ( @type String = [Char]@ ) + | UTypeFamilyDecl { _declTypeFamily :: Ann UTypeFamily dom stage + } -- ^ A type family declaration ( @type family F x@ ) + | UClosedTypeFamilyDecl { _declHead :: Ann UDeclHead 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 + , _declCtx :: AnnMaybeG UContext dom stage + , _declHead :: Ann UDeclHead dom stage + , _declCons :: AnnListG UConDecl dom stage + , _declDeriving :: AnnListG UDeriving dom stage + } -- ^ 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 + , _declHead :: Ann UDeclHead dom stage + , _declKind :: AnnMaybeG UKindConstraint dom stage + , _declGadt :: AnnListG UGadtConDecl dom stage + , _declDeriving :: AnnListG UDeriving dom stage + } -- ^ A GADT-style data or newtype declaration. + | UTypeInstDecl { _declInstance :: Ann UInstanceRule dom stage + , _declAssignedType :: Ann UType dom stage + } -- ^ Type family instance declaration (@ type instance Fam T = AssignedT @) + | UDataInstDecl { _declNewtype :: Ann UDataOrNewtypeKeyword dom stage + , _declInstance :: Ann UInstanceRule dom stage + , _declCons :: AnnListG UConDecl dom stage + , _declDeriving :: AnnListG UDeriving dom stage + } -- ^ Data instance declaration (@ data instance Fam T = Con1 | Con2 @) + | UGDataInstDecl { _declNewtype :: Ann UDataOrNewtypeKeyword dom stage + , _declInstance :: Ann UInstanceRule dom stage + , _declKind :: AnnMaybeG UKindConstraint dom stage + , _declGadt :: AnnListG UGadtConDecl dom stage + } -- ^ GADT-style data instance declaration (@ data instance Fam T where ... @) + | UClassDecl { _declCtx :: AnnMaybeG UContext dom stage + , _declHead :: Ann UDeclHead dom stage + , _declFunDeps :: AnnMaybeG UFunDeps dom stage + , _declBody :: AnnMaybeG UClassBody dom stage + } -- ^ Type class declaration (@ class X a [where f = ...] @) + | UInstDecl { _declOverlap :: AnnMaybeG UOverlapPragma dom stage + , _declInstRule :: Ann UInstanceRule dom stage + , _declInstDecl :: AnnMaybeG UInstBody dom stage + } -- ^ Instance declaration (@ instance X T [where f = ...] @) + | UPatternSynonymDecl { _declPatSyn :: Ann UPatternSynonym dom stage + } -- ^ Pattern synonyms (@ pattern Arrow t1 t2 = App "->" [t1, t2] @) + | UDerivDecl { _declDerivStrat :: AnnMaybeG UDeriveStrategy dom stage + , _declOverlap :: AnnMaybeG UOverlapPragma dom stage + , _declInstRule :: Ann UInstanceRule dom stage + } -- ^ Standalone deriving declaration (@ deriving instance X T @) + | UFixityDecl { _declFixity :: Ann UFixitySignature dom stage + } -- ^ Fixity declaration (@ infixl 5 +, - @) + | UDefaultDecl { _declTypes :: AnnListG UType dom stage + } -- ^ Default types (@ default (T1, T2) @) + | UTypeSigDecl { _declTypeSig :: Ann UTypeSignature dom stage + } -- ^ Type signature declaration (@ f :: Int -> Int @) + | UPatTypeSigDecl { _declPatTypeSig :: Ann UPatternTypeSignature dom stage + } -- ^ Pattern type signature declaration (@ pattern Succ :: Int -> Int @) + | UValueBinding { _declValBind :: Ann UValueBind dom stage + } -- ^ Function or value binding (@ f x = 12 @) + | UForeignImport { _declCallConv :: Ann UCallConv dom stage + , _declSafety :: AnnMaybeG USafety dom stage + , _declName :: Ann UName 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 + , _declForeignType :: Ann UType dom stage + } -- ^ Foreign export (@ foreign export ccall _foo :: Int -> IO Int @) + | UPragmaDecl { _declPragma :: Ann UTopLevelPragma dom stage + } -- ^ Top-level pragmas + | URoleDecl { _declRoleType :: Ann UQualifiedName dom stage + , _declRoles :: AnnListG URole dom stage + } -- ^ Role annotations (@ type role Ptr representational @) + | USpliceDecl { _declSplice :: Ann USplice dom stage + } -- ^ A Template Haskell splice declaration (@ $(generateDecls) @) + +-- The declared (possibly parameterized) type (@ A x :+: B y @). +data UDeclHead dom stage + = UDeclHead { _dhName :: Ann UName dom stage + } -- ^ Type or class name + | UDHParen { _dhBody :: Ann UDeclHead dom stage + } -- ^ Parenthesized type + | UDHApp { _dhAppFun :: Ann UDeclHead dom stage + , _dhAppOperand :: Ann UTyVar dom stage + } -- ^ Type application + | UDHInfix { _dhLeft :: Ann UTyVar dom stage + , _dhOperator :: Ann UOperator dom stage + , _dhRight :: Ann UTyVar dom stage + } -- ^ Infix application of the type/class name to the left operand + +-- * Type class definitions + +-- | The list of declarations that can appear in a typeclass +data UClassBody dom stage + = UClassBody { _cbElements :: AnnListG UClassElement dom stage + } + +-- | 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 :: * @ + | 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 @ + | UClsDefSig { _ceName :: Ann UName dom stage + , _ceType :: Ann UType dom stage + } -- ^ Default signature (by using @DefaultSignatures@): @ default _enum :: (Generic a, GEnum (Rep a)) => [a] @ + | UClsMinimal { _pragmaFormula :: Ann UMinimalFormula dom stage + } -- ^ Minimal pragma: @ {-# MINIMAL (==) | (/=) #-} @ + | UClsInline { _clsInline :: Ann UInlinePragma dom stage + } -- ^ Inline-like pragma in class definition + -- not supported yet (GHC 8.0.1) +-- | UClsPatSig { _cePatSig :: Ann UPatternTypeSignature dom stage + -- } -- ^ 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 + , _irCtx :: AnnMaybeG UContext dom stage + , _irHead :: Ann UInstanceHead dom stage + } -- ^ Instance head as an instance rule (@ X a => Y a @) + +-- | The specification of the class instance declaration +data UInstanceHead dom stage + = UInstanceHeadCon { _ihConName :: Ann UName dom stage + } -- ^ Type or class name + | UInstanceHeadInfix { _ihLeftOp :: Ann UType 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 + | UInstanceHeadApp { _ihFun :: Ann UInstanceHead dom stage + , _ihType :: Ann UType dom stage + } -- ^ Application to one more type + +-- | Instance body is the implementation of the class functions (@ where a x = 1; b x = 2 @) +data UInstBody dom stage + = UInstBody { _instBodyDecls :: AnnListG UInstBodyDecl dom stage + } + +-- | Declarations inside an instance declaration. +data UInstBodyDecl dom stage + = UInstBodyNormalDecl { _instBodyDeclFunbind :: Ann UValueBind dom stage + } -- ^ A normal value binding (@ f x = 12 @) + | UInstBodyTypeSig { _instBodyTypeSig :: Ann UTypeSignature dom stage + } -- ^ Type signature in instance definition with @InstanceSigs@ + | UInstBodyTypeDecl { _instBodyTypeEqn :: Ann UTypeEqn dom stage + } -- ^ An associated type definition (@ type A X = B @) + | UInstBodyDataDecl { _instBodyDataNew :: Ann UDataOrNewtypeKeyword dom stage + , _instBodyLhsType :: Ann UInstanceRule dom stage + , _instBodyDataCons :: AnnListG UConDecl dom stage + , _instBodyDerivings :: AnnListG UDeriving dom stage + } -- ^ An associated data type implementation (@ data A X = C1 | C2 @) + | UInstBodyGadtDataDecl { _instBodyDataNew :: Ann UDataOrNewtypeKeyword dom stage + , _instBodyLhsType :: Ann UInstanceRule dom stage + , _instBodyDataKind :: AnnMaybeG UKindConstraint dom stage + , _instBodyGadtCons :: AnnListG UGadtConDecl dom stage + , _instBodyDerivings :: AnnListG UDeriving dom stage + } -- ^ An associated data type implemented using GADT style + | USpecializeInstance { _specializeInstanceType :: Ann UType dom stage + } -- ^ 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. +data UOverlapPragma dom stage + = UEnableOverlap -- ^ @OVERLAP@ pragma + | UDisableOverlap -- ^ @NO_OVERLAP@ pragma + | UOverlappable -- ^ @OVERLAPPABLE@ pragma + | UOverlapping -- ^ @OVERLAPPING@ pragma + | UOverlaps -- ^ @OVERLAPS@ pragma + | UIncoherentOverlap -- ^ @INCOHERENT@ pragma + +-- * Type families + +-- | Open type and data families +data UTypeFamily dom stage + = UTypeFamily { _tfHead :: Ann UDeclHead dom stage + , _tfSpec :: AnnMaybeG UTypeFamilySpec dom stage + } -- ^ Type family declaration (@ type family A a :: * -> * @) + | UDataFamily { _tfHead :: Ann UDeclHead dom stage + , _tfKind :: AnnMaybeG UKindConstraint dom stage + } -- ^ Data family declaration (@ data family A a :: * -> * @) + +-- | Type family specification with kinds specification and injectivity. +data UTypeFamilySpec dom stage + = UTypeFamilyKind { _tfSpecKind :: Ann UKindConstraint dom stage + } -- ^ Specifies the kind of a type family (@ :: * -> * @) + | UTypeFamilyTyVar { _tfTypeVar :: Ann UTyVar dom stage + } -- ^ Specifies the kind of a type family (@ = t :: * -> * @) + | UTypeFamilyInjectivity { _tfInjectivity :: Ann UInjectivityAnn dom stage + } -- ^ Specifies the injectivity of a type family (@ = r | r -> a @) + +-- | Injectivity annotation for type families (@ = r | r -> a @) +data UInjectivityAnn dom stage + = UInjectivityAnn { _injAnnRes :: Ann UTyVar dom stage + , _injAnnDeps :: AnnListG UName dom stage + } + +-- | Type equations as found in closed type families (@ T A = S @) +data UTypeEqn dom stage + = UTypeEqn { _teLhs :: Ann UType dom stage + , _teRhs :: Ann UType dom stage + } + +-- * Type definitions + +-- | 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 + | UNewtypeKeyword + +-- | Type of GADT constructors (can be record types: @{ val :: Int }@) +data UGadtConType dom stage + = UGadtNormalType { _gadtConNormalType :: Ann UType dom stage + } + | UGadtRecordType { _gadtConRecordFields :: AnnListG UFieldDecl dom stage + , _gadtConResultType :: Ann UType dom stage + } + +-- | 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@ +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 { _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 { _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 { _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 { _deriveStrategy :: AnnMaybeG UDeriveStrategy dom stage + , _oneDerived :: Ann UInstanceHead dom stage + } + | UDerivings { _deriveStrategy :: AnnMaybeG UDeriveStrategy dom stage + , _allDerived :: AnnListG UInstanceHead dom stage + } + +data UDeriveStrategy dom stage + = UStockStrategy + | UAnyClassStrategy + | UNewtypeStrategy + +-- * Pattern synonyms + +-- | Pattern type signature declaration (@ pattern Succ :: Int -> Int @) +data UPatternTypeSignature dom stage + = UPatternTypeSignature { _patSigName :: AnnListG UName dom stage + , _patSigType :: Ann UType dom stage + } + +-- | Pattern synonyms: @ pattern Arrow t1 t2 = App "->" [t1, t2] @ +data UPatternSynonym dom stage + = UPatternSynonym { _patLhs :: Ann UPatSynLhs dom stage + , _patRhs :: Ann UPatSynRhs dom stage + } + +-- | Left hand side of a pattern synonym +data UPatSynLhs dom stage + = UNormalPatSyn { _patName :: Ann UName dom stage + , _patArgs :: AnnListG UName dom stage + } -- ^ A left hand side with a constructor name and arguments (@ Arrow t1 t2 @) + | UInfixPatSyn { _patSynLhs :: Ann UName dom stage + , _patSynOp :: Ann UOperator dom stage + , _patSynRhs :: Ann UName dom stage + } -- ^ An infix pattern synonym left-hand side (@ t1 :+: t2 @) + | URecordPatSyn { _patName :: Ann UName dom stage + , _patArgs :: AnnListG UName dom stage + } -- ^ A record-style pattern synonym left-hand side (@ Arrow { arrowFrom, arrowTo } @) + +-- | Right-hand side of pattern synonym +data UPatSynRhs dom stage + -- TODO: this feels bad, changing _patRhsOpposite may switch between <- and = + = UBidirectionalPatSyn { _patRhsPat :: Ann UPattern dom stage + , _patRhsOpposite :: AnnMaybeG UPatSynWhere dom stage + } -- ^ @ pattern Int = App "Int" [] @ or @ pattern Int <- App "Int" [] where Int = App "Int" [] @ + | UOneDirectionalPatSyn { _patRhsPat :: Ann UPattern dom stage + } -- ^ @ pattern Int <- App "Int" [] @ + +-- | Where clause of pattern synonym (explicit expression direction) +data UPatSynWhere dom stage + = UPatSynWhere { _patOpposite :: AnnListG UMatch dom stage } + +-- * Foreign imports + +-- | Call conventions of foreign functions +data UCallConv dom stage + = UStdCall + | UCCall + | UCPlusPlus + | UDotNet + | UJvm + | UJs + | UJavaScript + | UCApi + +-- | Safety annotations for foreign calls +data USafety dom stage + = USafe + | UThreadSafe + | UUnsafe + | UInterruptible + +-- * Role annotations + +-- | Role annotations for types +data URole dom stage + = UNominal + | URepresentational + | UPhantom + +-- * Pragmas + +-- | Top level pragmas +data UTopLevelPragma dom stage + = 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 + , _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 + , _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 + } -- ^ A pragma that annotates a definition with an arbitrary value (@ {-# ANN f 42 @) + -- TODO: extract pragmas that appear both in top-level and in instances (inline, inlinable, noinline) + | UInlinePragmaDecl { _pragmaInline :: Ann UInlinePragma dom stage } + | ULinePragma { _pragmaLineNum :: Ann LineNumber dom stage + , _pragmaFileName :: AnnMaybeG UStringNode dom stage + } -- ^ A pragma for maintaining line numbers in generated sources (@ {-# LINE 123 "somefile" #-} @) + | USpecializeDecl { _specializePragma :: Ann USpecializePragma dom stage } + | UCompletePragma { _pragmaObjects :: AnnListG UName dom stage + , _pragmaSignature :: AnnMaybeG UName dom stage + } -- ^ The COMPLETE pragma is used to inform the pattern match checker that a certain set of patterns is complete (@ {-# COMPLETE T :: [] #-} @). + +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 #-} @) + +-- | A rewrite rule (@ "map/map" forall f g xs. map f (map g xs) = map (f.g) xs @) +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 URuleVar dom stage -- ^ Variables bound in the rule + , _ruleLhs :: Ann UExpr dom stage -- ^ The transformed expression + , _ruleRhs :: Ann UExpr dom stage -- ^ The resulting expression + } + +-- | 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 + | UTypeAnnotation { _annotateName :: Ann UName dom stage + } -- ^ A type with the given name is annotated + | UModuleAnnotation -- ^ The whole module is annotated + +-- | Formulas of minimal annotations declaring which functions should be defined. +data UMinimalFormula dom stage + = UMinimalName { _minimalName :: Ann UName dom stage + } + | UMinimalParen { _minimalInner :: Ann UMinimalFormula dom stage + } + | UMinimalOr { _minimalOrs :: AnnListG UMinimalFormula dom stage + } -- ^ One of the minimal formulas are needed (@ min1 | min2 @) + | UMinimalAnd { _minimalAnds :: AnnListG UMinimalFormula dom stage + } -- ^ Both of the minimal formulas are needed (@ min1 , min2 @) + +-- | A line number for a line pragma. +data LineNumber dom stage + = LineNumber { _lineNumber :: Int }
+ Language/Haskell/Tools/AST/Representation/Exprs.hs view
@@ -0,0 +1,234 @@+-- | Representation of Haskell expressions +module Language.Haskell.Tools.AST.Representation.Exprs where + +import Language.Haskell.Tools.AST.Ann (Ann, AnnListG, AnnMaybeG) +import {-# SOURCE #-} Language.Haskell.Tools.AST.Representation.Binds (ULocalBind, ULocalBinds, URhsGuard) +import Language.Haskell.Tools.AST.Representation.Literals (ULiteral) +import Language.Haskell.Tools.AST.Representation.Names (UStringNode, UName, UOperator) +import Language.Haskell.Tools.AST.Representation.Patterns (UPattern) +import Language.Haskell.Tools.AST.Representation.Stmts +import {-# SOURCE #-} Language.Haskell.Tools.AST.Representation.TH (UBracket, UQuasiQuote, USplice) +import Language.Haskell.Tools.AST.Representation.Types (UType) + +-- | Haskell expressions +data UExpr dom stage + = UVar { _exprName :: Ann UName dom stage + } -- ^ A variable or a data constructor (@ a @) + | ULit { _exprLit :: Ann ULiteral dom stage + } -- ^ Literal expression (@ 42 @) + | UInfixApp { _exprLhs :: Ann UExpr dom stage + , _exprOperator :: Ann UOperator dom stage + , _exprRhs :: Ann UExpr dom stage + } -- ^ An infix operator application (@ a + b @) + | UPrefixApp { _exprOperator :: Ann UOperator dom stage + , _exprRhs :: Ann UExpr dom stage + } -- ^ Prefix operator application (@ -x @) + | UApp { _exprFun :: Ann UExpr dom stage + , _exprArg :: Ann UExpr dom stage + } -- ^ Function application (@ f 4 @) + | ULambda { _exprBindings :: AnnListG UPattern dom stage -- ^ at least one + , _exprInner :: Ann UExpr dom stage + } -- ^ Lambda expression (@ \a b -> a + b @) + | ULet { _exprFunBind :: AnnListG ULocalBind dom stage -- ^ nonempty + , _exprInner :: Ann UExpr dom stage + } -- ^ Local binding (@ let x = 2; y = 3 in e x y @) + | UIf { _exprCond :: Ann UExpr dom stage + , _exprThen :: Ann UExpr dom stage + , _exprElse :: Ann UExpr dom stage + } -- ^ If expression (@ if a then b else c @) + | UMultiIf { _exprIfAlts :: AnnListG UGuardedCaseRhs dom stage + } -- ^ Multi way if expressions with @MultiWayIf@ extension (@ if | guard1 -> expr1; guard2 -> expr2 @) + | UCase { _exprCase :: Ann UExpr dom stage + , _exprAlts :: AnnListG UAlt dom stage + } -- ^ Pattern matching expression (@ case expr of pat1 -> expr1; pat2 -> expr2 @) + | UDo { _doKind :: Ann UDoKind dom stage + , _exprStmts :: AnnListG UStmt dom stage + } -- ^ Do-notation expressions (@ do x <- act1; act2 @) + | UTuple { _tupleElems :: AnnListG UExpr dom stage + } -- ^ Tuple expression (@ (e1, e2, e3) @) + | UUnboxedTuple { _tupleElems :: AnnListG UExpr dom stage + } -- ^ Unboxed tuple expression (@ (# e1, e2, e3 #) @) + | UTupleSection { _tupleSectionElems :: AnnListG UTupSecElem dom stage + } -- ^ Tuple section, enabled with @TupleSections@ (@ (a,,b) @). One of the elements must be missing. + | UUnboxedTupSec { _tupleSectionElems :: AnnListG UTupSecElem dom stage + } -- ^ Unboxed tuple section enabled with @TupleSections@ (@ (# a,,b #) @). One of the elements must be missing. + | UList { _listElems :: AnnListG UExpr dom stage + } -- ^ List expression: @[1,2,3]@ + | UParArray { _listElems :: AnnListG UExpr dom stage + } -- ^ Parallel array expression: @[: 1,2,3 :]@ + | UParen { _exprInner :: Ann UExpr dom stage + } -- ^ Parenthesized expression: @( a + b )@ + | ULeftSection { _exprLhs :: Ann UExpr dom stage + , _exprOperator :: Ann UOperator dom stage + } -- ^ Left operator section: @(1+)@ + | URightSection { _exprOperator :: Ann UOperator dom stage + , _exprRhs :: Ann UExpr dom stage + } -- ^ Right operator section: @(+1)@ + | URecCon { _exprRecName :: Ann UName dom stage + , _exprRecFields :: AnnListG UFieldUpdate dom stage + } -- ^ Record value construction: @Point { x = 3, y = -2 }@ + | URecUpdate { _exprInner :: Ann UExpr dom stage + , _exprRecFields :: AnnListG UFieldUpdate dom stage + } -- ^ Record value update: @p1 { x = 3, y = -2 }@ + | UEnum { _enumFrom :: Ann UExpr dom stage + , _enumThen :: AnnMaybeG UExpr dom stage + , _enumTo :: AnnMaybeG UExpr dom stage + } -- ^ Enumeration expression (@ [1,3..10] @) + | UParArrayEnum { _enumFrom :: Ann UExpr dom stage + , _enumThen :: AnnMaybeG UExpr dom stage + , _enumToFix :: Ann UExpr dom stage + } -- ^ Parallel array enumeration (@ [: 1,3 .. 10 :] @) + | UListComp { _compExpr :: Ann UExpr dom stage + , _compBody :: AnnListG UListCompBody dom stage -- ^ Can only have 1 element without @ParallelListComp@ + } -- ^ List comprehension (@ [ (x, y) | x <- xs | y <- ys ] @) + | UParArrayComp { _compExpr :: Ann UExpr dom stage + , _compBody :: AnnListG UListCompBody dom stage + } -- ^ Parallel array comprehensions @ [: (x, y) | x <- xs , y <- ys :] @ enabled by @ParallelArrays@ + | UTypeSig { _exprInner :: Ann UExpr dom stage + , _exprSig :: Ann UType dom stage + } -- ^ Explicit type signature (@ x :: Int @) + | UExplTypeApp { _exprInner :: Ann UExpr dom stage + , _exprType :: Ann UType dom stage + } -- ^ Explicit type application (@ show \@Integer (read "5") @) + | UVarQuote { _quotedName :: Ann UName dom stage + } -- ^ @'x@ for template haskell reifying of expressions + | UTypeQuote { _quotedName :: Ann UName dom stage + } -- ^ @''T@ for template haskell reifying of types + | UBracketExpr { _exprBracket :: Ann UBracket dom stage + } -- ^ Template haskell bracket expression + | USplice { _exprSplice :: Ann USplice dom stage + } -- ^ Template haskell splice expression, for example: @$(gen a)@ or @$x@ + | UQuasiQuoteExpr { _exprQQ :: Ann UQuasiQuote dom stage + } -- ^ Template haskell quasi-quotation: @[$quoter|str]@ + | UExprPragma { _exprPragma :: Ann UExprPragma dom stage + , _innerExpr :: Ann UExpr dom stage + } + -- Arrows + | UProc { _procPattern :: Ann UPattern dom stage + , _procExpr :: Ann UCmd dom stage + } -- ^ Arrow definition: @proc a -> f -< a+1@ + | UArrowApp { _exprLhs :: Ann UExpr dom stage + , _arrowAppl :: Ann UArrowAppl dom stage + , _exprRhs :: Ann UExpr dom stage + } -- ^ Arrow application: @f -< a+1@ + | ULamCase { _exprAlts :: AnnListG UAlt dom stage + } -- ^ Lambda case ( @\case 0 -> 1; 1 -> 2@ ) + | UStaticPtr { _exprInner :: Ann UExpr dom stage + } -- ^ Static pointer expression (@ static e @). The inner expression must be closed (cannot have variables bound outside) + | UUnboxedSum { _exprSumPlaceholdersBefore :: AnnListG UUnboxedSumPlaceHolder dom stage + , _exprInner :: Ann UExpr dom stage + , _exprSumPlaceholdersAfter :: AnnListG UUnboxedSumPlaceHolder dom stage + } -- ^ Unboxed sum expression (@ (# | True #) @). + | UHole -- ^ A hole in the program @_@, similar to undefined but gives type information. + -- XML expressions omitted + +-- | Field update expressions +data UFieldUpdate dom stage + = UNormalFieldUpdate { _fieldName :: Ann UName dom stage + , _fieldValue :: Ann UExpr dom stage + } -- ^ Update of a field (@ x = 1 @) + | UFieldPun { _fieldUpdateName :: Ann UName dom stage + } -- ^ 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 + +-- | An element of a tuple section that can be an expression or missing (indicating a value from a parameter) +data UTupSecElem dom stage + = 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 + , _altRhs :: Ann (UCaseRhs' expr) dom stage + , _altBinds :: AnnMaybeG ULocalBinds dom stage + } +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 + } -- ^ Unguarded right-hand side a pattern match (@ -> 3 @) + | UGuardedCaseRhss { _rhsCaseGuards :: AnnListG (UGuardedCaseRhs' expr) dom stage + } -- ^ 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 @) +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 + } -- ^ A @CORE@ pragma for adding notes to expressions. + | USccPragma { _pragmaStr :: Ann UStringNode dom stage + } -- ^ An @SCC@ pragma for defining cost centers for profiling + | UGeneratedPragma { _pragmaSrcRange :: Ann USourceRange dom stage + } -- ^ A pragma that describes if an expression was generated from a code fragment by an external tool (@ {-# GENERATED "Happy.y" 1:15-1:25 #-} @) + +-- | In-AST source ranges (for generated pragmas) +data USourceRange dom stage + = USourceRange { _srFileName :: Ann UStringNode dom stage + , _srFromLine :: Ann Number dom stage + , _srFromCol :: Ann Number dom stage + , _srToLine :: Ann Number dom stage + , _srToCol :: Ann Number dom stage + } + +data Number dom stage + = Number { _numberInteger :: Integer + } + +-- * Arrows + +data UCmd dom stage + = UArrowAppCmd { _cmdLhs :: Ann UExpr dom stage + , _cmdArrowOp :: Ann UArrowAppl dom stage + , _cmdRhs :: Ann UExpr dom stage + } -- ^ An arrow application command (@ f -< x + 1 @) + | UArrowFormCmd { _cmdExpr :: Ann UExpr dom stage + , _cmdInnerCmds :: AnnListG UCmd dom stage + } -- ^ A form command (@ (|untilA (increment -< x+y) (within 0.5 -< x)|) @) + | UAppCmd { _cmdInnerCmd :: Ann UCmd dom stage + , _cmdApplied :: Ann UExpr dom stage + } -- ^ A function application command + | UInfixCmd { _cmdLeftCmd :: Ann UCmd dom stage + , _cmdOperator :: Ann UName dom stage + , _cmdRightCmd :: Ann UCmd dom stage + } -- ^ An infix command application + | ULambdaCmd { _cmdBindings :: AnnListG UPattern dom stage -- ^ at least one + , _cmdInner :: Ann UCmd dom stage + } -- ^ A lambda command + | UParenCmd { _cmdInner :: Ann UCmd dom stage + } -- ^ A parenthesized command + | UCaseCmd { _cmdExpr :: Ann UExpr dom stage + , _cmdAlts :: AnnListG UCmdAlt dom stage + } -- ^ A pattern match command + | UIfCmd { _cmdExpr :: Ann UExpr dom stage + , _cmdThen :: Ann UCmd dom stage + , _cmdElse :: Ann UCmd dom stage + } -- ^ An if command (@ if f x y then g -< x+1 else h -< y+2 @) + | ULetCmd { _cmdBinds :: AnnListG ULocalBind dom stage -- ^ nonempty + , _cmdInner :: Ann UCmd dom stage + } -- ^ A local binding command (@ let z = x+y @) + | UDoCmd { _cmdStmts :: AnnListG UCmdStmt dom stage + } -- ^ A do-notation in a command + +data UArrowAppl dom stage + = ULeftAppl -- ^ Left arrow application: @-<@ + | URightAppl -- ^ Right arrow application: @>-@ + | ULeftHighApp -- ^ Left arrow high application: @-<<@ + | URightHighApp -- ^ Right arrow high application: @>>-@ + +data UUnboxedSumPlaceHolder dom stage = UUnboxedSumPlaceHolder
+ Language/Haskell/Tools/AST/Representation/Exprs.hs-boot view
@@ -0,0 +1,15 @@+{-# LANGUAGE RoleAnnotations #-} + +module Language.Haskell.Tools.AST.Representation.Exprs where + +type role UExpr nominal nominal +data UExpr dom stage + +type role UCmd nominal nominal +data UCmd dom stage + +type role UFieldWildcard phantom phantom +data UFieldWildcard dom stage + +type role UUnboxedSumPlaceHolder phantom phantom +data UUnboxedSumPlaceHolder dom stage
+ Language/Haskell/Tools/AST/Representation/Kinds.hs view
@@ -0,0 +1,51 @@+-- | Representation of Haskell Kinds +module Language.Haskell.Tools.AST.Representation.Kinds where + +import Language.Haskell.Tools.AST.Ann (Ann, AnnListG) +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 + } + +-- | Haskell kinds +data UKind dom stage + = UStarKind -- ^ @*@, the kind of types + | UUnboxKind -- ^ @#@, the kind of unboxed types + | UFunKind { _kindLeft :: Ann UKind dom stage + , _kindRight :: Ann UKind dom stage + } -- ^ @->@, the kind of type constructor + | UParenKind { _kindParen :: Ann UKind dom stage + } -- ^ A parenthesised kind + | UVarKind { _kindVar :: Ann UName dom stage + } -- ^ Kind variable (using @PolyKinds@ extension) + | UAppKind { _kindAppFun :: 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 + } -- ^ Numeric value promoted to the kind level. + | UPromotedString { _promotedStringValue :: String + } -- ^ String value promoted to the kind level. + | UPromotedCon { _promotedConName :: Ann UName dom stage + } -- ^ A data constructor value promoted to the kind level. + | UPromotedList { _promotedElements :: AnnListG t dom stage + } -- ^ A list of elements as a kind. + | UPromotedTuple { _promotedElements :: AnnListG t dom stage + } -- ^ A tuple of elements as a kind. + | UPromotedUnit -- ^ Kind of the unit value @()@.
+ Language/Haskell/Tools/AST/Representation/Literals.hs view
@@ -0,0 +1,26 @@+-- | Representation of Haskell literals +module Language.Haskell.Tools.AST.Representation.Literals where + +-- | Haskell literals +data ULiteral dom stage + = UCharLit { _charLitValue :: Char + } -- ^ Character literal: @'c'@ + | UStringLit { _stringLitValue :: String + } -- ^ String literal: @"abc"@ + | UIntLit { _intLitValue :: Integer + } -- ^ Integer literal: @12@ + | UFracLit { _fracLitValue :: Rational + } -- ^ Fractional literal: @3.14@ + | UPrimIntLit { _intLitValue :: Integer + } -- ^ Primitive integer literal (of type @Int#@): @32#@ + | UPrimWordLit { _intLitValue :: Integer + } -- ^ Primitive word literal (of type @Word#@): @32##@ + | UPrimFloatLit { _floatLitValue :: Rational + } -- ^ Primitive float literal (of type @Float#@): @3.14#@ + | UPrimDoubleLit { _floatLitValue :: Rational + } -- ^ Primitive double literal (of type @Double#@): @3.14##@ + | UPrimCharLit { _charLitValue :: Char + } -- ^ Primitive character literal (of type @Char#@): @'c'#@ + | UPrimStringLit { _stringLitValue :: String + } -- ^ Primitive string literal (of type @Addr#@): @"xxx"#@ +
+ Language/Haskell/Tools/AST/Representation/Modules.hs view
@@ -0,0 +1,107 @@+-- | Representation of Haskell modules, imports and exports. Also contains file-level pragmas. +module Language.Haskell.Tools.AST.Representation.Modules where + +import Language.Haskell.Tools.AST.Ann (Ann, AnnListG, AnnMaybeG) +import Language.Haskell.Tools.AST.Representation.Decls (UDecl) +import Language.Haskell.Tools.AST.Representation.Names (UStringNode, UName) + +-- | The representation of a haskell module, that is a separate compilation unit. +-- It may or may not have a header. +data UModule dom stage + = UModule { _filePragmas :: AnnListG UFilePragma dom stage + , _modHead :: AnnMaybeG UModuleHead dom stage + , _modImports :: AnnListG UImportDecl dom stage + , _modDecl :: AnnListG UDecl dom stage + } + +-- | Module declaration with name and (optional) exports +data UModuleHead dom stage + = UModuleHead { _mhName :: Ann UModuleName dom stage + , _mhPragma :: AnnMaybeG UModulePragma dom stage + , _mhExports :: AnnMaybeG UExportSpecs dom stage + } + +-- | A list of export specifications surrounded by parentheses +data UExportSpecs dom stage + = UExportSpecs { _espExports :: AnnListG UExportSpec dom stage } + +-- | Export specifier +data UExportSpec dom stage + = UDeclExport { _exportDecl :: Ann UIESpec dom stage + } -- ^ Export a name and related names + | UModuleExport { _exportModuleName :: Ann UModuleName dom stage + } -- ^ The export of an imported module (@ module A @) + +-- | Marks a name to be imported or exported with related names (subspecifier) +data UIESpec dom stage + = UIESpec { _ieModifier :: AnnMaybeG UImportModifier dom stage + , _ieName :: Ann UName dom stage + , _ieSubspec :: AnnMaybeG USubSpec dom stage + } + +-- | Specifies the imported element +data UImportModifier dom stage + = UImportPattern -- ^ @pattern@: modifier for importing pattern synonyms + | UImportType -- ^ @type@: modifier for importing types + +-- | Marks how related names will be imported or exported with a given name +data USubSpec dom stage + = USubSpecAll -- ^ @(..)@: a class exported with all of its methods, or a datatype exported with all of its constructors. + | USubSpecList { _essList :: AnnListG UName dom stage + } -- ^ @(a,b,c)@: a class exported with some of its methods, or a datatype exported with some of its constructors. + +-- | Pragmas that must be used before defining the module +data UFilePragma dom stage + = ULanguagePragma { _lpPragmas :: AnnListG ULanguageExtension dom stage + } -- ^ @LANGUAGE@ pragma, listing the enabled language extensions in that file + | UOptionsPragma { _opStr :: Ann UStringNode dom stage + } -- ^ @OPTIONS@ pragma, possibly qualified with a tool, e.g. OPTIONS_GHC + +-- | Pragmas that must be used after the module head +data UModulePragma dom stage + = UModuleWarningPragma { _modWarningStr :: AnnListG UStringNode dom stage + } -- ^ A warning pragma attached to the module + | UModuleDeprecatedPragma { _modDeprecatedPragma :: AnnListG UStringNode dom stage + } -- ^ A deprecated pragma attached to the module + +-- | The name of the enabled language extension, for example (@ LambdaCase @) +data ULanguageExtension dom stage = ULanguageExtension { _langExt :: String } + +-- | An import declaration: @import Module.Name@ +data UImportDecl dom stage + = UImportDecl { _importSource :: AnnMaybeG UImportSource dom stage + , _importQualified :: AnnMaybeG UImportQualified dom stage + , _importSafe :: AnnMaybeG UImportSafe dom stage + , _importPkg :: AnnMaybeG UStringNode dom stage + , _importModule :: Ann UModuleName dom stage + , _importAs :: AnnMaybeG UImportRenaming dom stage + , _importSpec :: AnnMaybeG UImportSpec dom stage + } + +-- | Restriction on the imported names +data UImportSpec dom stage + = UImportSpecList { _importSpecList :: AnnListG UIESpec dom stage + } -- ^ Restrict the import definition to ONLY import the listed names + | UImportSpecHiding { _importSpecHiding :: AnnListG UIESpec dom stage + } -- ^ Restrict the import definition to DONT import the listed names + +-- | Marks the import as qualified: @qualified@ +data UImportQualified dom stage = UImportQualified + +-- | Marks the import as source: @{-# SOURCE #-}@ +data UImportSource dom stage = UImportSource + +-- | Marks the import as safe: @safe@ +data UImportSafe dom stage = UImportSafe + +-- | Marks an imported name to belong to the type namespace: @type@ +data UTypeNamespace dom stage = UTypeNamespace + +-- | Renaming imports (@ as A @) +data UImportRenaming dom stage = UImportRenaming { _importRename :: Ann UModuleName dom stage } + +-- | The name of a module +data UModuleName dom stage = UModuleName { _moduleNameString :: String } + +-- | The @type@ keyword used to qualify that the type and not the constructor of the same name is referred +data TypeKeyword dom stage = TypeKeyword
+ Language/Haskell/Tools/AST/Representation/Modules.hs-boot view
@@ -0,0 +1,9 @@+{-# LANGUAGE RoleAnnotations #-} + +module Language.Haskell.Tools.AST.Representation.Modules where + +type role UModule nominal nominal +data UModule dom stage + +type role UImportDecl nominal nominal +data UImportDecl dom stage
+ Language/Haskell/Tools/AST/Representation/Names.hs view
@@ -0,0 +1,42 @@+ +{-# LANGUAGE MonoLocalBinds #-} + + +-- | 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 + } -- ^ A normal name used as an operator with backticks: @ a `mod` b @ + | UNormalOp { _operatorName :: Ann UQualifiedName dom stage + } -- ^ A normal operator used as an operator. + +data UName dom stage + = UParenName { _simpleName :: Ann UQualifiedName dom stage + } -- ^ Parenthesized name: @ foldl (+) 0 @ + | UNormalName { _simpleName :: Ann UQualifiedName dom stage + } -- ^ A normal, non-operator name. + | 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 + } + +nameFromList :: AnnListG UNamePart dom stage -> UQualifiedName dom stage +nameFromList (AnnListG a xs) | not (null xs) + = UQualifiedName (AnnListG a (init xs)) (last xs) +nameFromList _ = error "nameFromList: empty list" + +-- | Parts of a qualified name. +data UNamePart dom stage + = UNamePart { _simpleNameStr :: String } + +-- | Program elements formatted as string literals (import packages, pragma texts) +data UStringNode dom stage + = UStringNode { _stringNodeStr :: String }
+ Language/Haskell/Tools/AST/Representation/Names.hs-boot view
@@ -0,0 +1,6 @@+{-# LANGUAGE RoleAnnotations #-} + +module Language.Haskell.Tools.AST.Representation.Names where + +type role UQualifiedName nominal nominal +data UQualifiedName dom stage
+ Language/Haskell/Tools/AST/Representation/Patterns.hs view
@@ -0,0 +1,74 @@+-- | Representation of Haskell patterns +module Language.Haskell.Tools.AST.Representation.Patterns where + +import Language.Haskell.Tools.AST.Ann (Ann, AnnListG) +import {-# SOURCE #-} Language.Haskell.Tools.AST.Representation.Exprs (UExpr, UFieldWildcard, UUnboxedSumPlaceHolder) +import Language.Haskell.Tools.AST.Representation.Literals (ULiteral) +import Language.Haskell.Tools.AST.Representation.Names (UName, UOperator) +import {-# SOURCE #-} Language.Haskell.Tools.AST.Representation.TH (UQuasiQuote, USplice) +import Language.Haskell.Tools.AST.Representation.Types (UType) + + +-- | Representation of patterns for pattern bindings +data UPattern dom stage + = UVarPat { _patternName :: Ann UName dom stage + } -- ^ Pattern name binding + | ULitPat { _patternLiteral :: Ann ULiteral dom stage + } -- ^ Literal pattern + | UInfixAppPat { _patternLhs :: Ann UPattern dom stage + , _patternOperator :: Ann UOperator dom stage + , _patternRhs :: Ann UPattern dom stage + } -- ^ Infix constructor application pattern (@ a :+: b @) + | UAppPat { _patternName :: Ann UName dom stage + , _patternArgs :: AnnListG UPattern dom stage + } -- ^ Constructor application pattern (@ Point x y @) + | UTuplePat { _patternElems :: AnnListG UPattern dom stage + } -- ^ Tuple pattern (@ (x,y) @) + | UUnboxTuplePat { _patternElems :: AnnListG UPattern dom stage + } -- ^ Unboxed tuple pattern (@ (# x, y #) @) + | UListPat { _patternElems :: AnnListG UPattern dom stage + } -- ^ List pattern (@ [1,2,a,x] @) + | UParArrPat { _patternElems :: AnnListG UPattern dom stage + } -- ^ Parallel array pattern (@ [:1,2,a,x:] @) + | UParenPat { _patternInner :: Ann UPattern dom stage + } -- ^ Parenthesised patterns + | URecPat { _patternName :: Ann UName dom stage + , _patternFields :: AnnListG UPatternField dom stage + } -- ^ Record pattern (@ Point { x = 3, y } @) + | UAsPat { _patternName :: Ann UName dom stage + , _patternInner :: Ann UPattern dom stage + } -- ^ As-pattern (explicit name binding) (@ ls\@(hd:_) @) + | UWildPat -- ^ Wildcard pattern: (@ _ @) + | UIrrefutablePat { _patternInner :: Ann UPattern dom stage + } -- ^ Irrefutable pattern (@ ~(x:_) @) + | UBangPat { _patternInner :: Ann UPattern dom stage + } -- ^ Bang pattern (@ !x @) + | UTypeSigPat { _patternInner :: Ann UPattern dom stage + , _patternType :: Ann UType dom stage + } -- ^ Pattern with explicit type signature (@ x :: Int @) + | UViewPat { _patternExpr :: Ann UExpr dom stage + , _patternInner :: Ann UPattern dom stage + } -- ^ View pattern (@ f -> Just 1 @) + -- regular list pattern omitted + -- xml patterns omitted + | USplicePat { _patternSplice :: Ann USplice dom stage + } -- ^ Splice patterns: @$(generateX inp)@ + | UQuasiQuotePat { _patQQ :: Ann UQuasiQuote dom stage + } -- ^ Quasi-quoted patterns: @[| 1 + 2 |]@ + | UNPlusKPat { _patternName :: Ann UName dom stage + , _patternLit :: Ann ULiteral dom stage + } + | UUnboxedSumPat { _patternSumPlaceholdersBefore :: AnnListG UUnboxedSumPlaceHolder dom stage + , _patternInner :: Ann UPattern dom stage + , _patternSumPlaceholdersAfter :: AnnListG UUnboxedSumPlaceHolder dom stage + } -- ^ Unboxed sum pattern (@ (# | expr #) @). + +-- Field specification of a record pattern +data UPatternField dom stage + = UNormalFieldPattern { _fieldPatternName :: Ann UName dom stage + , _fieldPattern :: Ann UPattern dom stage + } -- ^ Named field pattern (@ p = Point 3 2 @) + | UFieldPunPattern { _fieldPatternName :: Ann UName dom stage + } -- ^ Named field pun (@ p @) + | UFieldWildcardPattern { _fieldPatternWildcard :: Ann UFieldWildcard dom stage + } -- ^ Wildcard field pattern (@ .. @)
+ Language/Haskell/Tools/AST/Representation/Stmts.hs view
@@ -0,0 +1,43 @@+-- | Representation of Haskell statements (both do-notation and comprehensions) +module Language.Haskell.Tools.AST.Representation.Stmts where + +import Language.Haskell.Tools.AST.Ann (Ann, AnnListG, AnnMaybeG) +import {-# SOURCE #-} Language.Haskell.Tools.AST.Representation.Binds (ULocalBind) +import {-# SOURCE #-} Language.Haskell.Tools.AST.Representation.Exprs (UExpr, UCmd) +import Language.Haskell.Tools.AST.Representation.Patterns (UPattern) + +-- | Normal monadic statements +data UStmt' expr dom stage + = UBindStmt { _stmtPattern :: Ann UPattern dom stage + , _stmtExpr :: Ann expr dom stage + } -- ^ Binding statement (@ x <- action @) + | UExprStmt { _stmtExpr :: Ann expr dom stage + } -- ^ Non-binding statement (@ action @) + | ULetStmt { _stmtBinds :: AnnListG ULocalBind dom stage + } -- ^ Let statement (@ let x = 3; y = 4 @) + | URecStmt { _cmdStmtBinds :: AnnListG (UStmt' expr) dom stage + } -- ^ A recursive binding statement with (@ rec b <- f a c; c <- f b a @) +type UStmt = UStmt' UExpr +type UCmdStmt = UStmt' UCmd + +-- | Body of a list comprehension: (@ | x <- [1..10] @) +data UListCompBody dom stage + = UListCompBody { _compStmts :: AnnListG UCompStmt dom stage + } + +-- | List comprehension statement +data UCompStmt dom stage + = UCompStmt { _compStmt :: Ann UStmt dom stage + } -- ^ Normal monadic statement of a list comprehension + | UThenStmt { _thenExpr :: Ann UExpr dom stage + , _byExpr :: AnnMaybeG UExpr dom stage + } -- ^ Then statements by @TransformListComp@ (@ then sortWith by (x + y) @) + | UGroupStmt { _byExpr :: AnnMaybeG UExpr dom stage + , _usingExpr :: AnnMaybeG UExpr dom stage + } -- ^ Grouping statements by @TransformListComp@ (@ then group by (x + y) using groupWith @) + -- Note: either byExpr or usingExpr must have a value + +-- | Keywords @do@ or @mdo@ to start a do-block +data UDoKind dom stage + = UDoKeyword + | UMDoKeyword
+ Language/Haskell/Tools/AST/Representation/TH.hs view
@@ -0,0 +1,40 @@+-- | Representation of Template Haskell AST elements +module Language.Haskell.Tools.AST.Representation.TH where + +import Language.Haskell.Tools.AST.Ann (Ann, AnnListG) +import Language.Haskell.Tools.AST.Representation.Decls (UDecl) +import Language.Haskell.Tools.AST.Representation.Exprs (UExpr) +import Language.Haskell.Tools.AST.Representation.Names (UName) +import Language.Haskell.Tools.AST.Representation.Patterns (UPattern) +import Language.Haskell.Tools.AST.Representation.Types (UType) + +-- | A template haskell splice +data USplice dom stage + = UIdSplice { _spliceId :: Ann UName dom stage + } -- ^ A simple name splice: @$generateX@ + | UParenSplice { _spliceExpr :: Ann UExpr dom stage + } -- ^ A splice with parentheses: @$(generate input)@ + +-- | Template haskell quasi-quotation: @[quoter|str]@ +data UQuasiQuote dom stage + = UQuasiQuote { _qqExprName :: Ann UName dom stage + , _qqExprBody :: Ann QQString dom stage + } + +-- | Template Haskell Quasi-quotation content +data QQString dom stage + = QQString { _qqString :: String + } + + +-- | Template Haskell bracket expressions +data UBracket dom stage + = UExprBracket { _bracketExpr :: Ann UExpr dom stage + } -- ^ Expression bracket (@ [| x + y |] @) + | UPatternBracket { _bracketPattern :: Ann UPattern dom stage + } -- ^ Pattern bracket (@ [p| Point x y |] @) + | UTypeBracket { _bracketType :: Ann UType dom stage + } -- ^ Type bracket (@ [t| (Int,Int) |] @) + | UDeclsBracket { _bracketDecl :: AnnListG UDecl dom stage + } -- ^ Declaration bracket (@ [d| f :: Int -> Int; f x = x*x |] @) +
+ Language/Haskell/Tools/AST/Representation/TH.hs-boot view
@@ -0,0 +1,12 @@+{-# LANGUAGE RoleAnnotations #-} + +module Language.Haskell.Tools.AST.Representation.TH where + +type role USplice nominal nominal +data USplice dom stage + +type role UQuasiQuote nominal nominal +data UQuasiQuote dom stage + +type role UBracket nominal nominal +data UBracket dom stage
+ Language/Haskell/Tools/AST/Representation/Types.hs view
@@ -0,0 +1,87 @@+-- | Representation of Haskell types +module Language.Haskell.Tools.AST.Representation.Types where + +import Language.Haskell.Tools.AST.Ann (Ann, AnnListG, AnnMaybeG) +import Language.Haskell.Tools.AST.Representation.Kinds (UPromoted, UKind, UKindConstraint) +import Language.Haskell.Tools.AST.Representation.Names (UName, UOperator) +import {-# SOURCE #-} Language.Haskell.Tools.AST.Representation.TH (UQuasiQuote, USplice) + +-- | Type variable declaration +data UTyVar dom stage + = UTyVarDecl { _tyVarName :: Ann UName dom stage + , _tyVarKind :: AnnMaybeG UKindConstraint dom stage + } + +-- | Haskell types +data UType dom stage + = UTyForall { _typeBounded :: AnnListG UTyVar dom stage + , _typeType :: Ann UType dom stage + } -- ^ Forall types (@ forall x y . type @) + | UTyCtx { _typeCtx :: Ann UContext dom stage + , _typeType :: Ann UType dom stage + } -- ^ Type with a context (@ forall x y . type @) + | UTyFun { _typeParam :: Ann UType dom stage + , _typeResult :: Ann UType dom stage + } -- ^ Function types (@ a -> b @) + | UTyTuple { _typeElements :: AnnListG UType dom stage + } -- ^ Tuple types (@ (a,b) @) + | UTyUnbTuple { _typeElements :: AnnListG UType dom stage + } -- ^ Unboxed tuple types (@ (#a,b#) @) + | UTyList { _typeElement :: Ann UType dom stage + } -- ^ List type with special syntax (@ [a] @) + | UTyParArray { _typeElement :: Ann UType dom stage + } -- ^ Parallel array type (@ [:a:] @) + | UTyApp { _typeCon :: Ann UType dom stage + , _typeArg :: Ann UType dom stage + } -- ^ Type application (@ F a @) + | UTyVar { _typeName :: Ann UName dom stage + } -- ^ Type variable or constructor (@ a @) + | UTyParen { _typeInner :: Ann UType dom stage + } -- ^ Type surrounded by parentheses (@ (T a) @) + | UTyInfix { _typeLeft :: Ann UType dom stage + , _typeOperator :: Ann UOperator dom stage + , _typeRight :: Ann UType dom stage + } -- ^ Infix type constructor (@ (a <: b) @) + | UTyKinded { _typeInner :: Ann UType dom stage + , _typeKind :: Ann UKind dom stage + } -- ^ Type with explicit kind signature (@ a :: * @) + | UTyPromoted { _tpPromoted :: Ann (UPromoted UType) dom stage + } -- A promoted data type with @-XDataKinds@ (@ 3 @, @ Left @, @ 'Left @). + | UTySplice { _tsSplice :: Ann USplice dom stage + } -- ^ A Template Haskell splice type (@ $(genType) @). + | UTyQuasiQuote { _typeQQ :: Ann UQuasiQuote dom stage + } -- ^ A Template Haskell quasi-quote type (@ [quoter| ... ] @). + | UTyBang { _typeInner :: Ann UType dom stage + } -- ^ Strict type marked with @!@. + | UTyLazy { _typeInner :: Ann UType dom stage + } -- ^ Lazy type marked with @~@. (Should only be used if @Strict@ or @StrictData@ language extension is used) + | UTyUnpack { _typeInner :: Ann UType dom stage + } -- ^ Strict type marked with UNPACK pragma. (Usually contains the bang mark.) + | UTyNoUnpack { _typeInner :: Ann UType dom stage + } -- ^ Strict type marked with NOUNPACK pragma. (Usually contains the bang mark.) + | UTyWildcard -- ^ A wildcard type (@ _ @) with @-XPartialTypeSignatures@ + | UTyNamedWildc { _typeWildcardName :: Ann UName dom stage + } -- ^ A named wildcard type (@ _t @) with @-XPartialTypeSignatures@ + | UUnbSumType { _typeElements :: AnnListG UType dom stage + } -- ^ An unboxed sum type (@ (# Bool | Int | String #) @) + +-- One or more assertions +data UContext dom stage + = UContext { _contextAssertion :: Ann UAssertion dom stage + } -- ^ Assertions with the fat arrow (@ C a => ... @) + +-- | A single assertion in the context +data UAssertion dom stage + = UClassAssert { _assertClsName :: Ann UName dom stage + , _assertTypes :: AnnListG UType dom stage + } -- ^ Class assertion (@Cls x@) + | UInfixAssert { _assertLhs :: Ann UType dom stage + , _assertOp :: Ann UOperator dom stage + , _assertRhs :: Ann UType dom stage + } -- ^ Infix class assertion, also contains type equations (@ a ~ X y @) + | UImplicitAssert { _assertImplVar :: Ann UName dom stage + , _assertImplType :: Ann UType dom stage + } -- ^ Assertion for implicit parameter binding (@ ?cmp :: a -> a -> Bool @) + | UTupleAssert { _innerAsserts :: AnnListG UAssertion dom stage + } -- ^ Multiple assertions in one (@ (Ord a, Show a) @) + | UWildcardAssert -- ^ Wildcard assertion (@ _ @), enabled by @PartialTypeSignatures@
+ Language/Haskell/Tools/AST/Representation/Types.hs-boot view
@@ -0,0 +1,7 @@+{-# LANGUAGE RoleAnnotations #-} + +-- | Representation of Haskell types +module Language.Haskell.Tools.AST.Representation.Types where + +type role UType nominal nominal +data UType dom stage
Language/Haskell/Tools/AST/SemaInfoClasses.hs view
@@ -1,42 +1,82 @@-{-# LANGUAGE FlexibleInstances, FlexibleContexts, ConstraintKinds #-} -module Language.Haskell.Tools.AST.SemaInfoClasses where +{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE UndecidableInstances #-} +module Language.Haskell.Tools.AST.SemaInfoClasses + (module Language.Haskell.Tools.AST.SemaInfoClasses, getInstances, UsageSpec(..)) where + import GHC -import Id as GHC -import BasicTypes as GHC +import Id as GHC (Id, idName) import Control.Reference import Language.Haskell.Tools.AST.Ann as AST +import Language.Haskell.Tools.AST.Representation.Exprs as AST (UFieldWildcard, UExpr) +import Language.Haskell.Tools.AST.Representation.Modules as AST (UImportDecl, UModule) +import Language.Haskell.Tools.AST.Representation.Names as AST (UName(..), UQualifiedName) +import Language.Haskell.Tools.AST.Representation.Literals as AST (ULiteral) import Language.Haskell.Tools.AST.SemaInfoTypes as AST -import Language.Haskell.Tools.AST.Modules as AST -import Language.Haskell.Tools.AST.Base as AST -import Language.Haskell.Tools.AST.Exprs as AST +semanticsLitType :: Ann ULiteral IdDom st -> GHC.Type +semanticsLitType lit = lit ^. annotation & semanticInfo & literalType + +-- * Information about names + -- | Domains that have semantic information for names -type HasNameInfo dom = (Domain dom, HasNameInfo' (SemanticInfo dom QualifiedName)) +type HasNameInfo dom = (Domain dom, HasNameInfo' (SemanticInfo dom UQualifiedName)) -- | Infos that may have a name that can be extracted class HasNameInfo' si where semanticsName :: si -> Maybe GHC.Name -instance HasNameInfo' (NameInfo GHC.Name) where +instance HasNameInfo' (NameInfo GhcRn) where semanticsName = (^? nameInfo) instance HasNameInfo' CNameInfo where semanticsName = fmap idName . (^? cnameInfo) -type HasIdInfo dom = (Domain dom, HasIdInfo' (SemanticInfo dom QualifiedName)) +instance HasNameInfo dom => HasNameInfo' (Ann UQualifiedName dom st) where + semanticsName = semanticsName . (^. annotation&semanticInfo) +instance HasNameInfo dom => HasNameInfo' (Ann UName dom st) where + semanticsName = semanticsName . _simpleName . _element + +-- | Domains that have semantic information for literals +type HasLiteralInfo dom = (Domain dom, HasLiteralInfo' (SemanticInfo dom ULiteral)) + +-- | Info of types +class HasLiteralInfo' si where + semanticsLiteralType :: si -> GHC.Type + +instance HasLiteralInfo' LiteralInfo where + semanticsLiteralType = (^. literalType) + +instance HasLiteralInfo dom => HasLiteralInfo' (Ann ULiteral dom st) where + semanticsLiteralType = semanticsLiteralType . (^. annotation&semanticInfo) + +-- * Information about typed names + +type HasIdInfo dom = (Domain dom, HasIdInfo' (SemanticInfo dom UQualifiedName)) + -- | Infos that may have a typed name that can be extracted -class HasIdInfo' si where +class HasNameInfo' si => HasIdInfo' si where semanticsId :: si -> Id instance HasIdInfo' CNameInfo where semanticsId = (^. cnameInfo) -type HasFixityInfo dom = (Domain dom, HasFixityInfo' (SemanticInfo dom QualifiedName)) +instance HasIdInfo dom => HasIdInfo' (Ann UQualifiedName dom st) where + semanticsId = semanticsId . (^. annotation&semanticInfo) +instance HasIdInfo dom => HasIdInfo' (Ann UName dom st) where + semanticsId = semanticsId . _simpleName . _element + +-- * Fixity information + +type HasFixityInfo dom = (Domain dom, HasFixityInfo' (SemanticInfo dom UQualifiedName)) + -- | Infos that may have a fixity information class HasFixityInfo' si where semanticsFixity :: si -> Maybe GHC.Fixity @@ -44,8 +84,13 @@ instance HasFixityInfo' CNameInfo where semanticsFixity = (^. cnameFixity) -type HasScopeInfo dom = (Domain dom, HasScopeInfo' (SemanticInfo dom QualifiedName), HasScopeInfo' (SemanticInfo dom Expr)) +instance HasFixityInfo dom => HasFixityInfo' (Ann UQualifiedName dom st) where + semanticsFixity = semanticsFixity . (^. annotation&semanticInfo) +-- * Scope information + +type HasScopeInfo dom = (Domain dom, HasScopeInfo' (SemanticInfo dom UQualifiedName), HasScopeInfo' (SemanticInfo dom UExpr)) + -- | Infos that contain the names that are available in theirs scope class HasScopeInfo' si where semanticsScope :: si -> Scope @@ -59,8 +104,16 @@ instance HasScopeInfo' ScopeInfo where semanticsScope = (^. exprScopedLocals) -type HasDefiningInfo dom = (Domain dom, HasDefiningInfo' (SemanticInfo dom QualifiedName)) +instance HasScopeInfo dom => HasScopeInfo' (Ann UExpr dom st) where + semanticsScope = semanticsScope . (^. annotation&semanticInfo) +instance HasScopeInfo dom => HasScopeInfo' (Ann UQualifiedName dom st) where + semanticsScope = semanticsScope . (^. annotation&semanticInfo) + +-- * Information about names being defined + +type HasDefiningInfo dom = (Domain dom, HasDefiningInfo' (SemanticInfo dom UQualifiedName)) + -- | Infos that store if they were used to define a name class HasDefiningInfo' si where semanticsDefining :: si -> Bool @@ -71,44 +124,90 @@ instance HasDefiningInfo' CNameInfo where semanticsDefining = (^. cnameIsDefined) -type HasModuleInfo dom = (Domain dom, HasModuleInfo' (SemanticInfo dom AST.Module)) +instance HasDefiningInfo dom => HasDefiningInfo' (Ann UQualifiedName dom st) where + semanticsDefining = semanticsDefining . (^. annotation&semanticInfo) +-- * Information about source info in sema + +class HasSourceInfoInSema' si where + semanticsSourceInfo :: si -> Maybe SrcSpan + +instance HasSourceInfoInSema' (NameInfo n) where + semanticsSourceInfo = (^? nameLocation) + +-- * Information about modules + +type HasModuleInfo dom = (Domain dom, HasModuleInfo' (SemanticInfo dom AST.UModule)) + class HasModuleInfo' si where semanticsModule :: si -> GHC.Module + semanticsDynFlags :: si -> GHC.DynFlags isBootModule :: si -> Bool semanticsImplicitImports :: si -> [GHC.Name] + semanticsPrelTransMods :: si -> [Module] -instance HasModuleInfo' (AST.ModuleInfo GHC.Name) where +instance HasModuleInfo' (AST.ModuleInfo GhcRn) where semanticsModule = (^. defModuleName) + semanticsDynFlags = (^. defDynFlags) isBootModule = (^. defIsBootModule) - semanticsImplicitImports = (^. implicitNames) + semanticsImplicitImports = (^? implicitNames&traversal&pName) + semanticsPrelTransMods = (^. prelTransMods) -instance HasModuleInfo' (AST.ModuleInfo GHC.Id) where +instance HasModuleInfo' (AST.ModuleInfo GhcTc) where semanticsModule = (^. defModuleName) + semanticsDynFlags = (^. defDynFlags) isBootModule = (^. defIsBootModule) - semanticsImplicitImports = map idName . (^. implicitNames) + semanticsImplicitImports = map idName . (^? implicitNames&traversal&pName) + semanticsPrelTransMods = (^. prelTransMods) -type HasImportInfo dom = (Domain dom, HasImportInfo' (SemanticInfo dom AST.ImportDecl)) - +instance HasModuleInfo dom => HasModuleInfo' (Ann UModule dom st) where + semanticsModule = semanticsModule . (^. annotation&semanticInfo) + semanticsDynFlags = semanticsDynFlags . (^. annotation&semanticInfo) + isBootModule = isBootModule . (^. annotation&semanticInfo) + semanticsImplicitImports = semanticsImplicitImports . (^. annotation&semanticInfo) + semanticsPrelTransMods = semanticsPrelTransMods . (^. 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] semanticsImported :: si -> [GHC.Name] + semanticsTransMods :: si -> [Module] -instance HasImportInfo' (AST.ImportInfo GHC.Name) where +instance HasImportInfo' (AST.ImportInfo GhcRn) where semanticsImportedModule = (^. importedModule) semanticsAvailable = (^. availableNames) - semanticsImported = (^. importedNames) + semanticsImported = (^? importedNames&traversal&pName) + semanticsTransMods = (^. importTransMods) -instance HasImportInfo' (AST.ImportInfo GHC.Id) where +instance HasImportInfo' (AST.ImportInfo GhcTc) where semanticsImportedModule = (^. importedModule) semanticsAvailable = map idName . (^. availableNames) - semanticsImported = map idName . (^. importedNames) + semanticsImported = map idName . (^? importedNames&traversal&pName) + semanticsTransMods = (^. importTransMods) -type HasImplicitFieldsInfo dom = (Domain dom, HasImplicitFieldsInfo' (SemanticInfo dom AST.FieldWildcard)) - +instance HasImportInfo dom => HasImportInfo' (Ann UImportDecl dom st) where + semanticsImportedModule = semanticsImportedModule . (^. annotation&semanticInfo) + semanticsAvailable = semanticsAvailable . (^. annotation&semanticInfo) + semanticsImported = semanticsImported . (^. annotation&semanticInfo) + semanticsTransMods = semanticsTransMods . (^. annotation&semanticInfo) + +-- * 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)] instance HasImplicitFieldsInfo' ImplicitFieldInfo where semanticsImplicitFlds = (^. implicitFieldBindings) + +instance HasImplicitFieldsInfo dom => HasImplicitFieldsInfo' (Ann UFieldWildcard dom st) where + semanticsImplicitFlds = semanticsImplicitFlds . (^. annotation&semanticInfo) + +-- * AST elements with no information + +type HasNoSemanticInfo dom si = SemanticInfo dom si ~ NoSemanticInfo
Language/Haskell/Tools/AST/SemaInfoTypes.hs view
@@ -1,117 +1,225 @@-{-# LANGUAGE DeriveDataTypeable - , TemplateHaskell - , UndecidableInstances - , FlexibleContexts - , FlexibleInstances - #-} -module Language.Haskell.Tools.AST.SemaInfoTypes where +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE DeriveTraversable #-} -import Name as GHC +module Language.Haskell.Tools.AST.SemaInfoTypes + ( -- types + NoSemanticInfo, ScopeInfo, NameInfo, CNameInfo, ModuleInfo, ImportInfo, ImplicitFieldInfo + , Scope, UsageSpec(..), LiteralInfo(..), PreLiteralInfo(..) + -- references + , exprScopedLocals, nameScopedLocals, nameIsDefined, nameInfo, ambiguousName, nameLocation + , implicitName, cnameScopedLocals, cnameIsDefined, cnameInfo, cnameFixity + , defModuleName, defDynFlags, defIsBootModule, implicitNames, importedModule, availableNames + , importedNames, implicitFieldBindings, prelTransMods, importTransMods, literalType + -- creator functions + , mkNoSemanticInfo, mkScopeInfo, mkNameInfo, mkAmbiguousNameInfo, mkImplicitNameInfo, mkCNameInfo + , mkModuleInfo, mkImportInfo, mkImplicitFieldInfo + -- utils + , PName(..), pName, pNameParent, trfPNames, trfPNamesM, trfImportInfo, trfImportInfoM, trfModuleInfoM + , getInstances + ) where + import BasicTypes as GHC +import DynFlags as GHC +import FamInstEnv as GHC +import qualified GHC import Id as GHC +import Var +import InstEnv as GHC import Module as GHC -import SrcLoc as GHC +import Name as GHC import RdrName as GHC -import Outputable as GHC - -import Data.List -import Data.Data +import SrcLoc as GHC +import Type as GHC +import HscTypes as GHC +import CoAxiom as GHC +import HsExtension (IdP) +import Data.Data as Data import Control.Reference +import Control.Monad.IO.Class -type Scope = [[Name]] +type Scope = [[(Name, Maybe [UsageSpec], Maybe Name)]] --- | Semantic info type for any node not +data UsageSpec = UsageSpec { usageQualified :: Bool + , usageQualifier :: String + , usageAs :: String + } + deriving Data + +-- | Semantic info type for any node not -- carrying additional semantic information -data NoSemanticInfo = NoSemanticInfo - deriving (Eq, Data) +data NoSemanticInfo = NoSemanticInfo + deriving 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) + deriving Data +-- | Creates the information about the definitions in scope +mkScopeInfo :: Scope -> ScopeInfo +mkScopeInfo = ScopeInfo + +data PreLiteralInfo = RealLiteralInfo { _realLiteralType :: Type + } + | PreLiteralInfo { _preLiteralLoc :: SrcSpan + } + deriving Data + +data LiteralInfo = LiteralInfo { _literalType :: Type + } + deriving Data + -- | Info corresponding to a name data NameInfo n = NameInfo { _nameScopedLocals :: Scope , _nameIsDefined :: Bool - , _nameInfo :: n - } + , _nameInfo :: IdP n + } | AmbiguousNameInfo { _nameScopedLocals :: Scope , _nameIsDefined :: Bool , _ambiguousName :: RdrName - , _ambiguousLocation :: SrcSpan + , _nameLocation :: SrcSpan } | ImplicitNameInfo { _nameScopedLocals :: Scope , _nameIsDefined :: Bool , _implicitName :: String - , _implicitLocation :: SrcSpan + , _nameLocation :: SrcSpan } - deriving (Eq, Data) +deriving instance (Data n, Typeable n, Data (IdP n)) => Data (NameInfo n) +-- deriving instance Functor NameInfo +-- deriving instance Foldable NameInfo +-- deriving instance Traversable NameInfo +-- | Creates semantic information for an unambiguous name +mkNameInfo :: Scope -> Bool -> IdP n -> NameInfo n +mkNameInfo = NameInfo + +-- | Creates semantic information for a name that is ambiguous because the lack of type info +mkAmbiguousNameInfo :: Scope -> Bool -> RdrName -> SrcSpan -> NameInfo n +mkAmbiguousNameInfo = AmbiguousNameInfo + +-- | Creates semantic information for an implicit name +mkImplicitNameInfo :: Scope -> Bool -> String -> SrcSpan -> NameInfo n +mkImplicitNameInfo = ImplicitNameInfo + -- | Info corresponding to a name that is correctly identified data CNameInfo = CNameInfo { _cnameScopedLocals :: Scope , _cnameIsDefined :: Bool , _cnameInfo :: Id , _cnameFixity :: Maybe GHC.Fixity } - deriving (Eq, Data) + deriving Data +-- | Create a typed name semantic information +mkCNameInfo :: Scope -> Bool -> Id -> Maybe GHC.Fixity -> CNameInfo +mkCNameInfo = CNameInfo + +data PName n + = PName { _pName :: IdP n + , _pNameParent :: Maybe (IdP n) + } + +deriving instance (Data n, Typeable n, Data (IdP n)) => Data (PName n) + +trfPNames :: (IdP n -> IdP n') -> PName n -> PName n' +trfPNames f (PName name parent) = PName (f name) (fmap f parent) + +trfPNamesM :: Monad m => (IdP n -> m (IdP n')) -> PName n -> m (PName n') +trfPNamesM f (PName name (Just parent)) = PName <$> f name <*> (Just <$> f parent) +trfPNamesM f (PName name Nothing) = PName <$> f name <*> return Nothing + -- | 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 - } - deriving (Eq, Data) + , _implicitNames :: [PName n] -- ^ implicitly imported names + , _prelTransMods :: [GHC.Module] -- ^ Modules imported transitively. + } +trfModuleInfoM :: Monad m => (IdP n -> m (IdP n')) -> ModuleInfo n -> m (ModuleInfo n') +trfModuleInfoM f (ModuleInfo mn df bm impl tm) + = ModuleInfo mn df bm <$> mapM (trfPNamesM f) impl <*> return tm + +deriving instance (Data n, Typeable n, Data (IdP n)) => Data (ModuleInfo n) + +instance Data DynFlags where + gunfold _ _ _ = error "Cannot construct dyn flags" + toConstr _ = dynFlagsCon + dataTypeOf _ = dynFlagsType + +dynFlagsType = mkDataType "DynFlags.DynFlags" [dynFlagsCon] +dynFlagsCon = mkConstr dynFlagsType "DynFlags" [] Data.Prefix + +-- | Creates semantic information for the module element. +-- Strict in the list of implicitely imported, orphan and family instances. +mkModuleInfo :: GHC.Module -> DynFlags -> Bool -> [PName n] -> [GHC.Module] -> ModuleInfo n +-- the calculate of these fields involves a big parts of the GHC state and it causes a space leak +-- if not evaluated strictly +mkModuleInfo mod dfs boot !imported deps = ModuleInfo mod dfs boot imported deps + -- | 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. - } - deriving (Eq, Data) + , _availableNames :: [IdP n] -- ^ Names available from the imported module + , _importedNames :: [PName n] -- ^ Names actually imported from the module. + , _importTransMods :: [GHC.Module] -- ^ Modules imported transitively. + } --- | Info corresponding to an record-wildcard -data ImplicitFieldInfo = ImplicitFieldInfo { _implicitFieldBindings :: [(Name, Name)] -- ^ The implicitely bounded names - } - deriving (Eq, Data) +trfImportInfo :: (IdP n -> IdP n') -> ImportInfo n -> ImportInfo n' +trfImportInfo f (ImportInfo mod avail imp trm) + = ImportInfo mod (map f avail) (map (trfPNames f) imp) trm -instance Show ScopeInfo where - show (ScopeInfo locals) = "(ScopeInfo " ++ showSDocUnsafe (ppr locals) ++ ")" +trfImportInfoM :: Monad m => (IdP n -> m (IdP n')) -> ImportInfo n -> m (ImportInfo n') +trfImportInfoM f (ImportInfo mod avail imp trm) + = ImportInfo mod <$> (mapM f avail) <*> (mapM (trfPNamesM f) imp) <*> return trm -instance Outputable n => Show (NameInfo n) where - show (NameInfo locals defined nameInfo) = "(NameInfo " ++ showSDocUnsafe (ppr locals) ++ " " ++ show defined ++ " " ++ showSDocUnsafe (ppr nameInfo) ++ ")" - show (AmbiguousNameInfo locals defined nameInfo span) = "(AmbiguousNameInfo " ++ showSDocUnsafe (ppr locals) ++ " " ++ show defined ++ " " ++ showSDocUnsafe (ppr nameInfo) ++ " " ++ show span ++ ")" - show (ImplicitNameInfo locals defined nameInfo span) = "(ImplicitNameInfo " ++ showSDocUnsafe (ppr locals) ++ " " ++ show defined ++ " " ++ showSDocUnsafe (ppr nameInfo) ++ " " ++ show span ++ ")" +deriving instance (Data n, Typeable n, Data (IdP n)) => Data (ImportInfo n) -instance Show CNameInfo where - show (CNameInfo locals defined nameInfo fixity) = "(CNameInfo " ++ showSDocUnsafe (ppr locals) ++ " " ++ show defined ++ " " ++ showSDocUnsafe (ppr nameInfo) ++ showSDocUnsafe (ppr fixity) ++ ")" +deriving instance Data FamInst +deriving instance Data FamFlavor -instance Outputable n => Show (ModuleInfo n) where - show (ModuleInfo mod isboot imp) = "(ModuleInfo " ++ showSDocUnsafe (ppr mod) ++ " " ++ show isboot ++ " " ++ showSDocUnsafe (ppr imp) ++ ")" +-- | Creates semantic information for an import declaration +-- Strict in the list of the used and imported declarations, orphan and family instances. +mkImportInfo :: GHC.Module -> [IdP n] -> [PName n] -> [GHC.Module] -> ImportInfo n +-- the calculate of these fields involves a big parts of the GHC state and it causes a space leak +-- if not evaluated strictly +mkImportInfo mod !names !imported deps = ImportInfo mod names imported deps -instance Outputable n => Show (ImportInfo n) where - show (ImportInfo mod avail imported) = "(ImportInfo " ++ showSDocUnsafe (ppr mod) ++ " " ++ showSDocUnsafe (ppr avail) ++ " " ++ showSDocUnsafe (ppr imported) ++ ")" +-- | Gets the class and family instances from a module. +getInstances :: GHC.GhcMonad m => [GHC.Module] -> m ([ClsInst], [FamInst]) +getInstances mods = do + env <- GHC.getSession + eps <- liftIO $ hscEPS env + let (hptInsts, hptFamInsts) = hptInstances env (`elem` map GHC.moduleName mods) + isFromMods inst = maybe False (`elem` mods) $ nameModule_maybe $ Var.varName $ is_dfun inst + famIsFromMods inst = maybe False (`elem` mods) $ nameModule_maybe $ co_ax_name $ fi_axiom inst + epsInsts = filter isFromMods $ instEnvElts $ eps_inst_env eps + epsFamInsts = filter famIsFromMods $ famInstEnvElts $ eps_fam_inst_env eps + return (hptInsts ++ epsInsts, hptFamInsts ++ epsFamInsts) -instance Show ImplicitFieldInfo where - show (ImplicitFieldInfo bnds) = "(ImplicitFieldInfo [" ++ concat (intersperse "," (map (\(from,to) -> showSDocUnsafe (ppr from) ++ "->" ++ showSDocUnsafe (ppr to)) bnds)) ++ "])" +-- | Info corresponding to a record-wildcard +data ImplicitFieldInfo = ImplicitFieldInfo { _implicitFieldBindings :: [(Name, Name)] -- ^ The implicitly bounded names + } + deriving Data -instance Show NoSemanticInfo where - show NoSemanticInfo = "NoSemanticInfo" +-- | Creates semantic information for a wildcard field binding +mkImplicitFieldInfo :: [(Name, Name)] -> ImplicitFieldInfo +mkImplicitFieldInfo = ImplicitFieldInfo -makeReferences ''NoSemanticInfo +makeReferences ''PName makeReferences ''ScopeInfo makeReferences ''NameInfo makeReferences ''CNameInfo makeReferences ''ModuleInfo makeReferences ''ImportInfo makeReferences ''ImplicitFieldInfo - --- | Semantic and source code related information for an AST node. -data NodeInfo sema src - = NodeInfo { _semanticInfo :: sema - , _sourceInfo :: src - } - deriving (Eq, Show, Data) - -makeReferences ''NodeInfo+makeReferences ''LiteralInfo
− Language/Haskell/Tools/AST/Stmts.hs
@@ -1,38 +0,0 @@--- | Representation of Haskell statements (both do-notation and comprehensions) -module Language.Haskell.Tools.AST.Stmts where - -import Language.Haskell.Tools.AST.Ann -import Language.Haskell.Tools.AST.Base -import Language.Haskell.Tools.AST.Patterns -import {-# SOURCE #-} Language.Haskell.Tools.AST.Exprs (Expr, Cmd) -import {-# SOURCE #-} Language.Haskell.Tools.AST.Binds (LocalBind) - --- | Normal monadic statements -data Stmt' expr dom stage - = BindStmt { _stmtPattern :: Ann Pattern dom stage - , _stmtExpr :: Ann expr dom stage - } -- ^ Binding statement (@ x <- action @) - | ExprStmt { _stmtExpr :: Ann expr dom stage - } -- ^ Non-binding statement (@ action @) - | LetStmt { _stmtBinds :: AnnList LocalBind dom stage - } -- ^ Let statement (@ let x = 3; y = 4 @) - | RecStmt { _cmdStmtBinds :: AnnList (Stmt' expr) dom stage - } -- ^ A recursive binding statement with (@ rec b <- f a c; c <- f b a @) -type Stmt = Stmt' Expr - --- | Body of a list comprehension: (@ | x <- [1..10] @) -data ListCompBody dom stage - = ListCompBody { _compStmts :: AnnList CompStmt dom stage - } - --- | List comprehension statement -data CompStmt dom stage - = CompStmt { _compStmt :: Ann Stmt dom stage - } -- ^ Normal monadic statement of a list comprehension - | ThenStmt { _thenExpr :: Ann Expr dom stage - , _byExpr :: AnnMaybe Expr dom stage - } -- ^ Then statements by @TransformListComp@ (@ then sortWith by (x + y) @) - | GroupStmt { _byExpr :: AnnMaybe Expr dom stage - , _usingExpr :: AnnMaybe Expr dom stage - } -- ^ Grouping statements by @TransformListComp@ (@ then group by (x + y) using groupWith @) - -- Note: either byExpr or usingExpr must have a value
− Language/Haskell/Tools/AST/TH.hs
@@ -1,41 +0,0 @@--- | Representation of Template Haskell AST elements -module Language.Haskell.Tools.AST.TH where - -import Language.Haskell.Tools.AST.Decls -import Language.Haskell.Tools.AST.Binds -import Language.Haskell.Tools.AST.Exprs -import Language.Haskell.Tools.AST.Patterns -import Language.Haskell.Tools.AST.Types -import Language.Haskell.Tools.AST.Base -import Language.Haskell.Tools.AST.Ann - --- | A template haskell splice -data Splice dom stage - = IdSplice { _spliceId :: Ann Name dom stage - } -- ^ A simple name splice: @$generateX@ - | ParenSplice { _spliceExpr :: Ann Expr dom stage - } -- ^ A splice with parentheses: @$(generate input)@ - --- | Template haskell quasi-quotation: @[quoter|str]@ -data QuasiQuote dom stage - = QuasiQuote { _qqExprName :: Ann Name dom stage - , _qqExprBody :: Ann QQString dom stage - } - --- | Template Haskell Quasi-quotation content -data QQString dom stage - = QQString { _qqString :: String - } - - --- | Template Haskell bracket expressions -data Bracket dom stage - = ExprBracket { _bracketExpr :: Ann Expr dom stage - } -- ^ Expression bracket (@ [| x + y |] @) - | PatternBracket { _bracketPattern :: Ann Pattern dom stage - } -- ^ Pattern bracket (@ [| Point x y |] @) - | TypeBracket { _bracketType :: Ann Type dom stage - } -- ^ Pattern bracket (@ [| (Int,Int) |] @) - | DeclsBracket { _bracketDecl :: AnnList Decl dom stage - } -- ^ Declaration bracket (@ [| _f :: Int -> Int; f x = x*x |] @) -
− Language/Haskell/Tools/AST/TH.hs-boot
@@ -1,11 +0,0 @@-{-# LANGUAGE RoleAnnotations #-} -module Language.Haskell.Tools.AST.TH where - -type role Splice nominal nominal -data Splice dom stage - -type role QuasiQuote nominal nominal -data QuasiQuote dom stage - -type role Bracket nominal nominal -data Bracket dom stage
Language/Haskell/Tools/AST/TH/SemanticTraversal.hs view
@@ -1,28 +1,27 @@-{-# LANGUAGE LambdaCase - , CPP - , TemplateHaskell - #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TemplateHaskellQuotes #-} + -- | Generating instances for traversal on semantic information module Language.Haskell.Tools.AST.TH.SemanticTraversal where -import Control.Monad +import Control.Monad (Monad(..), mapM, replicateM) +import Language.Haskell.TH.Ppr (pprint) import Language.Haskell.TH.Syntax -import Language.Haskell.TH.Ppr -import Language.Haskell.Tools.AST.Ann +import Language.Haskell.Tools.AST.Ann (SemanticTraversal(..)) -- | Generate the instances for semantic information deriveSemanticTraversal :: Name -> Q [Dec] deriveSemanticTraversal nm = reify nm >>= \case TyConI dt -> case dt of - DataD _ tyConName typArgs _ dataCons _ -> - createInstance tyConName typArgs dataCons - NewtypeD _ tyConName typArgs _ dataCon _ -> - createInstance tyConName typArgs [dataCon] + DataD _ tyConName typArgs _ dataCons _ -> + createInstance tyConName typArgs dataCons + NewtypeD _ tyConName typArgs _ dataCon _ -> + createInstance tyConName typArgs [dataCon] _ -> fail "Unsupported data type" _ -> fail "Expected the name of a data type or newtype" - + createInstance :: Name -> [TyVarBndr] -> [Con] -> Q [Dec] -createInstance tyConName typArgs dataCons +createInstance tyConName typArgs dataCons = do clauses <- mapM createClause dataCons return [InstanceD Nothing (map (AppT (ConT className) . VarT) astParams) (AppT (ConT className) (foldl AppT (ConT tyConName) (map VarT astParams))) @@ -32,11 +31,12 @@ createClause (RecC conName conArgs) = createClause' conName (map (\(_,_,t) -> t) conArgs) createClause (NormalC conName conArgs) = createClause' conName (map snd conArgs) createClause (InfixC conArg1 conName conArg2) = createClause' conName [snd conArg1, snd conArg2] - + createClause _ = error "createClause: forall and GADT constructors are not supported" + createClause' :: Name -> [Type] -> Q Clause createClause' conName args = do bindedNames <- replicateM (length args) (newName "p") - return $ Clause [ VarP trf, ConP conName (map VarP bindedNames) ] + return $ Clause [ VarP trf, ConP conName (map VarP bindedNames) ] (NormalB (createExpr conName (zipWith processParam bindedNames args))) [] (tstage:tdom:_) = map getTyVar $ reverse typArgs @@ -48,21 +48,21 @@ createExpr ctrName [] = AppE applPure $ ConE ctrName createExpr ctrName (param1:params) - = foldl (\coll new -> InfixE (Just coll) applStar (Just new)) + = foldl (\coll new -> InfixE (Just coll) applStar (Just new)) (InfixE (Just $ ConE ctrName) applDollar (Just param1)) params - + applStar = VarE (mkName "Control.Applicative.<*>") applDollar = VarE (mkName "Control.Applicative.<$>") applPure = VarE (mkName "Control.Applicative.pure") - + className = ''SemanticTraversal funName = 'semaTraverse trf = mkName "f" - + -- | Creates the expression and the predicate for a parameter processParam :: Name -> Type -> Exp - processParam arg (AppT (AppT t (VarT dom)) (VarT stage)) | dom == tdom && stage == tstage + processParam arg (AppT (AppT _ (VarT dom)) (VarT stage)) | dom == tdom && stage == tstage = AppE (AppE (VarE funName) (VarE trf)) (VarE arg) processParam arg _ = AppE applPure (VarE arg) @@ -73,4 +73,4 @@ thExamine :: Q [Dec] -> Q [Dec] thExamine decl = do d <- decl runIO (putStrLn (pprint d)) - return d+ return d
Language/Haskell/Tools/AST/TH/SourceInfoTraversal.hs view
@@ -1,28 +1,27 @@-{-# LANGUAGE LambdaCase - , CPP - , TemplateHaskell - #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TemplateHaskellQuotes #-} + -- | Generating instances for traversal on semantic information module Language.Haskell.Tools.AST.TH.SourceInfoTraversal where -import Control.Monad +import Control.Monad (Monad(..), mapM, replicateM) +import Language.Haskell.TH.Ppr (pprint) import Language.Haskell.TH.Syntax -import Language.Haskell.TH.Ppr -import Language.Haskell.Tools.AST.Ann +import Language.Haskell.Tools.AST.Ann (SourceInfoTraversal(..)) -- | Generate the instances for semantic information deriveSourceInfoTraversal :: Name -> Q [Dec] deriveSourceInfoTraversal nm = reify nm >>= \case TyConI dt -> case dt of - DataD _ tyConName typArgs _ dataCons _ -> - createInstance tyConName typArgs dataCons - NewtypeD _ tyConName typArgs _ dataCon _ -> - createInstance tyConName typArgs [dataCon] + DataD _ tyConName typArgs _ dataCons _ -> + createInstance tyConName typArgs dataCons + NewtypeD _ tyConName typArgs _ dataCon _ -> + createInstance tyConName typArgs [dataCon] _ -> fail "Unsupported data type" _ -> fail "Expected the name of a data type or newtype" - + createInstance :: Name -> [TyVarBndr] -> [Con] -> Q [Dec] -createInstance tyConName typArgs dataCons +createInstance tyConName typArgs dataCons = do simpleClauses <- mapM (createClause simpleFunName False) dataCons upClauses <- mapM (createClause upFunName True) dataCons downClauses <- mapM (createClause downFunName True) dataCons @@ -34,7 +33,8 @@ createClause funName updown (RecC conName conArgs) = createClause' funName updown conName (map (\(_,_,t) -> t) conArgs) createClause funName updown (NormalC conName conArgs) = createClause' funName updown conName (map snd conArgs) createClause funName updown (InfixC conArg1 conName conArg2) = createClause' funName updown conName [snd conArg1, snd conArg2] - + createClause _ _ _ = error "createClause: forall and GADT constructors are not supported" + createClause' :: Name -> Bool -> Name -> [Type] -> Q Clause createClause' funName updown conName args = do bindedNames <- replicateM (length args) (newName "p") @@ -48,14 +48,14 @@ createExpr ctrName [] = AppE applPure $ ConE ctrName createExpr ctrName (param1:params) - = foldl (\coll new -> InfixE (Just coll) applStar (Just new)) + = foldl (\coll new -> InfixE (Just coll) applStar (Just new)) (InfixE (Just $ ConE ctrName) applDollar (Just param1)) params - + applStar = VarE (mkName "Control.Applicative.<*>") applDollar = VarE (mkName "Control.Applicative.<$>") applPure = VarE (mkName "Control.Applicative.pure") - + className = ''SourceInfoTraversal simpleFunName = 'sourceInfoTraverse upFunName = 'sourceInfoTraverseUp @@ -63,10 +63,10 @@ trf = mkName "trf" desc = mkName "desc" asc = mkName "asc" - + -- | Creates the expression and the predicate for a parameter processParam :: Name -> Bool -> Name -> Type -> Exp - processParam funName updown arg (AppT (AppT t (VarT dom)) (VarT stage)) | dom == tdom && stage == tstage + processParam funName updown arg (AppT (AppT _ (VarT dom)) (VarT stage)) | dom == tdom && stage == tstage = AppE (wrapUpdown $ AppE (VarE funName) (VarE trf)) (VarE arg) where wrapUpdown | updown = flip AppE (VarE asc) . flip AppE (VarE desc) | otherwise = id @@ -79,4 +79,4 @@ thExamine :: Q [Dec] -> Q [Dec] thExamine decl = do d <- decl runIO (putStrLn (pprint d)) - return d+ return d
− Language/Haskell/Tools/AST/Types.hs
@@ -1,87 +0,0 @@--- | Representation of Haskell types -module Language.Haskell.Tools.AST.Types where - -import Language.Haskell.Tools.AST.Ann -import Language.Haskell.Tools.AST.Literals -import Language.Haskell.Tools.AST.Base -import Language.Haskell.Tools.AST.Kinds -import {-# SOURCE #-} Language.Haskell.Tools.AST.TH - --- | Type variable declaration -data TyVar dom stage - = TyVarDecl { _tyVarName :: Ann Name dom stage - , _tyVarKind :: AnnMaybe KindConstraint dom stage - } - --- | Haskell types -data Type dom stage - = TyForall { _typeBounded :: AnnList TyVar dom stage - , _typeType :: Ann Type dom stage - } -- ^ Forall types (@ forall x y . type @) - | TyCtx { _typeCtx :: Ann Context dom stage - , _typeType :: Ann Type dom stage - } -- ^ Type with a context (@ forall x y . type @) - | TyFun { _typeParam :: Ann Type dom stage - , _typeResult :: Ann Type dom stage - } -- ^ Function types (@ a -> b @) - | TyTuple { _typeElements :: AnnList Type dom stage - } -- ^ Tuple types (@ (a,b) @) - | TyUnbTuple { _typeElements :: AnnList Type dom stage - } -- ^ Unboxed tuple types (@ (#a,b#) @) - | TyList { _typeElement :: Ann Type dom stage - } -- ^ List type with special syntax (@ [a] @) - | TyParArray { _typeElement :: Ann Type dom stage - } -- ^ Parallel array type (@ [:a:] @) - | TyApp { _typeCon :: Ann Type dom stage - , _typeArg :: Ann Type dom stage - } -- ^ Type application (@ F a @) - | TyVar { _typeName :: Ann Name dom stage - } -- ^ type variable or constructor (@ a @) - | TyParen { _typeInner :: Ann Type dom stage - } -- ^ type surrounded by parentheses (@ (T a) @) - | TyInfix { _typeLeft :: Ann Type dom stage - , _typeOperator :: Ann Operator dom stage - , _typeRight :: Ann Type dom stage - } -- ^ Infix type constructor (@ (a <: b) @) - | TyKinded { _typeInner :: Ann Type dom stage - , _typeKind :: Ann Kind dom stage - } -- ^ Type with explicit kind signature (@ _a :: * @) - | TyPromoted { _tpPromoted :: Ann (Promoted Type) dom stage - } -- A promoted data type with @-XDataKinds@ (@ 3 @, @ Left @, @ 'Left @). - | TySplice { _tsSplice :: Splice dom stage - } -- ^ a Template Haskell splice type (@ $(genType) @). - | TyQuasiQuote { _typeQQ :: QuasiQuote dom stage - } -- ^ a Template Haskell quasi-quote type (@ [quoter| ... ] @). - | TyBang { _typeInner :: Ann Type dom stage - } -- ^ Strict type marked with @!@. - | TyLazy { _typeInner :: Ann Type dom stage - } -- ^ Lazy type marked with @~@. (Should only be used if @Strict@ or @StrictData@ language extension is used) - | TyUnpack { _typeInner :: Ann Type dom stage - } -- ^ Strict type marked with UNPACK pragma. (Usually contains the bang mark.) - | TyNoUnpack { _typeInner :: Ann Type dom stage - } -- ^ Strict type marked with NOUNPACK pragma. (Usually contains the bang mark.) - | TyWildcard -- ^ A wildcard type (@ _ @) with @-XPartialTypeSignatures@ - | TyNamedWildc { _typeWildcardName :: Ann Name dom stage - } -- ^ A named wildcard type (@ _t @) with @-XPartialTypeSignatures@ - --- One or more assertions -data Context dom stage - = ContextOne { _contextAssertion :: Ann Assertion dom stage - } -- ^ One assertion (@ C a => ... @) - | ContextMulti { _contextAssertions :: AnnList Assertion dom stage - } -- ^ A set of assertions (@ (C1 a, C2 b) => ... @, but can be one: @ (C a) => ... @) - --- | A single assertion in the context -data Assertion dom stage - = ClassAssert { _assertClsName :: Ann Name dom stage - , _assertTypes :: AnnList Type dom stage - } -- ^ Class assertion (@Cls x@) - | InfixAssert { _assertLhs :: Ann Type dom stage - , _assertOp :: Ann Operator dom stage - , _assertRhs :: Ann Type dom stage - } -- ^ Infix class assertion, also contains type equations (@ a ~ X y @) - | ImplicitAssert { _assertImplVar :: Ann Name dom stage - , _assertImplType :: Ann Type dom stage - } -- ^ Assertion for implicit parameter binding (@ ?cmp :: a -> a -> Bool @) - -
Language/Haskell/Tools/AST/Utils/GHCInstances.hs view
@@ -1,19 +1,26 @@-{-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE StandaloneDeriving #-} + + module Language.Haskell.Tools.AST.Utils.GHCInstances where import Data.Data import SrcLoc deriving instance Data SrcLoc - + instance Data RealSrcLoc where gfoldl k z rsl = z mkRealSrcLoc `k` srcLocFile rsl `k` srcLocLine rsl `k` srcLocCol rsl gunfold k z c = case constrIndex c of 1 -> k (k (k (z mkRealSrcLoc))) + _ -> error "gunfold: has only 1 constructor" toConstr _ = con_RSL dataTypeOf _ = ty_RSL +con_RSL :: Constr con_RSL = mkConstr ty_RSL "RSL" [] Prefix + +ty_RSL :: DataType ty_RSL = mkDataType "SrcLoc.RealSrcLoc" [con_RSL]
− Language/Haskell/Tools/AST/Utils/OrdSrcSpan.hs
@@ -1,30 +0,0 @@--- | A wrapper for SrcSpans that is ordered. -module Language.Haskell.Tools.AST.Utils.OrdSrcSpan where - -import SrcLoc -import FastString - --- | 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) -
haskell-tools-ast.cabal view
@@ -1,5 +1,5 @@ name: haskell-tools-ast -version: 0.2.0.0 +version: 1.1.1.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,40 +13,44 @@ cabal-version: >=1.10 library - exposed-modules: Language.Haskell.Tools.AST - , Language.Haskell.Tools.AST.Modules - , Language.Haskell.Tools.AST.TH - , Language.Haskell.Tools.AST.Decls - , Language.Haskell.Tools.AST.Binds - , Language.Haskell.Tools.AST.Exprs - , Language.Haskell.Tools.AST.Stmts - , Language.Haskell.Tools.AST.Patterns - , Language.Haskell.Tools.AST.Types - , Language.Haskell.Tools.AST.Kinds - , Language.Haskell.Tools.AST.Literals - , Language.Haskell.Tools.AST.Base + 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 - + + other-modules: Language.Haskell.Tools.AST.Representation.Modules + , Language.Haskell.Tools.AST.Representation.TH + , Language.Haskell.Tools.AST.Representation.Decls + , Language.Haskell.Tools.AST.Representation.Binds + , Language.Haskell.Tools.AST.Representation.Exprs + , Language.Haskell.Tools.AST.Representation.Stmts + , Language.Haskell.Tools.AST.Representation.Patterns + , Language.Haskell.Tools.AST.Representation.Types + , Language.Haskell.Tools.AST.Representation.Kinds + , Language.Haskell.Tools.AST.Representation.Literals + , Language.Haskell.Tools.AST.Representation.Names + + , Language.Haskell.Tools.AST.MakeASTReferences + , Language.Haskell.Tools.AST.Utils.GHCInstances + , Language.Haskell.Tools.AST.Instances - , Language.Haskell.Tools.AST.Instances.Eq - , Language.Haskell.Tools.AST.Instances.Show , Language.Haskell.Tools.AST.Instances.Data , Language.Haskell.Tools.AST.Instances.Generic + , Language.Haskell.Tools.AST.Instances.ClassyPlate , Language.Haskell.Tools.AST.Instances.SemanticTraversal , Language.Haskell.Tools.AST.Instances.SourceInfoTraversal , Language.Haskell.Tools.AST.TH.SemanticTraversal , Language.Haskell.Tools.AST.TH.SourceInfoTraversal - , Language.Haskell.Tools.AST.References - , Language.Haskell.Tools.AST.Helpers - , Language.Haskell.Tools.AST.Utils.OrdSrcSpan - , Language.Haskell.Tools.AST.Utils.GHCInstances - - build-depends: base >=4.9 && <5.0 - , ghc >=8.0 && <8.1 - , references >=0.3.2 && <1.0 - , uniplate >=1.6 && <2.0 - , mtl >=2.2 && <3.0 - , template-haskell >=2.11 && <3.0 - default-language: Haskell2010+ + build-depends: base >= 4.11 && < 4.13 + , ghc >= 8.4 && < 8.7 + , references >= 0.3 && < 0.4 + , uniplate >= 1.6 && < 1.7 + , mtl >= 2.2 && < 2.3 + , template-haskell >= 2.13 && < 2.15 + , classyplate >= 0.3 && < 0.4 + , pretty >= 1.1 && < 1.2 + default-language: Haskell2010