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 | Common GlobalIdent166 | Extern GlobalIdent167 | ExternThread GlobalIdent168 deriving (Show, Eq)169170data Value171 = VConst DynConst172 | VLocal LocalIdent173 deriving (Show, Eq)174175data Linkage176 = LExport177 | LCommon178 | LThread179 | LSection String (Maybe String)180 deriving (Show, Eq)181182data AllocSize183 = AllocWord184 | AllocLong185 | AllocLongLong186 deriving (Show, Eq)187188getSize :: AllocSize -> Int189getSize AllocWord = 4190getSize AllocLong = 8191getSize AllocLongLong = 16192193data TypeDef194 = TypeDef195 { aggName :: UserIdent,196 aggAlign :: Maybe Word64,197 aggType :: AggType198 }199 deriving (Show, Eq)200201data SubType202 = SExtType ExtType203 | SUserDef UserIdent204 deriving (Show, Eq)205206type Field = (SubType, Maybe Word64)207208-- TODO: Type for tuple209data AggType210 = ARegular [Field]211 | AUnion [[Field]]212 | AOpaque Word64213 deriving (Show, Eq)214215data DataDef216 = DataDef217 { linkage :: [Linkage],218 name :: GlobalIdent,219 align :: Maybe Word64,220 objs :: [DataObj]221 }222 deriving (Show, Eq)223224dataSize :: DataDef -> Int225dataSize dataDef =226 sum $ map objSize (objs dataDef)227228data DataObj229 = OItem ExtType [DataItem]230 | OZeroFill Word64231 deriving (Show, Eq)232233objAlign :: DataObj -> Word64234objAlign (OZeroFill _) = 1 :: Word64235objAlign (OItem ty _) = fromIntegral $ extTypeByteSize ty236237objSize :: DataObj -> Int238objSize (OZeroFill n) = fromIntegral n239objSize (OItem ty items) = extTypeByteSize ty * cnt items240 where241 cnt :: [DataItem] -> Int242 cnt [] = 0243 cnt ((DString s) : xs) = length s + cnt xs244 cnt (_ : xs) = 1 + cnt xs245246data DataItem247 = DSymOff GlobalIdent Word64248 | DString String249 | DConst Const250 deriving (Show, Eq)251252data FuncDef253 = FuncDef254 { fLinkage :: [Linkage],255 fName :: GlobalIdent,256 fStart :: BlockIdent,257 fAbity :: Maybe Abity,258 fParams :: [FuncParam],259 fBlock :: Map BlockIdent Block260 }261 deriving (Show, Eq)262263fEntry :: FuncDef -> Block264fEntry func = fromJust $ Map.lookup (fStart func) (fBlock func)265266data FuncParam267 = Regular Abity LocalIdent268 | Env LocalIdent269 | Variadic270 deriving (Show, Eq)271272data FuncArg273 = ArgReg Abity Value274 | ArgEnv Value275 | ArgVar276 deriving (Show, Eq)277278data JumpInstr279 = Jump BlockIdent280 | Jnz Value BlockIdent BlockIdent281 | Return (Maybe Value)282 | Halt283 deriving (Show, Eq)284285data LoadType286 = LSubWord SubWordType287 | LBase BaseType288 deriving (Show, Eq)289290-- TODO: Could/Should define this on ExtType instead.291loadByteSize :: LoadType -> Word64292loadByteSize (LSubWord UnsignedByte) = 1293loadByteSize (LSubWord SignedByte) = 1294loadByteSize (LSubWord SignedHalf) = 2295loadByteSize (LSubWord UnsignedHalf) = 2296loadByteSize (LBase Word) = 4297loadByteSize (LBase Long) = 8298loadByteSize (LBase Single) = 4299loadByteSize (LBase Double) = 8300301data ExtArg302 = ExtSingle303 | ExtSubWord SubWordType304 | ExtSignedWord305 | ExtUnsignedWord306 deriving (Show, Eq)307308toExtType :: ExtArg -> (Bool, ExtType)309toExtType (ExtSubWord SignedByte) = (True, Byte)310toExtType (ExtSubWord UnsignedByte) = (False, Byte)311toExtType (ExtSubWord SignedHalf) = (True, HalfWord)312toExtType (ExtSubWord UnsignedHalf) = (False, HalfWord)313toExtType ExtSignedWord = (True, Base Word)314toExtType ExtUnsignedWord = (False, Base Word)315toExtType ExtSingle = (True, Base Single)316317data FloatArg = FDouble | FSingle318 deriving (Show, Eq)319320f2BaseType :: FloatArg -> BaseType321f2BaseType FSingle = Single322f2BaseType FDouble = Double323324data IntArg = IWord | ILong325 deriving (Show, Eq)326327i2BaseType :: IntArg -> BaseType328i2BaseType IWord = Word329i2BaseType ILong = Long330331-- TODO: Distinict types for floating point comparison?332data IntCmpOp333 = IEq334 | INe335 | ISle336 | ISlt337 | ISge338 | ISgt339 | IUle340 | IUlt341 | IUge342 | IUgt343 deriving (Show, Eq)344345data FloatCmpOp346 = FEq347 | FNe348 | FLe349 | FLt350 | FGe351 | FGt352 | FOrd353 | FUnord354 deriving (Show, Eq)355356data Instr357 = Add Value Value358 | Sub Value Value359 | Div Value Value360 | Mul Value Value361 | Neg Value362 | URem Value Value363 | Rem Value Value364 | UDiv Value Value365 | Or Value Value366 | Xor Value Value367 | And Value Value368 | Sar Value Value369 | Shr Value Value370 | Shl Value Value371 | Alloc AllocSize Value372 | Load LoadType Value373 | CompareInt IntArg IntCmpOp Value Value374 | CompareFloat FloatArg FloatCmpOp Value Value375 | Ext ExtArg Value376 | FloatToInt FloatArg Bool Value377 | IntToFloat IntArg Bool Value378 | TruncDouble Value379 | Cast Value380 | Copy Value381 | VAArg Value382 deriving (Show, Eq)383384data VolatileInstr385 = Store ExtType Value Value386 | VAStart Value387 | Blit Value Value Word64388 | DBGLoc Word64 Word64 (Maybe Word64)389 deriving (Show, Eq)390391data Statement392 = Assign LocalIdent BaseType Instr393 | Call (Maybe (LocalIdent, Abity)) Value [FuncArg]394 | Volatile VolatileInstr395 deriving (Show, Eq)396397data Phi398 = Phi399 { pName :: LocalIdent,400 pType :: BaseType,401 pLabels :: Map BlockIdent Value402 }403 deriving (Show, Eq)404405data Block406 = Block407 { label :: BlockIdent, -- TODO: Consider removing this (part of the Map)408 phi :: [Phi],409 stmt :: [Statement],410 term :: JumpInstr411 }412 deriving (Show, Eq)