diff --git a/src/Language/SystemVerilog/Parser.hs b/src/Language/SystemVerilog/Parser.hs index 5d60a94..7f8874e 100644 --- a/src/Language/SystemVerilog/Parser.hs +++ b/src/Language/SystemVerilog/Parser.hs @@ -6,13 +6,11 @@ module Language.SystemVerilog.Parser ) where import Control.Monad.Except -import Control.Monad.State.Strict import qualified Data.Map.Strict as Map import Language.SystemVerilog.AST (AST) import Language.SystemVerilog.Parser.Lex (lexStr) import Language.SystemVerilog.Parser.Parse (parse) import Language.SystemVerilog.Parser.Preprocess (preprocess, annotate, Env) -import Language.SystemVerilog.Parser.Tokens (Position(..), tokenPosition) -- parses a compilation unit given include search paths and predefined macros parseFiles :: [FilePath] -> [(String, String)] -> Bool -> Bool -> [FilePath] -> IO (Either String [AST]) @@ -37,9 +35,5 @@ parseFile' includePaths env skipPreprocessor path = do preResult <- liftIO $ runner includePaths env path (contents, env') <- liftEither preResult tokens <- liftEither $ uncurry lexStr $ unzip contents - let position = - if null tokens - then Position path 1 1 - else tokenPosition $ head tokens - ast <- evalStateT parse (position, tokens) + ast <- parse tokens return (ast, env') diff --git a/src/Language/SystemVerilog/Parser/Parse.y b/src/Language/SystemVerilog/Parser/Parse.y index 61a983b..fe3a3ad 100644 --- a/src/Language/SystemVerilog/Parser/Parse.y +++ b/src/Language/SystemVerilog/Parser/Parse.y @@ -25,7 +25,7 @@ import Language.SystemVerilog.Parser.Tokens %monad { ParseState } %lexer { positionKeep } { TokenEOF } -%name parse +%name parseMain %tokentype { Token } %error { parseError } @@ -1385,7 +1385,7 @@ StmtTrace :: { Stmt } Trace :: { String } : position { "Trace: " ++ show $1 } position :: { Position } - : {- empty -} {% gets fst } + : {- empty -} {% gets pPosition } end : "end" {} | error {% missingToken "end" } endclass : "endclass" {} | error {% missingToken "endclass" } @@ -1399,26 +1399,39 @@ join : "join" {} | error {% missingToken "join" } { -type ParseState = StateT (Position, [Token]) (ExceptT String IO) +data ParseData = ParseData + { pPosition :: Position + , pTokens :: [Token] + } + +type ParseState = StateT ParseData (ExceptT String IO) + +parse :: [Token] -> ExceptT String IO AST +parse [] = return [] +parse tokens = + evalStateT parseMain initialState + where + position = tokenPosition $ head tokens + initialState = ParseData position tokens posInject :: (Position -> a) -> ParseState a posInject cont = do - pos <- gets fst + pos <- gets pPosition return $ cont pos positionKeep :: (Token -> ParseState a) -> ParseState a positionKeep cont = do - tokens <- gets snd + tokens <- gets pTokens case tokens of [] -> cont TokenEOF tok : toks -> do - put (tokenPosition tok, toks) + put $ ParseData (tokenPosition tok) toks cont tok parseError :: Token -> ParseState a parseError a = case a of TokenEOF -> do - p <- gets fst + p <- gets pPosition throwError $ show p ++ ": Parse error: unexpected end of file." Token t s p -> throwError $ show p ++ ": Parse error: unexpected token '" ++ s ++ "' (" ++ show t ++ ")." @@ -1487,7 +1500,7 @@ addMIAttr attr item = MIAttr attr item missingToken :: String -> ParseState a missingToken expected = do - p <- gets fst + p <- gets pPosition throwError $ show p ++ ": Parse error: missing expected `" ++ expected ++ "`" }