ghc-lib-parser 8.8.2 → 8.8.2.20200205

raw patch · 3 files changed

+224/−3 lines, 3 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• compiler/hsSyn/HsDumpAst.hs +220/−0
• ghc-lib-parser.cabal +3/−2
• ghc-lib/stage0/compiler/build/Parser.hs +1/−1

@@ -0,0 +1,220 @@+{-+(c) The University of Glasgow 2006+(c) The GRASP/AQUA Project, Glasgow University, 1992-1998+-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | Contains a debug function to dump parts of the hsSyn AST. It uses a syb+-- traversal which falls back to displaying based on the constructor name, so+-- can be used to dump anything having a @Data.Data@ instance.++module HsDumpAst (+        -- * Dumping ASTs+        showAstData,+        BlankSrcSpan(..),+    ) where++import GhcPrelude++import Data.Data hiding (Fixity)+import Bag+import BasicTypes+import FastString+import NameSet+import Name+import DataCon+import SrcLoc+import HsSyn+import OccName hiding (occName)+import Var+import Module+import Outputable++import qualified Data.ByteString as B++data BlankSrcSpan = BlankSrcSpan | NoBlankSrcSpan+                  deriving (Eq,Show)++-- | Show a GHC syntax tree. This parameterised because it is also used for+-- comparing ASTs in ppr roundtripping tests, where the SrcSpan's are blanked+-- out, to avoid comparing locations, only structure+showAstData :: Data a => BlankSrcSpan -> a -> SDoc+showAstData b a0 = blankLine $$ showAstData' a0+  where+    showAstData' :: Data a => a -> SDoc+    showAstData' =+      generic+              `ext1Q` list+              `extQ` string `extQ` fastString `extQ` srcSpan+              `extQ` lit `extQ` litr `extQ` litt+              `extQ` bytestring+              `extQ` name `extQ` occName `extQ` moduleName `extQ` var+              `extQ` dataCon+              `extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet+              `extQ` fixity+              `ext2Q` located++      where generic :: Data a => a -> SDoc+            generic t = parens $ text (showConstr (toConstr t))+                                  $$ vcat (gmapQ showAstData' t)++            string :: String -> SDoc+            string     = text . normalize_newlines . show++            fastString :: FastString -> SDoc+            fastString s = braces $+                            text "FastString: "+                         <> text (normalize_newlines . show $ s)++            bytestring :: B.ByteString -> SDoc+            bytestring = text . normalize_newlines . show++            list []    = brackets empty+            list [x]   = brackets (showAstData' x)+            list (x1 : x2 : xs) =  (text "[" <> showAstData' x1)+                                $$ go x2 xs+              where+                go y [] = text "," <> showAstData' y <> text "]"+                go y1 (y2 : ys) = (text "," <> showAstData' y1) $$ go y2 ys++            -- Eliminate word-size dependence+            lit :: HsLit GhcPs -> SDoc+            lit (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s+            lit (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s+            lit (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s+            lit (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s+            lit l                  = generic l++            litr :: HsLit GhcRn -> SDoc+            litr (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s+            litr (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s+            litr (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s+            litr (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s+            litr l                  = generic l++            litt :: HsLit GhcTc -> SDoc+            litt (HsWordPrim   s x) = numericLit "HsWord{64}Prim" x s+            litt (HsWord64Prim s x) = numericLit "HsWord{64}Prim" x s+            litt (HsIntPrim    s x) = numericLit "HsInt{64}Prim"  x s+            litt (HsInt64Prim  s x) = numericLit "HsInt{64}Prim"  x s+            litt l                  = generic l++            numericLit :: String -> Integer -> SourceText -> SDoc+            numericLit tag x s = braces $ hsep [ text tag+                                               , generic x+                                               , generic s ]++            name :: Name -> SDoc+            name nm    = braces $ text "Name: " <> ppr nm++            occName n  =  braces $+                          text "OccName: "+                       <> text (OccName.occNameString n)++            moduleName :: ModuleName -> SDoc+            moduleName m = braces $ text "ModuleName: " <> ppr m++            srcSpan :: SrcSpan -> SDoc+            srcSpan ss = case b of+             BlankSrcSpan -> text "{ ss }"+             NoBlankSrcSpan -> braces $ char ' ' <>+                             (hang (ppr ss) 1+                                   -- TODO: show annotations here+                                   (text ""))++            var  :: Var -> SDoc+            var v      = braces $ text "Var: " <> ppr v++            dataCon :: DataCon -> SDoc+            dataCon c  = braces $ text "DataCon: " <> ppr c++            bagRdrName:: Bag (Located (HsBind GhcPs)) -> SDoc+            bagRdrName bg =  braces $+                             text "Bag(Located (HsBind GhcPs)):"+                          $$ (list . bagToList $ bg)++            bagName   :: Bag (Located (HsBind GhcRn)) -> SDoc+            bagName bg  =  braces $+                           text "Bag(Located (HsBind Name)):"+                        $$ (list . bagToList $ bg)++            bagVar    :: Bag (Located (HsBind GhcTc)) -> SDoc+            bagVar bg  =  braces $+                          text "Bag(Located (HsBind Var)):"+                       $$ (list . bagToList $ bg)++            nameSet ns =  braces $+                          text "NameSet:"+                       $$ (list . nameSetElemsStable $ ns)++            fixity :: Fixity -> SDoc+            fixity fx =  braces $+                         text "Fixity: "+                      <> ppr fx++            located :: (Data b,Data loc) => GenLocated loc b -> SDoc+            located (L ss a) = parens $+                   case cast ss of+                        Just (s :: SrcSpan) ->+                          srcSpan s+                        Nothing -> text "nnnnnnnn"+                      $$ showAstData' a++normalize_newlines :: String -> String+normalize_newlines ('\\':'r':'\\':'n':xs) = '\\':'n':normalize_newlines xs+normalize_newlines (x:xs)                 = x:normalize_newlines xs+normalize_newlines []                     = []++{-+************************************************************************+*                                                                      *+* Copied from syb+*                                                                      *+************************************************************************+-}+++-- | The type constructor for queries+newtype Q q x = Q { unQ :: x -> q }++-- | Extend a generic query by a type-specific case+extQ :: ( Typeable a+        , Typeable b+        )+     => (a -> q)+     -> (b -> q)+     -> a+     -> q+extQ f g a = maybe (f a) g (cast a)++-- | Type extension of queries for type constructors+ext1Q :: (Data d, Typeable t)+      => (d -> q)+      -> (forall e. Data e => t e -> q)+      -> d -> q+ext1Q def ext = unQ ((Q def) `ext1` (Q ext))+++-- | Type extension of queries for type constructors+ext2Q :: (Data d, Typeable t)+      => (d -> q)+      -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q)+      -> d -> q+ext2Q def ext = unQ ((Q def) `ext2` (Q ext))++-- | Flexible type extension+ext1 :: (Data a, Typeable t)+     => c a+     -> (forall d. Data d => c (t d))+     -> c a+ext1 def ext = maybe def id (dataCast1 ext)++++-- | Flexible type extension+ext2 :: (Data a, Typeable t)+     => c a+     -> (forall d1 d2. (Data d1, Data d2) => c (t d1 d2))+     -> c a+ext2 def ext = maybe def id (dataCast2 ext)

@@ -1,7 +1,7 @@ cabal-version: >=1.22 build-type: Simple name: ghc-lib-parser-version: 8.8.2+version: 8.8.2.20200205 license: BSD3 license-file: LICENSE category: Development@@ -53,7 +53,7 @@     compiler/Unique.h     compiler/nativeGen/NCG.h     compiler/utils/md5.h-tested-with: GHC==8.8.1, GHC==8.6.5, GHC==8.4.3+tested-with: GHC==8.8.2, GHC==8.6.5, GHC==8.4.4 source-repository head     type: git     location: git@github.com:digital-asset/ghc-lib.git@@ -239,6 +239,7 @@         HsBinds         HsDecls         HsDoc+        HsDumpAst         HsExpr         HsExtension         HsImpExp

@@ -12532,7 +12532,7 @@   {-# LINE 19 "<built-in>" #-}-{-# LINE 1 "/var/folders/kc/bjk2hzwx6bv07jz_s80wjh7w0000gn/T/ghc6627_0/ghc_2.h" #-}+{-# LINE 1 "/var/folders/kc/bjk2hzwx6bv07jz_s80wjh7w0000gn/T/ghc32763_0/ghc_2.h" #-}