Merge remote-tracking branch 'github/pr/83'
[ghc.git] / compiler / typecheck / TcAnnotations.hs
1 {-
2 (c) The University of Glasgow 2006
3 (c) The AQUA Project, Glasgow University, 1993-1998
4
5 \section[TcAnnotations]{Typechecking annotations}
6 -}
7
8 {-# LANGUAGE CPP #-}
9 {-# LANGUAGE FlexibleContexts #-}
10
11 module TcAnnotations ( tcAnnotations, annCtxt ) where
12
13 import GhcPrelude
14
15 import {-# SOURCE #-} TcSplice ( runAnnotation )
16 import Module
17 import DynFlags
18 import Control.Monad ( when )
19
20 import HsSyn
21 import Name
22 import Annotations
23 import TcRnMonad
24 import SrcLoc
25 import Outputable
26
27 -- Some platforms don't support the external interpreter, and
28 -- compilation on those platforms shouldn't fail just due to
29 -- annotations
30 #ifndef GHCI
31 tcAnnotations :: [LAnnDecl GhcRn] -> TcM [Annotation]
32 tcAnnotations anns = do
33 dflags <- getDynFlags
34 case gopt Opt_ExternalInterpreter dflags of
35 True -> tcAnnotations' anns
36 False -> warnAnns anns
37 warnAnns :: [LAnnDecl GhcRn] -> TcM [Annotation]
38 --- No GHCI; emit a warning (not an error) and ignore. cf Trac #4268
39 warnAnns [] = return []
40 warnAnns anns@(L loc _ : _)
41 = do { setSrcSpan loc $ addWarnTc NoReason $
42 (text "Ignoring ANN annotation" <> plural anns <> comma
43 <+> text "because this is a stage-1 compiler without -fexternal-interpreter or doesn't support GHCi")
44 ; return [] }
45 #else
46 tcAnnotations :: [LAnnDecl GhcRn] -> TcM [Annotation]
47 tcAnnotations = tcAnnotations'
48 #endif
49
50 tcAnnotations' :: [LAnnDecl GhcRn] -> TcM [Annotation]
51 tcAnnotations' anns = mapM tcAnnotation anns
52
53 tcAnnotation :: LAnnDecl GhcRn -> TcM Annotation
54 tcAnnotation (L loc ann@(HsAnnotation _ provenance expr)) = do
55 -- Work out what the full target of this annotation was
56 mod <- getModule
57 let target = annProvenanceToTarget mod provenance
58
59 -- Run that annotation and construct the full Annotation data structure
60 setSrcSpan loc $ addErrCtxt (annCtxt ann) $ do
61 -- See #10826 -- Annotations allow one to bypass Safe Haskell.
62 dflags <- getDynFlags
63 when (safeLanguageOn dflags) $ failWithTc safeHsErr
64 runAnnotation target expr
65 where
66 safeHsErr = vcat [ text "Annotations are not compatible with Safe Haskell."
67 , text "See https://ghc.haskell.org/trac/ghc/ticket/10826" ]
68
69 annProvenanceToTarget :: Module -> AnnProvenance Name
70 -> AnnTarget Name
71 annProvenanceToTarget _ (ValueAnnProvenance (L _ name)) = NamedTarget name
72 annProvenanceToTarget _ (TypeAnnProvenance (L _ name)) = NamedTarget name
73 annProvenanceToTarget mod ModuleAnnProvenance = ModuleTarget mod
74
75 annCtxt :: (SourceTextX p, OutputableBndrId p) => AnnDecl p -> SDoc
76 annCtxt ann
77 = hang (text "In the annotation:") 2 (ppr ann)