Fixes to datacon wrappers for indexed data types
[ghc-hetmet.git] / compiler / types / TyCon.lhs
index 3ae5c3e..dfbf02c 100644 (file)
@@ -13,12 +13,12 @@ module TyCon(
        tyConPrimRep,
 
        AlgTyConRhs(..), visibleDataCons, 
-        AlgTyConParent(..), hasParent,
+        AlgTyConParent(..), 
        SynTyConRhs(..),
 
        isFunTyCon, isUnLiftedTyCon, isProductTyCon, 
-       isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isClosedNewTyCon,
-       isPrimTyCon, 
+       isAlgTyCon, isDataTyCon, isNewTyCon, isClosedNewTyCon, isSynTyCon,
+       isClosedSynTyCon, isPrimTyCon, 
        isEnumerationTyCon, isGadtSyntaxTyCon, isOpenTyCon,
        assocTyConArgPoss_maybe, isTyConAssoc, setTyConArgPoss,
        isTupleTyCon, isUnboxedTupleTyCon, isBoxedTupleTyCon, tupleTyConBoxity,
@@ -73,7 +73,6 @@ import Class
 import BasicTypes
 import Name
 import PrelNames
-import Maybe
 import Maybes
 import Outputable
 import FastString
@@ -109,13 +108,6 @@ data TyCon
                                        --                 types if present
                                        -- But not over the data constructors
 
-        tyConArgPoss :: Maybe [Int],    -- for associated families: for each
-                                       -- tyvar in the AT decl, gives the
-                                       -- position of that tyvar in the class
-                                       -- argument list (starting from 0).
-                                       -- NB: Length is less than tyConArity
-                                       --     if higher kind signature.
-       
        algTcSelIds :: [Id],            -- Its record selectors (empty if none)
 
        algTcGadtSyntax  :: Bool,       -- True <=> the data type was declared using GADT syntax
@@ -157,13 +149,6 @@ data TyCon
 
        tyConTyVars  :: [TyVar],        -- Bound tyvars
 
-        tyConArgPoss :: Maybe [Int],    -- for associated families: for each
-                                       -- tyvar in the AT decl, gives the
-                                       -- position of that tyvar in the class
-                                       -- argument list (starting from 0).
-                                       -- NB: Length is less than tyConArity
-                                       --     if higher kind signature.
-       
        synTcRhs     :: SynTyConRhs     -- Expanded type in here
     }
 
@@ -203,21 +188,38 @@ data TyCon
 
 type FieldLabel = Name
 
+-- Right hand sides of type constructors for algebraic types
+--
 data AlgTyConRhs
-  = AbstractTyCon      -- We know nothing about this data type, except 
-                       -- that it's represented by a pointer
-                       -- Used when we export a data type abstractly into
-                       -- an hi file
 
-  | OpenDataTyCon       -- data family        (further instances can appear
-  | OpenNewTyCon        -- newtype family      at any time)
+  -- We know nothing about this data type, except that it's represented by a
+  -- pointer.  Used when we export a data type abstractly into an hi file.
+  --
+  = AbstractTyCon
+
+  -- The constructor represents an open family without a fixed right hand
+  -- side.  Additional instances can appear at any time.
+  --
+  | OpenTyCon {
+
+      otArgPoss   :: Maybe [Int],  
+       -- Nothing <=> top-level indexed type family
+       -- Just ns <=> associated (not toplevel) family
+       --   In the latter case, for each tyvar in the AT decl, 'ns' gives the
+       --   position of that tyvar in the class argument list (starting from 0).
+       --   NB: Length is less than tyConArity iff higher kind signature.
+       
+      otIsNewtype :: Bool           
+        -- is a newtype (rather than data type)?
+
+    }
 
   | DataTyCon {
        data_cons :: [DataCon],
                        -- The constructors; can be empty if the user declares
                        --   the type to have no constructors
                        -- INVARIANT: Kept in order of increasing tag
-                       --            (see the tag assignment in DataCon.mkDataCon)
+                       --        (see the tag assignment in DataCon.mkDataCon)
        is_enum :: Bool         -- Cached: True <=> an enumeration type
     }                  --         Includes data types with no constructors.
 
@@ -256,8 +258,7 @@ data AlgTyConRhs
 
 visibleDataCons :: AlgTyConRhs -> [DataCon]
 visibleDataCons AbstractTyCon                = []
-visibleDataCons OpenDataTyCon                = []
-visibleDataCons OpenNewTyCon                 = []
+visibleDataCons OpenTyCon {}                 = []
 visibleDataCons (DataTyCon{ data_cons = cs }) = cs
 visibleDataCons (NewTyCon{ data_con = c })    = [c]
 
@@ -266,26 +267,34 @@ visibleDataCons (NewTyCon{ data_con = c })    = [c]
 -- structure (ie, the class or family from which they derive) using a type of
 -- the following form.
 --
-data AlgTyConParent = -- An ordinary type constructor has no parent.
-                     NoParentTyCon
-
-                     -- Type constructors representing a class dictionary.
-                   | ClassTyCon    Class       
-
-                     -- Type constructors representing an instances of a type
-                     -- family.
-                   | FamilyTyCon   TyCon       -- the type family
-                                   [Type]      -- instance types
-                                   TyCon       -- a *coercion* identifying
-                                               -- the representation type
-                                               -- with the type instance
-
-hasParent :: AlgTyConParent -> Bool
-hasParent NoParentTyCon = False
-hasParent _other        = True
+data AlgTyConParent 
+  = NoParentTyCon      -- An ordinary type constructor has no parent.
+
+  | ClassTyCon         -- Type constructors representing a class dictionary.
+       Class   
+
+  | FamilyTyCon                -- Type constructors representing an instance of a type
+       TyCon           --   The type family
+       [Type]          --   Instance types; free variables are the tyConTyVars
+                       --      of this TyCon
+       TyCon           --   A CoercionTyCon identifying the representation 
+                       --     type with the type instance family.  
+                       --      c.f. Note [Newtype coercions]
+       -- E.g.  data intance T [a] = ...
+       -- gives a representation tycon:
+       --      data :R7T a = ...
+       --      axiom co a :: T [a] ~ :R7T a
+       -- with :R7T's algTcParent = FamilyTyCon T [a] co
 
 data SynTyConRhs
-  = OpenSynTyCon Kind  -- Type family: *result* kind given
+  = OpenSynTyCon Kind          -- Type family: *result* kind given
+                (Maybe [Int])  -- for associated families: for each tyvars in
+                               -- the AT decl, gives the position of that
+                               -- tyvar in the class argument list (starting
+                               -- from 0). 
+                               -- NB: Length is less than tyConArity
+                               --     if higher kind signature.
+
   | SynonymTyCon Type   -- Mentioning head type vars.  Acts as a template for
                        --  the expansion when the tycon is applied to some
                        --  types.  
@@ -319,7 +328,7 @@ and then when we used CoT at a particular type, s, we'd say
        CoT @ s
 which encodes as (TyConApp instCoercionTyCon [TyConApp CoT [], s])
 
-But in GHC we instead make CoT into a new piece of type syntax
+But in GHC we instead make CoT into a new piece of type syntax, CoercionTyCon,
 (like instCoercionTyCon, symCoercionTyCon etc), which must always
 be saturated, but which encodes as
        TyConApp CoT [s]
@@ -427,7 +436,6 @@ mkAlgTyCon name kind tyvars stupid rhs sel_ids parent is_rec gen_info gadt_syn
        tyConKind        = kind,
        tyConArity       = length tyvars,
        tyConTyVars      = tyvars,
-       tyConArgPoss     = Nothing,
        algTcStupidTheta = stupid,
        algTcRhs         = rhs,
        algTcSelIds      = sel_ids,
@@ -497,7 +505,6 @@ mkSynTyCon name kind tyvars rhs
        tyConKind = kind,
        tyConArity = length tyvars,
        tyConTyVars = tyvars,
-       tyConArgPoss = Nothing,
        synTcRhs = rhs
     }
 
@@ -546,8 +553,8 @@ isAlgTyCon (TupleTyCon {}) = True
 isAlgTyCon other          = False
 
 isDataTyCon :: TyCon -> Bool
--- isDataTyCon returns True for data types that are represented by
--- heap-allocated constructors.
+-- isDataTyCon returns True for data types that are definitely
+-- represented by heap-allocated constructors.
 -- These are srcutinised by Core-level @case@ expressions, and they
 -- get info tables allocated for them.
 --     True for all @data@ types
@@ -555,20 +562,20 @@ isDataTyCon :: TyCon -> Bool
 --               unboxed tuples
 isDataTyCon tc@(AlgTyCon {algTcRhs = rhs})  
   = case rhs of
-        OpenDataTyCon -> True
+        OpenTyCon {}  -> not (otIsNewtype rhs)
        DataTyCon {}  -> True
-       OpenNewTyCon  -> False
        NewTyCon {}   -> False
-       AbstractTyCon -> pprPanic "isDataTyCon" (ppr tc)
+       AbstractTyCon -> False   -- We don't know, so return False
 isDataTyCon (TupleTyCon {tyConBoxed = boxity}) = isBoxed boxity
 isDataTyCon other = False
 
 isNewTyCon :: TyCon -> Bool
-isNewTyCon (AlgTyCon {algTcRhs = rhs}) = case rhs of
-                                          OpenNewTyCon -> True
-                                          NewTyCon {}  -> True
-                                          _            -> False
-isNewTyCon other                       = False
+isNewTyCon (AlgTyCon {algTcRhs = rhs}) = 
+  case rhs of
+    OpenTyCon {} -> otIsNewtype rhs
+    NewTyCon {}  -> True
+    _           -> False
+isNewTyCon other                      = False
 
 -- This is an important refinement as typical newtype optimisations do *not*
 -- hold for newtype families.  Why?  Given a type `T a', if T is a newtype
@@ -599,6 +606,13 @@ isSynTyCon :: TyCon -> Bool
 isSynTyCon (SynTyCon {}) = True
 isSynTyCon _            = False
 
+-- As for newtypes, it is in some contexts important to distinguish between
+-- closed synonyms and synonym families, as synonym families have no unique
+-- right hand side to which a synonym family application can expand.
+--
+isClosedSynTyCon :: TyCon -> Bool
+isClosedSynTyCon tycon = isSynTyCon tycon && not (isOpenTyCon tycon)
+
 isGadtSyntaxTyCon :: TyCon -> Bool
 isGadtSyntaxTyCon (AlgTyCon { algTcGadtSyntax = res }) = res
 isGadtSyntaxTyCon other                                       = False
@@ -608,22 +622,24 @@ isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon { is_enum = res }}) = res
 isEnumerationTyCon other                                              = False
 
 isOpenTyCon :: TyCon -> Bool
-isOpenTyCon (SynTyCon {synTcRhs = OpenSynTyCon _}) = True
-isOpenTyCon (AlgTyCon {algTcRhs = OpenDataTyCon }) = True
-isOpenTyCon (AlgTyCon {algTcRhs = OpenNewTyCon  }) = True
-isOpenTyCon _                                     = False
+isOpenTyCon (SynTyCon {synTcRhs = OpenSynTyCon _ _}) = True
+isOpenTyCon (AlgTyCon {algTcRhs = OpenTyCon {}    }) = True
+isOpenTyCon _                                       = False
 
 assocTyConArgPoss_maybe :: TyCon -> Maybe [Int]
-assocTyConArgPoss_maybe (AlgTyCon { tyConArgPoss = poss }) = poss
-assocTyConArgPoss_maybe (SynTyCon { tyConArgPoss = poss }) = poss
-assocTyConArgPoss_maybe _                                  = Nothing
+assocTyConArgPoss_maybe (AlgTyCon { 
+                          algTcRhs = OpenTyCon {otArgPoss = poss}})  = poss
+assocTyConArgPoss_maybe (SynTyCon { synTcRhs = OpenSynTyCon _ poss }) = poss
+assocTyConArgPoss_maybe _ = Nothing
 
 isTyConAssoc :: TyCon -> Bool
 isTyConAssoc = isJust . assocTyConArgPoss_maybe
 
 setTyConArgPoss :: TyCon -> [Int] -> TyCon
-setTyConArgPoss tc@(AlgTyCon {}) poss = tc { tyConArgPoss = Just poss }
-setTyConArgPoss tc@(SynTyCon {}) poss = tc { tyConArgPoss = Just poss }
+setTyConArgPoss tc@(AlgTyCon { algTcRhs = rhs })               poss = 
+  tc { algTcRhs = rhs {otArgPoss = Just poss} }
+setTyConArgPoss tc@(SynTyCon { synTcRhs = OpenSynTyCon ki _ }) poss = 
+  tc { synTcRhs = OpenSynTyCon ki (Just poss) }
 setTyConArgPoss tc _ = pprPanic "setTyConArgPoss" (ppr tc)
 
 isTupleTyCon :: TyCon -> Bool
@@ -675,11 +691,24 @@ isCoercionTyCon :: TyCon -> Bool
 isCoercionTyCon (CoercionTyCon {}) = True
 isCoercionTyCon other              = False
 
+-- Identifies implicit tycons that, in particular, do not go into interface
+-- files (because they are implicitly reconstructed when the interface is
+-- read).
+--
+-- Note that 
+--
+-- * associated families are implicit, as they are re-constructed from
+--   the class declaration in which they reside, and 
+-- * family instances are *not* implicit as they represent the instance body
+--   (similar to a dfun does that for a class instance).
+--
 isImplicitTyCon :: TyCon -> Bool
-isImplicitTyCon SynTyCon{}                     = False
-isImplicitTyCon AlgTyCon{algTcParent = parent} = hasParent parent
-isImplicitTyCon other                          = True
-        -- catches: FunTyCon, TupleTyCon, PrimTyCon, 
+isImplicitTyCon tycon | isTyConAssoc tycon           = True
+                     | isSynTyCon tycon             = False
+                     | isAlgTyCon tycon             = isClassTyCon tycon ||
+                                                      isTupleTyCon tycon
+isImplicitTyCon _other                               = True
+        -- catches: FunTyCon, PrimTyCon, 
         -- CoercionTyCon, SuperKindTyCon
 \end{code}
 
@@ -748,7 +777,7 @@ tyConFamilySize  :: TyCon -> Int
 tyConFamilySize (AlgTyCon   {algTcRhs = DataTyCon {data_cons = cons}}) = 
   length cons
 tyConFamilySize (AlgTyCon   {algTcRhs = NewTyCon {}})                  = 1
-tyConFamilySize (AlgTyCon   {algTcRhs = OpenDataTyCon})                = 0
+tyConFamilySize (AlgTyCon   {algTcRhs = OpenTyCon {}})                 = 0
 tyConFamilySize (TupleTyCon {})                                               = 1
 #ifdef DEBUG
 tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)
@@ -805,7 +834,7 @@ synTyConType tc = case synTcRhs tc of
                    _              -> pprPanic "synTyConType" (ppr tc)
 
 synTyConResKind :: TyCon -> Kind
-synTyConResKind (SynTyCon {synTcRhs = OpenSynTyCon kind}) = kind
+synTyConResKind (SynTyCon {synTcRhs = OpenSynTyCon kind _}) = kind
 synTyConResKind tycon  = pprPanic "synTyConResKind" (ppr tycon)
 \end{code}
 
@@ -827,7 +856,7 @@ isClassTyCon other_tycon                         = False
 
 tyConClass_maybe :: TyCon -> Maybe Class
 tyConClass_maybe (AlgTyCon {algTcParent = ClassTyCon clas}) = Just clas
-tyConClass_maybe ther_tycon                                = Nothing
+tyConClass_maybe other_tycon                               = Nothing
 
 isFamInstTyCon :: TyCon -> Bool
 isFamInstTyCon (AlgTyCon {algTcParent = FamilyTyCon _ _ _ }) = True
@@ -836,13 +865,13 @@ isFamInstTyCon other_tycon                                     = False
 tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])
 tyConFamInst_maybe (AlgTyCon {algTcParent = FamilyTyCon fam instTys _}) = 
   Just (fam, instTys)
-tyConFamInst_maybe ther_tycon                                          = 
+tyConFamInst_maybe other_tycon                                         = 
   Nothing
 
 tyConFamilyCoercion_maybe :: TyCon -> Maybe TyCon
 tyConFamilyCoercion_maybe (AlgTyCon {algTcParent = FamilyTyCon _ _ coe}) = 
   Just coe
-tyConFamilyCoercion_maybe ther_tycon                                    = 
+tyConFamilyCoercion_maybe other_tycon                                   = 
   Nothing
 \end{code}