Lexeme パーサ

everyday parser Parsec
  • 説明の順序とコードが出現する順序がごちゃごちゃで、再現させにくい…
  • digitToInt って何だ？ Char.digitToInt にあった

まんま(完成品？)

module Main where

import Char
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Token( TokenParser, makeTokenParser, reservedNames, reservedOpNames )
import qualified Text.ParserCombinators.Parsec.Token as P
import Text.ParserCombinators.Parsec.Language( haskellStyle, haskellDef )

lexer :: TokenParser ()
lexer  = makeTokenParser 
         (haskellDef
         { reservedNames   = ["return","total"]
         , reservedOpNames = ["*","/","+","-"]
         })

whiteSpace = P.whiteSpace lexer
lexeme     = P.lexeme lexer
symbol     = P.symbol lexer
natural    = P.natural lexer
parens     = P.parens lexer
semi       = P.semi lexer
identifier = P.identifier lexer
reserved   = P.reserved lexer
reservedOp = P.reservedOp lexer

receipt :: Parser Bool
receipt = do{ ps <- many produkt
            ; p  <- total
            ; return (sum ps == p)
            }

produkt = do{ reserved "return"
            ; p <- price
            ; semi
            ; return (-p)
            }
      <|> do{ identifier
            ; p  <- price
            ; semi
            ; return p
            }
      <?> "produkt"

total   = do{ p <- price
            ; reserved "total"
            ; return p
            }

price   :: Parser Int   -- price in cents         
price   = lexeme (do{ ds1 <- many1 digit
                    ; char '.'
                    ; ds2 <- count 2 digit
                    ; return (convert 0 (ds1 ++ ds2))            
                    })
          <?> "price"
          where
            convert n []     = n
            convert n (d:ds) = convert (10*n + digitToInt d) ds

run :: Show a => Parser a -> String -> IO ()
run p input
        = case (parse p "" input) of
            Left err -> do{ putStr "parse error at "
                          ; print err
                          }
            Right x  -> print x

runLex :: Show a => Parser a -> String -> IO ()
runLex p input
        = run (do{ whiteSpace
                 ; x <- p
                 ; eof
                 ; return x
                 }) input

で、

*Main> runLex receipt "book 12.00; plant 2.55; 14.55 total"
True
*Main> runLex receipt "book 12.00; plant 2.55; 12.55 total"
False
*Main> runLex receipt "book 12.00; plant 2; 12.55 total"
parse error at (line 1, column 20):
unexpected ";"
expecting digit or "."
*Main> runLex receipt "book 12.00; return 2.00; plant 2.55; 12.55 total"
True
*Main> runLex receipt "book 12.00; reader 2.00; plant 1.00; 15.00 total"
True
*Main> runLex receipt "book 12.00; returns 2.00; plant 1.00; 15.00 total"
True
*Main> runLex receipt "book 12.00; total 2.00; plant 1.00; 15.00 total"
parse error at (line 1, column 13):
unexpected reserved word "total"
expecting produkt or price
*Main> runLex receipt "book 12.00; totals 2.00; return 1.00; 13.00 total"
True


まんま(produkt がちょっと違う、try 入り)

module Main where

import Char
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Token( TokenParser, makeTokenParser, reservedNames, reservedOpNames )
import qualified Text.ParserCombinators.Parsec.Token as P
import Text.ParserCombinators.Parsec.Language( haskellStyle, haskellDef )

lexer :: TokenParser ()
lexer  = makeTokenParser 
         (haskellDef
         { reservedNames   = ["return","total"]
         , reservedOpNames = ["*","/","+","-"]
         })

whiteSpace = P.whiteSpace lexer
lexeme     = P.lexeme lexer
symbol     = P.symbol lexer
natural    = P.natural lexer
parens     = P.parens lexer
semi       = P.semi lexer
identifier = P.identifier lexer
reserved   = P.reserved lexer
reservedOp = P.reservedOp lexer

receipt :: Parser Bool
receipt = do{ ps <- many produkt
            ; p  <- total
            ; return (sum ps == p)
            }

produkt = do{ try (symbol "return")
            ; p <- price
            ; semi
            ; return (-p)
            }
      <|> do{ identifier
            ; p  <- price
            ; semi
            ; return p
            }
      <?> "produkt"

total   = do{ p <- price
            ; reserved "total"
            ; return p
            }

price   :: Parser Int   -- price in cents         
price   = lexeme (do{ ds1 <- many1 digit
                    ; char '.'
                    ; ds2 <- count 2 digit
                    ; return (convert 0 (ds1 ++ ds2))            
                    })
          <?> "price"
          where
            convert n []     = n
            convert n (d:ds) = convert (10*n + digitToInt d) ds

run :: Show a => Parser a -> String -> IO ()
run p input
        = case (parse p "" input) of
            Left err -> do{ putStr "parse error at "
                          ; print err
                          }
            Right x  -> print x

runLex :: Show a => Parser a -> String -> IO ()
runLex p input
        = run (do{ whiteSpace
                 ; x <- p
                 ; eof
                 ; return x
                 }) input

で、

*Main> runLex receipt "book 12.00; plant 2.55; 14.55 total"
True
*Main> runLex receipt "book 12.00; plant 2.55; 12.55 total"
False
*Main> runLex receipt "book 12.00; plant 2; 12.55 total"
parse error at (line 1, column 20):
unexpected ";"
expecting digit or "."
*Main> runLex receipt "book 12.00; return 2.00; plant 2.55; 12.55 total"
True
*Main> runLex receipt "book 12.00; reader 2.00; plant 1.00; 15.00 total"
True
*Main> runLex receipt "book 12.00; returns 2.00; plant 1.00; 15.00 total"
parse error at (line 1, column 19):
unexpected "s"
expecting price
*Main> runLex receipt "book 12.00; total 2.00; plant 1.00; 15.00 total"
parse error at (line 1, column 13):
unexpected reserved word "total"
expecting produkt or price
*Main> runLex receipt "book 12.00; totals 2.00; return 1.00; 13.00 total"
True


まんま(lexer がちょっと違う、字句解析の時のまま)

module Main where

import Char
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Token( TokenParser, makeTokenParser, reservedOpNames )
import qualified Text.ParserCombinators.Parsec.Token as P
import Text.ParserCombinators.Parsec.Language( haskellStyle, haskellDef )

lexer :: TokenParser ()
lexer  = makeTokenParser 
         (haskellDef
         { reservedOpNames = ["*","/","+","-"]
         })

whiteSpace = P.whiteSpace lexer
lexeme     = P.lexeme lexer
symbol     = P.symbol lexer
natural    = P.natural lexer
parens     = P.parens lexer
semi       = P.semi lexer
identifier = P.identifier lexer
reserved   = P.reserved lexer
reservedOp = P.reservedOp lexer

receipt :: Parser Bool
receipt = do{ ps <- many produkt
            ; p  <- total
            ; return (sum ps == p)
            }

produkt = do{ reserved "return"
            ; p <- price
            ; semi
            ; return (-p)
            }
      <|> do{ identifier
            ; p  <- price
            ; semi
            ; return p
            }
      <?> "produkt"

total   = do{ p <- price
            ; reserved "total"
            ; return p
            }

price   :: Parser Int   -- price in cents         
price   = lexeme (do{ ds1 <- many1 digit
                    ; char '.'
                    ; ds2 <- count 2 digit
                    ; return (convert 0 (ds1 ++ ds2))            
                    })
          <?> "price"
          where
            convert n []     = n
            convert n (d:ds) = convert (10*n + digitToInt d) ds

run :: Show a => Parser a -> String -> IO ()
run p input
        = case (parse p "" input) of
            Left err -> do{ putStr "parse error at "
                          ; print err
                          }
            Right x  -> print x

runLex :: Show a => Parser a -> String -> IO ()
runLex p input
        = run (do{ whiteSpace
                 ; x <- p
                 ; eof
                 ; return x
                 }) input

で、

*Main> runLex receipt "book 12.00; plant 2.55; 14.55 total"
True
*Main> runLex receipt "book 12.00; plant 2.55; 12.55 total"
False
*Main> runLex receipt "book 12.00; plant 2; 12.55 total"
parse error at (line 1, column 20):
unexpected ";"
expecting digit or "."
*Main> runLex receipt "book 12.00; return 2.00; plant 2.55; 12.55 total"
True
*Main> runLex receipt "book 12.00; reader 2.00; plant 1.00; 15.00 total"
True
*Main> runLex receipt "book 12.00; returns 2.00; plant 1.00; 15.00 total"
True
*Main> runLex receipt "book 12.00; total 2.00; plant 1.00; 15.00 total"
True
*Main> runLex receipt "book 12.00; totals 2.00; return 1.00; 13.00 total"
True