Haskell中LALR1解析器改造：带附加信息的符号处理方案咨询

云上老周

2026-7-11

问题描述

我已经实现了一个仅依赖Eq约束的可参数化LALR(1)解析器，代码如下：

module LALR.Parser where

data Rule symbolT = Rule 
    {
        lhs :: symbolT,
        rhs :: Int
    }

data Action symbolT = Accept
    | Goto (State symbolT)
    | Shift (State symbolT)
    | Reduce (Rule symbolT)

data State symbolT = State
    {
        transitions :: [ (symbolT, Action symbolT) ]
    }

data Parser symbolT = Parser
    {
        states :: [State symbolT],
        input  :: [symbolT]
    }

data Result symbolT = UnexpectedSymbol symbolT
    | Accepted
    | Pending (Parser symbolT)
    | EmptyInput
    | EmptyStack

build :: State symbolT -> [symbolT] -> Parser symbolT
build state input = Parser
    {
        states = [state],
        input = input
    }

step :: Eq symbolT => Parser symbolT -> Result symbolT
step (Parser [] _) = EmptyStack
step (Parser _ []) = EmptyInput
step parser@(Parser states@(state : statesTail) input@(lookAhead : inputTail) ) = case (action) of
    Nothing                            -> UnexpectedSymbol lookAhead
    Just Accept                        -> Accepted
    Just (Shift target)                -> Pending (Parser (target : states) inputTail)
    Just (Reduce rule@(Rule lhs rhs) ) -> Pending (Parser (drop rhs states) (lhs : input) )
    Just (Goto target)                 -> Pending (Parser (target : states) inputTail )
    where
        action = lookup lookAhead (transitions state)

run :: Eq symbolT => Parser symbolT -> Result symbolT
run parser = case (step parser) of
    Pending parser -> run parser
    result         -> result

现在我想把它改造成编译器，不仅能接受/拒绝输入，还要能将输入转换为有用结果，计划添加处理不同动作的处理器。编译器需要处理的不是单纯的Symbol，而是带附加信息的符号，比如负载（词法分析器生成的内容）、行号、文件名等。

在面向对象语言里我会用继承从Symbol派生子类，但Haskell里该怎么实现？我考虑定义一个Token类型类，要求实现symbol :: Token -> Symbol函数，然后创建实现该类的数据结构，把约束从Eq symbolT改成Token symbolT，查找符号时调用symbol方法。（我目前主要用Prelude学习Haskell）

补充说明

你的代码全程由symbolT参数化，为何不直接假设symbolT是带负载的符号？你是否需要为不同符号设置不同类型的负载？

是的，我需要不同类型的负载，词法分析器生成[Token]，定义如下：

data Token = Assignment | Name String | Number Int

lex :: String -> Maybe [Token]

我可以为Token派生Eq实例，让它忽略负载：

instance Eq Token where
    (==) (Name _) (Name _) = True
    -- 其他情况类似

但这样定义状态的transitions时，就需要用占位Token，比如[ (Number 0, Accept), (Name "", Shift state3) ]，看起来不太合理。我想到了如下类型类方案：

class Tkn a symbolT where
    symbol :: a -> symbolT

然后在查找转移时调用该方法提取符号，不确定这个方案是否合理，或者有没有更优的实现方式。

解决方案

1. 分离语法符号与带负载的Token

首先明确区分语法符号（用于语法分析的抽象标识，比如AssignSym、NameSym、NumberSym）和实际Token（包含语法符号、负载、位置信息等）。状态转移表只和抽象语法符号关联，避免使用占位Token。

定义抽象语法符号类型：

data Symbol
    = AssignSym
    | NameSym
    | NumberSym
    deriving (Eq, Show)

定义带负载和位置信息的Token类型：

data Token
    = Assignment { tokenPos :: (Int, String) }  -- (行号, 文件名)
    | Name { tokenName :: String, tokenPos :: (Int, String) }
    | Number { tokenValue :: Int, tokenPos :: (Int, String) }

2. 用类型类关联Token与Symbol

用类型类提取Token对应的语法符号，和你的思路一致但更简洁：

class Tokenizable a where
    toSymbol :: a -> Symbol

为Token实现该类型类：

instance Tokenizable Token where
    toSymbol Assignment{} = AssignSym
    toSymbol Name{} = NameSym
    toSymbol Number{} = NumberSym

3. 修改解析器适配Token与语义输出

调整解析器结构，添加语义栈保存中间结果，让解析器能生成有用的输出：

调整核心数据类型

让State、Rule、Action基于抽象Symbol定义，转移表不再依赖具体Token：

data Rule = Rule 
    {
        lhs :: Symbol,
        rhs :: Int
    }

data Action = Accept
    | Goto State
    | Shift State
    | Reduce Rule

data State = State
    {
        transitions :: [ (Symbol, Action) ]
    }

定义支持语义值的解析器和结果类型：

-- 参数化支持不同Token类型和语义结果类型
data Parser tokenT semValT = Parser
    {
        states :: [State],
        input  :: [tokenT],
        semStack :: [semValT]  -- 保存语义分析中间结果
    }

data Result tokenT semValT
    = UnexpectedSymbol tokenT
    | Accepted semValT  -- 接受时返回最终语义结果
    | Pending (Parser tokenT semValT)
    | EmptyInput
    | EmptyStack

修改step函数添加语义处理

添加语义处理器参数，处理不同动作时生成对应语义值，同时通过Tokenizable约束提取Symbol做转移查找：

-- 语义处理器类型：输入动作、当前语义栈、当前Token，返回新语义值
type SemProcessor tokenT semValT = Action -> [semValT] -> tokenT -> Maybe semValT

step :: (Tokenizable tokenT) => SemProcessor tokenT semValT -> Parser tokenT semValT -> Result tokenT semValT
step _ (Parser [] _ _) = EmptyStack
step _ (Parser _ [] _) = EmptyInput
step semProc parser@(Parser states@(state : statesTail) input@(lookAhead : inputTail) semStack) =
    case lookup (toSymbol lookAhead) (transitions state) of
        Nothing -> UnexpectedSymbol lookAhead
        Just Accept -> case semStack of
            [final] -> Accepted final
            _ -> EmptyStack  -- 栈状态异常
        Just (Shift target) -> case semProc (Shift target) semStack lookAhead of
            Just newSem -> Pending (Parser (target : states) inputTail (newSem : semStack))
            Nothing -> UnexpectedSymbol lookAhead
        Just (Reduce rule@(Rule lhs rhs)) ->
            let (semToReduce, semRest) = splitAt rhs semStack
            in case semProc (Reduce rule) semToReduce lookAhead of
                Just newSem -> Pending (Parser (drop rhs states) (lhsToken lhs : input) (newSem : semRest))
                Nothing -> UnexpectedSymbol lookAhead
        Just (Goto target) -> case semProc (Goto target) semStack lookAhead of
            Just newSem -> Pending (Parser (target : states) inputTail (newSem : semStack))
            Nothing -> UnexpectedSymbol lookAhead
    where
        -- 根据Symbol生成Reduce时需要的占位Token
        lhsToken AssignSym = Assignment (0, "")
        lhsToken NameSym = Name "" (0, "")
        lhsToken NumberSym = Number 0 (0, "")

适配build和run函数

build :: State -> [tokenT] -> Parser tokenT semValT
build state input = Parser
    {
        states = [state],
        input = input,
        semStack = []
    }

run :: (Tokenizable tokenT) => SemProcessor tokenT semValT -> Parser tokenT semValT -> Result tokenT semValT
run semProc parser = case step semProc parser of
    Pending newParser -> run semProc newParser
    result -> result

4. 语义处理器示例

比如实现一个生成抽象语法树（AST）的处理器：

data Expr
    = Assign Expr Expr
    | Var String
    | Num Int

semProcessor :: SemProcessor Token Expr
semProcessor action semStack token = case action of
    Shift _ -> case token of
        Name n _ -> Just (Var n)
        Number v _ -> Just (Num v)
        Assignment{} -> Nothing
    Reduce (Rule lhs rhs) -> case (lhs, rhs, semStack) of
        (AssignSym, 2, [rhsExpr, lhsExpr]) -> Just (Assign lhsExpr rhsExpr)
        _ -> Nothing
    _ -> Just (head semStack)  -- Goto和Accept直接传递栈顶值

方案优势

分离语法符号与Token，转移表无需占位值，逻辑更清晰
Tokenizable类型类支持灵活扩展，后续可添加其他Token类型
语义栈设计让解析器能输出有用的编译结果，满足编译器需求

替代方案：GADTs增强类型安全

如果需要严格保证Symbol与负载类型的对应关系，可使用GADTs：

data Symbol a where
    AssignSym :: Symbol ()
    NameSym :: Symbol String
    NumberSym :: Symbol Int

data Token where
    Assignment :: (Int, String) -> Token
    Name :: String -> (Int, String) -> Token
    Number :: Int -> (Int, String) -> Token

class Tokenizable a where
    toSymbol :: a -> SomeSymbol

data SomeSymbol = forall a. SomeSymbol (Symbol a)

instance Tokenizable Token where
    toSymbol (Assignment _) = SomeSymbol AssignSym
    toSymbol (Name _ _) = SomeSymbol NameSym
    toSymbol (Number _ _) = SomeSymbol NumberSym

该方案在类型层面确保Symbol与负载的匹配，但会增加复杂度，适合对类型安全要求高的场景。

内容的提问来源于stack exchange，提问作者Chirmol Studio

Haskell中LALR1解析器改造：带附加信息的符号处理方案咨询

补充说明 #

1. 分离语法符号与带负载的Token #

2. 用类型类关联Token与Symbol #

3. 修改解析器适配Token与语义输出 #