X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Fiface%2FBinIface.hs;h=41bcaed8b211206e58675f4eeb0076271c205b0e;hb=bf40e268d916947786c56ec38db86190854a2d2c;hp=513bf2048b776e1126583bac25e7f6b7274c55d8;hpb=1525a5819aa3a6eae8d8b05cfe348a2384da0c84;p=ghc-hetmet.git diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index 513bf20..41bcaed 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 @@ -177,12 +172,13 @@ instance Binary ModIface where 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) @@ -365,19 +361,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 @@ -913,7 +899,6 @@ instance Binary IfaceDecl where put_ bh a6 put_ bh a7 put_ bh a8 - put_ bh (IfaceSyn aq ar as at) = do putByte bh 3 put_ bh aq @@ -977,6 +962,14 @@ instance Binary IfaceInst where 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 @@ -989,15 +982,19 @@ instance Binary OverlapFlag where 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)