diff --git a/compiler/GHC/CmmToAsm/Wasm/Asm.hs b/compiler/GHC/CmmToAsm/Wasm/Asm.hs index e4f03ef3afefdde76c50c972682e4ee19af5a33b..392ab34b7fbd5f3f412698e217ac39fd073a91ad 100644 --- a/compiler/GHC/CmmToAsm/Wasm/Asm.hs +++ b/compiler/GHC/CmmToAsm/Wasm/Asm.hs @@ -374,6 +374,7 @@ asmTellWasmInstr ty_word instr = case instr of WasmF32DemoteF64 -> asmTellLine "f32.demote_f64" WasmF64PromoteF32 -> asmTellLine "f64.promote_f32" WasmAbs ty -> asmTellLine $ asmFromWasmType ty <> ".abs" + WasmSqrt ty -> asmTellLine $ asmFromWasmType ty <> ".sqrt" WasmNeg ty -> asmTellLine $ asmFromWasmType ty <> ".neg" WasmMin ty -> asmTellLine $ asmFromWasmType ty <> ".min" WasmMax ty -> asmTellLine $ asmFromWasmType ty <> ".max" diff --git a/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs b/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs index cb408ba3f6159ba7c0b1d6b893c5cbc1428e0b62..b50795bff7e6593ce9ac6be169add47dce2c041f 100644 --- a/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs +++ b/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs @@ -1108,6 +1108,28 @@ lower_CMO_Un_Homo lbl op [reg] [x] = do x_instr `WasmConcat` WasmCCall op `WasmConcat` WasmLocalSet ty ri lower_CMO_Un_Homo _ _ _ _ = panic "lower_CMO_Un_Homo: unreachable" +-- | Lower an unary homogeneous 'CallishMachOp' to a primitive operation. +lower_CMO_Un_Homo_Prim :: + CLabel -> + ( forall pre t. + WasmTypeTag t -> + WasmInstr + w + (t : pre) + (t : pre) + ) -> + WasmTypeTag t -> + [CmmFormal] -> + [CmmActual] -> + WasmCodeGenM w (WasmStatements w) +lower_CMO_Un_Homo_Prim lbl op ty [reg] [x] = do + (ri, _) <- onCmmLocalReg reg + WasmExpr x_instr <- lower_CmmExpr_Typed lbl ty x + pure $ + WasmStatements $ + x_instr `WasmConcat` op ty `WasmConcat` WasmLocalSet ty ri +lower_CMO_Un_Homo_Prim _ _ _ _ _ = panic "lower_CMO_Bin_Homo_Prim: unreachable" + -- | Lower a binary homogeneous 'CallishMachOp' to a ccall. lower_CMO_Bin_Homo :: CLabel -> @@ -1211,8 +1233,8 @@ lower_CallishMachOp lbl MO_F64_Log rs xs = lower_CMO_Un_Homo lbl "log" rs xs lower_CallishMachOp lbl MO_F64_Log1P rs xs = lower_CMO_Un_Homo lbl "log1p" rs xs lower_CallishMachOp lbl MO_F64_Exp rs xs = lower_CMO_Un_Homo lbl "exp" rs xs lower_CallishMachOp lbl MO_F64_ExpM1 rs xs = lower_CMO_Un_Homo lbl "expm1" rs xs -lower_CallishMachOp lbl MO_F64_Fabs rs xs = lower_CMO_Un_Homo lbl "fabs" rs xs -lower_CallishMachOp lbl MO_F64_Sqrt rs xs = lower_CMO_Un_Homo lbl "sqrt" rs xs +lower_CallishMachOp lbl MO_F64_Fabs rs xs = lower_CMO_Un_Homo_Prim lbl WasmAbs TagF64 rs xs +lower_CallishMachOp lbl MO_F64_Sqrt rs xs = lower_CMO_Un_Homo_Prim lbl WasmSqrt TagF64 rs xs lower_CallishMachOp lbl MO_F32_Pwr rs xs = lower_CMO_Bin_Homo lbl "powf" rs xs lower_CallishMachOp lbl MO_F32_Sin rs xs = lower_CMO_Un_Homo lbl "sinf" rs xs lower_CallishMachOp lbl MO_F32_Cos rs xs = lower_CMO_Un_Homo lbl "cosf" rs xs @@ -1235,8 +1257,8 @@ lower_CallishMachOp lbl MO_F32_Log1P rs xs = lower_CallishMachOp lbl MO_F32_Exp rs xs = lower_CMO_Un_Homo lbl "expf" rs xs lower_CallishMachOp lbl MO_F32_ExpM1 rs xs = lower_CMO_Un_Homo lbl "expm1f" rs xs -lower_CallishMachOp lbl MO_F32_Fabs rs xs = lower_CMO_Un_Homo lbl "fabsf" rs xs -lower_CallishMachOp lbl MO_F32_Sqrt rs xs = lower_CMO_Un_Homo lbl "sqrtf" rs xs +lower_CallishMachOp lbl MO_F32_Fabs rs xs = lower_CMO_Un_Homo_Prim lbl WasmAbs TagF32 rs xs +lower_CallishMachOp lbl MO_F32_Sqrt rs xs = lower_CMO_Un_Homo_Prim lbl WasmSqrt TagF32 rs xs lower_CallishMachOp lbl (MO_UF_Conv w0) rs xs = lower_MO_UF_Conv lbl w0 rs xs lower_CallishMachOp _ MO_AcquireFence _ _ = pure $ WasmStatements WasmNop lower_CallishMachOp _ MO_ReleaseFence _ _ = pure $ WasmStatements WasmNop diff --git a/compiler/GHC/CmmToAsm/Wasm/Types.hs b/compiler/GHC/CmmToAsm/Wasm/Types.hs index 8738428237f6a5d16814110b3d675f3ee554cd7d..1b85f03c856fc200568228ee3bf5542a3a05e230 100644 --- a/compiler/GHC/CmmToAsm/Wasm/Types.hs +++ b/compiler/GHC/CmmToAsm/Wasm/Types.hs @@ -310,6 +310,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) + WasmSqrt :: WasmTypeTag t -> WasmInstr w (t : pre) (t : pre) WasmNeg :: WasmTypeTag t -> WasmInstr w (t : pre) (t : pre) WasmMin :: WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre) WasmMax :: WasmTypeTag t -> WasmInstr w (t : t : pre) (t : pre)