X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcBinds.lhs;fp=compiler%2Ftypecheck%2FTcBinds.lhs;h=b5bbeb1940e47b9cb989922a9c0c96f622df59ad;hp=881c304da454469b548aa23b0c6d4418ca727307;hb=c1c2c25355bc462e521b2c5fb41ac79307da22ff;hpb=eced7db98b3a8c7050196c619b5f7427a51417fd

diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs
index 881c304..b5bbeb1 100644
--- a/compiler/typecheck/TcBinds.lhs
+++ b/compiler/typecheck/TcBinds.lhs
@@ -559,22 +559,29 @@ tcImpPrags :: [LSig Name] -> TcM [LTcSpecPrag]
 tcImpPrags prags
   = do { this_mod <- getModule
        ; dflags <- getDOpts
-       ; if not (dopt Opt_Specialise dflags) then
-            return []    -- Ignore SPECIALISE pragmas for imported things
-	    	   	 -- when -O is not on; otherwise we get bogus 
-			 -- complaints about lack of INLINABLE pragmas 
-			 -- in the imported module (also compiled without -O)
-			 -- Notably, when Haddocking the base library
+       ; if (not_specialising dflags) then
+            return []
          else
             mapAndRecoverM (wrapLocM tcImpSpec) 
             [L loc (name,prag) | (L loc prag@(SpecSig (L _ name) _ _)) <- prags
                                , not (nameIsLocalOrFrom this_mod name) ] }
+  where
+    -- Ignore SPECIALISE pragmas for imported things
+    -- when we aren't specialising, or when we aren't generating
+    -- code.  The latter happens when Haddocking the base library;
+    -- we don't wnat complaints about lack of INLINABLE pragmas 
+    not_specialising dflags
+      | not (dopt Opt_Specialise dflags) = True
+      | otherwise = case hscTarget dflags of
+                      HscNothing -> True
+                      HscInterpreted -> True
+                      _other         -> False
 
 tcImpSpec :: (Name, Sig Name) -> TcM TcSpecPrag
 tcImpSpec (name, prag)
  = do { id <- tcLookupId name
-      ; checkTc (isAnyInlinePragma (idInlinePragma id))
-                (impSpecErr name)
+      ; unless (isAnyInlinePragma (idInlinePragma id))
+               (addWarnTc (impSpecErr name))
       ; tcSpec id prag }
 
 impSpecErr :: Name -> SDoc
@@ -591,7 +598,7 @@ impSpecErr name
 tcVectDecls :: [LVectDecl Name] -> TcM ([LVectDecl TcId])
 tcVectDecls decls 
   = do { decls' <- mapM (wrapLocM tcVect) decls
-       ; let ids  = [unLoc id | L _ (HsVect id _) <- decls']
+       ; let ids  = map lvectDeclName decls'
              dups = findDupsEq (==) ids
        ; mapM_ reportVectDups dups
        ; traceTcConstraints "End of tcVectDecls"
@@ -642,6 +649,11 @@ tcVect (HsVect name@(L loc _) (Just rhs))
         -- to the vectoriser - see "Note [Typechecked vectorisation pragmas]" in HsDecls
        ; return $ HsVect (L loc id') (Just rhsWrapped)
        }
+tcVect (HsNoVect name)
+  = addErrCtxt (vectCtxt name) $
+    do { id <- wrapLocM tcLookupId name
+       ; return $ HsNoVect id
+       }
 
 vectCtxt :: Located Name -> SDoc
 vectCtxt name = ptext (sLit "When checking the vectorisation declaration for") <+> ppr name