Replace Pretty with custom PPretty class

`bsc` uses separate classes for pretty-printing class syntax (`PPretty`) and Bluespec SystemVerilog syntax (`PVPrint`). Now that we are aiming to support both syntaxes, we can no longer just use `Pretty` for everything. This patch swaps out `Pretty` for `PPretty` in anticipation of adding `PVPrint` in a separate commit.
GaloisInc · Oct 18, 2023 · 023cc49 · 023cc49
1 parent ea54740
commit 023cc49
Show file tree

Hide file tree

Showing 14 changed files with 507 additions and 453 deletions.
diff --git a/language-bluespec.cabal b/language-bluespec.cabal
@@ -46,6 +46,7 @@ library
                         Language.Bluespec.Classic.AST.Literal
                         Language.Bluespec.Classic.AST.Position
                         Language.Bluespec.Classic.AST.Pragma
+                        Language.Bluespec.Classic.AST.Pretty
                         Language.Bluespec.Classic.AST.SchedInfo
                         Language.Bluespec.Classic.AST.SString
                         Language.Bluespec.Classic.AST.Syntax

diff --git a/src/Language/Bluespec/Classic/AST/Builtin/Types.hs b/src/Language/Bluespec/Classic/AST/Builtin/Types.hs
@@ -4,9 +4,9 @@ module Language.Bluespec.Classic.AST.Builtin.Types where
 import Language.Bluespec.Classic.AST.Builtin.Ids
 import Language.Bluespec.Classic.AST.Id
 import Language.Bluespec.Classic.AST.Position
+import Language.Bluespec.Classic.AST.Pretty
 import Language.Bluespec.Classic.AST.Type
 import Language.Bluespec.Prelude
-import Language.Bluespec.Pretty
 
 infixr 4 `fn`
 

diff --git a/src/Language/Bluespec/Classic/AST/FString.hs b/src/Language/Bluespec/Classic/AST/FString.hs
@@ -8,8 +8,8 @@ module Language.Bluespec.Classic.AST.FString
 
 import Data.String (IsString(..))
 import qualified Data.Text as T
-import Text.PrettyPrint.HughesPJClass
 
+import Language.Bluespec.Classic.AST.Pretty
 import Language.Bluespec.Classic.AST.SString
 import Language.Bluespec.Prelude
 
@@ -24,8 +24,8 @@ instance IsString FString where
 instance Show FString where
     show (FString s) = show s
 
-instance Pretty FString where
-    pPrintPrec _ _ x = text (show x)
+instance PPrint FString where
+    pPrint _ _ x = text (show x)
 
 getFString :: FString -> String
 getFString = toString

diff --git a/src/Language/Bluespec/Classic/AST/Id.hs b/src/Language/Bluespec/Classic/AST/Id.hs
@@ -28,14 +28,13 @@ module Language.Bluespec.Classic.AST.Id
 
 import Data.Char (isDigit)
 import qualified Data.List as L
-import Text.PrettyPrint.HughesPJClass
 
 import Language.Bluespec.Classic.AST.Builtin.FStrings
 import Language.Bluespec.Classic.AST.FString
 import Language.Bluespec.Classic.AST.Position
+import Language.Bluespec.Classic.AST.Pretty
 import Language.Bluespec.Lex
 import Language.Bluespec.Prelude
-import Language.Bluespec.Pretty
 import Language.Bluespec.Util
 
 data Id = Id { id_pos :: !Position,
@@ -62,9 +61,9 @@ instance Ord Id where
 instance Show Id where
     show = show_brief
 
-instance Pretty Id where
-    pPrintPrec d _p i
-      | d == pdDebug
+instance PPrint Id where
+    pPrint d _p i
+      | d == PDDebug
       = text (local_show i)
       | otherwise
       = if (dbgLevel >= 1)
@@ -151,8 +150,8 @@ mkQId pos mfs fs
 
 ppConId :: PDetail -> Id -> Doc
 ppConId d i
-  | d == pdDebug
-  = pPrintPrec pdDebug 0 i
+  | d == PDDebug
+  = pPrint PDDebug 0 i
   | otherwise
   = -- text ( "props:" ++ show (getIdProps i)) <>
     case (getIdBaseString i) of
@@ -162,8 +161,8 @@ ppConId d i
 
 ppId :: PDetail -> Id -> Doc
 ppId d i
-  | d == pdDebug
-  = pPrintPrec pdDebug 0 i
+  | d == PDDebug
+  = pPrint PDDebug 0 i
   | otherwise
   = if (dbgLevel >= 1)
     then case (getIdBaseString i) of
@@ -181,8 +180,8 @@ ppId d i
 
 ppVarId :: PDetail -> Id -> Doc
 ppVarId d i
-  | d == pdDebug
-  = pPrintPrec pdDebug 0 i
+  | d == PDDebug
+  = pPrint PDDebug 0 i
   | otherwise
   = if (dbgLevel >= 1)
     then case (getIdBaseString i) of
@@ -249,10 +248,10 @@ data IdProp = IdPCanFire
               | IdPParserGenerated
         deriving (Eq, Ord, Show)
 
-instance Pretty IdProp where
-    pPrintPrec d _ (IdPInlinedPositions poss) =
-        pparen True (text "IdPInlinedPositions" <+> pPrintPrec d 0 poss)
-    pPrintPrec _ _ prop = text (show prop)
+instance PPrint IdProp where
+    pPrint d _ (IdPInlinedPositions poss) =
+        pparen True (text "IdPInlinedPositions" <+> pPrint d 0 poss)
+    pPrint _ _ prop = text (show prop)
 
 -- #############################################################################
 -- # Methods for adding properties to Id's, checking for them etc.

diff --git a/src/Language/Bluespec/Classic/AST/IntLit.hs b/src/Language/Bluespec/Classic/AST/IntLit.hs
@@ -9,8 +9,7 @@ module Language.Bluespec.Classic.AST.IntLit
   , ilSizedBin
   ) where
 
-import Text.PrettyPrint.HughesPJClass
-
+import Language.Bluespec.Classic.AST.Pretty
 import Language.Bluespec.IntegerUtil
 import Language.Bluespec.Prelude
 
@@ -34,8 +33,8 @@ instance Show IntLit where
          -- width of 0 means don't pad with leading zeros
          integerFormatPref 0 b i ++ s
 
-instance Pretty IntLit where
-     pPrintPrec _d _p i = text (show i)
+instance PPrint IntLit where
+     pPrint _d _p i = text (show i)
 
 ilDec :: Integer -> IntLit
 ilDec i = IntLit { ilWidth = Nothing, ilBase = 10, ilValue = i }

diff --git a/src/Language/Bluespec/Classic/AST/Literal.hs b/src/Language/Bluespec/Classic/AST/Literal.hs
@@ -3,9 +3,8 @@ module Language.Bluespec.Classic.AST.Literal
   ( Literal(..)
   ) where
 
-import Text.PrettyPrint.HughesPJClass
-
 import Language.Bluespec.Classic.AST.IntLit
+import Language.Bluespec.Classic.AST.Pretty
 import Language.Bluespec.Prelude
 
 data Literal
@@ -16,9 +15,9 @@ data Literal
         | LPosition -- a position literal is a placeholder for the position in CLiteral
         deriving (Eq, Ord, Show)
 
-instance Pretty Literal where
-    pPrintPrec _ _ (LString s) = text (show s)
-    pPrintPrec _ _ (LChar c) = text (show c)
-    pPrintPrec d p (LInt i) = pPrintPrec d p i
-    pPrintPrec d p (LReal r) = pPrintPrec d p r
-    pPrintPrec _ _ LPosition = text ("<Position>")
+instance PPrint Literal where
+    pPrint _ _ (LString s) = text (show s)
+    pPrint _ _ (LChar c) = text (show c)
+    pPrint d p (LInt i) = pPrint d p i
+    pPrint d p (LReal r) = pPrint d p r
+    pPrint _ _ LPosition = text ("<Position>")
diff --git a/src/Language/Bluespec/Classic/AST/Position.hs b/src/Language/Bluespec/Classic/AST/Position.hs
@@ -8,16 +8,15 @@ module Language.Bluespec.Classic.AST.Position
   , HasPosition(..)
   ) where
 
-import Text.PrettyPrint.HughesPJClass
-
+import Language.Bluespec.Classic.AST.Pretty
 import Language.Bluespec.Prelude
 
 -- For now, we don't track positions, although we may do so in the future.
 data Position = NoPos
   deriving (Eq, Ord, Show)
 
-instance Pretty Position where
-    pPrintPrec _ _ NoPos = text "<NoPos>"
+instance PPrint Position where
+    pPrint _ _ NoPos = text "<NoPos>"
 
 bestPosition :: Position -> Position -> Position
 bestPosition p1 p2 = if p1 == noPosition then p2 else p1