X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcAnnotations.lhs;fp=compiler%2Ftypecheck%2FTcAnnotations.lhs;h=17ebbb13eaba1508856d4d620021f48f59aa91fb;hp=0000000000000000000000000000000000000000;hb=9bcd95bad83ee937c178970e8b729732e680fe1e;hpb=b1f3ff48870a3a4670cb41b890b78bbfffa8a32e

diff --git a/compiler/typecheck/TcAnnotations.lhs b/compiler/typecheck/TcAnnotations.lhs
new file mode 100644
index 0000000..17ebbb1
--- /dev/null
+++ b/compiler/typecheck/TcAnnotations.lhs
@@ -0,0 +1,53 @@
+%
+% (c) The University of Glasgow 2006
+% (c) The AQUA Project, Glasgow University, 1993-1998
+%
+\section[TcAnnotations]{Typechecking annotations}
+
+\begin{code}
+module TcAnnotations ( tcAnnotations ) where
+
+import HsSyn
+import Annotations
+import Name
+import TcRnMonad
+import SrcLoc
+import Outputable
+
+#ifdef GHCI
+import Module
+import TcExpr
+import {-# SOURCE #-} TcSplice ( runAnnotation )
+import FastString
+#endif
+
+import Control.Monad
+\end{code}
+
+\begin{code}
+tcAnnotations :: [LAnnDecl Name] -> TcM [Annotation]
+tcAnnotations = mapM tcAnnotation
+
+tcAnnotation :: LAnnDecl Name -> TcM Annotation
+#ifndef GHCI
+-- TODO: modify lexer so ANN pragmas are parsed as comments in a stage1 compiler, so developers don't see this error
+tcAnnotation (L _ (HsAnnotation _ expr)) = pprPanic "Cant do annotations without GHCi" (ppr expr)
+#else
+tcAnnotation ann@(L loc (HsAnnotation provenance expr)) = do
+    -- Work out what the full target of this annotation was
+    mod <- getModule
+    let target = annProvenanceToTarget mod provenance
+    
+    -- Run that annotation and construct the full Annotation data structure
+    setSrcSpan loc $ addErrCtxt (annCtxt ann) $ addExprErrCtxt expr $ runAnnotation target expr
+
+annProvenanceToTarget :: Module -> AnnProvenance Name -> AnnTarget Name
+annProvenanceToTarget _   (ValueAnnProvenance name) = NamedTarget name
+annProvenanceToTarget _   (TypeAnnProvenance name)  = NamedTarget name
+annProvenanceToTarget mod ModuleAnnProvenance       = ModuleTarget mod
+
+annCtxt :: OutputableBndr id => LAnnDecl id -> SDoc
+annCtxt ann
+  = hang (ptext (sLit "In the annotation:")) 4 (ppr ann)
+#endif
+\end{code}
\ No newline at end of file