{-# LANGUAGE RankNTypes #-} -- This program must be called with GHC's libdir as the single command line -- argument. module Main where -- import Data.Generics import Data.Data import Data.List import System.IO import GHC import DynFlags import MonadUtils import Outputable import Bag (filterBag,isEmptyBag) import System.Directory (removeFile) import System.Environment( getArgs ) import qualified Data.Map as Map import Data.Dynamic ( fromDynamic,Dynamic ) main::IO() main = do [libdir] <- getArgs testOneFile libdir "AnnotationLet" testOneFile libdir fileName = do p <- runGhc (Just libdir) $ do dflags <- getSessionDynFlags setSessionDynFlags dflags let mn =mkModuleName fileName addTarget Target { targetId = TargetModule mn , targetAllowObjCode = True , targetContents = Nothing } load LoadAllTargets modSum <- getModSummary mn p <- parseModule modSum t <- typecheckModule p d <- desugarModule t l <- loadModule d let ts=typecheckedSource l r =renamedSource l -- liftIO (putStr (showSDocDebug (ppr ts))) return (pm_annotations p) let anns = p (l,_) = fst $ head $ Map.toList (fst anns) annModule = (getAnnotation anns l AnnModule) annLet = (getAnnotation anns l AnnLet) putStrLn (intercalate "\n" [showAnns anns,pp annModule,pp annLet,pp l]) showAnns (anns,_) = "[\n" ++ (intercalate "\n" $ map (\((s,k),v) -> ("(AK " ++ pp s ++ " " ++ show k ++" = " ++ pp v ++ ")\n")) $ Map.toList anns) ++ "]\n" pp a = showPpr unsafeGlobalDynFlags a