From: Simon Peyton Jones <simonpj@microsoft.com>
Date: Mon, 13 Jun 2011 13:39:43 +0000 (+0100)
Subject: Merge branch 'master' of http://darcs.haskell.org/ghc
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=3bb66cc52ced70cd7081fb8a2e32a1005528d5a0;hp=-c

Merge branch 'master' of darcs.haskell.org/ghc
---

3bb66cc52ced70cd7081fb8a2e32a1005528d5a0
diff --combined compiler/typecheck/TcBinds.lhs
index 537da93,0fee7ab..b5bbeb1
--- a/compiler/typecheck/TcBinds.lhs
+++ b/compiler/typecheck/TcBinds.lhs
@@@ -559,29 -559,22 +559,29 @@@ tcImpPrags :: [LSig Name] -> TcM [LTcSp
  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
@@@ -598,7 -591,7 +598,7 @@@ impSpecErr nam
  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"
@@@ -649,6 -642,11 +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