refactor internal frontend interface

- add unified frontend configuration record to make adding future
  options easier
- use ExceptT throughout, rather than using runExceptT at internal
  boundaries

src/Language/SystemVerilog/Parser.hs

@@ -1,39 +1,62 @@
+{-# LANGUAGE TupleSections #-}
 {- sv2v
  - Author: Zachary Snow <zach@zachjs.com>
  -}
 module Language.SystemVerilog.Parser
-    ( parseFiles
+    ( initialEnv
+    , parseFiles
+    , Config(..)
     ) where
 
 import Control.Monad.Except
+import Data.List (elemIndex)
 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.Preprocess (preprocess, annotate, Env, Contents)
 
--- parses a compilation unit given include search paths and predefined macros
+data Config = Config
-parseFiles :: [FilePath] -> [(String, String)] -> Bool -> Bool -> [FilePath] -> IO (Either String [AST])
+    { cfEnv :: Env
-parseFiles includePaths defines siloed skipPreprocessor paths = do
+    , cfIncludePaths :: [FilePath]
-    let env = Map.map (\a -> (a, [])) $ Map.fromList defines
+    , cfSiloed :: Bool
-    runExceptT (parseFiles' includePaths env siloed skipPreprocessor paths)
+    , cfSkipPreprocessor :: Bool
+    }
 
--- parses a compilation unit given include search paths and predefined macros
+-- parse CLI macro definitions into the internal macro environment format
-parseFiles' :: [FilePath] -> Env -> Bool -> Bool -> [FilePath] -> ExceptT String IO [AST]
+initialEnv :: [String] -> Env
-parseFiles' _ _ _ _ [] = return []
+initialEnv = Map.map (, []) . Map.fromList . map splitDefine
-parseFiles' includePaths env siloed skipPreprocessor (path : paths) = do
-    (ast, envEnd) <- parseFile' includePaths env skipPreprocessor path
-    let envNext = if siloed then env else envEnd
-    asts <- parseFiles' includePaths envNext siloed skipPreprocessor paths
-    return $ ast : asts
 
--- parses a file given include search paths, a table of predefined macros, and
+-- split a raw CLI macro definition at the '=', if present
--- the file path
+splitDefine :: String -> (String, String)
-parseFile' :: [String] -> Env -> Bool -> FilePath -> ExceptT String IO (AST, Env)
+splitDefine str =
-parseFile' includePaths env skipPreprocessor path = do
+    case elemIndex '=' str of
-    let runner = if skipPreprocessor then annotate else preprocess
+        Nothing -> (str, "")
-    preResult <- liftIO $ runner includePaths env path
+        Just idx -> (name, tail rest)
-    (contents, env') <- liftEither preResult
+            where (name, rest) = splitAt idx str
-    tokens <- liftEither $ uncurry lexStr $ unzip contents
+
+-- parse a list of files according to the given configuration
+parseFiles :: Config -> [FilePath] -> ExceptT String IO [AST]
+parseFiles _ [] = return []
+parseFiles config (path : paths) = do
+    (config', ast) <- parseFile config path
+    fmap (ast :) $ parseFiles config' paths
+
+-- parse an individual file, potentially updating the configuration
+parseFile :: Config -> FilePath -> ExceptT String IO (Config, AST)
+parseFile config path = do
+    (config', contents) <- preprocessFile config path
+    tokens <- liftEither $ runExcept $ lexStr contents
     ast <- parse tokens
-    return (ast, env')
+    return (config', ast)
+
+-- preprocess an individual file, potentially updating the configuration
+preprocessFile :: Config -> FilePath -> ExceptT String IO (Config, Contents)
+preprocessFile config path | cfSkipPreprocessor config =
+    fmap (config, ) $ annotate path
+preprocessFile config path = do
+    (env', contents) <- preprocess (cfIncludePaths config) env path
+    let config' = config { cfEnv = if cfSiloed config then env else env' }
+    return (config', contents)
+    where env = cfEnv config

src/Language/SystemVerilog/Parser/Lex.x

@@ -20,6 +20,7 @@ import qualified Data.Set as Set
 import qualified Data.Vector as Vector
 
 import Language.SystemVerilog.Parser.Keywords (specMap)
+import Language.SystemVerilog.Parser.Preprocess (Contents)
 import Language.SystemVerilog.Parser.Tokens
 }
 
@@ -471,10 +472,11 @@ tokens :-
 
 {
 -- lexer entrypoint
-lexStr :: String -> [Position] -> Either String [Token]
+lexStr :: Contents -> Except String [Token]
-lexStr chars positions =
+lexStr contents =
-    runExcept $ postProcess [] tokens
+    postProcess [] tokens
     where
+        (chars, positions) = unzip contents
         tokensRaw = alexScanTokens chars
         positionsVec = Vector.fromList positions
         tokens = map (\tkf -> tkf positionsVec) tokensRaw

src/Language/SystemVerilog/Parser/Preprocess.hs

@@ -11,6 +11,7 @@ module Language.SystemVerilog.Parser.Preprocess
     ( preprocess
     , annotate
     , Env
+    , Contents
     ) where
 
 import Control.Monad.Except
@@ -25,6 +26,7 @@ import qualified Data.Map.Strict as Map
 import Language.SystemVerilog.Parser.Tokens (Position(..))
 
 type Env = Map.Map String (String, [(String, Maybe String)])
+type Contents = [(Char, Position)]
 
 type PPS = StateT PP (ExceptT String IO)
 
@@ -67,36 +69,41 @@ elsifCond defined c =
         _ -> PreviouslyTrue
 
 -- preprocessor entrypoint
-preprocess :: [String] -> Env -> FilePath -> IO (Either String ([(Char, Position)], Env))
+preprocess :: [String] -> Env -> FilePath -> ExceptT String IO (Env, Contents)
 preprocess includePaths env path = do
-    contents <-
+    contents <- liftIO $
         if path == "-"
             then getContents
             else loadFile path
-    let initialState = PP contents [] (Position path 1 1) path env [] includePaths [] [(path, env)]
+    let initialState = PP
-    result <- runExceptT $ execStateT preprocessInput initialState
+            { ppInput        = contents
-    return $ case result of
+            , ppOutput       = []
-        Left msg -> Left msg
+            , ppPosition     = Position path 1 1
-        Right finalState ->
+            , ppFilePath     = path
-            if not $ null $ ppCondStack finalState then
+            , ppEnv          = env
-                Left $ path ++ ": unfinished conditional directives: " ++
+            , ppCondStack    = []
-                    (show $ length $ ppCondStack finalState)
+            , ppIncludePaths = includePaths
-            else
+            , ppMacroStack   = []
-                Right (output, env')
+            , ppIncludeStack = [(path, env)]
-                where
+            }
-                    output = reverse $ ppOutput finalState
+    finalState <- execStateT preprocessInput initialState
-                    env' = ppEnv finalState
+    when (not $ null $ ppCondStack finalState) $
+        throwError $ path ++ ": unfinished conditional directives: " ++
+            (show $ length $ ppCondStack finalState)
+    let env' = ppEnv finalState
+    let output = reverse $ ppOutput finalState
+    return (env', output)
 
 -- position annotator entrypoint used for files that don't need any
 -- preprocessing
-annotate :: [String] -> Env -> FilePath -> IO (Either String ([(Char, Position)], Env))
+annotate :: FilePath -> ExceptT String IO Contents
-annotate _ env path = do
+annotate path = do
-    contents <-
+    contents <- liftIO $
         if path == "-"
             then getContents
             else loadFile path
     let positions = scanl advance (Position path 1 1) contents
-    return $ Right (zip contents positions, env)
+    return $ zip contents positions
 
 -- read in the given file
 loadFile :: FilePath -> IO String

src/sv2v.hs

@@ -9,18 +9,13 @@ import System.IO (hPrint, hPutStrLn, stderr, stdout)
 import System.Exit (exitFailure, exitSuccess)
 
 import Control.Monad (filterM, when, zipWithM_)
-import Data.List (elemIndex, intercalate)
+import Control.Monad.Except (runExceptT)
+import Data.List (intercalate)
 
 import Convert (convert)
 import Job (readJob, Job(..), Write(..))
 import Language.SystemVerilog.AST
-import Language.SystemVerilog.Parser (parseFiles)
+import Language.SystemVerilog.Parser (initialEnv, parseFiles, Config(..))
-
-splitDefine :: String -> (String, String)
-splitDefine str =
-    case elemIndex '=' str of
-        Nothing -> (str, "")
-        Just idx -> (take idx str, drop (idx + 1) str)
 
 isInterface :: Description -> Bool
 isInterface (Part _ _ Interface _ _ _ _ ) = True
@@ -80,9 +75,13 @@ main :: IO ()
 main = do
     job <- readJob
     -- parse the input files
-    let defines = map splitDefine $ define job
+    let config = Config
-    result <- parseFiles (incdir job) defines (siloed job)
+            { cfEnv              = initialEnv (define job)
-        (skipPreprocessor job) (files job)
+            , cfIncludePaths     = incdir job
+            , cfSiloed           = siloed job
+            , cfSkipPreprocessor = skipPreprocessor job
+            }
+    result <- runExceptT $ parseFiles config (files job)
     case result of
         Left msg -> do
             hPutStrLn stderr msg