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 = 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)156157data DataObj158 = OItem ExtType [DataItem]159 | OZeroFill Word64160 deriving (Show, Eq)161162objAlign :: DataObj -> Word64163objAlign (OZeroFill _) = 1 :: Word64164objAlign (OItem ty _) = fromIntegral $ extTypeByteSize ty165166data DataItem167 = DSymOff GlobalIdent Word64168 | DString String169 | DConst Const170 deriving (Show, Eq)171172data FuncDef173 = FuncDef174 { fLinkage :: [Linkage],175 fName :: GlobalIdent,176 fAbity :: Maybe Abity,177 fParams :: [FuncParam],178 fBlock :: [Block] -- TODO: Use a Map here179 }180 deriving (Show, Eq)181182data FuncParam183 = Regular Abity LocalIdent184 | Env LocalIdent185 | Variadic186 deriving (Show, Eq)187188data FuncArg189 = ArgReg Abity Value190 | ArgEnv Value191 | ArgVar192 deriving (Show, Eq)193194data JumpInstr195 = Jump BlockIdent196 | Jnz Value BlockIdent BlockIdent197 | Return (Maybe Value)198 | Halt199 deriving (Show, Eq)200201data LoadType202 = LSubWord SubWordType203 | LBase BaseType204 deriving (Show, Eq)205206-- TODO: Could/Should define this on ExtType instead.207loadByteSize :: LoadType -> Word64208loadByteSize (LSubWord UnsignedByte) = 1209loadByteSize (LSubWord SignedByte) = 1210loadByteSize (LSubWord SignedHalf) = 2211loadByteSize (LSubWord UnsignedHalf) = 2212loadByteSize (LBase Word) = 4213loadByteSize (LBase Long) = 8214loadByteSize (LBase Single) = 4215loadByteSize (LBase Double) = 8216217data ExtArg218 = ExtSingle219 | ExtSubWord SubWordType220 | ExtSignedWord221 | ExtUnsignedWord222 deriving (Show, Eq)223224toExtType :: ExtArg -> (Bool, ExtType)225toExtType (ExtSubWord SignedByte) = (True, Byte)226toExtType (ExtSubWord UnsignedByte) = (False, Byte)227toExtType (ExtSubWord SignedHalf) = (True, HalfWord)228toExtType (ExtSubWord UnsignedHalf) = (False, HalfWord)229toExtType ExtSignedWord = (True, Base Word)230toExtType ExtUnsignedWord = (False, Base Word)231toExtType ExtSingle = (True, Base Single)232233data FloatArg = FDouble | FSingle234 deriving (Show, Eq)235236f2BaseType :: FloatArg -> BaseType237f2BaseType FSingle = Single238f2BaseType FDouble = Double239240data IntArg = IWord | ILong241 deriving (Show, Eq)242243i2BaseType :: IntArg -> BaseType244i2BaseType IWord = Word245i2BaseType ILong = Long246247-- TODO: Distinict types for floating point comparison?248data IntCmpOp249 = IEq250 | INe251 | ISle252 | ISlt253 | ISge254 | ISgt255 | IUle256 | IUlt257 | IUge258 | IUgt259 deriving (Show, Eq)260261data FloatCmpOp262 = FEq263 | FNe264 | FLe265 | FLt266 | FGe267 | FGt268 | FOrd269 | FUnord270 deriving (Show, Eq)271272data Instr273 = Add Value Value274 | Sub Value Value275 | Div Value Value276 | Mul Value Value277 | Neg Value278 | URem Value Value279 | Rem Value Value280 | UDiv Value Value281 | Or Value Value282 | Xor Value Value283 | And Value Value284 | Sar Value Value285 | Shr Value Value286 | Shl Value Value287 | Alloc AllocSize Value288 | Load LoadType Value289 | CompareInt IntArg IntCmpOp Value Value290 | CompareFloat FloatArg FloatCmpOp Value Value291 | Ext ExtArg Value292 | FloatToInt FloatArg Bool Value293 | IntToFloat IntArg Bool Value294 | TruncDouble Value295 | Cast Value296 | Copy Value297 deriving (Show, Eq)298299data VolatileInstr300 = Store ExtType Value Value301 | Blit Value Value Word64302 deriving (Show, Eq)303304data Statement305 = Assign LocalIdent BaseType Instr306 | Call (Maybe (LocalIdent, Abity)) Value [FuncArg]307 | Volatile VolatileInstr308 deriving (Show, Eq)309310data Phi311 = Phi312 { pName :: LocalIdent,313 pType :: BaseType,314 pLabels :: Map BlockIdent Value315 }316 deriving (Show, Eq)317318data Block'319 = Block'320 { label' :: BlockIdent,321 phi' :: [Phi],322 stmt' :: [Statement],323 term' :: Maybe JumpInstr324 }325 deriving (Show, Eq)326327insertJumps :: [Block'] -> Maybe [Block]328insertJumps xs = foldM go [] $ zipWithNext xs329 where330 zipWithNext :: [a] -> [(a, Maybe a)]331 zipWithNext [] = []332 zipWithNext lst@(_ : t) = zip lst $ map Just t ++ [Nothing]333334 fromBlock' :: Block' -> JumpInstr -> Block335 fromBlock' (Block' l p s _) = Block l p s336337 go :: [Block] -> (Block', Maybe Block') -> Maybe [Block]338 go acc (x@Block' {term' = Just ji}, _) =339 Just (acc ++ [fromBlock' x ji])340 go acc (x@Block' {term' = Nothing}, Just nxt) =341 Just (acc ++ [fromBlock' x (Jump $ label' nxt)])342 go _ (Block' {term' = Nothing}, Nothing) =343 Nothing344345data Block346 = Block347 { label :: BlockIdent,348 phi :: [Phi],349 stmt :: [Statement],350 term :: JumpInstr351 }352 deriving (Show, Eq)