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 | LThread178 | LSection String (Maybe String)179 deriving (Show, Eq)180181data AllocSize182 = AllocWord183 | AllocLong184 | AllocLongLong185 deriving (Show, Eq)186187getSize :: AllocSize -> Int188getSize AllocWord = 4189getSize AllocLong = 8190getSize AllocLongLong = 16191192data TypeDef193 = TypeDef194 { aggName :: UserIdent,195 aggAlign :: Maybe Word64,196 aggType :: AggType197 }198 deriving (Show, Eq)199200data SubType201 = SExtType ExtType202 | SUserDef UserIdent203 deriving (Show, Eq)204205type Field = (SubType, Maybe Word64)206207-- TODO: Type for tuple208data AggType209 = ARegular [Field]210 | AUnion [[Field]]211 | AOpaque Word64212 deriving (Show, Eq)213214data DataDef215 = DataDef216 { linkage :: [Linkage],217 name :: GlobalIdent,218 align :: Maybe Word64,219 objs :: [DataObj]220 }221 deriving (Show, Eq)222223dataSize :: DataDef -> Int224dataSize dataDef =225 sum $ map objSize (objs dataDef)226227data DataObj228 = OItem ExtType [DataItem]229 | OZeroFill Word64230 deriving (Show, Eq)231232objAlign :: DataObj -> Word64233objAlign (OZeroFill _) = 1 :: Word64234objAlign (OItem ty _) = fromIntegral $ extTypeByteSize ty235236objSize :: DataObj -> Int237objSize (OZeroFill n) = fromIntegral n238objSize (OItem ty items) = extTypeByteSize ty * cnt items239 where240 cnt :: [DataItem] -> Int241 cnt [] = 0242 cnt ((DString s) : xs) = length s + cnt xs243 cnt (_ : xs) = 1 + cnt xs244245data DataItem246 = DSymOff GlobalIdent Word64247 | DString String248 | DConst Const249 deriving (Show, Eq)250251data FuncDef252 = FuncDef253 { fLinkage :: [Linkage],254 fName :: GlobalIdent,255 fStart :: BlockIdent,256 fAbity :: Maybe Abity,257 fParams :: [FuncParam],258 fBlock :: Map BlockIdent Block259 }260 deriving (Show, Eq)261262fEntry :: FuncDef -> Block263fEntry func = fromJust $ Map.lookup (fStart func) (fBlock func)264265data FuncParam266 = Regular Abity LocalIdent267 | Env LocalIdent268 | Variadic269 deriving (Show, Eq)270271data FuncArg272 = ArgReg Abity Value273 | ArgEnv Value274 | ArgVar275 deriving (Show, Eq)276277data JumpInstr278 = Jump BlockIdent279 | Jnz Value BlockIdent BlockIdent280 | Return (Maybe Value)281 | Halt282 deriving (Show, Eq)283284data LoadType285 = LSubWord SubWordType286 | LBase BaseType287 deriving (Show, Eq)288289-- TODO: Could/Should define this on ExtType instead.290loadByteSize :: LoadType -> Word64291loadByteSize (LSubWord UnsignedByte) = 1292loadByteSize (LSubWord SignedByte) = 1293loadByteSize (LSubWord SignedHalf) = 2294loadByteSize (LSubWord UnsignedHalf) = 2295loadByteSize (LBase Word) = 4296loadByteSize (LBase Long) = 8297loadByteSize (LBase Single) = 4298loadByteSize (LBase Double) = 8299300data ExtArg301 = ExtSingle302 | ExtSubWord SubWordType303 | ExtSignedWord304 | ExtUnsignedWord305 deriving (Show, Eq)306307toExtType :: ExtArg -> (Bool, ExtType)308toExtType (ExtSubWord SignedByte) = (True, Byte)309toExtType (ExtSubWord UnsignedByte) = (False, Byte)310toExtType (ExtSubWord SignedHalf) = (True, HalfWord)311toExtType (ExtSubWord UnsignedHalf) = (False, HalfWord)312toExtType ExtSignedWord = (True, Base Word)313toExtType ExtUnsignedWord = (False, Base Word)314toExtType ExtSingle = (True, Base Single)315316data FloatArg = FDouble | FSingle317 deriving (Show, Eq)318319f2BaseType :: FloatArg -> BaseType320f2BaseType FSingle = Single321f2BaseType FDouble = Double322323data IntArg = IWord | ILong324 deriving (Show, Eq)325326i2BaseType :: IntArg -> BaseType327i2BaseType IWord = Word328i2BaseType ILong = Long329330-- TODO: Distinict types for floating point comparison?331data IntCmpOp332 = IEq333 | INe334 | ISle335 | ISlt336 | ISge337 | ISgt338 | IUle339 | IUlt340 | IUge341 | IUgt342 deriving (Show, Eq)343344data FloatCmpOp345 = FEq346 | FNe347 | FLe348 | FLt349 | FGe350 | FGt351 | FOrd352 | FUnord353 deriving (Show, Eq)354355data Instr356 = Add Value Value357 | Sub Value Value358 | Div Value Value359 | Mul Value Value360 | Neg Value361 | URem Value Value362 | Rem Value Value363 | UDiv Value Value364 | Or Value Value365 | Xor Value Value366 | And Value Value367 | Sar Value Value368 | Shr Value Value369 | Shl Value Value370 | Alloc AllocSize Value371 | Load LoadType Value372 | CompareInt IntArg IntCmpOp Value Value373 | CompareFloat FloatArg FloatCmpOp Value Value374 | Ext ExtArg Value375 | FloatToInt FloatArg Bool Value376 | IntToFloat IntArg Bool Value377 | TruncDouble Value378 | Cast Value379 | Copy Value380 | VAArg Value381 deriving (Show, Eq)382383data VolatileInstr384 = Store ExtType Value Value385 | VAStart Value386 | Blit Value Value Word64387 | DBGLoc Word64 Word64 (Maybe Word64)388 deriving (Show, Eq)389390data Statement391 = Assign LocalIdent BaseType Instr392 | Call (Maybe (LocalIdent, Abity)) Value [FuncArg]393 | Volatile VolatileInstr394 deriving (Show, Eq)395396data Phi397 = Phi398 { pName :: LocalIdent,399 pType :: BaseType,400 pLabels :: Map BlockIdent Value401 }402 deriving (Show, Eq)403404data Block405 = Block406 { label :: BlockIdent, -- TODO: Consider removing this (part of the Map)407 phi :: [Phi],408 stmt :: [Statement],409 term :: JumpInstr410 }411 deriving (Show, Eq)