From 78f3db880368d1bdf0dd634bc28148bed55447a7 Mon Sep 17 00:00:00 2001
From: Rupert Swarbrick <rswarbrick@gmail.com>
Date: Wed, 18 Mar 2020 12:00:00 +0000
Subject: [PATCH] Fail more gracefully on mismatched `if/`elsif/`else/`endif

Without this patch, a stray `endif caused sv2v to take the tail of an
empty list. Now we raise a lexical error.

To do this, the patch pulls the "push" and "pop" logic for the
preprocessor condition stack into separate helper
functions (pushCondStack and popCondStack). It also defines some
helper functions for manipulating Cond's.

The patch also adds a documentation comment explaining what the
different values of Code meant (because I had to squint to work it
out).
---
 .../SystemVerilog/Parser/Preprocess.hs        | 68 ++++++++++++-------
 1 file changed, 43 insertions(+), 25 deletions(-)

diff --git a/src/Language/SystemVerilog/Parser/Preprocess.hs b/src/Language/SystemVerilog/Parser/Preprocess.hs
index e2bc544..75725b3 100644
--- a/src/Language/SystemVerilog/Parser/Preprocess.hs
+++ b/src/Language/SystemVerilog/Parser/Preprocess.hs
@@ -41,11 +41,30 @@ data PP = PP
 
 -- keeps track of the state of an if-else cascade level
 data Cond
-    = CurrentlyTrue
-    | PreviouslyTrue
-    | NeverTrue
+    = CurrentlyTrue -- an active if/elsif/else branch (condition is met)
+    | PreviouslyTrue -- an inactive else/elsif block due to an earlier if/elsif
+    | NeverTrue -- an inactive if/elsif block; a subsequent else will be met
     deriving (Eq, Show)
 
+-- update a Cond for an `else block, where this block is active if and only if
+-- no previous block was active
+elseCond :: Cond -> Cond
+elseCond NeverTrue = CurrentlyTrue
+elseCond _ = NeverTrue
+
+-- generate a Cond for an `if/`elsif that is not part of a PreviouslyTrue chain
+ifCond :: Bool -> Cond
+ifCond True = CurrentlyTrue
+ifCond False = NeverTrue
+
+-- update a Cond for an `elsif block. The boolean argument is whether the
+-- `elsif block's test is true.
+elsifCond :: Bool -> Cond -> Cond
+elsifCond defined c =
+    case c of
+        NeverTrue -> ifCond defined
+        _ -> PreviouslyTrue
+
 -- preprocessor entrypoint
 preprocess :: [String] -> Env -> FilePath -> IO (Either String ([(Char, Position)], Env))
 preprocess includePaths env path = do
@@ -157,6 +176,19 @@ getBuffer = do
     p <- getPosition
     return (x, p)
 
+-- Push a condition onto the top of the preprocessor condition stack
+pushCondStack :: Cond -> PPS ()
+pushCondStack c = getCondStack >>= setCondStack . (c :)
+
+-- Pop the top from the preprocessor condition stack
+popCondStack :: String -> PPS Cond
+popCondStack directive = do
+    cs <- getCondStack
+    case cs of
+        [] -> lexicalError $
+              "`" ++ directive ++ " directive outside of an `if/`endif block"
+        c : cs' -> setCondStack cs' >> return c
+
 isIdentChar :: Char -> Bool
 isIdentChar ch =
     ('a' <= ch && ch <= 'z') ||
@@ -677,36 +709,22 @@ handleDirective macrosOnly = do
         "ifdef" -> do
             dropSpaces
             name <- takeIdentifier
-            let newCond = if Map.member name env
-                    then CurrentlyTrue
-                    else NeverTrue
-            setCondStack $ newCond : condStack
+            pushCondStack $ ifCond $ Map.member name env
         "ifndef" -> do
             dropSpaces
             name <- takeIdentifier
-            let newCond = if Map.notMember name env
-                    then CurrentlyTrue
-                    else NeverTrue
-            setCondStack $ newCond : condStack
+            pushCondStack $ ifCond $ Map.notMember name env
         "else" -> do
-            let newCond = if head condStack == NeverTrue
-                    then CurrentlyTrue
-                    else NeverTrue
-            setCondStack $ newCond : tail condStack
+            c <- popCondStack "else"
+            pushCondStack $ elseCond c
         "elsif" -> do
             dropSpaces
             name <- takeIdentifier
-            let currCond = head condStack
-            let newCond =
-                    if currCond /= NeverTrue then
-                        PreviouslyTrue
-                    else if Map.member name env then
-                        CurrentlyTrue
-                    else
-                        NeverTrue
-            setCondStack $ newCond : tail condStack
+            c <- popCondStack "elsif"
+            pushCondStack $ elsifCond (Map.member name env) c
         "endif" -> do
-            setCondStack $ tail condStack
+            _ <- popCondStack "endif"
+            return ()
 
         "define" -> do
             dropSpaces