VECTORISE pragmas for type classes and instances
[ghc.git] / compiler / hsSyn / HsDecls.lhs
index 345ec32..480401b 100644 (file)
@@ -3,15 +3,7 @@
 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 %
 
-
-
 \begin{code}
-{-# OPTIONS -fno-warn-incomplete-patterns #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
 {-# LANGUAGE DeriveDataTypeable #-}
 
 -- | Abstract syntax of global declarations.
@@ -36,12 +28,14 @@ module HsDecls (
   collectRuleBndrSigTys,
   -- ** @VECTORISE@ declarations
   VectDecl(..), LVectDecl,
+  lvectDeclName, lvectInstDecl,
   -- ** @default@ declarations
   DefaultDecl(..), LDefaultDecl,
   -- ** Top-level template haskell splice
   SpliceDecl(..),
   -- ** Foreign function interface declarations
   ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
+  noForeignImportCoercionYet, noForeignExportCoercionYet,
   CImportSpec(..),
   -- ** Data-constructor declarations
   ConDecl(..), LConDecl, ResType(..), 
@@ -59,34 +53,39 @@ module HsDecls (
     ) where
 
 -- friends:
-import {-# SOURCE #-}  HsExpr( LHsExpr, HsExpr, pprExpr )
-       -- Because Expr imports Decls via HsBracket
+import {-# SOURCE #-}   HsExpr( LHsExpr, HsExpr, pprExpr )
+        -- Because Expr imports Decls via HsBracket
 
 import HsBinds
 import HsPat
 import HsTypes
 import HsDoc
+import TyCon
 import NameSet
+import Name
 import {- Kind parts of -} Type
 import BasicTypes
+import Coercion
 import ForeignCall
 
 -- others:
+import InstEnv
 import Class
-import Outputable      
+import Outputable       
 import Util
 import SrcLoc
 import FastString
 
+import Bag
 import Control.Monad    ( liftM )
-import Data.Data
+import Data.Data        hiding (TyCon)
 import Data.Maybe       ( isJust )
 \end{code}
 
 %************************************************************************
-%*                                                                     *
+%*                                                                      *
 \subsection[HsDecl]{Declarations}
-%*                                                                     *
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -94,20 +93,20 @@ type LHsDecl id = Located (HsDecl id)
 
 -- | A Haskell Declaration
 data HsDecl id
-  = TyClD      (TyClDecl id)     -- ^ A type or class declaration.
-  | InstD      (InstDecl  id)    -- ^ An instance declaration.
+  = TyClD       (TyClDecl id)     -- ^ A type or class declaration.
+  | InstD       (InstDecl  id)    -- ^ An instance declaration.
   | DerivD      (DerivDecl id)
-  | ValD       (HsBind id)
-  | SigD       (Sig id)
-  | DefD       (DefaultDecl id)
+  | ValD        (HsBind id)
+  | SigD        (Sig id)
+  | DefD        (DefaultDecl id)
   | ForD        (ForeignDecl id)
-  | WarningD   (WarnDecl id)
-  | AnnD       (AnnDecl id)
-  | RuleD      (RuleDecl id)
-  | VectD      (VectDecl id)
-  | SpliceD    (SpliceDecl id)
-  | DocD       (DocDecl)
-  | QuasiQuoteD        (HsQuasiQuote id)
+  | WarningD    (WarnDecl id)
+  | AnnD        (AnnDecl id)
+  | RuleD       (RuleDecl id)
+  | VectD       (VectDecl id)
+  | SpliceD     (SpliceDecl id)
+  | DocD        (DocDecl)
+  | QuasiQuoteD (HsQuasiQuote id)
   deriving (Data, Typeable)
 
 
@@ -116,11 +115,11 @@ data HsDecl id
 -- OR     in the ClassDecls in TyClDs
 --
 -- The former covers
---     a) data constructors
---     b) class methods (but they can be also done in the
---             signatures of class decls)
---     c) imported functions (that have an IfacSig)
---     d) top level decls
+--      a) data constructors
+--      b) class methods (but they can be also done in the
+--              signatures of class decls)
+--      c) imported functions (that have an IfacSig)
+--      d) top level decls
 --
 -- The latter is for class methods only
 
@@ -128,19 +127,19 @@ data HsDecl id
 -- fed to the renamer.
 data HsGroup id
   = HsGroup {
-       hs_valds  :: HsValBinds id,
+        hs_valds  :: HsValBinds id,
 
-       hs_tyclds :: [[LTyClDecl id]],  
-               -- A list of mutually-recursive groups
-               -- Parser generates a singleton list;
-               -- renamer does dependency analysis
+        hs_tyclds :: [[LTyClDecl id]],  
+                -- A list of mutually-recursive groups
+                -- Parser generates a singleton list;
+                -- renamer does dependency analysis
 
-       hs_instds :: [LInstDecl id],
+        hs_instds :: [LInstDecl id],
         hs_derivds :: [LDerivDecl id],
 
-       hs_fixds  :: [LFixitySig id],
-               -- Snaffled out of both top-level fixity signatures,
-               -- and those in class declarations
+        hs_fixds  :: [LFixitySig id],
+                -- Snaffled out of both top-level fixity signatures,
+                -- and those in class declarations
 
         hs_defds  :: [LDefaultDecl id],
         hs_fords  :: [LForeignDecl id],
@@ -157,9 +156,9 @@ emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
 emptyRnGroup  = emptyGroup { hs_valds = emptyValBindsOut }
 
 emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], hs_derivds = [],
-                      hs_fixds = [], hs_defds = [], hs_annds = [],
-                      hs_fords = [], hs_warnds = [], hs_ruleds = [], hs_vects = [],
-                      hs_valds = error "emptyGroup hs_valds: Can't happen",
+                       hs_fixds = [], hs_defds = [], hs_annds = [],
+                       hs_fords = [], hs_warnds = [], hs_ruleds = [], hs_vects = [],
+                       hs_valds = error "emptyGroup hs_valds: Can't happen",
                        hs_docs = [] }
 
 appendGroups :: HsGroup a -> HsGroup a -> HsGroup a
@@ -225,44 +224,44 @@ instance OutputableBndr name => Outputable (HsDecl name) where
 
 instance OutputableBndr name => Outputable (HsGroup name) where
     ppr (HsGroup { hs_valds  = val_decls,
-                  hs_tyclds = tycl_decls,
-                  hs_instds = inst_decls,
+                   hs_tyclds = tycl_decls,
+                   hs_instds = inst_decls,
                    hs_derivds = deriv_decls,
-                  hs_fixds  = fix_decls,
-                  hs_warnds = deprec_decls,
-                  hs_annds  = ann_decls,
-                  hs_fords  = foreign_decls,
-                  hs_defds  = default_decls,
-                  hs_ruleds = rule_decls,
-                  hs_vects  = vect_decls })
-       = vcat_mb empty 
+                   hs_fixds  = fix_decls,
+                   hs_warnds = deprec_decls,
+                   hs_annds  = ann_decls,
+                   hs_fords  = foreign_decls,
+                   hs_defds  = default_decls,
+                   hs_ruleds = rule_decls,
+                   hs_vects  = vect_decls })
+        = vcat_mb empty 
             [ppr_ds fix_decls, ppr_ds default_decls, 
-            ppr_ds deprec_decls, ppr_ds ann_decls,
-            ppr_ds rule_decls,
-            ppr_ds vect_decls,
-            if isEmptyValBinds val_decls 
+             ppr_ds deprec_decls, ppr_ds ann_decls,
+             ppr_ds rule_decls,
+             ppr_ds vect_decls,
+             if isEmptyValBinds val_decls 
                 then Nothing 
                 else Just (ppr val_decls),
-            ppr_ds (concat tycl_decls), 
+             ppr_ds (concat tycl_decls), 
              ppr_ds inst_decls,
              ppr_ds deriv_decls,
-            ppr_ds foreign_decls]
-       where
+             ppr_ds foreign_decls]
+        where
           ppr_ds :: Outputable a => [a] -> Maybe SDoc
-         ppr_ds [] = Nothing
-         ppr_ds ds = Just (vcat (map ppr ds))
+          ppr_ds [] = Nothing
+          ppr_ds ds = Just (vcat (map ppr ds))
 
           vcat_mb :: SDoc -> [Maybe SDoc] -> SDoc
-         -- Concatenate vertically with white-space between non-blanks
+          -- Concatenate vertically with white-space between non-blanks
           vcat_mb _    []             = empty
           vcat_mb gap (Nothing : ds) = vcat_mb gap ds
           vcat_mb gap (Just d  : ds) = gap $$ d $$ vcat_mb blankLine ds
 
 data SpliceDecl id 
-  = SpliceDecl                 -- Top level splice
+  = SpliceDecl                  -- Top level splice
         (Located (HsExpr id))
-        HsExplicitFlag         -- Explicit <=> $(f x y)
-                               -- Implicit <=> f x y,  i.e. a naked top level expression
+        HsExplicitFlag          -- Explicit <=> $(f x y)
+                                -- Implicit <=> f x y,  i.e. a naked top level expression
     deriving (Data, Typeable)
 
 instance OutputableBndr name => Outputable (SpliceDecl name) where
@@ -271,14 +270,14 @@ instance OutputableBndr name => Outputable (SpliceDecl name) where
 
 
 %************************************************************************
-%*                                                                     *
+%*                                                                      *
 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
-%*                                                                     *
+%*                                                                      *
 %************************************************************************
 
-               --------------------------------
-                       THE NAMING STORY
-               --------------------------------
+                --------------------------------
+                        THE NAMING STORY
+                --------------------------------
 
 Here is the story about the implicit names that go with type, class,
 and instance decls.  It's a bit tricky, so pay attention!
@@ -286,13 +285,13 @@ and instance decls.  It's a bit tricky, so pay attention!
 "Implicit" (or "system") binders
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   Each data type decl defines 
-       a worker name for each constructor
-       to-T and from-T convertors
+        a worker name for each constructor
+        to-T and from-T convertors
   Each class decl defines
-       a tycon for the class
-       a data constructor for that tycon
-       the worker for that constructor
-       a selector for each superclass
+        a tycon for the class
+        a data constructor for that tycon
+        the worker for that constructor
+        a selector for each superclass
 
 All have occurrence names that are derived uniquely from their parent
 declaration.
@@ -337,10 +336,10 @@ In *source-code* class declarations:
 
  - During typechecking, we generate a binding for each $dm for 
    which there's a programmer-supplied default method:
-       class Foo a where
-         op1 :: <type>
-         op2 :: <type>
-         op1 = ...
+        class Foo a where
+          op1 :: <type>
+          op2 :: <type>
+          op1 = ...
    We generate a binding for $dmop1 but not for $dmop2.
    The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
    The Name for $dmop2 is simply discarded.
@@ -348,9 +347,9 @@ In *source-code* class declarations:
 In *interface-file* class declarations:
   - When parsing, we see if there's an explicit programmer-supplied default method
     because there's an '=' sign to indicate it:
-       class Foo a where
-         op1 = :: <type>       -- NB the '='
-         op2   :: <type>
+        class Foo a where
+          op1 = :: <type>       -- NB the '='
+          op2   :: <type>
     We use this info to generate a DefMeth with a suitable RdrName for op1,
     and a NoDefMeth for op2
   - The interface file has a separate definition for $dmop1, with unfolding etc.
@@ -371,8 +370,8 @@ dictionary functions in advance (we don't know how many we need).
 On the other hand for interface-file instance declarations, the decl
 specifies the name of the dictionary function, and it has a binding elsewhere
 in the interface file:
-       instance {Eq Int} = dEqInt
-       dEqInt :: {Eq Int} <pragma info>
+        instance {Eq Int} = dEqInt
+        dEqInt :: {Eq Int} <pragma info>
 
 So again we treat source code and interface file code slightly differently.
 
@@ -387,8 +386,8 @@ Source code:
   - The occurrence name it chooses is derived from the instance decl (just for 
     documentation really) --- e.g. dNumInt.  Two dict funs may share a common
     occurrence name, but will have different uniques.  E.g.
-       instance Foo [Int]  where ...
-       instance Foo [Bool] where ...
+        instance Foo [Int]  where ...
+        instance Foo [Bool] where ...
     These might both be dFooList
 
   - The CoreTidy phase externalises the name, and ensures the occurrence name is
@@ -436,97 +435,116 @@ type LTyClDecl name = Located (TyClDecl name)
 -- | A type or class declaration.
 data TyClDecl name
   = ForeignType { 
-               tcdLName    :: Located name,
-               tcdExtName  :: Maybe FastString
+                tcdLName    :: Located name,
+                tcdExtName  :: Maybe FastString
     }
 
 
   | -- | @type/data family T :: *->*@
-    TyFamily {  tcdFlavour:: FamilyFlavour,            -- type or data
-               tcdLName  :: Located name,              -- type constructor
-               tcdTyVars :: [LHsTyVarBndr name],       -- type variables
-               tcdKind   :: Maybe Kind                 -- result kind
+    TyFamily {  tcdFlavour:: FamilyFlavour,             -- type or data
+                tcdLName  :: Located name,              -- type constructor
+                tcdTyVars :: [LHsTyVarBndr name],       -- type variables
+                tcdKind   :: Maybe Kind                 -- result kind
     }
 
 
   | -- | Declares a data type or newtype, giving its construcors
     -- @
-    --         data/newtype T a = <constrs>
-    -- data/newtype instance T [a] = <constrs>
+    --  data/newtype T a = <constrs>
+    --  data/newtype instance T [a] = <constrs>
     -- @
-    TyData {   tcdND     :: NewOrData,
-               tcdCtxt   :: LHsContext name,           -- ^ Context
-               tcdLName  :: Located name,              -- ^ Type constructor
-
-               tcdTyVars :: [LHsTyVarBndr name],       -- ^ Type variables
-                       
-               tcdTyPats :: Maybe [LHsType name],
-                        -- ^ Type patterns.
-                        --
-                       -- @Just [t1..tn]@ for @data instance T t1..tn = ...@
-                       --      in this case @tcdTyVars = fv( tcdTyPats )@.
-                       -- @Nothing@ for everything else.
+    TyData {    tcdND     :: NewOrData,
+                tcdCtxt   :: LHsContext name,           -- ^ Context
+                tcdLName  :: Located name,              -- ^ Type constructor
 
-               tcdKindSig:: Maybe Kind,
+                tcdTyVars :: [LHsTyVarBndr name],       -- ^ Type variables
+                tcdTyPats :: Maybe [LHsType name],      -- ^ Type patterns.
+                  -- See Note [tcdTyVars and tcdTyPats] 
+
+                tcdKindSig:: Maybe Kind,
                         -- ^ Optional kind signature.
                         --
-                       -- @(Just k)@ for a GADT-style @data@, or @data
-                       -- instance@ decl with explicit kind sig
+                        -- @(Just k)@ for a GADT-style @data@, or @data
+                        -- instance@ decl with explicit kind sig
 
-               tcdCons   :: [LConDecl name],
+                tcdCons   :: [LConDecl name],
                         -- ^ Data constructors
                         --
-                       -- For @data T a = T1 | T2 a@
+                        -- For @data T a = T1 | T2 a@
                         --   the 'LConDecl's all have 'ResTyH98'.
-                       -- For @data T a where { T1 :: T a }@
+                        -- For @data T a where { T1 :: T a }@
                         --   the 'LConDecls' all have 'ResTyGADT'.
 
-               tcdDerivs :: Maybe [LHsType name]
-                       -- ^ Derivings; @Nothing@ => not specified,
-                       --              @Just []@ => derive exactly what is asked
+                tcdDerivs :: Maybe [LHsType name]
+                        -- ^ Derivings; @Nothing@ => not specified,
+                        --              @Just []@ => derive exactly what is asked
                         --
-                       -- These "types" must be of form
+                        -- These "types" must be of form
                         -- @
-                       --      forall ab. C ty1 ty2
+                        --      forall ab. C ty1 ty2
                         -- @
-                       -- Typically the foralls and ty args are empty, but they
-                       -- are non-empty for the newtype-deriving case
+                        -- Typically the foralls and ty args are empty, but they
+                        -- are non-empty for the newtype-deriving case
     }
 
-  | TySynonym {        tcdLName  :: Located name,              -- ^ type constructor
-               tcdTyVars :: [LHsTyVarBndr name],       -- ^ type variables
-               tcdTyPats :: Maybe [LHsType name],      -- ^ Type patterns
-                       -- See comments for tcdTyPats in TyData
-                       -- 'Nothing' => vanilla type synonym
+  | TySynonym { tcdLName  :: Located name,              -- ^ type constructor
+                tcdTyVars :: [LHsTyVarBndr name],       -- ^ type variables
+                tcdTyPats :: Maybe [LHsType name],      -- ^ Type patterns
+                  -- See Note [tcdTyVars and tcdTyPats] 
 
-               tcdSynRhs :: LHsType name               -- ^ synonym expansion
+                tcdSynRhs :: LHsType name               -- ^ synonym expansion
     }
 
-  | ClassDecl {        tcdCtxt    :: LHsContext name,          -- ^ Context...
-               tcdLName   :: Located name,             -- ^ Name of the class
-               tcdTyVars  :: [LHsTyVarBndr name],      -- ^ Class type variables
-               tcdFDs     :: [Located (FunDep name)],  -- ^ Functional deps
-               tcdSigs    :: [LSig name],              -- ^ Methods' signatures
-               tcdMeths   :: LHsBinds name,            -- ^ Default methods
-               tcdATs     :: [LTyClDecl name],         -- ^ Associated types; ie
-                                                       --   only 'TyFamily' and
-                                                       --   'TySynonym'; the
-                                                        --   latter for defaults
-               tcdDocs    :: [LDocDecl]                -- ^ Haddock docs
+  | ClassDecl { tcdCtxt    :: LHsContext name,          -- ^ Context...
+                tcdLName   :: Located name,             -- ^ Name of the class
+                tcdTyVars  :: [LHsTyVarBndr name],      -- ^ Class type variables
+                tcdFDs     :: [Located (FunDep name)],  -- ^ Functional deps
+                tcdSigs    :: [LSig name],              -- ^ Methods' signatures
+                tcdMeths   :: LHsBinds name,            -- ^ Default methods
+                tcdATs     :: [LTyClDecl name],         -- ^ Associated types; ie
+                                                        --   only 'TyFamily'
+                tcdATDefs  :: [LTyClDecl name],         -- ^ Associated type defaults; ie
+                                                        --   only 'TySynonym'
+                tcdDocs    :: [LDocDecl]                -- ^ Haddock docs
     }
   deriving (Data, Typeable)
 
 data NewOrData
-  = NewType                    -- ^ @newtype Blah ...@
-  | DataType                   -- ^ @data Blah ...@
-  deriving( Eq, Data, Typeable )               -- Needed because Demand derives Eq
+  = NewType                     -- ^ @newtype Blah ...@
+  | DataType                    -- ^ @data Blah ...@
+  deriving( Eq, Data, Typeable )                -- Needed because Demand derives Eq
 
 data FamilyFlavour
-  = TypeFamily                 -- ^ @type family ...@
-  | DataFamily                 -- ^ @data family ...@
+  = TypeFamily                  -- ^ @type family ...@
+  | DataFamily                  -- ^ @data family ...@
   deriving (Data, Typeable)
 \end{code}
 
+Note [tcdTyVars and tcdTyPats] 
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We use TyData and TySynonym both for vanilla data/type declarations
+     type T a = Int
+AND for data/type family instance declarations
+     type instance F [a] = (a,Int)
+
+tcdTyPats = Nothing
+   This is a vanilla data type or type synonym
+   tcdTyVars are the quantified type variables
+
+tcdTyPats = Just tys
+   This is a data/type family instance declaration
+   tcdTyVars are fv(tys)
+
+   Eg   class C a b where
+          type F a x :: *
+        instance D p s => C (p,q) [r] where
+          type F (p,q) x = p -> x
+   The tcdTyVars of the F instance decl are {p,q,x},
+   i.e. not including s, nor r 
+        (and indeed neither s nor should be mentioned
+         on the RHS of the F instance decl; Trac #5515)
+
+------------------------------
 Simple classifiers
 
 \begin{code}
@@ -539,12 +557,12 @@ isDataDecl _other      = False
 -- | type or type instance declaration
 isTypeDecl :: TyClDecl name -> Bool
 isTypeDecl (TySynonym {}) = True
-isTypeDecl _other        = False
+isTypeDecl _other         = False
 
 -- | vanilla Haskell type synonym (ie, not a type instance)
 isSynDecl :: TyClDecl name -> Bool
 isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
-isSynDecl _other                           = False
+isSynDecl _other                            = False
 
 -- | type class
 isClassDecl :: TyClDecl name -> Bool
@@ -561,7 +579,7 @@ isFamInstDecl :: TyClDecl name -> Bool
 isFamInstDecl tydecl
    | isTypeDecl tydecl
      || isDataDecl tydecl = isJust (tcdTyPats tydecl)
-   | otherwise           = False
+   | otherwise            = False
 \end{code}
 
 Dealing with names
@@ -575,12 +593,12 @@ tyClDeclTyVars (TyFamily    {tcdTyVars = tvs}) = tvs
 tyClDeclTyVars (TySynonym   {tcdTyVars = tvs}) = tvs
 tyClDeclTyVars (TyData      {tcdTyVars = tvs}) = tvs
 tyClDeclTyVars (ClassDecl   {tcdTyVars = tvs}) = tvs
-tyClDeclTyVars (ForeignType {})                       = []
+tyClDeclTyVars (ForeignType {})                = []
 \end{code}
 
 \begin{code}
 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
-       -- class, synonym decls, data, newtype, family decls, family instances
+        -- class, synonym decls, data, newtype, family decls, family instances
 countTyClDecls decls 
  = (count isClassDecl    decls,
     count isSynDecl      decls,  -- excluding...
@@ -598,63 +616,61 @@ countTyClDecls decls
 
 \begin{code}
 instance OutputableBndr name
-             => Outputable (TyClDecl name) where
+              => Outputable (TyClDecl name) where
 
     ppr (ForeignType {tcdLName = ltycon})
-       = hsep [ptext (sLit "foreign import type dotnet"), ppr ltycon]
+        = hsep [ptext (sLit "foreign import type dotnet"), ppr ltycon]
 
     ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon, 
-                  tcdTyVars = tyvars, tcdKind = mb_kind})
+                   tcdTyVars = tyvars, tcdKind = mb_kind})
       = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
         where
-         pp_flavour = case flavour of
-                        TypeFamily -> ptext (sLit "type family")
-                        DataFamily -> ptext (sLit "data family")
+          pp_flavour = case flavour of
+                         TypeFamily -> ptext (sLit "type family")
+                         DataFamily -> ptext (sLit "data family")
 
           pp_kind = case mb_kind of
-                     Nothing   -> empty
-                     Just kind -> dcolon <+> pprKind kind
+                      Nothing   -> empty
+                      Just kind -> dcolon <+> pprKind kind
 
     ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
-                   tcdSynRhs = mono_ty})
+                    tcdSynRhs = mono_ty})
       = hang (ptext (sLit "type") <+> 
-             (if isJust typats then ptext (sLit "instance") else empty) <+>
-             pp_decl_head [] ltycon tyvars typats <+> 
-             equals)
-            4 (ppr mono_ty)
+              (if isJust typats then ptext (sLit "instance") else empty) <+>
+              pp_decl_head [] ltycon tyvars typats <+> 
+              equals)
+             4 (ppr mono_ty)
 
     ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
-                tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig, 
-                tcdCons = condecls, tcdDerivs = derivings})
+                 tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig, 
+                 tcdCons = condecls, tcdDerivs = derivings})
       = pp_tydecl (null condecls && isJust mb_sig) 
                   (ppr new_or_data <+> 
-                  (if isJust typats then ptext (sLit "instance") else empty) <+>
-                  pp_decl_head (unLoc context) ltycon tyvars typats <+> 
-                  ppr_sig mb_sig)
-                 (pp_condecls condecls)
-                 derivings
+                   (if isJust typats then ptext (sLit "instance") else empty) <+>
+                   pp_decl_head (unLoc context) ltycon tyvars typats <+> 
+                   ppr_sigx mb_sig)
+                  (pp_condecls condecls)
+                  derivings
       where
-       ppr_sig Nothing = empty
-       ppr_sig (Just kind) = dcolon <+> pprKind kind
+        ppr_sigx Nothing     = empty
+        ppr_sigx (Just kind) = dcolon <+> pprKind kind
 
     ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars, 
-                   tcdFDs = fds, 
-                   tcdSigs = sigs, tcdMeths = methods, tcdATs = ats})
-      | null sigs && null ats  -- No "where" part
+                    tcdFDs  = fds,
+                    tcdSigs = sigs, tcdMeths = methods,
+                    tcdATs = ats, tcdATDefs = at_defs})
+      | null sigs && isEmptyBag methods && null ats && null at_defs -- No "where" part
       = top_matter
 
-      | otherwise      -- Laid out
-      = sep [hsep [top_matter, ptext (sLit "where {")],
-            nest 4 (sep [ sep (map ppr_semi ats)
-                        , sep (map ppr_semi sigs)
-                        , pprLHsBinds methods
-                        , char '}'])]
+      | otherwise       -- Laid out
+      = vcat [ top_matter <+> ptext (sLit "where")
+             , nest 2 $ pprDeclList (map ppr ats ++
+                                     map ppr at_defs ++
+                                     pprLHsBindsForUser methods sigs) ]
       where
-        top_matter    =     ptext (sLit "class") 
-                       <+> pp_decl_head (unLoc context) lclas tyvars Nothing
-                       <+> pprFundeps (map unLoc fds)
-        ppr_semi :: Outputable a => a -> SDoc
-       ppr_semi decl = ppr decl <> semi
+        top_matter = ptext (sLit "class") 
+                     <+> pp_decl_head (unLoc context) lclas tyvars Nothing
+                     <+> pprFundeps (map unLoc fds)
 
 pp_decl_head :: OutputableBndr name
    => HsContext name
@@ -662,16 +678,16 @@ pp_decl_head :: OutputableBndr name
    -> [LHsTyVarBndr name]
    -> Maybe [LHsType name]
    -> SDoc
-pp_decl_head context thing tyvars Nothing      -- no explicit type patterns
+pp_decl_head context thing tyvars Nothing       -- no explicit type patterns
   = hsep [pprHsContext context, ppr thing, interppSP tyvars]
 pp_decl_head context thing _      (Just typats) -- explicit type patterns
   = hsep [ pprHsContext context, ppr thing
-        , hsep (map (pprParendHsType.unLoc) typats)]
+         , hsep (map (pprParendHsType.unLoc) typats)]
 
 pp_condecls :: OutputableBndr name => [LConDecl name] -> SDoc
 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
   = hang (ptext (sLit "where")) 2 (vcat (map ppr cs))
-pp_condecls cs                           -- In H98 syntax
+pp_condecls cs                    -- In H98 syntax
   = equals <+> sep (punctuate (ptext (sLit " |")) (map ppr cs))
 
 pp_tydecl :: OutputableBndr name => Bool -> SDoc -> SDoc -> Maybe [LHsType name] -> SDoc
@@ -682,7 +698,7 @@ pp_tydecl False pp_head pp_decl_rhs derivings
       pp_decl_rhs,
       case derivings of
         Nothing -> empty
-       Just ds -> hsep [ptext (sLit "deriving"), parens (interpp'SP ds)]
+        Just ds -> hsep [ptext (sLit "deriving"), parens (interpp'SP ds)]
     ])
 
 instance Outputable NewOrData where
@@ -692,9 +708,9 @@ instance Outputable NewOrData where
 
 
 %************************************************************************
-%*                                                                     *
+%*                                                                      *
 \subsection[ConDecl]{A data-constructor declaration}
-%*                                                                     *
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -704,13 +720,13 @@ type LConDecl name = Located (ConDecl name)
 --   MkT :: forall b a. Eq a => MkT a b
 
 -- data T b where
---     MkT1 :: Int -> T Int
+--      MkT1 :: Int -> T Int
 
 -- data T = Int `MkT` Int
---       | MkT2
+--        | MkT2
 
 -- data T a where
---     Int `MkT` Int :: T Int
+--      Int `MkT` Int :: T Int
 
 data ConDecl name
   = ConDecl
@@ -723,14 +739,17 @@ data ConDecl name
 
     , con_qvars     :: [LHsTyVarBndr name]
         -- ^ Type variables.  Depending on 'con_res' this describes the
-       -- follewing entities
+        -- following entities
         --
         --  - ResTyH98:  the constructor's *existential* type variables
         --  - ResTyGADT: *all* the constructor's quantified type variables
+        --
+        -- If con_explicit is Implicit, then con_qvars is irrelevant
+        -- until after renaming.  
 
     , con_cxt       :: LHsContext name
         -- ^ The context.  This /does not/ include the \"stupid theta\" which
-       -- lives only in the 'TyData' decl.
+        -- lives only in the 'TyData' decl.
 
     , con_details   :: HsConDeclDetails name
         -- ^ The main payload
@@ -743,9 +762,9 @@ data ConDecl name
 
     , con_old_rec :: Bool   
         -- ^ TEMPORARY field; True <=> user has employed now-deprecated syntax for
-       --                             GADT-style record decl   C { blah } :: T a b
-       -- Remove this when we no longer parse this stuff, and hence do not
-       -- need to report decprecated use
+        --                             GADT-style record decl   C { blah } :: T a b
+        -- Remove this when we no longer parse this stuff, and hence do not
+        -- need to report decprecated use
     } deriving (Data, Typeable)
 
 type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
@@ -756,13 +775,13 @@ hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
 hsConDeclArgTys (RecCon flds)      = map cd_fld_type flds
 
 data ResType name
-   = ResTyH98          -- Constructor was declared using Haskell 98 syntax
-   | ResTyGADT (LHsType name)  -- Constructor was declared using GADT-style syntax,
-                               --      and here is its result type
+   = ResTyH98           -- Constructor was declared using Haskell 98 syntax
+   | ResTyGADT (LHsType name)   -- Constructor was declared using GADT-style syntax,
+                                --      and here is its result type
    deriving (Data, Typeable)
 
 instance OutputableBndr name => Outputable (ResType name) where
-        -- Debugging only
+         -- Debugging only
    ppr ResTyH98 = ptext (sLit "ResTyH98")
    ppr (ResTyGADT ty) = ptext (sLit "ResTyGADT") <+> pprParendHsType (unLoc ty)
 \end{code}
@@ -773,14 +792,14 @@ instance (OutputableBndr name) => Outputable (ConDecl name) where
     ppr = pprConDecl
 
 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
-pprConDecl (ConDecl { con_name =con, con_explicit = expl, con_qvars = tvs
+pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
                     , con_cxt = cxt, con_details = details
                     , con_res = ResTyH98, con_doc = doc })
-  = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details con details]
+  = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details details]
   where
-    ppr_details con (InfixCon t1 t2) = hsep [ppr t1, pprHsInfix con, ppr t2]
-    ppr_details con (PrefixCon tys)  = hsep (pprHsVar con : map ppr tys)
-    ppr_details con (RecCon fields)  = ppr con <+> pprConDeclFields fields
+    ppr_details (InfixCon t1 t2) = hsep [ppr t1, pprHsInfix con, ppr t2]
+    ppr_details (PrefixCon tys)  = hsep (pprHsVar con : map ppr tys)
+    ppr_details (RecCon fields)  = ppr con <+> pprConDeclFields fields
 
 pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
                     , con_cxt = cxt, con_details = PrefixCon arg_tys
@@ -797,35 +816,39 @@ pprConDecl (ConDecl { con_name = con, con_explicit = expl, con_qvars = tvs
 
 pprConDecl (ConDecl {con_name = con, con_details = InfixCon {}, con_res = ResTyGADT {} })
   = pprPanic "pprConDecl" (ppr con)
-       -- In GADT syntax we don't allow infix constructors
+        -- In GADT syntax we don't allow infix constructors
 \end{code}
 
 %************************************************************************
-%*                                                                     *
-\subsection[InstDecl]{An instance declaration
-%*                                                                     *
+%*                                                                      *
+\subsection[InstDecl]{An instance declaration}
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
 type LInstDecl name = Located (InstDecl name)
 
 data InstDecl name
-  = InstDecl   (LHsType name)  -- Context => Class Instance-type
-                               -- Using a polytype means that the renamer conveniently
-                               -- figures out the quantified type variables for us.
-               (LHsBinds name)
-               [LSig name]     -- User-supplied pragmatic info
-               [LTyClDecl name]-- Associated types (ie, 'TyData' and
-                               -- 'TySynonym' only)
+  = InstDecl    (LHsType name)  -- Context => Class Instance-type
+                                -- Using a polytype means that the renamer conveniently
+                                -- figures out the quantified type variables for us.
+                (LHsBinds name)
+                [LSig name]     -- User-supplied pragmatic info
+                [LTyClDecl name]-- Associated types (ie, 'TyData' and
+                                -- 'TySynonym' only)
   deriving (Data, Typeable)
 
 instance (OutputableBndr name) => Outputable (InstDecl name) where
+    ppr (InstDecl inst_ty binds sigs ats)
+      | null sigs && null ats && isEmptyBag binds  -- No "where" part
+      = top_matter
 
-    ppr (InstDecl inst_ty binds uprags ats)
-      = vcat [hsep [ptext (sLit "instance"), ppr inst_ty, ptext (sLit "where")]
-             , nest 4 $ vcat (map ppr ats)
-            , nest 4 $ vcat (map ppr uprags)
-            , nest 4 $ pprLHsBinds binds ]
+      | otherwise       -- Laid out
+      = vcat [ top_matter <+> ptext (sLit "where")
+             , nest 2 $ pprDeclList (map ppr ats ++
+                                     pprLHsBindsForUser binds sigs) ]
+      where
+        top_matter = ptext (sLit "instance") <+> ppr inst_ty
 
 -- Extract the declarations of associated types from an instance
 --
@@ -834,15 +857,15 @@ instDeclATs inst_decls = [at | L _ (InstDecl _ _ _ ats) <- inst_decls, at <- ats
 \end{code}
 
 %************************************************************************
-%*                                                                     *
-\subsection[DerivDecl]{A stand-alone instance deriving declaration
-%*                                                                     *
+%*                                                                      *
+\subsection[DerivDecl]{A stand-alone instance deriving declaration}
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
 type LDerivDecl name = Located (DerivDecl name)
 
-data DerivDecl name = DerivDecl (LHsType name)
+data DerivDecl name = DerivDecl { deriv_type :: LHsType name }
   deriving (Data, Typeable)
 
 instance (OutputableBndr name) => Outputable (DerivDecl name) where
@@ -851,9 +874,9 @@ instance (OutputableBndr name) => Outputable (DerivDecl name) where
 \end{code}
 
 %************************************************************************
-%*                                                                     *
+%*                                                                      *
 \subsection[DefaultDecl]{A @default@ declaration}
-%*                                                                     *
+%*                                                                      *
 %************************************************************************
 
 There can only be one default declaration per module, but it is hard
@@ -864,20 +887,20 @@ syntax, and that restriction must be checked in the front end.
 type LDefaultDecl name = Located (DefaultDecl name)
 
 data DefaultDecl name
-  = DefaultDecl        [LHsType name]
+  = DefaultDecl [LHsType name]
   deriving (Data, Typeable)
 
 instance (OutputableBndr name)
-             => Outputable (DefaultDecl name) where
+              => Outputable (DefaultDecl name) where
 
     ppr (DefaultDecl tys)
       = ptext (sLit "default") <+> parens (interpp'SP tys)
 \end{code}
 
 %************************************************************************
-%*                                                                     *
+%*                                                                      *
 \subsection{Foreign function interface declaration}
-%*                                                                     *
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -891,39 +914,61 @@ instance (OutputableBndr name)
 type LForeignDecl name = Located (ForeignDecl name)
 
 data ForeignDecl name
-  = ForeignImport (Located name) (LHsType name) ForeignImport  -- defines name
-  | ForeignExport (Located name) (LHsType name) ForeignExport  -- uses name
+  = ForeignImport (Located name) -- defines this name
+                  (LHsType name) -- sig_ty
+                  Coercion       -- rep_ty ~ sig_ty
+                  ForeignImport
+  | ForeignExport (Located name) -- uses this name
+                  (LHsType name) -- sig_ty
+                  Coercion       -- sig_ty ~ rep_ty
+                  ForeignExport
   deriving (Data, Typeable)
+{-
+    In both ForeignImport and ForeignExport:
+        sig_ty is the type given in the Haskell code
+        rep_ty is the representation for this type, i.e. with newtypes
+               coerced away and type functions evaluated.
+    Thus if the declaration is valid, then rep_ty will only use types
+    such as Int and IO that we know how to make foreign calls with.
+-}
+
+noForeignImportCoercionYet :: Coercion
+noForeignImportCoercionYet
+    = panic "ForeignImport coercion evaluated before typechecking"
+
+noForeignExportCoercionYet :: Coercion
+noForeignExportCoercionYet
+    = panic "ForeignExport coercion evaluated before typechecking"
 
 -- Specification Of an imported external entity in dependence on the calling
 -- convention 
 --
 data ForeignImport = -- import of a C entity
-                    --
+                     --
                      --  * the two strings specifying a header file or library
                      --   may be empty, which indicates the absence of a
                      --   header or object specification (both are not used
                      --   in the case of `CWrapper' and when `CFunction'
                      --   has a dynamic target)
-                    --
-                    --  * the calling convention is irrelevant for code
-                    --   generation in the case of `CLabel', but is needed
-                    --   for pretty printing 
-                    --
-                    --  * `Safety' is irrelevant for `CLabel' and `CWrapper'
-                    --
-                    CImport  CCallConv       -- ccall or stdcall
-                             Safety          -- interruptible, safe or unsafe
-                             FastString      -- name of C header
-                             CImportSpec     -- details of the C entity
+                     --
+                     --  * the calling convention is irrelevant for code
+                     --   generation in the case of `CLabel', but is needed
+                     --   for pretty printing 
+                     --
+                     --  * `Safety' is irrelevant for `CLabel' and `CWrapper'
+                     --
+                     CImport  CCallConv       -- ccall or stdcall
+                              Safety          -- interruptible, safe or unsafe
+                              FastString      -- name of C header
+                              CImportSpec     -- details of the C entity
   deriving (Data, Typeable)
 
 -- details of an external C entity
 --
 data CImportSpec = CLabel    CLabelString     -- import address of a C label
-                | CFunction CCallTarget      -- static or dynamic function
-                | CWrapper                   -- wrapper to expose closures
-                                             -- (former f.e.d.)
+                 | CFunction CCallTarget      -- static or dynamic function
+                 | CWrapper                   -- wrapper to expose closures
+                                              -- (former f.e.d.)
   deriving (Data, Typeable)
 
 -- specification of an externally exported entity in dependence on the calling
@@ -936,10 +981,10 @@ data ForeignExport = CExport  CExportSpec    -- contains the calling convention
 --
 
 instance OutputableBndr name => Outputable (ForeignDecl name) where
-  ppr (ForeignImport n ty fimport) =
+  ppr (ForeignImport n ty fimport) =
     hang (ptext (sLit "foreign import") <+> ppr fimport <+> ppr n)
        2 (dcolon <+> ppr ty)
-  ppr (ForeignExport n ty fexport) =
+  ppr (ForeignExport n ty fexport) =
     hang (ptext (sLit "foreign export") <+> ppr fexport <+> ppr n)
        2 (dcolon <+> ppr ty)
 
@@ -965,22 +1010,22 @@ instance Outputable ForeignExport where
 
 
 %************************************************************************
-%*                                                                     *
+%*                                                                      *
 \subsection{Transformation rules}
-%*                                                                     *
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
 type LRuleDecl name = Located (RuleDecl name)
 
 data RuleDecl name
-  = HsRule                     -- Source rule
-       RuleName                -- Rule name
-       Activation
-       [RuleBndr name]         -- Forall'd vars; after typechecking this includes tyvars
-       (Located (HsExpr name)) -- LHS
+  = HsRule                      -- Source rule
+        RuleName                -- Rule name
+        Activation
+        [RuleBndr name]         -- Forall'd vars; after typechecking this includes tyvars
+        (Located (HsExpr name)) -- LHS
         NameSet                 -- Free-vars from the LHS
-       (Located (HsExpr name)) -- RHS
+        (Located (HsExpr name)) -- RHS
         NameSet                 -- Free-vars from the RHS
   deriving (Data, Typeable)
 
@@ -994,12 +1039,12 @@ collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
 
 instance OutputableBndr name => Outputable (RuleDecl name) where
   ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
-       = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
-              nest 4 (pp_forall <+> pprExpr (unLoc lhs)), 
-              nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
-       where
-         pp_forall | null ns   = empty
-                   | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
+        = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
+               nest 4 (pp_forall <+> pprExpr (unLoc lhs)), 
+               nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
+        where
+          pp_forall | null ns   = empty
+                    | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
 
 instance OutputableBndr name => Outputable (RuleBndr name) where
    ppr (RuleBndr name) = ppr name
@@ -1013,23 +1058,15 @@ instance OutputableBndr name => Outputable (RuleBndr name) where
 %*                                                                      *
 %************************************************************************
 
-A vectorisation pragma
+A vectorisation pragma, one of
 
-  {-# VECTORISE f = closure1 g (scalar_map g) #-} OR
+  {-# VECTORISE f = closure1 g (scalar_map g) #-}
   {-# VECTORISE SCALAR f #-}
-  
-Note [Typechecked vectorisation pragmas]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-In case of the first variant of vectorisation pragmas (with an explicit expression),
-we need to infer the type of that expression during type checking and then keep that type
-around until vectorisation, so that it can be checked against the *vectorised* type of 'f'.
-(We cannot determine vectorised types during type checking due to internal information of
-the vectoriser being needed.)
-
-To this end, we annotate the 'Id' of 'f' (the variable mentioned in the PRAGMA) with the
-inferred type of the expression.  This is slightly dodgy, as this is really the type of
-'$v_f' (the name of the vectorised function).
+  {-# NOVECTORISE f #-}
 
+  {-# VECTORISE type T = ty #-}
+  {-# VECTORISE SCALAR type T #-}
+  
 \begin{code}
 type LVectDecl name = Located (VectDecl name)
 
@@ -1037,20 +1074,88 @@ data VectDecl name
   = HsVect
       (Located name)
       (Maybe (LHsExpr name))    -- 'Nothing' => SCALAR declaration
+  | HsNoVect
+      (Located name)
+  | HsVectTypeIn                -- pre type-checking
+      Bool                      -- 'TRUE' => SCALAR declaration
+      (Located name)
+      (Maybe (Located name))    -- 'Nothing' => no right-hand side
+  | HsVectTypeOut               -- post type-checking
+      Bool                      -- 'TRUE' => SCALAR declaration
+      TyCon
+      (Maybe TyCon)             -- 'Nothing' => no right-hand side
+  | HsVectClassIn               -- pre type-checking
+      (Located name)
+  | HsVectClassOut              -- post type-checking
+      Class
+  | HsVectInstIn                -- pre type-checking
+      Bool                      -- 'TRUE' => SCALAR declaration
+      (LHsType name)
+  | HsVectInstOut               -- post type-checking
+      Bool                      -- 'TRUE' => SCALAR declaration
+      Instance
   deriving (Data, Typeable)
-      
+
+lvectDeclName :: NamedThing name => LVectDecl name -> Name
+lvectDeclName (L _ (HsVect         (L _ name) _))   = getName name
+lvectDeclName (L _ (HsNoVect       (L _ name)))     = getName name
+lvectDeclName (L _ (HsVectTypeIn   _ (L _ name) _)) = getName name
+lvectDeclName (L _ (HsVectTypeOut  _ tycon _))      = getName tycon
+lvectDeclName (L _ (HsVectClassIn  (L _ name)))     = getName name
+lvectDeclName (L _ (HsVectClassOut cls))            = getName cls
+lvectDeclName (L _ (HsVectInstIn   _ _))            = panic "HsDecls.lvectDeclName: HsVectInstIn"
+lvectDeclName (L _ (HsVectInstOut  _ _))            = panic "HsDecls.lvectDeclName: HsVectInstOut"
+-- lvectDeclName (L _ (HsVectInstIn   _ (L _ name)))   = getName name
+-- lvectDeclName (L _ (HsVectInstOut  _ inst))         = getName inst
+
+lvectInstDecl :: LVectDecl name -> Bool
+lvectInstDecl (L _ (HsVectInstIn _ _))  = True
+lvectInstDecl (L _ (HsVectInstOut _ _)) = True
+lvectInstDecl _                         = False
+
 instance OutputableBndr name => Outputable (VectDecl name) where
-  ppr (HsVect v rhs)
+  ppr (HsVect v Nothing)
+    = sep [text "{-# VECTORISE SCALAR" <+> ppr v <+> text "#-}" ]
+  ppr (HsVect v (Just rhs))
     = sep [text "{-# VECTORISE" <+> ppr v,
-           nest 4 (case rhs of
-                     Nothing  -> text "SCALAR #-}"
-                     Just rhs -> pprExpr (unLoc rhs) <+> text "#-}") ]
+           nest 4 $ 
+             pprExpr (unLoc rhs) <+> text "#-}" ]
+  ppr (HsNoVect v)
+    = sep [text "{-# NOVECTORISE" <+> ppr v <+> text "#-}" ]
+  ppr (HsVectTypeIn False t Nothing)
+    = sep [text "{-# VECTORISE type" <+> ppr t <+> text "#-}" ]
+  ppr (HsVectTypeIn False t (Just t'))
+    = sep [text "{-# VECTORISE type" <+> ppr t, text "=", ppr t', text "#-}" ]
+  ppr (HsVectTypeIn True t Nothing)
+    = sep [text "{-# VECTORISE SCALAR type" <+> ppr t <+> text "#-}" ]
+  ppr (HsVectTypeIn True t (Just t'))
+    = sep [text "{-# VECTORISE SCALAR type" <+> ppr t, text "=", ppr t', text "#-}" ]
+  ppr (HsVectTypeOut False t Nothing)
+    = sep [text "{-# VECTORISE type" <+> ppr t <+> text "#-}" ]
+  ppr (HsVectTypeOut False t (Just t'))
+    = sep [text "{-# VECTORISE type" <+> ppr t, text "=", ppr t', text "#-}" ]
+  ppr (HsVectTypeOut True t Nothing)
+    = sep [text "{-# VECTORISE SCALAR type" <+> ppr t <+> text "#-}" ]
+  ppr (HsVectTypeOut True t (Just t'))
+    = sep [text "{-# VECTORISE SCALAR type" <+> ppr t, text "=", ppr t', text "#-}" ]
+  ppr (HsVectClassIn c)
+    = sep [text "{-# VECTORISE class" <+> ppr c <+> text "#-}" ]
+  ppr (HsVectClassOut c)
+    = sep [text "{-# VECTORISE class" <+> ppr c <+> text "#-}" ]
+  ppr (HsVectInstIn False ty)
+    = sep [text "{-# VECTORISE instance" <+> ppr ty <+> text "#-}" ]
+  ppr (HsVectInstIn True ty)
+    = sep [text "{-# VECTORISE SCALAR instance" <+> ppr ty <+> text "#-}" ]
+  ppr (HsVectInstOut False i)
+    = sep [text "{-# VECTORISE instance" <+> ppr i <+> text "#-}" ]
+  ppr (HsVectInstOut True i)
+    = sep [text "{-# VECTORISE SCALAR instance" <+> ppr i <+> text "#-}" ]
 \end{code}
 
 %************************************************************************
-%*                                                                     *
+%*                                                                      *
 \subsection[DocDecl]{Document comments}
-%*                                                                     *
+%*                                                                      *
 %************************************************************************
 
 \begin{code}
@@ -1077,9 +1182,9 @@ docDeclDoc (DocGroup _ d) = d
 \end{code}
 
 %************************************************************************
-%*                                                                     *
+%*                                                                      *
 \subsection[DeprecDecl]{Deprecations}
-%*                                                                     *
+%*                                                                      *
 %************************************************************************
 
 We use exported entities for things to deprecate.
@@ -1096,9 +1201,9 @@ instance OutputableBndr name => Outputable (WarnDecl name) where
 \end{code}
 
 %************************************************************************
-%*                                                                     *
+%*                                                                      *
 \subsection[AnnDecl]{Annotations}
-%*                                                                     *
+%*                                                                      *
 %************************************************************************
 
 \begin{code}