From 9aa8b7033e71161cb291aa72288c9f3393b3456d Mon Sep 17 00:00:00 2001
From: Zachary Snow <zach@zachjs.com>
Date: Thu, 8 Jul 2021 16:30:02 -0400
Subject: [PATCH] fix handling of comments, quotes, and trailing whitespace in
 macro arguments

---
 .../SystemVerilog/Parser/Preprocess.hs        | 61 +++++++++++++------
 test/lex/macro_arg_comment.sv                 | 39 ++++++++++++
 test/lex/macro_arg_comment.v                  | 16 +++++
 3 files changed, 98 insertions(+), 18 deletions(-)
 create mode 100644 test/lex/macro_arg_comment.sv
 create mode 100644 test/lex/macro_arg_comment.v

diff --git a/src/Language/SystemVerilog/Parser/Preprocess.hs b/src/Language/SystemVerilog/Parser/Preprocess.hs
index 293f842..4f730ee 100644
--- a/src/Language/SystemVerilog/Parser/Preprocess.hs
+++ b/src/Language/SystemVerilog/Parser/Preprocess.hs
@@ -16,7 +16,7 @@ module Language.SystemVerilog.Parser.Preprocess
 import Control.Monad.Except
 import Control.Monad.State.Strict
 import Data.Char (ord)
-import Data.List (dropWhileEnd, tails, isPrefixOf, findIndex, intercalate)
+import Data.List (tails, isPrefixOf, findIndex, intercalate)
 import Data.Maybe (isJust, fromJust)
 import System.Directory (findFile)
 import System.FilePath (dropFileName)
@@ -397,34 +397,59 @@ takeMacroArguments = do
         argLoop :: PPS [String]
         argLoop = do
             dropWhitespace
-            (arg, isEnd) <- loop "" []
-            let arg' = dropWhileEnd isWhitespaceChar arg
+            (argRev, isEnd) <- loop "" []
+            let arg = trimAndRev argRev
             if isEnd
-                then return [arg']
+                then return [arg]
                 else do
                     rest <- argLoop
-                    return $ arg' : rest
+                    return $ arg : rest
         loop :: String -> [Char] -> PPS (String, Bool)
         loop curr stack = do
             ch <- takeChar
             case (stack, ch) of
-                (      s,'\\') -> do
-                    ch2 <- takeChar
-                    loop (curr ++ [ch, ch2]) s
                 ([     ], ',') -> return (curr, False)
                 ([     ], ')') -> return (curr, True)
 
-                ('"' : s, '"') -> loop (curr ++ [ch]) s
-                (      s, '"') -> loop (curr ++ [ch]) ('"' : s)
-                ('[' : s, ']') -> loop (curr ++ [ch]) s
-                (      s, '[') -> loop (curr ++ [ch]) ('[' : s)
-                ('(' : s, ')') -> loop (curr ++ [ch]) s
-                (      s, '(') -> loop (curr ++ [ch]) ('(' : s)
-                ('{' : s, '}') -> loop (curr ++ [ch]) s
-                (      s, '{') -> loop (curr ++ [ch]) ('{' : s)
+                -- simple quoted strings, allowing escaped quotes
+                ('\\': s, _  ) -> loop (ch : curr) s
+                ('"' : s, '"') -> loop (ch : curr) s
+                ('"' : _,'\\') -> loop (ch : curr) ('\\': stack)
+                ('"' : _, _  ) -> loop (ch : curr) stack
+                (      _, '"') -> loop (ch : curr) ('"' : stack)
 
-                (      s,'\n') -> loop (curr ++ [' ']) s
-                (      s, _  ) -> loop (curr ++ [ch ]) s
+                ('[' : s, ']') -> loop (ch : curr) s
+                (      s, '[') -> loop (ch : curr) ('[' : s)
+                ('(' : s, ')') -> loop (ch : curr) s
+                (      s, '(') -> loop (ch : curr) ('(' : s)
+                ('{' : s, '}') -> loop (ch : curr) s
+                (      s, '{') -> loop (ch : curr) ('{' : s)
+
+                (      s, '/') -> do
+                    next <- peekChar
+                    case next of
+                        '/' -> takeChar >> dropLineComment >> loop curr s
+                        '*' -> takeChar >> dropBlockComment >> loop curr s
+                        _ -> loop ('/' : curr) s
+
+                (      s,'\n') -> loop (' ' : curr) s
+                (      s, _  ) -> loop (ch  : curr) s
+
+        trimAndRev = -- drop surrounding whitespace and reverse string
+            dropWhile isWhitespaceChar . reverse . dropWhile isWhitespaceChar
+
+        dropLineComment :: PPS ()
+        dropLineComment = do
+            ch <- takeChar
+            when (ch /= '\n') dropLineComment
+
+        dropBlockComment :: PPS ()
+        dropBlockComment = do
+            ch1 <- takeChar
+            ch2 <- peekChar
+            if ch1 == '*' && ch2 == '/'
+                then takeChar >> return ()
+                else dropBlockComment
 
 defaultMacroArgs :: [Maybe String] -> [String] -> PPS [String]
 defaultMacroArgs [] [] = return []
diff --git a/test/lex/macro_arg_comment.sv b/test/lex/macro_arg_comment.sv
new file mode 100644
index 0000000..ad98756
--- /dev/null
+++ b/test/lex/macro_arg_comment.sv
@@ -0,0 +1,39 @@
+`define MACRO_A(
+    // comment
+    	/* intentional tab */
+    /* comment */ x /* comment */
+    	/* intentional tab */
+    // comment
+    ,
+    // comment
+    	/* intentional tab */
+    /* comment */ y /* comment */
+    	/* intentional tab */
+    // comment
+) \
+initial begin \
+    $display(`"x %b`", x); \
+    $display(`"y %b`", y); \
+end
+
+`define MACRO_B(x, y, z) initial $display(x, y, z);
+
+module top;
+    `MACRO_A(
+    // comment
+    	/* intentional tab */
+        /* comment */ 1 + 2 /* comment */
+    	/* intentional tab */
+    // comment
+        ,
+    	/* intentional tab */
+        /* comment */ 1'b1 & 1 /* comment */
+    	/* intentional tab */
+    // comment
+    )
+    `MACRO_B(
+        "/* not a block comment */",
+        "// not a line comment",
+        "cool \046 \" ( } { beans\\"
+    )
+endmodule
diff --git a/test/lex/macro_arg_comment.v b/test/lex/macro_arg_comment.v
new file mode 100644
index 0000000..2704dd5
--- /dev/null
+++ b/test/lex/macro_arg_comment.v
@@ -0,0 +1,16 @@
+`define MACRO_A(x, y) \
+initial begin \
+    $display(`"x %b`", x); \
+    $display(`"y %b`", y); \
+end
+
+`define MACRO_B(x, y, z) initial $display(x, y, z);
+
+module top;
+    `MACRO_A(1 + 2, 1'b1 & 1)
+    `MACRO_B(
+        "/* not a block comment */",
+        "// not a line comment",
+        "cool \046 \042 ( } { beans\\"
+    )
+endmodule