{-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Strict #-} module GHC.CmmToAsm.Wasm (ncgWasm) where import Data.ByteString.Builder import Data.Maybe import Data.Semigroup import GHC.Cmm import GHC.CmmToAsm.Wasm.Asm import GHC.CmmToAsm.Wasm.FromCmm import GHC.CmmToAsm.Wasm.Types import GHC.Data.Stream (Stream, StreamS (..), runStream) import GHC.Platform import GHC.Prelude import GHC.Types.Unique.Supply import GHC.Unit import System.IO ncgWasm :: Platform -> UniqSupply -> ModLocation -> Handle -> Stream IO RawCmmGroup a -> IO a ncgWasm :: forall a. Platform -> UniqSupply -> ModLocation -> Handle -> Stream IO RawCmmGroup a -> IO a ncgWasm Platform platform UniqSupply us ModLocation loc Handle h Stream IO RawCmmGroup a cmms = do (a r, WasmCodeGenState 'I32 s) <- forall a. Platform -> UniqSupply -> Stream IO RawCmmGroup a -> IO (a, WasmCodeGenState 'I32) streamCmmGroups Platform platform UniqSupply us Stream IO RawCmmGroup a cmms Handle -> Builder -> IO () hPutBuilder Handle h forall a b. (a -> b) -> a -> b $ Builder "# " forall a. Semigroup a => a -> a -> a <> String -> Builder string7 (forall a. HasCallStack => Maybe a -> a fromJust forall a b. (a -> b) -> a -> b $ ModLocation -> Maybe String ml_hs_file ModLocation loc) forall a. Semigroup a => a -> a -> a <> Builder "\n\n" Handle -> Builder -> IO () hPutBuilder Handle h forall a b. (a -> b) -> a -> b $ forall a. WasmAsmM a -> Builder execWasmAsmM forall a b. (a -> b) -> a -> b $ forall (w :: WasmType). WasmTypeTag w -> WasmCodeGenState w -> WasmAsmM () asmTellEverything WasmTypeTag 'I32 TagI32 WasmCodeGenState 'I32 s forall (f :: * -> *) a. Applicative f => a -> f a pure a r streamCmmGroups :: Platform -> UniqSupply -> Stream IO RawCmmGroup a -> IO (a, WasmCodeGenState 'I32) streamCmmGroups :: forall a. Platform -> UniqSupply -> Stream IO RawCmmGroup a -> IO (a, WasmCodeGenState 'I32) streamCmmGroups Platform platform UniqSupply us Stream IO RawCmmGroup a cmms = forall {f :: * -> *} {w :: WasmType} {a}. Monad f => WasmCodeGenState w -> StreamS f RawCmmGroup a -> f (a, WasmCodeGenState w) go (forall (w :: WasmType). Platform -> UniqSupply -> WasmCodeGenState w initialWasmCodeGenState Platform platform UniqSupply us) forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) r' r. Applicative m => Stream m r' r -> StreamS m r' r runStream Stream IO RawCmmGroup a cmms where go :: WasmCodeGenState w -> StreamS f RawCmmGroup a -> f (a, WasmCodeGenState w) go WasmCodeGenState w s (Done a r) = forall (f :: * -> *) a. Applicative f => a -> f a pure (a r, WasmCodeGenState w s) go WasmCodeGenState w s (Effect f (StreamS f RawCmmGroup a) m) = f (StreamS f RawCmmGroup a) m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= WasmCodeGenState w -> StreamS f RawCmmGroup a -> f (a, WasmCodeGenState w) go WasmCodeGenState w s go WasmCodeGenState w s (Yield RawCmmGroup cmm StreamS f RawCmmGroup a k) = WasmCodeGenState w -> StreamS f RawCmmGroup a -> f (a, WasmCodeGenState w) go (forall (w :: WasmType) a. WasmCodeGenM w a -> WasmCodeGenState w -> WasmCodeGenState w wasmExecM (forall (w :: WasmType). RawCmmGroup -> WasmCodeGenM w () onCmmGroup RawCmmGroup cmm) WasmCodeGenState w s) StreamS f RawCmmGroup a k