diff options
| -rw-r--r-- | compiler/GHC/CmmToAsm/Wasm/Asm.hs | 1 | ||||
| -rw-r--r-- | compiler/GHC/CmmToAsm/Wasm/FromCmm.hs | 31 | ||||
| -rw-r--r-- | compiler/GHC/CmmToAsm/Wasm/Types.hs | 1 |
3 files changed, 29 insertions, 4 deletions
diff --git a/compiler/GHC/CmmToAsm/Wasm/Asm.hs b/compiler/GHC/CmmToAsm/Wasm/Asm.hs index 5ccce28676..6f342818a4 100644 --- a/compiler/GHC/CmmToAsm/Wasm/Asm.hs +++ b/compiler/GHC/CmmToAsm/Wasm/Asm.hs @@ -359,6 +359,7 @@ asmTellWasmInstr ty_word instr = case instr of WasmF32DemoteF64 -> asmTellLine "f32.demote_f64" WasmF64PromoteF32 -> asmTellLine "f64.promote_f32" WasmAbs ty -> asmTellLine $ asmFromWasmType ty <> ".abs" + WasmNeg ty -> asmTellLine $ asmFromWasmType ty <> ".neg" WasmCond t -> do asmTellLine "if" asmWithTab $ asmTellWasmInstr ty_word t diff --git a/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs b/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs index 7016613d9d..e1ca600cba 100644 --- a/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs +++ b/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs @@ -224,6 +224,28 @@ extendSubword W32 TagI64 (WasmExpr instr) = WasmExpr $ instr `WasmConcat` WasmI64Extend32S extendSubword _ _ expr = expr +-- | Lower an unary homogeneous operation. +lower_MO_Un_Homo :: + ( forall pre t. + WasmTypeTag t -> + WasmInstr + w + (t : pre) + (t : pre) + ) -> + CLabel -> + CmmType -> + [CmmExpr] -> + WasmCodeGenM w (SomeWasmExpr w) +lower_MO_Un_Homo op lbl t0 [x] = case someWasmTypeFromCmmType t0 of + SomeWasmType ty -> do + WasmExpr x_instr <- lower_CmmExpr_Typed lbl ty x + pure $ + SomeWasmExpr ty $ + WasmExpr $ + x_instr `WasmConcat` op ty +lower_MO_Un_Homo _ _ _ _ = panic "lower_MO_Un_Homo: unreachable" + -- | Lower a binary homogeneous operation. Homogeneous: result type is -- the same with operand types. lower_MO_Bin_Homo :: @@ -699,11 +721,12 @@ lower_CmmMachOp lbl (MO_F_Sub w0) xs = lbl (cmmFloat w0) xs -lower_CmmMachOp lbl (MO_F_Neg w0) [x] = - lower_CmmMachOp +lower_CmmMachOp lbl (MO_F_Neg w0) xs = + lower_MO_Un_Homo + WasmNeg lbl - (MO_F_Sub w0) - [CmmLit $ CmmFloat 0 w0, x] + (cmmFloat w0) + xs lower_CmmMachOp lbl (MO_F_Mul w0) xs = lower_MO_Bin_Homo WasmMul diff --git a/compiler/GHC/CmmToAsm/Wasm/Types.hs b/compiler/GHC/CmmToAsm/Wasm/Types.hs index fa3287f0ec..284d62b173 100644 --- a/compiler/GHC/CmmToAsm/Wasm/Types.hs +++ b/compiler/GHC/CmmToAsm/Wasm/Types.hs @@ -305,6 +305,7 @@ data WasmInstr :: WasmType -> [WasmType] -> [WasmType] -> Type where WasmF32DemoteF64 :: WasmInstr w ('F64 : pre) ('F32 : pre) WasmF64PromoteF32 :: WasmInstr w ('F32 : pre) ('F64 : pre) WasmAbs :: WasmTypeTag t -> WasmInstr w (t : pre) (t : pre) + WasmNeg :: WasmTypeTag t -> WasmInstr w (t : pre) (t : pre) WasmCond :: WasmInstr w pre pre -> WasmInstr w (w : pre) pre newtype WasmExpr w t = WasmExpr (forall pre. WasmInstr w pre (t : pre)) |