aboutsummaryrefslogtreecommitdiffstats
path: root/src/Verismith/Verilog/Preprocess.hs
blob: 909334b9c7192c5cd01855a6896ce29c67b5d69c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
-- |
-- 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 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
    removeEOL a = case a of
      "" -> ""
      '\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
    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
    ignoreString a = case a of
      "" -> 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
  where
    pp :: Bool -> [Bool] -> [(String, String)] -> [String] -> [String]
    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

ppLine :: [(String, String)] -> String -> String
ppLine _ "" = ""
ppLine env ('`' : a) = case lookup name env of
  Just value -> value ++ ppLine env rest
  Nothing -> error $ "Undefined macro: `" ++ name ++ "  Env: " ++ show env
  where
    name =
      takeWhile
        (flip elem $ ['A' .. 'Z'] ++ ['a' .. 'z'] ++ ['0' .. '9'] ++ ['_'])
        a
    rest = drop (length name) a
ppLine env (a : b) = a : ppLine env b