[commit: ghc] overlapping-tyfams: Checkpoint while compiling. Need Simon's input on design. (725a16b)

[Richard Eisenberg]

Repository : http://darcs.haskell.org/ghc.git/

On branch  : overlapping-tyfams

https://github.com/ghc/ghc/commit/725a16b03ea74171cd3bcea8c3e1683c4139b9f2

>---------------------------------------------------------------

commit 725a16b03ea74171cd3bcea8c3e1683c4139b9f2
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Fri Jun 14 17:33:59 2013 +0100

    Checkpoint while compiling. Need Simon's input on design.

>---------------------------------------------------------------

 compiler/hsSyn/HsDecls.lhs         |  6 +++---
 compiler/iface/IfaceSyn.lhs        |  7 ++++++-
 compiler/parser/Parser.y.pp        |  2 +-
 compiler/types/FamInstEnv.lhs-boot |  9 +++++++++
 compiler/types/TyCon.lhs           | 13 ++++++++-----
 5 files changed, 27 insertions(+), 10 deletions(-)

diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs
index bbf18fa..2f1a788 100644
--- a/compiler/hsSyn/HsDecls.lhs
+++ b/compiler/hsSyn/HsDecls.lhs
@@ -480,7 +480,7 @@ data FamilyInfo name
   = DataFamily
   | OpenTypeFamily
   | ClosedTypeFamily [LTyFamInstEqn name]
-  deriving( Data, Typeable, Eq )
+  deriving( Data, Typeable )
 
 \end{code}
 
@@ -611,9 +611,9 @@ instance (OutputableBndr name) => Outputable (FamilyDecl name) where
           (pp_where, pp_eqns) = case info of
             ClosedTypeFamily eqns -> ( ptext (sLit "where")
                                      , vcat $ map ppr eqns )
-            _                     -> (empty, emtpy)
+            _                     -> (empty, empty)
 
-pprFlavour :: FamilyInfo -> SDoc
+pprFlavour :: FamilyInfo name -> SDoc
 pprFlavour DataFamily            = ptext (sLit "data family")
 pprFlavour OpenTypeFamily        = ptext (sLit "type family")
 pprFlavour (ClosedTypeFamily {}) = ptext (sLit "type family")
diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index e20269b..5cb7937 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -503,10 +503,15 @@ pprIfaceDecl (IfaceSyn {ifName = tycon,
        4 (vcat [equals <+> ppr mono_ty])
 
 pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
-                        ifSynRhs = SynFamilyTyCon {}, ifSynKind = kind })
+                        ifSynRhs = OpenSynFamilyTyCon {}, ifSynKind = kind })
   = hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
        4 (dcolon <+> ppr kind)
 
+pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
+                        ifSynRhs = ClosedSynFamilyTyCon {}, ifSynKind = kind })
+  = hang (ptext (sLit "closed type family") <+> pprIfaceDeclHead [] tycon tyvars)
+       4 (dcolon <+> ppr kind)
+
 pprIfaceDecl (IfaceData {ifName = tycon, ifCType = cType,
                          ifCtxt = context,
                          ifTyVars = tyvars, ifCons = condecls,
diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index e96e9b3..74d7269 100644
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -711,7 +711,7 @@ ty_fam_inst_eqn :: { LTyFamInstEqn RdrName }
                 -- Note the use of type for the head; this allows
                 -- infix type constructors and type patterns
               {% do { eqn <- mkTyFamInstEqn $1 $3
-                    ; return (LL eqn) }
+                    ; return (LL eqn) } }
 
 -- Associated type family declarations
 --
diff --git a/compiler/types/FamInstEnv.lhs-boot b/compiler/types/FamInstEnv.lhs-boot
new file mode 100644
index 0000000..e8ef30f
--- /dev/null
+++ b/compiler/types/FamInstEnv.lhs-boot
@@ -0,0 +1,9 @@
+\begin{code}
+
+module FamInstEnv where
+
+data FamInst br
+
+-- RAE: Remove this.
+
+\end{code}
\ No newline at end of file
diff --git a/compiler/types/TyCon.lhs b/compiler/types/TyCon.lhs
index 4978c00..0c5a1d6 100644
--- a/compiler/types/TyCon.lhs
+++ b/compiler/types/TyCon.lhs
@@ -88,6 +88,7 @@ module TyCon(
 
 import {-# SOURCE #-} TypeRep ( Kind, Type, PredType )
 import {-# SOURCE #-} DataCon ( DataCon, isVanillaDataCon )
+import {-# SOURCE #-} FamInstEnv ( FamInst ) -- RAE Remove!!
 
 import Var
 import Class
@@ -1151,19 +1152,21 @@ isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon { is_enum = res }}) = res
 isEnumerationTyCon (TupleTyCon {tyConArity = arity}) = arity == 0
 isEnumerationTyCon _                                                   = False
 
--- | Is this a 'TyCon', synonym or otherwise, that may have further instances appear?
+-- | Is this a 'TyCon', synonym or otherwise, that defines a family?
 isFamilyTyCon :: TyCon -> Bool
-isFamilyTyCon (SynTyCon {synTcRhs = SynFamilyTyCon {}})  = True
-isFamilyTyCon (AlgTyCon {algTcRhs = DataFamilyTyCon {}}) = True
+isFamilyTyCon (SynTyCon {synTcRhs = OpenSynFamilyTyCon })      = True
+isFamilyTyCon (SynTyCon {synTcRhs = ClosedSynFamilyTyCon {} }) = True
+isFamilyTyCon (AlgTyCon {algTcRhs = DataFamilyTyCon {}})       = True
 isFamilyTyCon _ = False
 
 -- | Is this a synonym 'TyCon' that can have may have further instances appear?
 isSynFamilyTyCon :: TyCon -> Bool
-isSynFamilyTyCon (SynTyCon {synTcRhs = SynFamilyTyCon {}}) = True
+isSynFamilyTyCon (SynTyCon {synTcRhs = OpenSynFamilyTyCon {}})   = True
+isSynFamilyTyCon (SynTyCon {synTcRhs = ClosedSynFamilyTyCon {}}) = True
 isSynFamilyTyCon _ = False
 
 isOpenSynFamilyTyCon :: TyCon -> Bool
-isOpenSynFamilyTyCon (SynTyCon {synTcRhs = SynFamilyTyCon { synf_open = is_open } }) = is_open
+isOpenSynFamilyTyCon (SynTyCon {synTcRhs = OpenSynFamilyTyCon }) = True
 isOpenSynFamilyTyCon _ = False
 
 -- | Is this a synonym 'TyCon' that can have may have further instances appear?