diff --git a/src/Language/Wasm/Binary.hs b/src/Language/Wasm/Binary.hs index a361508..aca9138 100644 --- a/src/Language/Wasm/Binary.hs +++ b/src/Language/Wasm/Binary.hs @@ -23,11 +23,11 @@ import qualified Data.Text.Lazy.Encoding as TLEncoding getULEB128 :: (Integral a, Bits a) => Get a getULEB128 = do val <- getWord8 - if val < 2 ^ 7 + if not (testBit val 7) then return $ fromIntegral val else do rest <- getULEB128 - return $ (fromIntegral $ 0x7F .&. val) + 128 * rest + return $ (fromIntegral $ val .&. 0x7F) .|. (rest `shiftL` 7) putULEB128 :: (Integral a, Bits a) => a -> Put putULEB128 val = @@ -101,8 +101,12 @@ skipCustomSection = do getSection :: SectionType -> Get a -> a -> Get a getSection sectionType parser def = do - nextByte <- lookAhead getWord8 - parseSection $ fromIntegral nextByte + empty <- isEmpty + if empty + then return def + else do + nextByte <- lookAhead getWord8 + parseSection $ fromIntegral nextByte where parseSection op | op == 0 = skipCustomSection >> getSection sectionType parser def diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y index 15adfd5..1bfa227 100644 --- a/src/Language/Wasm/Parser.y +++ b/src/Language/Wasm/Parser.y @@ -63,6 +63,7 @@ import qualified Data.Text.Lazy.Encoding as TLEncoding import qualified Data.Text.Lazy.Read as TLRead import qualified Data.ByteString.Lazy as LBS +import qualified Data.ByteString.Lazy.Char8 as LBSChar8 import Data.Maybe (fromMaybe, fromJust) import Data.List (foldl', findIndex, find) import Control.Monad (guard) @@ -1024,7 +1025,7 @@ command1 :: { Command } | meta1 { Meta $1 } module1 :: { ModuleDef } - : 'module' opt(ident) 'binary' list(string) ')' { BinaryModDef $2 (TLEncoding.encodeUtf8 $ TL.concat $4) } + : 'module' opt(ident) 'binary' list(string) ')' { BinaryModDef $2 (LBSChar8.pack $ TL.unpack $ TL.concat $4) } | 'module' opt(ident) 'quote' list(string) ')' { TextModDef $2 (TL.concat $4) } | 'module' opt(ident) list(modulefield) ')' { RawModDef $2 (desugarize $ concat $3) } | modulefield1 list(modulefield) { RawModDef Nothing (desugarize $ $1 ++ concat $2) } diff --git a/src/Language/Wasm/Validate.hs b/src/Language/Wasm/Validate.hs index d6b5e03..e0cdeb9 100644 --- a/src/Language/Wasm/Validate.hs +++ b/src/Language/Wasm/Validate.hs @@ -510,7 +510,8 @@ globalsShouldBeValid m@Module { imports, globals } = let check = runChecker ctx $ do isConstExpression init t <- getExpressionType init - return $ if isArrowMatch (empty ==> I32) t then Valid else TypeMismatch (empty ==> I32) t + let expected = empty ==> getGlobalType gt + return $ if isArrowMatch expected t then Valid else TypeMismatch t expected in case check of Left err -> err @@ -526,7 +527,7 @@ elemsShouldBeValid m@Module { elems, functions, tables, imports } = let check = runChecker ctx $ do isConstExpression offset t <- getExpressionType offset - return $ if isArrowMatch (empty ==> I32) t then Valid else TypeMismatch (empty ==> I32) t + return $ if isArrowMatch (empty ==> I32) t then Valid else TypeMismatch t (empty ==> I32) in let isIniterValid = case check of Left err -> err @@ -552,7 +553,7 @@ datasShouldBeValid m@Module { datas, mems, imports } = let check = runChecker ctx $ do isConstExpression offset t <- getExpressionType offset - return $ if isArrowMatch (empty ==> I32) t then Valid else TypeMismatch (empty ==> I32) t + return $ if isArrowMatch (empty ==> I32) t then Valid else TypeMismatch t (empty ==> I32) in let isOffsetValid = case check of Left err -> err diff --git a/tests/Test.hs b/tests/Test.hs index 9050d50..8874e31 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -34,7 +34,7 @@ compile file = do main :: IO () main = do files <- Directory.listDirectory "tests/samples" - -- let files = ["memory.wast"] + -- let files = ["binary.wast"] scriptTestCases <- (`mapM` files) $ \file -> do content <- LBS.readFile $ "tests/samples/" ++ file let Right script = Parser.parseScript <$> Lexer.scanner content