diff options
author | Cheng Shao <terrorjack@type.dance> | 2022-12-10 20:06:31 +0000 |
---|---|---|
committer | Cheng Shao <terrorjack@type.dance> | 2022-12-16 21:16:28 +0000 |
commit | e3104eab043d743ae01066d79f0306e64e82d776 (patch) | |
tree | 674d6cfa8b853898f032929c080d7428a2f1301e /compiler | |
parent | 1f3abd855849074471619860d6c3cc58ccfadf94 (diff) | |
download | haskell-e3104eab043d743ae01066d79f0306e64e82d776.tar.gz |
compiler: add missing export list of GHC.CmmToAsm.Wasm.FromCmm
Also removes some unreachable code here.
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/GHC/CmmToAsm/Wasm/FromCmm.hs | 70 |
1 files changed, 7 insertions, 63 deletions
diff --git a/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs b/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs index 43c9c2fd31..c406038f10 100644 --- a/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs +++ b/compiler/GHC/CmmToAsm/Wasm/FromCmm.hs @@ -13,7 +13,13 @@ {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} {-# HLINT ignore "Use camelCase" #-} -module GHC.CmmToAsm.Wasm.FromCmm where +module GHC.CmmToAsm.Wasm.FromCmm + ( alignmentFromWordType, + globalInfoFromCmmGlobalReg, + supportedCmmGlobalRegs, + onCmmGroup, + ) +where import Control.Monad import qualified Data.ByteString as BS @@ -196,41 +202,6 @@ supportedCmmGlobalRegs = <> [LongReg i | i <- [1 .. 1]] <> [Sp, SpLim, Hp, HpLim, CCCS] --- | Allocate a fresh symbol for an internal data section. -allocDataSection :: DataSection -> WasmCodeGenM w SymName -allocDataSection sec = do - u <- wasmUniq - let sym = fromString $ ".L" <> show u - wasmModifyM $ \s -> - s - { dataSections = - addToUniqMap (dataSections s) sym sec - } - pure sym - --- | Print a debug message to stderr by calling @fputs()@. We don't --- bother to check @fputs()@ return value. -wasmDebugMsg :: String -> WasmCodeGenM w (WasmStatements w) -wasmDebugMsg msg = do - ty_word_cmm <- wasmWordCmmTypeM - sym_buf <- - allocDataSection - DataSection - { dataSectionKind = - SectionROData, - dataSectionAlignment = - mkAlignment 1, - dataSectionContents = - [DataASCII $ fromString $ msg <> "\NUL"] - } - onFuncSym "fputs" [ty_word_cmm, ty_word_cmm] [b32] - pure $ - WasmStatements $ - WasmSymConst sym_buf - `WasmConcat` WasmSymConst "__stderr_FILE" - `WasmConcat` WasmCCall "fputs" - `WasmConcat` WasmDrop - -- | Truncate a subword. truncSubword :: Width -> WasmTypeTag t -> WasmExpr w t -> WasmExpr w t truncSubword W8 ty (WasmExpr instr) = @@ -1060,33 +1031,6 @@ 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 inline assembly. -lower_CMO_Un_Prim :: - CLabel -> - (forall pre t. WasmTypeTag t -> WasmInstr w (t : pre) (t : pre)) -> - [CmmFormal] -> - [CmmActual] -> - WasmCodeGenM w (WasmStatements w) -lower_CMO_Un_Prim lbl op [reg] [x] = do - (ri, SomeWasmType ty) <- onCmmLocalReg reg - SomeWasmExpr ty_x (WasmExpr x_instr) <- lower_CmmExpr lbl x - if - | Just Refl <- ty `testEquality` ty_x -> - pure $ - WasmStatements $ - x_instr `WasmConcat` op ty_x `WasmConcat` WasmLocalSet ty ri - | TagI32 <- ty, - TagI64 <- - ty_x -> - pure $ - WasmStatements $ - x_instr - `WasmConcat` op ty_x - `WasmConcat` WasmI32WrapI64 - `WasmConcat` WasmLocalSet ty ri - | otherwise -> panic "lower_CMO_Un_Prim: unreachable" -lower_CMO_Un_Prim _ _ _ _ = panic "lower_CMO_Un_Prim: unreachable" - -- | Lower a binary homogeneous 'CallishMachOp' to a ccall. lower_CMO_Bin_Homo :: CLabel -> |