Polysemy高阶效应下抽象While语言解释器的实现难题

你当前的核心问题是：While构造子的条件是m Bool类型（对应Polysemy中的Sem r Bool），但你提前用runT把它转换成Sem r Bool后，试图直接把它当作纯布尔值用在if判断里——这是行不通的，因为Sem r Bool是一个计算动作，不是纯值，需要每次循环都执行这个动作来获取最新的布尔结果。

下面是修正后的代码，重点修改了runWhileLang中While分支的实现：

import Polysemy
import Polysemy.State
import Prelude hiding (lookup)
import Data.Map
import Data.Maybe

type WhileLangState = Map String Double

data WhileLang m a where
    Assign :: String -> Double -> WhileLang m ()
    While :: m Bool -> m () -> WhileLang m ()
    GetVar :: String -> WhileLang m Double

makeSem ''WhileLang

runWhileLang :: Member (State WhileLangState) r => Sem (WhileLang : r) a -> Sem r a
runWhileLang = interpretH $ \case
    Assign s d -> do
      state <- get
      put (insert s d state)
      pureT ()
    While cond body -> do
        -- 把cond和body转换成可以在基础monad中运行的动作
        condAction <- runT cond
        bodyAction <- runT body
        -- 定义递归循环：每次先执行条件动作获取布尔值
        let loop = do
              condResult <- condAction
              if condResult
                then bodyAction >> loop
                else pure ()
        -- 用liftSem把循环动作提升到Tactical环境中执行
        liftSem loop
        pureT ()
    GetVar s -> do
      state <- get
      pureT $ fromMaybe 0 (lookup s state)

whileFactorial :: Member WhileLang r => Sem r ()
whileFactorial = do
  assign "n" 8
  assign "result" 1

  while ((> 0) <$> getVar "n") $ do
    result <- getVar "result"
    currentN <- getVar "n"
    assign "result" (result * currentN)
    assign "n" (currentN - 1)

关键修正点说明 #

1. 循环中每次求值条件：不再试图提前提取布尔值，而是在loop里每次都执行condAction（即Sem r Bool）来获取最新的条件结果——这符合While循环的语义：每次循环前都重新计算条件。
2. 用liftSem执行循环动作：因为interpretH的上下文是Tactical monad，需要用liftSem把普通的Sem r ()循环动作提升到这个环境中执行。
3. 移除无效的pureT包裹：原来的代码里用pureT loop是错误的，因为loop是Sem r ()，不是纯值，必须通过liftSem来执行它。

现在你可以正常运行阶乘示例，每次循环都会重新计算getVar "n" > 0的条件，直到n减到0时退出循环。

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