module Language.Haskell.Tools.AST.SemaInfoTypes
(
NoSemanticInfo, ScopeInfo, NameInfo, CNameInfo, ModuleInfo, ImportInfo, ImplicitFieldInfo
, Scope, UsageSpec(..), LiteralInfo(..), PreLiteralInfo(..)
, exprScopedLocals, nameScopedLocals, nameIsDefined, nameInfo, ambiguousName, nameLocation
, implicitName, cnameScopedLocals, cnameIsDefined, cnameInfo, cnameFixity
, defModuleName, defDynFlags, defIsBootModule, implicitNames, importedModule, availableNames
, importedNames, implicitFieldBindings, prelTransMods, importTransMods, literalType
, mkNoSemanticInfo, mkScopeInfo, mkNameInfo, mkAmbiguousNameInfo, mkImplicitNameInfo, mkCNameInfo
, mkModuleInfo, mkImportInfo, mkImplicitFieldInfo
, PName(..), pName, pNameParent
, 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 Name as GHC
import RdrName as GHC
import SrcLoc as GHC
import Type as GHC
import HscTypes as GHC
import CoAxiom as GHC
import Data.Maybe
import Data.Data as Data
import Control.Reference
import Control.Monad
import Control.Monad.IO.Class
import Outputable
type Scope = [[(Name, Maybe [UsageSpec], Maybe Name)]]
data UsageSpec = UsageSpec { usageQualified :: Bool
, usageQualifier :: String
, usageAs :: String
}
deriving Data
data NoSemanticInfo = NoSemanticInfo
deriving Data
mkNoSemanticInfo :: NoSemanticInfo
mkNoSemanticInfo = NoSemanticInfo
data ScopeInfo = ScopeInfo { _exprScopedLocals :: Scope
}
deriving Data
mkScopeInfo :: Scope -> ScopeInfo
mkScopeInfo = ScopeInfo
data PreLiteralInfo = RealLiteralInfo { _realLiteralType :: Type
}
| PreLiteralInfo { _preLiteralLoc :: SrcSpan
}
deriving Data
data LiteralInfo = LiteralInfo { _literalType :: Type
}
deriving Data
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 (Data, Functor, Foldable, Traversable)
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 Data
mkCNameInfo :: Scope -> Bool -> Id -> Maybe GHC.Fixity -> CNameInfo
mkCNameInfo = CNameInfo
data PName n
= PName { _pName :: n
, _pNameParent :: Maybe n
}
deriving (Data, Functor, Foldable, Traversable)
data ModuleInfo n = ModuleInfo { _defModuleName :: GHC.Module
, _defDynFlags :: DynFlags
, _defIsBootModule :: Bool
, _implicitNames :: [PName n]
, _prelTransMods :: [GHC.Module]
}
deriving (Data, Functor, Foldable, Traversable)
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
mkModuleInfo :: GHC.Module -> DynFlags -> Bool -> [PName n] -> [GHC.Module] -> ModuleInfo n
mkModuleInfo mod dfs boot !imported deps = ModuleInfo mod dfs boot imported deps
data ImportInfo n = ImportInfo { _importedModule :: GHC.Module
, _availableNames :: [n]
, _importedNames :: [PName n]
, _importTransMods :: [GHC.Module]
}
deriving (Data, Functor, Foldable, Traversable)
deriving instance Data FamInst
deriving instance Data FamFlavor
mkImportInfo :: GHC.Module -> [n] -> [PName n] -> [GHC.Module] -> ImportInfo n
mkImportInfo mod !names !imported deps = ImportInfo mod names imported deps
getInstances :: [Module] -> GHC.Ghc ([ClsInst], [FamInst])
getInstances mods = do
env <- GHC.getSession
eps <- liftIO $ hscEPS env
let homePkgs = catMaybes $ map (lookupHpt (hsc_HPT env) . GHC.moduleName) mods
(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)
data ImplicitFieldInfo = ImplicitFieldInfo { _implicitFieldBindings :: [(Name, Name)]
}
deriving Data
mkImplicitFieldInfo :: [(Name, Name)] -> ImplicitFieldInfo
mkImplicitFieldInfo = ImplicitFieldInfo
makeReferences ''PName
makeReferences ''ScopeInfo
makeReferences ''NameInfo
makeReferences ''CNameInfo
makeReferences ''ModuleInfo
makeReferences ''ImportInfo
makeReferences ''ImplicitFieldInfo
makeReferences ''LiteralInfo