Merge branch 'master' of http://darcs.haskell.org/ghc

7 files changed, 137 insertions, 175 deletions

diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 1e24f34dd3..336030cf0d 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -18,7 +18,6 @@ import HscTypes
 import BasicTypes
 import Demand
 import Annotations
-import CoreSyn
 import IfaceSyn
 import Module
 import Name
@@ -381,7 +380,8 @@ instance Binary ModIface where
 		 mi_usages    = usages,
 		 mi_exports   = exports,
 		 mi_exp_hash  = exp_hash,
-		 mi_fixities  = fixities,
+                 mi_used_th   = used_th,
+                 mi_fixities  = fixities,
 		 mi_warns     = warns,
 		 mi_anns      = anns,
 		 mi_decls     = decls,
@@ -390,8 +390,9 @@ instance Binary ModIface where
 		 mi_rules     = rules,
 		 mi_orphan_hash = orphan_hash,
                  mi_vect_info = vect_info,
-		 mi_hpc       = hpc_info,
-		 mi_trust     = trust }) = do
+                 mi_hpc       = hpc_info,
+                 mi_trust     = trust,
+                 mi_trust_pkg = trust_pkg }) = do
 	put_ bh mod
 	put_ bh is_boot
 	put_ bh iface_hash
@@ -402,7 +403,8 @@ instance Binary ModIface where
 	lazyPut bh usages
 	put_ bh exports
 	put_ bh exp_hash
-	put_ bh fixities
+        put_ bh used_th
+        put_ bh fixities
 	lazyPut bh warns
 	lazyPut bh anns
         put_ bh decls
@@ -413,6 +415,7 @@ instance Binary ModIface where
         put_ bh vect_info
 	put_ bh hpc_info
 	put_ bh trust
+	put_ bh trust_pkg
 
    get bh = do
 	mod_name  <- get bh
@@ -425,7 +428,8 @@ instance Binary ModIface where
 	usages	  <- {-# SCC "bin_usages" #-} lazyGet bh
 	exports	  <- {-# SCC "bin_exports" #-} get bh
 	exp_hash  <- get bh
-	fixities  <- {-# SCC "bin_fixities" #-} get bh
+        used_th   <- get bh
+        fixities  <- {-# SCC "bin_fixities" #-} get bh
 	warns     <- {-# SCC "bin_warns" #-} lazyGet bh
 	anns      <- {-# SCC "bin_anns" #-} lazyGet bh
         decls 	  <- {-# SCC "bin_tycldecls" #-} get bh
@@ -436,6 +440,7 @@ instance Binary ModIface where
         vect_info <- get bh
         hpc_info  <- get bh
         trust     <- get bh
+        trust_pkg <- get bh
 	return (ModIface {
 		 mi_module    = mod_name,
 		 mi_boot      = is_boot,
@@ -446,8 +451,9 @@ instance Binary ModIface where
 		 mi_deps      = deps,
 		 mi_usages    = usages,
 		 mi_exports   = exports,
-		 mi_exp_hash  = exp_hash,
-		 mi_anns      = anns,
+                 mi_exp_hash  = exp_hash,
+                 mi_used_th   = used_th,
+                 mi_anns      = anns,
 		 mi_fixities  = fixities,
 		 mi_warns     = warns,
 		 mi_decls     = decls,
@@ -459,6 +465,7 @@ instance Binary ModIface where
                  mi_vect_info = vect_info,
 		 mi_hpc       = hpc_info,
 		 mi_trust     = trust,
+		 mi_trust_pkg = trust_pkg,
 			-- And build the cached values
 		 mi_warn_fn   = mkIfaceWarnCache warns,
 		 mi_fix_fn    = mkIfaceFixCache fixities,
@@ -1273,14 +1280,6 @@ instance Binary IfaceUnfolding where
 	  _ -> do e <- get bh
 		  return (IfCompulsory e)
 
-instance Binary (DFunArg IfaceExpr) where
-    put_ bh (DFunPolyArg  e) = putByte bh 0 >> put_ bh e
-    put_ bh (DFunConstArg e) = putByte bh 1 >> put_ bh e
-    get bh = do { h <- getByte bh
-                ; case h of
-                    0 -> do { a <- get bh; return (DFunPolyArg a) }
-                    _ -> do { a <- get bh; return (DFunConstArg a) } }
-
 instance Binary IfaceNote where
     put_ bh (IfaceSCC aa) = do
 	    putByte bh 0
diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs
index eabe8c45aa..b9a6ab9352 100644
--- a/compiler/iface/BuildTyCl.lhs
+++ b/compiler/iface/BuildTyCl.lhs
@@ -30,7 +30,7 @@ import Type
 import Coercion
 
 import TcRnMonad
-import Data.List	( partition )
+import Util		( isSingleton )
 import Outputable
 \end{code}
 	
@@ -248,12 +248,9 @@ buildClass no_unf class_name tvs sc_theta fds ats sig_stuff tc_isrec
 	; op_items <- mapM (mk_op_item rec_clas) sig_stuff
 	  		-- Build the selector id and default method id
 
-	; let (eq_theta, dict_theta) = partition isEqPred sc_theta
-
-	      -- We only make selectors for the *value* superclasses, 
-	      -- not equality predicates 
+	      -- Make selectors for the superclasses 
 	; sc_sel_names <- mapM  (newImplicitBinder class_name . mkSuperDictSelOcc) 
-				[1..length dict_theta]
+				[1..length sc_theta]
         ; let sc_sel_ids = [ mkDictSelId no_unf sc_name rec_clas 
                            | sc_name <- sc_sel_names]
 	      -- We number off the Dict superclass selectors, 1, 2, 3 etc so that we 
@@ -264,22 +261,23 @@ buildClass no_unf class_name tvs sc_theta fds ats sig_stuff tc_isrec
 	      -- (We used to call them D_C, but now we can have two different
 	      --  superclasses both called C!)
 	
-	; let use_newtype = null eq_theta && (length dict_theta + length sig_stuff == 1)
-		-- Use a newtype if the data constructor has 
-		-- 	(a) exactly one value field
-		--	(b) no existential or equality-predicate fields
-		-- i.e. exactly one operation or superclass taken together
+	; let use_newtype = isSingleton arg_tys && not (any isEqPred sc_theta)
+		-- Use a newtype if the data constructor 
+		--   (a) has exactly one value field
+		--       i.e. exactly one operation or superclass taken together
+                --   (b) it's of lifted type 
+		-- (NB: for (b) don't look at the classes in sc_theta, because
+		--      they are part of the knot!  Hence isEqPred.)
 		-- See note [Class newtypes and equality predicates]
 
-		-- We play a bit fast and loose by treating the dictionary
-		-- superclasses as ordinary arguments.  That means that in 
-                -- the case of
+		-- We treat the dictionary superclasses as ordinary arguments.  
+                -- That means that in the case of
 		--     class C a => D a
 		-- we don't get a newtype with no arguments!
 	      args      = sc_sel_names ++ op_names
 	      op_tys	= [ty | (_,_,ty) <- sig_stuff]
 	      op_names  = [op | (op,_,_) <- sig_stuff]
-	      arg_tys   = map mkPredTy dict_theta ++ op_tys
+	      arg_tys   = map mkPredTy sc_theta ++ op_tys
               rec_tycon = classTyCon rec_clas
                
 	; dict_con <- buildDataCon datacon_name
@@ -288,7 +286,7 @@ buildClass no_unf class_name tvs sc_theta fds ats sig_stuff tc_isrec
 				   [{- No fields -}]
 				   tvs [{- no existentials -}]
                                    [{- No GADT equalities -}] 
-                                   eq_theta
+                                   [{- No theta -}]
                                    arg_tys
 				   (mkTyConApp rec_tycon (mkTyVarTys tvs))
 				   rec_tycon
@@ -312,9 +310,7 @@ buildClass no_unf class_name tvs sc_theta fds ats sig_stuff tc_isrec
 	      ; atTyCons = [tycon | ATyCon tycon <- ats]
 
 	      ; result = mkClass class_name tvs fds 
-			         (eq_theta ++ dict_theta)  -- Equalities first
-                                 (length eq_theta)	   -- Number of equalities
-                                 sc_sel_ids atTyCons
+			         sc_theta sc_sel_ids atTyCons
 				 op_items tycon
 	      }
 	; traceIf (text "buildClass" <+> ppr tycon) 
@@ -339,12 +335,12 @@ Consider
 	  op :: a -> b
 
 We cannot represent this by a newtype, even though it's not
-existential, and there's only one value field, because we do
-capture an equality predicate:
-
-	data C a b where
-	  MkC :: forall a b. (a ~ F b) => (a->b) -> C a b
-
-We need to access this equality predicate when we get passes a C
-dictionary.  See Trac #2238
+existential, because there are two value fields (the equality
+predicate and op. See Trac #2238
+
+Moreover, 
+	  class (a ~ F b) => C a b where {}
+Here we can't use a newtype either, even though there is only
+one field, because equality predicates are unboxed, and classes
+are boxed.
 
diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 41732a9215..8ca6b392ae 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -27,8 +27,6 @@ module IfaceSyn (
 #include "HsVersions.h"
 
 import IfaceType
-import CoreSyn( DFunArg, dfunArgExprs )
-import PprCore()     -- Printing DFunArgs
 import Demand
 import Annotations
 import Class
@@ -197,7 +195,7 @@ data IfaceInfoItem
   = HsArity      Arity
   | HsStrictness StrictSig
   | HsInline     InlinePragma
-  | HsUnfold     Bool             -- True <=> isNonRuleLoopBreaker is true
+  | HsUnfold     Bool             -- True <=> isStrongLoopBreaker is true
                  IfaceUnfolding   -- See Note [Expose recursive functions]
   | HsNoCafRefs
 
@@ -220,7 +218,7 @@ data IfaceUnfolding
   | IfLclWrapper Arity IfLclName  --     because the worker can simplify to a function in
                                   --     another module.
 
-  | IfDFunUnfold [DFunArg IfaceExpr]
+  | IfDFunUnfold [IfaceExpr]
 
 --------------------------------
 data IfaceExpr
@@ -316,43 +314,7 @@ defined.)
 
 Note [Versioning of instances]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Now consider versioning.  If we *use* an instance decl in one compilation,
-we'll depend on the dfun id for that instance, so we'll recompile if it changes.
-But suppose we *don't* (currently) use an instance!  We must recompile if
-the instance is changed in such a way that it becomes important.  (This would
-only matter with overlapping instances, else the importing module wouldn't have
-compiled before and the recompilation check is irrelevant.)
-
-The is_orph field is set to (Just n) if the instance is not an orphan.
-The 'n' is *any* of the locally-defined names mentioned anywhere in the
-instance head.  This name is used for versioning; the instance decl is
-considered part of the defn of this 'n'.
-
-I'm worried about whether this works right if we pick a name from
-a functionally-dependent part of the instance decl.  E.g.
-
-  module M where { class C a b | a -> b }
-
-and suppose we are compiling module X:
-
-  module X where
-        import M
-        data S  = ...
-        data T = ...
-        instance C S T where ...
-
-If we base the instance version on T, I'm worried that changing S to S'
-would change T's version, but not S or S'.  But an importing module might
-not depend on T, and so might not be recompiled even though the new instance
-(C S' T) might be relevant.  I have not been able to make a concrete example,
-and it seems deeply obscure, so I'm going to leave it for now.
-
-
-Note [Versioning of rules]
-~~~~~~~~~~~~~~~~~~~~~~~~~~
-A rule that is not an orphan has an ifRuleOrph field of (Just n), where n
-appears on the LHS of the rule; any change in the rule changes the version of n.
-
+See [http://hackage.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance#Instances]
 
 \begin{code}
 -- -----------------------------------------------------------------------------
@@ -826,7 +788,7 @@ freeNamesIfUnfold (IfCompulsory e)       = freeNamesIfExpr e
 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
 freeNamesIfUnfold (IfExtWrapper _ v)     = unitNameSet v
 freeNamesIfUnfold (IfLclWrapper {})      = emptyNameSet
-freeNamesIfUnfold (IfDFunUnfold vs)      = fnList freeNamesIfExpr (dfunArgExprs vs)
+freeNamesIfUnfold (IfDFunUnfold vs)      = fnList freeNamesIfExpr vs
 
 freeNamesIfExpr :: IfaceExpr -> NameSet
 freeNamesIfExpr (IfaceExt v)      = unitNameSet v
diff --git a/compiler/iface/IfaceType.lhs b/compiler/iface/IfaceType.lhs
index 7817b423ae..89cc755876 100644
--- a/compiler/iface/IfaceType.lhs
+++ b/compiler/iface/IfaceType.lhs
@@ -338,15 +338,18 @@ toIfaceKind = toIfaceType
 ---------------------
 toIfaceType :: Type -> IfaceType
 -- Synonyms are retained in the interface type
-toIfaceType (TyVarTy tv)      = IfaceTyVar (toIfaceTyCoVar tv)
+toIfaceType (TyVarTy tv)      = IfaceTyVar (toIfaceTyVar tv)
 toIfaceType (AppTy t1 t2)     = IfaceAppTy (toIfaceType t1) (toIfaceType t2)
 toIfaceType (FunTy t1 t2)     = IfaceFunTy (toIfaceType t1) (toIfaceType t2)
 toIfaceType (TyConApp tc tys) = IfaceTyConApp (toIfaceTyCon tc) (toIfaceTypes tys)
 toIfaceType (ForAllTy tv t)   = IfaceForAllTy (toIfaceTvBndr tv) (toIfaceType t)
 toIfaceType (PredTy st)       = IfacePredTy (toIfacePred toIfaceType st)
 
-toIfaceTyCoVar :: TyCoVar -> FastString
-toIfaceTyCoVar = occNameFS . getOccName
+toIfaceTyVar :: TyVar -> FastString
+toIfaceTyVar = occNameFS . getOccName
+
+toIfaceCoVar :: CoVar -> FastString
+toIfaceCoVar = occNameFS . getOccName
 
 ----------------
 -- A little bit of (perhaps optional) trickiness here.  When
@@ -408,7 +411,7 @@ coToIfaceType (AppCo co1 co2)       = IfaceAppTy    (coToIfaceType co1)
                                                     (coToIfaceType co2)
 coToIfaceType (ForAllCo v co)       = IfaceForAllTy (toIfaceTvBndr v) 
                                                     (coToIfaceType co)
-coToIfaceType (CoVarCo cv)          = IfaceTyVar  (toIfaceTyCoVar cv)
+coToIfaceType (CoVarCo cv)          = IfaceTyVar  (toIfaceCoVar cv)
 coToIfaceType (AxiomInstCo con cos) = IfaceCoConApp (IfaceCoAx (coAxiomName con))
                                                     (map coToIfaceType cos)
 coToIfaceType (UnsafeCo ty1 ty2)    = IfaceCoConApp IfaceUnsafeCo 
diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs
index daa0bb0284..9b7a40fb3a 100644
--- a/compiler/iface/LoadIface.lhs
+++ b/compiler/iface/LoadIface.lhs
@@ -655,6 +655,7 @@ pprModIface iface
         , nest 2 (text "ABI hash:" <+> ppr (mi_mod_hash iface))
         , nest 2 (text "export-list hash:" <+> ppr (mi_exp_hash iface))
         , nest 2 (text "orphan hash:" <+> ppr (mi_orphan_hash iface))
+        , nest 2 (text "used TH splices:" <+> ppr (mi_used_th iface))
         , nest 2 (ptext (sLit "where"))
 	, vcat (map pprExport (mi_exports iface))
 	, pprDeps (mi_deps iface)
@@ -669,6 +670,7 @@ pprModIface iface
         , pprVectInfo (mi_vect_info iface)
 	, ppr (mi_warns iface)
 	, pprTrustInfo (mi_trust iface)
+	, pprTrustPkg (mi_trust_pkg iface)
  	]
   where
     pp_boot | mi_boot iface = ptext (sLit "[boot]")
@@ -756,6 +758,9 @@ pprVectInfo (IfaceVectInfo { ifaceVectInfoVar          = vars
 pprTrustInfo :: IfaceTrustInfo -> SDoc
 pprTrustInfo trust = ptext (sLit "trusted:") <+> ppr trust
 
+pprTrustPkg :: Bool -> SDoc
+pprTrustPkg tpkg = ptext (sLit "require own pkg trusted:") <+> ppr tpkg
+
 instance Outputable Warnings where
     ppr = pprWarns
 
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 42a4278b4f..7e1a4631a5 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -123,18 +123,20 @@ mkIface :: HscEnv
                                 --          to write it
 
 mkIface hsc_env maybe_old_fingerprint mod_details
-         ModGuts{     mg_module    = this_mod,
-		      mg_boot      = is_boot,
-		      mg_used_names = used_names,
-		      mg_deps      = deps,
-                      mg_dir_imps  = dir_imp_mods,
-		      mg_rdr_env   = rdr_env,
-		      mg_fix_env   = fix_env,
-		      mg_warns   = warns,
-	              mg_hpc_info  = hpc_info }
+         ModGuts{     mg_module     = this_mod,
+                      mg_boot       = is_boot,
+                      mg_used_names = used_names,
+                      mg_used_th    = used_th,
+                      mg_deps       = deps,
+                      mg_dir_imps   = dir_imp_mods,
+                      mg_rdr_env    = rdr_env,
+                      mg_fix_env    = fix_env,
+                      mg_warns      = warns,
+                      mg_hpc_info   = hpc_info,
+                      mg_trust_pkg  = self_trust }
         = mkIface_ hsc_env maybe_old_fingerprint
-                   this_mod is_boot used_names deps rdr_env 
-                   fix_env warns hpc_info dir_imp_mods mod_details
+                   this_mod is_boot used_names used_th deps rdr_env fix_env
+                   warns hpc_info dir_imp_mods self_trust mod_details
 
 -- | make an interface from the results of typechecking only.  Useful
 -- for non-optimising compilation, or where we aren't generating any
@@ -151,20 +153,25 @@ mkIfaceTc hsc_env maybe_old_fingerprint mod_details
                       tcg_rdr_env = rdr_env,
                       tcg_fix_env = fix_env,
                       tcg_warns = warns,
-                      tcg_hpc = other_hpc_info
+                      tcg_hpc = other_hpc_info,
+                      tcg_th_splice_used = tc_splice_used
                     }
   = do
           let used_names = mkUsedNames tc_result
           deps <- mkDependencies tc_result
           let hpc_info = emptyHpcInfo other_hpc_info
+          used_th <- readIORef tc_splice_used
           mkIface_ hsc_env maybe_old_fingerprint
-                   this_mod (isHsBoot hsc_src) used_names deps rdr_env 
-                   fix_env warns hpc_info (imp_mods imports) mod_details
+                   this_mod (isHsBoot hsc_src) used_names used_th deps rdr_env
+                   fix_env warns hpc_info (imp_mods imports)
+                   (imp_trust_own_pkg imports) mod_details
         
 
 mkUsedNames :: TcGblEnv -> NameSet
 mkUsedNames TcGblEnv{ tcg_dus = dus } = allUses dus
         
+-- | Extract information from the rename and typecheck phases to produce
+-- a dependencies information for the module being compiled.
 mkDependencies :: TcGblEnv -> IO Dependencies
 mkDependencies
           TcGblEnv{ tcg_mod = mod,
@@ -172,9 +179,9 @@ mkDependencies
                     tcg_th_used = th_var
                   }
  = do 
-      th_used   <- readIORef th_var                     -- Whether TH is used
-      let
-        dep_mods = eltsUFM (delFromUFM (imp_dep_mods imports) (moduleName mod))
+      -- Template Haskell used?
+      th_used <- readIORef th_var
+      let dep_mods = eltsUFM (delFromUFM (imp_dep_mods imports) (moduleName mod))
                 -- M.hi-boot can be in the imp_dep_mods, but we must remove
                 -- it before recording the modules on which this one depends!
                 -- (We want to retain M.hi-boot in imp_dep_mods so that 
@@ -182,30 +189,31 @@ mkDependencies
                 --  on M.hi-boot, and hence that we should do the hi-boot consistency 
                 --  check.)
 
-        pkgs | th_used   = insertList thPackageId (imp_dep_pkgs imports)
-             | otherwise = imp_dep_pkgs imports
+          pkgs | th_used   = insertList thPackageId (imp_dep_pkgs imports)
+               | otherwise = imp_dep_pkgs imports
 
-        -- add in safe haskell 'package needs to be safe' bool
-        sorted_pkgs = sortBy stablePackageIdCmp pkgs
-        trust_pkgs  = imp_trust_pkgs imports
-        dep_pkgs'   = map (\x -> (x, x `elem` trust_pkgs)) sorted_pkgs
+          -- Set the packages required to be Safe according to Safe Haskell.
+          -- See Note [RnNames . Tracking Trust Transitively]
+          sorted_pkgs = sortBy stablePackageIdCmp pkgs
+          trust_pkgs  = imp_trust_pkgs imports
+          dep_pkgs'   = map (\x -> (x, x `elem` trust_pkgs)) sorted_pkgs
 
       return Deps { dep_mods   = sortBy (stableModuleNameCmp `on` fst) dep_mods,
                     dep_pkgs   = dep_pkgs',
                     dep_orphs  = sortBy stableModuleCmp (imp_orphs  imports),
                     dep_finsts = sortBy stableModuleCmp (imp_finsts imports) }
-                -- sort to get into canonical order
-                -- NB. remember to use lexicographic ordering
+                    -- sort to get into canonical order
+                    -- NB. remember to use lexicographic ordering
 
 mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface
-         -> NameSet -> Dependencies -> GlobalRdrEnv
+         -> NameSet -> Bool -> Dependencies -> GlobalRdrEnv
          -> NameEnv FixItem -> Warnings -> HpcInfo
-         -> ImportedMods
+         -> ImportedMods -> Bool
          -> ModDetails
-	 -> IO (Messages, Maybe (ModIface, Bool))
+         -> IO (Messages, Maybe (ModIface, Bool))
 mkIface_ hsc_env maybe_old_fingerprint 
-         this_mod is_boot used_names deps rdr_env fix_env src_warns hpc_info
-         dir_imp_mods
+         this_mod is_boot used_names used_th deps rdr_env fix_env src_warns
+         hpc_info dir_imp_mods pkg_trust_req
 	 ModDetails{  md_insts 	   = insts, 
 		      md_fam_insts = fam_insts,
 		      md_rules 	   = rules,
@@ -232,7 +240,7 @@ mkIface_ hsc_env maybe_old_fingerprint
 				-- Sigh: see Note [Root-main Id] in TcRnDriver
 
 		; fixities    = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env]
-		; warns     = src_warns
+		; warns       = src_warns
 		; iface_rules = map (coreRuleToIfaceRule this_mod) rules
 		; iface_insts = map instanceToIfaceInst insts
 		; iface_fam_insts = map famInstToIfaceFamInst fam_insts
@@ -263,7 +271,8 @@ mkIface_ hsc_env maybe_old_fingerprint
 			mi_iface_hash = fingerprint0,
 			mi_mod_hash  = fingerprint0,
  			mi_exp_hash  = fingerprint0,
- 			mi_orphan_hash = fingerprint0,
+                        mi_used_th   = used_th,
+                        mi_orphan_hash = fingerprint0,
 			mi_orphan    = False,	-- Always set by addVersionInfo, but
 						-- it's a strict field, so we can't omit it.
                         mi_finsts    = False,   -- Ditto
@@ -271,6 +280,7 @@ mkIface_ hsc_env maybe_old_fingerprint
 			mi_hash_fn   = deliberatelyOmitted "hash_fn",
 			mi_hpc       = isHpcUsed hpc_info,
 			mi_trust     = trust_info,
+			mi_trust_pkg = pkg_trust_req,
 
 			-- And build the cached values
 			mi_warn_fn = mkIfaceWarnCache warns,
@@ -283,8 +293,8 @@ mkIface_ hsc_env maybe_old_fingerprint
                                          intermediate_iface decls
 
 		-- Warn about orphans
-	; let warn_orphs      = dopt Opt_WarnOrphans dflags
-              warn_auto_orphs = dopt Opt_WarnAutoOrphans dflags
+	; let warn_orphs      = wopt Opt_WarnOrphans dflags
+              warn_auto_orphs = wopt Opt_WarnAutoOrphans dflags
               orph_warnings   --- Laziness means no work done unless -fwarn-orphans
 	        | warn_orphs || warn_auto_orphs = rule_warns `unionBags` inst_warns
 	        | otherwise 	       	        = emptyBag
@@ -468,7 +478,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
           = do let hash_fn = mk_put_name local_env
                    decl = abiDecl abi
                -- pprTrace "fingerprinting" (ppr (ifName decl) ) $ do
-               hash <- computeFingerprint dflags hash_fn abi
+               hash <- computeFingerprint hash_fn abi
                return (extend_hash_env (hash,decl) local_env,
                        (hash,decl) : decls_w_hashes)
 
@@ -480,7 +490,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
                -- pprTrace "fingerprinting" (ppr (map ifName decls) ) $ do
                let stable_abis = sortBy cmp_abiNames abis
                 -- put the cycle in a canonical order
-               hash <- computeFingerprint dflags hash_fn stable_abis
+               hash <- computeFingerprint hash_fn stable_abis
                let pairs = zip (repeat hash) decls
                return (foldr extend_hash_env local_env pairs,
                        pairs ++ decls_w_hashes)
@@ -514,12 +524,12 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
                    $ dep_orphs sorted_deps
    dep_orphan_hashes <- getOrphanHashes hsc_env orph_mods
 
-   orphan_hash <- computeFingerprint dflags (mk_put_name local_env)
+   orphan_hash <- computeFingerprint (mk_put_name local_env)
                       (map ifDFun orph_insts, orph_rules, fam_insts)
 
    -- the export list hash doesn't depend on the fingerprints of
    -- the Names it mentions, only the Names themselves, hence putNameLiterally.
-   export_hash <- computeFingerprint dflags putNameLiterally 
+   export_hash <- computeFingerprint putNameLiterally
                       (mi_exports iface0,
                        orphan_hash,
                        dep_orphan_hashes,
@@ -527,9 +537,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
                         -- dep_pkgs: see "Package Version Changes" on
                         -- wiki/Commentary/Compiler/RecompilationAvoidance
                        mi_trust iface0)
-                        -- TODO: Can probably make more fine grained. Only
-                        -- really need to have recompilation for overlapping
-                        -- instances.
+                        -- Make sure change of Safe Haskell mode causes recomp.
 
    -- put the declarations in a canonical order, sorted by OccName
    let sorted_decls = Map.elems $ Map.fromList $
@@ -541,7 +549,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
    --   - orphans
    --   - deprecations
    --   - XXX vect info?
-   mod_hash <- computeFingerprint dflags putNameLiterally
+   mod_hash <- computeFingerprint putNameLiterally
                       (map fst sorted_decls,
                        export_hash,
                        orphan_hash,
@@ -552,7 +560,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
    --    - usages
    --    - deps
    --    - hpc
-   iface_hash <- computeFingerprint dflags putNameLiterally
+   iface_hash <- computeFingerprint putNameLiterally
                       (mod_hash, 
                        mi_usages iface0,
                        sorted_deps,
@@ -745,19 +753,6 @@ putNameLiterally bh name = ASSERT( isExternalName name )
   do { put_ bh $! nameModule name
      ; put_ bh $! nameOccName name }
 
-computeFingerprint :: Binary a
-                   => DynFlags 
-                   -> (BinHandle -> Name -> IO ())
-                   -> a
-                   -> IO Fingerprint
-
-computeFingerprint _dflags put_name a = do
-  bh <- openBinMem (3*1024) -- just less than a block
-  ud <- newWriteState put_name putFS
-  bh <- return $ setUserData bh ud
-  put_ bh a
-  fingerprintBinMem bh
-
 {-
 -- for testing: use the md5sum command to generate fingerprints and
 -- compare the results against our built-in version.
@@ -918,7 +913,7 @@ mk_usage_info pit hsc_env this_mod direct_imports used_names
                 Just _                  -> pprPanic "mkUsage: empty direct import" empty
                 Nothing                 -> (False, safeImplicitImpsReq dflags)
                 -- Nothing case is for implicit imports like 'System.IO' when 'putStrLn'
-                -- is used in the source code. We require them to be safe in SafeHaskell
+                -- is used in the source code. We require them to be safe in Safe Haskell
     
         used_occs = lookupModuleEnv ent_map mod `orElse` []
 
@@ -1041,21 +1036,20 @@ so we may need to split up a single Avail into multiple ones.
 \begin{code}
 checkOldIface :: HscEnv
 	      -> ModSummary
-	      -> Bool 			-- Source unchanged
+              -> SourceModified
 	      -> Maybe ModIface 	-- Old interface from compilation manager, if any
 	      -> IO (RecompileRequired, Maybe ModIface)
 
-checkOldIface hsc_env mod_summary source_unchanged maybe_iface
+checkOldIface hsc_env mod_summary source_modified maybe_iface
   = do  showPass (hsc_dflags hsc_env) $
             "Checking old interface for " ++ (showSDoc $ ppr $ ms_mod mod_summary)
         initIfaceCheck hsc_env $
-            check_old_iface hsc_env mod_summary source_unchanged maybe_iface
+            check_old_iface hsc_env mod_summary source_modified maybe_iface
 
-check_old_iface :: HscEnv -> ModSummary -> Bool -> Maybe ModIface
+check_old_iface :: HscEnv -> ModSummary -> SourceModified -> Maybe ModIface
                 -> IfG (Bool, Maybe ModIface)
-check_old_iface hsc_env mod_summary src_unchanged maybe_iface
-  = let src_changed = not src_unchanged
-        dflags = hsc_dflags hsc_env
+check_old_iface hsc_env mod_summary src_modified maybe_iface
+  = let dflags = hsc_dflags hsc_env
         getIface =
              case maybe_iface of
                  Just _  -> do
@@ -1073,23 +1067,34 @@ check_old_iface hsc_env mod_summary src_unchanged maybe_iface
                              return $ Just iface
 
     in do
-        when src_changed
+         let src_changed
+              | dopt Opt_ForceRecomp (hsc_dflags hsc_env) = True
+              | SourceModified <- src_modified = True
+              | otherwise = False
+
+         when src_changed
              (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
 
-         -- If the source has changed and we're in interactive mode, avoid reading
-         -- an interface; just return the one we might have been supplied with.
-        if not (isObjectTarget $ hscTarget dflags) && src_changed
+         -- If the source has changed and we're in interactive mode,
+         -- avoid reading an interface; just return the one we might
+         -- have been supplied with.
+         if not (isObjectTarget $ hscTarget dflags) && src_changed
             then return (outOfDate, maybe_iface)
             else do
                 -- Try and read the old interface for the current module
                 -- from the .hi file left from the last time we compiled it
                 maybe_iface' <- getIface
+                if src_changed
+                   then return (outOfDate, maybe_iface')
+                   else do
                 case maybe_iface' of
                     Nothing -> return (outOfDate, maybe_iface')
-                    Just iface -> do
-                        -- We have got the old iface; check its versions
-                        recomp <- checkVersions hsc_env src_unchanged mod_summary iface
-                        return recomp
+                    Just iface ->
+                      -- We have got the old iface; check its versions
+                      -- even in the SourceUnmodifiedAndStable case we
+                      -- should check versions because some packages
+                      -- might have changed or gone away.
+                      checkVersions hsc_env mod_summary iface
 \end{code}
 
 @recompileRequired@ is called from the HscMain.   It checks whether
@@ -1110,16 +1115,10 @@ safeHsChanged hsc_env iface
   = (getSafeMode $ mi_trust iface) /= (safeHaskell $ hsc_dflags hsc_env)
 
 checkVersions :: HscEnv
-	      -> Bool		-- True <=> source unchanged
               -> ModSummary
 	      -> ModIface 	-- Old interface
 	      -> IfG (RecompileRequired, Maybe ModIface)
-checkVersions hsc_env source_unchanged mod_summary iface
-  | not source_unchanged
-  = let iface' = if safeHsChanged hsc_env iface then Nothing else Just iface
-    in return (outOfDate, iface')
-
-  | otherwise
+checkVersions hsc_env mod_summary iface
   = do { traceHiDiffs (text "Considering whether compilation is required for" <+>
                         ppr (mi_module iface) <> colon)
 
@@ -1532,7 +1531,7 @@ toIfaceIdInfo id_info
 
     ------------  Unfolding  --------------
     unfold_hsinfo = toIfUnfolding loop_breaker (unfoldingInfo id_info) 
-    loop_breaker  = isNonRuleLoopBreaker (occInfo id_info)
+    loop_breaker  = isStrongLoopBreaker (occInfo id_info)
 					
     ------------  Inline prag  --------------
     inline_prag = inlinePragInfo id_info
@@ -1563,7 +1562,7 @@ toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs, uf_arity = arity
     if_rhs = toIfaceExpr rhs
 
 toIfUnfolding lb (DFunUnfolding _ar _con ops)
-  = Just (HsUnfold lb (IfDFunUnfold (map (fmap toIfaceExpr) ops)))
+  = Just (HsUnfold lb (IfDFunUnfold (map toIfaceExpr ops)))
       -- No need to serialise the data constructor; 
       -- we can recover it from the type of the dfun
 
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 2187f03c61..8cfe3017e2 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -40,7 +40,7 @@ import TyCon
 import DataCon
 import TysWiredIn
 import TysPrim          ( anyTyConOfKind )
-import BasicTypes       ( Arity, nonRuleLoopBreaker )
+import BasicTypes       ( Arity, strongLoopBreaker )
 import qualified Var
 import VarEnv
 import VarSet
@@ -1055,7 +1055,7 @@ tcIdInfo ignore_prags name ty info
 	-- The next two are lazy, so they don't transitively suck stuff in
     tcPrag info (HsUnfold lb if_unf) 
       = do { unf <- tcUnfolding name ty info if_unf
-    	   ; let info1 | lb        = info `setOccInfo` nonRuleLoopBreaker
+    	   ; let info1 | lb        = info `setOccInfo` strongLoopBreaker
 	     	       | otherwise = info
 	   ; return (info1 `setUnfoldingInfoLazily` unf) }
 \end{code}
@@ -1091,14 +1091,12 @@ tcUnfolding name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr)
     }
 
 tcUnfolding name dfun_ty _ (IfDFunUnfold ops)
-  = do { mb_ops1 <- forkM_maybe doc $ mapM tc_arg ops
+  = do { mb_ops1 <- forkM_maybe doc $ mapM tcIfaceExpr ops
        ; return (case mb_ops1 of
        	 	    Nothing   -> noUnfolding
                     Just ops1 -> mkDFunUnfolding dfun_ty ops1) }
   where
     doc = text "Class ops for dfun" <+> ppr name
-    tc_arg (DFunPolyArg  e) = do { e' <- tcIfaceExpr e; return (DFunPolyArg e') }
-    tc_arg (DFunConstArg e) = do { e' <- tcIfaceExpr e; return (DFunConstArg e') }
 
 tcUnfolding name ty info (IfExtWrapper arity wkr)
   = tcIfaceWrapper name ty info arity (tcIfaceExtId wkr)