{-# 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 (intercalate) import System.IO import GHC import GHC.Driver.Session import GHC.Driver.Ppr import GHC.Utils.Monad import GHC.Utils.Outputable import GHC.Data.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 ann_items = apiAnnItems anns ann_eof = apiAnnEofPos anns (l,_) = fst $ head $ Map.toList ann_items annModule = getAnnotation anns l AnnModule annLet = getAnnotation anns l AnnLet putStrLn (intercalate "\n" [showAnns ann_items,pp annModule,pp annLet,pp l, "EOF: " ++ show ann_eof]) showAnns anns = "[\n" ++ (intercalate "\n" $ map (\((s,k),v) -> ("(AK " ++ pp s ++ " " ++ show k ++" = " ++ pp v ++ ")\n")) $ Map.toList anns) ++ "]\n" pp a = showPprUnsafe a