module Language.Haskell.Tools.AST.SemaInfoTypes
(
NoSemanticInfo, ScopeInfo, NameInfo, CNameInfo, ModuleInfo, ImportInfo, ImplicitFieldInfo
, Scope
, exprScopedLocals, nameScopedLocals, nameIsDefined, nameInfo, ambiguousName, nameLocation
, implicitName, cnameScopedLocals, cnameIsDefined, cnameInfo, cnameFixity
, defModuleName, defIsBootModule, implicitNames, importedModule, availableNames, importedNames
, implicitFieldBindings, importedOrphanInsts, importedFamInsts, prelOrphanInsts, prelFamInsts
, mkNoSemanticInfo, mkScopeInfo, mkNameInfo, mkAmbiguousNameInfo, mkImplicitNameInfo, mkCNameInfo
, mkModuleInfo, mkImportInfo, mkImplicitFieldInfo
) where
import BasicTypes as GHC
import FamInstEnv as GHC
import Id as GHC
import InstEnv as GHC
import Module as GHC
import Name as GHC
import Outputable as GHC
import RdrName as GHC
import SrcLoc as GHC
import Data.Data
import Data.List
import Control.Reference
type Scope = [[Name]]
data NoSemanticInfo = NoSemanticInfo
deriving (Eq, Data)
mkNoSemanticInfo :: NoSemanticInfo
mkNoSemanticInfo = NoSemanticInfo
data ScopeInfo = ScopeInfo { _exprScopedLocals :: Scope
}
deriving (Eq, Data)
mkScopeInfo :: Scope -> ScopeInfo
mkScopeInfo = ScopeInfo
data NameInfo n = NameInfo { _nameScopedLocals :: Scope
, _nameIsDefined :: Bool
, _nameInfo :: n
}
| AmbiguousNameInfo { _nameScopedLocals :: Scope
, _nameIsDefined :: Bool
, _ambiguousName :: RdrName
, _nameLocation :: SrcSpan
}
| ImplicitNameInfo { _nameScopedLocals :: Scope
, _nameIsDefined :: Bool
, _implicitName :: String
, _nameLocation :: SrcSpan
}
deriving (Eq, Data)
mkNameInfo :: Scope -> Bool -> n -> NameInfo n
mkNameInfo = NameInfo
mkAmbiguousNameInfo :: Scope -> Bool -> RdrName -> SrcSpan -> NameInfo n
mkAmbiguousNameInfo = AmbiguousNameInfo
mkImplicitNameInfo :: Scope -> Bool -> String -> SrcSpan -> NameInfo n
mkImplicitNameInfo = ImplicitNameInfo
data CNameInfo = CNameInfo { _cnameScopedLocals :: Scope
, _cnameIsDefined :: Bool
, _cnameInfo :: Id
, _cnameFixity :: Maybe GHC.Fixity
}
deriving (Eq, Data)
mkCNameInfo :: Scope -> Bool -> Id -> Maybe GHC.Fixity -> CNameInfo
mkCNameInfo = CNameInfo
data ModuleInfo n = ModuleInfo { _defModuleName :: GHC.Module
, _defIsBootModule :: Bool
, _implicitNames :: [n]
, _prelOrphanInsts :: [ClsInst]
, _prelFamInsts :: [FamInst]
}
deriving Data
mkModuleInfo :: GHC.Module -> Bool -> [n] -> [ClsInst] -> [FamInst] -> ModuleInfo n
mkModuleInfo = ModuleInfo
data ImportInfo n = ImportInfo { _importedModule :: GHC.Module
, _availableNames :: [n]
, _importedNames :: [n]
, _importedOrphanInsts :: [ClsInst]
, _importedFamInsts :: [FamInst]
}
deriving Data
deriving instance Data FamInst
deriving instance Data FamFlavor
mkImportInfo :: GHC.Module -> [n] -> [n] -> [ClsInst] -> [FamInst] -> ImportInfo n
mkImportInfo = ImportInfo
data ImplicitFieldInfo = ImplicitFieldInfo { _implicitFieldBindings :: [(Name, Name)]
}
deriving (Eq, Data)
mkImplicitFieldInfo :: [(Name, Name)] -> ImplicitFieldInfo
mkImplicitFieldInfo = ImplicitFieldInfo
instance Show ScopeInfo where
show (ScopeInfo locals) = "(ScopeInfo " ++ showSDocUnsafe (ppr locals) ++ ")"
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 ++ ")"
instance Show CNameInfo where
show (CNameInfo locals defined nameInfo fixity) = "(CNameInfo " ++ showSDocUnsafe (ppr locals) ++ " " ++ show defined ++ " " ++ showSDocUnsafe (ppr nameInfo) ++ showSDocUnsafe (ppr fixity) ++ ")"
instance Outputable n => Show (ModuleInfo n) where
show (ModuleInfo mod isboot imp clsInsts famInsts)
= "(ModuleInfo " ++ showSDocUnsafe (ppr mod) ++ " " ++ show isboot ++ " " ++ showSDocUnsafe (ppr imp) ++ " "
++ showSDocUnsafe (ppr clsInsts) ++ " " ++ showSDocUnsafe (ppr famInsts) ++ ")"
instance Outputable n => Show (ImportInfo n) where
show (ImportInfo mod avail imported clsInsts famInsts)
= "(ImportInfo " ++ showSDocUnsafe (ppr mod) ++ " " ++ showSDocUnsafe (ppr avail) ++ " " ++ showSDocUnsafe (ppr imported) ++ " "
++ showSDocUnsafe (ppr clsInsts) ++ " " ++ showSDocUnsafe (ppr famInsts) ++ ")"
instance Show ImplicitFieldInfo where
show (ImplicitFieldInfo bnds) = "(ImplicitFieldInfo [" ++ concat (intersperse "," (map (\(from,to) -> showSDocUnsafe (ppr from) ++ "->" ++ showSDocUnsafe (ppr to)) bnds)) ++ "])"
instance Show NoSemanticInfo where
show NoSemanticInfo = "NoSemanticInfo"
makeReferences ''NoSemanticInfo
makeReferences ''ScopeInfo
makeReferences ''NameInfo
makeReferences ''CNameInfo
makeReferences ''ModuleInfo
makeReferences ''ImportInfo
makeReferences ''ImplicitFieldInfo
instance Functor NameInfo where
fmap f = nameInfo .- f
instance Functor ModuleInfo where
fmap f = implicitNames .- map f
instance Functor ImportInfo where
fmap f (ImportInfo mod avail imps clsInsts famInsts) = ImportInfo mod (map f avail) (map f imps) clsInsts famInsts
instance Foldable NameInfo where
foldMap f si = maybe mempty f (si ^? nameInfo)
instance Foldable ModuleInfo where
foldMap f si = foldMap f (si ^. implicitNames)
instance Foldable ImportInfo where
foldMap f si = foldMap f ((si ^. availableNames) ++ (si ^. importedNames))
instance Traversable NameInfo where
traverse f (NameInfo locals defined nameInfo) = NameInfo locals defined <$> f nameInfo
traverse _ (AmbiguousNameInfo locals defined nameInfo span) = pure $ AmbiguousNameInfo locals defined nameInfo span
traverse _ (ImplicitNameInfo locals defined nameInfo span) = pure $ ImplicitNameInfo locals defined nameInfo span
instance Traversable ModuleInfo where
traverse f (ModuleInfo mod isboot imp clsInsts famInsts)
= ModuleInfo mod isboot <$> traverse f imp <*> pure clsInsts <*> pure famInsts
instance Traversable ImportInfo where
traverse f (ImportInfo mod avail imps clsInsts famInsts)
= ImportInfo mod <$> traverse f avail <*> traverse f imps <*> pure clsInsts <*> pure famInsts