Commit 6c0f10fa authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari

Kill Type pretty-printer

Here we consolidate the pretty-printing logic for types in IfaceType. We
need IfaceType regardless and the printer for Type can be implemented in
terms of that for IfaceType. See #11660.

Note that this is very much a work-in-progress. Namely I still have yet
to ponder how to ease the hs-boot file situation, still need to rip out
more dead code, need to move some of the special cases for, e.g., `*` to
the IfaceType printer, and need to get it to validate. That being said,
it comes close to validating as-is.

Test Plan: Validate

Reviewers: goldfire, austin

Subscribers: goldfire, thomie, simonpj

Differential Revision: https://phabricator.haskell.org/D2528

GHC Trac Issues: #11660
parent 8cb7bc5c
......@@ -19,6 +19,9 @@ types that
module BasicTypes(
Version, bumpVersion, initialVersion,
LeftOrRight(..),
pickLR,
ConTag, ConTagZ, fIRST_TAG,
Arity, RepArity,
......@@ -48,6 +51,8 @@ module BasicTypes(
Boxity(..), isBoxed,
TyPrec(..), maybeParen,
TupleSort(..), tupleSortBoxity, boxityTupleSort,
tupleParens,
......@@ -102,6 +107,25 @@ import StaticFlags( opt_PprStyle_Debug )
import Data.Data hiding (Fixity)
import Data.Function (on)
{-
************************************************************************
* *
Binary choice
* *
************************************************************************
-}
data LeftOrRight = CLeft | CRight
deriving( Eq, Data )
pickLR :: LeftOrRight -> (a,a) -> a
pickLR CLeft (l,_) = l
pickLR CRight (_,r) = r
instance Outputable LeftOrRight where
ppr CLeft = text "Left"
ppr CRight = text "Right"
{-
************************************************************************
* *
......@@ -624,6 +648,26 @@ pprSafeOverlap :: Bool -> SDoc
pprSafeOverlap True = text "[safe]"
pprSafeOverlap False = empty
{-
************************************************************************
* *
Type precedence
* *
************************************************************************
-}
data TyPrec -- See Note [Prededence in types]
= TopPrec -- No parens
| FunPrec -- Function args; no parens for tycon apps
| TyOpPrec -- Infix operator
| TyConPrec -- Tycon args; no parens for atomic
deriving( Eq, Ord )
maybeParen :: TyPrec -> TyPrec -> SDoc -> SDoc
maybeParen ctxt_prec inner_prec pretty
| ctxt_prec < inner_prec = pretty
| otherwise = parens pretty
{-
************************************************************************
* *
......
......@@ -1003,7 +1003,7 @@ lintCoBndr cv thing_inside
; let (subst', cv') = substCoVarBndr subst cv
; lintKind (varType cv')
; lintL (isCoercionType (varType cv'))
(text "CoVar with non-coercion type:" <+> pprTvBndr cv)
(text "CoVar with non-coercion type:" <+> pprTyVar cv)
; updateTCvSubst subst' (thing_inside cv') }
lintIdBndr :: Id -> (Id -> LintM a) -> LintM a
......
......@@ -378,7 +378,7 @@ pprTypedLetBinder binder
pprKindedTyVarBndr :: TyVar -> SDoc
-- Print a type variable binder with its kind (but not if *)
pprKindedTyVarBndr tyvar
= text "@" <+> pprTvBndr tyvar
= text "@" <+> pprTyVar tyvar
-- pprIdBndr does *not* print the type
-- When printing any Id binder in debug mode, we print its inline pragma and one-shot-ness
......
......@@ -314,6 +314,7 @@ Library
IfaceEnv
IfaceSyn
IfaceType
ToIface
LoadIface
MkIface
TcIface
......
......@@ -493,6 +493,7 @@ compiler_stage2_dll0_MODULES = \
IdInfo \
IfaceSyn \
IfaceType \
ToIface \
InstEnv \
Kind \
KnownUniques \
......
......@@ -62,6 +62,7 @@ import Fingerprint
import Binary
import BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue )
import Var( TyVarBndr(..) )
import Type ( TyPrec(..) )
import TyCon ( Role (..), Injectivity(..), HowAbstract(..) )
import StaticFlags (opt_PprStyle_Debug)
import Util( filterOut, filterByList )
......@@ -540,9 +541,10 @@ pprAxBranch pp_tc (IfaceAxBranch { ifaxbTyVars = tvs
where
ppr_binders
| null tvs && null cvs = empty
| null cvs = brackets (pprWithCommas pprIfaceTvBndr tvs)
| null cvs
= brackets (pprWithCommas (pprIfaceTvBndr True) tvs)
| otherwise
= brackets (pprWithCommas pprIfaceTvBndr tvs <> semi <+>
= brackets (pprWithCommas (pprIfaceTvBndr True) tvs <> semi <+>
pprWithCommas pprIfaceIdBndr cvs)
pp_lhs = hang pp_tc 2 (pprParendIfaceTcArgs pat_tys)
maybe_incomps = ppUnless (null incomps) $ parens $
......@@ -876,7 +878,7 @@ pprIfaceTyConParent IfNoParent
pprIfaceTyConParent (IfDataInstance _ tc tys)
= sdocWithDynFlags $ \dflags ->
let ftys = stripInvisArgs dflags tys
in pprIfaceTypeApp tc ftys
in pprIfaceTypeApp TopPrec tc ftys
pprIfaceDeclHead :: IfaceContext -> ShowSub -> Name
-> [IfaceTyConBinder] -- of the tycon, for invisible-suppression
......@@ -1336,6 +1338,7 @@ freeNamesIfProv IfaceUnsafeCoerceProv = emptyNameSet
freeNamesIfProv (IfacePhantomProv co) = freeNamesIfCoercion co
freeNamesIfProv (IfaceProofIrrelProv co) = freeNamesIfCoercion co
freeNamesIfProv (IfacePluginProv _) = emptyNameSet
freeNamesIfProv (IfaceHoleProv _) = emptyNameSet
freeNamesIfTyVarBndr :: TyVarBndr IfaceTvBndr vis -> NameSet
freeNamesIfTyVarBndr (TvBndr tv _) = freeNamesIfTvBndr tv
......
This diff is collapsed.
-- Exists to allow TyCoRep to import pretty-printers
module IfaceType where
import Var (TyVarBndr, ArgFlag)
import TyCon (TyConBndrVis)
import BasicTypes (TyPrec)
import Outputable (Outputable, SDoc)
import FastString (FastString)
type IfLclName = FastString
type IfaceKind = IfaceType
type IfacePredType = IfaceType
data IfaceType
data IfaceTyCon
data IfaceTyLit
data IfaceCoercion
data IfaceTcArgs
type IfaceTvBndr = (IfLclName, IfaceKind)
type IfaceTyConBinder = TyVarBndr IfaceTvBndr TyConBndrVis
type IfaceForAllBndr = TyVarBndr IfaceTvBndr ArgFlag
instance Outputable IfaceType
pprIfaceType, pprParendIfaceType :: IfaceType -> SDoc
pprIfaceSigmaType :: IfaceType -> SDoc
pprIfaceTyLit :: IfaceTyLit -> SDoc
pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprIfaceTvBndr :: Bool -> IfaceTvBndr -> SDoc
pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
pprIfaceContext :: [IfacePredType] -> SDoc
pprIfaceContextArr :: [IfacePredType] -> SDoc
pprIfaceTypeApp :: TyPrec -> IfaceTyCon -> IfaceTcArgs -> SDoc
pprIfaceCoTcApp :: TyPrec -> IfaceTyCon -> [IfaceCoercion] -> SDoc
pprTyTcApp :: TyPrec -> IfaceTyCon -> IfaceTcArgs -> SDoc
pprIfacePrefixApp :: TyPrec -> SDoc -> [SDoc] -> SDoc
......@@ -61,13 +61,11 @@ Basic idea:
import IfaceSyn
import BinFingerprint
import LoadIface
import ToIface
import FlagChecker
import Desugar ( mkUsageInfo, mkUsedNames, mkDependencies )
import Id
import IdInfo
import Demand
import Coercion( tidyCo )
import Annotations
import CoreSyn
import Class
......@@ -75,7 +73,6 @@ import TyCon
import CoAxiom
import ConLike
import DataCon
import PatSyn
import Type
import TcType
import InstEnv
......@@ -110,7 +107,6 @@ import Fingerprint
import Exception
import UniqFM
import UniqDFM
import MkId
import Control.Monad
import Data.Function
......@@ -1458,29 +1454,6 @@ dataConToIfaceDecl dataCon
ifIdDetails = IfVanillaId,
ifIdInfo = NoInfo }
--------------------------
patSynToIfaceDecl :: PatSyn -> IfaceDecl
patSynToIfaceDecl ps
= IfacePatSyn { ifName = getName $ ps
, ifPatMatcher = to_if_pr (patSynMatcher ps)
, ifPatBuilder = fmap to_if_pr (patSynBuilder ps)
, ifPatIsInfix = patSynIsInfix ps
, ifPatUnivBndrs = map toIfaceForAllBndr univ_bndrs'
, ifPatExBndrs = map toIfaceForAllBndr ex_bndrs'
, ifPatProvCtxt = tidyToIfaceContext env2 prov_theta
, ifPatReqCtxt = tidyToIfaceContext env2 req_theta
, ifPatArgs = map (tidyToIfaceType env2) args
, ifPatTy = tidyToIfaceType env2 rhs_ty
, ifFieldLabels = (patSynFieldLabels ps)
}
where
(_univ_tvs, req_theta, _ex_tvs, prov_theta, args, rhs_ty) = patSynSig ps
univ_bndrs = patSynUnivTyVarBinders ps
ex_bndrs = patSynExTyVarBinders ps
(env1, univ_bndrs') = tidyTyVarBinders emptyTidyEnv univ_bndrs
(env2, ex_bndrs') = tidyTyVarBinders env1 ex_bndrs
to_if_pr (id, needs_dummy) = (idName id, needs_dummy)
--------------------------
coAxiomToIfaceDecl :: CoAxiom br -> IfaceDecl
-- We *do* tidy Axioms, because they are not (and cannot
......@@ -1658,15 +1631,6 @@ tyConToIfaceDecl env tycon
[] -> False
ifaceFields flds = map flLabel $ dFsEnvElts flds
toIfaceBang :: TidyEnv -> HsImplBang -> IfaceBang
toIfaceBang _ HsLazy = IfNoBang
toIfaceBang _ (HsUnpack Nothing) = IfUnpack
toIfaceBang env (HsUnpack (Just co)) = IfUnpackCo (toIfaceCoercion (tidyCo env co))
toIfaceBang _ HsStrict = IfStrict
toIfaceSrcBang :: HsSrcBang -> IfaceSrcBang
toIfaceSrcBang (HsSrcBang _ unpk bang) = IfSrcBang unpk bang
classToIfaceDecl :: TidyEnv -> Class -> (TidyEnv, IfaceDecl)
classToIfaceDecl env clas
= ( env1
......@@ -1713,20 +1677,6 @@ classToIfaceDecl env clas
,map (tidyTyVar env1) tvs2)
--------------------------
tidyToIfaceType :: TidyEnv -> Type -> IfaceType
tidyToIfaceType env ty = toIfaceType (tidyType env ty)
tidyToIfaceTcArgs :: TidyEnv -> TyCon -> [Type] -> IfaceTcArgs
tidyToIfaceTcArgs env tc tys = toIfaceTcArgs tc (tidyTypes env tys)
tidyToIfaceContext :: TidyEnv -> ThetaType -> IfaceContext
tidyToIfaceContext env theta = map (tidyToIfaceType env) theta
toIfaceTyVarBinder :: TyVarBndr TyVar vis -> TyVarBndr IfaceTvBndr vis
toIfaceTyVarBinder (TvBndr tv vis) = TvBndr (toIfaceTvBndr tv) vis
toIfaceTyVarBinders :: [TyVarBndr TyVar vis] -> [TyVarBndr IfaceTvBndr vis]
toIfaceTyVarBinders = map toIfaceTyVarBinder
tidyTyConBinder :: TidyEnv -> TyConBinder -> (TidyEnv, TyConBinder)
-- If the type variable "binder" is in scope, don't re-bind it
......@@ -1787,94 +1737,6 @@ famInstToIfaceFamInst (FamInst { fi_axiom = axiom,
| otherwise
= chooseOrphanAnchor lhs_names
--------------------------
toIfaceLetBndr :: Id -> IfaceLetBndr
toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id))
(toIfaceType (idType id))
(toIfaceIdInfo (idInfo id))
-- Put into the interface file any IdInfo that CoreTidy.tidyLetBndr
-- has left on the Id. See Note [IdInfo on nested let-bindings] in IfaceSyn
--------------------------t
toIfaceIdDetails :: IdDetails -> IfaceIdDetails
toIfaceIdDetails VanillaId = IfVanillaId
toIfaceIdDetails (DFunId {}) = IfDFunId
toIfaceIdDetails (RecSelId { sel_naughty = n
, sel_tycon = tc }) =
let iface = case tc of
RecSelData ty_con -> Left (toIfaceTyCon ty_con)
RecSelPatSyn pat_syn -> Right (patSynToIfaceDecl pat_syn)
in IfRecSelId iface n
-- The remaining cases are all "implicit Ids" which don't
-- appear in interface files at all
toIfaceIdDetails other = pprTrace "toIfaceIdDetails" (ppr other)
IfVanillaId -- Unexpected; the other
toIfaceIdInfo :: IdInfo -> IfaceIdInfo
toIfaceIdInfo id_info
= case catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,
inline_hsinfo, unfold_hsinfo] of
[] -> NoInfo
infos -> HasInfo infos
-- NB: strictness and arity must appear in the list before unfolding
-- See TcIface.tcUnfolding
where
------------ Arity --------------
arity_info = arityInfo id_info
arity_hsinfo | arity_info == 0 = Nothing
| otherwise = Just (HsArity arity_info)
------------ Caf Info --------------
caf_info = cafInfo id_info
caf_hsinfo = case caf_info of
NoCafRefs -> Just HsNoCafRefs
_other -> Nothing
------------ Strictness --------------
-- No point in explicitly exporting TopSig
sig_info = strictnessInfo id_info
strict_hsinfo | not (isTopSig sig_info) = Just (HsStrictness sig_info)
| otherwise = Nothing
------------ Unfolding --------------
unfold_hsinfo = toIfUnfolding loop_breaker (unfoldingInfo id_info)
loop_breaker = isStrongLoopBreaker (occInfo id_info)
------------ Inline prag --------------
inline_prag = inlinePragInfo id_info
inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
| otherwise = Just (HsInline inline_prag)
--------------------------
toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs
, uf_src = src
, uf_guidance = guidance })
= Just $ HsUnfold lb $
case src of
InlineStable
-> case guidance of
UnfWhen {ug_arity = arity, ug_unsat_ok = unsat_ok, ug_boring_ok = boring_ok }
-> IfInlineRule arity unsat_ok boring_ok if_rhs
_other -> IfCoreUnfold True if_rhs
InlineCompulsory -> IfCompulsory if_rhs
InlineRhs -> IfCoreUnfold False if_rhs
-- Yes, even if guidance is UnfNever, expose the unfolding
-- If we didn't want to expose the unfolding, TidyPgm would
-- have stuck in NoUnfolding. For supercompilation we want
-- to see that unfolding!
where
if_rhs = toIfaceExpr rhs
toIfUnfolding lb (DFunUnfolding { df_bndrs = bndrs, df_args = args })
= Just (HsUnfold lb (IfDFunUnfold (map toIfaceBndr bndrs) (map toIfaceExpr args)))
-- No need to serialise the data constructor;
-- we can recover it from the type of the dfun
toIfUnfolding _ _
= Nothing
--------------------------
coreRuleToIfaceRule :: CoreRule -> IfaceRule
coreRuleToIfaceRule (BuiltinRule { ru_fn = fn})
......@@ -1909,89 +1771,6 @@ bogusIfaceRule id_name
ifRuleAuto = True }
---------------------
toIfaceExpr :: CoreExpr -> IfaceExpr
toIfaceExpr (Var v) = toIfaceVar v
toIfaceExpr (Lit l) = IfaceLit l
toIfaceExpr (Type ty) = IfaceType (toIfaceType ty)
toIfaceExpr (Coercion co) = IfaceCo (toIfaceCoercion co)
toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x, toIfaceOneShot x) (toIfaceExpr b)
toIfaceExpr (App f a) = toIfaceApp f [a]
toIfaceExpr (Case s x ty as)
| null as = IfaceECase (toIfaceExpr s) (toIfaceType ty)
| otherwise = IfaceCase (toIfaceExpr s) (getOccFS x) (map toIfaceAlt as)
toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e)
toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceCoercion co)
toIfaceExpr (Tick t e)
| Just t' <- toIfaceTickish t = IfaceTick t' (toIfaceExpr e)
| otherwise = toIfaceExpr e
toIfaceOneShot :: Id -> IfaceOneShot
toIfaceOneShot id | isId id
, OneShotLam <- oneShotInfo (idInfo id)
= IfaceOneShot
| otherwise
= IfaceNoOneShot
---------------------
toIfaceTickish :: Tickish Id -> Maybe IfaceTickish
toIfaceTickish (ProfNote cc tick push) = Just (IfaceSCC cc tick push)
toIfaceTickish (HpcTick modl ix) = Just (IfaceHpcTick modl ix)
toIfaceTickish (SourceNote src names) = Just (IfaceSource src names)
toIfaceTickish (Breakpoint {}) = Nothing
-- Ignore breakpoints, since they are relevant only to GHCi, and
-- should not be serialised (Trac #8333)
---------------------
toIfaceBind :: Bind Id -> IfaceBinding
toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r)
toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs]
---------------------
toIfaceAlt :: (AltCon, [Var], CoreExpr)
-> (IfaceConAlt, [FastString], IfaceExpr)
toIfaceAlt (c,bs,r) = (toIfaceCon c, map getOccFS bs, toIfaceExpr r)
---------------------
toIfaceCon :: AltCon -> IfaceConAlt
toIfaceCon (DataAlt dc) = IfaceDataAlt (getName dc)
toIfaceCon (LitAlt l) = IfaceLitAlt l
toIfaceCon DEFAULT = IfaceDefault
---------------------
toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
toIfaceApp (App f a) as = toIfaceApp f (a:as)
toIfaceApp (Var v) as
= case isDataConWorkId_maybe v of
-- We convert the *worker* for tuples into IfaceTuples
Just dc | saturated
, Just tup_sort <- tyConTuple_maybe tc
-> IfaceTuple tup_sort tup_args
where
val_args = dropWhile isTypeArg as
saturated = val_args `lengthIs` idArity v
tup_args = map toIfaceExpr val_args
tc = dataConTyCon dc
_ -> mkIfaceApps (toIfaceVar v) as
toIfaceApp e as = mkIfaceApps (toIfaceExpr e) as
mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
mkIfaceApps f as = foldl (\f a -> IfaceApp f (toIfaceExpr a)) f as
---------------------
toIfaceVar :: Id -> IfaceExpr
toIfaceVar v
| Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v))
-- Foreign calls have special syntax
| isBootUnfolding (idUnfolding v)
= IfaceApp (IfaceApp (IfaceExt noinlineIdName) (IfaceType (toIfaceType (idType v))))
(IfaceExt name) -- don't use mkIfaceApps, or infinite loop
-- See Note [Inlining and hs-boot files]
| isExternalName name = IfaceExt name
| otherwise = IfaceLcl (getOccFS name)
where name = idName v
{-
Note [Inlining and hs-boot files]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......
......@@ -1114,16 +1114,16 @@ tcIfaceType = go
go (IfaceCastTy ty co) = CastTy <$> go ty <*> tcIfaceCo co
go (IfaceCoercionTy co) = CoercionTy <$> tcIfaceCo co
tcIfaceTupleTy :: TupleSort -> IfaceTyConInfo -> IfaceTcArgs -> IfL Type
tcIfaceTupleTy sort info args
tcIfaceTupleTy :: TupleSort -> IsPromoted -> IfaceTcArgs -> IfL Type
tcIfaceTupleTy sort is_promoted args
= do { args' <- tcIfaceTcArgs args
; let arity = length args'
; base_tc <- tcTupleTyCon True sort arity
; case info of
NoIfaceTyConInfo
; case is_promoted of
IsNotPromoted
-> return (mkTyConApp base_tc args')
IfacePromotedDataCon
IsPromoted
-> do { let tc = promoteDataCon (tyConSingleDataCon base_tc)
kind_args = map typeKind args'
; return (mkTyConApp tc (kind_args ++ args')) } }
......@@ -1206,6 +1206,8 @@ tcIfaceUnivCoProv IfaceUnsafeCoerceProv = return UnsafeCoerceProv
tcIfaceUnivCoProv (IfacePhantomProv kco) = PhantomProv <$> tcIfaceCo kco
tcIfaceUnivCoProv (IfaceProofIrrelProv kco) = ProofIrrelProv <$> tcIfaceCo kco
tcIfaceUnivCoProv (IfacePluginProv str) = return $ PluginProv str
tcIfaceUnivCoProv (IfaceHoleProv _) =
pprPanic "tcIfaceUnivCoProv" (text "holes can't occur in interface files")
{-
************************************************************************
......@@ -1596,9 +1598,9 @@ tcIfaceTyConByName name
tcIfaceTyCon :: IfaceTyCon -> IfL TyCon
tcIfaceTyCon (IfaceTyCon name info)
= do { thing <- tcIfaceGlobal name
; return $ case info of
NoIfaceTyConInfo -> tyThingTyCon thing
IfacePromotedDataCon -> promoteDataCon $ tyThingDataCon thing }
; return $ case ifaceTyConIsPromoted info of
IsNotPromoted -> tyThingTyCon thing
IsPromoted -> promoteDataCon $ tyThingDataCon thing }
tcIfaceCoAxiom :: Name -> IfL (CoAxiom Branched)
tcIfaceCoAxiom name = do { thing <- tcIfaceGlobal name
......
{-# LANGUAGE CPP #-}
-- | Functions for converting Core things to interface file things.
module ToIface
( -- * Binders
toIfaceTvBndr
, toIfaceTvBndrs
, toIfaceIdBndr
, toIfaceBndr
, toIfaceForAllBndr
, toIfaceTyVarBinders
, toIfaceTyVar
-- * Types
, toIfaceType
, toIfaceKind
, toIfaceTcArgs
, toIfaceTyCon
, toIfaceTyCon_name
, toIfaceTyLit
-- * Tidying types
, tidyToIfaceType
, tidyToIfaceContext
, tidyToIfaceTcArgs
-- * Coercions
, toIfaceCoercion
-- * Pattern synonyms
, patSynToIfaceDecl
-- * Expressions
, toIfaceExpr
, toIfaceBang
, toIfaceSrcBang
, toIfaceLetBndr
, toIfaceIdDetails
, toIfaceIdInfo
, toIfUnfolding
, toIfaceOneShot
, toIfaceTickish
, toIfaceBind
, toIfaceAlt
, toIfaceCon
, toIfaceApp
, toIfaceVar
) where
#include "HsVersions.h"
import IfaceSyn
import DataCon
import Id
import IdInfo
import CoreSyn
import TyCon hiding ( pprPromotionQuote )
import CoAxiom
import TysPrim ( eqPrimTyCon, eqReprPrimTyCon )
import TysWiredIn ( heqTyCon )
import MkId ( noinlineIdName )
import PrelNames
import Name
import BasicTypes
import Type
import PatSyn
import Outputable
import FastString
import Util
import Var
import VarEnv
import TyCoRep
import Demand ( isTopSig )
import Data.Maybe ( catMaybes )
----------------
toIfaceTvBndr :: TyVar -> IfaceTvBndr
toIfaceTvBndr tyvar = ( occNameFS (getOccName tyvar)
, toIfaceKind (tyVarKind tyvar)
)
toIfaceIdBndr :: Id -> (IfLclName, IfaceType)
toIfaceIdBndr id = (occNameFS (getOccName id), toIfaceType (idType id))
toIfaceTvBndrs :: [TyVar] -> [IfaceTvBndr]
toIfaceTvBndrs = map toIfaceTvBndr
toIfaceBndr :: Var -> IfaceBndr
toIfaceBndr var
| isId var = IfaceIdBndr (toIfaceIdBndr var)
| otherwise = IfaceTvBndr (toIfaceTvBndr var)
toIfaceTyVarBinder :: TyVarBndr TyVar vis -> TyVarBndr IfaceTvBndr vis
toIfaceTyVarBinder (TvBndr tv vis) = TvBndr (toIfaceTvBndr tv) vis
toIfaceTyVarBinders :: [TyVarBndr TyVar vis] -> [TyVarBndr IfaceTvBndr vis]
toIfaceTyVarBinders = map toIfaceTyVarBinder
{-
************************************************************************
* *
Conversion from Type to IfaceType
* *
************************************************************************
-}
toIfaceKind :: Type -> IfaceType
toIfaceKind = toIfaceType
---------------------
toIfaceType :: Type -> IfaceType
-- Synonyms are retained in the interface type
toIfaceType (TyVarTy tv) = IfaceTyVar (toIfaceTyVar tv)
toIfaceType (AppTy t1 t2) = IfaceAppTy (toIfaceType t1) (toIfaceType t2)
toIfaceType (LitTy n) = IfaceLitTy (