aboutsummaryrefslogtreecommitdiffstats
path: root/src/Verismith/Verilog/Preprocess.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Verismith/Verilog/Preprocess.hs')
-rw-r--r--src/Verismith/Verilog/Preprocess.hs163
1 files changed, 80 insertions, 83 deletions
diff --git a/src/Verismith/Verilog/Preprocess.hs b/src/Verismith/Verilog/Preprocess.hs
index 91356f1..909334b 100644
--- a/src/Verismith/Verilog/Preprocess.hs
+++ b/src/Verismith/Verilog/Preprocess.hs
@@ -1,23 +1,21 @@
-{-|
-Module : Verismith.Verilog.Preprocess
-Description : Simple preprocessor for `define and comments.
-Copyright : (c) 2011-2015 Tom Hawkins, 2019 Yann Herklotz
-License : GPL-3
-Maintainer : yann [at] yannherklotz [dot] com
-Stability : experimental
-Portability : POSIX
-
-Simple preprocessor for `define and comments.
-
-The code is from https://github.com/tomahawkins/verilog.
-
-Edits to the original code are warning fixes and formatting changes.
--}
-
+-- |
+-- Module : Verismith.Verilog.Preprocess
+-- Description : Simple preprocessor for `define and comments.
+-- Copyright : (c) 2011-2015 Tom Hawkins, 2019 Yann Herklotz
+-- License : GPL-3
+-- Maintainer : yann [at] yannherklotz [dot] com
+-- Stability : experimental
+-- Portability : POSIX
+--
+-- Simple preprocessor for `define and comments.
+--
+-- The code is from https://github.com/tomahawkins/verilog.
+--
+-- Edits to the original code are warning fixes and formatting changes.
module Verismith.Verilog.Preprocess
- ( uncomment
- , preprocess
- )
+ ( uncomment,
+ preprocess,
+ )
where
-- | Remove comments from code. There is no difference between @(* *)@ and
@@ -27,84 +25,83 @@ uncomment :: FilePath -> String -> String
uncomment file = uncomment'
where
uncomment' a = case a of
- "" -> ""
- '/' : '/' : rest -> " " ++ removeEOL rest
- '/' : '*' : rest -> " " ++ remove rest
- '(' : '*' : rest -> " " ++ remove rest
- '"' : rest -> '"' : ignoreString rest
- b : rest -> b : uncomment' rest
-
+ "" -> ""
+ '/' : '/' : rest -> " " ++ removeEOL rest
+ '/' : '*' : rest -> " " ++ remove rest
+ '(' : '*' : rest -> " " ++ remove rest
+ '"' : rest -> '"' : ignoreString rest
+ b : rest -> b : uncomment' rest
removeEOL a = case a of
- "" -> ""
- '\n' : rest -> '\n' : uncomment' rest
- '\t' : rest -> '\t' : removeEOL rest
- _ : rest -> ' ' : removeEOL rest
-
+ "" -> ""
+ '\n' : rest -> '\n' : uncomment' rest
+ '\t' : rest -> '\t' : removeEOL rest
+ _ : rest -> ' ' : removeEOL rest
remove a = case a of
- "" -> error $ "File ended without closing comment (*/): " ++ file
- '"' : rest -> removeString rest
- '\n' : rest -> '\n' : remove rest
- '\t' : rest -> '\t' : remove rest
- '*' : '/' : rest -> " " ++ uncomment' rest
- '*' : ')' : rest -> " " ++ uncomment' rest
- _ : rest -> " " ++ remove rest
-
+ "" -> error $ "File ended without closing comment (*/): " ++ file
+ '"' : rest -> removeString rest
+ '\n' : rest -> '\n' : remove rest
+ '\t' : rest -> '\t' : remove rest
+ '*' : '/' : rest -> " " ++ uncomment' rest
+ '*' : ')' : rest -> " " ++ uncomment' rest
+ _ : rest -> " " ++ remove rest
removeString a = case a of
- "" -> error $ "File ended without closing string: " ++ file
- '"' : rest -> " " ++ remove rest
- '\\' : '"' : rest -> " " ++ removeString rest
- '\n' : rest -> '\n' : removeString rest
- '\t' : rest -> '\t' : removeString rest
- _ : rest -> ' ' : removeString rest
-
+ "" -> error $ "File ended without closing string: " ++ file
+ '"' : rest -> " " ++ remove rest
+ '\\' : '"' : rest -> " " ++ removeString rest
+ '\n' : rest -> '\n' : removeString rest
+ '\t' : rest -> '\t' : removeString rest
+ _ : rest -> ' ' : removeString rest
ignoreString a = case a of
- "" -> error $ "File ended without closing string: " ++ file
- '"' : rest -> '"' : uncomment' rest
- '\\' : '"' : rest -> "\\\"" ++ ignoreString rest
- b : rest -> b : ignoreString rest
+ "" -> error $ "File ended without closing string: " ++ file
+ '"' : rest -> '"' : uncomment' rest
+ '\\' : '"' : rest -> "\\\"" ++ ignoreString rest
+ b : rest -> b : ignoreString rest
-- | A simple `define preprocessor.
preprocess :: [(String, String)] -> FilePath -> String -> String
-preprocess env file content = unlines $ pp True [] env $ lines $ uncomment
- file
- content
+preprocess env file content =
+ unlines $ pp True [] env $ lines $
+ uncomment
+ file
+ content
where
pp :: Bool -> [Bool] -> [(String, String)] -> [String] -> [String]
- pp _ _ _ [] = []
+ pp _ _ _ [] = []
pp on stack env_ (a : rest) = case words a of
- "`define" : name : value ->
- ""
- : pp
- on
- stack
- (if on
- then (name, ppLine env_ $ unwords value) : env_
- else env_
- )
- rest
- "`ifdef" : name : _ ->
- "" : pp (on && elem name (map fst env_)) (on : stack) env_ rest
- "`ifndef" : name : _ ->
- "" : pp (on && notElem name (map fst env_)) (on : stack) env_ rest
- "`else" : _
- | not $ null stack
- -> "" : pp (head stack && not on) stack env_ rest
- | otherwise
- -> error $ "`else without associated `ifdef/`ifndef: " ++ file
- "`endif" : _
- | not $ null stack
- -> "" : pp (head stack) (tail stack) env_ rest
- | otherwise
- -> error $ "`endif without associated `ifdef/`ifndef: " ++ file
- _ -> (if on then ppLine env_ a else "") : pp on stack env_ rest
+ "`define" : name : value ->
+ ""
+ : pp
+ on
+ stack
+ ( if on
+ then (name, ppLine env_ $ unwords value) : env_
+ else env_
+ )
+ rest
+ "`ifdef" : name : _ ->
+ "" : pp (on && elem name (map fst env_)) (on : stack) env_ rest
+ "`ifndef" : name : _ ->
+ "" : pp (on && notElem name (map fst env_)) (on : stack) env_ rest
+ "`else" : _
+ | not $ null stack ->
+ "" : pp (head stack && not on) stack env_ rest
+ | otherwise ->
+ error $ "`else without associated `ifdef/`ifndef: " ++ file
+ "`endif" : _
+ | not $ null stack ->
+ "" : pp (head stack) (tail stack) env_ rest
+ | otherwise ->
+ error $ "`endif without associated `ifdef/`ifndef: " ++ file
+ _ -> (if on then ppLine env_ a else "") : pp on stack env_ rest
ppLine :: [(String, String)] -> String -> String
-ppLine _ "" = ""
+ppLine _ "" = ""
ppLine env ('`' : a) = case lookup name env of
- Just value -> value ++ ppLine env rest
- Nothing -> error $ "Undefined macro: `" ++ name ++ " Env: " ++ show env
+ Just value -> value ++ ppLine env rest
+ Nothing -> error $ "Undefined macro: `" ++ name ++ " Env: " ++ show env
where
- name = takeWhile
+ name =
+ takeWhile
(flip elem $ ['A' .. 'Z'] ++ ['a' .. 'z'] ++ ['0' .. '9'] ++ ['_'])
a
rest = drop (length name) a
generated by cgit (git 2.34.1) at 2024-05-10 00:43:09 +0000