X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fiface%2FBinIface.hs;h=3e9895a5bfea24d1d6dc18780a327f8d77ef95bc;hp=9ae85a2ef8c2f92f2a7442fc0bab1c04d63bdbd2;hb=2a8cdc3aee5997374273e27365f92c161aca8453;hpb=bb106f283663e9c16a4c72ec9ca57109ae57a0ed diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index 9ae85a2..3e9895a 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -18,11 +18,6 @@ import InstEnv ( OverlapFlag(..) ) import Class ( DefMeth(..) ) import CostCentre import StaticFlags ( opt_HiVersion, v_Build_tag ) -import Type ( Kind, - isLiftedTypeKind, isUnliftedTypeKind, isOpenTypeKind, - isArgTypeKind, isUbxTupleKind, liftedTypeKind, - unliftedTypeKind, openTypeKind, argTypeKind, - ubxTupleKind, mkArrowKind, splitFunTy_maybe ) import Panic import Binary import Util @@ -109,6 +104,7 @@ instance Binary ModIface where mi_deprecs = deprecs, mi_decls = decls, mi_insts = insts, + mi_fam_insts = fam_insts, mi_rules = rules, mi_rule_vers = rule_vers }) = do put_ bh (show opt_HiVersion) @@ -126,6 +122,7 @@ instance Binary ModIface where lazyPut bh deprecs put_ bh decls put_ bh insts + put_ bh fam_insts lazyPut bh rules put_ bh rule_vers @@ -161,6 +158,7 @@ instance Binary ModIface where deprecs <- {-# SCC "bin_deprecs" #-} lazyGet bh decls <- {-# SCC "bin_tycldecls" #-} get bh insts <- {-# SCC "bin_insts" #-} get bh + fam_insts <- {-# SCC "bin_fam_insts" #-} get bh rules <- {-# SCC "bin_rules" #-} lazyGet bh rule_vers <- get bh return (ModIface { @@ -177,12 +175,13 @@ instance Binary ModIface where mi_decls = decls, mi_globals = Nothing, mi_insts = insts, + mi_fam_insts = fam_insts, 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) @@ -365,19 +364,9 @@ instance Binary Fixity where 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 @@ -903,7 +892,7 @@ instance Binary IfaceDecl where 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 @@ -912,7 +901,7 @@ instance Binary IfaceDecl where 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 @@ -944,7 +933,8 @@ instance Binary IfaceDecl where 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 @@ -975,6 +965,16 @@ instance Binary IfaceInst where orph <- get bh return (IfaceInst cls tys dfun flag orph) +instance Binary IfaceFamInst where + put_ bh (IfaceFamInst fam tys tycon) = do + put_ bh fam + put_ bh tys + put_ bh tycon + get bh = do fam <- get bh + tys <- get bh + tycon <- get bh + return (IfaceFamInst fam tys tycon) + instance Binary OverlapFlag where put_ bh NoOverlap = putByte bh 0 put_ bh OverlapOk = putByte bh 1