CODEWITHSUNDEEP
haskelldslhaskell-polysemy
Morpheus
Morpheus

Reputation: 19

In a higher-order effect in polysemy for abstract while language interpreter

I have this problem, where I want to build an interpreter for an abstract form of the while language. In the condition of the while, I have an m Bool which needs to be evaluated before every loop execution. However, I have not yet found a way to extract/use the boolean out of the monad. I have made a while program for a factorial function to clarify how I want to use the while. Can anybody help me figure out how to solve this?

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)

Upvotes: 0

Views: 50

Answers (1)

Li-yao Xia
Li-yao Xia

Reputation: 33519

I'm not familiar with how polysemy works but based on the types of the API, it looks like you can use getInspectorT to get a function f x -> Maybe x that lets you inspect values produced by computations, getInitialState to get an "initial state", and bindTSimple to thread the state through the handled computation. I don't know in what situations the function returned by getInspectorT produces 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

Upvotes: 2

Related Questions