1-- SPDX-FileCopyrightText: 2025-2026 Sören Tempel <soeren+git@soeren-tempel.net>2--3-- SPDX-License-Identifier: GPL-3.0-only45module Language.QBE.Types6 ( -- * Identifiers7 UserIdent (..),8 LocalIdent (..),9 BlockIdent (..),10 GlobalIdent (..),1112 -- * Types13 BaseType (..),14 baseTypeByteSize,15 baseTypeBitSize,16 ExtType (..),17 extTypeBitSize,18 extTypeByteSize,19 SubWordType (..),20 SubType (..),21 LoadType (..),22 loadByteSize,2324 -- * Values25 Const (..),26 DynConst (..),27 Value (..),2829 -- * Definitions30 TypeDef (..),31 DataDef (..),32 Linkage (..),33 Field,34 AggType (..),35 dataSize,36 DataObj (..),37 objAlign,38 objSize,39 DataItem (..),40 JumpInstr (..),4142 -- * Functions43 FuncDef (..),44 FuncParam (..),45 FuncArg (..),46 Abity (..),47 abityToBase,48 Block (..),49 fEntry,5051 -- * Instructions52 Statement (..),53 Instr (..),54 VolatileInstr (..),55 ExtArg (..),56 toExtType,57 FloatArg (..),58 f2BaseType,59 IntArg (..),60 i2BaseType,61 IntCmpOp (..),62 FloatCmpOp (..),63 Phi (..),64 AllocSize (..),65 getSize,66 )67where6869import Data.Map (Map)70import Data.Map qualified as Map71import Data.Maybe (fromJust)72import Data.Word (Word64)7374-- TODO: Prefix all constructors7576newtype UserIdent = UserIdent {userIdent :: String}77 deriving (Eq, Ord)7879instance Show UserIdent where80 show (UserIdent s) = ':' : s8182newtype LocalIdent = LocalIdent {localIdent :: String}83 deriving (Eq, Ord)8485instance Show LocalIdent where86 show (LocalIdent s) = '%' : s8788newtype BlockIdent = BlockIdent {blockIdent :: String}89 deriving (Eq, Ord)9091instance Show BlockIdent where92 show (BlockIdent s) = '@' : s9394newtype GlobalIdent = GlobalIdent {globalIdent :: String}95 deriving (Eq, Ord)9697instance Show GlobalIdent where98 show (GlobalIdent s) = '$' : s99100------------------------------------------------------------------------101102data BaseType103 = Word104 | Long105 | Single106 | Double107 deriving (Show, Eq)108109baseTypeByteSize :: BaseType -> Int110baseTypeByteSize Word = 4111baseTypeByteSize Long = 8112baseTypeByteSize Single = 4113baseTypeByteSize Double = 8114115baseTypeBitSize :: BaseType -> Int116baseTypeBitSize ty = baseTypeByteSize ty * 8117118data ExtType119 = Base BaseType120 | Byte121 | HalfWord122 deriving (Show, Eq)123124extTypeByteSize :: ExtType -> Int125extTypeByteSize (Base b) = baseTypeByteSize b126extTypeByteSize Byte = 1127extTypeByteSize HalfWord = 2128129extTypeBitSize :: ExtType -> Int130extTypeBitSize ty = extTypeByteSize ty * 8131132data SubWordType133 = SignedByte134 | UnsignedByte135 | SignedHalf136 | UnsignedHalf137 deriving (Show, Eq)138139data Abity140 = ABase BaseType141 | ASubWordType SubWordType142 | AUserDef UserIdent143 deriving (Show, Eq)144145abityToBase :: Abity -> BaseType146-- Calls with a sub-word return type define a temporary of base type147-- w with its most significant bits unspecified.148abityToBase (ASubWordType _) = Word149-- When an aggregate type is used as argument type or return type, the150-- value respectively passed or returned needs to be a pointer to a151-- memory location holding the value.152abityToBase (AUserDef _) = Long153abityToBase (ABase ty) = ty154155data Const156 = Number Word64157 | SFP Float158 | DFP Double159 | Global GlobalIdent160 deriving (Show, Eq)161162data DynConst163 = Const Const164 | Thread GlobalIdent165 | Extern GlobalIdent166 | ExternThread GlobalIdent167 deriving (Show, Eq)168169data Value170 = VConst DynConst171 | VLocal LocalIdent172 deriving (Show, Eq)173174data Linkage175 = LExport176 | LThread177 | LSection String (Maybe String)178 deriving (Show, Eq)179180data AllocSize181 = AllocWord182 | AllocLong183 | AllocLongLong184 deriving (Show, Eq)185186getSize :: AllocSize -> Int187getSize AllocWord = 4188getSize AllocLong = 8189getSize AllocLongLong = 16190191data TypeDef192 = TypeDef193 { aggName :: UserIdent,194 aggAlign :: Maybe Word64,195 aggType :: AggType196 }197 deriving (Show, Eq)198199data SubType200 = SExtType ExtType201 | SUserDef UserIdent202 deriving (Show, Eq)203204type Field = (SubType, Maybe Word64)205206-- TODO: Type for tuple207data AggType208 = ARegular [Field]209 | AUnion [[Field]]210 | AOpaque Word64211 deriving (Show, Eq)212213data DataDef214 = DataDef215 { linkage :: [Linkage],216 name :: GlobalIdent,217 align :: Maybe Word64,218 objs :: [DataObj]219 }220 deriving (Show, Eq)221222dataSize :: DataDef -> Int223dataSize dataDef =224 sum $ map objSize (objs dataDef)225226data DataObj227 = OItem ExtType [DataItem]228 | OZeroFill Word64229 deriving (Show, Eq)230231objAlign :: DataObj -> Word64232objAlign (OZeroFill _) = 1 :: Word64233objAlign (OItem ty _) = fromIntegral $ extTypeByteSize ty234235objSize :: DataObj -> Int236objSize (OZeroFill n) = fromIntegral n237objSize (OItem ty items) = extTypeByteSize ty * cnt items238 where239 cnt :: [DataItem] -> Int240 cnt [] = 0241 cnt ((DString s) : xs) = length s + cnt xs242 cnt (_ : xs) = 1 + cnt xs243244data DataItem245 = DSymOff GlobalIdent Word64246 | DString String247 | DConst Const248 deriving (Show, Eq)249250data FuncDef251 = FuncDef252 { fLinkage :: [Linkage],253 fName :: GlobalIdent,254 fStart :: BlockIdent,255 fAbity :: Maybe Abity,256 fParams :: [FuncParam],257 fBlock :: Map BlockIdent Block258 }259 deriving (Show, Eq)260261fEntry :: FuncDef -> Block262fEntry func = fromJust $ Map.lookup (fStart func) (fBlock func)263264data FuncParam265 = Regular Abity LocalIdent266 | Env LocalIdent267 | Variadic268 deriving (Show, Eq)269270data FuncArg271 = ArgReg Abity Value272 | ArgEnv Value273 | ArgVar274 deriving (Show, Eq)275276data JumpInstr277 = Jump BlockIdent278 | Jnz Value BlockIdent BlockIdent279 | Return (Maybe Value)280 | Halt281 deriving (Show, Eq)282283data LoadType284 = LSubWord SubWordType285 | LBase BaseType286 deriving (Show, Eq)287288-- TODO: Could/Should define this on ExtType instead.289loadByteSize :: LoadType -> Word64290loadByteSize (LSubWord UnsignedByte) = 1291loadByteSize (LSubWord SignedByte) = 1292loadByteSize (LSubWord SignedHalf) = 2293loadByteSize (LSubWord UnsignedHalf) = 2294loadByteSize (LBase Word) = 4295loadByteSize (LBase Long) = 8296loadByteSize (LBase Single) = 4297loadByteSize (LBase Double) = 8298299data ExtArg300 = ExtSingle301 | ExtSubWord SubWordType302 | ExtSignedWord303 | ExtUnsignedWord304 deriving (Show, Eq)305306toExtType :: ExtArg -> (Bool, ExtType)307toExtType (ExtSubWord SignedByte) = (True, Byte)308toExtType (ExtSubWord UnsignedByte) = (False, Byte)309toExtType (ExtSubWord SignedHalf) = (True, HalfWord)310toExtType (ExtSubWord UnsignedHalf) = (False, HalfWord)311toExtType ExtSignedWord = (True, Base Word)312toExtType ExtUnsignedWord = (False, Base Word)313toExtType ExtSingle = (True, Base Single)314315data FloatArg = FDouble | FSingle316 deriving (Show, Eq)317318f2BaseType :: FloatArg -> BaseType319f2BaseType FSingle = Single320f2BaseType FDouble = Double321322data IntArg = IWord | ILong323 deriving (Show, Eq)324325i2BaseType :: IntArg -> BaseType326i2BaseType IWord = Word327i2BaseType ILong = Long328329-- TODO: Distinict types for floating point comparison?330data IntCmpOp331 = IEq332 | INe333 | ISle334 | ISlt335 | ISge336 | ISgt337 | IUle338 | IUlt339 | IUge340 | IUgt341 deriving (Show, Eq)342343data FloatCmpOp344 = FEq345 | FNe346 | FLe347 | FLt348 | FGe349 | FGt350 | FOrd351 | FUnord352 deriving (Show, Eq)353354data Instr355 = Add Value Value356 | Sub Value Value357 | Div Value Value358 | Mul Value Value359 | Neg Value360 | URem Value Value361 | Rem Value Value362 | UDiv Value Value363 | Or Value Value364 | Xor Value Value365 | And Value Value366 | Sar Value Value367 | Shr Value Value368 | Shl Value Value369 | Alloc AllocSize Value370 | Load LoadType Value371 | CompareInt IntArg IntCmpOp Value Value372 | CompareFloat FloatArg FloatCmpOp Value Value373 | Ext ExtArg Value374 | FloatToInt FloatArg Bool Value375 | IntToFloat IntArg Bool Value376 | TruncDouble Value377 | Cast Value378 | Copy Value379 | VAArg Value380 deriving (Show, Eq)381382data VolatileInstr383 = Store ExtType Value Value384 | VAStart Value385 | Blit Value Value Word64386 | DBGLoc Word64 Word64 (Maybe Word64)387 deriving (Show, Eq)388389data Statement390 = Assign LocalIdent BaseType Instr391 | Call (Maybe (LocalIdent, Abity)) Value [FuncArg]392 | Volatile VolatileInstr393 deriving (Show, Eq)394395data Phi396 = Phi397 { pName :: LocalIdent,398 pType :: BaseType,399 pLabels :: Map BlockIdent Value400 }401 deriving (Show, Eq)402403data Block404 = Block405 { label :: BlockIdent, -- TODO: Consider removing this (part of the Map)406 phi :: [Phi],407 stmt :: [Statement],408 term :: JumpInstr409 }410 deriving (Show, Eq)