Merge branch 'master' of http://darcs.haskell.org/ghc
authorSimon Peyton Jones <simonpj@microsoft.com>
Mon, 13 Jun 2011 13:39:43 +0000 (14:39 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Mon, 13 Jun 2011 13:39:43 +0000 (14:39 +0100)
1  2 
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