抽象语言解释器中多义词的高阶效应

Question

我有这个问题，我想为 while 语言的抽象形式构建一个解释器。在 while 的情况下，我有一个

m Bool

需要在每次循环执行之前进行评估。但是，我还没有找到从 monad 中提取/使用布尔值的方法。我为阶乘函数编写了一个 while 程序，以阐明我想如何使用 while。有人可以帮我解决这个问题吗？

import Polysemy
import Polysemy.State
import Prelude hiding (lookup, log)
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
        body' <- runT body
        cond' <- runT cond
        let loop = do
              if cond' -- how can I get the boolean?
                then body' >> loop
                else pure ()
        _ <- pureT 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)

Answer 1

我不熟悉一词多义的工作原理，但根据 API 的类型，您似乎可以使用

getInspectorT

来获取函数

f x -> Maybe x

来检查计算生成的值，

getInitialState

来获取“初始状态”，以及

bindTSimple

通过处理的计算来线程化状态。我不知道

getInspectorT

返回的函数在什么情况下会产生

Nothing

。

{-# LANGUAGE FlexibleContexts, TemplateHaskell, LambdaCase, GADTs, ScopedTypeVariables, DataKinds, TypeOperators #-}

import Polysemy
import Polysemy.State
import Prelude hiding (lookup, log)
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
      inspector <- getInspectorT
      let loop unit = do
            cond' <- bindTSimple (\() -> cond) unit
            if fromJust (inspect inspector cond') then
              bindTSimple (\() -> body) unit >>=
              loop
            else
              pure unit
      unit <- getInitialStateT
      loop unit
    (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)

-- Run the example
main :: IO ()
main = runM (runState (empty :: WhileLangState) (runWhileLang whileFactorial)) >>= print