Add Data and Typeable instances to HsSyn

[ghc-hetmet.git] / compiler / basicTypes / DataCon.lhs

diff --git a/compiler/basicTypes/DataCon.lhs b/compiler/basicTypes/DataCon.lhs
index df8af8e..e4da527 100644 (file)
--- a/compiler/basicTypes/DataCon.lhs
+++ b/compiler/basicTypes/DataCon.lhs
@@ -15,9 +15,11 @@ module DataCon (
        
        -- ** Type deconstruction
        dataConRepType, dataConSig, dataConFullSig,
-       dataConName, dataConIdentity, dataConTag, dataConTyCon, dataConUserType,
+       dataConName, dataConIdentity, dataConTag, dataConTyCon, 
+        dataConOrigTyCon, dataConUserType,
        dataConUnivTyVars, dataConExTyVars, dataConAllTyVars, 
-       dataConEqSpec, eqSpecPreds, dataConEqTheta, dataConDictTheta, dataConStupidTheta, 
+       dataConEqSpec, eqSpecPreds, dataConEqTheta, dataConDictTheta,
+       dataConStupidTheta,  
        dataConInstArgTys, dataConOrigArgTys, dataConOrigResTy,
        dataConInstOrigArgTys, dataConRepArgTys, 
        dataConFieldLabels, dataConFieldType,
@@ -49,10 +51,10 @@ import Outputable
 import Unique
 import ListSetOps
 import Util
-import Maybes
 import FastString
 import Module
 
+import qualified Data.Data as Data
 import Data.Char
 import Data.Word
 import Data.List ( partition )
@@ -96,12 +98,12 @@ Note [Data Constructor Naming]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Each data constructor C has two, and possibly up to four, Names associated with it:
 
-                            OccName    Name space      Name of
-  ---------------------------------------------------------------------------
-  * The "data con itself"      C       DataName        DataCon
-  * The "worker data con"      C       VarName         Id (the worker)
-  * The "wrapper data con"     \$WC    VarName         Id (the wrapper)
-  * The "newtype coercion"      :CoT    TcClsName      TyCon
+                  OccName   Name space   Name of   Notes
+ ---------------------------------------------------------------------------
+ The "data con itself"          C     DataName   DataCon   In dom( GlobalRdrEnv )
+ The "worker data con"  C     VarName    Id        The worker
+ The "wrapper data con"         $WC   VarName    Id        The wrapper
+ The "newtype coercion"  :CoT  TcClsName  TyCon
  
 EVERY data constructor (incl for newtypes) has the former two (the
 data con itself, and its worker.  But only some data constructors have a
@@ -269,8 +271,9 @@ data DataCon
                --       syntax, provided its type looks like the above.
                --       The declaration format is held in the TyCon (algTcGadtSyntax)
 
-       dcUnivTyVars :: [TyVar],        -- Universally-quantified type vars 
+       dcUnivTyVars :: [TyVar],        -- Universally-quantified type vars [a,b,c]
                                        -- INVARIANT: length matches arity of the dcRepTyCon
+                                       ---           result type of (rep) data con is exactly (T a b c)
 
        dcExTyVars   :: [TyVar],        -- Existentially-quantified type vars 
                -- In general, the dcUnivTyVars are NOT NECESSARILY THE SAME AS THE TYVARS
@@ -318,7 +321,6 @@ data DataCon
        dcOrigArgTys :: [Type],         -- Original argument types
                                        -- (before unboxing and flattening of strict fields)
        dcOrigResTy :: Type,            -- Original result type, as seen by the user
-               -- INVARIANT: mentions only dcUnivTyVars
                -- NB: for a data instance, the original user result type may 
                -- differ from the DataCon's representation TyCon.  Example
                --      data instance T [a] where MkT :: a -> T [a]
@@ -453,6 +455,15 @@ instance Outputable DataCon where
 
 instance Show DataCon where
     showsPrec p con = showsPrecSDoc p (ppr con)
+
+instance Data.Typeable DataCon where
+    typeOf _ = Data.mkTyConApp (Data.mkTyCon "DataCon") []
+
+instance Data.Data DataCon where
+    -- don't traverse?
+    toConstr _   = abstractConstr "DataCon"
+    gunfold _ _  = error "gunfold"
+    dataTypeOf _ = mkNoRepType "DataCon"
 \end{code}
 
 
@@ -564,6 +575,14 @@ dataConTag  = dcTag
 dataConTyCon :: DataCon -> TyCon
 dataConTyCon = dcRepTyCon
 
+-- | The original type constructor used in the definition of this data
+-- constructor.  In case of a data family instance, that will be the family
+-- type constructor.
+dataConOrigTyCon :: DataCon -> TyCon
+dataConOrigTyCon dc 
+  | Just (tc, _) <- tyConFamInst_maybe (dcRepTyCon dc) = tc
+  | otherwise                                          = dcRepTyCon dc
+
 -- | The representation type of the data constructor, i.e. the sort
 -- type that will represent values of this type at runtime
 dataConRepType :: DataCon -> Type
@@ -636,8 +655,10 @@ dataConFieldLabels = dcFields
 
 -- | Extract the type for any given labelled field of the 'DataCon'
 dataConFieldType :: DataCon -> FieldLabel -> Type
-dataConFieldType con label = expectJust "unexpected label" $
-    lookup label (dcFields con `zip` dcOrigArgTys con)
+dataConFieldType con label
+  = case lookup label (dcFields con `zip` dcOrigArgTys con) of
+      Just ty -> ty
+      Nothing -> pprPanic "dataConFieldType" (ppr con <+> ppr label)
 
 -- | The strictness markings decided on by the compiler.  Does not include those for
 -- existential dictionaries.  The list is in one-to-one correspondence with the arity of the 'DataCon'
@@ -726,7 +747,7 @@ dataConUserType :: DataCon -> Type
 --
 -- rather than:
 --
--- > T :: forall a c. forall b. (c=[a]) => a -> b -> T c
+-- > T :: forall a c. forall b. (c~[a]) => a -> b -> T c
 --
 -- NB: If the constructor is part of a data instance, the result type
 -- mentions the family tycon, not the internal one.