ghc-syb-utils 0.2.1.2 → 0.2.2

raw patch · 2 files changed

+79/−1 lines, 2 files

Files

• GHC/SYB/Utils.hs +78/−0
• ghc-syb-utils.cabal +1/−1

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes #-} {- | "GHC.Syb.Utils" provides common utilities for the Ghc Api,      either based on Data\/Typeable or for use with Data.Generics      over Ghc Api types.@@ -190,6 +191,7 @@ import GHC.SYB.Instances #endif  +import Control.Monad import Data.List  showSDoc_ :: SDoc -> String@@ -214,6 +216,7 @@ showData stage n =    generic `ext1Q` list `extQ` string `extQ` fastString `extQ` srcSpan            `extQ` name `extQ` occName `extQ` moduleName `extQ` var `extQ` dataCon+          `extQ` overLit           `extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet           `extQ` postTcType `extQ` fixity   where generic :: Data a => a -> String@@ -234,6 +237,9 @@         var        = ("{Var: "++) . (++"}") . showSDoc_ . ppr :: Var -> String         dataCon    = ("{DataCon: "++) . (++"}") . showSDoc_ . ppr :: DataCon -> String +        overLit :: (HsOverLit RdrName) -> String+        overLit    = ("{HsOverLit:"++) . (++"}") . showSDoc_ . ppr+         bagRdrName:: Bag (Located (HsBind RdrName)) -> String         bagRdrName = ("{Bag(Located (HsBind RdrName)): "++) . (++"}") . list . bagToList          bagName   :: Bag (Located (HsBind Name)) -> String@@ -268,3 +274,75 @@ --everythingBut q k z f x  --  | q x       = z --  | otherwise = foldl k (f x) (gmapQ (everythingBut q k z f) x)+++-- Question: how to handle partial results in the otherwise step?+everythingButStaged :: Stage -> (r -> r -> r) -> r -> GenericQ (r,Bool) -> GenericQ r+everythingButStaged stage k z f x+  | (const False `extQ` postTcType `extQ` fixity `extQ` nameSet) x = z+  | stop == True = v+  | otherwise = foldl k v (gmapQ (everythingButStaged stage k z f) x)+  where (v, stop) = f x+        nameSet    = const (stage `elem` [Parser,TypeChecker]) :: NameSet -> Bool+        postTcType = const (stage<TypeChecker)                 :: PostTcType -> Bool+        fixity     = const (stage<Renamer)                     :: GHC.Fixity -> Bool++-- | Look up a subterm by means of a maybe-typed filter.+somethingStaged :: Stage -> (Maybe u) -> GenericQ (Maybe u) -> GenericQ (Maybe u)++-- "something" can be defined in terms of "everything"+-- when a suitable "choice" operator is used for reduction+--+somethingStaged stage z = everythingStaged stage orElse z+++-- | Apply a monadic transformation at least somewhere.+--+-- The transformation is tried in a top-down manner and descends down if it+-- fails to apply at the root of the term.  If the transformation fails to apply+-- anywhere within the the term, the whole operation fails.+somewhereStaged :: MonadPlus m => Stage -> GenericM m -> GenericM m++somewhereStaged stage f x+  | (const False `extQ` postTcType `extQ` fixity `extQ` nameSet) x = mzero+  | otherwise = f x `mplus` gmapMp (somewhereStaged stage f) x+  where nameSet    = const (stage `elem` [Parser,TypeChecker]) :: NameSet -> Bool+        postTcType = const (stage<TypeChecker)                 :: PostTcType -> Bool+        fixity     = const (stage<Renamer)                     :: GHC.Fixity -> Bool++-- ---------------------------------------------------------------------++{-+-- | Apply a transformation everywhere in bottom-up manner+-- Note type GenericT = forall a. Data a => a -> a+everywhereStaged :: Stage+                    -> (forall a. Data a => a -> a)+                    -> (forall a. Data a => a -> a)++-- Use gmapT to recurse into immediate subterms;+-- recall: gmapT preserves the outermost constructor;+-- post-process recursively transformed result via f+--+everywhereStaged stage f -- = f . gmapT (everywhere f)+  | (const False `extQ` postTcType `extQ` fixity `extQ` nameSet) = mzero+  | otherwise = f . gmapT (everywhere stage f)+  where nameSet    = const (stage `elem` [Parser,TypeChecker]) :: NameSet -> Bool+        postTcType = const (stage<TypeChecker)                 :: PostTcType -> Bool+        fixity     = const (stage<Renamer)                     :: GHC.Fixity -> Bool+-}+++-- | Monadic variation on everywhere+everywhereMStaged :: Monad m => Stage -> GenericM m -> GenericM m++-- Bottom-up order is also reflected in order of do-actions+everywhereMStaged stage f x+  | (const False `extQ` postTcType `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+        postTcType = const (stage<TypeChecker)                 :: PostTcType -> Bool+        fixity     = const (stage<Renamer)                     :: GHC.Fixity -> Bool+++

@@ -1,5 +1,5 @@ name:            ghc-syb-utils-version:         0.2.1.2+version:         0.2.2 license:         BSD3 license-file:    LICENSE author:          Claus Reinke