1-- SPDX-FileCopyrightText: 2025 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 = AlignWord117 | AlignLong118 | AlignLongLong119 deriving (Show, Eq)120121getSize :: AllocSize -> Int122getSize AlignWord = 4123getSize AlignLong = 8124getSize AlignLongLong = 16125126data TypeDef127 = TypeDef128 { aggName :: UserIdent,129 aggAlign :: Maybe AllocSize,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 AllocSize,153 objs :: [DataObj]154 }155 deriving (Show, Eq)156157data DataObj158 = OItem ExtType [DataItem]159 | OZeroFill Word64160 deriving (Show, Eq)161162data DataItem163 = DSymbol GlobalIdent (Maybe Word64)164 | DString String165 | DConst Const166 deriving (Show, Eq)167168data FuncDef169 = FuncDef170 { fLinkage :: [Linkage],171 fName :: GlobalIdent,172 fAbity :: Maybe Abity,173 fParams :: [FuncParam],174 fBlock :: [Block] -- TODO: Use a Map here175 }176 deriving (Show, Eq)177178data FuncParam179 = Regular Abity LocalIdent180 | Env LocalIdent181 | Variadic182 deriving (Show, Eq)183184data FuncArg185 = ArgReg Abity Value186 | ArgEnv Value187 | ArgVar188 deriving (Show, Eq)189190data JumpInstr191 = Jump BlockIdent192 | Jnz Value BlockIdent BlockIdent193 | Return (Maybe Value)194 | Halt195 deriving (Show, Eq)196197data LoadType198 = LSubWord SubWordType199 | LBase BaseType200 deriving (Show, Eq)201202-- TODO: Could/Should define this on ExtType instead.203loadByteSize :: LoadType -> Word64204loadByteSize (LSubWord UnsignedByte) = 1205loadByteSize (LSubWord SignedByte) = 1206loadByteSize (LSubWord SignedHalf) = 2207loadByteSize (LSubWord UnsignedHalf) = 2208loadByteSize (LBase Word) = 4209loadByteSize (LBase Long) = 8210loadByteSize (LBase Single) = 4211loadByteSize (LBase Double) = 8212213data SubLongType214 = SLSubWord SubWordType215 | SLSignedWord216 | SLUnsignedWord217 deriving (Show, Eq)218219-- TODO: Distinict types for floating point comparison?220data CmpOp221 = CEq222 | CNe223 | CSle224 | CSlt225 | CSge226 | CSgt227 | CUle228 | CUlt229 | CUge230 | CUgt231 deriving (Show, Eq)232233data Instr234 = Add Value Value235 | Sub Value Value236 | -- | Div Value Value237 Mul Value Value238 | URem Value Value239 | Rem Value Value240 | UDiv Value Value241 | Or Value Value242 | Xor Value Value243 | And Value Value244 | Alloc AllocSize Value245 | Load LoadType Value246 | Compare BaseType CmpOp Value Value247 | Ext SubLongType Value248 deriving (Show, Eq)249250data VolatileInstr251 = Store ExtType Value Value252 | Blit Value Value Word64253 deriving (Show, Eq)254255data Statement256 = Assign LocalIdent BaseType Instr257 | Call (Maybe (LocalIdent, Abity)) Value [FuncArg]258 | Volatile VolatileInstr259 deriving (Show, Eq)260261data Phi262 = Phi263 { pName :: LocalIdent,264 pType :: BaseType,265 pLabels :: Map BlockIdent Value266 }267 deriving (Show, Eq)268269data Block'270 = Block'271 { label' :: BlockIdent,272 phi' :: [Phi],273 stmt' :: [Statement],274 term' :: Maybe JumpInstr275 }276 deriving (Show, Eq)277278insertJumps :: [Block'] -> Maybe [Block]279insertJumps xs = foldM go [] $ zipWithNext xs280 where281 zipWithNext :: [a] -> [(a, Maybe a)]282 zipWithNext [] = []283 zipWithNext lst@(_ : t) = zip lst $ map Just t ++ [Nothing]284285 fromBlock' :: Block' -> JumpInstr -> Block286 fromBlock' (Block' l p s _) = Block l p s287288 go :: [Block] -> (Block', Maybe Block') -> Maybe [Block]289 go acc (x@Block' {term' = Just ji}, _) =290 Just (acc ++ [fromBlock' x ji])291 go acc (x@Block' {term' = Nothing}, Just nxt) =292 Just (acc ++ [fromBlock' x (Jump $ label' nxt)])293 go _ (Block' {term' = Nothing}, Nothing) =294 Nothing295296data Block297 = Block298 { label :: BlockIdent,299 phi :: [Phi],300 stmt :: [Statement],301 term :: JumpInstr302 }303 deriving (Show, Eq)