Pretty instances for data definitions
This commit is contained in:
3
golden/data.qbe
Normal file
3
golden/data.qbe
Normal file
@@ -0,0 +1,3 @@
|
|||||||
|
export
|
||||||
|
data $d = align 8
|
||||||
|
{z 16, b $g + 32 "foo\nbar\NULbaz" -1}
|
||||||
@@ -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
|
||||||
---------------
|
---------------
|
||||||
|
|
||||||
|
|||||||
@@ -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"
|
||||||
|
|||||||
Reference in New Issue
Block a user