sanity checking: make sure we don't mix registerised and unreg'd code
authorSimon Marlow <simonmar@microsoft.com>
Thu, 16 Mar 2006 14:27:27 +0000 (14:27 +0000)
committerSimon Marlow <simonmar@microsoft.com>
Thu, 16 Mar 2006 14:27:27 +0000 (14:27 +0000)
ghc/compiler/iface/BinIface.hs

index 9fb0d4b..6d02fe0 100644 (file)
@@ -23,6 +23,7 @@ import Kind           ( Kind(..) )
 import Panic
 import Binary
 import Util
+import Config          ( cGhcUnregisterised )
 
 import DATA_IOREF
 import EXCEPTION       ( throwDyn )
@@ -109,8 +110,8 @@ instance Binary ModIface where
                 mi_rules     = rules,
                 mi_rule_vers = rule_vers }) = do
        put_ bh (show opt_HiVersion)
-       build_tag <- readIORef v_Build_tag
-       put  bh build_tag
+       way_descr <- getWayDescr
+       put  bh way_descr
        put_ bh mod
        put_ bh is_boot
        put_ bh mod_vers
@@ -138,13 +139,13 @@ instance Binary ModIface where
 
        check_way <- get bh
         ignore_way <- readIORef v_IgnoreHiWay
-       build_tag <- readIORef v_Build_tag
-        when (not ignore_way && check_way /= build_tag) $
+       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 "
-               ++ build_tag ++ ", found " ++ check_way))
+               ++ way_descr ++ ", found " ++ check_way))
 
        mod_name  <- get bh
        is_boot   <- get bh
@@ -184,6 +185,13 @@ instance Binary ModIface where
 
 GLOBAL_VAR(v_IgnoreHiWay, False, Bool)
 
+getWayDescr :: IO String
+getWayDescr = do
+  tag <- readIORef v_Build_tag
+  if cGhcUnregisterised == "YES" then return ('u':tag) else return tag
+       -- if this is an unregisterised build, make sure our interfaces
+       -- can't be used by a registerised build.
+
 -------------------------------------------------------------------------
 --             Types from: HscTypes
 -------------------------------------------------------------------------