ghc-syb-utils-0.3.0.0/0000755000000000000000000000000013333102765012533 5ustar0000000000000000ghc-syb-utils-0.3.0.0/LICENSE0000644000000000000000000000272613333102765013547 0ustar0000000000000000Copyright 2008, Claus Reinke All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: - Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. - Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. - Neither name of the author nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ghc-syb-utils-0.3.0.0/Setup.hs0000644000000000000000000000012513333102765014165 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main :: IO () main = defaultMainghc-syb-utils-0.3.0.0/ghc-syb-utils.cabal0000644000000000000000000000145713333102765016220 0ustar0000000000000000name: ghc-syb-utils version: 0.3.0.0 license: BSD3 license-file: LICENSE author: Claus Reinke copyright: (c) Claus Reinke 2008 maintainer: Daniel Gröber homepage: https://github.com/DanielG/ghc-syb description: Scrap Your Boilerplate utilities for the GHC API. synopsis: Scrap Your Boilerplate utilities for the GHC API. category: Development stability: provisional build-type: Simple cabal-version: >= 1.10 library build-depends: base >= 4 && < 5 , syb >= 0.1.0 , ghc >= 7.10 && < 8.6 , bytestring hs-source-dirs: . default-language: Haskell2010 default-extensions: Rank2Types, CPP ghc-options: -Wall exposed-modules: GHC.SYB.Utils ghc-syb-utils-0.3.0.0/GHC/0000755000000000000000000000000013333102765013134 5ustar0000000000000000ghc-syb-utils-0.3.0.0/GHC/SYB/0000755000000000000000000000000013333102765013571 5ustar0000000000000000ghc-syb-utils-0.3.0.0/GHC/SYB/Utils.hs0000644000000000000000000001055413333102765015232 0ustar0000000000000000{-# 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. -} module GHC.SYB.Utils where import Data.Generics import PprTyThing() import GHC hiding (moduleName) import SrcLoc() #if __GLASGOW_HASKELL__ >= 802 import NameSet(NameSet) #elif __GLASGOW_HASKELL__ >= 709 import NameSet(NameSet) #endif import Control.Monad -- | 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. data Stage = Parser | Renamer | TypeChecker deriving (Eq,Ord,Show) -- | Like 'everything', but avoid known potholes, based on the 'Stage' that -- generated the Ast. everythingStaged :: Stage -> (r -> r -> r) -> r -> GenericQ r -> GenericQ r everythingStaged stage k z f x | (const False `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 fixity = const (stage Bool -- | A variation of 'everything', using a 'GenericQ Bool' to skip -- parts of the input 'Data'. --everythingBut :: GenericQ Bool -> (r -> r -> r) -> r -> GenericQ r -> GenericQ r --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` 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 fixity = const (stage 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` fixity `extQ` nameSet) x = mzero | otherwise = f x `mplus` gmapMp (somewhereStaged stage f) x where nameSet = const (stage `elem` [Parser,TypeChecker]) :: NameSet -> Bool fixity = const (stage 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 Bool fixity = const (stage 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` 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 fixity = const (stage Bool