IfaceVectInfo and propagation through EPS

[ghc-hetmet.git] / compiler / iface / BinIface.hs

diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 72ea80d..3c62db9 100644 (file)
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -62,10 +62,36 @@ readBinIface_ hi_path nc = do
        throwDyn (ProgramError (
           "magic number mismatch: old/corrupt interface file?"))
 
+        -- Get the dictionary pointer.  We won't attempt to actually
+        -- read the dictionary until we've done the version checks below,
+        -- just in case this isn't a valid interface.  In retrospect the
+        -- version should have come before the dictionary pointer, but this
+        -- is the way it was done originally, and we can't change it now.
+  dict_p <- Binary.get bh      -- Get the dictionary ptr
+
+        -- Check the interface file version and ways.
+  check_ver  <- get bh
+  let our_ver = show opt_HiVersion
+  when (check_ver /= our_ver) $
+        -- This will be caught by readIface which will emit an error
+        -- msg containing the iface module name.
+    throwDyn (ProgramError (
+        "mismatched interface file versions: expected "
+        ++ our_ver ++ ", found " ++ check_ver))
+
+  check_way <- get bh
+  ignore_way <- readIORef v_IgnoreHiWay
+  way_descr <- getWayDescr
+  when (not ignore_way && check_way /= way_descr) $
+        -- This will be caught by readIface
+        -- which will emit an error msg containing the iface module name.
+     throwDyn (ProgramError (
+       "mismatched interface file ways: expected "
+       ++ way_descr ++ ", found " ++ check_way))
+
        -- Read the dictionary
        -- The next word in the file is a pointer to where the dictionary is
        -- (probably at the end of the file)
-  dict_p <- Binary.get bh      -- Get the dictionary ptr
   data_p <- tellBin bh         -- Remember where we are now
   seekBin bh dict_p
   dict <- getDictionary bh
@@ -95,6 +121,11 @@ writeBinIface dflags hi_path mod_iface = do
   dict_p_p <- tellBin bh
   put_ bh dict_p_p     -- Placeholder for ptr to dictionary
 
+        -- The version and way descriptor go next
+  put_ bh (show opt_HiVersion)
+  way_descr <- getWayDescr
+  put  bh way_descr
+
         -- Remember where the symbol table pointer will go
   symtab_p_p <- tellBin bh
   put_ bh symtab_p_p
@@ -262,10 +293,8 @@ instance Binary ModIface where
                 mi_insts     = insts,
                 mi_fam_insts = fam_insts,
                 mi_rules     = rules,
-                mi_rule_vers = rule_vers }) = do
-       put_ bh (show opt_HiVersion)
-       way_descr <- getWayDescr
-       put  bh way_descr
+                mi_rule_vers = rule_vers,
+                 mi_vect_info = vect_info }) = do
        put_ bh mod
        put_ bh is_boot
        put_ bh mod_vers
@@ -282,27 +311,9 @@ instance Binary ModIface where
        put_ bh fam_insts
        lazyPut bh rules
        put_ bh rule_vers
+        put_ bh vect_info
 
    get bh = do
-       check_ver  <- get bh
-       let our_ver = show opt_HiVersion
-        when (check_ver /= our_ver) $
-          -- use userError because this will be caught by readIface
-          -- which will emit an error msg containing the iface module name.
-          throwDyn (ProgramError (
-               "mismatched interface file versions: expected "
-               ++ our_ver ++ ", found " ++ check_ver))
-
-       check_way <- get bh
-        ignore_way <- readIORef v_IgnoreHiWay
-       way_descr <- getWayDescr
-        when (not ignore_way && check_way /= way_descr) $
-          -- use userError because this will be caught by readIface
-          -- which will emit an error msg containing the iface module name.
-          throwDyn (ProgramError (
-               "mismatched interface file ways: expected "
-               ++ way_descr ++ ", found " ++ check_way))
-
        mod_name  <- get bh
        is_boot   <- get bh
        mod_vers  <- get bh
@@ -319,6 +330,7 @@ instance Binary ModIface where
        fam_insts <- {-# SCC "bin_fam_insts" #-} get bh
        rules     <- {-# SCC "bin_rules" #-} lazyGet bh
        rule_vers <- get bh
+        vect_info <- get bh
        return (ModIface {
                 mi_module    = mod_name,
                 mi_boot      = is_boot,
@@ -337,6 +349,7 @@ instance Binary ModIface where
                 mi_fam_insts = fam_insts,
                 mi_rules     = rules,
                 mi_rule_vers = rule_vers,
+                 mi_vect_info = vect_info,
                        -- And build the cached values
                 mi_dep_fn    = mkIfaceDepCache deprecs,
                 mi_fix_fn    = mkIfaceFixCache fixities,
@@ -681,6 +694,16 @@ instance Binary IfaceBndr where
              _ -> do ab <- get bh
                      return (IfaceTvBndr ab)
 
+instance Binary IfaceLetBndr where
+    put_ bh (IfLetBndr a b c) = do
+           put_ bh a
+           put_ bh b
+           put_ bh c
+    get bh = do a <- get bh
+               b <- get bh
+               c <- get bh
+               return (IfLetBndr a b c)           
+
 instance Binary IfaceType where
     put_ bh (IfaceForAllTy aa ab) = do
            putByte bh 0
@@ -1002,15 +1025,6 @@ instance Binary IfaceNote where
     put_ bh (IfaceCoreNote s) = do
             putByte bh 4
             put_ bh s
-    put_ bh (IfaceTickBox m n) = do
-            putByte bh 5
-            put_ bh m
-            put_ bh n
-    put_ bh (IfaceBinaryTickBox m t e) = do
-            putByte bh 6
-            put_ bh m
-            put_ bh t
-            put_ bh e
     get bh = do
            h <- getByte bh
            case h of
@@ -1019,13 +1033,6 @@ instance Binary IfaceNote where
              3 -> do return IfaceInlineMe
               4 -> do ac <- get bh
                       return (IfaceCoreNote ac)
-              5 -> do m <- get bh
-                      n <- get bh
-                      return (IfaceTickBox m n)
-              6 -> do m <- get bh
-                      t <- get bh
-                      e <- get bh
-                      return (IfaceBinaryTickBox m t e)
 
 -------------------------------------------------------------------------
 --             IfaceDecl and friends
@@ -1214,4 +1221,11 @@ instance Binary IfaceRule where
            a7 <- get bh
            return (IfaceRule a1 a2 a3 a4 a5 a6 a7)
 
+instance Binary IfaceVectInfo where
+    put_ bh (IfaceVectInfo a1) = do
+           put_ bh a1
+    get bh = do
+           a1 <- get bh
+           return (IfaceVectInfo a1)
+