1
1
mirror of https://github.com/github/semantic.git synced 2024-12-27 00:44:57 +03:00

Move the monovariant Env carrier into its own module.

This commit is contained in:
Rob Rix 2019-11-01 15:19:01 -04:00
parent 778f84bb12
commit 5fef3262e5
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
2 changed files with 21 additions and 13 deletions

View File

@ -1,2 +1,21 @@
{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
module Analysis.Carrier.Env.Monovariant
() where
( -- * Env carrier
EnvC(..)
-- * Env effect
, module Analysis.Effect.Env
) where
import Analysis.Effect.Env
import Control.Effect.Carrier
import qualified Control.Monad.Fail as Fail
newtype EnvC name m a = EnvC { runEnv :: m a }
deriving (Applicative, Functor, Monad, Fail.MonadFail)
instance Carrier sig m
=> Carrier (Env name name :+: sig) (EnvC name m) where
eff (L (Alloc name k)) = k name
eff (L (Bind _ _ m k)) = m >>= k
eff (L (Lookup name k)) = k (Just name)
eff (R other) = EnvC (eff (handleCoercible other))

View File

@ -8,7 +8,7 @@ module Analysis.Typecheck
) where
import Analysis.Analysis
import Analysis.Effect.Env
import Analysis.Carrier.Env.Monovariant
import Analysis.File
import Analysis.FlowInsensitive
import Control.Applicative (Alternative (..))
@ -238,14 +238,3 @@ mvs = foldMap IntSet.singleton
substAll :: Monad t => IntMap.IntMap (t Meta) -> t Meta -> t Meta
substAll s a = a >>= \ i -> fromMaybe (pure i) (IntMap.lookup i s)
newtype EnvC name m a = EnvC { runEnv :: m a }
deriving (Applicative, Functor, Monad, MonadFail)
instance Carrier sig m
=> Carrier (Env name name :+: sig) (EnvC name m) where
eff (L (Alloc name k)) = k name
eff (L (Bind _ _ m k)) = m >>= k
eff (L (Lookup name k)) = k (Just name)
eff (R other) = EnvC (eff (handleCoercible other))