-- |
-- 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,
  )
where

-- | Remove comments from code. There is no difference between @(* *)@ and
-- @/* */@, therefore in this implementation, @*/@ could close @(*@ and vice-versa,
-- This will be fixed in an upcoming version.
uncomment :: FilePath -> String -> String
uncomment :: String -> String -> String
uncomment String
file = String -> String
uncomment'
  where
    uncomment' :: String -> String
uncomment' String
a = case String
a of
      String
"" -> String
""
      Char
'/' : Char
'/' : String
rest -> String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
removeEOL String
rest
      Char
'/' : Char
'*' : String
rest -> String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
remove String
rest
      Char
'(' : Char
'*' : Char
')' : String
rest -> Char
'(' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
'*' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
')' Char -> String -> String
forall a. a -> [a] -> [a]
: String
rest String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
remove String
rest
      Char
'(' : Char
'*' : String
rest -> String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
remove String
rest
      Char
'"' : String
rest -> Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
ignoreString String
rest
      Char
b : String
rest -> Char
b Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
uncomment' String
rest
    removeEOL :: String -> String
removeEOL String
a = case String
a of
      String
"" -> String
""
      Char
'\n' : String
rest -> Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
uncomment' String
rest
      Char
'\t' : String
rest -> Char
'\t' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
removeEOL String
rest
      Char
_ : String
rest -> Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
removeEOL String
rest
    remove :: String -> String
remove String
a = case String
a of
      String
"" -> String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"File ended without closing comment (*/): " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
      Char
'"' : String
rest -> String -> String
removeString String
rest
      Char
'\n' : String
rest -> Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
remove String
rest
      Char
'\t' : String
rest -> Char
'\t' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
remove String
rest
      Char
'*' : Char
'/' : String
rest -> String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
uncomment' String
rest
      Char
'*' : Char
')' : String
rest -> String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
uncomment' String
rest
      Char
_ : String
rest -> String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
remove String
rest
    removeString :: String -> String
removeString String
a = case String
a of
      String
"" -> String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"File ended without closing string: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
      Char
'"' : String
rest -> String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
remove String
rest
      Char
'\\' : Char
'"' : String
rest -> String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
removeString String
rest
      Char
'\n' : String
rest -> Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
removeString String
rest
      Char
'\t' : String
rest -> Char
'\t' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
removeString String
rest
      Char
_ : String
rest -> Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
removeString String
rest
    ignoreString :: String -> String
ignoreString String
a = case String
a of
      String
"" -> String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"File ended without closing string: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
      Char
'"' : String
rest -> Char
'"' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
uncomment' String
rest
      Char
'\\' : Char
'"' : String
rest -> String
"\\\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
ignoreString String
rest
      Char
b : String
rest -> Char
b Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
ignoreString String
rest

-- | A simple `define preprocessor.
preprocess :: [(String, String)] -> FilePath -> String -> String
preprocess :: [(String, String)] -> String -> String -> String
preprocess [(String, String)]
env String
file String
content =
  [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
    Bool -> [Bool] -> [(String, String)] -> [String] -> [String]
pp Bool
True [] [(String, String)]
env ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$
      String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$
        String -> String -> String
uncomment
          String
file
          String
content
  where
    pp :: Bool -> [Bool] -> [(String, String)] -> [String] -> [String]
    pp :: Bool -> [Bool] -> [(String, String)] -> [String] -> [String]
pp Bool
_ [Bool]
_ [(String, String)]
_ [] = []
    pp Bool
on [Bool]
stack [(String, String)]
env_ (String
a : [String]
rest) = case String -> [String]
words String
a of
      String
"`define" : String
name : [String]
value ->
        String
"" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
        Bool -> [Bool] -> [(String, String)] -> [String] -> [String]
pp
          Bool
on
          [Bool]
stack
          ( if Bool
on
              then (String
name, [(String, String)] -> String -> String
ppLine [(String, String)]
env_ (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String]
value) (String, String) -> [(String, String)] -> [(String, String)]
forall a. a -> [a] -> [a]
: [(String, String)]
env_
              else [(String, String)]
env_
          )
          [String]
rest
      String
"`ifdef" : String
name : [String]
_ ->
        String
"" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Bool -> [Bool] -> [(String, String)] -> [String] -> [String]
pp (Bool
on Bool -> Bool -> Bool
&& String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
name (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst [(String, String)]
env_)) (Bool
on Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool]
stack) [(String, String)]
env_ [String]
rest
      String
"`ifndef" : String
name : [String]
_ ->
        String
"" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Bool -> [Bool] -> [(String, String)] -> [String] -> [String]
pp (Bool
on Bool -> Bool -> Bool
&& String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem String
name (((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
forall a b. (a, b) -> a
fst [(String, String)]
env_)) (Bool
on Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: [Bool]
stack) [(String, String)]
env_ [String]
rest
      String
"`else" : [String]
_
        | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Bool]
stack ->
          String
"" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Bool -> [Bool] -> [(String, String)] -> [String] -> [String]
pp ([Bool] -> Bool
forall a. HasCallStack => [a] -> a
head [Bool]
stack Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
on) [Bool]
stack [(String, String)]
env_ [String]
rest
        | Bool
otherwise ->
          String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"`else  without associated `ifdef/`ifndef: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
      String
"`endif" : [String]
_
        | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Bool]
stack ->
          String
"" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Bool -> [Bool] -> [(String, String)] -> [String] -> [String]
pp ([Bool] -> Bool
forall a. HasCallStack => [a] -> a
head [Bool]
stack) ([Bool] -> [Bool]
forall a. HasCallStack => [a] -> [a]
tail [Bool]
stack) [(String, String)]
env_ [String]
rest
        | Bool
otherwise ->
          String -> [String]
forall a. HasCallStack => String -> a
error (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
"`endif  without associated `ifdef/`ifndef: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
      String
"`timescale" : [String]
_ -> Bool -> [Bool] -> [(String, String)] -> [String] -> [String]
pp Bool
on [Bool]
stack [(String, String)]
env_ [String]
rest
      [String]
_ -> (if Bool
on then [(String, String)] -> String -> String
ppLine [(String, String)]
env_ String
a else String
"") String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Bool -> [Bool] -> [(String, String)] -> [String] -> [String]
pp Bool
on [Bool]
stack [(String, String)]
env_ [String]
rest

ppLine :: [(String, String)] -> String -> String
ppLine :: [(String, String)] -> String -> String
ppLine [(String, String)]
_ String
"" = String
""
ppLine [(String, String)]
env (Char
'`' : String
a) = case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name [(String, String)]
env of
  Just String
value -> String
value String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(String, String)] -> String -> String
ppLine [(String, String)]
env String
rest
  Maybe String
Nothing -> String -> String
forall a. HasCallStack => String -> a
error (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"Undefined macro: `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"  Env: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [(String, String)] -> String
forall a. Show a => a -> String
show [(String, String)]
env
  where
    name :: String
name =
      (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile
        ((Char -> String -> Bool) -> String -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (String -> Char -> Bool) -> String -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ [Char
'A' .. Char
'Z'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'a' .. Char
'z'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'0' .. Char
'9'] String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
'_'])
        String
a
    rest :: String
rest = Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
name) String
a
ppLine [(String, String)]
env (Char
a : String
b) = Char
a Char -> String -> String
forall a. a -> [a] -> [a]
: [(String, String)] -> String -> String
ppLine [(String, String)]
env String
b