inspect-wasm

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

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

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

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")