[project @ 2003-05-27 12:40:19 by simonmar]

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

diff --git a/ghc/compiler/main/BinIface.hs b/ghc/compiler/main/BinIface.hs
index 8915ef2..e489fb2 100644 (file)
--- a/ghc/compiler/main/BinIface.hs
+++ b/ghc/compiler/main/BinIface.hs
@@ -5,7 +5,7 @@
 -- 
 -- Binary interface file support.
 
-module BinIface ( writeBinIface, readBinIface ) where
+module BinIface ( writeBinIface, readBinIface, v_IgnoreHiVersion ) where
 
 #include "HsVersions.h"
 
@@ -32,8 +32,9 @@ import CmdLineOpts    ( opt_IgnoreIfacePragmas, opt_HiVersion )
 import Panic
 import SrcLoc
 import Binary
+import Util
 
-import DATA_IOREF      ( readIORef )
+import DATA_IOREF
 import EXCEPTION       ( throwDyn )
 import Monad           ( when )
 
@@ -354,9 +355,10 @@ instance Binary ParsedIface where
        lazyPut bh deprecs
    get bh = do
        check_ver   <- get bh
+        ignore_ver <- readIORef v_IgnoreHiVersion
        build_tag <- readIORef v_Build_tag
        let our_ver = show opt_HiVersion ++ build_tag
-        when (check_ver /= our_ver) $
+        when (check_ver /= our_ver && not ignore_ver) $
           -- use userError because this will be caught by readIface
           -- which will emit an error msg containing the iface module name.
           throwDyn (ProgramError (
@@ -388,6 +390,8 @@ instance Binary ParsedIface where
                 pi_rules = rules,
                 pi_deprecs = deprecs })
 
+GLOBAL_VAR(v_IgnoreHiVersion, False, Bool)
+
 -- ----------------------------------------------------------------------------
 {-* Generated by DrIFT-v1.0 : Look, but Don't Touch. *-}
 
@@ -936,6 +940,9 @@ instance (Binary name) => Binary (UfNote name) where
            putByte bh 2
     put_ bh UfInlineMe = do
            putByte bh 3
+    put_ bh (UfCoreNote s) = do
+            putByte bh 4
+            put_ bh s
     get bh = do
            h <- getByte bh
            case h of
@@ -944,7 +951,9 @@ instance (Binary name) => Binary (UfNote name) where
              1 -> do ab <- get bh
                      return (UfCoerce ab)
              2 -> do return UfInlineCall
-             _ -> do return UfInlineMe
+             3 -> do return UfInlineMe
+              _ -> do ac <- get bh
+                      return (UfCoreNote ac)
 
 instance (Binary name) => Binary (BangType name) where
     put_ bh (BangType aa ab) = do