aboutsummaryrefslogtreecommitdiffstats
path: root/src/VeriFuzz/Parser/Preprocess.hs
blob: c0a424615f2e5f6b5a26bbb6f598f1eb0de76cc0 (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
{-|
Module      : VeriFuzz.Parser.Preprocess
Description : Simple preprocessor for `define and comments.
Copyright   : (c) 2011-2015 Tom Hawkins, 2019 Yann Herklotz
License     : GPL-3
Maintainer  : ymherklotz [at] gmail [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 VeriFuzz.Parser.Preprocess
  ( uncomment
  , preprocess
  ) where

-- | Remove comments from code.
uncomment :: FilePath -> String -> String
uncomment file = uncomment'
  where
  uncomment' a = case a of
    ""               -> ""
    '/' : '/' : rest -> "  " ++ removeEOL 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         -> " "  ++ 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