initial setup for combining pre-processor and lexer

src/Language/SystemVerilog/Parser/Lex.x

@@ -4,7 +4,7 @@ module Language.SystemVerilog.Parser.Lex (alexScanTokens) where
 import Language.SystemVerilog.Parser.Tokens
 }
 
-%wrapper "posn"
+%wrapper "monadUserState"
 
 -- Numbers
 
@@ -62,9 +62,8 @@ $decimalDigit = [0-9]
 
 -- Comments
 
-@commentBegin = "/*"
+@commentBlock = "/*"
-@commentEnd = "*/" | "**/"
+@commentLine = "//"
-@comment = "//" [^\n]* | "/**/"
 
 -- Directives
 
@@ -256,9 +255,8 @@ tokens :-
     "<<<="             { tok Sym_lt_lt_lt_eq }
     ">>>="             { tok Sym_gt_gt_gt_eq }
 
-  @comment           { tok Spe_Comment }
+    @commentLine       { removeUntil "\n" }
-  @commentBegin      { tok Spe_CommentBegin }
+    @commentBlock      { removeUntil "*/" }
-  @commentEnd        { tok Spe_CommentEnd }
     @directive         { tok Spe_Directive }
     @newline           { tok Spe_Newline }
 
@@ -267,6 +265,65 @@ tokens :-
     .                  { tok Unknown }
 
 {
-tok :: TokenName -> AlexPosn -> String -> Token
+
-tok t (AlexPn _ l c) s = Token t s $ Position "" l c
+type AlexUserState = [Token]
+
+alexInitUserState :: AlexUserState
+alexInitUserState = []
+
+alexScanTokens :: String -> [Token]
+alexScanTokens str =
+    let result = runAlex str $ alexMonadScan >> get
+    in case result of
+        Left msg -> error $ "Lex Error: " ++ msg
+        Right tokens -> tokens
+
+get :: Alex AlexUserState
+get = Alex $ \s -> Right (s, alex_ust s)
+
+gets :: (AlexUserState -> a) -> Alex a
+gets f = get >>= return . f
+
+modify :: (AlexUserState -> AlexUserState) -> Alex ()
+modify f = Alex func
+    where func s = Right (s { alex_ust = new }, ())
+            where new = f (alex_ust s)
+
+alexEOF :: Alex ()
+alexEOF = return ()
+
+type Action = AlexInput -> Int -> Alex ()
+
+
+-- remove characters from the input until the pattern is reached
+removeUntil :: String -> Action
+removeUntil pattern _ _ = loop
+    where
+        patternLen = length pattern
+        wantNewline = pattern == "\n"
+        loop = do
+            (AlexPn f l c, _, _, str) <- alexGetInput
+            let found = (null str && wantNewline)
+                     || pattern == take patternLen str
+            let nextPos = if head str == '\n'
+                    then AlexPn f (l+1) 0
+                    else AlexPn f l (c+1)
+            let afterPos = if wantNewline
+                    then AlexPn f (l+1) 0
+                    else AlexPn f l (c + patternLen)
+            let (newPos, newStr) = if found
+                    then (afterPos, drop patternLen str)
+                    else (nextPos, drop 1 str)
+            alexSetInput (newPos, ' ', [], newStr)
+            if found
+                then alexMonadScan
+                else loop
+
+tok :: TokenName -> Action
+tok tokId ((AlexPn _ l c), _, _, input) len =
+    modify (++ [t]) >> alexMonadScan
+    where
+        tokStr = take len input
+        tokPos = Position "" l c
+        t = Token tokId tokStr tokPos
 }

src/Language/SystemVerilog/Parser/Preprocess.hs

@@ -159,11 +159,6 @@ pp (Token Spe_Directive str pos : tokens) = do
                     return $ replacement ++ tokens'
 
 pp (Token Spe_Newline _ _ : tokens) = pp tokens
-pp (Token Spe_Comment _ _ : tokens) = pp tokens
-
-pp (Token Spe_CommentBegin _ _ : tokens) =
-    pp $ tail $ dropWhile (not . isEnd) tokens
-    where isEnd (Token t _ _ ) = t == Spe_CommentEnd
 
 pp (token : tokens) = do
     condStack <- gets ppCondStack

src/Language/SystemVerilog/Parser/Tokens.hs

@@ -334,9 +334,6 @@ data TokenName
   | Sym_amp_amp_amp
   | Sym_lt_lt_lt_eq
   | Sym_gt_gt_gt_eq
-  | Spe_Comment
-  | Spe_CommentBegin
-  | Spe_CommentEnd
   | Spe_Directive
   | Spe_Newline
   | Unknown