Extend TyCons and DataCons to represent data instance decls

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

diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 656ba36..4cb2b53 100644 (file)
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -11,8 +11,10 @@ module MkIface (
 
        writeIfaceFile, -- Write the interface file
 
-       checkOldIface   -- See if recompilation is required, by
+       checkOldIface,  -- See if recompilation is required, by
                        -- comparing version information
+
+        tyThingToIfaceDecl -- Converting things to their Iface equivalents
  ) where
 \end{code}
 
@@ -183,14 +185,17 @@ import IdInfo             ( IdInfo, CafInfo(..), WorkerInfo(..),
 import NewDemand       ( isTopSig )
 import CoreSyn
 import Class           ( classExtraBigSig, classTyCon )
-import TyCon           ( TyCon, AlgTyConRhs(..), isRecursiveTyCon, isForeignTyCon,
+import TyCon           ( TyCon, AlgTyConRhs(..), SynTyConRhs(..),
+                         isRecursiveTyCon, isForeignTyCon, 
                          isSynTyCon, isAlgTyCon, isPrimTyCon, isFunTyCon,
                          isTupleTyCon, tupleTyConBoxity, tyConStupidTheta,
-                         tyConHasGenerics, tyConArgVrcs, synTyConRhs, isGadtSyntaxTyCon,
-                         tyConArity, tyConTyVars, algTyConRhs, tyConExtName  )
+                         tyConHasGenerics, synTyConRhs, isGadtSyntaxTyCon,
+                         tyConArity, tyConTyVars, algTyConRhs, tyConExtName,
+                         tyConFamily_maybe )
 import DataCon         ( dataConName, dataConFieldLabels, dataConStrictMarks,
-                         dataConTyCon, dataConIsInfix, dataConUnivTyVars, dataConExTyVars, dataConEqSpec,
-                         dataConTheta, dataConOrigArgTys )
+                         dataConTyCon, dataConIsInfix, dataConUnivTyVars,
+                         dataConExTyVars, dataConEqSpec, dataConTheta,
+                         dataConOrigArgTys, dataConInstTys ) 
 import Type            ( TyThing(..), splitForAllTys, funResultTy )
 import TcType          ( deNoteType )
 import TysPrim         ( alphaTyVars )
@@ -994,11 +999,12 @@ tyThingToIfaceDecl ext (AClass clas)
                 ifName   = getOccName clas,
                 ifTyVars = toIfaceTvBndrs clas_tyvars,
                 ifFDs    = map toIfaceFD clas_fds,
+                ifATs    = map (tyThingToIfaceDecl ext . ATyCon) clas_ats,
                 ifSigs   = map toIfaceClassOp op_stuff,
-                ifRec    = boolToRecFlag (isRecursiveTyCon tycon),
-                ifVrcs   = tyConArgVrcs tycon }
+                ifRec    = boolToRecFlag (isRecursiveTyCon tycon) }
   where
-    (clas_tyvars, clas_fds, sc_theta, _, op_stuff) = classExtraBigSig clas
+    (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff) 
+      = classExtraBigSig clas
     tycon = classTyCon clas
 
     toIfaceClassOp (sel_id, def_meth)
@@ -1017,10 +1023,10 @@ tyThingToIfaceDecl ext (AClass clas)
 
 tyThingToIfaceDecl ext (ATyCon tycon)
   | isSynTyCon tycon
-  = IfaceSyn { ifName   = getOccName tycon,
-               ifTyVars = toIfaceTvBndrs tyvars,
-               ifVrcs    = tyConArgVrcs tycon,
-               ifSynRhs = toIfaceType ext syn_ty }
+  = IfaceSyn { ifName    = getOccName tycon,
+               ifTyVars  = toIfaceTvBndrs tyvars,
+               ifOpenSyn = syn_isOpen,
+               ifSynRhs  = toIfaceType ext syn_tyki }
 
   | isAlgTyCon tycon
   = IfaceData {        ifName    = getOccName tycon,
@@ -1029,8 +1035,8 @@ tyThingToIfaceDecl ext (ATyCon tycon)
                ifCons    = ifaceConDecls (algTyConRhs tycon),
                ifRec     = boolToRecFlag (isRecursiveTyCon tycon),
                ifGadtSyntax = isGadtSyntaxTyCon tycon,
-               ifVrcs    = tyConArgVrcs tycon,
-               ifGeneric = tyConHasGenerics tycon }
+               ifGeneric = tyConHasGenerics tycon,
+               ifFamily  = fmap (toIfaceTyCon ext) $ tyConFamily_maybe tycon }
 
   | isForeignTyCon tycon
   = IfaceForeign { ifName    = getOccName tycon,
@@ -1045,15 +1051,21 @@ tyThingToIfaceDecl ext (ATyCon tycon)
                ifGadtSyntax = False,
                ifGeneric = False,
                ifRec     = NonRecursive,
-               ifVrcs    = tyConArgVrcs tycon }
+               ifFamily  = Nothing }
 
   | otherwise = pprPanic "toIfaceDecl" (ppr tycon)
   where
     tyvars = tyConTyVars tycon
-    syn_ty = synTyConRhs tycon
-
-    ifaceConDecls (NewTyCon { data_con = con })    = IfNewTyCon  (ifaceConDecl con)
-    ifaceConDecls (DataTyCon { data_cons = cons }) = IfDataTyCon (map ifaceConDecl cons)
+    (syn_isOpen, syn_tyki) = case synTyConRhs tycon of
+                              OpenSynTyCon ki -> (True , ki)
+                              SynonymTyCon ty -> (False, ty)
+
+    ifaceConDecls (NewTyCon { data_con = con })    = 
+      IfNewTyCon  (ifaceConDecl con)
+    ifaceConDecls (DataTyCon { data_cons = cons }) = 
+      IfDataTyCon (map ifaceConDecl cons)
+    ifaceConDecls OpenDataTyCon                    = IfOpenDataTyCon
+    ifaceConDecls OpenNewTyCon                     = IfOpenNewTyCon
     ifaceConDecls AbstractTyCon                           = IfAbstractTyCon
        -- The last case happens when a TyCon has been trimmed during tidying
        -- Furthermore, tyThingToIfaceDecl is also used
@@ -1067,9 +1079,13 @@ tyThingToIfaceDecl ext (ATyCon tycon)
                    ifConExTvs   = toIfaceTvBndrs (dataConExTyVars data_con),
                    ifConEqSpec  = to_eq_spec (dataConEqSpec data_con),
                    ifConCtxt    = toIfaceContext ext (dataConTheta data_con),
-                   ifConArgTys  = map (toIfaceType ext) (dataConOrigArgTys data_con),
-                   ifConFields  = map getOccName (dataConFieldLabels data_con),
-                   ifConStricts = dataConStrictMarks data_con }
+                   ifConArgTys  = map (toIfaceType ext) 
+                                      (dataConOrigArgTys data_con),
+                   ifConFields  = map getOccName 
+                                      (dataConFieldLabels data_con),
+                   ifConStricts = dataConStrictMarks data_con,
+                   ifConInstTys = fmap (map (toIfaceType ext)) 
+                                       (dataConInstTys data_con) }
 
     to_eq_spec spec = [(getOccName tv, toIfaceType ext ty) | (tv,ty) <- spec]