Rough matches for family instances
[ghc-hetmet.git] / compiler / iface / MkIface.lhs
index 2069f89..11235ce 100644 (file)
@@ -176,7 +176,8 @@ compiled with -O.  I think this is the case.]
 #include "HsVersions.h"
 
 import IfaceSyn                -- All of it
-import IfaceType       ( toIfaceTvBndrs, toIfaceType, toIfaceContext )
+import IfaceType       ( toIfaceTvBndrs, toIfaceType, toIfaceContext,
+                         ifaceTyConOccName )
 import LoadIface       ( readIface, loadInterface, pprModIface )
 import Id              ( Id, idName, idType, idInfo, idArity, isDataConWorkId_maybe, isFCallId_maybe )
 import IdInfo          ( IdInfo, CafInfo(..), WorkerInfo(..), 
@@ -200,12 +201,14 @@ import Type               ( TyThing(..), splitForAllTys, funResultTy )
 import TcType          ( deNoteType )
 import TysPrim         ( alphaTyVars )
 import InstEnv         ( Instance(..) )
+import FamInstEnv      ( FamInst(..) )
 import TcRnMonad
 import HscTypes                ( ModIface(..), ModDetails(..), 
-                         ModGuts(..), HscEnv(..), hscEPS, Dependencies(..), FixItem(..),
+                         ModGuts(..), HscEnv(..), hscEPS, Dependencies(..),
+                         FixItem(..), 
                          ModSummary(..), msHiFilePath, 
                          mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache,
-                         typeEnvElts, 
+                         typeEnvElts,
                          GenAvailInfo(..), availName, 
                          ExternalPackageState(..),
                          Usage(..), IsBootInterface,
@@ -230,7 +233,6 @@ import Module
 import Outputable
 import BasicTypes      ( Version, initialVersion, bumpVersion, isAlwaysActive,
                          Activation(..), RecFlag(..), boolToRecFlag )
-import Outputable
 import Util            ( createDirectoryHierarchy, directoryOf, sortLe, seqList, lengthIs )
 import BinIface                ( writeBinIface )
 import Unique          ( Unique, Uniquable(..) )
@@ -266,17 +268,18 @@ mkIface :: HscEnv
                                --          is identical, so no need to write it
 
 mkIface hsc_env maybe_old_iface 
-       (ModGuts{     mg_module  = this_mod,
-                     mg_boot    = is_boot,
-                     mg_usages  = usages,
-                     mg_deps    = deps,
-                     mg_rdr_env = rdr_env,
-                     mg_fix_env = fix_env,
-                     mg_deprecs = src_deprecs })
-       (ModDetails{  md_insts   = insts, 
-                     md_rules   = rules,
-                     md_types   = type_env,
-                     md_exports = exports })
+       (ModGuts{     mg_module    = this_mod,
+                     mg_boot      = is_boot,
+                     mg_usages    = usages,
+                     mg_deps      = deps,
+                     mg_rdr_env   = rdr_env,
+                     mg_fix_env   = fix_env,
+                     mg_deprecs   = src_deprecs })
+       (ModDetails{  md_insts     = insts, 
+                     md_fam_insts = fam_insts,
+                     md_rules     = rules,
+                     md_types     = type_env,
+                     md_exports   = exports })
        
 -- NB: notice that mkIface does not look at the bindings
 --     only at the TypeEnv.  The previous Tidy phase has
@@ -294,10 +297,14 @@ mkIface hsc_env maybe_old_iface
                        -- Don't put implicit Ids and class tycons in the interface file
                        -- Nor wired-in things; the compiler knows about them anyhow
 
-               ; fixities    = [(occ,fix) | FixItem occ fix _ <- nameEnvElts fix_env]
-               ; deprecs     = mkIfaceDeprec src_deprecs
-               ; iface_rules = map (coreRuleToIfaceRule ext_nm_lhs ext_nm_rhs) rules
-               ; iface_insts = map (instanceToIfaceInst ext_nm_lhs) insts
+               ; fixities        = [ (occ,fix) 
+                                   | FixItem occ fix _ <- nameEnvElts fix_env]
+               ; deprecs         = mkIfaceDeprec src_deprecs
+               ; iface_rules     = map (coreRuleToIfaceRule 
+                                          ext_nm_lhs ext_nm_rhs) rules
+               ; iface_insts     = map (instanceToIfaceInst ext_nm_lhs) insts
+               ; iface_fam_insts = map (famInstToIfaceFamInst ext_nm_lhs) 
+                                       fam_insts
 
                ; intermediate_iface = ModIface { 
                        mi_module   = this_mod,
@@ -306,6 +313,7 @@ mkIface hsc_env maybe_old_iface
                        mi_usages   = usages,
                        mi_exports  = mkIfaceExports exports,
                        mi_insts    = sortLe le_inst iface_insts,
+                       mi_fam_insts= sortLe le_fam_inst iface_fam_insts,
                        mi_rules    = sortLe le_rule iface_rules,
                        mi_fixities = fixities,
                        mi_deprecs  = deprecs,
@@ -339,11 +347,13 @@ mkIface hsc_env maybe_old_iface
 
        ; return (new_iface, no_change_at_all) }
   where
-     r1 `le_rule` r2 = ifRuleName r1 <= ifRuleName r2
-     i1 `le_inst` i2 = ifDFun     i1 <= ifDFun     i2
+     r1 `le_rule`     r2      = ifRuleName        r1 <= ifRuleName        r2
+     i1 `le_inst`     i2      = ifDFun            i1 <= ifDFun            i2
+     i1 `le_fam_inst` i2      = ifFamInstTyConOcc i1 <= ifFamInstTyConOcc i2
 
      dflags = hsc_dflags hsc_env
      deliberatelyOmitted x = panic ("Deliberately omitted: " ++ x)
+     ifFamInstTyConOcc = ifaceTyConOccName . ifFamInstTyCon
 
                                              
 -----------------------------
@@ -787,44 +797,42 @@ checkOldIface hsc_env mod_summary source_unchanged maybe_iface
      }
 
 check_old_iface hsc_env mod_summary source_unchanged maybe_iface
- =     -- CHECK WHETHER THE SOURCE HAS CHANGED
-    ifM (not source_unchanged)
-       (traceHiDiffs (nest 4 (text "Source file changed or recompilation check turned off")))
-                                               `thenM_`
+ =  do         -- CHECK WHETHER THE SOURCE HAS CHANGED
+    { ifM (not source_unchanged)
+          (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.
-    getGhcMode                                 `thenM` \ ghc_mode ->
-    if (ghc_mode == Interactive || ghc_mode == JustTypecheck) 
-       && not source_unchanged then
-         returnM (outOfDate, maybe_iface)
-    else
-
-    case maybe_iface of {
-       Just old_iface -> do -- Use the one we already have
-       recomp <- checkVersions hsc_env source_unchanged old_iface
-       return (recomp, Just old_iface)
-
-    ;  Nothing ->
+    ; ghc_mode <- getGhcMode
+    ; if (ghc_mode == Interactive || ghc_mode == JustTypecheck) 
+        && not source_unchanged then
+         return (outOfDate, maybe_iface)
+      else
+      case maybe_iface of {
+        Just old_iface -> do -- Use the one we already have
+         { traceIf (text "We already have the old interface for" <+> ppr (ms_mod mod_summary))
+         ; recomp <- checkVersions hsc_env source_unchanged old_iface
+         ; return (recomp, Just old_iface) }
+
+      ; Nothing -> do
 
        -- Try and read the old interface for the current module
        -- from the .hi file left from the last time we compiled it
-    let
-       iface_path = msHiFilePath mod_summary
-    in
-    readIface (ms_mod mod_summary) iface_path False    `thenM` \ read_result ->
-    case read_result of {
-       Failed err ->   -- Old interface file not found, or garbled; give up
-                  traceIf (text "FYI: cannot read old interface file:"
-                                $$ nest 4 err)         `thenM_`
-                  returnM (outOfDate, Nothing)
+    { let iface_path = msHiFilePath mod_summary
+    ; read_result <- readIface (ms_mod mod_summary) iface_path False
+    ; case read_result of {
+         Failed err -> do      -- Old interface file not found, or garbled; give up
+               { traceIf (text "FYI: cannot read old interface file:"
+                                $$ nest 4 err)
+               ; return (outOfDate, Nothing) }
 
-    ;  Succeeded iface ->      
+      ;  Succeeded iface -> do
 
        -- We have got the old iface; check its versions
-    checkVersions hsc_env source_unchanged iface       `thenM` \ recomp ->
-    returnM (recomp, Just iface)
-    }}
+    { traceIf (text "Read the interface file" <+> text iface_path)
+    ; recomp <- checkVersions hsc_env source_unchanged iface
+    ; returnM (recomp, Just iface)
+    }}}}}
 \end{code}
 
 @recompileRequired@ is called from the HscMain.   It checks whether
@@ -857,7 +865,9 @@ checkVersions hsc_env source_unchanged iface
        -- (in which case we are done with this module) or it'll fail (in which
        -- case we'll compile the module from scratch anyhow).
        --      
-       -- We do this regardless of compilation mode
+       -- We do this regardless of compilation mode, although in --make mode
+       -- all the dependent modules should be in the HPT already, so it's
+       -- quite redundant
        ; updateEps_ $ \eps  -> eps { eps_is_boot = mod_deps }
 
        ; let this_pkg = thisPackage (hsc_dflags hsc_env)
@@ -1110,6 +1120,17 @@ instanceToIfaceInst ext_lhs ispec@(Instance { is_dfun = dfun_id, is_flag = oflag
     do_rough (Just n) = Just (toIfaceTyCon_name ext_lhs n)
 
 --------------------------
+famInstToIfaceFamInst :: (Name -> IfaceExtName) -> FamInst -> IfaceFamInst
+famInstToIfaceFamInst ext_lhs fi@(FamInst { fi_tycon = tycon,
+                                           fi_fam = fam, fi_tcs = mb_tcs })
+  = IfaceFamInst { ifFamInstTyCon  = toIfaceTyCon ext_lhs tycon
+                , ifFamInstFam    = ext_lhs fam
+                , ifFamInstTys    = map do_rough mb_tcs }
+  where
+    do_rough Nothing  = Nothing
+    do_rough (Just n) = Just (toIfaceTyCon_name ext_lhs n)
+
+--------------------------
 toIfaceIdInfo :: (Name -> IfaceExtName) -> IdInfo -> [IfaceInfoItem]
 toIfaceIdInfo ext id_info
   = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo,