quebex

  1-- SPDX-FileCopyrightText: 2025-2026 Sören Tempel <soeren+git@soeren-tempel.net>
  2--
  3-- SPDX-License-Identifier: GPL-3.0-only
  4
  5module Language.QBE.Types where
  6
  7import Control.Monad (foldM)
  8import Data.Map (Map)
  9import Data.Word (Word64)
 10
 11-- TODO: Prefix all constructors
 12
 13newtype UserIdent = UserIdent {userIdent :: String}
 14  deriving (Eq, Ord)
 15
 16instance Show UserIdent where
 17  show (UserIdent s) = ':' : s
 18
 19newtype LocalIdent = LocalIdent {localIdent :: String}
 20  deriving (Eq, Ord)
 21
 22instance Show LocalIdent where
 23  show (LocalIdent s) = '%' : s
 24
 25newtype BlockIdent = BlockIdent {blockIdent :: String}
 26  deriving (Eq, Ord)
 27
 28instance Show BlockIdent where
 29  show (BlockIdent s) = '@' : s
 30
 31newtype GlobalIdent = GlobalIdent {globalIdent :: String}
 32  deriving (Eq, Ord)
 33
 34instance Show GlobalIdent where
 35  show (GlobalIdent s) = '$' : s
 36
 37------------------------------------------------------------------------
 38
 39data BaseType
 40  = Word
 41  | Long
 42  | Single
 43  | Double
 44  deriving (Show, Eq)
 45
 46baseTypeByteSize :: BaseType -> Int
 47baseTypeByteSize Word = 4
 48baseTypeByteSize Long = 8
 49baseTypeByteSize Single = 4
 50baseTypeByteSize Double = 8
 51
 52baseTypeBitSize :: BaseType -> Int
 53baseTypeBitSize ty = baseTypeByteSize ty * 8
 54
 55data ExtType
 56  = Base BaseType
 57  | Byte
 58  | HalfWord
 59  deriving (Show, Eq)
 60
 61extTypeByteSize :: ExtType -> Int
 62extTypeByteSize (Base b) = baseTypeByteSize b
 63extTypeByteSize Byte = 1
 64extTypeByteSize HalfWord = 2
 65
 66extTypeBitSize :: ExtType -> Int
 67extTypeBitSize ty = extTypeByteSize ty * 8
 68
 69data SubWordType
 70  = SignedByte
 71  | UnsignedByte
 72  | SignedHalf
 73  | UnsignedHalf
 74  deriving (Show, Eq)
 75
 76data Abity
 77  = ABase BaseType
 78  | ASubWordType SubWordType
 79  | AUserDef UserIdent
 80  deriving (Show, Eq)
 81
 82abityToBase :: Abity -> BaseType
 83-- Calls with a sub-word return type define a temporary of base type
 84-- w with its most significant bits unspecified.
 85abityToBase (ASubWordType _) = Word
 86-- When an aggregate type is used as argument type or return type, the
 87-- value respectively passed or returned needs to be a pointer to a
 88-- memory location holding the value.
 89abityToBase (AUserDef _) = Long
 90abityToBase (ABase ty) = ty
 91
 92data Const
 93  = Number Word64
 94  | SFP Float
 95  | DFP Double
 96  | Global GlobalIdent
 97  deriving (Show, Eq)
 98
 99data DynConst
100  = Const Const
101  | Thread GlobalIdent
102  | Extern GlobalIdent
103  | ExternThread GlobalIdent
104  deriving (Show, Eq)
105
106data Value
107  = VConst DynConst
108  | VLocal LocalIdent
109  deriving (Show, Eq)
110
111data Linkage
112  = LExport
113  | LThread
114  | LSection String (Maybe String)
115  deriving (Show, Eq)
116
117data AllocSize
118  = AllocWord
119  | AllocLong
120  | AllocLongLong
121  deriving (Show, Eq)
122
123getSize :: AllocSize -> Int
124getSize AllocWord = 4
125getSize AllocLong = 8
126getSize AllocLongLong = 16
127
128data TypeDef
129  = TypeDef
130  { aggName :: UserIdent,
131    aggAlign :: Maybe Word64,
132    aggType :: AggType
133  }
134  deriving (Show, Eq)
135
136data SubType
137  = SExtType ExtType
138  | SUserDef UserIdent
139  deriving (Show, Eq)
140
141type Field = (SubType, Maybe Word64)
142
143-- TODO: Type for tuple
144data AggType
145  = ARegular [Field]
146  | AUnion [[Field]]
147  | AOpaque Word64
148  deriving (Show, Eq)
149
150data DataDef
151  = DataDef
152  { linkage :: [Linkage],
153    name :: GlobalIdent,
154    align :: Maybe Word64,
155    objs :: [DataObj]
156  }
157  deriving (Show, Eq)
158
159dataSize :: DataDef -> Int
160dataSize dataDef =
161  sum $ map objSize (objs dataDef)
162
163data DataObj
164  = OItem ExtType [DataItem]
165  | OZeroFill Word64
166  deriving (Show, Eq)
167
168objAlign :: DataObj -> Word64
169objAlign (OZeroFill _) = 1 :: Word64
170objAlign (OItem ty _) = fromIntegral $ extTypeByteSize ty
171
172objSize :: DataObj -> Int
173objSize (OZeroFill n) = fromIntegral n
174objSize (OItem ty items) = extTypeByteSize ty * cnt items
175  where
176    cnt :: [DataItem] -> Int
177    cnt [] = 0
178    cnt ((DString s) : xs) = length s + cnt xs
179    cnt (_ : xs) = 1 + cnt xs
180
181data DataItem
182  = DSymOff GlobalIdent Word64
183  | DString String
184  | DConst Const
185  deriving (Show, Eq)
186
187data FuncDef
188  = FuncDef
189  { fLinkage :: [Linkage],
190    fName :: GlobalIdent,
191    fAbity :: Maybe Abity,
192    fParams :: [FuncParam],
193    fBlock :: [Block] -- TODO: Use a Map here
194  }
195  deriving (Show, Eq)
196
197data FuncParam
198  = Regular Abity LocalIdent
199  | Env LocalIdent
200  | Variadic
201  deriving (Show, Eq)
202
203data FuncArg
204  = ArgReg Abity Value
205  | ArgEnv Value
206  | ArgVar
207  deriving (Show, Eq)
208
209data JumpInstr
210  = Jump BlockIdent
211  | Jnz Value BlockIdent BlockIdent
212  | Return (Maybe Value)
213  | Halt
214  deriving (Show, Eq)
215
216data LoadType
217  = LSubWord SubWordType
218  | LBase BaseType
219  deriving (Show, Eq)
220
221-- TODO: Could/Should define this on ExtType instead.
222loadByteSize :: LoadType -> Word64
223loadByteSize (LSubWord UnsignedByte) = 1
224loadByteSize (LSubWord SignedByte) = 1
225loadByteSize (LSubWord SignedHalf) = 2
226loadByteSize (LSubWord UnsignedHalf) = 2
227loadByteSize (LBase Word) = 4
228loadByteSize (LBase Long) = 8
229loadByteSize (LBase Single) = 4
230loadByteSize (LBase Double) = 8
231
232data ExtArg
233  = ExtSingle
234  | ExtSubWord SubWordType
235  | ExtSignedWord
236  | ExtUnsignedWord
237  deriving (Show, Eq)
238
239toExtType :: ExtArg -> (Bool, ExtType)
240toExtType (ExtSubWord SignedByte) = (True, Byte)
241toExtType (ExtSubWord UnsignedByte) = (False, Byte)
242toExtType (ExtSubWord SignedHalf) = (True, HalfWord)
243toExtType (ExtSubWord UnsignedHalf) = (False, HalfWord)
244toExtType ExtSignedWord = (True, Base Word)
245toExtType ExtUnsignedWord = (False, Base Word)
246toExtType ExtSingle = (True, Base Single)
247
248data FloatArg = FDouble | FSingle
249  deriving (Show, Eq)
250
251f2BaseType :: FloatArg -> BaseType
252f2BaseType FSingle = Single
253f2BaseType FDouble = Double
254
255data IntArg = IWord | ILong
256  deriving (Show, Eq)
257
258i2BaseType :: IntArg -> BaseType
259i2BaseType IWord = Word
260i2BaseType ILong = Long
261
262-- TODO: Distinict types for floating point comparison?
263data IntCmpOp
264  = IEq
265  | INe
266  | ISle
267  | ISlt
268  | ISge
269  | ISgt
270  | IUle
271  | IUlt
272  | IUge
273  | IUgt
274  deriving (Show, Eq)
275
276data FloatCmpOp
277  = FEq
278  | FNe
279  | FLe
280  | FLt
281  | FGe
282  | FGt
283  | FOrd
284  | FUnord
285  deriving (Show, Eq)
286
287data Instr
288  = Add Value Value
289  | Sub Value Value
290  | Div Value Value
291  | Mul Value Value
292  | Neg Value
293  | URem Value Value
294  | Rem Value Value
295  | UDiv Value Value
296  | Or Value Value
297  | Xor Value Value
298  | And Value Value
299  | Sar Value Value
300  | Shr Value Value
301  | Shl Value Value
302  | Alloc AllocSize Value
303  | Load LoadType Value
304  | CompareInt IntArg IntCmpOp Value Value
305  | CompareFloat FloatArg FloatCmpOp Value Value
306  | Ext ExtArg Value
307  | FloatToInt FloatArg Bool Value
308  | IntToFloat IntArg Bool Value
309  | TruncDouble Value
310  | Cast Value
311  | Copy Value
312  | VAArg Value
313  deriving (Show, Eq)
314
315data VolatileInstr
316  = Store ExtType Value Value
317  | VAStart Value
318  | Blit Value Value Word64
319  | DBGLoc Word64 Word64 (Maybe Word64)
320  deriving (Show, Eq)
321
322data Statement
323  = Assign LocalIdent BaseType Instr
324  | Call (Maybe (LocalIdent, Abity)) Value [FuncArg]
325  | Volatile VolatileInstr
326  deriving (Show, Eq)
327
328data Phi
329  = Phi
330  { pName :: LocalIdent,
331    pType :: BaseType,
332    pLabels :: Map BlockIdent Value
333  }
334  deriving (Show, Eq)
335
336data Block'
337  = Block'
338  { label' :: BlockIdent,
339    phi' :: [Phi],
340    stmt' :: [Statement],
341    term' :: Maybe JumpInstr
342  }
343  deriving (Show, Eq)
344
345insertJumps :: [Block'] -> Maybe [Block]
346insertJumps xs = foldM go [] $ zipWithNext xs
347  where
348    zipWithNext :: [a] -> [(a, Maybe a)]
349    zipWithNext [] = []
350    zipWithNext lst@(_ : t) = zip lst $ map Just t ++ [Nothing]
351
352    fromBlock' :: Block' -> JumpInstr -> Block
353    fromBlock' (Block' l p s _) = Block l p s
354
355    go :: [Block] -> (Block', Maybe Block') -> Maybe [Block]
356    go acc (x@Block' {term' = Just ji}, _) =
357      Just (acc ++ [fromBlock' x ji])
358    go acc (x@Block' {term' = Nothing}, Just nxt) =
359      Just (acc ++ [fromBlock' x (Jump $ label' nxt)])
360    go _ (Block' {term' = Nothing}, Nothing) =
361      Nothing
362
363data Block
364  = Block
365  { label :: BlockIdent,
366    phi :: [Phi],
367    stmt :: [Statement],
368    term :: JumpInstr
369  }
370  deriving (Show, Eq)