Add (a) CoreM monad, (b) new Annotations feature

[ghc-hetmet.git] / compiler / typecheck / FamInst.lhs

diff --git a/compiler/typecheck/FamInst.lhs b/compiler/typecheck/FamInst.lhs
index fd98fe9..67c526d 100644 (file)
--- a/compiler/typecheck/FamInst.lhs
+++ b/compiler/typecheck/FamInst.lhs
@@ -5,8 +5,6 @@ module FamInst (
         checkFamInstConsistency, tcExtendLocalFamInstEnv
     ) where
 
         checkFamInstConsistency, tcExtendLocalFamInstEnv
     ) where
 

-#include "HsVersions.h"
-

 import HscTypes
 import FamInstEnv
 import TcMType
 import HscTypes
 import FamInstEnv
 import TcMType

@@ -18,8 +16,9 @@ import Name
 import Module
 import SrcLoc
 import Outputable
 import Module
 import SrcLoc
 import Outputable

-import UniqFM
+import LazyUniqFM

 import FiniteMap
 import FiniteMap

+import FastString

 
 import Maybe
 import Monad
 
 import Maybe
 import Monad

@@ -37,6 +36,16 @@ check whether the instances in the two modules are consistent, *unless* we can
 be certain that the instances of the two modules have already been checked for
 consistency during the compilation of modules that we import.
 
 be certain that the instances of the two modules have already been checked for
 consistency during the compilation of modules that we import.
 

+Why do we need to check?  Consider 
+   module X1 where               module X2 where
+    data T1                        data T2
+    type instance F T1 b = Int     type instance F a T2 = Char
+    f1 :: F T1 a -> Int                    f2 :: Char -> F a T2
+    f1 x = x                       f2 x = x
+
+Now if we import both X1 and X2 we could make (f2 . f1) :: Int -> Char.
+Notice that neither instance is an orphan.
+

 How do we know which pairs of modules have already been checked?  Any pair of
 modules where both modules occur in the `HscTypes.dep_finsts' set (of the
 `HscTypes.Dependencies') of one of our directly imported modules must have
 How do we know which pairs of modules have already been checked?  Any pair of
 modules where both modules occur in the `HscTypes.dep_finsts' set (of the
 `HscTypes.Dependencies') of one of our directly imported modules must have

@@ -174,31 +183,41 @@ checkForConflicts inst_envs famInst
                         Nothing        -> panic "FamInst.checkForConflicts"
                         Just (tc, tys) -> tc `mkTyConApp` tys
              }
                         Nothing        -> panic "FamInst.checkForConflicts"
                         Just (tc, tys) -> tc `mkTyConApp` tys
              }

-       ; (tvs', _, tau') <- tcInstSkolType FamInstSkol ty
+       ; (_, _, tau') <- tcInstSkolType FamInstSkol ty

 
        ; let (fam, tys') = tcSplitTyConApp tau'
 
        ; let { matches   = lookupFamInstEnvUnify inst_envs fam tys'
             ; conflicts = [ conflictingFamInst
 
        ; let (fam, tys') = tcSplitTyConApp tau'
 
        ; let { matches   = lookupFamInstEnvUnify inst_envs fam tys'
             ; conflicts = [ conflictingFamInst

-                          | match@(_, conflictingFamInst) <- matches
-                          , conflicting fam tys' tycon match 
+                          | match@((conflictingFamInst, _), _) <- matches
+                          , conflicting tycon match 

                           ]
             }
        ; unless (null conflicts) $
           conflictInstErr famInst (head conflicts)
        }
   where
                           ]
             }
        ; unless (null conflicts) $
           conflictInstErr famInst (head conflicts)
        }
   where

-    -- In the case of data/newtype instances, any overlap is a conflict (as
-    -- these instances imply injective type mappings).
-    conflicting _   _    tycon _                 | isAlgTyCon tycon = True
-    conflicting fam tys' tycon (subst, cFamInst) | otherwise     =
-      panic "FamInst.checkForConflicts: overlap check for indexed synonyms is still missing"
-
+      -- - In the case of data family instances, any overlap is fundamentally a
+      --   conflict (as these instances imply injective type mappings).
+      -- - In the case of type family instances, overlap is admitted as long as
+      --   the right-hand sides of the overlapping rules coincide under the
+      --   overlap substitution.  We require that they are syntactically equal;
+      --   anything else would be difficult to test for at this stage.
+    conflicting tycon1 ((famInst2, _), subst) 
+      | isAlgTyCon tycon1 = True
+      | otherwise         = not (rhs1 `tcEqType` rhs2)
+      where
+        tycon2 = famInstTyCon famInst2
+        rhs1   = substTy subst $ synTyConType tycon1
+        rhs2   = substTy subst $ synTyConType tycon2
+
+conflictInstErr :: FamInst -> FamInst -> TcRn ()

 conflictInstErr famInst conflictingFamInst
   = addFamInstLoc famInst $
 conflictInstErr famInst conflictingFamInst
   = addFamInstLoc famInst $

-    addErr (hang (ptext SLIT("Conflicting family instance declarations:"))
+    addErr (hang (ptext (sLit "Conflicting family instance declarations:"))

               2 (pprFamInsts [famInst, conflictingFamInst]))
 
               2 (pprFamInsts [famInst, conflictingFamInst]))
 

+addFamInstLoc :: FamInst -> TcRn a -> TcRn a

 addFamInstLoc famInst thing_inside
   = setSrcSpan (mkSrcSpan loc loc) thing_inside
   where
 addFamInstLoc famInst thing_inside
   = setSrcSpan (mkSrcSpan loc loc) thing_inside
   where