Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Attempt at fixing https://github.com/nominolo/ghc-syb/issues/13 #14

Open
wants to merge 3 commits into
base: master
Choose a base branch
from
Open

Attempt at fixing https://github.com/nominolo/ghc-syb/issues/13 #14

Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
17fe828
Attempt at fixing https://github.com/nominolo/ghc-syb/issues/13
alanz Oct 30, 2015
0d566bc
Bypass Coercion panic, and work nameList in properly
alanz Nov 1, 2015
3eae91d
Use nameSetElemsStable
alanz Apr 24, 2017
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
35 changes: 34 additions & 1 deletion utils/GHC/SYB/Utils.hs
View file
Open in desktop
Expand Up @@ -185,7 +185,9 @@ import qualified OccName(occNameString)
import Bag(Bag,bagToList)
import Var(Var)
import FastString(FastString)
#if __GLASGOW_HASKELL__ >= 709
#if __GLASGOW_HASKELL__ > 800
import NameSet(NameSet,nameSetElemsStable)
#elif __GLASGOW_HASKELL__ >= 709
import NameSet(NameSet,nameSetElems)
#else
import NameSet(NameSet,nameSetToList)
Expand All @@ -198,6 +200,10 @@ import GHC.SYB.Instances
import Control.Monad
import Data.List

#if __GLASGOW_HASKELL__ <= 708
import Coercion
#endif

#if __GLASGOW_HASKELL__ < 709
nameSetElems :: NameSet -> [Name]
nameSetElems = nameSetToList
Expand All @@ -212,6 +218,7 @@ showSDoc_ = showSDoc
showSDoc_ = showSDoc tracingDynFlags
#endif


-- | Ghc Ast types tend to have undefined holes, to be filled
-- by later compiler phases. We tag Asts with their source,
-- so that we can avoid such holes based on who generated the Asts.
Expand All @@ -229,6 +236,8 @@ showData stage n =
`extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet
#if __GLASGOW_HASKELL__ <= 708
`extQ` postTcType
`extQ` nameList
`extQ` coercion
#endif
`extQ` fixity
where generic :: Data a => a -> String
Expand Down Expand Up @@ -262,11 +271,19 @@ showData stage n =
nameSet | stage `elem` [Parser,TypeChecker]
= const ("{!NameSet placeholder here!}") :: NameSet -> String
| otherwise
#if __GLASGOW_HASKELL__ > 800
= ("{NameSet: "++) . (++"}") . list . nameSetElemsStable
#else
= ("{NameSet: "++) . (++"}") . list . nameSetElems
#endif

#if __GLASGOW_HASKELL__ <= 708
postTcType | stage<TypeChecker = const "{!type placeholder here?!}" :: PostTcType -> String
| otherwise = showSDoc_ . ppr :: Type -> String
nameList | stage<TypeChecker = const "{![Name] placeholder here?!}" :: [Name] -> String
| otherwise = showSDoc_ . ppr :: [Name] -> String
coercion | stage<TypeChecker = const "{!Coercion placeholder here?!}" :: Coercion -> String
| otherwise = showSDoc_ . ppr :: Coercion -> String
#endif
fixity | stage<Renamer = const "{!fixity placeholder here?!}" :: GHC.Fixity -> String
| otherwise = ("{Fixity: "++) . (++"}") . showSDoc_ . ppr :: GHC.Fixity -> String
Expand All @@ -279,12 +296,16 @@ everythingStaged stage k z f x
| (const False
#if __GLASGOW_HASKELL__ <= 708
`extQ` postTcType
`extQ` nameList
`extQ` coercion
#endif
`extQ` fixity `extQ` nameSet) x = z
| otherwise = foldl k (f x) (gmapQ (everythingStaged stage k z f) x)
where nameSet = const (stage `elem` [Parser,TypeChecker]) :: NameSet -> Bool
#if __GLASGOW_HASKELL__ <= 708
postTcType = const (stage<TypeChecker) :: PostTcType -> Bool
nameList = const (stage<TypeChecker) :: [Name] -> Bool
coercion = const (stage<TypeChecker) :: Coercion -> Bool
#endif
fixity = const (stage<Renamer) :: GHC.Fixity -> Bool

Expand All @@ -302,6 +323,8 @@ everythingButStaged stage k z f x
| (const False
#if __GLASGOW_HASKELL__ <= 708
`extQ` postTcType
`extQ` nameList
`extQ` coercion
#endif
`extQ` fixity `extQ` nameSet) x = z
| stop == True = v
Expand All @@ -310,6 +333,8 @@ everythingButStaged stage k z f x
nameSet = const (stage `elem` [Parser,TypeChecker]) :: NameSet -> Bool
#if __GLASGOW_HASKELL__ <= 708
postTcType = const (stage<TypeChecker) :: PostTcType -> Bool
nameList = const (stage<TypeChecker) :: [Name] -> Bool
coercion = const (stage<TypeChecker) :: Coercion -> Bool
#endif
fixity = const (stage<Renamer) :: GHC.Fixity -> Bool

Expand All @@ -333,12 +358,16 @@ somewhereStaged stage f x
| (const False
#if __GLASGOW_HASKELL__ <= 708
`extQ` postTcType
`extQ` nameList
`extQ` coercion
#endif
`extQ` fixity `extQ` nameSet) x = mzero
| otherwise = f x `mplus` gmapMp (somewhereStaged stage f) x
where nameSet = const (stage `elem` [Parser,TypeChecker]) :: NameSet -> Bool
#if __GLASGOW_HASKELL__ <= 708
postTcType = const (stage<TypeChecker) :: PostTcType -> Bool
nameList = const (stage<TypeChecker) :: [Name] -> Bool
coercion = const (stage<TypeChecker) :: Coercion -> Bool
#endif
fixity = const (stage<Renamer) :: GHC.Fixity -> Bool

Expand Down Expand Up @@ -372,13 +401,17 @@ everywhereMStaged stage f x
| (const False
#if __GLASGOW_HASKELL__ <= 708
`extQ` postTcType
`extQ` nameList
`extQ` coercion
#endif
`extQ` fixity `extQ` nameSet) x = return x
| otherwise = do x' <- gmapM (everywhereMStaged stage f) x
f x'
where nameSet = const (stage `elem` [Parser,TypeChecker]) :: NameSet -> Bool
#if __GLASGOW_HASKELL__ <= 708
postTcType = const (stage<TypeChecker) :: PostTcType -> Bool
nameList = const (stage<TypeChecker) :: [Name] -> Bool
coercion = const (stage<TypeChecker) :: Coercion -> Bool
#endif
fixity = const (stage<Renamer) :: GHC.Fixity -> Bool

Expand Down