diff --git a/gyehoek.cabal b/gyehoek.cabal index 10b604f..ece1ef0 100644 --- a/gyehoek.cabal +++ b/gyehoek.cabal @@ -66,7 +66,7 @@ library , base ^>=4.21.2.0 , binary , containers - , cradle + , typed-process , effectful , effectful-core , effectful-plugin @@ -89,6 +89,7 @@ library , text-short , unordered-containers , vector + , bytestring hs-source-dirs: src default-language: GHC2024 diff --git a/src/Gyehoek/CPS/Lower.hs b/src/Gyehoek/CPS/Lower.hs index f8f1186..4e77b7a 100644 --- a/src/Gyehoek/CPS/Lower.hs +++ b/src/Gyehoek/CPS/Lower.hs @@ -183,10 +183,10 @@ lower' g e@(ExpApply f xs ktail) = do (ref.cast (ref $closure)) (struct.get $closure $code) (return_call_ref $cont-type) - ;; (@gyehoek todo - ;; (f' ##{f'}) - ;; (ktail #{l})) - |] + (@gyehoek todo + (f' ##{f'}) + (ktail #{l})) + |] lower' g e@(ExpContinue k xs) = do let nargs = length xs diff --git a/src/Gyehoek/Driver.hs b/src/Gyehoek/Driver.hs index 5957edc..4e71747 100644 --- a/src/Gyehoek/Driver.hs +++ b/src/Gyehoek/Driver.hs @@ -16,11 +16,18 @@ import qualified Gyehoek.Sexp as Sexp import qualified Gyehoek.Scheme.Syntax as Scm import qualified Data.Text.Encoding as T import System.IO (Handle) +import System.IO qualified as IO import Gyehoek.CPS.Convert import Gyehoek.CPS.Lower import Gyehoek.CPS.Syntax qualified as Cps import Control.Monad import Text.Pretty.Simple (pShowNoColor) +import System.Process.Typed +import Data.Text.Encoding (encodeUtf8) +import System.Environment.Blank (getEnvDefault) +import GHC.Conc (atomically) +import qualified Data.Text.IO as TIO +import qualified Data.ByteString.Lazy as BS main :: IO () @@ -59,6 +66,31 @@ readScm f = Sexp.parseSexps @Scm.CommandOrDef (fileName f) <$> hGetContents h >>= either error (pure . Scm.MkProgram) +inspectWasm :: IOE :> es => Text -> Eff es () +inspectWasm wat = do + pager_cmd <- liftIO $ getEnvDefault "PAGER" "less" + let wasmtools_cfg + = proc "wasm-tools" ["print", "-pf", "--print-operand-stack" + ,"--color", "always", "-"] + -- & setStdin (byteStringInput . view lazy . encodeUtf8 $ wat) + -- & setStdout byteStringOutput + & setStdin createPipe + & setStdout createPipe + & setStderr inherit + let pager_cfg = proc pager_cmd [] + & setStdin createPipe + & setStdout inherit + & setStderr inherit + liftIO $ withProcessWait_ wasmtools_cfg \wasmtools -> do + TIO.hPutStrLn (getStdin wasmtools) wat + IO.hFlush (getStdin wasmtools) + IO.hClose (getStdin wasmtools) + withProcessWait_ pager_cfg \pager -> do + t <- BS.hGetContents (getStdout wasmtools) + BS.hPut (getStdin pager) t + IO.hFlush (getStdin pager) + IO.hClose (getStdin pager) + driver :: (GenSym :> es, FileSystem :> es, IOE :> es) => Options -> Eff es () @@ -70,8 +102,11 @@ driver opts = do when opts.dumpCPS do hPutStrLn FS.stdout $ Sexp.encodePretty cps ^?! _Right wat <- lowerProgram cps - withFile opts.output FS.WriteMode \h -> - hPutStrLn h wat + if not opts.inspectWasm then + withFile opts.output FS.WriteMode \h -> + hPutStrLn h wat + else + inspectWasm wat parse_e2e :: FilePath -> IO Scm.Program parse_e2e = runEff . runFileSystem . readScm diff --git a/src/Gyehoek/Options.hs b/src/Gyehoek/Options.hs index 6c80dd3..64243c9 100644 --- a/src/Gyehoek/Options.hs +++ b/src/Gyehoek/Options.hs @@ -19,6 +19,7 @@ data Options = MkOptions -- , dumpQBE :: Maybe FilePath dumpCPS :: Bool , dumpParsed :: Bool + , inspectWasm :: Bool , output :: FilePath , sourceFile :: FilePath } @@ -49,10 +50,12 @@ parseOutput = strOption parseDumpCPS = switch (long "dump-cps") parseDumpParsed = switch (long "dump-parsed") +parseInspectWasm = switch $ long "inspect-wasm" <> short 'p' parser :: Parser Options parser = MkOptions <$> parseDumpCPS <*> parseDumpParsed + <*> parseInspectWasm <*> parseOutput <*> argument str (metavar "FILE")