feat: Data instances

src/Language/QBE.hs

@@ -4,6 +4,8 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE GADTs #-}
 {-|
 Module      : Language.QBE
 Description : Types and Pretty instances for the QBE IL
@@ -92,6 +94,7 @@ import Prettyprinter
 import Data.Hashable (Hashable)
 import Control.DeepSeq (NFData)
 import Data.String (IsString)
+import Data.Data (Data)
 
 -- * Identifiers
 ----------------
@@ -100,12 +103,12 @@ import Data.String (IsString)
 type RawIdent = ShortText
 
 -- | Sigils are used to differentiate the verious types of 'Ident'ifier.
-data Sigil
-  = AggregateTy -- ^ @:@
-  | Global -- ^ @$@
-  | Temporary -- ^ @%@
-  | Label -- ^ @\@@
-  deriving (Show, Eq)
+data Sigil where
+  AggregateTy :: Sigil
+  Global :: Sigil
+  Temporary :: Sigil
+  Label :: Sigil
+  deriving (Show, Eq, Data)
 
 -- | QBE identifiers. The sigil is represented at the type level, so that
 -- mixing incompatible identifiers is impossible.
@@ -124,7 +127,7 @@ data Sigil
 --       In the second argument of ‘($)’, namely ‘Jmp $ Ident @'Global "a"’
 --       In the expression: pretty $ Jmp $ Ident @'Global "a"
 newtype Ident (t :: Sigil) = Ident RawIdent
-  deriving (Show, Eq, Ord, IsString, NFData, Hashable)
+  deriving (Show, Eq, Ord, IsString, NFData, Hashable, Data)
 
 instance Pretty (Ident 'AggregateTy) where
   pretty (Ident raw) = pretty ':' <> pretty (TS.toText raw)
@@ -144,7 +147,7 @@ data BaseTy
   | Long -- ^ @l@
   | Single -- ^ @s@
   | Double -- ^ @d@
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 instance Pretty BaseTy where
   pretty Word   = pretty 'w'
@@ -157,7 +160,7 @@ data ExtTy
   = BaseTy BaseTy
   | Byte -- ^ @b@
   | HalfWord -- ^ @h@
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 instance Pretty ExtTy where
   pretty (BaseTy baseTy) = pretty baseTy
@@ -174,7 +177,7 @@ data Const
   | CSingle Float -- ^ Single-precision float
   | CDouble Double -- ^ Double-precision float
   | CGlobal (Ident 'Global) -- ^ Global symbol
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 instance Pretty Const where
   pretty (CInt int) = pretty int
@@ -188,7 +191,7 @@ instance Pretty Const where
 data Linkage
   = Export -- ^ Marks the defined item as visible outside the current file's scope
   | Section ShortText (Maybe Text) -- ^ Section name, with optional linker flags
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 instance Pretty Linkage where
   pretty Export = "export"
@@ -210,7 +213,7 @@ type Amount = Word64
 data TypeDef
   = TypeDef (Ident 'AggregateTy) (Maybe Alignment) [(SubTy, Maybe Amount)]
   | Opaque (Ident 'AggregateTy) Alignment Size
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 instance Pretty TypeDef where
   pretty (TypeDef ident alignment def) =
@@ -228,7 +231,7 @@ instance Pretty TypeDef where
 data SubTy
   = SubExtTy ExtTy
   | SubAggregateTy (Ident 'AggregateTy)
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 instance Pretty SubTy where
   pretty (SubExtTy extTy) = pretty extTy
@@ -239,7 +242,7 @@ instance Pretty SubTy where
 
 -- | Global object definition
 data DataDef = DataDef [Linkage] (Ident 'Global) (Maybe Alignment) [Field]
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 instance Pretty DataDef where
   pretty (DataDef linkage ident alignment fields) = vsep
@@ -253,7 +256,7 @@ data DataItem
   = Symbol (Ident 'Global) (Maybe Alignment)
   | String ByteString
   | Const Const
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 instance Pretty DataItem where
   pretty (Symbol ident alignment) =
@@ -264,7 +267,7 @@ instance Pretty DataItem where
 data Field
   = FieldExtTy ExtTy (NonEmpty DataItem)
   | FieldZero Size
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 instance Pretty Field where
   pretty (FieldExtTy extTy items) = pretty extTy <+> hsep (toList $ pretty <$> items)
@@ -276,7 +279,7 @@ instance Pretty Field where
 -- TODO use record syntax on long types like this one
 -- | Function definition. The 'Maybe (Ident \'Temporary)' is the environment
 data FuncDef = FuncDef [Linkage] (Maybe AbiTy) (Ident 'Global) (Maybe (Ident 'Temporary)) [Param] Variadic (NonEmpty Block)
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 instance Pretty FuncDef where
   pretty (FuncDef linkage abiTy ident env params variadic blocks) = vsep
@@ -291,7 +294,7 @@ instance Pretty FuncDef where
     ]
 
 data AbiTy = AbiBaseTy BaseTy | AbiAggregateTy (Ident 'AggregateTy)
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 instance Pretty AbiTy where
   pretty (AbiBaseTy baseTy) = pretty baseTy
@@ -299,14 +302,14 @@ instance Pretty AbiTy where
 
 -- | Function parameter
 data Param = Param AbiTy (Ident 'Temporary)
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 instance Pretty Param where
   pretty (Param abiTy ident) = pretty abiTy <+> pretty ident
 
 -- | Indicates the presence or absence of a variadic marker
 data Variadic = Variadic | NoVariadic
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 -- | 'Variadic' → @Just "..."@
 -- 'NoVariadic' → @Nothing@
@@ -322,7 +325,7 @@ data Val
   = ValConst Const
   | ValTemporary (Ident 'Temporary)
   | ValGlobal (Ident 'Global)
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 instance Pretty Val where
   pretty (ValConst c) = pretty c
@@ -331,7 +334,7 @@ instance Pretty Val where
 
 -- | Block of instructions beginning with a label and ending with a jump
 data Block = Block (Ident 'Label) [Phi] [Inst] Jump
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 instance Pretty Block where
   pretty (Block ident phis insts jump) = hang 4 $ vsep $ concat
@@ -346,7 +349,7 @@ data Jump
   = Jmp (Ident 'Label) -- ^ Unconditional jump
   | Jnz Val (Ident 'Label) (Ident 'Label) -- ^ Conditional jump
   | Ret (Maybe Val) -- ^ Function return
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 instance Pretty Jump where
   pretty (Jmp ident) = "jmp" <+> pretty ident
@@ -362,7 +365,7 @@ instance Pretty Jump where
 -- MAYBE change [PhiArg] to Map (Ident 'Label) Val
 -- | Phi instruction
 data Phi = Phi Assignment [PhiArg]
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 instance Pretty Phi where
   pretty (Phi assignment args) =
@@ -370,7 +373,7 @@ instance Pretty Phi where
 
 -- | Phi instruction argument, associating a 'Val' to a 'Label'
 data PhiArg = PhiArg (Ident 'Label) Val
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 instance Pretty PhiArg where
   pretty (PhiArg label val) = pretty label <+> pretty val
@@ -429,7 +432,7 @@ data Inst
   | VaStart (Ident 'Temporary)
   -- | @vaarg@, fetches the next argument from a variable argument list
   | VaArg Assignment (Ident 'Temporary)
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 instance Pretty Inst where
   pretty (BinaryOp assignment op v1 v2) =
@@ -478,7 +481,7 @@ instance Pretty Inst where
 
 -- | Represents the @%x =t@ part of an instruction.
 data Assignment = Assignment (Ident 'Temporary) BaseTy
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 -- | Infix synonym of 'Assignment'
 pattern (:=) :: Ident 'Temporary -> BaseTy -> Assignment
@@ -489,7 +492,7 @@ instance Pretty Assignment where
 
 -- | Integer representation
 data IntRepr = Signed | Unsigned
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 -- | Binary arithmetic and bit operations
 data BinaryOp
@@ -516,7 +519,7 @@ data BinaryOp
   | Shr
   -- | @shl@
   | Shl
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 instance Pretty BinaryOp where
   pretty Add            = "add"
@@ -548,7 +551,7 @@ data Comparison
   -- Floating point only comparison
   | O -- ^ ordered (no operand is a NaN) (floating point only)
   | Uo -- ^ unordered (at least one operand is a NaN) (floating point only)
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 instance Pretty Comparison where
   pretty Eq = "eq"
@@ -566,7 +569,7 @@ instance Pretty IntRepr where
 
 -- | Function argument
 data Arg = Arg AbiTy Val
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 instance Pretty Arg where
   pretty (Arg abiTy val) = pretty abiTy <+> pretty val
@@ -576,7 +579,7 @@ instance Pretty Arg where
 
 -- | Datatypre representing a QBE IL source file
 data Program = Program [TypeDef] [DataDef] [FuncDef]
-  deriving (Show, Eq)
+  deriving (Show, Eq, Data)
 
 instance Pretty Program where
   pretty (Program typeDefs dataDefs funcDefs) = vsep $ concat