{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveTraversable #-}
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, 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 Name as GHC
import RdrName as GHC
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, 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 :: IdP n
}
| AmbiguousNameInfo { _nameScopedLocals :: Scope
, _nameIsDefined :: Bool
, _ambiguousName :: RdrName
, _nameLocation :: SrcSpan
}
| ImplicitNameInfo { _nameScopedLocals :: Scope
, _nameIsDefined :: Bool
, _implicitName :: String
, _nameLocation :: SrcSpan
}
deriving instance (Data n, Typeable n, Data (IdP n)) => Data (NameInfo n)
mkNameInfo :: Scope -> Bool -> IdP 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 :: 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
data ModuleInfo n = ModuleInfo { _defModuleName :: GHC.Module
, _defDynFlags :: DynFlags
, _defIsBootModule :: Bool
, _implicitNames :: [PName n]
, _prelTransMods :: [GHC.Module]
}
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
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 :: [IdP n]
, _importedNames :: [PName n]
, _importTransMods :: [GHC.Module]
}
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
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
deriving instance (Data n, Typeable n, Data (IdP n)) => Data (ImportInfo n)
deriving instance Data FamInst
deriving instance Data FamFlavor
mkImportInfo :: GHC.Module -> [IdP n] -> [PName n] -> [GHC.Module] -> ImportInfo n
mkImportInfo mod !names !imported deps = ImportInfo mod names imported deps
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)
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