Merge branch 'master' into json-output

.github/workflows/haskell.yml

@@ -0,0 +1,58 @@
+name: Haskell CI
+
+on: [pull_request]
+
+jobs:
+  build:
+    name: ghc ${{ matrix.ghc }}
+    runs-on: ubuntu-16.04
+    strategy:
+      matrix:
+        ghc: ["8.8.1"]
+        cabal: ["3.0"]
+
+    steps:
+    - uses: actions/checkout@master
+      if: github.event.action == 'opened' || github.event.action == 'synchronize'
+
+    - uses: actions/setup-haskell@v1
+      name: Setup Haskell
+      with:
+        ghc-version: ${{ matrix.ghc }}
+        cabal-version: ${{ matrix.cabal }}
+
+    - uses: actions/cache@preview
+      name: Cache ~/.cabal/packages
+      with:
+        path: ~/.cabal/packages
+        key: ${{ runner.os }}-${{ matrix.ghc }}-cabal-packages
+    - uses: actions/cache@preview
+      name: Cache ~/.cabal/store
+      with:
+        path: ~/.cabal/store
+        key: ${{ runner.os }}-${{ matrix.ghc }}-cabal-store
+    - uses: actions/cache@preview
+      name: Cache dist-newstyle
+      with:
+        path: dist-newstyle
+        key: ${{ runner.os }}-${{ matrix.ghc }}-semantic-dist
+
+    - name: Install dependencies
+      run: |
+        cabal v2-update
+        cabal v2-configure --disable-optimization --enable-benchmarks --enable-tests --write-ghc-environment-files=always -j2
+        cabal v2-build --only-dependencies
+
+    - name: hlint
+      run: |
+        cabal install hlint --installdir=dist-newstyle
+        dist-newstyle/hlint src semantic-python
+
+    - name: Build & test
+      run: |
+        cabal v2-build
+        cabal v2-run semantic:test
+        cabal v2-run semantic-core:test
+        cabal v2-run semantic-python:test
+        cd semantic-source; cabal v2-run semantic-source:test; cd ..
+        cd semantic-source; cabal v2-run semantic-source:doctest -- src; cd ..

.travis.yml

@@ -1,56 +0,0 @@
-language: c
-
-cache:
-  directories:
-    - $HOME/.cabal/packages
-    - $HOME/.cabal/store
-    - $TRAVIS_BUILD_DIR/dist-newstyle
-
-before_cache:
-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
-  # remove files that are regenerated by 'cabal update'
-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*
-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json
-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache
-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar
-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx
-
-  - rm -rfv $HOME/.cabal/packages/head.hackage
-
-matrix:
-  include:
-    - compiler: "ghc-8.6.5"
-      addons: {apt: {packages: [cabal-install-2.4,ghc-8.6.5], sources: [hvr-ghc]}}
-
-before_install:
-- mkdir -p $HOME/.local/bin
-- curl -L -o /tmp/hlint.tar.gz "https://github.com/ndmitchell/hlint/releases/download/v2.2.3/hlint-2.2.3-x86_64-linux.tar.gz"
-- tar -xf /tmp/hlint.tar.gz -C /tmp
-- cp /tmp/hlint-2.2.3/hlint $HOME/.local/bin
-- cp -r /tmp/hlint-2.2.3/data $HOME/.local/bin
-- "PATH=/opt/ghc/bin:$HOME/local/bin:$PATH"
-- ghc --version
-- cabal --version
-- hlint --version
-
-install:
-- cabal v2-update -v
-- cabal v2-configure --enable-tests --enable-benchmarks --disable-optimization --write-ghc-environment-files=always --jobs=2
-- cabal v2-build --only-dependencies
-
-script:
-- hlint src semantic-python
-- cabal v2-build
-- cabal v2-run semantic:test
-- cabal v2-run semantic-core:test
-- cabal v2-run semantic-python:test
-- cd semantic-source; cabal v2-run semantic-source:test; cd ..
-- cd semantic-source; cabal v2-run semantic-source:doctest; cd ..
-# parse-examples is disabled because it slaughters our CI
-# - cabal v2-run semantic:parse-examples
-
-# Any branch linked with a pull request will be built, as well as the non-PR
-# branches listed below:
-branches:
-  only:
-    - master

Dockerfile

@@ -1,5 +1,5 @@
 # Put protoc and twirp tooling in its own image
-FROM haskell:8.6 as haskell
+FROM haskell:8.8 as haskell
 RUN cabal v2-update && \
     cabal v2-install proto-lens-protoc
 RUN which proto-lens-protoc
@@ -19,7 +19,7 @@ COPY --from=haskell /root/.cabal/bin/proto-lens-protoc /usr/local/bin/proto-lens
 ENTRYPOINT ["/protobuf/bin/protoc", "-I/protobuf", "--plugin=protoc-gen-haskell=/usr/local/bin/proto-lens-protoc"]
 
 # Build semantic
-FROM haskell:8.6 as build
+FROM haskell:8.8 as build
 WORKDIR /build
 
 # Build all of semantic

README.md

@@ -96,7 +96,7 @@ Available options:
 
 ## Development
 
-`semantic` requires at least GHC 8.6.4 and Cabal 2.4. We strongly recommend using [`ghcup`][ghcup] to sandbox GHC versions, as GHC packages installed through your OS's package manager may not install statically-linked versions of the GHC boot libraries. `semantic` currently builds only on Unix systems; users of other operating systems may wish to use the [Docker images](https://github.com/github/semantic/packages/11609).
+`semantic` requires at least GHC 8.8.1 and Cabal 3.0. We strongly recommend using [`ghcup`][ghcup] to sandbox GHC versions, as GHC packages installed through your OS's package manager may not install statically-linked versions of the GHC boot libraries. `semantic` currently builds only on Unix systems; users of other operating systems may wish to use the [Docker images](https://github.com/github/semantic/packages/11609).
 
 We use `cabal's` [Nix-style local builds][nix] for development. To get started quickly:
 

cabal.project

@@ -36,9 +36,9 @@ package semantic-ast
 source-repository-package
   type: git
   location: https://github.com/tclem/proto-lens-jsonpb
-  tag: e4d10b77f57ee25beb759a33e63e2061420d3dc2
+  tag: 5d40444be689bef1e12cbe38da0261283775ec64
 
 source-repository-package
   type: git
   location: https://github.com/antitypical/fused-syntax.git
-  tag: 6b412694e64cc275ed06513b3c360f03bb1f04fd
+  tag: d11e14581217590a5c67f79cbaeee35ac8acee6a

script/fix-broken-cabal-store

@@ -0,0 +1,5 @@
+#!/bin/bash
+
+rm -rf ~/.cabal/store/ghc-8.6.5/tr-sttr*
+rm -rf ~/.cabal/store/ghc-8.6.5/lib/libHStr-sttr*
+rm -rf ~/.cabal/store/ghc-8.6.5/package.db/tr-sttr*

semantic-analysis/semantic-analysis.cabal

@@ -52,13 +52,13 @@ library
     Control.Effect.Readline
   build-depends:
       algebraic-graphs            ^>= 0.3
-    , base                         >= 4.12 && < 5
+    , base                         >= 4.13 && < 5
     , containers                  ^>= 0.6
-    , fused-effects               ^>= 0.5
+    , fused-effects               ^>= 1.0
     , fused-syntax
     , haskeline                   ^>= 0.7.5
     , pathtype                    ^>= 0.8.1
-    , prettyprinter               ^>= 1.2.1
+    , prettyprinter                >= 1.2.1 && < 1.4
     , prettyprinter-ansi-terminal ^>= 1.1.1
     , semantic-source             ^>= 0
     , terminal-size               ^>= 0.3

semantic-analysis/src/Analysis/Concrete.hs

@@ -1,4 +1,6 @@
-{-# LANGUAGE DerivingVia, FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DerivingVia, FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, NamedFieldPuns,
+             OverloadedStrings, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeOperators,
+             UndecidableInstances #-}
 module Analysis.Concrete
 ( Concrete(..)
 , concrete
@@ -13,14 +15,13 @@ import qualified Algebra.Graph as G
 import qualified Algebra.Graph.Export.Dot as G
 import           Analysis.Analysis
 import           Analysis.File
-import           Control.Applicative (Alternative (..))
+import           Control.Algebra
 import           Control.Carrier.Fail.WithLoc
-import           Control.Effect
-import           Control.Effect.Fresh
-import           Control.Effect.NonDet
-import           Control.Effect.Reader hiding (Local)
-import           Control.Effect.State
-import           Control.Monad ((<=<), guard)
+import           Control.Carrier.Fresh.Strict
+import           Control.Carrier.NonDet.Church
+import           Control.Carrier.Reader hiding (Local)
+import           Control.Carrier.State.Strict
+import           Control.Monad ((<=<))
 import           Data.Function (fix)
 import qualified Data.IntMap as IntMap
 import qualified Data.IntSet as IntSet
@@ -73,7 +74,7 @@ concrete
      , Show (term name)
      )
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
+     .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
      => Analysis term name Precise (Concrete term name) m
      -> (term name -> m (Concrete term name))
      -> (term name -> m (Concrete term name))
@@ -82,24 +83,23 @@ concrete
   -> (Heap term name, [File (Either (Path.AbsRelFile, Span, String) (Concrete term name))])
 concrete eval
   = run
-  . runFresh
+  . evalFresh 0
   . runHeap
   . traverse (runFile eval)
 
 runFile
   :: forall term name m sig
-  .  ( Carrier sig m
-     , Effect sig
+  .  ( Effect sig
      , Foldable term
      , IsString name
-     , Member Fresh sig
-     , Member (State (Heap term name)) sig
+     , Has Fresh sig m
+     , Has (State (Heap term name)) sig m
      , Ord name
      , Show name
      , Show (term name)
      )
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
+     .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
      => Analysis term name Precise (Concrete term name) m
      -> (term name -> m (Concrete term name))
      -> (term name -> m (Concrete term name))
@@ -113,20 +113,20 @@ runFile eval file = traverse run file
             . runReader @(Env name) mempty
             . fix (eval concreteAnalysis)
 
-concreteAnalysis :: ( Carrier sig m
-                    , Foldable term
-                    , IsString name
-                    , Member Fresh sig
-                    , Member (Reader (Env name)) sig
-                    , Member (Reader Path.AbsRelFile) sig
-                    , Member (Reader Span) sig
-                    , Member (State (Heap term name)) sig
-                    , MonadFail m
-                    , Ord name
-                    , Show name
-                    , Show (term name)
-                    )
-                 => Analysis term name Precise (Concrete term name) m
+concreteAnalysis
+  :: ( Foldable term
+     , IsString name
+     , Has Fresh sig m
+     , Has (Reader (Env name)) sig m
+     , Has (Reader Path.AbsRelFile) sig m
+     , Has (Reader Span) sig m
+     , Has (State (Heap term name)) sig m
+     , MonadFail m
+     , Ord name
+     , Show name
+     , Show (term name)
+     )
+  => Analysis term name Precise (Concrete term name) m
 concreteAnalysis = Analysis{..}
   where alloc _ = fresh
         bind name addr m = local (Map.insert name addr) m
@@ -164,7 +164,7 @@ concreteAnalysis = Analysis{..}
 
 
 lookupConcrete :: (IsString name, Ord name) => Heap term name -> name -> Concrete term name -> Maybe Precise
-lookupConcrete heap name = run . evalState IntSet.empty . runNonDet . inConcrete
+lookupConcrete heap name = run . evalState IntSet.empty . runNonDetA . inConcrete
   where -- look up the name in a concrete value
         inConcrete = inFrame <=< maybeA . recordFrame
         -- look up the name in a specific 'Frame', with slots taking precedence over parents

semantic-analysis/src/Analysis/FlowInsensitive.hs

@@ -2,20 +2,20 @@
 module Analysis.FlowInsensitive
 ( Heap
 , FrameId(..)
+, Cache
 , convergeTerm
 , cacheTerm
 , runHeap
 , foldMapA
 ) where
 
-import           Control.Effect
-import           Control.Effect.Fresh
-import           Control.Effect.NonDet
-import           Control.Effect.Reader
-import           Control.Effect.State
+import           Control.Algebra
+import           Control.Carrier.Fresh.Strict
+import           Control.Carrier.NonDet.Church
+import           Control.Carrier.Reader
+import           Control.Carrier.State.Strict
 import qualified Data.Map as Map
 import           Data.Maybe (fromMaybe)
-import           Data.Monoid (Alt(..))
 import qualified Data.Set as Set
 
 newtype Cache term a = Cache { unCache :: Map.Map term (Set.Set a) }
@@ -28,30 +28,29 @@ newtype FrameId name = FrameId { unFrameId :: name }
 
 
 convergeTerm :: forall m sig a term address proxy
-             .  ( Carrier sig m
-                , Effect sig
+             .  ( Effect sig
                 , Eq address
-                , Member Fresh sig
-                , Member (State (Heap address a)) sig
+                , Has Fresh sig m
+                , Has (State (Heap address a)) sig m
                 , Ord a
                 , Ord term
                 )
              => proxy address
-             -> (term -> NonDetC (ReaderC (Cache term a) (StateC (Cache term a) m)) a)
+             -> Int
+             -> (term -> NonDetC (FreshC (ReaderC (Cache term a) (StateC (Cache term a) m))) a)
              -> term
              -> m (Set.Set a)
-convergeTerm _ eval body = do
+convergeTerm _ n eval body = do
   heap <- get
   (cache, _) <- converge (Cache Map.empty :: Cache term a, heap :: Heap address a) $ \ (prevCache, _) -> runState (Cache Map.empty) . runReader prevCache $ do
-    _ <- resetFresh . runNonDetM Set.singleton $ eval body
+    _ <- runFresh n . runNonDetM Set.singleton $ eval body
     get
   pure (fromMaybe mempty (Map.lookup body (unCache cache)))
 
 cacheTerm :: forall m sig a term
           .  ( Alternative m
-             , Carrier sig m
-             , Member (Reader (Cache term a)) sig
-             , Member (State  (Cache term a)) sig
+             , Has (Reader (Cache term a)) sig m
+             , Has (State  (Cache term a)) sig m
              , Ord a
              , Ord term
              )
@@ -70,13 +69,6 @@ cacheTerm eval term = do
 runHeap :: StateC (Heap address a) m b -> m (Heap address a, b)
 runHeap m = runState Map.empty m
 
--- | Fold a collection by mapping each element onto an 'Alternative' action.
-foldMapA :: (Alternative m, Foldable t) => (b -> m a) -> t b -> m a
-foldMapA f = getAlt . foldMap (Alt . f)
-
-runNonDetM :: (Monoid b, Applicative m) => (a -> b) -> NonDetC m a -> m b
-runNonDetM f (NonDetC m) = m (fmap . (<>) . f) (pure mempty)
-
 -- | Iterate a monadic action starting from some initial seed until the results converge.
 --
 --   This applies the Kleene fixed-point theorem to finitize a monotone action. cf https://en.wikipedia.org/wiki/Kleene_fixed-point_theorem

semantic-analysis/src/Analysis/ImportGraph.hs

@@ -9,11 +9,11 @@ import           Analysis.Analysis
 import           Analysis.File
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative(..))
+import           Control.Algebra
 import           Control.Carrier.Fail.WithLoc
-import           Control.Effect
-import           Control.Effect.Fresh
-import           Control.Effect.Reader
-import           Control.Effect.State
+import           Control.Carrier.Fresh.Strict
+import           Control.Carrier.Reader
+import           Control.Carrier.State.Strict
 import           Control.Monad ((>=>))
 import           Data.Foldable (fold, for_)
 import           Data.Function (fix)
@@ -51,7 +51,7 @@ data Semi term name
 importGraph
   :: (Ord name, Ord (term name), Show name, Show (term name))
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
+     .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
      => Analysis term name name (Value term name) m
      -> (term name -> m (Value term name))
      -> (term name -> m (Value term name))
@@ -62,23 +62,22 @@ importGraph
      )
 importGraph eval
   = run
-  . runFresh
+  . evalFresh 0
   . runHeap
   . traverse (runFile eval)
 
 runFile
   :: forall term name m sig
-  .  ( Carrier sig m
-     , Effect sig
-     , Member Fresh sig
-     , Member (State (Heap name (Value term name))) sig
+  .  ( Effect sig
+     , Has Fresh sig m
+     , Has (State (Heap name (Value term name))) sig m
      , Ord  name
      , Ord  (term name)
      , Show name
      , Show (term name)
      )
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
+     .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
      => Analysis term name name (Value term name) m
      -> (term name -> m (Value term name))
      -> (term name -> m (Value term name))
@@ -90,14 +89,13 @@ runFile eval file = traverse run file
             . runReader (fileSpan file)
             . runFail
             . fmap fold
-            . convergeTerm (Proxy @name) (fix (cacheTerm . eval importGraphAnalysis))
+            . convergeTerm (Proxy @name) 0 (fix (cacheTerm . eval importGraphAnalysis))
 
 -- FIXME: decompose into a product domain and two atomic domains
 importGraphAnalysis :: ( Alternative m
-                       , Carrier sig m
-                       , Member (Reader Path.AbsRelFile) sig
-                       , Member (Reader Span) sig
-                       , Member (State (Heap name (Value term name))) sig
+                       , Has (Reader Path.AbsRelFile) sig m
+                       , Has (Reader Span) sig m
+                       , Has (State (Heap name (Value term name))) sig m
                        , MonadFail m
                        , Ord  name
                        , Ord  (term name)

semantic-analysis/src/Analysis/ScopeGraph.hs

@@ -10,11 +10,11 @@ module Analysis.ScopeGraph
 import           Analysis.Analysis
 import           Analysis.File
 import           Analysis.FlowInsensitive
+import           Control.Algebra
 import           Control.Applicative (Alternative (..))
+import           Control.Carrier.Reader
 import           Control.Carrier.Fail.WithLoc
-import           Control.Effect.Carrier
-import           Control.Effect.Fresh
-import           Control.Effect.Reader
+import           Control.Carrier.Fresh.Strict
 import           Control.Effect.State
 import           Control.Monad ((>=>))
 import           Data.Foldable (fold)
@@ -53,7 +53,7 @@ instance Ord name => Monoid (ScopeGraph name) where
 scopeGraph
   :: (Ord name, Ord (term name))
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
+     .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
      => Analysis term name name (ScopeGraph name) m
      -> (term name -> m (ScopeGraph name))
      -> (term name -> m (ScopeGraph name))
@@ -62,21 +62,20 @@ scopeGraph
   -> (Heap name (ScopeGraph name), [File (Either (Path.AbsRelFile, Span, String) (ScopeGraph name))])
 scopeGraph eval
   = run
-  . runFresh
+  . evalFresh 0
   . runHeap
   . traverse (runFile eval)
 
 runFile
   :: forall term name m sig
-  .  ( Carrier sig m
-     , Effect sig
-     , Member Fresh sig
-     , Member (State (Heap name (ScopeGraph name))) sig
+  .  ( Effect sig
+     , Has Fresh sig m
+     , Has (State (Heap name (ScopeGraph name))) sig m
      , Ord name
      , Ord (term name)
      )
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
+     .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
      => Analysis term name name (ScopeGraph name) m
      -> (term name -> m (ScopeGraph name))
      -> (term name -> m (ScopeGraph name))
@@ -89,15 +88,14 @@ runFile eval file = traverse run file
             . runReader (Map.empty @name @Ref)
             . runFail
             . fmap fold
-            . convergeTerm (Proxy @name) (fix (cacheTerm . eval scopeGraphAnalysis))
+            . convergeTerm (Proxy @name) 0 (fix (cacheTerm . eval scopeGraphAnalysis))
 
 scopeGraphAnalysis
   :: ( Alternative m
-     , Carrier sig m
-     , Member (Reader Path.AbsRelFile) sig
-     , Member (Reader Span) sig
-     , Member (Reader (Map.Map name Ref)) sig
-     , Member (State (Heap name (ScopeGraph name))) sig
+     , Has (Reader Path.AbsRelFile) sig m
+     , Has (Reader Span) sig m
+     , Has (Reader (Map.Map name Ref)) sig m
+     , Has (State (Heap name (ScopeGraph name))) sig m
      , Ord name
      )
   => Analysis term name name (ScopeGraph name) m

semantic-analysis/src/Analysis/Typecheck.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveGeneric, DeriveTraversable, DerivingVia, FlexibleContexts, FlexibleInstances, LambdaCase, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators #-}
+{-# LANGUAGE DeriveGeneric, DeriveTraversable, DerivingVia, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-}
 module Analysis.Typecheck
 ( Monotype (..)
 , Meta
@@ -10,12 +10,12 @@ module Analysis.Typecheck
 import           Analysis.Analysis
 import           Analysis.File
 import           Analysis.FlowInsensitive
+import           Control.Algebra
 import           Control.Applicative (Alternative (..))
 import           Control.Carrier.Fail.WithLoc
-import           Control.Effect.Carrier
-import           Control.Effect.Fresh as Fresh
-import           Control.Effect.Reader hiding (Local)
-import           Control.Effect.State
+import           Control.Carrier.Fresh.Strict as Fresh
+import           Control.Carrier.Reader hiding (Local)
+import           Control.Carrier.State.Strict
 import           Control.Monad ((>=>), unless)
 import           Data.Foldable (for_)
 import           Data.Function (fix)
@@ -60,32 +60,30 @@ deriving instance (Ord  name, Ord  a, forall a . Eq   a => Eq   (f a)
 deriving instance (Show name, Show a, forall a . Show a => Show (f a))          => Show (Monotype name f a)
 
 instance HFunctor (Monotype name)
+
 instance RightModule (Monotype name) where
-  Unit     >>=* _ = Unit
-  Bool     >>=* _ = Bool
-  String   >>=* _ = String
-  Arr a b  >>=* f = Arr (a >>= f) (b >>= f)
-  Record m >>=* f = Record ((>>= f) <$> m)
+  item >>=* go = case item of
+    Bool -> Bool
+    Unit -> Unit
+    String -> String
+    Arr l r -> Arr (l >>= go) (r >>= go)
+    Record items -> Record (fmap (>>= go) items)
 
 type Meta = Int
 
 newtype Polytype f a = PForAll (Scope () f a)
-  deriving (Foldable, Functor, Generic1, Traversable)
+  deriving (Foldable, Functor, Generic1, HFunctor, RightModule, Traversable)
 
 deriving instance (Eq   a, forall a . Eq   a => Eq   (f a), Monad f) => Eq   (Polytype f a)
 deriving instance (Ord  a, forall a . Eq   a => Eq   (f a)
                          , forall a . Ord  a => Ord  (f a), Monad f) => Ord  (Polytype f a)
 deriving instance (Show a, forall a . Show a => Show (f a))          => Show (Polytype f a)
 
-instance HFunctor Polytype
-instance RightModule Polytype where
-  PForAll b >>=* f = PForAll (b >>=* f)
 
-
-forAll :: (Eq a, Carrier sig m, Member Polytype sig) => a -> m a -> m a
+forAll :: (Eq a, Has Polytype sig m) => a -> m a -> m a
 forAll n body = send (PForAll (abstract1 n body))
 
-forAlls :: (Eq a, Carrier sig m, Member Polytype sig, Foldable t) => t a -> m a -> m a
+forAlls :: (Eq a, Has Polytype sig m, Foldable t) => t a -> m a -> m a
 forAlls ns body = foldr forAll body ns
 
 generalize :: Term (Monotype name) Meta -> Term (Polytype :+: Monotype name) Void
@@ -95,7 +93,7 @@ generalize ty = fromJust (closed (forAlls (IntSet.toList (mvs ty)) (hoistTerm R
 typecheckingFlowInsensitive
   :: (Ord name, Ord (term name), Show name)
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
+     .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
      => Analysis term name name (Type name) m
      -> (term name -> m (Type name))
      -> (term name -> m (Type name))
@@ -106,23 +104,22 @@ typecheckingFlowInsensitive
      )
 typecheckingFlowInsensitive eval
   = run
-  . runFresh
+  . evalFresh 0
   . runHeap
   . fmap (fmap (fmap (fmap generalize)))
   . traverse (runFile eval)
 
 runFile
   :: forall term name m sig
-  .  ( Carrier sig m
-     , Effect sig
-     , Member Fresh sig
-     , Member (State (Heap name (Type name))) sig
+  .  ( Effect sig
+     , Has Fresh sig m
+     , Has (State (Heap name (Type name))) sig m
      , Ord name
      , Ord (term name)
      , Show name
      )
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
+     .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
      => Analysis term name name (Type name) m
      -> (term name -> m (Type name))
      -> (term name -> m (Type name))
@@ -147,14 +144,13 @@ runFile eval file = traverse run file
               v <- meta
               bs <- m
               v <$ for_ bs (unify v))
-          . convergeTerm (Proxy @name) (fix (cacheTerm . eval typecheckingAnalysis))
+          . convergeTerm (Proxy @name) 1 (fix (cacheTerm . eval typecheckingAnalysis))
 
 typecheckingAnalysis
   :: ( Alternative m
-     , Carrier sig m
-     , Member Fresh sig
-     , Member (State (Set.Set (Constraint name))) sig
-     , Member (State (Heap name (Type name))) sig
+     , Has Fresh sig m
+     , Has (State (Set.Set (Constraint name))) sig m
+     , Has (State (Heap name (Type name))) sig m
      , Ord name
      )
   => Analysis term name name (Type name) m
@@ -202,17 +198,17 @@ data Solution name
 
 infix 5 :=
 
-meta :: (Carrier sig m, Member Fresh sig) => m (Type name)
+meta :: Has Fresh sig m => m (Type name)
 meta = pure <$> Fresh.fresh
 
-unify :: (Carrier sig m, Member (State (Set.Set (Constraint name))) sig, Ord name) => Type name -> Type name -> m ()
+unify :: (Has (State (Set.Set (Constraint name))) sig m, Ord name) => Type name -> Type name -> m ()
 unify t1 t2
   | t1 == t2  = pure ()
   | otherwise = modify (<> Set.singleton (t1 :===: t2))
 
 type Substitution name = IntMap.IntMap (Type name)
 
-solve :: (Member (State (Substitution name)) sig, MonadFail m, Ord name, Show name, Carrier sig m) => Set.Set (Constraint name) -> m ()
+solve :: (Has (State (Substitution name)) sig m, MonadFail m, Ord name, Show name) => Set.Set (Constraint name) -> m ()
 solve cs = for_ cs solve
   where solve = \case
           -- FIXME: how do we enforce proper subtyping? row polymorphism or something?

semantic-analysis/src/Control/Carrier/Fail/WithLoc.hs

@@ -8,9 +8,9 @@ module Control.Carrier.Fail.WithLoc
 ) where
 
 import Control.Applicative
-import Control.Effect.Carrier
-import Control.Effect.Error
-import Control.Effect.Fail (Fail(..), MonadFail(..))
+import Control.Algebra
+import Control.Carrier.Error.Either
+import Control.Effect.Fail
 import Control.Effect.Reader
 import Prelude hiding (fail)
 import Source.Span
@@ -22,12 +22,12 @@ runFail = runError . runFailC
 newtype FailC m a = FailC { runFailC :: ErrorC (Path.AbsRelFile, Span, String) m a }
   deriving (Alternative, Applicative, Functor, Monad)
 
-instance (Carrier sig m, Effect sig, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig) => MonadFail (FailC m) where
+instance (Effect sig, Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m) => MonadFail (FailC m) where
   fail s = do
     path <- ask
     span <- ask
     FailC (throwError (path :: Path.AbsRelFile, span :: Span, s))
 
-instance (Carrier sig m, Effect sig, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig) => Carrier (Fail :+: sig) (FailC m) where
-  eff (L (Fail s)) = fail s
-  eff (R other)    = FailC (eff (R (handleCoercible other)))
+instance (Effect sig, Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m) => Algebra (Fail :+: sig) (FailC m) where
+  alg (L (Fail s)) = fail s
+  alg (R other)    = FailC (alg (R (handleCoercible other)))

semantic-analysis/src/Control/Carrier/Readline/Haskeline.hs

@@ -1,21 +1,18 @@
 {-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, ScopedTypeVariables, TypeApplications, TypeOperators, UndecidableInstances #-}
 module Control.Carrier.Readline.Haskeline
-( -- * Readline effect
-  module Control.Effect.Readline
-  -- * Readline carrier
-, runReadline
+( -- * Readline carrier
+  runReadline
 , runReadlineWithHistory
 , ReadlineC (..)
-  -- * Re-exports
-, Carrier
-, run
+  -- * Readline effect
+, module Control.Effect.Readline
 , runM
 ) where
 
-import Control.Effect.Carrier
-import Control.Effect.Lift
-import Control.Effect.Reader
-import Control.Effect.Readline hiding (Carrier)
+import Control.Algebra
+import Control.Carrier.Lift
+import Control.Carrier.Reader
+import Control.Effect.Readline
 import Control.Monad.Fix
 import Control.Monad.IO.Class
 import Data.Coerce
@@ -48,14 +45,14 @@ runReadlineWithHistory block = do
 newtype ReadlineC m a = ReadlineC { runReadlineC :: ReaderC Line (LiftC (InputT m)) a }
   deriving (Applicative, Functor, Monad, MonadFix, MonadIO)
 
-instance MonadException m => Carrier Readline (ReadlineC m) where
-  eff (Prompt prompt k) = ReadlineC $ do
+instance MonadException m => Algebra Readline (ReadlineC m) where
+  alg (Prompt prompt k) = ReadlineC $ do
     str <- sendM (getInputLine @m (cyan <> prompt <> plain))
     Line line <- ask
     local increment (runReadlineC (k line str))
     where cyan = "\ESC[1;36m\STX"
           plain = "\ESC[0m\STX"
-  eff (Print doc k) = do
+  alg (Print doc k) = do
     s <- maybe 80 Size.width <$> liftIO size
     liftIO (renderIO stdout (layoutSmart defaultLayoutOptions { layoutPageWidth = AvailablePerLine s 0.8 } (doc <> line)))
     k

semantic-analysis/src/Control/Effect/Readline.hs

@@ -1,14 +1,16 @@
-{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, OverloadedStrings #-}
+{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, MultiParamTypeClasses #-}
 module Control.Effect.Readline
 ( -- * Readline effect
   Readline (..)
 , prompt
 , print
   -- * Re-exports
-, Carrier
+, Algebra
+, Has
+, run
 ) where
 
-import Control.Effect.Carrier
+import Control.Algebra
 import Data.Text.Prettyprint.Doc
 import Data.Text.Prettyprint.Doc.Render.Terminal
 import GHC.Generics (Generic1)
@@ -20,11 +22,11 @@ data Readline m k
   deriving (Functor, Generic1)
 
 instance HFunctor Readline
-instance Effect   Readline
+instance Effect Readline
 
 
-prompt :: (Member Readline sig, Carrier sig m) => String -> m (Int, Maybe String)
+prompt :: Has Readline sig m => String -> m (Int, Maybe String)
 prompt p = send (Prompt p (curry pure))
 
-print :: (Carrier sig m, Member Readline sig) => Doc AnsiStyle -> m ()
+print :: Has Readline sig m => Doc AnsiStyle -> m ()
 print s = send (Print s (pure ()))

semantic-ast/semantic-ast.cabal

@@ -40,13 +40,13 @@ library
   exposed-modules:     Marshal.JSON
   -- other-modules:
   -- other-extensions:
-  build-depends:       base                 ^>=4.12.0.0
-                     , tree-sitter          ^>= 0.7
-                     , semantic-source      ^>= 0.0
-                     , tree-sitter-python   ^>= 0.8
-                     , bytestring           ^>= 0.10.8.2
-                     , optparse-applicative ^>= 0.14.3.0
-                     , pretty-simple        ^>= 3.1.0.0
+  build-depends:       base ^>= 4.13
+                     , tree-sitter ^>= 0.7.1
+                     , semantic-source ^>= 0.0
+                     , tree-sitter-python ^>= 0.8
+                     , bytestring ^>= 0.10.8.2
+                     , optparse-applicative >= 0.14.3 && < 0.16
+                     , pretty-simple ^>= 3.1.0.0
                      , aeson                ^>= 1.4.6.0
                      , text                 ^>= 1.2.3.1
   hs-source-dirs:      src
@@ -59,15 +59,15 @@ executable semantic-ast
   main-is:             Main.hs
   -- other-modules:
   -- other-extensions:
-  build-depends:       base                 ^>=4.12.0.0
+  build-depends:       base
                      , semantic-ast
-                     , tree-sitter          ^>= 0.7
-                     , semantic-source      ^>= 0.0
-                     , tree-sitter-python   ^>= 0.8
-                     , bytestring           ^>= 0.10.8.2
-                     , optparse-applicative ^>= 0.14.3.0
-                     , pretty-simple        ^>= 3.1.0.0
-                     , aeson                ^>= 1.4.6.0
+                     , tree-sitter
+                     , semantic-source
+                     , tree-sitter-python
+                     , bytestring
+                     , optparse-applicative
+                     , pretty-simple
+                     , aeson
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:       -Wall

semantic-core/semantic-core.cabal

@@ -46,17 +46,17 @@ library
     Core.Eval
     Core.Name
   build-depends:
-      base                         >= 4.12 && < 5
-    , fused-effects               ^>= 0.5
+      base                         >= 4.13 && < 5
+    , fused-effects               ^>= 1.0
     , fused-syntax
     , parsers                     ^>= 0.12.10
     , pathtype                    ^>= 0.8.1
-    , prettyprinter               ^>= 1.2.1
+    , prettyprinter                >= 1.2.1 && < 1.4
     , prettyprinter-ansi-terminal ^>= 1.1.1
     , semantic-analysis           ^>= 0
     , semantic-source             ^>= 0
     , text                        ^>= 1.2.3.1
-    , trifecta                    ^>= 2
+    , trifecta                     >= 2 && < 2.2
     , unordered-containers        ^>= 0.2.10
 
 test-suite test

semantic-core/src/Core/Core.hs

@@ -1,6 +1,4 @@
-{-# LANGUAGE DeriveGeneric, DeriveTraversable, FlexibleContexts, LambdaCase, MultiParamTypeClasses, OverloadedStrings,
-             QuantifiedConstraints, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeFamilies, TypeOperators,
-             UndecidableInstances #-}
+{-# LANGUAGE DeriveGeneric, DeriveTraversable, FlexibleContexts, LambdaCase, MultiParamTypeClasses, OverloadedStrings, QuantifiedConstraints, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Core.Core
 ( Core(..)
 , rec
@@ -37,8 +35,8 @@ module Core.Core
 , stripAnnotations
 ) where
 
+import Control.Algebra
 import Control.Applicative (Alternative (..))
-import Control.Effect.Carrier
 import Core.Name
 import Data.Bifunctor (Bifunctor (..))
 import Data.Foldable (foldl')
@@ -52,6 +50,7 @@ import Syntax.Foldable
 import Syntax.Module
 import Syntax.Scope
 import Syntax.Stack
+import Syntax.Sum
 import Syntax.Term
 import Syntax.Traversable
 
@@ -95,11 +94,6 @@ instance HFunctor Core
 instance HFoldable Core
 instance HTraversable Core
 
-deriving instance (Eq   a, forall a . Eq   a => Eq   (f a), Monad f) => Eq   (Core f a)
-deriving instance (Ord  a, forall a . Eq   a => Eq   (f a)
-                         , forall a . Ord  a => Ord  (f a), Monad f) => Ord  (Core f a)
-deriving instance (Show a, forall a . Show a => Show (f a))          => Show (Core f a)
-
 instance RightModule Core where
   Rec b      >>=* f = Rec ((>>=* f) <$> b)
   (a :>> b)  >>=* f = (a >>= f) :>> (b >>= f)
@@ -116,20 +110,25 @@ instance RightModule Core where
   (a :? b)   >>=* f = (a >>= f) :. b
   (a := b)   >>=* f = (a >>= f) := (b >>= f)
 
+deriving instance (Eq   a, forall a . Eq   a => Eq   (f a), Monad f) => Eq   (Core f a)
+deriving instance (Ord  a, forall a . Eq   a => Eq   (f a)
+                         , forall a . Ord  a => Ord  (f a), Monad f) => Ord  (Core f a)
+deriving instance (Show a, forall a . Show a => Show (f a))          => Show (Core f a)
 
-rec :: (Eq a, Carrier sig m, Member Core sig) => Named a -> m a -> m a
+
+rec :: (Eq a, Has Core sig m) => Named a -> m a -> m a
 rec (Named u n) b = send (Rec (Named u (abstract1 n b)))
 
-(>>>) :: (Carrier sig m, Member Core sig) => m a -> m a -> m a
+(>>>) :: Has Core sig m => m a -> m a -> m a
 a >>> b = send (a :>> b)
 
 infixr 1 >>>
 
-unseq :: (Alternative m, Member Core sig) => Term sig a -> m (Term sig a, Term sig a)
+unseq :: (Alternative m, Project Core sig) => Term sig a -> m (Term sig a, Term sig a)
 unseq (Alg sig) | Just (a :>> b) <- prj sig = pure (a, b)
 unseq _                                     = empty
 
-unseqs :: Member Core sig => Term sig a -> NonEmpty (Term sig a)
+unseqs :: Project Core sig => Term sig a -> NonEmpty (Term sig a)
 unseqs = go
   where go t = case unseq t of
           Just (l, r) -> go l <> go r
@@ -137,23 +136,23 @@ unseqs = go
 
 -- TODO: if the left hand side is only a unit, this should return just the RHS
 -- this is a little fiddly to do
-(>>>=) :: (Eq a, Carrier sig m, Member Core sig) => (Named a :<- m a) -> m a -> m a
+(>>>=) :: (Eq a, Has Core sig m) => (Named a :<- m a) -> m a -> m a
 Named u n :<- a >>>= b = send (Named u a :>>= abstract1 n b)
 
 infixr 1 >>>=
 
-unbind :: (Alternative m, Member Core sig, RightModule sig) => a -> Term sig a -> m (Named a :<- Term sig a, Term sig a)
+unbind :: (Alternative m, Project Core sig, RightModule sig) => a -> Term sig a -> m (Named a :<- Term sig a, Term sig a)
 unbind n (Alg sig) | Just (Named u a :>>= b) <- prj sig = pure (Named u n :<- a, instantiate1 (pure n) b)
 unbind _ _                                              = empty
 
-unstatement :: (Alternative m, Member Core sig, RightModule sig) => a -> Term sig a -> m (Maybe (Named a) :<- Term sig a, Term sig a)
+unstatement :: (Alternative m, Project Core sig, RightModule sig) => a -> Term sig a -> m (Maybe (Named a) :<- Term sig a, Term sig a)
 unstatement n t = first (first Just) <$> unbind n t <|> first (Nothing :<-) <$> unseq t
 
-do' :: (Eq a, Foldable t, Carrier sig m, Member Core sig) => t (Maybe (Named a) :<- m a) -> m a
+do' :: (Eq a, Foldable t, Has Core sig m) => t (Maybe (Named a) :<- m a) -> m a
 do' bindings = fromMaybe unit (foldr bind Nothing bindings)
   where bind (n :<- a) v = maybe (a >>>) ((>>>=) . (:<- a)) n <$> v <|> Just a
 
-unstatements :: (Member Core sig, RightModule sig) => Term sig a -> (Stack (Maybe (Named (Either Int a)) :<- Term sig (Either Int a)), Term sig (Either Int a))
+unstatements :: (Project Core sig, RightModule sig) => Term sig a -> (Stack (Maybe (Named (Either Int a)) :<- Term sig (Either Int a)), Term sig (Either Int a))
 unstatements = unprefix (unstatement . Left) . fmap Right
 
 data a :<- b = a :<- b
@@ -165,65 +164,65 @@ instance Bifunctor (:<-) where
   bimap f g (a :<- b) = f a :<- g b
 
 
-lam :: (Eq a, Carrier sig m, Member Core sig) => Named a -> m a -> m a
+lam :: (Eq a, Has Core sig m) => Named a -> m a -> m a
 lam (Named u n) b = send (Lam (Named u (abstract1 n b)))
 
-lams :: (Eq a, Foldable t, Carrier sig m, Member Core sig) => t (Named a) -> m a -> m a
+lams :: (Eq a, Foldable t, Has Core sig m) => t (Named a) -> m a -> m a
 lams names body = foldr lam body names
 
-unlam :: (Alternative m, Member Core sig, RightModule sig) => a -> Term sig a -> m (Named a, Term sig a)
+unlam :: (Alternative m, Project Core sig, RightModule sig) => a -> Term sig a -> m (Named a, Term sig a)
 unlam n (Alg sig) | Just (Lam b) <- prj sig = pure (n <$ b, instantiate1 (pure n) (namedValue b))
 unlam _ _                                   = empty
 
-($$) :: (Carrier sig m, Member Core sig) => m a -> m a -> m a
+($$) :: Has Core sig m => m a -> m a -> m a
 f $$ a = send (f :$ a)
 
 infixl 8 $$
 
 -- | Application of a function to a sequence of arguments.
-($$*) :: (Foldable t, Carrier sig m, Member Core sig) => m a -> t (m a) -> m a
+($$*) :: (Foldable t, Has Core sig m) => m a -> t (m a) -> m a
 ($$*) = foldl' ($$)
 
 infixl 8 $$*
 
-unapply :: (Alternative m, Member Core sig) => Term sig a -> m (Term sig a, Term sig a)
+unapply :: (Alternative m, Project Core sig) => Term sig a -> m (Term sig a, Term sig a)
 unapply (Alg sig) | Just (f :$ a) <- prj sig = pure (f, a)
 unapply _                                    = empty
 
-unapplies :: Member Core sig => Term sig a -> (Term sig a, Stack (Term sig a))
+unapplies :: Project Core sig => Term sig a -> (Term sig a, Stack (Term sig a))
 unapplies core = case unapply core of
   Just (f, a) -> (:> a) <$> unapplies f
   Nothing     -> (core, Nil)
 
-unit :: (Carrier sig m, Member Core sig) => m a
+unit :: Has Core sig m => m a
 unit = send Unit
 
-bool :: (Carrier sig m, Member Core sig) => Bool -> m a
+bool :: Has Core sig m => Bool -> m a
 bool = send . Bool
 
-if' :: (Carrier sig m, Member Core sig) => m a -> m a -> m a -> m a
+if' :: Has Core sig m => m a -> m a -> m a -> m a
 if' c t e = send (If c t e)
 
-string :: (Carrier sig m, Member Core sig) => Text -> m a
+string :: Has Core sig m => Text -> m a
 string = send . String
 
-load :: (Carrier sig m, Member Core sig) => m a -> m a
+load :: Has Core sig m => m a -> m a
 load = send . Load
 
-record :: (Carrier sig m, Member Core sig) => [(Name, m a)] -> m a
+record :: Has Core sig m => [(Name, m a)] -> m a
 record fs = send (Record fs)
 
-(...) :: (Carrier sig m, Member Core sig) => m a -> Name -> m a
+(...) :: Has Core sig m => m a -> Name -> m a
 a ... b = send (a :. b)
 
 infixl 9 ...
 
-(.?) :: (Carrier sig m, Member Core sig) => m a -> Name -> m a
+(.?) :: Has Core sig m => m a -> Name -> m a
 a .? b = send (a :? b)
 
 infixl 9 .?
 
-(.=) :: (Carrier sig m, Member Core sig) => m a -> m a -> m a
+(.=) :: Has Core sig m => m a -> m a -> m a
 a .= b = send (a := b)
 
 infix 3 .=
@@ -241,17 +240,17 @@ instance RightModule (Ann ann) where
   Ann l b >>=* f = Ann l (b >>= f)
 
 
-ann :: (Carrier sig m, Member (Ann Span) sig) => HasCallStack => m a -> m a
+ann :: Has (Ann Span) sig m => HasCallStack => m a -> m a
 ann = annWith callStack
 
-annAt :: (Carrier sig m, Member (Ann ann) sig) => ann -> m a -> m a
+annAt :: Has (Ann ann) sig m => ann -> m a -> m a
 annAt ann = send . Ann ann
 
-annWith :: (Carrier sig m, Member (Ann Span) sig) => CallStack -> m a -> m a
+annWith :: Has (Ann Span) sig m => CallStack -> m a -> m a
 annWith callStack = maybe id (annAt . spanFromSrcLoc . snd) (listToMaybe (getCallStack callStack))
 
 
-stripAnnotations :: forall ann a sig . (HFunctor sig, forall g . Functor g => Functor (sig g)) => Term (Ann ann :+: sig) a -> Term sig a
+stripAnnotations :: forall ann a sig . RightModule sig => Term (Ann ann :+: sig) a -> Term sig a
 stripAnnotations (Var v)             = Var v
 stripAnnotations (Alg (L (Ann _ b))) = stripAnnotations b
 stripAnnotations (Alg (R        b))  = Alg (hmap stripAnnotations b)

semantic-core/src/Core/Eval.hs

@@ -12,8 +12,8 @@ module Core.Eval
 
 import Analysis.Analysis
 import Analysis.File
+import Control.Algebra
 import Control.Applicative (Alternative (..))
-import Control.Effect.Carrier
 import Control.Effect.Fail
 import Control.Effect.Reader
 import Control.Monad ((>=>))
@@ -28,8 +28,7 @@ import Syntax.Scope
 import Syntax.Term
 import qualified System.Path as Path
 
-eval :: ( Carrier sig m
-        , Member (Reader Span) sig
+eval :: ( Has (Reader Span) sig m
         , MonadFail m
         , Semigroup value
         )
@@ -98,30 +97,30 @@ eval Analysis{..} eval = \case
           Alg (L (Ann span c)) -> local (const span) (ref c)
 
 
-prog1 :: (Carrier sig t, Member Core sig) => File (t Name)
+prog1 :: Has Core sig t => File (t Name)
 prog1 = fromBody $ lam (named' "foo")
   (    named' "bar" :<- pure "foo"
   >>>= Core.if' (pure "bar")
     (Core.bool False)
     (Core.bool True))
 
-prog2 :: (Carrier sig t, Member Core sig) => File (t Name)
+prog2 :: Has Core sig t => File (t Name)
 prog2 = fromBody $ fileBody prog1 $$ Core.bool True
 
-prog3 :: (Carrier sig t, Member Core sig) => File (t Name)
+prog3 :: Has Core sig t => File (t Name)
 prog3 = fromBody $ lams [named' "foo", named' "bar", named' "quux"]
   (Core.if' (pure "quux")
     (pure "bar")
     (pure "foo"))
 
-prog4 :: (Carrier sig t, Member Core sig) => File (t Name)
+prog4 :: Has Core sig t => File (t Name)
 prog4 = fromBody
   (    named' "foo" :<- Core.bool True
   >>>= Core.if' (pure "foo")
     (Core.bool True)
     (Core.bool False))
 
-prog5 :: (Carrier sig t, Member (Ann Span) sig, Member Core sig) => File (t Name)
+prog5 :: (Has (Ann Span) sig t, Has Core sig t) => File (t Name)
 prog5 = fromBody $ ann (do'
   [ Just (named' "mkPoint") :<- lams [named' "_x", named' "_y"] (ann (Core.record
     [ ("x", ann (pure "_x"))
@@ -132,7 +131,7 @@ prog5 = fromBody $ ann (do'
   , Nothing :<- ann (ann (pure "point") Core.... "y") .= ann (ann (pure "point") Core.... "x")
   ])
 
-prog6 :: (Carrier sig t, Member Core sig) => [File (t Name)]
+prog6 :: Has Core sig t => [File (t Name)]
 prog6 =
   [ (fromBody (Core.record
     [ ("dep", Core.record [ ("var", Core.bool True) ]) ]))
@@ -144,7 +143,7 @@ prog6 =
     { filePath = Path.absRel "main" }
   ]
 
-ruby :: (Carrier sig t, Member (Ann Span) sig, Member Core sig) => File (t Name)
+ruby :: (Has (Ann Span) sig t, Has Core sig t) => File (t Name)
 ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (do' statements))
   where statements =
           [ Just "Class" :<- record

semantic-core/src/Core/Parser.hs

@@ -9,8 +9,8 @@ module Core.Parser
 
 -- Consult @doc/grammar.md@ for an EBNF grammar.
 
+import           Control.Algebra
 import           Control.Applicative
-import           Control.Effect.Carrier
 import           Control.Monad
 import           Core.Core ((:<-) (..), Core)
 import qualified Core.Core as Core
@@ -57,25 +57,25 @@ identifier = choice [quote, plain] <?> "identifier" where
 
 -- * Parsers (corresponding to EBNF)
 
-core :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t Name)
+core :: (TokenParsing m, Has Core sig t, Monad m) => m (t Name)
 core = runCoreParser expr
 
-expr :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t Name)
+expr :: (TokenParsing m, Has Core sig t, Monad m) => m (t Name)
 expr = ifthenelse <|> lambda <|> rec <|> load <|> assign
 
-assign :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t Name)
+assign :: (TokenParsing m, Has Core sig t, Monad m) => m (t Name)
 assign = application <**> (symbolic '=' *> rhs <|> pure id) <?> "assignment"
   where rhs = flip (Core..=) <$> application
 
-application :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t Name)
+application :: (TokenParsing m, Has Core sig t, Monad m) => m (t Name)
 application = projection `chainl1` (pure (Core.$$))
 
-projection :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t Name)
+projection :: (TokenParsing m, Has Core sig t, Monad m) => m (t Name)
 projection = foldl' (&) <$> atom <*> many (choice [ flip (Core..?)  <$ symbol ".?" <*> identifier
                                                   , flip (Core....) <$ dot         <*> identifier
                                                   ])
 
-atom :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t Name)
+atom :: (TokenParsing m, Has Core sig t, Monad m) => m (t Name)
 atom = choice
   [ comp
   , lit
@@ -83,26 +83,26 @@ atom = choice
   , parens expr
   ]
 
-comp :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t Name)
+comp :: (TokenParsing m, Has Core sig t, Monad m) => m (t Name)
 comp = braces (Core.do' <$> sepEndByNonEmpty statement semi) <?> "compound statement"
 
-statement :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (Maybe (Named Name) :<- t Name)
+statement :: (TokenParsing m, Has Core sig t, Monad m) => m (Maybe (Named Name) :<- t Name)
 statement
   =   try ((:<-) . Just <$> name <* symbol "<-" <*> expr)
   <|> (Nothing :<-) <$> expr
   <?> "statement"
 
-ifthenelse :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t Name)
+ifthenelse :: (TokenParsing m, Has Core sig t, Monad m) => m (t Name)
 ifthenelse = Core.if'
   <$ reserved "if"   <*> expr
   <* reserved "then" <*> expr
   <* reserved "else" <*> expr
   <?> "if-then-else statement"
 
-rec :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t Name)
+rec :: (TokenParsing m, Has Core sig t, Monad m) => m (t Name)
 rec = Core.rec <$ reserved "rec" <*> name <* symbolic '=' <*> expr <?> "recursive binding"
 
-load :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t Name)
+load :: (TokenParsing m, Has Core sig t, Monad m) => m (t Name)
 load = Core.load <$ reserved "load" <*> expr
 
 -- * Literals
@@ -110,7 +110,7 @@ load = Core.load <$ reserved "load" <*> expr
 name :: (TokenParsing m, Monad m) => m (Named Name)
 name = named' <$> identifier <?> "name"
 
-lit :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t Name)
+lit :: (TokenParsing m, Has Core sig t, Monad m) => m (t Name)
 lit = let x `given` n = x <$ reserved n in choice
   [ Core.bool True  `given` "#true"
   , Core.bool False `given` "#false"
@@ -119,10 +119,10 @@ lit = let x `given` n = x <$ reserved n in choice
   , Core.string <$> stringLiteral
   ] <?> "literal"
 
-record :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t Name)
+record :: (TokenParsing m, Has Core sig t, Monad m) => m (t Name)
 record = Core.record <$ reserved "#record" <*> braces (sepEndBy ((,) <$> identifier <* symbolic ':' <*> expr) comma)
 
-lambda :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t Name)
+lambda :: (TokenParsing m, Has Core sig t, Monad m) => m (t Name)
 lambda = Core.lam <$ lambduh <*> name <* arrow <*> expr <?> "lambda" where
   lambduh = symbolic 'λ' <|> symbolic '\\'
   arrow   = symbol "→"   <|> symbol "->"

semantic-core/test/Generators.hs

@@ -12,13 +12,13 @@ module Generators
   , expr
   ) where
 
-import Hedgehog hiding (Var)
+import           Hedgehog hiding (Var)
 import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Range as Range
 
-import Control.Effect.Carrier
+import           Control.Algebra
 import qualified Core.Core as Core
-import Core.Name
+import           Core.Name
 
 -- The 'prune' call here ensures that we don't spend all our time just generating
 -- fresh names for variables, since the length of variable names is not an
@@ -27,16 +27,16 @@ name :: MonadGen m => m (Named Name)
 name = Gen.prune (named' <$> names) where
   names = Name <$> Gen.text (Range.linear 1 10) Gen.lower
 
-boolean :: (Carrier sig t, Member Core.Core sig, MonadGen m) => m (t Name)
+boolean :: (Has Core.Core sig t, MonadGen m) => m (t Name)
 boolean = Core.bool <$> Gen.bool
 
 variable :: (Applicative t, MonadGen m) => m (t Name)
 variable = pure . namedValue <$> name
 
-ifthenelse :: (Carrier sig t, Member Core.Core sig, MonadGen m) => m (t Name) -> m (t Name)
+ifthenelse :: (Has Core.Core sig t, MonadGen m) => m (t Name) -> m (t Name)
 ifthenelse bod = Gen.subterm3 boolean bod bod Core.if'
 
-apply :: (Carrier sig t, Member Core.Core sig, MonadGen m) => m (t Name) -> m (t Name)
+apply :: (Has Core.Core sig t, MonadGen m) => m (t Name) -> m (t Name)
 apply gen = go where
   go = Gen.recursive
     Gen.choice
@@ -45,21 +45,21 @@ apply gen = go where
     , Gen.subtermM go (\x -> Core.lam <$> name <*> pure x)
     ]
 
-lambda :: (Carrier sig t, Member Core.Core sig, MonadGen m) => m (t Name) -> m (t Name)
+lambda :: (Has Core.Core sig t, MonadGen m) => m (t Name) -> m (t Name)
 lambda bod = do
   arg <- name
   Gen.subterm bod (Core.lam arg)
 
-record :: (Carrier sig t, Member Core.Core sig, MonadGen m) => m (t Name) -> m (t Name)
+record :: (Has Core.Core sig t, MonadGen m) => m (t Name) -> m (t Name)
 record bod = Core.record <$> Gen.list (Range.linear 0 5) ((,) . namedValue <$> name <*> bod)
 
-atoms :: (Carrier sig t, Member Core.Core sig, MonadGen m) => [m (t Name)]
+atoms :: (Has Core.Core sig t, MonadGen m) => [m (t Name)]
 atoms = [variable, pure Core.unit, boolean, Core.string <$> Gen.text (Range.linear 1 10) Gen.lower]
 
-literal :: (Carrier sig t, Member Core.Core sig, MonadGen m) => m (t Name)
+literal :: (Has Core.Core sig t, MonadGen m) => m (t Name)
 literal = Gen.recursive Gen.choice atoms [lambda literal, record literal]
 
-expr :: (Carrier sig t, Member Core.Core sig, MonadGen m) => m (t Name)
+expr :: (Has Core.Core sig t, MonadGen m) => m (t Name)
 expr = Gen.recursive Gen.choice atoms
   [ Gen.subtermM expr (\x -> flip Core.rec x <$> name)
   , Gen.subterm2 expr expr (Core.>>>)

semantic-java/semantic-java.cabal

@@ -23,11 +23,11 @@ library
     Language.Java
     Language.Java.Tags
   build-depends:
-      base              >= 4.12 && < 5
-    , fused-effects    ^>= 0.5
+      base              >= 4.13 && < 5
+    , fused-effects    ^>= 1.0
     , semantic-source  ^>= 0.0
     , semantic-tags    ^>= 0.0
-    , tree-sitter      ^>= 0.7
+    , tree-sitter      ^>= 0.7.1
     , tree-sitter-java ^>= 0.6
   hs-source-dirs:      src
   default-language:    Haskell2010

semantic-java/src/Language/Java/Tags.hs

@@ -16,9 +16,8 @@ import qualified TreeSitter.Java.AST as Java
 
 class ToTags t where
   tags
-    :: ( Carrier sig m
-       , Member (Reader Source) sig
-       , Member (Writer Tags.Tags) sig
+    :: ( Has (Reader Source) sig m
+       , Has (Writer Tags.Tags) sig m
        )
     => t Loc
     -> m ()
@@ -29,9 +28,8 @@ instance (ToTagsBy strategy t, strategy ~ ToTagsInstance t) => ToTags t where
 
 class ToTagsBy (strategy :: Strategy) t where
   tags'
-    :: ( Carrier sig m
-       , Member (Reader Source) sig
-       , Member (Writer Tags.Tags) sig
+    :: ( Has (Reader Source) sig m
+       , Has (Writer Tags.Tags) sig m
        )
     => t Loc
     -> m ()
@@ -89,9 +87,8 @@ instance ToTagsBy 'Custom Java.MethodInvocation where
 
 
 gtags
-  :: ( Carrier sig m
-     , Member (Reader Source) sig
-     , Member (Writer Tags.Tags) sig
+  :: ( Has (Reader Source) sig m
+     , Has (Writer Tags.Tags) sig m
      , Generic1 t
      , Tags.GFoldable1 ToTags (Rep1 t)
      )

semantic-json/semantic-json.cabal

@@ -22,7 +22,7 @@ library
   exposed-modules:
     Language.JSON
   build-depends:
-      base              >= 4.12 && < 5
+      base              >= 4.13 && < 5
     , semantic-tags    ^>= 0.0
     , tree-sitter      ^>= 0.7
     , tree-sitter-json ^>= 0.5

semantic-python/semantic-python.cabal

@@ -20,8 +20,8 @@ tested-with:         GHC == 8.6.5
 
 common haskell
   default-language:    Haskell2010
-  build-depends:       base ^>=4.12
-                     , fused-effects ^>= 0.5
+  build-depends:       base ^>= 4.13
+                     , fused-effects ^>= 1.0
                      , fused-syntax
                      , parsers ^>= 0.12.10
                      , semantic-core ^>= 0.0
@@ -43,7 +43,8 @@ common haskell
     -Wno-missed-specialisations
     -Wno-all-missed-specialisations
     -Wno-star-is-type
-
+  if (impl(ghc >= 8.8))
+    ghc-options: -Wno-missing-deriving-strategies
 
 
 library

semantic-python/src/Language/Python/Core.hs

@@ -10,7 +10,7 @@ module Language.Python.Core
 import Prelude hiding (fail)
 
 import           AST.Element
-import           Control.Effect hiding ((:+:))
+import           Control.Algebra hiding ((:+:))
 import           Control.Effect.Reader
 import           Core.Core as Core
 import           Core.Name as Name
@@ -49,28 +49,25 @@ pattern SingleIdentifier name <- Py.ExpressionList
 -- We leave the representation of Core syntax abstract so that it's not
 -- possible for us to 'cheat' by pattern-matching on or eliminating a
 -- compiled term.
-type CoreSyntax sig t = ( Member Core sig
-                        , Member (Ann Span) sig
-                        , Member Failure sig
-                        , Carrier sig t
+type CoreSyntax sig t = ( Has Core sig t
+                        , Has (Ann Span) sig t
+                        , Has Failure sig t
                         , Foldable t
                         )
 
 class Compile (py :: * -> *) where
   compile :: ( CoreSyntax syn t
-             , Member (Reader Bindings) sig
-             , Carrier sig m
+             , Has (Reader Bindings) sig m
              )
           => py Span
           -> (t Name -> m (t Name))
           -> (t Name -> m (t Name))
 
-  default compile :: (Applicative m, Member Failure syn, Carrier syn t, Show (py Span)) => py Span -> (t Name -> m (t Name)) -> (t Name -> m (t Name))
+  default compile :: (Applicative m, Has Failure syn t, Show (py Span)) => py Span -> (t Name -> m (t Name)) -> (t Name -> m (t Name))
   compile a _ _ = defaultCompile a
 
 toplevelCompile :: ( CoreSyntax syn t
-                   , Member (Reader Bindings) sig
-                   , Carrier sig m
+                   , Has (Reader Bindings) sig m
                    )
                 => Py.Module Span
                 -> m (t Name)
@@ -78,7 +75,7 @@ toplevelCompile py = compile py pure none
 
 -- | TODO: This is not right, it should be a reference to a Preluded
 -- NoneType instance, but it will do for now.
-none :: (Member Core sig, Carrier sig t) => t Name
+none :: Has Core sig t => t Name
 none = unit
 
 locate :: ( HasField "ann" syntax Span
@@ -89,7 +86,7 @@ locate :: ( HasField "ann" syntax Span
        -> t a
 locate syn  = Core.annAt (getField @"ann" syn)
 
-defaultCompile :: (Applicative m, Member Failure syn, Carrier syn t, Show py) => py -> m (t Name)
+defaultCompile :: (Applicative m, Has Failure syn t, Show py) => py -> m (t Name)
 defaultCompile = pure . unimplemented
 
 
@@ -142,7 +139,7 @@ desugar acc = \case
 -- returns a function). There's some pun to be made on "collapsing
 -- sugar", like "icing" or "sugar water" but I'll leave that as an
 -- exercise to the reader.
-collapseDesugared :: (CoreSyntax syn t, Member (Reader Bindings) sig, Carrier sig m)
+collapseDesugared :: (CoreSyntax syn t, Has (Reader Bindings) sig m)
                   => Located Name           -- The current LHS to which to assign
                   -> (t Name -> m (t Name)) -- A meta-continuation: it takes a name and returns a continuation
                   -> t Name                 -- The current RHS to which to assign, yielded from an outer continuation
@@ -314,7 +311,18 @@ instance Compile Py.ImportFromStatement
 instance Compile Py.ImportStatement
 instance Compile Py.Integer
 
-instance Compile Py.Lambda
+instance Compile Py.Lambda where
+  compile it@Py.Lambda
+    { body
+    , parameters
+    } cc next = do
+      let unparams (Py.LambdaParameters _ ps) = toList ps
+          unparam (Py.Parameter (Prj (Py.Identifier _pann pname))) = Just . named' . Name $ pname
+          unparam _ = Nothing
+      body' <- compile body cc next
+      let params = maybe [] unparams parameters
+      pure . locate it . lams (catMaybes (fmap unparam params)) $ body'
+
 instance Compile Py.List
 instance Compile Py.ListComprehension
 instance Compile Py.ListSplat
@@ -333,7 +341,11 @@ instance Compile Py.Module where
     in fmap (locate it) . foldr compile buildRecord stmts
 
 instance Compile Py.NamedExpression
-instance Compile Py.None
+
+instance Compile Py.None where
+  -- None is not overridable, and thus always points to the prelude's None.
+  compile _it cc _ = cc (pure "__semantic_prelude" ... "None")
+
 instance Compile Py.NonlocalStatement
 instance Compile Py.NotOperator
 

semantic-python/src/Language/Python/Failure.hs

@@ -11,7 +11,7 @@ module Language.Python.Failure
 
 import Prelude hiding (fail)
 
-import Control.Effect.Carrier
+import Control.Algebra
 import Control.Monad.Fail
 import Data.Coerce
 import Data.Kind
@@ -42,10 +42,10 @@ instance RightModule Failure where
   a >>=* _ = coerce a
 
 
-unimplemented :: (Show ast, Member Failure sig, Carrier sig m) => ast -> m a
+unimplemented :: (Show ast, Has Failure sig m) => ast -> m a
 unimplemented = send . Unimplemented . show
 
-invariantViolated :: (Member Failure sig, Carrier sig m) => String -> m a
+invariantViolated :: Has Failure sig m => String -> m a
 invariantViolated = send . InvariantViolated
 
 eliminateFailures :: (MonadFail m, HTraversable sig, RightModule sig)

semantic-python/src/Language/Python/Tags.hs

@@ -20,9 +20,8 @@ import qualified TreeSitter.Python.AST as Py
 
 class ToTags t where
   tags
-    :: ( Carrier sig m
-       , Member (Reader Source) sig
-       , Member (Writer Tags.Tags) sig
+    :: ( Has (Reader Source) sig m
+       , Has (Writer Tags.Tags) sig m
        )
     => t Loc
     -> m ()
@@ -33,9 +32,8 @@ instance (ToTagsBy strategy t, strategy ~ ToTagsInstance t) => ToTags t where
 
 class ToTagsBy (strategy :: Strategy) t where
   tags'
-    :: ( Carrier sig m
-       , Member (Reader Source) sig
-       , Member (Writer Tags.Tags) sig
+    :: ( Has (Reader Source) sig m
+       , Has (Writer Tags.Tags) sig m
        )
     => t Loc
     -> m ()
@@ -96,9 +94,8 @@ docComment _ _ = Nothing
 
 
 gtags
-  :: ( Carrier sig m
-     , Member (Reader Source) sig
-     , Member (Writer Tags.Tags) sig
+  :: ( Has (Reader Source) sig m
+     , Has (Writer Tags.Tags) sig m
      , Generic1 t
      , Tags.GFoldable1 ToTags (Rep1 t)
      )

semantic-python/src/Prelude.score

@@ -10,8 +10,16 @@
 
   str <- type "str" object #record { __new__: \prim -> instance #unit prim #record{} };
 
+  NoneType <- type "None" object #record { __new__: \prim -> instance #unit prim #record{} };
+  None <- NoneType.__slots.__new__ #unit;
+
   getitem <- \super -> \item -> \attr ->
     if item.slots.?attr then item.slots.attr else #unit;
 
-  #record { type: type, object: object, str: str, getitem: getitem}
+  #record { type: type
+          , object: object
+          , str: str
+          , NoneType: NoneType
+          , None: None
+          , getitem: getitem}
 }

semantic-python/test/Directive.hs

@@ -8,8 +8,8 @@ module Directive ( Directive (..)
                  ) where
 
 import           Analysis.Concrete (Concrete (..))
+import           Control.Algebra
 import           Control.Applicative
-import           Control.Effect
 import           Control.Monad
 import           Control.Monad.Trans.Resource (ResourceT, runResourceT)
 import           Core.Core (Core)

semantic-python/test/Test.hs

@@ -6,9 +6,9 @@ import           Analysis.Concrete (Concrete)
 import qualified Analysis.Concrete as Concrete
 import           Analysis.File
 import           Analysis.ScopeGraph
-import           Control.Effect
-import           Control.Effect.Fail
-import           Control.Effect.Reader
+import           Control.Algebra
+import           Control.Carrier.Fail.Either
+import           Control.Carrier.Reader
 import           Control.Monad hiding (fail)
 import           Control.Monad.Catch
 import           Control.Monad.IO.Class
@@ -118,10 +118,10 @@ checkPythonFile fp = HUnit.testCaseSteps (Path.toString fp) $ \step -> withFroze
   result <- ByteString.readFile (Path.toString fullPath) >>= TS.parseByteString TSP.tree_sitter_python
 
   -- Run the compiler
-  let coreResult = Control.Effect.run
+  let coreResult = Control.Algebra.run
                    . runFail
                    . eliminateFailures
-                   . Control.Effect.run
+                   . Control.Algebra.run
                    . runReader @Py.Bindings mempty
                    . Py.toplevelCompile @(Failure :+: Ann Span :+: Core) @(Term _)
                    <$> result

semantic-python/test/fixtures/4-01-lambda-literals.py

@@ -0,0 +1,4 @@
+# CHECK-TREE: { const <- \x -> \y -> x; y <- const #true #true; z <- const #false #false; #record { const: const, y : y, z: z, }}
+const = lambda x, y: x
+y = const(True, True)
+z = const(False, False)

semantic-python/test/fixtures/4-02-nonetype.py

@@ -0,0 +1,2 @@
+# CHECK-TREE: { x <- __semantic_prelude.None; #record { x : x }}
+x = None

semantic-source/semantic-source.cabal

@@ -48,7 +48,7 @@ library
     Source.Span
   build-depends:
       aeson          ^>= 1.4.2.0
-    , base            >= 4.12 && < 5
+    , base            >= 4.13 && < 5
     , bytestring     ^>= 0.10.8.2
     , deepseq        ^>= 1.4.4.0
     , generic-monoid ^>= 0.1.0.0

semantic-tags/semantic-tags.cabal

@@ -24,8 +24,8 @@ library
     Tags.Tag
     Tags.Tagging.Precise
   build-depends:
-      base                >= 4.12 && < 5
-    , fused-effects      ^>= 0.5
+      base                >= 4.13 && < 5
+    , fused-effects      ^>= 1.0
     , semantic-source    ^>= 0.0
     , text               ^>= 1.2.3.1
   hs-source-dirs:      src
@@ -42,3 +42,5 @@ library
     -Wno-missed-specialisations
     -Wno-all-missed-specialisations
     -Wno-star-is-type
+  if (impl(ghc >= 8.8))
+    ghc-options: -Wno-missing-deriving-strategies

semantic-tags/src/Tags/Tagging/Precise.hs

@@ -8,9 +8,9 @@ module Tags.Tagging.Precise
 , GFoldable1(..)
 ) where
 
-import Control.Effect.Pure
-import Control.Effect.Reader
-import Control.Effect.Writer
+import Control.Carrier.Reader
+import Control.Carrier.Writer.Strict
+import Data.Functor.Identity
 import Data.Monoid (Endo(..))
 import Data.Text as Text (Text, takeWhile)
 import GHC.Generics
@@ -26,12 +26,12 @@ class ToTags t where
   tags :: Source -> t Loc -> [Tag]
 
 
-yield :: (Carrier sig m, Member (Writer Tags) sig) => Tag -> m ()
+yield :: Has (Writer Tags) sig m => Tag -> m ()
 yield = tell . Endo . (:) . modSpan toOneIndexed where
   modSpan f t@Tag{ loc = l } = t { loc = l { span = f (span l) } }
   toOneIndexed (Span (Pos l1 c1) (Pos l2 c2)) = Span (Pos (l1 + 1) (c1 + 1)) (Pos (l2 + 1) (c2 + 1))
 
-runTagging :: Source -> ReaderC Source (WriterC Tags PureC) () -> [Tag]
+runTagging :: Source -> ReaderC Source (WriterC Tags Identity) () -> [Tag]
 runTagging source
   = ($ [])
   . appEndo

semantic.cabal

@@ -16,7 +16,7 @@ build-type:          Simple
 stability:           alpha
 extra-source-files:  README.md
 
-tested-with:         GHC == 8.6.5
+tested-with:         GHC == 8.8.1
 
 flag release
   description: Build with optimizations on (for CI or deployment builds)
@@ -46,7 +46,7 @@ common haskell
 -- as caret-operator bounds relative to a version in Stackage.
 -- These are currently pinned to lts-13.13.
 common dependencies
-  build-depends:       base >= 4.12 && < 5
+  build-depends:       base >= 4.13 && < 5
                      , aeson ^>= 1.4.2.0
                      , algebraic-graphs ^>= 0.3
                      , async ^>= 2.2.1
@@ -54,11 +54,12 @@ common dependencies
                      , bytestring ^>= 0.10.8.2
                      , containers ^>= 0.6.0.1
                      , directory ^>= 1.3.3.0
-                     , fastsum ^>= 0.1.1.0
-                     , fused-effects ^>= 0.5.0.0
-                     , fused-effects-exceptions ^>= 0.2.0.0
-                     , hashable ^>= 1.2.7.0
-                     , tree-sitter ^>= 0.7
+                     , fastsum ^>= 0.1.1.1
+                     , fused-effects ^>= 1
+                     , fused-effects-exceptions ^>= 1
+                     , fused-effects-resumable ^>= 0.1
+                     , hashable >= 1.2.7 && < 1.4
+                     , tree-sitter ^>= 0.7.1
                      , mtl ^>= 2.2.2
                      , network ^>= 2.8.0.0
                      , pathtype ^>= 0.8.1
@@ -115,6 +116,7 @@ library
                      , Control.Effect.Interpose
                      , Control.Effect.Parse
                      , Control.Effect.REPL
+                     , Control.Effect.Sum.Project
                      -- Datatypes for abstract interpretation
                      , Data.Abstract.Address.Hole
                      , Data.Abstract.Address.Monovariant
@@ -255,7 +257,7 @@ library
                      , Prologue
   autogen-modules:     Paths_semantic
   other-modules:       Paths_semantic
-  build-depends:       base >= 4.12 && < 5
+  build-depends:       base >= 4.13 && < 5
                      , ansi-terminal >= 0.8.2 && <1
                      , array ^>= 0.5.3.0
                      , attoparsec ^>= 0.13.2.2
@@ -270,18 +272,18 @@ library
                      , hostname ^>= 1.0
                      , hscolour ^>= 1.24.4
                      , kdt ^>= 0.2.4
-                     , lens ^>= 4.17
+                     , lens >= 4.17 && < 4.19
                      , mersenne-random-pure64 ^>= 0.2.2.0
                      , network-uri ^>= 2.6.1.0
-                     , optparse-applicative ^>= 0.14.3.0
+                     , optparse-applicative >= 0.14.3 && < 0.16
                      , parallel ^>= 3.2.2.0
                      , parsers ^>= 0.12.9
-                     , prettyprinter ^>= 1.2.1
+                     , prettyprinter >= 1.2.1 && < 1.4
                      , pretty-show ^>= 1.9.5
                      , profunctors ^>= 5.3
-                     , proto-lens ^>= 0.5.1.0
+                     , proto-lens >= 0.5 && < 0.7
                      , proto-lens-jsonpb
-                     , proto-lens-runtime ^>= 0.5.0.0
+                     , proto-lens-runtime >= 0.5 && <0.7
                      , reducers ^>= 3.12.3
                      , semantic-java ^>= 0
                      , semantic-json ^>= 0
@@ -290,8 +292,8 @@ library
                      , semigroupoids ^>= 5.3.2
                      , split ^>= 0.2.3.3
                      , stm-chans ^>= 3.0.0.4
-                     , template-haskell ^>= 2.14
-                     , time ^>= 1.8.0.2
+                     , template-haskell >= 2.14 && < 2.16
+                     , time >= 1.8.0.2 && < 1.10
                      , utf8-string ^>= 1.0.1.1
                      , unliftio-core ^>= 0.1.2.0
                      , unordered-containers ^>= 0.2.9.0

src/Analysis/Abstract/Caching/FlowInsensitive.hs

@@ -5,19 +5,26 @@ module Analysis.Abstract.Caching.FlowInsensitive
 , caching
 ) where
 
+import Prologue
+
+import Control.Algebra (Effect)
+import Control.Carrier.Fresh.Strict
+import Control.Carrier.NonDet.Church
+import Control.Carrier.Reader
+import Control.Carrier.State.Strict
+
 import Control.Abstract
 import Data.Abstract.Module
 import Data.Map.Monoidal as Monoidal hiding (empty)
-import Prologue
 
 -- | Look up the set of values for a given configuration in the in-cache.
-consultOracle :: (Member (Reader (Cache term address value)) sig, Carrier sig m, Ord address, Ord term, Ord value)
+consultOracle :: (Has (Reader (Cache term address value)) sig m, Ord address, Ord term, Ord value)
               => Configuration term address
               -> Evaluator term address value m (Set value)
 consultOracle configuration = asks (fromMaybe mempty . cacheLookup configuration)
 
 -- | Run an action with the given in-cache.
-withOracle :: (Member (Reader (Cache term address value)) sig, Carrier sig m)
+withOracle :: Has (Reader (Cache term address value)) sig m
            => Cache term address value
            -> Evaluator term address value m a
            -> Evaluator term address value m a
@@ -25,13 +32,13 @@ withOracle cache = local (const cache)
 
 
 -- | Look up the set of values for a given configuration in the out-cache.
-lookupCache :: (Member (State (Cache term address value)) sig, Carrier sig m, Ord address, Ord term)
+lookupCache :: (Has (State (Cache term address value)) sig m, Ord address, Ord term)
             => Configuration term address
             -> Evaluator term address value m (Maybe (Set value))
 lookupCache configuration = cacheLookup configuration <$> get
 
 -- | Run an action, caching its result and 'Heap' under the given configuration.
-cachingConfiguration :: (Member (State (Cache term address value)) sig, Carrier sig m, Ord address, Ord term, Ord value)
+cachingConfiguration :: (Has (State (Cache term address value)) sig m, Ord address, Ord term, Ord value)
                      => Configuration term address
                      -> Set value
                      -> Evaluator term address value m value
@@ -41,23 +48,22 @@ cachingConfiguration configuration values action = do
   result <- action
   result <$ modify (cacheInsert configuration result)
 
-putCache :: (Member (State (Cache term address value)) sig, Carrier sig m)
+putCache :: Has (State (Cache term address value)) sig m
          => Cache term address value
          -> Evaluator term address value m ()
 putCache = put
 
 -- | Run an action starting from an empty out-cache, and return the out-cache afterwards.
-isolateCache :: (Member (State (Cache term address value)) sig, Member (State (Heap address address value)) sig, Carrier sig m)
+isolateCache :: (Has (State (Cache term address value)) sig m, Has (State (Heap address address value)) sig m)
              => Evaluator term address value m a
              -> Evaluator term address value m (Cache term address value, Heap address address value)
 isolateCache action = putCache lowerBound *> action *> ((,) <$> get <*> get)
 
 
 -- | Analyze a term using the in-cache as an oracle & storing the results of the analysis in the out-cache.
-cachingTerms :: ( Member (Reader (Cache term address value)) sig
-                , Member (Reader (Live address)) sig
-                , Member (State (Cache term address value)) sig
-                , Carrier sig m
+cachingTerms :: ( Has (Reader (Cache term address value)) sig m
+                , Has (Reader (Live address)) sig m
+                , Has (State (Cache term address value)) sig m
                 , Ord address
                 , Ord term
                 , Ord value
@@ -73,33 +79,33 @@ cachingTerms recur term = do
       values <- consultOracle c
       cachingConfiguration c values (recur term)
 
-convergingModules :: ( Eq value
-                     , Member Fresh sig
-                     , Member (Reader (Cache term address value)) sig
-                     , Member (Reader (Live address)) sig
-                     , Member (State (Cache term address value)) sig
-                     , Member (State (Heap address address value)) sig
+convergingModules :: ( Effect sig
+                     , Eq value
+                     , Has Fresh sig m
+                     , Has (Reader (Cache term address value)) sig m
+                     , Has (Reader (Live address)) sig m
+                     , Has (State (Cache term address value)) sig m
+                     , Has (State (Heap address address value)) sig m
                      , Ord address
                      , Ord term
-                     , Carrier sig m
                      , Alternative m
                      )
-                  => (Module (Either prelude term) -> Evaluator term address value (NonDetC m) value)
+                  => (Module (Either prelude term) -> Evaluator term address value (NonDetC (FreshC m)) value)
                   -> (Module (Either prelude term) -> Evaluator term address value m value)
-convergingModules recur m@(Module _ (Left _)) = raiseHandler runNonDet (recur m) >>= maybeM empty
+convergingModules recur m@(Module _ (Left _)) = raiseHandler (evalFresh 0 . runNonDetA) (recur m) >>= maybeM empty
 convergingModules recur m@(Module _ (Right term)) = do
   c <- getConfiguration term
   heap <- getHeap
   -- Convergence here is predicated upon an Eq instance, not α-equivalence
   (cache, _) <- converge (lowerBound, heap) (\ (prevCache, _) -> isolateCache $ do
     -- We need to reset fresh generation so that this invocation converges.
-    resetFresh $
+    raiseHandler (evalFresh 0) $
     -- This is subtle: though the calling context supports nondeterminism, we want
     -- to corral all the nondeterminism that happens in this @eval@ invocation, so
     -- that it doesn't "leak" to the calling context and diverge (otherwise this
     -- would never complete). We don’t need to use the values, so we 'gather' the
     -- nondeterministic values into @()@.
-      withOracle prevCache (raiseHandler (runNonDet @Maybe) (recur m)))
+      withOracle prevCache (raiseHandler (runNonDetA @Maybe) (recur m)))
   maybe empty scatter (cacheLookup c cache)
 
 -- | Iterate a monadic action starting from some initial seed until the results converge.
@@ -118,17 +124,17 @@ converge seed f = loop seed
             loop x'
 
 -- | Nondeterministically write each of a collection of stores & return their associated results.
-scatter :: (Foldable t, Carrier sig m, Alternative m) => t value -> Evaluator term address value m value
+scatter :: (Foldable t, Alternative m) => t value -> Evaluator term address value m value
 scatter = foldMapA pure
 
 -- | Get the current 'Configuration' with a passed-in term.
-getConfiguration :: (Member (Reader (Live address)) sig, Carrier sig m)
+getConfiguration :: Has (Reader (Live address)) sig m
                  => term
                  -> Evaluator term address value m (Configuration term address)
 getConfiguration term = Configuration term <$> askRoots
 
 
-caching :: Carrier sig m
+caching :: Algebra sig m
         => Evaluator term address value (NonDetC
                                         (ReaderC (Cache term address value)
                                         (StateC (Cache term address value)
@@ -138,7 +144,7 @@ caching
   = raiseHandler (runState  lowerBound)
   . raiseHandler (runReader lowerBound)
   . fmap (toList @B)
-  . raiseHandler runNonDet
+  . raiseHandler runNonDetA
 
 data B a = E | L a | B (B a) (B a)
   deriving (Functor)

src/Analysis/Abstract/Caching/FlowSensitive.hs

@@ -6,19 +6,26 @@ module Analysis.Abstract.Caching.FlowSensitive
 , caching
 ) where
 
+import Prologue
+
+import Control.Algebra (Effect)
+import Control.Carrier.NonDet.Church
+import Control.Carrier.Reader
+import Control.Carrier.Fresh.Strict
+import Control.Carrier.State.Strict
+
 import Control.Abstract
 import Data.Abstract.Module
 import Data.Map.Monoidal as Monoidal hiding (empty)
-import Prologue
 
 -- | Look up the set of values for a given configuration in the in-cache.
-consultOracle :: (Cacheable term address value, Member (Reader (Cache term address value)) sig, Carrier sig m)
+consultOracle :: (Cacheable term address value, Has (Reader (Cache term address value)) sig m)
               => Configuration term address value
               -> Evaluator term address value m (Set (Cached address value))
 consultOracle configuration = fromMaybe mempty . cacheLookup configuration <$> ask
 
 -- | Run an action with the given in-cache.
-withOracle :: (Member (Reader (Cache term address value)) sig, Carrier sig m)
+withOracle :: Has (Reader (Cache term address value)) sig m
            => Cache term address value
            -> Evaluator term address value m a
            -> Evaluator term address value m a
@@ -26,13 +33,13 @@ withOracle cache = local (const cache)
 
 
 -- | Look up the set of values for a given configuration in the out-cache.
-lookupCache :: (Cacheable term address value, Member (State (Cache term address value)) sig, Carrier sig m)
+lookupCache :: (Cacheable term address value, Has (State (Cache term address value)) sig m)
             => Configuration term address value
             -> Evaluator term address value m (Maybe (Set (Cached address value)))
 lookupCache configuration = cacheLookup configuration <$> get
 
 -- | Run an action, caching its result and 'Heap' under the given configuration.
-cachingConfiguration :: (Cacheable term address value, Member (State (Cache term address value)) sig, Member (State (Heap address address value)) sig, Carrier sig m)
+cachingConfiguration :: (Cacheable term address value, Has (State (Cache term address value)) sig m, Has (State (Heap address address value)) sig m)
                      => Configuration term address value
                      -> Set (Cached address value)
                      -> Evaluator term address value m value
@@ -42,13 +49,13 @@ cachingConfiguration configuration values action = do
   result <- Cached <$> action <*> getHeap
   cachedValue result <$ modify (cacheInsert configuration result)
 
-putCache :: (Member (State (Cache term address value)) sig, Carrier sig m)
+putCache :: Has (State (Cache term address value)) sig m
          => Cache term address value
          -> Evaluator term address value m ()
 putCache = put
 
 -- | Run an action starting from an empty out-cache, and return the out-cache afterwards.
-isolateCache :: (Member (State (Cache term address value)) sig, Carrier sig m)
+isolateCache :: Has (State (Cache term address value)) sig m
              => Evaluator term address value m a
              -> Evaluator term address value m (Cache term address value)
 isolateCache action = putCache lowerBound *> action *> get
@@ -56,11 +63,10 @@ isolateCache action = putCache lowerBound *> action *> get
 
 -- | Analyze a term using the in-cache as an oracle & storing the results of the analysis in the out-cache.
 cachingTerms :: ( Cacheable term address value
-                , Member (Reader (Cache term address value)) sig
-                , Member (Reader (Live address)) sig
-                , Member (State (Cache term address value)) sig
-                , Member (State (Heap address address value)) sig
-                , Carrier sig m
+                , Has (Reader (Cache term address value)) sig m
+                , Has (Reader (Live address)) sig m
+                , Has (State (Cache term address value)) sig m
+                , Has (State (Heap address address value)) sig m
                 , Alternative m
                 )
              => Open (term -> Evaluator term address value m value)
@@ -74,30 +80,30 @@ cachingTerms recur term = do
       cachingConfiguration c pairs (recur term)
 
 convergingModules :: ( Cacheable term address value
-                     , Member Fresh sig
-                     , Member (Reader (Cache term address value)) sig
-                     , Member (Reader (Live address)) sig
-                     , Member (State (Cache term address value)) sig
-                     , Member (State (Heap address address value)) sig
-                     , Carrier sig m
+                     , Effect sig
+                     , Has Fresh sig m
+                     , Has (Reader (Cache term address value)) sig m
+                     , Has (Reader (Live address)) sig m
+                     , Has (State (Cache term address value)) sig m
+                     , Has (State (Heap address address value)) sig m
                      , Alternative m
                      )
-                  => (Module (Either prelude term) -> Evaluator term address value (NonDetC m) value)
+                  => (Module (Either prelude term) -> Evaluator term address value (NonDetC (FreshC m)) value)
                   -> (Module (Either prelude term) -> Evaluator term address value m value)
-convergingModules recur m@(Module _ (Left _)) = raiseHandler runNonDet (recur m) >>= maybeM empty
+convergingModules recur m@(Module _ (Left _)) = raiseHandler (evalFresh 0 . runNonDetA) (recur m) >>= maybeM empty
 convergingModules recur m@(Module _ (Right term)) = do
   c <- getConfiguration term
   -- Convergence here is predicated upon an Eq instance, not α-equivalence
   cache <- converge lowerBound (\ prevCache -> isolateCache $ do
     putHeap        (configurationHeap    c)
     -- We need to reset fresh generation so that this invocation converges.
-    resetFresh $
+    raiseHandler (evalFresh 0) $
     -- This is subtle: though the calling context supports nondeterminism, we want
     -- to corral all the nondeterminism that happens in this @eval@ invocation, so
     -- that it doesn't "leak" to the calling context and diverge (otherwise this
     -- would never complete). We don’t need to use the values, so we 'gather' the
     -- nondeterministic values into @()@.
-      withOracle prevCache (raiseHandler (runNonDet @Maybe) (recur m)))
+      withOracle prevCache (raiseHandler (runNonDetA @Maybe) (recur m)))
   maybe empty scatter (cacheLookup c cache)
 
 -- | Iterate a monadic action starting from some initial seed until the results converge.
@@ -116,11 +122,13 @@ converge seed f = loop seed
             loop x'
 
 -- | Nondeterministically write each of a collection of stores & return their associated results.
-scatter :: (Foldable t, Member (State (Heap address address value)) sig, Alternative m, Carrier sig m) => t (Cached address value) -> Evaluator term address value m value
+scatter :: (Foldable t, Has (State (Heap address address value)) sig m, Alternative m)
+        => t (Cached address value)
+        -> Evaluator term address value m value
 scatter = foldMapA (\ (Cached value heap') -> putHeap heap' $> value)
 
 -- | Get the current 'Configuration' with a passed-in term.
-getConfiguration :: (Member (Reader (Live address)) sig, Member (State (Heap address address value)) sig, Carrier sig m)
+getConfiguration :: (Has (Reader (Live address)) sig m, Has (State (Heap address address value)) sig m)
                  => term
                  -> Evaluator term address value m (Configuration term address value)
 getConfiguration term = Configuration term <$> askRoots <*> getHeap
@@ -135,7 +143,7 @@ caching :: Monad m
 caching
   = raiseHandler (runState  lowerBound)
   . raiseHandler (runReader lowerBound)
-  . raiseHandler runNonDet
+  . raiseHandler runNonDetA
 
 
 -- | A map of 'Configuration's to 'Set's of resulting values & 'Heap's.
@@ -144,9 +152,9 @@ newtype Cache term address value = Cache { unCache :: Monoidal.Map (Configuratio
 
 -- | A single point in a program’s execution.
 data Configuration term address value = Configuration
-  { configurationTerm    :: term                       -- ^ The “instruction,” i.e. the current term to evaluate.
-  , configurationRoots   :: Live address               -- ^ The set of rooted addresses.
-  , configurationHeap    :: Heap address address value -- ^ The heap of values.
+  { configurationTerm  :: term                       -- ^ The “instruction,” i.e. the current term to evaluate.
+  , configurationRoots :: Live address               -- ^ The set of rooted addresses.
+  , configurationHeap  :: Heap address address value -- ^ The heap of values.
   }
   deriving (Eq, Ord, Show)
 

src/Analysis/Abstract/Collecting.hs

@@ -3,6 +3,7 @@ module Analysis.Abstract.Collecting
 ) where
 
 import Control.Abstract
+import Control.Carrier.Reader
 import Prologue
 
 providingLiveSet :: Evaluator term address value (ReaderC (Live address) m) a -> Evaluator term address value m a

src/Analysis/Abstract/Dead.hs

@@ -7,6 +7,7 @@ module Analysis.Abstract.Dead
 ) where
 
 import Control.Abstract
+import Control.Carrier.State.Strict
 import Data.Abstract.Module
 import Data.Semigroup.Reducer as Reducer
 import Data.Set (delete)
@@ -19,11 +20,11 @@ newtype Dead term = Dead { unDead :: Set term }
 deriving instance Ord term => Reducer term (Dead term)
 
 -- | Update the current 'Dead' set.
-killAll :: (Member (State (Dead term)) sig, Carrier sig m) => Dead term -> Evaluator term address value m ()
+killAll :: (Has (State (Dead term)) sig m) => Dead term -> Evaluator term address value m ()
 killAll = put
 
 -- | Revive a single term, removing it from the current 'Dead' set.
-revive :: (Member (State (Dead term)) sig, Carrier sig m, Ord term) => term -> Evaluator term address value m ()
+revive :: (Has (State (Dead term)) sig m, Ord term) => term -> Evaluator term address value m ()
 revive t = modify (Dead . delete t . unDead)
 
 -- | Compute the set of all subterms recursively.
@@ -31,19 +32,17 @@ subterms :: (Ord term, Recursive term, Foldable (Base term)) => term -> Dead ter
 subterms term = term `cons` para (foldMap (uncurry cons)) term
 
 
-revivingTerms :: ( Member (State (Dead term)) sig
-                , Ord term
-                , Carrier sig m
-                )
+revivingTerms :: ( Has (State (Dead term)) sig m
+                 , Ord term
+                 )
               => Open (term -> Evaluator term address value m a)
 revivingTerms recur term = revive term *> recur term
 
 killingModules :: ( Foldable (Base term)
-                 , Member (State (Dead term)) sig
-                 , Ord term
-                 , Recursive term
-                 , Carrier sig m
-                 )
+                  , Has (State (Dead term)) sig m
+                  , Ord term
+                  , Recursive term
+                  )
                => Open (Module term -> Evaluator term address value m a)
 killingModules recur m = killAll (subterms (moduleBody m)) *> recur m
 

src/Analysis/Abstract/Graph.hs

@@ -18,10 +18,12 @@ module Analysis.Abstract.Graph
 
 import           Algebra.Graph.Export.Dot hiding (vertexName)
 import           Control.Abstract hiding (Function(..))
-import           Control.Effect.Carrier
+import           Control.Algebra
+import           Control.Carrier.Reader
+import           Control.Carrier.State.Strict
+import           Control.Effect.Sum.Project
 import           Data.Abstract.BaseError
 import           Data.Abstract.Module (Module (moduleInfo), ModuleInfo (..))
-import           Data.Abstract.Package (PackageInfo (..))
 import           Data.ByteString.Builder
 import           Data.Graph
 import           Data.Graph.ControlFlowVertex
@@ -57,20 +59,19 @@ style = (defaultStyle (T.encodeUtf8Builder . vertexIdentifier))
 
 
 -- | Add vertices to the graph for evaluated identifiers.
-graphingTerms :: ( Member (Reader ModuleInfo) sig
-                 , Member (Reader Span) sig
-                 , Member (State (Graph ControlFlowVertex)) sig
-                 , Member (State (Map (Slot address) ControlFlowVertex)) sig
-                 , Member (State (Heap address address value)) sig
-                 , Member (State (ScopeGraph address)) sig
-                 , Member (Resumable (BaseError (ScopeError address))) sig
-                 , Member (Resumable (BaseError (HeapError address))) sig
-                 , Member (Reader (CurrentFrame address)) sig
-                 , Member (Reader (CurrentScope address)) sig
-                 , Member (Reader ControlFlowVertex) sig
+graphingTerms :: ( Has (Reader ModuleInfo) sig m
+                 , Has (Reader Span) sig m
+                 , Has (State (Graph ControlFlowVertex)) sig m
+                 , Has (State (Map (Slot address) ControlFlowVertex)) sig m
+                 , Has (State (Heap address address value)) sig m
+                 , Has (State (ScopeGraph address)) sig m
+                 , Has (Resumable (BaseError (ScopeError address))) sig m
+                 , Has (Resumable (BaseError (HeapError address))) sig m
+                 , Has (Reader (CurrentFrame address)) sig m
+                 , Has (Reader (CurrentScope address)) sig m
+                 , Has (Reader ControlFlowVertex) sig m
                  , VertexDeclaration term
                  , Ord address
-                 , Carrier sig m
                  )
               => Open (term Loc -> Evaluator (term Loc) address value m a)
 graphingTerms recur term = do
@@ -96,20 +97,18 @@ graphingTerms recur term = do
         pure valRef
 
 -- | Add vertices to the graph for evaluated modules and the packages containing them.
-graphingPackages :: ( Member (Reader PackageInfo) sig
-                    , Member (State (Graph ControlFlowVertex)) sig
-                    , Member (Reader ControlFlowVertex) sig
-                    , Carrier sig m
+graphingPackages :: ( Has (Reader PackageInfo) sig m
+                    , Has (State (Graph ControlFlowVertex)) sig m
+                    , Has (Reader ControlFlowVertex) sig m
                     )
                  => Open (Module term -> m a)
 graphingPackages recur m =
   let v = moduleVertex (moduleInfo m) in packageInclusion v *> local (const v) (recur m)
 
 -- | Add vertices to the graph for imported modules.
-graphingModules :: ( Member (Reader ModuleInfo) sig
-                   , Member (State (Graph ControlFlowVertex)) sig
-                   , Member (Reader ControlFlowVertex) sig
-                   , Carrier sig m
+graphingModules :: ( Has (Reader ModuleInfo) sig m
+                   , Has (State (Graph ControlFlowVertex)) sig m
+                   , Has (Reader ControlFlowVertex) sig m
                    )
                 => (Module body -> Evaluator term address value (EavesdropC address value m) a)
                 -> (Module body -> Evaluator term address value m a)
@@ -129,9 +128,8 @@ graphingModules recur m = do
       in moduleInclusion (moduleVertex (ModuleInfo path' (moduleLanguage info) (moduleOid info)))
 
 -- | Add vertices to the graph for imported modules.
-graphingModuleInfo :: ( Member (Reader ModuleInfo) sig
-                      , Member (State (Graph ModuleInfo)) sig
-                      , Carrier sig m
+graphingModuleInfo :: ( Has (Reader ModuleInfo) sig m
+                      , Has (State (Graph ModuleInfo)) sig m
                       )
                    => (Module body -> Evaluator term address value (EavesdropC address value m) a)
                    -> (Module body -> Evaluator term address value m a)
@@ -154,15 +152,14 @@ newtype EavesdropC address value m a = EavesdropC ((forall x . Modules address v
 runEavesdropC :: (forall x . Modules address value m x -> m ()) -> EavesdropC address value m a -> m a
 runEavesdropC f (EavesdropC m) = m f
 
-instance (Carrier sig m, Member (Modules address value) sig, Applicative m) => Carrier sig (EavesdropC address value m) where
-  eff op
-    | Just eff <- prj op = EavesdropC (\ handler -> let eff' = hmap (runEavesdropC handler) eff in handler eff' *> send eff')
-    | otherwise          = EavesdropC (\ handler -> eff (hmap (runEavesdropC handler) op))
+instance (Has (Modules address value) sig m, Project (Modules address value) sig, Applicative m) => Algebra sig (EavesdropC address value m) where
+  alg op
+    | Just alg <- prj op = EavesdropC (\ handler -> let eff' = hmap (runEavesdropC handler) alg in handler eff' *> send eff')
+    | otherwise          = EavesdropC (\ handler -> alg (hmap (runEavesdropC handler) op))
 
 -- | Add an edge from the current package to the passed vertex.
-packageInclusion :: ( Member (Reader PackageInfo) sig
-                    , Member (State (Graph ControlFlowVertex)) sig
-                    , Carrier sig m
+packageInclusion :: ( Has (Reader PackageInfo) sig m
+                    , Has (State (Graph ControlFlowVertex)) sig m
                     )
                  => ControlFlowVertex
                  -> m ()
@@ -171,9 +168,8 @@ packageInclusion v = do
   appendGraph (vertex (packageVertex p) `connect` vertex v)
 
 -- | Add an edge from the current module to the passed vertex.
-moduleInclusion :: ( Member (Reader ModuleInfo) sig
-                   , Member (State (Graph ControlFlowVertex)) sig
-                   , Carrier sig m
+moduleInclusion :: ( Has (Reader ModuleInfo) sig m
+                   , Has (State (Graph ControlFlowVertex)) sig m
                    )
                 => ControlFlowVertex
                 -> m ()
@@ -182,9 +178,8 @@ moduleInclusion v = do
   appendGraph (vertex (moduleVertex m) `connect` vertex v)
 
 -- | Add an edge from the passed variable name to the context it originated within.
-variableDefinition :: ( Member (State (Graph ControlFlowVertex)) sig
-                      , Member (Reader ControlFlowVertex) sig
-                      , Carrier sig m
+variableDefinition :: ( Has (State (Graph ControlFlowVertex)) sig m
+                      , Has (Reader ControlFlowVertex) sig m
                       )
                    => ControlFlowVertex
                    -> m ()
@@ -192,11 +187,11 @@ variableDefinition var = do
   context <- ask
   appendGraph (vertex context `connect` vertex var)
 
-appendGraph :: (Member (State (Graph v)) sig, Carrier sig m) => Graph v -> m ()
+appendGraph :: Has (State (Graph v)) sig m => Graph v -> m ()
 appendGraph = modify . (<>)
 
 
-graphing :: Carrier sig m
+graphing :: Algebra sig m
          => Evaluator term address value (StateC (Map (Slot address) ControlFlowVertex)
                                          (StateC (Graph ControlFlowVertex)
                                          m)) result

src/Analysis/Abstract/Tracing.hs

@@ -5,36 +5,33 @@ module Analysis.Abstract.Tracing
 ) where
 
 import Control.Abstract hiding (trace)
-import Control.Effect.Writer
+import Control.Carrier.Writer.Strict
 import Data.Semigroup.Reducer as Reducer
 
 -- | Trace analysis.
 --
 --   Instantiating @trace@ to @[]@ yields a linear trace analysis, while @Set@ yields a reachable state analysis.
-tracingTerms :: ( Member (State (Heap address address value)) sig
-               , Member (Writer (trace (Configuration term address value))) sig
-               , Carrier sig m
-               , Reducer (Configuration term address value) (trace (Configuration term address value))
-               )
+tracingTerms :: ( Has (State (Heap address address value)) sig m
+                , Has (Writer (trace (Configuration term address value))) sig m
+                , Reducer (Configuration term address value) (trace (Configuration term address value))
+                )
              => trace (Configuration term address value)
              -> Open (term -> Evaluator term address value m a)
 tracingTerms proxy recur term = getConfiguration term >>= trace . (`asTypeOf` proxy) . Reducer.unit >> recur term
 
-trace :: ( Member (Writer (trace (Configuration term address value))) sig
-        , Carrier sig m
-        )
+trace :: Has (Writer (trace (Configuration term address value))) sig m
       => trace (Configuration term address value)
       -> Evaluator term address value m ()
 trace = tell
 
-tracing :: (Monoid (trace (Configuration term address value)))
+tracing :: Monoid (trace (Configuration term address value))
         => Evaluator term address value (WriterC (trace (Configuration term address value)) (Evaluator term address value m)) a
         -> Evaluator term address value m (trace (Configuration term address value), a)
 tracing = runWriter . runEvaluator
 
 
 -- | Get the current 'Configuration' with a passed-in term.
-getConfiguration :: (Member (State (Heap address address value)) sig, Carrier sig m)
+getConfiguration :: Has (State (Heap address address value)) sig m
                  => term
                  -> Evaluator term address value m (Configuration term address value)
 getConfiguration term = Configuration term <$>  getHeap

src/Assigning/Assignment.hs

@@ -98,7 +98,6 @@ import Data.AST
 import Data.Error
 import qualified Source.Source as Source
 import Data.Term
-import Data.Text (Text)
 import Data.Text.Encoding (decodeUtf8')
 import qualified Source.Loc as L
 import Source.Range as Range

src/Control/Abstract/Context.hs

@@ -22,38 +22,38 @@ import Prologue
 import Source.Span
 
 -- | Get the currently evaluating 'ModuleInfo'.
-currentModule :: (Member (Reader ModuleInfo) sig, Carrier sig m) => m ModuleInfo
+currentModule :: (Has (Reader ModuleInfo) sig m) => m ModuleInfo
 currentModule = ask
 
 -- | Run an action with a locally-replaced 'ModuleInfo'.
-withCurrentModule :: (Member (Reader ModuleInfo) sig, Carrier sig m) => ModuleInfo -> m a -> m a
+withCurrentModule :: Has (Reader ModuleInfo) sig m => ModuleInfo -> m a -> m a
 withCurrentModule = local . const
 
 -- | Get the currently evaluating 'PackageInfo'.
-currentPackage :: (Member (Reader PackageInfo) sig, Carrier sig m) => m PackageInfo
+currentPackage :: Has (Reader PackageInfo) sig m => m PackageInfo
 currentPackage = ask
 
 -- | Run an action with a locally-replaced 'PackageInfo'.
-withCurrentPackage :: (Member (Reader PackageInfo) sig, Carrier sig m) => PackageInfo -> m a -> m a
+withCurrentPackage :: Has (Reader PackageInfo) sig m => PackageInfo -> m a -> m a
 withCurrentPackage = local . const
 
 -- | Get the 'Span' of the currently-evaluating term (if any).
-currentSpan :: (Member (Reader Span) sig, Carrier sig m) => m Span
+currentSpan :: Has (Reader Span) sig m => m Span
 currentSpan = ask
 
 -- | Run an action with a locally-replaced 'Span'.
-withCurrentSpan :: (Member (Reader Span) sig, Carrier sig m) => Span -> m a -> m a
+withCurrentSpan :: Has (Reader Span) sig m => Span -> m a -> m a
 withCurrentSpan = local . const
 
-modifyChildSpan :: (Member (State Span) sig, Carrier sig m) => Span -> m a -> m a
+modifyChildSpan :: Has (State Span) sig m => Span -> m a -> m a
 modifyChildSpan span m = m <* put span
 
 -- | Run an action with locally-replaced 'ModuleInfo' & 'Span' derived from the passed 'SrcLoc'.
-withCurrentSrcLoc :: (Member (Reader ModuleInfo) sig, Member (Reader Span) sig, Carrier sig m) => SrcLoc -> m a -> m a
+withCurrentSrcLoc :: (Has (Reader ModuleInfo) sig m, Has (Reader Span) sig m) => SrcLoc -> m a -> m a
 withCurrentSrcLoc loc = withCurrentModule (moduleInfoFromSrcLoc loc) . withCurrentSpan (spanFromSrcLoc loc)
 
 -- | Run an action with locally replaced 'ModuleInfo' & 'Span' derived from the Haskell call stack.
 --
 --   This is suitable for contextualizing builtins & other functionality intended for use from client code but defined in Haskell source.
-withCurrentCallStack :: (Member (Reader ModuleInfo) sig, Member (Reader Span) sig, Carrier sig m) => CallStack -> m a -> m a
+withCurrentCallStack :: (Has (Reader ModuleInfo) sig m, Has (Reader Span) sig m) => CallStack -> m a -> m a
 withCurrentCallStack = maybe id (withCurrentSrcLoc . snd) . listToMaybe . getCallStack

src/Control/Abstract/Evaluator.hs

@@ -17,7 +17,8 @@ module Control.Abstract.Evaluator
   , module X
   ) where
 
-import Control.Effect.Carrier
+import Control.Algebra
+import Control.Carrier.Error.Either
 import Control.Effect.Error as X
 import Control.Effect.Fresh as X
 import Control.Effect.NonDet as X
@@ -36,8 +37,8 @@ import Data.Coerce
 newtype Evaluator term address value m a = Evaluator { runEvaluator :: m a }
   deriving (Alternative, Applicative, Functor, Monad, MonadIO)
 
-instance Carrier sig m => Carrier sig (Evaluator term address value m) where
-  eff = Evaluator . eff . handleCoercible
+instance Algebra sig m => Algebra sig (Evaluator term address value m) where
+  alg = Evaluator . alg . handleCoercible
 
 -- | Raise a handler on monads into a handler on 'Evaluator's over those monads.
 raiseHandler :: (m a -> n b)
@@ -56,19 +57,17 @@ type Open a = a -> a
 newtype Return value = Return { unReturn :: value }
   deriving (Eq, Ord, Show)
 
-earlyReturn :: ( Member (Error (Return value)) sig
-               , Carrier sig m
-               )
+earlyReturn :: Has (Throw (Return value)) sig m
             => value
             -> Evaluator term address value m value
 earlyReturn = throwError . Return
 
-catchReturn :: (Member (Error (Return value)) sig, Carrier sig m)
+catchReturn :: Has (Catch (Return value)) sig m
             => Evaluator term address value m value
             -> Evaluator term address value m value
 catchReturn = flip catchError (\ (Return value) -> pure value)
 
-runReturn :: Carrier sig m
+runReturn :: Algebra sig m
           => Evaluator term address value (ErrorC (Return value) m) value
           -> Evaluator term address value m value
 runReturn = raiseHandler $ fmap (either unReturn id) . runError
@@ -87,29 +86,27 @@ unLoopControl = \case
   Continue v -> v
   Abort      -> error "unLoopControl: Abort"
 
-throwBreak :: (Member (Error (LoopControl value)) sig, Carrier sig m)
+throwBreak :: Has (Error (LoopControl value)) sig m
            => value
            -> Evaluator term address value m value
 throwBreak = throwError . Break
 
-throwContinue :: (Member (Error (LoopControl value)) sig, Carrier sig m)
+throwContinue :: Has (Error (LoopControl value)) sig m
               => value
               -> Evaluator term address value m value
 throwContinue = throwError . Continue
 
-throwAbort :: forall term address sig m value a . (Member (Error (LoopControl value)) sig, Carrier sig m)
+throwAbort :: forall term address sig m value a . Has (Error (LoopControl value)) sig m
            => Evaluator term address value m a
 throwAbort = throwError (Abort @value)
 
-catchLoopControl :: ( Member (Error (LoopControl value)) sig
-                    , Carrier sig m
-                    )
+catchLoopControl :: Has (Error (LoopControl value)) sig m
                  => Evaluator term address value m a
                  -> (LoopControl value -> Evaluator term address value m a)
                  -> Evaluator term address value m a
 catchLoopControl = catchError
 
-runLoopControl :: Carrier sig m
+runLoopControl :: Algebra sig m
                => Evaluator term address value (ErrorC (LoopControl value) m) value
                -> Evaluator term address value m value
 runLoopControl = raiseHandler $ fmap (either unLoopControl id) . runError

src/Control/Abstract/Heap.hs

@@ -1,4 +1,6 @@
-{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, GADTs, GeneralizedNewtypeDeriving, KindSignatures, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, GADTs, GeneralizedNewtypeDeriving, KindSignatures,
+             RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeOperators,
+             UndecidableInstances #-}
 module Control.Abstract.Heap
 ( Heap
 , HeapError(..)
@@ -47,15 +49,17 @@ import           Control.Abstract.Evaluator
 import           Control.Abstract.Roots
 import           Control.Abstract.ScopeGraph hiding (ScopeError (..))
 import           Control.Abstract.ScopeGraph (ScopeError)
-import           Control.Applicative (Alternative)
-import           Control.Effect.Carrier
+import           Control.Algebra
+import           Control.Carrier.Resumable.Either (SomeError (..))
+import qualified Control.Carrier.Resumable.Either as Either
+import qualified Control.Carrier.Resumable.Resume as With
 import           Data.Abstract.BaseError
 import           Data.Abstract.Heap (Heap, Position (..))
 import qualified Data.Abstract.Heap as Heap
 import           Data.Abstract.Live
 import           Data.Abstract.Module (ModuleInfo)
 import           Data.Abstract.Name
-import           Data.Abstract.ScopeGraph (Kind(..), Path (..), Relation(..), putDeclarationScopeAtPosition)
+import           Data.Abstract.ScopeGraph (Kind (..), Path (..), putDeclarationScopeAtPosition)
 import qualified Data.Map.Strict as Map
 import           Prologue
 import           Source.Span (Span)
@@ -63,13 +67,12 @@ import           Source.Span (Span)
 
 -- | Evaluates an action locally the scope and frame of the given frame address.
 withScopeAndFrame :: ( Ord address
-                     , Member (Reader ModuleInfo) sig
-                     , Member (Reader Span) sig
-                     , Member (Resumable (BaseError (HeapError address))) sig
-                     , Member (Reader (CurrentFrame address)) sig
-                     , Member (Reader (CurrentScope address)) sig
-                     , Member (State (Heap address address value)) sig
-                     , Carrier sig m
+                     , Has (Reader ModuleInfo) sig m
+                     , Has (Reader Span) sig m
+                     , Has (Resumable (BaseError (HeapError address))) sig m
+                     , Has (Reader (CurrentFrame address)) sig m
+                     , Has (Reader (CurrentScope address)) sig m
+                     , Has (State (Heap address address value)) sig m
                      )
                   => address
                   -> Evaluator term address value m a
@@ -80,16 +83,15 @@ withScopeAndFrame address action = do
 
 -- | Evaluates an action locally the scope and frame of the given frame address.
 withLexicalScopeAndFrame :: ( Ord address
-                            , Member (Reader ModuleInfo) sig
-                            , Member (Reader Span) sig
-                            , Member (Resumable (BaseError (HeapError address))) sig
-                            , Member (State (Heap address address value)) sig
-                            , Member (State (ScopeGraph address)) sig
-                            , Member (Reader (CurrentFrame address)) sig
-                            , Member (Reader (CurrentScope address)) sig
-                            , Member (Allocator address) sig
-                            , Member Fresh sig
-                            , Carrier sig m
+                            , Has (Reader ModuleInfo) sig m
+                            , Has (Reader Span) sig m
+                            , Has (Resumable (BaseError (HeapError address))) sig m
+                            , Has (State (Heap address address value)) sig m
+                            , Has (State (ScopeGraph address)) sig m
+                            , Has (Reader (CurrentFrame address)) sig m
+                            , Has (Reader (CurrentScope address)) sig m
+                            , Has (Allocator address) sig m
+                            , Has Fresh sig m
                             )
                          => Evaluator term address value m a
                          -> Evaluator term address value m a
@@ -103,42 +105,39 @@ withLexicalScopeAndFrame action = do
 
 -- | Lookup a scope address for a given frame address.
 scopeLookup :: ( Ord address
-               , Member (Reader ModuleInfo) sig
-               , Member (Reader Span) sig
-               , Member (Resumable (BaseError (HeapError address))) sig
-               , Member (State (Heap address address value)) sig
-               , Carrier sig m
+               , Has (Reader ModuleInfo) sig m
+               , Has (Reader Span) sig m
+               , Has (Resumable (BaseError (HeapError address))) sig m
+               , Has (State (Heap address address value)) sig m
+
                )
             => address
             -> Evaluator term address value m address
 scopeLookup address = maybeM (throwHeapError (LookupAddressError address)) =<< Heap.scopeLookup address <$> getHeap
 
-getHeap :: (Member (State (Heap address address value)) sig, Carrier sig m) => Evaluator term address value m (Heap address address value)
+getHeap :: Has (State (Heap address address value)) sig m => Evaluator term address value m (Heap address address value)
 getHeap = get
 
 -- | Set the heap.
-putHeap :: (Member (State (Heap address address value)) sig, Carrier sig m) => Heap address address value -> Evaluator term address value m ()
+putHeap :: Has (State (Heap address address value)) sig m => Heap address address value -> Evaluator term address value m ()
 putHeap = put
 
 -- | Update the heap.
-modifyHeap :: (Member (State (Heap address address value)) sig, Carrier sig m) => (Heap address address value -> Heap address address value) -> Evaluator term address value m ()
+modifyHeap :: Has (State (Heap address address value)) sig m => (Heap address address value -> Heap address address value) -> Evaluator term address value m ()
 modifyHeap = modify
 
 newtype CurrentFrame address = CurrentFrame { unCurrentFrame :: address }
 
 -- | Retrieve the heap.
-currentFrame :: ( Carrier sig m
-                , Member (Reader (CurrentFrame address)) sig
-                )
+currentFrame :: Has (Reader (CurrentFrame address)) sig m
              => Evaluator term address value m address
 currentFrame = asks unCurrentFrame
 
 
 -- | Inserts a new frame into the heap with the given scope and links.
-newFrame :: ( Carrier sig m
-            , Member (Allocator address) sig
-            , Member Fresh sig
-            , Member (State (Heap address address value)) sig
+newFrame :: ( Has (Allocator address) sig m
+            , Has Fresh sig m
+            , Has (State (Heap address address value)) sig m
             , Ord address
             )
          => address
@@ -151,9 +150,7 @@ newFrame scope links = do
   pure address
 
 -- | Evaluates the action within the frame of the given frame address.
-withFrame :: ( Carrier sig m
-             , Member (Reader (CurrentFrame address)) sig
-             )
+withFrame :: Has (Reader (CurrentFrame address)) sig m
           => address
           -> Evaluator term address value m a -- Not sure about this `sig` here (substituting `sig` for `effects`)
           -> Evaluator term address value m a
@@ -161,17 +158,16 @@ withFrame address = local (const (CurrentFrame address))
 
 -- | Define a declaration and assign the value of an action in the current frame.
 define :: ( HasCallStack
-          , Member (Deref value) sig
-          , Member (Reader ModuleInfo) sig
-          , Member (Reader Span) sig
-          , Member (Reader (CurrentFrame address)) sig
-          , Member (Reader (CurrentScope address)) sig
-          , Member (State (Heap address address value)) sig
-          , Member (State (ScopeGraph address)) sig
-          , Member (Resumable (BaseError (ScopeError address))) sig
-          , Member (Resumable (BaseError (HeapError address))) sig
+          , Has (Deref value) sig m
+          , Has (Reader ModuleInfo) sig m
+          , Has (Reader Span) sig m
+          , Has (Reader (CurrentFrame address)) sig m
+          , Has (Reader (CurrentScope address)) sig m
+          , Has (State (Heap address address value)) sig m
+          , Has (State (ScopeGraph address)) sig m
+          , Has (Resumable (BaseError (ScopeError address))) sig m
+          , Has (Resumable (BaseError (HeapError address))) sig m
           , Ord address
-          , Carrier sig m
           )
        => Declaration
        -> Relation
@@ -186,17 +182,16 @@ define declaration rel accessControl def = withCurrentCallStack callStack $ do
   assign slot value
 
 -- | Associate an empty child scope with a declaration and then locally evaluate the body within an associated frame.
-withChildFrame :: ( Member (Allocator address) sig
-                  , Member (State (Heap address address value)) sig
-                  , Member (State (ScopeGraph address)) sig
-                  , Member (Reader (CurrentFrame address)) sig
-                  , Member (Reader (CurrentScope address)) sig
-                  , Member Fresh sig
-                  , Member (Reader ModuleInfo) sig
-                  , Member (Reader Span) sig
-                  , Member (Resumable (BaseError (HeapError address))) sig
+withChildFrame :: ( Has (Allocator address) sig m
+                  , Has (State (Heap address address value)) sig m
+                  , Has (State (ScopeGraph address)) sig m
+                  , Has (Reader (CurrentFrame address)) sig m
+                  , Has (Reader (CurrentScope address)) sig m
+                  , Has Fresh sig m
+                  , Has (Reader ModuleInfo) sig m
+                  , Has (Reader Span) sig m
+                  , Has (Resumable (BaseError (HeapError address))) sig m
                   , Ord address
-                  , Carrier sig m
                   )
                 => Declaration
                 -> (address -> Evaluator term address value m a)
@@ -208,13 +203,12 @@ withChildFrame declaration body = do
   withScopeAndFrame frame (body frame)
 
 -- | Dereference the given address in the heap, or fail if the address is uninitialized.
-deref :: ( Member (Deref value) sig
-         , Member (Reader ModuleInfo) sig
-         , Member (Reader Span) sig
-         , Member (Resumable (BaseError (AddressError address value))) sig
-         , Member (State (Heap address address value)) sig
+deref :: ( Has (Deref value) sig m
+         , Has (Reader ModuleInfo) sig m
+         , Has (Reader Span) sig m
+         , Has (Resumable (BaseError (AddressError address value))) sig m
+         , Has (State (Heap address address value)) sig m
          , Ord address
-         , Carrier sig m
          )
       => Slot address
       -> Evaluator term address value m value
@@ -224,13 +218,12 @@ deref slot@Slot{..} = do
   eff <- send $ DerefCell slotValue pure
   maybeM (throwAddressError $ UninitializedSlot slot) eff
 
-putSlotDeclarationScope :: ( Member (State (Heap address address value)) sig
-                           , Member (State (ScopeGraph address)) sig
-                           , Member (Resumable (BaseError (HeapError address))) sig
-                           , Member (Reader ModuleInfo) sig
-                           , Member (Reader Span) sig
+putSlotDeclarationScope :: ( Has (State (Heap address address value)) sig m
+                           , Has (State (ScopeGraph address)) sig m
+                           , Has (Resumable (BaseError (HeapError address))) sig m
+                           , Has (Reader ModuleInfo) sig m
+                           , Has (Reader Span) sig m
                            , Ord address
-                           , Carrier sig m
                            )
                         => Slot address
                         -> Maybe address
@@ -240,14 +233,13 @@ putSlotDeclarationScope Slot{..} assocScope = do
   modify (putDeclarationScopeAtPosition scopeAddress position assocScope)
 
 
-maybeLookupDeclaration :: ( Carrier sig m
-                          , Member (Reader (CurrentFrame address)) sig
-                          , Member (Reader (CurrentScope address)) sig
-                          , Member (Reader ModuleInfo) sig
-                          , Member (Reader Span) sig
-                          , Member (Resumable (BaseError (HeapError address))) sig
-                          , Member (State (Heap address address value)) sig
-                          , Member (State (ScopeGraph address)) sig
+maybeLookupDeclaration :: ( Has (Reader (CurrentFrame address)) sig m
+                          , Has (Reader (CurrentScope address)) sig m
+                          , Has (Reader ModuleInfo) sig m
+                          , Has (Reader Span) sig m
+                          , Has (Resumable (BaseError (HeapError address))) sig m
+                          , Has (State (Heap address address value)) sig m
+                          , Has (State (ScopeGraph address)) sig m
                           , Ord address
                           )
                        => Declaration
@@ -260,34 +252,32 @@ maybeLookupDeclaration decl = do
       pure (Just (Slot frameAddress (Heap.pathPosition path)))
     Nothing -> pure Nothing
 
-lookupSlot :: ( Carrier sig m
-                     , Member (Reader (CurrentFrame address)) sig
-                     , Member (Reader (CurrentScope address)) sig
-                     , Member (Reader ModuleInfo) sig
-                     , Member (Reader Span) sig
-                     , Member (Resumable (BaseError (HeapError address))) sig
-                     , Member (Resumable (BaseError (ScopeError address))) sig
-                     , Member (State (Heap address address value)) sig
-                     , Member (State (ScopeGraph address)) sig
-                     , Ord address
-                     )
-                  => Declaration
-                  -> Evaluator term address value m (Slot address)
+lookupSlot :: ( Has (Reader (CurrentFrame address)) sig m
+              , Has (Reader (CurrentScope address)) sig m
+              , Has (Reader ModuleInfo) sig m
+              , Has (Reader Span) sig m
+              , Has (Resumable (BaseError (HeapError address))) sig m
+              , Has (Resumable (BaseError (ScopeError address))) sig m
+              , Has (State (Heap address address value)) sig m
+              , Has (State (ScopeGraph address)) sig m
+              , Ord address
+              )
+           => Declaration
+           -> Evaluator term address value m (Slot address)
 lookupSlot decl = do
   path <- lookupScopePath decl
   frameAddress <- lookupFrameAddress path
   pure (Slot frameAddress (Heap.pathPosition path))
 
-lookupDeclarationFrame :: ( Member (State (Heap address address value)) sig
-                          , Member (State (ScopeGraph address)) sig
-                          , Member (Reader (CurrentFrame address)) sig
-                          , Member (Reader (CurrentScope address)) sig
-                          , Member (Reader ModuleInfo) sig
-                          , Member (Reader Span) sig
-                          , Member (Resumable (BaseError (ScopeError address))) sig
-                          , Member (Resumable (BaseError (HeapError address))) sig
+lookupDeclarationFrame :: ( Has (State (Heap address address value)) sig m
+                          , Has (State (ScopeGraph address)) sig m
+                          , Has (Reader (CurrentFrame address)) sig m
+                          , Has (Reader (CurrentScope address)) sig m
+                          , Has (Reader ModuleInfo) sig m
+                          , Has (Reader Span) sig m
+                          , Has (Resumable (BaseError (ScopeError address))) sig m
+                          , Has (Resumable (BaseError (HeapError address))) sig m
                           , Ord address
-                          , Carrier sig m
                           )
                        => Declaration
                        -> Evaluator term address value m address
@@ -295,12 +285,11 @@ lookupDeclarationFrame decl = do
   path <- lookupScopePath decl
   lookupFrameAddress path
 
-lookupFrame :: ( Member (State (Heap address address value)) sig
-               , Member (Reader ModuleInfo) sig
-               , Member (Reader Span) sig
-               , Member (Resumable (BaseError (HeapError address))) sig
+lookupFrame :: ( Has (State (Heap address address value)) sig m
+               , Has (Reader ModuleInfo) sig m
+               , Has (Reader Span) sig m
+               , Has (Resumable (BaseError (HeapError address))) sig m
                , Ord address
-               , Carrier sig m
                )
              => address
              -> Evaluator term address value m (Heap.Frame address address value)
@@ -309,13 +298,12 @@ lookupFrame address = do
   maybeM (throwHeapError (LookupFrameError address)) (Heap.frameLookup address heap)
 
 -- | Follow a path through the heap and return the frame address associated with the declaration.
-lookupFrameAddress :: ( Member (State (Heap address address value)) sig
-                      , Member (Reader (CurrentFrame address)) sig
-                      , Member (Reader ModuleInfo) sig
-                      , Member (Reader Span) sig
-                      , Member (Resumable (BaseError (HeapError address))) sig
+lookupFrameAddress :: ( Has (State (Heap address address value)) sig m
+                      , Has (Reader (CurrentFrame address)) sig m
+                      , Has (Reader ModuleInfo) sig m
+                      , Has (Reader Span) sig m
+                      , Has (Resumable (BaseError (HeapError address))) sig m
                       , Ord address
-                      , Carrier sig m
                       )
                    => Path address
                    -> Evaluator term address value m address
@@ -331,11 +319,10 @@ lookupFrameAddress path = go path =<< currentFrame
               Map.lookup nextScopeAddress scopeMap
         maybe (throwHeapError $ LookupLinkError p) (go path') frameAddress
 
-frameLinks :: ( Carrier sig m
-              , Member (Reader ModuleInfo) sig
-              , Member (Reader Span) sig
-              , Member (Resumable (BaseError (HeapError address))) sig
-              , Member (State (Heap address address value)) sig
+frameLinks :: ( Has (Reader ModuleInfo) sig m
+              , Has (Reader Span) sig m
+              , Has (Resumable (BaseError (HeapError address))) sig m
+              , Has (State (Heap address address value)) sig m
               , Ord address
               )
            => address
@@ -343,12 +330,11 @@ frameLinks :: ( Carrier sig m
 frameLinks address = maybeM (throwHeapError (LookupLinksError address)) . Heap.frameLinks address =<< getHeap
 
 
-insertFrameLink :: ( Carrier sig m
-                   , Member (Reader (CurrentFrame address)) sig
-                   , Member (Reader ModuleInfo) sig
-                   , Member (Reader Span) sig
-                   , Member (Resumable (BaseError (HeapError address))) sig
-                   , Member (State (Heap address address value)) sig
+insertFrameLink :: ( Has (Reader (CurrentFrame address)) sig m
+                   , Has (Reader ModuleInfo) sig m
+                   , Has (Reader Span) sig m
+                   , Has (Resumable (BaseError (HeapError address))) sig m
+                   , Has (State (Heap address address value)) sig m
                    , Ord address
                    )
                 => EdgeLabel
@@ -364,10 +350,9 @@ insertFrameLink label linkMap = do
 
 
 -- | Write a value to the given frame address in the 'Heap'.
-assign :: ( Member (Deref value) sig
-          , Member (State (Heap address address value)) sig
+assign :: ( Has (Deref value) sig m
+          , Has (State (Heap address address value)) sig m
           , Ord address
-          , Carrier sig m
           )
        => Slot address
        -> value
@@ -377,8 +362,7 @@ assign addr value = do
   cell <- send (AssignCell value (fromMaybe lowerBound (Heap.getSlotValue addr heap)) pure)
   putHeap (Heap.setSlot addr cell heap)
 
-dealloc :: ( Carrier sig m
-           , Member (State (Heap address address value)) sig
+dealloc :: ( Has (State (Heap address address value)) sig m
            , Ord address
            )
         => Slot address
@@ -389,11 +373,10 @@ dealloc addr = modifyHeap (Heap.deleteSlot addr)
 -- Garbage collection
 
 -- | Collect any addresses in the heap not rooted in or reachable from the given 'Live' set.
-gc :: ( Member (State (Heap address address value)) sig
+gc :: ( Has (State (Heap address address value)) sig m
       , Ord address
       , Ord value
       , ValueRoots address value
-      , Carrier sig m
       )
    => Live address                       -- ^ The set of addresses to consider rooted.
    -> Evaluator term address value m ()
@@ -454,23 +437,22 @@ instance Eq address => Eq1 (HeapError address) where
   liftEq _ (LookupFrameError a) (LookupFrameError b)     = a == b
   liftEq _ _ _                                           = False
 
-throwHeapError  :: ( Member (Resumable (BaseError (HeapError address))) sig
-                   , Member (Reader ModuleInfo) sig
-                   , Member (Reader Span) sig
-                   , Carrier sig m
+throwHeapError  :: ( Has (Resumable (BaseError (HeapError address))) sig m
+                   , Has (Reader ModuleInfo) sig m
+                   , Has (Reader Span) sig m
                    )
                 => HeapError address resume
                 -> Evaluator term address value m resume
 throwHeapError = throwBaseError
 
-runHeapError :: Evaluator term address value (ResumableC (BaseError (HeapError address)) m) a
+runHeapError :: Evaluator term address value (Either.ResumableC (BaseError (HeapError address)) m) a
              -> Evaluator term address value m (Either (SomeError (BaseError (HeapError address))) a)
-runHeapError = raiseHandler runResumable
+runHeapError = raiseHandler Either.runResumable
 
 runHeapErrorWith :: (forall resume. (BaseError (HeapError address)) resume -> Evaluator term address value m resume)
-                 -> Evaluator term address value (ResumableWithC (BaseError (HeapError address)) m) a
+                 -> Evaluator term address value (With.ResumableC (BaseError (HeapError address)) m) a
                  -> Evaluator term address value m a
-runHeapErrorWith f = raiseHandler $ runResumableWith (runEvaluator . f)
+runHeapErrorWith f = raiseHandler $ With.runResumable (runEvaluator . f)
 
 data AddressError address value resume where
   UnallocatedSlot   :: Slot address -> AddressError address value (Set value)
@@ -483,22 +465,21 @@ instance Show address => Show1 (AddressError address value) where
 instance Eq address => Eq1 (AddressError address value) where
   liftEq _ (UninitializedSlot a) (UninitializedSlot b) = a == b
   liftEq _ (UnallocatedSlot a)   (UnallocatedSlot b)   = a == b
-  liftEq _ _                        _                        = False
+  liftEq _ _                        _                  = False
 
-throwAddressError :: ( Member (Resumable (BaseError (AddressError address body))) sig
-                     , Member (Reader ModuleInfo) sig
-                     , Member (Reader Span) sig
-                     , Carrier sig m
+throwAddressError :: ( Has (Resumable (BaseError (AddressError address body))) sig m
+                     , Has (Reader ModuleInfo) sig m
+                     , Has (Reader Span) sig m
                      )
                   => AddressError address body resume
                   -> Evaluator term address value m resume
 throwAddressError = throwBaseError
 
-runAddressError :: Evaluator term address value (ResumableC (BaseError (AddressError address value)) m) a
+runAddressError :: Evaluator term address value (Either.ResumableC (BaseError (AddressError address value)) m) a
                 -> Evaluator term address value m (Either (SomeError (BaseError (AddressError address value))) a)
-runAddressError = raiseHandler runResumable
+runAddressError = raiseHandler Either.runResumable
 
 runAddressErrorWith :: (forall resume . (BaseError (AddressError address value)) resume -> Evaluator term address value m resume)
-                    -> Evaluator term address value (ResumableWithC (BaseError (AddressError address value)) m) a
+                    -> Evaluator term address value (With.ResumableC (BaseError (AddressError address value)) m) a
                     -> Evaluator term address value m a
-runAddressErrorWith f = raiseHandler $ runResumableWith (runEvaluator . f)
+runAddressErrorWith f = raiseHandler $ With.runResumable (runEvaluator . f)

src/Control/Abstract/Modules.hs

@@ -1,4 +1,6 @@
-{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving,
+             KindSignatures, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeOperators,
+             UndecidableInstances #-}
 module Control.Abstract.Modules
 ( ModuleResult
 , lookupModule
@@ -19,16 +21,21 @@ module Control.Abstract.Modules
 , ModuleTable
 ) where
 
+import Prologue
+
+import           Control.Algebra
+import           Control.Carrier.Reader
+import qualified Control.Carrier.Resumable.Either as Either
+import qualified Control.Carrier.Resumable.Resume as With
+import qualified Data.Set as Set
+import           Source.Span
+import           System.FilePath.Posix (takeDirectory)
+
 import Control.Abstract.Evaluator
-import Control.Effect.Carrier
 import Data.Abstract.BaseError
 import Data.Abstract.Module
 import Data.Abstract.ModuleTable as ModuleTable
 import Data.Language
-import qualified Data.Set as Set
-import Prologue
-import Source.Span
-import System.FilePath.Posix (takeDirectory)
 
 -- | A scope address, frame address, and value ref.
 --
@@ -36,27 +43,27 @@ import System.FilePath.Posix (takeDirectory)
 type ModuleResult address = (,) (address, address)
 
 -- | Retrieve an evaluated module, if any. @Nothing@ means we’ve never tried to load it, and @Just (env, value)@ indicates the result of a completed load.
-lookupModule :: (Member (Modules address value) sig, Carrier sig m) => ModulePath -> Evaluator term address value m (Maybe (ModuleResult address value))
+lookupModule :: Has (Modules address value) sig m => ModulePath -> Evaluator term address value m (Maybe (ModuleResult address value))
 lookupModule = sendModules . flip Lookup pure
 
 -- | Resolve a list of module paths to a possible module table entry.
-resolve :: (Member (Modules address value) sig, Carrier sig m) => [FilePath] -> Evaluator term address value m (Maybe ModulePath)
+resolve :: Has (Modules address value) sig m => [FilePath] -> Evaluator term address value m (Maybe ModulePath)
 resolve = sendModules . flip Resolve pure
 
-listModulesInDir :: (Member (Modules address value) sig, Carrier sig m) => FilePath -> Evaluator term address value m [ModulePath]
+listModulesInDir :: Has (Modules address value) sig m => FilePath -> Evaluator term address value m [ModulePath]
 listModulesInDir = sendModules . flip List pure
 
 
 -- | Require/import another module by name and return its environment and value.
 --
 -- Looks up the module's name in the cache of evaluated modules first, returns if found, otherwise loads/evaluates the module.
-require :: (Member (Modules address value) sig, Carrier sig m) => ModulePath -> Evaluator term address value m (ModuleResult address value)
+require :: Has (Modules address value) sig m => ModulePath -> Evaluator term address value m (ModuleResult address value)
 require path = lookupModule path >>= maybeM (load path)
 
 -- | Load another module by name and return its environment and value.
 --
 -- Always loads/evaluates.
-load :: (Member (Modules address value) sig, Carrier sig m) => ModulePath -> Evaluator term address value m (ModuleResult address value)
+load :: Has (Modules address value) sig m => ModulePath -> Evaluator term address value m (ModuleResult address value)
 load path = sendModules (Load path pure)
 
 
@@ -71,8 +78,7 @@ instance HFunctor (Modules address value)
 instance Effect   (Modules address value)
 
 
-sendModules :: ( Member (Modules address value) sig
-               , Carrier sig m)
+sendModules :: Has (Modules address value) sig m
             => Modules address value (Evaluator term address value m) return
             -> Evaluator term address value m return
 sendModules = send
@@ -85,21 +91,20 @@ runModules paths = raiseHandler (runReader paths . runModulesC)
 newtype ModulesC address value m a = ModulesC { runModulesC :: ReaderC (Set ModulePath) m a }
   deriving (Alternative, Applicative, Functor, Monad, MonadIO)
 
-instance ( Member (Reader (ModuleTable (Module (ModuleResult address value)))) sig
-         , Member (Resumable (BaseError (LoadError address value))) sig
-         , Carrier sig m
+instance ( Has (Reader (ModuleTable (Module (ModuleResult address value)))) sig m
+         , Has (Resumable (BaseError (LoadError address value))) sig m
          )
-      => Carrier (Modules address value :+: sig) (ModulesC address value m) where
-  eff (L op) = do
+      => Algebra (Modules address value :+: sig) (ModulesC address value m) where
+  alg (L op) = do
     paths <- ModulesC ask
     case op of
       Load    name  k -> askModuleTable >>= maybeM (throwLoadError (ModuleNotFoundError name)) . fmap moduleBody . ModuleTable.lookup name >>= k
       Lookup  path  k -> askModuleTable >>= k . fmap moduleBody . ModuleTable.lookup path
       Resolve names k -> k (find (`Set.member` paths) names)
       List    dir   k -> k (filter ((dir ==) . takeDirectory) (toList paths))
-  eff (R other) = ModulesC (eff (R (handleCoercible other)))
+  alg (R other) = ModulesC (alg (R (handleCoercible other)))
 
-askModuleTable :: (Member (Reader (ModuleTable (Module (ModuleResult address value)))) sig, Carrier sig m) => m (ModuleTable (Module (ModuleResult address value)))
+askModuleTable :: Has (Reader (ModuleTable (Module (ModuleResult address value)))) sig m => m (ModuleTable (Module (ModuleResult address value)))
 askModuleTable = ask
 
 
@@ -114,16 +119,16 @@ instance Show1 (LoadError address value) where
 instance Eq1 (LoadError address value) where
   liftEq _ (ModuleNotFoundError a) (ModuleNotFoundError b) = a == b
 
-runLoadError :: Evaluator term address value (ResumableC (BaseError (LoadError address value)) m) a
-             -> Evaluator term address value m (Either (SomeError (BaseError (LoadError address value))) a)
-runLoadError = raiseHandler runResumable
+runLoadError :: Evaluator term address value (Either.ResumableC (BaseError (LoadError address value)) m) a
+             -> Evaluator term address value m (Either (Either.SomeError (BaseError (LoadError address value))) a)
+runLoadError = raiseHandler Either.runResumable
 
 runLoadErrorWith :: (forall resume . (BaseError (LoadError address value)) resume -> Evaluator term address value m resume)
-                 -> Evaluator term address value (ResumableWithC (BaseError (LoadError address value)) m) a
+                 -> Evaluator term address value (With.ResumableC (BaseError (LoadError address value)) m) a
                  -> Evaluator term address value m a
-runLoadErrorWith f = raiseHandler $ runResumableWith (runEvaluator . f)
+runLoadErrorWith f = raiseHandler $ With.runResumable (runEvaluator . f)
 
-throwLoadError :: (Member (Resumable (BaseError (LoadError address value))) sig, Carrier sig m)
+throwLoadError :: Has (Resumable (BaseError (LoadError address value))) sig m
                => LoadError address value resume
                -> m resume
 throwLoadError err@(ModuleNotFoundError name) = throwResumable $ BaseError (ModuleInfo name Unknown mempty) lowerBound err
@@ -144,22 +149,21 @@ deriving instance Show (ResolutionError b)
 instance Show1 ResolutionError where liftShowsPrec _ _ = showsPrec
 instance Eq1 ResolutionError where
   liftEq _ (NotFoundError a _ l1) (NotFoundError b _ l2) = a == b && l1 == l2
-  liftEq _ (GoImportError a) (GoImportError b) = a == b
-  liftEq _ _ _ = False
+  liftEq _ (GoImportError a) (GoImportError b)           = a == b
+  liftEq _ _ _                                           = False
 
-runResolutionError :: Evaluator term address value (ResumableC (BaseError ResolutionError) m) a
-                   -> Evaluator term address value m (Either (SomeError (BaseError ResolutionError)) a)
-runResolutionError = raiseHandler runResumable
+runResolutionError :: Evaluator term address value (Either.ResumableC (BaseError ResolutionError) m) a
+                   -> Evaluator term address value m (Either (Either.SomeError (BaseError ResolutionError)) a)
+runResolutionError = raiseHandler Either.runResumable
 
 runResolutionErrorWith :: (forall resume . (BaseError ResolutionError) resume -> Evaluator term address value m resume)
-                       -> Evaluator term address value (ResumableWithC (BaseError ResolutionError) m) a
+                       -> Evaluator term address value (With.ResumableC (BaseError ResolutionError) m) a
                        -> Evaluator term address value m a
-runResolutionErrorWith f = raiseHandler $ runResumableWith (runEvaluator . f)
+runResolutionErrorWith f = raiseHandler $ With.runResumable (runEvaluator . f)
 
-throwResolutionError :: ( Member (Reader ModuleInfo) sig
-                        , Member (Reader Span) sig
-                        , Member (Resumable (BaseError ResolutionError)) sig
-                        , Carrier sig m
+throwResolutionError :: ( Has (Reader ModuleInfo) sig m
+                        , Has (Reader Span) sig m
+                        , Has (Resumable (BaseError ResolutionError)) sig m
                         )
                      => ResolutionError resume
                      -> Evaluator term address value m resume

src/Control/Abstract/Primitive.hs

@@ -17,20 +17,19 @@ import Data.Map.Strict as Map
 import Prologue
 
 defineBuiltIn :: ( HasCallStack
-                 , Member (Deref value) sig
-                 , Member (Reader (CurrentFrame address)) sig
-                 , Member (Reader (CurrentScope address)) sig
-                 , Member (Reader ModuleInfo) sig
-                 , Member (Reader Span) sig
-                 , Member (State (Heap address address value)) sig
-                 , Member (State (ScopeGraph address)) sig
-                 , Member (Resumable (BaseError (ScopeError address))) sig
-                 , Member (Resumable (BaseError (HeapError address))) sig
-                 , Member (Function term address value) sig
-                 , Member (Allocator address) sig
-                 , Member Fresh sig
+                 , Has (Deref value) sig m
+                 , Has (Reader (CurrentFrame address)) sig m
+                 , Has (Reader (CurrentScope address)) sig m
+                 , Has (Reader ModuleInfo) sig m
+                 , Has (Reader Span) sig m
+                 , Has (State (Heap address address value)) sig m
+                 , Has (State (ScopeGraph address)) sig m
+                 , Has (Resumable (BaseError (ScopeError address))) sig m
+                 , Has (Resumable (BaseError (HeapError address))) sig m
+                 , Has (Function term address value) sig m
+                 , Has (Allocator address) sig m
+                 , Has Fresh sig m
                  , Ord address
-                 , Carrier sig m
                  )
               => Declaration
               -> Relation
@@ -52,20 +51,19 @@ defineBuiltIn declaration rel accessControl value = withCurrentCallStack callSta
   value <- builtIn associatedScope value
   assign slot value
 
-defineClass :: ( Carrier sig m
-               , HasCallStack
-               , Member (Allocator address) sig
-               , Member (Deref value) sig
-               , Member (Reader ModuleInfo) sig
-               , Member (Reader Span) sig
-               , Member Fresh sig
-               , Member (Reader (CurrentFrame address)) sig
-               , Member (Reader (CurrentScope address)) sig
-               , Member (Resumable (BaseError (HeapError address))) sig
-               , Member (Resumable (BaseError (ScopeError address))) sig
-               , Member (State (Heap address address value)) sig
-               , Member (State (ScopeGraph address)) sig
-               , Member (Unit value) sig
+defineClass :: ( HasCallStack
+               , Has (Allocator address) sig m
+               , Has (Deref value) sig m
+               , Has (Reader ModuleInfo) sig m
+               , Has (Reader Span) sig m
+               , Has Fresh sig m
+               , Has (Reader (CurrentFrame address)) sig m
+               , Has (Reader (CurrentScope address)) sig m
+               , Has (Resumable (BaseError (HeapError address))) sig m
+               , Has (Resumable (BaseError (ScopeError address))) sig m
+               , Has (State (Heap address address value)) sig m
+               , Has (State (ScopeGraph address)) sig m
+               , Has (Unit value) sig m
                , Ord address
                )
             => Declaration
@@ -89,19 +87,18 @@ defineClass declaration superclasses body = void . define declaration Default Pu
     unit
 
 defineNamespace :: ( AbstractValue term address value m
-                   , Carrier sig m
                    , HasCallStack
-                   , Member (Allocator address) sig
-                   , Member (Deref value) sig
-                   , Member (Reader (CurrentFrame address)) sig
-                   , Member (Reader (CurrentScope address)) sig
-                   , Member (Reader ModuleInfo) sig
-                   , Member (Reader Span) sig
-                   , Member (Resumable (BaseError (HeapError address))) sig
-                   , Member Fresh sig
-                   , Member (Resumable (BaseError (ScopeError address))) sig
-                   , Member (State (Heap address address value)) sig
-                   , Member (State (ScopeGraph address)) sig
+                   , Has (Allocator address) sig m
+                   , Has (Deref value) sig m
+                   , Has (Reader (CurrentFrame address)) sig m
+                   , Has (Reader (CurrentScope address)) sig m
+                   , Has (Reader ModuleInfo) sig m
+                   , Has (Reader Span) sig m
+                   , Has (Resumable (BaseError (HeapError address))) sig m
+                   , Has Fresh sig m
+                   , Has (Resumable (BaseError (ScopeError address))) sig m
+                   , Has (State (Heap address address value)) sig m
+                   , Has (State (ScopeGraph address)) sig m
                    , Ord address
                    )
                 => Declaration

src/Control/Abstract/PythonPackage.hs

@@ -3,7 +3,8 @@ module Control.Abstract.PythonPackage
 ( runPythonPackaging, Strategy(..) ) where
 
 import           Control.Abstract as Abstract
-import           Control.Effect.Carrier
+import           Control.Algebra
+import           Control.Effect.Sum.Project
 import           Data.Abstract.Name (name)
 import           Data.Abstract.Path (stripQuotes)
 import           Data.Abstract.Value.Concrete (Value (..))
@@ -24,14 +25,15 @@ newtype PythonPackagingC term address m a = PythonPackagingC { runPythonPackagin
 wrap :: Evaluator term address (Value term address) m a -> PythonPackagingC term address m a
 wrap = PythonPackagingC . runEvaluator
 
-instance ( Carrier sig m
-         , Member (Function term address (Value term address)) sig
-         , Member (State Strategy) sig
-         , Member (Abstract.String (Value term address)) sig
-         , Member (Abstract.Array (Value term address)) sig
+instance ( Algebra sig m
+         , Project (Function term address (Value term address)) sig
+         , Has (Function term address (Value term address)) sig m
+         , Has (State Strategy) sig m
+         , Has (Abstract.String (Value term address)) sig m
+         , Has (Abstract.Array (Value term address)) sig m
          )
-      => Carrier sig (PythonPackagingC term address m) where
-  eff op
+      => Algebra sig (PythonPackagingC term address m) where
+  alg op
     | Just e <- prj op = wrap $ case handleCoercible e of
       Call callName params k -> Evaluator . k =<< do
         case callName of
@@ -55,4 +57,4 @@ instance ( Carrier sig m
       Function name params body scope k -> function name params body scope >>= Evaluator . k
       BuiltIn n b k -> builtIn n b >>= Evaluator . k
       Bind obj value k -> bindThis obj value >>= Evaluator . k
-    | otherwise = PythonPackagingC . eff $ handleCoercible op
+    | otherwise = PythonPackagingC . alg $ handleCoercible op

src/Control/Abstract/Roots.hs

@@ -15,9 +15,9 @@ class ValueRoots address value where
   valueRoots :: value -> Live address
 
 -- | Retrieve the local 'Live' set.
-askRoots :: (Member (Reader (Live address)) sig, Carrier sig m) => Evaluator term address value m (Live address)
+askRoots :: Has (Reader (Live address)) sig m => Evaluator term address value m (Live address)
 askRoots = ask
 
 -- | Run a computation with the given 'Live' set added to the local root set.
-extraRoots :: (Member (Reader (Live address)) sig, Carrier sig m, Ord address) => Live address -> Evaluator term address value m a -> Evaluator term address value m a
+extraRoots :: (Has (Reader (Live address)) sig m, Ord address) => Live address -> Evaluator term address value m a -> Evaluator term address value m a
 extraRoots roots = local (<> roots)

src/Control/Abstract/ScopeGraph.hs

@@ -44,7 +44,9 @@ module Control.Abstract.ScopeGraph
   ) where
 
 import           Control.Abstract.Evaluator hiding (Local)
-import           Control.Effect.Carrier
+import           Control.Algebra
+import qualified Control.Carrier.Resumable.Resume as With
+import qualified Control.Carrier.Resumable.Either as Either
 import           Data.Abstract.BaseError
 import           Data.Abstract.Module
 import           Data.Abstract.Name hiding (name)
@@ -55,16 +57,15 @@ import           Prologue
 import           Source.Span
 
 lookup :: ( Ord address
-          , Member (State (ScopeGraph address)) sig
-          , Carrier sig m)
+          , Has (State (ScopeGraph address)) sig m
+          )
        => Reference
        -> Evaluator term address value m (Maybe address)
 lookup ref = ScopeGraph.scopeOfRef ref <$> get
 
-declare :: ( Carrier sig m
-           , Member (State (ScopeGraph address)) sig
-           , Member (Reader (CurrentScope address)) sig
-           , Member (Reader ModuleInfo) sig
+declare :: ( Has (State (ScopeGraph address)) sig m
+           , Has (Reader (CurrentScope address)) sig m
+           , Has (Reader ModuleInfo) sig m
            , Ord address
            )
         => Declaration
@@ -81,11 +82,10 @@ declare decl rel accessControl span kind scope = do
 
 -- | If the provided name is 'Nothing' we want to reflect that the declaration's name was a generated name (gensym).
 -- We use the 'Gensym' relation to indicate that. Otherwise, we use the provided 'relation'.
-declareMaybeName :: ( Carrier sig m
-                    , Member (State (ScopeGraph address)) sig
-                    , Member (Reader (CurrentScope address)) sig
-                    , Member (Reader ModuleInfo) sig
-                    , Member Fresh sig
+declareMaybeName :: ( Has (State (ScopeGraph address)) sig m
+                    , Has (Reader (CurrentScope address)) sig m
+                    , Has (Reader ModuleInfo) sig m
+                    , Has Fresh sig m
                     , Ord address
                     )
                  => Maybe Name
@@ -101,9 +101,8 @@ declareMaybeName maybeName relation ac span kind scope = do
     _         -> gensym >>= \name -> declare (Declaration name) Gensym ac span kind scope >> pure name
 
 putDeclarationScope :: ( Ord address
-                       , Member (Reader (CurrentScope address)) sig
-                       , Member (State (ScopeGraph address)) sig
-                       , Carrier sig m
+                       , Has (Reader (CurrentScope address)) sig m
+                       , Has (State (ScopeGraph address)) sig m
                        )
                      => Declaration
                      -> address
@@ -114,8 +113,7 @@ putDeclarationScope decl assocScope = do
 
 putDeclarationSpan :: forall address sig m term value .
                       ( Ord address
-                      , Member (State (ScopeGraph address)) sig
-                      , Carrier sig m
+                      , Has (State (ScopeGraph address)) sig m
                       )
                    => Declaration
                    -> Span
@@ -124,10 +122,9 @@ putDeclarationSpan decl = modify @(ScopeGraph address) . ScopeGraph.insertDeclar
 
 reference :: forall address sig m term value .
              ( Ord address
-             , Member (State (ScopeGraph address)) sig
-             , Member (Reader (CurrentScope address)) sig
-             , Member (Reader ModuleInfo) sig
-             , Carrier sig m
+             , Has (State (ScopeGraph address)) sig m
+             , Has (Reader (CurrentScope address)) sig m
+             , Has (Reader ModuleInfo) sig m
              )
           => Reference
           -> Span
@@ -140,26 +137,25 @@ reference ref span kind decl = do
   modify @(ScopeGraph address) (ScopeGraph.reference ref moduleInfo span kind decl currentAddress)
 
 -- | Combinator to insert an export edge from the current scope to the provided scope address.
-insertExportEdge :: (Member (Reader (CurrentScope scopeAddress)) sig, Member (State (ScopeGraph scopeAddress)) sig, Carrier sig m, Ord scopeAddress)
+insertExportEdge :: (Has (Reader (CurrentScope scopeAddress)) sig m, Has (State (ScopeGraph scopeAddress)) sig m, Ord scopeAddress)
                  => scopeAddress
                  -> Evaluator term scopeAddress value m ()
 insertExportEdge = insertEdge ScopeGraph.Export
 
 -- | Combinator to insert an import edge from the current scope to the provided scope address.
-insertImportEdge :: (Member (Reader (CurrentScope scopeAddress)) sig, Member (State (ScopeGraph scopeAddress)) sig, Carrier sig m, Ord scopeAddress)
+insertImportEdge :: (Has (Reader (CurrentScope scopeAddress)) sig m, Has (State (ScopeGraph scopeAddress)) sig m, Ord scopeAddress)
                  => scopeAddress
                  -> Evaluator term scopeAddress value m ()
 insertImportEdge = insertEdge ScopeGraph.Import
 
 -- | Combinator to insert a lexical edge from the current scope to the provided scope address.
-insertLexicalEdge :: (Member (Reader (CurrentScope scopeAddress)) sig, Member (State (ScopeGraph scopeAddress)) sig, Carrier sig m, Ord scopeAddress)
+insertLexicalEdge :: (Has (Reader (CurrentScope scopeAddress)) sig m, Has (State (ScopeGraph scopeAddress)) sig m, Ord scopeAddress)
                   => scopeAddress
                   -> Evaluator term scopeAddress value m ()
 insertLexicalEdge = insertEdge ScopeGraph.Lexical
 
-insertEdge :: ( Member (State (ScopeGraph address)) sig
-              , Member (Reader (CurrentScope address)) sig
-              , Carrier sig m
+insertEdge :: ( Has (State (ScopeGraph address)) sig m
+              , Has (Reader (CurrentScope address)) sig m
               , Ord address)
            => EdgeLabel
            -> address
@@ -169,10 +165,9 @@ insertEdge label target = do
   modify (ScopeGraph.insertEdge label target currentAddress)
 
 -- | Inserts a new scope into the scope graph with the given edges.
-newScope :: ( Member (Allocator address) sig
-            , Member (State (ScopeGraph address)) sig
-            , Member Fresh sig
-            , Carrier sig m
+newScope :: ( Has (Allocator address) sig m
+            , Has (State (ScopeGraph address)) sig m
+            , Has Fresh sig m
             , Ord address
             )
          => Map EdgeLabel [address]
@@ -184,10 +179,9 @@ newScope edges = do
   address <$ modify (ScopeGraph.newScope address edges)
 
 -- | Inserts a new scope into the scope graph with the given edges.
-newPreludeScope :: ( Member (Allocator address) sig
-            , Member (State (ScopeGraph address)) sig
-            , Member Fresh sig
-            , Carrier sig m
+newPreludeScope :: ( Has (Allocator address) sig m
+            , Has (State (ScopeGraph address)) sig m
+            , Has Fresh sig m
             , Ord address
             )
          => Map EdgeLabel [address]
@@ -200,25 +194,21 @@ newPreludeScope edges = do
 
 newtype CurrentScope address = CurrentScope { unCurrentScope :: address }
 
-currentScope :: ( Carrier sig m
-                , Member (Reader (CurrentScope address)) sig
-                )
+currentScope :: Has (Reader (CurrentScope address)) sig m
              => Evaluator term address value m address
 currentScope = asks unCurrentScope
 
-lookupScope :: ( Member (Resumable (BaseError (ScopeError address))) sig
-                , Member (Reader ModuleInfo) sig
-                , Member (Reader Span) sig
-                , Member (State (ScopeGraph address)) sig
-                , Carrier sig m
-                , Ord address
-                )
+lookupScope :: ( Has (Resumable (BaseError (ScopeError address))) sig m
+               , Has (Reader ModuleInfo) sig m
+               , Has (Reader Span) sig m
+               , Has (State (ScopeGraph address)) sig m
+               , Ord address
+               )
             => address
             -> Evaluator term address value m (Scope address)
 lookupScope address = maybeM (throwScopeError LookupScopeError) . ScopeGraph.lookupScope address =<< get
 
-declarationsByRelation :: ( Member (State (ScopeGraph address)) sig
-                          , Carrier sig m
+declarationsByRelation :: ( Has (State (ScopeGraph address)) sig m
                           , Ord address
                           )
                        => address
@@ -226,11 +216,10 @@ declarationsByRelation :: ( Member (State (ScopeGraph address)) sig
                        -> Evaluator term address value m [ Info address ]
 declarationsByRelation scope relation = ScopeGraph.declarationsByRelation scope relation <$> get
 
-declarationByName :: ( Member (Resumable (BaseError (ScopeError address))) sig
-                     , Member (Reader ModuleInfo) sig
-                     , Member (Reader Span) sig
-                     , Member (State (ScopeGraph address)) sig
-                     , Carrier sig m
+declarationByName :: ( Has (Resumable (BaseError (ScopeError address))) sig m
+                     , Has (Reader ModuleInfo) sig m
+                     , Has (Reader Span) sig m
+                     , Has (State (ScopeGraph address)) sig m
                      , Ord address
                      )
                   => address
@@ -240,8 +229,7 @@ declarationByName scope name = do
   scopeGraph <- get
   maybeM (throwScopeError $ DeclarationByNameError name) (ScopeGraph.declarationByName scope name scopeGraph)
 
-declarationsByAccessControl :: ( Member (State (ScopeGraph address)) sig
-                               , Carrier sig m
+declarationsByAccessControl :: ( Has (State (ScopeGraph address)) sig m
                                , Ord address
                                )
                             => address
@@ -249,12 +237,11 @@ declarationsByAccessControl :: ( Member (State (ScopeGraph address)) sig
                             -> Evaluator term address value m [ Info address ]
 declarationsByAccessControl scopeAddress accessControl = ScopeGraph.declarationsByAccessControl scopeAddress accessControl <$> get
 
-insertImportReference :: ( Member (Resumable (BaseError (ScopeError address))) sig
-                        , Member (Reader ModuleInfo) sig
-                        , Member (Reader Span) sig
-                        , Member (State (ScopeGraph address)) sig
-                        , Member (Reader (CurrentScope address)) sig
-                        , Carrier sig m
+insertImportReference :: ( Has (Resumable (BaseError (ScopeError address))) sig m
+                        , Has (Reader ModuleInfo) sig m
+                        , Has (Reader Span) sig m
+                        , Has (State (ScopeGraph address)) sig m
+                        , Has (Reader (CurrentScope address)) sig m
                         , Ord address
                         )
                       => Reference
@@ -271,8 +258,7 @@ insertImportReference ref span kind decl scopeAddress = do
   newScope <- maybeM (throwScopeError ImportReferenceError) (ScopeGraph.insertImportReference ref moduleInfo span kind decl currentAddress scopeGraph scope)
   insertScope scopeAddress newScope
 
-insertScope :: ( Member (State (ScopeGraph address)) sig
-               , Carrier sig m
+insertScope :: ( Has (State (ScopeGraph address)) sig m
                , Ord address
                )
             => address
@@ -280,9 +266,8 @@ insertScope :: ( Member (State (ScopeGraph address)) sig
             -> Evaluator term address value m ()
 insertScope scopeAddress scope = modify (ScopeGraph.insertScope scopeAddress scope)
 
-maybeLookupScopePath :: ( Member (State (ScopeGraph address)) sig
-                        , Member (Reader (CurrentScope address)) sig
-                        , Carrier sig m
+maybeLookupScopePath :: ( Has (State (ScopeGraph address)) sig m
+                        , Has (Reader (CurrentScope address)) sig m
                         , Ord address
                         )
                      => Declaration
@@ -291,27 +276,25 @@ maybeLookupScopePath Declaration{..} = do
   currentAddress <- currentScope
   gets (ScopeGraph.lookupScopePath unDeclaration currentAddress)
 
-lookupScopePath :: ( Member (Resumable (BaseError (ScopeError address))) sig
-                , Member (Reader ModuleInfo) sig
-                , Member (Reader Span) sig
-                , Member (State (ScopeGraph address)) sig
-                , Member (Reader (CurrentScope address)) sig
-                , Carrier sig m
-                , Ord address
-                )
-             => Declaration
-             -> Evaluator term address value m (ScopeGraph.Path address)
+lookupScopePath :: ( Has (Resumable (BaseError (ScopeError address))) sig m
+                   , Has (Reader ModuleInfo) sig m
+                   , Has (Reader Span) sig m
+                   , Has (State (ScopeGraph address)) sig m
+                   , Has (Reader (CurrentScope address)) sig m
+                   , Ord address
+                   )
+                => Declaration
+                -> Evaluator term address value m (ScopeGraph.Path address)
 lookupScopePath decl@Declaration{..} = do
   currentAddress <- currentScope
   scopeGraph <- get
   maybeM (throwScopeError $ LookupPathError decl) (ScopeGraph.lookupScopePath unDeclaration currentAddress scopeGraph)
 
-lookupDeclarationScope :: ( Member (Resumable (BaseError (ScopeError address))) sig
-                          , Member (Reader ModuleInfo) sig
-                          , Member (Reader Span) sig
-                          , Member (State (ScopeGraph address)) sig
-                          , Member (Reader (CurrentScope address)) sig
-                          , Carrier sig m
+lookupDeclarationScope :: ( Has (Resumable (BaseError (ScopeError address))) sig m
+                          , Has (Reader ModuleInfo) sig m
+                          , Has (Reader Span) sig m
+                          , Has (State (ScopeGraph address)) sig m
+                          , Has (Reader (CurrentScope address)) sig m
                           , Ord address
                           )
                        => Declaration
@@ -321,21 +304,18 @@ lookupDeclarationScope decl = do
   currentScope' <- currentScope
   maybeM (throwScopeError $ LookupDeclarationScopeError decl) (ScopeGraph.pathDeclarationScope currentScope' path)
 
-associatedScope :: (Ord address, Member (State (ScopeGraph address)) sig, Carrier sig m) => Declaration -> Evaluator term address value m (Maybe address)
+associatedScope :: (Ord address, Has (State (ScopeGraph address)) sig m) => Declaration -> Evaluator term address value m (Maybe address)
 associatedScope decl = ScopeGraph.associatedScope decl <$> get
 
-withScope :: ( Carrier sig m
-             , Member (Reader (CurrentScope address)) sig
-             )
+withScope :: Has (Reader (CurrentScope address)) sig m
           => address
           -> Evaluator term address value m a
           -> Evaluator term address value m a
 withScope scope = local (const (CurrentScope scope))
 
-throwScopeError :: ( Member (Resumable (BaseError (ScopeError address))) sig
-                   , Member (Reader ModuleInfo) sig
-                   , Member (Reader Span) sig
-                   , Carrier sig m
+throwScopeError :: ( Has (Resumable (BaseError (ScopeError address))) sig m
+                   , Has (Reader ModuleInfo) sig m
+                   , Has (Reader Span) sig m
                    )
                 => ScopeError address resume
                 -> Evaluator term address value m resume
@@ -362,7 +342,7 @@ instance Eq1 (ScopeError address) where
   liftEq _ CurrentScopeError                    CurrentScopeError                   = True
   liftEq _ _                                    _                                   = False
 
-alloc :: (Member (Allocator address) sig, Carrier sig m) => Name -> Evaluator term address value m address
+alloc :: (Has (Allocator address) sig m) => Name -> Evaluator term address value m address
 alloc = send . flip Alloc pure
 
 data Allocator address (m :: * -> *) k
@@ -380,10 +360,10 @@ newtype AllocatorC address m a = AllocatorC { runAllocatorC :: m a }
   deriving (Alternative, Applicative, Functor, Monad)
 
 runScopeErrorWith :: (forall resume . BaseError (ScopeError address) resume -> Evaluator term address value m resume)
-                  -> Evaluator term address value (ResumableWithC (BaseError (ScopeError address)) m) a
+                  -> Evaluator term address value (With.ResumableC (BaseError (ScopeError address)) m) a
                   -> Evaluator term address value m a
-runScopeErrorWith f = raiseHandler $ runResumableWith (runEvaluator . f)
+runScopeErrorWith f = raiseHandler $ With.runResumable (runEvaluator . f)
 
-runScopeError :: Evaluator term address value (ResumableC (BaseError (ScopeError address)) m) a
-              -> Evaluator term address value m (Either (SomeError (BaseError (ScopeError address))) a)
-runScopeError = raiseHandler runResumable
+runScopeError :: Evaluator term address value (Either.ResumableC (BaseError (ScopeError address)) m) a
+              -> Evaluator term address value m (Either (Either.SomeError (BaseError (ScopeError address))) a)
+runScopeError = raiseHandler Either.runResumable

src/Control/Abstract/Value.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, GADTs, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeOperators #-}
+{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, GADTs, GeneralizedNewtypeDeriving, KindSignatures,
+             MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeOperators #-}
 module Control.Abstract.Value
 ( AbstractValue(..)
 , AbstractIntro(..)
@@ -73,8 +74,9 @@ module Control.Abstract.Value
 
 import Control.Abstract.Evaluator
 import Control.Abstract.Heap
-import Control.Abstract.ScopeGraph (Allocator, CurrentScope, Declaration, ScopeGraph)
-import Control.Effect.Carrier
+import Control.Abstract.ScopeGraph (CurrentScope, Declaration, ScopeGraph)
+import Control.Algebra
+import Control.Carrier.Reader
 import Data.Abstract.BaseError
 import Data.Abstract.Module
 import Data.Abstract.Name
@@ -108,7 +110,7 @@ data Comparator
 --
 -- In the concrete domain, introductions & eliminations respectively construct & pattern match against values, while in abstract domains they respectively construct & project finite sets of discrete observations of abstract values. For example, an abstract domain modelling integers as a sign (-, 0, or +) would introduce abstract values by mapping integers to their sign and eliminate them by mapping signs back to some canonical integer, e.g. - -> -1, 0 -> 0, + -> 1.
 
-function :: (Member (Function term address value) sig, Carrier sig m) => Name -> [Name] -> term -> address -> Evaluator term address value m value
+function :: Has (Function term address value) sig m => Name -> [Name] -> term -> address -> Evaluator term address value m value
 function name params body scope = sendFunction (Function name params body scope pure)
 
 data BuiltIn
@@ -116,16 +118,16 @@ data BuiltIn
   | Show
   deriving (Eq, Ord, Show, Generic)
 
-builtIn :: (Member (Function term address value) sig, Carrier sig m) => address -> BuiltIn -> Evaluator term address value m value
+builtIn :: Has (Function term address value) sig m => address -> BuiltIn -> Evaluator term address value m value
 builtIn address = sendFunction . flip (BuiltIn address) pure
 
-call :: (Member (Function term address value) sig, Carrier sig m) => value -> [value] -> Evaluator term address value m value
+call :: Has (Function term address value) sig m => value -> [value] -> Evaluator term address value m value
 call fn args = sendFunction (Call fn args pure)
 
-sendFunction :: (Member (Function term address value) sig, Carrier sig m) => Function term address value (Evaluator term address value m) a -> Evaluator term address value m a
+sendFunction :: Has (Function term address value) sig m => Function term address value (Evaluator term address value m) a -> Evaluator term address value m a
 sendFunction = send
 
-bindThis :: (Member (Function term address value) sig, Carrier sig m) => value -> value -> Evaluator term address value m value
+bindThis :: Has (Function term address value) sig m => value -> value -> Evaluator term address value m value
 bindThis this that = sendFunction (Bind this that pure)
 
 data Function term address value (m :: * -> *) k
@@ -147,15 +149,15 @@ newtype FunctionC term address value m a = FunctionC { runFunctionC :: ReaderC (
   deriving (Alternative, Applicative, Functor, Monad)
 
 -- | Construct a boolean value in the abstract domain.
-boolean :: (Member (Boolean value) sig, Carrier sig m) => Bool -> m value
+boolean :: Has (Boolean value) sig m => Bool -> m value
 boolean = send . flip Boolean pure
 
 -- | Extract a 'Bool' from a given value.
-asBool :: (Member (Boolean value) sig, Carrier sig m) => value -> m Bool
+asBool :: Has (Boolean value) sig m => value -> m Bool
 asBool = send . flip AsBool pure
 
 -- | Eliminate boolean values. TODO: s/boolean/truthy
-ifthenelse :: (Member (Boolean value) sig, Carrier sig m) => value -> m a -> m a -> m a
+ifthenelse :: Has (Boolean value) sig m => value -> m a -> m a -> m a
 ifthenelse v t e = asBool v >>= \ c -> if c then t else e
 
 data Boolean value (m :: * -> *) k
@@ -175,31 +177,30 @@ newtype BooleanC value m a = BooleanC { runBooleanC :: m a }
 
 
 -- | The fundamental looping primitive, built on top of 'ifthenelse'.
-while :: (Member (While value) sig, Carrier sig m)
+while :: Has (While value) sig m
       => Evaluator term address value m value -- ^ Condition
       -> Evaluator term address value m value -- ^ Body
       -> Evaluator term address value m value
 while cond body = send (While cond body pure)
 
 -- | Do-while loop, built on top of while.
-doWhile :: (Member (While value) sig, Carrier sig m)
+doWhile :: Has (While value) sig m
   => Evaluator term address value m value -- ^ Body
   -> Evaluator term address value m value -- ^ Condition
   -> Evaluator term address value m value
 doWhile body cond = body *> while cond body
 
 -- | C-style for loops.
-forLoop :: ( Carrier sig m
-           , Member (Allocator address) sig
-           , Member (Reader ModuleInfo) sig
-           , Member (Reader Span) sig
-           , Member (Resumable (BaseError (HeapError address))) sig
-           , Member (State (Heap address address value)) sig
-           , Member (State (ScopeGraph address)) sig
-           , Member (Reader (CurrentFrame address)) sig
-           , Member (Reader (CurrentScope address)) sig
-           , Member (While value) sig
-           , Member Fresh sig
+forLoop :: ( Has (Allocator address) sig m
+           , Has (Reader ModuleInfo) sig m
+           , Has (Reader Span) sig m
+           , Has (Resumable (BaseError (HeapError address))) sig m
+           , Has (State (Heap address address value)) sig m
+           , Has (State (ScopeGraph address)) sig m
+           , Has (Reader (CurrentFrame address)) sig m
+           , Has (Reader (CurrentScope address)) sig m
+           , Has (While value) sig m
+           , Has Fresh sig m
            , Ord address
            )
   => Evaluator term address value m value -- ^ Initial statement
@@ -224,7 +225,7 @@ newtype WhileC value m a = WhileC { runWhileC :: m a }
   deriving (Alternative, Applicative, Functor, Monad)
 
 -- | Construct an abstract unit value.
-unit :: (Carrier sig m, Member (Unit value) sig) => Evaluator term address value m value
+unit :: Has (Unit value) sig m => Evaluator term address value m value
 unit = send (Unit pure)
 
 newtype Unit value (m :: * -> *) k
@@ -242,11 +243,11 @@ newtype UnitC value m a = UnitC { runUnitC :: m a }
   deriving (Alternative, Applicative, Functor, Monad)
 
 -- | Construct a String value in the abstract domain.
-string :: (Member (String value) sig, Carrier sig m) => Text -> m value
+string :: Has (String value) sig m => Text -> m value
 string t = send (String t pure)
 
 -- | Extract 'Text' from a given value.
-asString :: (Member (String value) sig, Carrier sig m) => value -> m Text
+asString :: Has (String value) sig m => value -> m Text
 asString v = send (AsString v pure)
 
 data String value (m :: * -> *) k
@@ -266,19 +267,19 @@ runString = raiseHandler runStringC
 
 
 -- | Construct an abstract integral value.
-integer :: (Member (Numeric value) sig, Carrier sig m) => Integer -> m value
+integer :: Has (Numeric value) sig m => Integer -> m value
 integer t = send (Integer t pure)
 
 -- | Construct a floating-point value.
-float :: (Member (Numeric value) sig, Carrier sig m) => Scientific -> m value
+float :: Has (Numeric value) sig m => Scientific -> m value
 float t = send (Float t pure)
 
 -- | Construct a rational value.
-rational :: (Member (Numeric value) sig, Carrier sig m) => Rational -> m value
+rational :: Has (Numeric value) sig m => Rational -> m value
 rational t = send (Rational t pure)
 
 -- | Lift a unary operator over a 'Num' to a function on 'value's.
-liftNumeric  :: (Member (Numeric value) sig, Carrier sig m)
+liftNumeric  :: Has (Numeric value) sig m
              => (forall a . Num a => a -> a)
              -> value
              -> m value
@@ -288,7 +289,7 @@ liftNumeric t v = send (LiftNumeric (NumericFunction t) v pure)
 --   You usually pass the same operator as both arguments, except in the cases where
 --   Haskell provides different functions for integral and fractional operations, such
 --   as division, exponentiation, and modulus.
-liftNumeric2 :: (Member (Numeric value) sig, Carrier sig m)
+liftNumeric2 :: Has (Numeric value) sig m
              => (forall a b. Number a -> Number b -> SomeNumber)
              -> value
              -> value
@@ -319,11 +320,11 @@ runNumeric = raiseHandler runNumericC
 
 
 -- | Cast numbers to integers
-castToInteger :: (Member (Bitwise value) sig, Carrier sig m) => value -> m value
+castToInteger :: Has (Bitwise value) sig m => value -> m value
 castToInteger t = send (CastToInteger t pure)
 
 -- | Lift a unary bitwise operator to values. This is usually 'complement'.
-liftBitwise :: (Member (Bitwise value) sig, Carrier sig m)
+liftBitwise :: Has (Bitwise value) sig m
             => (forall a . Bits a => a -> a)
             -> value
             -> m value
@@ -332,14 +333,14 @@ liftBitwise t v = send (LiftBitwise (BitwiseFunction t) v pure)
 -- | Lift a binary bitwise operator to values. The Integral constraint is
 --   necessary to satisfy implementation details of Haskell left/right shift,
 --   but it's fine, since these are only ever operating on integral values.
-liftBitwise2 :: (Member (Bitwise value) sig, Carrier sig m)
+liftBitwise2 :: Has (Bitwise value) sig m
              => (forall a . (Integral a, Bits a) => a -> a -> a)
              -> value
              -> value
              -> m value
 liftBitwise2 t v1 v2 = send (LiftBitwise2 (Bitwise2Function t) v1 v2 pure)
 
-unsignedRShift :: (Member (Bitwise value) sig, Carrier sig m)
+unsignedRShift :: Has (Bitwise value) sig m
                => value
                -> value
                -> m value
@@ -366,17 +367,17 @@ runBitwise = raiseHandler runBitwiseC
 newtype BitwiseC value m a = BitwiseC { runBitwiseC :: m a }
   deriving (Alternative, Applicative, Functor, Monad)
 
-object :: (Member (Object address value) sig, Carrier sig m) => address -> m value
+object :: Has (Object address value) sig m => address -> m value
 object address = send (Object address pure)
 
 -- | Extract the environment from any scoped object (e.g. classes, namespaces, etc).
-scopedEnvironment :: (Member (Object address value) sig, Carrier sig m) => value -> m (Maybe address)
+scopedEnvironment :: Has (Object address value) sig m => value -> m (Maybe address)
 scopedEnvironment value = send (ScopedEnvironment value pure)
 
 -- | Build a class value from a name and environment.
 -- declaration is the new class's identifier
 -- address is the environment to capture
-klass :: (Member (Object address value) sig, Carrier sig m) => Declaration -> address -> m value
+klass :: Has (Object address value) sig m => Declaration -> address -> m value
 klass d a = send (Klass d a pure)
 
 data Object address value m k
@@ -396,10 +397,10 @@ runObject :: Evaluator term address value (ObjectC address value m) a
 runObject = raiseHandler runObjectC
 
 -- | Construct an array of zero or more values.
-array :: (Member (Array value) sig, Carrier sig m) => [value] -> m value
+array :: Has (Array value) sig m => [value] -> m value
 array v = send (Array v pure)
 
-asArray :: (Member (Array value) sig, Carrier sig m) => value -> m [value]
+asArray :: Has (Array value) sig m => value -> m [value]
 asArray v = send (AsArray v pure)
 
 data Array value (m :: * -> *) k
@@ -418,11 +419,11 @@ runArray :: Evaluator term address value (ArrayC value m) a
 runArray = raiseHandler runArrayC
 
 -- | Construct a hash out of pairs.
-hash :: (Member (Hash value) sig, Carrier sig m) => [(value, value)] -> m value
+hash :: Has (Hash value) sig m => [(value, value)] -> m value
 hash v = send (Hash v pure)
 
 -- | Construct a key-value pair for use in a hash.
-kvPair :: (Member (Hash value) sig, Carrier sig m) => value -> value -> m value
+kvPair :: Has (Hash value) sig m => value -> value -> m value
 kvPair v1 v2 = send (KvPair v1 v2 pure)
 
 data Hash value (m :: * -> *) k

src/Control/Carrier/Parse/Measured.hs

@@ -1,17 +1,17 @@
 {-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RecordWildCards, TypeOperators, UndecidableInstances #-}
 -- | A carrier for 'Parse' effects suitable for use in production.
 module Control.Carrier.Parse.Measured
-( -- * Parse effect
-  module Control.Effect.Parse
-  -- * Parse carrier
-, ParseC(..)
+( -- * Parse carrier
+  ParseC(..)
   -- * Exceptions
 , ParserCancelled(..)
+  -- * Parse effect
+, module Control.Effect.Parse
 ) where
 
 import qualified Assigning.Assignment as Assignment
+import           Control.Algebra
 import           Control.Effect.Error
-import           Control.Effect.Carrier
 import           Control.Effect.Parse
 import           Control.Effect.Reader
 import           Control.Effect.Trace
@@ -32,22 +32,21 @@ import           Semantic.Timeout
 import           Source.Source (Source)
 
 newtype ParseC m a = ParseC { runParse :: m a }
-  deriving (Applicative, Functor, Monad, MonadIO)
+  deriving (Applicative, Functor, Monad, MonadFail, MonadIO)
 
-instance ( Carrier sig m
-         , Member (Error SomeException) sig
-         , Member (Reader TaskSession) sig
-         , Member Telemetry sig
-         , Member Timeout sig
-         , Member Trace sig
+instance ( Has (Error SomeException) sig m
+         , Has (Reader TaskSession) sig m
+         , Has Telemetry sig m
+         , Has Timeout sig m
+         , Has Trace sig m
          , MonadIO m
          )
-      => Carrier (Parse :+: sig) (ParseC m) where
-  eff (L (Parse parser blob k)) = runParser blob parser >>= k
-  eff (R other) = ParseC (eff (handleCoercible other))
+      => Algebra (Parse :+: sig) (ParseC m) where
+  alg (L (Parse parser blob k)) = runParser blob parser >>= k
+  alg (R other) = ParseC (alg (handleCoercible other))
 
 -- | Parse a 'Blob' in 'IO'.
-runParser :: (Member (Error SomeException) sig, Member (Reader TaskSession) sig, Member Telemetry sig, Member Timeout sig, Member Trace sig, Carrier sig m, MonadIO m)
+runParser :: (Has (Error SomeException) sig m, Has (Reader TaskSession) sig m, Has Telemetry sig m, Has Timeout sig m, Has Trace sig m, MonadIO m)
           => Blob
           -> Parser term
           -> m term
@@ -81,12 +80,11 @@ instance Exception ParserCancelled
 runAssignment
   :: ( Foldable term
      , Syntax.HasErrors term
-     , Member (Error SomeException) sig
-     , Member (Reader TaskSession) sig
-     , Member Telemetry sig
-     , Member Timeout sig
-     , Member Trace sig
-     , Carrier sig m
+     , Has (Error SomeException) sig m
+     , Has (Reader TaskSession) sig m
+     , Has Telemetry sig m
+     , Has Timeout sig m
+     , Has Trace sig m
      , MonadIO m
      )
   => (Source -> assignment (term Assignment.Loc) -> ast -> Either (Error.Error String) (term Assignment.Loc))
@@ -137,7 +135,7 @@ runAssignment assign parser blob@Blob{..} assignment = do
 
 
 -- | Log an 'Error.Error' at the specified 'Level'.
-logError :: (Member Telemetry sig, Carrier sig m)
+logError :: Has Telemetry sig m
          => TaskSession
          -> Level
          -> Blob

src/Control/Carrier/Parse/Simple.hs

@@ -1,20 +1,21 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RecordWildCards, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, MultiParamTypeClasses,
+             RecordWildCards, TypeOperators, UndecidableInstances #-}
 -- | A carrier for 'Parse' effects suitable for use in the repl, tests, etc.
 module Control.Carrier.Parse.Simple
-( -- * Parse effect
-  module Control.Effect.Parse
-  -- * Parse carrier
-, ParseC(..)
+( -- * Parse carrier
+  ParseC(..)
 , runParse
   -- * Exceptions
 , ParseFailure(..)
+  -- * Parse effect
+, module Control.Effect.Parse
 ) where
 
 import qualified Assigning.Assignment as Assignment
+import           Control.Algebra
+import           Control.Carrier.Reader
 import           Control.Effect.Error
-import           Control.Effect.Carrier
 import           Control.Effect.Parse
-import           Control.Effect.Reader
 import           Control.Exception
 import           Control.Monad.IO.Class
 import           Data.Blob
@@ -23,23 +24,21 @@ import           Parsing.Parser
 import           Parsing.TreeSitter
 
 runParse :: Duration -> ParseC m a -> m a
-runParse timeout = runReader timeout . runParseC
+runParse timeout (ParseC m) = runReader timeout m
 
-newtype ParseC m a = ParseC { runParseC :: ReaderC Duration m a }
-  deriving (Applicative, Functor, Monad, MonadIO)
+newtype ParseC m a = ParseC (ReaderC Duration m a)
+  deriving (Applicative, Functor, Monad, MonadFail, MonadIO)
 
-instance ( Carrier sig m
-         , Member (Error SomeException) sig
+instance ( Has (Error SomeException) sig m
          , MonadIO m
          )
-      => Carrier (Parse :+: sig) (ParseC m) where
-  eff (L (Parse parser blob k)) = ParseC ask >>= \ timeout -> runParser timeout blob parser >>= k
-  eff (R other) = ParseC (send (handleCoercible other))
+      => Algebra (Parse :+: sig) (ParseC m) where
+  alg (L (Parse parser blob k)) = ParseC ask >>= \ timeout -> runParser timeout blob parser >>= k
+  alg (R other)                 = ParseC (send (handleCoercible other))
 
 -- | Parse a 'Blob' in 'IO'.
 runParser
-  :: ( Carrier sig m
-     , Member (Error SomeException) sig
+  :: ( Has (Error SomeException) sig m
      , MonadIO m
      )
   => Duration

src/Control/Effect/Interpose.hs

@@ -8,8 +8,9 @@ module Control.Effect.Interpose
 ) where
 
 import Control.Applicative
-import Control.Effect.Carrier
-import Control.Effect.Reader
+import Control.Algebra
+import Control.Carrier.Reader
+import Control.Effect.Sum.Project
 
 data Interpose (eff :: (* -> *) -> * -> *) m k
   = forall a . Interpose (m a) (forall n x . eff n x -> m x) (a -> m k)
@@ -24,7 +25,7 @@ instance HFunctor (Interpose eff) where
 --   The intercepted effects are not re-sent in the surrounding context; thus, the innermost nested 'interpose' listening for an effect will win, and the effect’s own handler will not get the chance to service the request.
 --
 --   Note that since 'Interpose' lacks an 'Effect' instance, only “pure” effects, i.e. effects which can be handled inside other effects using 'hmap' alone, can be run within the 'runInterpose' scope. This includes @Reader@, but not e.g. @State@ or @Error@.
-interpose :: (Member (Interpose eff) sig, Carrier sig m)
+interpose :: Has (Interpose eff) sig m
           => m a
           -> (forall n x . eff n x -> m x)
           -> m a
@@ -46,11 +47,11 @@ newtype Listener (eff :: (* -> *) -> * -> *) m = Listener (forall n x . eff n x
 runListener :: Listener eff (InterposeC eff m) -> eff (InterposeC eff m) a -> InterposeC eff m a
 runListener (Listener listen) = listen
 
-instance (Carrier sig m, Member eff sig) => Carrier (Interpose eff :+: sig) (InterposeC eff m) where
-  eff (L (Interpose m h k)) =
+instance (Has eff sig m, Project eff sig) => Algebra (Interpose eff :+: sig) (InterposeC eff m) where
+  alg (L (Interpose m h k)) =
     InterposeC (local (const (Just (Listener h))) (runInterposeC m)) >>= k
-  eff (R other) = do
+  alg (R other) = do
     listener <- InterposeC ask
     case (listener, prj other) of
       (Just listener, Just eff) -> runListener listener eff
-      _                         -> InterposeC (eff (R (handleCoercible other)))
+      _                         -> InterposeC (alg (R (handleCoercible other)))

src/Control/Effect/Parse.hs

@@ -7,9 +7,13 @@ module Control.Effect.Parse
 , parserForBlob
 , parseWith
 , parsePairWith
+  -- * Re-exports
+, Algebra
+, Has
+, run
 ) where
 
-import Control.Effect.Carrier
+import Control.Algebra
 import Control.Effect.Error
 import Control.Exception (SomeException)
 import Data.Bitraversable
@@ -28,11 +32,11 @@ instance HFunctor Parse where
   hmap f (Parse parser blob k) = Parse parser blob (f . k)
 
 instance Effect Parse where
-  handle state handler (Parse parser blob k) = Parse parser blob (handler . (<$ state) . k)
+  thread state handler (Parse parser blob k) = Parse parser blob (handler . (<$ state) . k)
 
 
 -- | Parse a 'Blob' with the given 'Parser'.
-parse :: (Member Parse sig, Carrier sig m)
+parse :: Has Parse sig m
       => Parser term
       -> Blob
       -> m term
@@ -50,7 +54,7 @@ parserForBlob parsers = parserForLanguage parsers . blobLanguage
 
 -- | Parse a 'Blob' with one of the provided parsers, and run an action on the abstracted term.
 parseWith
-  :: (Carrier sig m, Member (Error SomeException) sig, Member Parse sig)
+  :: (Has (Error SomeException) sig m, Has Parse sig m)
   => Map.Map Language (SomeParser c ann)       -- ^ The set of parsers to select from.
   -> (forall term . c term => term ann -> m a) -- ^ A function to run on the parsed term. Note that the term is abstract, but constrained by @c@, allowing you to do anything @c@ allows, and requiring that all the input parsers produce terms supporting @c@.
   -> Blob                                      -- ^ The blob to parse.
@@ -61,7 +65,7 @@ parseWith parsers with blob = case parserForBlob parsers blob of
 
 -- | Parse a 'BlobPair' with one of the provided parsers, and run an action on the abstracted term pair.
 parsePairWith
-  :: (Carrier sig m, Member (Error SomeException) sig, Member Parse sig)
+  :: (Has (Error SomeException) sig m, Has Parse sig m)
   => Map.Map Language (SomeParser c ann)                                     -- ^ The set of parsers to select from.
   -> (forall term . c term => Edit (Blob, term ann) (Blob, term ann) -> m a) -- ^ A function to run on the parsed terms. Note that the terms are abstract, but constrained by @c@, allowing you to do anything @c@ allows, and requiring that all the input parsers produce terms supporting @c@.
   -> BlobPair                                                                -- ^ The blob pair to parse.

src/Control/Effect/REPL.hs

@@ -10,8 +10,8 @@ module Control.Effect.REPL
 
 import Prologue
 
-import Control.Effect.Carrier
-import Control.Effect.Reader
+import Control.Algebra
+import Control.Carrier.Reader
 import System.Console.Haskeline
 import qualified Data.Text as T
 
@@ -23,10 +23,10 @@ data REPL (m :: * -> *) k
 instance HFunctor REPL
 instance Effect   REPL
 
-prompt :: (Member REPL sig, Carrier sig m) => Text -> m (Maybe Text)
+prompt :: Has REPL sig m => Text -> m (Maybe Text)
 prompt p = send (Prompt p pure)
 
-output :: (Member REPL sig, Carrier sig m) => Text -> m ()
+output :: Has REPL sig m => Text -> m ()
 output s = send (Output s (pure ()))
 
 runREPL :: Prefs -> Settings IO -> REPLC m a -> m a
@@ -35,13 +35,13 @@ runREPL prefs settings = runReader (prefs, settings) . runREPLC
 newtype REPLC m a = REPLC { runREPLC :: ReaderC (Prefs, Settings IO) m a }
   deriving (Functor, Applicative, Monad, MonadIO)
 
-instance (Carrier sig m, MonadIO m) => Carrier (REPL :+: sig) (REPLC m) where
-  eff (L op) = do
+instance (Algebra sig m, MonadIO m) => Algebra (REPL :+: sig) (REPLC m) where
+  alg (L op) = do
     args <- REPLC ask
     case op of
       Prompt p k -> liftIO (uncurry runInputTWithPrefs args (fmap (fmap T.pack) (getInputLine (cyan <> T.unpack p <> plain)))) >>= k
       Output s k -> liftIO (uncurry runInputTWithPrefs args (outputStrLn (T.unpack s))) *> k
-  eff (R other) = REPLC (eff (R (handleCoercible other)))
+  alg (R other) = REPLC (alg (R (handleCoercible other)))
 
 
 cyan :: String

src/Control/Effect/Sum/Project.hs

@@ -0,0 +1,21 @@
+{-# LANGUAGE FlexibleInstances, KindSignatures, MultiParamTypeClasses, TypeOperators #-}
+
+module Control.Effect.Sum.Project
+( Project (..)
+) where
+
+import Control.Effect.Sum
+
+class Member sub sup => Project (sub :: (* -> *) -> (* -> *)) sup where
+  prj :: sup m a -> Maybe (sub m a)
+
+instance Project sub sub where
+  prj = Just
+
+instance {-# OVERLAPPABLE #-} Project sub (sub :+: sup) where
+  prj (L f) = Just f
+  prj _     = Nothing
+
+instance {-# OVERLAPPABLE #-} Project sub sup => Project sub (sub' :+: sup) where
+  prj (R g) = prj g
+  prj _     = Nothing

src/Data/Abstract/Address/Hole.hs

@@ -5,7 +5,7 @@ module Data.Abstract.Address.Hole
 ) where
 
 import Control.Abstract
-import Control.Effect.Carrier
+import Control.Algebra
 import Prologue
 
 data Hole context a = Partial context | Total a
@@ -22,21 +22,21 @@ toMaybe (Total a)   = Just a
 promoteA :: AllocatorC address m a -> AllocatorC (Hole context address) m a
 promoteA = AllocatorC . runAllocatorC
 
-instance ( Carrier (Allocator address :+: sig) (AllocatorC address m)
-         , Carrier sig m
+instance ( Algebra (Allocator address :+: sig) (AllocatorC address m)
+         , Algebra sig m
          , Monad m
          )
-      => Carrier (Allocator (Hole context address) :+: sig) (AllocatorC (Hole context address) m) where
-  eff (R other) = AllocatorC . eff . handleCoercible $ other
-  eff (L (Alloc name k)) = Total <$> promoteA (eff (L (Alloc name pure))) >>= k
+      => Algebra (Allocator (Hole context address) :+: sig) (AllocatorC (Hole context address) m) where
+  alg (R other) = AllocatorC . alg . handleCoercible $ other
+  alg (L (Alloc name k)) = Total <$> promoteA (alg (L (Alloc name pure))) >>= k
 
 
 promoteD :: DerefC address value m a -> DerefC (Hole context address) value m a
 promoteD = DerefC . runDerefC
 
-instance (Carrier (Deref value :+: sig) (DerefC address value m), Carrier sig m)
-      => Carrier (Deref value :+: sig) (DerefC (Hole context address) value m) where
-  eff (R other) = DerefC . eff . handleCoercible $ other
-  eff (L op) = case op of
-    DerefCell        cell k -> promoteD (eff (L (DerefCell        cell pure))) >>= k
-    AssignCell value cell k -> promoteD (eff (L (AssignCell value cell pure))) >>= k
+instance (Algebra (Deref value :+: sig) (DerefC address value m), Algebra sig m)
+      => Algebra (Deref value :+: sig) (DerefC (Hole context address) value m) where
+  alg (R other) = DerefC . alg . handleCoercible $ other
+  alg (L op) = case op of
+    DerefCell        cell k -> promoteD (alg (L (DerefCell        cell pure))) >>= k
+    AssignCell value cell k -> promoteD (alg (L (AssignCell value cell pure))) >>= k

src/Data/Abstract/Address/Monovariant.hs

@@ -3,11 +3,12 @@ module Data.Abstract.Address.Monovariant
 ( Monovariant(..)
 ) where
 
+import Prologue
+
 import Control.Abstract
-import Control.Effect.Carrier
+import Control.Algebra
 import Data.Abstract.Name
 import qualified Data.Set as Set
-import Prologue
 
 -- | 'Monovariant' models using one address for a particular name. It tracks the set of values that a particular address takes and uses it's name to lookup in the store and only allocation if new.
 newtype Monovariant = Monovariant { unMonovariant :: Name }
@@ -17,11 +18,11 @@ instance Show Monovariant where
   showsPrec d = showsUnaryWith showsPrec "Monovariant" d . unMonovariant
 
 
-instance Carrier sig m => Carrier (Allocator Monovariant :+: sig) (AllocatorC Monovariant m) where
-  eff (L (Alloc name k)) = k (Monovariant name)
-  eff (R other) = AllocatorC . eff . handleCoercible $ other
+instance Algebra sig m => Algebra (Allocator Monovariant :+: sig) (AllocatorC Monovariant m) where
+  alg (L (Alloc name k)) = k (Monovariant name)
+  alg (R other) = AllocatorC . alg . handleCoercible $ other
 
-instance (Ord value, Carrier sig m, Alternative m, Monad m) => Carrier (Deref value :+: sig) (DerefC Monovariant value m) where
-  eff (L (DerefCell cell k)) = traverse (foldMapA pure) (nonEmpty (toList cell)) >>= k
-  eff (L (AssignCell value cell k)) = k (Set.insert value cell)
-  eff (R other) = DerefC . eff . handleCoercible $ other
+instance (Ord value, Algebra sig m, Alternative m, Monad m) => Algebra (Deref value :+: sig) (DerefC Monovariant value m) where
+  alg (L (DerefCell cell k)) = traverse (foldMapA pure) (nonEmpty (toList cell)) >>= k
+  alg (L (AssignCell value cell k)) = k (Set.insert value cell)
+  alg (R other) = DerefC . alg . handleCoercible $ other

src/Data/Abstract/Address/Precise.hs

@@ -3,11 +3,10 @@ module Data.Abstract.Address.Precise
 ( Precise(..)
 ) where
 
-import Control.Abstract
-import Control.Abstract.ScopeGraph (AllocatorC(..))
-import Control.Effect.Carrier
+import           Control.Abstract
+import           Control.Algebra
 import qualified Data.Set as Set
-import Prologue
+import           Prologue
 
 -- | 'Precise' models precise store semantics where only the 'Latest' value is taken. Everything gets it's own address (always makes a new allocation) which makes for a larger store.
 newtype Precise = Precise { unPrecise :: Int }
@@ -17,13 +16,13 @@ instance Show Precise where
   showsPrec d = showsUnaryWith showsPrec "Precise" d . unPrecise
 
 
-instance (Member Fresh sig, Carrier sig m) => Carrier (Allocator Precise :+: sig) (AllocatorC Precise m) where
-  eff (R other) = AllocatorC . eff . handleCoercible $ other
-  eff (L (Alloc _ k)) = Precise <$> fresh >>= k
+instance Has Fresh sig m => Algebra (Allocator Precise :+: sig) (AllocatorC Precise m) where
+  alg (R other)       = AllocatorC . alg . handleCoercible $ other
+  alg (L (Alloc _ k)) = Precise <$> fresh >>= k
 
 
-instance Carrier sig m => Carrier (Deref value :+: sig) (DerefC Precise value m) where
-  eff (R other) = DerefC . eff . handleCoercible $ other
-  eff (L op) = case op of
+instance Algebra sig m => Algebra (Deref value :+: sig) (DerefC Precise value m) where
+  alg (R other) = DerefC . alg . handleCoercible $ other
+  alg (L op) = case op of
     DerefCell        cell k -> k (fst <$> Set.minView cell)
     AssignCell value _    k -> k (Set.singleton value)

src/Data/Abstract/BaseError.hs

@@ -28,10 +28,9 @@ instance (Eq1 exc) => Eq1 (BaseError exc) where
 instance Show1 exc => Show1 (BaseError exc) where
   liftShowsPrec sl sp d (BaseError info span exc) = showParen (d > 10) $ showString "BaseError" . showChar ' ' . showsPrec 11 info . showChar ' ' . showsPrec 11 span . showChar ' ' . liftShowsPrec sl sp 11 exc
 
-throwBaseError :: ( Member (Resumable (BaseError exc)) sig
-                  , Member (Reader M.ModuleInfo) sig
-                  , Member (Reader S.Span) sig
-                  , Carrier sig m
+throwBaseError :: ( Has (Resumable (BaseError exc)) sig m
+                  , Has (Reader M.ModuleInfo) sig m
+                  , Has (Reader S.Span) sig m
                   )
                 => exc resume
                 -> m resume

src/Data/Abstract/Evaluatable.hs

@@ -17,6 +17,15 @@ module Data.Abstract.Evaluatable
 , throwUnspecializedError
 ) where
 
+import Prologue
+
+import           Control.Algebra
+import qualified Control.Carrier.Resumable.Either as Either
+import qualified Control.Carrier.Resumable.Resume as With
+import           Data.Scientific (Scientific)
+import           Data.Semigroup.Foldable
+import           Source.Span (HasSpan(..))
+
 import Control.Abstract hiding (Load, String)
 import qualified Control.Abstract as Abstract
 import Control.Abstract.Context as X
@@ -29,56 +38,49 @@ import Data.Abstract.FreeVariables as X
 import Data.Abstract.Module
 import Data.Abstract.Name as X
 import qualified Data.Abstract.ScopeGraph as ScopeGraph
-import Data.Abstract.ScopeGraph (Relation(..))
 import Data.Abstract.AccessControls.Class as X
 import Data.Language
-import Data.Scientific (Scientific)
 import Data.Semigroup.App
-import Data.Semigroup.Foldable
-import Data.Sum hiding (project)
 import Data.Term
-import Prologue
-import Source.Span (HasSpan(..))
 
 -- | The 'Evaluatable' class defines the necessary interface for a term to be evaluated. While a default definition of 'eval' is given, instances with computational content must implement 'eval' to perform their small-step operational semantics.
 class (Show1 constr, Foldable constr) => Evaluatable constr where
   eval :: ( AbstractValue term address value m
           , AccessControls term
-          , Carrier sig m
           , Declarations term
           , FreeVariables term
           , HasSpan term
-          , Member (Allocator address) sig
-          , Member (Bitwise value) sig
-          , Member (Boolean value) sig
-          , Member (While value) sig
-          , Member (Deref value) sig
-          , Member (State (ScopeGraph address)) sig
-          , Member (Error (LoopControl value)) sig
-          , Member (Error (Return value)) sig
-          , Member Fresh sig
-          , Member (Function term address value) sig
-          , Member (Modules address value) sig
-          , Member (Numeric value) sig
-          , Member (Object address value) sig
-          , Member (Array value) sig
-          , Member (Hash value) sig
-          , Member (Reader ModuleInfo) sig
-          , Member (Reader PackageInfo) sig
-          , Member (Reader Span) sig
-          , Member (State Span) sig
-          , Member (Abstract.String value) sig
-          , Member (Reader (CurrentFrame address)) sig
-          , Member (Reader (CurrentScope address)) sig
-          , Member (Resumable (BaseError (ScopeError address))) sig
-          , Member (Resumable (BaseError (HeapError address))) sig
-          , Member (Resumable (BaseError (AddressError address value))) sig
-          , Member (Resumable (BaseError (UnspecializedError address value))) sig
-          , Member (Resumable (BaseError (EvalError term address value))) sig
-          , Member (Resumable (BaseError ResolutionError)) sig
-          , Member (State (Heap address address value)) sig
-          , Member Trace sig
-          , Member (Unit value) sig
+          , Has (Allocator address) sig m
+          , Has (Bitwise value) sig m
+          , Has (Boolean value) sig m
+          , Has (While value) sig m
+          , Has (Deref value) sig m
+          , Has (State (ScopeGraph address)) sig m
+          , Has (Error (LoopControl value)) sig m
+          , Has (Error (Return value)) sig m
+          , Has Fresh sig m
+          , Has (Function term address value) sig m
+          , Has (Modules address value) sig m
+          , Has (Numeric value) sig m
+          , Has (Object address value) sig m
+          , Has (Array value) sig m
+          , Has (Hash value) sig m
+          , Has (Reader ModuleInfo) sig m
+          , Has (Reader PackageInfo) sig m
+          , Has (Reader Span) sig m
+          , Has (State Span) sig m
+          , Has (Abstract.String value) sig m
+          , Has (Reader (CurrentFrame address)) sig m
+          , Has (Reader (CurrentScope address)) sig m
+          , Has (Resumable (BaseError (ScopeError address))) sig m
+          , Has (Resumable (BaseError (HeapError address))) sig m
+          , Has (Resumable (BaseError (AddressError address value))) sig m
+          , Has (Resumable (BaseError (UnspecializedError address value))) sig m
+          , Has (Resumable (BaseError (EvalError term address value))) sig m
+          , Has (Resumable (BaseError ResolutionError)) sig m
+          , Has (State (Heap address address value)) sig m
+          , Has Trace sig m
+          , Has (Unit value) sig m
           , Ord address
           , Show address
           )
@@ -90,19 +92,18 @@ class (Show1 constr, Foldable constr) => Evaluatable constr where
     throwUnspecializedError $ UnspecializedError ("Eval unspecialized for " <> liftShowsPrec (const (const id)) (const id) 0 expr "")
 
   ref :: ( AbstractValue term address value m
-         , Carrier sig m
          , Declarations term
-         , Member (Object address value) sig
-         , Member (Reader (CurrentFrame address)) sig
-         , Member (Reader (CurrentScope address)) sig
-         , Member (Reader ModuleInfo) sig
-         , Member (Reader Span) sig
-         , Member (Resumable (BaseError (EvalError term address value))) sig
-         , Member (Resumable (BaseError (HeapError address))) sig
-         , Member (Resumable (BaseError (ScopeError address))) sig
-         , Member (Resumable (BaseError (UnspecializedError address value))) sig
-         , Member (State (Heap address address value)) sig
-         , Member (State (ScopeGraph address)) sig
+         , Has (Object address value) sig m
+         , Has (Reader (CurrentFrame address)) sig m
+         , Has (Reader (CurrentScope address)) sig m
+         , Has (Reader ModuleInfo) sig m
+         , Has (Reader Span) sig m
+         , Has (Resumable (BaseError (EvalError term address value))) sig m
+         , Has (Resumable (BaseError (HeapError address))) sig m
+         , Has (Resumable (BaseError (ScopeError address))) sig m
+         , Has (Resumable (BaseError (UnspecializedError address value))) sig m
+         , Has (State (Heap address address value)) sig m
+         , Has (State (ScopeGraph address)) sig m
          , Ord address
          )
       => (term -> Evaluator term address value m value)
@@ -112,7 +113,7 @@ class (Show1 constr, Foldable constr) => Evaluatable constr where
     throwUnspecializedError $ RefUnspecializedError ("ref unspecialized for " <> liftShowsPrec (const (const id)) (const id) 0 expr "")
 
 
-traceResolve :: (Show a, Show b, Member Trace sig, Carrier sig m) => a -> b -> Evaluator term address value m ()
+traceResolve :: (Show a, Show b, Has Trace sig m) => a -> b -> Evaluator term address value m ()
 traceResolve name path = trace ("resolved " <> show name <> " -> " <> show path)
 
 
@@ -120,24 +121,23 @@ traceResolve name path = trace ("resolved " <> show name <> " -> " <> show path)
 
 class HasPrelude (language :: Language) where
   definePrelude :: ( AbstractValue term address value m
-                   , Carrier sig m
                    , HasCallStack
-                   , Member (Allocator address) sig
-                   , Member (State (ScopeGraph address)) sig
-                   , Member (Resumable (BaseError (ScopeError address))) sig
-                   , Member (Resumable (BaseError (HeapError address))) sig
-                   , Member (Deref value) sig
-                   , Member Fresh sig
-                   , Member (Function term address value) sig
-                   , Member (Reader ModuleInfo) sig
-                   , Member (Reader Span) sig
-                   , Member (Resumable (BaseError (AddressError address value))) sig
-                   , Member (State (Heap address address value)) sig
-                   , Member (Reader (CurrentFrame address)) sig
-                   , Member (Reader (CurrentScope address)) sig
-                   , Member Trace sig
-                   , Member (Unit value) sig
-                   , Member (Object address value) sig
+                   , Has (Allocator address) sig m
+                   , Has (State (ScopeGraph address)) sig m
+                   , Has (Resumable (BaseError (ScopeError address))) sig m
+                   , Has (Resumable (BaseError (HeapError address))) sig m
+                   , Has (Deref value) sig m
+                   , Has Fresh sig m
+                   , Has (Function term address value) sig m
+                   , Has (Reader ModuleInfo) sig m
+                   , Has (Reader Span) sig m
+                   , Has (Resumable (BaseError (AddressError address value))) sig m
+                   , Has (State (Heap address address value)) sig m
+                   , Has (Reader (CurrentFrame address)) sig m
+                   , Has (Reader (CurrentScope address)) sig m
+                   , Has Trace sig m
+                   , Has (Unit value) sig m
+                   , Has (Object address value) sig m
                    , Ord address
                    , Show address
                    )
@@ -175,17 +175,16 @@ instance HasPrelude 'JavaScript where
     defineSelf
     defineNamespace (Declaration (X.name "console")) $ defineBuiltIn (Declaration $ X.name "log") Default Public Print
 
-defineSelf :: ( Carrier sig m
-              , Member (State (ScopeGraph address)) sig
-              , Member (Resumable (BaseError (ScopeError address))) sig
-              , Member (Resumable (BaseError (HeapError address))) sig
-              , Member (Deref value) sig
-              , Member (Reader ModuleInfo) sig
-              , Member (Reader Span) sig
-              , Member (State (Heap address address value)) sig
-              , Member (Reader (CurrentFrame address)) sig
-              , Member (Reader (CurrentScope address)) sig
-              , Member (Object address value) sig
+defineSelf :: ( Has (State (ScopeGraph address)) sig m
+              , Has (Resumable (BaseError (ScopeError address))) sig m
+              , Has (Resumable (BaseError (HeapError address))) sig m
+              , Has (Deref value) sig m
+              , Has (Reader ModuleInfo) sig m
+              , Has (Reader Span) sig m
+              , Has (State (Heap address address value)) sig m
+              , Has (Reader (CurrentFrame address)) sig m
+              , Has (Reader (CurrentScope address)) sig m
+              , Has (Object address value) sig m
               , Ord address
               )
            => Evaluator term address value m ()
@@ -213,10 +212,9 @@ data EvalError term address value return where
   ReferenceError      :: value -> term -> EvalError term address value (Slot address)
   ScopedEnvError      :: value -> EvalError term address value address
 
-throwNoNameError :: ( Carrier sig m
-                    , Member (Reader ModuleInfo) sig
-                    , Member (Reader Span) sig
-                    , Member (Resumable (BaseError (EvalError term address value))) sig
+throwNoNameError :: ( Has (Reader ModuleInfo) sig m
+                    , Has (Reader Span) sig m
+                    , Has (Resumable (BaseError (EvalError term address value))) sig m
                     )
                 => term
                 -> Evaluator term address value m Name
@@ -240,19 +238,18 @@ instance (Eq term, Eq value) => Eq1 (EvalError term address value) where
 instance (Show term, Show value) => Show1 (EvalError term address value) where
   liftShowsPrec _ _ = showsPrec
 
-runEvalError :: Evaluator term address value (ResumableC (BaseError (EvalError term address value)) m) a
-             -> Evaluator term address value m (Either (SomeError (BaseError (EvalError term address value))) a)
-runEvalError = raiseHandler runResumable
+runEvalError :: Evaluator term address value (Either.ResumableC (BaseError (EvalError term address value)) m) a
+             -> Evaluator term address value m (Either (Either.SomeError (BaseError (EvalError term address value))) a)
+runEvalError = raiseHandler Either.runResumable
 
 runEvalErrorWith :: (forall resume . (BaseError (EvalError term address value)) resume -> Evaluator term address value m resume)
-                 -> Evaluator term address value (ResumableWithC (BaseError (EvalError term address value)) m) a
+                 -> Evaluator term address value (With.ResumableC (BaseError (EvalError term address value)) m) a
                  -> Evaluator term address value m a
-runEvalErrorWith f = raiseHandler $ runResumableWith (runEvaluator . f)
+runEvalErrorWith f = raiseHandler $ With.runResumable (runEvaluator . f)
 
-throwEvalError :: ( Member (Reader ModuleInfo) sig
-                  , Member (Reader Span) sig
-                  , Member (Resumable (BaseError (EvalError term address value))) sig
-                  , Carrier sig m
+throwEvalError :: ( Has (Reader ModuleInfo) sig m
+                  , Has (Reader Span) sig m
+                  , Has (Resumable (BaseError (EvalError term address value))) sig m
                   )
                => EvalError term address value resume
                -> Evaluator term address value m resume
@@ -275,20 +272,19 @@ instance Eq1 (UnspecializedError address value) where
 instance Show1 (UnspecializedError address value) where
   liftShowsPrec _ _ = showsPrec
 
-runUnspecialized :: Evaluator term address value (ResumableC (BaseError (UnspecializedError address value)) m) a
-                 -> Evaluator term address value m (Either (SomeError (BaseError (UnspecializedError address value))) a)
-runUnspecialized = raiseHandler runResumable
+runUnspecialized :: Evaluator term address value (Either.ResumableC (BaseError (UnspecializedError address value)) m) a
+                 -> Evaluator term address value m (Either (Either.SomeError (BaseError (UnspecializedError address value))) a)
+runUnspecialized = raiseHandler Either.runResumable
 
 runUnspecializedWith :: (forall resume . BaseError (UnspecializedError address value) resume -> Evaluator term address value m resume)
-                     -> Evaluator term address value (ResumableWithC (BaseError (UnspecializedError address value)) m) a
+                     -> Evaluator term address value (With.ResumableC (BaseError (UnspecializedError address value)) m) a
                      -> Evaluator term address value m a
-runUnspecializedWith f = raiseHandler $ runResumableWith (runEvaluator . f)
+runUnspecializedWith f = raiseHandler $ With.runResumable (runEvaluator . f)
 
 
-throwUnspecializedError :: ( Member (Resumable (BaseError (UnspecializedError address value))) sig
-                           , Member (Reader ModuleInfo) sig
-                           , Member (Reader Span) sig
-                           , Carrier sig m
+throwUnspecializedError :: ( Has (Resumable (BaseError (UnspecializedError address value))) sig m
+                           , Has (Reader ModuleInfo) sig m
+                           , Has (Reader Span) sig m
                            )
                         => UnspecializedError address value resume
                         -> Evaluator term address value m resume

src/Data/Abstract/Name.hs

@@ -12,7 +12,6 @@ module Data.Abstract.Name
 import           Control.Effect.Fresh
 import           Data.Aeson
 import qualified Data.Char as Char
-import           Data.Text (Text)
 import qualified Data.Text as Text
 import           Prologue
 
@@ -23,7 +22,7 @@ data Name
   deriving (Eq, Ord)
 
 -- | Generate a fresh (unused) name for use in synthesized variables/closures/etc.
-gensym :: (Member Fresh sig, Carrier sig m) => m Name
+gensym :: Has Fresh sig m => m Name
 gensym = I <$> fresh
 
 -- | Construct a 'Name' from a 'Text'.

src/Data/Abstract/Value/Abstract.hs

@@ -7,7 +7,7 @@ module Data.Abstract.Value.Abstract
 ) where
 
 import Control.Abstract as Abstract
-import Control.Effect.Carrier
+import Control.Algebra
 import Data.Abstract.BaseError
 import Data.Abstract.Evaluatable
 import qualified Data.Map.Strict as Map
@@ -17,29 +17,29 @@ data Abstract = Abstract
   deriving (Eq, Ord, Show)
 
 
-instance ( Member (Allocator address) sig
-         , Member (Deref Abstract) sig
-         , Member (Error (Return Abstract)) sig
-         , Member Fresh sig
-         , Member (Reader (CurrentFrame address)) sig
-         , Member (Reader (CurrentScope address)) sig
-         , Member (Reader ModuleInfo) sig
-         , Member (Reader Span) sig
-         , Member (State Span) sig
-         , Member (State (ScopeGraph address)) sig
-         , Member (Resumable (BaseError (EvalError term address Abstract))) sig
-         , Member (Resumable (BaseError (ScopeError address))) sig
-         , Member (Resumable (BaseError (HeapError address))) sig
-         , Member (Resumable (BaseError (AddressError address Abstract))) sig
-         , Member (State (Heap address address Abstract)) sig
+instance ( Has (Allocator address) sig m
+         , Has (Deref Abstract) sig m
+         , Has (Error (Return Abstract)) sig m
+         , Has Fresh sig m
+         , Has (Reader (CurrentFrame address)) sig m
+         , Has (Reader (CurrentScope address)) sig m
+         , Has (Reader ModuleInfo) sig m
+         , Has (Reader Span) sig m
+         , Has (State Span) sig m
+         , Has (State (ScopeGraph address)) sig m
+         , Has (Resumable (BaseError (EvalError term address Abstract))) sig m
+         , Has (Resumable (BaseError (ScopeError address))) sig m
+         , Has (Resumable (BaseError (HeapError address))) sig m
+         , Has (Resumable (BaseError (AddressError address Abstract))) sig m
+         , Has (State (Heap address address Abstract)) sig m
          , Declarations term
          , Ord address
          , Show address
-         , Carrier sig m
+         , Algebra sig m
          )
-      => Carrier (Abstract.Function term address Abstract :+: sig) (FunctionC term address Abstract m) where
-  eff (R other) = FunctionC . eff . R . handleCoercible $ other
-  eff (L op) = runEvaluator $ do
+      => Algebra (Abstract.Function term address Abstract :+: sig) (FunctionC term address Abstract m) where
+  alg (R other) = FunctionC . alg . R . handleCoercible $ other
+  alg (L op) = runEvaluator $ do
     eval <- Evaluator . FunctionC $ ask
     case op of
       Function _ params body scope k -> do
@@ -58,72 +58,72 @@ instance ( Member (Allocator address) sig
       Call _ _ k -> Evaluator (k Abstract)
 
 
-instance (Carrier sig m, Alternative m) => Carrier (Boolean Abstract :+: sig) (BooleanC Abstract m) where
-  eff (L (Boolean _ k)) = k Abstract
-  eff (L (AsBool  _ k)) = k True <|> k False
-  eff (R other)         = BooleanC . eff . handleCoercible $ other
+instance (Algebra sig m, Alternative m) => Algebra (Boolean Abstract :+: sig) (BooleanC Abstract m) where
+  alg (L (Boolean _ k)) = k Abstract
+  alg (L (AsBool  _ k)) = k True <|> k False
+  alg (R other)         = BooleanC . alg . handleCoercible $ other
 
 
-instance ( Member (Abstract.Boolean Abstract) sig
-         , Carrier sig m
+instance ( Has (Abstract.Boolean Abstract) sig m
+         , Algebra sig m
          , Alternative m
          )
-      => Carrier (While Abstract :+: sig) (WhileC Abstract m) where
-  eff (R other) = WhileC . eff . handleCoercible $ other
-  eff (L (Abstract.While cond body k)) = do
+      => Algebra (While Abstract :+: sig) (WhileC Abstract m) where
+  alg (R other) = WhileC . alg . handleCoercible $ other
+  alg (L (Abstract.While cond body k)) = do
     cond' <- cond
     ifthenelse cond' (body *> empty) (k Abstract)
 
-instance Carrier sig m
-      => Carrier (Unit Abstract :+: sig) (UnitC Abstract m) where
-  eff (R other) = UnitC . eff . handleCoercible $ other
-  eff (L (Abstract.Unit k)) = k Abstract
+instance Algebra sig m
+      => Algebra (Unit Abstract :+: sig) (UnitC Abstract m) where
+  alg (R other) = UnitC . alg . handleCoercible $ other
+  alg (L (Abstract.Unit k)) = k Abstract
 
-instance Carrier sig m
-      => Carrier (Abstract.String Abstract :+: sig) (StringC Abstract m) where
-  eff (R other) = StringC . eff . handleCoercible $ other
-  eff (L op) = case op of
+instance Algebra sig m
+      => Algebra (Abstract.String Abstract :+: sig) (StringC Abstract m) where
+  alg (R other) = StringC . alg . handleCoercible $ other
+  alg (L op) = case op of
     Abstract.String _ k -> k Abstract
     AsString        _ k -> k ""
 
-instance Carrier sig m
-      => Carrier (Numeric Abstract :+: sig) (NumericC Abstract m) where
-  eff (R other) = NumericC . eff . handleCoercible $ other
-  eff (L op) = case op of
+instance Algebra sig m
+      => Algebra (Numeric Abstract :+: sig) (NumericC Abstract m) where
+  alg (R other) = NumericC . alg . handleCoercible $ other
+  alg (L op) = case op of
     Integer _ k -> k Abstract
     Float _ k -> k Abstract
     Rational _ k -> k Abstract
     LiftNumeric _ _ k -> k Abstract
     LiftNumeric2 _ _ _ k -> k Abstract
 
-instance Carrier sig m
-      => Carrier (Bitwise Abstract :+: sig) (BitwiseC Abstract m) where
-  eff (R other) = BitwiseC . eff . handleCoercible $ other
-  eff (L op) = case op of
+instance Algebra sig m
+      => Algebra (Bitwise Abstract :+: sig) (BitwiseC Abstract m) where
+  alg (R other) = BitwiseC . alg . handleCoercible $ other
+  alg (L op) = case op of
     CastToInteger _ k -> k Abstract
     LiftBitwise _ _ k -> k Abstract
     LiftBitwise2 _ _ _ k -> k Abstract
     UnsignedRShift _ _ k -> k Abstract
 
-instance Carrier sig m
-      => Carrier (Object address Abstract :+: sig) (ObjectC address Abstract m) where
-  eff (R other) = ObjectC . eff . handleCoercible $ other
-  eff (L op) = case op of
+instance Algebra sig m
+      => Algebra (Object address Abstract :+: sig) (ObjectC address Abstract m) where
+  alg (R other) = ObjectC . alg . handleCoercible $ other
+  alg (L op) = case op of
     Object _ k -> k Abstract
     ScopedEnvironment _ k -> k Nothing
     Klass _ _ k -> k Abstract
 
-instance Carrier sig m
-      => Carrier (Array Abstract :+: sig) (ArrayC Abstract m) where
-  eff (R other) = ArrayC . eff . handleCoercible $ other
-  eff (L op) = case op of
+instance Algebra sig m
+      => Algebra (Array Abstract :+: sig) (ArrayC Abstract m) where
+  alg (R other) = ArrayC . alg . handleCoercible $ other
+  alg (L op) = case op of
     Array _ k -> k Abstract
     AsArray _ k -> k []
 
-instance Carrier sig m
-      => Carrier (Hash Abstract :+: sig) (HashC Abstract m) where
-  eff (R other) = HashC . eff . handleCoercible $ other
-  eff (L op) = case op of
+instance Algebra sig m
+      => Algebra (Hash Abstract :+: sig) (HashC Abstract m) where
+  alg (R other) = HashC . alg . handleCoercible $ other
+  alg (L op) = case op of
     Hash _ k -> k Abstract
     KvPair _ _ k -> k Abstract
 

src/Data/Abstract/Value/Concrete.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, LambdaCase, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, LambdaCase, MultiParamTypeClasses, RankNTypes,
+             ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-}
 module Data.Abstract.Value.Concrete
   ( Value (..)
   , ValueError (..)
@@ -6,25 +7,27 @@ module Data.Abstract.Value.Concrete
   , runValueErrorWith
   ) where
 
-import Control.Abstract.ScopeGraph (Allocator, ScopeError)
-import Control.Abstract.Heap (scopeLookup)
-import qualified Control.Abstract as Abstract
-import Control.Abstract hiding (Boolean(..), Function(..), Numeric(..), Object(..), Array(..), Hash(..), String(..), Unit(..), While(..))
-import Control.Effect.Carrier
-import Control.Effect.Interpose
-import Data.Abstract.BaseError
-import Data.Abstract.Evaluatable (UnspecializedError(..), EvalError(..), Declarations)
-import Data.Abstract.FreeVariables
-import Data.Abstract.Name
-import qualified Data.Abstract.Number as Number
-import Data.Bits
-import Data.List (genericIndex, genericLength)
-import Data.Scientific (Scientific, coefficient, normalize)
-import Data.Scientific.Exts
-import Data.Text (pack)
-import Data.Word
 import Prologue
+
+import           Control.Carrier.Resumable.Either (SomeError)
+import qualified Control.Carrier.Resumable.Either as Either
+import qualified Control.Carrier.Resumable.Resume as With
+import           Data.List (genericIndex, genericLength)
 import qualified Data.Map.Strict as Map
+import           Data.Scientific.Exts
+import           Data.Text (pack)
+
+import           Control.Abstract hiding
+    (Array (..), Boolean (..), Function (..), Hash (..), Numeric (..), Object (..), String (..), Unit (..), While (..))
+import qualified Control.Abstract as Abstract
+import           Control.Algebra
+import           Control.Effect.Interpose
+import           Data.Abstract.BaseError
+import           Data.Abstract.Evaluatable (Declarations, EvalError (..), UnspecializedError (..))
+import           Data.Abstract.FreeVariables
+import           Data.Abstract.Name
+import qualified Data.Abstract.Number as Number
+
 
 data Value term address
     -- TODO: Split Closure up into a separate data type.                                                  Scope   Frame
@@ -52,33 +55,33 @@ instance ValueRoots address (Value term address) where
 
 
 instance ( FreeVariables term
-         , Member (Allocator address) sig
-         , Member (Deref (Value term address)) sig
-         , Member Fresh sig
-         , Member (Reader (CurrentFrame address)) sig
-         , Member (Reader (CurrentScope address)) sig
-         , Member (Reader ModuleInfo) sig
-         , Member (Reader PackageInfo) sig
-         , Member (Reader Span) sig
-         , Member (State Span) sig
-         , Member (State (ScopeGraph address)) sig
-         , Member (Resumable (BaseError (AddressError address (Value term address)))) sig
-         , Member (Resumable (BaseError (EvalError term address (Value term address)))) sig
-         , Member (Resumable (BaseError (ValueError term address))) sig
-         , Member (Resumable (BaseError (HeapError address))) sig
-         , Member (Resumable (BaseError (ScopeError address))) sig
-         , Member (State (Heap address address (Value term address))) sig
-         , Member (Error (Return (Value term address))) sig
+         , Has (Allocator address) sig m
+         , Has (Deref (Value term address)) sig m
+         , Has Fresh sig m
+         , Has (Reader (CurrentFrame address)) sig m
+         , Has (Reader (CurrentScope address)) sig m
+         , Has (Reader ModuleInfo) sig m
+         , Has (Reader PackageInfo) sig m
+         , Has (Reader Span) sig m
+         , Has (State Span) sig m
+         , Has (State (ScopeGraph address)) sig m
+         , Has (Resumable (BaseError (AddressError address (Value term address)))) sig m
+         , Has (Resumable (BaseError (EvalError term address (Value term address)))) sig m
+         , Has (Resumable (BaseError (ValueError term address))) sig m
+         , Has (Resumable (BaseError (HeapError address))) sig m
+         , Has (Resumable (BaseError (ScopeError address))) sig m
+         , Has (State (Heap address address (Value term address))) sig m
+         , Has (Error (Return (Value term address))) sig m
          , Declarations term
-         , Member Trace sig
+         , Has Trace sig m
          , Ord address
-         , Carrier sig m
+         , Algebra sig m
          , Show address
          , Show term
          )
-      => Carrier (Abstract.Function term address (Value term address) :+: sig) (Abstract.FunctionC term address (Value term address) m) where
-  eff (R other) = FunctionC . eff . R . handleCoercible $ other
-  eff (L op) = runEvaluator $ do
+      => Algebra (Abstract.Function term address (Value term address) :+: sig) (Abstract.FunctionC term address (Value term address) m) where
+  alg (R other) = FunctionC . alg . R . handleCoercible $ other
+  alg (L op) = runEvaluator $ do
     eval <- Evaluator . FunctionC $ ask
     let closure maybeName params body scope = do
           packageInfo <- currentPackage
@@ -119,27 +122,27 @@ instance ( FreeVariables term
           _ -> throwValueError (CallError op)
         Evaluator (k boxed)
 
-instance ( Member (Reader ModuleInfo) sig
-         , Member (Reader Span) sig
-         , Member (Resumable (BaseError (ValueError term address))) sig
-         , Carrier sig m
+instance ( Has (Reader ModuleInfo) sig m
+         , Has (Reader Span) sig m
+         , Has (Resumable (BaseError (ValueError term address))) sig m
+         , Algebra sig m
          , Monad m
          )
-      => Carrier (Abstract.Boolean (Value term address) :+: sig) (BooleanC (Value term address) m) where
-  eff (R other) = BooleanC . eff . handleCoercible $ other
-  eff (L op) = case op of
+      => Algebra (Abstract.Boolean (Value term address) :+: sig) (BooleanC (Value term address) m) where
+  alg (R other) = BooleanC . alg . handleCoercible $ other
+  alg (L op) = case op of
     Abstract.Boolean b          k -> k $! Boolean b
     Abstract.AsBool (Boolean b) k -> k b
     Abstract.AsBool other       k -> throwBaseError (BoolError other) >>= k
 
-instance ( Carrier sig m
-         , Member (Abstract.Boolean (Value term address)) sig
-         , Member (Error (LoopControl (Value term address))) sig
-         , Member (Interpose (Resumable (BaseError (UnspecializedError address (Value term address))))) sig
+instance ( Algebra sig m
+         , Has (Abstract.Boolean (Value term address)) sig m
+         , Has (Error (LoopControl (Value term address))) sig m
+         , Has (Interpose (Resumable (BaseError (UnspecializedError address (Value term address))))) sig m
          )
-      => Carrier (Abstract.While (Value term address) :+: sig) (WhileC (Value term address) m) where
-  eff (R other) = WhileC . eff . handleCoercible $ other
-  eff (L (Abstract.While cond body k)) = do
+      => Algebra (Abstract.While (Value term address) :+: sig) (WhileC (Value term address) m) where
+  alg (R other) = WhileC . alg . handleCoercible $ other
+  alg (L (Abstract.While cond body k)) = do
 
     let loop x = catchError x $ \case
           Break value -> pure value
@@ -194,33 +197,33 @@ instance ( Carrier sig m
     --       Resumable (BaseError _ _ (RefUnspecializedError _)) _ -> throwError (Abort @(Value term address))) >>= k
 
 
-instance Carrier sig m
-      => Carrier (Abstract.Unit (Value term address) :+: sig) (UnitC (Value term address) m) where
-  eff (R other) = UnitC . eff . handleCoercible $ other
-  eff (L (Abstract.Unit k )) = k Unit
+instance Algebra sig m
+      => Algebra (Abstract.Unit (Value term address) :+: sig) (UnitC (Value term address) m) where
+  alg (R other)              = UnitC . alg . handleCoercible $ other
+  alg (L (Abstract.Unit k )) = k Unit
 
-instance ( Member (Reader ModuleInfo) sig
-         , Member (Reader Span) sig
-         , Member (Resumable (BaseError (ValueError term address))) sig
-         , Carrier sig m
+instance ( Has (Reader ModuleInfo) sig m
+         , Has (Reader Span) sig m
+         , Has (Resumable (BaseError (ValueError term address))) sig m
+         , Algebra sig m
          , Monad m
          )
-      => Carrier (Abstract.String (Value term address) :+: sig) (StringC (Value term address) m) where
-  eff (R other) = StringC . eff . handleCoercible $ other
-  eff (L op) = case op of
+      => Algebra (Abstract.String (Value term address) :+: sig) (StringC (Value term address) m) where
+  alg (R other) = StringC . alg . handleCoercible $ other
+  alg (L op) = case op of
     Abstract.String   t          k -> k (String t)
     Abstract.AsString (String t) k -> k t
     Abstract.AsString other      k -> throwBaseError (StringError other) >>= k
 
-instance ( Member (Reader ModuleInfo) sig
-         , Member (Reader Span) sig
-         , Member (Resumable (BaseError (ValueError term address))) sig
-         , Carrier sig m
+instance ( Has (Reader ModuleInfo) sig m
+         , Has (Reader Span) sig m
+         , Has (Resumable (BaseError (ValueError term address))) sig m
+         , Algebra sig m
          , Monad m
          )
-      => Carrier (Abstract.Numeric (Value term address) :+: sig) (NumericC (Value term address) m) where
-  eff (R other) = NumericC . eff . handleCoercible $ other
-  eff (L op) = case op of
+      => Algebra (Abstract.Numeric (Value term address) :+: sig) (NumericC (Value term address) m) where
+  alg (R other) = NumericC . alg . handleCoercible $ other
+  alg (L op) = case op of
     Abstract.Integer  t k -> k (Integer (Number.Integer t))
     Abstract.Float    t k -> k (Float (Number.Decimal t))
     Abstract.Rational t k -> k (Rational (Number.Ratio t))
@@ -242,28 +245,27 @@ instance ( Member (Reader ModuleInfo) sig
       _                        -> throwBaseError (Numeric2Error left right)
 
 -- Dispatch whatever's contained inside a 'Number.SomeNumber' to its appropriate 'MonadValue' ctor
-specialize :: ( Member (Reader ModuleInfo) sig
-              , Member (Reader Span) sig
-              , Member (Resumable (BaseError (ValueError term address))) sig
-              , Carrier sig m
+specialize :: ( Has (Reader ModuleInfo) sig m
+              , Has (Reader Span) sig m
+              , Has (Resumable (BaseError (ValueError term address))) sig m
               )
            => Either ArithException Number.SomeNumber
            -> m (Value term address)
-specialize (Left exc) = throwBaseError (ArithmeticError exc)
+specialize (Left exc)                                     = throwBaseError (ArithmeticError exc)
 specialize (Right (Number.SomeNumber (Number.Integer t))) = pure (Integer (Number.Integer t))
 specialize (Right (Number.SomeNumber (Number.Decimal t))) = pure (Float (Number.Decimal t))
 specialize (Right (Number.SomeNumber (Number.Ratio t)))   = pure (Rational (Number.Ratio t))
 
 
-instance ( Member (Reader ModuleInfo) sig
-         , Member (Reader Span) sig
-         , Member (Resumable (BaseError (ValueError term address))) sig
-         , Carrier sig m
+instance ( Has (Reader ModuleInfo) sig m
+         , Has (Reader Span) sig m
+         , Has (Resumable (BaseError (ValueError term address))) sig m
+         , Algebra sig m
          , Monad m
          )
-      => Carrier (Abstract.Bitwise (Value term address) :+: sig) (BitwiseC (Value term address) m) where
-  eff (R other) = BitwiseC . eff . handleCoercible $ other
-  eff (L op) = case op of
+      => Algebra (Abstract.Bitwise (Value term address) :+: sig) (BitwiseC (Value term address) m) where
+  alg (R other) = BitwiseC . alg . handleCoercible $ other
+  alg (L op) = case op of
     CastToInteger (Integer (Number.Integer i)) k -> k (Integer (Number.Integer i))
     CastToInteger (Float (Number.Decimal i)) k -> k (Integer (Number.Integer (coefficient (normalize i))))
     CastToInteger i k -> throwBaseError (NumericError i) >>= k
@@ -278,33 +280,33 @@ ourShift :: Word64 -> Int -> Integer
 ourShift a b = toInteger (shiftR a b)
 
 
-instance Carrier sig m => Carrier (Abstract.Object address (Value term address) :+: sig) (ObjectC address (Value term address) m) where
-  eff (R other) = ObjectC . eff . handleCoercible $ other
-  eff (L op) = case op of
-    Abstract.Object address k -> k (Object address)
-    Abstract.ScopedEnvironment (Object address) k -> k (Just address)
-    Abstract.ScopedEnvironment (Class _ _ address) k -> k (Just address)
+instance Algebra sig m => Algebra (Abstract.Object address (Value term address) :+: sig) (ObjectC address (Value term address) m) where
+  alg (R other) = ObjectC . alg . handleCoercible $ other
+  alg (L op) = case op of
+    Abstract.Object address k                          -> k (Object address)
+    Abstract.ScopedEnvironment (Object address) k      -> k (Just address)
+    Abstract.ScopedEnvironment (Class _ _ address) k   -> k (Just address)
     Abstract.ScopedEnvironment (Namespace _ address) k -> k (Just address)
-    Abstract.ScopedEnvironment _ k -> k Nothing
-    Abstract.Klass n frame k -> k (Class n mempty frame)
+    Abstract.ScopedEnvironment _ k                     -> k Nothing
+    Abstract.Klass n frame k                           -> k (Class n mempty frame)
 
-instance ( Member (Reader ModuleInfo) sig
-         , Member (Reader Span) sig
-         , Member (Resumable (BaseError (ValueError term address))) sig
-         , Carrier sig m
+instance ( Has (Reader ModuleInfo) sig m
+         , Has (Reader Span) sig m
+         , Has (Resumable (BaseError (ValueError term address))) sig m
+         , Algebra sig m
          , Monad m
          )
-      => Carrier (Abstract.Array (Value term address) :+: sig) (ArrayC (Value term address) m) where
-  eff (R other) = ArrayC . eff . handleCoercible $ other
-  eff (L op) = case op of
-    Abstract.Array t k -> k (Array t)
+      => Algebra (Abstract.Array (Value term address) :+: sig) (ArrayC (Value term address) m) where
+  alg (R other) = ArrayC . alg . handleCoercible $ other
+  alg (L op) = case op of
+    Abstract.Array t k                   -> k (Array t)
     Abstract.AsArray (Array addresses) k -> k addresses
-    Abstract.AsArray val k -> throwBaseError (ArrayError val) >>= k
+    Abstract.AsArray val k               -> throwBaseError (ArrayError val) >>= k
 
-instance ( Carrier sig m ) => Carrier (Abstract.Hash (Value term address) :+: sig) (HashC (Value term address) m) where
-  eff (R other) = HashC . eff . handleCoercible $ other
-  eff (L op) = case op of
-    Abstract.Hash t k -> k ((Hash . map (uncurry KVPair)) t)
+instance ( Algebra sig m ) => Algebra (Abstract.Hash (Value term address) :+: sig) (HashC (Value term address) m) where
+  alg (R other) = HashC . alg . handleCoercible $ other
+  alg (L op) = case op of
+    Abstract.Hash t k     -> k ((Hash . map (uncurry KVPair)) t)
     Abstract.KvPair t v k -> k (KVPair t v)
 
 
@@ -315,13 +317,13 @@ instance (Show address, Show term) => AbstractIntro (Value term address) where
   null     = Null
 
 -- | Construct a 'Value' wrapping the value arguments (if any).
-instance ( Member (Abstract.Boolean (Value term address)) sig
-         , Member (Reader ModuleInfo) sig
-         , Member (Reader Span) sig
-         , Member (Resumable (BaseError (ValueError term address))) sig
+instance ( Has (Abstract.Boolean (Value term address)) sig m
+         , Has (Reader ModuleInfo) sig m
+         , Has (Reader Span) sig m
+         , Has (Resumable (BaseError (ValueError term address))) sig m
          , Show address
          , Show term
-         , Carrier sig m
+         , Algebra sig m
          )
       => AbstractValue term address (Value term address) m where
   asPair val
@@ -383,35 +385,34 @@ data ValueError term address resume where
   BoundsError            :: [Value term address] -> Prelude.Integer  -> ValueError term address (Value term address)
 
 instance (Eq address, Eq term) => Eq1 (ValueError term address) where
-  liftEq _ (StringError a) (StringError b)                       = a == b
-  liftEq _ (CallError a) (CallError b)                           = a == b
-  liftEq _ (BoolError a) (BoolError c)                           = a == c
-  liftEq _ (IndexError a b) (IndexError c d)                     = (a == c) && (b == d)
-  liftEq _ (Numeric2Error a b) (Numeric2Error c d)               = (a == c) && (b == d)
-  liftEq _ (ComparisonError a b) (ComparisonError c d)           = (a == c) && (b == d)
-  liftEq _ (Bitwise2Error a b) (Bitwise2Error c d)               = (a == c) && (b == d)
-  liftEq _ (BitwiseError a) (BitwiseError b)                     = a == b
-  liftEq _ (KeyValueError a) (KeyValueError b)                   = a == b
-  liftEq _ (BoundsError a b) (BoundsError c d)                   = (a == c) && (b == d)
-  liftEq _ _             _                                       = False
+  liftEq _ (StringError a) (StringError b)             = a == b
+  liftEq _ (CallError a) (CallError b)                 = a == b
+  liftEq _ (BoolError a) (BoolError c)                 = a == c
+  liftEq _ (IndexError a b) (IndexError c d)           = (a == c) && (b == d)
+  liftEq _ (Numeric2Error a b) (Numeric2Error c d)     = (a == c) && (b == d)
+  liftEq _ (ComparisonError a b) (ComparisonError c d) = (a == c) && (b == d)
+  liftEq _ (Bitwise2Error a b) (Bitwise2Error c d)     = (a == c) && (b == d)
+  liftEq _ (BitwiseError a) (BitwiseError b)           = a == b
+  liftEq _ (KeyValueError a) (KeyValueError b)         = a == b
+  liftEq _ (BoundsError a b) (BoundsError c d)         = (a == c) && (b == d)
+  liftEq _ _             _                             = False
 
 deriving instance (Show address, Show term) => Show (ValueError term address resume)
 instance (Show address, Show term) => Show1 (ValueError term address) where
   liftShowsPrec _ _ = showsPrec
 
-runValueError :: Evaluator term address (Value term address) (ResumableC (BaseError (ValueError term address)) m) a
+runValueError :: Evaluator term address (Value term address) (Either.ResumableC (BaseError (ValueError term address)) m) a
               -> Evaluator term address (Value term address) m (Either (SomeError (BaseError (ValueError term address))) a)
-runValueError = Evaluator . runResumable . runEvaluator
+runValueError = Evaluator . Either.runResumable . runEvaluator
 
 runValueErrorWith :: (forall resume . BaseError (ValueError term address) resume -> Evaluator term address (Value term address) m resume)
-                  -> Evaluator term address (Value term address) (ResumableWithC (BaseError (ValueError term address)) m) a
+                  -> Evaluator term address (Value term address) (With.ResumableC (BaseError (ValueError term address)) m) a
                   -> Evaluator term address (Value term address) m a
-runValueErrorWith f = Evaluator . runResumableWith (runEvaluator . f) . runEvaluator
+runValueErrorWith f = Evaluator . With.runResumable (runEvaluator . f) . runEvaluator
 
-throwValueError :: ( Member (Resumable (BaseError (ValueError term address))) sig
-                   , Member (Reader ModuleInfo) sig
-                   , Member (Reader Span) sig
-                   , Carrier sig m
+throwValueError :: ( Has (Resumable (BaseError (ValueError term address))) sig m
+                   , Has (Reader ModuleInfo) sig m
+                   , Has (Reader Span) sig m
                    )
                 => ValueError term address resume
                 -> Evaluator term address (Value term address) m resume

src/Data/Abstract/Value/Type.hs

@@ -11,14 +11,20 @@ module Data.Abstract.Value.Type
   , runWhile
   ) where
 
+import Prologue hiding (TypeError)
+
+import           Control.Algebra
+import           Control.Carrier.State.Strict
+import qualified Control.Carrier.Resumable.Resume as With
+import           Control.Carrier.Resumable.Either (SomeError)
+import qualified Control.Carrier.Resumable.Either as Either
+import qualified Data.Map as Map
+
 import Control.Abstract.ScopeGraph
 import qualified Control.Abstract as Abstract
 import Control.Abstract hiding (Boolean(..), Function(..), Numeric(..), Object(..), Array(..), Hash(..), String(..), Unit(..), While(..))
-import Control.Effect.Carrier
 import Data.Abstract.BaseError
 import Data.Semigroup.Foldable (foldMap1)
-import qualified Data.Map as Map
-import Prologue hiding (TypeError)
 import Data.Abstract.Evaluatable
 
 type TName = Int
@@ -86,39 +92,38 @@ instance Ord1  TypeError where
 
 instance Show1 TypeError where liftShowsPrec _ _ = showsPrec
 
-runTypeError :: Evaluator term address value (ResumableC (BaseError TypeError) m) a
+runTypeError :: Evaluator term address value (Either.ResumableC (BaseError TypeError) m) a
              -> Evaluator term address value m (Either (SomeError (BaseError TypeError)) a)
-runTypeError = raiseHandler runResumable
+runTypeError = raiseHandler Either.runResumable
 
 runTypeErrorWith :: (forall resume . (BaseError TypeError) resume -> Evaluator term address value m resume)
-                 -> Evaluator term address value (ResumableWithC (BaseError TypeError) m) a
+                 -> Evaluator term address value (With.ResumableC (BaseError TypeError) m) a
                  -> Evaluator term address value m a
-runTypeErrorWith f = raiseHandler $ runResumableWith (runEvaluator . f)
+runTypeErrorWith f = raiseHandler $ With.runResumable (runEvaluator . f)
 
 
-throwTypeError :: ( Member (Resumable (BaseError TypeError)) sig
-                  , Member (Reader ModuleInfo) sig
-                  , Member (Reader Span) sig
-                  , Carrier sig m
+throwTypeError :: ( Has (Resumable (BaseError TypeError)) sig m
+                  , Has (Reader ModuleInfo) sig m
+                  , Has (Reader Span) sig m
                   )
                => TypeError resume
                -> m resume
 throwTypeError = throwBaseError
 
-runTypeMap :: Carrier sig m
+runTypeMap :: Algebra sig m
            => Evaluator term address Type (StateC TypeMap m) a
            -> Evaluator term address Type m a
 runTypeMap = raiseHandler $ fmap snd . runState emptyTypeMap
 
-runTypes :: Carrier sig m
-         => Evaluator term address Type (ResumableC (BaseError TypeError)
+runTypes :: Algebra sig m
+         => Evaluator term address Type (Either.ResumableC (BaseError TypeError)
                                          (StateC TypeMap m)) a
          -> Evaluator term address Type m (Either (SomeError (BaseError TypeError)) a)
 runTypes = runTypeMap . runTypeError
 
-runTypesWith :: Carrier sig m
+runTypesWith :: Algebra sig m
              => (forall resume . (BaseError TypeError) resume -> Evaluator term address Type (StateC TypeMap m) resume)
-             -> Evaluator term address Type (ResumableWithC (BaseError TypeError)
+             -> Evaluator term address Type (With.ResumableC (BaseError TypeError)
                                             (StateC TypeMap
                                             m)) a
              -> Evaluator term address Type m a
@@ -130,17 +135,13 @@ newtype TypeMap = TypeMap { unTypeMap :: Map.Map TName Type }
 emptyTypeMap :: TypeMap
 emptyTypeMap = TypeMap Map.empty
 
-modifyTypeMap :: ( Member (State TypeMap) sig
-                 , Carrier sig m
-                 )
+modifyTypeMap :: Has (State TypeMap) sig m
               => (Map.Map TName Type -> Map.Map TName Type)
               -> m ()
 modifyTypeMap f = modify (TypeMap . f . unTypeMap)
 
 -- | Prunes substituted type variables
-prune :: ( Member (State TypeMap) sig
-         , Carrier sig m
-         )
+prune :: Has (State TypeMap) sig m
       => Type
       -> m Type
 prune (Var id) = gets (Map.lookup id . unTypeMap) >>= \case
@@ -153,9 +154,7 @@ prune ty = pure ty
 
 -- | Checks whether a type variable name occurs within another type. This
 --   function is used in 'substitute' to prevent unification of infinite types
-occur :: ( Member (State TypeMap) sig
-         , Carrier sig m
-         )
+occur :: Has (State TypeMap) sig m
       => TName
       -> Type
       -> m Bool
@@ -181,11 +180,10 @@ occur id = prune >=> \case
     eitherM f (a, b) = (||) <$> f a <*> f b
 
 -- | Substitutes a type variable name for another type
-substitute :: ( Member (Reader ModuleInfo) sig
-              , Member (Reader Span) sig
-              , Member (Resumable (BaseError TypeError)) sig
-              , Member (State TypeMap) sig
-              , Carrier sig m
+substitute :: ( Has (Reader ModuleInfo) sig m
+              , Has (Reader Span) sig m
+              , Has (Resumable (BaseError TypeError)) sig m
+              , Has (State TypeMap) sig m
               )
            => TName
            -> Type
@@ -199,11 +197,10 @@ substitute id ty = do
   pure ty
 
 -- | Unify two 'Type's.
-unify :: ( Member (Reader ModuleInfo) sig
-         , Member (Reader Span) sig
-         , Member (Resumable (BaseError TypeError)) sig
-         , Member (State TypeMap) sig
-         , Carrier sig m
+unify :: ( Has (Reader ModuleInfo) sig m
+         , Has (Reader Span) sig m
+         , Has (Resumable (BaseError TypeError)) sig m
+         , Has (State TypeMap) sig m
          )
       => Type
       -> Type
@@ -229,31 +226,31 @@ instance Ord address => ValueRoots address Type where
   valueRoots _ = mempty
 
 
-instance ( Member (Allocator address) sig
-         , Member (Deref Type) sig
-         , Member (Error (Return Type)) sig
-         , Member Fresh sig
-         , Member (Reader (CurrentFrame address)) sig
-         , Member (Reader (CurrentScope address)) sig
-         , Member (Reader ModuleInfo) sig
-         , Member (Reader Span) sig
-         , Member (State Span) sig
-         , Member (Resumable (BaseError (EvalError term address Type))) sig
-         , Member (Resumable (BaseError TypeError)) sig
-         , Member (Resumable (BaseError (AddressError address Type))) sig
-         , Member (State (Heap address address Type)) sig
-         , Member (State (ScopeGraph address)) sig
-         , Member (Resumable (BaseError (ScopeError address))) sig
-         , Member (Resumable (BaseError (HeapError address))) sig
-         , Member (State TypeMap) sig
+instance ( Has (Allocator address) sig m
+         , Has (Deref Type) sig m
+         , Has (Error (Return Type)) sig m
+         , Has Fresh sig m
+         , Has (Reader (CurrentFrame address)) sig m
+         , Has (Reader (CurrentScope address)) sig m
+         , Has (Reader ModuleInfo) sig m
+         , Has (Reader Span) sig m
+         , Has (State Span) sig m
+         , Has (Resumable (BaseError (EvalError term address Type))) sig m
+         , Has (Resumable (BaseError TypeError)) sig m
+         , Has (Resumable (BaseError (AddressError address Type))) sig m
+         , Has (State (Heap address address Type)) sig m
+         , Has (State (ScopeGraph address)) sig m
+         , Has (Resumable (BaseError (ScopeError address))) sig m
+         , Has (Resumable (BaseError (HeapError address))) sig m
+         , Has (State TypeMap) sig m
          , Declarations term
          , Ord address
          , Show address
-         , Carrier sig m
+         , Algebra sig m
          )
-      => Carrier (Abstract.Function term address Type :+: sig) (FunctionC term address Type m) where
-  eff (R other) = FunctionC (eff (R (handleCoercible other)))
-  eff (L op) = runEvaluator $ do
+      => Algebra (Abstract.Function term address Type :+: sig) (FunctionC term address Type m) where
+  alg (R other) = FunctionC (alg (R (handleCoercible other)))
+  alg (L op) = runEvaluator $ do
     eval <- Evaluator . FunctionC $ ask
     case op of
       Abstract.Function _ params body scope k -> do
@@ -285,58 +282,58 @@ instance ( Member (Allocator address) sig
 
 
 
-instance ( Member (Reader ModuleInfo) sig
-         , Member (Reader Span) sig
-         , Member (Resumable (BaseError TypeError)) sig
-         , Member (State TypeMap) sig
-         , Carrier sig m
+instance ( Has (Reader ModuleInfo) sig m
+         , Has (Reader Span) sig m
+         , Has (Resumable (BaseError TypeError)) sig m
+         , Has (State TypeMap) sig m
+         , Algebra sig m
          , Alternative m
          )
-      => Carrier (Abstract.Boolean Type :+: sig) (BooleanC Type m) where
-  eff (R other) = BooleanC . eff . handleCoercible $ other
-  eff (L (Abstract.Boolean _ k)) = k Bool
-  eff (L (Abstract.AsBool t k))  = unify t Bool *> (k True <|> k False)
+      => Algebra (Abstract.Boolean Type :+: sig) (BooleanC Type m) where
+  alg (R other) = BooleanC . alg . handleCoercible $ other
+  alg (L (Abstract.Boolean _ k)) = k Bool
+  alg (L (Abstract.AsBool t k))  = unify t Bool *> (k True <|> k False)
 
 
 
-instance ( Member (Abstract.Boolean Type) sig
-         , Carrier sig m
+instance ( Has (Abstract.Boolean Type) sig m
+         , Algebra sig m
          , Alternative m
          )
-      => Carrier (Abstract.While Type :+: sig) (WhileC Type m) where
-  eff (R other) = WhileC . eff . handleCoercible $ other
-  eff (L (Abstract.While cond body k)) = do
+      => Algebra (Abstract.While Type :+: sig) (WhileC Type m) where
+  alg (R other) = WhileC . alg . handleCoercible $ other
+  alg (L (Abstract.While cond body k)) = do
     cond' <- cond
     ifthenelse cond' (body *> empty) (k Unit)
 
 
-instance Carrier sig m
-      => Carrier (Abstract.Unit Type :+: sig) (UnitC Type m) where
-  eff (R other) = UnitC . eff . handleCoercible $ other
-  eff (L (Abstract.Unit k)) = k Unit
+instance Algebra sig m
+      => Algebra (Abstract.Unit Type :+: sig) (UnitC Type m) where
+  alg (R other) = UnitC . alg . handleCoercible $ other
+  alg (L (Abstract.Unit k)) = k Unit
 
-instance ( Member (Reader ModuleInfo) sig
-         , Member (Reader Span) sig
-         , Member (Resumable (BaseError TypeError)) sig
-         , Member (State TypeMap) sig
-         , Carrier sig m
+instance ( Has (Reader ModuleInfo) sig m
+         , Has (Reader Span) sig m
+         , Has (Resumable (BaseError TypeError)) sig m
+         , Has (State TypeMap) sig m
+         , Algebra sig m
          , Alternative m
          )
-      => Carrier (Abstract.String Type :+: sig) (StringC Type m) where
-  eff (R other) = StringC . eff . handleCoercible $ other
-  eff (L (Abstract.String _ k)) = k String
-  eff (L (Abstract.AsString t k)) = unify t String *> k ""
+      => Algebra (Abstract.String Type :+: sig) (StringC Type m) where
+  alg (R other) = StringC . alg . handleCoercible $ other
+  alg (L (Abstract.String _ k)) = k String
+  alg (L (Abstract.AsString t k)) = unify t String *> k ""
 
-instance ( Member (Reader ModuleInfo) sig
-         , Member (Reader Span) sig
-         , Member (Resumable (BaseError TypeError)) sig
-         , Member (State TypeMap) sig
-         , Carrier sig m
+instance ( Has (Reader ModuleInfo) sig m
+         , Has (Reader Span) sig m
+         , Has (Resumable (BaseError TypeError)) sig m
+         , Has (State TypeMap) sig m
+         , Algebra sig m
          , Monad m
          )
-      => Carrier (Abstract.Numeric Type :+: sig) (NumericC Type m) where
-  eff (R other) = NumericC . eff . handleCoercible $ other
-  eff (L op) = case op of
+      => Algebra (Abstract.Numeric Type :+: sig) (NumericC Type m) where
+  alg (R other) = NumericC . alg . handleCoercible $ other
+  alg (L op) = case op of
     Abstract.Integer _ k -> k Int
     Abstract.Float _ k -> k Float
     Abstract.Rational _ k -> k Rational
@@ -346,50 +343,50 @@ instance ( Member (Reader ModuleInfo) sig
       (Int, Float) -> k Float
       _            -> unify left right >>= k
 
-instance ( Member (Reader ModuleInfo) sig
-         , Member (Reader Span) sig
-         , Member (Resumable (BaseError TypeError)) sig
-         , Member (State TypeMap) sig
-         , Carrier sig m
+instance ( Has (Reader ModuleInfo) sig m
+         , Has (Reader Span) sig m
+         , Has (Resumable (BaseError TypeError)) sig m
+         , Has (State TypeMap) sig m
+         , Algebra sig m
          , Monad m
          )
-      => Carrier (Abstract.Bitwise Type :+: sig) (BitwiseC Type m) where
-  eff (R other) = BitwiseC . eff . handleCoercible $ other
-  eff (L op) = case op of
+      => Algebra (Abstract.Bitwise Type :+: sig) (BitwiseC Type m) where
+  alg (R other) = BitwiseC . alg . handleCoercible $ other
+  alg (L op) = case op of
     CastToInteger t k -> unify t (Int :+ Float :+ Rational) *> k Int
     LiftBitwise _ t k -> unify t Int >>= k
     LiftBitwise2 _ t1 t2 k -> unify Int t1 >>= unify t2 >>= k
     UnsignedRShift t1 t2 k -> unify Int t2 *> unify Int t1 >>= k
 
-instance ( Carrier sig m ) => Carrier (Abstract.Object address Type :+: sig) (ObjectC address Type m) where
-  eff (R other) = ObjectC . eff . handleCoercible $ other
-  eff (L op) = case op of
+instance ( Algebra sig m ) => Algebra (Abstract.Object address Type :+: sig) (ObjectC address Type m) where
+  alg (R other) = ObjectC . alg . handleCoercible $ other
+  alg (L op) = case op of
     Abstract.Object _ k -> k Object
     Abstract.ScopedEnvironment _ k -> k Nothing
     Abstract.Klass _ _ k -> k Object
 
-instance ( Member Fresh sig
-         , Member (Reader ModuleInfo) sig
-         , Member (Reader Span) sig
-         , Member (Resumable (BaseError TypeError)) sig
-         , Member (State TypeMap) sig
-         , Carrier sig m
+instance ( Has Fresh sig m
+         , Has (Reader ModuleInfo) sig m
+         , Has (Reader Span) sig m
+         , Has (Resumable (BaseError TypeError)) sig m
+         , Has (State TypeMap) sig m
+         , Algebra sig m
          , Monad m
          )
-      => Carrier (Abstract.Array Type :+: sig) (ArrayC Type m) where
-  eff (R other) = ArrayC . eff . handleCoercible $ other
-  eff (L (Abstract.Array fieldTypes k)) = do
+      => Algebra (Abstract.Array Type :+: sig) (ArrayC Type m) where
+  alg (R other) = ArrayC . alg . handleCoercible $ other
+  alg (L (Abstract.Array fieldTypes k)) = do
     var <- fresh
     fieldType <- foldr (\ t1 -> (unify t1 =<<)) (pure (Var var)) fieldTypes
     k (Array fieldType)
-  eff (L (Abstract.AsArray t k)) = do
+  alg (L (Abstract.AsArray t k)) = do
     field <- fresh
     unify t (Array (Var field)) >> k mempty
 
-instance ( Carrier sig m ) => Carrier (Abstract.Hash Type :+: sig) (HashC Type m) where
-  eff (R other) = HashC . eff . handleCoercible $ other
-  eff (L (Abstract.Hash t k)) = k (Hash t)
-  eff (L (Abstract.KvPair t1 t2 k)) = k (t1 :* t2)
+instance ( Algebra sig m ) => Algebra (Abstract.Hash Type :+: sig) (HashC Type m) where
+  alg (R other) = HashC . alg . handleCoercible $ other
+  alg (L (Abstract.Hash t k)) = k (Hash t)
+  alg (L (Abstract.KvPair t1 t2 k)) = k (t1 :* t2)
 
 
 instance AbstractHole Type where
@@ -399,12 +396,12 @@ instance AbstractIntro Type where
   null        = Null
 
 -- | Discard the value arguments (if any), constructing a 'Type' instead.
-instance ( Member Fresh sig
-         , Member (Reader ModuleInfo) sig
-         , Member (Reader Span) sig
-         , Member (Resumable (BaseError TypeError)) sig
-         , Member (State TypeMap) sig
-         , Carrier sig m
+instance ( Has Fresh sig m
+         , Has (Reader ModuleInfo) sig m
+         , Has (Reader Span) sig m
+         , Has (Resumable (BaseError TypeError)) sig m
+         , Has (State TypeMap) sig m
+         , Algebra sig m
          )
       => AbstractValue term address Type m where
   tuple fields = pure $ zeroOrMoreProduct fields

src/Data/Blob.hs

@@ -94,7 +94,7 @@ decodeBlobs = fmap blobs <$> eitherDecode
 newtype NoLanguageForBlob = NoLanguageForBlob FilePath
   deriving (Eq, Exception, Ord, Show)
 
-noLanguageForBlob :: (Member (Error SomeException) sig, Carrier sig m) => FilePath -> m a
+noLanguageForBlob :: Has (Error SomeException) sig m => FilePath -> m a
 noLanguageForBlob blobPath = throwError (SomeException (NoLanguageForBlob blobPath))
 
 -- | Represents a blobs suitable for diffing which can be either a blob to

src/Data/Blob/IO.hs

@@ -25,10 +25,10 @@ readBlobFromFile (File path language) = do
   pure . Just . sourceBlob path language . Source.fromUTF8 $ raw
 
 -- | Read a utf8-encoded file to a 'Blob', raising an IOError if it can't be found.
-readBlobFromFile' :: MonadIO m => File -> m Blob
+readBlobFromFile' :: (MonadFail m, MonadIO m) => File -> m Blob
 readBlobFromFile' file = do
   maybeFile <- readBlobFromFile file
-  maybeM (Prelude.fail ("cannot read '" <> show file <> "', file not found or language not supported.")) maybeFile
+  maybeM (fail ("cannot read '" <> show file <> "', file not found or language not supported.")) maybeFile
 
 -- | Read all blobs in the directory with Language.supportedExts.
 readBlobsFromDir :: MonadIO m => Path.AbsRelDir -> m [Blob]

src/Data/Error.hs

@@ -14,7 +14,6 @@ module Data.Error
 import Prologue
 
 import Data.ByteString.Char8 (unpack)
-import Data.Ix (inRange)
 import Data.List (intersperse, isSuffixOf)
 import System.Console.ANSI
 

src/Data/Graph.hs

@@ -20,7 +20,7 @@ import qualified Algebra.Graph.AdjacencyMap as A
 import           Algebra.Graph.Class (connect, overlay, vertex)
 import qualified Algebra.Graph.Class as Class
 import qualified Algebra.Graph.ToGraph as Class
-import           Control.Effect.State
+import           Control.Carrier.State.Strict
 import           Control.Lens (view)
 import           Data.Aeson
 import qualified Data.Set as Set
@@ -50,7 +50,7 @@ topologicalSort = go . Class.toAdjacencyMap . G.transpose . unGraph
           . traverse_ visit
           . A.vertexList
           $ graph
-          where visit :: (Member (State (Visited v)) sig, Carrier sig m) => v -> m ()
+          where visit :: Has (State (Visited v)) sig m => v -> m ()
                 visit v = do
                   isMarked <- Set.member v . visitedVertices <$> get
                   if isMarked then

src/Data/Graph/ControlFlowVertex.hs

@@ -20,7 +20,6 @@ import           Data.Abstract.Name
 import           Data.Abstract.Package (PackageInfo (..))
 import           Data.Aeson
 import           Data.Graph (VertexTag (..))
-import qualified Data.Graph as G
 import           Data.Quieterm (Quieterm(..))
 import qualified Data.Syntax as Syntax
 import qualified Data.Syntax.Declaration as Declaration

src/Data/JSON/Fields.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE DefaultSignatures, FlexibleContexts, FlexibleInstances, GADTs, MultiParamTypeClasses, OverloadedStrings, RecordWildCards, TypeApplications, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DefaultSignatures, FlexibleContexts, FlexibleInstances, GADTs, MultiParamTypeClasses, OverloadedStrings,
+             RecordWildCards, TypeApplications, TypeOperators, UndecidableInstances #-}
 module Data.JSON.Fields
   ( JSONFields (..)
   , JSONFields1 (..)
@@ -10,7 +11,6 @@ module Data.JSON.Fields
 import           Data.Aeson
 import           Data.Edit
 import qualified Data.Map as Map
-import           Data.Sum (Apply (..), Sum)
 import qualified Data.Text as Text
 import           GHC.Generics
 import           Prologue

src/Data/Syntax/Declaration.hs

@@ -9,7 +9,6 @@ import qualified Data.Set as Set
 
 import           Control.Abstract hiding (AccessControl (..), Function)
 import           Data.Abstract.Evaluatable
-import           Data.Abstract.Name (__self)
 import qualified Data.Abstract.ScopeGraph as ScopeGraph
 import           Data.JSON.Fields
 import           Diffing.Algorithm
@@ -39,12 +38,11 @@ instance Evaluatable Function where
     v <- function name params functionBody associatedScope
     v <$ assign addr v
 
-declareFunction :: ( Carrier sig m
-                   , Member (State (ScopeGraph address)) sig
-                   , Member (Allocator address) sig
-                   , Member (Reader (CurrentScope address)) sig
-                   , Member (Reader ModuleInfo) sig
-                   , Member Fresh sig
+declareFunction :: ( Has (State (ScopeGraph address)) sig m
+                   , Has (Allocator address) sig m
+                   , Has (Reader (CurrentScope address)) sig m
+                   , Has (Reader ModuleInfo) sig m
+                   , Has Fresh sig m
                    , Ord address
                    )
                 => Maybe Name

src/Data/Syntax/Expression.hs

@@ -4,8 +4,8 @@ module Data.Syntax.Expression (module Data.Syntax.Expression) where
 import Prelude hiding (null)
 import Prologue hiding (index, null)
 
-import           Control.Abstract hiding (Bitwise (..), Call, Member)
-import           Data.Abstract.Evaluatable as Abstract hiding (Member)
+import           Control.Abstract hiding (Bitwise (..), Call)
+import           Data.Abstract.Evaluatable as Abstract
 import           Data.Abstract.Name as Name
 import           Data.Abstract.Number (liftIntegralFrac, liftReal, liftedExponent, liftedFloorDiv)
 import           Data.Fixed

src/Data/Syntax/Statement.hs

@@ -3,8 +3,8 @@ module Data.Syntax.Statement (module Data.Syntax.Statement) where
 
 import Prologue
 
-import           Control.Abstract hiding (Break, Continue, Return, While)
-import           Data.Abstract.Evaluatable as Abstract
+import           Control.Abstract hiding (Break, Catch, Continue, Return, Throw, While)
+import           Data.Abstract.Evaluatable as Abstract hiding (Catch, Throw)
 import           Data.Aeson (ToJSON1 (..))
 import           Data.JSON.Fields
 import qualified Data.Abstract.ScopeGraph as ScopeGraph

src/Diffing/Algorithm.hs

@@ -14,7 +14,7 @@ module Diffing.Algorithm
   , algorithmForTerms
   ) where
 
-import Control.Effect.Carrier hiding ((:+:))
+import Control.Algebra hiding ((:+:))
 import Control.Effect.NonDet
 import qualified Data.Diff as Diff
 import qualified Data.Edit as Edit
@@ -45,53 +45,53 @@ instance Effect   (Diff term1 term2 diff)
 newtype Algorithm term1 term2 diff m a = Algorithm { runAlgorithm :: m a }
   deriving (Applicative, Alternative, Functor, Monad)
 
-instance Carrier sig m => Carrier sig (Algorithm term1 term2 diff m) where
-  eff = Algorithm . eff . handleCoercible
+instance Algebra sig m => Algebra sig (Algorithm term1 term2 diff m) where
+  alg = Algorithm . alg . handleCoercible
 
 
 -- DSL
 
 -- | Diff two terms without specifying the algorithm to be used.
-diff :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => term1 -> term2 -> m diff
+diff :: Has (Diff term1 term2 diff) sig m => term1 -> term2 -> m diff
 diff a1 a2 = send (Diff a1 a2 pure)
 
 -- | Diff an 'Edit.Edit' of terms without specifying the algorithm to be used.
-diffEdit :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => Edit.Edit term1 term2 -> Algorithm term1 term2 diff m diff
+diffEdit :: Has (Diff term1 term2 diff) sig m => Edit.Edit term1 term2 -> Algorithm term1 term2 diff m diff
 diffEdit = Edit.edit byDeleting byInserting diff
 
 -- | Diff a pair of optional terms without specifying the algorithm to be used.
-diffMaybe :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => Maybe term1 -> Maybe term2 -> Algorithm term1 term2 diff m (Maybe diff)
+diffMaybe :: Has (Diff term1 term2 diff) sig m => Maybe term1 -> Maybe term2 -> Algorithm term1 term2 diff m (Maybe diff)
 diffMaybe (Just a1) (Just a2) = Just <$> diff a1 a2
 diffMaybe (Just a1) _         = Just <$> byDeleting a1
 diffMaybe _         (Just a2) = Just <$> byInserting a2
 diffMaybe _         _         = pure Nothing
 
 -- | Diff two terms linearly.
-linearly :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => term1 -> term2 -> Algorithm term1 term2 diff m diff
+linearly :: Has (Diff term1 term2 diff) sig m => term1 -> term2 -> Algorithm term1 term2 diff m diff
 linearly f1 f2 = send (Linear f1 f2 pure)
 
 -- | Diff two terms using RWS.
-byRWS :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => [term1] -> [term2] -> Algorithm term1 term2 diff m [diff]
+byRWS :: Has (Diff term1 term2 diff) sig m => [term1] -> [term2] -> Algorithm term1 term2 diff m [diff]
 byRWS as1 as2 = send (RWS as1 as2 pure)
 
 -- | Delete a term.
-byDeleting :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => term1 -> Algorithm term1 term2 diff m diff
+byDeleting :: Has (Diff term1 term2 diff) sig m => term1 -> Algorithm term1 term2 diff m diff
 byDeleting a1 = sendDiff (Delete a1 pure)
 
 -- | Insert a term.
-byInserting :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => term2 -> Algorithm term1 term2 diff m diff
+byInserting :: Has (Diff term1 term2 diff) sig m => term2 -> Algorithm term1 term2 diff m diff
 byInserting a2 = sendDiff (Insert a2 pure)
 
 -- | Replace one term with another.
-byReplacing :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => term1 -> term2 -> Algorithm term1 term2 diff m diff
+byReplacing :: Has (Diff term1 term2 diff) sig m => term1 -> term2 -> Algorithm term1 term2 diff m diff
 byReplacing a1 a2 = send (Replace a1 a2 pure)
 
-sendDiff :: (Carrier sig m, Member (Diff term1 term2 diff) sig) => Diff term1 term2 diff m a -> Algorithm term1 term2 diff m a
+sendDiff :: Has (Diff term1 term2 diff) sig m => Diff term1 term2 diff m a -> Algorithm term1 term2 diff m a
 sendDiff = Algorithm . send
 
 
 -- | Diff two terms based on their 'Diffable' instances, performing substructural comparisons iff the initial comparison fails.
-algorithmForTerms :: (Carrier sig m, Diffable syntax, Member (Diff (Term syntax ann1) (Term syntax ann2) (Diff.Diff syntax ann1 ann2)) sig, Member NonDet sig, Alternative m)
+algorithmForTerms :: (Diffable syntax, Has (Diff (Term syntax ann1) (Term syntax ann2) (Diff.Diff syntax ann1 ann2)) sig m, Has NonDet sig m, Alternative m)
                   => Term syntax ann1
                   -> Term syntax ann2
                   -> Algorithm (Term syntax ann1) (Term syntax ann2) (Diff.Diff syntax ann1 ann2) m (Diff.Diff syntax ann1 ann2)
@@ -134,12 +134,12 @@ instance Alternative Equivalence where
 -- | A type class for determining what algorithm to use for diffing two terms.
 class Diffable f where
   -- | Construct an algorithm to diff a pair of @f@s populated with disjoint terms.
-  algorithmFor :: (Alternative m, Carrier sig m, Member (Diff term1 term2 diff) sig, Member NonDet sig)
+  algorithmFor :: (Alternative m, Has (Diff term1 term2 diff) sig m, Has NonDet sig m)
                => f term1
                -> f term2
                -> Algorithm term1 term2 diff m (f diff)
   default
-    algorithmFor :: (Alternative m, Carrier sig m, Generic1 f, GDiffable (Rep1 f), Member (Diff term1 term2 diff) sig, Member NonDet sig)
+    algorithmFor :: (Alternative m, Generic1 f, GDiffable (Rep1 f), Has (Diff term1 term2 diff) sig m, Has NonDet sig m)
                  => f term1
                  -> f term2
                  -> Algorithm term1 term2 diff m (f diff)
@@ -182,7 +182,7 @@ class Diffable f where
   default comparableTo :: (Generic1 f, GDiffable (Rep1 f)) => f term1 -> f term2 -> Bool
   comparableTo = genericComparableTo
 
-genericAlgorithmFor :: (Alternative m, Carrier sig m, Generic1 f, GDiffable (Rep1 f), Member (Diff term1 term2 diff) sig, Member NonDet sig)
+genericAlgorithmFor :: (Alternative m, Generic1 f, GDiffable (Rep1 f),Has (Diff term1 term2 diff) sig m, Has NonDet sig m)
                     => f term1
                     -> f term2
                     -> Algorithm term1 term2 diff m (f diff)
@@ -230,7 +230,7 @@ instance Diffable NonEmpty where
 
 -- | A generic type class for diffing two terms defined by the Generic1 interface.
 class GDiffable f where
-  galgorithmFor :: (Alternative m, Carrier sig m, Member (Diff term1 term2 diff) sig, Member NonDet sig) => f term1 -> f term2 -> Algorithm term1 term2 diff m (f diff)
+  galgorithmFor :: (Alternative m, Has (Diff term1 term2 diff) sig m, Has NonDet sig m) => f term1 -> f term2 -> Algorithm term1 term2 diff m (f diff)
 
   gtryAlignWith :: Alternative g => (Edit.Edit a1 a2 -> g b) -> f a1 -> f a2 -> g (f b)
 

src/Diffing/Interpreter.hs

@@ -5,9 +5,8 @@ module Diffing.Interpreter
 , stripDiff
 ) where
 
-import Control.Effect.Carrier
-import Control.Effect.Cull
-import Control.Effect.NonDet
+import Control.Algebra
+import Control.Carrier.Cull.Church
 import qualified Data.Diff as Diff
 import Data.Edit (Edit, edit)
 import Data.Term
@@ -20,7 +19,7 @@ diffTerms :: (Diffable syntax, Eq1 syntax, Hashable1 syntax, Traversable syntax)
           => Term syntax ann1
           -> Term syntax ann2
           -> Diff.Diff syntax ann1 ann2
-diffTerms t1 t2 = stripDiff (fromMaybe (Diff.comparing t1' t2') (run (runNonDetOnce (runDiff (algorithmForTerms t1' t2')))))
+diffTerms t1 t2 = stripDiff (fromMaybe (Diff.comparing t1' t2') (run (runCullA (cull (runDiff (algorithmForTerms t1' t2'))))))
   where (t1', t2') = ( defaultFeatureVectorDecorator t1
                      , defaultFeatureVectorDecorator t2)
 
@@ -54,21 +53,19 @@ newtype DiffC term1 term2 diff m a = DiffC { runDiffC :: m a }
   deriving (Alternative, Applicative, Functor, Monad, MonadIO)
 
 instance ( Alternative m
-         , Carrier sig m
          , Diffable syntax
          , Eq1 syntax
-         , Member NonDet sig
-         , Monad m
+         , Has NonDet sig m
          , Traversable syntax
          )
-      => Carrier
+      => Algebra
         (Diff (Term syntax (FeatureVector, ann1)) (Term syntax (FeatureVector, ann2)) (Diff.Diff syntax (FeatureVector, ann1) (FeatureVector, ann2)) :+: sig)
         (DiffC (Term syntax (FeatureVector, ann1)) (Term syntax (FeatureVector, ann2)) (Diff.Diff syntax (FeatureVector, ann1) (FeatureVector, ann2)) m) where
-  eff (L op) = case op of
+  alg (L op) = case op of
     Diff t1 t2 k -> runDiff (algorithmForTerms t1 t2) <|> pure (Diff.comparing t1 t2) >>= k
     Linear (Term (In ann1 f1)) (Term (In ann2 f2)) k -> Diff.merge (ann1, ann2) <$> tryAlignWith (runDiff . diffEdit) f1 f2 >>= k
     RWS as bs k -> traverse (runDiff . diffEdit) (rws comparableTerms equivalentTerms as bs) >>= k
     Delete a k -> k (Diff.deleting a)
     Insert b k -> k (Diff.inserting b)
     Replace a b k -> k (Diff.comparing a b)
-  eff (R other) = DiffC . eff . handleCoercible $ other
+  alg (R other) = DiffC . alg . handleCoercible $ other

src/Language/Go/Syntax.hs

@@ -19,13 +19,12 @@ import qualified Data.Text as T
 import           Diffing.Algorithm
 import           System.FilePath.Posix
 
-resolveGoImport :: ( Member (Modules address value) sig
-                   , Member (Reader ModuleInfo) sig
-                   , Member (Reader Package.PackageInfo) sig
-                   , Member (Reader Span) sig
-                   , Member (Resumable (BaseError ResolutionError)) sig
-                   , Member Trace sig
-                   , Carrier sig m
+resolveGoImport :: ( Has (Modules address value) sig m
+                   , Has (Reader ModuleInfo) sig m
+                   , Has (Reader Package.PackageInfo) sig m
+                   , Has (Reader Span) sig m
+                   , Has (Resumable (BaseError ResolutionError)) sig m
+                   , Has Trace sig m
                    )
                 => ImportPath
                 -> Evaluator term address value m [ModulePath]

src/Language/PHP/Syntax.hs

@@ -44,11 +44,10 @@ instance Evaluatable VariableName
 -- file, the complete contents of the included file are treated as though it
 -- were defined inside that function.
 
-resolvePHPName :: ( Member (Modules address value) sig
-                  , Member (Reader ModuleInfo) sig
-                  , Member (Reader Span) sig
-                  , Member (Resumable (BaseError ResolutionError)) sig
-                  , Carrier sig m
+resolvePHPName :: ( Has (Modules address value) sig m
+                  , Has (Reader ModuleInfo) sig m
+                  , Has (Reader Span) sig m
+                  , Has (Resumable (BaseError ResolutionError)) sig m
                   )
                => T.Text
                -> Evaluator term address value m ModulePath
@@ -58,18 +57,17 @@ resolvePHPName n = do
   where name = toName n
         toName = T.unpack . dropRelativePrefix . stripQuotes
 
-include :: ( Carrier sig m
-           , Member (Modules address value) sig
-           , Member (Reader (CurrentFrame address)) sig
-           , Member (Reader (CurrentScope address)) sig
-           , Member (Reader ModuleInfo) sig
-           , Member (Reader Span) sig
-           , Member (Resumable (BaseError (HeapError address))) sig
-           , Member (State (ScopeGraph address)) sig
-           , Member (Resumable (BaseError ResolutionError)) sig
-           , Member (State (Heap address address value)) sig
-           , Member (Abstract.String value) sig
-           , Member Trace sig
+include :: ( Has (Modules address value) sig m
+           , Has (Reader (CurrentFrame address)) sig m
+           , Has (Reader (CurrentScope address)) sig m
+           , Has (Reader ModuleInfo) sig m
+           , Has (Reader Span) sig m
+           , Has (Resumable (BaseError (HeapError address))) sig m
+           , Has (State (ScopeGraph address)) sig m
+           , Has (Resumable (BaseError ResolutionError)) sig m
+           , Has (State (Heap address address value)) sig m
+           , Has (Abstract.String value) sig m
+           , Has Trace sig m
            , Ord address
            )
         => (term -> Evaluator term address value m value)

src/Language/Python/Syntax.hs

@@ -56,12 +56,11 @@ relativeQualifiedName prefix paths = RelativeQualifiedName (T.unpack prefix) (Ju
 -- Subsequent imports of `parent.two` or `parent.three` will execute
 --     `parent/two/__init__.py` and
 --     `parent/three/__init__.py` respectively.
-resolvePythonModules :: ( Member (Modules address value) sig
-                        , Member (Reader ModuleInfo) sig
-                        , Member (Reader Span) sig
-                        , Member (Resumable (BaseError ResolutionError)) sig
-                        , Member Trace sig
-                        , Carrier sig m
+resolvePythonModules :: ( Has (Modules address value) sig m
+                        , Has (Reader ModuleInfo) sig m
+                        , Has (Reader Span) sig m
+                        , Has (Resumable (BaseError ResolutionError)) sig m
+                        , Has Trace sig m
                         )
                      => QualifiedName
                      -> Evaluator term address value m (NonEmpty ModulePath)

src/Language/Ruby/Assignment.hs

@@ -12,7 +12,6 @@ import           Assigning.Assignment hiding (Assignment, Error)
 import qualified Assigning.Assignment as Assignment
 import           Data.Abstract.Name (name)
 import qualified Data.Abstract.ScopeGraph as ScopeGraph (AccessControl(..))
-import           Data.List (elem)
 import qualified Data.List.NonEmpty as NonEmpty
 import           Data.Syntax
     ( contextualize

src/Language/Ruby/Syntax.hs

@@ -4,10 +4,6 @@ module Language.Ruby.Syntax (module Language.Ruby.Syntax) where
 import Prologue
 
 import           Control.Abstract as Abstract hiding (Load, String)
-import           Control.Abstract.Heap (Heap, HeapError, insertFrameLink)
-import           Control.Abstract.ScopeGraph (insertImportEdge)
-import           Control.Abstract.Value (Boolean)
-import           Control.Monad (unless)
 import           Data.Abstract.BaseError
 import           Data.Abstract.Evaluatable
 import qualified Data.Abstract.Module as M
@@ -26,11 +22,10 @@ import           System.FilePath.Posix
 -- TODO: Fully sort out ruby require/load mechanics
 --
 -- require "json"
-resolveRubyName :: ( Member (Modules address value) sig
-                   , Member (Reader ModuleInfo) sig
-                   , Member (Reader Span) sig
-                   , Member (Resumable (BaseError ResolutionError)) sig
-                   , Carrier sig m
+resolveRubyName :: ( Has (Modules address value) sig m
+                   , Has (Reader ModuleInfo) sig m
+                   , Has (Reader Span) sig m
+                   , Has (Resumable (BaseError ResolutionError)) sig m
                    )
                 => Text
                 -> Evaluator term address value m M.ModulePath
@@ -41,11 +36,10 @@ resolveRubyName name = do
   maybeM (throwResolutionError $ NotFoundError name' paths Language.Ruby) modulePath
 
 -- load "/root/src/file.rb"
-resolveRubyPath :: ( Member (Modules address value) sig
-                   , Member (Reader ModuleInfo) sig
-                   , Member (Reader Span) sig
-                   , Member (Resumable (BaseError ResolutionError)) sig
-                   , Carrier sig m
+resolveRubyPath :: ( Has (Modules address value) sig m
+                   , Has (Reader ModuleInfo) sig m
+                   , Has (Reader Span) sig m
+                   , Has (Resumable (BaseError ResolutionError)) sig m
                    )
                 => Text
                 -> Evaluator term address value m M.ModulePath
@@ -101,9 +95,8 @@ instance Evaluatable Require where
     insertFrameLink ScopeGraph.Import (Map.singleton moduleScope moduleFrame)
     pure v -- Returns True if the file was loaded, False if it was already loaded. http://ruby-doc.org/core-2.5.0/Kernel.html#method-i-require
 
-doRequire :: ( Member (Boolean value) sig
-             , Member (Modules address value) sig
-             , Carrier sig m
+doRequire :: ( Has (Boolean value) sig m
+             , Has (Modules address value) sig m
              )
           => M.ModulePath
           -> Evaluator term address value m ((address, address), value)
@@ -130,19 +123,18 @@ instance Evaluatable Load where
     shouldWrap <- eval wrap >>= asBool
     doLoad path shouldWrap
 
-doLoad :: ( Member (Boolean value) sig
-          , Member (Modules address value) sig
-          , Member (Reader (CurrentFrame address)) sig
-          , Member (Reader (CurrentScope address)) sig
-          , Member (Reader ModuleInfo) sig
-          , Member (Reader Span) sig
-          , Member (Resumable (BaseError ResolutionError)) sig
-          , Member (State (ScopeGraph.ScopeGraph address)) sig
-          , Member (State (Heap address address value)) sig
-          , Member (Resumable (BaseError (HeapError address))) sig
-          , Member Trace sig
+doLoad :: ( Has (Boolean value) sig m
+          , Has (Modules address value) sig m
+          , Has (Reader (CurrentFrame address)) sig m
+          , Has (Reader (CurrentScope address)) sig m
+          , Has (Reader ModuleInfo) sig m
+          , Has (Reader Span) sig m
+          , Has (Resumable (BaseError ResolutionError)) sig m
+          , Has (State (ScopeGraph.ScopeGraph address)) sig m
+          , Has (State (Heap address address value)) sig m
+          , Has (Resumable (BaseError (HeapError address))) sig m
+          , Has Trace sig m
           , Ord address
-          , Carrier sig m
           )
        => Text
        -> Bool

src/Language/TypeScript/Resolution.hs

@@ -26,13 +26,12 @@ import qualified Data.Language as Language
 --
 -- NB: TypeScript has a couple of different strategies, but the main one (and the
 -- only one we support) mimics Node.js.
-resolveWithNodejsStrategy :: ( Member (Modules address value) sig
-                             , Member (Reader M.ModuleInfo) sig
-                             , Member (Reader PackageInfo) sig
-                             , Member (Reader Span) sig
-                             , Member (Resumable (BaseError ResolutionError)) sig
-                             , Member Trace sig
-                             , Carrier sig m
+resolveWithNodejsStrategy :: ( Has (Modules address value) sig m
+                             , Has (Reader M.ModuleInfo) sig m
+                             , Has (Reader PackageInfo) sig m
+                             , Has (Reader Span) sig m
+                             , Has (Resumable (BaseError ResolutionError)) sig m
+                             , Has Trace sig m
                              )
                           => ImportPath
                           -> [String]
@@ -47,13 +46,12 @@ resolveWithNodejsStrategy (ImportPath path _)    exts        = resolveRelativePa
 -- /root/src/moduleB.ts
 -- /root/src/moduleB/package.json (if it specifies a "types" property)
 -- /root/src/moduleB/index.ts
-resolveRelativePath :: ( Member (Modules address value) sig
-                       , Member (Reader M.ModuleInfo) sig
-                       , Member (Reader PackageInfo) sig
-                       , Member (Reader Span) sig
-                       , Member (Resumable (BaseError ResolutionError)) sig
-                       , Member Trace sig
-                       , Carrier sig m
+resolveRelativePath :: ( Has (Modules address value) sig m
+                       , Has (Reader M.ModuleInfo) sig m
+                       , Has (Reader PackageInfo) sig m
+                       , Has (Reader Span) sig m
+                       , Has (Resumable (BaseError ResolutionError)) sig m
+                       , Has Trace sig m
                        )
                     => FilePath
                     -> [String]
@@ -77,13 +75,12 @@ resolveRelativePath relImportPath exts = do
 --
 -- /root/node_modules/moduleB.ts, etc
 -- /node_modules/moduleB.ts, etc
-resolveNonRelativePath :: ( Member (Modules address value) sig
-                          , Member (Reader M.ModuleInfo) sig
-                          , Member (Reader PackageInfo) sig
-                          , Member (Reader Span) sig
-                          , Member (Resumable (BaseError ResolutionError)) sig
-                          , Member Trace sig
-                          , Carrier sig m
+resolveNonRelativePath :: ( Has (Modules address value) sig m
+                          , Has (Reader M.ModuleInfo) sig m
+                          , Has (Reader PackageInfo) sig m
+                          , Has (Reader Span) sig m
+                          , Has (Resumable (BaseError ResolutionError)) sig m
+                          , Has Trace sig m
                           )
                        => FilePath
                        -> [String]
@@ -104,10 +101,9 @@ resolveNonRelativePath name exts = do
     notFound xs = throwResolutionError $ NotFoundError name xs Language.TypeScript
 
 -- | Resolve a module name to a ModulePath.
-resolveModule :: ( Member (Modules address value) sig
-                 , Member (Reader PackageInfo) sig
-                 , Member Trace sig
-                 , Carrier sig m
+resolveModule :: ( Has (Modules address value) sig m
+                 , Has (Reader PackageInfo) sig m
+                 , Has Trace sig m
                  )
               => FilePath -- ^ Module path used as directory to search in
               -> [String] -- ^ File extensions to look for

src/Language/TypeScript/Syntax/TypeScript.hs

@@ -5,7 +5,6 @@ import Prologue
 
 import           Control.Abstract hiding (Import)
 import           Data.Abstract.Evaluatable as Evaluatable
-import           Data.Abstract.ScopeGraph (AccessControl (..))
 import           Data.JSON.Fields
 import qualified Data.Map.Strict as Map
 import           Data.Semigroup.App
@@ -237,23 +236,22 @@ instance Ord1 Module where liftCompare = genericLiftCompare
 instance Show1 Module where liftShowsPrec = genericLiftShowsPrec
 
 declareModule :: ( AbstractValue term address value m
-                 , Carrier sig m
                  , Declarations term
-                 , Member (Allocator address) sig
-                 , Member (Deref value) sig
-                 , Member (Object address value) sig
-                 , Member (Reader (CurrentFrame address)) sig
-                 , Member (Reader (CurrentScope address)) sig
-                 , Member (Reader Span) sig
-                 , Member (Resumable (BaseError (EvalError term address value))) sig
-                 , Member (State (Heap address address value)) sig
-                 , Member (State (ScopeGraph address)) sig
-                 , Member Fresh sig
-                 , Member (Reader ModuleInfo) sig
-                 , Member (Resumable (BaseError (AddressError address value))) sig
-                 , Member (Resumable (BaseError (HeapError address))) sig
-                 , Member (Resumable (BaseError (ScopeError address))) sig
-                 , Member (Unit value) sig
+                 , Has (Allocator address) sig m
+                 , Has (Deref value) sig m
+                 , Has (Object address value) sig m
+                 , Has (Reader (CurrentFrame address)) sig m
+                 , Has (Reader (CurrentScope address)) sig m
+                 , Has (Reader Span) sig m
+                 , Has (Resumable (BaseError (EvalError term address value))) sig m
+                 , Has (State (Heap address address value)) sig m
+                 , Has (State (ScopeGraph address)) sig m
+                 , Has Fresh sig m
+                 , Has (Reader ModuleInfo) sig m
+                 , Has (Resumable (BaseError (AddressError address value))) sig m
+                 , Has (Resumable (BaseError (HeapError address))) sig m
+                 , Has (Resumable (BaseError (ScopeError address))) sig m
+                 , Has (Unit value) sig m
                  , Ord address
                  )
                 => (term -> Evaluator term address value m value)

src/Parsing/TreeSitter.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE DataKinds, DeriveGeneric, FlexibleContexts, GADTs, LambdaCase, RecordWildCards, ScopedTypeVariables, TypeOperators #-}
+{-# LANGUAGE DataKinds, DeriveGeneric, FlexibleContexts, GADTs, LambdaCase, RecordWildCards, ScopedTypeVariables,
+             TypeOperators #-}
 module Parsing.TreeSitter
 ( TSParseException (..)
 , Duration(..)
@@ -8,13 +9,11 @@ module Parsing.TreeSitter
 
 import Prologue
 
-import           Control.Effect.Fail
-import           Control.Effect.Lift
-import           Control.Effect.Reader
+import           Control.Carrier.Fail.Either
+import           Control.Carrier.Reader
 import qualified Control.Exception as Exc
 import           Foreign
 import           Foreign.C.Types (CBool (..))
-import           Foreign.Marshal.Array (allocaArray)
 
 import           Data.AST (AST, Node (Node))
 import           Data.Blob
@@ -59,7 +58,7 @@ parseToPreciseAST
   -> m (Either TSParseException (t Loc))
 parseToPreciseAST parseTimeout language blob = runParse parseTimeout language blob $ \ rootPtr ->
   TS.withCursor (castPtr rootPtr) $ \ cursor ->
-    runM (runFail (runReader cursor (runReader (Source.bytes (blobSource blob)) (TS.peekNode >>= TS.unmarshalNode))))
+    runFail (runReader cursor (runReader (Source.bytes (blobSource blob)) (TS.peekNode >>= TS.unmarshalNode)))
       >>= either (Exc.throw . UnmarshalFailure) pure
 
 instance Exception TSParseException where

src/Prologue.hs

@@ -2,39 +2,38 @@
 module Prologue
   ( module X
   , eitherM
-  , foldMapA
   , maybeM
   , maybeLast
   , fromMaybeLast
   ) where
 
 
-import Debug.Trace as X (traceShowM, traceM)
 import Data.Bifunctor.Join as X
 import Data.Bits as X
 import Data.ByteString as X (ByteString)
 import Data.Coerce as X
-import Data.Int as X (Int8, Int16, Int32, Int64)
 import Data.Either as X (fromLeft, fromRight)
+import Data.Int as X (Int16, Int32, Int64, Int8)
 import Data.IntMap as X (IntMap)
 import Data.IntSet as X (IntSet)
 import Data.Ix as X (Ix (..))
 import Data.List.NonEmpty as X (NonEmpty (..), nonEmpty, some1)
 import Data.Map as X (Map)
 import Data.Maybe as X
-import Data.Monoid (Alt (..))
+import Data.Semilattice.Lower as X (Lower (..))
 import Data.Sequence as X (Seq)
-import Data.Semilattice.Lower as X (Lower(..))
 import Data.Set as X (Set)
-import Data.Sum as X (Sum, Element, Elements, (:<), (:<:), Apply (..), inject)
+import Data.Sum as X ((:<), (:<:), Apply (..), Element, Elements, Sum, inject)
 import Data.Text as X (Text)
-import Data.Word as X (Word8, Word16, Word32, Word64)
+import Data.Word as X (Word16, Word32, Word64, Word8)
+import Debug.Trace as X (traceM, traceShowM)
 
 import Control.Exception as X hiding (Handler (..), assert, evaluate, throw, throwIO, throwTo)
 
 -- Typeclasses
 import Control.Applicative as X
 import Control.Arrow as X ((&&&), (***))
+import Control.Effect.NonDet as X (foldMapA)
 import Control.Monad as X hiding (fail, return)
 import Control.Monad.Fail as X (MonadFail (..))
 import Control.Monad.IO.Class as X (MonadIO (..))
@@ -44,15 +43,14 @@ import Data.Bifunctor as X (Bifunctor (..))
 import Data.Bitraversable as X
 import Data.Foldable as X hiding (product, sum)
 import Data.Function as X (fix, on, (&))
-import Data.Functor as X (void, ($>))
+import Data.Functor as X (($>))
 import Data.Functor.Classes as X
 import Data.Functor.Classes.Generic as X
 import Data.Functor.Foldable as X (Base, Corecursive (..), Recursive (..))
 import Data.Hashable as X (Hashable, hash, hashUsing, hashWithSalt)
-import Data.Hashable.Lifted as X (Hashable1(..), hashWithSalt1)
+import Data.Hashable.Lifted as X (Hashable1 (..), hashWithSalt1)
 import Data.Monoid as X (First (..), Last (..), Monoid (..))
 import Data.Monoid.Generic as X
-import Data.Profunctor.Unsafe
 import Data.Proxy as X (Proxy (..))
 import Data.Semigroup as X (Semigroup (..))
 import Data.Traversable as X
@@ -62,11 +60,6 @@ import Data.Typeable as X (Typeable)
 import GHC.Generics as X (Generic, Generic1)
 import GHC.Stack as X
 
--- | Fold a collection by mapping each element onto an 'Alternative' action.
-foldMapA :: (Alternative m, Foldable t) => (b -> m a) -> t b -> m a
-foldMapA f = getAlt #. foldMap (Alt #. f)
-{-# INLINE foldMapA #-}
-
 maybeLast :: Foldable t => b -> (a -> b) -> t a -> b
 maybeLast b f = maybe b f . getLast . foldMap (Last . Just)
 

src/Rendering/Graph.hs

@@ -8,10 +8,9 @@ module Rendering.Graph
 
 import Algebra.Graph.Export.Dot
 import Analysis.ConstructorName
-import Control.Effect.Fresh
-import Control.Effect.Pure
-import Control.Effect.Reader
-import Control.Effect.State
+import Control.Carrier.Fresh.Strict
+import Control.Carrier.Reader
+import Control.Carrier.State.Strict
 import Control.Lens
 import Data.Diff
 import Data.Edit
@@ -32,13 +31,14 @@ renderTreeGraph :: (Ord vertex, Recursive t, ToTreeGraph vertex (Base t)) => t -
 renderTreeGraph = simplify . runGraph . cata toTreeGraph
 
 runGraph :: ReaderC (Graph vertex)
-           (FreshC PureC) (Graph vertex)
+           (FreshC Identity) (Graph vertex)
          -> Graph vertex
 runGraph = run . runFresh' . runReader mempty
   where
     -- NB: custom runFresh so that we count starting at 1 in order to avoid
     -- default values for proto encoding.
     runFresh' = evalState 1 . runFreshC
+    runFreshC (FreshC a) = a
 
 -- | GraphViz styling for terms
 termStyle :: (IsString string, Monoid string) => String -> Style TermVertex string
@@ -62,7 +62,7 @@ diffStyle name = (defaultStyle (fromString . show . view diffVertexId))
           _                                -> []
 
 class ToTreeGraph vertex t | t -> vertex where
-  toTreeGraph :: (Member Fresh sig, Member (Reader (Graph vertex)) sig, Carrier sig m) => t (m (Graph vertex)) -> m (Graph vertex)
+  toTreeGraph :: (Has Fresh sig m, Has (Reader (Graph vertex)) sig m) => t (m (Graph vertex)) -> m (Graph vertex)
 
 instance (ConstructorName syntax, Foldable syntax) =>
   ToTreeGraph TermVertex (TermF syntax Loc) where
@@ -70,9 +70,8 @@ instance (ConstructorName syntax, Foldable syntax) =>
     termAlgebra ::
       ( ConstructorName syntax
       , Foldable syntax
-      , Member Fresh sig
-      , Member (Reader (Graph TermVertex)) sig
-      , Carrier sig m
+      , Has Fresh sig m
+      , Has (Reader (Graph TermVertex)) sig m
       )
       => TermF syntax Loc (m (Graph TermVertex))
       -> m (Graph TermVertex)
@@ -117,9 +116,8 @@ instance (ConstructorName syntax, Foldable syntax) =>
       ann a = converting #? Loc.span a
       diffAlgebra ::
         ( Foldable f
-        , Member Fresh sig
-        , Member (Reader (Graph DiffTreeVertex)) sig
-        , Carrier sig m
+        , Has Fresh sig m
+        , Has (Reader (Graph DiffTreeVertex)) sig m
         ) => f (m (Graph DiffTreeVertex)) -> DiffTreeVertex'DiffTerm -> m (Graph DiffTreeVertex)
       diffAlgebra syntax a = do
         i <- fresh

src/Rendering/JSON.hs

@@ -13,7 +13,6 @@ module Rendering.JSON
 , SomeJSON(..)
 ) where
 
-import Data.Aeson (ToJSON, toJSON, object, (.=))
 import Data.Aeson as A
 import Data.Blob
 import Data.JSON.Fields

src/Semantic/Analysis.hs

@@ -10,8 +10,9 @@ import Prologue
 import qualified Data.Map.Strict as Map
 
 import Control.Abstract as Abstract
-import Control.Abstract.ScopeGraph (runAllocator)
-import Control.Effect.Carrier
+import Control.Algebra
+import Control.Carrier.Error.Either
+import Control.Carrier.Reader
 import Control.Effect.Interpose
 import Data.Abstract.Evaluatable
 import Data.Abstract.Module
@@ -44,18 +45,18 @@ type DomainC term address value m
     m))))))))))
 
 -- | Evaluate a list of modules with the prelude for the passed language available, and applying the passed function to every module.
-evaluate :: ( Carrier outerSig outer
+evaluate :: ( Algebra outerSig outer
             , derefSig ~ (Deref value :+: allocatorSig)
             , derefC ~ DerefC address value allocatorC
-            , Carrier derefSig derefC
+            , Algebra derefSig derefC
             , allocatorSig ~ (Allocator address :+: Reader ModuleInfo :+: outerSig)
             , allocatorC ~ AllocatorC address (ReaderC ModuleInfo outer)
-            , Carrier allocatorSig allocatorC
+            , Algebra allocatorSig allocatorC
             , Effect outerSig
-            , Member Fresh outerSig
-            , Member (Reader (ModuleTable (Module (ModuleResult address value)))) outerSig
-            , Member (State (Heap address address value)) outerSig
-            , Member (State (ScopeGraph address)) outerSig
+            , Has Fresh outerSig outer
+            , Has (Reader (ModuleTable (Module (ModuleResult address value)))) outerSig outer
+            , Has (State (Heap address address value)) outerSig outer
+            , Has (State (ScopeGraph address)) outerSig outer
             , Ord address
             )
          => proxy (lang :: Language)
@@ -109,21 +110,21 @@ runDomainEffects :: ( AbstractValue term address value (DomainC term address val
                     , whileSig ~ (While value :+: booleanSig)
                     , functionC ~ FunctionC term address value whileC
                     , functionSig ~ (Function term address value :+: whileSig)
-                    , Carrier functionSig functionC
+                    , Algebra functionSig functionC
                     , HasPrelude lang
-                    , Member (Allocator address) sig
-                    , Member (Deref value) sig
-                    , Member Fresh sig
-                    , Member (Reader (CurrentFrame address)) sig
-                    , Member (Reader (CurrentScope address)) sig
-                    , Member (Reader ModuleInfo) sig
-                    , Member (Reader Span) sig
-                    , Member (Resumable (BaseError (AddressError address value))) sig
-                    , Member (Resumable (BaseError (HeapError address))) sig
-                    , Member (Resumable (BaseError (ScopeError address))) sig
-                    , Member (State (Heap address address value)) sig
-                    , Member (State (ScopeGraph address)) sig
-                    , Member Trace sig
+                    , Has (Allocator address) sig m
+                    , Has (Deref value) sig m
+                    , Has Fresh sig m
+                    , Has (Reader (CurrentFrame address)) sig m
+                    , Has (Reader (CurrentScope address)) sig m
+                    , Has (Reader ModuleInfo) sig m
+                    , Has (Reader Span) sig m
+                    , Has (Resumable (BaseError (AddressError address value))) sig m
+                    , Has (Resumable (BaseError (HeapError address))) sig m
+                    , Has (Resumable (BaseError (ScopeError address))) sig m
+                    , Has (State (Heap address address value)) sig m
+                    , Has (State (ScopeGraph address)) sig m
+                    , Has Trace sig m
                     , Ord address
                     , Show address
                     )
@@ -148,44 +149,43 @@ runDomainEffects runTerm
 -- | Evaluate a term recursively, applying the passed function at every recursive position.
 --
 --   This calls out to the 'Evaluatable' instances, and can have other functions composed after it to e.g. intercept effects arising in the evaluation of the term.
-evalTerm :: ( Carrier sig m
-            , AbstractValue term address value m
+evalTerm :: ( AbstractValue term address value m
             , AccessControls term
             , Declarations term
             , Evaluatable (Base term)
             , FreeVariables term
             , HasSpan term
-            , Member (Allocator address) sig
-            , Member (Bitwise value) sig
-            , Member (Boolean value) sig
-            , Member (Deref value) sig
-            , Member (Error (LoopControl value)) sig
-            , Member (Error (Return value)) sig
-            , Member (Function term address value) sig
-            , Member (Modules address value) sig
-            , Member (Numeric value) sig
-            , Member (Object address value) sig
-            , Member (Array value) sig
-            , Member (Hash value) sig
-            , Member (Reader ModuleInfo) sig
-            , Member (Reader PackageInfo) sig
-            , Member (Reader Span) sig
-            , Member (Resumable (BaseError (AddressError address value))) sig
-            , Member (Resumable (BaseError (HeapError address))) sig
-            , Member (Resumable (BaseError (ScopeError address))) sig
-            , Member (Resumable (BaseError (UnspecializedError address value))) sig
-            , Member (Resumable (BaseError (EvalError term address value))) sig
-            , Member (Resumable (BaseError ResolutionError)) sig
-            , Member (State (Heap address address value)) sig
-            , Member (State (ScopeGraph address)) sig
-            , Member (Abstract.String value) sig
-            , Member (Reader (CurrentFrame address)) sig
-            , Member (Reader (CurrentScope address)) sig
-            , Member (State Span) sig
-            , Member (Unit value) sig
-            , Member (While value) sig
-            , Member Fresh sig
-            , Member Trace sig
+            , Has (Allocator address) sig m
+            , Has (Bitwise value) sig m
+            , Has (Boolean value) sig m
+            , Has (Deref value) sig m
+            , Has (Error (LoopControl value)) sig m
+            , Has (Error (Return value)) sig m
+            , Has (Function term address value) sig m
+            , Has (Modules address value) sig m
+            , Has (Numeric value) sig m
+            , Has (Object address value) sig m
+            , Has (Array value) sig m
+            , Has (Hash value) sig m
+            , Has (Reader ModuleInfo) sig m
+            , Has (Reader PackageInfo) sig m
+            , Has (Reader Span) sig m
+            , Has (Resumable (BaseError (AddressError address value))) sig m
+            , Has (Resumable (BaseError (HeapError address))) sig m
+            , Has (Resumable (BaseError (ScopeError address))) sig m
+            , Has (Resumable (BaseError (UnspecializedError address value))) sig m
+            , Has (Resumable (BaseError (EvalError term address value))) sig m
+            , Has (Resumable (BaseError ResolutionError)) sig m
+            , Has (State (Heap address address value)) sig m
+            , Has (State (ScopeGraph address)) sig m
+            , Has (Abstract.String value) sig m
+            , Has (Reader (CurrentFrame address)) sig m
+            , Has (Reader (CurrentScope address)) sig m
+            , Has (State Span) sig m
+            , Has (Unit value) sig m
+            , Has (While value) sig m
+            , Has Fresh sig m
+            , Has Trace sig m
             , Ord address
             , Recursive term
             , Show address

src/Semantic/Api/Diffs.hs

@@ -49,25 +49,25 @@ data DiffOutputFormat
   | DiffDotGraph
   deriving (Eq, Show)
 
-parseDiffBuilder :: (Traversable t, Member (Error SomeException) sig, Member (Reader Config) sig, Member Telemetry sig, Member Distribute sig, Member Parse sig, Carrier sig m, MonadIO m) => DiffOutputFormat -> t BlobPair -> m Builder
+parseDiffBuilder :: (Traversable t, Has (Error SomeException) sig m, Has (Reader Config) sig m, Has Telemetry sig m, Has Distribute sig m, Has Parse sig m, MonadIO m) => DiffOutputFormat -> t BlobPair -> m Builder
 parseDiffBuilder DiffJSONTree    = distributeFoldMap jsonDiff >=> serialize Format.JSON -- NB: Serialize happens at the top level for these two JSON formats to collect results of multiple blob pairs.
 parseDiffBuilder DiffJSONGraph   = diffGraph >=> serialize Format.JSON
 parseDiffBuilder DiffSExpression = distributeFoldMap (parsePairWith diffParsers sexprDiff)
 parseDiffBuilder DiffShow        = distributeFoldMap (parsePairWith diffParsers showDiff)
 parseDiffBuilder DiffDotGraph    = distributeFoldMap (parsePairWith diffParsers dotGraphDiff)
 
-jsonDiff :: (Member (Error SomeException) sig, Member Telemetry sig, Member Parse sig, Carrier sig m, MonadIO m) => BlobPair -> m (Rendering.JSON.JSON "diffs" SomeJSON)
+jsonDiff :: (Has (Error SomeException) sig m, Has Telemetry sig m, Has Parse sig m, MonadIO m) => BlobPair -> m (Rendering.JSON.JSON "diffs" SomeJSON)
 jsonDiff blobPair = parsePairWith diffParsers jsonTreeDiff blobPair `catchError` jsonError blobPair
 
 jsonError :: Applicative m => BlobPair -> SomeException -> m (Rendering.JSON.JSON "diffs" SomeJSON)
 jsonError blobPair (SomeException e) = pure $ renderJSONDiffError blobPair (show e)
 
-diffGraph :: (Traversable t, Member (Error SomeException) sig, Member Telemetry sig, Member Distribute sig, Member Parse sig, Carrier sig m, MonadIO m) => t BlobPair -> m DiffTreeGraphResponse
+diffGraph :: (Traversable t, Has (Error SomeException) sig m, Has Telemetry sig m, Has Distribute sig m, Has Parse sig m, MonadIO m) => t BlobPair -> m DiffTreeGraphResponse
 diffGraph blobs = do
   graph <- distributeFor blobs go
   pure $ defMessage & P.files .~ toList graph
   where
-    go :: (Member (Error SomeException) sig, Member Telemetry sig, Member Parse sig, Carrier sig m, MonadIO m) => BlobPair -> m DiffTreeFileGraph
+    go :: (Has (Error SomeException) sig m, Has Telemetry sig m, Has Parse sig m, MonadIO m) => BlobPair -> m DiffTreeFileGraph
     go blobPair = parsePairWith diffParsers jsonGraphDiff blobPair
       `catchError` \(SomeException e) ->
         pure $ defMessage
@@ -82,14 +82,14 @@ diffGraph blobs = do
 
 
 class DOTGraphDiff term where
-  dotGraphDiff :: (Carrier sig m, Member (Reader Config) sig, Member Telemetry sig, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m Builder
+  dotGraphDiff :: (Has (Reader Config) sig m, Has Telemetry sig m, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m Builder
 
 instance (DiffTerms term, ConstructorName (Syntax term), Foldable (Syntax term), Functor (Syntax term)) => DOTGraphDiff term where
   dotGraphDiff = serialize (DOT (diffStyle "diffs")) . renderTreeGraph <=< diffTerms
 
 
 class JSONGraphDiff term where
-  jsonGraphDiff :: (Carrier sig m, Member Telemetry sig, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m DiffTreeFileGraph
+  jsonGraphDiff :: (Has Telemetry sig m, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m DiffTreeFileGraph
 
 instance (DiffTerms term, ConstructorName (Syntax term), Foldable (Syntax term), Functor (Syntax term)) => JSONGraphDiff term where
   jsonGraphDiff terms = do
@@ -108,27 +108,27 @@ instance (DiffTerms term, ConstructorName (Syntax term), Foldable (Syntax term),
 
 
 class JSONTreeDiff term where
-  jsonTreeDiff :: (Carrier sig m, Member Telemetry sig, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m (Rendering.JSON.JSON "diffs" SomeJSON)
+  jsonTreeDiff :: (Has Telemetry sig m, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m (Rendering.JSON.JSON "diffs" SomeJSON)
 
 instance (DiffTerms term, Foldable (Syntax term), ToJSONFields1 (Syntax term)) => JSONTreeDiff term where
   jsonTreeDiff terms = renderJSONDiff (bimap fst fst terms) <$> diffTerms terms
 
 
 class SExprDiff term where
-  sexprDiff :: (Carrier sig m, Member (Reader Config) sig, Member Telemetry sig, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m Builder
+  sexprDiff :: (Has (Reader Config) sig m, Has Telemetry sig m, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m Builder
 
 instance (DiffTerms term, ConstructorName (Syntax term), Foldable (Syntax term), Functor (Syntax term)) => SExprDiff term where
   sexprDiff = serialize (SExpression ByConstructorName) <=< diffTerms
 
 
 class ShowDiff term where
-  showDiff :: (Carrier sig m, Member (Reader Config) sig, Member Telemetry sig, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m Builder
+  showDiff :: (Has (Reader Config) sig m, Has Telemetry sig m, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m Builder
 
 instance (DiffTerms term, Foldable (Syntax term), Show1 (Syntax term)) => ShowDiff term where
   showDiff = serialize Show <=< diffTerms
 
 
-diffTerms :: (DiffTerms term, Foldable (Syntax term), Member Telemetry sig, Carrier sig m, MonadIO m)
+diffTerms :: (DiffTerms term, Foldable (Syntax term), Has Telemetry sig m, MonadIO m)
   => Edit (Blob, term ann) (Blob, term ann) -> m (Diff (Syntax term) ann ann)
 diffTerms terms = time "diff" languageTag $ do
   let diff = diffTermPair (bimap snd snd terms)

src/Semantic/Api/Symbols.hs

@@ -32,10 +32,10 @@ import           Source.Loc as Loc
 import           Tags.Tagging
 import qualified Tags.Tagging.Precise as Precise
 
-legacyParseSymbols :: (Member Distribute sig, Member (Error SomeException) sig, Member (Reader PerLanguageModes) sig, Member Parse sig, Carrier sig m, Traversable t) => t Blob -> m Legacy.ParseTreeSymbolResponse
+legacyParseSymbols :: (Has Distribute sig m, Has (Error SomeException) sig m, Has (Reader PerLanguageModes) sig m, Has Parse sig m, Traversable t) => t Blob -> m Legacy.ParseTreeSymbolResponse
 legacyParseSymbols blobs = Legacy.ParseTreeSymbolResponse <$> distributeFoldMap go blobs
   where
-    go :: (Member (Error SomeException) sig, Member (Reader PerLanguageModes) sig, Member Parse sig, Carrier sig m) => Blob -> m [Legacy.File]
+    go :: (Has (Error SomeException) sig m, Has (Reader PerLanguageModes) sig m, Has Parse sig m) => Blob -> m [Legacy.File]
     go blob@Blob{..} = asks toTagsParsers >>= \ p -> parseWith p (pure . renderToSymbols) blob `catchError` (\(SomeException _) -> pure (pure emptyFile))
       where
         emptyFile = tagsToFile []
@@ -59,15 +59,15 @@ legacyParseSymbols blobs = Legacy.ParseTreeSymbolResponse <$> distributeFoldMap
           , symbolSpan = converting #? Loc.span loc
           }
 
-parseSymbolsBuilder :: (Member Distribute sig, Member (Error SomeException) sig, Member Parse sig, Member (Reader Config) sig, Member (Reader PerLanguageModes) sig, Carrier sig m, Traversable t) => Format ParseTreeSymbolResponse -> t Blob -> m Builder
+parseSymbolsBuilder :: (Has Distribute sig m, Has (Error SomeException) sig m, Has Parse sig m, Has (Reader Config) sig m, Has (Reader PerLanguageModes) sig m, Traversable t) => Format ParseTreeSymbolResponse -> t Blob -> m Builder
 parseSymbolsBuilder format blobs = parseSymbols blobs >>= serialize format
 
-parseSymbols :: (Member Distribute sig, Member (Error SomeException) sig, Member (Reader PerLanguageModes) sig, Member Parse sig, Carrier sig m, Traversable t) => t Blob -> m ParseTreeSymbolResponse
+parseSymbols :: (Has Distribute sig m, Has (Error SomeException) sig m, Has (Reader PerLanguageModes) sig m, Has Parse sig m, Traversable t) => t Blob -> m ParseTreeSymbolResponse
 parseSymbols blobs = do
   terms <- distributeFor blobs go
   pure $ defMessage & P.files .~ toList terms
   where
-    go :: (Member (Error SomeException) sig, Member (Reader PerLanguageModes) sig, Member Parse sig, Carrier sig m) => Blob -> m File
+    go :: (Has (Error SomeException) sig m, Has (Reader PerLanguageModes) sig m, Has Parse sig m) => Blob -> m File
     go blob@Blob{..} = catching $ tagsToFile <$> tagsForBlob blob
       where
         catching m = m `catchError` (\(SomeException e) -> pure $ errorFile (show e))
@@ -96,7 +96,7 @@ parseSymbols blobs = do
           & P.maybe'span ?~ converting # Loc.span loc
           & P.maybe'docs .~ fmap (flip (set P.docstring) defMessage) docs
 
-tagsForBlob :: (Carrier sig m, Member (Error SomeException) sig, Member Parse sig, Member (Reader PerLanguageModes) sig) => Blob -> m [Tag]
+tagsForBlob :: (Has (Error SomeException) sig m, Has Parse sig m, Has (Reader PerLanguageModes) sig m) => Blob -> m [Tag]
 tagsForBlob blob = asks toTagsParsers >>= \p -> parseWith p (pure . tags symbolsToSummarize blob) blob
 
 symbolsToSummarize :: [Text]

src/Semantic/Api/TOCSummaries.hs

@@ -46,13 +46,13 @@ import           Source.Source as Source
 import qualified Tags.Tag as Tag
 import qualified Tags.Tagging.Precise as Tagging
 
-diffSummaryBuilder :: (Carrier sig m, Member Distribute sig, Member (Error SomeException) sig, Member Parse sig, Member (Reader Config) sig, Member (Reader PerLanguageModes) sig, Member Telemetry sig, MonadIO m) => Format DiffTreeTOCResponse -> [BlobPair] -> m Builder
+diffSummaryBuilder :: (Has Distribute sig m, Has (Error SomeException) sig m, Has Parse sig m, Has (Reader Config) sig m, Has (Reader PerLanguageModes) sig m, Has Telemetry sig m, MonadIO m) => Format DiffTreeTOCResponse -> [BlobPair] -> m Builder
 diffSummaryBuilder format blobs = diffSummary blobs >>= serialize format
 
-legacyDiffSummary :: (Carrier sig m, Member Distribute sig, Member (Error SomeException) sig, Member Parse sig, Member (Reader PerLanguageModes) sig, Member Telemetry sig, MonadIO m) => [BlobPair] -> m Summaries
+legacyDiffSummary :: (Has Distribute sig m, Has (Error SomeException) sig m, Has Parse sig m, Has (Reader PerLanguageModes) sig m, Has Telemetry sig m, MonadIO m) => [BlobPair] -> m Summaries
 legacyDiffSummary = distributeFoldMap go
   where
-    go :: (Carrier sig m, Member (Error SomeException) sig, Member Parse sig, Member (Reader PerLanguageModes) sig, Member Telemetry sig, MonadIO m) => BlobPair -> m Summaries
+    go :: (Has (Error SomeException) sig m, Has Parse sig m, Has (Reader PerLanguageModes) sig m, Has Telemetry sig m, MonadIO m) => BlobPair -> m Summaries
     go blobPair = asks summarizeTermParsers >>= \ p -> parsePairWith p (fmap (uncurry (flip Summaries) . bimap toMap toMap . partitionEithers) . summarizeTerms) blobPair
       `catchError` \(SomeException e) ->
         pure $ Summaries mempty (toMap [ErrorSummary (T.pack (show e)) lowerBound lang])
@@ -64,12 +64,12 @@ legacyDiffSummary = distributeFoldMap go
             toMap as = Map.singleton path (toJSON <$> as)
 
 
-diffSummary :: (Carrier sig m, Member Distribute sig, Member (Error SomeException) sig, Member Parse sig, Member (Reader PerLanguageModes) sig, Member Telemetry sig, MonadIO m) => [BlobPair] -> m DiffTreeTOCResponse
+diffSummary :: (Has Distribute sig m, Has (Error SomeException) sig m, Has Parse sig m, Has (Reader PerLanguageModes) sig m, Has Telemetry sig m, MonadIO m) => [BlobPair] -> m DiffTreeTOCResponse
 diffSummary blobs = do
   diff <- distributeFor blobs go
   pure $ defMessage & P.files .~ diff
   where
-    go :: (Carrier sig m, Member (Error SomeException) sig, Member Parse sig, Member (Reader PerLanguageModes) sig, Member Telemetry sig, MonadIO m) => BlobPair -> m TOCSummaryFile
+    go :: (Has (Error SomeException) sig m, Has Parse sig m, Has (Reader PerLanguageModes) sig m, Has Telemetry sig m, MonadIO m) => BlobPair -> m TOCSummaryFile
     go blobPair = asks summarizeTermParsers >>= \ p -> parsePairWith p (fmap (uncurry toFile . partitionEithers . map (bimap toError toChange)) . summarizeTerms) blobPair
       `catchError` \(SomeException e) ->
         pure $ toFile [defMessage & P.error .~ T.pack (show e) & P.maybe'span .~ Nothing] []
@@ -103,13 +103,13 @@ summarizeTermParsers :: PerLanguageModes -> Map Language (SomeParser SummarizeTe
 summarizeTermParsers = allParsers
 
 class SummarizeTerms term where
-  summarizeTerms :: (Member Telemetry sig, Carrier sig m, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m [Either ErrorSummary TOCSummary]
+  summarizeTerms :: (Has Telemetry sig m, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m [Either ErrorSummary TOCSummary]
 
 instance (TermMode term ~ strategy, SummarizeTermsBy strategy term) => SummarizeTerms term where
   summarizeTerms = summarizeTermsBy @strategy
 
 class SummarizeTermsBy (strategy :: LanguageMode) term where
-  summarizeTermsBy :: (Member Telemetry sig, Carrier sig m, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m [Either ErrorSummary TOCSummary]
+  summarizeTermsBy :: (Has Telemetry sig m, MonadIO m) => Edit (Blob, term Loc) (Blob, term Loc) -> m [Either ErrorSummary TOCSummary]
 
 instance (DiffTerms term, HasDeclaration (Syntax term), Traversable (Syntax term), Recursive (term Loc), Base (term Loc) ~ TermF (Syntax term) Loc) => SummarizeTermsBy 'ALaCarte term where
   summarizeTermsBy = fmap diffTOC . diffTerms . bimap decorateTerm decorateTerm where

src/Semantic/Api/Terms.hs

@@ -43,13 +43,13 @@ import qualified Language.JSON as JSON
 import qualified Language.Python as PythonPrecise
 
 
-termGraph :: (Traversable t, Member Distribute sig, Member (Error SomeException) sig, Member Parse sig, Carrier sig m) => t Blob -> m ParseTreeGraphResponse
+termGraph :: (Traversable t, Has Distribute sig m, Has (Error SomeException) sig m, Has Parse sig m) => t Blob -> m ParseTreeGraphResponse
 termGraph blobs = do
   terms <- distributeFor blobs go
   pure $ defMessage
     & P.files .~ toList terms
   where
-    go :: (Member (Error SomeException) sig, Member Parse sig, Carrier sig m) => Blob -> m ParseTreeFileGraph
+    go :: (Has (Error SomeException) sig m, Has Parse sig m) => Blob -> m ParseTreeFileGraph
     go blob = parseWith jsonGraphTermParsers (pure . jsonGraphTerm blob) blob
       `catchError` \(SomeException e) ->
         pure $ defMessage
@@ -71,7 +71,7 @@ data TermOutputFormat
   | TermQuiet
   deriving (Eq, Show)
 
-parseTermBuilder :: (Traversable t, Member Distribute sig, Member (Error SomeException) sig, Member (Reader PerLanguageModes) sig, Member Parse sig, Member (Reader Config) sig, Carrier sig m, MonadIO m)
+parseTermBuilder :: (Traversable t, Has Distribute sig m, Has (Error SomeException) sig m, Has (Reader PerLanguageModes) sig m, Has Parse sig m, Has (Reader Config) sig m, MonadIO m)
   => TermOutputFormat -> t Blob -> m Builder
 parseTermBuilder TermJSONTree    = distributeFoldMap jsonTerm >=> serialize Format.JSON -- NB: Serialize happens at the top level for these two JSON formats to collect results of multiple blobs.
 parseTermBuilder TermJSONGraph   = termGraph >=> serialize Format.JSON
@@ -80,13 +80,13 @@ parseTermBuilder TermDotGraph    = distributeFoldMap (parseWith dotGraphTermPars
 parseTermBuilder TermShow        = distributeFoldMap (\ blob -> asks showTermParsers >>= \ parsers -> parseWith parsers showTerm blob)
 parseTermBuilder TermQuiet       = distributeFoldMap quietTerm
 
-jsonTerm :: (Member (Error SomeException) sig, Member Parse sig, Carrier sig m) => Blob -> m (Rendering.JSON.JSON "trees" SomeJSON)
+jsonTerm :: (Has (Error SomeException) sig m, Has Parse sig m) => Blob -> m (Rendering.JSON.JSON "trees" SomeJSON)
 jsonTerm blob = parseWith jsonTreeTermParsers (pure . jsonTreeTerm blob) blob `catchError` jsonError blob
 
 jsonError :: Applicative m => Blob -> SomeException -> m (Rendering.JSON.JSON "trees" SomeJSON)
 jsonError blob (SomeException e) = pure $ renderJSONError blob (show e)
 
-quietTerm :: (Member (Error SomeException) sig, Member (Reader PerLanguageModes) sig, Member Parse sig, Member (Reader Config) sig, Carrier sig m, MonadIO m) => Blob -> m Builder
+quietTerm :: (Has (Error SomeException) sig m, Has (Reader PerLanguageModes) sig m, Has Parse sig m, Has (Reader Config) sig m, MonadIO m) => Blob -> m Builder
 quietTerm blob = showTiming blob <$> time' ( asks showTermParsers >>= \ parsers -> parseWith parsers (fmap (const (Right ())) . showTerm) blob `catchError` timingError )
   where
     timingError (SomeException e) = pure (Left (show e))
@@ -99,13 +99,13 @@ showTermParsers :: PerLanguageModes -> Map Language (SomeParser ShowTerm Loc)
 showTermParsers = allParsers
 
 class ShowTerm term where
-  showTerm :: (Carrier sig m, Member (Reader Config) sig) => term Loc -> m Builder
+  showTerm :: (Has (Reader Config) sig m) => term Loc -> m Builder
 
 instance (TermMode term ~ strategy, ShowTermBy strategy term) => ShowTerm term where
   showTerm = showTermBy @strategy
 
 class ShowTermBy (strategy :: LanguageMode) term where
-  showTermBy :: (Carrier sig m, Member (Reader Config) sig) => term Loc -> m Builder
+  showTermBy :: (Has (Reader Config) sig m) => term Loc -> m Builder
 
 instance ShowTermBy 'Precise Java.Term where
   showTermBy = serialize Show . void . Java.getTerm
@@ -149,7 +149,7 @@ dotGraphTermParsers :: Map Language (SomeParser DOTGraphTerm Loc)
 dotGraphTermParsers = aLaCarteParsers
 
 class DOTGraphTerm term where
-  dotGraphTerm :: (Carrier sig m, Member (Reader Config) sig) => term Loc -> m Builder
+  dotGraphTerm :: (Has (Reader Config) sig m) => term Loc -> m Builder
 
 instance (Recursive (term Loc), ToTreeGraph TermVertex (Base (term Loc))) => DOTGraphTerm term where
   dotGraphTerm = serialize (DOT (termStyle "terms")) . renderTreeGraph

src/Semantic/CLI.hs

@@ -2,8 +2,7 @@
 module Semantic.CLI (main) where
 
 import qualified Control.Carrier.Parse.Measured as Parse
-import           Control.Effect.Reader
-import           Control.Exception as Exc (displayException)
+import           Control.Carrier.Reader
 import           Data.Blob
 import           Data.Blob.IO
 import qualified Data.Flag as Flag
@@ -28,7 +27,7 @@ import qualified System.Path as Path
 import qualified System.Path.PartClass as Path.PartClass
 
 import Control.Concurrent (mkWeakThreadId, myThreadId)
-import Control.Exception (Exception (..), throwTo)
+import Control.Exception (throwTo)
 import Proto.Semantic_JSON ()
 import System.Mem.Weak (deRefWeak)
 import System.Posix.Signals

src/Semantic/Distribute.hs

@@ -1,4 +1,7 @@
-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving,
+             MultiParamTypeClasses, StandaloneDeriving, TypeOperators, UndecidableInstances #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+-- TODO: We should kill this entirely, because with fused-effects 1.0 we can unlift the various runConcurrently operations.
 module Semantic.Distribute
 ( distribute
 , distributeFor
@@ -9,9 +12,10 @@ module Semantic.Distribute
 , DistributeC(..)
 ) where
 
+import           Control.Algebra
+import           Control.Carrier.Lift
+import           Control.Carrier.Reader
 import qualified Control.Concurrent.Async as Async
-import           Control.Effect.Carrier
-import           Control.Effect.Reader
 import           Control.Monad.IO.Unlift
 import           Control.Parallel.Strategies
 import           Prologue
@@ -19,19 +23,19 @@ import           Prologue
 -- | Distribute a 'Traversable' container of tasks over the available cores (i.e. execute them concurrently), collecting their results.
 --
 --   This is a concurrent analogue of 'sequenceA'.
-distribute :: (Member Distribute sig, Traversable t, Carrier sig m) => t (m output) -> m (t output)
+distribute :: (Has Distribute sig m, Traversable t) => t (m output) -> m (t output)
 distribute = fmap (withStrategy (parTraversable rseq)) <$> traverse (send . flip Distribute pure)
 
 -- | Distribute the application of a function to each element of a 'Traversable' container of inputs over the available cores (i.e. perform the function concurrently for each element), collecting the results.
 --
 --   This is a concurrent analogue of 'for' or 'traverse' (with the arguments flipped).
-distributeFor :: (Member Distribute sig, Traversable t, Carrier sig m) => t a -> (a -> m output) -> m (t output)
+distributeFor :: (Has Distribute sig m, Traversable t) => t a -> (a -> m output) -> m (t output)
 distributeFor inputs toTask = distribute (fmap toTask inputs)
 
 -- | Distribute the application of a function to each element of a 'Traversable' container of inputs over the available cores (i.e. perform the function concurrently for each element), combining the results 'Monoid'ally into a final value.
 --
 --   This is a concurrent analogue of 'foldMap'.
-distributeFoldMap :: (Member Distribute sig, Monoid output, Traversable t, Carrier sig m) => (a -> m output) -> t a -> m output
+distributeFoldMap :: (Has Distribute sig m, Monoid output, Traversable t) => (a -> m output) -> t a -> m output
 distributeFoldMap toTask inputs = fmap fold (distribute (fmap toTask inputs))
 
 
@@ -45,7 +49,7 @@ instance HFunctor Distribute where
   hmap f (Distribute m k) = Distribute (f m) (f . k)
 
 instance Effect Distribute where
-  handle state handler (Distribute task k) = Distribute (handler (task <$ state)) (handler . fmap k)
+  thread state handler (Distribute task k) = Distribute (handler (task <$ state)) (handler . fmap k)
 
 
 -- | Evaluate a 'Distribute' effect concurrently.
@@ -55,16 +59,22 @@ runDistribute u@(UnliftIO unlift) = unlift . runReader u . runDistributeC
 withDistribute :: MonadUnliftIO m => DistributeC m a -> m a
 withDistribute r = withUnliftIO (`runDistribute` r)
 
+instance MonadUnliftIO m => MonadUnliftIO (LiftC m) where
+  askUnliftIO = LiftC $ withUnliftIO $ \u -> pure (UnliftIO (unliftIO u . runM))
+  {-# INLINE askUnliftIO #-}
+  withRunInIO inner = LiftC $ withRunInIO $ \run -> inner (run . runM)
+  {-# INLINE withRunInIO #-}
+
 newtype DistributeC m a = DistributeC { runDistributeC :: ReaderC (UnliftIO m) m a }
-  deriving (Functor, Applicative, Monad, MonadIO)
+  deriving (Functor, Applicative, Monad, MonadFail, MonadIO)
 
 -- This can be simpler if we add an instance to fused-effects that takes
 -- care of this folderol for us (then we can justt derive the MonadUnliftIO instance)
-instance (MonadIO m, Carrier sig m) => MonadUnliftIO (DistributeC m) where
+instance (MonadIO m, Algebra sig m) => MonadUnliftIO (DistributeC m) where
   askUnliftIO = DistributeC . ReaderC $ \ u -> pure (UnliftIO (runDistribute u))
 
-instance (Carrier sig m, MonadIO m) => Carrier (Distribute :+: sig) (DistributeC m) where
-  eff (L (Distribute task k)) = do
+instance (Algebra sig m, MonadIO m) => Algebra (Distribute :+: sig) (DistributeC m) where
+  alg (L (Distribute task k)) = do
     handler <- DistributeC ask
     liftIO (Async.runConcurrently (Async.Concurrently (runDistribute handler task))) >>= k
-  eff (R other) = DistributeC (eff (R (handleCoercible other)))
+  alg (R other) = DistributeC (alg (R (handleCoercible other)))

src/Semantic/Graph.hs

@@ -36,13 +36,16 @@ import           Analysis.Abstract.Collecting
 import           Analysis.Abstract.Graph as Graph
 import           Control.Abstract hiding (String)
 import           Control.Abstract.PythonPackage as PythonPackage
-import           Control.Effect.Carrier
+import           Control.Algebra
+import           Control.Carrier.Fresh.Strict
+import           Control.Carrier.Reader
+import           Control.Carrier.Resumable.Resume
+import           Control.Carrier.State.Strict
 import           Control.Effect.Parse
 import           Control.Lens.Getter
 import           Data.Abstract.Address.Hole as Hole
 import           Data.Abstract.Address.Monovariant as Monovariant
 import           Data.Abstract.Address.Precise as Precise
-import           Data.Abstract.BaseError (BaseError (..))
 import           Data.Abstract.Evaluatable
 import           Data.Abstract.Heap
 import           Data.Abstract.Module
@@ -110,11 +113,10 @@ analysisParsers = Map.fromList
   , tsxParser
   ]
 
-runGraph :: ( Member Distribute sig
-            , Member Parse sig
-            , Member Resolution sig
-            , Member Trace sig
-            , Carrier sig m
+runGraph :: ( Has Distribute sig m
+            , Has Parse sig m
+            , Has Resolution sig m
+            , Has Trace sig m
             , Effect sig
             )
          => GraphType
@@ -151,8 +153,7 @@ reifyLanguage = \case
 
 runCallGraph :: ( AnalyzeTerm term
                 , HasPrelude lang
-                , Member Trace sig
-                , Carrier sig m
+                , Has Trace sig m
                 , Effect sig
                 )
              => Proxy lang
@@ -167,7 +168,7 @@ runCallGraph lang includePackages modules package
   . runHeap
   . runScopeGraph
   . caching
-  . raiseHandler runFresh
+  . raiseHandler (runFresh 0)
   . resumingLoadError
   . resumingUnspecialized
   . resumingScopeError
@@ -193,8 +194,7 @@ runModuleTable = raiseHandler $ runReader lowerBound
 
 runImportGraphToModuleInfos :: ( AnalyzeTerm term
                                , HasPrelude lang
-                               , Member Trace sig
-                               , Carrier sig m
+                               , Has Trace sig m
                                , Effect sig
                                )
                             => Proxy lang
@@ -205,8 +205,7 @@ runImportGraphToModuleInfos lang package = runImportGraph lang package allModule
 
 runImportGraphToModules :: ( AnalyzeTerm term
                            , HasPrelude lang
-                           , Member Trace sig
-                           , Carrier sig m
+                           , Has Trace sig m
                            , Effect sig
                            )
                         => Proxy lang
@@ -217,8 +216,7 @@ runImportGraphToModules lang package = runImportGraph lang package resolveOrLowe
 
 runImportGraph :: ( AnalyzeTerm term
                   , HasPrelude lang
-                  , Member Trace sig
-                  , Carrier sig m
+                  , Has Trace sig m
                   , Effect sig
                   )
                => Proxy lang
@@ -230,7 +228,7 @@ runImportGraph lang package f
   . runEvaluator @_ @_ @(Value _ (Hole (Maybe Name) Precise))
   . raiseHandler (runState lowerBound)
   . runHeap
-  . raiseHandler runFresh
+  . raiseHandler (runFresh 0)
   . resumingLoadError
   . resumingUnspecialized
   . resumingScopeError
@@ -258,7 +256,7 @@ runScopeGraph :: Ord address
 runScopeGraph = raiseHandler (runState lowerBound)
 
 -- | Parse a list of files into a 'Package'.
-parsePackage :: (Member Distribute sig, Member Resolution sig, Member Parse sig, Member Trace sig, Carrier sig m)
+parsePackage :: (Has Distribute sig m, Has Resolution sig m, Has Parse sig m, Has Trace sig m)
              => Parser term -- ^ A parser.
              -> Project     -- ^ Project to parse into a package.
              -> m (Package (Blob, term))
@@ -272,18 +270,17 @@ parsePackage parser project = do
     n = Data.Abstract.Evaluatable.name (projectName project) -- TODO: Confirm this is the right `name`.
 
 -- | Parse all files in a project into 'Module's.
-parseModules :: (Member Distribute sig, Member Parse sig, Carrier sig m) => Parser term -> Project -> m [Module (Blob, term)]
+parseModules :: (Has Distribute sig m, Has Parse sig m) => Parser term -> Project -> m [Module (Blob, term)]
 parseModules parser p = distributeFor (projectBlobs p) (parseModule p parser)
 
 
 -- | Parse a list of packages from a python project.
 parsePythonPackage :: forall term sig m .
                    ( AnalyzeTerm term
-                   , Member Distribute sig
-                   , Member Parse sig
-                   , Member Resolution sig
-                   , Member Trace sig
-                   , Carrier sig m
+                   , Has Distribute sig m
+                   , Has Parse sig m
+                   , Has Resolution sig m
+                   , Has Trace sig m
                    , Effect sig
                    )
                    => Parser (term Loc) -- ^ A parser.
@@ -293,7 +290,7 @@ parsePythonPackage parser project = do
   let runAnalysis = runEvaluator @_ @_ @(Value (term Loc) (Hole (Maybe Name) Precise))
         . raiseHandler (runState PythonPackage.Unknown)
         . raiseHandler (runState (lowerBound @(Heap (Hole (Maybe Name) Precise) (Hole (Maybe Name) Precise) (Value (term Loc) (Hole (Maybe Name) Precise)))))
-        . raiseHandler runFresh
+        . raiseHandler (runFresh 0)
         . resumingLoadError
         . resumingUnspecialized
         -- . resumingEnvironmentError -- TODO: Fix me. Replace with `resumineScopeGraphError`?
@@ -342,16 +339,15 @@ parsePythonPackage parser project = do
         resMap <- Task.resolutionMap p
         pure (Package.fromModules (Data.Abstract.Evaluatable.name $ projectName p) modules resMap) -- TODO: Confirm this is the right `name`.
 
-parseModule :: (Member Parse sig, Carrier sig m)
+parseModule :: Has Parse sig m
             => Project
             -> Parser term
             -> Blob
             -> m (Module (Blob, term))
 parseModule proj parser blob = moduleForBlob (Just (projectRootDir proj)) blob . (,) blob <$> parse parser blob
 
-withTermSpans :: ( Member (Reader Span) sig
-                 , Member (State Span) sig -- last evaluated child's span
-                 , Carrier sig m
+withTermSpans :: ( Has (Reader Span) sig m
+                 , Has (State Span) sig m -- last evaluated child's span
                  )
               => (term -> Span)
               -> Open (term -> Evaluator term address value m a)
@@ -360,10 +356,9 @@ withTermSpans getSpan recur term = let
   updatedSpanAlg = withCurrentSpan span (recur term)
   in modifyChildSpan span updatedSpanAlg
 
-resumingResolutionError :: ( Member Trace sig
-                           , Carrier sig m
+resumingResolutionError :: ( Has Trace sig m
                            )
-                         => Evaluator term address value (ResumableWithC (BaseError ResolutionError) m) a
+                         => Evaluator term address value (ResumableC (BaseError ResolutionError) m) a
                          -> Evaluator term address value m a
 resumingResolutionError = runResolutionErrorWith $ \ baseError -> do
   traceError "ResolutionError" baseError
@@ -371,25 +366,23 @@ resumingResolutionError = runResolutionErrorWith $ \ baseError -> do
     NotFoundError nameToResolve _ _ -> pure nameToResolve
     GoImportError pathToResolve     -> pure [pathToResolve]
 
-resumingLoadError :: ( Carrier sig m
-                     , Member Trace sig
+resumingLoadError :: ( Has Trace sig m
                      , AbstractHole value
                      , AbstractHole address
                      )
-                  => Evaluator term address value (ResumableWithC (BaseError (LoadError address value)) m) a
+                  => Evaluator term address value (ResumableC (BaseError (LoadError address value)) m) a
                   -> Evaluator term address value m a
 resumingLoadError = runLoadErrorWith (\ baseError -> traceError "LoadError" baseError *> case baseErrorException baseError of
   ModuleNotFoundError _ -> pure ((hole, hole), hole))
 
-resumingEvalError :: ( Carrier sig m
-                     , Member Fresh sig
-                     , Member Trace sig
+resumingEvalError :: ( Has Fresh sig m
+                     , Has Trace sig m
                      , Show value
                      , Show term
                      , AbstractHole address
                      , AbstractHole value
                      )
-                  => Evaluator term address value (ResumableWithC (BaseError (EvalError term address value)) m) a
+                  => Evaluator term address value (ResumableC (BaseError (EvalError term address value)) m) a
                   -> Evaluator term address value m a
 resumingEvalError = runEvalErrorWith (\ baseError -> traceError "EvalError" baseError *> case baseErrorException baseError of
   AccessControlError{}  -> pure hole
@@ -406,21 +399,19 @@ resumingEvalError = runEvalErrorWith (\ baseError -> traceError "EvalError" base
 
 resumingUnspecialized :: ( AbstractHole address
                          , AbstractHole value
-                         , Carrier sig m
-                         , Member Trace sig
+                         , Has Trace sig m
                          )
-                      => Evaluator term address value (ResumableWithC (BaseError (UnspecializedError address value)) m) a
+                      => Evaluator term address value (ResumableC (BaseError (UnspecializedError address value)) m) a
                       -> Evaluator term address value m a
 resumingUnspecialized = runUnspecializedWith (\ baseError -> traceError "UnspecializedError" baseError *> case baseErrorException baseError of
   UnspecializedError _ -> pure hole
   RefUnspecializedError _ -> pure hole)
 
 resumingAddressError :: ( AbstractHole value
-                        , Carrier sig m
-                        , Member Trace sig
+                        , Has Trace sig m
                         , Show address
                         )
-                     => Evaluator term address value (ResumableWithC (BaseError (AddressError address value)) m) a
+                     => Evaluator term address value (ResumableC (BaseError (AddressError address value)) m) a
                      -> Evaluator term address value m a
 resumingAddressError = runAddressErrorWith $ \ baseError -> do
   traceError "AddressError" baseError
@@ -428,12 +419,11 @@ resumingAddressError = runAddressErrorWith $ \ baseError -> do
     UnallocatedSlot   _ -> pure lowerBound
     UninitializedSlot _ -> pure hole
 
-resumingValueError :: ( Carrier sig m
-                      , Member Trace sig
+resumingValueError :: ( Has Trace sig m
                       , Show address
                       , Show term
                       )
-                   => Evaluator term address (Value term address) (ResumableWithC (BaseError (ValueError term address)) m) a
+                   => Evaluator term address (Value term address) (ResumableC (BaseError (ValueError term address)) m) a
                    -> Evaluator term address (Value term address) m a
 resumingValueError = runValueErrorWith (\ baseError -> traceError "ValueError" baseError *> case baseErrorException baseError of
   CallError{}       -> pure hole
@@ -450,12 +440,11 @@ resumingValueError = runValueErrorWith (\ baseError -> traceError "ValueError" b
   ArrayError{}      -> pure lowerBound
   ArithmeticError{} -> pure hole)
 
-resumingHeapError :: ( Carrier sig m
-                     , AbstractHole address
-                     , Member Trace sig
+resumingHeapError :: ( AbstractHole address
+                     , Has Trace sig m
                      , Show address
                      )
-                  => Evaluator term address value (ResumableWithC (BaseError (HeapError address)) m) a
+                  => Evaluator term address value (ResumableC (BaseError (HeapError address)) m) a
                   -> Evaluator term address value m a
 resumingHeapError = runHeapErrorWith (\ baseError -> traceError "ScopeError" baseError *> case baseErrorException baseError of
     CurrentFrameError -> pure hole
@@ -465,15 +454,14 @@ resumingHeapError = runHeapErrorWith (\ baseError -> traceError "ScopeError" bas
     LookupLinksError _ -> pure mempty
     LookupLinkError _ -> pure hole)
 
-resumingScopeError :: ( Carrier sig m
-                     , Member Trace sig
-                     , AbstractHole (Slot address)
-                     , AbstractHole (Scope address)
-                     , AbstractHole (Path address)
-                     , AbstractHole (Info address)
-                     , AbstractHole address
-                     )
-                    => Evaluator term address value (ResumableWithC (BaseError (ScopeError address)) m) a
+resumingScopeError :: ( Has Trace sig m
+                      , AbstractHole (Slot address)
+                      , AbstractHole (Scope address)
+                      , AbstractHole (Path address)
+                      , AbstractHole (Info address)
+                      , AbstractHole address
+                      )
+                    => Evaluator term address value (ResumableC (BaseError (ScopeError address)) m) a
                     -> Evaluator term address value m a
 resumingScopeError = runScopeErrorWith (\ baseError -> traceError "ScopeError" baseError *> case baseErrorException baseError of
   ScopeError _ _ -> pure hole
@@ -484,12 +472,11 @@ resumingScopeError = runScopeErrorWith (\ baseError -> traceError "ScopeError" b
   LookupDeclarationScopeError _ -> pure hole
   DeclarationByNameError _ -> pure hole)
 
-resumingTypeError :: ( Carrier sig m
-                     , Member Trace sig
+resumingTypeError :: ( Has Trace sig m
                      , Effect sig
                      , Alternative m
                      )
-                  => Evaluator term address Type (ResumableWithC (BaseError TypeError)
+                  => Evaluator term address Type (ResumableC (BaseError TypeError)
                                                  (StateC TypeMap
                                                  m)) a
                   -> Evaluator term address Type m a
@@ -500,5 +487,5 @@ resumingTypeError = runTypesWith (\ baseError -> traceError "TypeError" baseErro
 prettyShow :: Show a => a -> String
 prettyShow = hscolour TTY defaultColourPrefs False False "" False . ppShow
 
-traceError :: (Member Trace sig, Show (exc resume), Carrier sig m) => String -> BaseError exc resume -> Evaluator term address value m ()
+traceError :: (Has Trace sig m, Show (exc resume)) => String -> BaseError exc resume -> Evaluator term address value m ()
 traceError prefix baseError = trace $ prefix <> ": " <> prettyShow baseError

src/Semantic/Resolution.hs

@@ -7,14 +7,13 @@ module Semantic.Resolution
   , ResolutionC(..)
   ) where
 
-import           Control.Effect.Carrier
+import           Control.Algebra
 import           Data.Aeson
 import           Data.Aeson.Types (parseMaybe)
 import           Data.Blob
 import           Data.Language
 import qualified Data.Map as Map
 import           Data.Project
-import           GHC.Generics (Generic1)
 import           Prologue
 import           Semantic.Task.Files
 import qualified Source.Source as Source
@@ -22,7 +21,7 @@ import           System.FilePath.Posix
 import qualified System.Path as Path
 
 
-nodeJSResolutionMap :: (Member Files sig, Carrier sig m, MonadIO m) => FilePath -> Text -> [FilePath] -> m (Map FilePath FilePath)
+nodeJSResolutionMap :: (Has Files sig m, MonadIO m) => FilePath -> Text -> [FilePath] -> m (Map FilePath FilePath)
 nodeJSResolutionMap rootDir prop excludeDirs = do
   files <- findFiles (Path.absRel rootDir) [".json"] (fmap Path.absRel excludeDirs)
   let packageFiles = fileForTypedPath <$> filter ((==) (Path.relFile "package.json") . Path.takeFileName) files
@@ -37,7 +36,7 @@ nodeJSResolutionMap rootDir prop excludeDirs = do
       where relPkgDotJSONPath = makeRelative rootDir path
             relEntryPath x = takeDirectory relPkgDotJSONPath </> x
 
-resolutionMap :: (Member Resolution sig, Carrier sig m) => Project -> m (Map FilePath FilePath)
+resolutionMap :: Has Resolution sig m => Project -> m (Map FilePath FilePath)
 resolutionMap Project{..} = case projectLanguage of
   TypeScript -> send (NodeJSResolution projectRootDir "types" projectExcludeDirs pure)
   JavaScript -> send (NodeJSResolution projectRootDir "main"  projectExcludeDirs pure)
@@ -55,10 +54,10 @@ runResolution :: ResolutionC m a -> m a
 runResolution = runResolutionC
 
 newtype ResolutionC m a = ResolutionC { runResolutionC :: m a }
-  deriving (Applicative, Functor, Monad, MonadIO)
+  deriving (Applicative, Functor, Monad, MonadFail, MonadIO)
 
-instance (Member Files sig, Carrier sig m, MonadIO m) => Carrier (Resolution :+: sig) (ResolutionC m) where
-  eff (R other) = ResolutionC . eff . handleCoercible $ other
-  eff (L op) = case op of
+instance (Has Files sig m, MonadIO m) => Algebra (Resolution :+: sig) (ResolutionC m) where
+  alg (R other) = ResolutionC . alg . handleCoercible $ other
+  alg (L op) = case op of
     NodeJSResolution dir prop excludeDirs k -> nodeJSResolutionMap dir prop excludeDirs >>= k
     NoResolution                          k -> k Map.empty

src/Semantic/Task.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, RecordWildCards, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, KindSignatures,
+             MultiParamTypeClasses, RecordWildCards, ScopedTypeVariables, TypeOperators, UndecidableInstances #-}
 module Semantic.Task
 ( TaskC
 , Level(..)
@@ -45,12 +46,10 @@ module Semantic.Task
 , Telemetry
 ) where
 
-import           Control.Effect.Carrier
-import           Control.Effect.Catch
-import           Control.Effect.Error
-import           Control.Effect.Lift
-import           Control.Effect.Reader
-import           Control.Effect.Resource
+import           Control.Algebra
+import           Control.Carrier.Error.Either
+import           Control.Carrier.Lift
+import           Control.Carrier.Reader
 import           Control.Effect.Trace
 import           Control.Monad.IO.Class
 import           Data.ByteString.Builder
@@ -74,12 +73,10 @@ type TaskC
   ( TelemetryC
   ( ErrorC SomeException
   ( TimeoutC
-  ( ResourceC
-  ( CatchC
   ( DistributeC
-  ( LiftC IO)))))))))))
+  ( LiftC IO)))))))))
 
-serialize :: (Member (Reader Config) sig, Carrier sig m)
+serialize :: Has (Reader Config) sig m
           => Format input
           -> input
           -> m Builder
@@ -104,8 +101,6 @@ runTask taskSession@TaskSession{..} task = do
         run
           = runM
           . withDistribute
-          . runCatch
-          . runResource
           . withTimeout
           . runError
           . runTelemetry logger statter
@@ -134,8 +129,8 @@ runTraceInTelemetry :: TraceInTelemetryC m a
 runTraceInTelemetry = runTraceInTelemetryC
 
 newtype TraceInTelemetryC m a = TraceInTelemetryC { runTraceInTelemetryC :: m a }
-  deriving (Applicative, Functor, Monad, MonadIO)
+  deriving (Applicative, Functor, Monad, MonadFail, MonadIO)
 
-instance (Member Telemetry sig, Carrier sig m) => Carrier (Trace :+: sig) (TraceInTelemetryC m) where
-  eff (R other)         = TraceInTelemetryC . eff . handleCoercible $ other
-  eff (L (Trace str k)) = writeLog Debug str [] >> k
+instance Has Telemetry sig m => Algebra (Trace :+: sig) (TraceInTelemetryC m) where
+  alg (R other)         = TraceInTelemetryC . alg . handleCoercible $ other
+  alg (L (Trace str k)) = writeLog Debug str [] >> k