never executed always true always false

    1 {-
    2 (c) The University of Glasgow 2006
    3 (c) The AQUA Project, Glasgow University, 1993-1998
    4 
    5 -}
    6 
    7 {-# LANGUAGE FlexibleContexts #-}
    8 {-# LANGUAGE TypeFamilies #-}
    9 
   10 -- | Typechecking annotations
   11 module GHC.Tc.Gen.Annotation ( tcAnnotations, annCtxt ) where
   12 
   13 import GHC.Prelude
   14 
   15 import GHC.Driver.Session
   16 import GHC.Driver.Env
   17 
   18 import GHC.Tc.Errors.Types
   19 import {-# SOURCE #-} GHC.Tc.Gen.Splice ( runAnnotation )
   20 import GHC.Tc.Utils.Monad
   21 
   22 import GHC.Unit.Module
   23 
   24 import GHC.Hs
   25 
   26 import GHC.Utils.Outputable
   27 
   28 import GHC.Types.Name
   29 import GHC.Types.Annotations
   30 import GHC.Types.SrcLoc
   31 
   32 import Control.Monad ( when )
   33 
   34 -- Some platforms don't support the interpreter, and compilation on those
   35 -- platforms shouldn't fail just due to annotations
   36 tcAnnotations :: [LAnnDecl GhcRn] -> TcM [Annotation]
   37 tcAnnotations anns = do
   38   hsc_env <- getTopEnv
   39   case hsc_interp hsc_env of
   40     Just _  -> mapM tcAnnotation anns
   41     Nothing -> warnAnns anns
   42 
   43 warnAnns :: [LAnnDecl GhcRn] -> TcM [Annotation]
   44 --- No GHCI; emit a warning (not an error) and ignore. cf #4268
   45 warnAnns [] = return []
   46 warnAnns anns@(L loc _ : _)
   47   = do { setSrcSpanA loc $ addDiagnosticTc (TcRnIgnoringAnnotations anns)
   48        ; return [] }
   49 
   50 tcAnnotation :: LAnnDecl GhcRn -> TcM Annotation
   51 tcAnnotation (L loc ann@(HsAnnotation _ _ provenance expr)) = do
   52     -- Work out what the full target of this annotation was
   53     mod <- getModule
   54     let target = annProvenanceToTarget mod provenance
   55 
   56     -- Run that annotation and construct the full Annotation data structure
   57     setSrcSpanA loc $ addErrCtxt (annCtxt ann) $ do
   58       -- See #10826 -- Annotations allow one to bypass Safe Haskell.
   59       dflags <- getDynFlags
   60       when (safeLanguageOn dflags) $ failWithTc TcRnAnnotationInSafeHaskell
   61       runAnnotation target expr
   62 
   63 annProvenanceToTarget :: Module -> AnnProvenance GhcRn
   64                       -> AnnTarget Name
   65 annProvenanceToTarget _   (ValueAnnProvenance (L _ name)) = NamedTarget name
   66 annProvenanceToTarget _   (TypeAnnProvenance (L _ name))  = NamedTarget name
   67 annProvenanceToTarget mod ModuleAnnProvenance             = ModuleTarget mod
   68 
   69 annCtxt :: (OutputableBndrId p) => AnnDecl (GhcPass p) -> SDoc
   70 annCtxt ann
   71   = hang (text "In the annotation:") 2 (ppr ann)