Panic when using syb with GHC API

Thomas Schilling nominolo at googlemail.com
Thu Aug 25 11:22:17 CEST 2011


GHC's parse tree contains lots of placeholders.  You are not supposed
to look at them until a specific phase has been run.  For example,
anything of type "SyntaxExpr" is an error thunk until the renamer has
been run.  Unfortunately, SyntaxExpr is just a type synonym, so
there's no way to distinguish them via SYB.

The simplest workaround is to adapt the default traversal code for the
nodes which may contain such error thunks.  A better solution would be
to change the GHC AST to wrap such possibly undefined nodes with
newtypes, but that would only take effect once the next version of GHC
is released.

On 24 August 2011 23:11, Simon Hengel <simon.hengel at wiktory.org> wrote:
> Hello,
> I'm trying to query a type-checked module with syb, this works for a
> plain binding.  But as soon as I add a type signature for that binding,
> I get an "panic!"
>
> I experienced similar problems with a renamed module.
>
> Are those data structures meant to be used with syb?  And if yes, what
> did I miss?
>
> Bellow is some code to reproduce my issue.  Any help is very much
> appreciated.
>
>    -- A.hs
>    module Main where
>
>    import GHC
>    import Outputable
>    import Data.Generics
>    import GHC.Paths (libdir)
>
>    import Bag
>
>    main :: IO ()
>    main = do
>      m <- parse
>      putStrLn $ showSDoc $ ppr $ m
>      putStrLn "\n---\n"
>      putStrLn $ showSDoc $ ppr $ selectAbsBinds m
>
>    parse = runGhc (Just libdir) $ do
>      _ <- getSessionDynFlags >>= setSessionDynFlags
>      target <- guessTarget "B.hs" Nothing
>      setTargets [target]
>      Succeeded <- load LoadAllTargets
>      modSum <- getModSummary $ mkModuleName "B"
>      m <- parseModule modSum >>= typecheckModule
>      return $ typecheckedSource m
>
>    selectAbsBinds :: GenericQ [HsBindLR Id Id]
>    selectAbsBinds = everything (++) ([] `mkQ` f)
>      where
>        f x@(AbsBinds _ _ _ _ _) = [x]
>        f _ = []
>
>
>    -- B.hs
>    module B where
>
>    foo :: Char
>    foo = 'f'
>
> Cheers,
> Simon
>
> _______________________________________________
> Glasgow-haskell-users mailing list
> Glasgow-haskell-users at haskell.org
> http://www.haskell.org/mailman/listinfo/glasgow-haskell-users
>



-- 
Push the envelope. Watch it bend.



More information about the Glasgow-haskell-users mailing list