From 7e9fb3379c4ff89cbbd2f5e061a6bfb95732ba17 Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Fri, 6 Aug 2021 22:23:34 -0600 Subject: [PATCH] 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 | 71 ++++++++++++------- src/Language/SystemVerilog/Parser/Lex.x | 8 ++- .../SystemVerilog/Parser/Preprocess.hs | 45 +++++++----- src/sv2v.hs | 21 +++--- 4 files changed, 88 insertions(+), 57 deletions(-) diff --git a/src/Language/SystemVerilog/Parser.hs b/src/Language/SystemVerilog/Parser.hs index 7f8874e..7ba0091 100644 --- a/src/Language/SystemVerilog/Parser.hs +++ b/src/Language/SystemVerilog/Parser.hs @@ -1,39 +1,62 @@ +{-# LANGUAGE TupleSections #-} {- sv2v - Author: Zachary Snow -} 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 -parseFiles :: [FilePath] -> [(String, String)] -> Bool -> Bool -> [FilePath] -> IO (Either String [AST]) -parseFiles includePaths defines siloed skipPreprocessor paths = do - let env = Map.map (\a -> (a, [])) $ Map.fromList defines - runExceptT (parseFiles' includePaths env siloed skipPreprocessor paths) +data Config = Config + { cfEnv :: Env + , cfIncludePaths :: [FilePath] + , cfSiloed :: Bool + , cfSkipPreprocessor :: Bool + } --- parses a compilation unit given include search paths and predefined macros -parseFiles' :: [FilePath] -> Env -> Bool -> Bool -> [FilePath] -> ExceptT String IO [AST] -parseFiles' _ _ _ _ [] = return [] -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 +-- parse CLI macro definitions into the internal macro environment format +initialEnv :: [String] -> Env +initialEnv = Map.map (, []) . Map.fromList . map splitDefine --- parses a file given include search paths, a table of predefined macros, and --- the file path -parseFile' :: [String] -> Env -> Bool -> FilePath -> ExceptT String IO (AST, Env) -parseFile' includePaths env skipPreprocessor path = do - let runner = if skipPreprocessor then annotate else preprocess - preResult <- liftIO $ runner includePaths env path - (contents, env') <- liftEither preResult - tokens <- liftEither $ uncurry lexStr $ unzip contents +-- split a raw CLI macro definition at the '=', if present +splitDefine :: String -> (String, String) +splitDefine str = + case elemIndex '=' str of + Nothing -> (str, "") + Just idx -> (name, tail rest) + where (name, rest) = splitAt idx str + +-- 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 diff --git a/src/Language/SystemVerilog/Parser/Lex.x b/src/Language/SystemVerilog/Parser/Lex.x index fa5f434..23993cd 100644 --- a/src/Language/SystemVerilog/Parser/Lex.x +++ b/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 chars positions = - runExcept $ postProcess [] tokens +lexStr :: Contents -> Except String [Token] +lexStr contents = + postProcess [] tokens where + (chars, positions) = unzip contents tokensRaw = alexScanTokens chars positionsVec = Vector.fromList positions tokens = map (\tkf -> tkf positionsVec) tokensRaw diff --git a/src/Language/SystemVerilog/Parser/Preprocess.hs b/src/Language/SystemVerilog/Parser/Preprocess.hs index 4f730ee..6f607dc 100644 --- a/src/Language/SystemVerilog/Parser/Preprocess.hs +++ b/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)] - result <- runExceptT $ execStateT preprocessInput initialState - return $ case result of - Left msg -> Left msg - Right finalState -> - if not $ null $ ppCondStack finalState then - Left $ path ++ ": unfinished conditional directives: " ++ - (show $ length $ ppCondStack finalState) - else - Right (output, env') - where - output = reverse $ ppOutput finalState - env' = ppEnv finalState + let initialState = PP + { ppInput = contents + , ppOutput = [] + , ppPosition = Position path 1 1 + , ppFilePath = path + , ppEnv = env + , ppCondStack = [] + , ppIncludePaths = includePaths + , ppMacroStack = [] + , ppIncludeStack = [(path, env)] + } + finalState <- execStateT preprocessInput initialState + 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 _ env path = do - contents <- +annotate :: FilePath -> ExceptT String IO Contents +annotate path = do + 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 diff --git a/src/sv2v.hs b/src/sv2v.hs index 5910507..b231509 100644 --- a/src/sv2v.hs +++ b/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) - -splitDefine :: String -> (String, String) -splitDefine str = - case elemIndex '=' str of - Nothing -> (str, "") - Just idx -> (take idx str, drop (idx + 1) str) +import Language.SystemVerilog.Parser (initialEnv, parseFiles, Config(..)) 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 - result <- parseFiles (incdir job) defines (siloed job) - (skipPreprocessor job) (files job) + let config = Config + { cfEnv = initialEnv (define 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