Remove the distinction between data and newtype families
[ghc-hetmet.git] / compiler / types / TyCon.lhs
index dfbf02c..85881b6 100644 (file)
@@ -13,7 +13,7 @@ module TyCon(
        tyConPrimRep,
 
        AlgTyConRhs(..), visibleDataCons, 
-        AlgTyConParent(..), 
+        TyConParent(..), 
        SynTyConRhs(..),
 
        isFunTyCon, isUnLiftedTyCon, isProductTyCon, 
@@ -125,7 +125,7 @@ data TyCon
        hasGenerics :: Bool,            -- True <=> generic to/from functions are available
                                        -- (in the exports of the data type's source module)
 
-       algTcParent :: AlgTyConParent   -- Gives the class or family tycon for
+       algTcParent :: TyConParent      -- Gives the class or family tycon for
                                        -- derived tycons representing classes
                                        -- or family instances, respectively.
     }
@@ -149,7 +149,12 @@ data TyCon
 
        tyConTyVars  :: [TyVar],        -- Bound tyvars
 
-       synTcRhs     :: SynTyConRhs     -- Expanded type in here
+       synTcRhs     :: SynTyConRhs,    -- Expanded type in here
+
+        synTcParent  :: TyConParent     -- Gives the family tycon of
+                                        -- representation tycons of family
+                                        -- instances
+
     }
 
   | PrimTyCon {                        -- Primitive types; cannot be defined in Haskell
@@ -199,19 +204,22 @@ data AlgTyConRhs
 
   -- The constructor represents an open family without a fixed right hand
   -- side.  Additional instances can appear at any time.
-  --
+  -- 
+  -- These are introduced by either a top level decl:
+  --   data T a :: *
+  -- or an assoicated data type decl, in a class decl:
+  --    class C a b where
+  --     data T b :: *
+
   | OpenTyCon {
 
-      otArgPoss   :: Maybe [Int],  
+      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 {
@@ -262,30 +270,41 @@ visibleDataCons OpenTyCon {}                    = []
 visibleDataCons (DataTyCon{ data_cons = cs }) = cs
 visibleDataCons (NewTyCon{ data_con = c })    = [c]
 
--- Both type classes as well as data/newtype family instances imply implicit
+-- Both type classes as well as family instances imply implicit
 -- type constructors.  These implicit type constructors refer to their parent
 -- structure (ie, the class or family from which they derive) using a type of
--- the following form.
---
-data AlgTyConParent 
+-- the following form.  We use `TyConParent' for both algebraic and synonym 
+-- types, but the variant `ClassTyCon' will only be used by algebraic tycons.
+
+data TyConParent 
   = NoParentTyCon      -- An ordinary type constructor has no parent.
 
   | ClassTyCon         -- Type constructors representing a class dictionary.
-       Class   
+       Class           -- INVARIANT: the classTyCon of this Class is the current tycon
 
   | FamilyTyCon                -- Type constructors representing an instance of a type
        TyCon           --   The type family
        [Type]          --   Instance types; free variables are the tyConTyVars
-                       --      of this TyCon
+                       --      of the current TyCon (not the family one)
+                       --      INVARIANT: the number of types matches the arity 
+                       --                 of the family 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
 
+okParent :: Name -> TyConParent -> Bool        -- Checks invariants
+okParent tc_name NoParentTyCon                 = True
+okParent tc_name (ClassTyCon cls)              = tyConName (classTyCon cls) == tc_name
+okParent tc_name (FamilyTyCon fam_tc tys co_tc) = tyConArity fam_tc == length tys
+
+--------------------
 data SynTyConRhs
   = OpenSynTyCon Kind          -- Type family: *result* kind given
                 (Maybe [Int])  -- for associated families: for each tyvars in
@@ -297,7 +316,7 @@ data SynTyConRhs
 
   | SynonymTyCon Type   -- Mentioning head type vars.  Acts as a template for
                        --  the expansion when the tycon is applied to some
-                       --  types.  
+                       --  types.
 \end{code}
 
 Note [Newtype coercions]
@@ -367,6 +386,39 @@ we get:
 And now Lint complains unless Foo T == Foo [], and that requires T==[]
 
 
+Note [Indexed data types] (aka data type families)
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+   See also Note [Wrappers for data instance tycons] in MkId.lhs
+
+Consider
+       data family T a
+
+       data instance T (b,c) where
+         T1 :: b -> c -> T (b,c)
+
+Then
+  * T is the "family TyCon"
+
+  * We make "representation TyCon" :R1T, thus:
+       data :R1T b c where
+         T1 :: forall b c. b -> c -> :R1T b c
+
+  * It has a top-level coercion connecting it to the family TyCon
+
+       axiom :Co:R1T b c : T (b,c) ~ :R1T b c
+
+  * The data contructor T1 has a wrapper (which is what the source-level
+    "T1" invokes):
+
+       $WT1 :: forall b c. b -> c -> T (b,c)
+       $WT1 b c (x::b) (y::c) = T1 b c x y `cast` sym (:Co:R1T b c)
+
+  * The representation TyCon :R1T has an AlgTyConParent of
+
+       FamilyTyCon T [(b,c)] :Co:R1T
+
+
+
 %************************************************************************
 %*                                                                     *
 \subsection{PrimRep}
@@ -439,7 +491,7 @@ mkAlgTyCon name kind tyvars stupid rhs sel_ids parent is_rec gen_info gadt_syn
        algTcStupidTheta = stupid,
        algTcRhs         = rhs,
        algTcSelIds      = sel_ids,
-       algTcParent      = parent,
+       algTcParent      = ASSERT( okParent name parent ) parent,
        algTcRec         = is_rec,
        algTcGadtSyntax  = gadt_syn,
        hasGenerics = gen_info
@@ -498,14 +550,15 @@ mkPrimTyCon' name kind arity rep is_unlifted
        tyConExtName = Nothing
     }
 
-mkSynTyCon name kind tyvars rhs
+mkSynTyCon name kind tyvars rhs parent
   = SynTyCon { 
        tyConName = name,
        tyConUnique = nameUnique name,
        tyConKind = kind,
        tyConArity = length tyvars,
        tyConTyVars = tyvars,
-       synTcRhs = rhs
+       synTcRhs = rhs,
+        synTcParent = parent
     }
 
 mkCoercionTyCon name arity kindRule
@@ -560,9 +613,14 @@ isDataTyCon :: TyCon -> Bool
 --     True for all @data@ types
 --     False for newtypes
 --               unboxed tuples
+--               type families
+-- 
+-- NB: for a data type family, T, only the *instance* tycons are
+--     get an info table etc.  The family tycon does not.
+--     Hence False for OpenTyCon
 isDataTyCon tc@(AlgTyCon {algTcRhs = rhs})  
   = case rhs of
-        OpenTyCon {}  -> not (otIsNewtype rhs)
+        OpenTyCon {}  -> False
        DataTyCon {}  -> True
        NewTyCon {}   -> False
        AbstractTyCon -> False   -- We don't know, so return False
@@ -572,7 +630,6 @@ isDataTyCon other = False
 isNewTyCon :: TyCon -> Bool
 isNewTyCon (AlgTyCon {algTcRhs = rhs}) = 
   case rhs of
-    OpenTyCon {} -> otIsNewtype rhs
     NewTyCon {}  -> True
     _           -> False
 isNewTyCon other                      = False
@@ -860,17 +917,22 @@ tyConClass_maybe other_tycon                                  = Nothing
 
 isFamInstTyCon :: TyCon -> Bool
 isFamInstTyCon (AlgTyCon {algTcParent = FamilyTyCon _ _ _ }) = True
+isFamInstTyCon (SynTyCon {synTcParent = FamilyTyCon _ _ _ }) = True
 isFamInstTyCon other_tycon                                  = False
 
 tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])
 tyConFamInst_maybe (AlgTyCon {algTcParent = FamilyTyCon fam instTys _}) = 
   Just (fam, instTys)
+tyConFamInst_maybe (SynTyCon {synTcParent = FamilyTyCon fam instTys _}) = 
+  Just (fam, instTys)
 tyConFamInst_maybe other_tycon                                         = 
   Nothing
 
 tyConFamilyCoercion_maybe :: TyCon -> Maybe TyCon
 tyConFamilyCoercion_maybe (AlgTyCon {algTcParent = FamilyTyCon _ _ coe}) = 
   Just coe
+tyConFamilyCoercion_maybe (SynTyCon {synTcParent = FamilyTyCon _ _ coe}) = 
+  Just coe
 tyConFamilyCoercion_maybe other_tycon                                   = 
   Nothing
 \end{code}