我有一个使用以下数据类型定义的递归下降解析器的产生:
data CST
= Program CST CST
| Block CST CST CST
| StatementList CST CST
| EmptyStatementList
| Statement CST
| PrintStatement CST CST CST CST
| AssignmentStatement CST CST CST
| VarDecl CST CST
| WhileStatement CST CST CST
| IfStatement CST CST CST
| Expr CST
| IntExpr1 CST CST CST
| IntExpr2 CST
| StringExpr CST CST CST
| BooleanExpr1 CST CST CST CST CST
| BooleanExpr2 CST
| Id CST
| CharList CST CST
| EmptyCharList
| Type CST
| Character CST
| Space CST
| Digit CST
| BoolOp CST
| BoolVal CST
| IntOp CST
| TermComponent Token
| ErrorTermComponent (Token, Int)
| NoInput
正如数据类型名称所暗示的那样,数据类型构造了一个具体的语法树。我想知道是否有一种更易于维护的模式匹配方式。例如,要跟踪解析调用的执行,我有以下内容:
checkAndPrintParse :: CST -> IO ()
checkAndPrintParse (Program c1 c2) = do
putStrLn "Parser: parseProgram"
checkAndPrintParse c1
checkAndPrintParse c2
checkAndPrintParse (Block c1 c2 c3) = do
putStrLn "Parser: parseBlock"
checkAndPrintParse c1
checkAndPrintParse c2
checkAndPrintParse c3
checkAndPrintParse (StatementList c1 c2) = do
putStrLn "Parser: parseStatementList"
checkAndPrintParse c1
checkAndPrintParse c2
等等。我已查看fix
功能/模式,但我不确定它是否适用于此处。
答案 0 :(得分:4)
使用generic-derived来获取构造函数的名称:
Generic
(来自GHC.Generics
)conNameOf :: CSTF -> String
(来自Generics.Deriving
)使用递归方案遍历递归类型:
makeBaseFunctor
派生递归类型的基础仿函数。 CST
的基本仿函数(CSTF
)是一种参数化类型,其形状与CST
相同,但CST
的递归出现次数被type参数替换。 cata
(开头可能有些弯曲)。在这种情况下,我们希望从IO ()
递归构造CST
动作,即函数CST -> IO ()
。为此,cata
的类型变为(CSTF (IO ()) -> IO ()) -> CST -> IO ()
(带t ~ CST
和a ~ IO ()
),其中第一个参数定义了生成的递归函数的主体,以及递归的结果调用放在基础仿函数的字段中。所以,如果你的目标是编写递归函数checkAndPrintParse
,例如:
checkAndPrintParse (Program c1 c2) = do
putStrLn "Parser: parseProgram"
checkAndPrintParse c1
checkAndPrintParse c2
cata
会将其递归调用的结果放在c1
和c2
上代替这些字段:
-- goal: find f such that cata f = checkAndPrintParse
-- By definition of cata
cata f (Program c1 c2) = f (ProgramF (cata f c1) (cata f c2))
-- By the goal and the definition of checkAndPrintParse
cata f (Program c1 c2) = checkAndPrintParse (Program c1 c2) = do
putStrLn "Parser: parseProgram"
checkAndPrintParse c1
checkAndPrintParse c2
因此
f (ProgramF (cata f c1) (cata f c2)) = do
putStrLn "Parser: parseProgram"
cata f c1
cata f c2
摘要cata f c1
和cata f c2
f (ProgramF x1 x2) = do
putStrLn "Parser: parserProgram"
x1 >> x2
识别折叠(在Foldable
意义上)
f t@(ProgramF _ _) = do
putStrLn "Parser: parserProgram"
sequence_ t
再次推广
f t = do
putStrLn $ "Parser: " ++ conNameOf t -- Prints "ProgramF" instead of "parserProgram"... *shrugs*
sequence_ t
这是我们给cata
的论点。
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
import GHC.Generics
import Generics.Deriving (conNameOf)
import Data.Functor.Foldable
import Data.Functor.Foldable.TH (makeBaseFunctor)
data CST
= Program CST CST
| Block CST CST CST
| StatementList CST CST
| EmptyStatementList
| Statement CST
| PrintStatement CST CST CST CST
| AssignmentStatement CST CST CST
| VarDecl CST CST
| WhileStatement CST CST CST
| IfStatement CST CST CST
| Expr CST
| IntExpr1 CST CST CST
| IntExpr2 CST
| StringExpr CST CST CST
| BooleanExpr1 CST CST CST CST CST
| BooleanExpr2 CST
| Id CST
| CharList CST CST
| EmptyCharList
| Type CST
| Character CST
| Space CST
| Digit CST
| BoolOp CST
| BoolVal CST
| IntOp CST
| TermComponent Token
| ErrorTermComponent (Token, Int)
| NoInput
deriving Generic
data Token = Token
makeBaseFunctor ''CST
deriving instance Generic (CSTF a)
checkAndPrintParse :: CST -> IO ()
checkAndPrintParse = cata $ \t -> do
putStrLn $ "Parser: " ++ conNameOf t
sequence_ t
main = checkAndPrintParse $
Program (Block NoInput NoInput NoInput) (Id NoInput)
输出:
Parser: ProgramF
Parser: BlockF
Parser: NoInputF
Parser: NoInputF
Parser: NoInputF
Parser: IdF
Parser: NoInputF