1-- SPDX-FileCopyrightText: 2025-2026 Sören Tempel <soeren+git@soeren-tempel.net>2--3-- SPDX-License-Identifier: GPL-3.0-only45module Language.QBE.Types where67import Control.Monad (foldM)8import Data.Map (Map)9import Data.Word (Word64)1011-- TODO: Prefix all constructors1213newtype UserIdent = UserIdent {userIdent :: String}14 deriving (Eq, Ord)1516instance Show UserIdent where17 show (UserIdent s) = ':' : s1819newtype LocalIdent = LocalIdent {localIdent :: String}20 deriving (Eq, Ord)2122instance Show LocalIdent where23 show (LocalIdent s) = '%' : s2425newtype BlockIdent = BlockIdent {blockIdent :: String}26 deriving (Eq, Ord)2728instance Show BlockIdent where29 show (BlockIdent s) = '@' : s3031newtype GlobalIdent = GlobalIdent {globalIdent :: String}32 deriving (Eq, Ord)3334instance Show GlobalIdent where35 show (GlobalIdent s) = '$' : s3637------------------------------------------------------------------------3839data BaseType40 = Word41 | Long42 | Single43 | Double44 deriving (Show, Eq)4546baseTypeByteSize :: BaseType -> Int47baseTypeByteSize Word = 448baseTypeByteSize Long = 849baseTypeByteSize Single = 450baseTypeByteSize Double = 85152baseTypeBitSize :: BaseType -> Int53baseTypeBitSize ty = baseTypeByteSize ty * 85455data ExtType56 = Base BaseType57 | Byte58 | HalfWord59 deriving (Show, Eq)6061extTypeByteSize :: ExtType -> Int62extTypeByteSize (Base b) = baseTypeByteSize b63extTypeByteSize Byte = 164extTypeByteSize HalfWord = 26566extTypeBitSize :: ExtType -> Int67extTypeBitSize ty = extTypeByteSize ty * 86869data SubWordType70 = SignedByte71 | UnsignedByte72 | SignedHalf73 | UnsignedHalf74 deriving (Show, Eq)7576data Abity77 = ABase BaseType78 | ASubWordType SubWordType79 | AUserDef UserIdent80 deriving (Show, Eq)8182abityToBase :: Abity -> BaseType83-- Calls with a sub-word return type define a temporary of base type84-- w with its most significant bits unspecified.85abityToBase (ASubWordType _) = Word86-- When an aggregate type is used as argument type or return type, the87-- value respectively passed or returned needs to be a pointer to a88-- memory location holding the value.89abityToBase (AUserDef _) = Long90abityToBase (ABase ty) = ty9192data Const93 = Number Word6494 | SFP Float95 | DFP Double96 | Global GlobalIdent97 deriving (Show, Eq)9899data DynConst100 = Const Const101 | Thread GlobalIdent102 deriving (Show, Eq)103104data Value105 = VConst DynConst106 | VLocal LocalIdent107 deriving (Show, Eq)108109data Linkage110 = LExport111 | LThread112 | LSection String (Maybe String)113 deriving (Show, Eq)114115data AllocSize116 = AllocWord117 | AllocLong118 | AllocLongLong119 deriving (Show, Eq)120121getSize :: AllocSize -> Int122getSize AllocWord = 4123getSize AllocLong = 8124getSize AllocLongLong = 16125126data TypeDef127 = TypeDef128 { aggName :: UserIdent,129 aggAlign :: Maybe Word64,130 aggType :: AggType131 }132 deriving (Show, Eq)133134data SubType135 = SExtType ExtType136 | SUserDef UserIdent137 deriving (Show, Eq)138139type Field = (SubType, Maybe Word64)140141-- TODO: Type for tuple142data AggType143 = ARegular [Field]144 | AUnion [[Field]]145 | AOpaque Word64146 deriving (Show, Eq)147148data DataDef149 = DataDef150 { linkage :: [Linkage],151 name :: GlobalIdent,152 align :: Maybe Word64,153 objs :: [DataObj]154 }155 deriving (Show, Eq)156157dataSize :: DataDef -> Int158dataSize dataDef =159 sum $ map objSize (objs dataDef)160161data DataObj162 = OItem ExtType [DataItem]163 | OZeroFill Word64164 deriving (Show, Eq)165166objAlign :: DataObj -> Word64167objAlign (OZeroFill _) = 1 :: Word64168objAlign (OItem ty _) = fromIntegral $ extTypeByteSize ty169170objSize :: DataObj -> Int171objSize (OZeroFill n) = fromIntegral n172objSize (OItem ty items) = extTypeByteSize ty * cnt items173 where174 cnt :: [DataItem] -> Int175 cnt [] = 0176 cnt ((DString s) : xs) = length s + cnt xs177 cnt (_ : xs) = 1 + cnt xs178179data DataItem180 = DSymOff GlobalIdent Word64181 | DString String182 | DConst Const183 deriving (Show, Eq)184185data FuncDef186 = FuncDef187 { fLinkage :: [Linkage],188 fName :: GlobalIdent,189 fAbity :: Maybe Abity,190 fParams :: [FuncParam],191 fBlock :: [Block] -- TODO: Use a Map here192 }193 deriving (Show, Eq)194195data FuncParam196 = Regular Abity LocalIdent197 | Env LocalIdent198 | Variadic199 deriving (Show, Eq)200201data FuncArg202 = ArgReg Abity Value203 | ArgEnv Value204 | ArgVar205 deriving (Show, Eq)206207data JumpInstr208 = Jump BlockIdent209 | Jnz Value BlockIdent BlockIdent210 | Return (Maybe Value)211 | Halt212 deriving (Show, Eq)213214data LoadType215 = LSubWord SubWordType216 | LBase BaseType217 deriving (Show, Eq)218219-- TODO: Could/Should define this on ExtType instead.220loadByteSize :: LoadType -> Word64221loadByteSize (LSubWord UnsignedByte) = 1222loadByteSize (LSubWord SignedByte) = 1223loadByteSize (LSubWord SignedHalf) = 2224loadByteSize (LSubWord UnsignedHalf) = 2225loadByteSize (LBase Word) = 4226loadByteSize (LBase Long) = 8227loadByteSize (LBase Single) = 4228loadByteSize (LBase Double) = 8229230data ExtArg231 = ExtSingle232 | ExtSubWord SubWordType233 | ExtSignedWord234 | ExtUnsignedWord235 deriving (Show, Eq)236237toExtType :: ExtArg -> (Bool, ExtType)238toExtType (ExtSubWord SignedByte) = (True, Byte)239toExtType (ExtSubWord UnsignedByte) = (False, Byte)240toExtType (ExtSubWord SignedHalf) = (True, HalfWord)241toExtType (ExtSubWord UnsignedHalf) = (False, HalfWord)242toExtType ExtSignedWord = (True, Base Word)243toExtType ExtUnsignedWord = (False, Base Word)244toExtType ExtSingle = (True, Base Single)245246data FloatArg = FDouble | FSingle247 deriving (Show, Eq)248249f2BaseType :: FloatArg -> BaseType250f2BaseType FSingle = Single251f2BaseType FDouble = Double252253data IntArg = IWord | ILong254 deriving (Show, Eq)255256i2BaseType :: IntArg -> BaseType257i2BaseType IWord = Word258i2BaseType ILong = Long259260-- TODO: Distinict types for floating point comparison?261data IntCmpOp262 = IEq263 | INe264 | ISle265 | ISlt266 | ISge267 | ISgt268 | IUle269 | IUlt270 | IUge271 | IUgt272 deriving (Show, Eq)273274data FloatCmpOp275 = FEq276 | FNe277 | FLe278 | FLt279 | FGe280 | FGt281 | FOrd282 | FUnord283 deriving (Show, Eq)284285data Instr286 = Add Value Value287 | Sub Value Value288 | Div Value Value289 | Mul Value Value290 | Neg Value291 | URem Value Value292 | Rem Value Value293 | UDiv Value Value294 | Or Value Value295 | Xor Value Value296 | And Value Value297 | Sar Value Value298 | Shr Value Value299 | Shl Value Value300 | Alloc AllocSize Value301 | Load LoadType Value302 | CompareInt IntArg IntCmpOp Value Value303 | CompareFloat FloatArg FloatCmpOp Value Value304 | Ext ExtArg Value305 | FloatToInt FloatArg Bool Value306 | IntToFloat IntArg Bool Value307 | TruncDouble Value308 | Cast Value309 | Copy Value310 | VAArg Value311 deriving (Show, Eq)312313data VolatileInstr314 = Store ExtType Value Value315 | VAStart Value316 | Blit Value Value Word64317 | DBGLoc Word64 Word64 (Maybe Word64)318 deriving (Show, Eq)319320data Statement321 = Assign LocalIdent BaseType Instr322 | Call (Maybe (LocalIdent, Abity)) Value [FuncArg]323 | Volatile VolatileInstr324 deriving (Show, Eq)325326data Phi327 = Phi328 { pName :: LocalIdent,329 pType :: BaseType,330 pLabels :: Map BlockIdent Value331 }332 deriving (Show, Eq)333334data Block'335 = Block'336 { label' :: BlockIdent,337 phi' :: [Phi],338 stmt' :: [Statement],339 term' :: Maybe JumpInstr340 }341 deriving (Show, Eq)342343insertJumps :: [Block'] -> Maybe [Block]344insertJumps xs = foldM go [] $ zipWithNext xs345 where346 zipWithNext :: [a] -> [(a, Maybe a)]347 zipWithNext [] = []348 zipWithNext lst@(_ : t) = zip lst $ map Just t ++ [Nothing]349350 fromBlock' :: Block' -> JumpInstr -> Block351 fromBlock' (Block' l p s _) = Block l p s352353 go :: [Block] -> (Block', Maybe Block') -> Maybe [Block]354 go acc (x@Block' {term' = Just ji}, _) =355 Just (acc ++ [fromBlock' x ji])356 go acc (x@Block' {term' = Nothing}, Just nxt) =357 Just (acc ++ [fromBlock' x (Jump $ label' nxt)])358 go _ (Block' {term' = Nothing}, Nothing) =359 Nothing360361data Block362 = Block363 { label :: BlockIdent,364 phi :: [Phi],365 stmt :: [Statement],366 term :: JumpInstr367 }368 deriving (Show, Eq)