diff --git a/exec/Main.hs b/exec/Main.hs new file mode 100644 index 0000000..4a4d38e --- /dev/null +++ b/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 [ + "\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.") \ No newline at end of file diff --git a/src/Language/Wasm/Binary.hs b/src/Language/Wasm/Binary.hs index be5603d..fe443e7 100644 --- a/src/Language/Wasm/Binary.hs +++ b/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.Int (Int8) +import Data.Word (Word8, Word32, Word64) +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 (I64Const val) = putWord8 0x42 >> putSLEB128 val + put (I32Const val) = putWord8 0x41 >> putSLEB128 (asInt32 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 diff --git a/wasm.cabal b/wasm.cabal index 4696d53..6fc85a2 100644 --- a/wasm.cabal +++ b/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