Parsec ライブラリでパーサを作る

Parsec ライブラリでパーサを作る

という記事を見つけたので、そこのプログラム例を実行してみた。

アイディアとしては、式の代数的データ型 Expr と単項演算の代数的データ型 Unop 、２項演算の代数的データ型 Duop 、文の代数的データ型 Stmt を作り、パーサによるパースの段階で、データをそれぞれの枠組みに割り当てていくという感じだった。

文のパーサを再帰下降型でプログラムすることで、その都度行われる処理が、自然に構文木を作るようになる。パターンマッチで自然に構文木が作られていくのが面白かった。

自分用のプログラム言語を作るための最後の関門である構文木の作成は、代数的データ型の利用で直感的に行うことができるようだ。

stmt.hs

実行例

Prelude> :l stmt.hs
[1 of 1] Compiling Statement ( stmt.hs, interpreted )
Ok, modules loaded: Statement.
*Statement> play "a := true"
Seq ["a" := Con True]
*Statement> play "if a = b then c := true else c := false fi"
Seq [If (Duo Iff (Var "a") (Var "b")) (Seq ["c" := Con True]) (Seq ["c" :=
 Con False])]
*Statement> play "a := true; b := a"
Seq ["a" := Con True,"b" := Var "a"]

ファイル名：stmt.hs

module Statement where

import Text.Parsec
import Text.Parsec.String
import Text.Parsec.Expr
import Text.Parsec.Token
import Text.Parsec.Language (emptyDef)

data Expr = Var String | Con Bool | Uno Unop Expr | Duo Duop Expr Expr
   deriving Show
data Unop = Not deriving Show
data Duop = And | Iff deriving Show
data Stmt = Nop | String := Expr | If Expr Stmt Stmt | While Expr Stmt |
 Seq [Stmt]
   deriving Show

def :: LanguageDef st
def = emptyDef {
   commentStart = "{-"
   , commentEnd = "-}"
   , identStart = letter
   , identLetter = alphaNum
   , opStart = oneOf "~&=:"
   , opLetter = oneOf "~&=:"
   , reservedOpNames = ["~", "&", "=", ":="]
   , reservedNames = ["true", "false", "nop", "if", "then", "else", "fi",
 "while", "do", "od"]
}

lexer = makeTokenParser def

m_parens = parens lexer
m_identifier = identifier lexer
m_reservedOp = reservedOp lexer
m_reserved = reserved lexer
m_semiSep1 = semiSep1 lexer
m_whiteSpace = whiteSpace lexer

exprparser :: Parser Expr
exprparser = buildExpressionParser table term <?> "expression"
table = [
   [ Prefix (m_reservedOp "-" >> return (Uno Not))]
   , [Infix (m_reservedOp "&" >> return (Duo And)) AssocLeft]
   , [Infix (m_reservedOp "=" >> return (Duo Iff)) AssocLeft]
   ]
term = m_parens exprparser
   <|> fmap Var m_identifier
   <|> (m_reserved "true" >> return (Con True))
   <|> (m_reserved "false" >> return (Con False))

mainparser :: Parser Stmt
mainparser = m_whiteSpace >> stmtparser <* eof
   where
     stmtparser :: Parser Stmt
     stmtparser = fmap Seq (m_semiSep1 stmt1)
     stmt1 = (m_reserved "nop" >> return Nop)
       <|> do { v <- m_identifier; m_reservedOp ":="; e <- exprparser;
 return (v := e) }
       <|> do { m_reserved "if" ; b <- exprparser ; m_reserved "then" ;
 p <- stmtparser ; m_reserved "else" ; q <- stmtparser ; m_reserved "fi" ;
 return (If b p q) }
       <|> do { m_reserved "while" ; b <- exprparser ; m_reserved "do" ;
 p <- stmtparser ; m_reserved "od" ; return (While b p) }

play :: String -> IO ()
play inp = case parse mainparser "" inp of
   Left err -> print err
   Right ans -> print ans