From: Simon Marlow <simonmar@microsoft.com>
Date: Thu, 16 Mar 2006 14:27:27 +0000 (+0000)
Subject: sanity checking: make sure we don't mix registerised and unreg'd code
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=f83d5d070a6fe9a45e4cb72eb81b3434bd5fc553

sanity checking: make sure we don't mix registerised and unreg'd code
---

diff --git a/ghc/compiler/iface/BinIface.hs b/ghc/compiler/iface/BinIface.hs
index 9fb0d4b..6d02fe0 100644
--- a/ghc/compiler/iface/BinIface.hs
+++ b/ghc/compiler/iface/BinIface.hs
@@ -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
 -------------------------------------------------------------------------