From e61853e7a6895cfd3e57890007ef986130834066 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Madeleine=20Sydney=20=C5=9Alaga?= Date: Thu, 30 Apr 2026 17:36:59 -0600 Subject: [PATCH] feat: Data instances --- src/Language/QBE.hs | 67 +++++++++++++++++++++++---------------------- 1 file changed, 35 insertions(+), 32 deletions(-) diff --git a/src/Language/QBE.hs b/src/Language/QBE.hs index 77ad7be..00c137d 100644 --- a/src/Language/QBE.hs +++ b/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