diff --git a/src/Language/SystemVerilog/Parser.hs b/src/Language/SystemVerilog/Parser.hs index 6f0e49e..6c0d188 100644 --- a/src/Language/SystemVerilog/Parser.hs +++ b/src/Language/SystemVerilog/Parser.hs @@ -5,29 +5,32 @@ module Language.SystemVerilog.Parser ( parseFiles ) where +import Control.Monad.Except import qualified Data.Map.Strict as Map import Language.SystemVerilog.AST (AST) import Language.SystemVerilog.Parser.Lex (lexFile, Env) import Language.SystemVerilog.Parser.Parse (parse) -- parses a compilation unit given include search paths and predefined macros -parseFiles :: [FilePath] -> [(String, String)] -> [FilePath] -> IO [AST] -parseFiles includePaths defines paths = do +parseFiles :: [FilePath] -> [(String, String)] -> Bool -> [FilePath] -> IO (Either String [AST]) +parseFiles includePaths defines siloed paths = do 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 -parseFiles' :: [FilePath] -> Env -> [FilePath] -> IO [AST] -parseFiles' _ _ [] = return [] -parseFiles' includePaths env (path : paths) = do - (ast, env') <- parseFile' includePaths env path - asts <- parseFiles' includePaths env' paths +parseFiles' :: [FilePath] -> Env -> Bool -> [FilePath] -> ExceptT String IO [AST] +parseFiles' _ _ _ [] = return [] +parseFiles' includePaths env siloed (path : paths) = do + (ast, envEnd) <- parseFile' includePaths env path + let envNext = if siloed then env else envEnd + asts <- parseFiles' includePaths envNext siloed paths return $ ast : asts -- parses a file given include search paths, a table of predefined macros, and -- the file path -parseFile' :: [String] -> Env -> FilePath -> IO (AST, Env) +parseFile' :: [String] -> Env -> FilePath -> ExceptT String IO (AST, Env) parseFile' includePaths env path = do - (tokens, env') <- lexFile includePaths env path - let ast = parse tokens + result <- liftIO $ lexFile includePaths env path + (tokens, env') <- liftEither result + ast <- parse tokens return (ast, env') diff --git a/src/Language/SystemVerilog/Parser/Lex.x b/src/Language/SystemVerilog/Parser/Lex.x index a781b0b..4d72be9 100644 --- a/src/Language/SystemVerilog/Parser/Lex.x +++ b/src/Language/SystemVerilog/Parser/Lex.x @@ -511,16 +511,16 @@ alexInitUserState :: AlexUserState alexInitUserState = LS [] "" Map.empty [] [] -- 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 str <- readFile path let result = runAlex str $ setEnv >> alexMonadScan >> get return $ case result of - Left msg -> error $ "Lexical Error: " ++ msg + Left msg -> Left msg Right finalState -> if null $ lsCondStack finalState - then (reverse $ lsToks finalState, lsEnv finalState) - else error $ "unfinished conditional directives: " ++ + then Right (reverse $ lsToks finalState, lsEnv finalState) + else Left $ path ++ ": unfinished conditional directives: " ++ (show $ length $ lsCondStack finalState) where setEnv = do @@ -541,7 +541,7 @@ lexicalError :: String -> Alex a lexicalError msg = do (pn, _, _, _) <- alexGetInput pos <- toTokPos pn - alexError $ msg ++ ", at " ++ show pos + alexError $ "Lexical error: " ++ msg ++ ", at " ++ show pos -- get the current user state get :: Alex AlexUserState diff --git a/src/Language/SystemVerilog/Parser/Parse.y b/src/Language/SystemVerilog/Parser/Parse.y index f20aba5..b1d5c85 100644 --- a/src/Language/SystemVerilog/Parser/Parse.y +++ b/src/Language/SystemVerilog/Parser/Parse.y @@ -13,11 +13,13 @@ { module Language.SystemVerilog.Parser.Parse (parse) where +import Control.Monad.Except import Language.SystemVerilog.AST import Language.SystemVerilog.Parser.ParseDecl import Language.SystemVerilog.Parser.Tokens } +%monad { ExceptT String IO } %name parse %tokentype { Token } %error { parseError } @@ -1194,10 +1196,10 @@ DimFn :: { DimFn } { -parseError :: [Token] -> a +parseError :: [Token] -> ExceptT String IO a parseError a = case a of - [] -> error "Parse error: no tokens left to parse." - Token t s p : _ -> error $ "Parse error: unexpected token '" ++ s ++ "' (" ++ show t ++ ") at " ++ show p ++ "." + [] -> throwError $ "Parse error: no tokens left to parse." + Token t s p : _ -> throwError $ "Parse error: unexpected token '" ++ s ++ "' (" ++ show t ++ ") at " ++ show p ++ "." genItemsToGenItem :: [GenItem] -> GenItem genItemsToGenItem [x] = x diff --git a/src/sv2v.hs b/src/sv2v.hs index 891b049..ec73afc 100644 --- a/src/sv2v.hs +++ b/src/sv2v.hs @@ -22,16 +22,15 @@ main :: IO () main = do job <- readJob -- parse the input files - let includePaths = incdir job let defines = map splitDefine $ define job - let singleton = \x -> [x] - let toFileLists = if siloed job then map singleton else singleton - astLists <- mapM - (parseFiles includePaths defines) - (toFileLists $ files job) - let asts = concat astLists - -- convert the files - let asts' = convert (exclude job) asts - -- print the converted files out - hPrint stdout $ concat asts' - exitSuccess + result <- parseFiles (incdir job) defines (siloed job) (files job) + case result of + Left msg -> do + hPutStr stderr $ msg ++ "\n" + exitFailure + Right asts -> do + -- convert the files + let asts' = convert (exclude job) asts + -- print the converted files out + hPrint stdout $ concat asts' + exitSuccess