Merge branch 'master' into type-enforced-ast

exec/Main.hs

@@ -0,0 +1,153 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Base64.Lazy as Base64
+import Data.Maybe (fromMaybe)
+
+import qualified Language.Wasm.Lexer as Lexer
+import qualified Language.Wasm.Parser as Parser
+import qualified Language.Wasm.Binary as Binary
+
+import Options.Applicative
+import Data.Semigroup ((<>))
+
+{-
+wasm compile INPUT -o output -f js -f binary
+wasm exec --script INPUT
+wasm validate INPUT -f binary -f text
+wasm link 
+-}
+
+data CompileOutFormat = OutJS | OutBinary | OutHTML deriving (Eq)
+data ExecMod = Plain | Script deriving (Show, Eq)
+data Input = InpText | InpBinary deriving (Eq)
+
+instance Read CompileOutFormat where
+  readsPrec _ "js" = [(OutJS, "")]
+  readsPrec _ "binary" = [(OutBinary, "")]
+  readsPrec _ "html" = [(OutHTML, "")]
+  readsPrec _ _ = error "Unknown compilation output foramt"
+
+instance Show CompileOutFormat where
+  show OutJS = "js"
+  show OutBinary = "binary"
+  show OutHTML = "html"
+
+instance Read Input where
+  readsPrec _ "text" = [(InpText, "")]
+  readsPrec _ "binary" = [(InpBinary, "")]
+  readsPrec _ _ = error "Unknown validation input foramt"
+
+instance Show Input where
+  show InpText = "text"
+  show InpBinary = "binary"
+
+data WasmCommand
+  = Compile {
+    input :: String,
+    output :: String,
+    outFormat :: CompileOutFormat
+  }
+  | Exec {
+    input :: String,
+    mode :: ExecMod,
+    inpFormat :: Input
+  }
+  | Validate {
+    input :: String,
+    inpFormat :: Input
+  }
+  deriving (Show, Eq)
+
+compileArgs = Compile
+  <$> argument str (metavar "FILE")
+  <*> strOption (
+      long "out"
+      <> short 'o'
+      <> metavar "FILE"
+      <> help "Distination for compilation"
+    )
+  <*> option auto (
+      long "format"
+      <> short 'f'
+      <> help "Output file format"
+      <> showDefault
+      <> value OutBinary
+    )
+
+execArgs = Exec
+  <$> argument str (metavar "FILE")
+  <*> flag Plain Script (long "script" <> help "Execute file in script mode")
+  <*> option auto (
+    long "format"
+    <> short 'f'
+    <> help "Input file format"
+    <> showDefault
+    <> value InpText
+  )
+
+validateArgs = Validate
+  <$> argument str (metavar "FILE")
+  <*> option auto (
+      long "format"
+      <> short 'f'
+      <> help "Input file format"
+      <> showDefault
+      <> value InpText
+    )
+
+config :: Parser WasmCommand
+config = subparser (
+    command "compile" (info compileArgs (progDesc "Compile WebAssembly file from text representation"))
+    <> command "exec" (info execArgs (progDesc "Compile WebAssembly file if needed and execute"))
+    <> command "validate" (info validateArgs (progDesc "Validate WebAssembly file"))
+  )
+
+toBinary :: LBS.ByteString -> Either String LBS.ByteString
+toBinary content = do
+    lexemes <- Lexer.scanner content
+    mod <- Parser.parseModule lexemes
+    return $ Binary.dumpModuleLazy mod
+
+compileAs :: (LBS.ByteString -> LBS.ByteString) -> String -> String -> IO ()
+compileAs transform input output = do
+  content <- LBS.readFile input
+  case toBinary content of
+    Right binary ->
+      LBS.writeFile output $ transform binary
+    Left reason ->
+      putStrLn $ "Cannot complie module: " ++ reason
+
+binary :: LBS.ByteString -> LBS.ByteString
+binary = id
+
+js :: LBS.ByteString -> LBS.ByteString
+js binary =
+    let asBase64 = Base64.encode binary in
+    LBS.concat [
+      "const bytes = Uint8Array.from(atob('" <> asBase64 <> "'), c => c.charCodeAt(0));\n",
+      "WebAssembly.instantiate(bytes, {}).then(res => console.log(res.instance))\n"
+    ]
+
+html :: LBS.ByteString -> LBS.ByteString
+html binary =
+    LBS.concat [
+      "<script>\n",
+      js binary,
+      "</script>\n"
+    ]
+
+exec :: WasmCommand -> IO ()
+exec (Compile inp out OutBinary) = compileAs binary inp out
+exec (Compile inp out OutJS) = compileAs js inp out
+exec (Compile inp out OutHTML) = compileAs html inp out
+exec command = putStrLn $ "command is not implemented yet: " ++ show command
+
+main :: IO ()
+main = execParser opts >>= exec
+  where
+    opts = info (config <**> helper)
+      (fullDesc
+        <> progDesc "WebAssembly Toolkit"
+        <> header "This tool can compile text representation to binary format, validate module in text or binary representation and so on.")

src/Language/Wasm/Binary.hs

@@ -12,14 +12,26 @@ import Language.Wasm.Structure
 
 import Numeric.Natural (Natural)
 import Data.Bits
-import Data.Word (Word8)
+import Data.Word (Word8, Word32, Word64)
-import Data.Int (Int8)
+import Data.Int (Int8, Int32, Int64)
 import Data.Serialize
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Encoding as TLEncoding
 
+asInt32 :: Word32 -> Int32
+asInt32 w =
+    if w < 0x80000000
+    then fromIntegral w
+    else -1 * fromIntegral (0xFFFFFFFF - w + 1)
+
+asInt64 :: Word64 -> Int64
+asInt64 w =
+    if w < 0x8000000000000000
+    then fromIntegral w
+    else -1 * fromIntegral (0xFFFFFFFFFFFFFFFF - w + 1)
+
 getULEB128 :: (Integral a, Bits a) => Int -> Get a
 getULEB128 bitsBudget = do
     if bitsBudget > 0 then return () else fail "integer representation too long"
@@ -348,8 +360,8 @@ instance Serialize Instruction where
     put CurrentMemory = putWord8 0x3F >> putWord8 0x00
     put GrowMemory = putWord8 0x40 >> putWord8 0x00
     -- Numeric instructions
-    put (I32Const val) = putWord8 0x41 >> putSLEB128 val
+    put (I32Const val) = putWord8 0x41 >> putSLEB128 (asInt32 val)
-    put (I64Const val) = putWord8 0x42 >> putSLEB128 val
+    put (I64Const val) = putWord8 0x42 >> putSLEB128 (asInt64 val)
     put (F32Const val) = putWord8 0x43 >> putFloat32le val
     put (F64Const val) = putWord8 0x44 >> putFloat64le val
     put I32Eqz = putWord8 0x45

wasm.cabal

@@ -52,6 +52,16 @@ library
       Paths_wasm
   default-language: Haskell2010
 
+executable wasm
+  main-is: Main.hs
+  hs-source-dirs: exec
+  build-depends:
+      base >=4.6 && <5.0
+    , wasm ==0.1.0
+    , optparse-applicative >= 0.14
+    , bytestring >=0.10 && <0.11
+    , base64-bytestring >= 1.0
+
 test-suite test
   type: exitcode-stdio-1.0
   main-is: Test.hs