New syntax for GADT-style record declarations, and associated refactoring

[ghc-hetmet.git] / compiler / hsSyn / HsBinds.lhs

diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs
index 83273f0..702e736 100644 (file)
--- a/compiler/hsSyn/HsBinds.lhs
+++ b/compiler/hsSyn/HsBinds.lhs
@@ -426,12 +426,18 @@ type LSig name = Located (Sig name)
 data Sig name  -- Signatures and pragmas
   =    -- An ordinary type signature
        -- f :: Num a => a -> a
-    TypeSig    (Located name)  -- A bog-std type signature
-               (LHsType name)
+    TypeSig (Located name) (LHsType name)
+
+       -- A type signature in generated code, notably the code
+       -- generated for record selectors.  We simply record
+       -- the desired Id itself, replete with its name, type
+       -- and IdDetails.  Otherwise it's just like a type 
+       -- signature: there should be an accompanying binding
+  | IdSig Id
 
        -- An ordinary fixity declaration
        --      infixl *** 8
-  | FixSig     (FixitySig name)        -- Fixity declaration
+  | FixSig (FixitySig name)
 
        -- An inline pragma
        -- {#- INLINE f #-}
@@ -511,10 +517,17 @@ isFixityLSig :: LSig name -> Bool
 isFixityLSig (L _ (FixSig {})) = True
 isFixityLSig _                = False
 
-isVanillaLSig :: LSig name -> Bool
+isVanillaLSig :: LSig name -> Bool      -- User type signatures
+-- A badly-named function, but it's part of the GHCi (used
+-- by Haddock) so I don't want to change it gratuitously.
 isVanillaLSig (L _(TypeSig {})) = True
 isVanillaLSig _                 = False
 
+isTypeLSig :: LSig name -> Bool         -- Type signatures
+isTypeLSig (L _(TypeSig {})) = True
+isTypeLSig (L _(IdSig {}))   = True
+isTypeLSig _                 = False
+
 isSpecLSig :: LSig name -> Bool
 isSpecLSig (L _(SpecSig {})) = True
 isSpecLSig _                 = False
@@ -536,6 +549,7 @@ isInlineLSig _                    = False
 
 hsSigDoc :: Sig name -> SDoc
 hsSigDoc (TypeSig {})          = ptext (sLit "type signature")
+hsSigDoc (IdSig {})            = ptext (sLit "id signature")
 hsSigDoc (SpecSig {})          = ptext (sLit "SPECIALISE pragma")
 hsSigDoc (InlineSig {})         = ptext (sLit "INLINE pragma")
 hsSigDoc (SpecInstSig {})      = ptext (sLit "SPECIALISE instance pragma")
@@ -547,6 +561,7 @@ Signature equality is used when checking for duplicate signatures
 \begin{code}
 eqHsSig :: Eq a => LSig a -> LSig a -> Bool
 eqHsSig (L _ (FixSig (FixitySig n1 _))) (L _ (FixSig (FixitySig n2 _))) = unLoc n1 == unLoc n2
+eqHsSig (L _ (IdSig n1))               (L _ (IdSig n2))                = n1 == n2
 eqHsSig (L _ (TypeSig n1 _))           (L _ (TypeSig n2 _))            = unLoc n1 == unLoc n2
 eqHsSig (L _ (InlineSig n1 _))          (L _ (InlineSig n2 _))          = unLoc n1 == unLoc n2
        -- For specialisations, we don't have equality over
@@ -561,6 +576,7 @@ instance (OutputableBndr name) => Outputable (Sig name) where
 
 ppr_sig :: OutputableBndr name => Sig name -> SDoc
 ppr_sig (TypeSig var ty)         = pprVarSig (unLoc var) ty
+ppr_sig (IdSig id)               = pprVarSig id (varType id)
 ppr_sig (FixSig fix_sig)         = ppr fix_sig
 ppr_sig (SpecSig var ty inl)     = pragBrackets (pprSpec var ty inl)
 ppr_sig (InlineSig var inl)       = pragBrackets (ppr inl <+> ppr var)