From e2e154f8d7c02c95b7d65d476652b3ef69e46766 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 4 Oct 2019 17:35:02 -0400
Subject: [PATCH 001/155] Add a source repository package for fused-effects
 pinned to master.

---
 cabal.project | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/cabal.project b/cabal.project
index 3b5c80622..1dc5afa8a 100644
--- a/cabal.project
+++ b/cabal.project
@@ -11,3 +11,8 @@ source-repository-package
   type: git
   location: https://github.com/tclem/proto-lens-jsonpb
   tag: e4d10b77f57ee25beb759a33e63e2061420d3dc2
+
+source-repository-package
+  type: git
+  location: https://github.com/fused-effects/fused-effects
+  tag: b0983cefd366a4df010ae3ac45318c50328d042e

From 87a7d3aba64e22f5d34a478ef2361bc74849b22a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 4 Oct 2019 17:51:11 -0400
Subject: [PATCH 002/155] Add a source repository package for
 fused-effects-exceptions.

---
 cabal.project | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/cabal.project b/cabal.project
index 1dc5afa8a..eee4a955e 100644
--- a/cabal.project
+++ b/cabal.project
@@ -16,3 +16,8 @@ source-repository-package
   type: git
   location: https://github.com/fused-effects/fused-effects
   tag: b0983cefd366a4df010ae3ac45318c50328d042e
+
+source-repository-package
+  type: git
+  location: https://github.com/fused-effects/fused-effects-exceptions
+  tag: 5cf63ef72066ccfa63e6c07a936760302f54f5ab

From b534f7cd84266f05969bbd6dd8623567b4185d6a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 4 Oct 2019 17:52:59 -0400
Subject: [PATCH 003/155] Stub in a module for the haskeline-based Readline
 carrier.

---
 semantic-core/semantic-core.cabal                       | 1 +
 semantic-core/src/Control/Carrier/Readline/Haskeline.hs | 2 ++
 2 files changed, 3 insertions(+)
 create mode 100644 semantic-core/src/Control/Carrier/Readline/Haskeline.hs

diff --git a/semantic-core/semantic-core.cabal b/semantic-core/semantic-core.cabal
index ba80c082e..a6b259c5b 100644
--- a/semantic-core/semantic-core.cabal
+++ b/semantic-core/semantic-core.cabal
@@ -25,6 +25,7 @@ library
                      , Analysis.ImportGraph
                      , Analysis.ScopeGraph
                      , Analysis.Typecheck
+                     , Control.Carrier.Readline.Haskeline
                      , Control.Effect.Readline
                      , Control.Monad.Module
                      , Data.Core
diff --git a/semantic-core/src/Control/Carrier/Readline/Haskeline.hs b/semantic-core/src/Control/Carrier/Readline/Haskeline.hs
new file mode 100644
index 000000000..e6914752c
--- /dev/null
+++ b/semantic-core/src/Control/Carrier/Readline/Haskeline.hs
@@ -0,0 +1,2 @@
+module Control.Carrier.Readline.Haskeline
+() where

From 3a43887e3099ec07e69a292f1a3fd312735bea75 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 4 Oct 2019 18:24:35 -0400
Subject: [PATCH 004/155] Move the Readline carrier into its own module.

---
 .../src/Control/Carrier/Readline/Haskeline.hs | 70 ++++++++++++++-
 semantic-core/src/Control/Effect/Readline.hs  | 90 +++----------------
 2 files changed, 83 insertions(+), 77 deletions(-)

diff --git a/semantic-core/src/Control/Carrier/Readline/Haskeline.hs b/semantic-core/src/Control/Carrier/Readline/Haskeline.hs
index e6914752c..746c2f55b 100644
--- a/semantic-core/src/Control/Carrier/Readline/Haskeline.hs
+++ b/semantic-core/src/Control/Carrier/Readline/Haskeline.hs
@@ -1,2 +1,70 @@
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, OverloadedStrings, RankNTypes, TypeApplications, TypeOperators, UndecidableInstances #-}
 module Control.Carrier.Readline.Haskeline
-() where
+( runReadline
+, runReadlineWithHistory
+, ReadlineC (..)
+, runControlIO
+, ControlIOC (..)
+) where
+
+import Control.Carrier
+import Control.Carrier.Lift
+import Control.Carrier.Reader
+import Control.Effect.Readline
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Class
+import Data.Text.Prettyprint.Doc.Render.Text
+import System.Console.Haskeline hiding (Handler, handle)
+import System.Directory
+import System.FilePath
+
+runReadline :: MonadException m => Prefs -> Settings m -> ReadlineC m a -> m a
+runReadline prefs settings = runInputTWithPrefs prefs settings . runM . runReader (Line 0) . runReadlineC
+
+runReadlineWithHistory :: MonadException m => ReadlineC m a -> m a
+runReadlineWithHistory block = do
+  homeDir <- liftIO getHomeDirectory
+  prefs <- liftIO $ readPrefs (homeDir </> ".haskeline")
+  let settingsDir = homeDir </> ".local/semantic-core"
+      settings = Settings
+        { complete = noCompletion
+        , historyFile = Just (settingsDir <> "/repl_history")
+        , autoAddHistory = True
+        }
+  liftIO $ createDirectoryIfMissing True settingsDir
+
+  runReadline prefs settings block
+
+newtype ReadlineC m a = ReadlineC { runReadlineC :: ReaderC Line (LiftC (InputT m)) a }
+  deriving (Applicative, Functor, Monad, MonadIO)
+
+instance (MonadException m, MonadIO m) => Carrier (Readline :+: Lift (InputT m)) (ReadlineC m) where
+  eff (L (Prompt prompt k)) = ReadlineC $ do
+    str <- lift (lift (getInputLine (cyan <> prompt <> plain)))
+    local increment (runReadlineC (k str))
+    where cyan = "\ESC[1;36m\STX"
+          plain = "\ESC[0m\STX"
+  eff (L (Print text k)) = liftIO (putDoc (unAnyDoc text)) *> k
+  eff (L (AskLine k)) = ReadlineC ask >>= k
+  eff (R other) = ReadlineC (eff (R (handleCoercible other)))
+
+
+runControlIO :: (forall x . m x -> IO x) -> ControlIOC m a -> m a
+runControlIO handler = runReader (Handler handler) . runControlIOC
+
+-- | This exists to work around the 'MonadException' constraint that haskeline entails.
+newtype ControlIOC m a = ControlIOC { runControlIOC :: ReaderC (Handler m) m a }
+  deriving (Applicative, Functor, Monad, MonadIO)
+
+newtype Handler m = Handler (forall x . m x -> IO x)
+
+runHandler :: Handler m -> ControlIOC m a -> IO a
+runHandler h@(Handler handler) = handler . runReader h . runControlIOC
+
+instance Carrier sig m => Carrier sig (ControlIOC m) where
+  eff op = ControlIOC (eff (R (handleCoercible op)))
+
+instance (Carrier sig m, MonadIO m) => MonadException (ControlIOC m) where
+  controlIO f = ControlIOC $ do
+    handler <- ask
+    liftIO (f (RunIO (fmap pure . runHandler handler)) >>= runHandler handler)
diff --git a/semantic-core/src/Control/Effect/Readline.hs b/semantic-core/src/Control/Effect/Readline.hs
index 5f862c7ce..6cca9264b 100644
--- a/semantic-core/src/Control/Effect/Readline.hs
+++ b/semantic-core/src/Control/Effect/Readline.hs
@@ -1,108 +1,46 @@
-{-# LANGUAGE DeriveAnyClass, DeriveFunctor, DeriveGeneric, DerivingStrategies, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, OverloadedStrings, RankNTypes, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-}
-
+{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, RankNTypes, TypeApplications #-}
 module Control.Effect.Readline
-( Readline (..)
+( Readline(..)
+, AnyDoc(..)
 , prompt
 , print
 , println
 , askLine
-, Line (..)
+, Line(..)
 , increment
-, ReadlineC (..)
-, runReadline
-, runReadlineWithHistory
-, ControlIOC (..)
-, runControlIO
 ) where
 
-import Prelude hiding (print)
-
-import Control.Effect.Carrier
-import Control.Effect.Lift
-import Control.Effect.Reader
-import Control.Monad.IO.Class
-import Control.Monad.Trans.Class
+import Control.Carrier
 import Data.Int
 import Data.String
 import Data.Text.Prettyprint.Doc
-import Data.Text.Prettyprint.Doc.Render.Text
 import GHC.Generics (Generic1)
-import System.Console.Haskeline hiding (Handler, handle)
-import System.Directory
-import System.FilePath
+import Prelude hiding (print)
 
 data Readline m k
   = Prompt String (Maybe String -> m k)
   | Print AnyDoc (m k)
   | AskLine (Line -> m k)
-  deriving stock (Functor, Generic1)
-  deriving anyclass (Effect, HFunctor)
+  deriving (Functor, Generic1)
+
+instance HFunctor Readline
+instance Effect   Readline
 
 newtype AnyDoc = AnyDoc { unAnyDoc :: forall a . Doc a }
 
-prompt :: (IsString str, Member Readline sig, Carrier sig m) => String -> m (Maybe str)
+prompt :: (IsString str, Has Readline sig m) => String -> m (Maybe str)
 prompt p = fmap fromString <$> send (Prompt p pure)
 
-print :: (Pretty a, Carrier sig m, Member Readline sig) => a -> m ()
+print :: (Pretty a, Has Readline sig m) => a -> m ()
 print s = send (Print (AnyDoc (pretty s)) (pure ()))
 
-println :: (Pretty a, Carrier sig m, Member Readline sig) => a -> m ()
+println :: (Pretty a, Has Readline sig m) => a -> m ()
 println s = print s >> print @String "\n"
 
-askLine :: (Carrier sig m, Member Readline sig) => m Line
+askLine :: Has Readline sig m => m Line
 askLine = send (AskLine pure)
 
 newtype Line = Line Int64
 
 increment :: Line -> Line
 increment (Line n) = Line (n + 1)
-
-newtype ReadlineC m a = ReadlineC { runReadlineC :: ReaderC Line (LiftC (InputT m)) a }
-  deriving newtype (Applicative, Functor, Monad, MonadIO)
-
-runReadline :: MonadException m => Prefs -> Settings m -> ReadlineC m a -> m a
-runReadline prefs settings = runInputTWithPrefs prefs settings . runM . runReader (Line 0) . runReadlineC
-
-instance (MonadException m, MonadIO m) => Carrier (Readline :+: Lift (InputT m)) (ReadlineC m) where
-  eff (L (Prompt prompt k)) = ReadlineC $ do
-    str <- lift (lift (getInputLine (cyan <> prompt <> plain)))
-    local increment (runReadlineC (k str))
-    where cyan = "\ESC[1;36m\STX"
-          plain = "\ESC[0m\STX"
-  eff (L (Print text k)) = liftIO (putDoc (unAnyDoc text)) *> k
-  eff (L (AskLine k)) = ReadlineC ask >>= k
-  eff (R other) = ReadlineC (eff (R (handleCoercible other)))
-
-runReadlineWithHistory :: MonadException m => ReadlineC m a -> m a
-runReadlineWithHistory block = do
-  homeDir <- liftIO getHomeDirectory
-  prefs <- liftIO $ readPrefs (homeDir </> ".haskeline")
-  let settingsDir = homeDir </> ".local/semantic-core"
-      settings = Settings
-        { complete = noCompletion
-        , historyFile = Just (settingsDir <> "/repl_history")
-        , autoAddHistory = True
-        }
-  liftIO $ createDirectoryIfMissing True settingsDir
-
-  runReadline prefs settings block
-
-runControlIO :: (forall x . m x -> IO x) -> ControlIOC m a -> m a
-runControlIO handler = runReader (Handler handler) . runControlIOC
-
--- | This exists to work around the 'MonadException' constraint that haskeline entails.
-newtype ControlIOC m a = ControlIOC { runControlIOC :: ReaderC (Handler m) m a }
-  deriving newtype (Applicative, Functor, Monad, MonadIO)
-
-newtype Handler m = Handler (forall x . m x -> IO x)
-
-runHandler :: Handler m -> ControlIOC m a -> IO a
-runHandler h@(Handler handler) = handler . runReader h . runControlIOC
-
-instance Carrier sig m => Carrier sig (ControlIOC m) where
-  eff op = ControlIOC (eff (R (handleCoercible op)))
-
-instance (Carrier sig m, MonadIO m) => MonadException (ControlIOC m) where
-  controlIO f = ControlIOC $ do
-    handler <- ask
-    liftIO (f (RunIO (fmap pure . runHandler handler)) >>= runHandler handler)

From e254bcbea4454a21e19bdf07776e3aad0f1761e5 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 4 Oct 2019 18:24:46 -0400
Subject: [PATCH 005/155] Remove redundant definitions.

---
 semantic-core/src/Analysis/FlowInsensitive.hs | 7 -------
 1 file changed, 7 deletions(-)

diff --git a/semantic-core/src/Analysis/FlowInsensitive.hs b/semantic-core/src/Analysis/FlowInsensitive.hs
index 0240d6739..7ed8f7f3b 100644
--- a/semantic-core/src/Analysis/FlowInsensitive.hs
+++ b/semantic-core/src/Analysis/FlowInsensitive.hs
@@ -70,13 +70,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

From 13d8eca0262a7d1976399269bf5d1f8614784437 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 4 Oct 2019 18:25:02 -0400
Subject: [PATCH 006/155] Update the flow-insensitive analysis.

---
 semantic-core/src/Analysis/FlowInsensitive.hs | 21 ++++++++-----------
 1 file changed, 9 insertions(+), 12 deletions(-)

diff --git a/semantic-core/src/Analysis/FlowInsensitive.hs b/semantic-core/src/Analysis/FlowInsensitive.hs
index 7ed8f7f3b..5e73a8676 100644
--- a/semantic-core/src/Analysis/FlowInsensitive.hs
+++ b/semantic-core/src/Analysis/FlowInsensitive.hs
@@ -8,14 +8,13 @@ module Analysis.FlowInsensitive
 , foldMapA
 ) where
 
-import           Control.Effect
+import           Control.Carrier
+import           Control.Carrier.NonDet.Church
+import           Control.Carrier.Reader
+import           Control.Carrier.State.Strict
 import           Control.Effect.Fresh
-import           Control.Effect.NonDet
-import           Control.Effect.Reader
-import           Control.Effect.State
 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,11 +27,10 @@ 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
                 )
@@ -49,9 +47,8 @@ convergeTerm _ eval body = do
 
 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
              )

From fdb983a7b5d352a035fa4b22f01343c154f667c3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 4 Oct 2019 18:25:18 -0400
Subject: [PATCH 007/155] Fix imports.

---
 semantic-core/src/Control/Monad/Module.hs | 2 +-
 semantic-core/src/Data/Scope.hs           | 2 +-
 semantic-core/src/Data/Term.hs            | 2 +-
 3 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/semantic-core/src/Control/Monad/Module.hs b/semantic-core/src/Control/Monad/Module.hs
index 84087d45d..d2b0647b8 100644
--- a/semantic-core/src/Control/Monad/Module.hs
+++ b/semantic-core/src/Control/Monad/Module.hs
@@ -6,7 +6,7 @@ module Control.Monad.Module
 , joinr
 ) where
 
-import Control.Effect.Carrier
+import Control.Carrier
 
 -- | Modules over monads allow lifting of a monad’s product (i.e. 'Control.Monad.join') into another structure composed with the monad. A right-module @f m@ over a monad @m@ therefore allows one to extend @m@’s '>>=' operation to values of @f m@ using the '>>=*' operator.
 --
diff --git a/semantic-core/src/Data/Scope.hs b/semantic-core/src/Data/Scope.hs
index 63fa2ced1..912c98daf 100644
--- a/semantic-core/src/Data/Scope.hs
+++ b/semantic-core/src/Data/Scope.hs
@@ -17,7 +17,7 @@ module Data.Scope
 ) where
 
 import Control.Applicative (liftA2)
-import Control.Effect.Carrier
+import Control.Carrier
 import Control.Monad ((>=>), guard)
 import Control.Monad.Module
 import Control.Monad.Trans.Class
diff --git a/semantic-core/src/Data/Term.hs b/semantic-core/src/Data/Term.hs
index 54bc6bf70..b03e15dbc 100644
--- a/semantic-core/src/Data/Term.hs
+++ b/semantic-core/src/Data/Term.hs
@@ -4,7 +4,7 @@ module Data.Term
 , hoistTerm
 ) where
 
-import Control.Effect.Carrier
+import Control.Carrier
 import Control.Monad (ap)
 import Control.Monad.Module
 

From a7700826af4271d03b98716e15bcab1494aa4599 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 4 Oct 2019 18:25:29 -0400
Subject: [PATCH 008/155] Fix imports & instances.

---
 semantic-core/src/Data/Loc.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/semantic-core/src/Data/Loc.hs b/semantic-core/src/Data/Loc.hs
index 7309da66e..6d573300b 100644
--- a/semantic-core/src/Data/Loc.hs
+++ b/semantic-core/src/Data/Loc.hs
@@ -12,8 +12,8 @@ module Data.Loc
 ) where
 
 import Control.Applicative
-import Control.Effect.Carrier
-import Control.Effect.Error
+import Control.Carrier
+import Control.Carrier.Error.Either
 import Control.Effect.Fail
 import Control.Effect.Reader
 import Data.Text (Text, pack)
@@ -70,11 +70,11 @@ runFailWithLoc = runError . runFailWithLocC
 newtype FailWithLocC m a = FailWithLocC { runFailWithLocC :: ErrorC (Loc, String) m a }
   deriving (Alternative, Applicative, Functor, Monad)
 
-instance (Carrier sig m, Effect sig, Member (Reader Loc) sig) => MonadFail (FailWithLocC m) where
+instance (Effect sig, Has (Reader Loc) sig m) => MonadFail (FailWithLocC m) where
   fail s = do
     loc <- ask
     FailWithLocC (throwError (loc :: Loc, s))
 
-instance (Carrier sig m, Effect sig, Member (Reader Loc) sig) => Carrier (Fail :+: sig) (FailWithLocC m) where
+instance (Effect sig, Has (Reader Loc) sig m) => Carrier (Fail :+: sig) (FailWithLocC m) where
   eff (L (Fail s)) = fail s
   eff (R other)    = FailWithLocC (eff (R (handleCoercible other)))

From 171bafc69e7bbe2a76427ba7a23d1ede914efc17 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 4 Oct 2019 18:25:47 -0400
Subject: [PATCH 009/155] Define Project locally to Data.Core for now.

---
 semantic-core/src/Data/Core.hs | 38 +++++++++++++++++++++++++++++++++-
 1 file changed, 37 insertions(+), 1 deletion(-)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 6691516ae..e50f412f3 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveGeneric, DeriveTraversable, FlexibleContexts, LambdaCase, MultiParamTypeClasses, OverloadedStrings, QuantifiedConstraints, RankNTypes,
+{-# LANGUAGE DeriveGeneric, DeriveTraversable, FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, OverloadedStrings, QuantifiedConstraints, RankNTypes,
              ScopedTypeVariables, StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Data.Core
 ( Core(..)
@@ -239,3 +239,39 @@ stripAnnotations :: (HFunctor sig, forall g . Functor g => Functor (sig g)) => T
 stripAnnotations (Var v)              = Var v
 stripAnnotations (Term (L (Ann _ b))) = stripAnnotations b
 stripAnnotations (Term (R        b))  = Term (hmap stripAnnotations b)
+
+
+-- | The class of types which can be projected from a signature.
+--
+--   This is based on Wouter Swierstra’s design described in [Data types à la carte](http://www.cs.ru.nl/~W.Swierstra/Publications/DataTypesALaCarte.pdf). As described therein, overlapping instances are required in order to distinguish e.g. left-occurrence from right-recursion.
+--
+--   It should not generally be necessary for you to define new 'Project' instances, but these are not specifically prohibited if you wish to get creative.
+class Project (sub :: (* -> *) -> (* -> *)) sup where
+  -- | Inject a member of a signature into the signature.
+  prj :: sup m a -> Maybe (sub m a)
+
+-- | Reflexivity: @t@ is a member of itself.
+instance Project t t where
+  prj = Just
+
+-- | Left-recursion: if @t@ is a member of @l1 ':+:' l2 ':+:' r@, then we can inject it into @(l1 ':+:' l2) ':+:' r@ by injection into a right-recursive signature, followed by left-association.
+instance {-# OVERLAPPABLE #-}
+         Project t (l1 :+: l2 :+: r)
+      => Project t ((l1 :+: l2) :+: r) where
+  prj = prj . reassoc where
+    reassoc (L (L l)) = L l
+    reassoc (L (R l)) = R (L l)
+    reassoc (R r)     = R (R r)
+
+-- | Left-occurrence: if @t@ is at the head of a signature, we can inject it in O(1).
+instance {-# OVERLAPPABLE #-}
+         Project l (l :+: r) where
+  prj (L l) = Just l
+  prj _     = Nothing
+
+-- | Right-recursion: if @t@ is a member of @r@, we can inject it into @r@ in O(n), followed by lifting that into @l ':+:' r@ in O(1).
+instance {-# OVERLAPPABLE #-}
+         Project l r
+      => Project l (l' :+: r) where
+  prj (R r) = prj r
+  prj _     = Nothing

From 60fff8d9a91fa08cef8c0a485eeb2b5368fa42f6 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 4 Oct 2019 18:25:56 -0400
Subject: [PATCH 010/155] Fix constraints.

---
 semantic-core/src/Data/Core.hs | 56 +++++++++++++++++-----------------
 1 file changed, 28 insertions(+), 28 deletions(-)

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index e50f412f3..e5dca8e2c 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -36,7 +36,7 @@ module Data.Core
 ) where
 
 import Control.Applicative (Alternative (..))
-import Control.Effect.Carrier
+import Control.Carrier
 import Control.Monad.Module
 import Data.Bifunctor (Bifunctor (..))
 import Data.Foldable (foldl')
@@ -108,19 +108,19 @@ instance RightModule Core where
   (a := b)   >>=* f = (a >>= f) := (b >>= f)
 
 
-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 (Term 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
@@ -128,23 +128,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 (Term 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
@@ -156,60 +156,60 @@ 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 (Term 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 (Term 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 -> m a -> m a
+(.=) :: Has Core sig m => m a -> m a -> m a
 a .= b = send (a := b)
 
 infix 3 .=
@@ -225,13 +225,13 @@ instance RightModule Ann where
   Ann l b >>=* f = Ann l (b >>= f)
 
 
-ann :: (Carrier sig m, Member Ann sig) => HasCallStack => m a -> m a
+ann :: Has Ann sig m => HasCallStack => m a -> m a
 ann = annWith callStack
 
-annAt :: (Carrier sig m, Member Ann sig) => Loc -> m a -> m a
+annAt :: Has Ann sig m => Loc -> m a -> m a
 annAt loc = send . Ann loc
 
-annWith :: (Carrier sig m, Member Ann sig) => CallStack -> m a -> m a
+annWith :: Has Ann sig m => CallStack -> m a -> m a
 annWith callStack = maybe id annAt (stackLoc callStack)
 
 

From 09ec150aea2f1c9d35e519665b2298877dd572b5 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 4 Oct 2019 18:26:56 -0400
Subject: [PATCH 011/155] Fix the core parser.

---
 semantic-core/src/Data/Core/Parser.hs | 32 +++++++++++++--------------
 1 file changed, 16 insertions(+), 16 deletions(-)

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index fc4b88c52..dfd24f4f7 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -12,7 +12,7 @@ module Data.Core.Parser
 -- Consult @doc/grammar.md@ for an EBNF grammar.
 
 import           Control.Applicative
-import           Control.Effect.Carrier
+import           Control.Carrier
 import qualified Data.Char as Char
 import           Data.Core ((:<-) (..), Core)
 import qualified Data.Core as Core
@@ -48,23 +48,23 @@ 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 = 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' (Core....) <$> atom <*> many (namedValue <$ dot <*> name)
 
-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
@@ -72,29 +72,29 @@ 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
 
-lvalue :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t Name)
+lvalue :: (TokenParsing m, Has Core sig t, Monad m) => m (t Name)
 lvalue = choice
   [ projection
   , ident
@@ -106,7 +106,7 @@ lvalue = choice
 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"
@@ -115,10 +115,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 "->"

From 2c4d23dcb6768f14f5efb26c9bfb3ed306538f65 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 4 Oct 2019 18:27:53 -0400
Subject: [PATCH 012/155] Fix Analysis.Eval.

---
 semantic-core/src/Analysis/Eval.hs | 19 +++++++++----------
 1 file changed, 9 insertions(+), 10 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index d645d355b..575371c81 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -12,7 +12,7 @@ module Analysis.Eval
 ) where
 
 import Control.Applicative (Alternative (..))
-import Control.Effect.Carrier
+import Control.Carrier
 import Control.Effect.Fail
 import Control.Effect.Reader
 import Control.Monad ((>=>))
@@ -28,8 +28,7 @@ import Data.Text (Text)
 import GHC.Stack
 import Prelude hiding (fail)
 
-eval :: ( Carrier sig m
-        , Member (Reader Loc) sig
+eval :: ( Has (Reader Loc) sig m
         , MonadFail m
         , Semigroup value
         )
@@ -93,30 +92,30 @@ eval Analysis{..} eval = \case
           Term (L (Ann loc c)) -> local (const loc) (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 sig, Member Core sig) => File (t Name)
+prog5 :: (Has Ann 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"))
@@ -127,7 +126,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 =
   [ File (Loc "dep"  (locSpan (fromJust here))) $ Core.record
     [ ("dep", Core.record [ ("var", Core.bool True) ]) ]
@@ -137,7 +136,7 @@ prog6 =
     ])
   ]
 
-ruby :: (Carrier sig t, Member Ann sig, Member Core sig) => File (t Name)
+ruby :: (Has Ann sig t, Has Core sig t) => File (t Name)
 ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (do' statements))
   where statements =
           [ Just "Class" :<- record

From 0e790149928ccd7698f000ac1e1d9eb73c56a073 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 4 Oct 2019 18:29:57 -0400
Subject: [PATCH 013/155] Fix Analysis.Typecheck.

---
 semantic-core/src/Analysis/Typecheck.hs | 38 ++++++++++++-------------
 1 file changed, 18 insertions(+), 20 deletions(-)

diff --git a/semantic-core/src/Analysis/Typecheck.hs b/semantic-core/src/Analysis/Typecheck.hs
index 3140246a9..d6fb898b0 100644
--- a/semantic-core/src/Analysis/Typecheck.hs
+++ b/semantic-core/src/Analysis/Typecheck.hs
@@ -10,11 +10,11 @@ module Analysis.Typecheck
 import           Analysis.Eval
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative (..))
-import           Control.Effect.Carrier
-import           Control.Effect.Fail
-import           Control.Effect.Fresh as Fresh
-import           Control.Effect.Reader hiding (Local)
-import           Control.Effect.State
+import           Control.Carrier
+import           Control.Carrier.Fail.Either
+import           Control.Carrier.Fresh.Strict as Fresh
+import           Control.Carrier.Reader hiding (Local)
+import           Control.Carrier.State.Strict
 import           Control.Monad ((>=>), unless)
 import           Control.Monad.Module
 import           Data.File
@@ -81,10 +81,10 @@ 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 Meta -> Term (Polytype :+: Monotype) Void
@@ -94,7 +94,7 @@ generalize ty = fromJust (closed (forAlls (IntSet.toList (mvs ty)) (hoistTerm R
 typecheckingFlowInsensitive
   :: Ord term
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     .  (Has (Reader Loc) sig m, MonadFail m)
      => Analysis term Name Type m
      -> (term -> m Type)
      -> (term -> m Type)
@@ -111,14 +111,13 @@ typecheckingFlowInsensitive eval
   . traverse (runFile eval)
 
 runFile
-  :: ( Carrier sig m
-     , Effect sig
-     , Member Fresh sig
-     , Member (State (Heap Name Type)) sig
+  :: ( Effect sig
+     , Has Fresh sig m
+     , Has (State (Heap Name Type)) sig m
      , Ord term
      )
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     .  (Has (Reader Loc) sig m, MonadFail m)
      => Analysis term Name Type m
      -> (term -> m Type)
      -> (term -> m Type)
@@ -146,10 +145,9 @@ runFile eval file = traverse run file
 
 typecheckingAnalysis
   :: ( Alternative m
-     , Carrier sig m
-     , Member Fresh sig
-     , Member (State (Set.Set Constraint)) sig
-     , Member (State (Heap Name Type)) sig
+     , Has Fresh sig m
+     , Has (State (Set.Set Constraint)) sig m
+     , Has (State (Heap Name Type)) sig m
      )
   => Analysis term Name Type m
 typecheckingAnalysis = Analysis{..}
@@ -196,17 +194,17 @@ data Solution
 
 infix 5 :=
 
-meta :: (Carrier sig m, Member Fresh sig) => m Type
+meta :: Has Fresh sig m => m Type
 meta = pure <$> Fresh.fresh
 
-unify :: (Carrier sig m, Member (State (Set.Set Constraint)) sig) => Term Monotype Meta -> Term Monotype Meta -> m ()
+unify :: Has (State (Set.Set Constraint)) sig m => Term Monotype Meta -> Term Monotype Meta -> m ()
 unify t1 t2
   | t1 == t2  = pure ()
   | otherwise = modify (<> Set.singleton (t1 :===: t2))
 
 type Substitution = IntMap.IntMap Type
 
-solve :: (Carrier sig m, Member (State Substitution) sig, MonadFail m) => Set.Set Constraint -> m ()
+solve :: (Has (State Substitution) sig m, MonadFail m) => Set.Set Constraint -> m ()
 solve cs = for_ cs solve
   where solve = \case
           -- FIXME: how do we enforce proper subtyping? row polymorphism or something?

From 6b9e765528ab01c3a724a1911cd45180b9670ddd Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 4 Oct 2019 18:31:10 -0400
Subject: [PATCH 014/155] Fix Analysis.ScopeGraph.

---
 semantic-core/src/Analysis/ScopeGraph.hs | 28 +++++++++++-------------
 1 file changed, 13 insertions(+), 15 deletions(-)

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index 0ca3311c4..ce4c610cc 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -10,11 +10,11 @@ module Analysis.ScopeGraph
 import           Analysis.Eval
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative (..))
-import           Control.Effect.Carrier
-import           Control.Effect.Fail
-import           Control.Effect.Fresh
-import           Control.Effect.Reader
-import           Control.Effect.State
+import           Control.Carrier
+import           Control.Carrier.Fail.Either
+import           Control.Carrier.Fresh.Strict
+import           Control.Carrier.Reader
+import           Control.Carrier.State.Strict
 import           Control.Monad ((>=>))
 import           Data.File
 import           Data.Foldable (fold)
@@ -50,7 +50,7 @@ instance Monoid ScopeGraph where
 scopeGraph
   :: Ord term
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     .  (Has (Reader Loc) sig m, MonadFail m)
      => Analysis term Name ScopeGraph m
      -> (term -> m ScopeGraph)
      -> (term -> m ScopeGraph)
@@ -64,14 +64,13 @@ scopeGraph eval
   . traverse (runFile eval)
 
 runFile
-  :: ( Carrier sig m
-     , Effect sig
-     , Member Fresh sig
-     , Member (State (Heap Name ScopeGraph)) sig
+  :: ( Effect sig
+     , Has Fresh sig m
+     , Has (State (Heap Name ScopeGraph)) sig m
      , Ord term
      )
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     .  (Has (Reader Loc) sig m, MonadFail m)
      => Analysis term Name ScopeGraph m
      -> (term -> m ScopeGraph)
      -> (term -> m ScopeGraph)
@@ -87,10 +86,9 @@ runFile eval file = traverse run file
 
 scopeGraphAnalysis
   :: ( Alternative m
-     , Carrier sig m
-     , Member (Reader Loc) sig
-     , Member (Reader (Map.Map Name Loc)) sig
-     , Member (State (Heap Name ScopeGraph)) sig
+     , Has (Reader Loc) sig m
+     , Has (Reader (Map.Map Name Loc)) sig m
+     , Has (State (Heap Name ScopeGraph)) sig m
      )
   => Analysis term Name ScopeGraph m
 scopeGraphAnalysis = Analysis{..}

From 376d1ef7bcbc15d0bd98893cf9e37511a48ad1b0 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 4 Oct 2019 18:32:21 -0400
Subject: [PATCH 015/155] Fix Analysis.ImportGraph.

---
 semantic-core/src/Analysis/ImportGraph.hs | 26 +++++++++++------------
 1 file changed, 12 insertions(+), 14 deletions(-)

diff --git a/semantic-core/src/Analysis/ImportGraph.hs b/semantic-core/src/Analysis/ImportGraph.hs
index 9e7cc81aa..1fac3e6f0 100644
--- a/semantic-core/src/Analysis/ImportGraph.hs
+++ b/semantic-core/src/Analysis/ImportGraph.hs
@@ -8,11 +8,11 @@ module Analysis.ImportGraph
 import           Analysis.Eval
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative(..))
-import           Control.Effect
-import           Control.Effect.Fail
-import           Control.Effect.Fresh
-import           Control.Effect.Reader
-import           Control.Effect.State
+import           Control.Carrier
+import           Control.Carrier.Fail.Either
+import           Control.Carrier.Fresh.Strict
+import           Control.Carrier.Reader
+import           Control.Carrier.State.Strict
 import           Control.Monad ((>=>))
 import           Data.File
 import           Data.Foldable (fold, for_)
@@ -51,7 +51,7 @@ data Semi term
 importGraph
   :: (Ord term, Show term)
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     .  (Has (Reader Loc) sig m, MonadFail m)
      => Analysis term Name (Value term) m
      -> (term -> m (Value term))
      -> (term -> m (Value term))
@@ -67,15 +67,14 @@ importGraph eval
   . traverse (runFile eval)
 
 runFile
-  :: ( Carrier sig m
-     , Effect sig
-     , Member Fresh sig
-     , Member (State (Heap Name (Value term))) sig
+  :: ( Effect sig
+     , Has Fresh sig m
+     , Has (State (Heap Name (Value term))) sig m
      , Ord  term
      , Show term
      )
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     .  (Has (Reader Loc) sig m, MonadFail m)
      => Analysis term Name (Value term) m
      -> (term -> m (Value term))
      -> (term -> m (Value term))
@@ -90,9 +89,8 @@ runFile eval file = traverse run file
 
 -- FIXME: decompose into a product domain and two atomic domains
 importGraphAnalysis :: ( Alternative m
-                       , Carrier sig m
-                       , Member (Reader Loc) sig
-                       , Member (State (Heap Name (Value term))) sig
+                       , Has (Reader Loc) sig m
+                       , Has (State (Heap Name (Value term))) sig m
                        , MonadFail m
                        , Ord  term
                        , Show term

From d59b7cc796aac09ab6cfb11a65527aff62911e74 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 4 Oct 2019 18:34:01 -0400
Subject: [PATCH 016/155] Fix Analysis.Concrete.

---
 semantic-core/src/Analysis/Concrete.hs | 36 ++++++++++++--------------
 1 file changed, 17 insertions(+), 19 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index b84dd1331..9da07308f 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -13,12 +13,12 @@ import qualified Algebra.Graph as G
 import qualified Algebra.Graph.Export.Dot as G
 import           Analysis.Eval
 import           Control.Applicative (Alternative (..))
-import           Control.Effect
-import           Control.Effect.Fail
-import           Control.Effect.Fresh
-import           Control.Effect.NonDet
-import           Control.Effect.Reader hiding (Local)
-import           Control.Effect.State
+import           Control.Carrier
+import           Control.Carrier.Fail.Either
+import           Control.Carrier.Fresh.Strict
+import           Control.Carrier.NonDet.Church
+import           Control.Carrier.Reader hiding (Local)
+import           Control.Carrier.State.Strict
 import           Control.Monad ((<=<), guard)
 import           Data.File
 import           Data.Function (fix)
@@ -71,7 +71,7 @@ data Edge = Lexical | Import
 concrete
   :: (Foldable term, Show (term Name))
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     .  (Has (Reader Loc) sig m, MonadFail m)
      => Analysis (term Name) Precise (Concrete (term Name)) m
      -> (term Name -> m (Concrete (term Name)))
      -> (term Name -> m (Concrete (term Name)))
@@ -85,15 +85,14 @@ concrete eval
   . traverse (runFile eval)
 
 runFile
-  :: ( Carrier sig m
-     , Effect sig
+  :: ( Effect sig
      , Foldable term
-     , Member Fresh sig
-     , Member (State (Heap (term Name))) sig
+     , Has Fresh sig m
+     , Has (State (Heap (term Name))) sig m
      , Show (term Name)
      )
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     .  (Has (Reader Loc) sig m, MonadFail m)
      => Analysis (term Name) Precise (Concrete (term Name)) m
      -> (term Name -> m (Concrete (term Name)))
      -> (term Name -> m (Concrete (term Name)))
@@ -106,12 +105,11 @@ runFile eval file = traverse run file
             . runReader @Env mempty
             . fix (eval concreteAnalysis)
 
-concreteAnalysis :: ( Carrier sig m
-                    , Foldable term
-                    , Member Fresh sig
-                    , Member (Reader Env) sig
-                    , Member (Reader Loc) sig
-                    , Member (State (Heap (term Name))) sig
+concreteAnalysis :: ( Foldable term
+                    , Has Fresh sig m
+                    , Has (Reader Env) sig m
+                    , Has (Reader Loc) sig m
+                    , Has (State (Heap (term Name))) sig m
                     , MonadFail m
                     , Show (term Name)
                     )
@@ -152,7 +150,7 @@ concreteAnalysis = Analysis{..}
 
 
 lookupConcrete :: Heap term -> Name -> Concrete term -> 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

From 3c3ff4aefc8a90bfbac7e840bf9066c363f932c1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 4 Oct 2019 18:44:17 -0400
Subject: [PATCH 017/155] Fix Tags.Tagging.Precise.

---
 semantic-tags/src/Tags/Tagging/Precise.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index c9c356650..2a7557214 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/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.Pure
+import Control.Carrier.Reader
+import Control.Carrier.Writer.Strict
 import Data.Monoid (Endo(..))
 import Data.Text as Text (Text, takeWhile)
 import GHC.Generics
@@ -26,7 +26,7 @@ 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{ span = s } = t { span = f s }
   toOneIndexed (Span (Pos l1 c1) (Pos l2 c2)) = Span (Pos (l1 + 1) (c1 + 1)) (Pos (l2 + 1) (c2 + 1))

From 13a6989a018d6b5c589ccd82400e91ae48ad0020 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 7 Oct 2019 09:07:02 -0400
Subject: [PATCH 018/155] Port Control.Effect.Parse forward.

---
 src/Control/Effect/Parse.hs | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/src/Control/Effect/Parse.hs b/src/Control/Effect/Parse.hs
index 07be28411..61efa76d3 100644
--- a/src/Control/Effect/Parse.hs
+++ b/src/Control/Effect/Parse.hs
@@ -5,9 +5,11 @@ module Control.Effect.Parse
 , parse
 , parseWith
 , parsePairWith
+  -- * Re-exports
+, Has
 ) where
 
-import Control.Effect.Carrier
+import Control.Carrier
 import Control.Effect.Error
 import Control.Exception (SomeException)
 import Data.Bifunctor.Join
@@ -30,7 +32,7 @@ instance Effect Parse where
 
 
 -- | Parse a 'Blob' with the given 'Parser'.
-parse :: (Member Parse sig, Carrier sig m)
+parse :: Has Parse sig m
       => Parser term
       -> Blob
       -> m term
@@ -39,7 +41,7 @@ parse parser blob = send (Parse parser blob pure)
 
 -- | 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.
@@ -50,7 +52,7 @@ parseWith parsers with blob = case Map.lookup (blobLanguage blob) parsers 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 => These (term ann) (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.

From f88dced69f47a4c6269c57fcd56e736cb2a5cd54 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 25 Oct 2019 17:28:32 -0400
Subject: [PATCH 019/155] Bump some SHAs.

---
 cabal.project | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/cabal.project b/cabal.project
index 2c42ea752..b40c74113 100644
--- a/cabal.project
+++ b/cabal.project
@@ -42,7 +42,7 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/fused-effects/fused-effects
-  tag: b0983cefd366a4df010ae3ac45318c50328d042e
+  tag: 7a8c0e8ab98bbbebe8bdf4af2b3531041ec8caef
 
 source-repository-package
   type: git
@@ -52,4 +52,4 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/antitypical/fused-syntax.git
-  tag: 5b7512db962d5b3f973002615b8bc86ab074d5aa
+  tag: 73a101e97759d51272b2fd9b0203565f99f9eaf6

From b1dd77d2fc407529413d464b781a244a44807eac Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 25 Oct 2019 17:45:19 -0400
Subject: [PATCH 020/155] Fix an import.

---
 semantic-analysis/src/Analysis/Concrete.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 30b0b94e0..50910111c 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -13,8 +13,8 @@ import qualified Algebra.Graph as G
 import qualified Algebra.Graph.Export.Dot as G
 import           Analysis.Analysis
 import           Analysis.File
+import           Control.Algebra
 import           Control.Applicative (Alternative (..))
-import           Control.Carrier
 import           Control.Carrier.Fail.WithLoc
 import           Control.Carrier.Fresh.Strict
 import           Control.Carrier.NonDet.Church

From dedeb43162e36d9a67cd831b0744e9199dcfc79a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 25 Oct 2019 17:45:25 -0400
Subject: [PATCH 021/155] Export the Cache type.

---
 semantic-analysis/src/Analysis/FlowInsensitive.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/semantic-analysis/src/Analysis/FlowInsensitive.hs b/semantic-analysis/src/Analysis/FlowInsensitive.hs
index 5e73a8676..e33c88e13 100644
--- a/semantic-analysis/src/Analysis/FlowInsensitive.hs
+++ b/semantic-analysis/src/Analysis/FlowInsensitive.hs
@@ -2,6 +2,7 @@
 module Analysis.FlowInsensitive
 ( Heap
 , FrameId(..)
+, Cache
 , convergeTerm
 , cacheTerm
 , runHeap

From ff605867524c55b3e38ac0c41ab0dadf8d39f394 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 25 Oct 2019 17:45:35 -0400
Subject: [PATCH 022/155] Reset fresh manually.

---
 semantic-analysis/src/Analysis/FlowInsensitive.hs | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

diff --git a/semantic-analysis/src/Analysis/FlowInsensitive.hs b/semantic-analysis/src/Analysis/FlowInsensitive.hs
index e33c88e13..7558b31f8 100644
--- a/semantic-analysis/src/Analysis/FlowInsensitive.hs
+++ b/semantic-analysis/src/Analysis/FlowInsensitive.hs
@@ -9,11 +9,11 @@ module Analysis.FlowInsensitive
 , foldMapA
 ) where
 
-import           Control.Carrier
+import           Control.Algebra
+import           Control.Carrier.Fresh.Strict
 import           Control.Carrier.NonDet.Church
 import           Control.Carrier.Reader
 import           Control.Carrier.State.Strict
-import           Control.Effect.Fresh
 import qualified Data.Map as Map
 import           Data.Maybe (fromMaybe)
 import qualified Data.Set as Set
@@ -28,7 +28,7 @@ newtype FrameId name = FrameId { unFrameId :: name }
 
 
 convergeTerm :: forall m sig a term address proxy
-             .  ( Effect sig
+             .  ( CanHandle sig ((,) (Cache term a))
                 , Eq address
                 , Has Fresh sig m
                 , Has (State (Heap address a)) sig m
@@ -36,13 +36,14 @@ convergeTerm :: forall m sig a term address proxy
                 , 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)))
 

From 50a94cee9dcf4cd3cd095715839b2f49cab59dd2 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 25 Oct 2019 17:45:43 -0400
Subject: [PATCH 023/155] Correct Fail.WithLoc.

---
 .../src/Control/Carrier/Fail/WithLoc.hs            | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/semantic-analysis/src/Control/Carrier/Fail/WithLoc.hs b/semantic-analysis/src/Control/Carrier/Fail/WithLoc.hs
index 90cf3c157..b19be04fa 100644
--- a/semantic-analysis/src/Control/Carrier/Fail/WithLoc.hs
+++ b/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 (CanHandle sig (Either (Path.AbsRelFile, Span, String)), 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 (CanHandle sig (Either (Path.AbsRelFile, Span, String)), 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 (handleCoercible other)

From f206046d21fdf89bf50554b5f091255191d5e620 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 25 Oct 2019 17:46:06 -0400
Subject: [PATCH 024/155] Fix Analysis.Typecheck.

Yeah, this is not going to fly.
---
 semantic-analysis/src/Analysis/Typecheck.hs | 27 ++++++++++++++++-----
 1 file changed, 21 insertions(+), 6 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index a4ff8a5a5..ca709a248 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/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, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Analysis.Typecheck
 ( Monotype (..)
 , Meta
@@ -10,10 +10,11 @@ module Analysis.Typecheck
 import           Analysis.Analysis
 import           Analysis.File
 import           Analysis.FlowInsensitive
+import           Control.Algebra
 import           Control.Applicative (Alternative (..))
-import           Control.Carrier
 import           Control.Carrier.Fail.WithLoc
 import           Control.Carrier.Fresh.Strict as Fresh
+import           Control.Carrier.NonDet.Church
 import           Control.Carrier.Reader hiding (Local)
 import           Control.Carrier.State.Strict
 import           Control.Monad ((>=>), unless)
@@ -33,6 +34,7 @@ import           Data.Void
 import           GHC.Generics (Generic1)
 import           Prelude hiding (fail)
 import           Source.Span
+import           Syntax.Functor
 import           Syntax.Module
 import           Syntax.Scope
 import           Syntax.Term
@@ -60,6 +62,14 @@ 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 Effect   (Monotype name) where
+  handle ctx dst = \case
+    Bool -> Bool
+    Unit -> Unit
+    String -> String
+    Arr f a -> Arr (dst (f <$ ctx)) (dst (a <$ ctx))
+    Record fs -> Record (dst . (<$ ctx) <$> fs)
+
 instance RightModule (Monotype name) where
   Unit     >>=* _ = Unit
   Bool     >>=* _ = Bool
@@ -70,7 +80,7 @@ instance RightModule (Monotype name) where
 type Meta = Int
 
 newtype Polytype f a = PForAll (Scope () f a)
-  deriving (Foldable, Functor, Generic1, Traversable)
+  deriving (Effect, Foldable, Functor, Generic1, 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)
@@ -106,14 +116,19 @@ typecheckingFlowInsensitive
      )
 typecheckingFlowInsensitive eval
   = run
-  . runFresh
+  . evalFresh 0
   . runHeap
   . fmap (fmap (fmap (fmap generalize)))
   . traverse (runFile eval)
 
 runFile
   :: forall term name m sig
-  .  ( Effect sig
+  .  ( CanHandle sig (Either (Path.AbsRelFile, Span, String))
+     , CanHandle sig ((,) (IntMap.IntMap (Type name)))
+     , CanHandle sig ((,) (Set.Set (Constraint name)))
+     , CanHandle sig ((,) (Cache (term name) (Type name)))
+     , CanHandle sig ((,) Int)
+     , CanHandle sig (NonDetC (FreshC (ReaderC (Cache (term name) (Type name)) (StateC (Cache (term name) (Type name)) (StateC (Set.Set (Constraint name)) (FailC (ReaderC Span (ReaderC Path.AbsRelFile (StateC (Substitution name) m)))))))))
      , Has Fresh sig m
      , Has (State (Heap name (Type name))) sig m
      , Ord name
@@ -146,7 +161,7 @@ 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

From dc7a3e1a21ea060dbc74c90bca6592da45af775f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 10:40:18 -0400
Subject: [PATCH 025/155] Bump.

---
 cabal.project | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/cabal.project b/cabal.project
index b40c74113..97014effa 100644
--- a/cabal.project
+++ b/cabal.project
@@ -42,7 +42,7 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/fused-effects/fused-effects
-  tag: 7a8c0e8ab98bbbebe8bdf4af2b3531041ec8caef
+  tag: b18f7d1af076d531b5e382ae5c12801c8b356b1f
 
 source-repository-package
   type: git

From 1ba069fedd2359830adb307408d4dee9adfdd6b3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 10:40:27 -0400
Subject: [PATCH 026/155] Identity.

---
 semantic-analysis/src/Analysis/Typecheck.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index ca709a248..721051e9b 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -21,6 +21,7 @@ import           Control.Monad ((>=>), unless)
 import           Data.Foldable (for_)
 import           Data.Function (fix)
 import           Data.Functor (($>))
+import           Data.Functor.Identity
 import qualified Data.IntMap as IntMap
 import qualified Data.IntSet as IntSet
 import           Data.List.NonEmpty (nonEmpty)
@@ -128,7 +129,7 @@ runFile
      , CanHandle sig ((,) (Set.Set (Constraint name)))
      , CanHandle sig ((,) (Cache (term name) (Type name)))
      , CanHandle sig ((,) Int)
-     , CanHandle sig (NonDetC (FreshC (ReaderC (Cache (term name) (Type name)) (StateC (Cache (term name) (Type name)) (StateC (Set.Set (Constraint name)) (FailC (ReaderC Span (ReaderC Path.AbsRelFile (StateC (Substitution name) m)))))))))
+     , CanHandle sig (NonDetC Identity)
      , Has Fresh sig m
      , Has (State (Heap name (Type name))) sig m
      , Ord name

From f616dbeb7880e5426412e9ece030189ad0d2c091 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 10:55:40 -0400
Subject: [PATCH 027/155] :fire: a redundant copy of the Readline carrier.

---
 .../src/Control/Carrier/Readline/Haskeline.hs | 70 -------------------
 1 file changed, 70 deletions(-)
 delete mode 100644 semantic-core/src/Control/Carrier/Readline/Haskeline.hs

diff --git a/semantic-core/src/Control/Carrier/Readline/Haskeline.hs b/semantic-core/src/Control/Carrier/Readline/Haskeline.hs
deleted file mode 100644
index 746c2f55b..000000000
--- a/semantic-core/src/Control/Carrier/Readline/Haskeline.hs
+++ /dev/null
@@ -1,70 +0,0 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, OverloadedStrings, RankNTypes, TypeApplications, TypeOperators, UndecidableInstances #-}
-module Control.Carrier.Readline.Haskeline
-( runReadline
-, runReadlineWithHistory
-, ReadlineC (..)
-, runControlIO
-, ControlIOC (..)
-) where
-
-import Control.Carrier
-import Control.Carrier.Lift
-import Control.Carrier.Reader
-import Control.Effect.Readline
-import Control.Monad.IO.Class
-import Control.Monad.Trans.Class
-import Data.Text.Prettyprint.Doc.Render.Text
-import System.Console.Haskeline hiding (Handler, handle)
-import System.Directory
-import System.FilePath
-
-runReadline :: MonadException m => Prefs -> Settings m -> ReadlineC m a -> m a
-runReadline prefs settings = runInputTWithPrefs prefs settings . runM . runReader (Line 0) . runReadlineC
-
-runReadlineWithHistory :: MonadException m => ReadlineC m a -> m a
-runReadlineWithHistory block = do
-  homeDir <- liftIO getHomeDirectory
-  prefs <- liftIO $ readPrefs (homeDir </> ".haskeline")
-  let settingsDir = homeDir </> ".local/semantic-core"
-      settings = Settings
-        { complete = noCompletion
-        , historyFile = Just (settingsDir <> "/repl_history")
-        , autoAddHistory = True
-        }
-  liftIO $ createDirectoryIfMissing True settingsDir
-
-  runReadline prefs settings block
-
-newtype ReadlineC m a = ReadlineC { runReadlineC :: ReaderC Line (LiftC (InputT m)) a }
-  deriving (Applicative, Functor, Monad, MonadIO)
-
-instance (MonadException m, MonadIO m) => Carrier (Readline :+: Lift (InputT m)) (ReadlineC m) where
-  eff (L (Prompt prompt k)) = ReadlineC $ do
-    str <- lift (lift (getInputLine (cyan <> prompt <> plain)))
-    local increment (runReadlineC (k str))
-    where cyan = "\ESC[1;36m\STX"
-          plain = "\ESC[0m\STX"
-  eff (L (Print text k)) = liftIO (putDoc (unAnyDoc text)) *> k
-  eff (L (AskLine k)) = ReadlineC ask >>= k
-  eff (R other) = ReadlineC (eff (R (handleCoercible other)))
-
-
-runControlIO :: (forall x . m x -> IO x) -> ControlIOC m a -> m a
-runControlIO handler = runReader (Handler handler) . runControlIOC
-
--- | This exists to work around the 'MonadException' constraint that haskeline entails.
-newtype ControlIOC m a = ControlIOC { runControlIOC :: ReaderC (Handler m) m a }
-  deriving (Applicative, Functor, Monad, MonadIO)
-
-newtype Handler m = Handler (forall x . m x -> IO x)
-
-runHandler :: Handler m -> ControlIOC m a -> IO a
-runHandler h@(Handler handler) = handler . runReader h . runControlIOC
-
-instance Carrier sig m => Carrier sig (ControlIOC m) where
-  eff op = ControlIOC (eff (R (handleCoercible op)))
-
-instance (Carrier sig m, MonadIO m) => MonadException (ControlIOC m) where
-  controlIO f = ControlIOC $ do
-    handler <- ask
-    liftIO (f (RunIO (fmap pure . runHandler handler)) >>= runHandler handler)

From bb6d3e027fb586ba2c3660dbd8e7043d297f32fd Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 10:56:30 -0400
Subject: [PATCH 028/155] Reformat a signature.

---
 semantic-analysis/src/Analysis/Concrete.hs | 28 ++++++++++++----------
 1 file changed, 15 insertions(+), 13 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 50910111c..f6f7ee49a 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -112,19 +112,21 @@ runFile eval file = traverse run file
             . runReader @(Env name) mempty
             . fix (eval concreteAnalysis)
 
-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
+  :: forall term name m sig
+  .  ( 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

From f8370766167d72dfbeaf2f5d3f996adc695f3c1a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 10:56:38 -0400
Subject: [PATCH 029/155] Fix an ambiguous variable.

---
 semantic-analysis/src/Analysis/Concrete.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index f6f7ee49a..7f98549f1 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -160,7 +160,7 @@ concreteAnalysis = Analysis{..}
         addr ... n = do
           val <- deref addr
           heap <- get
-          pure (val >>= lookupConcrete heap n)
+          pure (val >>= lookupConcrete (heap :: Heap term name) n)
 
 
 lookupConcrete :: (IsString name, Ord name) => Heap term name -> name -> Concrete term name -> Maybe Precise

From 5cc2e2509d81ac9e4074c8fb3649633a85934252 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 10:56:58 -0400
Subject: [PATCH 030/155] evalFresh.

---
 semantic-analysis/src/Analysis/Concrete.hs    | 2 +-
 semantic-analysis/src/Analysis/ImportGraph.hs | 4 ++--
 semantic-analysis/src/Analysis/ScopeGraph.hs  | 4 ++--
 3 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 7f98549f1..4362084bc 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -82,7 +82,7 @@ concrete
   -> (Heap term name, [File (Either (Path.AbsRelFile, Span, String) (Concrete term name))])
 concrete eval
   = run
-  . runFresh
+  . evalFresh 0
   . runHeap
   . traverse (runFile eval)
 
diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index deee4f7bb..f97eb0b87 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -62,7 +62,7 @@ importGraph
      )
 importGraph eval
   = run
-  . runFresh
+  . evalFresh 0
   . runHeap
   . traverse (runFile eval)
 
@@ -89,7 +89,7 @@ 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
diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index cf97aaa5b..9cd7e614b 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -62,7 +62,7 @@ scopeGraph
   -> (Heap name (ScopeGraph name), [File (Either (Path.AbsRelFile, Span, String) (ScopeGraph name))])
 scopeGraph eval
   = run
-  . runFresh
+  . evalFresh 0
   . runHeap
   . traverse (runFile eval)
 
@@ -89,7 +89,7 @@ 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

From bb7fb81c6802aa01901f8e932daa9a42b3a89f74 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 10:57:09 -0400
Subject: [PATCH 031/155] Fix the analyses constraints.

---
 semantic-analysis/src/Analysis/Concrete.hs    |  2 +-
 semantic-analysis/src/Analysis/ImportGraph.hs |  9 ++++--
 semantic-analysis/src/Analysis/ScopeGraph.hs  | 31 ++++++++++---------
 3 files changed, 25 insertions(+), 17 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 4362084bc..719984e60 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -88,7 +88,7 @@ concrete eval
 
 runFile
   :: forall term name m sig
-  .  ( Effect sig
+  .  ( CanHandle sig (Either (Path.AbsRelFile, Span, String))
      , Foldable term
      , IsString name
      , Has Fresh sig m
diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index f97eb0b87..9740eebe4 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -9,14 +9,16 @@ import           Analysis.Analysis
 import           Analysis.File
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative(..))
-import           Control.Carrier
+import           Control.Algebra
 import           Control.Carrier.Fail.WithLoc
 import           Control.Carrier.Fresh.Strict
+import           Control.Carrier.NonDet.Church
 import           Control.Carrier.Reader
 import           Control.Carrier.State.Strict
 import           Control.Monad ((>=>))
 import           Data.Foldable (fold, for_)
 import           Data.Function (fix)
+import           Data.Functor.Identity
 import           Data.List.NonEmpty (nonEmpty)
 import qualified Data.Map as Map
 import           Data.Proxy
@@ -68,7 +70,10 @@ importGraph eval
 
 runFile
   :: forall term name m sig
-  .  ( Effect sig
+  .  ( CanHandle sig (Either (Path.AbsRelFile, Span, String))
+     , CanHandle sig ((,) Int)
+     , CanHandle sig (NonDetC Identity)
+     , CanHandle sig ((,) (Cache (term name) (Value term name)))
      , Has Fresh sig m
      , Has (State (Heap name (Value term name))) sig m
      , Ord  name
diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index 9cd7e614b..46e349286 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -10,15 +10,17 @@ module Analysis.ScopeGraph
 import           Analysis.Analysis
 import           Analysis.File
 import           Analysis.FlowInsensitive
+import           Control.Algebra
 import           Control.Applicative (Alternative (..))
+import           Control.Carrier.NonDet.Church
+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)
 import           Data.Function (fix)
+import           Data.Functor.Identity
 import           Data.List.NonEmpty
 import qualified Data.Map as Map
 import           Data.Proxy
@@ -53,7 +55,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))
@@ -68,15 +70,17 @@ scopeGraph eval
 
 runFile
   :: forall term name m sig
-  .  ( Carrier sig m
-     , Effect sig
-     , Member Fresh sig
-     , Member (State (Heap name (ScopeGraph name))) sig
+  .  ( CanHandle sig ((,) Int)
+     , CanHandle sig ((,) (Cache (term name) (ScopeGraph name)))
+     , CanHandle sig (Either (Path.AbsRelFile, Span, String))
+     , CanHandle sig (NonDetC Identity)
+     , 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))
@@ -93,11 +97,10 @@ runFile eval file = traverse run file
 
 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

From e4dfe76ce92d78c07370732fbdbe275f5334fffa Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 10:58:49 -0400
Subject: [PATCH 032/155] Fix up the Readline effect & carrier.

---
 .../src/Control/Carrier/Readline/Haskeline.hs | 25 ++++++++-----------
 .../src/Control/Effect/Readline.hs            | 13 +++++-----
 2 files changed, 18 insertions(+), 20 deletions(-)

diff --git a/semantic-analysis/src/Control/Carrier/Readline/Haskeline.hs b/semantic-analysis/src/Control/Carrier/Readline/Haskeline.hs
index b7222acfb..6c43d1bb1 100644
--- a/semantic-analysis/src/Control/Carrier/Readline/Haskeline.hs
+++ b/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
diff --git a/semantic-analysis/src/Control/Effect/Readline.hs b/semantic-analysis/src/Control/Effect/Readline.hs
index 1a4b31639..bcb58f20b 100644
--- a/semantic-analysis/src/Control/Effect/Readline.hs
+++ b/semantic-analysis/src/Control/Effect/Readline.hs
@@ -5,10 +5,12 @@ module Control.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)
@@ -19,12 +21,11 @@ data Readline m k
   | Print (Doc AnsiStyle) (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 ()))

From c2a1a298a8d6a6c01292bb51fbc32fa3d76751b0 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 11:09:41 -0400
Subject: [PATCH 033/155] Fix Core.Core.

---
 semantic-core/src/Core/Core.hs | 34 ++++++++++++++++++++++++++++------
 1 file changed, 28 insertions(+), 6 deletions(-)

diff --git a/semantic-core/src/Core/Core.hs b/semantic-core/src/Core/Core.hs
index 7dc499a6a..14d1393f8 100644
--- a/semantic-core/src/Core/Core.hs
+++ b/semantic-core/src/Core/Core.hs
@@ -36,8 +36,8 @@ module Core.Core
 , stripAnnotations
 ) where
 
+import Control.Algebra
 import Control.Applicative (Alternative (..))
-import Control.Carrier
 import Core.Name
 import Data.Bifunctor (Bifunctor (..))
 import Data.Foldable (foldl')
@@ -47,8 +47,10 @@ import Data.Text (Text)
 import GHC.Generics (Generic1)
 import GHC.Stack
 import Source.Span
+import Syntax.Functor
 import Syntax.Scope
 import Syntax.Stack
+import Syntax.Sum
 import Syntax.Module
 import Syntax.Term
 
@@ -89,6 +91,24 @@ infixl 9 :.
 infix  3 :=
 
 instance HFunctor Core
+instance Effect Core where
+  type CanHandle Core ctx = Traversable ctx
+  handle ctx dst = \case
+    Rec b -> Rec (handle ctx dst <$> b)
+    a :>> b -> dst (a <$ ctx) :>> dst (b <$ ctx)
+    a :>>= f -> (dst . (<$ ctx) <$> a) :>>= handle ctx dst f
+    Lam b -> Lam (handle ctx dst <$> b)
+    f :$ a -> dst (f <$ ctx) :$ dst (a <$ ctx)
+    Unit -> Unit
+    Bool b -> Bool b
+    If c t e -> If (dst (c <$ ctx)) (dst (t <$ ctx)) (dst (e <$ ctx))
+    String s -> String s
+    Load t -> Load (dst (t <$ ctx))
+    Record fs -> Record (map (fmap (dst . (<$ ctx))) fs)
+    f :. n -> dst (f <$ ctx) :. n
+    f :? n -> dst (f <$ ctx) :? n
+    f := a -> dst (f <$ ctx) := dst (a <$ ctx)
+
 
 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)
@@ -120,7 +140,7 @@ 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
 
@@ -137,7 +157,7 @@ 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
 
@@ -166,7 +186,7 @@ lam (Named u n) b = send (Lam (Named u (abstract1 n b)))
 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
 
@@ -181,7 +201,7 @@ infixl 8 $$
 
 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
 
@@ -229,6 +249,8 @@ data Ann ann f a
   deriving (Eq, Foldable, Functor, Generic1, Ord, Show, Traversable)
 
 instance HFunctor (Ann ann)
+instance Effect   (Ann ann) where
+  handle ctx dst (Ann a b) = Ann a (dst (b <$ ctx))
 
 instance RightModule (Ann ann) where
   Ann l b >>=* f = Ann l (b >>= f)
@@ -244,7 +266,7 @@ 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)

From d3cb08c9cf3f6441e0a9bcbdc1229cddfae6f2fb Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 11:10:34 -0400
Subject: [PATCH 034/155] Fix the rest of semantic-core.

---
 semantic-core/src/Core/Eval.hs   | 2 +-
 semantic-core/src/Core/Parser.hs | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index 92a27cb32..ba9c47360 100644
--- a/semantic-core/src/Core/Eval.hs
+++ 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.Carrier
 import Control.Effect.Fail
 import Control.Effect.Reader
 import Control.Monad ((>=>))
diff --git a/semantic-core/src/Core/Parser.hs b/semantic-core/src/Core/Parser.hs
index 958ae64c4..1f49646f6 100644
--- a/semantic-core/src/Core/Parser.hs
+++ b/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.Carrier
 import           Control.Monad
 import           Core.Core ((:<-) (..), Core)
 import qualified Core.Core as Core

From 4f3938d293b7d512f7891bf0af16f8e5fd054505 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 11:57:59 -0400
Subject: [PATCH 035/155] Bump for constraints in the Effect signature.

---
 cabal.project                                 |  4 ++--
 semantic-analysis/src/Analysis/Concrete.hs    |  7 ++++---
 .../src/Analysis/FlowInsensitive.hs           |  7 ++++---
 semantic-analysis/src/Analysis/ImportGraph.hs | 13 ++++++------
 semantic-analysis/src/Analysis/ScopeGraph.hs  | 13 ++++++------
 semantic-analysis/src/Analysis/Typecheck.hs   | 21 ++++++++++---------
 .../src/Control/Carrier/Fail/WithLoc.hs       |  6 +++---
 .../src/Control/Effect/Readline.hs            |  4 ++--
 8 files changed, 40 insertions(+), 35 deletions(-)

diff --git a/cabal.project b/cabal.project
index 97014effa..8b9f8cfa6 100644
--- a/cabal.project
+++ b/cabal.project
@@ -42,7 +42,7 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/fused-effects/fused-effects
-  tag: b18f7d1af076d531b5e382ae5c12801c8b356b1f
+  tag: 1c5a2fd197a5bd4af43019e9be6ec59b44c00d7c
 
 source-repository-package
   type: git
@@ -52,4 +52,4 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/antitypical/fused-syntax.git
-  tag: 73a101e97759d51272b2fd9b0203565f99f9eaf6
+  tag: d4ca0910d2b73f7686f57229557018973c2adc4a
diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 719984e60..788515dcf 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DerivingVia, FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE ConstraintKinds, DerivingVia, FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeOperators, UndecidableInstances #-}
 module Analysis.Concrete
 ( Concrete(..)
 , concrete
@@ -87,8 +87,9 @@ concrete eval
   . traverse (runFile eval)
 
 runFile
-  :: forall term name m sig
-  .  ( CanHandle sig (Either (Path.AbsRelFile, Span, String))
+  :: forall term name m c sig
+  .  ( c (Either (Path.AbsRelFile, Span, String))
+     , Effect c sig
      , Foldable term
      , IsString name
      , Has Fresh sig m
diff --git a/semantic-analysis/src/Analysis/FlowInsensitive.hs b/semantic-analysis/src/Analysis/FlowInsensitive.hs
index 7558b31f8..a497a0c0d 100644
--- a/semantic-analysis/src/Analysis/FlowInsensitive.hs
+++ b/semantic-analysis/src/Analysis/FlowInsensitive.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, OverloadedStrings, ScopedTypeVariables, TypeOperators #-}
+{-# LANGUAGE ConstraintKinds, FlexibleContexts, OverloadedStrings, ScopedTypeVariables, TypeOperators #-}
 module Analysis.FlowInsensitive
 ( Heap
 , FrameId(..)
@@ -27,8 +27,9 @@ newtype FrameId name = FrameId { unFrameId :: name }
   deriving (Eq, Ord, Show)
 
 
-convergeTerm :: forall m sig a term address proxy
-             .  ( CanHandle sig ((,) (Cache term a))
+convergeTerm :: forall m c sig a term address proxy
+             .  ( Effect c sig
+                , c ((,) (Cache term a))
                 , Eq address
                 , Has Fresh sig m
                 , Has (State (Heap address a)) sig m
diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 9740eebe4..fbd4ec824 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications #-}
+{-# LANGUAGE ConstraintKinds, FlexibleContexts, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications #-}
 module Analysis.ImportGraph
 ( ImportGraph
 , importGraph
@@ -69,11 +69,12 @@ importGraph eval
   . traverse (runFile eval)
 
 runFile
-  :: forall term name m sig
-  .  ( CanHandle sig (Either (Path.AbsRelFile, Span, String))
-     , CanHandle sig ((,) Int)
-     , CanHandle sig (NonDetC Identity)
-     , CanHandle sig ((,) (Cache (term name) (Value term name)))
+  :: forall term name m c sig
+  .  ( c (Either (Path.AbsRelFile, Span, String))
+     , c (NonDetC Identity)
+     , c ((,) (Cache (term name) (Value term name)))
+     , c ((,) Int)
+     , Effect c sig
      , Has Fresh sig m
      , Has (State (Heap name (Value term name))) sig m
      , Ord  name
diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index 46e349286..aa54771bf 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, OverloadedStrings, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeOperators #-}
+{-# LANGUAGE ConstraintKinds, FlexibleContexts, OverloadedStrings, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeOperators #-}
 module Analysis.ScopeGraph
 ( ScopeGraph(..)
 , Ref (..)
@@ -69,11 +69,12 @@ scopeGraph eval
   . traverse (runFile eval)
 
 runFile
-  :: forall term name m sig
-  .  ( CanHandle sig ((,) Int)
-     , CanHandle sig ((,) (Cache (term name) (ScopeGraph name)))
-     , CanHandle sig (Either (Path.AbsRelFile, Span, String))
-     , CanHandle sig (NonDetC Identity)
+  :: forall term name m c sig
+  .  ( c ((,) Int)
+     , c ((,) (Cache (term name) (ScopeGraph name)))
+     , c (Either (Path.AbsRelFile, Span, String))
+     , c (NonDetC Identity)
+     , Effect c sig
      , Has Fresh sig m
      , Has (State (Heap name (ScopeGraph name))) sig m
      , Ord name
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 721051e9b..0b8a2edbe 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveGeneric, DeriveTraversable, DerivingVia, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE ConstraintKinds, DeriveGeneric, DeriveTraversable, DerivingVia, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
 module Analysis.Typecheck
 ( Monotype (..)
 , Meta
@@ -63,7 +63,7 @@ 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 Effect   (Monotype name) where
+instance Effect Functor (Monotype name) where
   handle ctx dst = \case
     Bool -> Bool
     Unit -> Unit
@@ -81,7 +81,7 @@ instance RightModule (Monotype name) where
 type Meta = Int
 
 newtype Polytype f a = PForAll (Scope () f a)
-  deriving (Effect, Foldable, Functor, Generic1, Traversable)
+  deriving (Effect Traversable, Foldable, Functor, Generic1, 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)
@@ -123,13 +123,14 @@ typecheckingFlowInsensitive eval
   . traverse (runFile eval)
 
 runFile
-  :: forall term name m sig
-  .  ( CanHandle sig (Either (Path.AbsRelFile, Span, String))
-     , CanHandle sig ((,) (IntMap.IntMap (Type name)))
-     , CanHandle sig ((,) (Set.Set (Constraint name)))
-     , CanHandle sig ((,) (Cache (term name) (Type name)))
-     , CanHandle sig ((,) Int)
-     , CanHandle sig (NonDetC Identity)
+  :: forall term name m c sig
+  .  ( c (Either (Path.AbsRelFile, Span, String))
+     , c ((,) (IntMap.IntMap (Type name)))
+     , c ((,) (Set.Set (Constraint name)))
+     , c ((,) (Cache (term name) (Type name)))
+     , c ((,) Int)
+     , c (NonDetC Identity)
+     , Effect c sig
      , Has Fresh sig m
      , Has (State (Heap name (Type name))) sig m
      , Ord name
diff --git a/semantic-analysis/src/Control/Carrier/Fail/WithLoc.hs b/semantic-analysis/src/Control/Carrier/Fail/WithLoc.hs
index b19be04fa..54c96d44d 100644
--- a/semantic-analysis/src/Control/Carrier/Fail/WithLoc.hs
+++ b/semantic-analysis/src/Control/Carrier/Fail/WithLoc.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE ConstraintKinds, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
 module Control.Carrier.Fail.WithLoc
 ( -- * Fail effect
   module Control.Effect.Fail
@@ -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 (CanHandle sig (Either (Path.AbsRelFile, Span, String)), Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m) => MonadFail (FailC m) where
+instance (Effect c sig, c (Either (Path.AbsRelFile, Span, String)), 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 (CanHandle sig (Either (Path.AbsRelFile, Span, String)), Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m) => Algebra (Fail :+: sig) (FailC m) where
+instance (Effect c sig, c (Either (Path.AbsRelFile, Span, String)), 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 (handleCoercible other)
diff --git a/semantic-analysis/src/Control/Effect/Readline.hs b/semantic-analysis/src/Control/Effect/Readline.hs
index bcb58f20b..89a81795e 100644
--- a/semantic-analysis/src/Control/Effect/Readline.hs
+++ b/semantic-analysis/src/Control/Effect/Readline.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, OverloadedStrings #-}
+{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, MultiParamTypeClasses #-}
 module Control.Effect.Readline
 ( -- * Readline effect
   Readline (..)
@@ -21,7 +21,7 @@ data Readline m k
   | Print (Doc AnsiStyle) (m k)
   deriving (Functor, Generic1)
 
-instance Effect Readline
+instance Effect Functor Readline
 
 
 prompt :: Has Readline sig m => String -> m (Int, Maybe String)

From 554b2896578ff0db98ab1507d488fa4e0485fac2 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 11:59:37 -0400
Subject: [PATCH 036/155] Derive the Effect instance for Monotype.

---
 semantic-analysis/src/Analysis/Typecheck.hs | 8 +-------
 1 file changed, 1 insertion(+), 7 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 0b8a2edbe..ef4d306cf 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -63,13 +63,7 @@ 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 Effect Functor (Monotype name) where
-  handle ctx dst = \case
-    Bool -> Bool
-    Unit -> Unit
-    String -> String
-    Arr f a -> Arr (dst (f <$ ctx)) (dst (a <$ ctx))
-    Record fs -> Record (dst . (<$ ctx) <$> fs)
+instance Effect Functor (Monotype name)
 
 instance RightModule (Monotype name) where
   Unit     >>=* _ = Unit

From e139ec0a76fe7a53cf18236688750dead3752321 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 12:00:30 -0400
Subject: [PATCH 037/155] Fix the Effect instances in Core.Core.

---
 semantic-core/src/Core/Core.hs | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/semantic-core/src/Core/Core.hs b/semantic-core/src/Core/Core.hs
index 14d1393f8..7f5ab1a73 100644
--- a/semantic-core/src/Core/Core.hs
+++ b/semantic-core/src/Core/Core.hs
@@ -91,8 +91,7 @@ infixl 9 :.
 infix  3 :=
 
 instance HFunctor Core
-instance Effect Core where
-  type CanHandle Core ctx = Traversable ctx
+instance Effect Traversable Core where
   handle ctx dst = \case
     Rec b -> Rec (handle ctx dst <$> b)
     a :>> b -> dst (a <$ ctx) :>> dst (b <$ ctx)
@@ -249,7 +248,7 @@ data Ann ann f a
   deriving (Eq, Foldable, Functor, Generic1, Ord, Show, Traversable)
 
 instance HFunctor (Ann ann)
-instance Effect   (Ann ann) where
+instance Effect Functor (Ann ann) where
   handle ctx dst (Ann a b) = Ann a (dst (b <$ ctx))
 
 instance RightModule (Ann ann) where

From b3308bc694d29d0e0388a1a15f7c6cbf9ac8bc0b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 12:01:06 -0400
Subject: [PATCH 038/155] Derive the Effect instance for Ann.

---
 semantic-core/src/Core/Core.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/semantic-core/src/Core/Core.hs b/semantic-core/src/Core/Core.hs
index 7f5ab1a73..a4264ea2e 100644
--- a/semantic-core/src/Core/Core.hs
+++ b/semantic-core/src/Core/Core.hs
@@ -248,8 +248,7 @@ data Ann ann f a
   deriving (Eq, Foldable, Functor, Generic1, Ord, Show, Traversable)
 
 instance HFunctor (Ann ann)
-instance Effect Functor (Ann ann) where
-  handle ctx dst (Ann a b) = Ann a (dst (b <$ ctx))
+instance Effect Functor (Ann ann)
 
 instance RightModule (Ann ann) where
   Ann l b >>=* f = Ann l (b >>= f)

From 904b79b462d5e70e3039db08f5a47d3131518f6c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 12:01:13 -0400
Subject: [PATCH 039/155] Derive the Effect instance for Core.

---
 semantic-core/src/Core/Core.hs | 18 +-----------------
 1 file changed, 1 insertion(+), 17 deletions(-)

diff --git a/semantic-core/src/Core/Core.hs b/semantic-core/src/Core/Core.hs
index a4264ea2e..0bb2966a9 100644
--- a/semantic-core/src/Core/Core.hs
+++ b/semantic-core/src/Core/Core.hs
@@ -91,23 +91,7 @@ infixl 9 :.
 infix  3 :=
 
 instance HFunctor Core
-instance Effect Traversable Core where
-  handle ctx dst = \case
-    Rec b -> Rec (handle ctx dst <$> b)
-    a :>> b -> dst (a <$ ctx) :>> dst (b <$ ctx)
-    a :>>= f -> (dst . (<$ ctx) <$> a) :>>= handle ctx dst f
-    Lam b -> Lam (handle ctx dst <$> b)
-    f :$ a -> dst (f <$ ctx) :$ dst (a <$ ctx)
-    Unit -> Unit
-    Bool b -> Bool b
-    If c t e -> If (dst (c <$ ctx)) (dst (t <$ ctx)) (dst (e <$ ctx))
-    String s -> String s
-    Load t -> Load (dst (t <$ ctx))
-    Record fs -> Record (map (fmap (dst . (<$ ctx))) fs)
-    f :. n -> dst (f <$ ctx) :. n
-    f :? n -> dst (f <$ ctx) :? n
-    f := a -> dst (f <$ ctx) := dst (a <$ ctx)
-
+instance Effect Traversable 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)

From 8d751c1dbcea9176f183ea642adc6769f247ee8e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 13:26:07 -0400
Subject: [PATCH 040/155] Derive the RightModule instance for Ann.

---
 cabal.project                  | 2 +-
 semantic-core/src/Core/Core.hs | 4 +---
 2 files changed, 2 insertions(+), 4 deletions(-)

diff --git a/cabal.project b/cabal.project
index 8b9f8cfa6..53bd560ce 100644
--- a/cabal.project
+++ b/cabal.project
@@ -52,4 +52,4 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/antitypical/fused-syntax.git
-  tag: d4ca0910d2b73f7686f57229557018973c2adc4a
+  tag: cb3dce1ec4b1197032da8e0c7f4fab20f9bf36b2
diff --git a/semantic-core/src/Core/Core.hs b/semantic-core/src/Core/Core.hs
index 0bb2966a9..563b2d2af 100644
--- a/semantic-core/src/Core/Core.hs
+++ b/semantic-core/src/Core/Core.hs
@@ -233,9 +233,7 @@ data Ann ann f a
 
 instance HFunctor (Ann ann)
 instance Effect Functor (Ann ann)
-
-instance RightModule (Ann ann) where
-  Ann l b >>=* f = Ann l (b >>= f)
+instance RightModule (Ann ann)
 
 
 ann :: Has (Ann Span) sig m => HasCallStack => m a -> m a

From a8333adae0055691dcacd7df5537768f6d31d16a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 13:26:15 -0400
Subject: [PATCH 041/155] Derive the RightModule instance for Core.

---
 semantic-core/src/Core/Core.hs | 17 +----------------
 1 file changed, 1 insertion(+), 16 deletions(-)

diff --git a/semantic-core/src/Core/Core.hs b/semantic-core/src/Core/Core.hs
index 563b2d2af..d0f6ed955 100644
--- a/semantic-core/src/Core/Core.hs
+++ b/semantic-core/src/Core/Core.hs
@@ -92,28 +92,13 @@ infix  3 :=
 
 instance HFunctor Core
 instance Effect Traversable Core
+instance RightModule 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)
-  (a :>>= b) >>=* f = ((>>= f) <$> a) :>>= (b >>=* f)
-  Lam b      >>=* f = Lam ((>>=* f) <$> b)
-  (a :$ b)   >>=* f = (a >>= f) :$ (b >>= f)
-  Unit       >>=* _ = Unit
-  Bool b     >>=* _ = Bool b
-  If c t e   >>=* f = If (c >>= f) (t >>= f) (e >>= f)
-  String s   >>=* _ = String s
-  Load b     >>=* f = Load (b >>= f)
-  Record fs  >>=* f = Record (map (fmap (>>= f)) fs)
-  (a :. b)   >>=* f = (a >>= f) :. b
-  (a :? b)   >>=* f = (a >>= f) :. b
-  (a := b)   >>=* f = (a >>= f) := (b >>= f)
-
 
 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)))

From 37d41a83a169fb6ff8750d5a9bf3990fc17b1f67 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 13:26:48 -0400
Subject: [PATCH 042/155] Derive the RightModule instance for Monotype.

---
 semantic-analysis/src/Analysis/Typecheck.hs | 8 +-------
 1 file changed, 1 insertion(+), 7 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index ef4d306cf..93fd4be0c 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -64,13 +64,7 @@ deriving instance (Show name, Show a, forall a . Show a => Show (f a))
 
 instance HFunctor (Monotype name)
 instance Effect Functor (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)
+instance RightModule (Monotype name)
 
 type Meta = Int
 

From b9e05a97e7d74f942ad9f4d7da3ac7415eef709c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 13:27:52 -0400
Subject: [PATCH 043/155] Derive the HFunctor & RightModule instances for
 Polytype.

---
 semantic-analysis/src/Analysis/Typecheck.hs | 6 +-----
 1 file changed, 1 insertion(+), 5 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 93fd4be0c..fbac1421b 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -69,17 +69,13 @@ instance RightModule (Monotype name)
 type Meta = Int
 
 newtype Polytype f a = PForAll (Scope () f a)
-  deriving (Effect Traversable, Foldable, Functor, Generic1, Traversable)
+  deriving (Effect Traversable, 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, Has Polytype sig m) => a -> m a -> m a
 forAll n body = send (PForAll (abstract1 n body))

From c9c74ad67b9a761671a090b93988f98a42f896f7 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 13:29:44 -0400
Subject: [PATCH 044/155] Abstract over the context constraints in
 Analysis.Typecheck.

---
 semantic-analysis/src/Analysis/Typecheck.hs | 9 +--------
 1 file changed, 1 insertion(+), 8 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index fbac1421b..809479e99 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -14,14 +14,12 @@ import           Control.Algebra
 import           Control.Applicative (Alternative (..))
 import           Control.Carrier.Fail.WithLoc
 import           Control.Carrier.Fresh.Strict as Fresh
-import           Control.Carrier.NonDet.Church
 import           Control.Carrier.Reader hiding (Local)
 import           Control.Carrier.State.Strict
 import           Control.Monad ((>=>), unless)
 import           Data.Foldable (for_)
 import           Data.Function (fix)
 import           Data.Functor (($>))
-import           Data.Functor.Identity
 import qualified Data.IntMap as IntMap
 import qualified Data.IntSet as IntSet
 import           Data.List.NonEmpty (nonEmpty)
@@ -108,12 +106,7 @@ typecheckingFlowInsensitive eval
 
 runFile
   :: forall term name m c sig
-  .  ( c (Either (Path.AbsRelFile, Span, String))
-     , c ((,) (IntMap.IntMap (Type name)))
-     , c ((,) (Set.Set (Constraint name)))
-     , c ((,) (Cache (term name) (Type name)))
-     , c ((,) Int)
-     , c (NonDetC Identity)
+  .  ( forall ctx . Functor ctx => c ctx
      , Effect c sig
      , Has Fresh sig m
      , Has (State (Heap name (Type name))) sig m

From 5b004aba1f5415b7476e632b3f7463a2e69b948e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 13:30:41 -0400
Subject: [PATCH 045/155] Abstract over the context constraints in
 Analysis.ScopeGraph.

---
 semantic-analysis/src/Analysis/ScopeGraph.hs | 9 ++-------
 1 file changed, 2 insertions(+), 7 deletions(-)

diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index aa54771bf..f8f8c8b82 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ConstraintKinds, FlexibleContexts, OverloadedStrings, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeOperators #-}
+{-# LANGUAGE ConstraintKinds, FlexibleContexts, OverloadedStrings, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeOperators #-}
 module Analysis.ScopeGraph
 ( ScopeGraph(..)
 , Ref (..)
@@ -12,7 +12,6 @@ import           Analysis.File
 import           Analysis.FlowInsensitive
 import           Control.Algebra
 import           Control.Applicative (Alternative (..))
-import           Control.Carrier.NonDet.Church
 import           Control.Carrier.Reader
 import           Control.Carrier.Fail.WithLoc
 import           Control.Carrier.Fresh.Strict
@@ -20,7 +19,6 @@ import           Control.Effect.State
 import           Control.Monad ((>=>))
 import           Data.Foldable (fold)
 import           Data.Function (fix)
-import           Data.Functor.Identity
 import           Data.List.NonEmpty
 import qualified Data.Map as Map
 import           Data.Proxy
@@ -70,10 +68,7 @@ scopeGraph eval
 
 runFile
   :: forall term name m c sig
-  .  ( c ((,) Int)
-     , c ((,) (Cache (term name) (ScopeGraph name)))
-     , c (Either (Path.AbsRelFile, Span, String))
-     , c (NonDetC Identity)
+  .  ( forall ctx . Functor ctx => c ctx
      , Effect c sig
      , Has Fresh sig m
      , Has (State (Heap name (ScopeGraph name))) sig m

From 3c1cdcb437a12624b67eeb2d8b6903c0a9483a61 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 13:31:45 -0400
Subject: [PATCH 046/155] Abstract over the context constraints in
 Analysis.ImportGraph.

---
 semantic-analysis/src/Analysis/ImportGraph.hs | 9 ++-------
 1 file changed, 2 insertions(+), 7 deletions(-)

diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index fbd4ec824..2fdc6a83d 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ConstraintKinds, FlexibleContexts, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications #-}
+{-# LANGUAGE ConstraintKinds, FlexibleContexts, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications #-}
 module Analysis.ImportGraph
 ( ImportGraph
 , importGraph
@@ -12,13 +12,11 @@ import           Control.Applicative (Alternative(..))
 import           Control.Algebra
 import           Control.Carrier.Fail.WithLoc
 import           Control.Carrier.Fresh.Strict
-import           Control.Carrier.NonDet.Church
 import           Control.Carrier.Reader
 import           Control.Carrier.State.Strict
 import           Control.Monad ((>=>))
 import           Data.Foldable (fold, for_)
 import           Data.Function (fix)
-import           Data.Functor.Identity
 import           Data.List.NonEmpty (nonEmpty)
 import qualified Data.Map as Map
 import           Data.Proxy
@@ -70,10 +68,7 @@ importGraph eval
 
 runFile
   :: forall term name m c sig
-  .  ( c (Either (Path.AbsRelFile, Span, String))
-     , c (NonDetC Identity)
-     , c ((,) (Cache (term name) (Value term name)))
-     , c ((,) Int)
+  .  ( forall ctx . Functor ctx => c ctx
      , Effect c sig
      , Has Fresh sig m
      , Has (State (Heap name (Value term name))) sig m

From ed65e400033d3c046b1850ad628e30c30fcd150a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 28 Oct 2019 13:32:35 -0400
Subject: [PATCH 047/155] Abstract over the context constraints in
 Analysis.Concrete.

---
 semantic-analysis/src/Analysis/Concrete.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 788515dcf..2f84f13f6 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ConstraintKinds, DerivingVia, FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE ConstraintKinds, DerivingVia, FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeOperators, UndecidableInstances #-}
 module Analysis.Concrete
 ( Concrete(..)
 , concrete
@@ -88,7 +88,7 @@ concrete eval
 
 runFile
   :: forall term name m c sig
-  .  ( c (Either (Path.AbsRelFile, Span, String))
+  .  ( forall ctx . Functor ctx => c ctx
      , Effect c sig
      , Foldable term
      , IsString name

From eb989d2c3f909ea47daf5acb69f7517bd8a34395 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Wed, 6 Nov 2019 15:01:42 -0500
Subject: [PATCH 048/155] Bump versions.

---
 cabal.project  | 6 +++---
 semantic.cabal | 4 ++--
 2 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/cabal.project b/cabal.project
index c36900e03..210647625 100644
--- a/cabal.project
+++ b/cabal.project
@@ -38,14 +38,14 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/fused-effects/fused-effects
-  tag: 1c5a2fd197a5bd4af43019e9be6ec59b44c00d7c
+  tag: eb039082280697e5ed998740462cc13fbdcc85f7
 
 source-repository-package
   type: git
   location: https://github.com/fused-effects/fused-effects-exceptions
-  tag: 5cf63ef72066ccfa63e6c07a936760302f54f5ab
+  tag: 31c9b7cdee1b93b1f1d716c1af92ad4b8c2bd4d3
 
 source-repository-package
   type: git
   location: https://github.com/antitypical/fused-syntax.git
-  tag: cb3dce1ec4b1197032da8e0c7f4fab20f9bf36b2
+  tag: 4e1048e3e3004d6b4cb3d365fdf589186a306e27
diff --git a/semantic.cabal b/semantic.cabal
index 0a843d020..0f0e2053a 100644
--- a/semantic.cabal
+++ b/semantic.cabal
@@ -55,8 +55,8 @@ common dependencies
                      , 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
+                     , fused-effects ^>= 1
+                     , fused-effects-exceptions ^>= 1
                      , hashable ^>= 1.2.7.0
                      , tree-sitter ^>= 0.5
                      , mtl ^>= 2.2.2

From 593eb129b6aad4e818c8b58f68165e57355426dd Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Thu, 7 Nov 2019 15:47:11 -0500
Subject: [PATCH 049/155] Track TS upstream. So many dependencies!

---
 cabal.project | 42 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 42 insertions(+)

diff --git a/cabal.project b/cabal.project
index 210647625..51e6ff13d 100644
--- a/cabal.project
+++ b/cabal.project
@@ -49,3 +49,45 @@ source-repository-package
   type: git
   location: https://github.com/antitypical/fused-syntax.git
   tag: 4e1048e3e3004d6b4cb3d365fdf589186a306e27
+
+source-repository-package
+  type: git
+  location: https://github.com/tree-sitter/haskell-tree-sitter
+  subdir: tree-sitter
+  tag: dfa8d51c838dddc745402f1fc1caaad45c069c1d
+
+source-repository-package
+  type: git
+  location: https://github.com/tree-sitter/haskell-tree-sitter
+  subdir: tree-sitter-go
+  tag: dfa8d51c838dddc745402f1fc1caaad45c069c1d
+
+source-repository-package
+  type: git
+  location: https://github.com/tree-sitter/haskell-tree-sitter
+  subdir: tree-sitter-ruby
+  tag: dfa8d51c838dddc745402f1fc1caaad45c069c1d
+
+source-repository-package
+  type: git
+  location: https://github.com/tree-sitter/haskell-tree-sitter
+  subdir: tree-sitter-python
+  tag: dfa8d51c838dddc745402f1fc1caaad45c069c1d
+
+source-repository-package
+  type: git
+  location: https://github.com/tree-sitter/haskell-tree-sitter
+  subdir: tree-sitter-php
+  tag: dfa8d51c838dddc745402f1fc1caaad45c069c1d
+
+source-repository-package
+  type: git
+  location: https://github.com/tree-sitter/haskell-tree-sitter
+  subdir: tree-sitter-typescript
+  tag: dfa8d51c838dddc745402f1fc1caaad45c069c1d
+
+source-repository-package
+  type: git
+  location: https://github.com/tree-sitter/haskell-tree-sitter
+  subdir: tree-sitter-tsx
+  tag: dfa8d51c838dddc745402f1fc1caaad45c069c1d

From 35ea116f000046d3e601adb98dfc7f61f6a889f2 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Thu, 7 Nov 2019 15:48:57 -0500
Subject: [PATCH 050/155] Bump various FE dependencies from 0.5 to 1.0.

---
 semantic-analysis/semantic-analysis.cabal | 2 +-
 semantic-core/semantic-core.cabal         | 2 +-
 semantic-java/semantic-java.cabal         | 2 +-
 semantic-python/semantic-python.cabal     | 2 +-
 semantic-tags/semantic-tags.cabal         | 2 +-
 5 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/semantic-analysis/semantic-analysis.cabal b/semantic-analysis/semantic-analysis.cabal
index cb77bf035..e7d4789e1 100644
--- a/semantic-analysis/semantic-analysis.cabal
+++ b/semantic-analysis/semantic-analysis.cabal
@@ -54,7 +54,7 @@ library
       algebraic-graphs            ^>= 0.3
     , base                         >= 4.12 && < 5
     , containers                  ^>= 0.6
-    , fused-effects               ^>= 0.5
+    , fused-effects               ^>= 1.0
     , fused-syntax
     , haskeline                   ^>= 0.7.5
     , pathtype                    ^>= 0.8.1
diff --git a/semantic-core/semantic-core.cabal b/semantic-core/semantic-core.cabal
index 0be3f8a50..be48eb0e8 100644
--- a/semantic-core/semantic-core.cabal
+++ b/semantic-core/semantic-core.cabal
@@ -47,7 +47,7 @@ library
     Core.Name
   build-depends:
       base                         >= 4.12 && < 5
-    , fused-effects               ^>= 0.5
+    , fused-effects               ^>= 1.0
     , fused-syntax
     , parsers                     ^>= 0.12.10
     , pathtype                    ^>= 0.8.1
diff --git a/semantic-java/semantic-java.cabal b/semantic-java/semantic-java.cabal
index 129a6398c..87b2e5ded 100644
--- a/semantic-java/semantic-java.cabal
+++ b/semantic-java/semantic-java.cabal
@@ -24,7 +24,7 @@ library
     Language.Java.Tags
   build-depends:
       base              >= 4.12 && < 5
-    , fused-effects    ^>= 0.5
+    , fused-effects    ^>= 1.0
     , semantic-source  ^>= 0.0
     , semantic-tags    ^>= 0.0
     , tree-sitter      ^>= 0.5
diff --git a/semantic-python/semantic-python.cabal b/semantic-python/semantic-python.cabal
index 9605a4e75..514fdf91f 100644
--- a/semantic-python/semantic-python.cabal
+++ b/semantic-python/semantic-python.cabal
@@ -21,7 +21,7 @@ tested-with:         GHC == 8.6.5
 common haskell
   default-language:    Haskell2010
   build-depends:       base ^>=4.12
-                     , fused-effects ^>= 0.5
+                     , fused-effects ^>= 1.0
                      , fused-syntax
                      , parsers ^>= 0.12.10
                      , semantic-core ^>= 0.0
diff --git a/semantic-tags/semantic-tags.cabal b/semantic-tags/semantic-tags.cabal
index 9d16c0d3b..e3c9e05fa 100644
--- a/semantic-tags/semantic-tags.cabal
+++ b/semantic-tags/semantic-tags.cabal
@@ -25,7 +25,7 @@ library
     Tags.Tagging.Precise
   build-depends:
       base                >= 4.12 && < 5
-    , fused-effects      ^>= 0.5
+    , fused-effects      ^>= 1.0
     , semantic-source    ^>= 0.0
     , text               ^>= 1.2.3.1
   hs-source-dirs:      src

From edc1894299a72570381651a2cc86f58f4492842b Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 10:14:54 -0500
Subject: [PATCH 051/155] Pin to correct fused-syntax and fused-exceptions.

---
 cabal.project | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/cabal.project b/cabal.project
index 51e6ff13d..438f2e177 100644
--- a/cabal.project
+++ b/cabal.project
@@ -43,12 +43,12 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/fused-effects/fused-effects-exceptions
-  tag: 31c9b7cdee1b93b1f1d716c1af92ad4b8c2bd4d3
+  tag: 8d3d9c9eafcf254c7ccc04219d23114520117ccc
 
 source-repository-package
   type: git
   location: https://github.com/antitypical/fused-syntax.git
-  tag: 4e1048e3e3004d6b4cb3d365fdf589186a306e27
+  tag: 3cd17047d4c709ecba555bbe70b6e91923d7b698
 
 source-repository-package
   type: git

From e041d2440d7a3acd254653eb0918a15a75de31c1 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 10:16:20 -0500
Subject: [PATCH 052/155] :fire: state types in FlowInsensitive.

---
 semantic-analysis/src/Analysis/FlowInsensitive.hs | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/semantic-analysis/src/Analysis/FlowInsensitive.hs b/semantic-analysis/src/Analysis/FlowInsensitive.hs
index a497a0c0d..9b9927260 100644
--- a/semantic-analysis/src/Analysis/FlowInsensitive.hs
+++ b/semantic-analysis/src/Analysis/FlowInsensitive.hs
@@ -27,9 +27,8 @@ newtype FrameId name = FrameId { unFrameId :: name }
   deriving (Eq, Ord, Show)
 
 
-convergeTerm :: forall m c sig a term address proxy
-             .  ( Effect c sig
-                , c ((,) (Cache term a))
+convergeTerm :: forall m sig a term address proxy
+             .  ( Effect sig
                 , Eq address
                 , Has Fresh sig m
                 , Has (State (Heap address a)) sig m

From 3feec0e5eee66c50d4ed07e7f3fbe89645d47450 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 10:16:34 -0500
Subject: [PATCH 053/155] Correct Algebra instance for FailC.

---
 semantic-analysis/src/Control/Carrier/Fail/WithLoc.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/semantic-analysis/src/Control/Carrier/Fail/WithLoc.hs b/semantic-analysis/src/Control/Carrier/Fail/WithLoc.hs
index 54c96d44d..8b918ca7d 100644
--- a/semantic-analysis/src/Control/Carrier/Fail/WithLoc.hs
+++ b/semantic-analysis/src/Control/Carrier/Fail/WithLoc.hs
@@ -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 (Effect c sig, c (Either (Path.AbsRelFile, Span, String)), Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m) => 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 (Effect c sig, c (Either (Path.AbsRelFile, Span, String)), Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m) => Algebra (Fail :+: sig) (FailC m) where
+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 (handleCoercible other)
+  alg (R other)    = FailC (alg (R (handleCoercible other)))

From cac8047ee0607acbee538965e612ee5b53d01516 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 10:21:48 -0500
Subject: [PATCH 054/155] Fix Typecheck analysis.

Had to write this RightModule instance by hand. It typechecks, so I
guess it works?
---
 semantic-analysis/src/Analysis/Typecheck.hs | 19 ++++++++++++-------
 1 file changed, 12 insertions(+), 7 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 809479e99..cef3e85b4 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -33,7 +33,6 @@ import           Data.Void
 import           GHC.Generics (Generic1)
 import           Prelude hiding (fail)
 import           Source.Span
-import           Syntax.Functor
 import           Syntax.Module
 import           Syntax.Scope
 import           Syntax.Term
@@ -61,13 +60,20 @@ 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 Effect Functor (Monotype name)
-instance RightModule (Monotype name)
+instance Effect (Monotype name)
+
+instance RightModule (Monotype name) where
+  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 (Effect Traversable, Foldable, Functor, Generic1, HFunctor, RightModule, 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)
@@ -105,9 +111,8 @@ typecheckingFlowInsensitive eval
   . traverse (runFile eval)
 
 runFile
-  :: forall term name m c sig
-  .  ( forall ctx . Functor ctx => c ctx
-     , Effect c sig
+  :: forall term name m sig
+  .  ( Effect sig
      , Has Fresh sig m
      , Has (State (Heap name (Type name))) sig m
      , Ord name

From e6bf975ee87e277f8dee3b5983812e5eaaa3768d Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 10:22:58 -0500
Subject: [PATCH 055/155] Fix state type in runFile.

---
 semantic-analysis/src/Analysis/ScopeGraph.hs | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index f8f8c8b82..37aa66c59 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -67,9 +67,8 @@ scopeGraph eval
   . traverse (runFile eval)
 
 runFile
-  :: forall term name m c sig
-  .  ( forall ctx . Functor ctx => c ctx
-     , Effect c sig
+  :: forall term name m sig
+  .  ( Effect sig
      , Has Fresh sig m
      , Has (State (Heap name (ScopeGraph name))) sig m
      , Ord name

From df98749bd0e368a3cb2a2c21f2b9d7be0e0d0a8d Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 10:23:39 -0500
Subject: [PATCH 056/155] Fix Analysis.ImportGraph.

---
 semantic-analysis/src/Analysis/ImportGraph.hs | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 2fdc6a83d..1a5e91bf1 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -67,9 +67,8 @@ importGraph eval
   . traverse (runFile eval)
 
 runFile
-  :: forall term name m c sig
-  .  ( forall ctx . Functor ctx => c ctx
-     , Effect c sig
+  :: forall term name m sig
+  .  ( Effect sig
      , Has Fresh sig m
      , Has (State (Heap name (Value term name))) sig m
      , Ord  name

From f1a5f0439d8f518b0d2aba938fa4f9ea98d72f18 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 10:24:18 -0500
Subject: [PATCH 057/155] Fix state type in concrete analysis.

---
 semantic-analysis/src/Analysis/Concrete.hs | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 2f84f13f6..c96a4fee9 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -87,9 +87,8 @@ concrete eval
   . traverse (runFile eval)
 
 runFile
-  :: forall term name m c sig
-  .  ( forall ctx . Functor ctx => c ctx
-     , Effect c sig
+  :: forall term name m sig
+  .  ( Effect sig
      , Foldable term
      , IsString name
      , Has Fresh sig m

From 0ceba4a1606fc1523c36d0e0fad8c25d01765b99 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 10:24:54 -0500
Subject: [PATCH 058/155] Ensure Readline is an HFunctor.

---
 semantic-analysis/src/Control/Effect/Readline.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Control/Effect/Readline.hs b/semantic-analysis/src/Control/Effect/Readline.hs
index 89a81795e..ad41dd968 100644
--- a/semantic-analysis/src/Control/Effect/Readline.hs
+++ b/semantic-analysis/src/Control/Effect/Readline.hs
@@ -21,7 +21,8 @@ data Readline m k
   | Print (Doc AnsiStyle) (m k)
   deriving (Functor, Generic1)
 
-instance Effect Functor Readline
+instance HFunctor Readline
+instance Effect Readline
 
 
 prompt :: Has Readline sig m => String -> m (Int, Maybe String)

From a11462dc13e2e34dbb42e999fad0387a91a91b23 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 10:27:50 -0500
Subject: [PATCH 059/155] PureC is gone.

---
 semantic-tags/src/Tags/Tagging/Precise.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index b2f7b5d7b..2cf73a6e9 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -8,9 +8,9 @@ module Tags.Tagging.Precise
 , GFoldable1(..)
 ) where
 
-import Control.Carrier.Pure
 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
@@ -31,7 +31,7 @@ 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

From 9fb876be84a4d57d275c251314523749ee8222fb Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 10:36:43 -0500
Subject: [PATCH 060/155] Port over RightModule definitions for Core and Ann.

---
 semantic-core/src/Core/Core.hs | 24 +++++++++++++++++++-----
 1 file changed, 19 insertions(+), 5 deletions(-)

diff --git a/semantic-core/src/Core/Core.hs b/semantic-core/src/Core/Core.hs
index d0f6ed955..d70e48b2b 100644
--- a/semantic-core/src/Core/Core.hs
+++ b/semantic-core/src/Core/Core.hs
@@ -47,7 +47,6 @@ import Data.Text (Text)
 import GHC.Generics (Generic1)
 import GHC.Stack
 import Source.Span
-import Syntax.Functor
 import Syntax.Scope
 import Syntax.Stack
 import Syntax.Sum
@@ -91,8 +90,22 @@ infixl 9 :.
 infix  3 :=
 
 instance HFunctor Core
-instance Effect Traversable Core
-instance RightModule Core
+
+instance RightModule Core where
+  Rec b      >>=* f = Rec ((>>=* f) <$> b)
+  (a :>> b)  >>=* f = (a >>= f) :>> (b >>= f)
+  (a :>>= b) >>=* f = ((>>= f) <$> a) :>>= (b >>=* f)
+  Lam b      >>=* f = Lam ((>>=* f) <$> b)
+  (a :$ b)   >>=* f = (a >>= f) :$ (b >>= f)
+  Unit       >>=* _ = Unit
+  Bool b     >>=* _ = Bool b
+  If c t e   >>=* f = If (c >>= f) (t >>= f) (e >>= f)
+  String s   >>=* _ = String s
+  Load b     >>=* f = Load (b >>= f)
+  Record fs  >>=* f = Record (map (fmap (>>= f)) fs)
+  (a :. b)   >>=* f = (a >>= f) :. b
+  (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)
@@ -217,8 +230,9 @@ data Ann ann f a
   deriving (Eq, Foldable, Functor, Generic1, Ord, Show, Traversable)
 
 instance HFunctor (Ann ann)
-instance Effect Functor (Ann ann)
-instance RightModule (Ann ann)
+
+instance RightModule (Ann ann) where
+  Ann l b >>=* f = Ann l (b >>= f)
 
 
 ann :: Has (Ann Span) sig m => HasCallStack => m a -> m a

From f65faec2a89ea80c06e777e9bedad8c6700a741f Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 12:00:46 -0500
Subject: [PATCH 061/155] Track a local tree-sitter so this starts building.

---
 cabal.project | 43 +------------------------------------------
 1 file changed, 1 insertion(+), 42 deletions(-)

diff --git a/cabal.project b/cabal.project
index 438f2e177..7fdc5975a 100644
--- a/cabal.project
+++ b/cabal.project
@@ -6,6 +6,7 @@ packages: .
           semantic-json
           semantic-python
           semantic-tags
+          ../haskell-tree-sitter/*
 
 jobs: $ncpus
 
@@ -49,45 +50,3 @@ source-repository-package
   type: git
   location: https://github.com/antitypical/fused-syntax.git
   tag: 3cd17047d4c709ecba555bbe70b6e91923d7b698
-
-source-repository-package
-  type: git
-  location: https://github.com/tree-sitter/haskell-tree-sitter
-  subdir: tree-sitter
-  tag: dfa8d51c838dddc745402f1fc1caaad45c069c1d
-
-source-repository-package
-  type: git
-  location: https://github.com/tree-sitter/haskell-tree-sitter
-  subdir: tree-sitter-go
-  tag: dfa8d51c838dddc745402f1fc1caaad45c069c1d
-
-source-repository-package
-  type: git
-  location: https://github.com/tree-sitter/haskell-tree-sitter
-  subdir: tree-sitter-ruby
-  tag: dfa8d51c838dddc745402f1fc1caaad45c069c1d
-
-source-repository-package
-  type: git
-  location: https://github.com/tree-sitter/haskell-tree-sitter
-  subdir: tree-sitter-python
-  tag: dfa8d51c838dddc745402f1fc1caaad45c069c1d
-
-source-repository-package
-  type: git
-  location: https://github.com/tree-sitter/haskell-tree-sitter
-  subdir: tree-sitter-php
-  tag: dfa8d51c838dddc745402f1fc1caaad45c069c1d
-
-source-repository-package
-  type: git
-  location: https://github.com/tree-sitter/haskell-tree-sitter
-  subdir: tree-sitter-typescript
-  tag: dfa8d51c838dddc745402f1fc1caaad45c069c1d
-
-source-repository-package
-  type: git
-  location: https://github.com/tree-sitter/haskell-tree-sitter
-  subdir: tree-sitter-tsx
-  tag: dfa8d51c838dddc745402f1fc1caaad45c069c1d

From fbea9072f8c699fc225523650a62fd1e97e2bc88 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 12:03:10 -0500
Subject: [PATCH 062/155] Port Python compiler to use Has.

---
 semantic-python/src/Language/Python/Core.hs | 17 +++++++----------
 1 file changed, 7 insertions(+), 10 deletions(-)

diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs
index 1212c76a9..f9fcb69bf 100644
--- a/semantic-python/src/Language/Python/Core.hs
+++ b/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           Control.Monad.Fail
 import           Core.Core as Core
@@ -49,9 +49,8 @@ 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
-                        , Carrier sig t
+type CoreSyntax sig t = ( Has Core sig t
+                        , Has (Ann Span) sig t
                         , Foldable t
                         )
 
@@ -59,8 +58,7 @@ class Compile (py :: * -> *) where
   -- FIXME: rather than failing the compilation process entirely
   -- with MonadFail, we should emit core that represents failure
   compile :: ( CoreSyntax syn t
-             , Member (Reader Bindings) sig
-             , Carrier sig m
+             , Has (Reader Bindings) sig m
              , MonadFail m
              )
           => py Span
@@ -71,8 +69,7 @@ class Compile (py :: * -> *) where
   compile a _ _ = defaultCompile a
 
 toplevelCompile :: ( CoreSyntax syn t
-                   , Member (Reader Bindings) sig
-                   , Carrier sig m
+                   , Has (Reader Bindings) sig m
                    , MonadFail m
                    )
                 => Py.Module Span
@@ -81,7 +78,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
@@ -146,7 +143,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

From 7acd177fa7bf8612b715ce33f49ee97907f4c425 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 12:04:46 -0500
Subject: [PATCH 063/155] Port Python tagging to FE1.

---
 semantic-python/src/Language/Python/Tags.hs | 15 ++++++---------
 1 file changed, 6 insertions(+), 9 deletions(-)

diff --git a/semantic-python/src/Language/Python/Tags.hs b/semantic-python/src/Language/Python/Tags.hs
index 5fd9af258..57d79c825 100644
--- a/semantic-python/src/Language/Python/Tags.hs
+++ b/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)
      )

From e74183c285459ecf5b47b4ea9bc72c8a2c02b224 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 12:06:48 -0500
Subject: [PATCH 064/155] Port Java tagging to FE1.

---
 semantic-java/src/Language/Java/Tags.hs | 15 ++++++---------
 1 file changed, 6 insertions(+), 9 deletions(-)

diff --git a/semantic-java/src/Language/Java/Tags.hs b/semantic-java/src/Language/Java/Tags.hs
index 101def1a5..6267e2ddb 100644
--- a/semantic-java/src/Language/Java/Tags.hs
+++ b/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)
      )

From e3db8c1224f16ee55505c081ec19eeb499de4cc3 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 12:14:22 -0500
Subject: [PATCH 065/155] Add fused-effects-resumable as a dependency.

---
 cabal.project  | 5 +++++
 semantic.cabal | 1 +
 2 files changed, 6 insertions(+)

diff --git a/cabal.project b/cabal.project
index 7fdc5975a..15f6a6c95 100644
--- a/cabal.project
+++ b/cabal.project
@@ -46,6 +46,11 @@ source-repository-package
   location: https://github.com/fused-effects/fused-effects-exceptions
   tag: 8d3d9c9eafcf254c7ccc04219d23114520117ccc
 
+source-repository-package
+  type: git
+  location: https://github.com/fused-effects/fused-effects-resumable
+  tag: bd6c51dff70f03d8404572f1f413c8a612e41c49
+
 source-repository-package
   type: git
   location: https://github.com/antitypical/fused-syntax.git
diff --git a/semantic.cabal b/semantic.cabal
index 0f0e2053a..d41b61646 100644
--- a/semantic.cabal
+++ b/semantic.cabal
@@ -57,6 +57,7 @@ common dependencies
                      , fastsum ^>= 0.1.1.0
                      , fused-effects ^>= 1
                      , fused-effects-exceptions ^>= 1
+                     , fused-effects-resumable ^>= 0.1
                      , hashable ^>= 1.2.7.0
                      , tree-sitter ^>= 0.5
                      , mtl ^>= 2.2.2

From c06873bedbafaf9f7476f9482a7bf4a8f355b62f Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 12:14:33 -0500
Subject: [PATCH 066/155] Port Control.Abstract.Evaluator to FE1.

---
 src/Control/Abstract/Evaluator.hs | 27 ++++++++++++---------------
 1 file changed, 12 insertions(+), 15 deletions(-)

diff --git a/src/Control/Abstract/Evaluator.hs b/src/Control/Abstract/Evaluator.hs
index 8835852f8..44729d6f5 100644
--- a/src/Control/Abstract/Evaluator.hs
+++ b/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

From b60491714f8bd64ec89449c13f0df27870f962ea Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 12:16:10 -0500
Subject: [PATCH 067/155] Fix type errors in Interpose before porting over prj.

---
 src/Control/Effect/Interpose.hs | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/src/Control/Effect/Interpose.hs b/src/Control/Effect/Interpose.hs
index 3086cf293..6f9c4f57b 100644
--- a/src/Control/Effect/Interpose.hs
+++ b/src/Control/Effect/Interpose.hs
@@ -8,8 +8,8 @@ module Control.Effect.Interpose
 ) where
 
 import Control.Applicative
-import Control.Effect.Carrier
-import Control.Effect.Reader
+import Control.Algebra
+import Control.Carrier.Reader
 
 data Interpose (eff :: (* -> *) -> * -> *) m k
   = forall a . Interpose (m a) (forall n x . eff n x -> m x) (a -> m k)
@@ -24,7 +24,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 +46,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 => 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)))

From f2f5eccdeb7375989bedf2702c09ca175bbf846a Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 12:20:43 -0500
Subject: [PATCH 068/155] Add Control.Effect.Sum.Project.

Fixes #289.
---
 semantic.cabal                    |  1 +
 src/Control/Effect/Sum/Project.hs | 21 +++++++++++++++++++++
 2 files changed, 22 insertions(+)
 create mode 100644 src/Control/Effect/Sum/Project.hs

diff --git a/semantic.cabal b/semantic.cabal
index d41b61646..ff7a0e792 100644
--- a/semantic.cabal
+++ b/semantic.cabal
@@ -116,6 +116,7 @@ library
                      , Control.Effect.Interpose
                      , Control.Effect.Parse
                      , Control.Effect.REPL
+                     , Control.Effect.Sum.Project
                      , Control.Rewriting
                      -- Datatypes for abstract interpretation
                      , Data.Abstract.Address.Hole
diff --git a/src/Control/Effect/Sum/Project.hs b/src/Control/Effect/Sum/Project.hs
new file mode 100644
index 000000000..a962eea5a
--- /dev/null
+++ b/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

From a81483f5ab53be22b48d4c26f67927060b3654e1 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 12:22:29 -0500
Subject: [PATCH 069/155] Fix Interpose effect.

---
 src/Control/Effect/Interpose.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/Control/Effect/Interpose.hs b/src/Control/Effect/Interpose.hs
index 6f9c4f57b..89313fd6c 100644
--- a/src/Control/Effect/Interpose.hs
+++ b/src/Control/Effect/Interpose.hs
@@ -10,6 +10,7 @@ module Control.Effect.Interpose
 import Control.Applicative
 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)
@@ -46,7 +47,7 @@ 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 Has eff sig m => Algebra (Interpose eff :+: sig) (InterposeC eff m) where
+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
   alg (R other) = do

From 7d8ccd42ce97d9fad92752b6c16d2308d6f12b9d Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 12:26:13 -0500
Subject: [PATCH 070/155] Port Diffing.Algorithm to FE1.

---
 src/Diffing/Algorithm.hs | 34 +++++++++++++++++-----------------
 1 file changed, 17 insertions(+), 17 deletions(-)

diff --git a/src/Diffing/Algorithm.hs b/src/Diffing/Algorithm.hs
index 8d2b98607..9bd5f7011 100644
--- a/src/Diffing/Algorithm.hs
+++ b/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)
 

From c765b28c4c3221f1c3aa874d41f3de1b06c26ce5 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 12:33:52 -0500
Subject: [PATCH 071/155] FE1-ify Diffing.Interpreter.

---
 src/Diffing/Interpreter.hs | 17 +++++++----------
 1 file changed, 7 insertions(+), 10 deletions(-)

diff --git a/src/Diffing/Interpreter.hs b/src/Diffing/Interpreter.hs
index 49a2c019b..d9bdbb5ac 100644
--- a/src/Diffing/Interpreter.hs
+++ 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

From 8c0224ab0862310ebaf84bb731273506dfc0632e Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 12:35:00 -0500
Subject: [PATCH 072/155] Has-ify Data.Blob.

---
 src/Data/Blob.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Data/Blob.hs b/src/Data/Blob.hs
index 852f6ae76..b2df25015 100644
--- a/src/Data/Blob.hs
+++ b/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

From 66584f8aaeb645eb5b8d41f10eaabaad7e204ff5 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 12:56:10 -0500
Subject: [PATCH 073/155] Use proper carriers and kill runM in
 Parsing.TreeSitter.

---
 src/Parsing/TreeSitter.hs | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/src/Parsing/TreeSitter.hs b/src/Parsing/TreeSitter.hs
index 16321ee4d..23406ecc9 100644
--- a/src/Parsing/TreeSitter.hs
+++ b/src/Parsing/TreeSitter.hs
@@ -8,9 +8,8 @@ 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 (..))
@@ -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

From 4543148e732f56ea42a98bf39916fa21f7b713c5 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 13:33:06 -0500
Subject: [PATCH 074/155] Has-ify Data.Abstract.Name.

---
 src/Data/Abstract/Name.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Data/Abstract/Name.hs b/src/Data/Abstract/Name.hs
index 7af31fe90..5ec366642 100644
--- a/src/Data/Abstract/Name.hs
+++ b/src/Data/Abstract/Name.hs
@@ -23,7 +23,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'.

From 3e6c84a48e734177af2eaf3bc7b41a69e2eb2f44 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 13:37:47 -0500
Subject: [PATCH 075/155] Has-ify Control.Abstract.Roots.

---
 src/Control/Abstract/Roots.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Control/Abstract/Roots.hs b/src/Control/Abstract/Roots.hs
index 6835f8c28..5f219a027 100644
--- a/src/Control/Abstract/Roots.hs
+++ b/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)

From 89b8a507372eae742a5e6e6cb2e50202c755bcdd Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 13:39:13 -0500
Subject: [PATCH 076/155] Fix Algebra for REPL.

---
 src/Control/Effect/REPL.hs | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/src/Control/Effect/REPL.hs b/src/Control/Effect/REPL.hs
index 0f4b2f1be..a606ad7c7 100644
--- a/src/Control/Effect/REPL.hs
+++ b/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

From edac9f47160840133fc85f7acf49e7e48dad6d1e Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 13:41:04 -0500
Subject: [PATCH 077/155] Has-ify Control.Abstract.Context.

---
 src/Control/Abstract/Context.hs | 18 +++++++++---------
 1 file changed, 9 insertions(+), 9 deletions(-)

diff --git a/src/Control/Abstract/Context.hs b/src/Control/Abstract/Context.hs
index 3b129fd46..9b1cef723 100644
--- a/src/Control/Abstract/Context.hs
+++ b/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

From 78d265e30777e0740443ba1b89a3711e2cf12871 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 13:41:50 -0500
Subject: [PATCH 078/155] Has-ify Data.Abstract.BaseError.

---
 src/Data/Abstract/BaseError.hs | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/src/Data/Abstract/BaseError.hs b/src/Data/Abstract/BaseError.hs
index fc5af47fd..87db9a0c4 100644
--- a/src/Data/Abstract/BaseError.hs
+++ b/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

From 7ed1c8c7a5e4a0634c99807dd326c2404587629b Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 13:52:08 -0500
Subject: [PATCH 079/155] Port Abstract.ScopeGraph to FE1.

This was a little involved.
---
 src/Control/Abstract/ScopeGraph.hs | 170 +++++++++++++----------------
 1 file changed, 75 insertions(+), 95 deletions(-)

diff --git a/src/Control/Abstract/ScopeGraph.hs b/src/Control/Abstract/ScopeGraph.hs
index b9174e098..a02af4346 100644
--- a/src/Control/Abstract/ScopeGraph.hs
+++ b/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

From 06fad83d8b2fd7c8bf43ddcfb18136a6b1515f8a Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 13:56:09 -0500
Subject: [PATCH 080/155] Port Abstract.Modules to FE1.

---
 src/Control/Abstract/Modules.hs | 78 +++++++++++++++++----------------
 1 file changed, 41 insertions(+), 37 deletions(-)

diff --git a/src/Control/Abstract/Modules.hs b/src/Control/Abstract/Modules.hs
index de2ab3a15..2362750d2 100644
--- a/src/Control/Abstract/Modules.hs
+++ b/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

From e71e10fb17cddb3568b8685c68074536f76974d3 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 14:01:34 -0500
Subject: [PATCH 081/155] Port Abstract.Heap to FE1.

---
 src/Control/Abstract/Heap.hs | 266 ++++++++++++++++-------------------
 1 file changed, 123 insertions(+), 143 deletions(-)

diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs
index 8e706efde..0ee974623 100644
--- a/src/Control/Abstract/Heap.hs
+++ b/src/Control/Abstract/Heap.hs
@@ -47,8 +47,11 @@ import           Control.Abstract.Evaluator
 import           Control.Abstract.Roots
 import           Control.Abstract.ScopeGraph hiding (ScopeError (..))
 import           Control.Abstract.ScopeGraph (ScopeError)
+import           Control.Algebra
 import           Control.Applicative (Alternative)
-import           Control.Effect.Carrier
+import qualified Control.Carrier.Resumable.Resume as With
+import           Control.Carrier.Resumable.Either (SomeError (..))
+import qualified Control.Carrier.Resumable.Either as Either
 import           Data.Abstract.BaseError
 import           Data.Abstract.Heap (Heap, Position (..))
 import qualified Data.Abstract.Heap as Heap
@@ -63,13 +66,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 +82,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 +104,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 +149,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 +157,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 +181,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 +202,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 +217,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 +232,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 +251,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 +284,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 +297,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 +318,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 +329,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 +349,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 +361,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 +372,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 +436,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)
@@ -485,20 +466,19 @@ instance Eq address => Eq1 (AddressError address value) where
   liftEq _ (UnallocatedSlot a)   (UnallocatedSlot b)   = a == b
   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)

From a73f8e83de5bfce81b5a6df3b35b5a644548c3fd Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 14:11:32 -0500
Subject: [PATCH 082/155] Has-ify Control.Abstract.Value.

---
 src/Control/Abstract/Value.hs | 82 +++++++++++++++++------------------
 1 file changed, 41 insertions(+), 41 deletions(-)

diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs
index 34e5fb7ec..6bd71a100 100644
--- a/src/Control/Abstract/Value.hs
+++ b/src/Control/Abstract/Value.hs
@@ -74,7 +74,8 @@ 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.Algebra
+import Control.Carrier.Reader
 import Data.Abstract.BaseError
 import Data.Abstract.Module
 import Data.Abstract.Name
@@ -108,7 +109,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 +117,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 +148,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 +176,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 +224,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 +242,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 +266,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 +288,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 +319,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 +332,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 +366,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 +396,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 +418,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

From bf0b830b2eacf26c1c05c0f76407250f76dc81d0 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 14:12:30 -0500
Subject: [PATCH 083/155] Has-ify Control.Abstract.Primitive.

---
 src/Control/Abstract/Primitive.hs | 75 +++++++++++++++----------------
 1 file changed, 36 insertions(+), 39 deletions(-)

diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs
index bb69ddfe4..9932974d2 100644
--- a/src/Control/Abstract/Primitive.hs
+++ b/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

From 00e821d68f7d5747f8eab8081920ee91278f22c4 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 14:16:34 -0500
Subject: [PATCH 084/155] Has-ify Data.Abstract.Evaluatable.

---
 src/Data/Abstract/Evaluatable.hs | 197 +++++++++++++++----------------
 1 file changed, 97 insertions(+), 100 deletions(-)

diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs
index 2b01af6f9..8b1301590 100644
--- a/src/Data/Abstract/Evaluatable.hs
+++ b/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
@@ -32,53 +41,47 @@ 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 +93,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 +114,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 +122,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 +176,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 +213,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 +239,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 +273,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

From e45b7086b9edfee3177899594dc837f234f52d66 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 14:22:14 -0500
Subject: [PATCH 085/155] Has-ify Syntax.TypeScript.

---
 src/Language/TypeScript/Syntax/TypeScript.hs | 31 ++++++++++----------
 1 file changed, 15 insertions(+), 16 deletions(-)

diff --git a/src/Language/TypeScript/Syntax/TypeScript.hs b/src/Language/TypeScript/Syntax/TypeScript.hs
index b7102b11a..b11620471 100644
--- a/src/Language/TypeScript/Syntax/TypeScript.hs
+++ b/src/Language/TypeScript/Syntax/TypeScript.hs
@@ -237,23 +237,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)

From 1a4c95ca2453de6939e961d0e01c3b15a5e385be Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 15:29:32 -0500
Subject: [PATCH 086/155] Has-ify TypeScript.Resolution.

---
 src/Language/TypeScript/Resolution.hs | 46 ++++++++++++---------------
 1 file changed, 21 insertions(+), 25 deletions(-)

diff --git a/src/Language/TypeScript/Resolution.hs b/src/Language/TypeScript/Resolution.hs
index d37103a59..b0cf9f1b0 100644
--- a/src/Language/TypeScript/Resolution.hs
+++ b/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

From 1c1b8a8f750df46b16edfa24081f6dcc7a1ae6ee Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 15:53:50 -0500
Subject: [PATCH 087/155] Has-ify Ruby syntax.

---
 src/Language/Ruby/Syntax.hs | 46 +++++++++++++++++--------------------
 1 file changed, 21 insertions(+), 25 deletions(-)

diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs
index ca1f57760..09bbbe601 100644
--- a/src/Language/Ruby/Syntax.hs
+++ b/src/Language/Ruby/Syntax.hs
@@ -26,11 +26,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 +40,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 +99,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 +127,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

From f527e423caea8cf363bb23897235fa492fbd65aa Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 16:00:23 -0500
Subject: [PATCH 088/155] Has-ify the Syntax modules.

---
 src/Data/Syntax/Declaration.hs | 11 +++++------
 src/Data/Syntax/Expression.hs  |  4 ++--
 src/Data/Syntax/Statement.hs   |  4 ++--
 src/Language/Go/Syntax.hs      | 13 ++++++-------
 src/Language/PHP/Syntax.hs     | 32 +++++++++++++++-----------------
 src/Language/Python/Syntax.hs  | 11 +++++------
 6 files changed, 35 insertions(+), 40 deletions(-)

diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs
index e2f55f24c..d0e18e619 100644
--- a/src/Data/Syntax/Declaration.hs
+++ b/src/Data/Syntax/Declaration.hs
@@ -39,12 +39,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
diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs
index 2dfd33241..bca174ccd 100644
--- a/src/Data/Syntax/Expression.hs
+++ b/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
diff --git a/src/Data/Syntax/Statement.hs b/src/Data/Syntax/Statement.hs
index e63f2ad1e..f8ce1bb0d 100644
--- a/src/Data/Syntax/Statement.hs
+++ b/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
diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs
index c34ed9458..c0fa0423f 100644
--- a/src/Language/Go/Syntax.hs
+++ b/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]
diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs
index 875ff99fa..f3826b2a6 100644
--- a/src/Language/PHP/Syntax.hs
+++ b/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)
diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs
index dc56eaa3b..476e4957c 100644
--- a/src/Language/Python/Syntax.hs
+++ b/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)

From 7b447b5018c0e1f30f28157439ac425943d89cd7 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 16:05:35 -0500
Subject: [PATCH 089/155] Port Abstract.Value.Type to FE1.

---
 src/Data/Abstract/Value/Type.hs | 241 ++++++++++++++++----------------
 1 file changed, 119 insertions(+), 122 deletions(-)

diff --git a/src/Data/Abstract/Value/Type.hs b/src/Data/Abstract/Value/Type.hs
index c1eb2a49f..3f4dc6d4d 100644
--- a/src/Data/Abstract/Value/Type.hs
+++ b/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

From 99f0016d7c5def6d946322b5810fdef369b86970 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 16:17:47 -0500
Subject: [PATCH 090/155] Port Abstract.Value.Concrete to FE1.

---
 src/Data/Abstract/Value/Concrete.hs | 202 ++++++++++++++--------------
 1 file changed, 102 insertions(+), 100 deletions(-)

diff --git a/src/Data/Abstract/Value/Concrete.hs b/src/Data/Abstract/Value/Concrete.hs
index 9dc1e02c5..887b4cb6c 100644
--- a/src/Data/Abstract/Value/Concrete.hs
+++ b/src/Data/Abstract/Value/Concrete.hs
@@ -6,25 +6,29 @@ module Data.Abstract.Value.Concrete
   , runValueErrorWith
   ) where
 
+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 (Scientific, coefficient, normalize)
+import Data.Scientific.Exts
+import Data.Text (pack)
+
 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.Algebra
 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 qualified Data.Map.Strict as Map
+
 
 data Value term address
     -- TODO: Split Closure up into a separate data type.                                                  Scope   Frame
@@ -52,33 +56,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 +123,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 +198,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,10 +246,9 @@ 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)
@@ -255,15 +258,15 @@ specialize (Right (Number.SomeNumber (Number.Decimal t))) = pure (Float (Number.
 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,9 +281,9 @@ 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
+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)
@@ -288,22 +291,22 @@ instance Carrier sig m => Carrier (Abstract.Object address (Value term address)
     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
+      => 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
 
-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
+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 +318,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
@@ -399,19 +402,18 @@ deriving instance (Show address, Show term) => Show (ValueError term address res
 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

From f859f4a6300ed778be44a294fbb7454ea65a2691 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 16:20:58 -0500
Subject: [PATCH 091/155] Has-ify Abstract.Value.Abstract.

---
 src/Data/Abstract/Value/Abstract.hs | 114 ++++++++++++++--------------
 1 file changed, 57 insertions(+), 57 deletions(-)

diff --git a/src/Data/Abstract/Value/Abstract.hs b/src/Data/Abstract/Value/Abstract.hs
index d45b81a79..12c7e7f95 100644
--- a/src/Data/Abstract/Value/Abstract.hs
+++ b/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
 

From 5b0ccc9b15f86ce4c7466a0aa2898addcc59c801 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 16:22:04 -0500
Subject: [PATCH 092/155] Algebrize Address.Precise.

---
 src/Data/Abstract/Address/Precise.hs | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/src/Data/Abstract/Address/Precise.hs b/src/Data/Abstract/Address/Precise.hs
index c60331b19..f92b6fa3c 100644
--- a/src/Data/Abstract/Address/Precise.hs
+++ b/src/Data/Abstract/Address/Precise.hs
@@ -5,7 +5,7 @@ module Data.Abstract.Address.Precise
 
 import Control.Abstract
 import Control.Abstract.ScopeGraph (AllocatorC(..))
-import Control.Effect.Carrier
+import Control.Algebra
 import qualified Data.Set as Set
 import Prologue
 
@@ -17,13 +17,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)

From 911066aaed013c90c73b12fa15fb430a9b50fe21 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 16:24:50 -0500
Subject: [PATCH 093/155] Use fused-effects's foldMapA.

---
 src/Prologue.hs | 9 +--------
 1 file changed, 1 insertion(+), 8 deletions(-)

diff --git a/src/Prologue.hs b/src/Prologue.hs
index 51cf2fb06..6bffd7b96 100644
--- a/src/Prologue.hs
+++ b/src/Prologue.hs
@@ -2,7 +2,6 @@
 module Prologue
   ( module X
   , eitherM
-  , foldMapA
   , maybeM
   , maybeLast
   , fromMaybeLast
@@ -22,7 +21,6 @@ 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.Sequence as X (Seq)
 import Data.Semilattice.Lower as X (Lower(..))
 import Data.Set as X (Set)
@@ -35,6 +33,7 @@ import Control.Exception as X hiding (Handler (..), assert, evaluate, throw, thr
 -- 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 (..))
@@ -52,7 +51,6 @@ import Data.Hashable as X (Hashable, hash, hashUsing, hashWithSalt)
 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)
 

From ca814174b80924c9afb1298d34f96384dae97183 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 16:32:19 -0500
Subject: [PATCH 094/155] Missing Prologue import.

---
 src/Analysis/Abstract/Collecting.hs      |  1 +
 src/Data/Abstract/Address/Monovariant.hs | 19 ++++++++++---------
 2 files changed, 11 insertions(+), 9 deletions(-)

diff --git a/src/Analysis/Abstract/Collecting.hs b/src/Analysis/Abstract/Collecting.hs
index 4a7d11f3c..74dddf163 100644
--- a/src/Analysis/Abstract/Collecting.hs
+++ b/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
diff --git a/src/Data/Abstract/Address/Monovariant.hs b/src/Data/Abstract/Address/Monovariant.hs
index c3f7e0f4e..f32a8d206 100644
--- a/src/Data/Abstract/Address/Monovariant.hs
+++ b/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

From 9d1bd90bed6e7bd0df8ccc28c5222863402800a2 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 16:35:13 -0500
Subject: [PATCH 095/155] Algebrize Abstract.Address.Hole.

---
 src/Data/Abstract/Address/Hole.hs | 24 ++++++++++++------------
 1 file changed, 12 insertions(+), 12 deletions(-)

diff --git a/src/Data/Abstract/Address/Hole.hs b/src/Data/Abstract/Address/Hole.hs
index a313921e4..868e33244 100644
--- a/src/Data/Abstract/Address/Hole.hs
+++ b/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

From d9537934505425a3ab685c9e1d7ea91183c689f2 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 16:37:15 -0500
Subject: [PATCH 096/155] Make PythonPackage use our project function.

---
 src/Control/Abstract/PythonPackage.hs | 20 +++++++++++---------
 1 file changed, 11 insertions(+), 9 deletions(-)

diff --git a/src/Control/Abstract/PythonPackage.hs b/src/Control/Abstract/PythonPackage.hs
index 165ea0c8f..291a16fe8 100644
--- a/src/Control/Abstract/PythonPackage.hs
+++ b/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

From bea0ce153d9731c70bc5e896a77d40e77f325ae8 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 19:25:36 -0500
Subject: [PATCH 097/155] Port dead-code analysis.

---
 src/Analysis/Abstract/Dead.hs | 21 ++++++++++-----------
 1 file changed, 10 insertions(+), 11 deletions(-)

diff --git a/src/Analysis/Abstract/Dead.hs b/src/Analysis/Abstract/Dead.hs
index 10d8cfd65..578b5e338 100644
--- a/src/Analysis/Abstract/Dead.hs
+++ b/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
 

From 01724d70abab145f1185b7bccb7574fa9656d188 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 19:25:51 -0500
Subject: [PATCH 098/155] Port tracing analysis.

---
 src/Analysis/Abstract/Tracing.hs | 19 ++++++++-----------
 1 file changed, 8 insertions(+), 11 deletions(-)

diff --git a/src/Analysis/Abstract/Tracing.hs b/src/Analysis/Abstract/Tracing.hs
index 598cbc7b4..06bd470fb 100644
--- a/src/Analysis/Abstract/Tracing.hs
+++ b/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

From 2f3566e01a8d322a576f4740f58ec622db866536 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 19:25:57 -0500
Subject: [PATCH 099/155] Port flow-sensitive analysis.

This one is a little shifty given the lack of resetFresh.
---
 .../Abstract/Caching/FlowSensitive.hs         | 60 ++++++++++---------
 1 file changed, 33 insertions(+), 27 deletions(-)

diff --git a/src/Analysis/Abstract/Caching/FlowSensitive.hs b/src/Analysis/Abstract/Caching/FlowSensitive.hs
index f77b47b11..23de4acf4 100644
--- a/src/Analysis/Abstract/Caching/FlowSensitive.hs
+++ b/src/Analysis/Abstract/Caching/FlowSensitive.hs
@@ -6,19 +6,25 @@ module Analysis.Abstract.Caching.FlowSensitive
 , caching
 ) where
 
+import Prologue
+
+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 +32,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 +48,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 +62,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 +79,29 @@ 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
+                     , 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 m value)
-convergingModules recur m@(Module _ (Left _)) = raiseHandler runNonDet (recur m) >>= maybeM empty
+convergingModules recur m@(Module _ (Left _)) = raiseHandler 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 $
+    evalFresh 0 . pure $
     -- 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 +120,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 +141,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 +150,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)
 

From 006a622d39f3f7212f6b733e0bec570fb47a2dd1 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 21:07:30 -0500
Subject: [PATCH 100/155] Overhaul Analysis.Caching.FlowInsensitive.

This file scares me.
---
 .../Abstract/Caching/FlowInsensitive.hs       | 52 ++++++++++---------
 1 file changed, 28 insertions(+), 24 deletions(-)

diff --git a/src/Analysis/Abstract/Caching/FlowInsensitive.hs b/src/Analysis/Abstract/Caching/FlowInsensitive.hs
index b54500ca1..9a86a42aa 100644
--- a/src/Analysis/Abstract/Caching/FlowInsensitive.hs
+++ b/src/Analysis/Abstract/Caching/FlowInsensitive.hs
@@ -5,19 +5,25 @@ module Analysis.Abstract.Caching.FlowInsensitive
 , caching
 ) where
 
+import Prologue
+
+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 +31,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 +47,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
@@ -74,32 +79,31 @@ cachingTerms recur term = do
       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
+                     , 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 m value)
-convergingModules recur m@(Module _ (Left _)) = raiseHandler runNonDet (recur m) >>= maybeM empty
+convergingModules recur m@(Module _ (Left _)) = raiseHandler 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 $
+    evalFresh 0 . pure $
     -- 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 +122,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 +142,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)

From 725f0c59d75af44754b15f34696a493e706b350a Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 21:14:31 -0500
Subject: [PATCH 101/155] Small changes to Data.Graph.

---
 src/Data/Graph.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Data/Graph.hs b/src/Data/Graph.hs
index 9366a784d..b219cc468 100644
--- a/src/Data/Graph.hs
+++ b/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

From 4ff67a54f8d227c4d84467042546532f1e3774c1 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 21:16:58 -0500
Subject: [PATCH 102/155] Upgrade the Parse effect to FE1.

---
 src/Control/Carrier/Parse/Simple.hs | 16 +++++++---------
 src/Control/Effect/Parse.hs         |  4 ++--
 2 files changed, 9 insertions(+), 11 deletions(-)

diff --git a/src/Control/Carrier/Parse/Simple.hs b/src/Control/Carrier/Parse/Simple.hs
index f9a2c55c0..f22437adc 100644
--- a/src/Control/Carrier/Parse/Simple.hs
+++ b/src/Control/Carrier/Parse/Simple.hs
@@ -11,10 +11,10 @@ module Control.Carrier.Parse.Simple
 ) 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
@@ -28,18 +28,16 @@ runParse timeout = runReader timeout . runParseC
 newtype ParseC m a = ParseC { runParseC :: ReaderC Duration m a }
   deriving (Applicative, Functor, Monad, 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
diff --git a/src/Control/Effect/Parse.hs b/src/Control/Effect/Parse.hs
index 23703ba9a..e646694bf 100644
--- a/src/Control/Effect/Parse.hs
+++ b/src/Control/Effect/Parse.hs
@@ -11,7 +11,7 @@ module Control.Effect.Parse
 , Has
 ) where
 
-import Control.Carrier
+import Control.Algebra
 import Control.Effect.Error
 import Control.Exception (SomeException)
 import Data.Bitraversable
@@ -30,7 +30,7 @@ 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'.

From 79bbb0968f6bbf66d1c9243b1a970d8a896e970c Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 21:21:36 -0500
Subject: [PATCH 103/155] Port Abstract.Graph to FE1.

---
 src/Analysis/Abstract/Graph.hs | 74 ++++++++++++++++------------------
 1 file changed, 35 insertions(+), 39 deletions(-)

diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs
index f62359bb4..8e059a79a 100644
--- a/src/Analysis/Abstract/Graph.hs
+++ b/src/Analysis/Abstract/Graph.hs
@@ -18,7 +18,10 @@ 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 (..))
@@ -57,20 +60,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 +98,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 +129,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 +153,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 +169,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 +179,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 +188,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

From 9dbfd7f4b821b80642b4e8d3600494b1916968b8 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 21:24:39 -0500
Subject: [PATCH 104/155] Port Semantic.Analysis to FE1.

---
 src/Semantic/Analysis.hs | 111 ++++++++++++++++++++-------------------
 1 file changed, 56 insertions(+), 55 deletions(-)

diff --git a/src/Semantic/Analysis.hs b/src/Semantic/Analysis.hs
index 3a70f9a44..16b91759e 100644
--- a/src/Semantic/Analysis.hs
+++ b/src/Semantic/Analysis.hs
@@ -11,7 +11,9 @@ 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 +46,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 +111,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 +150,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

From dda7ebbe6b4a1707c7ab1b2d69fd4b1d22a989bf Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 21:27:18 -0500
Subject: [PATCH 105/155] Fix up Rendering.Graph (with a nasty hack).

---
 src/Rendering/Graph.hs | 22 ++++++++++------------
 1 file changed, 10 insertions(+), 12 deletions(-)

diff --git a/src/Rendering/Graph.hs b/src/Rendering/Graph.hs
index 02b496949..e35617099 100644
--- a/src/Rendering/Graph.hs
+++ b/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

From 3cb89b0aaf968523ad1a846641a55f2d0d127cd2 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 21:29:53 -0500
Subject: [PATCH 106/155] Port over the thoroughly-benighted Distribute effect.

This needs to die.
---
 src/Semantic/Distribute.hs | 21 +++++++++++----------
 1 file changed, 11 insertions(+), 10 deletions(-)

diff --git a/src/Semantic/Distribute.hs b/src/Semantic/Distribute.hs
index b4e198e4b..48abb3ea5 100644
--- a/src/Semantic/Distribute.hs
+++ b/src/Semantic/Distribute.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving, TypeOperators, UndecidableInstances #-}
+-- TODO: We should kill this entirely, because with fused-effects 1.0 we can unlift the various runConcurrently operations.
 module Semantic.Distribute
 ( distribute
 , distributeFor
@@ -10,8 +11,8 @@ module Semantic.Distribute
 ) where
 
 import qualified Control.Concurrent.Async as Async
-import           Control.Effect.Carrier
-import           Control.Effect.Reader
+import           Control.Algebra
+import           Control.Carrier.Reader
 import           Control.Monad.IO.Unlift
 import           Control.Parallel.Strategies
 import           Prologue
@@ -19,19 +20,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 +46,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.
@@ -60,11 +61,11 @@ newtype DistributeC m a = DistributeC { runDistributeC :: ReaderC (UnliftIO m) m
 
 -- 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)))

From b06a2c14d42075221582cdd66c4729e4e67c7f8d Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 21:35:02 -0500
Subject: [PATCH 107/155] Port over Files effect and remove `rethrowing` hack.

---
 src/Semantic/Task/Files.hs | 51 +++++++++++++++++---------------------
 1 file changed, 23 insertions(+), 28 deletions(-)

diff --git a/src/Semantic/Task/Files.hs b/src/Semantic/Task/Files.hs
index 0e6c19a52..c13d2086d 100644
--- a/src/Semantic/Task/Files.hs
+++ b/src/Semantic/Task/Files.hs
@@ -16,8 +16,7 @@ module Semantic.Task.Files
   , FilesArg(..)
   ) where
 
-import           Control.Effect.Carrier
-import           Control.Effect.Catch
+import           Control.Algebra
 import           Control.Effect.Error
 import           Data.Blob
 import           Data.Blob.IO
@@ -57,10 +56,10 @@ instance HFunctor Files where
   hmap f (Write d b k) = Write d b (f k)
 
 instance Effect Files where
-  handle state handler (Read s k) = Read s (handler . (<$ state) . k)
-  handle state handler (ReadProject mp p l ps k) = ReadProject mp p l ps (handler . (<$ state) . k)
-  handle state handler (FindFiles p s ps k) = FindFiles p s ps (handler . (<$ state) . k)
-  handle state handler (Write d b k) = Write d b (handler . (<$ state) $ k)
+  thread state handler (Read s k) = Read s (handler . (<$ state) . k)
+  thread state handler (ReadProject mp p l ps k) = ReadProject mp p l ps (handler . (<$ state) . k)
+  thread state handler (FindFiles p s ps k) = FindFiles p s ps (handler . (<$ state) . k)
+  thread state handler (Write d b k) = Write d b (handler . (<$ state) $ k)
 
 -- | Run a 'Files' effect in 'IO'
 runFiles :: FilesC m a -> m a
@@ -69,20 +68,20 @@ runFiles = runFilesC
 newtype FilesC m a = FilesC { runFilesC :: m a }
   deriving (Functor, Applicative, Monad, MonadIO)
 
-instance (Member (Error SomeException) sig, Member Catch sig, MonadIO m, Carrier sig m) => Carrier (Files :+: sig) (FilesC m) where
-  eff (R other) = FilesC (eff (handleCoercible other))
-  eff (L op) = case op of
-    Read (FromPath path) k                                    -> rethrowing (readBlobFromFile' path) >>= k
-    Read (FromHandle handle) k                                -> rethrowing (readBlobsFromHandle handle) >>= k
-    Read (FromDir dir) k                                      -> rethrowing (readBlobsFromDir dir) >>= k
-    Read (FromPathPair p1 p2) k                               -> rethrowing (readFilePair p1 p2) >>= k
-    Read (FromPairHandle handle) k                            -> rethrowing (readBlobPairsFromHandle handle) >>= k
-    ReadProject rootDir dir language excludeDirs k            -> rethrowing (readProjectFromPaths rootDir dir language excludeDirs) >>= k
-    FindFiles dir exts excludeDirs k                          -> rethrowing (findFilesInDir dir exts excludeDirs) >>= k
-    Write (ToPath path) builder k                             -> rethrowing (liftIO (IO.withBinaryFile path IO.WriteMode (`B.hPutBuilder` builder))) >> k
-    Write (ToHandle (WriteHandle handle)) builder k           -> rethrowing (liftIO (B.hPutBuilder handle builder)) >> k
+instance (Has (Error SomeException) sig m, MonadIO m) => Algebra (Files :+: sig) (FilesC m) where
+  alg (R other) = FilesC (alg (handleCoercible other))
+  alg (L op) = case op of
+    Read (FromPath path) k                                    -> readBlobFromFile' path >>= k
+    Read (FromHandle handle) k                                -> readBlobsFromHandle handle >>= k
+    Read (FromDir dir) k                                      -> readBlobsFromDir dir >>= k
+    Read (FromPathPair p1 p2) k                               -> readFilePair p1 p2 >>= k
+    Read (FromPairHandle handle) k                            -> readBlobPairsFromHandle handle >>= k
+    ReadProject rootDir dir language excludeDirs k            -> readProjectFromPaths rootDir dir language excludeDirs >>= k
+    FindFiles dir exts excludeDirs k                          -> findFilesInDir dir exts excludeDirs >>= k
+    Write (ToPath path) builder k                             -> liftIO (IO.withBinaryFile path IO.WriteMode (`B.hPutBuilder` builder)) >> k
+    Write (ToHandle (WriteHandle handle)) builder k           -> liftIO (B.hPutBuilder handle builder) >> k
 
-readBlob :: (Member Files sig, Carrier sig m) => File -> m Blob
+readBlob :: Has Files sig m => File -> m Blob
 readBlob file = send (Read (FromPath file) pure)
 
 -- Various ways to read in files
@@ -91,7 +90,7 @@ data FilesArg
   | FilesFromPaths [File]
 
 -- | A task which reads a list of 'Blob's from a 'Handle' or a list of 'FilePath's optionally paired with 'Language's.
-readBlobs :: (Member Files sig, Carrier sig m, MonadIO m) => FilesArg -> m [Blob]
+readBlobs :: (Has Files sig m, MonadIO m) => FilesArg -> m [Blob]
 readBlobs (FilesFromHandle handle) = send (Read (FromHandle handle) pure)
 readBlobs (FilesFromPaths [path]) = do
   isDir <- isDirectory (filePath path)
@@ -101,20 +100,16 @@ readBlobs (FilesFromPaths [path]) = do
 readBlobs (FilesFromPaths paths) = traverse (send . flip Read pure . FromPath) paths
 
 -- | A task which reads a list of pairs of 'Blob's from a 'Handle' or a list of pairs of 'FilePath's optionally paired with 'Language's.
-readBlobPairs :: (Member Files sig, Carrier sig m) => Either (Handle 'IO.ReadMode) [(File, File)] -> m [BlobPair]
+readBlobPairs :: Has Files sig m => Either (Handle 'IO.ReadMode) [(File, File)] -> m [BlobPair]
 readBlobPairs (Left handle) = send (Read (FromPairHandle handle) pure)
 readBlobPairs (Right paths) = traverse (send . flip Read pure . uncurry FromPathPair) paths
 
-readProject :: (Member Files sig, Carrier sig m) => Maybe Path.AbsRelDir -> Path.AbsRelFileDir -> Language -> [Path.AbsRelDir] -> m Project
+readProject :: Has Files sig m => Maybe Path.AbsRelDir -> Path.AbsRelFileDir -> Language -> [Path.AbsRelDir] -> m Project
 readProject rootDir dir lang excludeDirs = send (ReadProject rootDir dir lang excludeDirs pure)
 
-findFiles :: (Member Files sig, Carrier sig m) => Path.AbsRelDir -> [String] -> [Path.AbsRelDir] -> m [Path.AbsRelFile]
+findFiles :: Has Files sig m => Path.AbsRelDir -> [String] -> [Path.AbsRelDir] -> m [Path.AbsRelFile]
 findFiles dir exts paths = send (FindFiles dir exts paths pure)
 
 -- | A task which writes a 'B.Builder' to a 'Handle' or a 'FilePath'.
-write :: (Member Files sig, Carrier sig m) => Destination -> B.Builder -> m ()
+write :: Has Files sig m => Destination -> B.Builder -> m ()
 write dest builder = send (Write dest builder (pure ()))
-
--- | Catch synchronous exceptions thrown in 'IO' and rethrow them in an 'Error' effect.
-rethrowing :: (Member Catch sig, Member (Error SomeException) sig, MonadIO m, Carrier sig m) => m a -> m a
-rethrowing act = act `catchSync` throwError @SomeException

From 6e19094ded59f46bdcd1013bcea4be3530ab1fb8 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 21:36:42 -0500
Subject: [PATCH 108/155] Port Resolution to FE1.

---
 src/Semantic/Resolution.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/src/Semantic/Resolution.hs b/src/Semantic/Resolution.hs
index 3d9c17ee0..65db994d7 100644
--- a/src/Semantic/Resolution.hs
+++ b/src/Semantic/Resolution.hs
@@ -7,7 +7,7 @@ module Semantic.Resolution
   , ResolutionC(..)
   ) where
 
-import           Control.Effect.Carrier
+import           Control.Algebra
 import           Data.Aeson
 import           Data.Aeson.Types (parseMaybe)
 import           Data.Blob
@@ -22,7 +22,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 +37,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)
@@ -57,8 +57,8 @@ runResolution = runResolutionC
 newtype ResolutionC m a = ResolutionC { runResolutionC :: m a }
   deriving (Applicative, Functor, Monad, 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

From d53a7bafdd7a291fd2760225006759e5da3da91d Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 21:40:31 -0500
Subject: [PATCH 109/155] Port Telemetry effect to FE1.

---
 src/Semantic/Telemetry.hs | 24 ++++++++++++------------
 1 file changed, 12 insertions(+), 12 deletions(-)

diff --git a/src/Semantic/Telemetry.hs b/src/Semantic/Telemetry.hs
index 251e1350d..231171752 100644
--- a/src/Semantic/Telemetry.hs
+++ b/src/Semantic/Telemetry.hs
@@ -49,8 +49,8 @@ module Semantic.Telemetry
 , IgnoreTelemetryC(..)
 ) where
 
-import           Control.Effect.Carrier
-import           Control.Effect.Reader
+import           Control.Algebra
+import           Control.Carrier.Reader
 import           Control.Exception
 import           Control.Monad.IO.Class
 import qualified Data.Time.Clock.POSIX as Time (getCurrentTime)
@@ -117,15 +117,15 @@ queueStat q = liftIO . writeAsyncQueue q
 -- Eff interface
 
 -- | A task which logs a message at a specific log level to stderr.
-writeLog :: (Member Telemetry sig, Carrier sig m) => Level -> String -> [(String, String)] -> m ()
+writeLog :: Has Telemetry sig m => Level -> String -> [(String, String)] -> m ()
 writeLog level message pairs = send (WriteLog level message pairs (pure ()))
 
 -- | A task which writes a stat.
-writeStat :: (Member Telemetry sig, Carrier sig m) => Stat -> m ()
+writeStat :: Has Telemetry sig m => Stat -> m ()
 writeStat stat = send (WriteStat stat (pure ()))
 
 -- | A task which measures and stats the timing of another task.
-time :: (Member Telemetry sig, Carrier sig m, MonadIO m) => String -> [(String, String)] -> m output -> m output
+time :: (Has Telemetry sig m, MonadIO m) => String -> [(String, String)] -> m output -> m output
 time statName tags task = do
   (a, stat) <- withTiming statName tags task
   a <$ writeStat stat
@@ -150,13 +150,13 @@ runTelemetry logger statter = runReader (logger, statter) . runTelemetryC
 newtype TelemetryC m a = TelemetryC { runTelemetryC :: ReaderC (LogQueue, StatQueue) m a }
   deriving (Applicative, Functor, Monad, MonadIO)
 
-instance (Carrier sig m, MonadIO m) => Carrier (Telemetry :+: sig) (TelemetryC m) where
-  eff (L op) = do
+instance (Algebra sig m, MonadIO m) => Algebra (Telemetry :+: sig) (TelemetryC m) where
+  alg (L op) = do
     queues <- TelemetryC ask
     case op of
       WriteStat stat k               -> queueStat (snd queues) stat *> k
       WriteLog level message pairs k -> queueLogMessage (fst queues) level message pairs *> k
-  eff (R other) = TelemetryC (eff (R (handleCoercible other)))
+  alg (R other) = TelemetryC (alg (R (handleCoercible other)))
 
 -- | Run a 'Telemetry' effect by ignoring statting/logging.
 ignoreTelemetry :: IgnoreTelemetryC m a -> m a
@@ -165,7 +165,7 @@ ignoreTelemetry = runIgnoreTelemetryC
 newtype IgnoreTelemetryC m a = IgnoreTelemetryC { runIgnoreTelemetryC :: m a }
   deriving (Applicative, Functor, Monad)
 
-instance Carrier sig m => Carrier (Telemetry :+: sig) (IgnoreTelemetryC m) where
-  eff (R other) = IgnoreTelemetryC . eff . handleCoercible $ other
-  eff (L (WriteStat _ k))    = k
-  eff (L (WriteLog _ _ _ k)) = k
+instance Algebra sig m => Algebra (Telemetry :+: sig) (IgnoreTelemetryC m) where
+  alg (R other) = IgnoreTelemetryC . alg . handleCoercible $ other
+  alg (L (WriteStat _ k))    = k
+  alg (L (WriteLog _ _ _ k)) = k

From 9a419428afff07a1a65deee9c58078ba3942ffa1 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 21:40:42 -0500
Subject: [PATCH 110/155] Port Timeout effect to FE1.

---
 src/Semantic/Timeout.hs | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/src/Semantic/Timeout.hs b/src/Semantic/Timeout.hs
index 8b4184ae7..6b6eccd11 100644
--- a/src/Semantic/Timeout.hs
+++ b/src/Semantic/Timeout.hs
@@ -8,8 +8,8 @@ module Semantic.Timeout
 , Duration(..)
 ) where
 
-import           Control.Effect.Carrier
-import           Control.Effect.Reader
+import           Control.Algebra
+import           Control.Carrier.Reader
 import           Control.Monad.IO.Class
 import           Control.Monad.IO.Unlift
 import           Data.Duration
@@ -18,7 +18,7 @@ import qualified System.Timeout as System
 -- | Run an action with a timeout. Returns 'Nothing' when no result is available
 -- within the specified duration. Uses 'System.Timeout.timeout' so all caveats
 -- about not operating over FFI boundaries apply.
-timeout :: (Member Timeout sig, Carrier sig m) => Duration -> m output -> m (Maybe output)
+timeout :: Has Timeout sig m => Duration -> m output -> m (Maybe output)
 timeout n = send . flip (Timeout n) pure
 
 -- | 'Timeout' effects run other effects, aborting them if they exceed the
@@ -32,7 +32,7 @@ instance HFunctor Timeout where
   hmap f (Timeout n task k) = Timeout n (f task) (f . k)
 
 instance Effect Timeout where
-  handle state handler (Timeout n task k) = Timeout n (handler (task <$ state)) (handler . maybe (k Nothing <$ state) (fmap (k . Just)))
+  thread state handler (Timeout n task k) = Timeout n (handler (task <$ state)) (handler . maybe (k Nothing <$ state) (fmap (k . Just)))
 
 -- | Evaulate a 'Timeout' effect.
 runTimeout :: (forall x . m x -> IO x)
@@ -59,8 +59,8 @@ instance MonadUnliftIO m => MonadUnliftIO (TimeoutC m) where
   askUnliftIO = TimeoutC . ReaderC $ \(Handler h) ->
     withUnliftIO $ \u -> pure (UnliftIO $ \r -> unliftIO u (runTimeout h r))
 
-instance (Carrier sig m, MonadIO m) => Carrier (Timeout :+: sig) (TimeoutC m) where
-  eff (L (Timeout n task k)) = do
+instance (Algebra sig m, MonadIO m) => Algebra (Timeout :+: sig) (TimeoutC m) where
+  alg (L (Timeout n task k)) = do
     handler <- TimeoutC ask
     liftIO (System.timeout (toMicroseconds n) (runHandler handler task)) >>= k
-  eff (R other) = TimeoutC (eff (R (handleCoercible other)))
+  alg (R other) = TimeoutC (alg (R (handleCoercible other)))

From ce2c083b8739124fdcd6a85cbd517ef240e5e388 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 21:48:21 -0500
Subject: [PATCH 111/155] Institute hellish hack to make Task compile.

---
 src/Semantic/Distribute.hs |  8 ++++++++
 src/Semantic/Task.hs       | 24 +++++++++---------------
 2 files changed, 17 insertions(+), 15 deletions(-)

diff --git a/src/Semantic/Distribute.hs b/src/Semantic/Distribute.hs
index 48abb3ea5..818b679fb 100644
--- a/src/Semantic/Distribute.hs
+++ b/src/Semantic/Distribute.hs
@@ -1,4 +1,5 @@
 {-# 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
@@ -13,6 +14,7 @@ module Semantic.Distribute
 import qualified Control.Concurrent.Async as Async
 import           Control.Algebra
 import           Control.Carrier.Reader
+import           Control.Carrier.Lift
 import           Control.Monad.IO.Unlift
 import           Control.Parallel.Strategies
 import           Prologue
@@ -56,6 +58,12 @@ 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 -> return (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)
 
diff --git a/src/Semantic/Task.hs b/src/Semantic/Task.hs
index 12ac48dd1..a2b33febf 100644
--- a/src/Semantic/Task.hs
+++ b/src/Semantic/Task.hs
@@ -45,12 +45,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 +72,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 +100,6 @@ runTask taskSession@TaskSession{..} task = do
         run
           = runM
           . withDistribute
-          . runCatch
-          . runResource
           . withTimeout
           . runError
           . runTelemetry logger statter
@@ -136,6 +130,6 @@ runTraceInTelemetry = runTraceInTelemetryC
 newtype TraceInTelemetryC m a = TraceInTelemetryC { runTraceInTelemetryC :: m a }
   deriving (Applicative, Functor, Monad, 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

From 685c7e8f3f4cac702921d765378032355287ba5c Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 21:55:04 -0500
Subject: [PATCH 112/155] Port Semantic.Graph to FE1.

---
 src/Semantic/Graph.hs | 116 +++++++++++++++++++-----------------------
 1 file changed, 52 insertions(+), 64 deletions(-)

diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs
index 4ce3562eb..83524dea7 100644
--- a/src/Semantic/Graph.hs
+++ b/src/Semantic/Graph.hs
@@ -36,7 +36,11 @@ 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
@@ -110,11 +114,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 +154,7 @@ reifyLanguage = \case
 
 runCallGraph :: ( AnalyzeTerm term
                 , HasPrelude lang
-                , Member Trace sig
-                , Carrier sig m
+                , Has Trace sig m
                 , Effect sig
                 )
              => Proxy lang
@@ -167,7 +169,7 @@ runCallGraph lang includePackages modules package
   . runHeap
   . runScopeGraph
   . caching
-  . raiseHandler runFresh
+  . raiseHandler (runFresh 0)
   . resumingLoadError
   . resumingUnspecialized
   . resumingScopeError
@@ -193,8 +195,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 +206,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 +217,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 +229,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 +257,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 +271,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 +291,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 +340,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 +357,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 +367,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 +400,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 +420,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 +441,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 +455,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 +473,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 +488,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

From 6edd486eb4d223fbff43f55453c0a0f4425f17c3 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 21:59:28 -0500
Subject: [PATCH 113/155] Port, or attempt to port, Semantic.Util to FE1.

---
 src/Semantic/Util.hs | 14 +++++++++-----
 1 file changed, 9 insertions(+), 5 deletions(-)

diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs
index f91bbc821..b60d3fcd8 100644
--- a/src/Semantic/Util.hs
+++ b/src/Semantic/Util.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, FlexibleContexts, PartialTypeSignatures, TypeApplications, TypeOperators #-}
+{-# LANGUAGE AllowAmbiguousTypes, DataKinds, FlexibleContexts, PartialTypeSignatures, TypeApplications, TypeOperators #-}
 {-# OPTIONS_GHC -Wno-missing-signatures -Wno-missing-exported-signatures -Wno-partial-type-signatures -O0 #-}
 module Semantic.Util
   ( evaluateProject'
@@ -14,9 +14,13 @@ import Prelude hiding (readFile)
 import           Control.Abstract
 import           Control.Abstract.Heap (runHeapError)
 import           Control.Abstract.ScopeGraph (runScopeError)
+import           Control.Carrier.Fresh.Strict
 import           Control.Carrier.Parse.Simple
-import           Control.Effect.Lift
-import           Control.Effect.Trace (runTraceByPrinting)
+import           Control.Carrier.Lift
+import           Control.Carrier.Trace.Printing
+import           Control.Carrier.Reader
+import           Control.Carrier.Resumable.Either (SomeError (..))
+import           Control.Carrier.State.Strict
 import           Control.Exception (displayException)
 import           Control.Lens.Getter
 import           Data.Abstract.Address.Precise as Precise
@@ -50,10 +54,10 @@ justEvaluating :: Evaluator term Precise (Value term Precise) _ result
 justEvaluating
   = runM
   . runEvaluator
-  . raiseHandler runTraceByPrinting
+  . raiseHandler runTrace
   . runHeap
   . runScopeGraph
-  . raiseHandler runFresh
+  . raiseHandler (fmap snd . runFresh 0)
   . fmap reassociate
   . runLoadError
   . runUnspecialized

From efa4b0be61478330a8e790171df87d52075ff1d3 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 22:02:20 -0500
Subject: [PATCH 114/155] Spruce up Measured carrier for FE1.

---
 src/Control/Carrier/Parse/Measured.hs | 34 +++++++++++++--------------
 1 file changed, 16 insertions(+), 18 deletions(-)

diff --git a/src/Control/Carrier/Parse/Measured.hs b/src/Control/Carrier/Parse/Measured.hs
index 54a6381f6..19b45d58c 100644
--- a/src/Control/Carrier/Parse/Measured.hs
+++ b/src/Control/Carrier/Parse/Measured.hs
@@ -10,8 +10,8 @@ module Control.Carrier.Parse.Measured
 ) 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
@@ -34,20 +34,19 @@ import           Source.Source (Source)
 newtype ParseC m a = ParseC { runParse :: m a }
   deriving (Applicative, Functor, Monad, 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

From 442ab1cc82bd352d70904383838cab3538b858ca Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 22:04:15 -0500
Subject: [PATCH 115/155] Spruce up Api.Diffs for FE1.

---
 src/Semantic/Api/Diffs.hs | 20 ++++++++++----------
 1 file changed, 10 insertions(+), 10 deletions(-)

diff --git a/src/Semantic/Api/Diffs.hs b/src/Semantic/Api/Diffs.hs
index 55ff2b49b..6465e1310 100644
--- a/src/Semantic/Api/Diffs.hs
+++ b/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)

From 3c9301e63e81aa71d85fec5d1559dec4ec45611e Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 22:05:13 -0500
Subject: [PATCH 116/155] And TOCSummaries.

---
 src/Semantic/Api/TOCSummaries.hs | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/src/Semantic/Api/TOCSummaries.hs b/src/Semantic/Api/TOCSummaries.hs
index 56f8b3bd0..13b1c59b5 100644
--- a/src/Semantic/Api/TOCSummaries.hs
+++ b/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

From 7fc41d0ef15390c1b2122285802cb29f62027a28 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 22:06:43 -0500
Subject: [PATCH 117/155] And the Terms API.

---
 src/Semantic/Api/Terms.hs | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/src/Semantic/Api/Terms.hs b/src/Semantic/Api/Terms.hs
index 1b35c2ad6..dcd8b9a3e 100644
--- a/src/Semantic/Api/Terms.hs
+++ b/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

From 7bdfd1e0ddd5bed90c8d5aa6a4aa948c5edffdf9 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 22:07:35 -0500
Subject: [PATCH 118/155] Port Tags.Tagging to FE1.

---
 src/Tags/Tagging.hs | 10 +++-------
 1 file changed, 3 insertions(+), 7 deletions(-)

diff --git a/src/Tags/Tagging.hs b/src/Tags/Tagging.hs
index 04ce85a71..d99cc9394 100644
--- a/src/Tags/Tagging.hs
+++ b/src/Tags/Tagging.hs
@@ -10,7 +10,7 @@ where
 import Prelude hiding (fail, filter, log)
 import Prologue hiding (Element, hash)
 
-import           Control.Effect.State as Eff
+import           Control.Carrier.State.Strict as Eff
 import           Data.Abstract.Declarations (Declarations)
 import           Data.Text as T hiding (empty)
 import           Streaming
@@ -49,9 +49,7 @@ runTagging lang symbolsToSummarize source
 
 type ContextToken = (Text, Range)
 
-contextualizing :: ( Member (State [ContextToken]) sig
-                   , Carrier sig m
-                   )
+contextualizing :: Has (State [ContextToken]) sig m
                 => Source.Source
                 -> (Text -> Maybe Kind)
                 -> Stream (Of Token) m a
@@ -68,9 +66,7 @@ contextualizing source toKind = Streaming.mapMaybeM $ \case
     slice = stripEnd . Source.toText . Source.slice source
     firstLine = T.take 180 . fst . breakOn "\n"
 
-enterScope, exitScope :: ( Member (State [ContextToken]) sig
-                         , Carrier sig m
-                         )
+enterScope, exitScope :: Has (State [ContextToken]) sig m
                       => ContextToken
                       -> m ()
 enterScope c = modify @[ContextToken] (c :)

From 9c9e9db80f1afa7273e322a061728cfaf6b07a75 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 22:10:06 -0500
Subject: [PATCH 119/155] Main semantic library is done!

---
 src/Semantic/Api/Symbols.hs | 12 ++++++------
 src/Semantic/CLI.hs         |  2 +-
 2 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/src/Semantic/Api/Symbols.hs b/src/Semantic/Api/Symbols.hs
index 63116a676..7c81593c3 100644
--- a/src/Semantic/Api/Symbols.hs
+++ b/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]
diff --git a/src/Semantic/CLI.hs b/src/Semantic/CLI.hs
index 4e4525363..fde36174e 100644
--- a/src/Semantic/CLI.hs
+++ b/src/Semantic/CLI.hs
@@ -2,7 +2,7 @@
 module Semantic.CLI (main) where
 
 import qualified Control.Carrier.Parse.Measured as Parse
-import           Control.Effect.Reader
+import           Control.Carrier.Reader
 import           Control.Exception as Exc (displayException)
 import           Data.Blob
 import           Data.Blob.IO

From 2e39e129cdf49787017c0e054f7bf60f53c2a2f9 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 22:37:17 -0500
Subject: [PATCH 120/155] Make semantic-python tests work.

---
 semantic-python/test/Directive.hs | 2 +-
 semantic-python/test/Test.hs      | 8 ++++----
 2 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/semantic-python/test/Directive.hs b/semantic-python/test/Directive.hs
index 32c3ef9c4..83634e235 100644
--- a/semantic-python/test/Directive.hs
+++ b/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)
diff --git a/semantic-python/test/Test.hs b/semantic-python/test/Test.hs
index b9a49f3fe..140d5ded5 100644
--- a/semantic-python/test/Test.hs
+++ b/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
@@ -116,7 +116,7 @@ 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
                    . runReader @Py.Bindings mempty
                    . Py.toplevelCompile

From b9388d1d203f372920aaaaf03fac10da17fc9ad3 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 22:43:09 -0500
Subject: [PATCH 121/155] Fix SpecHelpers.

Man, this is a monster of a file.
---
 test/SpecHelpers.hs | 17 +++++++++++------
 1 file changed, 11 insertions(+), 6 deletions(-)

diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs
index 77420a8df..83a867778 100644
--- a/test/SpecHelpers.hs
+++ b/test/SpecHelpers.hs
@@ -24,9 +24,13 @@ module SpecHelpers
 ) where
 
 import Control.Abstract
+import Control.Carrier.Fresh.Strict
 import Control.Carrier.Parse.Simple
-import Control.Effect.Lift
-import Control.Effect.Trace as X (runTraceByIgnoring, runTraceByReturning)
+import Control.Carrier.Reader
+import qualified Control.Carrier.Trace.Ignoring as Trace.Ignoring
+import Control.Carrier.Resumable.Either
+import Control.Carrier.Lift
+import Control.Carrier.State.Strict
 import Control.Exception (displayException)
 import Control.Monad ((>=>))
 import Control.Monad as X
@@ -101,7 +105,7 @@ parseFilePath session path = do
   res <- runTask session . runParse (configTreeSitterParseTimeout (config session)) . runReader defaultLanguageModes $ parseTermBuilder TermSExpression (toList blob)
   pure (runBuilder <$> res)
 
-runParseWithConfig :: (Carrier sig m, Member (Reader Config) sig) => ParseC m a -> m a
+runParseWithConfig :: Has (Reader Config) sig m => ParseC m a -> m a
 runParseWithConfig task = asks configTreeSitterParseTimeout >>= \ timeout -> runParse timeout task
 
 -- | Read two files to a BlobPair.
@@ -124,7 +128,7 @@ type TestEvaluatingC term
   ( StateC (Heap Precise Precise (Val term))
   ( StateC (ScopeGraph Precise)
   ( FreshC
-  ( TraceByIgnoringC
+  ( Trace.Ignoring.TraceC
   ( LiftC IO))))))))))))
 type TestEvaluatingErrors term
   = '[ BaseError (AddressError Precise (Val term))
@@ -147,8 +151,9 @@ testEvaluating :: Evaluator term Precise (Val term) (TestEvaluatingC term) a
                -> IO (TestEvaluatingState term a)
 testEvaluating
   = runM
-  . runTraceByIgnoring
-  . runFresh
+  . Trace.Ignoring.runTrace
+  . fmap snd
+  . runFresh 0
   . runEvaluator
   . runScopeGraph
   . runHeap

From d26ff76a9f11a9f72bd335a93d1499dbbf4a4f45 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 22:48:26 -0500
Subject: [PATCH 122/155] First pass over the specs.

---
 test/Control/Abstract/Evaluator/Spec.hs | 14 ++++++++++----
 test/Rendering/TOC/Spec.hs              |  3 +--
 test/Semantic/CLI/Spec.hs               |  2 +-
 test/Semantic/Spec.hs                   |  2 +-
 test/SpecHelpers.hs                     |  2 +-
 test/Tags/Spec.hs                       |  2 +-
 6 files changed, 15 insertions(+), 10 deletions(-)

diff --git a/test/Control/Abstract/Evaluator/Spec.hs b/test/Control/Abstract/Evaluator/Spec.hs
index bc56e1023..8ad56e89c 100644
--- a/test/Control/Abstract/Evaluator/Spec.hs
+++ b/test/Control/Abstract/Evaluator/Spec.hs
@@ -6,7 +6,12 @@ module Control.Abstract.Evaluator.Spec
 
 import           Control.Abstract as Abstract
 import qualified Control.Abstract.Heap as Heap
-import           Control.Effect.Lift
+import           Control.Carrier.Lift
+import           Control.Carrier.Error.Either
+import           Control.Carrier.Fresh.Strict
+import           Control.Carrier.Resumable.Either
+import           Control.Carrier.State.Strict
+import           Control.Carrier.Trace.Ignoring
 import           Data.Abstract.Address.Precise as Precise
 import           Data.Abstract.BaseError
 import           Data.Abstract.Evaluatable
@@ -44,10 +49,11 @@ spec = do
 
 evaluate
   = runM
-  . runTraceByIgnoring
+  . runTrace
   . runState (lowerBound @(ScopeGraph Precise))
   . runState (lowerBound @(Heap Precise Precise Val))
-  . runFresh
+  . fmap snd
+  . runFresh 0
   . runReader (PackageInfo (SpecHelpers.name "test") mempty)
   . runReader (ModuleInfo "test/Control/Abstract/Evaluator/Spec.hs" Language.Haskell mempty)
   . evalState (lowerBound @Span)
@@ -104,7 +110,7 @@ newtype SpecEff = SpecEff
                  (FreshC
                  (StateC (Heap Precise Precise Val)
                  (StateC (ScopeGraph Precise)
-                 (TraceByIgnoringC
+                 (TraceC
                  (LiftC IO))))))))))))))))))))))))
                  Val
   }
diff --git a/test/Rendering/TOC/Spec.hs b/test/Rendering/TOC/Spec.hs
index f0bff8c6c..369c36667 100644
--- a/test/Rendering/TOC/Spec.hs
+++ b/test/Rendering/TOC/Spec.hs
@@ -3,7 +3,6 @@ module Rendering.TOC.Spec (spec) where
 
 import Analysis.TOCSummary
 import Control.Effect.Parse
-import Control.Effect.Reader
 import Control.Monad.IO.Class
 import Data.Aeson hiding (defaultOptions)
 import Data.Bifunctor
@@ -217,7 +216,7 @@ blankDiff = merge (Nothing, Nothing) (inject [ inserting (termIn Nothing (inject
 
 -- Diff helpers
 summarize
-  :: (Member (Error SomeException) sig, Member Parse sig, Member Telemetry sig, Carrier sig m, MonadIO m)
+  :: (Has (Error SomeException) sig m, Has Parse sig m, Has Telemetry sig m, MonadIO m)
   => BlobPair
   -> m [Either ErrorSummary TOCSummary]
 summarize = parsePairWith (summarizeTermParsers defaultLanguageModes) summarizeTerms
diff --git a/test/Semantic/CLI/Spec.hs b/test/Semantic/CLI/Spec.hs
index c95b6c1e7..f561a0cea 100644
--- a/test/Semantic/CLI/Spec.hs
+++ b/test/Semantic/CLI/Spec.hs
@@ -1,7 +1,7 @@
 module Semantic.CLI.Spec (testTree) where
 
 import           Control.Carrier.Parse.Simple
-import           Control.Effect.Reader
+import           Control.Carrier.Reader
 import           Data.ByteString.Builder
 import           Semantic.Api hiding (Blob, BlobPair, File)
 import           Semantic.Task
diff --git a/test/Semantic/Spec.hs b/test/Semantic/Spec.hs
index d2c0832af..f11135317 100644
--- a/test/Semantic/Spec.hs
+++ b/test/Semantic/Spec.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Semantic.Spec (spec) where
 
-import Control.Effect.Reader
+import Control.Carrier.Reader
 import Control.Exception (fromException)
 import SpecHelpers
 
diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs
index 83a867778..b0e8a7ebc 100644
--- a/test/SpecHelpers.hs
+++ b/test/SpecHelpers.hs
@@ -26,7 +26,7 @@ module SpecHelpers
 import Control.Abstract
 import Control.Carrier.Fresh.Strict
 import Control.Carrier.Parse.Simple
-import Control.Carrier.Reader
+import Control.Carrier.Reader as X
 import qualified Control.Carrier.Trace.Ignoring as Trace.Ignoring
 import Control.Carrier.Resumable.Either
 import Control.Carrier.Lift
diff --git a/test/Tags/Spec.hs b/test/Tags/Spec.hs
index 48a194744..15ae4d973 100644
--- a/test/Tags/Spec.hs
+++ b/test/Tags/Spec.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Tags.Spec (spec) where
 
-import Control.Effect.Reader
+import Control.Carrier.Reader
 import Semantic.Api.Symbols
 import Source.Loc
 import SpecHelpers

From 0507db6a5092080b09de09794370e5c90d8ce347 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Fri, 8 Nov 2019 22:50:16 -0500
Subject: [PATCH 123/155] Second pass. Got a couple failures.

---
 test/Analysis/Ruby/Spec.hs       | 2 +-
 test/Analysis/TypeScript/Spec.hs | 3 ++-
 2 files changed, 3 insertions(+), 2 deletions(-)

diff --git a/test/Analysis/Ruby/Spec.hs b/test/Analysis/Ruby/Spec.hs
index 8b919f66e..22eabdb58 100644
--- a/test/Analysis/Ruby/Spec.hs
+++ b/test/Analysis/Ruby/Spec.hs
@@ -3,7 +3,7 @@
 module Analysis.Ruby.Spec (spec) where
 
 import           Control.Abstract (Declaration (..), ScopeError (..))
-import           Control.Effect.Resumable (SomeError (..))
+import           Control.Carrier.Resumable.Either (SomeError (..))
 import           Data.Abstract.Evaluatable
 import qualified Data.Abstract.ModuleTable as ModuleTable
 import           Data.Abstract.Number as Number
diff --git a/test/Analysis/TypeScript/Spec.hs b/test/Analysis/TypeScript/Spec.hs
index a47b375cb..eda224409 100644
--- a/test/Analysis/TypeScript/Spec.hs
+++ b/test/Analysis/TypeScript/Spec.hs
@@ -3,9 +3,10 @@
 
 module Analysis.TypeScript.Spec (spec) where
 
+import           Control.Abstract.ScopeGraph hiding (AccessControl(..))
+import           Control.Carrier.Resumable.Either (SomeError (..))
 import           Data.Syntax.Statement (StatementBlock(..))
 import qualified Data.Abstract.ScopeGraph as ScopeGraph (AccessControl(..))
-import           Control.Abstract.ScopeGraph hiding (AccessControl(..))
 import           Data.Abstract.Evaluatable
 import qualified Data.Abstract.Heap as Heap
 import           Data.Abstract.Module (ModuleInfo (..))

From e536f6cc142b11f4d9abb63693d2310136eba629 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 10 Dec 2019 14:59:47 -0500
Subject: [PATCH 124/155] Bump fused-syntax.

---
 cabal.project | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/cabal.project b/cabal.project
index 915592c04..4007ea016 100644
--- a/cabal.project
+++ b/cabal.project
@@ -57,4 +57,4 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/antitypical/fused-syntax.git
-  tag: 6b412694e64cc275ed06513b3c360f03bb1f04fd
+  tag: 1fd5534085d9592f8b42461c0b2602b0344389bb

From 0efe5a2bf9c9790cebe5c28adb41f67ca5afd7ba Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 10 Dec 2019 15:10:03 -0500
Subject: [PATCH 125/155] :fire: the source-repository-package stanza for
 fused-effects.

---
 cabal.project | 5 -----
 1 file changed, 5 deletions(-)

diff --git a/cabal.project b/cabal.project
index 4007ea016..3a1848324 100644
--- a/cabal.project
+++ b/cabal.project
@@ -39,11 +39,6 @@ source-repository-package
   location: https://github.com/tclem/proto-lens-jsonpb
   tag: e4d10b77f57ee25beb759a33e63e2061420d3dc2
 
-source-repository-package
-  type: git
-  location: https://github.com/fused-effects/fused-effects
-  tag: eb039082280697e5ed998740462cc13fbdcc85f7
-
 source-repository-package
   type: git
   location: https://github.com/fused-effects/fused-effects-exceptions

From a461c72ae4eba654d050fc59ce4a26ba18a644a1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 10 Dec 2019 15:10:25 -0500
Subject: [PATCH 126/155] Bump a few tree-sitter-* versions.

---
 semantic-ast/semantic-ast.cabal       | 8 ++++----
 semantic-java/semantic-java.cabal     | 4 ++--
 semantic-json/semantic-json.cabal     | 4 ++--
 semantic-python/semantic-python.cabal | 4 ++--
 semantic.cabal                        | 4 ++--
 5 files changed, 12 insertions(+), 12 deletions(-)

diff --git a/semantic-ast/semantic-ast.cabal b/semantic-ast/semantic-ast.cabal
index 5d014ab37..e73c0a1ab 100644
--- a/semantic-ast/semantic-ast.cabal
+++ b/semantic-ast/semantic-ast.cabal
@@ -41,9 +41,9 @@ library
   -- other-modules:
   -- other-extensions:
   build-depends:       base ^>=4.12.0.0
-                     , tree-sitter ^>= 0.5
+                     , tree-sitter ^>= 0.6
                      , semantic-source ^>= 0.0
-                     , tree-sitter-python ^>= 0.6
+                     , tree-sitter-python ^>= 0.7
                      , bytestring ^>= 0.10.8.2
                      , optparse-applicative ^>= 0.14.3.0
                      , pretty-simple ^>= 3.1.0.0
@@ -57,9 +57,9 @@ executable semantic-ast
   -- other-extensions:
   build-depends:       base ^>=4.12.0.0
                      , semantic-ast
-                     , tree-sitter ^>= 0.5
+                     , tree-sitter ^>= 0.6
                      , semantic-source ^>= 0.0
-                     , tree-sitter-python ^>= 0.6
+                     , tree-sitter-python ^>= 0.7
                      , bytestring ^>= 0.10.8.2
                      , optparse-applicative ^>= 0.14.3.0
                      , pretty-simple ^>= 3.1.0.0
diff --git a/semantic-java/semantic-java.cabal b/semantic-java/semantic-java.cabal
index 87b2e5ded..57f95832d 100644
--- a/semantic-java/semantic-java.cabal
+++ b/semantic-java/semantic-java.cabal
@@ -27,8 +27,8 @@ library
     , fused-effects    ^>= 1.0
     , semantic-source  ^>= 0.0
     , semantic-tags    ^>= 0.0
-    , tree-sitter      ^>= 0.5
-    , tree-sitter-java ^>= 0.4
+    , tree-sitter      ^>= 0.6
+    , tree-sitter-java ^>= 0.5
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:
diff --git a/semantic-json/semantic-json.cabal b/semantic-json/semantic-json.cabal
index 03522a1d2..2ae35f8d6 100644
--- a/semantic-json/semantic-json.cabal
+++ b/semantic-json/semantic-json.cabal
@@ -24,8 +24,8 @@ library
   build-depends:
       base              >= 4.12 && < 5
     , semantic-tags    ^>= 0.0
-    , tree-sitter      ^>= 0.5
-    , tree-sitter-json ^>= 0.3
+    , tree-sitter      ^>= 0.6
+    , tree-sitter-json ^>= 0.4
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:
diff --git a/semantic-python/semantic-python.cabal b/semantic-python/semantic-python.cabal
index 9676760ba..f32556ce1 100644
--- a/semantic-python/semantic-python.cabal
+++ b/semantic-python/semantic-python.cabal
@@ -28,8 +28,8 @@ common haskell
                      , semantic-source ^>= 0.0
                      , semantic-tags ^>= 0.0
                      , text ^>= 1.2.3
-                     , tree-sitter ^>= 0.5
-                     , tree-sitter-python ^>= 0.6
+                     , tree-sitter ^>= 0.6
+                     , tree-sitter-python ^>= 0.7
 
   ghc-options:
     -Weverything
diff --git a/semantic.cabal b/semantic.cabal
index b7c77ba91..12d27f9ef 100644
--- a/semantic.cabal
+++ b/semantic.cabal
@@ -59,7 +59,7 @@ common dependencies
                      , fused-effects-exceptions ^>= 1
                      , fused-effects-resumable ^>= 0.1
                      , hashable ^>= 1.2.7.0
-                     , tree-sitter ^>= 0.5
+                     , tree-sitter ^>= 0.6
                      , mtl ^>= 2.2.2
                      , network ^>= 2.8.0.0
                      , pathtype ^>= 0.8.1
@@ -300,7 +300,7 @@ library
                      , vector ^>= 0.12.0.2
                      , tree-sitter-go ^>= 0.2
                      , tree-sitter-php ^>= 0.2
-                     , tree-sitter-python ^>= 0.6
+                     , tree-sitter-python ^>= 0.7
                      , tree-sitter-ruby ^>= 0.2
                      , tree-sitter-typescript ^>= 0.2.1
                      , tree-sitter-tsx ^>= 0.2.1

From 83194f8b98c11f3f96e6653c6e320b107bf6dd1e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 10 Dec 2019 15:11:01 -0500
Subject: [PATCH 127/155] :fire: a redundant import.

---
 semantic-core/src/Core/Core.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/semantic-core/src/Core/Core.hs b/semantic-core/src/Core/Core.hs
index 052806ed8..4d12cecc4 100644
--- a/semantic-core/src/Core/Core.hs
+++ b/semantic-core/src/Core/Core.hs
@@ -51,7 +51,6 @@ import Syntax.Module
 import Syntax.Scope
 import Syntax.Stack
 import Syntax.Sum
-import Syntax.Module
 import Syntax.Term
 import Syntax.Traversable
 

From fc8c8189207d3106b1d82a1fac890f08224bf9de Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 10 Dec 2019 15:14:44 -0500
Subject: [PATCH 128/155] Correct an import.

---
 semantic-python/src/Language/Python/Failure.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-python/src/Language/Python/Failure.hs b/semantic-python/src/Language/Python/Failure.hs
index e9943d9b9..5ddc8027e 100644
--- a/semantic-python/src/Language/Python/Failure.hs
+++ b/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

From 0c8aa349765275cb7498142cc8f0e9f746ddedd4 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 10 Dec 2019 15:17:08 -0500
Subject: [PATCH 129/155] Fix some old-style constraints.

---
 semantic-python/src/Language/Python/Core.hs    | 4 ++--
 semantic-python/src/Language/Python/Failure.hs | 4 ++--
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs
index 359e6bb1d..5d7acc6c9 100644
--- a/semantic-python/src/Language/Python/Core.hs
+++ b/semantic-python/src/Language/Python/Core.hs
@@ -63,7 +63,7 @@ class Compile (py :: * -> *) where
           -> (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
@@ -86,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
 
 
diff --git a/semantic-python/src/Language/Python/Failure.hs b/semantic-python/src/Language/Python/Failure.hs
index 5ddc8027e..8f499b286 100644
--- a/semantic-python/src/Language/Python/Failure.hs
+++ b/semantic-python/src/Language/Python/Failure.hs
@@ -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)

From 65d58e97da8088731ecd4ff262a8519ad554977f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 10 Dec 2019 15:17:16 -0500
Subject: [PATCH 130/155] Add a missing Compile instance.

---
 semantic-python/src/Language/Python/Core.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs
index 5d7acc6c9..3bf100958 100644
--- a/semantic-python/src/Language/Python/Core.hs
+++ b/semantic-python/src/Language/Python/Core.hs
@@ -314,6 +314,7 @@ instance Compile Py.Integer
 instance Compile Py.Lambda
 instance Compile Py.List
 instance Compile Py.ListComprehension
+instance Compile Py.ListSplat
 
 instance Compile Py.Module where
   compile it@Py.Module { Py.extraChildren = stmts } _cc =

From e1498768410bde64f77052bf8c8e58513a4c0ed8 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 10 Dec 2019 16:16:18 -0500
Subject: [PATCH 131/155] Bump tree-sitter-json for the tests.

---
 semantic.cabal | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic.cabal b/semantic.cabal
index 12d27f9ef..c80eac428 100644
--- a/semantic.cabal
+++ b/semantic.cabal
@@ -353,7 +353,7 @@ test-suite test
                      , Generators
                      , Properties
   build-depends:       semantic
-                     , tree-sitter-json ^>= 0.3
+                     , tree-sitter-json ^>= 0.4
                      , Glob ^>= 0.10.0
                      , hedgehog ^>= 1
                      , hspec >= 2.6 && <3

From ff0c12c2005f3fa05eb3f847ffac1afcecc6af3a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 10 Dec 2019 16:29:05 -0500
Subject: [PATCH 132/155] Run the `Fresh` computation locally.

---
 src/Analysis/Abstract/Caching/FlowInsensitive.hs | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/src/Analysis/Abstract/Caching/FlowInsensitive.hs b/src/Analysis/Abstract/Caching/FlowInsensitive.hs
index 9a86a42aa..b3119db29 100644
--- a/src/Analysis/Abstract/Caching/FlowInsensitive.hs
+++ b/src/Analysis/Abstract/Caching/FlowInsensitive.hs
@@ -7,6 +7,7 @@ module Analysis.Abstract.Caching.FlowInsensitive
 
 import Prologue
 
+import Control.Algebra (Effect)
 import Control.Carrier.Fresh.Strict
 import Control.Carrier.NonDet.Church
 import Control.Carrier.Reader
@@ -78,7 +79,8 @@ cachingTerms recur term = do
       values <- consultOracle c
       cachingConfiguration c values (recur term)
 
-convergingModules :: ( Eq value
+convergingModules :: ( Effect sig
+                     , Eq value
                      , Has Fresh sig m
                      , Has (Reader (Cache term address value)) sig m
                      , Has (Reader (Live address)) sig m
@@ -88,16 +90,16 @@ convergingModules :: ( Eq value
                      , Ord term
                      , 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 runNonDetA (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.
-    evalFresh 0 . pure $
+    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

From 6ea357f08cfd7bf937e52f43bd967f620c41619f Mon Sep 17 00:00:00 2001
From: Timothy Clem <timothy.clem@gmail.com>
Date: Mon, 9 Dec 2019 09:52:55 -0800
Subject: [PATCH 133/155] Fix python assignment

---
 src/Language/Python/Assignment.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Language/Python/Assignment.hs b/src/Language/Python/Assignment.hs
index c63dfbc7c..f07fe1170 100644
--- a/src/Language/Python/Assignment.hs
+++ b/src/Language/Python/Assignment.hs
@@ -137,7 +137,7 @@ keywordArgument :: Assignment (Term Loc)
 keywordArgument = makeTerm <$> symbol KeywordArgument <*> children (Statement.Assignment [] <$> term expression <*> term expression)
 
 parenthesizedExpression :: Assignment (Term Loc)
-parenthesizedExpression = symbol ParenthesizedExpression *> children expressions
+parenthesizedExpression = (symbol ParenthesizedExpression <|> symbol ParenthesizedExpression') *> children expressions
 
 parameter :: Assignment (Term Loc)
 parameter =  makeTerm <$> symbol DefaultParameter <*> children (Statement.Assignment [] <$> term expression <*> term expression)

From 38ef115e7d0020837e42e454bceef2d26c877f55 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Tue, 10 Dec 2019 12:20:00 -0500
Subject: [PATCH 134/155] Mention that semantic doesn't yet build on Windows.

As discussed in #393, we should warn people that Win32 is a no-go.
---
 README.md | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/README.md b/README.md
index 04e91b406..d50688bbd 100644
--- a/README.md
+++ b/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` 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).
 
 We use `cabal's` [Nix-style local builds][nix] for development. To get started quickly:
 

From ec19540425863ed13b8aff5c721b1a701f4344a0 Mon Sep 17 00:00:00 2001
From: Timothy Clem <timothy.clem@gmail.com>
Date: Tue, 10 Dec 2019 11:03:07 -0800
Subject: [PATCH 135/155] ++tree-sitter 0.7

Also bumps parsers that changed
---
 semantic-ast/semantic-ast.cabal       |  8 ++++----
 semantic-java/semantic-java.cabal     |  4 ++--
 semantic-json/semantic-json.cabal     |  4 ++--
 semantic-python/semantic-python.cabal |  4 ++--
 semantic.cabal                        | 16 ++++++++--------
 5 files changed, 18 insertions(+), 18 deletions(-)

diff --git a/semantic-ast/semantic-ast.cabal b/semantic-ast/semantic-ast.cabal
index e73c0a1ab..d5d6ea86e 100644
--- a/semantic-ast/semantic-ast.cabal
+++ b/semantic-ast/semantic-ast.cabal
@@ -41,9 +41,9 @@ library
   -- other-modules:
   -- other-extensions:
   build-depends:       base ^>=4.12.0.0
-                     , tree-sitter ^>= 0.6
+                     , tree-sitter ^>= 0.7
                      , semantic-source ^>= 0.0
-                     , tree-sitter-python ^>= 0.7
+                     , tree-sitter-python ^>= 0.8
                      , bytestring ^>= 0.10.8.2
                      , optparse-applicative ^>= 0.14.3.0
                      , pretty-simple ^>= 3.1.0.0
@@ -57,9 +57,9 @@ executable semantic-ast
   -- other-extensions:
   build-depends:       base ^>=4.12.0.0
                      , semantic-ast
-                     , tree-sitter ^>= 0.6
+                     , tree-sitter ^>= 0.7
                      , semantic-source ^>= 0.0
-                     , tree-sitter-python ^>= 0.7
+                     , tree-sitter-python ^>= 0.8
                      , bytestring ^>= 0.10.8.2
                      , optparse-applicative ^>= 0.14.3.0
                      , pretty-simple ^>= 3.1.0.0
diff --git a/semantic-java/semantic-java.cabal b/semantic-java/semantic-java.cabal
index 57f95832d..aa7b35b74 100644
--- a/semantic-java/semantic-java.cabal
+++ b/semantic-java/semantic-java.cabal
@@ -27,8 +27,8 @@ library
     , fused-effects    ^>= 1.0
     , semantic-source  ^>= 0.0
     , semantic-tags    ^>= 0.0
-    , tree-sitter      ^>= 0.6
-    , tree-sitter-java ^>= 0.5
+    , tree-sitter      ^>= 0.7
+    , tree-sitter-java ^>= 0.6
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:
diff --git a/semantic-json/semantic-json.cabal b/semantic-json/semantic-json.cabal
index 2ae35f8d6..ef6a3428d 100644
--- a/semantic-json/semantic-json.cabal
+++ b/semantic-json/semantic-json.cabal
@@ -24,8 +24,8 @@ library
   build-depends:
       base              >= 4.12 && < 5
     , semantic-tags    ^>= 0.0
-    , tree-sitter      ^>= 0.6
-    , tree-sitter-json ^>= 0.4
+    , tree-sitter      ^>= 0.7
+    , tree-sitter-json ^>= 0.5
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:
diff --git a/semantic-python/semantic-python.cabal b/semantic-python/semantic-python.cabal
index f32556ce1..8d7472f1b 100644
--- a/semantic-python/semantic-python.cabal
+++ b/semantic-python/semantic-python.cabal
@@ -28,8 +28,8 @@ common haskell
                      , semantic-source ^>= 0.0
                      , semantic-tags ^>= 0.0
                      , text ^>= 1.2.3
-                     , tree-sitter ^>= 0.6
-                     , tree-sitter-python ^>= 0.7
+                     , tree-sitter ^>= 0.7
+                     , tree-sitter-python ^>= 0.8
 
   ghc-options:
     -Weverything
diff --git a/semantic.cabal b/semantic.cabal
index c80eac428..4615219a0 100644
--- a/semantic.cabal
+++ b/semantic.cabal
@@ -1,7 +1,7 @@
 cabal-version:       2.4
 
 name:                semantic
-version:             0.9.0.0
+version:             0.10.0.0
 synopsis:            Framework and executable for analyzing and diffing untrusted code.
 description:         Semantic is a library for parsing, analyzing, and comparing source code across many languages.
 homepage:            http://github.com/github/semantic#readme
@@ -59,7 +59,7 @@ common dependencies
                      , fused-effects-exceptions ^>= 1
                      , fused-effects-resumable ^>= 0.1
                      , hashable ^>= 1.2.7.0
-                     , tree-sitter ^>= 0.6
+                     , tree-sitter ^>= 0.7
                      , mtl ^>= 2.2.2
                      , network ^>= 2.8.0.0
                      , pathtype ^>= 0.8.1
@@ -298,12 +298,12 @@ library
                      , unliftio-core ^>= 0.1.2.0
                      , unordered-containers ^>= 0.2.9.0
                      , vector ^>= 0.12.0.2
-                     , tree-sitter-go ^>= 0.2
+                     , tree-sitter-go ^>= 0.3
                      , tree-sitter-php ^>= 0.2
-                     , tree-sitter-python ^>= 0.7
-                     , tree-sitter-ruby ^>= 0.2
-                     , tree-sitter-typescript ^>= 0.2.1
-                     , tree-sitter-tsx ^>= 0.2.1
+                     , tree-sitter-python ^>= 0.8
+                     , tree-sitter-ruby ^>= 0.3
+                     , tree-sitter-typescript ^>= 0.3
+                     , tree-sitter-tsx ^>= 0.3
 
 executable semantic
   import:              haskell, dependencies, executable-flags
@@ -353,7 +353,7 @@ test-suite test
                      , Generators
                      , Properties
   build-depends:       semantic
-                     , tree-sitter-json ^>= 0.4
+                     , tree-sitter-json ^>= 0.5
                      , Glob ^>= 0.10.0
                      , hedgehog ^>= 1
                      , hspec >= 2.6 && <3

From 409b165a7c4e695bc338b6015db165d381cd3e14 Mon Sep 17 00:00:00 2001
From: Timothy Clem <timothy.clem@gmail.com>
Date: Tue, 10 Dec 2019 11:08:49 -0800
Subject: [PATCH 136/155] No more ArgumentListWithParens

---
 src/Language/Ruby/Assignment.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/src/Language/Ruby/Assignment.hs b/src/Language/Ruby/Assignment.hs
index 241ea6117..48d77f615 100644
--- a/src/Language/Ruby/Assignment.hs
+++ b/src/Language/Ruby/Assignment.hs
@@ -315,7 +315,7 @@ pair :: Assignment (Term Loc)
 pair =   makeTerm <$> symbol Pair <*> children (Literal.KeyValue <$> expression <*> (expression <|> emptyTerm))
 
 args :: Assignment [Term Loc]
-args = (symbol ArgumentList <|> symbol ArgumentListWithParens) *> children (many expression) <|> many expression
+args = symbol ArgumentList *> children (many expression) <|> many expression
 
 methodCall :: Assignment (Term Loc)
 methodCall = makeTerm' <$> symbol MethodCall <*> children (require <|> load <|> send)
@@ -335,8 +335,8 @@ methodCall = makeTerm' <$> symbol MethodCall <*> children (require <|> load <|>
     load = inject <$ symbol Identifier <*> do
       s <- rawSource
       guard (s == "load")
-      (symbol ArgumentList <|> symbol ArgumentListWithParens) *> children (Ruby.Syntax.Load <$> expression <*> optional expression)
-    nameExpression = (symbol ArgumentList <|> symbol ArgumentListWithParens) *> children expression
+      symbol ArgumentList *> children (Ruby.Syntax.Load <$> expression <*> optional expression)
+    nameExpression = symbol ArgumentList *> children expression
 
 methodSelector :: Assignment (Term Loc)
 methodSelector = makeTerm <$> symbols <*> (Syntax.Identifier <$> (name <$> source))

From 484f4278e1118e1272f99b17d91ebfbcf20d3119 Mon Sep 17 00:00:00 2001
From: Timothy Clem <timothy.clem@gmail.com>
Date: Tue, 10 Dec 2019 12:52:34 -0800
Subject: [PATCH 137/155] ++tree-sitter-ruby, fix assignment

---
 semantic.cabal                  |  2 +-
 src/Language/Ruby/Assignment.hs | 20 +++++++++++++-------
 2 files changed, 14 insertions(+), 8 deletions(-)

diff --git a/semantic.cabal b/semantic.cabal
index 4615219a0..e415eb95c 100644
--- a/semantic.cabal
+++ b/semantic.cabal
@@ -301,7 +301,7 @@ library
                      , tree-sitter-go ^>= 0.3
                      , tree-sitter-php ^>= 0.2
                      , tree-sitter-python ^>= 0.8
-                     , tree-sitter-ruby ^>= 0.3
+                     , tree-sitter-ruby ^>= 0.3.1
                      , tree-sitter-typescript ^>= 0.3
                      , tree-sitter-tsx ^>= 0.3
 
diff --git a/src/Language/Ruby/Assignment.hs b/src/Language/Ruby/Assignment.hs
index 48d77f615..016c83a1f 100644
--- a/src/Language/Ruby/Assignment.hs
+++ b/src/Language/Ruby/Assignment.hs
@@ -70,11 +70,15 @@ expressionChoices =
   , method
   , methodCall
   , mk Break Statement.Break
+  , mk Break' Statement.Break
   , mk Next Statement.Continue
+  , mk Next' Statement.Continue
   , mk Redo Statement.Retry
   , mk Retry Statement.Retry
   , mk Return Statement.Return
+  , mk Return' Statement.Return
   , mk Yield Statement.Yield
+  , mk Yield' Statement.Yield
   , module'
   , pair
   , parenthesizedExpressions
@@ -92,7 +96,7 @@ expressionChoices =
   , while'
   ]
   where
-    mk s construct = makeTerm <$> symbol s <*> children ((construct .) . fromMaybe <$> emptyTerm <*> optional (symbol ArgumentList *> children expressions))
+    mk s construct = makeTerm <$> symbol s <*> children ((construct .) . fromMaybe <$> emptyTerm <*> optional ((symbol ArgumentList <|> symbol ArgumentList') *> children expressions))
 
 expressions :: Assignment (Term Loc)
 expressions = makeTerm'' <$> location <*> many expression
@@ -315,10 +319,10 @@ pair :: Assignment (Term Loc)
 pair =   makeTerm <$> symbol Pair <*> children (Literal.KeyValue <$> expression <*> (expression <|> emptyTerm))
 
 args :: Assignment [Term Loc]
-args = symbol ArgumentList *> children (many expression) <|> many expression
+args = (symbol ArgumentList <|> symbol ArgumentList') *> children (many expression) <|> many expression
 
 methodCall :: Assignment (Term Loc)
-methodCall = makeTerm' <$> symbol MethodCall <*> children (require <|> load <|> send)
+methodCall = makeTerm' <$> (symbol MethodCall <|> symbol MethodCall') <*> children (require <|> load <|> send)
   where
     send = inject <$> ((regularCall <|> funcCall <|> scopeCall <|> dotCall) <*> optional block)
 
@@ -335,8 +339,8 @@ methodCall = makeTerm' <$> symbol MethodCall <*> children (require <|> load <|>
     load = inject <$ symbol Identifier <*> do
       s <- rawSource
       guard (s == "load")
-      symbol ArgumentList *> children (Ruby.Syntax.Load <$> expression <*> optional expression)
-    nameExpression = symbol ArgumentList *> children expression
+      (symbol ArgumentList <|> symbol ArgumentList') *> children (Ruby.Syntax.Load <$> expression <*> optional expression)
+    nameExpression = (symbol ArgumentList <|> symbol ArgumentList') *> children expression
 
 methodSelector :: Assignment (Term Loc)
 methodSelector = makeTerm <$> symbols <*> (Syntax.Identifier <$> (name <$> source))
@@ -465,8 +469,10 @@ invert term = makeTerm <$> location <*> fmap Expression.Not term
 
 -- | Match a term optionally preceded by comment(s), or a sequence of comments if the term is not present.
 term :: Assignment (Term Loc) -> Assignment (Term Loc)
-term term = contextualize comment term <|> makeTerm1 <$> (Syntax.Context <$> some1 (comment <|> heredocEnd) <*> emptyTerm)
-  where heredocEnd = makeTerm <$> symbol HeredocEnd <*> (Literal.TextElement <$> source)
+term term = contextualize comment term <|> makeTerm1 <$> (Syntax.Context <$> some1 (comment <|> heredocBody) <*> emptyTerm)
+  where
+    heredocBody = makeTerm <$> symbol HeredocBody <*> children (some (interpolation <|> escapeSequence <|> heredocEnd))
+    heredocEnd = makeTerm <$> symbol HeredocEnd <*> (Literal.TextElement <$> source)
 
 -- | Match a series of terms or comments until a delimiter is matched.
 manyTermsTill :: Assignment (Term Loc) -> Assignment b -> Assignment [Term Loc]

From 5586c46193527e7733911564f36abea1cd86aca2 Mon Sep 17 00:00:00 2001
From: Timothy Clem <timothy.clem@gmail.com>
Date: Tue, 10 Dec 2019 12:52:44 -0800
Subject: [PATCH 138/155] Structure of heredocs changed

---
 test/fixtures/ruby/corpus/heredoc.diffA-B.txt | 7 ++++---
 test/fixtures/ruby/corpus/heredoc.diffB-A.txt | 7 ++++---
 test/fixtures/ruby/corpus/heredoc.parseB.txt  | 7 ++++---
 3 files changed, 12 insertions(+), 9 deletions(-)

diff --git a/test/fixtures/ruby/corpus/heredoc.diffA-B.txt b/test/fixtures/ruby/corpus/heredoc.diffA-B.txt
index d758bdc9d..e5315ecb0 100644
--- a/test/fixtures/ruby/corpus/heredoc.diffA-B.txt
+++ b/test/fixtures/ruby/corpus/heredoc.diffA-B.txt
@@ -1,9 +1,10 @@
 (Statements
 {+(Send
-  {+(Send
-    {+(Identifier)+}
-    {+(TextElement)+}
+  {+(Context
     {+(Statements
+      {+(TextElement)+})+}
+    {+(Send
+      {+(Identifier)+}
       {+(TextElement)+})+})+}
   {+(Identifier)+})+}
 {-(TextElement)-}
diff --git a/test/fixtures/ruby/corpus/heredoc.diffB-A.txt b/test/fixtures/ruby/corpus/heredoc.diffB-A.txt
index 461284630..bc9659102 100644
--- a/test/fixtures/ruby/corpus/heredoc.diffB-A.txt
+++ b/test/fixtures/ruby/corpus/heredoc.diffB-A.txt
@@ -3,9 +3,10 @@
 {+(Statements
   {+(TextElement)+})+}
 {-(Send
-  {-(Send
-    {-(Identifier)-}
-    {-(TextElement)-}
+  {-(Context
     {-(Statements
+      {-(TextElement)-})-}
+    {-(Send
+      {-(Identifier)-}
       {-(TextElement)-})-})-}
   {-(Identifier)-})-})
diff --git a/test/fixtures/ruby/corpus/heredoc.parseB.txt b/test/fixtures/ruby/corpus/heredoc.parseB.txt
index b9c81795e..7a04ab9f5 100644
--- a/test/fixtures/ruby/corpus/heredoc.parseB.txt
+++ b/test/fixtures/ruby/corpus/heredoc.parseB.txt
@@ -1,8 +1,9 @@
 (Statements
   (Send
-    (Send
-      (Identifier)
-      (TextElement)
+    (Context
       (Statements
+        (TextElement))
+      (Send
+        (Identifier)
         (TextElement)))
     (Identifier)))

From cc8b1891e43111698a28eff422ecb039343bb524 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 10 Dec 2019 16:35:51 -0500
Subject: [PATCH 139/155] Run the inner computations.

---
 src/Analysis/Abstract/Caching/FlowSensitive.hs | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/src/Analysis/Abstract/Caching/FlowSensitive.hs b/src/Analysis/Abstract/Caching/FlowSensitive.hs
index 23de4acf4..ab1a212ba 100644
--- a/src/Analysis/Abstract/Caching/FlowSensitive.hs
+++ b/src/Analysis/Abstract/Caching/FlowSensitive.hs
@@ -8,6 +8,7 @@ module Analysis.Abstract.Caching.FlowSensitive
 
 import Prologue
 
+import Control.Algebra (Effect)
 import Control.Carrier.NonDet.Church
 import Control.Carrier.Reader
 import Control.Carrier.Fresh.Strict
@@ -79,6 +80,7 @@ cachingTerms recur term = do
       cachingConfiguration c pairs (recur term)
 
 convergingModules :: ( Cacheable term address value
+                     , Effect sig
                      , Has Fresh sig m
                      , Has (Reader (Cache term address value)) sig m
                      , Has (Reader (Live address)) sig m
@@ -86,16 +88,16 @@ convergingModules :: ( Cacheable term address value
                      , 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 runNonDetA (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.
-    evalFresh 0 . pure $
+    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

From b1cc324c112a89a0fc7aef031eacbefec8f03e0c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 10 Dec 2019 16:54:35 -0500
Subject: [PATCH 140/155] Bump fused-syntax to master.

---
 cabal.project | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/cabal.project b/cabal.project
index 3a1848324..a0699054c 100644
--- a/cabal.project
+++ b/cabal.project
@@ -52,4 +52,4 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/antitypical/fused-syntax.git
-  tag: 1fd5534085d9592f8b42461c0b2602b0344389bb
+  tag: d11e14581217590a5c67f79cbaeee35ac8acee6a

From 86a99f3485bf61da19ccdc1ac9d2037c27c9f26f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 10 Dec 2019 16:55:33 -0500
Subject: [PATCH 141/155] :fire: the source-repository-package stanzas for
 fused-effects-resumable and fused-effects-exceptions.

---
 cabal.project | 10 ----------
 1 file changed, 10 deletions(-)

diff --git a/cabal.project b/cabal.project
index a0699054c..2a13f8935 100644
--- a/cabal.project
+++ b/cabal.project
@@ -39,16 +39,6 @@ source-repository-package
   location: https://github.com/tclem/proto-lens-jsonpb
   tag: e4d10b77f57ee25beb759a33e63e2061420d3dc2
 
-source-repository-package
-  type: git
-  location: https://github.com/fused-effects/fused-effects-exceptions
-  tag: 8d3d9c9eafcf254c7ccc04219d23114520117ccc
-
-source-repository-package
-  type: git
-  location: https://github.com/fused-effects/fused-effects-resumable
-  tag: bd6c51dff70f03d8404572f1f413c8a612e41c49
-
 source-repository-package
   type: git
   location: https://github.com/antitypical/fused-syntax.git

From e1d3e4ba693ae510c8f5ead15dfaba9e2f96a758 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 10 Dec 2019 16:55:45 -0500
Subject: [PATCH 142/155] :fire: the local inclusion of haskell-tree-sitter.

---
 cabal.project | 1 -
 1 file changed, 1 deletion(-)

diff --git a/cabal.project b/cabal.project
index 2a13f8935..db018f11a 100644
--- a/cabal.project
+++ b/cabal.project
@@ -6,7 +6,6 @@ packages: .
           semantic-json
           semantic-python
           semantic-tags
-          ../haskell-tree-sitter/*
 
 jobs: $ncpus
 

From af1d62a75b706f9d34ddbbbee503a53ec8d2d913 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Wed, 11 Dec 2019 15:04:18 -0500
Subject: [PATCH 143/155] Depend on newer tree-sitter.

---
 semantic-ast/semantic-ast.cabal   | 2 +-
 semantic-java/semantic-java.cabal | 2 +-
 semantic.cabal                    | 2 +-
 3 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/semantic-ast/semantic-ast.cabal b/semantic-ast/semantic-ast.cabal
index d5d6ea86e..84e40ffb9 100644
--- a/semantic-ast/semantic-ast.cabal
+++ b/semantic-ast/semantic-ast.cabal
@@ -41,7 +41,7 @@ library
   -- other-modules:
   -- other-extensions:
   build-depends:       base ^>=4.12.0.0
-                     , tree-sitter ^>= 0.7
+                     , tree-sitter ^>= 0.7.1
                      , semantic-source ^>= 0.0
                      , tree-sitter-python ^>= 0.8
                      , bytestring ^>= 0.10.8.2
diff --git a/semantic-java/semantic-java.cabal b/semantic-java/semantic-java.cabal
index aa7b35b74..5b9704447 100644
--- a/semantic-java/semantic-java.cabal
+++ b/semantic-java/semantic-java.cabal
@@ -27,7 +27,7 @@ library
     , 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
diff --git a/semantic.cabal b/semantic.cabal
index e415eb95c..fe82182ac 100644
--- a/semantic.cabal
+++ b/semantic.cabal
@@ -59,7 +59,7 @@ common dependencies
                      , fused-effects-exceptions ^>= 1
                      , fused-effects-resumable ^>= 0.1
                      , hashable ^>= 1.2.7.0
-                     , tree-sitter ^>= 0.7
+                     , tree-sitter ^>= 0.7.1
                      , mtl ^>= 2.2.2
                      , network ^>= 2.8.0.0
                      , pathtype ^>= 0.8.1

From 575935f6c63714192e28e10ed536147bd916d669 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Wed, 11 Dec 2019 15:41:50 -0500
Subject: [PATCH 144/155] Fix lints.

---
 src/Semantic/Distribute.hs |  9 +++++----
 src/Semantic/Task/Files.hs | 18 ++++++++++--------
 2 files changed, 15 insertions(+), 12 deletions(-)

diff --git a/src/Semantic/Distribute.hs b/src/Semantic/Distribute.hs
index 818b679fb..3298e7312 100644
--- a/src/Semantic/Distribute.hs
+++ b/src/Semantic/Distribute.hs
@@ -1,4 +1,5 @@
-{-# 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
@@ -11,10 +12,10 @@ module Semantic.Distribute
 , DistributeC(..)
 ) where
 
-import qualified Control.Concurrent.Async as Async
 import           Control.Algebra
-import           Control.Carrier.Reader
 import           Control.Carrier.Lift
+import           Control.Carrier.Reader
+import qualified Control.Concurrent.Async as Async
 import           Control.Monad.IO.Unlift
 import           Control.Parallel.Strategies
 import           Prologue
@@ -59,7 +60,7 @@ withDistribute :: MonadUnliftIO m => DistributeC m a -> m a
 withDistribute r = withUnliftIO (`runDistribute` r)
 
 instance MonadUnliftIO m => MonadUnliftIO (LiftC m) where
-  askUnliftIO = LiftC $ withUnliftIO $ \u -> return (UnliftIO (unliftIO u . runM))
+  askUnliftIO = LiftC $ withUnliftIO $ \u -> pure (UnliftIO (unliftIO u . runM))
   {-# INLINE askUnliftIO #-}
   withRunInIO inner = LiftC $ withRunInIO $ \run -> inner (run . runM)
   {-# INLINE withRunInIO #-}
diff --git a/src/Semantic/Task/Files.hs b/src/Semantic/Task/Files.hs
index c13d2086d..83313bf94 100644
--- a/src/Semantic/Task/Files.hs
+++ b/src/Semantic/Task/Files.hs
@@ -1,4 +1,6 @@
-{-# LANGUAGE DataKinds, DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GADTs, GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DataKinds, DeriveFunctor, ExistentialQuantification, FlexibleContexts, FlexibleInstances, GADTs,
+             GeneralizedNewtypeDeriving, KindSignatures, MultiParamTypeClasses, StandaloneDeriving, TypeOperators,
+             UndecidableInstances #-}
 
 module Semantic.Task.Files
   ( Files
@@ -28,8 +30,8 @@ import           Prelude hiding (readFile)
 import           Prologue hiding (catch)
 import           Semantic.IO
 import qualified System.IO as IO hiding (withBinaryFile)
-import qualified System.Path.IO as IO (withBinaryFile)
 import qualified System.Path as Path
+import qualified System.Path.IO as IO (withBinaryFile)
 
 data Source blob where
   FromPath       :: File                            -> Source Blob
@@ -50,16 +52,16 @@ data Files (m :: * -> *) k
 deriving instance Functor m => Functor (Files m)
 
 instance HFunctor Files where
-  hmap f (Read s k) = Read s (f . k)
+  hmap f (Read s k)                = Read s (f . k)
   hmap f (ReadProject mp p l ps k) = ReadProject mp p l ps (f . k)
-  hmap f (FindFiles p s ps k) = FindFiles p s ps (f . k)
-  hmap f (Write d b k) = Write d b (f k)
+  hmap f (FindFiles p s ps k)      = FindFiles p s ps (f . k)
+  hmap f (Write d b k)             = Write d b (f k)
 
 instance Effect Files where
-  thread state handler (Read s k) = Read s (handler . (<$ state) . k)
+  thread state handler (Read s k)                = Read s (handler . (<$ state) . k)
   thread state handler (ReadProject mp p l ps k) = ReadProject mp p l ps (handler . (<$ state) . k)
-  thread state handler (FindFiles p s ps k) = FindFiles p s ps (handler . (<$ state) . k)
-  thread state handler (Write d b k) = Write d b (handler . (<$ state) $ k)
+  thread state handler (FindFiles p s ps k)      = FindFiles p s ps (handler . (<$ state) . k)
+  thread state handler (Write d b k)             = Write d b (handler . (<$ state) $ k)
 
 -- | Run a 'Files' effect in 'IO'
 runFiles :: FilesC m a -> m a

From 34214b737f698f5d906cedcbdd5d51ec689a8662 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Wed, 11 Dec 2019 15:44:50 -0500
Subject: [PATCH 145/155] Fix Generators module.

---
 semantic-core/test/Generators.hs | 22 +++++++++++-----------
 1 file changed, 11 insertions(+), 11 deletions(-)

diff --git a/semantic-core/test/Generators.hs b/semantic-core/test/Generators.hs
index d96a82cdf..ee56f1d4b 100644
--- a/semantic-core/test/Generators.hs
+++ b/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.>>>)

From 862ee92eb8831e4b35d18ca7ab7cfe98e3839bcf Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Wed, 11 Dec 2019 15:47:03 -0500
Subject: [PATCH 146/155] Fix semantic-python tests.

---
 semantic-python/test/Test.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-python/test/Test.hs b/semantic-python/test/Test.hs
index 1a0288c01..2931598d4 100644
--- a/semantic-python/test/Test.hs
+++ b/semantic-python/test/Test.hs
@@ -121,7 +121,7 @@ checkPythonFile fp = HUnit.testCaseSteps (Path.toString fp) $ \step -> withFroze
   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

From 353226c0cb04d0e96727e79432cad835ce3f3710 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Wed, 11 Dec 2019 15:50:15 -0500
Subject: [PATCH 147/155] Fix parse-examples.

---
 test/Examples.hs | 9 ++++-----
 1 file changed, 4 insertions(+), 5 deletions(-)

diff --git a/test/Examples.hs b/test/Examples.hs
index 8488801c3..c642f2d97 100644
--- a/test/Examples.hs
+++ b/test/Examples.hs
@@ -3,12 +3,10 @@
 module Main (main) where
 
 import           Control.Carrier.Parse.Measured
-import           Control.Effect
-import           Control.Effect.Reader
+import           Control.Carrier.Reader
+import           Control.Concurrent.Async (forConcurrently)
 import           Control.Exception (displayException)
 import qualified Control.Foldl as Foldl
-import           Data.Function ((&))
-import           Control.Concurrent.Async (forConcurrently)
 import           Control.Monad
 import           Control.Monad.IO.Class
 import           Control.Monad.Trans.Resource (ResIO, runResourceT)
@@ -16,6 +14,7 @@ import           Data.Blob
 import qualified Data.ByteString.Lazy.Char8 as BLC
 import qualified Data.ByteString.Streaming.Char8 as ByteStream
 import           Data.Either
+import           Data.Function ((&))
 import           Data.Language (defaultLanguageModes)
 import           Data.Set (Set)
 import           Data.Typeable
@@ -119,5 +118,5 @@ knownFailuresForPath tsDir (Just path)
   )
 
 
-parseFilePath :: (Member (Error SomeException) sig, Member Distribute sig, Member Parse sig, Member Files sig, Member (Reader Config) sig, Carrier sig m, MonadIO m) => Path.RelFile -> m Bool
+parseFilePath :: (Has (Error SomeException) sig m, Has Distribute sig m, Has Parse sig m, Has Files sig m, Has (Reader Config) sig m, MonadIO m) => Path.RelFile -> m Bool
 parseFilePath path = readBlob (fileForTypedPath path) >>= runReader defaultLanguageModes . parseTermBuilder @[] TermShow . pure >>= const (pure True)

From 22b6c3bab3a2a9053cc8dffdddc79edbd30e11b0 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 12 Dec 2019 11:31:15 -0500
Subject: [PATCH 148/155] :fire: some redundant language extensions.

---
 semantic-analysis/src/Analysis/Concrete.hs        | 2 +-
 semantic-analysis/src/Analysis/FlowInsensitive.hs | 2 +-
 semantic-analysis/src/Analysis/ImportGraph.hs     | 2 +-
 semantic-analysis/src/Analysis/ScopeGraph.hs      | 2 +-
 semantic-analysis/src/Analysis/Typecheck.hs       | 2 +-
 5 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index c96a4fee9..4362084bc 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ConstraintKinds, DerivingVia, FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, QuantifiedConstraints, 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
diff --git a/semantic-analysis/src/Analysis/FlowInsensitive.hs b/semantic-analysis/src/Analysis/FlowInsensitive.hs
index 9b9927260..bb744194c 100644
--- a/semantic-analysis/src/Analysis/FlowInsensitive.hs
+++ b/semantic-analysis/src/Analysis/FlowInsensitive.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ConstraintKinds, FlexibleContexts, OverloadedStrings, ScopedTypeVariables, TypeOperators #-}
+{-# LANGUAGE FlexibleContexts, OverloadedStrings, ScopedTypeVariables, TypeOperators #-}
 module Analysis.FlowInsensitive
 ( Heap
 , FrameId(..)
diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 1a5e91bf1..88a3082b6 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ConstraintKinds, FlexibleContexts, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications #-}
+{-# LANGUAGE FlexibleContexts, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications #-}
 module Analysis.ImportGraph
 ( ImportGraph
 , importGraph
diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index 37aa66c59..58e93c5b7 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ConstraintKinds, FlexibleContexts, OverloadedStrings, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeOperators #-}
+{-# LANGUAGE FlexibleContexts, OverloadedStrings, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeOperators #-}
 module Analysis.ScopeGraph
 ( ScopeGraph(..)
 , Ref (..)
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index cef3e85b4..6f27df864 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ConstraintKinds, DeriveGeneric, DeriveTraversable, DerivingVia, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DeriveGeneric, DeriveTraversable, DerivingVia, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-}
 module Analysis.Typecheck
 ( Monotype (..)
 , Meta

From 5ae742cf1c030416ce9462d69418903180e045b9 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 12 Dec 2019 11:31:24 -0500
Subject: [PATCH 149/155] :fire: unnecessary scoped type variables.

---
 semantic-analysis/src/Analysis/Concrete.hs | 5 ++---
 1 file changed, 2 insertions(+), 3 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 4362084bc..26c3c072b 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -113,8 +113,7 @@ runFile eval file = traverse run file
             . fix (eval concreteAnalysis)
 
 concreteAnalysis
-  :: forall term name m sig
-  .  ( Foldable term
+  :: ( Foldable term
      , IsString name
      , Has Fresh sig m
      , Has (Reader (Env name)) sig m
@@ -160,7 +159,7 @@ concreteAnalysis = Analysis{..}
         addr ... n = do
           val <- deref addr
           heap <- get
-          pure (val >>= lookupConcrete (heap :: Heap term name) n)
+          pure (val >>= lookupConcrete heap n)
 
 
 lookupConcrete :: (IsString name, Ord name) => Heap term name -> name -> Concrete term name -> Maybe Precise

From e0c47f11bc23fdf78bec1b8ce6dcac516695254c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 12 Dec 2019 11:32:01 -0500
Subject: [PATCH 150/155] :fire: an unnecessary Effect instance for Monotype.

---
 semantic-analysis/src/Analysis/Typecheck.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 6f27df864..3f38575b9 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -60,7 +60,6 @@ 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 Effect (Monotype name)
 
 instance RightModule (Monotype name) where
   item >>=* go = case item of

From b726bf8702efee60d3274eebfd25a4ed8f521cb3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 12 Dec 2019 11:41:06 -0500
Subject: [PATCH 151/155] :fire: ConstraintKinds.

---
 semantic-analysis/src/Control/Carrier/Fail/WithLoc.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Control/Carrier/Fail/WithLoc.hs b/semantic-analysis/src/Control/Carrier/Fail/WithLoc.hs
index 8b918ca7d..6abce03f4 100644
--- a/semantic-analysis/src/Control/Carrier/Fail/WithLoc.hs
+++ b/semantic-analysis/src/Control/Carrier/Fail/WithLoc.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ConstraintKinds, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
 module Control.Carrier.Fail.WithLoc
 ( -- * Fail effect
   module Control.Effect.Fail

From d81d482592aea386e529be3b013821fe8f41fd53 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 12 Dec 2019 11:42:33 -0500
Subject: [PATCH 152/155] :fire: runParseC.

---
 src/Control/Carrier/Parse/Simple.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Control/Carrier/Parse/Simple.hs b/src/Control/Carrier/Parse/Simple.hs
index f22437adc..14d9d413a 100644
--- a/src/Control/Carrier/Parse/Simple.hs
+++ b/src/Control/Carrier/Parse/Simple.hs
@@ -23,9 +23,9 @@ 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 }
+newtype ParseC m a = ParseC (ReaderC Duration m a)
   deriving (Applicative, Functor, Monad, MonadIO)
 
 instance ( Has (Error SomeException) sig m

From fdabcdb722c8b3accf7d391e30da3d8dace6b97f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 12 Dec 2019 11:42:40 -0500
Subject: [PATCH 153/155] Re-export Algebra & run as well.

---
 src/Control/Effect/Parse.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/src/Control/Effect/Parse.hs b/src/Control/Effect/Parse.hs
index e646694bf..461ae27e3 100644
--- a/src/Control/Effect/Parse.hs
+++ b/src/Control/Effect/Parse.hs
@@ -8,7 +8,9 @@ module Control.Effect.Parse
 , parseWith
 , parsePairWith
   -- * Re-exports
+, Algebra
 , Has
+, run
 ) where
 
 import Control.Algebra

From 95089e8833b1982798e197a7a0701d9e25a2acdd Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 12 Dec 2019 11:43:19 -0500
Subject: [PATCH 154/155] Re-export the effect module last.

---
 src/Control/Carrier/Parse/Measured.hs | 8 ++++----
 src/Control/Carrier/Parse/Simple.hs   | 8 ++++----
 2 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/src/Control/Carrier/Parse/Measured.hs b/src/Control/Carrier/Parse/Measured.hs
index 19b45d58c..3a384bddf 100644
--- a/src/Control/Carrier/Parse/Measured.hs
+++ b/src/Control/Carrier/Parse/Measured.hs
@@ -1,12 +1,12 @@
 {-# 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
diff --git a/src/Control/Carrier/Parse/Simple.hs b/src/Control/Carrier/Parse/Simple.hs
index 14d9d413a..2c341061d 100644
--- a/src/Control/Carrier/Parse/Simple.hs
+++ b/src/Control/Carrier/Parse/Simple.hs
@@ -1,13 +1,13 @@
 {-# 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

From c78529d06187ee09ccf5dc4b5f6fb47788403eab Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Thu, 12 Dec 2019 15:11:28 -0500
Subject: [PATCH 155/155] Add script to fix corrupted tree-sitter Cabal stores.

---
 script/fix-broken-cabal-store | 5 +++++
 1 file changed, 5 insertions(+)
 create mode 100755 script/fix-broken-cabal-store

diff --git a/script/fix-broken-cabal-store b/script/fix-broken-cabal-store
new file mode 100755
index 000000000..db1839666
--- /dev/null
+++ b/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*