From 6c4183c930d86a51f75ba61d87b8f97c43eaa2b2 Mon Sep 17 00:00:00 2001 From: Ilya Rezvov Date: Mon, 16 Apr 2018 15:37:28 -0700 Subject: [PATCH] check if optional labels match for block instructions --- src/Language/Wasm/Lexer.x | 20 ++--- src/Language/Wasm/Parser.y | 156 +++++++++++++++++++++++-------------- tests/Test.hs | 2 +- 3 files changed, 110 insertions(+), 68 deletions(-) diff --git a/src/Language/Wasm/Lexer.x b/src/Language/Wasm/Lexer.x index b8b0929..365a266 100644 --- a/src/Language/Wasm/Lexer.x +++ b/src/Language/Wasm/Lexer.x @@ -124,31 +124,31 @@ parseHexalSignedInt :: AlexAction Lexeme parseHexalSignedInt = token $ \(pos, _, s, _) len -> let (sign, slen) = parseSign s in let num = readHexFromPrefix (len - 2 - slen) $ LBSUtf8.drop (2 + slen) s in - Lexeme pos $ TIntLit $ sign num + Lexeme (Just pos) $ TIntLit $ sign num parseNanSigned :: AlexAction Lexeme parseNanSigned = token $ \(pos, _, s, _) len -> let (sign, slen) = parseSign s in let num = readHexFromPrefix (len - 6 - slen) $ LBSUtf8.drop (6 + slen) s in - Lexeme pos $ TFloatLit $ sign $ makeNaN $ fromIntegral num + Lexeme (Just pos) $ TFloatLit $ sign $ makeNaN $ fromIntegral num parseDecimalSignedInt :: AlexAction Lexeme parseDecimalSignedInt = token $ \(pos, _, s, _) len -> let (sign, slen) = parseSign s in let num = readDecFromPrefix (len - slen) $ LBSUtf8.drop slen s in - Lexeme pos $ TIntLit $ sign num + Lexeme (Just pos) $ TIntLit $ sign num parseDecFloat :: AlexAction Lexeme parseDecFloat = token $ \(pos, _, s, _) len -> let (sign, slen) = parseSign s in let str = filter (/= '_') $ takeChars (len - slen) $ LBSUtf8.drop slen s in - Lexeme pos $ TFloatLit $ sign $ readDecFloat str + Lexeme (Just pos) $ TFloatLit $ sign $ readDecFloat str parseHexFloat :: AlexAction Lexeme parseHexFloat = token $ \(pos, _, s, _) len -> let (sign, slen) = parseSign s in let ('0' : 'x' : str) = filter (/= '_') $ takeChars (len - slen) $ LBS.drop slen s in - Lexeme pos $ TFloatLit $ sign $ readHexFloat str + Lexeme (Just pos) $ TFloatLit $ sign $ readHexFloat str startBlockComment :: AlexAction Lexeme startBlockComment _inp _len = do @@ -212,13 +212,13 @@ endStringLiteral (pos, _, _inp, _) _len = do setLexerStringFlag False str <- LBS.pack . reverse <$> getLexerStringValue setLexerStringValue [] - return $ Lexeme pos $ TStringLit str + return $ Lexeme (Just pos) $ TStringLit str tokenStr :: (LBS.ByteString -> Token) -> AlexAction Lexeme -tokenStr f = token $ \(pos, _, s, _) len -> (Lexeme pos $ f $ LBS.take len s) +tokenStr f = token $ \(pos, _, s, _) len -> (Lexeme (Just pos) $ f $ LBS.take len s) constToken :: Token -> AlexAction Lexeme -constToken tok = token $ \(pos, _, _, _) _len -> (Lexeme pos tok) +constToken tok = token $ \(pos, _, _, _) _len -> (Lexeme (Just pos) tok) {- End Lexem Helpers -} @@ -233,7 +233,7 @@ data Token = TKeyword LBS.ByteString | EOF deriving (Show, Eq) -data Lexeme = Lexeme { pos :: AlexPosn, tok :: Token } deriving (Show, Eq) +data Lexeme = Lexeme { pos :: Maybe AlexPosn, tok :: Token } deriving (Show, Eq) data AlexUserState = AlexUserState { lexerCommentDepth :: Int, @@ -280,7 +280,7 @@ addCharCodeToLexerStringValue c = Alex $ \s -> let ust = alex_ust s in Right (s{ alex_ust = ust{ lexerStringValue = c : lexerStringValue ust } }, ()) -alexEOF = return $ Lexeme (error "Trying to read EOF position") EOF +alexEOF = return $ Lexeme Nothing EOF takeChars :: Int64 -> LBS.ByteString -> String takeChars n str = reverse $ go n str [] diff --git a/src/Language/Wasm/Parser.y b/src/Language/Wasm/Parser.y index 67f69c3..16e7e6f 100644 --- a/src/Language/Wasm/Parser.y +++ b/src/Language/Wasm/Parser.y @@ -66,7 +66,7 @@ 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.Maybe (fromMaybe, fromJust, isNothing) import Data.List (foldl', findIndex, find) import Control.Monad (guard) @@ -323,10 +323,7 @@ import Debug.Trace as Debug 'output' { Lexeme _ (TKeyword "output") } -- script extension end id { Lexeme _ (TId $$) } -u32 { Lexeme _ (TIntLit (asUInt32 -> Just $$)) } -i32 { Lexeme _ (TIntLit (asInt32 -> Just $$)) } -i64 { Lexeme _ (TIntLit (asInt64 -> Just $$)) } -unrestricted_int { Lexeme _ (TIntLit $$) } +int { Lexeme _ (TIntLit $$) } f64 { Lexeme _ (TFloatLit $$) } offset { Lexeme _ (TKeyword (asOffset -> Just $$)) } align { Lexeme _ (TKeyword (asAlign -> Just $$)) } @@ -383,26 +380,32 @@ memidx :: { MemoryIndex } | ident { Named $1 } int32 :: { Integer } - : u32 { fromIntegral $1 } - | i32 { $1 } + : int {% + if $1 >= -(2^31) && $1 < 2^32 + then Right $1 + else Left ("Int literal value is out of signed int32 boundaries: " ++ show $1) + } + +u32 :: { Natural } + : int {% + if $1 >= 0 && $1 < 2^32 + then Right (fromIntegral $1) + else Left ("Int literal value is out of unsigned int32 boundaries: " ++ show $1) + } int64 :: { Integer } - : u32 { fromIntegral $1 } - | i32 { $1 } - | i64 { $1 } + : int {% + if $1 >= -(2^63) && $1 < 2^64 + then Right $1 + else Left ("Int literal value is out of signed int64 boundaries: " ++ show $1) + } float32 :: { Float } - : u32 { fromIntegral $1 } - | i32 { fromIntegral $1 } - | i64 { fromIntegral $1 } - | unrestricted_int { fromIntegral $1 } + : int { fromIntegral $1 } | f64 { asFloat32 $1 } float64 :: { Double } - : u32 { fromIntegral $1 } - | i32 { fromIntegral $1 } - | i64 { fromIntegral $1 } - | unrestricted_int { fromIntegral $1 } + : int { fromIntegral $1 } | f64 { $1 } plaininstr :: { PlainInstr } @@ -644,56 +647,104 @@ instruction :: { [Instruction] } raw_instr :: { [Instruction] } : plaininstr { [PlainInstr $1] } | 'call_indirect' raw_call_indirect { $2 } - | 'block' opt(ident) raw_block { [$3 $2] } - | 'loop' opt(ident) raw_loop { [$3 $2] } - | 'if' opt(ident) raw_if_result { $3 $2 } + | 'block' opt(ident) raw_block {% (: []) `fmap` $3 $2 } + | 'loop' opt(ident) raw_loop {% (: []) `fmap` $3 $2 } + | 'if' opt(ident) raw_if_result {% $3 $2 } -raw_block :: { Maybe Ident -> Instruction } - : 'end' opt(ident) { \ident -> BlockInstr ident [] [] } - | raw_instr list(instruction) 'end' opt(ident) { \ident -> BlockInstr ident [] ($1 ++ concat $2) } +raw_block :: { Maybe Ident -> Either String Instruction } + : 'end' opt(ident) { + \ident -> + if ident == $2 || isNothing $2 + then Right $ BlockInstr ident [] [] + else Left "Block labels have to match" + } + | raw_instr list(instruction) 'end' opt(ident) { + \ident -> + if ident == $4 || isNothing $4 + then Right $ BlockInstr ident [] ($1 ++ concat $2) + else Left "Block labels have to match" + } | '(' raw_block1 { $2 } -raw_block1 :: { Maybe Ident -> Instruction } +raw_block1 :: { Maybe Ident -> Either String Instruction } : 'result' valtype ')' list(instruction) 'end' opt(ident) { - \ident -> BlockInstr ident [$2] (concat $4) + \ident -> + if ident == $6 || isNothing $6 + then Right $ BlockInstr ident [$2] (concat $4) + else Left "Block labels have to match" } | foldedinstr1 list(instruction) 'end' opt(ident) { - \ident -> BlockInstr ident [] ($1 ++ concat $2) + \ident -> + if ident == $4 || isNothing $4 + then Right $ BlockInstr ident [] ($1 ++ concat $2) + else Left "Block labels have to match" } -raw_loop :: { Maybe Ident -> Instruction } - : 'end' opt(ident) { \ident -> LoopInstr ident [] [] } +raw_loop :: { Maybe Ident -> Either String Instruction } + : 'end' opt(ident) { + \ident -> + if ident == $2 || isNothing $2 + then Right $ LoopInstr ident [] [] + else Left "Loop labels have to match" + } | raw_instr list(instruction) 'end' opt(ident) { - \ident -> LoopInstr ident [] ($1 ++ concat $2) + \ident -> + if ident == $4 || isNothing $4 + then Right $ LoopInstr ident [] ($1 ++ concat $2) + else Left "Loop labels have to match" } | '(' raw_loop1 { $2 } -raw_loop1 :: { Maybe Ident -> Instruction } +raw_loop1 :: { Maybe Ident -> Either String Instruction } : 'result' valtype ')' list(instruction) 'end' opt(ident) { - \ident -> LoopInstr ident [$2] (concat $4) + \ident -> + if ident == $6 || isNothing $6 + then Right $ LoopInstr ident [$2] (concat $4) + else Left "Loop labels have to match" } | foldedinstr1 list(instruction) 'end' opt(ident) { - \ident -> LoopInstr ident [] ($1 ++ concat $2) + \ident -> + if ident == $4 || isNothing $4 + then Right $ LoopInstr ident [] ($1 ++ concat $2) + else Left "Loop labels have to match" } -raw_if_result :: { Maybe Ident -> [Instruction] } - : raw_else { \ident -> [IfInstr ident [] [] $1] } +raw_if_result :: { Maybe Ident -> Either String [Instruction] } + : raw_else { + \ident -> + if ident == (snd $1) || isNothing (snd $1) + then Right [IfInstr ident [] [] $ fst $1] + else Left "If labels have to match" + } | raw_instr list(instruction) raw_else { - \ident -> [IfInstr ident [] ($1 ++ concat $2) $3] + \ident -> + if ident == (snd $3) || isNothing (snd $3) + then Right [IfInstr ident [] ($1 ++ concat $2) $ fst $3] + else Left "If labels have to match" } | '(' raw_if_result1 { $2 } -raw_if_result1 :: { Maybe Ident -> [Instruction] } +raw_if_result1 :: { Maybe Ident -> Either String [Instruction] } : 'result' valtype ')' list(instruction) raw_else { - \ident -> [IfInstr ident [$2] (concat $4) $5] + \ident -> + if ident == (snd $5) || isNothing (snd $5) + then Right [IfInstr ident [$2] (concat $4) $ fst $5] + else Left "If labels have to match" } | foldedinstr1 list(instruction) raw_else { - \ident -> [IfInstr ident [] ($1 ++ concat $2) $3] + \ident -> + if ident == (snd $3) || isNothing (snd $3) + then Right [IfInstr ident [] ($1 ++ concat $2) $ fst $3] + else Left "If labels have to match" } -raw_else :: { [Instruction] } - : 'end' opt(ident) { [] } - | 'else' opt(ident) list(instruction) 'end' opt(ident) { concat $3 } +raw_else :: { ([Instruction], Maybe Ident) } + : 'end' opt(ident) { ([], $2) } + | 'else' opt(ident) list(instruction) 'end' opt(ident) {% + if matchIdents $2 $5 + then Right (concat $3, if isNothing $2 then $5 else $2) + else Left "If labels have to match" + } raw_call_indirect :: { [Instruction] } : '(' raw_call_indirect_typeuse { (PlainInstr $ CallIndirect $ fst $2) : snd $2 } @@ -1100,20 +1151,10 @@ prependFuncResults prep f@(Function { funcType = AnonimousTypeUse ft }) = mergeFuncType :: FuncType -> FuncType -> FuncType mergeFuncType (FuncType lps lrs) (FuncType rps rrs) = FuncType (lps ++ rps) (lrs ++ rrs) -asUInt32 :: Integer -> Maybe Natural -asUInt32 val - | val >= 0, val < 2 ^ 32 = Just $ fromIntegral val - | otherwise = Nothing - -asInt32 :: Integer -> Maybe Integer -asInt32 val - | val >= -2 ^ 31, val < 2 ^ 32 = Just $ fromIntegral val - | otherwise = Nothing - -asInt64 :: Integer -> Maybe Integer -asInt64 val - | val >= -2 ^ 63, val < 2 ^ 64 = Just $ fromIntegral val - | otherwise = Nothing +matchIdents :: Maybe Ident -> Maybe Ident -> Bool +matchIdents Nothing _ = True +matchIdents _ Nothing = True +matchIdents a b = a == b asFloat32 :: Double -> Float asFloat32 v = doubleToFloat v @@ -1372,7 +1413,8 @@ data ModuleField = deriving(Show, Eq, Generic, NFData) happyError (Lexeme _ EOF : []) = Left $ "Error occuried during parsing phase at the end of file" -happyError (Lexeme (AlexPn abs line col) tok : tokens) = Left $ +happyError (Lexeme Nothing tok : tokens) = Left $ "Error occuried during parsing phase at the end of file" +happyError (Lexeme (Just (AlexPn abs line col)) tok : tokens) = Left $ "Error occuried during parsing phase. " ++ "Line " ++ show line ++ ", " ++ "Column " ++ show col ++ ", " ++ diff --git a/tests/Test.hs b/tests/Test.hs index ac6a7ac..e0dbd81 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 = ["utf8-invalid-encoding.wast"] + -- let files = ["int_literals.wast"] scriptTestCases <- (`mapM` files) $ \file -> do content <- LBS.readFile $ "tests/samples/" ++ file let Right script = Lexer.scanner content >>= Parser.parseScript