{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
module Language.Haskell.Liquid.GHC.Plugin.Types
( SpecComment(..)
, LiquidLib
, mkLiquidLib
, libTarget
, libDeps
, allDeps
, addLibDependencies
, CachedSpec
, toCached
, cachedSpecStableModuleId
, cachedSpecModule
, fromCached
, InputSpec
, CompanionSpec
, LiquidSpec
, downcastSpec
, mkInputSpec
, mkCompanionSpec
, mergeInputWithCompanion
, PipelineData(..)
, TcData
, tcAllImports
, tcQualifiedImports
, tcResolvedNames
, tcAvailableTyCons
, tcAvailableVars
, mkTcData
, Unoptimised(fromUnoptimised)
, toUnoptimised
) where
import Data.Binary as B
import Data.Data ( Data )
import Data.Foldable
import Outputable hiding ( (<>) )
import GHC.Generics hiding ( moduleName )
import HscTypes (ModGuts)
import GHC ( Name
, TyThing
, TyCon
, LImportDecl
, GhcRn
)
import Var ( Var )
import Module ( Module, moduleStableString )
import qualified Data.HashSet as HS
import Data.Hashable
import Language.Fixpoint.Types.Spans
import Language.Haskell.Liquid.Types.Specs
import qualified Language.Haskell.Liquid.GHC.Interface as LH
import Language.Fixpoint.Types.Names ( Symbol )
data LiquidLib = LiquidLib
{ LiquidLib -> LiftedSpec
llTarget :: LiftedSpec
, LiquidLib -> TargetDependencies
llDeps :: TargetDependencies
} deriving (Int -> LiquidLib -> ShowS
[LiquidLib] -> ShowS
LiquidLib -> String
(Int -> LiquidLib -> ShowS)
-> (LiquidLib -> String)
-> ([LiquidLib] -> ShowS)
-> Show LiquidLib
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LiquidLib] -> ShowS
$cshowList :: [LiquidLib] -> ShowS
show :: LiquidLib -> String
$cshow :: LiquidLib -> String
showsPrec :: Int -> LiquidLib -> ShowS
$cshowsPrec :: Int -> LiquidLib -> ShowS
Show, (forall x. LiquidLib -> Rep LiquidLib x)
-> (forall x. Rep LiquidLib x -> LiquidLib) -> Generic LiquidLib
forall x. Rep LiquidLib x -> LiquidLib
forall x. LiquidLib -> Rep LiquidLib x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LiquidLib x -> LiquidLib
$cfrom :: forall x. LiquidLib -> Rep LiquidLib x
Generic)
instance B.Binary LiquidLib
mkLiquidLib :: LiftedSpec -> LiquidLib
mkLiquidLib :: LiftedSpec -> LiquidLib
mkLiquidLib LiftedSpec
s = LiftedSpec -> TargetDependencies -> LiquidLib
LiquidLib LiftedSpec
s TargetDependencies
forall a. Monoid a => a
mempty
addLibDependencies :: TargetDependencies -> LiquidLib -> LiquidLib
addLibDependencies :: TargetDependencies -> LiquidLib -> LiquidLib
addLibDependencies TargetDependencies
deps LiquidLib
lib = LiquidLib
lib { llDeps :: TargetDependencies
llDeps = TargetDependencies
deps TargetDependencies -> TargetDependencies -> TargetDependencies
forall a. Semigroup a => a -> a -> a
<> (LiquidLib -> TargetDependencies
llDeps LiquidLib
lib) }
libTarget :: LiquidLib -> LiftedSpec
libTarget :: LiquidLib -> LiftedSpec
libTarget = LiquidLib -> LiftedSpec
llTarget
libDeps :: LiquidLib -> TargetDependencies
libDeps :: LiquidLib -> TargetDependencies
libDeps = LiquidLib -> TargetDependencies
llDeps
allDeps :: Foldable f => f LiquidLib -> TargetDependencies
allDeps :: f LiquidLib -> TargetDependencies
allDeps = (TargetDependencies -> LiquidLib -> TargetDependencies)
-> TargetDependencies -> f LiquidLib -> TargetDependencies
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\TargetDependencies
acc LiquidLib
lib -> TargetDependencies
acc TargetDependencies -> TargetDependencies -> TargetDependencies
forall a. Semigroup a => a -> a -> a
<> LiquidLib -> TargetDependencies
llDeps LiquidLib
lib) TargetDependencies
forall a. Monoid a => a
mempty
data CachedSpec = CachedSpec StableModule LiftedSpec deriving (Int -> CachedSpec -> ShowS
[CachedSpec] -> ShowS
CachedSpec -> String
(Int -> CachedSpec -> ShowS)
-> (CachedSpec -> String)
-> ([CachedSpec] -> ShowS)
-> Show CachedSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CachedSpec] -> ShowS
$cshowList :: [CachedSpec] -> ShowS
show :: CachedSpec -> String
$cshow :: CachedSpec -> String
showsPrec :: Int -> CachedSpec -> ShowS
$cshowsPrec :: Int -> CachedSpec -> ShowS
Show, (forall x. CachedSpec -> Rep CachedSpec x)
-> (forall x. Rep CachedSpec x -> CachedSpec) -> Generic CachedSpec
forall x. Rep CachedSpec x -> CachedSpec
forall x. CachedSpec -> Rep CachedSpec x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CachedSpec x -> CachedSpec
$cfrom :: forall x. CachedSpec -> Rep CachedSpec x
Generic)
instance Binary CachedSpec
instance Eq CachedSpec where
(CachedSpec StableModule
id1 LiftedSpec
_) == :: CachedSpec -> CachedSpec -> Bool
== (CachedSpec StableModule
id2 LiftedSpec
_) = StableModule
id1 StableModule -> StableModule -> Bool
forall a. Eq a => a -> a -> Bool
== StableModule
id2
instance Hashable CachedSpec where
hashWithSalt :: Int -> CachedSpec -> Int
hashWithSalt Int
s (CachedSpec (StableModule Module
mdl) LiftedSpec
_) =
Int -> String -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Module -> String
moduleStableString Module
mdl)
toCached :: Module -> LiftedSpec -> CachedSpec
toCached :: Module -> LiftedSpec -> CachedSpec
toCached Module
mdl LiftedSpec
liftedSpec = StableModule -> LiftedSpec -> CachedSpec
CachedSpec (Module -> StableModule
toStableModule Module
mdl) LiftedSpec
liftedSpec
cachedSpecStableModuleId :: CachedSpec -> String
cachedSpecStableModuleId :: CachedSpec -> String
cachedSpecStableModuleId (CachedSpec (StableModule Module
m) LiftedSpec
_) = Module -> String
moduleStableString Module
m
cachedSpecModule :: CachedSpec -> Module
cachedSpecModule :: CachedSpec -> Module
cachedSpecModule (CachedSpec (StableModule Module
m) LiftedSpec
_) = Module
m
fromCached :: CachedSpec -> (StableModule, LiftedSpec)
fromCached :: CachedSpec -> (StableModule, LiftedSpec)
fromCached (CachedSpec StableModule
sm LiftedSpec
s) = (StableModule
sm, LiftedSpec
s)
data InputSpec
data CompanionSpec
data LiquidSpec t where
MkInputSpec :: BareSpec -> LiquidSpec InputSpec
MkCompanionSpec :: BareSpec -> LiquidSpec CompanionSpec
deriving instance Show (LiquidSpec InputSpec)
deriving instance Show (LiquidSpec CompanionSpec)
mkInputSpec :: BareSpec -> LiquidSpec InputSpec
mkInputSpec :: BareSpec -> LiquidSpec InputSpec
mkInputSpec = BareSpec -> LiquidSpec InputSpec
MkInputSpec
mkCompanionSpec :: BareSpec -> LiquidSpec CompanionSpec
mkCompanionSpec :: BareSpec -> LiquidSpec CompanionSpec
mkCompanionSpec = BareSpec -> LiquidSpec CompanionSpec
MkCompanionSpec
downcastSpec :: LiquidSpec t -> BareSpec
downcastSpec :: LiquidSpec t -> BareSpec
downcastSpec = \case
MkInputSpec BareSpec
s -> BareSpec
s
MkCompanionSpec BareSpec
s -> BareSpec
s
mergeInputWithCompanion :: LiquidSpec InputSpec -> LiquidSpec CompanionSpec -> LiquidSpec InputSpec
mergeInputWithCompanion :: LiquidSpec InputSpec
-> LiquidSpec CompanionSpec -> LiquidSpec InputSpec
mergeInputWithCompanion (MkInputSpec BareSpec
s1) (MkCompanionSpec BareSpec
s2) = BareSpec -> LiquidSpec InputSpec
MkInputSpec (BareSpec
s1 BareSpec -> BareSpec -> BareSpec
forall a. Semigroup a => a -> a -> a
<> BareSpec
s2)
newtype =
(SourcePos, String)
deriving (Int -> SpecComment -> ShowS
[SpecComment] -> ShowS
SpecComment -> String
(Int -> SpecComment -> ShowS)
-> (SpecComment -> String)
-> ([SpecComment] -> ShowS)
-> Show SpecComment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpecComment] -> ShowS
$cshowList :: [SpecComment] -> ShowS
show :: SpecComment -> String
$cshow :: SpecComment -> String
showsPrec :: Int -> SpecComment -> ShowS
$cshowsPrec :: Int -> SpecComment -> ShowS
Show, )
newtype Unoptimised a = Unoptimised { Unoptimised a -> a
fromUnoptimised :: a }
toUnoptimised :: a -> Unoptimised a
toUnoptimised :: a -> Unoptimised a
toUnoptimised = a -> Unoptimised a
forall a. a -> Unoptimised a
Unoptimised
data PipelineData = PipelineData {
PipelineData -> Unoptimised ModGuts
pdUnoptimisedCore :: Unoptimised ModGuts
, PipelineData -> TcData
pdTcData :: TcData
, :: [SpecComment]
}
data TcData = TcData {
TcData -> HashSet Symbol
tcAllImports :: HS.HashSet Symbol
, TcData -> QImports
tcQualifiedImports :: QImports
, TcData -> [(Name, Maybe TyThing)]
tcResolvedNames :: [(Name, Maybe TyThing)]
, TcData -> [TyCon]
tcAvailableTyCons :: [GHC.TyCon]
, TcData -> [Var]
tcAvailableVars :: [Var]
}
instance Outputable TcData where
ppr :: TcData -> SDoc
ppr (TcData{[(Name, Maybe TyThing)]
[Var]
[TyCon]
HashSet Symbol
QImports
tcAvailableVars :: [Var]
tcAvailableTyCons :: [TyCon]
tcResolvedNames :: [(Name, Maybe TyThing)]
tcQualifiedImports :: QImports
tcAllImports :: HashSet Symbol
tcAvailableVars :: TcData -> [Var]
tcAvailableTyCons :: TcData -> [TyCon]
tcResolvedNames :: TcData -> [(Name, Maybe TyThing)]
tcQualifiedImports :: TcData -> QImports
tcAllImports :: TcData -> HashSet Symbol
..}) =
String -> SDoc
text String
"TcData { imports = " SDoc -> SDoc -> SDoc
<+> String -> SDoc
text ([Symbol] -> String
forall a. Show a => a -> String
show ([Symbol] -> String) -> [Symbol] -> String
forall a b. (a -> b) -> a -> b
$ HashSet Symbol -> [Symbol]
forall a. HashSet a -> [a]
HS.toList HashSet Symbol
tcAllImports)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
" , qImports = " SDoc -> SDoc -> SDoc
<+> String -> SDoc
text (QImports -> String
forall a. Show a => a -> String
show QImports
tcQualifiedImports)
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
" , names = " SDoc -> SDoc -> SDoc
<+> [(Name, Maybe TyThing)] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [(Name, Maybe TyThing)]
tcResolvedNames
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
" , availTyCons = " SDoc -> SDoc -> SDoc
<+> [TyCon] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TyCon]
tcAvailableTyCons
SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
" }"
mkTcData :: [LImportDecl GhcRn]
-> [(Name, Maybe TyThing)]
-> [TyCon]
-> [Var]
-> TcData
mkTcData :: [LImportDecl GhcRn]
-> [(Name, Maybe TyThing)] -> [TyCon] -> [Var] -> TcData
mkTcData [LImportDecl GhcRn]
imps [(Name, Maybe TyThing)]
resolvedNames [TyCon]
availTyCons [Var]
availVars = TcData :: HashSet Symbol
-> QImports
-> [(Name, Maybe TyThing)]
-> [TyCon]
-> [Var]
-> TcData
TcData {
tcAllImports :: HashSet Symbol
tcAllImports = [LImportDecl GhcRn] -> HashSet Symbol
LH.allImports [LImportDecl GhcRn]
imps
, tcQualifiedImports :: QImports
tcQualifiedImports = [LImportDecl GhcRn] -> QImports
LH.qualifiedImports [LImportDecl GhcRn]
imps
, tcResolvedNames :: [(Name, Maybe TyThing)]
tcResolvedNames = [(Name, Maybe TyThing)]
resolvedNames
, tcAvailableTyCons :: [TyCon]
tcAvailableTyCons = [TyCon]
availTyCons
, tcAvailableVars :: [Var]
tcAvailableVars = [Var]
availVars
}