From 92ac53252e5f12e268cb932fc871f8335c904c62 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Tue, 23 Oct 2018 09:45:33 -0400 Subject: [PATCH] Define upcasting to InterposeC. --- src/Data/Abstract/Value/Concrete.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Data/Abstract/Value/Concrete.hs b/src/Data/Abstract/Value/Concrete.hs index 14f7a44ec..059b1d7a6 100644 --- a/src/Data/Abstract/Value/Concrete.hs +++ b/src/Data/Abstract/Value/Concrete.hs @@ -10,6 +10,7 @@ module Data.Abstract.Value.Concrete import qualified Control.Abstract as Abstract import Control.Abstract hiding (Boolean(..), Function(..), While(..)) import Control.Effect.Carrier +import Control.Effect.Internal import Control.Effect.Sum import Data.Abstract.BaseError import Data.Abstract.Evaluatable (UnspecializedError(..)) @@ -167,6 +168,9 @@ interpose :: (Member eff sig, HFunctor eff, Carrier sig m) -> m a interpose handler = runInterposeC handler . interpret +upcast :: Eff m a -> Eff (InterposeC eff (Eff m)) a +upcast m = Eff (\ k -> InterposeC (\ f -> m >>= runInterposeC f . k)) + newtype InterposeC eff m a = InterposeC ((forall x . eff m (m x) -> m x) -> m a) runInterposeC :: (forall x . eff m (m x) -> m x) -> InterposeC eff m a -> m a