P79 - 用 Monad Transformer 求值后缀表达式
Evaluate postfix notation with monad transformers
官方模块：
Problems.P79核心函数：calculatePostfix
← P78 Writer Monad 与 Collatz | P80 图表示转换 →
状态、失败与日志
StateT [Integer]保存操作数栈；MaybeT表示栈下溢、除零等失败；Writer保存每一步的栈和操作符。
1import Control.Monad (mzero)
2import Control.Monad.State
3import Control.Monad.Trans.Maybe
4import Control.Monad.Writer
5
6data Operator = Negate | Add | Subtract | Multiply | Divide | Modulo
7 deriving (Eq, Show)
8data Element = Operator Operator | Operand Integer
9 deriving (Eq, Show)
10
11type History = [([Integer], Maybe Operator)]
12type Calculation = MaybeT (StateT [Integer] (Writer History))
实现
方法一：MaybeT + StateT + Writer
1calculatePostfix :: [Element] -> (Maybe Integer, History)
2calculatePostfix expression = (answer, history)
3 where
4 ((status, stack), history) =
5 runWriter (runStateT (runMaybeT (mapM_ step expression)) [])
6 answer = case (status, stack) of
7 (Just (), [x]) -> Just x
8 _ -> Nothing
9
10step :: Element -> Calculation ()
11step (Operand n) = modify (n:) >> record Nothing
12step (Operator op) = apply op >> record (Just op)
13
14record :: Maybe Operator -> Calculation ()
15record op = get >>= \stack -> tell [(stack, op)]
16
17pop :: Calculation Integer
18pop = do
19 stack <- get
20 case stack of
21 [] -> mzero
22 x:rest -> put rest >> pure x
23
24apply :: Operator -> Calculation ()
25apply Negate = pop >>= \x -> modify ((-x):)
26apply op = do
27 b <- pop
28 a <- pop
29 value <- binary op a b
30 modify (value:)
31
32binary :: Operator -> Integer -> Integer -> Calculation Integer
33binary Add a b = pure (a + b)
34binary Subtract a b = pure (a - b)
35binary Multiply a b = pure (a * b)
36binary Divide _ 0 = mzero
37binary Divide a b = pure (a `div` b)
38binary Modulo _ 0 = mzero
39binary Modulo a b = pure (a `mod` b)
40binary Negate _ _ = mzero
方法二：用 ExceptT 保留失败原因
1import Control.Monad.Except
2
3type CalculationE = ExceptT String (StateT [Integer] (Writer History))
4
5calculatePostfixEither :: [Element] -> (Either String Integer, History)
6calculatePostfixEither expression = (answer, history)
7 where
8 ((status, stack), history) =
9 runWriter (runStateT (runExceptT (mapM_ stepE expression)) [])
10 answer = case (status, stack) of
11 (Left message, _) -> Left message
12 (Right (), [value]) -> Right value
13 (Right (), _) -> Left "expression did not leave one value"
14
15stepE :: Element -> CalculationE ()
16stepE (Operand n) = modify (n :) >> recordE Nothing
17stepE (Operator operator) = applyE operator >> recordE (Just operator)
18
19recordE :: Maybe Operator -> CalculationE ()
20recordE operator = get >>= \stack -> tell [(stack, operator)]
21
22popE :: CalculationE Integer
23popE = do
24 stack <- get
25 case stack of
26 [] -> throwError "stack underflow"
27 value:rest -> put rest >> pure value
28
29applyE :: Operator -> CalculationE ()
30applyE Negate = popE >>= \value -> modify ((-value) :)
31applyE operator = do
32 right <- popE
33 left <- popE
34 value <- binaryE operator left right
35 modify (value :)
36
37binaryE :: Operator -> Integer -> Integer -> CalculationE Integer
38binaryE Add a b = pure (a + b)
39binaryE Subtract a b = pure (a - b)
40binaryE Multiply a b = pure (a * b)
41binaryE Divide _ 0 = throwError "division by zero"
42binaryE Divide a b = pure (a `div` b)
43binaryE Modulo _ 0 = throwError "modulo by zero"
44binaryE Modulo a b = pure (a `mod` b)
45binaryE Negate _ _ = throwError "unexpected binary negate"
状态栈和 Writer 历史保持不变，只把最外层失败效果从 MaybeT 换成 ExceptT String。这样仍然会在错误处短路，同时调用者能区分栈下溢、除零和最终栈元素数量错误。
方法对比
| 方法 | 失败信息 | 成功结果 |
|---|---|---|
MaybeT | 只有 Nothing | Maybe Integer |
ExceptT String | 具体错误文本 | Either String Integer |
测试
1>>> calculatePostfix [Operand 3, Operand 4, Operand 2,
2... Operator Subtract, Operator Multiply]
3(Just 6,[([3],Nothing),([4,3],Nothing),([2,4,3],Nothing),
4 ([2,3],Just Subtract),([6],Just Multiply)])
5>>> fst (calculatePostfix [Operand 1, Operand 0, Operator Divide])
6Nothing
7>>> fst (calculatePostfixEither [Operand 1, Operand 0, Operator Divide])
8Left "division by zero"
Transformer 的层次使三种效果保持独立：错误不会伪造结果，状态不需要手工穿线，历史也不会混入求值返回类型。