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 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)156157data DataObj158 = OItem ExtType [DataItem]159 | OZeroFill Word64160 deriving (Show, Eq)161162data DataItem163 = DSymOff GlobalIdent Word64164 | 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 | Neg Value239 | URem Value Value240 | Rem Value Value241 | UDiv Value Value242 | Or Value Value243 | Xor Value Value244 | And Value Value245 | Sar Value Value246 | Shr Value Value247 | Shl Value Value248 | Alloc AllocSize Value249 | Load LoadType Value250 | Compare BaseType CmpOp Value Value251 | Ext SubLongType Value252 | Cast Value253 | Copy Value254 deriving (Show, Eq)255256data VolatileInstr257 = Store ExtType Value Value258 | Blit Value Value Word64259 deriving (Show, Eq)260261data Statement262 = Assign LocalIdent BaseType Instr263 | Call (Maybe (LocalIdent, Abity)) Value [FuncArg]264 | Volatile VolatileInstr265 deriving (Show, Eq)266267data Phi268 = Phi269 { pName :: LocalIdent,270 pType :: BaseType,271 pLabels :: Map BlockIdent Value272 }273 deriving (Show, Eq)274275data Block'276 = Block'277 { label' :: BlockIdent,278 phi' :: [Phi],279 stmt' :: [Statement],280 term' :: Maybe JumpInstr281 }282 deriving (Show, Eq)283284insertJumps :: [Block'] -> Maybe [Block]285insertJumps xs = foldM go [] $ zipWithNext xs286 where287 zipWithNext :: [a] -> [(a, Maybe a)]288 zipWithNext [] = []289 zipWithNext lst@(_ : t) = zip lst $ map Just t ++ [Nothing]290291 fromBlock' :: Block' -> JumpInstr -> Block292 fromBlock' (Block' l p s _) = Block l p s293294 go :: [Block] -> (Block', Maybe Block') -> Maybe [Block]295 go acc (x@Block' {term' = Just ji}, _) =296 Just (acc ++ [fromBlock' x ji])297 go acc (x@Block' {term' = Nothing}, Just nxt) =298 Just (acc ++ [fromBlock' x (Jump $ label' nxt)])299 go _ (Block' {term' = Nothing}, Nothing) =300 Nothing301302data Block303 = Block304 { label :: BlockIdent,305 phi :: [Phi],306 stmt :: [Statement],307 term :: JumpInstr308 }309 deriving (Show, Eq)