Pretty instances for data definitions

This commit is contained in:
Francesco Gazzetta
2022-07-02 12:05:42 +02:00
parent 8f9652e28e
commit 24e3d4ad06
3 changed files with 30 additions and 3 deletions

3
golden/data.qbe Normal file
View File

@@ -0,0 +1,3 @@
export
data $d = align 8
{z 16, b $g + 32 "foo\nbar\NULbaz" -1}

View File

@@ -10,9 +10,10 @@ import Data.Text.Short (ShortText)
import qualified Data.Text.Short as TS import qualified Data.Text.Short as TS
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.Word (Word64) import Data.Word (Word64)
import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty (NonEmpty, toList)
import Data.Maybe (maybeToList)
import Prettyprinter import Prettyprinter
( Pretty(pretty), (<+>) ( Pretty(pretty), (<+>), vsep, hsep
, space, encloseSep, lbrace, rbrace, comma, equals, braces ) , space, encloseSep, lbrace, rbrace, comma, equals, braces )
-- Instances -- Instances
import Data.Hashable (Hashable) import Data.Hashable (Hashable)
@@ -152,17 +153,35 @@ instance Pretty SubTy where
data DataDef = DataDef [Linkage] (Ident 'Global) (Maybe Alignment) [Field] data DataDef = DataDef [Linkage] (Ident 'Global) (Maybe Alignment) [Field]
deriving (Show, Eq) deriving (Show, Eq)
instance Pretty DataDef where
pretty (DataDef linkage ident alignment fields) = vsep
[ vsep $ pretty <$> linkage
, hsep $ ("data" <+> pretty ident <+> equals)
: maybeToList (("align" <+>) . pretty <$> alignment)
, encloseSep lbrace rbrace (comma <> space) (pretty <$> fields)
]
data DataItem data DataItem
= Symbol (Ident 'Global) Alignment = Symbol (Ident 'Global) (Maybe Alignment)
| String ByteString | String ByteString
| Const Const | Const Const
deriving (Show, Eq) deriving (Show, Eq)
instance Pretty DataItem where
pretty (Symbol ident alignment) =
hsep $ pretty ident : maybeToList ((pretty '+' <+>) . pretty <$> alignment)
pretty (String bs) = pretty $ show bs -- HACK: hoping that the escape sequences are the same...
pretty (Const c) = pretty c
data Field data Field
= FieldExtTy ExtTy (NonEmpty DataItem) = FieldExtTy ExtTy (NonEmpty DataItem)
| FieldZero Size | FieldZero Size
deriving (Show, Eq) deriving (Show, Eq)
instance Pretty Field where
pretty (FieldExtTy extTy items) = pretty extTy <+> hsep (toList $ pretty <$> items)
pretty (FieldZero size) = pretty 'z' <+> pretty size
-- ** Functions -- ** Functions
--------------- ---------------

View File

@@ -11,6 +11,7 @@ import Test.Tasty.Silver (goldenVsAction)
import System.FilePath ((</>), (<.>)) import System.FilePath ((</>), (<.>))
import Prettyprinter (Pretty(pretty), layoutPretty, defaultLayoutOptions) import Prettyprinter (Pretty(pretty), layoutPretty, defaultLayoutOptions)
import Prettyprinter.Render.Text (renderStrict) import Prettyprinter.Render.Text (renderStrict)
import Data.List.NonEmpty (NonEmpty((:|)))
data P = forall a. Pretty a => P a data P = forall a. Pretty a => P a
@@ -42,6 +43,10 @@ goldenTests = testGroup "golden tests"
, (SubAggregateTy "t1", Nothing) , (SubAggregateTy "t1", Nothing)
] ]
, t "opaque" $ Opaque "t" 8 16 , t "opaque" $ Opaque "t" 8 16
, t "data" $ DataDef [Export] "d" (Just 8)
[ FieldZero 16
, FieldExtTy Byte $ Symbol "g" (Just 32) :| [String "foo\nbar\0baz", Const $ CInt True 1]
]
, t "val" [ValConst (CInt False 0), ValTemporary "temporary", ValGlobal "global"] , t "val" [ValConst (CInt False 0), ValTemporary "temporary", ValGlobal "global"]
, t "jmp" $ Jmp "target" , t "jmp" $ Jmp "target"
, t "jnz" $ Jnz (ValConst $ CInt False 0) "target1" "target2" , t "jnz" $ Jnz (ValConst $ CInt False 0) "target1" "target2"