Commit bdafb60d by Zachary Snow

lexical and parse errors print to stderr

parent 7267f94b
...@@ -5,29 +5,32 @@ module Language.SystemVerilog.Parser ...@@ -5,29 +5,32 @@ module Language.SystemVerilog.Parser
( parseFiles ( parseFiles
) where ) where
import Control.Monad.Except
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
import Language.SystemVerilog.AST (AST) import Language.SystemVerilog.AST (AST)
import Language.SystemVerilog.Parser.Lex (lexFile, Env) import Language.SystemVerilog.Parser.Lex (lexFile, Env)
import Language.SystemVerilog.Parser.Parse (parse) import Language.SystemVerilog.Parser.Parse (parse)
-- parses a compilation unit given include search paths and predefined macros -- parses a compilation unit given include search paths and predefined macros
parseFiles :: [FilePath] -> [(String, String)] -> [FilePath] -> IO [AST] parseFiles :: [FilePath] -> [(String, String)] -> Bool -> [FilePath] -> IO (Either String [AST])
parseFiles includePaths defines paths = do parseFiles includePaths defines siloed paths = do
let env = Map.map (\a -> (a, [])) $ Map.fromList defines let env = Map.map (\a -> (a, [])) $ Map.fromList defines
parseFiles' includePaths env paths runExceptT (parseFiles' includePaths env siloed paths)
-- parses a compilation unit given include search paths and predefined macros -- parses a compilation unit given include search paths and predefined macros
parseFiles' :: [FilePath] -> Env -> [FilePath] -> IO [AST] parseFiles' :: [FilePath] -> Env -> Bool -> [FilePath] -> ExceptT String IO [AST]
parseFiles' _ _ [] = return [] parseFiles' _ _ _ [] = return []
parseFiles' includePaths env (path : paths) = do parseFiles' includePaths env siloed (path : paths) = do
(ast, env') <- parseFile' includePaths env path (ast, envEnd) <- parseFile' includePaths env path
asts <- parseFiles' includePaths env' paths let envNext = if siloed then env else envEnd
asts <- parseFiles' includePaths envNext siloed paths
return $ ast : asts return $ ast : asts
-- parses a file given include search paths, a table of predefined macros, and -- parses a file given include search paths, a table of predefined macros, and
-- the file path -- the file path
parseFile' :: [String] -> Env -> FilePath -> IO (AST, Env) parseFile' :: [String] -> Env -> FilePath -> ExceptT String IO (AST, Env)
parseFile' includePaths env path = do parseFile' includePaths env path = do
(tokens, env') <- lexFile includePaths env path result <- liftIO $ lexFile includePaths env path
let ast = parse tokens (tokens, env') <- liftEither result
ast <- parse tokens
return (ast, env') return (ast, env')
...@@ -511,16 +511,16 @@ alexInitUserState :: AlexUserState ...@@ -511,16 +511,16 @@ alexInitUserState :: AlexUserState
alexInitUserState = LS [] "" Map.empty [] [] alexInitUserState = LS [] "" Map.empty [] []
-- public-facing lexer entrypoint -- public-facing lexer entrypoint
lexFile :: [String] -> Env -> FilePath -> IO ([Token], Env) lexFile :: [String] -> Env -> FilePath -> IO (Either String ([Token], Env))
lexFile includePaths env path = do lexFile includePaths env path = do
str <- readFile path str <- readFile path
let result = runAlex str $ setEnv >> alexMonadScan >> get let result = runAlex str $ setEnv >> alexMonadScan >> get
return $ case result of return $ case result of
Left msg -> error $ "Lexical Error: " ++ msg Left msg -> Left msg
Right finalState -> Right finalState ->
if null $ lsCondStack finalState if null $ lsCondStack finalState
then (reverse $ lsToks finalState, lsEnv finalState) then Right (reverse $ lsToks finalState, lsEnv finalState)
else error $ "unfinished conditional directives: " ++ else Left $ path ++ ": unfinished conditional directives: " ++
(show $ length $ lsCondStack finalState) (show $ length $ lsCondStack finalState)
where where
setEnv = do setEnv = do
...@@ -541,7 +541,7 @@ lexicalError :: String -> Alex a ...@@ -541,7 +541,7 @@ lexicalError :: String -> Alex a
lexicalError msg = do lexicalError msg = do
(pn, _, _, _) <- alexGetInput (pn, _, _, _) <- alexGetInput
pos <- toTokPos pn pos <- toTokPos pn
alexError $ msg ++ ", at " ++ show pos alexError $ "Lexical error: " ++ msg ++ ", at " ++ show pos
-- get the current user state -- get the current user state
get :: Alex AlexUserState get :: Alex AlexUserState
......
...@@ -13,11 +13,13 @@ ...@@ -13,11 +13,13 @@
{ {
module Language.SystemVerilog.Parser.Parse (parse) where module Language.SystemVerilog.Parser.Parse (parse) where
import Control.Monad.Except
import Language.SystemVerilog.AST import Language.SystemVerilog.AST
import Language.SystemVerilog.Parser.ParseDecl import Language.SystemVerilog.Parser.ParseDecl
import Language.SystemVerilog.Parser.Tokens import Language.SystemVerilog.Parser.Tokens
} }
%monad { ExceptT String IO }
%name parse %name parse
%tokentype { Token } %tokentype { Token }
%error { parseError } %error { parseError }
...@@ -1194,10 +1196,10 @@ DimFn :: { DimFn } ...@@ -1194,10 +1196,10 @@ DimFn :: { DimFn }
{ {
parseError :: [Token] -> a parseError :: [Token] -> ExceptT String IO a
parseError a = case a of parseError a = case a of
[] -> error "Parse error: no tokens left to parse." [] -> throwError $ "Parse error: no tokens left to parse."
Token t s p : _ -> error $ "Parse error: unexpected token '" ++ s ++ "' (" ++ show t ++ ") at " ++ show p ++ "." Token t s p : _ -> throwError $ "Parse error: unexpected token '" ++ s ++ "' (" ++ show t ++ ") at " ++ show p ++ "."
genItemsToGenItem :: [GenItem] -> GenItem genItemsToGenItem :: [GenItem] -> GenItem
genItemsToGenItem [x] = x genItemsToGenItem [x] = x
......
...@@ -22,16 +22,15 @@ main :: IO () ...@@ -22,16 +22,15 @@ main :: IO ()
main = do main = do
job <- readJob job <- readJob
-- parse the input files -- parse the input files
let includePaths = incdir job
let defines = map splitDefine $ define job let defines = map splitDefine $ define job
let singleton = \x -> [x] result <- parseFiles (incdir job) defines (siloed job) (files job)
let toFileLists = if siloed job then map singleton else singleton case result of
astLists <- mapM Left msg -> do
(parseFiles includePaths defines) hPutStr stderr $ msg ++ "\n"
(toFileLists $ files job) exitFailure
let asts = concat astLists Right asts -> do
-- convert the files -- convert the files
let asts' = convert (exclude job) asts let asts' = convert (exclude job) asts
-- print the converted files out -- print the converted files out
hPrint stdout $ concat asts' hPrint stdout $ concat asts'
exitSuccess exitSuccess
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment