qute

  1-- SPDX-FileCopyrightText: 2025 Sören Tempel <soeren+git@soeren-tempel.net>
  2--
  3-- SPDX-License-Identifier: GPL-3.0-only
  4
  5-- | This module provides a generic expression language used to describe
  6-- arithmetic and logic operations on instruction operands in the abstract
  7-- 'Language.QBE.Simulator' description of QBE semantics. Therefore, in
  8-- addition to the 'Language.QBE.Simulator.State.Simulator' monad, it is the
  9-- central component for the abstract description of QBE's semantics.
 10module Language.QBE.Simulator.Expression
 11  ( -- * Expression Abstraction
 12    ValueRepr (..),
 13
 14    -- * Conversion Functions,
 15    fromString,
 16    toString,
 17    boolToValue,
 18
 19    -- * Comparision
 20    compareIntExpr,
 21    compareFloatExpr,
 22  )
 23where
 24
 25import Data.Char qualified as C
 26import Data.Word (Word64)
 27import Language.QBE.Types qualified as QBE
 28
 29-- | Generic expression abstraction operating on values of type 'QBE.ExtType'.
 30-- Values are either fixed-size bitvectors (8-, 16, 32-, or 64-bit) or
 31-- single-precision or double-precision floating point values. The value type
 32-- must be tracked internally by the 'ValueRepr' instance. Operations on the
 33-- value must return 'Nothing' if the operation is performed on values of
 34-- different types.
 35class ValueRepr v where
 36  -- | Create a 'ValueRepr' from an integer literal.
 37  --
 38  -- TODO: rename fromLit to fromInt
 39  fromLit :: QBE.ExtType -> Word64 -> v
 40
 41  fromFloat :: Float -> v
 42  fromDouble :: Double -> v
 43  toWord64 :: v -> Word64
 44  getType :: v -> QBE.ExtType
 45
 46  floatToInt :: QBE.ExtType -> Bool -> v -> Maybe v
 47  intToFloat :: QBE.ExtType -> Bool -> v -> Maybe v
 48  extendFloat :: v -> Maybe v
 49  truncFloat :: v -> Maybe v
 50
 51  -- | Extend a value to the given 'QBE.ExtType'. The 'Bool' is true if
 52  -- the value should be sign-extended, otherwise it is zero-extended.
 53  -- If the @v@ is a float or if the current size exceeds (or is equal to)
 54  -- the size of 'QBE.ExtType', then 'Nothing' is returned.
 55  extend :: QBE.ExtType -> Bool -> v -> Maybe v
 56
 57  -- | Extract the least significant bits of a @v@. The bits to extract
 58  -- are deduced from the given 'QBE.ExtType'. Returns 'Nothing' if the
 59  -- 'QBE.ExtType' is a float type, if the value is a float, or if the size
 60  -- of 'QBE.ExtType' exceeds the size of @v@.
 61  extract :: QBE.ExtType -> v -> Maybe v
 62
 63  -- | Addition.
 64  add :: v -> v -> Maybe v
 65
 66  -- | Subtraction.
 67  sub :: v -> v -> Maybe v
 68
 69  -- | Multiplication.
 70  mul :: v -> v -> Maybe v
 71
 72  -- | Unsigned division.
 73  div :: v -> v -> Maybe v
 74
 75  -- | Unsigned remainder.
 76  urem :: v -> v -> Maybe v
 77
 78  -- | Signed remainder.
 79  srem :: v -> v -> Maybe v
 80
 81  -- | Unsigned division.
 82  udiv :: v -> v -> Maybe v
 83
 84  -- | Bitwise or.
 85  or :: v -> v -> Maybe v
 86
 87  -- | Bitwise xor.
 88  xor :: v -> v -> Maybe v
 89
 90  -- | Bitwise and.
 91  and :: v -> v -> Maybe v
 92
 93  -- | Unary negation.
 94  neg :: v -> Maybe v
 95
 96  -- | Arithmetic right shift, preserving the sign bit of the shifted value.
 97  -- Shift amount must always be a 32-bit value, the shifted value must be 32- or 64-bit.
 98  sar :: v -> v -> Maybe v
 99
100  -- | Logical shift right, filling the newly freed bits with zeroes.
101  -- Shift amount must always be a 32-bit value, the shifted value must be 32- or 64-bit.
102  shr :: v -> v -> Maybe v
103
104  -- | Logical shift left, always fills the freed bits with zeroes.
105  -- Shift amount must always be a 32-bit value, the shifted value must be 32- or 64-bit.
106  shl :: v -> v -> Maybe v
107
108  -- | Check for equality.
109  eq :: v -> v -> Maybe v
110
111  -- | Check if two values are not equal.
112  ne :: v -> v -> Maybe v
113
114  -- | Signed less than or equal to.
115  sle :: v -> v -> Maybe v
116
117  -- | Signed less than.
118  slt :: v -> v -> Maybe v
119
120  -- | Signed greater than or equal to.
121  sge :: v -> v -> Maybe v
122
123  -- | Signed greater than.
124  sgt :: v -> v -> Maybe v
125
126  -- | Unsigned less than or equal to.
127  ule :: v -> v -> Maybe v
128
129  -- | Unsigned less than.
130  ult :: v -> v -> Maybe v
131
132  -- | Unsigned greater than or equal to.
133  uge :: v -> v -> Maybe v
134
135  -- | Unsigned greater then.
136  ugt :: v -> v -> Maybe v
137
138  -- | Ordered, no operand is a NaN.
139  -- Only defined for floating points, must return 'Nothing' otherwise.
140  ord :: v -> v -> Maybe v
141
142  -- | Unordered, at least one operand is a NaN.
143  -- Only defined for floating points, must return 'Nothing' otherwise.
144  unord :: v -> v -> Maybe v
145  unord lhs rhs = ord lhs rhs >>= neg
146
147-- | Convert a string to a list of 8-bit values represented through 'ValueRepr'.
148fromString :: (ValueRepr v) => String -> [v]
149fromString = map (\c -> fromLit QBE.Byte (fromIntegral $ C.ord c))
150
151-- | Inverse of 'fromString'.
152toString :: (ValueRepr v) => [v] -> String
153toString = map (\b -> C.chr (fromIntegral $ toWord64 b))
154
155-- | Convert a Boolean value to a 64-bit value in 'ValueRepr'.
156boolToValue :: (ValueRepr v) => Bool -> v
157boolToValue True = fromLit (QBE.Base QBE.Long) 1
158boolToValue False = fromLit (QBE.Base QBE.Long) 0
159
160-- | Map a 'QBE.IntCmpOp' to the corresponding function from 'ValueRepr'.
161compareIntExpr :: (ValueRepr v) => QBE.IntCmpOp -> (v -> v -> Maybe v)
162compareIntExpr QBE.IEq = eq
163compareIntExpr QBE.INe = ne
164compareIntExpr QBE.ISle = sle
165compareIntExpr QBE.ISlt = slt
166compareIntExpr QBE.ISge = sge
167compareIntExpr QBE.ISgt = sgt
168compareIntExpr QBE.IUle = ule
169compareIntExpr QBE.IUlt = ult
170compareIntExpr QBE.IUge = uge
171compareIntExpr QBE.IUgt = ugt
172{-# INLINE compareIntExpr #-}
173
174-- | Map a 'QBE.FloatCmpOp' to the corresponding function from 'ValueRepr'.
175compareFloatExpr :: (ValueRepr v) => QBE.FloatCmpOp -> (v -> v -> Maybe v)
176compareFloatExpr QBE.FEq = eq
177compareFloatExpr QBE.FNe = ne
178compareFloatExpr QBE.FLe = sle
179compareFloatExpr QBE.FLt = slt
180compareFloatExpr QBE.FGe = sge
181compareFloatExpr QBE.FGt = sgt
182compareFloatExpr QBE.FOrd = ord
183compareFloatExpr QBE.FUnord = unord
184{-# INLINE compareFloatExpr #-}