{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Language.Haskell.Liquid.GHC.Plugin (
plugin
) where
import qualified Liquid.GHC.API as O
import Liquid.GHC.API as GHC hiding (Type)
import qualified Text.PrettyPrint.HughesPJ as PJ
import qualified Language.Fixpoint.Types as F
import qualified Language.Haskell.Liquid.GHC.Misc as LH
import qualified Language.Haskell.Liquid.UX.CmdLine as LH
import qualified Language.Haskell.Liquid.GHC.Interface as LH
import qualified Language.Haskell.Liquid.Liquid as LH
import qualified Language.Haskell.Liquid.Types.PrettyPrint as LH ( filterReportErrors
, filterReportErrorsWith
, defaultFilterReporter
, reduceFilters )
import qualified Language.Haskell.Liquid.GHC.Logging as LH (addTcRnUnknownMessages)
import Language.Haskell.Liquid.GHC.Plugin.Types
import Language.Haskell.Liquid.GHC.Plugin.Util as Util
import Language.Haskell.Liquid.GHC.Plugin.SpecFinder
as SpecFinder
import Language.Haskell.Liquid.GHC.Types (MGIModGuts(..), miModGuts)
import GHC.LanguageExtensions
import Control.Monad
import qualified Control.Monad.Catch as Ex
import Control.Monad.IO.Class (MonadIO)
import Data.Coerce
import Data.Function ((&))
import Data.Kind ( Type )
import Data.List as L
hiding ( intersperse )
import Data.IORef
import qualified Data.Set as S
import Data.Set ( Set )
import qualified Data.HashSet as HS
import qualified Data.HashMap.Strict as HM
import System.IO.Unsafe ( unsafePerformIO )
import Language.Fixpoint.Types hiding ( errs
, panic
, Error
, Result
, Expr
)
import qualified Language.Haskell.Liquid.Measure as Ms
import Language.Haskell.Liquid.Parse
import Language.Haskell.Liquid.Transforms.ANF
import Language.Haskell.Liquid.Types hiding ( getConfig )
import Language.Haskell.Liquid.Bare
import Language.Haskell.Liquid.UX.CmdLine
newtype LiquidCheckException = ErrorsOccurred [Filter]
deriving (LiquidCheckException -> LiquidCheckException -> Bool
(LiquidCheckException -> LiquidCheckException -> Bool)
-> (LiquidCheckException -> LiquidCheckException -> Bool)
-> Eq LiquidCheckException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LiquidCheckException -> LiquidCheckException -> Bool
== :: LiquidCheckException -> LiquidCheckException -> Bool
$c/= :: LiquidCheckException -> LiquidCheckException -> Bool
/= :: LiquidCheckException -> LiquidCheckException -> Bool
Eq, Eq LiquidCheckException
Eq LiquidCheckException =>
(LiquidCheckException -> LiquidCheckException -> Ordering)
-> (LiquidCheckException -> LiquidCheckException -> Bool)
-> (LiquidCheckException -> LiquidCheckException -> Bool)
-> (LiquidCheckException -> LiquidCheckException -> Bool)
-> (LiquidCheckException -> LiquidCheckException -> Bool)
-> (LiquidCheckException
-> LiquidCheckException -> LiquidCheckException)
-> (LiquidCheckException
-> LiquidCheckException -> LiquidCheckException)
-> Ord LiquidCheckException
LiquidCheckException -> LiquidCheckException -> Bool
LiquidCheckException -> LiquidCheckException -> Ordering
LiquidCheckException
-> LiquidCheckException -> LiquidCheckException
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: LiquidCheckException -> LiquidCheckException -> Ordering
compare :: LiquidCheckException -> LiquidCheckException -> Ordering
$c< :: LiquidCheckException -> LiquidCheckException -> Bool
< :: LiquidCheckException -> LiquidCheckException -> Bool
$c<= :: LiquidCheckException -> LiquidCheckException -> Bool
<= :: LiquidCheckException -> LiquidCheckException -> Bool
$c> :: LiquidCheckException -> LiquidCheckException -> Bool
> :: LiquidCheckException -> LiquidCheckException -> Bool
$c>= :: LiquidCheckException -> LiquidCheckException -> Bool
>= :: LiquidCheckException -> LiquidCheckException -> Bool
$cmax :: LiquidCheckException
-> LiquidCheckException -> LiquidCheckException
max :: LiquidCheckException
-> LiquidCheckException -> LiquidCheckException
$cmin :: LiquidCheckException
-> LiquidCheckException -> LiquidCheckException
min :: LiquidCheckException
-> LiquidCheckException -> LiquidCheckException
Ord, Int -> LiquidCheckException -> ShowS
[LiquidCheckException] -> ShowS
LiquidCheckException -> String
(Int -> LiquidCheckException -> ShowS)
-> (LiquidCheckException -> String)
-> ([LiquidCheckException] -> ShowS)
-> Show LiquidCheckException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LiquidCheckException -> ShowS
showsPrec :: Int -> LiquidCheckException -> ShowS
$cshow :: LiquidCheckException -> String
show :: LiquidCheckException -> String
$cshowList :: [LiquidCheckException] -> ShowS
showList :: [LiquidCheckException] -> ShowS
Show)
cfgRef :: IORef Config
cfgRef :: IORef Config
cfgRef = IO (IORef Config) -> IORef Config
forall a. IO a -> a
unsafePerformIO (IO (IORef Config) -> IORef Config)
-> IO (IORef Config) -> IORef Config
forall a b. (a -> b) -> a -> b
$ Config -> IO (IORef Config)
forall a. a -> IO (IORef a)
newIORef Config
defConfig
{-# NOINLINE cfgRef #-}
debugLogs :: Bool
debugLogs :: Bool
debugLogs = Bool
False
getConfig :: IO Config
getConfig :: IO Config
getConfig = IORef Config -> IO Config
forall a. IORef a -> IO a
readIORef IORef Config
cfgRef
debugLog :: MonadIO m => String -> m ()
debugLog :: forall (m :: * -> *). MonadIO m => String -> m ()
debugLog String
msg = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debugLogs (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ()
putStrLn String
msg)
plugin :: GHC.Plugin
plugin :: Plugin
plugin = Plugin
GHC.defaultPlugin {
typeCheckResultAction = liquidPlugin
, driverPlugin = customDynFlags
, pluginRecompile = purePlugin
}
where
liquidPlugin :: [CommandLineOption] -> ModSummary -> TcGblEnv -> TcM TcGblEnv
liquidPlugin :: [String] -> ModSummary -> TcGblEnv -> TcM TcGblEnv
liquidPlugin [String]
_ ModSummary
summary TcGblEnv
gblEnv = do
Config
cfg <- IO Config -> IOEnv (Env TcGblEnv TcLclEnv) Config
forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Config
getConfig
if Config -> Bool
skipModule Config
cfg then TcGblEnv -> TcM TcGblEnv
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return TcGblEnv
gblEnv
else ModSummary -> TcGblEnv -> TcM TcGblEnv
liquidPluginGo ModSummary
summary TcGblEnv
gblEnv
liquidPluginGo :: ModSummary -> TcGblEnv -> TcM TcGblEnv
liquidPluginGo ModSummary
summary TcGblEnv
gblEnv = do
Logger
logger <- IOEnv (Env TcGblEnv TcLclEnv) Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
DynFlags
dynFlags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
Logger -> SDoc -> (TcGblEnv -> ()) -> TcM TcGblEnv -> TcM TcGblEnv
forall (m :: * -> *) a.
MonadIO m =>
Logger -> SDoc -> (a -> ()) -> m a -> m a
withTiming Logger
logger (String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"LiquidHaskell" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
brackets (ModuleName -> SDoc
forall a. Outputable a => a -> SDoc
ppr (ModuleName -> SDoc) -> ModuleName -> SDoc
forall a b. (a -> b) -> a -> b
$ ModSummary -> ModuleName
ms_mod_name ModSummary
summary)) (() -> TcGblEnv -> ()
forall a b. a -> b -> a
const ()) (TcM TcGblEnv -> TcM TcGblEnv) -> TcM TcGblEnv -> TcM TcGblEnv
forall a b. (a -> b) -> a -> b
$ do
if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_Haddock DynFlags
dynFlags
then do
let msg :: Doc
msg = [Doc] -> Doc
PJ.vcat [ String -> Doc
PJ.text String
"LH can't be run with Haddock."
, Int -> Doc -> Doc
PJ.nest Int
4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
PJ.text String
"Documentation will still be created."
]
let srcLoc :: SrcLoc
srcLoc = FastString -> Int -> Int -> SrcLoc
mkSrcLoc (String -> FastString
mkFastString (String -> FastString) -> String -> FastString
forall a b. (a -> b) -> a -> b
$ ModSummary -> String
ms_hspp_file ModSummary
summary) Int
1 Int
1
let warning :: Warning
warning = SrcSpan -> Doc -> Warning
mkWarning (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan SrcLoc
srcLoc SrcLoc
srcLoc) Doc
msg
IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ Logger -> Warning -> IO ()
printWarning Logger
logger Warning
warning
TcGblEnv -> TcM TcGblEnv
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TcGblEnv
gblEnv
else do
Either LiquidCheckException TcGblEnv
newGblEnv <- ModSummary
-> TcGblEnv -> TcM (Either LiquidCheckException TcGblEnv)
typecheckHook ModSummary
summary TcGblEnv
gblEnv
case Either LiquidCheckException TcGblEnv
newGblEnv of
Left (ErrorsOccurred []) -> TcGblEnv -> TcM TcGblEnv
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TcGblEnv
gblEnv
Left (ErrorsOccurred [Filter]
errorFilters) -> do
String -> [Filter] -> IOEnv (Env TcGblEnv TcLclEnv) ()
defaultFilterReporter (ModSummary -> String
LH.modSummaryHsFile ModSummary
summary) [Filter]
errorFilters
TcM TcGblEnv
forall env a. IOEnv env a
failM
Right TcGblEnv
newGblEnv' ->
TcGblEnv -> TcM TcGblEnv
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TcGblEnv
newGblEnv'
customDynFlags :: [CommandLineOption] -> HscEnv -> IO HscEnv
customDynFlags :: [String] -> HscEnv -> IO HscEnv
customDynFlags [String]
opts HscEnv
hscEnv = do
Config
cfg <- IO Config -> IO Config
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Config -> IO Config) -> IO Config -> IO Config
forall a b. (a -> b) -> a -> b
$ [String] -> IO Config
LH.getOpts [String]
opts
IORef Config -> Config -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Config
cfgRef Config
cfg
HscEnv -> IO HscEnv
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (HscEnv
hscEnv { hsc_dflags = configureDynFlags (hsc_dflags hscEnv) })
where
configureDynFlags :: DynFlags -> DynFlags
configureDynFlags :: DynFlags -> DynFlags
configureDynFlags DynFlags
df =
DynFlags
df DynFlags -> GeneralFlag -> DynFlags
`gopt_set` GeneralFlag
Opt_ImplicitImportQualified
DynFlags -> GeneralFlag -> DynFlags
`gopt_set` GeneralFlag
Opt_PIC
DynFlags -> GeneralFlag -> DynFlags
`gopt_set` GeneralFlag
Opt_DeferTypedHoles
DynFlags -> GeneralFlag -> DynFlags
`gopt_set` GeneralFlag
Opt_KeepRawTokenStream
DynFlags -> Extension -> DynFlags
`xopt_set` Extension
MagicHash
DynFlags -> Extension -> DynFlags
`xopt_set` Extension
DeriveGeneric
DynFlags -> Extension -> DynFlags
`xopt_set` Extension
StandaloneDeriving
class Unoptimise a where
type UnoptimisedTarget a :: Type
unoptimise :: a -> UnoptimisedTarget a
instance Unoptimise DynFlags where
type UnoptimisedTarget DynFlags = DynFlags
unoptimise :: DynFlags -> UnoptimisedTarget DynFlags
unoptimise DynFlags
df = Int -> DynFlags -> DynFlags
updOptLevel Int
0 DynFlags
df
{ debugLevel = 1
, ghcLink = LinkInMemory
, backend = interpreterBackend
, ghcMode = CompManager
}
instance Unoptimise ModSummary where
type UnoptimisedTarget ModSummary = ModSummary
unoptimise :: ModSummary -> UnoptimisedTarget ModSummary
unoptimise ModSummary
modSummary = ModSummary
modSummary { ms_hspp_opts = unoptimise (ms_hspp_opts modSummary) }
instance Unoptimise (DynFlags, HscEnv) where
type UnoptimisedTarget (DynFlags, HscEnv) = HscEnv
unoptimise :: (DynFlags, HscEnv) -> UnoptimisedTarget (DynFlags, HscEnv)
unoptimise (DynFlags -> UnoptimisedTarget DynFlags
forall a. Unoptimise a => a -> UnoptimisedTarget a
unoptimise -> UnoptimisedTarget DynFlags
df, HscEnv
env) = HscEnv
env { hsc_dflags = df }
typecheckHook :: ModSummary -> TcGblEnv -> TcM (Either LiquidCheckException TcGblEnv)
typecheckHook :: ModSummary
-> TcGblEnv -> TcM (Either LiquidCheckException TcGblEnv)
typecheckHook (ModSummary -> UnoptimisedTarget ModSummary
forall a. Unoptimise a => a -> UnoptimisedTarget a
unoptimise -> UnoptimisedTarget ModSummary
modSummary) TcGblEnv
tcGblEnv = do
String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ String
"We are in module: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> StableModule -> String
forall a. Show a => a -> String
show (Module -> StableModule
toStableModule Module
thisModule)
HscEnv
env <- Env TcGblEnv TcLclEnv -> HscEnv
forall gbl lcl. Env gbl lcl -> HscEnv
env_top (Env TcGblEnv TcLclEnv -> HscEnv)
-> IOEnv (Env TcGblEnv TcLclEnv) (Env TcGblEnv TcLclEnv)
-> IOEnv (Env TcGblEnv TcLclEnv) HscEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOEnv (Env TcGblEnv TcLclEnv) (Env TcGblEnv TcLclEnv)
forall env. IOEnv env env
getEnv
ParsedModule
parsed <- IO ParsedModule -> IOEnv (Env TcGblEnv TcLclEnv) ParsedModule
forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ParsedModule -> IOEnv (Env TcGblEnv TcLclEnv) ParsedModule)
-> IO ParsedModule -> IOEnv (Env TcGblEnv TcLclEnv) ParsedModule
forall a b. (a -> b) -> a -> b
$ HscEnv -> ModSummary -> IO ParsedModule
parseModuleIO HscEnv
env (ModSummary -> ModSummary
LH.keepRawTokenStream ModSummary
UnoptimisedTarget ModSummary
modSummary)
let comments :: [(Maybe RealSrcLoc, String)]
comments = ParsedModule -> [(Maybe RealSrcLoc, String)]
LH.extractSpecComments ParsedModule
parsed
TypecheckedModuleLH
typechecked <- IO TypecheckedModuleLH
-> IOEnv (Env TcGblEnv TcLclEnv) TypecheckedModuleLH
forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TypecheckedModuleLH
-> IOEnv (Env TcGblEnv TcLclEnv) TypecheckedModuleLH)
-> IO TypecheckedModuleLH
-> IOEnv (Env TcGblEnv TcLclEnv) TypecheckedModuleLH
forall a b. (a -> b) -> a -> b
$ HscEnv -> ParsedModule -> IO TypecheckedModuleLH
typecheckModuleIO (HscEnv -> HscEnv
dropPlugins HscEnv
env) (ParsedModule -> ParsedModule
LH.ignoreInline ParsedModule
parsed)
[(Name, Maybe TyThing)]
resolvedNames <- IO [(Name, Maybe TyThing)]
-> IOEnv (Env TcGblEnv TcLclEnv) [(Name, Maybe TyThing)]
forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(Name, Maybe TyThing)]
-> IOEnv (Env TcGblEnv TcLclEnv) [(Name, Maybe TyThing)])
-> IO [(Name, Maybe TyThing)]
-> IOEnv (Env TcGblEnv TcLclEnv) [(Name, Maybe TyThing)]
forall a b. (a -> b) -> a -> b
$ HscEnv -> TcGblEnv -> IO [(Name, Maybe TyThing)]
LH.lookupTyThings HscEnv
env TcGblEnv
tcGblEnv
[TyCon]
availTyCons <- IO [TyCon] -> IOEnv (Env TcGblEnv TcLclEnv) [TyCon]
forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [TyCon] -> IOEnv (Env TcGblEnv TcLclEnv) [TyCon])
-> IO [TyCon] -> IOEnv (Env TcGblEnv TcLclEnv) [TyCon]
forall a b. (a -> b) -> a -> b
$ HscEnv -> TcGblEnv -> [AvailInfo] -> IO [TyCon]
LH.availableTyCons HscEnv
env TcGblEnv
tcGblEnv (TcGblEnv -> [AvailInfo]
tcg_exports TcGblEnv
tcGblEnv)
[Id]
availVars <- IO [Id] -> IOEnv (Env TcGblEnv TcLclEnv) [Id]
forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Id] -> IOEnv (Env TcGblEnv TcLclEnv) [Id])
-> IO [Id] -> IOEnv (Env TcGblEnv TcLclEnv) [Id]
forall a b. (a -> b) -> a -> b
$ HscEnv -> TcGblEnv -> [AvailInfo] -> IO [Id]
LH.availableVars HscEnv
env TcGblEnv
tcGblEnv (TcGblEnv -> [AvailInfo]
tcg_exports TcGblEnv
tcGblEnv)
ModGuts
unoptimisedGuts <- IO ModGuts -> IOEnv (Env TcGblEnv TcLclEnv) ModGuts
forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ModGuts -> IOEnv (Env TcGblEnv TcLclEnv) ModGuts)
-> IO ModGuts -> IOEnv (Env TcGblEnv TcLclEnv) ModGuts
forall a b. (a -> b) -> a -> b
$ HscEnv -> ModSummary -> TypecheckedModuleLH -> IO ModGuts
desugarModuleIO HscEnv
env ModSummary
UnoptimisedTarget ModSummary
modSummary TypecheckedModuleLH
typechecked
let tcData :: TcData
tcData = [LImportDecl GhcRn]
-> [(Name, Maybe TyThing)] -> [TyCon] -> [Id] -> TcData
mkTcData (TcGblEnv -> [LImportDecl GhcRn]
tcg_rn_imports TcGblEnv
tcGblEnv) [(Name, Maybe TyThing)]
resolvedNames [TyCon]
availTyCons [Id]
availVars
let pipelineData :: PipelineData
pipelineData = ModGuts -> TcData -> [SpecComment] -> PipelineData
PipelineData ModGuts
unoptimisedGuts TcData
tcData (((Maybe RealSrcLoc, String) -> SpecComment)
-> [(Maybe RealSrcLoc, String)] -> [SpecComment]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe RealSrcLoc, String) -> SpecComment
mkSpecComment [(Maybe RealSrcLoc, String)]
comments)
PipelineData
-> ModSummary
-> TcGblEnv
-> TcM (Either LiquidCheckException TcGblEnv)
liquidHaskellCheck PipelineData
pipelineData ModSummary
UnoptimisedTarget ModSummary
modSummary TcGblEnv
tcGblEnv
where
thisModule :: Module
thisModule :: Module
thisModule = TcGblEnv -> Module
tcg_mod TcGblEnv
tcGblEnv
dropPlugins :: HscEnv -> HscEnv
dropPlugins HscEnv
hsc_env = HscEnv
hsc_env { hsc_plugins = emptyPlugins }
serialiseSpec :: Module -> TcGblEnv -> LiquidLib -> TcM TcGblEnv
serialiseSpec :: Module -> TcGblEnv -> LiquidLib -> TcM TcGblEnv
serialiseSpec Module
thisModule TcGblEnv
tcGblEnv LiquidLib
liquidLib = do
let serialisedSpec :: Annotation
serialisedSpec = LiquidLib -> Module -> Annotation
Util.serialiseLiquidLib LiquidLib
liquidLib Module
thisModule
String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ String
"Serialised annotation ==> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SDoc -> String
O.showSDocUnsafe (SDoc -> String) -> (Annotation -> SDoc) -> Annotation -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Annotation -> SDoc
forall a. Outputable a => a -> SDoc
O.ppr (Annotation -> String) -> Annotation -> String
forall a b. (a -> b) -> a -> b
$ Annotation
serialisedSpec)
TcGblEnv -> TcM TcGblEnv
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TcGblEnv -> TcM TcGblEnv) -> TcGblEnv -> TcM TcGblEnv
forall a b. (a -> b) -> a -> b
$ TcGblEnv
tcGblEnv { tcg_anns = serialisedSpec : tcg_anns tcGblEnv }
processInputSpec :: Config -> PipelineData -> ModSummary -> TcGblEnv -> BareSpec -> TcM (Either LiquidCheckException TcGblEnv)
processInputSpec :: Config
-> PipelineData
-> ModSummary
-> TcGblEnv
-> BareSpec
-> TcM (Either LiquidCheckException TcGblEnv)
processInputSpec Config
cfg PipelineData
pipelineData ModSummary
modSummary TcGblEnv
tcGblEnv BareSpec
inputSpec = do
HscEnv
hscEnv <- Env TcGblEnv TcLclEnv -> HscEnv
forall gbl lcl. Env gbl lcl -> HscEnv
env_top (Env TcGblEnv TcLclEnv -> HscEnv)
-> IOEnv (Env TcGblEnv TcLclEnv) (Env TcGblEnv TcLclEnv)
-> IOEnv (Env TcGblEnv TcLclEnv) HscEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOEnv (Env TcGblEnv TcLclEnv) (Env TcGblEnv TcLclEnv)
forall env. IOEnv env env
getEnv
String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ String
" Input spec: \n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ BareSpec -> String
forall a. Show a => a -> String
show BareSpec
inputSpec
String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ String
"Relevant ===> \n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unlines (Module -> String
renderModule (Module -> String) -> [Module] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set Module -> [Module]
forall a. Set a -> [a]
S.toList (ModuleGraph -> ModGuts -> Set Module
relevantModules (HscEnv -> ModuleGraph
hsc_mod_graph HscEnv
hscEnv) ModGuts
modGuts))
LogicMap
logicMap :: LogicMap <- IO LogicMap -> IOEnv (Env TcGblEnv TcLclEnv) LogicMap
forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO LogicMap
LH.makeLogicMap
let lhContext :: LiquidHaskellContext
lhContext = LiquidHaskellContext {
lhGlobalCfg :: Config
lhGlobalCfg = Config
cfg
, lhInputSpec :: BareSpec
lhInputSpec = BareSpec
inputSpec
, lhModuleLogicMap :: LogicMap
lhModuleLogicMap = LogicMap
logicMap
, lhModuleSummary :: ModSummary
lhModuleSummary = ModSummary
modSummary
, lhModuleTcData :: TcData
lhModuleTcData = PipelineData -> TcData
pdTcData PipelineData
pipelineData
, lhModuleGuts :: ModGuts
lhModuleGuts = PipelineData -> ModGuts
pdUnoptimisedCore PipelineData
pipelineData
, lhRelevantModules :: Set Module
lhRelevantModules = ModuleGraph -> ModGuts -> Set Module
relevantModules (HscEnv -> ModuleGraph
hsc_mod_graph HscEnv
hscEnv) ModGuts
modGuts
}
if BareSpec -> Bool
isIgnore BareSpec
inputSpec
then Either LiquidCheckException TcGblEnv
-> TcM (Either LiquidCheckException TcGblEnv)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either LiquidCheckException TcGblEnv
-> TcM (Either LiquidCheckException TcGblEnv))
-> Either LiquidCheckException TcGblEnv
-> TcM (Either LiquidCheckException TcGblEnv)
forall a b. (a -> b) -> a -> b
$ LiquidCheckException -> Either LiquidCheckException TcGblEnv
forall a b. a -> Either a b
Left ([Filter] -> LiquidCheckException
ErrorsOccurred [])
else do
Either LiquidCheckException LiquidLib
liquidLib' <- LiquidHaskellContext -> TcM (Either LiquidCheckException LiquidLib)
checkLiquidHaskellContext LiquidHaskellContext
lhContext
(LiquidLib -> TcM TcGblEnv)
-> Either LiquidCheckException LiquidLib
-> TcM (Either LiquidCheckException TcGblEnv)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> Either LiquidCheckException a
-> f (Either LiquidCheckException b)
traverse (Module -> TcGblEnv -> LiquidLib -> TcM TcGblEnv
serialiseSpec Module
thisModule TcGblEnv
tcGblEnv) Either LiquidCheckException LiquidLib
liquidLib'
where
thisModule :: Module
thisModule :: Module
thisModule = TcGblEnv -> Module
tcg_mod TcGblEnv
tcGblEnv
modGuts :: ModGuts
modGuts :: ModGuts
modGuts = PipelineData -> ModGuts
pdUnoptimisedCore PipelineData
pipelineData
liquidHaskellCheckWithConfig :: Config -> PipelineData -> ModSummary -> TcGblEnv -> TcM (Either LiquidCheckException TcGblEnv)
liquidHaskellCheckWithConfig :: Config
-> PipelineData
-> ModSummary
-> TcGblEnv
-> TcM (Either LiquidCheckException TcGblEnv)
liquidHaskellCheckWithConfig Config
globalCfg PipelineData
pipelineData ModSummary
modSummary TcGblEnv
tcGblEnv = do
let specQuotes :: [BPspec]
specQuotes :: [BPspec]
specQuotes = (TcGblEnv -> Module)
-> (TcGblEnv -> [Annotation]) -> TcGblEnv -> [BPspec]
forall a. (a -> Module) -> (a -> [Annotation]) -> a -> [BPspec]
LH.extractSpecQuotes' TcGblEnv -> Module
tcg_mod TcGblEnv -> [Annotation]
tcg_anns TcGblEnv
tcGblEnv
Either LiquidCheckException BareSpec
inputSpec' :: Either LiquidCheckException BareSpec <-
String
-> Module
-> [SpecComment]
-> [BPspec]
-> TcM (Either LiquidCheckException BareSpec)
getLiquidSpec String
thisFile Module
thisModule (PipelineData -> [SpecComment]
pdSpecComments PipelineData
pipelineData) [BPspec]
specQuotes
case Either LiquidCheckException BareSpec
inputSpec' of
Left LiquidCheckException
e -> Either LiquidCheckException TcGblEnv
-> TcM (Either LiquidCheckException TcGblEnv)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either LiquidCheckException TcGblEnv
-> TcM (Either LiquidCheckException TcGblEnv))
-> Either LiquidCheckException TcGblEnv
-> TcM (Either LiquidCheckException TcGblEnv)
forall a b. (a -> b) -> a -> b
$ LiquidCheckException -> Either LiquidCheckException TcGblEnv
forall a b. a -> Either a b
Left LiquidCheckException
e
Right BareSpec
inputSpec ->
Config
-> String
-> [Located String]
-> (Config -> TcM (Either LiquidCheckException TcGblEnv))
-> TcM (Either LiquidCheckException TcGblEnv)
forall (m :: * -> *) a.
MonadIO m =>
Config -> String -> [Located String] -> (Config -> m a) -> m a
withPragmas Config
globalCfg String
thisFile (Spec LocBareType LocSymbol -> [Located String]
forall ty bndr. Spec ty bndr -> [Located String]
Ms.pragmas (Spec LocBareType LocSymbol -> [Located String])
-> Spec LocBareType LocSymbol -> [Located String]
forall a b. (a -> b) -> a -> b
$ BareSpec -> Spec LocBareType LocSymbol
fromBareSpec BareSpec
inputSpec) ((Config -> TcM (Either LiquidCheckException TcGblEnv))
-> TcM (Either LiquidCheckException TcGblEnv))
-> (Config -> TcM (Either LiquidCheckException TcGblEnv))
-> TcM (Either LiquidCheckException TcGblEnv)
forall a b. (a -> b) -> a -> b
$ \Config
moduleCfg -> do
Config
-> PipelineData
-> ModSummary
-> TcGblEnv
-> BareSpec
-> TcM (Either LiquidCheckException TcGblEnv)
processInputSpec Config
moduleCfg PipelineData
pipelineData ModSummary
modSummary TcGblEnv
tcGblEnv BareSpec
inputSpec
TcM (Either LiquidCheckException TcGblEnv)
-> (UserError -> TcM (Either LiquidCheckException TcGblEnv))
-> TcM (Either LiquidCheckException TcGblEnv)
forall e a.
(HasCallStack, Exception e) =>
IOEnv (Env TcGblEnv TcLclEnv) a
-> (e -> IOEnv (Env TcGblEnv TcLclEnv) a)
-> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`Ex.catch` (\(UserError
e :: UserError) -> Config -> [UserError] -> TcM (Either LiquidCheckException TcGblEnv)
forall e.
(Show e, PPrint e) =>
Config -> [TError e] -> TcM (Either LiquidCheckException TcGblEnv)
reportErrs Config
moduleCfg [UserError
e])
TcM (Either LiquidCheckException TcGblEnv)
-> (Error -> TcM (Either LiquidCheckException TcGblEnv))
-> TcM (Either LiquidCheckException TcGblEnv)
forall e a.
(HasCallStack, Exception e) =>
IOEnv (Env TcGblEnv TcLclEnv) a
-> (e -> IOEnv (Env TcGblEnv TcLclEnv) a)
-> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`Ex.catch` (\(Error
e :: Error) -> Config -> [Error] -> TcM (Either LiquidCheckException TcGblEnv)
forall e.
(Show e, PPrint e) =>
Config -> [TError e] -> TcM (Either LiquidCheckException TcGblEnv)
reportErrs Config
moduleCfg [Error
e])
TcM (Either LiquidCheckException TcGblEnv)
-> ([Error] -> TcM (Either LiquidCheckException TcGblEnv))
-> TcM (Either LiquidCheckException TcGblEnv)
forall e a.
(HasCallStack, Exception e) =>
IOEnv (Env TcGblEnv TcLclEnv) a
-> (e -> IOEnv (Env TcGblEnv TcLclEnv) a)
-> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`Ex.catch` (\([Error]
es :: [Error]) -> Config -> [Error] -> TcM (Either LiquidCheckException TcGblEnv)
forall e.
(Show e, PPrint e) =>
Config -> [TError e] -> TcM (Either LiquidCheckException TcGblEnv)
reportErrs Config
moduleCfg [Error]
es)
where
thisFile :: FilePath
thisFile :: String
thisFile = ModSummary -> String
LH.modSummaryHsFile ModSummary
modSummary
continue :: TcM (Either LiquidCheckException TcGblEnv)
continue :: TcM (Either LiquidCheckException TcGblEnv)
continue = Either LiquidCheckException TcGblEnv
-> TcM (Either LiquidCheckException TcGblEnv)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either LiquidCheckException TcGblEnv
-> TcM (Either LiquidCheckException TcGblEnv))
-> Either LiquidCheckException TcGblEnv
-> TcM (Either LiquidCheckException TcGblEnv)
forall a b. (a -> b) -> a -> b
$ LiquidCheckException -> Either LiquidCheckException TcGblEnv
forall a b. a -> Either a b
Left ([Filter] -> LiquidCheckException
ErrorsOccurred [])
reportErrs :: (Show e, F.PPrint e) => Config -> [TError e] -> TcM (Either LiquidCheckException TcGblEnv)
reportErrs :: forall e.
(Show e, PPrint e) =>
Config -> [TError e] -> TcM (Either LiquidCheckException TcGblEnv)
reportErrs Config
cfg = String
-> TcM (Either LiquidCheckException TcGblEnv)
-> TcM (Either LiquidCheckException TcGblEnv)
-> [Filter]
-> Tidy
-> [TError e]
-> TcM (Either LiquidCheckException TcGblEnv)
forall e' a.
(Show e', PPrint e') =>
String
-> TcRn a -> TcRn a -> [Filter] -> Tidy -> [TError e'] -> TcRn a
LH.filterReportErrors String
thisFile TcM (Either LiquidCheckException TcGblEnv)
forall env a. IOEnv env a
GHC.failM TcM (Either LiquidCheckException TcGblEnv)
continue (Config -> [Filter]
getFilters Config
cfg) Tidy
Full
thisModule :: Module
thisModule :: Module
thisModule = TcGblEnv -> Module
tcg_mod TcGblEnv
tcGblEnv
liquidHaskellCheck :: PipelineData -> ModSummary -> TcGblEnv -> TcM (Either LiquidCheckException TcGblEnv)
liquidHaskellCheck :: PipelineData
-> ModSummary
-> TcGblEnv
-> TcM (Either LiquidCheckException TcGblEnv)
liquidHaskellCheck PipelineData
pipelineData ModSummary
modSummary TcGblEnv
tcGblEnv = do
Config
cfg <- IO Config -> IOEnv (Env TcGblEnv TcLclEnv) Config
forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Config
getConfig
Config
-> PipelineData
-> ModSummary
-> TcGblEnv
-> TcM (Either LiquidCheckException TcGblEnv)
liquidHaskellCheckWithConfig Config
cfg PipelineData
pipelineData ModSummary
modSummary TcGblEnv
tcGblEnv
checkLiquidHaskellContext :: LiquidHaskellContext -> TcM (Either LiquidCheckException LiquidLib)
checkLiquidHaskellContext :: LiquidHaskellContext -> TcM (Either LiquidCheckException LiquidLib)
checkLiquidHaskellContext LiquidHaskellContext
lhContext = do
Either LiquidCheckException ProcessModuleResult
pmr <- LiquidHaskellContext
-> TcM (Either LiquidCheckException ProcessModuleResult)
processModule LiquidHaskellContext
lhContext
case Either LiquidCheckException ProcessModuleResult
pmr of
Left LiquidCheckException
e -> Either LiquidCheckException LiquidLib
-> TcM (Either LiquidCheckException LiquidLib)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either LiquidCheckException LiquidLib
-> TcM (Either LiquidCheckException LiquidLib))
-> Either LiquidCheckException LiquidLib
-> TcM (Either LiquidCheckException LiquidLib)
forall a b. (a -> b) -> a -> b
$ LiquidCheckException -> Either LiquidCheckException LiquidLib
forall a b. a -> Either a b
Left LiquidCheckException
e
Right ProcessModuleResult{TargetInfo
LiquidLib
pmrClientLib :: LiquidLib
pmrTargetInfo :: TargetInfo
pmrClientLib :: ProcessModuleResult -> LiquidLib
pmrTargetInfo :: ProcessModuleResult -> TargetInfo
..} -> do
Output Doc
out <- IO (Output Doc) -> IOEnv (Env TcGblEnv TcLclEnv) (Output Doc)
forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Output Doc) -> IOEnv (Env TcGblEnv TcLclEnv) (Output Doc))
-> IO (Output Doc) -> IOEnv (Env TcGblEnv TcLclEnv) (Output Doc)
forall a b. (a -> b) -> a -> b
$ TargetInfo -> IO (Output Doc)
LH.checkTargetInfo TargetInfo
pmrTargetInfo
let bareSpec :: BareSpec
bareSpec = LiquidHaskellContext -> BareSpec
lhInputSpec LiquidHaskellContext
lhContext
file :: String
file = ModSummary -> String
LH.modSummaryHsFile (ModSummary -> String) -> ModSummary -> String
forall a b. (a -> b) -> a -> b
$ LiquidHaskellContext -> ModSummary
lhModuleSummary LiquidHaskellContext
lhContext
Config
-> String
-> [Located String]
-> (Config -> TcM (Either LiquidCheckException LiquidLib))
-> TcM (Either LiquidCheckException LiquidLib)
forall (m :: * -> *) a.
MonadIO m =>
Config -> String -> [Located String] -> (Config -> m a) -> m a
withPragmas (LiquidHaskellContext -> Config
lhGlobalCfg LiquidHaskellContext
lhContext) String
file (Spec LocBareType LocSymbol -> [Located String]
forall ty bndr. Spec ty bndr -> [Located String]
Ms.pragmas (Spec LocBareType LocSymbol -> [Located String])
-> Spec LocBareType LocSymbol -> [Located String]
forall a b. (a -> b) -> a -> b
$ BareSpec -> Spec LocBareType LocSymbol
fromBareSpec BareSpec
bareSpec) ((Config -> TcM (Either LiquidCheckException LiquidLib))
-> TcM (Either LiquidCheckException LiquidLib))
-> (Config -> TcM (Either LiquidCheckException LiquidLib))
-> TcM (Either LiquidCheckException LiquidLib)
forall a b. (a -> b) -> a -> b
$ \Config
moduleCfg -> do
let filters :: [Filter]
filters = Config -> [Filter]
getFilters Config
moduleCfg
(OutputResult -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> Config
-> [String]
-> Output Doc
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *).
MonadIO m =>
(OutputResult -> m ()) -> Config -> [String] -> Output Doc -> m ()
LH.reportResult (String
-> [Filter] -> OutputResult -> IOEnv (Env TcGblEnv TcLclEnv) ()
errorLogger String
file [Filter]
filters) Config
moduleCfg [TargetSrc -> String
giTarget (TargetInfo -> TargetSrc
giSrc TargetInfo
pmrTargetInfo)] Output Doc
out
case Output Doc -> ErrorResult
forall a. Output a -> ErrorResult
o_result Output Doc
out of
F.Safe Stats
_ -> Either LiquidCheckException LiquidLib
-> TcM (Either LiquidCheckException LiquidLib)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either LiquidCheckException LiquidLib
-> TcM (Either LiquidCheckException LiquidLib))
-> Either LiquidCheckException LiquidLib
-> TcM (Either LiquidCheckException LiquidLib)
forall a b. (a -> b) -> a -> b
$ LiquidLib -> Either LiquidCheckException LiquidLib
forall a b. b -> Either a b
Right LiquidLib
pmrClientLib
ErrorResult
_ | Config -> Bool
json Config
moduleCfg -> TcM (Either LiquidCheckException LiquidLib)
forall env a. IOEnv env a
failM
| Bool
otherwise -> Either LiquidCheckException LiquidLib
-> TcM (Either LiquidCheckException LiquidLib)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either LiquidCheckException LiquidLib
-> TcM (Either LiquidCheckException LiquidLib))
-> Either LiquidCheckException LiquidLib
-> TcM (Either LiquidCheckException LiquidLib)
forall a b. (a -> b) -> a -> b
$ LiquidCheckException -> Either LiquidCheckException LiquidLib
forall a b. a -> Either a b
Left (LiquidCheckException -> Either LiquidCheckException LiquidLib)
-> LiquidCheckException -> Either LiquidCheckException LiquidLib
forall a b. (a -> b) -> a -> b
$ [Filter] -> LiquidCheckException
ErrorsOccurred []
errorLogger :: FilePath -> [Filter] -> OutputResult -> TcM ()
errorLogger :: String
-> [Filter] -> OutputResult -> IOEnv (Env TcGblEnv TcLclEnv) ()
errorLogger String
file [Filter]
filters OutputResult
outputResult = do
FilterReportErrorsArgs
(IOEnv (Env TcGblEnv TcLclEnv)) Filter Any (SrcSpan, Doc) ()
-> [(SrcSpan, Doc)] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) filter msg e a.
(Monad m, Ord filter) =>
FilterReportErrorsArgs m filter msg e a -> [e] -> m a
LH.filterReportErrorsWith
FilterReportErrorsArgs { errorReporter :: [(SrcSpan, Doc)] -> IOEnv (Env TcGblEnv TcLclEnv) ()
errorReporter = \[(SrcSpan, Doc)]
errs ->
[(SrcSpan, Doc)] -> IOEnv (Env TcGblEnv TcLclEnv) ()
LH.addTcRnUnknownMessages [(SrcSpan
sp, Doc
e) | (SrcSpan
sp, Doc
e) <- [(SrcSpan, Doc)]
errs]
, filterReporter :: [Filter] -> IOEnv (Env TcGblEnv TcLclEnv) ()
filterReporter = String -> [Filter] -> IOEnv (Env TcGblEnv TcLclEnv) ()
LH.defaultFilterReporter String
file
, failure :: IOEnv (Env TcGblEnv TcLclEnv) ()
failure = IOEnv (Env TcGblEnv TcLclEnv) ()
forall env a. IOEnv env a
GHC.failM
, continue :: IOEnv (Env TcGblEnv TcLclEnv) ()
continue = () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
, matchingFilters :: (SrcSpan, Doc) -> [Filter]
matchingFilters = ((SrcSpan, Doc) -> String)
-> [Filter] -> (SrcSpan, Doc) -> [Filter]
forall e. (e -> String) -> [Filter] -> e -> [Filter]
LH.reduceFilters (\(SrcSpan
src, Doc
doc) -> Doc -> String
PJ.render Doc
doc String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SrcSpan -> String
forall a. Outputable a => a -> String
LH.showPpr SrcSpan
src) [Filter]
filters
, filters :: [Filter]
filters = [Filter]
filters
}
(OutputResult -> [(SrcSpan, Doc)]
LH.orMessages OutputResult
outputResult)
isIgnore :: BareSpec -> Bool
isIgnore :: BareSpec -> Bool
isIgnore (MkBareSpec Spec LocBareType LocSymbol
sp) = (Located String -> Bool) -> [Located String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"--skip-module") (String -> Bool)
-> (Located String -> String) -> Located String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located String -> String
forall a. Located a -> a
F.val) (Spec LocBareType LocSymbol -> [Located String]
forall ty bndr. Spec ty bndr -> [Located String]
pragmas Spec LocBareType LocSymbol
sp)
loadDependencies :: Config
-> Module
-> [Module]
-> TcM TargetDependencies
loadDependencies :: Config -> Module -> [Module] -> TcM TargetDependencies
loadDependencies Config
currentModuleConfig Module
thisModule [Module]
mods = do
HscEnv
hscEnv <- Env TcGblEnv TcLclEnv -> HscEnv
forall gbl lcl. Env gbl lcl -> HscEnv
env_top (Env TcGblEnv TcLclEnv -> HscEnv)
-> IOEnv (Env TcGblEnv TcLclEnv) (Env TcGblEnv TcLclEnv)
-> IOEnv (Env TcGblEnv TcLclEnv) HscEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOEnv (Env TcGblEnv TcLclEnv) (Env TcGblEnv TcLclEnv)
forall env. IOEnv env env
getEnv
[SpecFinderResult]
results <- [String] -> HscEnv -> [Module] -> TcM [SpecFinderResult]
SpecFinder.findRelevantSpecs
(Config -> [String]
excludeAutomaticAssumptionsFor Config
currentModuleConfig) HscEnv
hscEnv [Module]
mods
TargetDependencies
deps <- (TargetDependencies -> SpecFinderResult -> TcM TargetDependencies)
-> TargetDependencies
-> [SpecFinderResult]
-> TcM TargetDependencies
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM TargetDependencies -> SpecFinderResult -> TcM TargetDependencies
processResult TargetDependencies
forall a. Monoid a => a
mempty ([SpecFinderResult] -> [SpecFinderResult]
forall a. [a] -> [a]
reverse [SpecFinderResult]
results)
[StableModule]
redundant <- IO [StableModule] -> IOEnv (Env TcGblEnv TcLclEnv) [StableModule]
forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [StableModule] -> IOEnv (Env TcGblEnv TcLclEnv) [StableModule])
-> IO [StableModule]
-> IOEnv (Env TcGblEnv TcLclEnv) [StableModule]
forall a b. (a -> b) -> a -> b
$ HscEnv -> Config -> IO [StableModule]
configToRedundantDependencies HscEnv
hscEnv Config
currentModuleConfig
String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ String
"Redundant dependencies ==> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [StableModule] -> String
forall a. Show a => a -> String
show [StableModule]
redundant
TargetDependencies -> TcM TargetDependencies
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TargetDependencies -> TcM TargetDependencies)
-> TargetDependencies -> TcM TargetDependencies
forall a b. (a -> b) -> a -> b
$ (TargetDependencies -> StableModule -> TargetDependencies)
-> TargetDependencies -> [StableModule] -> TargetDependencies
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((StableModule -> TargetDependencies -> TargetDependencies)
-> TargetDependencies -> StableModule -> TargetDependencies
forall a b c. (a -> b -> c) -> b -> a -> c
flip StableModule -> TargetDependencies -> TargetDependencies
dropDependency) TargetDependencies
deps [StableModule]
redundant
where
processResult :: TargetDependencies -> SpecFinderResult -> TcM TargetDependencies
processResult :: TargetDependencies -> SpecFinderResult -> TcM TargetDependencies
processResult !TargetDependencies
acc (SpecNotFound Module
mdl) = do
String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ String
"[T:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Module -> String
renderModule Module
thisModule
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"] Spec not found for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Module -> String
renderModule Module
mdl
TargetDependencies -> TcM TargetDependencies
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TargetDependencies
acc
processResult TargetDependencies
_ (SpecFound Module
originalModule SearchLocation
location BareSpec
_) = do
DynFlags
dynFlags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ String
"[T:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ModuleName -> String
forall a. Show a => a -> String
show (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
thisModule)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"] Spec found for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Module -> String
renderModule Module
originalModule String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", at location " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SearchLocation -> String
forall a. Show a => a -> String
show SearchLocation
location
String -> TcM TargetDependencies
forall (m :: * -> *) a. MonadIO m => String -> m a
Util.pluginAbort (DynFlags -> SDoc -> String
O.showSDoc DynFlags
dynFlags (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ String -> SDoc
forall doc. IsLine doc => String -> doc
O.text String
"A BareSpec was returned as a dependency, this is not allowed, in " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
O.<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
O.ppr Module
thisModule)
processResult !TargetDependencies
acc (LibFound Module
originalModule SearchLocation
location LiquidLib
lib) = do
String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ String
"[T:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ModuleName -> String
forall a. Show a => a -> String
show (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
thisModule)
String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"] Lib found for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Module -> String
renderModule Module
originalModule String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", at location " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SearchLocation -> String
forall a. Show a => a -> String
show SearchLocation
location
TargetDependencies -> TcM TargetDependencies
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TargetDependencies -> TcM TargetDependencies)
-> TargetDependencies -> TcM TargetDependencies
forall a b. (a -> b) -> a -> b
$ TargetDependencies {
getDependencies :: HashMap StableModule LiftedSpec
getDependencies = StableModule
-> LiftedSpec
-> HashMap StableModule LiftedSpec
-> HashMap StableModule LiftedSpec
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert (Module -> StableModule
toStableModule Module
originalModule) (LiquidLib -> LiftedSpec
libTarget LiquidLib
lib) (TargetDependencies -> HashMap StableModule LiftedSpec
getDependencies (TargetDependencies -> HashMap StableModule LiftedSpec)
-> TargetDependencies -> HashMap StableModule LiftedSpec
forall a b. (a -> b) -> a -> b
$ TargetDependencies
acc TargetDependencies -> TargetDependencies -> TargetDependencies
forall a. Semigroup a => a -> a -> a
<> LiquidLib -> TargetDependencies
libDeps LiquidLib
lib)
}
data LiquidHaskellContext = LiquidHaskellContext {
LiquidHaskellContext -> Config
lhGlobalCfg :: Config
, LiquidHaskellContext -> BareSpec
lhInputSpec :: BareSpec
, LiquidHaskellContext -> LogicMap
lhModuleLogicMap :: LogicMap
, LiquidHaskellContext -> ModSummary
lhModuleSummary :: ModSummary
, LiquidHaskellContext -> TcData
lhModuleTcData :: TcData
, LiquidHaskellContext -> ModGuts
lhModuleGuts :: ModGuts
, LiquidHaskellContext -> Set Module
lhRelevantModules :: Set Module
}
data ProcessModuleResult = ProcessModuleResult {
ProcessModuleResult -> LiquidLib
pmrClientLib :: LiquidLib
, ProcessModuleResult -> TargetInfo
pmrTargetInfo :: TargetInfo
}
getLiquidSpec :: FilePath -> Module -> [SpecComment] -> [BPspec] -> TcM (Either LiquidCheckException BareSpec)
getLiquidSpec :: String
-> Module
-> [SpecComment]
-> [BPspec]
-> TcM (Either LiquidCheckException BareSpec)
getLiquidSpec String
thisFile Module
thisModule [SpecComment]
specComments [BPspec]
specQuotes = do
Config
globalCfg <- IO Config -> IOEnv (Env TcGblEnv TcLclEnv) Config
forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Config
getConfig
let commSpecE :: Either [Error] (ModName, Spec LocBareType LocSymbol)
commSpecE :: Either [Error] (ModName, Spec LocBareType LocSymbol)
commSpecE = ModuleName
-> [(SourcePos, String)]
-> [BPspec]
-> Either [Error] (ModName, Spec LocBareType LocSymbol)
hsSpecificationP (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
thisModule) ([SpecComment] -> [(SourcePos, String)]
forall a b. Coercible a b => a -> b
coerce [SpecComment]
specComments) [BPspec]
specQuotes
case Either [Error] (ModName, Spec LocBareType LocSymbol)
commSpecE of
Left [Error]
errors ->
String
-> TcM (Either LiquidCheckException BareSpec)
-> TcM (Either LiquidCheckException BareSpec)
-> [Filter]
-> Tidy
-> [Error]
-> TcM (Either LiquidCheckException BareSpec)
forall e' a.
(Show e', PPrint e') =>
String
-> TcRn a -> TcRn a -> [Filter] -> Tidy -> [TError e'] -> TcRn a
LH.filterReportErrors String
thisFile TcM (Either LiquidCheckException BareSpec)
forall env a. IOEnv env a
GHC.failM TcM (Either LiquidCheckException BareSpec)
forall {b}.
IOEnv (Env TcGblEnv TcLclEnv) (Either LiquidCheckException b)
continue (Config -> [Filter]
getFilters Config
globalCfg) Tidy
Full [Error]
errors
Right (Spec LocBareType LocSymbol -> BareSpec
toBareSpec (Spec LocBareType LocSymbol -> BareSpec)
-> ((ModName, Spec LocBareType LocSymbol)
-> Spec LocBareType LocSymbol)
-> (ModName, Spec LocBareType LocSymbol)
-> BareSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModName, Spec LocBareType LocSymbol) -> Spec LocBareType LocSymbol
forall a b. (a, b) -> b
snd -> BareSpec
commSpec) -> do
HscEnv
env <- Env TcGblEnv TcLclEnv -> HscEnv
forall gbl lcl. Env gbl lcl -> HscEnv
env_top (Env TcGblEnv TcLclEnv -> HscEnv)
-> IOEnv (Env TcGblEnv TcLclEnv) (Env TcGblEnv TcLclEnv)
-> IOEnv (Env TcGblEnv TcLclEnv) HscEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOEnv (Env TcGblEnv TcLclEnv) (Env TcGblEnv TcLclEnv)
forall env. IOEnv env env
getEnv
SpecFinderResult
res <- IO SpecFinderResult
-> IOEnv (Env TcGblEnv TcLclEnv) SpecFinderResult
forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SpecFinderResult
-> IOEnv (Env TcGblEnv TcLclEnv) SpecFinderResult)
-> IO SpecFinderResult
-> IOEnv (Env TcGblEnv TcLclEnv) SpecFinderResult
forall a b. (a -> b) -> a -> b
$ HscEnv -> Module -> IO SpecFinderResult
SpecFinder.findCompanionSpec HscEnv
env Module
thisModule
case SpecFinderResult
res of
SpecFound Module
_ SearchLocation
_ BareSpec
companionSpec -> do
String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ String
"Companion spec found for " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Module -> String
renderModule Module
thisModule
Either LiquidCheckException BareSpec
-> TcM (Either LiquidCheckException BareSpec)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either LiquidCheckException BareSpec
-> TcM (Either LiquidCheckException BareSpec))
-> Either LiquidCheckException BareSpec
-> TcM (Either LiquidCheckException BareSpec)
forall a b. (a -> b) -> a -> b
$ BareSpec -> Either LiquidCheckException BareSpec
forall a b. b -> Either a b
Right (BareSpec -> Either LiquidCheckException BareSpec)
-> BareSpec -> Either LiquidCheckException BareSpec
forall a b. (a -> b) -> a -> b
$ BareSpec
commSpec BareSpec -> BareSpec -> BareSpec
forall a. Semigroup a => a -> a -> a
<> BareSpec
companionSpec
SpecFinderResult
_ -> Either LiquidCheckException BareSpec
-> TcM (Either LiquidCheckException BareSpec)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either LiquidCheckException BareSpec
-> TcM (Either LiquidCheckException BareSpec))
-> Either LiquidCheckException BareSpec
-> TcM (Either LiquidCheckException BareSpec)
forall a b. (a -> b) -> a -> b
$ BareSpec -> Either LiquidCheckException BareSpec
forall a b. b -> Either a b
Right BareSpec
commSpec
where
continue :: IOEnv (Env TcGblEnv TcLclEnv) (Either LiquidCheckException b)
continue = Either LiquidCheckException b
-> IOEnv (Env TcGblEnv TcLclEnv) (Either LiquidCheckException b)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either LiquidCheckException b
-> IOEnv (Env TcGblEnv TcLclEnv) (Either LiquidCheckException b))
-> Either LiquidCheckException b
-> IOEnv (Env TcGblEnv TcLclEnv) (Either LiquidCheckException b)
forall a b. (a -> b) -> a -> b
$ LiquidCheckException -> Either LiquidCheckException b
forall a b. a -> Either a b
Left ([Filter] -> LiquidCheckException
ErrorsOccurred [])
processModule :: LiquidHaskellContext -> TcM (Either LiquidCheckException ProcessModuleResult)
processModule :: LiquidHaskellContext
-> TcM (Either LiquidCheckException ProcessModuleResult)
processModule LiquidHaskellContext{Set Module
ModGuts
ModSummary
Config
LogicMap
BareSpec
TcData
lhGlobalCfg :: LiquidHaskellContext -> Config
lhInputSpec :: LiquidHaskellContext -> BareSpec
lhModuleLogicMap :: LiquidHaskellContext -> LogicMap
lhModuleSummary :: LiquidHaskellContext -> ModSummary
lhModuleTcData :: LiquidHaskellContext -> TcData
lhModuleGuts :: LiquidHaskellContext -> ModGuts
lhRelevantModules :: LiquidHaskellContext -> Set Module
lhGlobalCfg :: Config
lhInputSpec :: BareSpec
lhModuleLogicMap :: LogicMap
lhModuleSummary :: ModSummary
lhModuleTcData :: TcData
lhModuleGuts :: ModGuts
lhRelevantModules :: Set Module
..} = do
String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String
"Module ==> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Module -> String
renderModule Module
thisModule)
HscEnv
hscEnv <- Env TcGblEnv TcLclEnv -> HscEnv
forall gbl lcl. Env gbl lcl -> HscEnv
env_top (Env TcGblEnv TcLclEnv -> HscEnv)
-> IOEnv (Env TcGblEnv TcLclEnv) (Env TcGblEnv TcLclEnv)
-> IOEnv (Env TcGblEnv TcLclEnv) HscEnv
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOEnv (Env TcGblEnv TcLclEnv) (Env TcGblEnv TcLclEnv)
forall env. IOEnv env env
getEnv
let bareSpec :: BareSpec
bareSpec = BareSpec
lhInputSpec
let file :: String
file = ModSummary -> String
LH.modSummaryHsFile ModSummary
lhModuleSummary
()
_ <- IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ [Located String] -> IO ()
LH.checkFilePragmas ([Located String] -> IO ()) -> [Located String] -> IO ()
forall a b. (a -> b) -> a -> b
$ Spec LocBareType LocSymbol -> [Located String]
forall ty bndr. Spec ty bndr -> [Located String]
Ms.pragmas (BareSpec -> Spec LocBareType LocSymbol
fromBareSpec BareSpec
bareSpec)
Config
-> String
-> [Located String]
-> (Config
-> TcM (Either LiquidCheckException ProcessModuleResult))
-> TcM (Either LiquidCheckException ProcessModuleResult)
forall (m :: * -> *) a.
MonadIO m =>
Config -> String -> [Located String] -> (Config -> m a) -> m a
withPragmas Config
lhGlobalCfg String
file (Spec LocBareType LocSymbol -> [Located String]
forall ty bndr. Spec ty bndr -> [Located String]
Ms.pragmas (Spec LocBareType LocSymbol -> [Located String])
-> Spec LocBareType LocSymbol -> [Located String]
forall a b. (a -> b) -> a -> b
$ BareSpec -> Spec LocBareType LocSymbol
fromBareSpec BareSpec
bareSpec) ((Config -> TcM (Either LiquidCheckException ProcessModuleResult))
-> TcM (Either LiquidCheckException ProcessModuleResult))
-> (Config
-> TcM (Either LiquidCheckException ProcessModuleResult))
-> TcM (Either LiquidCheckException ProcessModuleResult)
forall a b. (a -> b) -> a -> b
$ \Config
moduleCfg -> do
TargetDependencies
dependencies <- Config -> Module -> [Module] -> TcM TargetDependencies
loadDependencies Config
moduleCfg
Module
thisModule
(Set Module -> [Module]
forall a. Set a -> [a]
S.toList Set Module
lhRelevantModules)
String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ String
"Found " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (HashMap StableModule LiftedSpec -> Int
forall k v. HashMap k v -> Int
HM.size (HashMap StableModule LiftedSpec -> Int)
-> HashMap StableModule LiftedSpec -> Int
forall a b. (a -> b) -> a -> b
$ TargetDependencies -> HashMap StableModule LiftedSpec
getDependencies TargetDependencies
dependencies) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" dependencies:"
Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debugLogs (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
[StableModule]
-> (StableModule -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (HashMap StableModule LiftedSpec -> [StableModule]
forall k v. HashMap k v -> [k]
HM.keys (HashMap StableModule LiftedSpec -> [StableModule])
-> (TargetDependencies -> HashMap StableModule LiftedSpec)
-> TargetDependencies
-> [StableModule]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TargetDependencies -> HashMap StableModule LiftedSpec
getDependencies (TargetDependencies -> [StableModule])
-> TargetDependencies -> [StableModule]
forall a b. (a -> b) -> a -> b
$ TargetDependencies
dependencies) ((StableModule -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> (StableModule -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> (StableModule -> String)
-> StableModule
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> String
moduleStableString (Module -> String)
-> (StableModule -> Module) -> StableModule -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StableModule -> Module
unStableModule
String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ String
"mg_exports => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SDoc -> String
O.showSDocUnsafe ([AvailInfo] -> SDoc
forall a. Outputable a => a -> SDoc
O.ppr ([AvailInfo] -> SDoc) -> [AvailInfo] -> SDoc
forall a b. (a -> b) -> a -> b
$ ModGuts -> [AvailInfo]
mg_exports ModGuts
modGuts)
String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ String
"mg_tcs => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SDoc -> String
O.showSDocUnsafe ([TyCon] -> SDoc
forall a. Outputable a => a -> SDoc
O.ppr ([TyCon] -> SDoc) -> [TyCon] -> SDoc
forall a b. (a -> b) -> a -> b
$ ModGuts -> [TyCon]
mg_tcs ModGuts
modGuts)
TargetSrc
targetSrc <- IO TargetSrc -> IOEnv (Env TcGblEnv TcLclEnv) TargetSrc
forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TargetSrc -> IOEnv (Env TcGblEnv TcLclEnv) TargetSrc)
-> IO TargetSrc -> IOEnv (Env TcGblEnv TcLclEnv) TargetSrc
forall a b. (a -> b) -> a -> b
$ Config -> String -> TcData -> ModGuts -> HscEnv -> IO TargetSrc
makeTargetSrc Config
moduleCfg String
file TcData
lhModuleTcData ModGuts
modGuts HscEnv
hscEnv
Logger
logger <- IOEnv (Env TcGblEnv TcLclEnv) Logger
forall (m :: * -> *). HasLogger m => m Logger
getLogger
Either Diagnostics ([Warning], TargetSpec, LiftedSpec)
result <-
Config
-> LogicMap
-> TargetSrc
-> BareSpec
-> TargetDependencies
-> TcRn (Either Diagnostics ([Warning], TargetSpec, LiftedSpec))
makeTargetSpec Config
moduleCfg LogicMap
lhModuleLogicMap TargetSrc
targetSrc BareSpec
bareSpec TargetDependencies
dependencies
let continue :: IOEnv (Env TcGblEnv TcLclEnv) (Either LiquidCheckException b)
continue = Either LiquidCheckException b
-> IOEnv (Env TcGblEnv TcLclEnv) (Either LiquidCheckException b)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either LiquidCheckException b
-> IOEnv (Env TcGblEnv TcLclEnv) (Either LiquidCheckException b))
-> Either LiquidCheckException b
-> IOEnv (Env TcGblEnv TcLclEnv) (Either LiquidCheckException b)
forall a b. (a -> b) -> a -> b
$ LiquidCheckException -> Either LiquidCheckException b
forall a b. a -> Either a b
Left ([Filter] -> LiquidCheckException
ErrorsOccurred [])
reportErrs :: (Show e, F.PPrint e) => [TError e] -> TcRn (Either LiquidCheckException ProcessModuleResult)
reportErrs :: forall e.
(Show e, PPrint e) =>
[TError e] -> TcM (Either LiquidCheckException ProcessModuleResult)
reportErrs = String
-> TcM (Either LiquidCheckException ProcessModuleResult)
-> TcM (Either LiquidCheckException ProcessModuleResult)
-> [Filter]
-> Tidy
-> [TError e]
-> TcM (Either LiquidCheckException ProcessModuleResult)
forall e' a.
(Show e', PPrint e') =>
String
-> TcRn a -> TcRn a -> [Filter] -> Tidy -> [TError e'] -> TcRn a
LH.filterReportErrors String
file TcM (Either LiquidCheckException ProcessModuleResult)
forall env a. IOEnv env a
GHC.failM TcM (Either LiquidCheckException ProcessModuleResult)
forall {b}.
IOEnv (Env TcGblEnv TcLclEnv) (Either LiquidCheckException b)
continue (Config -> [Filter]
getFilters Config
moduleCfg) Tidy
Full
(case Either Diagnostics ([Warning], TargetSpec, LiftedSpec)
result of
Left Diagnostics
diagnostics -> do
IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ (Warning -> IO ()) -> [Warning] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Logger -> Warning -> IO ()
printWarning Logger
logger) (Diagnostics -> [Warning]
allWarnings Diagnostics
diagnostics)
[Error] -> TcM (Either LiquidCheckException ProcessModuleResult)
forall e.
(Show e, PPrint e) =>
[TError e] -> TcM (Either LiquidCheckException ProcessModuleResult)
reportErrs ([Error] -> TcM (Either LiquidCheckException ProcessModuleResult))
-> [Error] -> TcM (Either LiquidCheckException ProcessModuleResult)
forall a b. (a -> b) -> a -> b
$ Diagnostics -> [Error]
allErrors Diagnostics
diagnostics
Right ([Warning]
warnings, TargetSpec
targetSpec, LiftedSpec
liftedSpec) -> do
IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IO () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ (Warning -> IO ()) -> [Warning] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Logger -> Warning -> IO ()
printWarning Logger
logger) [Warning]
warnings
let targetInfo :: TargetInfo
targetInfo = TargetSrc -> TargetSpec -> TargetInfo
TargetInfo TargetSrc
targetSrc TargetSpec
targetSpec
String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ String
"bareSpec ==> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ BareSpec -> String
forall a. Show a => a -> String
show BareSpec
bareSpec
String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> String -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ String
"liftedSpec ==> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ LiftedSpec -> String
forall a. Show a => a -> String
show LiftedSpec
liftedSpec
let clientLib :: LiquidLib
clientLib = LiftedSpec -> LiquidLib
mkLiquidLib LiftedSpec
liftedSpec LiquidLib -> (LiquidLib -> LiquidLib) -> LiquidLib
forall a b. a -> (a -> b) -> b
& TargetDependencies -> LiquidLib -> LiquidLib
addLibDependencies TargetDependencies
dependencies
let result' :: ProcessModuleResult
result' = ProcessModuleResult {
pmrClientLib :: LiquidLib
pmrClientLib = LiquidLib
clientLib
, pmrTargetInfo :: TargetInfo
pmrTargetInfo = TargetInfo
targetInfo
}
Either LiquidCheckException ProcessModuleResult
-> TcM (Either LiquidCheckException ProcessModuleResult)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either LiquidCheckException ProcessModuleResult
-> TcM (Either LiquidCheckException ProcessModuleResult))
-> Either LiquidCheckException ProcessModuleResult
-> TcM (Either LiquidCheckException ProcessModuleResult)
forall a b. (a -> b) -> a -> b
$ ProcessModuleResult
-> Either LiquidCheckException ProcessModuleResult
forall a b. b -> Either a b
Right ProcessModuleResult
result')
TcM (Either LiquidCheckException ProcessModuleResult)
-> (UserError
-> TcM (Either LiquidCheckException ProcessModuleResult))
-> TcM (Either LiquidCheckException ProcessModuleResult)
forall e a.
(HasCallStack, Exception e) =>
IOEnv (Env TcGblEnv TcLclEnv) a
-> (e -> IOEnv (Env TcGblEnv TcLclEnv) a)
-> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`Ex.catch` (\(UserError
e :: UserError) -> [UserError]
-> TcM (Either LiquidCheckException ProcessModuleResult)
forall e.
(Show e, PPrint e) =>
[TError e] -> TcM (Either LiquidCheckException ProcessModuleResult)
reportErrs [UserError
e])
TcM (Either LiquidCheckException ProcessModuleResult)
-> (Error -> TcM (Either LiquidCheckException ProcessModuleResult))
-> TcM (Either LiquidCheckException ProcessModuleResult)
forall e a.
(HasCallStack, Exception e) =>
IOEnv (Env TcGblEnv TcLclEnv) a
-> (e -> IOEnv (Env TcGblEnv TcLclEnv) a)
-> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`Ex.catch` (\(Error
e :: Error) -> [Error] -> TcM (Either LiquidCheckException ProcessModuleResult)
forall e.
(Show e, PPrint e) =>
[TError e] -> TcM (Either LiquidCheckException ProcessModuleResult)
reportErrs [Error
e])
TcM (Either LiquidCheckException ProcessModuleResult)
-> ([Error]
-> TcM (Either LiquidCheckException ProcessModuleResult))
-> TcM (Either LiquidCheckException ProcessModuleResult)
forall e a.
(HasCallStack, Exception e) =>
IOEnv (Env TcGblEnv TcLclEnv) a
-> (e -> IOEnv (Env TcGblEnv TcLclEnv) a)
-> IOEnv (Env TcGblEnv TcLclEnv) a
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
m a -> (e -> m a) -> m a
`Ex.catch` (\([Error]
es :: [Error]) -> [Error] -> TcM (Either LiquidCheckException ProcessModuleResult)
forall e.
(Show e, PPrint e) =>
[TError e] -> TcM (Either LiquidCheckException ProcessModuleResult)
reportErrs [Error]
es)
where
modGuts :: ModGuts
modGuts = ModGuts
lhModuleGuts
thisModule :: Module
thisModule = ModGuts -> Module
mg_module ModGuts
modGuts
makeTargetSrc :: Config
-> FilePath
-> TcData
-> ModGuts
-> HscEnv
-> IO TargetSrc
makeTargetSrc :: Config -> String -> TcData -> ModGuts -> HscEnv -> IO TargetSrc
makeTargetSrc Config
cfg String
file TcData
tcData ModGuts
modGuts HscEnv
hscEnv = do
[CoreBind]
coreBinds <- Config -> HscEnv -> ModGuts -> IO [CoreBind]
anormalize Config
cfg HscEnv
hscEnv ModGuts
modGuts
let availTcs :: [TyCon]
availTcs = TcData -> [TyCon]
tcAvailableTyCons TcData
tcData
let allTcs :: [TyCon]
allTcs = [TyCon] -> [TyCon]
forall a. Eq a => [a] -> [a]
L.nub (MGIModGuts -> [TyCon]
mgi_tcs MGIModGuts
mgiModGuts [TyCon] -> [TyCon] -> [TyCon]
forall a. [a] -> [a] -> [a]
++ [TyCon]
availTcs)
let dataCons :: [Id]
dataCons = (TyCon -> [Id]) -> [TyCon] -> [Id]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((DataCon -> Id) -> [DataCon] -> [Id]
forall a b. (a -> b) -> [a] -> [b]
map DataCon -> Id
dataConWorkId ([DataCon] -> [Id]) -> (TyCon -> [DataCon]) -> TyCon -> [Id]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> [DataCon]
tyConDataCons) [TyCon]
allTcs
let ([TyCon]
fiTcs, [(Symbol, DataCon)]
fiDcs) = [FamInst] -> ([TyCon], [(Symbol, DataCon)])
LH.makeFamInstEnv (ModGuts -> [FamInst]
getFamInstances ModGuts
modGuts)
let things :: [(Name, Maybe TyThing)]
things = TcData -> [(Name, Maybe TyThing)]
tcResolvedNames TcData
tcData
let impVars :: [Id]
impVars = [CoreBind] -> [Id]
LH.importVars [CoreBind]
coreBinds [Id] -> [Id] -> [Id]
forall a. [a] -> [a] -> [a]
++ Maybe [ClsInst] -> [Id]
LH.classCons (MGIModGuts -> Maybe [ClsInst]
mgi_cls_inst MGIModGuts
mgiModGuts)
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"_gsTcs => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TyCon] -> String
forall a. Show a => a -> String
show [TyCon]
allTcs
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"_gsFiTcs => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [TyCon] -> String
forall a. Show a => a -> String
show [TyCon]
fiTcs
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"_gsFiDcs => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(Symbol, DataCon)] -> String
forall a. Show a => a -> String
show [(Symbol, DataCon)]
fiDcs
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"dataCons => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Id] -> String
forall a. Show a => a -> String
show [Id]
dataCons
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"coreBinds => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SDoc -> String
O.showSDocUnsafe (SDoc -> String) -> ([CoreBind] -> SDoc) -> [CoreBind] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CoreBind] -> SDoc
forall a. Outputable a => a -> SDoc
O.ppr ([CoreBind] -> String) -> [CoreBind] -> String
forall a b. (a -> b) -> a -> b
$ [CoreBind]
coreBinds)
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"impVars => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SDoc -> String
O.showSDocUnsafe (SDoc -> String) -> ([Id] -> SDoc) -> [Id] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Id] -> SDoc
forall a. Outputable a => a -> SDoc
O.ppr ([Id] -> String) -> [Id] -> String
forall a b. (a -> b) -> a -> b
$ [Id]
impVars)
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"defVars => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Id] -> String
forall a. Show a => a -> String
show ([Id] -> [Id]
forall a. Eq a => [a] -> [a]
L.nub ([Id] -> [Id]) -> [Id] -> [Id]
forall a b. (a -> b) -> a -> b
$ [Id]
dataCons [Id] -> [Id] -> [Id]
forall a. [a] -> [a] -> [a]
++ [CoreBind] -> [Id]
forall a. CBVisitable a => a -> [Id]
letVars [CoreBind]
coreBinds [Id] -> [Id] -> [Id]
forall a. [a] -> [a] -> [a]
++ TcData -> [Id]
tcAvailableVars TcData
tcData)
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"useVars => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SDoc -> String
O.showSDocUnsafe (SDoc -> String) -> ([Id] -> SDoc) -> [Id] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Id] -> SDoc
forall a. Outputable a => a -> SDoc
O.ppr ([Id] -> String) -> [Id] -> String
forall a b. (a -> b) -> a -> b
$ [CoreBind] -> [Id]
forall a. CBVisitable a => a -> [Id]
readVars [CoreBind]
coreBinds)
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"derVars => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SDoc -> String
O.showSDocUnsafe (SDoc -> String) -> (HashSet Id -> SDoc) -> HashSet Id -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet Id -> SDoc
forall a. Outputable a => a -> SDoc
O.ppr (HashSet Id -> String) -> HashSet Id -> String
forall a b. (a -> b) -> a -> b
$ [Id] -> HashSet Id
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList (Config -> MGIModGuts -> [Id]
LH.derivedVars Config
cfg MGIModGuts
mgiModGuts))
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"gsExports => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ HashSet StableName -> String
forall a. Show a => a -> String
show (MGIModGuts -> HashSet StableName
mgi_exports MGIModGuts
mgiModGuts)
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"gsTcs => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SDoc -> String
O.showSDocUnsafe (SDoc -> String) -> ([TyCon] -> SDoc) -> [TyCon] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TyCon] -> SDoc
forall a. Outputable a => a -> SDoc
O.ppr ([TyCon] -> String) -> [TyCon] -> String
forall a b. (a -> b) -> a -> b
$ [TyCon]
allTcs)
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"gsCls => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SDoc -> String
O.showSDocUnsafe (SDoc -> String)
-> (Maybe [ClsInst] -> SDoc) -> Maybe [ClsInst] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [ClsInst] -> SDoc
forall a. Outputable a => a -> SDoc
O.ppr (Maybe [ClsInst] -> String) -> Maybe [ClsInst] -> String
forall a b. (a -> b) -> a -> b
$ MGIModGuts -> Maybe [ClsInst]
mgi_cls_inst MGIModGuts
mgiModGuts)
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"gsFiTcs => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SDoc -> String
O.showSDocUnsafe (SDoc -> String) -> ([TyCon] -> SDoc) -> [TyCon] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TyCon] -> SDoc
forall a. Outputable a => a -> SDoc
O.ppr ([TyCon] -> String) -> [TyCon] -> String
forall a b. (a -> b) -> a -> b
$ [TyCon]
fiTcs)
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"gsFiDcs => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(Symbol, DataCon)] -> String
forall a. Show a => a -> String
show [(Symbol, DataCon)]
fiDcs
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"gsPrimTcs => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SDoc -> String
O.showSDocUnsafe (SDoc -> String) -> ([TyCon] -> SDoc) -> [TyCon] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TyCon] -> SDoc
forall a. Outputable a => a -> SDoc
O.ppr ([TyCon] -> String) -> [TyCon] -> String
forall a b. (a -> b) -> a -> b
$ [TyCon]
GHC.primTyCons)
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"things => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (SDoc -> String
O.showSDocUnsafe (SDoc -> String)
-> ([(Name, Maybe TyThing)] -> SDoc)
-> [(Name, Maybe TyThing)]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
O.vcat ([SDoc] -> SDoc)
-> ([(Name, Maybe TyThing)] -> [SDoc])
-> [(Name, Maybe TyThing)]
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, Maybe TyThing) -> SDoc)
-> [(Name, Maybe TyThing)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Name, Maybe TyThing) -> SDoc
forall a. Outputable a => a -> SDoc
O.ppr ([(Name, Maybe TyThing)] -> String)
-> [(Name, Maybe TyThing)] -> String
forall a b. (a -> b) -> a -> b
$ [(Name, Maybe TyThing)]
things)
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"allImports => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ HashSet Symbol -> String
forall a. Show a => a -> String
show (TcData -> HashSet Symbol
tcAllImports TcData
tcData)
String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
debugLog (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"qualImports => " String -> ShowS
forall a. [a] -> [a] -> [a]
++ QImports -> String
forall a. Show a => a -> String
show (TcData -> QImports
tcQualifiedImports TcData
tcData)
TargetSrc -> IO TargetSrc
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TargetSrc -> IO TargetSrc) -> TargetSrc -> IO TargetSrc
forall a b. (a -> b) -> a -> b
$ TargetSrc
{ giTarget :: String
giTarget = String
file
, giTargetMod :: ModName
giTargetMod = ModType -> ModuleName -> ModName
ModName ModType
Target (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName (ModGuts -> Module
mg_module ModGuts
modGuts))
, giCbs :: [CoreBind]
giCbs = [CoreBind]
coreBinds
, giImpVars :: [Id]
giImpVars = [Id]
impVars
, giDefVars :: [Id]
giDefVars = [Id] -> [Id]
forall a. Eq a => [a] -> [a]
L.nub ([Id] -> [Id]) -> [Id] -> [Id]
forall a b. (a -> b) -> a -> b
$ [Id]
dataCons [Id] -> [Id] -> [Id]
forall a. [a] -> [a] -> [a]
++ [CoreBind] -> [Id]
forall a. CBVisitable a => a -> [Id]
letVars [CoreBind]
coreBinds [Id] -> [Id] -> [Id]
forall a. [a] -> [a] -> [a]
++ TcData -> [Id]
tcAvailableVars TcData
tcData
, giUseVars :: [Id]
giUseVars = [CoreBind] -> [Id]
forall a. CBVisitable a => a -> [Id]
readVars [CoreBind]
coreBinds
, giDerVars :: HashSet Id
giDerVars = [Id] -> HashSet Id
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList (Config -> MGIModGuts -> [Id]
LH.derivedVars Config
cfg MGIModGuts
mgiModGuts)
, gsExports :: HashSet StableName
gsExports = MGIModGuts -> HashSet StableName
mgi_exports MGIModGuts
mgiModGuts
, gsTcs :: [TyCon]
gsTcs = [TyCon]
allTcs
, gsCls :: Maybe [ClsInst]
gsCls = MGIModGuts -> Maybe [ClsInst]
mgi_cls_inst MGIModGuts
mgiModGuts
, gsFiTcs :: [TyCon]
gsFiTcs = [TyCon]
fiTcs
, gsFiDcs :: [(Symbol, DataCon)]
gsFiDcs = [(Symbol, DataCon)]
fiDcs
, gsPrimTcs :: [TyCon]
gsPrimTcs = [TyCon]
GHC.primTyCons
, gsQualImps :: QImports
gsQualImps = TcData -> QImports
tcQualifiedImports TcData
tcData
, gsAllImps :: HashSet Symbol
gsAllImps = TcData -> HashSet Symbol
tcAllImports TcData
tcData
, gsTyThings :: [TyThing]
gsTyThings = [ TyThing
t | (Name
_, Just TyThing
t) <- [(Name, Maybe TyThing)]
things ]
}
where
mgiModGuts :: MGIModGuts
mgiModGuts :: MGIModGuts
mgiModGuts = Maybe [ClsInst] -> ModGuts -> MGIModGuts
miModGuts Maybe [ClsInst]
deriv ModGuts
modGuts
where
deriv :: Maybe [ClsInst]
deriv = [ClsInst] -> Maybe [ClsInst]
forall a. a -> Maybe a
Just ([ClsInst] -> Maybe [ClsInst]) -> [ClsInst] -> Maybe [ClsInst]
forall a b. (a -> b) -> a -> b
$ InstEnv -> [ClsInst]
instEnvElts (InstEnv -> [ClsInst]) -> InstEnv -> [ClsInst]
forall a b. (a -> b) -> a -> b
$ ModGuts -> InstEnv
mg_inst_env ModGuts
modGuts
getFamInstances :: ModGuts -> [FamInst]
getFamInstances :: ModGuts -> [FamInst]
getFamInstances ModGuts
guts = FamInstEnv -> [FamInst]
famInstEnvElts (ModGuts -> FamInstEnv
mg_fam_inst_env ModGuts
guts)