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

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

diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 21080ee..7ef13a3 100644 (file)
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -10,7 +10,8 @@ module IfaceSyn (
        IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..),
        IfaceExpr(..), IfaceAlt, IfaceNote(..), IfaceLetBndr(..),
        IfaceBinding(..), IfaceConAlt(..), IfaceIdInfo(..),
-       IfaceInfoItem(..), IfaceRule(..), IfaceInst(..), IfaceFamInst(..),
+       IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
+       IfaceInst(..), IfaceFamInst(..),
 
        -- Misc
         ifaceDeclSubBndrs, visibleIfConDecls,
@@ -24,16 +25,17 @@ module IfaceSyn (
 
 #include "HsVersions.h"
 
-import CoreSyn
 import IfaceType
 
 import NewDemand
+import Annotations
 import Class
 import NameSet 
 import Name
 import CostCentre
 import Literal
 import ForeignCall
+import Serialized
 import BasicTypes
 import Outputable
 import FastString
@@ -82,11 +84,10 @@ data IfaceDecl
 
   | IfaceSyn  {        ifName    :: OccName,           -- Type constructor
                ifTyVars  :: [IfaceTvBndr],     -- Type variables
-               ifOpenSyn :: Bool,              -- Is an open family?
-               ifSynRhs  :: IfaceType,         -- Type for an ordinary
-                                               -- synonym and kind for an
-                                               -- open family
-                ifFamInst    :: Maybe (IfaceTyCon, [IfaceType])
+               ifSynKind :: IfaceKind,         -- Kind of the *rhs* (not of the tycon)
+               ifSynRhs  :: Maybe IfaceType,   -- Just rhs for an ordinary synonyn
+                                               -- Nothing for an open family
+                ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
                                                 -- Just <=> instance of family
                                                 -- Invariant: ifOpenSyn == False
                                                 --   for family instances
@@ -165,6 +166,14 @@ data IfaceRule
        ifRuleOrph   :: Maybe OccName   -- Just like IfaceInst
     }
 
+data IfaceAnnotation
+  = IfaceAnnotation {
+        ifAnnotatedTarget :: IfaceAnnTarget,
+        ifAnnotatedValue :: Serialized
+  }
+
+type IfaceAnnTarget = AnnTarget OccName
+
 data IfaceIdInfo
   = NoInfo                     -- When writing interface file without -O
   | HasInfo [IfaceInfoItem]    -- Has info, and here it is
@@ -427,15 +436,15 @@ pprIfaceDecl (IfaceForeign {ifName = tycon})
   = hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
 
 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, 
-                       ifOpenSyn = False, ifSynRhs = mono_ty, 
+                       ifSynRhs = Just mono_ty, 
                         ifFamInst = mbFamInst})
   = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
        4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
 
 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, 
-                       ifOpenSyn = True, ifSynRhs = mono_ty})
+                       ifSynRhs = Nothing, ifSynKind = kind })
   = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
-       4 (dcolon <+> ppr mono_ty)
+       4 (dcolon <+> ppr kind)
 
 pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
                         ifTyVars = tyvars, ifCons = condecls, 
@@ -663,18 +672,25 @@ freeNamesIfDecl (IfaceId _s t i) =
 freeNamesIfDecl IfaceForeign{} = 
   emptyNameSet
 freeNamesIfDecl d@IfaceData{} =
+  freeNamesIfTvBndrs (ifTyVars d) &&&
   freeNamesIfTcFam (ifFamInst d) &&&
   freeNamesIfContext (ifCtxt d) &&&
   freeNamesIfConDecls (ifCons d)
 freeNamesIfDecl d@IfaceSyn{} =
-  freeNamesIfType    (ifSynRhs d) &&&
+  freeNamesIfTvBndrs (ifTyVars d) &&&
+  freeNamesIfSynRhs (ifSynRhs d) &&&
   freeNamesIfTcFam (ifFamInst d)
 freeNamesIfDecl d@IfaceClass{} =
+  freeNamesIfTvBndrs (ifTyVars d) &&&
   freeNamesIfContext (ifCtxt d) &&&
   freeNamesIfDecls   (ifATs d) &&&
   fnList freeNamesIfClsSig (ifSigs d)
 
 -- All other changes are handled via the version info on the tycon
+freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
+freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
+freeNamesIfSynRhs Nothing   = emptyNameSet
+
 freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
 freeNamesIfTcFam (Just (tc,tys)) = 
   freeNamesIfTc tc &&& fnList freeNamesIfType tys
@@ -697,6 +713,8 @@ freeNamesIfConDecls _               = emptyNameSet
 
 freeNamesIfConDecl :: IfaceConDecl -> NameSet
 freeNamesIfConDecl c = 
+  freeNamesIfTvBndrs (ifConUnivTvs c) &&&
+  freeNamesIfTvBndrs (ifConExTvs c) &&&
   freeNamesIfContext (ifConCtxt c) &&& 
   fnList freeNamesIfType (ifConArgTys c) &&&
   fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
@@ -715,9 +733,24 @@ freeNamesIfType (IfaceAppTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 freeNamesIfType (IfacePredTy st)      = freeNamesIfPredType st
 freeNamesIfType (IfaceTyConApp tc ts) = 
    freeNamesIfTc tc &&& fnList freeNamesIfType ts
-freeNamesIfType (IfaceForAllTy _tv t)  = freeNamesIfType t
+freeNamesIfType (IfaceForAllTy tv t)  =
+   freeNamesIfTvBndr tv &&& freeNamesIfType t
 freeNamesIfType (IfaceFunTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 
+freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
+freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
+
+freeNamesIfBndr :: IfaceBndr -> NameSet
+freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
+freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
+
+freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
+freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
+    -- kinds can have Names inside, when the Kind is an equality predicate
+
+freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
+freeNamesIfIdBndr = freeNamesIfTvBndr
+
 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
 freeNamesIfIdInfo NoInfo = emptyNameSet
 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
@@ -759,8 +792,11 @@ freeNamesIfTc (IfaceTc tc) = unitNameSet tc
 freeNamesIfTc _ = emptyNameSet
 
 freeNamesIfRule :: IfaceRule -> NameSet
-freeNamesIfRule (IfaceRule _n _a _bs f es rhs _o)
-  = unitNameSet f &&& fnList freeNamesIfExpr es &&& freeNamesIfExpr rhs
+freeNamesIfRule (IfaceRule _n _a bs f es rhs _o)
+  = unitNameSet f &&&
+    fnList freeNamesIfBndr bs &&&
+    fnList freeNamesIfExpr es &&&
+    freeNamesIfExpr rhs
 
 -- helpers
 (&&&) :: NameSet -> NameSet -> NameSet