Changes between Version 2 and Version 3 of GhcApiAstTraversals


Ignore:
Timestamp:
Jul 15, 2008 1:15:32 PM (7 years ago)
Author:
claus
Comment:

updated source files (extract common functions to Utils, avoid potholes based on stage, traverse NameSet and Bag abstractly)

Legend:

Unmodified
Added
Removed
Modified
  • GhcApiAstTraversals

    v2 v3  
    3636- for starters, here's a `Data`-based show that shows the constructors/abstract types instead of pretty-printing them:
    3737{{{
    38 showData :: Data a => Int -> a -> String
    39 showData n = generic `ext1Q` list `extQ` string `extQ` bagName `extQ` bagRdrName
    40                      `extQ` name `extQ` occName `extQ` moduleName `extQ` srcSpan
    41                      `extQ` postTcType `extQ` fixity
     38-- generic Data-based show, with special cases for GHC Ast types,
     39-- showing abstract types abstractly and avoiding known potholes
     40showData :: Data a => Stage -> Int -> a -> String
     41showData stage n =
     42  generic `ext1Q` list `extQ` string `extQ` fastString `extQ` srcSpan
     43          `extQ` name `extQ` occName `extQ` moduleName `extQ` var `extQ` dataCon
     44          `extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet
     45          `extQ` postTcType `extQ` fixity
    4246  where generic :: Data a => a -> String
    4347        generic t = indent n ++ "(" ++ showConstr (toConstr t)
    44                  ++ space (concat (intersperse " " (gmapQ (showData (n+1)) t))) ++ ")"
     48                 ++ space (concat (intersperse " " (gmapQ (showData stage (n+1)) t))) ++ ")"
    4549        space "" = ""
    4650        space s  = ' ':s
    4751        indent n = "\n" ++ replicate n ' '
    4852        string     = show :: String -> String
    49         list l     = indent n ++ "[" ++ concat (intersperse "," (map (showData (n+1)) l)) ++ "]"
     53        fastString = ("{FastString: "++) . (++"}") . show :: FastString -> String
     54        list l     = indent n ++ "["
     55                              ++ concat (intersperse "," (map (showData stage (n+1)) l)) ++ "]"
     56
    5057        name       = ("{Name: "++) . (++"}") . showSDoc . ppr :: Name -> String
    5158        occName    = ("{OccName: "++) . (++"}") .  OccName.occNameString
    5259        moduleName = ("{ModuleName: "++) . (++"}") . showSDoc . ppr :: ModuleName -> String
    5360        srcSpan    = ("{"++) . (++"}") . showSDoc . ppr :: SrcSpan -> String
     61        var        = ("{Var: "++) . (++"}") . showSDoc . ppr :: Var -> String
     62        dataCon    = ("{DataCon: "++) . (++"}") . showSDoc . ppr :: DataCon -> String
     63
    5464        bagRdrName:: Bag (Located (HsBind RdrName)) -> String
    5565        bagRdrName = ("{Bag(Located (HsBind RdrName)): "++) . (++"}") . list . bagToList
    5666        bagName   :: Bag (Located (HsBind Name)) -> String
    5767        bagName    = ("{Bag(Located (HsBind Name)): "++) . (++"}") . list . bagToList
    58         postTcType = const "{!type placeholder here?!}" :: PostTcType -> String
    59         fixity     = const "{!fixity placeholder here?!}" :: GHC.Fixity -> String
     68        bagVar    :: Bag (Located (HsBind Var)) -> String
     69        bagVar     = ("{Bag(Located (HsBind Var)): "++) . (++"}") . list . bagToList
     70
     71        nameSet | stage `elem` [Parser,TypeChecker]
     72                = const ("{!NameSet placeholder here!}") :: NameSet -> String
     73                | otherwise     
     74                = ("{NameSet: "++) . (++"}") . list . nameSetToList
     75
     76        postTcType | stage<TypeChecker = const "{!type placeholder here?!}" :: PostTcType -> String
     77                   | otherwise     = showSDoc . ppr :: Type -> String
     78
     79        fixity | stage<Renamer = const "{!fixity placeholder here?!}" :: GHC.Fixity -> String
     80               | otherwise     = ("{Fixity: "++) . (++"}") . showSDoc . ppr :: GHC.Fixity -> String
    6081}}}
    6182  For example usage, see the attached `APISybTesting`: it parses a `TestModule`, prettyprints and shows, does an identity transform, and an example query (extract classes and family declarations).