Rewrite the parser with real lexer

4 files changed, 941 insertions, 0 deletions

diff --git a/src/VeriFuzz/Parser/Lex.x b/src/VeriFuzz/Parser/Lex.x
new file mode 100644
index 0000000..86c431e
--- /dev/null
+++ b/src/VeriFuzz/Parser/Lex.x
@@ -0,0 +1,187 @@
+{
+{-# OPTIONS_GHC -w #-}
+module VeriFuzz.Parser.Lex
+  ( alexScanTokens
+  ) where
+
+import VeriFuzz.Parser.Token
+
+}
+
+%wrapper "posn"
+
+-- Numbers
+
+$nonZeroDecimalDigit = [1-9]
+$decimalDigit = [0-9]
+@binaryDigit  = [0-1]
+@octalDigit   = [0-7]
+@hexDigit     = [0-9a-fA-F]
+
+@decimalBase = "'" [dD]
+@binaryBase  = "'" [bB]
+@octalBase   = "'" [oO]
+@hexBase     = "'" [hH]
+
+@binaryValue         = @binaryDigit ("_" | @binaryDigit)*
+@octalValue  = @octalDigit  ("_" | @octalDigit)*
+@hexValue    = @hexDigit    ("_" | @hexDigit)*
+
+@unsignedNumber = $decimalDigit ("_" | $decimalDigit)*
+
+@size = @unsignedNumber
+
+@decimalNumber
+  = @unsignedNumber
+  | @size? @decimalBase @unsignedNumber
+
+@binaryNumber = @size? @binaryBase @binaryValue
+@octalNumber  = @size? @octalBase  @octalValue
+@hexNumber    = @size? @hexBase    @hexValue
+  
+-- $exp  = [eE]
+-- $sign = [\+\-]
+-- @realNumber = unsignedNumber "." unsignedNumber | unsignedNumber ( "." unsignedNumber)? exp sign? unsignedNumber
+@number = @decimalNumber | @octalNumber | @binaryNumber | @hexNumber
+
+-- Strings
+
+@string = \" [^\r\n]* \"
+
+-- Identifiers
+
+@escapedIdentifier = "\" ($printable # $white)+ $white
+@simpleIdentifier  = [a-zA-Z_] [a-zA-Z0-9_\$]*
+@systemIdentifier = "$" [a-zA-Z0-9_\$]+
+
+
+tokens :-
+
+  "always"           { tok KWAlways     }
+  "assign"           { tok KWAssign     }
+  "begin"            { tok KWBegin      }
+  "case"             { tok KWCase       }
+  "default"          { tok KWDefault    }
+  "else"             { tok KWElse       }
+  "end"              { tok KWEnd        }
+  "endcase"          { tok KWEndcase    }
+  "endmodule"        { tok KWEndmodule  }
+  "for"              { tok KWFor        }
+  "if"               { tok KWIf         }
+  "initial"          { tok KWInitial    }
+  "inout"            { tok KWInout      }
+  "input"            { tok KWInput      }
+  "integer"          { tok KWInteger    }
+  "localparam"       { tok KWLocalparam }
+  "module"           { tok KWModule     }
+  "negedge"          { tok KWNegedge    }
+  "or"               { tok KWOr         }
+  "output"           { tok KWOutput     }
+  "parameter"        { tok KWParameter  }
+  "posedge"          { tok KWPosedge    }
+  "reg"              { tok KWReg        }
+  "wire"             { tok KWWire       }
+  "signed"           { tok KWSigned     }
+
+  @simpleIdentifier  { tok IdSimple  }
+  @escapedIdentifier { tok IdEscaped }
+  @systemIdentifier  { tok IdSystem  }
+
+  @number            { tok LitNumber }
+  @string            { tok LitString }
+
+  "("                { tok SymParenL }
+  ")"                { tok SymParenR }
+  "["                { tok SymBrackL }
+  "]"                { tok SymBrackR }
+  "{"                { tok SymBraceL }
+  "}"                { tok SymBraceR }
+  "~"                { tok SymTildy }
+  "!"                { tok SymBang }
+  "@"                { tok SymAt }
+  "#"                { tok SymPound }
+  "%"                { tok SymPercent }
+  "^"                { tok SymHat }
+  "&"                { tok SymAmp }
+  "|"                { tok SymBar }
+  "*"                { tok SymAster }
+  "."                { tok SymDot }
+  ","                { tok SymComma }
+  ":"                { tok SymColon }
+  ";"                { tok SymSemi }
+  "="                { tok SymEq }
+  "<"                { tok SymLt }
+  ">"                { tok SymGt }
+  "+"                { tok SymPlus }
+  "-"                { tok SymDash }
+  "?"                { tok SymQuestion }
+  "/"                { tok SymSlash }
+  "$"                { tok SymDollar }
+  "'"                { tok SymSQuote }
+
+  "~&"               { tok SymTildyAmp }
+  "~|"               { tok SymTildyBar }
+  "~^"               { tok SymTildyHat }
+  "^~"               { tok SymHatTildy }
+  "=="               { tok SymEqEq }
+  "!="               { tok SymBangEq }
+  "&&"               { tok SymAmpAmp }
+  "||"               { tok SymBarBar }
+  "**"               { tok SymAsterAster }
+  "<="               { tok SymLtEq }
+  ">="               { tok SymGtEq }
+  ">>"               { tok SymGtGt }
+  "<<"               { tok SymLtLt }
+  "++"               { tok SymPlusPlus }
+  "--"               { tok SymDashDash }
+  "+="               { tok SymPlusEq }
+  "-="               { tok SymDashEq }
+  "*="               { tok SymAsterEq }
+  "/="               { tok SymSlashEq }
+  "%="               { tok SymPercentEq }
+  "&="               { tok SymAmpEq }
+  "|="               { tok SymBarEq }
+  "^="               { tok SymHatEq }
+  "+:"               { tok SymPlusColon }
+  "-:"               { tok SymDashColon }
+  "::"               { tok SymColonColon }
+  ".*"               { tok SymDotAster }
+  "->"               { tok SymDashGt }
+  ":="               { tok SymColonEq }
+  ":/"               { tok SymColonSlash }
+  "##"               { tok SymPoundPound }
+  "[*"               { tok SymBrackLAster }
+  "[="               { tok SymBrackLEq }
+  "=>"               { tok SymEqGt }
+  "@*"               { tok SymAtAster }
+  "(*"               { tok SymParenLAster }
+  "*)"               { tok SymAsterParenR }
+  "*>"               { tok SymAsterGt }
+
+  "==="              { tok SymEqEqEq }
+  "!=="              { tok SymBangEqEq }
+  "=?="              { tok SymEqQuestionEq }
+  "!?="              { tok SymBangQuestionEq }
+  ">>>"              { tok SymGtGtGt }
+  "<<<"              { tok SymLtLtLt }
+  "<<="              { tok SymLtLtEq }
+  ">>="              { tok SymGtGtEq }
+  "|->"              { tok SymBarDashGt }
+  "|=>"              { tok SymBarEqGt }
+  "[->"              { tok SymBrackLDashGt }
+  "@@("              { tok SymAtAtParenL }
+  "(*)"              { tok SymParenLAsterParenR }
+  "->>"              { tok SymDashGtGt }
+  "&&&"              { tok SymAmpAmpAmp }
+
+  "<<<="             { tok SymLtLtLtEq }
+  ">>>="             { tok SymGtGtGtEq }
+
+  $white             ;
+
+  .                  { tok Unknown }
+
+{
+tok :: TokenName -> AlexPosn -> String -> Token
+tok t (AlexPn _ l c) s = Token t s $ Position "" l c
+}
diff --git a/src/VeriFuzz/Parser/Parser.hs b/src/VeriFuzz/Parser/Parser.hs
new file mode 100644
index 0000000..5a1d163
--- /dev/null
+++ b/src/VeriFuzz/Parser/Parser.hs
@@ -0,0 +1,329 @@
+{-|
+Module      : VeriFuzz.Parser.Parser
+Description : Minimal Verilog parser to reconstruct the AST.
+Copyright   : (c) 2019, Yann Herklotz
+License     : GPL-3
+Maintainer  : ymherklotz [at] gmail [dot] com
+Stability   : experimental
+Portability : POSIX
+
+Minimal Verilog parser to reconstruct the AST. This parser does not support the
+whole Verilog syntax, as the AST does not support it either.
+-}
+
+module VeriFuzz.Parser.Parser
+    ( -- * Parsers
+      parseVerilog
+    , parseVerilogSrc
+    , parseDescription
+    , parseModDecl
+    , parseContAssign
+    , parseExpr
+    )
+where
+
+import           Control.Lens
+import           Data.Functor               (($>))
+import           Data.Functor.Identity      (Identity)
+import qualified Data.Text                  as T
+import           Text.Parsec                hiding (satisfy)
+import           Text.Parsec.Expr
+import           VeriFuzz.AST
+--import           VeriFuzz.CodeGen
+import           Data.Bits
+import           Data.List                  (isInfixOf, isPrefixOf)
+import           VeriFuzz.Internal
+import           VeriFuzz.Parser.Lex
+import           VeriFuzz.Parser.Preprocess
+import           VeriFuzz.Parser.Token
+
+
+type Parser = Parsec [Token] ()
+
+type ParseOperator = Operator [Token] () Identity
+
+data Decimal = Decimal { size :: Int
+                       , num  :: Integer
+                       }
+
+instance Num Decimal where
+    (Decimal sa na) + (Decimal sb nb) = Decimal (max sa sb) (na + nb)
+    (Decimal sa na) - (Decimal sb nb) = Decimal (max sa sb) (na - nb)
+    (Decimal sa na) * (Decimal sb nb) = Decimal (max sa sb) (na * nb)
+    negate (Decimal s n) = Decimal s $ negate n
+    abs (Decimal s n) = Decimal s $ abs n
+    signum (Decimal s n) = Decimal s $ signum n
+    fromInteger = Decimal 32 . fromInteger
+
+-- | This parser succeeds whenever the given predicate returns true when called
+-- with parsed `Token`. Same as 'Text.Parsec.Char.satisfy'.
+satisfy :: (Token -> Bool) -> Parser TokenName
+satisfy f = tokenPrim show nextPos tokeq
+  where
+    tokeq :: Token -> Maybe TokenName
+    tokeq t@(Token t' _ _) = if f t then Just t' else Nothing
+
+satisfy' :: (Token -> Maybe a) -> Parser a
+satisfy' = tokenPrim show nextPos
+
+nextPos :: SourcePos -> Token -> [Token] -> SourcePos
+nextPos pos _ (Token _ _ (Position _ l c):_) = setSourceColumn (setSourceLine pos l) c
+nextPos pos _ []                = pos
+
+-- | Parses given `TokenName`.
+tok :: TokenName -> Parser TokenName
+tok t = satisfy (\(Token t' _ _) -> t' == t) <?> show t
+
+-- | Parse without returning the `TokenName`.
+tok' :: TokenName -> Parser ()
+tok' p = tok p >> return ()
+
+parens :: Parser a -> Parser a
+parens = between (tok SymParenL) (tok SymParenR)
+
+brackets :: Parser a -> Parser a
+brackets = between (tok SymBrackL) (tok SymBrackR)
+
+braces :: Parser a -> Parser a
+braces = between (tok SymBraceL) (tok SymBraceR)
+
+sBinOp :: BinaryOperator -> Expr -> Expr -> Expr
+sBinOp = sOp BinOp where sOp f b a = f a b
+
+parseExpr' :: Parser Expr
+parseExpr' = buildExpressionParser parseTable parseTerm <?> "expr"
+
+matchHex :: Char -> Bool
+matchHex c = c == 'h' || c == 'H'
+
+--matchBin :: Char -> Bool
+--matchBin c = c == 'b' || c == 'B'
+
+matchDec :: Char -> Bool
+matchDec c = c == 'd' || c == 'D'
+
+matchOct :: Char -> Bool
+matchOct c = c == 'o' || c == 'O'
+
+decToExpr :: Decimal -> Expr
+decToExpr (Decimal s n) = Number s n
+
+-- | Parse a Number depending on if it is in a hex or decimal form. Octal and
+-- binary are not supported yet.
+parseNum :: Parser Expr
+parseNum = decToExpr <$> number
+
+parseVar :: Parser Expr
+parseVar = Id <$> identifier
+
+systemFunc :: String -> Parser String
+systemFunc s = satisfy' matchId
+    where
+        matchId (Token IdSystem s' _) =
+            if s == s' then Just s else Nothing
+        matchId _ = Nothing
+
+parseFunction :: Parser Function
+parseFunction =
+    systemFunc "unsigned" $> UnSignedFunc <|> systemFunc "signed" $> SignedFunc
+
+parseFun :: Parser Expr
+parseFun = do
+    f    <- parseFunction
+    expr <- parens parseExpr
+    return $ Func f expr
+
+parseTerm :: Parser Expr
+parseTerm =
+    parens parseExpr
+        <|> (Concat <$> braces (commaSep parseExpr))
+        <|> parseFun
+        <|> parseNum
+        <|> parseVar
+        <?> "simple expr"
+
+-- | Parses the ternary conditional operator. It will behave in a right
+-- associative way.
+parseCond :: Expr -> Parser Expr
+parseCond e = do
+    tok' SymQuestion
+    expr <- parseExpr
+    tok' SymColon
+    Cond e expr <$> parseExpr
+
+parseExpr :: Parser Expr
+parseExpr = do
+    e <- parseExpr'
+    option e . try $ parseCond e
+
+-- | Table of binary and unary operators that encode the right precedence for
+-- each.
+parseTable :: [[ParseOperator Expr]]
+parseTable
+    = [ [prefix SymBang (UnOp UnLNot), prefix SymTildy (UnOp UnNot)]
+      , [ prefix SymAmp  (UnOp UnAnd)
+        , prefix SymBar  (UnOp UnOr)
+        , prefix SymTildyAmp (UnOp UnNand)
+        , prefix SymTildyBar (UnOp UnNor)
+        , prefix SymHat  (UnOp UnXor)
+        , prefix SymTildyHat (UnOp UnNxor)
+        , prefix SymHatTildy (UnOp UnNxorInv)
+        ]
+      , [prefix SymPlus (UnOp UnPlus), prefix SymDash (UnOp UnMinus)]
+      , [binary SymAsterAster (sBinOp BinPower) AssocRight]
+      , [ binary SymAster (sBinOp BinTimes) AssocLeft
+        , binary SymSlash (sBinOp BinDiv)   AssocLeft
+        , binary SymPercent (sBinOp BinMod)   AssocLeft
+        ]
+      , [ binary SymPlus (sBinOp BinPlus) AssocLeft
+        , binary SymDash (sBinOp BinPlus) AssocLeft
+        ]
+      , [ binary SymLtLt (sBinOp BinLSL) AssocLeft
+        , binary SymGtGt (sBinOp BinLSR) AssocLeft
+        ]
+      , [ binary SymLtLtLt (sBinOp BinASL) AssocLeft
+        , binary SymGtGtGt (sBinOp BinASR) AssocLeft
+        ]
+      , [ binary SymLt  (sBinOp BinLT)  AssocNone
+        , binary SymGt  (sBinOp BinGT)  AssocNone
+        , binary SymLtEq (sBinOp BinLEq) AssocNone
+        , binary SymGtEq (sBinOp BinLEq) AssocNone
+        ]
+      , [ binary SymEqEq (sBinOp BinEq)  AssocNone
+        , binary SymBangEq (sBinOp BinNEq) AssocNone
+        ]
+      , [ binary SymEqEqEq (sBinOp BinEq)  AssocNone
+        , binary SymBangEqEq (sBinOp BinNEq) AssocNone
+        ]
+      , [binary SymAmp (sBinOp BinAnd) AssocLeft]
+      , [ binary SymHat  (sBinOp BinXor)     AssocLeft
+        , binary SymHatTildy (sBinOp BinXNor)    AssocLeft
+        , binary SymTildyHat (sBinOp BinXNorInv) AssocLeft
+        ]
+      , [binary SymBar (sBinOp BinOr) AssocLeft]
+      , [binary SymAmpAmp (sBinOp BinLAnd) AssocLeft]
+      , [binary SymBarBar (sBinOp BinLOr) AssocLeft]
+      ]
+
+binary :: TokenName -> (a -> a -> a) -> Assoc -> ParseOperator a
+binary name fun = Infix ((tok name <?> "binary") >> return fun)
+
+prefix :: TokenName -> (a -> a) -> ParseOperator a
+prefix name fun = Prefix ((tok name <?> "prefix") >> return fun)
+
+commaSep :: Parser a -> Parser [a]
+commaSep = flip sepBy $ tok SymComma
+
+parseContAssign :: Parser ContAssign
+parseContAssign = do
+    var  <- tok KWAssign *> identifier
+    expr <- tok SymEq *> parseExpr
+    tok SymSemi
+    return $ ContAssign var expr
+
+numLit :: Parser String
+numLit = satisfy' matchId
+    where
+        matchId (Token LitNumber s _) = Just s
+        matchId _                     = Nothing
+
+number :: Parser Decimal
+number = number' <$> numLit
+  where
+  number' :: String -> Decimal
+  number' a
+    | all (flip elem ['0' .. '9']) a = fromInteger $ read a
+    | head a == '\''                 = fromInteger $ f a
+    | isInfixOf  "'"  a              = Decimal (read w) (f b)
+    | otherwise                      = error $ "Invalid number format: " ++ a
+    where
+    w = takeWhile (/= '\'') a
+    b = dropWhile (/= '\'') a
+    f a
+      | isPrefixOf "'d" a = read $ drop 2 a
+      | isPrefixOf "'h" a = read $ "0x" ++ drop 2 a
+      | isPrefixOf "'b" a = foldl (\ n b -> shiftL n 1 .|. (if b == '1' then 1 else 0)) 0 (drop 2 a)
+      | otherwise         = error $ "Invalid number format: " ++ a
+
+toInteger' :: Decimal -> Integer
+toInteger' (Decimal _ n) = n
+
+-- | Parse a range and return the total size. As it is inclusive, 1 has to be
+-- added to the difference.
+parseRange :: Parser Int
+parseRange = do
+    rangeH <- tok SymBrackL *> number
+    rangeL <- tok SymColon *> number
+    tok' SymBrackR
+    return . fromInteger . toInteger' $ rangeH - rangeL + 1
+
+strId :: Parser String
+strId = satisfy' matchId
+    where
+        matchId (Token IdSimple s _)  = Just s
+        matchId (Token IdEscaped s _) = Just s
+        matchId _                     = Nothing
+
+identifier :: Parser Identifier
+identifier = Identifier . T.pack <$> strId
+
+parseNetDecl :: Maybe PortDir -> Parser ModItem
+parseNetDecl pd = do
+    t     <- option Wire type_
+    sign  <- option False (tok KWSigned $> True)
+    range <- option 1 parseRange
+    name  <- identifier
+    tok' SymSemi
+    return . Decl pd . Port t sign range $ name
+    where type_ = tok KWWire $> Wire <|> tok KWReg $> Reg
+
+parsePortDir :: Parser PortDir
+parsePortDir =
+    tok KWOutput
+        $>  PortOut
+        <|> tok KWInput
+        $>  PortIn
+        <|> tok KWInout
+        $>  PortInOut
+
+parseDecl :: Parser ModItem
+parseDecl = (Just <$> parsePortDir >>= parseNetDecl) <|> parseNetDecl Nothing
+
+parseModItem :: Parser ModItem
+parseModItem = (ModCA <$> parseContAssign) <|> parseDecl
+
+parseModList :: Parser [Identifier]
+parseModList = list <|> return []
+    where list = parens $ commaSep identifier
+
+filterDecl :: PortDir -> ModItem -> Bool
+filterDecl p (Decl (Just p') _) = p == p'
+filterDecl _ _                  = False
+
+modPorts :: PortDir -> [ModItem] -> [Port]
+modPorts p mis = filter (filterDecl p) mis ^.. traverse . declPort
+
+parseModDecl :: Parser ModDecl
+parseModDecl = do
+    name    <- tok KWModule *> identifier
+    _       <- fmap defaultPort <$> parseModList
+    tok' SymSemi
+    modItem <- option [] . try $ many1 parseModItem
+    tok' KWEndmodule
+    return $ ModDecl name
+                     (modPorts PortOut modItem)
+                     (modPorts PortIn modItem)
+                     modItem
+
+parseDescription :: Parser Description
+parseDescription = Description <$> parseModDecl
+
+-- | Parses a 'String' into 'VerilogSrc' by skipping any beginning whitespace
+-- and then parsing multiple Verilog source.
+parseVerilogSrc :: Parser VerilogSrc
+parseVerilogSrc = VerilogSrc <$> many parseDescription
+
+-- | Parse a 'String' containing verilog code. The parser currently only supports
+-- the subset of Verilog that is being generated randomly.
+parseVerilog :: String -> String -> Either ParseError VerilogSrc
+parseVerilog s = parse parseVerilogSrc s . alexScanTokens . preprocess [] s
diff --git a/src/VeriFuzz/Parser/Preprocess.hs b/src/VeriFuzz/Parser/Preprocess.hs
new file mode 100644
index 0000000..c0a4246
--- /dev/null
+++ b/src/VeriFuzz/Parser/Preprocess.hs
@@ -0,0 +1,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
+
diff --git a/src/VeriFuzz/Parser/Token.hs b/src/VeriFuzz/Parser/Token.hs
new file mode 100644
index 0000000..f776dd8
--- /dev/null
+++ b/src/VeriFuzz/Parser/Token.hs
@@ -0,0 +1,337 @@
+module VeriFuzz.Parser.Token
+  ( Token     (..)
+  , TokenName (..)
+  , Position  (..)
+  , tokenString
+  ) where
+
+import           Text.Printf
+
+tokenString :: Token -> String
+tokenString (Token _ s _) = s
+
+data Position = Position String Int Int deriving Eq
+
+instance Show Position where
+  show (Position f l c) = printf "%s:%d:%d" f l c
+
+data Token = Token TokenName String Position deriving (Show, Eq)
+
+data TokenName
+  = KWAlias
+  | KWAlways
+  | KWAlwaysComb
+  | KWAlwaysFf
+  | KWAlwaysLatch
+  | KWAnd
+  | KWAssert
+  | KWAssign
+  | KWAssume
+  | KWAutomatic
+  | KWBefore
+  | KWBegin
+  | KWBind
+  | KWBins
+  | KWBinsof
+  | KWBit
+  | KWBreak
+  | KWBuf
+  | KWBufif0
+  | KWBufif1
+  | KWByte
+  | KWCase
+  | KWCasex
+  | KWCasez
+  | KWCell
+  | KWChandle
+  | KWClass
+  | KWClocking
+  | KWCmos
+  | KWConfig
+  | KWConst
+  | KWConstraint
+  | KWContext
+  | KWContinue
+  | KWCover
+  | KWCovergroup
+  | KWCoverpoint
+  | KWCross
+  | KWDeassign
+  | KWDefault
+  | KWDefparam
+  | KWDesign
+  | KWDisable
+  | KWDist
+  | KWDo
+  | KWEdge
+  | KWElse
+  | KWEnd
+  | KWEndcase
+  | KWEndclass
+  | KWEndclocking
+  | KWEndconfig
+  | KWEndfunction
+  | KWEndgenerate
+  | KWEndgroup
+  | KWEndinterface
+  | KWEndmodule
+  | KWEndpackage
+  | KWEndprimitive
+  | KWEndprogram
+  | KWEndproperty
+  | KWEndspecify
+  | KWEndsequence
+  | KWEndtable
+  | KWEndtask
+  | KWEnum
+  | KWEvent
+  | KWExpect
+  | KWExport
+  | KWExtends
+  | KWExtern
+  | KWFinal
+  | KWFirstMatch
+  | KWFor
+  | KWForce
+  | KWForeach
+  | KWForever
+  | KWFork
+  | KWForkjoin
+  | KWFunction
+  | KWFunctionPrototype
+  | KWGenerate
+  | KWGenvar
+  | KWHighz0
+  | KWHighz1
+  | KWIf
+  | KWIff
+  | KWIfnone
+  | KWIgnoreBins
+  | KWIllegalBins
+  | KWImport
+  | KWIncdir
+  | KWInclude
+  | KWInitial
+  | KWInout
+  | KWInput
+  | KWInside
+  | KWInstance
+  | KWInt
+  | KWInteger
+  | KWInterface
+  | KWIntersect
+  | KWJoin
+  | KWJoinAny
+  | KWJoinNone
+  | KWLarge
+  | KWLiblist
+  | KWLibrary
+  | KWLocal
+  | KWLocalparam
+  | KWLogic
+  | KWLongint
+  | KWMacromodule
+  | KWMatches
+  | KWMedium
+  | KWModport
+  | KWModule
+  | KWNand
+  | KWNegedge
+  | KWNew
+  | KWNmos
+  | KWNor
+  | KWNoshowcancelled
+  | KWNot
+  | KWNotif0
+  | KWNotif1
+  | KWNull
+  | KWOption
+  | KWOr
+  | KWOutput
+  | KWPackage
+  | KWPacked
+  | KWParameter
+  | KWPathpulseDollar
+  | KWPmos
+  | KWPosedge
+  | KWPrimitive
+  | KWPriority
+  | KWProgram
+  | KWProperty
+  | KWProtected
+  | KWPull0
+  | KWPull1
+  | KWPulldown
+  | KWPullup
+  | KWPulsestyleOnevent
+  | KWPulsestyleOndetect
+  | KWPure
+  | KWRand
+  | KWRandc
+  | KWRandcase
+  | KWRandsequence
+  | KWRcmos
+  | KWReal
+  | KWRealtime
+  | KWRef
+  | KWReg
+  | KWRelease
+  | KWRepeat
+  | KWReturn
+  | KWRnmos
+  | KWRpmos
+  | KWRtran
+  | KWRtranif0
+  | KWRtranif1
+  | KWScalared
+  | KWSequence
+  | KWShortint
+  | KWShortreal
+  | KWShowcancelled
+  | KWSigned
+  | KWSmall
+  | KWSolve
+  | KWSpecify
+  | KWSpecparam
+  | KWStatic
+  | KWStrength0
+  | KWStrength1
+  | KWString
+  | KWStrong0
+  | KWStrong1
+  | KWStruct
+  | KWSuper
+  | KWSupply0
+  | KWSupply1
+  | KWTable
+  | KWTagged
+  | KWTask
+  | KWThis
+  | KWThroughout
+  | KWTime
+  | KWTimeprecision
+  | KWTimeunit
+  | KWTran
+  | KWTranif0
+  | KWTranif1
+  | KWTri
+  | KWTri0
+  | KWTri1
+  | KWTriand
+  | KWTrior
+  | KWTrireg
+  | KWType
+  | KWTypedef
+  | KWTypeOption
+  | KWUnion
+  | KWUnique
+  | KWUnsigned
+  | KWUse
+  | KWVar
+  | KWVectored
+  | KWVirtual
+  | KWVoid
+  | KWWait
+  | KWWaitOrder
+  | KWWand
+  | KWWeak0
+  | KWWeak1
+  | KWWhile
+  | KWWildcard
+  | KWWire
+  | KWWith
+  | KWWithin
+  | KWWor
+  | KWXnor
+  | KWXor
+  | IdSimple
+  | IdEscaped
+  | IdSystem
+  | LitNumberUnsigned
+  | LitNumber
+  | LitString
+  | SymParenL
+  | SymParenR
+  | SymBrackL
+  | SymBrackR
+  | SymBraceL
+  | SymBraceR
+  | SymTildy
+  | SymBang
+  | SymAt
+  | SymPound
+  | SymPercent
+  | SymHat
+  | SymAmp
+  | SymBar
+  | SymAster
+  | SymDot
+  | SymComma
+  | SymColon
+  | SymSemi
+  | SymEq
+  | SymLt
+  | SymGt
+  | SymPlus
+  | SymDash
+  | SymQuestion
+  | SymSlash
+  | SymDollar
+  | SymSQuote
+  | SymTildyAmp
+  | SymTildyBar
+  | SymTildyHat
+  | SymHatTildy
+  | SymEqEq
+  | SymBangEq
+  | SymAmpAmp
+  | SymBarBar
+  | SymAsterAster
+  | SymLtEq
+  | SymGtEq
+  | SymGtGt
+  | SymLtLt
+  | SymPlusPlus
+  | SymDashDash
+  | SymPlusEq
+  | SymDashEq
+  | SymAsterEq
+  | SymSlashEq
+  | SymPercentEq
+  | SymAmpEq
+  | SymBarEq
+  | SymHatEq
+  | SymPlusColon
+  | SymDashColon
+  | SymColonColon
+  | SymDotAster
+  | SymDashGt
+  | SymColonEq
+  | SymColonSlash
+  | SymPoundPound
+  | SymBrackLAster
+  | SymBrackLEq
+  | SymEqGt
+  | SymAtAster
+  | SymParenLAster
+  | SymAsterParenR
+  | SymAsterGt
+  | SymEqEqEq
+  | SymBangEqEq
+  | SymEqQuestionEq
+  | SymBangQuestionEq
+  | SymGtGtGt
+  | SymLtLtLt
+  | SymLtLtEq
+  | SymGtGtEq
+  | SymBarDashGt
+  | SymBarEqGt
+  | SymBrackLDashGt
+  | SymAtAtParenL
+  | SymParenLAsterParenR
+  | SymDashGtGt
+  | SymAmpAmpAmp
+  | SymLtLtLtEq
+  | SymGtGtGtEq
+  | Unknown
+  deriving (Show, Eq)