X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FhsSyn%2FHsDecls.lhs;h=3712cbd9f72c6777d5beafe3ff108d857dd37c57;hp=53d2949aabc3fd3726775ae3cfd6d6efe8470952;hb=c5b178be60a5a44abd2f4ddf8c399857678326e2;hpb=bba816223372c52fb586cda2e3f041d7791110a5

diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs
index 53d2949..3712cbd 100644
--- a/compiler/hsSyn/HsDecls.lhs
+++ b/compiler/hsSyn/HsDecls.lhs
@@ -28,6 +28,7 @@ module HsDecls (
   collectRuleBndrSigTys,
   -- ** @VECTORISE@ declarations
   VectDecl(..), LVectDecl,
+  lvectDeclName,
   -- ** @default@ declarations
   DefaultDecl(..), LDefaultDecl,
   -- ** Top-level template haskell splice
@@ -834,7 +835,7 @@ instDeclATs inst_decls = [at | L _ (InstDecl _ _ _ ats) <- inst_decls, at <- ats
 \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
@@ -1005,10 +1006,11 @@ 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 #-}
+  {-# NOVECTORISE f #-}
   
 Note [Typechecked vectorisation pragmas]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1029,14 +1031,23 @@ data VectDecl name
   = HsVect
       (Located name)
       (Maybe (LHsExpr name))    -- 'Nothing' => SCALAR declaration
+  | HsNoVect
+      (Located name)
   deriving (Data, Typeable)
-      
+
+lvectDeclName :: LVectDecl name -> name
+lvectDeclName (L _ (HsVect   (L _ name) _)) = name
+lvectDeclName (L _ (HsNoVect (L _ name)))   = name
+
 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 "#-}" ]
 \end{code}
 
 %************************************************************************