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).