2

我尝试使用raiseUnder（使用多义词 1.6.0）来引入效果以使用其他解释器，例如：

{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}

module Memoization where

import Data.Kind
import qualified Data.Map.Strict as M
import Polysemy
import Polysemy.State

data Memoization (k :: Type) (v :: Type) (m :: Type -> Type) (a :: Type) where
  FetchMemoized :: k -> Memoization k v m v

makeSem ''Memoization

runMemoizationState ::
  forall k v r.
  ( Ord k,
    Members
      '[State (M.Map k v)]
      r
  ) =>
  (k -> Sem r v) ->
  InterpreterFor (Memoization k v) r
runMemoizationState f = interpret $ \case
  FetchMemoized k -> do
    memoized <- get @(M.Map k v)
    case memoized M.!? k of
      Just memoizedResult -> return memoizedResult
      Nothing -> do
        result <- f k
        modify' $ M.insert k result
        return result

runMemoizationState' ::
  forall k v r.
  ( Ord k
  ) =>
  (k -> Sem r v) ->
  InterpreterFor (Memoization k v) r
runMemoizationState' f =
  evalState mempty
    . runMemoizationState f
    . raiseUnder @(State (M.Map k v)) @(Memoization k v) @r

虽然我希望它只是注入一个新的效果：

raiseUnder :: forall e2 e1 r a. Sem (e1 ': r) a -> Sem (e1 ': (e2 ': r)) a

我收到此错误：

Sem r a -> Sem (WithTactics e f (Sem rInitial) r) (f a)
Memoization.hs:46:7-55: error:
    * Occurs check: cannot construct the infinite type:
        r ~ State (M.Map k v) : r
      Expected type: Sem (Memoization k v : r) a
                     -> Sem (Memoization k v : r) a
        Actual type: Sem (Memoization k v : r) a
                     -> Sem (Memoization k v : State (M.Map k v) : r) a
    * In the second argument of `(.)', namely
        `raiseUnder @(State (M.Map k v)) @(Memoization k v) @r'
      In the second argument of `(.)', namely
        `runMemoizationState f
           . raiseUnder @(State (M.Map k v)) @(Memoization k v) @r'
      In the expression:
        evalState mempty
          . runMemoizationState f
              . raiseUnder @(State (M.Map k v)) @(Memoization k v) @r
    * Relevant bindings include
        f :: k -> Sem r v
          (bound at Memoization.hs:43:22)
        runMemoizationState' :: (k -> Sem r v)
                                -> InterpreterFor (Memoization k v) r
          (bound at Memoization.hs:43:1)
   |
46 |     . raiseUnder @(State (M.Map k v)) @(Memoization k v) @r
   |       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
4

1 回答 1

1

正如@ Georgi Lyubenov所提到的，问题是我的函数finrunMemoizationState需要State效果，一旦解耦，它就可以工作：

runMemoizationState ::
  forall k v r.
  Ord k =>
  (k -> Sem r v) ->
  InterpretersFor '[Memoization k v, State (M.Map k v)] r
runMemoizationState f =
  evalState mempty
    . run'
  where
    run' :: InterpreterFor (Memoization k v) (State (M.Map k v) ': r)
    run' = interpret $ \case
      FetchMemoized k -> do
        memoized <- get @(M.Map k v)
        case memoized M.!? k of
          Just memoizedResult -> return memoizedResult
          Nothing -> do
            result <- raise $ f k
            modify' $ M.insert k result
            return result

runMemoizationState' ::
  forall k v r.
  ( Ord k
  ) =>
  (k -> Sem r v) ->
  InterpreterFor (Memoization k v) r
runMemoizationState' f =
  runMemoizationState f
    . raiseUnder @(State (M.Map k v)) @(Memoization k v) @r
于 2021-10-25T19:27:04.340 回答