Add {-# OPTIONS_GHC -w #-} and some blurb to all compiler modules

[ghc-hetmet.git] / compiler / iface / IfaceSyn.lhs

diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 5a18da3..20cc5c6 100644 (file)
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -4,6 +4,13 @@
 %
 
 \begin{code}
+{-# OPTIONS_GHC -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings
+-- for details
+
 module IfaceSyn (
        module IfaceType,               -- Re-export all this
 
@@ -39,6 +46,7 @@ import ForeignCall
 import BasicTypes
 import Outputable
 import FastString
+import Module
 
 import Data.List
 import Data.Maybe
@@ -77,14 +85,21 @@ data IfaceDecl
                                                -- current compilation unit 
                 ifFamInst    :: Maybe (IfaceTyCon, [IfaceType])
                                                 -- Just <=> instance of family
+                                                -- Invariant: 
+                                                --   ifCons /= IfOpenDataTyCon
+                                                --   for family instances
     }
 
   | IfaceSyn  {        ifName    :: OccName,           -- Type constructor
                ifTyVars  :: [IfaceTvBndr],     -- Type variables
                ifOpenSyn :: Bool,              -- Is an open family?
-               ifSynRhs  :: IfaceType          -- Type for an ordinary
+               ifSynRhs  :: IfaceType,         -- Type for an ordinary
                                                -- synonym and kind for an
                                                -- open family
+                ifFamInst    :: Maybe (IfaceTyCon, [IfaceType])
+                                                -- Just <=> instance of family
+                                                -- Invariant: ifOpenSyn == False
+                                                --   for family instances
     }
 
   | IfaceClass { ifCtxt    :: IfaceContext,    -- Context...
@@ -201,6 +216,7 @@ data IfaceExpr
   | IfaceCast   IfaceExpr IfaceCoercion
   | IfaceLit   Literal
   | IfaceFCall ForeignCall IfaceType
+  | IfaceTick   Module Int
 
 data IfaceNote = IfaceSCC CostCentre
               | IfaceInlineMe
@@ -391,9 +407,10 @@ pprIfaceDecl (IfaceForeign {ifName = tycon})
   = hsep [ptext SLIT("foreign import type dotnet"), ppr tycon]
 
 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, 
-                       ifOpenSyn = False, ifSynRhs = mono_ty})
+                       ifOpenSyn = False, ifSynRhs = mono_ty, 
+                        ifFamInst = mbFamInst})
   = hang (ptext SLIT("type") <+> pprIfaceDeclHead [] tycon tyvars)
-       4 (equals <+> ppr mono_ty)
+       4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
 
 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, 
                        ifOpenSyn = True, ifSynRhs = mono_ty})
@@ -512,6 +529,7 @@ pprIfaceExpr add_par (IfaceLcl v)       = ppr v
 pprIfaceExpr add_par (IfaceExt v)       = ppr v
 pprIfaceExpr add_par (IfaceLit l)       = ppr l
 pprIfaceExpr add_par (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
+pprIfaceExpr add_par (IfaceTick m ix)   = braces (text "tick" <+> ppr m <+> ppr ix)
 pprIfaceExpr add_par (IfaceType ty)     = char '@' <+> pprParendIfaceType ty
 
 pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
@@ -712,14 +730,10 @@ eqIfDecl d1@(IfaceData {}) d2@(IfaceData {})
        -- The type variables of the data type do not scope
        -- over the constructors (any more), but they do scope
        -- over the stupid context in the IfaceConDecls
-  where
-    Nothing             `eqIfTc_fam` Nothing             = Equal
-    (Just (fam1, tys1)) `eqIfTc_fam` (Just (fam2, tys2)) = 
-      fam1 `eqIfTc` fam2 &&& eqListBy eqIfType tys1 tys2
-    _                  `eqIfTc_fam` _                   = NotEqual
 
 eqIfDecl d1@(IfaceSyn {}) d2@(IfaceSyn {})
   = bool (ifName d1 == ifName d2) &&&
+    ifFamInst d1 `eqIfTc_fam` ifFamInst d2 &&&
     eqWith (ifTyVars d1) (ifTyVars d2) (\ env -> 
           eq_ifType env (ifSynRhs d1) (ifSynRhs d2)
         )
@@ -740,6 +754,15 @@ eqIfDecl _ _ = NotEqual    -- default case
 eqWith :: [IfaceTvBndr] -> [IfaceTvBndr] -> (EqEnv -> IfaceEq) -> IfaceEq
 eqWith = eq_ifTvBndrs emptyEqEnv
 
+eqIfTc_fam :: Maybe (IfaceTyCon, [IfaceType]) 
+           -> Maybe (IfaceTyCon, [IfaceType])
+           -> IfaceEq
+Nothing             `eqIfTc_fam` Nothing             = Equal
+(Just (fam1, tys1)) `eqIfTc_fam` (Just (fam2, tys2)) = 
+  fam1 `eqIfTc` fam2 &&& eqListBy eqIfType tys1 tys2
+_                      `eqIfTc_fam` _               = NotEqual
+
+
 -----------------------
 eqIfInst d1 d2 = bool (ifDFun d1 == ifDFun d2 && ifOFlag d1 == ifOFlag d2)
 -- All other changes are handled via the version info on the dfun
@@ -802,6 +825,7 @@ eq_ifaceExpr env (IfaceLcl v1)            (IfaceLcl v2)        = eqIfOcc env v1 v2
 eq_ifaceExpr env (IfaceExt v1)       (IfaceExt v2)        = eqIfExt v1 v2
 eq_ifaceExpr env (IfaceLit l1)        (IfaceLit l2)       = bool (l1 == l2)
 eq_ifaceExpr env (IfaceFCall c1 ty1)  (IfaceFCall c2 ty2)  = bool (c1==c2) &&& eq_ifType env ty1 ty2
+eq_ifaceExpr env (IfaceTick m1 ix1)   (IfaceTick m2 ix2)   = bool (m1==m2) &&& bool (ix1 == ix2)
 eq_ifaceExpr env (IfaceType ty1)      (IfaceType ty2)     = eq_ifType env ty1 ty2
 eq_ifaceExpr env (IfaceTuple n1 as1)  (IfaceTuple n2 as2)  = bool (n1==n2) &&& eqListBy (eq_ifaceExpr env) as1 as2
 eq_ifaceExpr env (IfaceLam b1 body1)  (IfaceLam b2 body2)  = eq_ifBndr env b1 b2 (\env -> eq_ifaceExpr env body1 body2)