summaryrefslogtreecommitdiff
path: root/compiler/iface
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/iface')
-rw-r--r--compiler/iface/BinIface.hs20
-rw-r--r--compiler/iface/IfaceSyn.lhs1
-rw-r--r--compiler/iface/IfaceType.lhs20
-rw-r--r--compiler/iface/TcIface.lhs7
4 files changed, 48 insertions, 0 deletions
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index d821c13fdc..8bf6594df5 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -1026,6 +1026,10 @@ instance Binary IfaceType where
put_ bh (IfaceTyConApp tc tys)
= do { putByte bh 21; put_ bh tc; put_ bh tys }
+ put_ bh (IfaceLitTy n)
+ = do { putByte bh 30; put_ bh n }
+
+
get bh = do
h <- getByte bh
case h of
@@ -1065,8 +1069,24 @@ instance Binary IfaceType where
21 -> do { tc <- get bh; tys <- get bh
; return (IfaceTyConApp tc tys) }
+ 30 -> do n <- get bh
+ return (IfaceLitTy n)
+
_ -> panic ("get IfaceType " ++ show h)
+instance Binary IfaceTyLit where
+ put_ bh (IfaceNumTyLit n) = putByte bh 1 >> put_ bh n
+ put_ bh (IfaceStrTyLit n) = putByte bh 2 >> put_ bh n
+
+ get bh =
+ do tag <- getByte bh
+ case tag of
+ 1 -> do { n <- get bh
+ ; return (IfaceNumTyLit n) }
+ 2 -> do { n <- get bh
+ ; return (IfaceStrTyLit n) }
+ _ -> panic ("get IfaceTyLit " ++ show tag)
+
instance Binary IfaceTyCon where
-- Int,Char,Bool can't show up here because they can't not be saturated
put_ bh IfaceIntTc = putByte bh 1
diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index fd8b361b3d..ef74b13489 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -795,6 +795,7 @@ freeNamesIfType (IfaceTyVar _) = emptyNameSet
freeNamesIfType (IfaceAppTy s t) = freeNamesIfType s &&& freeNamesIfType t
freeNamesIfType (IfaceTyConApp tc ts) =
freeNamesIfTc tc &&& fnList freeNamesIfType ts
+freeNamesIfType (IfaceLitTy _) = emptyNameSet
freeNamesIfType (IfaceForAllTy tv t) =
freeNamesIfTvBndr tv &&& freeNamesIfType t
freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
diff --git a/compiler/iface/IfaceType.lhs b/compiler/iface/IfaceType.lhs
index 5441287eef..77f4b700d2 100644
--- a/compiler/iface/IfaceType.lhs
+++ b/compiler/iface/IfaceType.lhs
@@ -17,6 +17,7 @@ module IfaceType (
IfExtName, IfLclName, IfIPName,
IfaceType(..), IfacePredType, IfaceKind, IfaceTyCon(..), IfaceCoCon(..),
+ IfaceTyLit(..),
IfaceContext, IfaceBndr(..), IfaceTvBndr, IfaceIdBndr, IfaceCoercion,
ifaceTyConName,
@@ -83,10 +84,15 @@ data IfaceType -- A kind of universal type, used for types, kinds, and coerci
| IfaceTyConApp IfaceTyCon [IfaceType] -- Not necessarily saturated
-- Includes newtypes, synonyms, tuples
| IfaceCoConApp IfaceCoCon [IfaceType] -- Always saturated
+ | IfaceLitTy IfaceTyLit
type IfacePredType = IfaceType
type IfaceContext = [IfacePredType]
+data IfaceTyLit
+ = IfaceNumTyLit Integer
+ | IfaceStrTyLit FastString
+
data IfaceTyCon -- Encodes type constructors, kind constructors
-- coercion constructors, the lot
= IfaceTc IfExtName -- The common case
@@ -241,6 +247,8 @@ ppr_ty :: Int -> IfaceType -> SDoc
ppr_ty _ (IfaceTyVar tyvar) = ppr tyvar
ppr_ty ctxt_prec (IfaceTyConApp tc tys) = ppr_tc_app ctxt_prec tc tys
+ppr_ty _ (IfaceLitTy n) = ppr_tylit n
+
ppr_ty ctxt_prec (IfaceCoConApp tc tys)
= maybeParen ctxt_prec tYCON_PREC
(sep [ppr tc, nest 4 (sep (map pprParendIfaceType tys))])
@@ -302,6 +310,10 @@ ppr_tc :: IfaceTyCon -> SDoc
ppr_tc tc@(IfaceTc ext_nm) = parenSymOcc (getOccName ext_nm) (ppr tc)
ppr_tc tc = ppr tc
+ppr_tylit :: IfaceTyLit -> SDoc
+ppr_tylit (IfaceNumTyLit n) = integer n
+ppr_tylit (IfaceStrTyLit n) = text (show n)
+
-------------------
instance Outputable IfaceTyCon where
ppr (IfaceIPTc n) = ppr (IPName n)
@@ -317,6 +329,9 @@ instance Outputable IfaceCoCon where
ppr IfaceInstCo = ptext (sLit "Inst")
ppr (IfaceNthCo d) = ptext (sLit "Nth:") <> int d
+instance Outputable IfaceTyLit where
+ ppr = ppr_tylit
+
-------------------
pprIfaceContext :: IfaceContext -> SDoc
-- Prints "(C a, D b) =>", including the arrow
@@ -362,6 +377,7 @@ toIfaceType (TyVarTy tv) = IfaceTyVar (toIfaceTyVar tv)
toIfaceType (AppTy t1 t2) = IfaceAppTy (toIfaceType t1) (toIfaceType t2)
toIfaceType (FunTy t1 t2) = IfaceFunTy (toIfaceType t1) (toIfaceType t2)
toIfaceType (TyConApp tc tys) = IfaceTyConApp (toIfaceTyCon tc) (toIfaceTypes tys)
+toIfaceType (LitTy n) = IfaceLitTy (toIfaceTyLit n)
toIfaceType (ForAllTy tv t) = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t)
toIfaceTyVar :: TyVar -> FastString
@@ -402,6 +418,10 @@ toIfaceWiredInTyCon tc nm
| nm == tySuperKindTyConName = IfaceSuperKindTc
| otherwise = IfaceTc nm
+toIfaceTyLit :: TyLit -> IfaceTyLit
+toIfaceTyLit (NumTyLit x) = IfaceNumTyLit x
+toIfaceTyLit (StrTyLit x) = IfaceStrTyLit x
+
----------------
toIfaceTypes :: [Type] -> [IfaceType]
toIfaceTypes ts = map toIfaceType ts
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 6946752158..a081fbe36e 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -855,6 +855,7 @@ tcIfaceVectInfo mod typeEnv (IfaceVectInfo
tcIfaceType :: IfaceType -> IfL Type
tcIfaceType (IfaceTyVar n) = do { tv <- tcIfaceTyVar n; return (TyVarTy tv) }
tcIfaceType (IfaceAppTy t1 t2) = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (AppTy t1' t2') }
+tcIfaceType (IfaceLitTy l) = do { l1 <- tcIfaceTyLit l; return (LitTy l1) }
tcIfaceType (IfaceFunTy t1 t2) = do { t1' <- tcIfaceType t1; t2' <- tcIfaceType t2; return (FunTy t1' t2') }
tcIfaceType (IfaceTyConApp tc ts) = do { tc' <- tcIfaceTyCon tc; ts' <- tcIfaceTypes ts; return (mkTyConApp tc' ts') }
tcIfaceType (IfaceForAllTy tv t) = bindIfaceTyVar tv $ \ tv' -> do { t' <- tcIfaceType t; return (ForAllTy tv' t') }
@@ -866,6 +867,11 @@ tcIfaceTypes tys = mapM tcIfaceType tys
-----------------------------------------
tcIfaceCtxt :: IfaceContext -> IfL ThetaType
tcIfaceCtxt sts = mapM tcIfaceType sts
+
+-----------------------------------------
+tcIfaceTyLit :: IfaceTyLit -> IfL TyLit
+tcIfaceTyLit (IfaceNumTyLit n) = return (NumTyLit n)
+tcIfaceTyLit (IfaceStrTyLit n) = return (StrTyLit n)
\end{code}
%************************************************************************
@@ -880,6 +886,7 @@ tcIfaceCo (IfaceTyVar n) = mkCoVarCo <$> tcIfaceCoVar n
tcIfaceCo (IfaceAppTy t1 t2) = mkAppCo <$> tcIfaceCo t1 <*> tcIfaceCo t2
tcIfaceCo (IfaceFunTy t1 t2) = mkFunCo <$> tcIfaceCo t1 <*> tcIfaceCo t2
tcIfaceCo (IfaceTyConApp tc ts) = mkTyConAppCo <$> tcIfaceTyCon tc <*> mapM tcIfaceCo ts
+tcIfaceCo t@(IfaceLitTy _) = mkReflCo <$> tcIfaceType t
tcIfaceCo (IfaceCoConApp tc ts) = tcIfaceCoApp tc ts
tcIfaceCo (IfaceForAllTy tv t) = bindIfaceTyVar tv $ \ tv' ->
mkForAllCo tv' <$> tcIfaceCo t
View Lorry Controller Status