import IfaceSyn
import VarEnv
import InstEnv ( OverlapFlag(..) )
-import Packages ( PackageIdH(..) )
import Class ( DefMeth(..) )
import CostCentre
import StaticFlags ( opt_HiVersion, v_Build_tag )
-import Kind ( Kind(..) )
import Panic
import Binary
import Util
mi_module = mod,
mi_boot = is_boot,
mi_mod_vers = mod_vers,
- mi_package = _, -- we ignore the package on output
mi_orphan = orphan,
mi_deps = deps,
mi_usages = usages,
rules <- {-# SCC "bin_rules" #-} lazyGet bh
rule_vers <- get bh
return (ModIface {
- mi_package = HomePackage, -- to be filled in properly later
mi_module = mod_name,
mi_boot = is_boot,
mi_mod_vers = mod_vers,
mi_decls = decls,
mi_globals = Nothing,
mi_insts = insts,
+ mi_fam_insts = mkIfaceFamInstsCache . map snd $ decls,
mi_rules = rules,
mi_rule_vers = rule_vers,
-- And build the cached values
- mi_dep_fn = mkIfaceDepCache deprecs,
- mi_fix_fn = mkIfaceFixCache fixities,
- mi_ver_fn = mkIfaceVerCache decls })
+ mi_dep_fn = mkIfaceDepCache deprecs,
+ mi_fix_fn = mkIfaceFixCache fixities,
+ mi_ver_fn = mkIfaceVerCache decls })
GLOBAL_VAR(v_IgnoreHiWay, False, Bool)
return (Fixity aa ab)
instance (Binary name) => Binary (IPName name) where
- put_ bh (Dupable aa) = do
- putByte bh 0
- put_ bh aa
- put_ bh (Linear ab) = do
- putByte bh 1
- put_ bh ab
- get bh = do
- h <- getByte bh
- case h of
- 0 -> do aa <- get bh
- return (Dupable aa)
- _ -> do ab <- get bh
- return (Linear ab)
+ put_ bh (IPName aa) = put_ bh aa
+ get bh = do aa <- get bh
+ return (IPName aa)
-------------------------------------------------------------------------
-- Types from: Demand
_ -> do ab <- get bh
return (IfaceTvBndr ab)
-instance Binary Kind where
- put_ bh LiftedTypeKind = putByte bh 0
- put_ bh UnliftedTypeKind = putByte bh 1
- put_ bh OpenTypeKind = putByte bh 2
- put_ bh ArgTypeKind = putByte bh 3
- put_ bh UbxTupleKind = putByte bh 4
- put_ bh (FunKind k1 k2) = do
- putByte bh 5
- put_ bh k1
- put_ bh k2
- put_ bh (KindVar kv) = pprPanic "BinIface.put_: kind var" (ppr kv)
-
- get bh = do
- h <- getByte bh
- case h of
- 0 -> return LiftedTypeKind
- 1 -> return UnliftedTypeKind
- 2 -> return OpenTypeKind
- 3 -> return ArgTypeKind
- 4 -> return UbxTupleKind
- _ -> do k1 <- get bh
- k2 <- get bh
- return (FunKind k1 k2)
-
instance Binary IfaceType where
put_ bh (IfaceForAllTy aa ab) = do
putByte bh 0
-- Unit tuple and pairs
put_ bh (IfaceTyConApp (IfaceTupTc Boxed 0) []) = putByte bh 10
put_ bh (IfaceTyConApp (IfaceTupTc Boxed 2) [t1,t2]) = do { putByte bh 11; put_ bh t1; put_ bh t2 }
+ -- Kind cases
+ put_ bh (IfaceTyConApp IfaceLiftedTypeKindTc []) = putByte bh 12
+ put_ bh (IfaceTyConApp IfaceOpenTypeKindTc []) = putByte bh 13
+ put_ bh (IfaceTyConApp IfaceUnliftedTypeKindTc []) = putByte bh 14
+ put_ bh (IfaceTyConApp IfaceUbxTupleKindTc []) = putByte bh 15
+ put_ bh (IfaceTyConApp IfaceArgTypeKindTc []) = putByte bh 16
+
-- Generic cases
- put_ bh (IfaceTyConApp (IfaceTc tc) tys) = do { putByte bh 12; put_ bh tc; put_ bh tys }
- put_ bh (IfaceTyConApp tc tys) = do { putByte bh 13; put_ bh tc; put_ bh tys }
+
+ put_ bh (IfaceTyConApp (IfaceTc tc) tys) = do { putByte bh 18; put_ bh tc; put_ bh tys }
+ put_ bh (IfaceTyConApp tc tys) = do { putByte bh 19; put_ bh tc; put_ bh tys }
get bh = do
h <- getByte bh
9 -> do { ty <- get bh; return (IfaceTyConApp IfaceListTc [ty]) }
10 -> return (IfaceTyConApp (IfaceTupTc Boxed 0) [])
11 -> do { t1 <- get bh; t2 <- get bh; return (IfaceTyConApp (IfaceTupTc Boxed 2) [t1,t2]) }
- 12 -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp (IfaceTc tc) tys) }
+ 12 -> return (IfaceTyConApp IfaceLiftedTypeKindTc [])
+ 13 -> return (IfaceTyConApp IfaceOpenTypeKindTc [])
+ 14 -> return (IfaceTyConApp IfaceUnliftedTypeKindTc [])
+ 15 -> return (IfaceTyConApp IfaceUbxTupleKindTc [])
+ 16 -> return (IfaceTyConApp IfaceArgTypeKindTc [])
+
+ 18 -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp (IfaceTc tc) tys) }
_ -> do { tc <- get bh; tys <- get bh; return (IfaceTyConApp tc tys) }
instance Binary IfaceTyCon where
put_ bh IfaceCharTc = putByte bh 3
put_ bh IfaceListTc = putByte bh 4
put_ bh IfacePArrTc = putByte bh 5
- put_ bh (IfaceTupTc bx ar) = do { putByte bh 6; put_ bh bx; put_ bh ar }
- put_ bh (IfaceTc ext) = do { putByte bh 7; put_ bh ext }
+ put_ bh IfaceLiftedTypeKindTc = putByte bh 6
+ put_ bh IfaceOpenTypeKindTc = putByte bh 7
+ put_ bh IfaceUnliftedTypeKindTc = putByte bh 8
+ put_ bh IfaceUbxTupleKindTc = putByte bh 9
+ put_ bh IfaceArgTypeKindTc = putByte bh 10
+ put_ bh (IfaceTupTc bx ar) = do { putByte bh 11; put_ bh bx; put_ bh ar }
+ put_ bh (IfaceTc ext) = do { putByte bh 12; put_ bh ext }
get bh = do
h <- getByte bh
3 -> return IfaceCharTc
4 -> return IfaceListTc
5 -> return IfacePArrTc
- 6 -> do { bx <- get bh; ar <- get bh; return (IfaceTupTc bx ar) }
+ 6 -> return IfaceLiftedTypeKindTc
+ 7 -> return IfaceOpenTypeKindTc
+ 8 -> return IfaceUnliftedTypeKindTc
+ 9 -> return IfaceUbxTupleKindTc
+ 10 -> return IfaceArgTypeKindTc
+ 11 -> do { bx <- get bh; ar <- get bh; return (IfaceTupTc bx ar) }
_ -> do { ext <- get bh; return (IfaceTc ext) }
instance Binary IfacePredType where
putByte bh 1
put_ bh ac
put_ bh ad
+ put_ bh (IfaceEqPred ac ad) = do
+ putByte bh 2
+ put_ bh ac
+ put_ bh ad
get bh = do
h <- getByte bh
case h of
0 -> do aa <- get bh
ab <- get bh
return (IfaceClassP aa ab)
- _ -> do ac <- get bh
+ 1 -> do ac <- get bh
ad <- get bh
return (IfaceIParam ac ad)
+ 2 -> do ac <- get bh
+ ad <- get bh
+ return (IfaceEqPred ac ad)
-------------------------------------------------------------------------
-- IfaceExpr and friends
put_ bh (IfaceExt aa) = do
putByte bh 10
put_ bh aa
+ put_ bh (IfaceCast ie ico) = do
+ putByte bh 11
+ put_ bh ie
+ put_ bh ico
get bh = do
h <- getByte bh
case h of
9 -> do as <- get bh
at <- get bh
return (IfaceFCall as at)
- _ -> do aa <- get bh
- return (IfaceExt aa)
+ 10 -> do aa <- get bh
+ return (IfaceExt aa)
+ 11 -> do ie <- get bh
+ ico <- get bh
+ return (IfaceCast ie ico)
instance Binary IfaceConAlt where
put_ bh IfaceDefault = do
put_ bh (IfaceSCC aa) = do
putByte bh 0
put_ bh aa
- put_ bh (IfaceCoerce ab) = do
- putByte bh 1
- put_ bh ab
- put_ bh IfaceInlineCall = do
- putByte bh 2
put_ bh IfaceInlineMe = do
putByte bh 3
put_ bh (IfaceCoreNote s) = do
case h of
0 -> do aa <- get bh
return (IfaceSCC aa)
- 1 -> do ab <- get bh
- return (IfaceCoerce ab)
- 2 -> do return IfaceInlineCall
3 -> do return IfaceInlineMe
- _ -> do ac <- get bh
+ 4 -> do ac <- get bh
return (IfaceCoreNote ac)
put_ bh idinfo
put_ bh (IfaceForeign ae af) =
error "Binary.put_(IfaceDecl): IfaceForeign"
- put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7) = do
+ put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8) = do
putByte bh 2
put_ bh a1
put_ bh a2
put_ bh a5
put_ bh a6
put_ bh a7
-
+ put_ bh a8
put_ bh (IfaceSyn aq ar as at) = do
putByte bh 3
put_ bh aq
a5 <- get bh
a6 <- get bh
a7 <- get bh
- return (IfaceData a1 a2 a3 a4 a5 a6 a7)
+ a8 <- get bh
+ return (IfaceData a1 a2 a3 a4 a5 a6 a7 a8)
3 -> do
aq <- get bh
ar <- get bh
orph <- get bh
return (IfaceInst cls tys dfun flag orph)
+instance Binary IfaceFamInst where
+ put_ bh (IfaceFamInst tycon tys) = do
+ put_ bh tycon
+ put_ bh tys
+ get bh = do tycon <- get bh
+ tys <- get bh
+ return (IfaceFamInst tycon tys)
+
instance Binary OverlapFlag where
put_ bh NoOverlap = putByte bh 0
put_ bh OverlapOk = putByte bh 1
instance Binary IfaceConDecls where
put_ bh IfAbstractTyCon = putByte bh 0
- put_ bh (IfDataTyCon cs) = do { putByte bh 1
+ put_ bh IfOpenDataTyCon = putByte bh 1
+ put_ bh IfOpenNewTyCon = putByte bh 2
+ put_ bh (IfDataTyCon cs) = do { putByte bh 3
; put_ bh cs }
- put_ bh (IfNewTyCon c) = do { putByte bh 2
+ put_ bh (IfNewTyCon c) = do { putByte bh 4
; put_ bh c }
get bh = do
h <- getByte bh
case h of
0 -> return IfAbstractTyCon
- 1 -> do cs <- get bh
+ 1 -> return IfOpenDataTyCon
+ 2 -> return IfOpenNewTyCon
+ 3 -> do cs <- get bh
return (IfDataTyCon cs)
_ -> do aa <- get bh
return (IfNewTyCon aa)
instance Binary IfaceConDecl where
- put_ bh (IfVanillaCon a1 a2 a3 a4 a5) = do
- putByte bh 0
- put_ bh a1
- put_ bh a2
- put_ bh a3
- put_ bh a4
- put_ bh a5
- put_ bh (IfGadtCon a1 a2 a3 a4 a5 a6) = do
- putByte bh 1
+ put_ bh (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9) = do
put_ bh a1
put_ bh a2
put_ bh a3
put_ bh a4
put_ bh a5
put_ bh a6
- get bh = do
- h <- getByte bh
- case h of
- 0 -> do a1 <- get bh
- a2 <- get bh
- a3 <- get bh
- a4 <- get bh
- a5 <- get bh
- return (IfVanillaCon a1 a2 a3 a4 a5)
- _ -> do a1 <- get bh
- a2 <- get bh
- a3 <- get bh
- a4 <- get bh
- a5 <- get bh
- a6 <- get bh
- return (IfGadtCon a1 a2 a3 a4 a5 a6)
+ put_ bh a7
+ put_ bh a8
+ put_ bh a9
+ get bh = do a1 <- get bh
+ a2 <- get bh
+ a3 <- get bh
+ a4 <- get bh
+ a5 <- get bh
+ a6 <- get bh
+ a7 <- get bh
+ a8 <- get bh
+ a9 <- get bh
+ return (IfCon a1 a2 a3 a4 a5 a6 a7 a8 a9)
instance Binary IfaceClassOp where
put_ bh (IfaceClassOp n def ty) = do