diff --git a/ghc-exactprint.cabal b/ghc-exactprint.cabal --- a/ghc-exactprint.cabal +++ b/ghc-exactprint.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: ghc-exactprint -version: 0.1.0.0 +version: 0.1.0.1 synopsis: ExactPrint for GHC description: Using the API Annotations available from GHC 7.10 RC2, this library provides a means to round trip any* code that can @@ -12,6 +12,8 @@ . The dependency footprint is deliberately kept small so that it can easily be tested against GHC HEAD + . + Note: requires GHC 7.10 RC2 or later license: BSD3 license-file: LICENSE @@ -36,7 +38,9 @@ , syb hs-source-dirs: src default-language: Haskell2010 - + -- Note: the following constraint actually requires RC2 or better + if impl (ghc < 7.10) + buildable: False Test-Suite test type: exitcode-stdio-1.0 diff --git a/tests/Test.hs b/tests/Test.hs --- a/tests/Test.hs +++ b/tests/Test.hs @@ -3,7 +3,6 @@ module Main where import Language.Haskell.GHC.ExactPrint --- import Language.Haskell.GHC.ExactPrint.Types import Language.Haskell.GHC.ExactPrint.Utils import GHC.Paths ( libdir ) @@ -11,8 +10,8 @@ import qualified DynFlags as GHC import qualified FastString as GHC import qualified GHC as GHC -import qualified MonadUtils as GHC -import qualified Outputable as GHC +-- import qualified MonadUtils as GHC +-- import qualified Outputable as GHC import qualified GHC.SYB.Utils as SYB @@ -33,89 +32,90 @@ -- tests = TestCase (do r <- manipulateAstTest "examples/LetStmt.hs" "Layout.LetStmt" -- assertBool "test" r ) +tests :: Test tests = TestList [ - mkTestMod "examples/LetStmt.hs" "Layout.LetStmt" - , mkTestMod "examples/LetExpr.hs" "LetExpr" - , mkTestMod "examples/ExprPragmas.hs" "ExprPragmas" - , mkTestMod "examples/ListComprehensions.hs" "Main" - , mkTestMod "examples/MonadComprehensions.hs" "Main" - , mkTestMod "examples/FunDeps.hs" "Main" - , mkTestMod "examples/ImplicitParams.hs" "Main" - , mkTestMod "examples/RecursiveDo.hs" "Main" - , mkTestMod "examples/TypeFamilies.hs" "Main" - , mkTestMod "examples/MultiParamTypeClasses.hs" "Main" - , mkTestMod "examples/DataFamilies.hs" "DataFamilies" - , mkTestMod "examples/Deriving.hs" "Main" - , mkTestMod "examples/Default.hs" "Main" - , mkTestMod "examples/ForeignDecl.hs" "ForeignDecl" - , mkTestMod "examples/Warning.hs" "Warning" - , mkTestMod "examples/Annotations.hs" "Annotations" - , mkTestMod "examples/DocDecls.hs" "DocDecls" - , mkTestModTH "examples/QuasiQuote.hs" "QuasiQuote" - , mkTestMod "examples/Roles.hs" "Roles" - , mkTestMod "examples/Splice.hs" "Splice" - , mkTestMod "examples/ImportsSemi.hs" "ImportsSemi" - , mkTestMod "examples/Stmts.hs" "Stmts" - , mkTestMod "examples/Mixed.hs" "Main" - , mkTestMod "examples/Arrow.hs" "Arrow" - , mkTestMod "examples/PatSynBind.hs" "Main" - , mkTestMod "examples/HsDo.hs" "HsDo" - , mkTestMod "examples/ForAll.hs" "ForAll" - , mkTestMod "examples/PArr.hs" "PArr" - , mkTestMod "examples/ViewPatterns.hs" "Main" - , mkTestMod "examples/BangPatterns.hs" "Main" - , mkTestMod "examples/Associated.hs" "Main" - , mkTestMod "examples/Move1.hs" "Move1" - , mkTestMod "examples/Rules.hs" "Rules" - , mkTestMod "examples/TypeOperators.hs" "Main" - , mkTestMod "examples/NullaryTypeClasses.hs" "Main" - , mkTestMod "examples/FunctionalDeps.hs" "Main" - , mkTestMod "examples/DerivingOC.hs" "Main" - , mkTestMod "examples/GenericDeriving.hs" "Main" - , mkTestMod "examples/OverloadedStrings.hs" "Main" - , mkTestMod "examples/RankNTypes.hs" "Main" - , mkTestMod "examples/Existential.hs" "Main" - , mkTestMod "examples/ScopedTypeVariables.hs" "Main" - , mkTestMod "examples/Arrows.hs" "Main" - , mkTestMod "examples/TH.hs" "Main" - , mkTestMod "examples/StaticPointers.hs" "Main" - , mkTestMod "examples/DataDecl.hs" "Main" - , mkTestMod "examples/Guards.hs" "Main" - , mkTestMod "examples/RebindableSyntax.hs" "Main" - , mkTestMod "examples/RdrNames.hs" "RdrNames" - , mkTestMod "examples/Vect.hs" "Vect" - , mkTestMod "examples/Tuple.hs" "Main" - , mkTestMod "examples/ExtraConstraints1.hs" "ExtraConstraints1" - , mkTestMod "examples/AddAndOr3.hs" "AddAndOr3" - , mkTestMod "examples/Ann01.hs" "Ann01" - , mkTestMod "examples/StrictLet.hs" "Main" - , mkTestMod "examples/Cg008.hs" "Cg008" - , mkTestMod "examples/T2388.hs" "T2388" - , mkTestMod "examples/T3132.hs" "T3132" - , mkTestMod "examples/Stream.hs" "Stream" - , mkTestMod "examples/Trit.hs" "Trit" - , mkTestMod "examples/DataDecl.hs" "Main" - , mkTestMod "examples/Zipper.hs" "Zipper" - , mkTestMod "examples/Sigs.hs" "Sigs" - , mkTestMod "examples/Utils2.hs" "Utils2" - , mkTestMod "examples/EmptyMostlyInst.hs" "EmptyMostlyInst" - , mkTestMod "examples/EmptyMostlyNoSemis.hs" "EmptyMostlyNoSemis" - , mkTestMod "examples/Dead1.hs" "Dead1" - , mkTestMod "examples/EmptyMostly.hs" "EmptyMostly" - , mkTestMod "examples/FromUtils.hs" "Main" - , mkTestMod "examples/DocDecls.hs" "DocDecls" - , mkTestMod "examples/RecordUpdate.hs" "Main" - -- , mkTestMod "examples/Unicode.hs" "Main" - , mkTestMod "examples/B.hs" "Main" - , mkTestMod "examples/LayoutWhere.hs" "Main" - , mkTestMod "examples/LayoutLet.hs" "Main" - , mkTestMod "examples/Deprecation.hs" "Deprecation" - , mkTestMod "examples/Infix.hs" "Main" - , mkTestMod "examples/BCase.hs" "Main" - , mkTestMod "examples/AltsSemis.hs" "Main" + mkTestMod "LetStmt.hs" "Layout.LetStmt" + , mkTestMod "LetExpr.hs" "LetExpr" + , mkTestMod "ExprPragmas.hs" "ExprPragmas" + , mkTestMod "ListComprehensions.hs" "Main" + , mkTestMod "MonadComprehensions.hs" "Main" + , mkTestMod "FunDeps.hs" "Main" + , mkTestMod "ImplicitParams.hs" "Main" + , mkTestMod "RecursiveDo.hs" "Main" + , mkTestMod "TypeFamilies.hs" "Main" + , mkTestMod "MultiParamTypeClasses.hs" "Main" + , mkTestMod "DataFamilies.hs" "DataFamilies" + , mkTestMod "Deriving.hs" "Main" + , mkTestMod "Default.hs" "Main" + , mkTestMod "ForeignDecl.hs" "ForeignDecl" + , mkTestMod "Warning.hs" "Warning" + , mkTestMod "Annotations.hs" "Annotations" + , mkTestMod "DocDecls.hs" "DocDecls" + , mkTestModTH "QuasiQuote.hs" "QuasiQuote" + , mkTestMod "Roles.hs" "Roles" + , mkTestMod "Splice.hs" "Splice" + , mkTestMod "ImportsSemi.hs" "ImportsSemi" + , mkTestMod "Stmts.hs" "Stmts" + , mkTestMod "Mixed.hs" "Main" + , mkTestMod "Arrow.hs" "Arrow" + , mkTestMod "PatSynBind.hs" "Main" + , mkTestMod "HsDo.hs" "HsDo" + , mkTestMod "ForAll.hs" "ForAll" + , mkTestMod "PArr.hs" "PArr" + , mkTestMod "ViewPatterns.hs" "Main" + , mkTestMod "BangPatterns.hs" "Main" + , mkTestMod "Associated.hs" "Main" + , mkTestMod "Move1.hs" "Move1" + , mkTestMod "Rules.hs" "Rules" + , mkTestMod "TypeOperators.hs" "Main" + , mkTestMod "NullaryTypeClasses.hs" "Main" + , mkTestMod "FunctionalDeps.hs" "Main" + , mkTestMod "DerivingOC.hs" "Main" + , mkTestMod "GenericDeriving.hs" "Main" + , mkTestMod "OverloadedStrings.hs" "Main" + , mkTestMod "RankNTypes.hs" "Main" + , mkTestMod "Existential.hs" "Main" + , mkTestMod "ScopedTypeVariables.hs" "Main" + , mkTestMod "Arrows.hs" "Main" + , mkTestMod "TH.hs" "Main" + , mkTestMod "StaticPointers.hs" "Main" + , mkTestMod "DataDecl.hs" "Main" + , mkTestMod "Guards.hs" "Main" + , mkTestMod "RebindableSyntax.hs" "Main" + , mkTestMod "RdrNames.hs" "RdrNames" + , mkTestMod "Vect.hs" "Vect" + , mkTestMod "Tuple.hs" "Main" + , mkTestMod "ExtraConstraints1.hs" "ExtraConstraints1" + , mkTestMod "AddAndOr3.hs" "AddAndOr3" + , mkTestMod "Ann01.hs" "Ann01" + , mkTestMod "StrictLet.hs" "Main" + , mkTestMod "Cg008.hs" "Cg008" + , mkTestMod "T2388.hs" "T2388" + , mkTestMod "T3132.hs" "T3132" + , mkTestMod "Stream.hs" "Stream" + , mkTestMod "Trit.hs" "Trit" + , mkTestMod "DataDecl.hs" "Main" + , mkTestMod "Zipper.hs" "Zipper" + , mkTestMod "Sigs.hs" "Sigs" + , mkTestMod "Utils2.hs" "Utils2" + , mkTestMod "EmptyMostlyInst.hs" "EmptyMostlyInst" + , mkTestMod "EmptyMostlyNoSemis.hs" "EmptyMostlyNoSemis" + , mkTestMod "Dead1.hs" "Dead1" + , mkTestMod "EmptyMostly.hs" "EmptyMostly" + , mkTestMod "FromUtils.hs" "Main" + , mkTestMod "DocDecls.hs" "DocDecls" + , mkTestMod "RecordUpdate.hs" "Main" + -- , mkTestMod "Unicode.hs" "Main" + , mkTestMod "B.hs" "Main" + , mkTestMod "LayoutWhere.hs" "Main" + , mkTestMod "LayoutLet.hs" "Main" + , mkTestMod "Deprecation.hs" "Deprecation" + , mkTestMod "Infix.hs" "Main" + , mkTestMod "BCase.hs" "Main" + , mkTestMod "AltsSemis.hs" "Main" - , mkTestMod "examples/LetExprSemi.hs" "LetExprSemi" + , mkTestMod "LetExprSemi.hs" "LetExprSemi" ] mkTestMain :: FilePath -> Test @@ -134,96 +134,96 @@ -- --------------------------------------------------------------------- -t :: IO Bool -t = do +tt :: IO Bool +tt = do - manipulateAstTest "examples/LetStmt.hs" "Layout.LetStmt" - manipulateAstTest "examples/LetExpr.hs" "LetExpr" - manipulateAstTest "examples/ExprPragmas.hs" "ExprPragmas" - manipulateAstTest "examples/ListComprehensions.hs" "Main" - manipulateAstTest "examples/MonadComprehensions.hs" "Main" - manipulateAstTest "examples/FunDeps.hs" "Main" - manipulateAstTest "examples/ImplicitParams.hs" "Main" - manipulateAstTest "examples/RecursiveDo.hs" "Main" - manipulateAstTest "examples/TypeFamilies.hs" "Main" - manipulateAstTest "examples/MultiParamTypeClasses.hs" "Main" - manipulateAstTest "examples/DataFamilies.hs" "DataFamilies" - manipulateAstTest "examples/Deriving.hs" "Main" - manipulateAstTest "examples/Default.hs" "Main" - manipulateAstTest "examples/ForeignDecl.hs" "ForeignDecl" - manipulateAstTest "examples/Warning.hs" "Warning" - manipulateAstTest "examples/Annotations.hs" "Annotations" - manipulateAstTest "examples/DocDecls.hs" "DocDecls" - manipulateAstTestTH "examples/QuasiQuote.hs" "QuasiQuote" - manipulateAstTest "examples/Roles.hs" "Roles" - manipulateAstTest "examples/Splice.hs" "Splice" - manipulateAstTest "examples/ImportsSemi.hs" "ImportsSemi" - manipulateAstTest "examples/Stmts.hs" "Stmts" - manipulateAstTest "examples/Mixed.hs" "Main" - manipulateAstTest "examples/Arrow.hs" "Arrow" - manipulateAstTest "examples/PatSynBind.hs" "Main" - manipulateAstTest "examples/HsDo.hs" "HsDo" - manipulateAstTest "examples/ForAll.hs" "ForAll" - manipulateAstTest "examples/PArr.hs" "PArr" - manipulateAstTest "examples/ViewPatterns.hs" "Main" - manipulateAstTest "examples/BangPatterns.hs" "Main" - manipulateAstTest "examples/Associated.hs" "Main" - manipulateAstTest "examples/Move1.hs" "Move1" - manipulateAstTest "examples/Rules.hs" "Rules" - manipulateAstTest "examples/TypeOperators.hs" "Main" - manipulateAstTest "examples/NullaryTypeClasses.hs" "Main" - manipulateAstTest "examples/FunctionalDeps.hs" "Main" - manipulateAstTest "examples/DerivingOC.hs" "Main" - manipulateAstTest "examples/GenericDeriving.hs" "Main" - manipulateAstTest "examples/OverloadedStrings.hs" "Main" - manipulateAstTest "examples/RankNTypes.hs" "Main" - manipulateAstTest "examples/Existential.hs" "Main" - manipulateAstTest "examples/ScopedTypeVariables.hs" "Main" - manipulateAstTest "examples/Arrows.hs" "Main" - manipulateAstTest "examples/TH.hs" "Main" - manipulateAstTest "examples/StaticPointers.hs" "Main" - manipulateAstTest "examples/DataDecl.hs" "Main" - manipulateAstTest "examples/Guards.hs" "Main" - manipulateAstTest "examples/RebindableSyntax.hs" "Main" - manipulateAstTest "examples/RdrNames.hs" "RdrNames" - manipulateAstTest "examples/Vect.hs" "Vect" - manipulateAstTest "examples/Tuple.hs" "Main" - manipulateAstTest "examples/ExtraConstraints1.hs" "ExtraConstraints1" - manipulateAstTest "examples/AddAndOr3.hs" "AddAndOr3" - manipulateAstTest "examples/Ann01.hs" "Ann01" - manipulateAstTest "examples/StrictLet.hs" "Main" - manipulateAstTest "examples/Cg008.hs" "Cg008" - manipulateAstTest "examples/T2388.hs" "T2388" - manipulateAstTest "examples/T3132.hs" "T3132" - manipulateAstTest "examples/Stream.hs" "Stream" - manipulateAstTest "examples/Trit.hs" "Trit" - manipulateAstTest "examples/DataDecl.hs" "Main" - manipulateAstTest "examples/Zipper.hs" "Zipper" - manipulateAstTest "examples/Sigs.hs" "Sigs" - manipulateAstTest "examples/Utils2.hs" "Utils2" - manipulateAstTest "examples/EmptyMostlyInst.hs" "EmptyMostlyInst" - manipulateAstTest "examples/EmptyMostlyNoSemis.hs" "EmptyMostlyNoSemis" - manipulateAstTest "examples/Dead1.hs" "Dead1" - manipulateAstTest "examples/EmptyMostly.hs" "EmptyMostly" - manipulateAstTest "examples/FromUtils.hs" "Main" - manipulateAstTest "examples/DocDecls.hs" "DocDecls" - manipulateAstTest "examples/RecordUpdate.hs" "Main" - -- manipulateAstTest "examples/Unicode.hs" "Main" - manipulateAstTest "examples/B.hs" "Main" - manipulateAstTest "examples/LayoutWhere.hs" "Main" - manipulateAstTest "examples/LayoutLet.hs" "Main" - manipulateAstTest "examples/Deprecation.hs" "Deprecation" - manipulateAstTest "examples/Infix.hs" "Main" - manipulateAstTest "examples/BCase.hs" "Main" - manipulateAstTest "examples/AltsSemis.hs" "Main" + manipulateAstTest "LetStmt.hs" "Layout.LetStmt" + manipulateAstTest "LetExpr.hs" "LetExpr" + manipulateAstTest "ExprPragmas.hs" "ExprPragmas" + manipulateAstTest "ListComprehensions.hs" "Main" + manipulateAstTest "MonadComprehensions.hs" "Main" + manipulateAstTest "FunDeps.hs" "Main" + manipulateAstTest "ImplicitParams.hs" "Main" + manipulateAstTest "RecursiveDo.hs" "Main" + manipulateAstTest "TypeFamilies.hs" "Main" + manipulateAstTest "MultiParamTypeClasses.hs" "Main" + manipulateAstTest "DataFamilies.hs" "DataFamilies" + manipulateAstTest "Deriving.hs" "Main" + manipulateAstTest "Default.hs" "Main" + manipulateAstTest "ForeignDecl.hs" "ForeignDecl" + manipulateAstTest "Warning.hs" "Warning" + manipulateAstTest "Annotations.hs" "Annotations" + manipulateAstTest "DocDecls.hs" "DocDecls" + manipulateAstTestTH "QuasiQuote.hs" "QuasiQuote" + manipulateAstTest "Roles.hs" "Roles" + manipulateAstTest "Splice.hs" "Splice" + manipulateAstTest "ImportsSemi.hs" "ImportsSemi" + manipulateAstTest "Stmts.hs" "Stmts" + manipulateAstTest "Mixed.hs" "Main" + manipulateAstTest "Arrow.hs" "Arrow" + manipulateAstTest "PatSynBind.hs" "Main" + manipulateAstTest "HsDo.hs" "HsDo" + manipulateAstTest "ForAll.hs" "ForAll" + manipulateAstTest "PArr.hs" "PArr" + manipulateAstTest "ViewPatterns.hs" "Main" + manipulateAstTest "BangPatterns.hs" "Main" + manipulateAstTest "Associated.hs" "Main" + manipulateAstTest "Move1.hs" "Move1" + manipulateAstTest "Rules.hs" "Rules" + manipulateAstTest "TypeOperators.hs" "Main" + manipulateAstTest "NullaryTypeClasses.hs" "Main" + manipulateAstTest "FunctionalDeps.hs" "Main" + manipulateAstTest "DerivingOC.hs" "Main" + manipulateAstTest "GenericDeriving.hs" "Main" + manipulateAstTest "OverloadedStrings.hs" "Main" + manipulateAstTest "RankNTypes.hs" "Main" + manipulateAstTest "Existential.hs" "Main" + manipulateAstTest "ScopedTypeVariables.hs" "Main" + manipulateAstTest "Arrows.hs" "Main" + manipulateAstTest "TH.hs" "Main" + manipulateAstTest "StaticPointers.hs" "Main" + manipulateAstTest "DataDecl.hs" "Main" + manipulateAstTest "Guards.hs" "Main" + manipulateAstTest "RebindableSyntax.hs" "Main" + manipulateAstTest "RdrNames.hs" "RdrNames" + manipulateAstTest "Vect.hs" "Vect" + manipulateAstTest "Tuple.hs" "Main" + manipulateAstTest "ExtraConstraints1.hs" "ExtraConstraints1" + manipulateAstTest "AddAndOr3.hs" "AddAndOr3" + manipulateAstTest "Ann01.hs" "Ann01" + manipulateAstTest "StrictLet.hs" "Main" + manipulateAstTest "Cg008.hs" "Cg008" + manipulateAstTest "T2388.hs" "T2388" + manipulateAstTest "T3132.hs" "T3132" + manipulateAstTest "Stream.hs" "Stream" + manipulateAstTest "Trit.hs" "Trit" + manipulateAstTest "DataDecl.hs" "Main" + manipulateAstTest "Zipper.hs" "Zipper" + manipulateAstTest "Sigs.hs" "Sigs" + manipulateAstTest "Utils2.hs" "Utils2" + manipulateAstTest "EmptyMostlyInst.hs" "EmptyMostlyInst" + manipulateAstTest "EmptyMostlyNoSemis.hs" "EmptyMostlyNoSemis" + manipulateAstTest "Dead1.hs" "Dead1" + manipulateAstTest "EmptyMostly.hs" "EmptyMostly" + manipulateAstTest "FromUtils.hs" "Main" + manipulateAstTest "DocDecls.hs" "DocDecls" + manipulateAstTest "RecordUpdate.hs" "Main" + -- manipulateAstTest "Unicode.hs" "Main" + manipulateAstTest "B.hs" "Main" + manipulateAstTest "LayoutWhere.hs" "Main" + manipulateAstTest "LayoutLet.hs" "Main" + manipulateAstTest "Deprecation.hs" "Deprecation" + manipulateAstTest "Infix.hs" "Main" + manipulateAstTest "BCase.hs" "Main" + manipulateAstTest "AltsSemis.hs" "Main" - manipulateAstTest "examples/LetExprSemi.hs" "LetExprSemi" + manipulateAstTest "LetExprSemi.hs" "LetExprSemi" {- - manipulateAstTest "examples/Cpp.hs" "Main" - manipulateAstTest "examples/Lhs.lhs" "Main" - manipulateAstTest "examples/ParensAroundContext.hs" "ParensAroundContext" - manipulateAstTest "examples/EmptyMostly2.hs" "EmptyMostly2" - manipulateAstTest "examples/Foo.hs" "Main" + manipulateAstTest "Cpp.hs" "Main" + manipulateAstTest "Lhs.lhs" "Main" + manipulateAstTest "ParensAroundContext.hs" "ParensAroundContext" + manipulateAstTest "EmptyMostly2.hs" "EmptyMostly2" + manipulateAstTest "Foo.hs" "Main" -} -- | Where all the tests are to be found @@ -240,14 +240,15 @@ manipulateAstTestTH file modname = manipulateAstTest' True file modname manipulateAstTest' :: Bool -> FilePath -> String -> IO Bool -manipulateAstTest' useTH file modname = do - let out = file <.> "out" - golden = file <.> "golden" +manipulateAstTest' useTH file' modname = do + let testpath = "./tests/examples/" + file = testpath file' + out = file <.> "out" contents <- readUTF8File file (ghcAnns,t) <- parsedFileGhc file modname useTH let - parsed@(GHC.L l hsmod) = GHC.pm_parsed_source $ GHC.tm_parsed_module t + parsed = GHC.pm_parsed_source $ GHC.tm_parsed_module t parsedAST = SYB.showData SYB.Parser 0 parsed -- parsedAST = showGhc parsed -- `debug` ("getAnn:=" ++ (show (getAnnotationValue (snd ann) (GHC.getLoc parsed) :: Maybe AnnHsModule))) @@ -255,11 +256,6 @@ ann = annotateAST parsed ghcAnns `debug` ("ghcAnns:" ++ showGhc ghcAnns) - Just (GHC.L le exps) = GHC.hsmodExports hsmod - secondExp@(GHC.L l2 _) = ghead "foo" $ tail exps - ss = GHC.mkSrcSpan (GHC.mkSrcLoc (GHC.mkFastString "examples/PatBind.hs") 16 9) - (GHC.mkSrcLoc (GHC.mkFastString "examples/PatBind.hs") 16 27) - printed = exactPrintAnnotation parsed [] ann -- `debug` ("ann=" ++ (show $ map (\(s,a) -> (ss2span s, a)) $ Map.toList ann)) result = if printed == contents @@ -271,8 +267,7 @@ writeFile out $ result -- putStrLn $ "Test:ann organised:" ++ showGhc (organiseAnns ann) -- putStrLn $ "Test:showdata:" ++ showAnnData (organiseAnns ann) 0 parsed - return ("Match\n" == result) --- }}} + return ("Match\n" == result) -- --------------------------------------------------------------------- @@ -282,7 +277,7 @@ parsedFileGhc :: String -> String -> Bool -> IO (GHC.ApiAnns,ParseResult) parsedFileGhc fileName modname useTH = do - putStrLn $ "parsedFileGhc:" ++ show fileName + -- putStrLn $ "parsedFileGhc:" ++ show fileName #if __GLASGOW_HASKELL__ > 704 GHC.defaultErrorHandler GHC.defaultFatalMessager GHC.defaultFlushOut $ do #else @@ -311,18 +306,18 @@ -- else GHC.gopt_set (GHC.gopt_unset dflags''' GHC.Opt_Haddock) -- GHC.Opt_KeepRawTokenStream - (dflags5,args,warns) <- GHC.parseDynamicFlagsCmdLine dflags4 [GHC.noLoc "-package ghc"] - GHC.liftIO $ putStrLn $ "dflags set:(args,warns)" ++ show (map GHC.unLoc args,map GHC.unLoc warns) + (dflags5,_args,_warns) <- GHC.parseDynamicFlagsCmdLine dflags4 [GHC.noLoc "-package ghc"] + -- GHC.liftIO $ putStrLn $ "dflags set:(args,warns)" ++ show (map GHC.unLoc args,map GHC.unLoc warns) void $ GHC.setSessionDynFlags dflags5 -- GHC.liftIO $ putStrLn $ "dflags set" target <- GHC.guessTarget fileName Nothing GHC.setTargets [target] - GHC.liftIO $ putStrLn $ "target set:" ++ showGhc (GHC.targetId target) + -- GHC.liftIO $ putStrLn $ "target set:" ++ showGhc (GHC.targetId target) void $ GHC.load GHC.LoadAllTargets -- Loads and compiles, much as calling make -- GHC.liftIO $ putStrLn $ "targets loaded" - g <- GHC.getModuleGraph - let showStuff ms = show (GHC.moduleNameString $ GHC.moduleName $ GHC.ms_mod ms,GHC.ms_location ms) + -- g <- GHC.getModuleGraph + -- let showStuff ms = show (GHC.moduleNameString $ GHC.moduleName $ GHC.ms_mod ms,GHC.ms_location ms) -- GHC.liftIO $ putStrLn $ "module graph:" ++ (intercalate "," (map showStuff g)) modSum <- GHC.getModSummary $ GHC.mkModuleName modname @@ -331,11 +326,11 @@ p <- GHC.parseModule modSum -- GHC.liftIO $ putStrLn $ "got parsedModule" t <- GHC.typecheckModule p - GHC.liftIO $ putStrLn $ "typechecked" + -- GHC.liftIO $ putStrLn $ "typechecked" -- toks <- GHC.getRichTokenStream (GHC.ms_mod modSum) -- GHC.liftIO $ putStrLn $ "toks" let anns = GHC.pm_annotations p - GHC.liftIO $ putStrLn $ "anns" + -- GHC.liftIO $ putStrLn $ "anns" return (anns,t) readUTF8File :: FilePath -> IO String