msyds/haskell-wasm
1
0
Fork 0
forked from GitHub/haskell-wasm
Code Pull Requests Activity

make parser monadic

Browse Source
This commit is contained in:
Ilya Rezvov
2018-04-15 18:54:39 -07:00
parent a5e16c6e7b
commit a1ae58b5f7
3 changed files with 7 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Language/Wasm/Parser.y
+3 -2
View File
@@ -101,6 +101,7 @@ import Debug.Trace as Debug
%name parseModule mod
%name parseModuleFields modAsFields
%name parseScript script
%monad { Either String }
%tokentype { Lexeme }
%token
@@ -1355,8 +1356,8 @@ data ModuleField =
| MFData DataSegment
deriving(Show, Eq, Generic, NFData)
happyError (Lexeme _ EOF : []) = error $ "Error occuried during parsing phase at the end of file"
happyError (Lexeme (AlexPn abs line col) tok : tokens) = error $
happyError (Lexeme _ EOF : []) = Left $ "Error occuried during parsing phase at the end of file"
happyError (Lexeme (AlexPn abs line col) tok : tokens) = Left $
"Error occuried during parsing phase. " ++
"Line " ++ show line ++ ", " ++
"Column " ++ show col ++ ", " ++
src/Language/Wasm/Script.hs
+2 -2
View File
@@ -144,7 +144,7 @@ runScript onAssertFail script = do
buildModule :: ModuleDef -> (Maybe Ident, Struct.Module)
buildModule (RawModDef ident m) = (ident, m)
buildModule (TextModDef ident textRep) =
let Right m = Parser.parseModule <$> Lexer.scanner (TLEncoding.encodeUtf8 textRep) in
let Right m = Lexer.scanner (TLEncoding.encodeUtf8 textRep) >>= Parser.parseModule in
(ident, m)
buildModule (BinaryModDef ident binaryRep) =
let Right m = Binary.decodeModuleLazy binaryRep in
@@ -199,7 +199,7 @@ runScript onAssertFail script = do
++ show (getFailureString reason)
in onAssertFail msg assert
runAssert st assert@(AssertMalformed (TextModDef _ textRep) failureString) =
case DeepSeq.force $ Parser.parseModule <$> Lexer.scanner (TLEncoding.encodeUtf8 textRep) of
case DeepSeq.force $ Lexer.scanner (TLEncoding.encodeUtf8 textRep) >>= Parser.parseModule of
Right _ -> onAssertFail ("Module parsing should fail with failure string " ++ show failureString) assert
Left _ -> return ()
runAssert st assert@(AssertMalformed (BinaryModDef ident binaryRep) failureString) =