lexemeパーサを使うようにした

今週にはいって風邪をひいたりして、あまり作業を進められていないのですが
とはいえ、溜め込むと書くのが億劫になってしまうので、少しでも書いておこうと思います。

前回、とりあえず Vparsecという名前で書いています - kei-os2007 against the machine!! という内容で
Verilogパーサを書き始めましたが、空白の読み飛ばしとかもパース処理の中で実行していて
パース処理が無駄に煩雑になってしまっていました。
そこで、Parsecの Tokenライブラリと呼べばよいのでしょうか、
これを importして、不要な空白を読み飛ばす lexemeパーサを活用し
パーサ記述の煩雑さを減らしてみました。

今回の lexemeパーサの追加にあたって、下のような記述を加えています。

import qualified Text.ParserCombinators.Parsec.Token as P
import Text.ParserCombinators.Parsec.Language

-- XXX Mmm... TODO
verilogStyle =  emptyDef
            { commentStart = ""
            , commentEnd = ""
            , commentLine = ""
            , nestedComments = False
            , identStart = letter <|> char '_'
            , identLetter = alphaNum <|> oneOf "_'"
            , opStart = opLetter emptyDef
            , opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~"
            , reservedOpNames = []
            , reservedNames = []
            , caseSensitive = True
            }

lexer = P.makeTokenParser(verilogStyle)

reserved    = P.reserved lexer
operator    = P.operator lexer
reservedOp  = P.reservedOp lexer

natural     = P.natural lexer

symbol      = P.symbol lexer
lexeme      = P.lexeme lexer
whiteSpace  = P.whiteSpace lexer

parens      = P.parens lexer
braces      = P.braces lexer
angles      = P.angles lexer
brackets    = P.brackets lexer

semi        = P.semi lexer
comma       = P.comma lexer
colon       = P.colon lexer
dot         = P.dot lexer

semiSep     = P.semiSep lexer
semiSep1    = P.semiSep1 lexer
commaSep    = P.commaSep lexer
commaSep1   = P.commaSep1 lexer

import qualified 〜 を使うことによって
Text.ParserCombinators.Parsec.Tokenを P で置き換えて書けるようにしています。
記述量の節約ですね。

verilogStyleは、いまのところ、とりあえずの形だけです。すいません。
（今後、作り込んでいきたいと思っています。）

で、makeTokenParserを使って、トークンパーサを生成しています。lexerです。
この lexerを使って、新しく lexemeパーサを定義しています。
（reservedから commaSep1の行まで）

というわけで、lexemeパーサに置き換え後のソースコードを貼っておきます。
spaceや spacesによる読み飛ばし処理がなくなっています。
そのかわりに、新たに導入した symbol, lexeme, whiteSpace, parens, braces, semi, comma, colon, dot といったパーサが登場しています。

あと、細かなことですが func = do {a <- hoge; return a} のように書いてあった箇所は
func = hoge の記述に変えました。

次は、semantic valueのことを考えて、プリプロセス処理のことを考えて、と
進んでいくものと思われます。

module Vparsec where

import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Expr
import qualified Text.ParserCombinators.Parsec.Token as P
import Text.ParserCombinators.Parsec.Language

-- XXX Mmm... TODO
verilogStyle =  emptyDef
            { commentStart = ""
            , commentEnd = ""
            , commentLine = ""
            , nestedComments = False
            , identStart = letter <|> char '_'
            , identLetter = alphaNum <|> oneOf "_'"
            , opStart = opLetter emptyDef
            , opLetter = oneOf ":!#$%&*+./<=>?@\\^|-~"
            , reservedOpNames = []
            , reservedNames = []
            , caseSensitive = True
            }

lexer = P.makeTokenParser(verilogStyle)

reserved    = P.reserved lexer
operator    = P.operator lexer
reservedOp  = P.reservedOp lexer

natural     = P.natural lexer

symbol      = P.symbol lexer
lexeme      = P.lexeme lexer
whiteSpace  = P.whiteSpace lexer

parens      = P.parens lexer
braces      = P.braces lexer
angles      = P.angles lexer
brackets    = P.brackets lexer

semi        = P.semi lexer
comma       = P.comma lexer
colon       = P.colon lexer
dot         = P.dot lexer

semiSep     = P.semiSep lexer
semiSep1    = P.semiSep1 lexer
commaSep    = P.commaSep lexer
commaSep1   = P.commaSep1 lexer


{- for tiny parser test  -}
test :: Show a => Parser a -> String -> IO ()
test p input
        = case (parse p "" input) of
            Left err -> print err
            Right x -> print x


{-- File input version : parseVerilog "your_verilog_file.v" --}
parseVerilog :: FilePath -> IO ()
parseVerilog fname
    = do { input <- readFile fname
         ; putStr input
         ; case parse verilog1995 fname input of
                Left err -> do { putStr "Error parsing at : " ; print err }
                Right x -> print x }

-- Verilog 1995 parser
verilog1995 :: Parser String
verilog1995 = description
            <?> "source text!!"

description :: Parser String
description = moduleDeclaration <|> udpDeclaration
          <?> "description"
                
-- XXX MEMO : letters, digits, dollar, _ :: first must be a letter or the underscore.
-- XXX size is up to 1024. (this consraint is not implemented yet)
identifier :: Parser String
identifier = do { c <- char '_' <|> letter
                ; cs <- many (try(alphaNum) <|> try(char '_') <|> char '$')
                ; return (c:cs) }
          <?> "identifier"

moduleDeclaration :: Parser String
moduleDeclaration = do { a <- try(symbol "module")
                       ; b <- moduleDeclaration_
                       ; return $ a ++ b }
                <|> do { a <- try(symbol "macromodule")
                       ; b <- moduleDeclaration_
                       ; return $ a ++ b }
                <?> "moduleDeclaration"
    where
        moduleDeclaration_ :: Parser String
        moduleDeclaration_
              = do { a <- lexeme nameOfModule
                   ; b <- listOfPorts <|> string ""
                   ; c <- semi
--                   ; d <- lexeme(many moduleItem)     -- XXX TODO : next implementation
                   ; e <- symbol "endmodule"
                   ; return $ a ++ b ++ c {-++ (concat d)-} ++ e }

nameOfModule :: Parser String
nameOfModule = identifier <?> "nameOfModule"

listOfPorts :: Parser String
listOfPorts = parens listOfPorts_
            <?> "listOfPorts"
    where
        listOfPorts_ = do { whiteSpace
                          ; a <- lexeme port
                          ; b <- lexeme(many commaPorts)
                          ; return $ a ++ (concat b) }
                   <?> "listOfPorts_"

port :: Parser String
port = try(portExpression)
    <|> do { a <- dot
           ; b <- lexeme nameOfPort
           ; c <- parens port_
           ; return $ a ++ b ++ c }
    <|> string ""
    <?> "port"
        where
            port_ :: Parser String
            port_ = portExpression
                <|> string ""
                <?> "port_"

commaPorts :: Parser String
commaPorts = do { a <- comma
                ; b <- port
                ; return $ a ++ b }
          <?> "commaPorts"

portExpression :: Parser String
portExpression = try(portReference)
             <|> braces portExpression_
             <?> "portExpression"
                where
                    portExpression_ :: Parser String
                    portExpression_ = do { a <- portReference
                                         ; b <- many(commaPortReference)
                                         ; return $ a ++ concat(b) }

commaPortReference :: Parser String
commaPortReference = do { a <- comma
                        ; b <- portReference
                        ; return $ a ++ b }
                  <?> "commaPortReference"

portReference :: Parser String
portReference = do { a <- nameOfVariable
                   ; b <- portReference_
                   ; return $ a ++ b }
            <?> "portReference"
    where
        portReference_ :: Parser String
        portReference_ = do { a <- brackets constantExpression_; return a }
                      <|> string ""
        constantExpression_ :: Parser String
        constantExpression_ = constantExpression
                          <|> do { a <- lexeme constantExpression
                                 ; b <- colon
                                 ; c <- lexeme constantExpression
                                 ; return $ a ++ b ++ c}

nameOfPort :: Parser String
nameOfPort = identifier <?> "nameOfPort"

nameOfVariable :: Parser String
nameOfVariable = identifier <?> "nameOfVariable"


udpDeclaration :: Parser String
udpDeclaration = string ""
             <?> "udpDeclaration"

constantExpression :: Parser String
--constantExpression = expression
constantExpression = string ""      -- dummy
                 <?> "constantExpression"