From e20c60f7a75decc8a2053305f9859b3405b4ce7a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 11 Oct 2019 16:49:37 -0400
Subject: [PATCH 001/318] Define an Env effect.

---
 semantic-analysis/src/Analysis/Analysis.hs | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index f9cd0549d..0a2dcadac 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE DeriveFunctor, ExistentialQuantification, RankNTypes, StandaloneDeriving #-}
 module Analysis.Analysis
 ( Analysis(..)
 ) where
@@ -24,3 +24,10 @@ data Analysis term name address value m = Analysis
   , record    :: [(name, value)] -> m value
   , (...)     :: address -> name -> m (Maybe address)
   }
+
+data Env name addr m k
+  = Alloc name (addr -> m k)
+  | forall a . Bind name addr (m a) (a -> m k)
+  | Lookup name (Maybe addr -> m k)
+
+deriving instance Functor m => Functor (Env name addr m)

From bd8b21ebba1fb4bfcf5d7b248fa219a4539079ce Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 11 Oct 2019 16:50:36 -0400
Subject: [PATCH 002/318] Define a Heap effect.

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

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 0a2dcadac..0acae501d 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -31,3 +31,8 @@ data Env name addr m k
   | Lookup name (Maybe addr -> m k)
 
 deriving instance Functor m => Functor (Env name addr m)
+
+data Heap addr value m k
+  = Deref addr (Maybe value -> m k)
+  | Assign addr value (m k)
+  deriving (Functor)

From 5cbab3e8f9bf7e0a72d7f6f49faf9101203dc44d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 11 Oct 2019 17:06:20 -0400
Subject: [PATCH 003/318] Define a Domain effect.

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

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 0acae501d..4bae8529f 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -36,3 +36,13 @@ data Heap addr value m k
   = Deref addr (Maybe value -> m k)
   | Assign addr value (m k)
   deriving (Functor)
+
+data Domain term name value m k
+  = Abstract name (term name) (value -> m k)
+  | Apply value value         (value -> m k)
+  | Unit
+  | Bool   Bool  (value -> m k)
+  | AsBool value (Bool  -> m k)
+  | String   Text  (value -> m k)
+  | AsString value (Text  -> m k)
+  deriving (Functor)

From 30ed90072d4e4798f5cb4719a48dea94726e3b0f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 11 Oct 2019 17:16:22 -0400
Subject: [PATCH 004/318] Parameterize value by the term and name types.

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

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 4bae8529f..f8d85bd38 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -38,11 +38,11 @@ data Heap addr value m k
   deriving (Functor)
 
 data Domain term name value m k
-  = Abstract name (term name) (value -> m k)
-  | Apply value value         (value -> m k)
+  = Abstract name (term name)                 (value term name -> m k)
+  | Apply (value term name) (value term name) (value term name -> m k)
   | Unit
-  | Bool   Bool  (value -> m k)
-  | AsBool value (Bool  -> m k)
-  | String   Text  (value -> m k)
-  | AsString value (Text  -> m k)
+  | Bool   Bool              (value term name -> m k)
+  | AsBool (value term name) (Bool            -> m k)
+  | String   Text              (value term name -> m k)
+  | AsString (value term name) (Text            -> m k)
   deriving (Functor)

From 2a6b7c55a1ab8d33cb0a3b175ff6a72b34f9b87e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 11 Oct 2019 17:16:44 -0400
Subject: [PATCH 005/318] Give Unit a continuation.

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

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index f8d85bd38..4b42845f6 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -40,7 +40,7 @@ data Heap addr value m k
 data Domain term name value m k
   = Abstract name (term name)                 (value term name -> m k)
   | Apply (value term name) (value term name) (value term name -> m k)
-  | Unit
+  | Unit (value term name -> m k)
   | Bool   Bool              (value term name -> m k)
   | AsBool (value term name) (Bool            -> m k)
   | String   Text              (value term name -> m k)

From 532f3b319662b3d93cb70842f337b4b0cc4b8519 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 11 Oct 2019 17:17:40 -0400
Subject: [PATCH 006/318] Comments grouping the constructors.

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

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 4b42845f6..7c955a782 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -38,11 +38,15 @@ data Heap addr value m k
   deriving (Functor)
 
 data Domain term name value m k
+  -- Functions construction & elimination
   = Abstract name (term name)                 (value term name -> m k)
   | Apply (value term name) (value term name) (value term name -> m k)
+  -- Unit construction (no elimination)
   | Unit (value term name -> m k)
+  -- Boolean construction & elimination
   | Bool   Bool              (value term name -> m k)
   | AsBool (value term name) (Bool            -> m k)
+  -- String construction & elimination
   | String   Text              (value term name -> m k)
   | AsString (value term name) (Text            -> m k)
   deriving (Functor)

From 5acb7bee115d28c2541a0f8aae56c87384943aaf Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 11 Oct 2019 17:20:21 -0400
Subject: [PATCH 007/318] Add records to Domain.

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

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 7c955a782..eb9251e72 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -49,4 +49,7 @@ data Domain term name value m k
   -- String construction & elimination
   | String   Text              (value term name -> m k)
   | AsString (value term name) (Text            -> m k)
+  -- Record construction & elimination
+  | Record [(name, value term name)] (value term name -> m k)
+  | Project (value term name) name   (Maybe (value term name) -> m k)
   deriving (Functor)

From 46984f04c1b8c0dc1e22b7830152bab51836e498 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 11 Oct 2019 17:22:59 -0400
Subject: [PATCH 008/318] Alignment.

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

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index eb9251e72..b6596731c 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -50,6 +50,6 @@ data Domain term name value m k
   | String   Text              (value term name -> m k)
   | AsString (value term name) (Text            -> m k)
   -- Record construction & elimination
-  | Record [(name, value term name)] (value term name -> m k)
+  | Record [(name, value term name)] (value term name         -> m k)
   | Project (value term name) name   (Maybe (value term name) -> m k)
   deriving (Functor)

From 39a2df683dbfd2387614dc8fe982365899d38827 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 13:18:57 -0400
Subject: [PATCH 009/318] Define an HFunctor instance for Env.

---
 semantic-analysis/src/Analysis/Analysis.hs | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index b6596731c..58a402359 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -1,8 +1,9 @@
-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, RankNTypes, StandaloneDeriving #-}
+{-# LANGUAGE DeriveFunctor, ExistentialQuantification, LambdaCase, RankNTypes, StandaloneDeriving #-}
 module Analysis.Analysis
 ( Analysis(..)
 ) where
 
+import Control.Effect.Carrier
 import Data.Text (Text)
 
 -- | A record of functions necessary to perform analysis.
@@ -32,6 +33,13 @@ data Env name addr m k
 
 deriving instance Functor m => Functor (Env name addr m)
 
+instance HFunctor (Env name addr) where
+  hmap f = \case
+    Alloc name k -> Alloc name (f . k)
+    Bind name addr m k -> Bind name addr (f m) (f . k)
+    Lookup name k -> Lookup name (f . k)
+
+
 data Heap addr value m k
   = Deref addr (Maybe value -> m k)
   | Assign addr value (m k)

From 894234d058bf6b835a05e4373cef4d1a822573ac Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 13:19:35 -0400
Subject: [PATCH 010/318] Derive an HFunctor instance for Heap.

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

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 58a402359..1a7e17775 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -1,10 +1,11 @@
-{-# LANGUAGE DeriveFunctor, ExistentialQuantification, LambdaCase, RankNTypes, StandaloneDeriving #-}
+{-# LANGUAGE DeriveFunctor, DeriveGeneric, ExistentialQuantification, LambdaCase, RankNTypes, StandaloneDeriving #-}
 module Analysis.Analysis
 ( Analysis(..)
 ) where
 
 import Control.Effect.Carrier
 import Data.Text (Text)
+import GHC.Generics (Generic1)
 
 -- | A record of functions necessary to perform analysis.
 --
@@ -43,7 +44,10 @@ instance HFunctor (Env name addr) where
 data Heap addr value m k
   = Deref addr (Maybe value -> m k)
   | Assign addr value (m k)
-  deriving (Functor)
+  deriving (Functor, Generic1)
+
+instance HFunctor (Heap addr value)
+
 
 data Domain term name value m k
   -- Functions construction & elimination

From 597b8f0813fa28a42fcad39d73af14172fcdefd6 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 13:20:28 -0400
Subject: [PATCH 011/318] Derive an HFunctor instance for Domain.

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

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 1a7e17775..29cb92d99 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -64,4 +64,6 @@ data Domain term name value m k
   -- Record construction & elimination
   | Record [(name, value term name)] (value term name         -> m k)
   | Project (value term name) name   (Maybe (value term name) -> m k)
-  deriving (Functor)
+  deriving (Functor, Generic1)
+
+instance HFunctor (Domain term name value)

From 9c5289f54bb5d9a757b796ddfb076b0de0dec0c3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 14:30:32 -0400
Subject: [PATCH 012/318] Define an Effect instance for Env.

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

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 29cb92d99..99520d19e 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -40,6 +40,12 @@ instance HFunctor (Env name addr) where
     Bind name addr m k -> Bind name addr (f m) (f . k)
     Lookup name k -> Lookup name (f . k)
 
+instance Effect (Env name addr) where
+  handle ctx hdl = \case
+    Alloc name k -> Alloc name (hdl . (<$ ctx) . k)
+    Bind name addr m k -> Bind name addr (hdl (m <$ ctx)) (hdl . fmap k)
+    Lookup name k -> Lookup name (hdl . (<$ ctx) . k)
+
 
 data Heap addr value m k
   = Deref addr (Maybe value -> m k)

From fe29381b339b47da0ac655af30b1ddd10ffd9ec1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 14:39:51 -0400
Subject: [PATCH 013/318] Derive an Effect instance for Heap.

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

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 99520d19e..2e400c5e3 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -53,6 +53,7 @@ data Heap addr value m k
   deriving (Functor, Generic1)
 
 instance HFunctor (Heap addr value)
+instance Effect   (Heap addr value)
 
 
 data Domain term name value m k

From cf1371f66a05bc6ea9207ab1bb5dd3bac156a2c5 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 14:39:59 -0400
Subject: [PATCH 014/318] Derive an Effect instance for Domain.

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

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 2e400c5e3..7db304c1f 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -74,3 +74,4 @@ data Domain term name value m k
   deriving (Functor, Generic1)
 
 instance HFunctor (Domain term name value)
+instance Effect   (Domain term name value)

From 7508f9c9022b9572417ea5edbcca994a041bc325 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 14:41:31 -0400
Subject: [PATCH 015/318] Export Env.

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

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 7db304c1f..31876da28 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveFunctor, DeriveGeneric, ExistentialQuantification, LambdaCase, RankNTypes, StandaloneDeriving #-}
 module Analysis.Analysis
 ( Analysis(..)
+, Env(..)
 ) where
 
 import Control.Effect.Carrier

From 1a48a16a44c2c31c4d8608599cf45fd28448595f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 14:41:40 -0400
Subject: [PATCH 016/318] Define a smart constructor for Alloc.

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

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 31876da28..da631650e 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -1,6 +1,7 @@
-{-# LANGUAGE DeriveFunctor, DeriveGeneric, ExistentialQuantification, LambdaCase, RankNTypes, StandaloneDeriving #-}
+{-# LANGUAGE DeriveFunctor, DeriveGeneric, ExistentialQuantification, FlexibleContexts, LambdaCase, RankNTypes, StandaloneDeriving #-}
 module Analysis.Analysis
 ( Analysis(..)
+, alloc'
 , Env(..)
 ) where
 
@@ -28,6 +29,10 @@ data Analysis term name address value m = Analysis
   , (...)     :: address -> name -> m (Maybe address)
   }
 
+alloc' :: (Carrier sig m, Member (Env name addr) sig) => name -> m addr
+alloc' name = send (Alloc name pure)
+
+
 data Env name addr m k
   = Alloc name (addr -> m k)
   | forall a . Bind name addr (m a) (a -> m k)

From 1c1caac53b6fa8caad72ff83ae7c6de90f047119 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 14:42:18 -0400
Subject: [PATCH 017/318] Define a smart constructor for Bind.

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

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index da631650e..99f2f0195 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -2,6 +2,7 @@
 module Analysis.Analysis
 ( Analysis(..)
 , alloc'
+, bind'
 , Env(..)
 ) where
 
@@ -32,6 +33,9 @@ data Analysis term name address value m = Analysis
 alloc' :: (Carrier sig m, Member (Env name addr) sig) => name -> m addr
 alloc' name = send (Alloc name pure)
 
+bind' :: (Carrier sig m, Member (Env name addr) sig) => name -> addr -> m a -> m a
+bind' name addr m = send (Bind name addr m pure)
+
 
 data Env name addr m k
   = Alloc name (addr -> m k)

From 2eb80687ea1eff9887df573168871329c466e9fc Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 14:43:04 -0400
Subject: [PATCH 018/318] Define a smart constructor for Lookup.

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

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 99f2f0195..ae9a91f9e 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -3,6 +3,7 @@ module Analysis.Analysis
 ( Analysis(..)
 , alloc'
 , bind'
+, lookupEnv'
 , Env(..)
 ) where
 
@@ -36,6 +37,9 @@ alloc' name = send (Alloc name pure)
 bind' :: (Carrier sig m, Member (Env name addr) sig) => name -> addr -> m a -> m a
 bind' name addr m = send (Bind name addr m pure)
 
+lookupEnv' :: (Carrier sig m, Member (Env name addr) sig) => name -> m (Maybe addr)
+lookupEnv' name = send (Lookup name pure)
+
 
 data Env name addr m k
   = Alloc name (addr -> m k)

From 2ef1a7aa1280c1beebe7d426604b15bcad350124 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 14:46:55 -0400
Subject: [PATCH 019/318] Qualify the import of Analysis.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 61fd29761..c297d005e 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -11,7 +11,7 @@ module Analysis.Concrete
 
 import qualified Algebra.Graph as G
 import qualified Algebra.Graph.Export.Dot as G
-import           Analysis.Analysis
+import qualified Analysis.Analysis as A
 import           Analysis.File
 import           Control.Applicative (Alternative (..))
 import           Control.Carrier.Fail.WithLoc
@@ -74,7 +74,7 @@ concrete
      )
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term name Precise (Concrete term name) m
+     => A.Analysis term name Precise (Concrete term name) m
      -> (term name -> m (Concrete term name))
      -> (term name -> m (Concrete term name))
      )
@@ -100,7 +100,7 @@ runFile
      )
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term name Precise (Concrete term name) m
+     => A.Analysis term name Precise (Concrete term name) m
      -> (term name -> m (Concrete term name))
      -> (term name -> m (Concrete term name))
      )
@@ -126,8 +126,8 @@ concreteAnalysis :: ( Carrier sig m
                     , Show name
                     , Show (term name)
                     )
-                 => Analysis term name Precise (Concrete term name) m
-concreteAnalysis = Analysis{..}
+                 => A.Analysis term name Precise (Concrete term name) m
+concreteAnalysis = A.Analysis{..}
   where alloc _ = fresh
         bind name addr m = local (Map.insert name addr) m
         lookupEnv n = asks (Map.lookup n)

From 3aa3cb5005e5430db4c79ff35fe60b1dce080c21 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 14:51:24 -0400
Subject: [PATCH 020/318] Define a concrete Env carrier.

---
 semantic-analysis/src/Analysis/Concrete.hs | 18 +++++++++++++++++-
 1 file changed, 17 insertions(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index c297d005e..342826a1b 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 DerivingVia, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeOperators, UndecidableInstances #-}
 module Analysis.Concrete
 ( Concrete(..)
 , concrete
@@ -16,6 +16,7 @@ import           Analysis.File
 import           Control.Applicative (Alternative (..))
 import           Control.Carrier.Fail.WithLoc
 import           Control.Effect
+import           Control.Effect.Carrier
 import           Control.Effect.Fresh
 import           Control.Effect.NonDet
 import           Control.Effect.Reader hiding (Local)
@@ -226,3 +227,18 @@ data EdgeType term name
   | Slot name
   | Value (Concrete term name)
   deriving (Eq, Ord, Show)
+
+
+newtype EnvC name m a = EnvC { runEnv :: m a }
+  deriving (Applicative, Functor, Monad)
+
+instance ( Carrier sig m
+         , Member Fresh sig
+         , Member (Reader (Map.Map name Precise)) sig
+         , Ord name
+         )
+      => Carrier (A.Env name Precise :+: sig) (EnvC name m) where
+  eff (L (A.Alloc _ k))          = fresh >>= k
+  eff (L (A.Bind name addr m k)) = local (Map.insert name addr) m >>= k
+  eff (L (A.Lookup name k))      = asks (Map.lookup name) >>= k
+  eff (R other)                  = EnvC (eff (handleCoercible other))

From 4f44170281e2fc4144e917bb76a2d1c848a1bc60 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 14:52:17 -0400
Subject: [PATCH 021/318] Derive a MonadFail instance for EnvC.

---
 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 342826a1b..373f38e67 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -230,7 +230,7 @@ data EdgeType term name
 
 
 newtype EnvC name m a = EnvC { runEnv :: m a }
-  deriving (Applicative, Functor, Monad)
+  deriving (Applicative, Functor, Monad, MonadFail)
 
 instance ( Carrier sig m
          , Member Fresh sig

From f0739bb151f3eaa5a37ac956ec250b083a4aa7e8 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 14:52:21 -0400
Subject: [PATCH 022/318] Run the env carrier.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 373f38e67..9c8cc9c76 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -112,6 +112,7 @@ runFile eval file = traverse run file
             . runReader (fileSpan file)
             . runFail
             . runReader @(Env name) mempty
+            . runEnv @name
             . fix (eval concreteAnalysis)
 
 concreteAnalysis :: ( Carrier sig m

From ec94b7de1ace37b1709bb0f3b5b89e92c871bb44 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 14:55:48 -0400
Subject: [PATCH 023/318] Define a carrier for monovariant Env.

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

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 07b924560..fde196d31 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, MultiParamTypeClasses, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-}
 module Analysis.Typecheck
 ( Monotype (..)
 , Meta
@@ -236,3 +236,14 @@ mvs = foldMap IntSet.singleton
 
 substAll :: Monad t => IntMap.IntMap (t Meta) -> t Meta -> t Meta
 substAll s a = a >>= \ i -> fromMaybe (pure i) (IntMap.lookup i s)
+
+
+newtype EnvC name m a = EnvC { runEnv :: m a }
+  deriving (Applicative, Functor, Monad, MonadFail)
+
+instance Carrier sig m
+      => Carrier (Env name name :+: sig) (EnvC name m) where
+  eff (L (Alloc name k))  = k name
+  eff (L (Bind _ _ m k))  = m >>= k
+  eff (L (Lookup name k)) = k (Just name)
+  eff (R other)           = EnvC (eff (handleCoercible other))

From 131c804184f43356ea9fec8a4f4c1720abc30d89 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 14:56:43 -0400
Subject: [PATCH 024/318] Stub in a module for the Env effect.

---
 semantic-analysis/semantic-analysis.cabal    | 1 +
 semantic-analysis/src/Analysis/Effect/Env.hs | 2 ++
 2 files changed, 3 insertions(+)
 create mode 100644 semantic-analysis/src/Analysis/Effect/Env.hs

diff --git a/semantic-analysis/semantic-analysis.cabal b/semantic-analysis/semantic-analysis.cabal
index cb77bf035..9bc4d2b53 100644
--- a/semantic-analysis/semantic-analysis.cabal
+++ b/semantic-analysis/semantic-analysis.cabal
@@ -42,6 +42,7 @@ library
   exposed-modules:
     Analysis.Analysis
     Analysis.Concrete
+    Analysis.Effect.Env
     Analysis.File
     Analysis.FlowInsensitive
     Analysis.ImportGraph
diff --git a/semantic-analysis/src/Analysis/Effect/Env.hs b/semantic-analysis/src/Analysis/Effect/Env.hs
new file mode 100644
index 000000000..7193c88d1
--- /dev/null
+++ b/semantic-analysis/src/Analysis/Effect/Env.hs
@@ -0,0 +1,2 @@
+module Analysis.Effect.Env
+() where

From 7809bd2e8da1ed984268222200d42a5847278b91 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 14:58:33 -0400
Subject: [PATCH 025/318] Move Env into its own module.

---
 semantic-analysis/src/Analysis/Analysis.hs   | 33 -----------------
 semantic-analysis/src/Analysis/Concrete.hs   |  1 +
 semantic-analysis/src/Analysis/Effect/Env.hs | 38 +++++++++++++++++++-
 semantic-analysis/src/Analysis/Typecheck.hs  |  1 +
 4 files changed, 39 insertions(+), 34 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index ae9a91f9e..635511336 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -1,10 +1,6 @@
 {-# LANGUAGE DeriveFunctor, DeriveGeneric, ExistentialQuantification, FlexibleContexts, LambdaCase, RankNTypes, StandaloneDeriving #-}
 module Analysis.Analysis
 ( Analysis(..)
-, alloc'
-, bind'
-, lookupEnv'
-, Env(..)
 ) where
 
 import Control.Effect.Carrier
@@ -31,35 +27,6 @@ data Analysis term name address value m = Analysis
   , (...)     :: address -> name -> m (Maybe address)
   }
 
-alloc' :: (Carrier sig m, Member (Env name addr) sig) => name -> m addr
-alloc' name = send (Alloc name pure)
-
-bind' :: (Carrier sig m, Member (Env name addr) sig) => name -> addr -> m a -> m a
-bind' name addr m = send (Bind name addr m pure)
-
-lookupEnv' :: (Carrier sig m, Member (Env name addr) sig) => name -> m (Maybe addr)
-lookupEnv' name = send (Lookup name pure)
-
-
-data Env name addr m k
-  = Alloc name (addr -> m k)
-  | forall a . Bind name addr (m a) (a -> m k)
-  | Lookup name (Maybe addr -> m k)
-
-deriving instance Functor m => Functor (Env name addr m)
-
-instance HFunctor (Env name addr) where
-  hmap f = \case
-    Alloc name k -> Alloc name (f . k)
-    Bind name addr m k -> Bind name addr (f m) (f . k)
-    Lookup name k -> Lookup name (f . k)
-
-instance Effect (Env name addr) where
-  handle ctx hdl = \case
-    Alloc name k -> Alloc name (hdl . (<$ ctx) . k)
-    Bind name addr m k -> Bind name addr (hdl (m <$ ctx)) (hdl . fmap k)
-    Lookup name k -> Lookup name (hdl . (<$ ctx) . k)
-
 
 data Heap addr value m k
   = Deref addr (Maybe value -> m k)
diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 9c8cc9c76..c9ce49e6a 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -12,6 +12,7 @@ module Analysis.Concrete
 import qualified Algebra.Graph as G
 import qualified Algebra.Graph.Export.Dot as G
 import qualified Analysis.Analysis as A
+import qualified Analysis.Effect.Env as A
 import           Analysis.File
 import           Control.Applicative (Alternative (..))
 import           Control.Carrier.Fail.WithLoc
diff --git a/semantic-analysis/src/Analysis/Effect/Env.hs b/semantic-analysis/src/Analysis/Effect/Env.hs
index 7193c88d1..b16dd6955 100644
--- a/semantic-analysis/src/Analysis/Effect/Env.hs
+++ b/semantic-analysis/src/Analysis/Effect/Env.hs
@@ -1,2 +1,38 @@
+{-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, LambdaCase, StandaloneDeriving #-}
 module Analysis.Effect.Env
-() where
+( alloc
+, bind
+, lookupEnv
+, Env(..)
+) where
+
+import Control.Effect.Carrier
+
+alloc :: (Carrier sig m, Member (Env name addr) sig) => name -> m addr
+alloc name = send (Alloc name pure)
+
+bind :: (Carrier sig m, Member (Env name addr) sig) => name -> addr -> m a -> m a
+bind name addr m = send (Bind name addr m pure)
+
+lookupEnv :: (Carrier sig m, Member (Env name addr) sig) => name -> m (Maybe addr)
+lookupEnv name = send (Lookup name pure)
+
+
+data Env name addr m k
+  = Alloc name (addr -> m k)
+  | forall a . Bind name addr (m a) (a -> m k)
+  | Lookup name (Maybe addr -> m k)
+
+deriving instance Functor m => Functor (Env name addr m)
+
+instance HFunctor (Env name addr) where
+  hmap f = \case
+    Alloc name k -> Alloc name (f . k)
+    Bind name addr m k -> Bind name addr (f m) (f . k)
+    Lookup name k -> Lookup name (f . k)
+
+instance Effect (Env name addr) where
+  handle ctx hdl = \case
+    Alloc name k -> Alloc name (hdl . (<$ ctx) . k)
+    Bind name addr m k -> Bind name addr (hdl (m <$ ctx)) (hdl . fmap k)
+    Lookup name k -> Lookup name (hdl . (<$ ctx) . k)
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index fde196d31..83a8d511c 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -8,6 +8,7 @@ module Analysis.Typecheck
 ) where
 
 import           Analysis.Analysis
+import           Analysis.Effect.Env
 import           Analysis.File
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative (..))

From 6305e661c45ad090f2cc6b31178bfee7c9586bd0 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 14:59:04 -0400
Subject: [PATCH 026/318] Run the env effect.

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

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 83a8d511c..3902b0f1f 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -109,6 +109,7 @@ typecheckingFlowInsensitive eval
   = run
   . runFresh
   . runHeap
+  . runEnv
   . fmap (fmap (fmap (fmap generalize)))
   . traverse (runFile eval)
 

From d8955fdb20e619d1afcc2240a675636a3ef408a8 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 15:00:03 -0400
Subject: [PATCH 027/318] Stub in a module for the precise Env carrier.

---
 semantic-analysis/semantic-analysis.cabal             | 1 +
 semantic-analysis/src/Analysis/Carrier/Env/Precise.hs | 2 ++
 2 files changed, 3 insertions(+)
 create mode 100644 semantic-analysis/src/Analysis/Carrier/Env/Precise.hs

diff --git a/semantic-analysis/semantic-analysis.cabal b/semantic-analysis/semantic-analysis.cabal
index 9bc4d2b53..f555ee8d0 100644
--- a/semantic-analysis/semantic-analysis.cabal
+++ b/semantic-analysis/semantic-analysis.cabal
@@ -41,6 +41,7 @@ library
   hs-source-dirs: src
   exposed-modules:
     Analysis.Analysis
+    Analysis.Carrier.Env.Precise
     Analysis.Concrete
     Analysis.Effect.Env
     Analysis.File
diff --git a/semantic-analysis/src/Analysis/Carrier/Env/Precise.hs b/semantic-analysis/src/Analysis/Carrier/Env/Precise.hs
new file mode 100644
index 000000000..ad48afd59
--- /dev/null
+++ b/semantic-analysis/src/Analysis/Carrier/Env/Precise.hs
@@ -0,0 +1,2 @@
+module Analysis.Carrier.Env.Precise
+() where

From 06ea57e167443231877a17cf57bb3196c7616116 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 15:04:22 -0400
Subject: [PATCH 028/318] Move the precise env carrier to its own module.

---
 .../src/Analysis/Carrier/Env/Precise.hs       | 34 ++++++++++++++++++-
 semantic-analysis/src/Analysis/Concrete.hs    | 20 ++---------
 2 files changed, 35 insertions(+), 19 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Carrier/Env/Precise.hs b/semantic-analysis/src/Analysis/Carrier/Env/Precise.hs
index ad48afd59..39c3f51bf 100644
--- a/semantic-analysis/src/Analysis/Carrier/Env/Precise.hs
+++ b/semantic-analysis/src/Analysis/Carrier/Env/Precise.hs
@@ -1,2 +1,34 @@
+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
 module Analysis.Carrier.Env.Precise
-() where
+( -- * Env carrier
+  EnvC(..)
+  -- * Env effect
+, A.alloc
+, A.bind
+, A.lookupEnv
+, A.Env(..)
+) where
+
+import qualified Analysis.Effect.Env as A
+import Control.Effect.Carrier
+import Control.Effect.Fresh
+import Control.Effect.Reader
+import qualified Control.Monad.Fail as Fail
+import qualified Data.Map as Map
+
+type Precise = Int
+type Env name = Map.Map name Precise
+
+newtype EnvC name m a = EnvC { runEnv :: m a }
+  deriving (Applicative, Functor, Monad, Fail.MonadFail)
+
+instance ( Carrier sig m
+         , Member Fresh sig
+         , Member (Reader (Env name)) sig
+         , Ord name
+         )
+      => Carrier (A.Env name Precise :+: sig) (EnvC name m) where
+  eff (L (A.Alloc _ k))          = fresh >>= k
+  eff (L (A.Bind name addr m k)) = local (Map.insert name addr) m >>= k
+  eff (L (A.Lookup name k))      = asks (Map.lookup name) >>= k
+  eff (R other)                  = EnvC (eff (handleCoercible other))
diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index c9ce49e6a..f82c0517d 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -12,12 +12,11 @@ module Analysis.Concrete
 import qualified Algebra.Graph as G
 import qualified Algebra.Graph.Export.Dot as G
 import qualified Analysis.Analysis as A
-import qualified Analysis.Effect.Env as A
+import qualified Analysis.Carrier.Env.Precise as A
 import           Analysis.File
 import           Control.Applicative (Alternative (..))
 import           Control.Carrier.Fail.WithLoc
 import           Control.Effect
-import           Control.Effect.Carrier
 import           Control.Effect.Fresh
 import           Control.Effect.NonDet
 import           Control.Effect.Reader hiding (Local)
@@ -113,7 +112,7 @@ runFile eval file = traverse run file
             . runReader (fileSpan file)
             . runFail
             . runReader @(Env name) mempty
-            . runEnv @name
+            . A.runEnv @name
             . fix (eval concreteAnalysis)
 
 concreteAnalysis :: ( Carrier sig m
@@ -229,18 +228,3 @@ data EdgeType term name
   | Slot name
   | Value (Concrete term name)
   deriving (Eq, Ord, Show)
-
-
-newtype EnvC name m a = EnvC { runEnv :: m a }
-  deriving (Applicative, Functor, Monad, MonadFail)
-
-instance ( Carrier sig m
-         , Member Fresh sig
-         , Member (Reader (Map.Map name Precise)) sig
-         , Ord name
-         )
-      => Carrier (A.Env name Precise :+: sig) (EnvC name m) where
-  eff (L (A.Alloc _ k))          = fresh >>= k
-  eff (L (A.Bind name addr m k)) = local (Map.insert name addr) m >>= k
-  eff (L (A.Lookup name k))      = asks (Map.lookup name) >>= k
-  eff (R other)                  = EnvC (eff (handleCoercible other))

From e58db3da3143ceb17b0abb2c5ae0b01f3f60b6ba Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 15:12:36 -0400
Subject: [PATCH 029/318] Use the env effect in the concrete analysis.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index f82c0517d..e1fdee545 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -11,7 +11,7 @@ module Analysis.Concrete
 
 import qualified Algebra.Graph as G
 import qualified Algebra.Graph.Export.Dot as G
-import qualified Analysis.Analysis as A
+import           Analysis.Analysis
 import qualified Analysis.Carrier.Env.Precise as A
 import           Analysis.File
 import           Control.Applicative (Alternative (..))
@@ -75,7 +75,7 @@ concrete
      )
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => A.Analysis term name Precise (Concrete term name) m
+     => Analysis term name Precise (Concrete term name) m
      -> (term name -> m (Concrete term name))
      -> (term name -> m (Concrete term name))
      )
@@ -101,7 +101,7 @@ runFile
      )
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => A.Analysis term name Precise (Concrete term name) m
+     => Analysis term name Precise (Concrete term name) m
      -> (term name -> m (Concrete term name))
      -> (term name -> m (Concrete term name))
      )
@@ -118,7 +118,7 @@ runFile eval file = traverse run file
 concreteAnalysis :: ( Carrier sig m
                     , Foldable term
                     , IsString name
-                    , Member Fresh sig
+                    , Member (A.Env name Precise) sig
                     , Member (Reader (Env name)) sig
                     , Member (Reader Path.AbsRelFile) sig
                     , Member (Reader Span) sig
@@ -128,11 +128,11 @@ concreteAnalysis :: ( Carrier sig m
                     , Show name
                     , Show (term name)
                     )
-                 => A.Analysis term name Precise (Concrete term name) m
-concreteAnalysis = A.Analysis{..}
-  where alloc _ = fresh
-        bind name addr m = local (Map.insert name addr) m
-        lookupEnv n = asks (Map.lookup n)
+                 => Analysis term name Precise (Concrete term name) m
+concreteAnalysis = Analysis{..}
+  where alloc = A.alloc
+        bind = A.bind
+        lookupEnv = A.lookupEnv
         deref = gets . IntMap.lookup
         assign addr value = modify (IntMap.insert addr value)
         abstract _ name body = do

From 778f84bb128cf0ea44dcef8c83bbc0778ee12b4a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 15:13:15 -0400
Subject: [PATCH 030/318] Define a module for the monovariant Env carrier.

---
 semantic-analysis/semantic-analysis.cabal                 | 1 +
 semantic-analysis/src/Analysis/Carrier/Env/Monovariant.hs | 2 ++
 2 files changed, 3 insertions(+)
 create mode 100644 semantic-analysis/src/Analysis/Carrier/Env/Monovariant.hs

diff --git a/semantic-analysis/semantic-analysis.cabal b/semantic-analysis/semantic-analysis.cabal
index f555ee8d0..b7815f01e 100644
--- a/semantic-analysis/semantic-analysis.cabal
+++ b/semantic-analysis/semantic-analysis.cabal
@@ -41,6 +41,7 @@ library
   hs-source-dirs: src
   exposed-modules:
     Analysis.Analysis
+    Analysis.Carrier.Env.Monovariant
     Analysis.Carrier.Env.Precise
     Analysis.Concrete
     Analysis.Effect.Env
diff --git a/semantic-analysis/src/Analysis/Carrier/Env/Monovariant.hs b/semantic-analysis/src/Analysis/Carrier/Env/Monovariant.hs
new file mode 100644
index 000000000..8f9c3acd4
--- /dev/null
+++ b/semantic-analysis/src/Analysis/Carrier/Env/Monovariant.hs
@@ -0,0 +1,2 @@
+module Analysis.Carrier.Env.Monovariant
+() where

From 5fef3262e53cf6a8ed35e601d5ae5d85e052cc93 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 15:19:01 -0400
Subject: [PATCH 031/318] Move the monovariant Env carrier into its own module.

---
 .../src/Analysis/Carrier/Env/Monovariant.hs   | 21 ++++++++++++++++++-
 semantic-analysis/src/Analysis/Typecheck.hs   | 13 +-----------
 2 files changed, 21 insertions(+), 13 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Carrier/Env/Monovariant.hs b/semantic-analysis/src/Analysis/Carrier/Env/Monovariant.hs
index 8f9c3acd4..cb8a63d11 100644
--- a/semantic-analysis/src/Analysis/Carrier/Env/Monovariant.hs
+++ b/semantic-analysis/src/Analysis/Carrier/Env/Monovariant.hs
@@ -1,2 +1,21 @@
+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
 module Analysis.Carrier.Env.Monovariant
-() where
+( -- * Env carrier
+  EnvC(..)
+  -- * Env effect
+, module Analysis.Effect.Env
+) where
+
+import Analysis.Effect.Env
+import Control.Effect.Carrier
+import qualified Control.Monad.Fail as Fail
+
+newtype EnvC name m a = EnvC { runEnv :: m a }
+  deriving (Applicative, Functor, Monad, Fail.MonadFail)
+
+instance Carrier sig m
+      => Carrier (Env name name :+: sig) (EnvC name m) where
+  eff (L (Alloc name k))  = k name
+  eff (L (Bind _ _ m k))  = m >>= k
+  eff (L (Lookup name k)) = k (Just name)
+  eff (R other)           = EnvC (eff (handleCoercible other))
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 3902b0f1f..c71c68a65 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -8,7 +8,7 @@ module Analysis.Typecheck
 ) where
 
 import           Analysis.Analysis
-import           Analysis.Effect.Env
+import           Analysis.Carrier.Env.Monovariant
 import           Analysis.File
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative (..))
@@ -238,14 +238,3 @@ mvs = foldMap IntSet.singleton
 
 substAll :: Monad t => IntMap.IntMap (t Meta) -> t Meta -> t Meta
 substAll s a = a >>= \ i -> fromMaybe (pure i) (IntMap.lookup i s)
-
-
-newtype EnvC name m a = EnvC { runEnv :: m a }
-  deriving (Applicative, Functor, Monad, MonadFail)
-
-instance Carrier sig m
-      => Carrier (Env name name :+: sig) (EnvC name m) where
-  eff (L (Alloc name k))  = k name
-  eff (L (Bind _ _ m k))  = m >>= k
-  eff (L (Lookup name k)) = k (Just name)
-  eff (R other)           = EnvC (eff (handleCoercible other))

From 9e472c595698ab9c9167f7b753d3df899011d93d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 15:20:58 -0400
Subject: [PATCH 032/318] Use the Env effect to define the Analysis.

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

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index c71c68a65..cfd67d755 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -8,7 +8,7 @@ module Analysis.Typecheck
 ) where
 
 import           Analysis.Analysis
-import           Analysis.Carrier.Env.Monovariant
+import           Analysis.Carrier.Env.Monovariant as A
 import           Analysis.File
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative (..))
@@ -109,7 +109,6 @@ typecheckingFlowInsensitive eval
   = run
   . runFresh
   . runHeap
-  . runEnv
   . fmap (fmap (fmap (fmap generalize)))
   . traverse (runFile eval)
 
@@ -140,6 +139,7 @@ runFile eval file = traverse run file
           . runState (mempty :: (Substitution name))
           . runReader (filePath file)
           . runReader (fileSpan file)
+          . runEnv @name
           . runFail
           . (\ m -> do
             (cs, t) <- m
@@ -154,6 +154,7 @@ runFile eval file = traverse run file
 typecheckingAnalysis
   :: ( Alternative m
      , Carrier sig m
+     , Member (Env name name) sig
      , Member Fresh sig
      , Member (State (Set.Set (Constraint name))) sig
      , Member (State (Heap name (Type name))) sig
@@ -161,9 +162,9 @@ typecheckingAnalysis
      )
   => Analysis term name name (Type name) m
 typecheckingAnalysis = Analysis{..}
-  where alloc = pure
-        bind _ _ m = m
-        lookupEnv = pure . Just
+  where alloc = A.alloc
+        bind = A.bind
+        lookupEnv = A.lookupEnv
         deref addr = gets (Map.lookup addr >=> nonEmpty . Set.toList) >>= maybe (pure Nothing) (foldMapA (pure . Just))
         assign addr ty = modify (Map.insertWith (<>) addr (Set.singleton ty))
         abstract eval name body = do

From 0f7be2084d34bc0fe7c997a0e55a72b894803f5e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 15:23:13 -0400
Subject: [PATCH 033/318] Use the Env effect to define the import graph
 analysis.

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

diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index aebab99c7..0dcee0bd6 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -6,6 +6,7 @@ module Analysis.ImportGraph
 ) where
 
 import           Analysis.Analysis
+import           Analysis.Carrier.Env.Monovariant as A
 import           Analysis.File
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative(..))
@@ -88,6 +89,7 @@ runFile
 runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
+            . runEnv @name
             . runFail
             . fmap fold
             . convergeTerm (Proxy @name) (fix (cacheTerm . eval importGraphAnalysis))
@@ -95,6 +97,7 @@ runFile eval file = traverse run file
 -- FIXME: decompose into a product domain and two atomic domains
 importGraphAnalysis :: ( Alternative m
                        , Carrier sig m
+                       , Member (Env name name) sig
                        , Member (Reader Path.AbsRelFile) sig
                        , Member (Reader Span) sig
                        , Member (State (Heap name (Value term name))) sig
@@ -106,9 +109,9 @@ importGraphAnalysis :: ( Alternative m
                        )
                     => Analysis term name name (Value term name) m
 importGraphAnalysis = Analysis{..}
-  where alloc = pure
-        bind _ _ m = m
-        lookupEnv = pure . Just
+  where alloc = A.alloc
+        bind = A.bind
+        lookupEnv = A.lookupEnv
         deref addr = gets (Map.lookup addr >=> nonEmpty . Set.toList) >>= maybe (pure Nothing) (foldMapA (pure . Just))
         assign addr v = modify (Map.insertWith (<>) addr (Set.singleton v))
         abstract _ name body = do

From eb591f94df764cf800bee69e4c2e92f0384a43f3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 15:23:21 -0400
Subject: [PATCH 034/318] Use the Env effect to define the scope graph
 analysis.

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

diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index cf97aaa5b..0140f21ad 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -8,6 +8,7 @@ module Analysis.ScopeGraph
 ) where
 
 import           Analysis.Analysis
+import           Analysis.Carrier.Env.Monovariant as A
 import           Analysis.File
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative (..))
@@ -86,6 +87,7 @@ runFile
 runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
+            . runEnv @name
             . runReader (Map.empty @name @Ref)
             . runFail
             . fmap fold
@@ -95,6 +97,7 @@ scopeGraphAnalysis
   :: ( Alternative m
      , Carrier sig m
      , Member (Reader Path.AbsRelFile) sig
+     , Member (Env name name) sig
      , Member (Reader Span) sig
      , Member (Reader (Map.Map name Ref)) sig
      , Member (State (Heap name (ScopeGraph name))) sig
@@ -102,11 +105,9 @@ scopeGraphAnalysis
      )
   => Analysis term name name (ScopeGraph name) m
 scopeGraphAnalysis = Analysis{..}
-  where alloc = pure
-        bind name _ m = do
-          ref <- askRef
-          local (Map.insert name ref) m
-        lookupEnv = pure . Just
+  where alloc = A.alloc
+        bind = A.bind
+        lookupEnv = A.lookupEnv
         deref addr = do
           ref <- askRef
           bindRef <- asks (Map.lookup addr)

From 6e1383d2de8b1b241c31abd5171cc1080c23843d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 1 Nov 2019 15:25:49 -0400
Subject: [PATCH 035/318] Evaluate Core using the Env effect.

---
 semantic-core/src/Core/Eval.hs | 12 +++++++-----
 1 file changed, 7 insertions(+), 5 deletions(-)

diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index f7c23b5d7..5b2c7fa10 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -11,6 +11,7 @@ module Core.Eval
 ) where
 
 import Analysis.Analysis
+import Analysis.Effect.Env as A
 import Analysis.File
 import Control.Applicative (Alternative (..))
 import Control.Effect.Carrier
@@ -29,6 +30,7 @@ import Syntax.Term
 import qualified System.Path as Path
 
 eval :: ( Carrier sig m
+        , Member (Env Name address) sig
         , Member (Reader Span) sig
         , MonadFail m
         , Semigroup value
@@ -40,8 +42,8 @@ eval Analysis{..} eval = \case
   Var n -> lookupEnv' n >>= deref' n
   Alg (R c) -> case c of
     Rec (Named (Ignored n) b) -> do
-      addr <- alloc n
-      v <- bind n addr (eval (instantiate1 (pure n) b))
+      addr <- A.alloc n
+      v <- A.bind n addr (eval (instantiate1 (pure n) b))
       v <$ assign addr v
     -- NB: Combining the results of the evaluations allows us to model effects in abstract domains. This in turn means that we can define an abstract domain modelling the types-and-effects of computations by means of a 'Semigroup' instance which takes the type of its second operand and the union of both operands’ effects.
     --
@@ -49,9 +51,9 @@ eval Analysis{..} eval = \case
     a :>> b -> (<>) <$> eval a <*> eval b
     Named (Ignored n) a :>>= b -> do
       a' <- eval a
-      addr <- alloc n
+      addr <- A.alloc n
       assign addr a'
-      bind n addr ((a' <>) <$> eval (instantiate1 (pure n) b))
+      A.bind n addr ((a' <>) <$> eval (instantiate1 (pure n) b))
     Lam (Named (Ignored n) b) -> abstract eval n (instantiate1 (pure n) b)
     f :$ a -> do
       f' <- eval f
@@ -82,7 +84,7 @@ eval Analysis{..} eval = \case
         uninitialized s = fail ("uninitialized variable: " <> s)
         invalidRef s = fail ("invalid ref: " <> s)
 
-        lookupEnv' n = lookupEnv n >>= maybe (freeVariable (show n)) pure
+        lookupEnv' n = A.lookupEnv n >>= maybe (freeVariable (show n)) pure
         deref' n = deref >=> maybe (uninitialized (show n)) pure
 
         ref = \case

From d70a169e9311cd5bed0375ae5de2e94e5154d0ed Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 12:09:01 -0500
Subject: [PATCH 036/318] Reorder the contexts for ease of type application.

---
 semantic-analysis/src/Analysis/Effect/Env.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Effect/Env.hs b/semantic-analysis/src/Analysis/Effect/Env.hs
index b16dd6955..f3fe945dc 100644
--- a/semantic-analysis/src/Analysis/Effect/Env.hs
+++ b/semantic-analysis/src/Analysis/Effect/Env.hs
@@ -8,13 +8,13 @@ module Analysis.Effect.Env
 
 import Control.Effect.Carrier
 
-alloc :: (Carrier sig m, Member (Env name addr) sig) => name -> m addr
+alloc :: (Member (Env name addr) sig, Carrier sig m) => name -> m addr
 alloc name = send (Alloc name pure)
 
-bind :: (Carrier sig m, Member (Env name addr) sig) => name -> addr -> m a -> m a
+bind :: (Member (Env name addr) sig, Carrier sig m) => name -> addr -> m a -> m a
 bind name addr m = send (Bind name addr m pure)
 
-lookupEnv :: (Carrier sig m, Member (Env name addr) sig) => name -> m (Maybe addr)
+lookupEnv :: (Member (Env name addr) sig, Carrier sig m) => name -> m (Maybe addr)
 lookupEnv name = send (Lookup name pure)
 
 

From 17da79fe24798d3da1c2ac14b0018f0e10d651c6 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 12:10:54 -0500
Subject: [PATCH 037/318] Reformat the importGraphAnalysis signature.

---
 semantic-analysis/src/Analysis/ImportGraph.hs | 27 ++++++++++---------
 1 file changed, 14 insertions(+), 13 deletions(-)

diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 0dcee0bd6..27c5d0d03 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -95,19 +95,20 @@ runFile eval file = traverse run file
             . convergeTerm (Proxy @name) (fix (cacheTerm . eval importGraphAnalysis))
 
 -- FIXME: decompose into a product domain and two atomic domains
-importGraphAnalysis :: ( Alternative m
-                       , Carrier sig m
-                       , Member (Env name name) sig
-                       , Member (Reader Path.AbsRelFile) sig
-                       , Member (Reader Span) sig
-                       , Member (State (Heap name (Value term name))) sig
-                       , MonadFail m
-                       , Ord  name
-                       , Ord  (term name)
-                       , Show name
-                       , Show (term name)
-                       )
-                    => Analysis term name name (Value term name) m
+importGraphAnalysis
+  :: ( Alternative m
+     , Carrier sig m
+     , Member (Env name name) sig
+     , Member (Reader Path.AbsRelFile) sig
+     , Member (Reader Span) sig
+     , Member (State (Heap name (Value term name))) sig
+     , MonadFail m
+     , Ord  name
+     , Ord  (term name)
+     , Show name
+     , Show (term name)
+     )
+  => Analysis term name name (Value term name) m
 importGraphAnalysis = Analysis{..}
   where alloc = A.alloc
         bind = A.bind

From 961bf622ca4799c432b34bb9b6655852bb91f83b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 12:12:59 -0500
Subject: [PATCH 038/318] :fire: the Analysis env fields.

---
 semantic-analysis/src/Analysis/Analysis.hs    |  5 +----
 semantic-analysis/src/Analysis/Concrete.hs    |  9 +++------
 semantic-analysis/src/Analysis/ImportGraph.hs | 14 ++++++--------
 semantic-analysis/src/Analysis/ScopeGraph.hs  | 12 +++++-------
 semantic-analysis/src/Analysis/Typecheck.hs   | 12 +++++-------
 5 files changed, 20 insertions(+), 32 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 635511336..97d30879e 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -11,10 +11,7 @@ import GHC.Generics (Generic1)
 --
 -- This is intended to be replaced with a selection of algebraic effects providing these interfaces and carriers providing reusable implementations.
 data Analysis term name address value m = Analysis
-  { alloc     :: name -> m address
-  , bind      :: forall a . name -> address -> m a -> m a
-  , lookupEnv :: name -> m (Maybe address)
-  , deref     :: address -> m (Maybe value)
+  { deref     :: address -> m (Maybe value)
   , assign    :: address -> value -> m ()
   , abstract  :: (term name -> m value) -> name -> term name -> m value
   , apply     :: (term name -> m value) -> value -> value -> m value
diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index e1fdee545..04fb03a6f 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -130,10 +130,7 @@ concreteAnalysis :: ( Carrier sig m
                     )
                  => Analysis term name Precise (Concrete term name) m
 concreteAnalysis = Analysis{..}
-  where alloc = A.alloc
-        bind = A.bind
-        lookupEnv = A.lookupEnv
-        deref = gets . IntMap.lookup
+  where deref = gets . IntMap.lookup
         assign addr value = modify (IntMap.insert addr value)
         abstract _ name body = do
           path <- ask
@@ -142,7 +139,7 @@ concreteAnalysis = Analysis{..}
           pure (Closure path span name body env)
         apply eval (Closure path span name body env) a = do
           local (const path) . local (const span) $ do
-            addr <- alloc name
+            addr <- A.alloc name
             assign addr a
             local (const (Map.insert name addr env)) (eval body)
         apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
@@ -155,7 +152,7 @@ concreteAnalysis = Analysis{..}
         asString v          = fail $ "Cannot coerce " <> show v <> " to String"
         record fields = do
           fields' <- for fields $ \ (name, value) -> do
-            addr <- alloc name
+            addr <- A.alloc name
             assign addr value
             pure (name, addr)
           pure (Record (Map.fromList fields'))
diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 27c5d0d03..b30e43743 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -96,7 +96,8 @@ runFile eval file = traverse run file
 
 -- FIXME: decompose into a product domain and two atomic domains
 importGraphAnalysis
-  :: ( Alternative m
+  :: forall term name m sig
+  .  ( Alternative m
      , Carrier sig m
      , Member (Env name name) sig
      , Member (Reader Path.AbsRelFile) sig
@@ -110,19 +111,16 @@ importGraphAnalysis
      )
   => Analysis term name name (Value term name) m
 importGraphAnalysis = Analysis{..}
-  where alloc = A.alloc
-        bind = A.bind
-        lookupEnv = A.lookupEnv
-        deref addr = gets (Map.lookup addr >=> nonEmpty . Set.toList) >>= maybe (pure Nothing) (foldMapA (pure . Just))
+  where deref addr = gets (Map.lookup addr >=> nonEmpty . Set.toList) >>= maybe (pure Nothing) (foldMapA (pure . Just))
         assign addr v = modify (Map.insertWith (<>) addr (Set.singleton v))
         abstract _ name body = do
           path <- ask
           span <- ask
           pure (Value (Closure path span name body) mempty)
         apply eval (Value (Closure path span name body) _) a = local (const path) . local (const span) $ do
-          addr <- alloc name
+          addr <- alloc @name @name name
           assign addr a
-          bind name addr (eval body)
+          A.bind name addr (eval body)
         apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
         unit = pure mempty
         bool _ = pure mempty
@@ -132,7 +130,7 @@ importGraphAnalysis = Analysis{..}
         asString _ = pure mempty
         record fields = do
           for_ fields $ \ (k, v) -> do
-            addr <- alloc k
+            addr <- A.alloc @name @name k
             assign addr v
           pure (Value Abstract (foldMap (valueGraph . snd) fields))
         _ ... m = pure (Just m)
diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index 0140f21ad..f46746946 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -94,7 +94,8 @@ runFile eval file = traverse run file
             . convergeTerm (Proxy @name) (fix (cacheTerm . eval scopeGraphAnalysis))
 
 scopeGraphAnalysis
-  :: ( Alternative m
+  :: forall term name m sig
+  .  ( Alternative m
      , Carrier sig m
      , Member (Reader Path.AbsRelFile) sig
      , Member (Env name name) sig
@@ -105,10 +106,7 @@ scopeGraphAnalysis
      )
   => Analysis term name name (ScopeGraph name) m
 scopeGraphAnalysis = Analysis{..}
-  where alloc = A.alloc
-        bind = A.bind
-        lookupEnv = A.lookupEnv
-        deref addr = do
+  where deref addr = do
           ref <- askRef
           bindRef <- asks (Map.lookup addr)
           cell <- gets (Map.lookup addr >=> nonEmpty . Set.toList)
@@ -119,9 +117,9 @@ scopeGraphAnalysis = Analysis{..}
           bindRef <- asks (Map.lookup addr)
           modify (Map.insertWith (<>) addr (Set.singleton (extendBinding addr ref bindRef <> v)))
         abstract eval name body = do
-          addr <- alloc name
+          addr <- A.alloc @name @name name
           assign name mempty
-          bind name addr (eval body)
+          A.bind name addr (eval body)
         apply _ f a = pure (f <> a)
         unit = pure mempty
         bool _ = pure mempty
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index cfd67d755..84b849844 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -152,7 +152,8 @@ runFile eval file = traverse run file
           . convergeTerm (Proxy @name) (fix (cacheTerm . eval typecheckingAnalysis))
 
 typecheckingAnalysis
-  :: ( Alternative m
+  :: forall term name m sig
+  .  ( Alternative m
      , Carrier sig m
      , Member (Env name name) sig
      , Member Fresh sig
@@ -162,14 +163,11 @@ typecheckingAnalysis
      )
   => Analysis term name name (Type name) m
 typecheckingAnalysis = Analysis{..}
-  where alloc = A.alloc
-        bind = A.bind
-        lookupEnv = A.lookupEnv
-        deref addr = gets (Map.lookup addr >=> nonEmpty . Set.toList) >>= maybe (pure Nothing) (foldMapA (pure . Just))
+  where deref addr = gets (Map.lookup addr >=> nonEmpty . Set.toList) >>= maybe (pure Nothing) (foldMapA (pure . Just))
         assign addr ty = modify (Map.insertWith (<>) addr (Set.singleton ty))
         abstract eval name body = do
           -- FIXME: construct the associated scope
-          addr <- alloc name
+          addr <- A.alloc @name @name name
           arg <- meta
           assign addr arg
           ty <- eval body
@@ -187,7 +185,7 @@ typecheckingAnalysis = Analysis{..}
         asString s = unify (Alg String) s $> mempty
         record fields = do
           fields' <- for fields $ \ (k, v) -> do
-            addr <- alloc k
+            addr <- A.alloc @name @name k
             (k, v) <$ assign addr v
           -- FIXME: should records reference types by address instead?
           pure (Alg (Record (Map.fromList fields')))

From 6359d96a7cd2f8b6a1e5d3ead870f53d27f514b7 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 12:13:44 -0500
Subject: [PATCH 039/318] Stub in a module for the Heap effect.

---
 semantic-analysis/semantic-analysis.cabal     | 1 +
 semantic-analysis/src/Analysis/Effect/Heap.hs | 2 ++
 2 files changed, 3 insertions(+)
 create mode 100644 semantic-analysis/src/Analysis/Effect/Heap.hs

diff --git a/semantic-analysis/semantic-analysis.cabal b/semantic-analysis/semantic-analysis.cabal
index b7815f01e..da92d5f9b 100644
--- a/semantic-analysis/semantic-analysis.cabal
+++ b/semantic-analysis/semantic-analysis.cabal
@@ -45,6 +45,7 @@ library
     Analysis.Carrier.Env.Precise
     Analysis.Concrete
     Analysis.Effect.Env
+    Analysis.Effect.Heap
     Analysis.File
     Analysis.FlowInsensitive
     Analysis.ImportGraph
diff --git a/semantic-analysis/src/Analysis/Effect/Heap.hs b/semantic-analysis/src/Analysis/Effect/Heap.hs
new file mode 100644
index 000000000..8b984e9d5
--- /dev/null
+++ b/semantic-analysis/src/Analysis/Effect/Heap.hs
@@ -0,0 +1,2 @@
+module Analysis.Effect.Heap
+() where

From d23f34b8c47e3fe114dac5a0351a598616e785d8 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 12:14:38 -0500
Subject: [PATCH 040/318] Move the Heap effect to its own module.

---
 semantic-analysis/src/Analysis/Analysis.hs    |  9 ---------
 semantic-analysis/src/Analysis/Effect/Heap.hs | 15 ++++++++++++++-
 2 files changed, 14 insertions(+), 10 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 97d30879e..1110b20dd 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -25,15 +25,6 @@ data Analysis term name address value m = Analysis
   }
 
 
-data Heap addr value m k
-  = Deref addr (Maybe value -> m k)
-  | Assign addr value (m k)
-  deriving (Functor, Generic1)
-
-instance HFunctor (Heap addr value)
-instance Effect   (Heap addr value)
-
-
 data Domain term name value m k
   -- Functions construction & elimination
   = Abstract name (term name)                 (value term name -> m k)
diff --git a/semantic-analysis/src/Analysis/Effect/Heap.hs b/semantic-analysis/src/Analysis/Effect/Heap.hs
index 8b984e9d5..8f7e9269b 100644
--- a/semantic-analysis/src/Analysis/Effect/Heap.hs
+++ b/semantic-analysis/src/Analysis/Effect/Heap.hs
@@ -1,2 +1,15 @@
+{-# LANGUAGE DeriveFunctor, DeriveGeneric #-}
 module Analysis.Effect.Heap
-() where
+( Heap(..)
+) where
+
+import Control.Effect.Carrier
+import GHC.Generics (Generic1)
+
+data Heap addr value m k
+  = Deref addr (Maybe value -> m k)
+  | Assign addr value (m k)
+  deriving (Functor, Generic1)
+
+instance HFunctor (Heap addr value)
+instance Effect   (Heap addr value)

From b1c2f261e9184fa48f145aa0680ba17b9976d67b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 12:16:00 -0500
Subject: [PATCH 041/318] Define a smart constructor for Deref.

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

diff --git a/semantic-analysis/src/Analysis/Effect/Heap.hs b/semantic-analysis/src/Analysis/Effect/Heap.hs
index 8f7e9269b..dc183c14a 100644
--- a/semantic-analysis/src/Analysis/Effect/Heap.hs
+++ b/semantic-analysis/src/Analysis/Effect/Heap.hs
@@ -1,11 +1,16 @@
-{-# LANGUAGE DeriveFunctor, DeriveGeneric #-}
+{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts #-}
 module Analysis.Effect.Heap
-( Heap(..)
+( deref
+, Heap(..)
 ) where
 
 import Control.Effect.Carrier
 import GHC.Generics (Generic1)
 
+deref :: (Member (Heap addr value) sig, Carrier sig m) => addr -> m (Maybe value)
+deref addr = send (Deref addr pure)
+
+
 data Heap addr value m k
   = Deref addr (Maybe value -> m k)
   | Assign addr value (m k)

From ab5b566bcb15ead26b800c248bb66556c90f99aa Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 12:16:28 -0500
Subject: [PATCH 042/318] Define a smart constructor for Assign.

---
 semantic-analysis/src/Analysis/Effect/Heap.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/semantic-analysis/src/Analysis/Effect/Heap.hs b/semantic-analysis/src/Analysis/Effect/Heap.hs
index dc183c14a..cbb7df7e6 100644
--- a/semantic-analysis/src/Analysis/Effect/Heap.hs
+++ b/semantic-analysis/src/Analysis/Effect/Heap.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts #-}
 module Analysis.Effect.Heap
 ( deref
+, assign
 , Heap(..)
 ) where
 
@@ -10,6 +11,9 @@ import GHC.Generics (Generic1)
 deref :: (Member (Heap addr value) sig, Carrier sig m) => addr -> m (Maybe value)
 deref addr = send (Deref addr pure)
 
+assign :: (Member (Heap addr value) sig, Carrier sig m) => addr -> value -> m ()
+assign addr value = send (Assign addr value (pure ()))
+
 
 data Heap addr value m k
   = Deref addr (Maybe value -> m k)

From 250237024e8f55032f5ac351ac4b862117f8de67 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 12:27:24 -0500
Subject: [PATCH 043/318] Section headings.

---
 semantic-analysis/src/Analysis/Effect/Env.hs  | 3 ++-
 semantic-analysis/src/Analysis/Effect/Heap.hs | 3 ++-
 2 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Effect/Env.hs b/semantic-analysis/src/Analysis/Effect/Env.hs
index f3fe945dc..9e1353579 100644
--- a/semantic-analysis/src/Analysis/Effect/Env.hs
+++ b/semantic-analysis/src/Analysis/Effect/Env.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveFunctor, ExistentialQuantification, FlexibleContexts, LambdaCase, StandaloneDeriving #-}
 module Analysis.Effect.Env
-( alloc
+( -- * Env effect
+  alloc
 , bind
 , lookupEnv
 , Env(..)
diff --git a/semantic-analysis/src/Analysis/Effect/Heap.hs b/semantic-analysis/src/Analysis/Effect/Heap.hs
index cbb7df7e6..4e96aa702 100644
--- a/semantic-analysis/src/Analysis/Effect/Heap.hs
+++ b/semantic-analysis/src/Analysis/Effect/Heap.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts #-}
 module Analysis.Effect.Heap
-( deref
+( -- * Heap effect
+  deref
 , assign
 , Heap(..)
 ) where

From e99299811d1dbfe432c7bf1fabc20b38cab6ce0e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 12:28:33 -0500
Subject: [PATCH 044/318] Re-export Carrier & run from the effect modules.

---
 semantic-analysis/src/Analysis/Effect/Env.hs  | 3 +++
 semantic-analysis/src/Analysis/Effect/Heap.hs | 3 +++
 2 files changed, 6 insertions(+)

diff --git a/semantic-analysis/src/Analysis/Effect/Env.hs b/semantic-analysis/src/Analysis/Effect/Env.hs
index 9e1353579..74e7c3b94 100644
--- a/semantic-analysis/src/Analysis/Effect/Env.hs
+++ b/semantic-analysis/src/Analysis/Effect/Env.hs
@@ -5,6 +5,9 @@ module Analysis.Effect.Env
 , bind
 , lookupEnv
 , Env(..)
+  -- * Re-exports
+, Carrier
+, run
 ) where
 
 import Control.Effect.Carrier
diff --git a/semantic-analysis/src/Analysis/Effect/Heap.hs b/semantic-analysis/src/Analysis/Effect/Heap.hs
index 4e96aa702..ec18f3955 100644
--- a/semantic-analysis/src/Analysis/Effect/Heap.hs
+++ b/semantic-analysis/src/Analysis/Effect/Heap.hs
@@ -4,6 +4,9 @@ module Analysis.Effect.Heap
   deref
 , assign
 , Heap(..)
+  -- * Re-exports
+, Carrier
+, run
 ) where
 
 import Control.Effect.Carrier

From 05de03e2e60dad6e64536759d67a49abb15f34e5 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 12:29:21 -0500
Subject: [PATCH 045/318] Stub in a module for a precise heap carrier.

---
 semantic-analysis/semantic-analysis.cabal              | 1 +
 semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs | 2 ++
 2 files changed, 3 insertions(+)
 create mode 100644 semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs

diff --git a/semantic-analysis/semantic-analysis.cabal b/semantic-analysis/semantic-analysis.cabal
index da92d5f9b..4085d5665 100644
--- a/semantic-analysis/semantic-analysis.cabal
+++ b/semantic-analysis/semantic-analysis.cabal
@@ -43,6 +43,7 @@ library
     Analysis.Analysis
     Analysis.Carrier.Env.Monovariant
     Analysis.Carrier.Env.Precise
+    Analysis.Carrier.Heap.Precise
     Analysis.Concrete
     Analysis.Effect.Env
     Analysis.Effect.Heap
diff --git a/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs b/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs
new file mode 100644
index 000000000..28354b257
--- /dev/null
+++ b/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs
@@ -0,0 +1,2 @@
+module Analysis.Carrier.Heap.Precise
+() where

From b2a329c68466532fa1b454c3de87f9b6a4c9e483 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 12:29:54 -0500
Subject: [PATCH 046/318] Re-export the Heap effect.

---
 semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs b/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs
index 28354b257..9f66ce2f1 100644
--- a/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs
+++ b/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs
@@ -1,2 +1,6 @@
 module Analysis.Carrier.Heap.Precise
-() where
+( -- * Heap effect
+  module Analysis.Effect.Heap
+) where
+
+import Analysis.Effect.Heap

From 5b8364cd51a20e2e860b8f39de360e75b8d3d7e9 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 12:32:01 -0500
Subject: [PATCH 047/318] Stub in a Heap carrier.

---
 .../src/Analysis/Carrier/Heap/Precise.hs              | 11 +++++++++--
 1 file changed, 9 insertions(+), 2 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs b/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs
index 9f66ce2f1..e5dd80a18 100644
--- a/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs
+++ b/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs
@@ -1,6 +1,13 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Analysis.Carrier.Heap.Precise
-( -- * Heap effect
-  module Analysis.Effect.Heap
+( -- * Heap carrier
+  HeapC(..)
+  -- * Heap effect
+, module Analysis.Effect.Heap
 ) where
 
 import Analysis.Effect.Heap
+import qualified Control.Monad.Fail as Fail
+
+newtype HeapC addr value m a = HeapC { runHeap :: m a }
+  deriving (Applicative, Functor, Monad, Fail.MonadFail)

From c3327fa1e5712e6dfb1f760f82a83196f05a4cc2 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 12:34:38 -0500
Subject: [PATCH 048/318] HeapC wraps a state effect.

---
 semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs b/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs
index e5dd80a18..270dff8d9 100644
--- a/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs
+++ b/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs
@@ -1,13 +1,19 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Analysis.Carrier.Heap.Precise
 ( -- * Heap carrier
-  HeapC(..)
+  runHeap
+, HeapC(..)
   -- * Heap effect
 , module Analysis.Effect.Heap
 ) where
 
 import Analysis.Effect.Heap
+import Control.Effect.State.Strict
 import qualified Control.Monad.Fail as Fail
+import qualified Data.IntMap as IntMap
 
-newtype HeapC addr value m a = HeapC { runHeap :: m a }
+runHeap :: HeapC value m a -> m (IntMap.IntMap value, a)
+runHeap (HeapC m) = runState mempty m
+
+newtype HeapC value m a = HeapC (StateC (IntMap.IntMap value) m a)
   deriving (Applicative, Functor, Monad, Fail.MonadFail)

From 08e1061b90f0633d3bf13fbd082e718d606e1183 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 12:47:20 -0500
Subject: [PATCH 049/318] Define a Carrier instance for Heap.

---
 .../src/Analysis/Carrier/Heap/Precise.hs              | 11 ++++++++++-
 1 file changed, 10 insertions(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs b/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs
index 270dff8d9..1522baa8e 100644
--- a/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs
+++ b/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
 module Analysis.Carrier.Heap.Precise
 ( -- * Heap carrier
   runHeap
@@ -8,12 +8,21 @@ module Analysis.Carrier.Heap.Precise
 ) where
 
 import Analysis.Effect.Heap
+import Control.Effect.Carrier
 import Control.Effect.State.Strict
 import qualified Control.Monad.Fail as Fail
 import qualified Data.IntMap as IntMap
 
+type Precise = Int
+
 runHeap :: HeapC value m a -> m (IntMap.IntMap value, a)
 runHeap (HeapC m) = runState mempty m
 
 newtype HeapC value m a = HeapC (StateC (IntMap.IntMap value) m a)
   deriving (Applicative, Functor, Monad, Fail.MonadFail)
+
+instance (Carrier sig m, Effect sig)
+      => Carrier (Heap Precise value :+: sig) (HeapC value m) where
+  eff (L (Deref addr k))        = HeapC (gets (IntMap.lookup addr)) >>= k
+  eff (L (Assign addr value k)) = HeapC (modify (IntMap.insert addr value)) >> k
+  eff (R other)                 = HeapC (eff (R (handleCoercible other)))

From aaa4f6585f16b17179e756a0bf1da03edf36096b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 12:48:11 -0500
Subject: [PATCH 050/318] Stub in a module for a monovariant heap carrier.

---
 semantic-analysis/semantic-analysis.cabal                  | 1 +
 semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs | 2 ++
 2 files changed, 3 insertions(+)
 create mode 100644 semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs

diff --git a/semantic-analysis/semantic-analysis.cabal b/semantic-analysis/semantic-analysis.cabal
index 4085d5665..9468b047b 100644
--- a/semantic-analysis/semantic-analysis.cabal
+++ b/semantic-analysis/semantic-analysis.cabal
@@ -43,6 +43,7 @@ library
     Analysis.Analysis
     Analysis.Carrier.Env.Monovariant
     Analysis.Carrier.Env.Precise
+    Analysis.Carrier.Heap.Monovariant
     Analysis.Carrier.Heap.Precise
     Analysis.Concrete
     Analysis.Effect.Env
diff --git a/semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs b/semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs
new file mode 100644
index 000000000..36d20f360
--- /dev/null
+++ b/semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs
@@ -0,0 +1,2 @@
+module Analysis.Carrier.Heap.Monovariant
+() where

From 1b8dafcf339ed155b71f4b0bbac21d73374e8abf Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 12:48:55 -0500
Subject: [PATCH 051/318] Re-export the heap effect.

---
 semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs b/semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs
index 36d20f360..d98a998e1 100644
--- a/semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs
+++ b/semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs
@@ -1,2 +1,6 @@
 module Analysis.Carrier.Heap.Monovariant
-() where
+( -- * Heap effect
+  module Analysis.Effect.Heap
+) where
+
+import Analysis.Effect.Heap

From a17a6825d32faf7e927e44d1f1560adc5f0e2742 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 12:52:03 -0500
Subject: [PATCH 052/318] Define a monovariant Heap carrier.

---
 .../src/Analysis/Carrier/Heap/Monovariant.hs   | 18 ++++++++++++++++--
 1 file changed, 16 insertions(+), 2 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs b/semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs
index d98a998e1..4536150f3 100644
--- a/semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs
+++ b/semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs
@@ -1,6 +1,20 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Analysis.Carrier.Heap.Monovariant
-( -- * Heap effect
-  module Analysis.Effect.Heap
+( -- * Heap carrier
+  runHeap
+, HeapC(..)
+  -- * Heap effect
+, module Analysis.Effect.Heap
 ) where
 
 import Analysis.Effect.Heap
+import Control.Effect.State.Strict
+import qualified Control.Monad.Fail as Fail
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+
+runHeap :: HeapC addr value m a -> m (Map.Map addr (Set.Set value), a)
+runHeap (HeapC m) = runState Map.empty m
+
+newtype HeapC addr value m a = HeapC (StateC (Map.Map addr (Set.Set value)) m a)
+  deriving (Applicative, Functor, Monad, Fail.MonadFail)

From 8f50312be3fe9682621f74f3ef95c4e9ab069591 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 13:15:49 -0500
Subject: [PATCH 053/318] Define a Carrier instance for HeapC.

---
 .../src/Analysis/Carrier/Heap/Monovariant.hs  | 26 ++++++++++++++-----
 1 file changed, 19 insertions(+), 7 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs b/semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs
index 4536150f3..701b14d2b 100644
--- a/semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs
+++ b/semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs
@@ -1,20 +1,32 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
 module Analysis.Carrier.Heap.Monovariant
 ( -- * Heap carrier
-  runHeap
-, HeapC(..)
+  HeapC(..)
   -- * Heap effect
 , module Analysis.Effect.Heap
 ) where
 
 import Analysis.Effect.Heap
+import Control.Applicative (Alternative)
+import Control.Effect.Carrier
 import Control.Effect.State.Strict
+import Control.Monad ((>=>))
 import qualified Control.Monad.Fail as Fail
+import Data.List.NonEmpty (nonEmpty)
 import qualified Data.Map as Map
+import Data.Monoid (Alt(..))
 import qualified Data.Set as Set
 
-runHeap :: HeapC addr value m a -> m (Map.Map addr (Set.Set value), a)
-runHeap (HeapC m) = runState Map.empty m
+newtype HeapC addr value m a = HeapC { runHeap :: m a }
+  deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail)
 
-newtype HeapC addr value m a = HeapC (StateC (Map.Map addr (Set.Set value)) m a)
-  deriving (Applicative, Functor, Monad, Fail.MonadFail)
+instance ( Alternative m
+         , Carrier sig m
+         , Member (State (Map.Map addr (Set.Set value))) sig
+         , Ord addr
+         , Ord value
+         )
+      => Carrier (Heap addr value :+: sig) (HeapC addr value m) where
+  eff (L (Deref  addr       k)) = gets (Map.lookup addr >=> nonEmpty . Set.toList) >>= maybe (pure Nothing) (getAlt . foldMap (Alt . pure . Just)) >>= k
+  eff (L (Assign addr value k)) = modify (Map.insertWith (<>) addr (Set.singleton value)) >> k
+  eff (R other)                 = HeapC (eff (handleCoercible other))

From 327208eb15cc52b981ff1c757413473b7aa5adda Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 13:35:07 -0500
Subject: [PATCH 054/318] Surface the precise heap through a State effect.

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

diff --git a/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs b/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs
index 1522baa8e..d54893392 100644
--- a/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs
+++ b/semantic-analysis/src/Analysis/Carrier/Heap/Precise.hs
@@ -22,7 +22,7 @@ newtype HeapC value m a = HeapC (StateC (IntMap.IntMap value) m a)
   deriving (Applicative, Functor, Monad, Fail.MonadFail)
 
 instance (Carrier sig m, Effect sig)
-      => Carrier (Heap Precise value :+: sig) (HeapC value m) where
+      => Carrier (Heap Precise value :+: State (IntMap.IntMap value) :+: sig) (HeapC value m) where
   eff (L (Deref addr k))        = HeapC (gets (IntMap.lookup addr)) >>= k
   eff (L (Assign addr value k)) = HeapC (modify (IntMap.insert addr value)) >> k
-  eff (R other)                 = HeapC (eff (R (handleCoercible other)))
+  eff (R other)                 = HeapC (eff (handleCoercible other))

From 932786179009623b318036ab520a341bc2f30f0b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 13:35:52 -0500
Subject: [PATCH 055/318] Use the precise heap carrier to implement the
 Concrete analysis.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 04fb03a6f..dedce3b3d 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -13,6 +13,7 @@ import qualified Algebra.Graph as G
 import qualified Algebra.Graph.Export.Dot as G
 import           Analysis.Analysis
 import qualified Analysis.Carrier.Env.Precise as A
+import qualified Analysis.Carrier.Heap.Precise as A
 import           Analysis.File
 import           Control.Applicative (Alternative (..))
 import           Control.Carrier.Fail.WithLoc
@@ -84,7 +85,7 @@ concrete
 concrete eval
   = run
   . runFresh
-  . runHeap
+  . A.runHeap
   . traverse (runFile eval)
 
 runFile
@@ -94,6 +95,7 @@ runFile
      , Foldable term
      , IsString name
      , Member Fresh sig
+     , Member (A.Heap Precise (Concrete term name)) sig
      , Member (State (Heap term name)) sig
      , Ord name
      , Show name
@@ -119,6 +121,7 @@ concreteAnalysis :: ( Carrier sig m
                     , Foldable term
                     , IsString name
                     , Member (A.Env name Precise) sig
+                    , Member (A.Heap Precise (Concrete term name)) sig
                     , Member (Reader (Env name)) sig
                     , Member (Reader Path.AbsRelFile) sig
                     , Member (Reader Span) sig
@@ -130,8 +133,8 @@ concreteAnalysis :: ( Carrier sig m
                     )
                  => Analysis term name Precise (Concrete term name) m
 concreteAnalysis = Analysis{..}
-  where deref = gets . IntMap.lookup
-        assign addr value = modify (IntMap.insert addr value)
+  where deref = A.deref
+        assign = A.assign
         abstract _ name body = do
           path <- ask
           span <- ask
@@ -179,10 +182,6 @@ lookupConcrete heap name = run . evalState IntSet.empty . runNonDet . inConcrete
         maybeA = maybe empty pure
 
 
-runHeap :: StateC (Heap term name) m a -> m (Heap term name, a)
-runHeap = runState mempty
-
-
 -- | 'heapGraph', 'heapValueGraph', and 'heapAddressGraph' allow us to conveniently export SVGs of the heap:
 --
 --   > λ let (heap, res) = concrete [ruby]

From 812769035880a0c99732ecc830fb073abeed8f29 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 13:36:03 -0500
Subject: [PATCH 056/318] Only import the effect.

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

diff --git a/semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs b/semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs
index 701b14d2b..e540b8db4 100644
--- a/semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs
+++ b/semantic-analysis/src/Analysis/Carrier/Heap/Monovariant.hs
@@ -9,7 +9,7 @@ module Analysis.Carrier.Heap.Monovariant
 import Analysis.Effect.Heap
 import Control.Applicative (Alternative)
 import Control.Effect.Carrier
-import Control.Effect.State.Strict
+import Control.Effect.State
 import Control.Monad ((>=>))
 import qualified Control.Monad.Fail as Fail
 import Data.List.NonEmpty (nonEmpty)

From ec53cd91d6a1ae0b69c03b5c9666c8c77e2dd75e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 13:38:12 -0500
Subject: [PATCH 057/318] :fire: some redundant qualifiers.

---
 semantic-analysis/src/Analysis/ImportGraph.hs | 6 +++---
 semantic-analysis/src/Analysis/ScopeGraph.hs  | 6 +++---
 semantic-analysis/src/Analysis/Typecheck.hs   | 6 +++---
 3 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index b30e43743..aa1a53223 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -6,7 +6,7 @@ module Analysis.ImportGraph
 ) where
 
 import           Analysis.Analysis
-import           Analysis.Carrier.Env.Monovariant as A
+import           Analysis.Carrier.Env.Monovariant
 import           Analysis.File
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative(..))
@@ -120,7 +120,7 @@ importGraphAnalysis = Analysis{..}
         apply eval (Value (Closure path span name body) _) a = local (const path) . local (const span) $ do
           addr <- alloc @name @name name
           assign addr a
-          A.bind name addr (eval body)
+          bind name addr (eval body)
         apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
         unit = pure mempty
         bool _ = pure mempty
@@ -130,7 +130,7 @@ importGraphAnalysis = Analysis{..}
         asString _ = pure mempty
         record fields = do
           for_ fields $ \ (k, v) -> do
-            addr <- A.alloc @name @name k
+            addr <- alloc @name @name k
             assign addr v
           pure (Value Abstract (foldMap (valueGraph . snd) fields))
         _ ... m = pure (Just m)
diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index f46746946..a2b5065d8 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -8,7 +8,7 @@ module Analysis.ScopeGraph
 ) where
 
 import           Analysis.Analysis
-import           Analysis.Carrier.Env.Monovariant as A
+import           Analysis.Carrier.Env.Monovariant
 import           Analysis.File
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative (..))
@@ -117,9 +117,9 @@ scopeGraphAnalysis = Analysis{..}
           bindRef <- asks (Map.lookup addr)
           modify (Map.insertWith (<>) addr (Set.singleton (extendBinding addr ref bindRef <> v)))
         abstract eval name body = do
-          addr <- A.alloc @name @name name
+          addr <- alloc @name @name name
           assign name mempty
-          A.bind name addr (eval body)
+          bind name addr (eval body)
         apply _ f a = pure (f <> a)
         unit = pure mempty
         bool _ = pure mempty
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 84b849844..c2f8be177 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -8,7 +8,7 @@ module Analysis.Typecheck
 ) where
 
 import           Analysis.Analysis
-import           Analysis.Carrier.Env.Monovariant as A
+import           Analysis.Carrier.Env.Monovariant
 import           Analysis.File
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative (..))
@@ -167,7 +167,7 @@ typecheckingAnalysis = Analysis{..}
         assign addr ty = modify (Map.insertWith (<>) addr (Set.singleton ty))
         abstract eval name body = do
           -- FIXME: construct the associated scope
-          addr <- A.alloc @name @name name
+          addr <- alloc @name @name name
           arg <- meta
           assign addr arg
           ty <- eval body
@@ -185,7 +185,7 @@ typecheckingAnalysis = Analysis{..}
         asString s = unify (Alg String) s $> mempty
         record fields = do
           fields' <- for fields $ \ (k, v) -> do
-            addr <- A.alloc @name @name k
+            addr <- alloc @name @name k
             (k, v) <$ assign addr v
           -- FIXME: should records reference types by address instead?
           pure (Alg (Record (Map.fromList fields')))

From 309b5fd1bb9dcdd4999dc7f1307a187b8ae1c3e7 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 13:46:57 -0500
Subject: [PATCH 058/318] Export runNonDetM.

---
 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 0240d6739..0fa703209 100644
--- a/semantic-analysis/src/Analysis/FlowInsensitive.hs
+++ b/semantic-analysis/src/Analysis/FlowInsensitive.hs
@@ -6,6 +6,7 @@ module Analysis.FlowInsensitive
 , cacheTerm
 , runHeap
 , foldMapA
+, runNonDetM
 ) where
 
 import           Control.Effect

From 6199c154362a67f5cc937047e7663fd4e588c99e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 13:47:59 -0500
Subject: [PATCH 059/318] Run flow-insensitive analyses in an Alternative
 context.

---
 .../src/Analysis/FlowInsensitive.hs           | 35 ++++++++++---------
 semantic-analysis/src/Analysis/ImportGraph.hs |  1 +
 semantic-analysis/src/Analysis/ScopeGraph.hs  |  1 +
 semantic-analysis/src/Analysis/Typecheck.hs   |  1 +
 4 files changed, 21 insertions(+), 17 deletions(-)

diff --git a/semantic-analysis/src/Analysis/FlowInsensitive.hs b/semantic-analysis/src/Analysis/FlowInsensitive.hs
index 0fa703209..2eec54714 100644
--- a/semantic-analysis/src/Analysis/FlowInsensitive.hs
+++ b/semantic-analysis/src/Analysis/FlowInsensitive.hs
@@ -28,45 +28,46 @@ newtype FrameId name = FrameId { unFrameId :: name }
   deriving (Eq, Ord, Show)
 
 
-convergeTerm :: forall m sig a term address proxy
-             .  ( Carrier sig m
+convergeTerm :: forall m sig value term address proxy
+             .  ( Alternative m
+                , Carrier sig m
                 , Effect sig
                 , Eq address
                 , Member Fresh sig
-                , Member (State (Heap address a)) sig
-                , Ord a
+                , Member (State (Heap address value)) sig
                 , Ord term
+                , Ord value
                 )
              => proxy address
-             -> (term -> NonDetC (ReaderC (Cache term a) (StateC (Cache term a) m)) a)
+             -> (term -> NonDetC (ReaderC (Cache term value) (StateC (Cache term value) m)) value)
              -> term
-             -> m (Set.Set a)
+             -> m value
 convergeTerm _ 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
+  (cache, _) <- converge (Cache Map.empty :: Cache term value, heap :: Heap address value) $ \ (prevCache, _) -> runState (Cache Map.empty) . runReader prevCache $ do
     _ <- resetFresh . runNonDetM Set.singleton $ eval body
     get
-  pure (fromMaybe mempty (Map.lookup body (unCache cache)))
+  maybe empty (foldMapA pure) (Map.lookup body (unCache cache))
 
-cacheTerm :: forall m sig a term
+cacheTerm :: forall m sig value term
           .  ( Alternative m
              , Carrier sig m
-             , Member (Reader (Cache term a)) sig
-             , Member (State  (Cache term a)) sig
-             , Ord a
+             , Member (Reader (Cache term value)) sig
+             , Member (State  (Cache term value)) sig
+             , Ord value
              , Ord term
              )
-          => (term -> m a)
-          -> (term -> m a)
+          => (term -> m value)
+          -> (term -> m value)
 cacheTerm eval term = do
   cached <- gets (Map.lookup term . unCache)
-  case cached :: Maybe (Set.Set a) of
+  case cached :: Maybe (Set.Set value) of
     Just results -> foldMapA pure results
     Nothing -> do
       results <- asks (fromMaybe mempty . Map.lookup term . unCache)
-      modify (Cache . Map.insert term (results :: Set.Set a) . unCache)
+      modify (Cache . Map.insert term (results :: Set.Set value) . unCache)
       result <- eval term
-      result <$ modify (Cache . Map.insertWith (<>) term (Set.singleton (result :: a)) . unCache)
+      result <$ modify (Cache . Map.insertWith (<>) term (Set.singleton (result :: value)) . unCache)
 
 runHeap :: StateC (Heap address a) m b -> m (Heap address a, b)
 runHeap m = runState Map.empty m
diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index aa1a53223..2c946e590 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -92,6 +92,7 @@ runFile eval file = traverse run file
             . runEnv @name
             . runFail
             . fmap fold
+            . runNonDetM Set.singleton
             . convergeTerm (Proxy @name) (fix (cacheTerm . eval importGraphAnalysis))
 
 -- FIXME: decompose into a product domain and two atomic domains
diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index a2b5065d8..b4156e624 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -91,6 +91,7 @@ runFile eval file = traverse run file
             . runReader (Map.empty @name @Ref)
             . runFail
             . fmap fold
+            . runNonDetM Set.singleton
             . convergeTerm (Proxy @name) (fix (cacheTerm . eval scopeGraphAnalysis))
 
 scopeGraphAnalysis
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index c2f8be177..bc68d84c3 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -149,6 +149,7 @@ runFile eval file = traverse run file
               v <- meta
               bs <- m
               v <$ for_ bs (unify v))
+          . runNonDetM Set.singleton
           . convergeTerm (Proxy @name) (fix (cacheTerm . eval typecheckingAnalysis))
 
 typecheckingAnalysis

From 29d6654f1a9de8d8af305fbf40ba96c4b0599a62 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 13:50:04 -0500
Subject: [PATCH 060/318] Use the Heap effect in Typecheck.

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

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index bc68d84c3..cd76d3b56 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -9,6 +9,7 @@ module Analysis.Typecheck
 
 import           Analysis.Analysis
 import           Analysis.Carrier.Env.Monovariant
+import qualified Analysis.Carrier.Heap.Monovariant as A
 import           Analysis.File
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative (..))
@@ -17,13 +18,12 @@ import           Control.Effect.Carrier
 import           Control.Effect.Fresh as Fresh
 import           Control.Effect.Reader hiding (Local)
 import           Control.Effect.State
-import           Control.Monad ((>=>), unless)
+import           Control.Monad (unless)
 import           Data.Foldable (for_)
 import           Data.Function (fix)
 import           Data.Functor (($>))
 import qualified Data.IntMap as IntMap
 import qualified Data.IntSet as IntSet
-import           Data.List.NonEmpty (nonEmpty)
 import qualified Data.Map as Map
 import           Data.Maybe (fromJust, fromMaybe)
 import           Data.Proxy
@@ -150,6 +150,7 @@ runFile eval file = traverse run file
               bs <- m
               v <$ for_ bs (unify v))
           . runNonDetM Set.singleton
+          . A.runHeap @name @(Type name)
           . convergeTerm (Proxy @name) (fix (cacheTerm . eval typecheckingAnalysis))
 
 typecheckingAnalysis
@@ -158,14 +159,14 @@ typecheckingAnalysis
      , Carrier sig m
      , Member (Env name name) sig
      , Member Fresh sig
+     , Member (A.Heap name (Type name)) sig
      , Member (State (Set.Set (Constraint name))) sig
-     , Member (State (Heap name (Type name))) sig
      , Ord name
      )
   => Analysis term name name (Type name) m
 typecheckingAnalysis = Analysis{..}
-  where deref addr = gets (Map.lookup addr >=> nonEmpty . Set.toList) >>= maybe (pure Nothing) (foldMapA (pure . Just))
-        assign addr ty = modify (Map.insertWith (<>) addr (Set.singleton ty))
+  where deref = A.deref
+        assign = A.assign
         abstract eval name body = do
           -- FIXME: construct the associated scope
           addr <- alloc @name @name name

From ca50eb2fdb7133c4c839cbf95472be9f38c12971 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 13:51:46 -0500
Subject: [PATCH 061/318] Run the Heap effect inside convergeTerm.

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

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index cd76d3b56..263c09a19 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -150,8 +150,7 @@ runFile eval file = traverse run file
               bs <- m
               v <$ for_ bs (unify v))
           . runNonDetM Set.singleton
-          . A.runHeap @name @(Type name)
-          . convergeTerm (Proxy @name) (fix (cacheTerm . eval typecheckingAnalysis))
+          . convergeTerm (Proxy @name) (A.runHeap @name @(Type name) . fix (cacheTerm . eval typecheckingAnalysis))
 
 typecheckingAnalysis
   :: forall term name m sig

From d5b180b4651c4a83f47d02350c5f8c1104a76dcd Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 13:52:28 -0500
Subject: [PATCH 062/318] Revert "Run flow-insensitive analyses in an
 Alternative context."

This reverts commit 6199c154362a67f5cc937047e7663fd4e588c99e.
---
 .../src/Analysis/FlowInsensitive.hs           | 35 +++++++++----------
 semantic-analysis/src/Analysis/ImportGraph.hs |  1 -
 semantic-analysis/src/Analysis/ScopeGraph.hs  |  1 -
 semantic-analysis/src/Analysis/Typecheck.hs   |  1 -
 4 files changed, 17 insertions(+), 21 deletions(-)

diff --git a/semantic-analysis/src/Analysis/FlowInsensitive.hs b/semantic-analysis/src/Analysis/FlowInsensitive.hs
index 2eec54714..0fa703209 100644
--- a/semantic-analysis/src/Analysis/FlowInsensitive.hs
+++ b/semantic-analysis/src/Analysis/FlowInsensitive.hs
@@ -28,46 +28,45 @@ newtype FrameId name = FrameId { unFrameId :: name }
   deriving (Eq, Ord, Show)
 
 
-convergeTerm :: forall m sig value term address proxy
-             .  ( Alternative m
-                , Carrier sig m
+convergeTerm :: forall m sig a term address proxy
+             .  ( Carrier sig m
                 , Effect sig
                 , Eq address
                 , Member Fresh sig
-                , Member (State (Heap address value)) sig
+                , Member (State (Heap address a)) sig
+                , Ord a
                 , Ord term
-                , Ord value
                 )
              => proxy address
-             -> (term -> NonDetC (ReaderC (Cache term value) (StateC (Cache term value) m)) value)
+             -> (term -> NonDetC (ReaderC (Cache term a) (StateC (Cache term a) m)) a)
              -> term
-             -> m value
+             -> m (Set.Set a)
 convergeTerm _ eval body = do
   heap <- get
-  (cache, _) <- converge (Cache Map.empty :: Cache term value, heap :: Heap address value) $ \ (prevCache, _) -> runState (Cache Map.empty) . runReader prevCache $ do
+  (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
     get
-  maybe empty (foldMapA pure) (Map.lookup body (unCache cache))
+  pure (fromMaybe mempty (Map.lookup body (unCache cache)))
 
-cacheTerm :: forall m sig value term
+cacheTerm :: forall m sig a term
           .  ( Alternative m
              , Carrier sig m
-             , Member (Reader (Cache term value)) sig
-             , Member (State  (Cache term value)) sig
-             , Ord value
+             , Member (Reader (Cache term a)) sig
+             , Member (State  (Cache term a)) sig
+             , Ord a
              , Ord term
              )
-          => (term -> m value)
-          -> (term -> m value)
+          => (term -> m a)
+          -> (term -> m a)
 cacheTerm eval term = do
   cached <- gets (Map.lookup term . unCache)
-  case cached :: Maybe (Set.Set value) of
+  case cached :: Maybe (Set.Set a) of
     Just results -> foldMapA pure results
     Nothing -> do
       results <- asks (fromMaybe mempty . Map.lookup term . unCache)
-      modify (Cache . Map.insert term (results :: Set.Set value) . unCache)
+      modify (Cache . Map.insert term (results :: Set.Set a) . unCache)
       result <- eval term
-      result <$ modify (Cache . Map.insertWith (<>) term (Set.singleton (result :: value)) . unCache)
+      result <$ modify (Cache . Map.insertWith (<>) term (Set.singleton (result :: a)) . unCache)
 
 runHeap :: StateC (Heap address a) m b -> m (Heap address a, b)
 runHeap m = runState Map.empty m
diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 2c946e590..aa1a53223 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -92,7 +92,6 @@ runFile eval file = traverse run file
             . runEnv @name
             . runFail
             . fmap fold
-            . runNonDetM Set.singleton
             . convergeTerm (Proxy @name) (fix (cacheTerm . eval importGraphAnalysis))
 
 -- FIXME: decompose into a product domain and two atomic domains
diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index b4156e624..a2b5065d8 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -91,7 +91,6 @@ runFile eval file = traverse run file
             . runReader (Map.empty @name @Ref)
             . runFail
             . fmap fold
-            . runNonDetM Set.singleton
             . convergeTerm (Proxy @name) (fix (cacheTerm . eval scopeGraphAnalysis))
 
 scopeGraphAnalysis
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 263c09a19..ae3c48684 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -149,7 +149,6 @@ runFile eval file = traverse run file
               v <- meta
               bs <- m
               v <$ for_ bs (unify v))
-          . runNonDetM Set.singleton
           . convergeTerm (Proxy @name) (A.runHeap @name @(Type name) . fix (cacheTerm . eval typecheckingAnalysis))
 
 typecheckingAnalysis

From 641b9899834486559790081b6d3ea3221736c6ed Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 13:52:42 -0500
Subject: [PATCH 063/318] Revert "Export runNonDetM."

This reverts commit 309b5fd1bb9dcdd4999dc7f1307a187b8ae1c3e7.
---
 semantic-analysis/src/Analysis/FlowInsensitive.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/FlowInsensitive.hs b/semantic-analysis/src/Analysis/FlowInsensitive.hs
index 0fa703209..0240d6739 100644
--- a/semantic-analysis/src/Analysis/FlowInsensitive.hs
+++ b/semantic-analysis/src/Analysis/FlowInsensitive.hs
@@ -6,7 +6,6 @@ module Analysis.FlowInsensitive
 , cacheTerm
 , runHeap
 , foldMapA
-, runNonDetM
 ) where
 
 import           Control.Effect

From 42b7e77e8486fb7de6addb0879005b660bc967c8 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 13:54:48 -0500
Subject: [PATCH 064/318] Use the Heap effect to define the import graph
 analysis.

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

diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index aa1a53223..f6c3d87dc 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -7,6 +7,7 @@ module Analysis.ImportGraph
 
 import           Analysis.Analysis
 import           Analysis.Carrier.Env.Monovariant
+import qualified Analysis.Carrier.Heap.Monovariant as A
 import           Analysis.File
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative(..))
@@ -14,11 +15,8 @@ import           Control.Carrier.Fail.WithLoc
 import           Control.Effect
 import           Control.Effect.Fresh
 import           Control.Effect.Reader
-import           Control.Effect.State
-import           Control.Monad ((>=>))
 import           Data.Foldable (fold, for_)
 import           Data.Function (fix)
-import           Data.List.NonEmpty (nonEmpty)
 import qualified Data.Map as Map
 import           Data.Proxy
 import qualified Data.Set as Set
@@ -92,7 +90,7 @@ runFile eval file = traverse run file
             . runEnv @name
             . runFail
             . fmap fold
-            . convergeTerm (Proxy @name) (fix (cacheTerm . eval importGraphAnalysis))
+            . convergeTerm (Proxy @name) (A.runHeap @name @(Value term name) . fix (cacheTerm . eval importGraphAnalysis))
 
 -- FIXME: decompose into a product domain and two atomic domains
 importGraphAnalysis
@@ -100,19 +98,17 @@ importGraphAnalysis
   .  ( Alternative m
      , Carrier sig m
      , Member (Env name name) sig
+     , Member (A.Heap name (Value term name)) sig
      , Member (Reader Path.AbsRelFile) sig
      , Member (Reader Span) sig
-     , Member (State (Heap name (Value term name))) sig
      , MonadFail m
-     , Ord  name
-     , Ord  (term name)
      , Show name
      , Show (term name)
      )
   => Analysis term name name (Value term name) m
 importGraphAnalysis = Analysis{..}
-  where deref addr = gets (Map.lookup addr >=> nonEmpty . Set.toList) >>= maybe (pure Nothing) (foldMapA (pure . Just))
-        assign addr v = modify (Map.insertWith (<>) addr (Set.singleton v))
+  where deref = A.deref
+        assign = A.assign
         abstract _ name body = do
           path <- ask
           span <- ask

From 3e987cc7e2af8c4b26d1d91ead9549e2c9b2bb7a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 13:56:06 -0500
Subject: [PATCH 065/318] Sort constraints.

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

diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index a2b5065d8..180c84a9d 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -97,8 +97,8 @@ scopeGraphAnalysis
   :: forall term name m sig
   .  ( Alternative m
      , Carrier sig m
-     , Member (Reader Path.AbsRelFile) sig
      , Member (Env name name) sig
+     , Member (Reader Path.AbsRelFile) sig
      , Member (Reader Span) sig
      , Member (Reader (Map.Map name Ref)) sig
      , Member (State (Heap name (ScopeGraph name))) sig

From 9303d7e7ca8493b37ae44b41a087a91673291fc2 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 13:57:16 -0500
Subject: [PATCH 066/318] Use the Heap effect to define the scope graph
 analysis.

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

diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index 180c84a9d..e9887e72b 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -9,6 +9,7 @@ module Analysis.ScopeGraph
 
 import           Analysis.Analysis
 import           Analysis.Carrier.Env.Monovariant
+import qualified Analysis.Carrier.Heap.Monovariant as A
 import           Analysis.File
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative (..))
@@ -17,10 +18,8 @@ import           Control.Effect.Carrier
 import           Control.Effect.Fresh
 import           Control.Effect.Reader
 import           Control.Effect.State
-import           Control.Monad ((>=>))
 import           Data.Foldable (fold)
 import           Data.Function (fix)
-import           Data.List.NonEmpty
 import qualified Data.Map as Map
 import           Data.Proxy
 import qualified Data.Set as Set
@@ -91,31 +90,22 @@ runFile eval file = traverse run file
             . runReader (Map.empty @name @Ref)
             . runFail
             . fmap fold
-            . convergeTerm (Proxy @name) (fix (cacheTerm . eval scopeGraphAnalysis))
+            . convergeTerm (Proxy @name) (A.runHeap @name @(ScopeGraph name) . fix (cacheTerm . eval scopeGraphAnalysis))
 
 scopeGraphAnalysis
   :: forall term name m sig
   .  ( Alternative m
      , Carrier sig m
      , Member (Env name name) sig
+     , Member (A.Heap name (ScopeGraph name)) sig
      , Member (Reader Path.AbsRelFile) sig
      , Member (Reader Span) sig
-     , Member (Reader (Map.Map name Ref)) sig
-     , Member (State (Heap name (ScopeGraph name))) sig
      , Ord name
      )
   => Analysis term name name (ScopeGraph name) m
 scopeGraphAnalysis = Analysis{..}
-  where deref addr = do
-          ref <- askRef
-          bindRef <- asks (Map.lookup addr)
-          cell <- gets (Map.lookup addr >=> nonEmpty . Set.toList)
-          let extending = mappend (extendBinding addr ref bindRef)
-          maybe (pure Nothing) (foldMapA (pure . Just . extending)) cell
-        assign addr v = do
-          ref <- askRef
-          bindRef <- asks (Map.lookup addr)
-          modify (Map.insertWith (<>) addr (Set.singleton (extendBinding addr ref bindRef <> v)))
+  where deref = A.deref
+        assign = A.assign
         abstract eval name body = do
           addr <- alloc @name @name name
           assign name mempty
@@ -135,7 +125,3 @@ scopeGraphAnalysis = Analysis{..}
             (k, v') <$ assign addr v'
           pure (foldMap snd fields')
         _ ... m = pure (Just m)
-
-        askRef = Ref <$> ask <*> ask
-
-        extendBinding addr ref bindRef = ScopeGraph (maybe Map.empty (\ (Ref path span) -> Map.singleton (Decl addr path span) (Set.singleton ref)) bindRef)

From 07568e55a5c4a025d80ec5705dfbbb7e8398ec9e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 14:00:05 -0500
Subject: [PATCH 067/318] Use the Heap effect to define eval.

---
 semantic-core/src/Core/Eval.hs | 19 +++++++++++--------
 1 file changed, 11 insertions(+), 8 deletions(-)

diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index 5b2c7fa10..20ab76426 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, LambdaCase, OverloadedStrings, RankNTypes, RecordWildCards, TypeOperators #-}
+{-# LANGUAGE FlexibleContexts, LambdaCase, OverloadedStrings, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeOperators #-}
 module Core.Eval
 ( eval
 , prog1
@@ -12,6 +12,7 @@ module Core.Eval
 
 import Analysis.Analysis
 import Analysis.Effect.Env as A
+import Analysis.Effect.Heap as A
 import Analysis.File
 import Control.Applicative (Alternative (..))
 import Control.Effect.Carrier
@@ -29,8 +30,10 @@ import Syntax.Scope
 import Syntax.Term
 import qualified System.Path as Path
 
-eval :: ( Carrier sig m
+eval :: forall address value m sig
+     .  ( Carrier sig m
         , Member (Env Name address) sig
+        , Member (Heap address value) sig
         , Member (Reader Span) sig
         , MonadFail m
         , Semigroup value
@@ -42,17 +45,17 @@ eval Analysis{..} eval = \case
   Var n -> lookupEnv' n >>= deref' n
   Alg (R c) -> case c of
     Rec (Named (Ignored n) b) -> do
-      addr <- A.alloc n
+      addr <- A.alloc @Name @address n
       v <- A.bind n addr (eval (instantiate1 (pure n) b))
-      v <$ assign addr v
+      v <$ A.assign addr v
     -- NB: Combining the results of the evaluations allows us to model effects in abstract domains. This in turn means that we can define an abstract domain modelling the types-and-effects of computations by means of a 'Semigroup' instance which takes the type of its second operand and the union of both operands’ effects.
     --
     -- It’s also worth noting that we use a semigroup instead of a semilattice because the lattice structure of our abstract domains is instead modelled by nondeterminism effects used by some of them.
     a :>> b -> (<>) <$> eval a <*> eval b
     Named (Ignored n) a :>>= b -> do
       a' <- eval a
-      addr <- A.alloc n
-      assign addr a'
+      addr <- A.alloc @Name @address n
+      A.assign addr a'
       A.bind n addr ((a' <>) <$> eval (instantiate1 (pure n) b))
     Lam (Named (Ignored n) b) -> abstract eval n (instantiate1 (pure n) b)
     f :$ a -> do
@@ -78,14 +81,14 @@ eval Analysis{..} eval = \case
     a := b -> do
       b' <- eval b
       addr <- ref a
-      b' <$ assign addr b'
+      b' <$ A.assign addr b'
   Alg (L (Ann span c)) -> local (const span) (eval c)
   where freeVariable s = fail ("free variable: " <> s)
         uninitialized s = fail ("uninitialized variable: " <> s)
         invalidRef s = fail ("invalid ref: " <> s)
 
         lookupEnv' n = A.lookupEnv n >>= maybe (freeVariable (show n)) pure
-        deref' n = deref >=> maybe (uninitialized (show n)) pure
+        deref' n = A.deref @address >=> maybe (uninitialized (show n)) pure
 
         ref = \case
           Var n -> lookupEnv' n

From a667c656a19fa9cac0a720f81f83304d92191524 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 14:03:31 -0500
Subject: [PATCH 068/318] Reformat the signature for concreteAnalysis.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index dedce3b3d..658e9217c 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -117,21 +117,22 @@ runFile eval file = traverse run file
             . A.runEnv @name
             . fix (eval concreteAnalysis)
 
-concreteAnalysis :: ( Carrier sig m
-                    , Foldable term
-                    , IsString name
-                    , Member (A.Env name Precise) sig
-                    , Member (A.Heap Precise (Concrete term name)) sig
-                    , Member (Reader (Env name)) sig
-                    , Member (Reader Path.AbsRelFile) sig
-                    , Member (Reader Span) sig
-                    , Member (State (Heap term name)) sig
-                    , MonadFail m
-                    , Ord name
-                    , Show name
-                    , Show (term name)
-                    )
-                 => Analysis term name Precise (Concrete term name) m
+concreteAnalysis
+  :: ( Carrier sig m
+     , Foldable term
+     , IsString name
+     , Member (A.Env name Precise) sig
+     , Member (A.Heap Precise (Concrete term name)) sig
+     , Member (Reader (Env name)) sig
+     , Member (Reader Path.AbsRelFile) sig
+     , Member (Reader Span) sig
+     , Member (State (Heap term name)) sig
+     , MonadFail m
+     , Ord name
+     , Show name
+     , Show (term name)
+     )
+  => Analysis term name Precise (Concrete term name) m
 concreteAnalysis = Analysis{..}
   where deref = A.deref
         assign = A.assign

From a55972ef88f9acf5bf6cae5cbff2e13a1d5ced7c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 14:04:03 -0500
Subject: [PATCH 069/318] Remove the heap fields from Analysis.

---
 semantic-analysis/src/Analysis/Analysis.hs    |  4 +---
 semantic-analysis/src/Analysis/Concrete.hs    | 13 ++++++-------
 semantic-analysis/src/Analysis/ImportGraph.hs |  8 +++-----
 semantic-analysis/src/Analysis/ScopeGraph.hs  |  8 +++-----
 semantic-analysis/src/Analysis/Typecheck.hs   |  8 +++-----
 5 files changed, 16 insertions(+), 25 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 1110b20dd..012bca8a7 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -11,9 +11,7 @@ import GHC.Generics (Generic1)
 --
 -- This is intended to be replaced with a selection of algebraic effects providing these interfaces and carriers providing reusable implementations.
 data Analysis term name address value m = Analysis
-  { deref     :: address -> m (Maybe value)
-  , assign    :: address -> value -> m ()
-  , abstract  :: (term name -> m value) -> name -> term name -> m value
+  { abstract  :: (term name -> m value) -> name -> term name -> m value
   , apply     :: (term name -> m value) -> value -> value -> m value
   , unit      :: m value
   , bool      :: Bool -> m value
diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 658e9217c..e7b010ac6 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -118,7 +118,8 @@ runFile eval file = traverse run file
             . fix (eval concreteAnalysis)
 
 concreteAnalysis
-  :: ( Carrier sig m
+  :: forall term name m sig
+  .  ( Carrier sig m
      , Foldable term
      , IsString name
      , Member (A.Env name Precise) sig
@@ -134,9 +135,7 @@ concreteAnalysis
      )
   => Analysis term name Precise (Concrete term name) m
 concreteAnalysis = Analysis{..}
-  where deref = A.deref
-        assign = A.assign
-        abstract _ name body = do
+  where abstract _ name body = do
           path <- ask
           span <- ask
           env <- asks (flip Map.restrictKeys (Set.delete name (foldMap Set.singleton body)))
@@ -144,7 +143,7 @@ concreteAnalysis = Analysis{..}
         apply eval (Closure path span name body env) a = do
           local (const path) . local (const span) $ do
             addr <- A.alloc name
-            assign addr a
+            A.assign addr a
             local (const (Map.insert name addr env)) (eval body)
         apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
         unit = pure Unit
@@ -157,11 +156,11 @@ concreteAnalysis = Analysis{..}
         record fields = do
           fields' <- for fields $ \ (name, value) -> do
             addr <- A.alloc name
-            assign addr value
+            A.assign addr value
             pure (name, addr)
           pure (Record (Map.fromList fields'))
         addr ... n = do
-          val <- deref addr
+          val <- A.deref @Precise @(Concrete term name) addr
           heap <- get
           pure (val >>= lookupConcrete heap n)
 
diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index f6c3d87dc..e7105ff28 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -107,15 +107,13 @@ importGraphAnalysis
      )
   => Analysis term name name (Value term name) m
 importGraphAnalysis = Analysis{..}
-  where deref = A.deref
-        assign = A.assign
-        abstract _ name body = do
+  where abstract _ name body = do
           path <- ask
           span <- ask
           pure (Value (Closure path span name body) mempty)
         apply eval (Value (Closure path span name body) _) a = local (const path) . local (const span) $ do
           addr <- alloc @name @name name
-          assign addr a
+          A.assign addr a
           bind name addr (eval body)
         apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
         unit = pure mempty
@@ -127,6 +125,6 @@ importGraphAnalysis = Analysis{..}
         record fields = do
           for_ fields $ \ (k, v) -> do
             addr <- alloc @name @name k
-            assign addr v
+            A.assign addr v
           pure (Value Abstract (foldMap (valueGraph . snd) fields))
         _ ... m = pure (Just m)
diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index e9887e72b..73bc829b9 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -104,11 +104,9 @@ scopeGraphAnalysis
      )
   => Analysis term name name (ScopeGraph name) m
 scopeGraphAnalysis = Analysis{..}
-  where deref = A.deref
-        assign = A.assign
-        abstract eval name body = do
+  where abstract eval name body = do
           addr <- alloc @name @name name
-          assign name mempty
+          A.assign @name @(ScopeGraph name) name mempty
           bind name addr (eval body)
         apply _ f a = pure (f <> a)
         unit = pure mempty
@@ -122,6 +120,6 @@ scopeGraphAnalysis = Analysis{..}
             path <- ask
             span <- ask
             let v' = ScopeGraph (Map.singleton (Decl k path span) mempty) <> v
-            (k, v') <$ assign addr v'
+            (k, v') <$ A.assign @name addr v'
           pure (foldMap snd fields')
         _ ... m = pure (Just m)
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index ae3c48684..233878bf4 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -163,13 +163,11 @@ typecheckingAnalysis
      )
   => Analysis term name name (Type name) m
 typecheckingAnalysis = Analysis{..}
-  where deref = A.deref
-        assign = A.assign
-        abstract eval name body = do
+  where abstract eval name body = do
           -- FIXME: construct the associated scope
           addr <- alloc @name @name name
           arg <- meta
-          assign addr arg
+          A.assign addr arg
           ty <- eval body
           pure (Alg (Arr arg ty))
         apply _ f a = do
@@ -186,7 +184,7 @@ typecheckingAnalysis = Analysis{..}
         record fields = do
           fields' <- for fields $ \ (k, v) -> do
             addr <- alloc @name @name k
-            (k, v) <$ assign addr v
+            (k, v) <$ A.assign addr v
           -- FIXME: should records reference types by address instead?
           pure (Alg (Record (Map.fromList fields')))
         _ ... m = pure (Just m)

From 1098d95cd8b4f4139618b3a2d6ffa8c140c8b649 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 14:20:56 -0500
Subject: [PATCH 070/318] Stub in a module for modelling the concrete domain.

---
 semantic-analysis/semantic-analysis.cabal | 1 +
 semantic-analysis/src/Analysis/Domain.hs  | 2 ++
 2 files changed, 3 insertions(+)
 create mode 100644 semantic-analysis/src/Analysis/Domain.hs

diff --git a/semantic-analysis/semantic-analysis.cabal b/semantic-analysis/semantic-analysis.cabal
index 9468b047b..4a6d89ecd 100644
--- a/semantic-analysis/semantic-analysis.cabal
+++ b/semantic-analysis/semantic-analysis.cabal
@@ -46,6 +46,7 @@ library
     Analysis.Carrier.Heap.Monovariant
     Analysis.Carrier.Heap.Precise
     Analysis.Concrete
+    Analysis.Domain
     Analysis.Effect.Env
     Analysis.Effect.Heap
     Analysis.File
diff --git a/semantic-analysis/src/Analysis/Domain.hs b/semantic-analysis/src/Analysis/Domain.hs
new file mode 100644
index 000000000..4cc72b765
--- /dev/null
+++ b/semantic-analysis/src/Analysis/Domain.hs
@@ -0,0 +1,2 @@
+module Analysis.Domain
+() where

From 664c7301db8fc9fa598931c9dba19576179eeb95 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 14:22:48 -0500
Subject: [PATCH 071/318] Stub in a Domain datatype modelling the basic kinds
 of values.

---
 semantic-analysis/src/Analysis/Domain.hs | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/Domain.hs b/semantic-analysis/src/Analysis/Domain.hs
index 4cc72b765..b26bc76d2 100644
--- a/semantic-analysis/src/Analysis/Domain.hs
+++ b/semantic-analysis/src/Analysis/Domain.hs
@@ -1,2 +1,10 @@
 module Analysis.Domain
-() where
+( Domain(..)
+) where
+
+import Data.Text (Text)
+
+data Domain
+  = Unit
+  | Bool Bool
+  | String Text

From d4190ddb17d5a9bcc4084fc5bc00593f97f166d7 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 14:24:05 -0500
Subject: [PATCH 072/318] Derive some instances for Domain.

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

diff --git a/semantic-analysis/src/Analysis/Domain.hs b/semantic-analysis/src/Analysis/Domain.hs
index b26bc76d2..3c5e24146 100644
--- a/semantic-analysis/src/Analysis/Domain.hs
+++ b/semantic-analysis/src/Analysis/Domain.hs
@@ -8,3 +8,4 @@ data Domain
   = Unit
   | Bool Bool
   | String Text
+  deriving (Eq, Ord, Show)

From e4caca6f19f4e2b52c9bec804cefb225fbaa5ffe Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 14:27:12 -0500
Subject: [PATCH 073/318] Add Record to Domain.

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

diff --git a/semantic-analysis/src/Analysis/Domain.hs b/semantic-analysis/src/Analysis/Domain.hs
index 3c5e24146..8250e0cbb 100644
--- a/semantic-analysis/src/Analysis/Domain.hs
+++ b/semantic-analysis/src/Analysis/Domain.hs
@@ -4,8 +4,9 @@ module Analysis.Domain
 
 import Data.Text (Text)
 
-data Domain
+data Domain name a
   = Unit
   | Bool Bool
   | String Text
+  | Record [(name, a)]
   deriving (Eq, Ord, Show)

From 3721ccbacee0de71cfb690d2b3e37c42fc623c5e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 14:30:17 -0500
Subject: [PATCH 074/318] Add Lam to Domain.

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

diff --git a/semantic-analysis/src/Analysis/Domain.hs b/semantic-analysis/src/Analysis/Domain.hs
index 8250e0cbb..765aa52ae 100644
--- a/semantic-analysis/src/Analysis/Domain.hs
+++ b/semantic-analysis/src/Analysis/Domain.hs
@@ -9,4 +9,5 @@ data Domain name a
   | Bool Bool
   | String Text
   | Record [(name, a)]
+  | Lam name a
   deriving (Eq, Ord, Show)

From a3e7d51cfee917426660ac97f7c1776fb8a48c2b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 14:30:45 -0500
Subject: [PATCH 075/318] Fix a typo.

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

diff --git a/semantic-core/src/Core/Core.hs b/semantic-core/src/Core/Core.hs
index 84b475da3..77d9d2e97 100644
--- a/semantic-core/src/Core/Core.hs
+++ b/semantic-core/src/Core/Core.hs
@@ -55,7 +55,7 @@ import Syntax.Term
 data Core f a
   -- | Recursive local binding of a name in a scope; strict evaluation of the name in the body will diverge.
   --
-  --   Simultaneous (and therefore potentially mutually-recursive) bidnings can be made by binding a 'Record' recursively within 'Rec' and projecting from it with ':.'.
+  --   Simultaneous (and therefore potentially mutually-recursive) bindings can be made by binding a 'Record' recursively within 'Rec' and projecting from it with ':.'.
   = Rec (Named (Scope () f a))
   -- | Sequencing without binding; analogous to '>>' or '*>'.
   | f a :>> f a

From 40d3e5ece6e5f35d5de628c632124353204c778d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 14:33:06 -0500
Subject: [PATCH 076/318] Rename Arr to :->.

---
 semantic-analysis/src/Analysis/Typecheck.hs | 20 +++++++++++---------
 1 file changed, 11 insertions(+), 9 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 233878bf4..986ab5366 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -44,10 +44,12 @@ data Monotype name f a
   = Bool
   | Unit
   | String
-  | Arr (f a) (f a)
+  | f a :-> f a
   | Record (Map.Map name (f a))
   deriving (Foldable, Functor, Generic1, Traversable)
 
+infixr 0 :->
+
 type Type name = Term (Monotype name) Meta
 
 -- FIXME: Union the effects/annotations on the operands.
@@ -62,11 +64,11 @@ deriving instance (Show name, Show a, forall a . Show a => Show (f a))
 
 instance HFunctor (Monotype name)
 instance RightModule (Monotype name) where
-  Unit     >>=* _ = Unit
-  Bool     >>=* _ = Bool
-  String   >>=* _ = String
-  Arr a b  >>=* f = Arr (a >>= f) (b >>= f)
-  Record m >>=* f = Record ((>>= f) <$> m)
+  Unit      >>=* _ = Unit
+  Bool      >>=* _ = Bool
+  String    >>=* _ = String
+  (a :-> b) >>=* f = a >>= f :-> b >>= f
+  Record m  >>=* f = Record ((>>= f) <$> m)
 
 type Meta = Int
 
@@ -169,11 +171,11 @@ typecheckingAnalysis = Analysis{..}
           arg <- meta
           A.assign addr arg
           ty <- eval body
-          pure (Alg (Arr arg ty))
+          pure (Alg (arg :-> ty))
         apply _ f a = do
           _A <- meta
           _B <- meta
-          unify (Alg (Arr _A _B)) f
+          unify (Alg (_A :-> _B)) f
           unify _A a
           pure _B
         unit = pure (Alg Unit)
@@ -216,7 +218,7 @@ solve cs = for_ cs solve
   where solve = \case
           -- FIXME: how do we enforce proper subtyping? row polymorphism or something?
           Alg (Record f1) :===: Alg (Record f2) -> traverse solve (Map.intersectionWith (:===:) f1 f2) $> ()
-          Alg (Arr a1 b1) :===: Alg (Arr a2 b2) -> solve (a1 :===: a2) *> solve (b1 :===: b2)
+          Alg (a1 :-> b1) :===: Alg (a2 :-> b2) -> solve (a1 :===: a2) *> solve (b1 :===: b2)
           Var m1   :===: Var m2   | m1 == m2 -> pure ()
           Var m1   :===: t2         -> do
             sol <- solution m1

From 24f6159acc39f098f3ea6f4cfc4a5a7ec2676ab3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 14:35:24 -0500
Subject: [PATCH 077/318] Domain is scope-safe.

---
 semantic-analysis/src/Analysis/Domain.hs | 14 ++++++++++----
 1 file changed, 10 insertions(+), 4 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Domain.hs b/semantic-analysis/src/Analysis/Domain.hs
index 765aa52ae..8eac171c9 100644
--- a/semantic-analysis/src/Analysis/Domain.hs
+++ b/semantic-analysis/src/Analysis/Domain.hs
@@ -1,13 +1,19 @@
+{-# LANGUAGE QuantifiedConstraints, StandaloneDeriving #-}
 module Analysis.Domain
 ( Domain(..)
 ) where
 
 import Data.Text (Text)
+import Syntax.Scope
 
-data Domain name a
+data Domain name f a
   = Unit
   | Bool Bool
   | String Text
-  | Record [(name, a)]
-  | Lam name a
-  deriving (Eq, Ord, Show)
+  | Record [(name, f a)]
+  | Lam name (Scope () f a)
+
+deriving instance (Eq   name, Eq   a, forall a . Eq   a => Eq   (f a), Monad f) => Eq   (Domain name f a)
+deriving instance (Ord  name, Ord  a, forall a . Eq   a => Eq   (f a)
+                                    , forall a . Ord  a => Ord  (f a), Monad f) => Ord  (Domain name f a)
+deriving instance (Show name, Show a, forall a . Show a => Show (f a))          => Show (Domain name f a)

From 7208186efa21476d543094c33f4bf04fe89e9954 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 14:40:18 -0500
Subject: [PATCH 078/318] Copy Name in from Core.Name.

---
 semantic-analysis/src/Analysis/Domain.hs | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/Domain.hs b/semantic-analysis/src/Analysis/Domain.hs
index 8eac171c9..0d124a697 100644
--- a/semantic-analysis/src/Analysis/Domain.hs
+++ b/semantic-analysis/src/Analysis/Domain.hs
@@ -1,8 +1,9 @@
-{-# LANGUAGE QuantifiedConstraints, StandaloneDeriving #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, QuantifiedConstraints, StandaloneDeriving #-}
 module Analysis.Domain
 ( Domain(..)
 ) where
 
+import Data.String (IsString)
 import Data.Text (Text)
 import Syntax.Scope
 
@@ -17,3 +18,8 @@ deriving instance (Eq   name, Eq   a, forall a . Eq   a => Eq   (f a), Monad f)
 deriving instance (Ord  name, Ord  a, forall a . Eq   a => Eq   (f a)
                                     , forall a . Ord  a => Ord  (f a), Monad f) => Ord  (Domain name f a)
 deriving instance (Show name, Show a, forall a . Show a => Show (f a))          => Show (Domain name f a)
+
+
+-- | User-specified and -relevant names.
+newtype Name = Name { unName :: Text }
+  deriving (Eq, IsString, Ord, Show)

From 99a84e5646c3b8c8d25641f4aef44b9439aac902 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 14:43:15 -0500
Subject: [PATCH 079/318] Specialize Domain to Name.

---
 semantic-analysis/src/Analysis/Domain.hs | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Domain.hs b/semantic-analysis/src/Analysis/Domain.hs
index 0d124a697..da2ae86ad 100644
--- a/semantic-analysis/src/Analysis/Domain.hs
+++ b/semantic-analysis/src/Analysis/Domain.hs
@@ -7,17 +7,17 @@ import Data.String (IsString)
 import Data.Text (Text)
 import Syntax.Scope
 
-data Domain name f a
+data Domain f a
   = Unit
   | Bool Bool
   | String Text
-  | Record [(name, f a)]
-  | Lam name (Scope () f a)
+  | Record [(Name, f a)]
+  | Lam Name (Scope () f a)
 
-deriving instance (Eq   name, Eq   a, forall a . Eq   a => Eq   (f a), Monad f) => Eq   (Domain name f a)
-deriving instance (Ord  name, Ord  a, forall a . Eq   a => Eq   (f a)
-                                    , forall a . Ord  a => Ord  (f a), Monad f) => Ord  (Domain name f a)
-deriving instance (Show name, Show a, forall a . Show a => Show (f a))          => Show (Domain name f a)
+deriving instance (Eq   a, forall a . Eq   a => Eq   (f a), Monad f) => Eq   (Domain f a)
+deriving instance (Ord  a, forall a . Eq   a => Eq   (f a)
+                         , forall a . Ord  a => Ord  (f a), Monad f) => Ord  (Domain f a)
+deriving instance (Show a, forall a . Show a => Show (f a))          => Show (Domain f a)
 
 
 -- | User-specified and -relevant names.

From 20555fcf84de109a22b627f20e20e3327fd485c1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 14:44:21 -0500
Subject: [PATCH 080/318] =?UTF-8?q?Lam=E2=80=99s=20name=20is=20in=20Maybe.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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

diff --git a/semantic-analysis/src/Analysis/Domain.hs b/semantic-analysis/src/Analysis/Domain.hs
index da2ae86ad..1fe09a7e0 100644
--- a/semantic-analysis/src/Analysis/Domain.hs
+++ b/semantic-analysis/src/Analysis/Domain.hs
@@ -12,7 +12,7 @@ data Domain f a
   | Bool Bool
   | String Text
   | Record [(Name, f a)]
-  | Lam Name (Scope () f a)
+  | Lam (Maybe Name) (Scope () f a)
 
 deriving instance (Eq   a, forall a . Eq   a => Eq   (f a), Monad f) => Eq   (Domain f a)
 deriving instance (Ord  a, forall a . Eq   a => Eq   (f a)

From 722e40571ce98cfb74105f33dd7ce60ed759d3db Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 14:46:14 -0500
Subject: [PATCH 081/318] Define a smart constructor for Unit.

---
 semantic-analysis/src/Analysis/Domain.hs | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Domain.hs b/semantic-analysis/src/Analysis/Domain.hs
index 1fe09a7e0..e3f3cc0c7 100644
--- a/semantic-analysis/src/Analysis/Domain.hs
+++ b/semantic-analysis/src/Analysis/Domain.hs
@@ -1,12 +1,18 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, QuantifiedConstraints, StandaloneDeriving #-}
+{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, QuantifiedConstraints, StandaloneDeriving #-}
 module Analysis.Domain
-( Domain(..)
+( unit
+, Domain(..)
 ) where
 
+import Control.Effect.Carrier
 import Data.String (IsString)
 import Data.Text (Text)
 import Syntax.Scope
 
+unit :: (Carrier sig m, Member Domain sig) => m a
+unit = send Unit
+
+
 data Domain f a
   = Unit
   | Bool Bool

From 6b6581dbbe2227de8e291abb82ca6dc2e0248139 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 14:46:41 -0500
Subject: [PATCH 082/318] Define a smart constructor for Bool.

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

diff --git a/semantic-analysis/src/Analysis/Domain.hs b/semantic-analysis/src/Analysis/Domain.hs
index e3f3cc0c7..43671069c 100644
--- a/semantic-analysis/src/Analysis/Domain.hs
+++ b/semantic-analysis/src/Analysis/Domain.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, QuantifiedConstraints, StandaloneDeriving #-}
 module Analysis.Domain
 ( unit
+, bool
 , Domain(..)
 ) where
 
@@ -12,6 +13,9 @@ import Syntax.Scope
 unit :: (Carrier sig m, Member Domain sig) => m a
 unit = send Unit
 
+bool :: (Carrier sig m, Member Domain sig) => Bool -> m a
+bool = send . Bool
+
 
 data Domain f a
   = Unit

From c9161d51d11c73ff89f694fde9302d830374a710 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 14:47:19 -0500
Subject: [PATCH 083/318] Define a smart constructor for String.

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

diff --git a/semantic-analysis/src/Analysis/Domain.hs b/semantic-analysis/src/Analysis/Domain.hs
index 43671069c..9d7e67f47 100644
--- a/semantic-analysis/src/Analysis/Domain.hs
+++ b/semantic-analysis/src/Analysis/Domain.hs
@@ -2,6 +2,7 @@
 module Analysis.Domain
 ( unit
 , bool
+, string
 , Domain(..)
 ) where
 
@@ -16,6 +17,9 @@ unit = send Unit
 bool :: (Carrier sig m, Member Domain sig) => Bool -> m a
 bool = send . Bool
 
+string :: (Carrier sig m, Member Domain sig) => Text -> m a
+string = send . String
+
 
 data Domain f a
   = Unit

From ca3bb15353d5c06ae75f5fbee361e9e4f6829109 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 14:47:43 -0500
Subject: [PATCH 084/318] Define a smart constructor for Record.

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

diff --git a/semantic-analysis/src/Analysis/Domain.hs b/semantic-analysis/src/Analysis/Domain.hs
index 9d7e67f47..5f1864df0 100644
--- a/semantic-analysis/src/Analysis/Domain.hs
+++ b/semantic-analysis/src/Analysis/Domain.hs
@@ -3,6 +3,7 @@ module Analysis.Domain
 ( unit
 , bool
 , string
+, record
 , Domain(..)
 ) where
 
@@ -20,6 +21,9 @@ bool = send . Bool
 string :: (Carrier sig m, Member Domain sig) => Text -> m a
 string = send . String
 
+record :: (Carrier sig m, Member Domain sig) => [(Name, m a)] -> m a
+record fs = send (Record fs)
+
 
 data Domain f a
   = Unit

From 9822b4eed77dfa81a4330dc1e658f5ea959fae58 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 14:48:59 -0500
Subject: [PATCH 085/318] Define a smart constructor for Lam.

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

diff --git a/semantic-analysis/src/Analysis/Domain.hs b/semantic-analysis/src/Analysis/Domain.hs
index 5f1864df0..c676050c3 100644
--- a/semantic-analysis/src/Analysis/Domain.hs
+++ b/semantic-analysis/src/Analysis/Domain.hs
@@ -4,6 +4,7 @@ module Analysis.Domain
 , bool
 , string
 , record
+, lam
 , Domain(..)
 ) where
 
@@ -24,6 +25,9 @@ string = send . String
 record :: (Carrier sig m, Member Domain sig) => [(Name, m a)] -> m a
 record fs = send (Record fs)
 
+lam :: (Eq a, Carrier sig m, Member Domain sig) => Maybe Name -> a -> m a -> m a
+lam u n b = send (Lam u (abstract1 n b))
+
 
 data Domain f a
   = Unit

From 2d362d9874f388583bdda3afc42affd14c725104 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 15:36:55 -0500
Subject: [PATCH 086/318] Define a smart constructor for multiple lambdas.

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

diff --git a/semantic-analysis/src/Analysis/Domain.hs b/semantic-analysis/src/Analysis/Domain.hs
index c676050c3..7938f2b71 100644
--- a/semantic-analysis/src/Analysis/Domain.hs
+++ b/semantic-analysis/src/Analysis/Domain.hs
@@ -5,6 +5,7 @@ module Analysis.Domain
 , string
 , record
 , lam
+, lams
 , Domain(..)
 ) where
 
@@ -28,6 +29,9 @@ record fs = send (Record fs)
 lam :: (Eq a, Carrier sig m, Member Domain sig) => Maybe Name -> a -> m a -> m a
 lam u n b = send (Lam u (abstract1 n b))
 
+lams :: (Eq a, Foldable t, Carrier sig m, Member Domain sig) => t (Maybe Name, a) -> m a -> m a
+lams names body = foldr (uncurry lam) body names
+
 
 data Domain f a
   = Unit

From 3bafe21a23c02201fd1c61aa78f205b02c4de375 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 15:38:27 -0500
Subject: [PATCH 087/318] Define an eliminator for Lam.

---
 semantic-analysis/src/Analysis/Domain.hs | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/semantic-analysis/src/Analysis/Domain.hs b/semantic-analysis/src/Analysis/Domain.hs
index 7938f2b71..fad165e27 100644
--- a/semantic-analysis/src/Analysis/Domain.hs
+++ b/semantic-analysis/src/Analysis/Domain.hs
@@ -6,13 +6,17 @@ module Analysis.Domain
 , record
 , lam
 , lams
+, unlam
 , Domain(..)
 ) where
 
+import Control.Applicative (Alternative(..))
 import Control.Effect.Carrier
 import Data.String (IsString)
 import Data.Text (Text)
+import Syntax.Module
 import Syntax.Scope
+import Syntax.Term
 
 unit :: (Carrier sig m, Member Domain sig) => m a
 unit = send Unit
@@ -32,6 +36,10 @@ lam u n b = send (Lam u (abstract1 n b))
 lams :: (Eq a, Foldable t, Carrier sig m, Member Domain sig) => t (Maybe Name, a) -> m a -> m a
 lams names body = foldr (uncurry lam) body names
 
+unlam :: (Alternative m, Member Domain sig, RightModule sig) => a -> Term sig a -> m (Maybe Name, a, Term sig a)
+unlam n (Alg sig) | Just (Lam n' b) <- prj sig = pure (n', n, instantiate1 (pure n) b)
+unlam _ _                                      = empty
+
 
 data Domain f a
   = Unit

From e5bfa87d8676039938662547674a4d20ced2e3f9 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 15:52:40 -0500
Subject: [PATCH 088/318] Derive Foldable, Functor, & Traversable instances for
 Domain.

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

diff --git a/semantic-analysis/src/Analysis/Domain.hs b/semantic-analysis/src/Analysis/Domain.hs
index fad165e27..2ae1912bf 100644
--- a/semantic-analysis/src/Analysis/Domain.hs
+++ b/semantic-analysis/src/Analysis/Domain.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, QuantifiedConstraints, StandaloneDeriving #-}
+{-# LANGUAGE DeriveTraversable, FlexibleContexts, GeneralizedNewtypeDeriving, QuantifiedConstraints, StandaloneDeriving #-}
 module Analysis.Domain
 ( unit
 , bool
@@ -47,6 +47,7 @@ data Domain f a
   | String Text
   | Record [(Name, f a)]
   | Lam (Maybe Name) (Scope () f a)
+  deriving (Foldable, Functor, Traversable)
 
 deriving instance (Eq   a, forall a . Eq   a => Eq   (f a), Monad f) => Eq   (Domain f a)
 deriving instance (Ord  a, forall a . Eq   a => Eq   (f a)

From 4b0af27dde93746658647af848106292c0c2aa69 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 15:53:54 -0500
Subject: [PATCH 089/318] Rename Domain to Intro.

---
 semantic-analysis/semantic-analysis.cabal     |  2 +-
 .../src/Analysis/{Domain.hs => Intro.hs}      | 26 +++++++++----------
 2 files changed, 14 insertions(+), 14 deletions(-)
 rename semantic-analysis/src/Analysis/{Domain.hs => Intro.hs} (64%)

diff --git a/semantic-analysis/semantic-analysis.cabal b/semantic-analysis/semantic-analysis.cabal
index 4a6d89ecd..145619bba 100644
--- a/semantic-analysis/semantic-analysis.cabal
+++ b/semantic-analysis/semantic-analysis.cabal
@@ -46,12 +46,12 @@ library
     Analysis.Carrier.Heap.Monovariant
     Analysis.Carrier.Heap.Precise
     Analysis.Concrete
-    Analysis.Domain
     Analysis.Effect.Env
     Analysis.Effect.Heap
     Analysis.File
     Analysis.FlowInsensitive
     Analysis.ImportGraph
+    Analysis.Intro
     Analysis.ScopeGraph
     Analysis.Typecheck
     Control.Carrier.Fail.WithLoc
diff --git a/semantic-analysis/src/Analysis/Domain.hs b/semantic-analysis/src/Analysis/Intro.hs
similarity index 64%
rename from semantic-analysis/src/Analysis/Domain.hs
rename to semantic-analysis/src/Analysis/Intro.hs
index 2ae1912bf..07d424078 100644
--- a/semantic-analysis/src/Analysis/Domain.hs
+++ b/semantic-analysis/src/Analysis/Intro.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE DeriveTraversable, FlexibleContexts, GeneralizedNewtypeDeriving, QuantifiedConstraints, StandaloneDeriving #-}
-module Analysis.Domain
+module Analysis.Intro
 ( unit
 , bool
 , string
@@ -7,7 +7,7 @@ module Analysis.Domain
 , lam
 , lams
 , unlam
-, Domain(..)
+, Intro(..)
 ) where
 
 import Control.Applicative (Alternative(..))
@@ -18,30 +18,30 @@ import Syntax.Module
 import Syntax.Scope
 import Syntax.Term
 
-unit :: (Carrier sig m, Member Domain sig) => m a
+unit :: (Carrier sig m, Member Intro sig) => m a
 unit = send Unit
 
-bool :: (Carrier sig m, Member Domain sig) => Bool -> m a
+bool :: (Carrier sig m, Member Intro sig) => Bool -> m a
 bool = send . Bool
 
-string :: (Carrier sig m, Member Domain sig) => Text -> m a
+string :: (Carrier sig m, Member Intro sig) => Text -> m a
 string = send . String
 
-record :: (Carrier sig m, Member Domain sig) => [(Name, m a)] -> m a
+record :: (Carrier sig m, Member Intro sig) => [(Name, m a)] -> m a
 record fs = send (Record fs)
 
-lam :: (Eq a, Carrier sig m, Member Domain sig) => Maybe Name -> a -> m a -> m a
+lam :: (Eq a, Carrier sig m, Member Intro sig) => Maybe Name -> a -> m a -> m a
 lam u n b = send (Lam u (abstract1 n b))
 
-lams :: (Eq a, Foldable t, Carrier sig m, Member Domain sig) => t (Maybe Name, a) -> m a -> m a
+lams :: (Eq a, Foldable t, Carrier sig m, Member Intro sig) => t (Maybe Name, a) -> m a -> m a
 lams names body = foldr (uncurry lam) body names
 
-unlam :: (Alternative m, Member Domain sig, RightModule sig) => a -> Term sig a -> m (Maybe Name, a, Term sig a)
+unlam :: (Alternative m, Member Intro sig, RightModule sig) => a -> Term sig a -> m (Maybe Name, a, Term sig a)
 unlam n (Alg sig) | Just (Lam n' b) <- prj sig = pure (n', n, instantiate1 (pure n) b)
 unlam _ _                                      = empty
 
 
-data Domain f a
+data Intro f a
   = Unit
   | Bool Bool
   | String Text
@@ -49,10 +49,10 @@ data Domain f a
   | Lam (Maybe Name) (Scope () f a)
   deriving (Foldable, Functor, Traversable)
 
-deriving instance (Eq   a, forall a . Eq   a => Eq   (f a), Monad f) => Eq   (Domain f a)
+deriving instance (Eq   a, forall a . Eq   a => Eq   (f a), Monad f) => Eq   (Intro f a)
 deriving instance (Ord  a, forall a . Eq   a => Eq   (f a)
-                         , forall a . Ord  a => Ord  (f a), Monad f) => Ord  (Domain f a)
-deriving instance (Show a, forall a . Show a => Show (f a))          => Show (Domain f a)
+                         , forall a . Ord  a => Ord  (f a), Monad f) => Ord  (Intro f a)
+deriving instance (Show a, forall a . Show a => Show (f a))          => Show (Intro f a)
 
 
 -- | User-specified and -relevant names.

From a5e1d5e0cb98303e993281038fa690a7e3ff91de Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 16:02:12 -0500
Subject: [PATCH 090/318] Derive a Generic1 instance for Intro.

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

diff --git a/semantic-analysis/src/Analysis/Intro.hs b/semantic-analysis/src/Analysis/Intro.hs
index 07d424078..ac429e725 100644
--- a/semantic-analysis/src/Analysis/Intro.hs
+++ b/semantic-analysis/src/Analysis/Intro.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveTraversable, FlexibleContexts, GeneralizedNewtypeDeriving, QuantifiedConstraints, StandaloneDeriving #-}
+{-# LANGUAGE DeriveGeneric, DeriveTraversable, FlexibleContexts, GeneralizedNewtypeDeriving, QuantifiedConstraints, StandaloneDeriving #-}
 module Analysis.Intro
 ( unit
 , bool
@@ -14,6 +14,7 @@ import Control.Applicative (Alternative(..))
 import Control.Effect.Carrier
 import Data.String (IsString)
 import Data.Text (Text)
+import GHC.Generics (Generic1)
 import Syntax.Module
 import Syntax.Scope
 import Syntax.Term
@@ -47,7 +48,7 @@ data Intro f a
   | String Text
   | Record [(Name, f a)]
   | Lam (Maybe Name) (Scope () f a)
-  deriving (Foldable, Functor, Traversable)
+  deriving (Foldable, Functor, Generic1, Traversable)
 
 deriving instance (Eq   a, forall a . Eq   a => Eq   (f a), Monad f) => Eq   (Intro f a)
 deriving instance (Ord  a, forall a . Eq   a => Eq   (f a)

From 20591377daeb2c5f5a89fc5cc5a010d02c99d9bb Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 16:02:19 -0500
Subject: [PATCH 091/318] Define an HFunctor instance for Intro.

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

diff --git a/semantic-analysis/src/Analysis/Intro.hs b/semantic-analysis/src/Analysis/Intro.hs
index ac429e725..741ba4d5f 100644
--- a/semantic-analysis/src/Analysis/Intro.hs
+++ b/semantic-analysis/src/Analysis/Intro.hs
@@ -55,6 +55,8 @@ deriving instance (Ord  a, forall a . Eq   a => Eq   (f a)
                          , forall a . Ord  a => Ord  (f a), Monad f) => Ord  (Intro f a)
 deriving instance (Show a, forall a . Show a => Show (f a))          => Show (Intro f a)
 
+instance HFunctor Intro
+
 
 -- | User-specified and -relevant names.
 newtype Name = Name { unName :: Text }

From 23d1c843426dcdfe945164109c935da9be8463d4 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 16:03:14 -0500
Subject: [PATCH 092/318] Define a RightModule instance for Intro.

---
 semantic-analysis/src/Analysis/Intro.hs | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/semantic-analysis/src/Analysis/Intro.hs b/semantic-analysis/src/Analysis/Intro.hs
index 741ba4d5f..5900539bf 100644
--- a/semantic-analysis/src/Analysis/Intro.hs
+++ b/semantic-analysis/src/Analysis/Intro.hs
@@ -57,6 +57,13 @@ deriving instance (Show a, forall a . Show a => Show (f a))          => Show (In
 
 instance HFunctor Intro
 
+instance RightModule Intro where
+  Unit       >>=* _ = Unit
+  Bool b     >>=* _ = Bool b
+  String s   >>=* _ = String s
+  Record fs  >>=* f = Record (map (fmap (>>= f)) fs)
+  Lam n b    >>=* f = Lam n (b >>=* f)
+
 
 -- | User-specified and -relevant names.
 newtype Name = Name { unName :: Text }

From ea2b67904982f0bcf9bfa49e11c7b2b8ebac2e83 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 16:07:02 -0500
Subject: [PATCH 093/318] Export Name.

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

diff --git a/semantic-analysis/src/Analysis/Intro.hs b/semantic-analysis/src/Analysis/Intro.hs
index 5900539bf..b89617a18 100644
--- a/semantic-analysis/src/Analysis/Intro.hs
+++ b/semantic-analysis/src/Analysis/Intro.hs
@@ -8,6 +8,7 @@ module Analysis.Intro
 , lams
 , unlam
 , Intro(..)
+, Name(..)
 ) where
 
 import Control.Applicative (Alternative(..))

From 4811adddae5dea339f8e0eb265423d5af5729290 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 16:29:08 -0500
Subject: [PATCH 094/318] Define a smart constructor for Lam binding with Fin.

---
 semantic-analysis/src/Analysis/Intro.hs | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/Intro.hs b/semantic-analysis/src/Analysis/Intro.hs
index b89617a18..463c40967 100644
--- a/semantic-analysis/src/Analysis/Intro.hs
+++ b/semantic-analysis/src/Analysis/Intro.hs
@@ -1,10 +1,11 @@
-{-# LANGUAGE DeriveGeneric, DeriveTraversable, FlexibleContexts, GeneralizedNewtypeDeriving, QuantifiedConstraints, StandaloneDeriving #-}
+{-# LANGUAGE DataKinds, DeriveGeneric, DeriveTraversable, FlexibleContexts, GeneralizedNewtypeDeriving, QuantifiedConstraints, StandaloneDeriving #-}
 module Analysis.Intro
 ( unit
 , bool
 , string
 , record
 , lam
+, lamFin
 , lams
 , unlam
 , Intro(..)
@@ -16,9 +17,11 @@ import Control.Effect.Carrier
 import Data.String (IsString)
 import Data.Text (Text)
 import GHC.Generics (Generic1)
+import Syntax.Fin
 import Syntax.Module
 import Syntax.Scope
 import Syntax.Term
+import Syntax.Var
 
 unit :: (Carrier sig m, Member Intro sig) => m a
 unit = send Unit
@@ -35,6 +38,9 @@ record fs = send (Record fs)
 lam :: (Eq a, Carrier sig m, Member Intro sig) => Maybe Name -> a -> m a -> m a
 lam u n b = send (Lam u (abstract1 n b))
 
+lamFin :: (Carrier sig m, Member Intro sig) => Maybe Name -> m (Var (Fin ('S n)) a) -> m (Var (Fin n) a)
+lamFin u b = send (Lam u (toScopeFin b))
+
 lams :: (Eq a, Foldable t, Carrier sig m, Member Intro sig) => t (Maybe Name, a) -> m a -> m a
 lams names body = foldr (uncurry lam) body names
 

From cd5165ce005a842a4f8802b933298633bdecad7e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 4 Nov 2019 16:36:31 -0500
Subject: [PATCH 095/318] Strengthen to Fin without Var.

---
 semantic-analysis/src/Analysis/Intro.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Intro.hs b/semantic-analysis/src/Analysis/Intro.hs
index 463c40967..1ee81596d 100644
--- a/semantic-analysis/src/Analysis/Intro.hs
+++ b/semantic-analysis/src/Analysis/Intro.hs
@@ -17,7 +17,7 @@ import Control.Effect.Carrier
 import Data.String (IsString)
 import Data.Text (Text)
 import GHC.Generics (Generic1)
-import Syntax.Fin
+import Syntax.Fin as Fin
 import Syntax.Module
 import Syntax.Scope
 import Syntax.Term
@@ -38,8 +38,8 @@ record fs = send (Record fs)
 lam :: (Eq a, Carrier sig m, Member Intro sig) => Maybe Name -> a -> m a -> m a
 lam u n b = send (Lam u (abstract1 n b))
 
-lamFin :: (Carrier sig m, Member Intro sig) => Maybe Name -> m (Var (Fin ('S n)) a) -> m (Var (Fin n) a)
-lamFin u b = send (Lam u (toScopeFin b))
+lamFin :: (Carrier sig m, Member Intro sig) => Maybe Name -> m (Fin ('S n)) -> m (Fin n)
+lamFin u b = send (Lam u (abstractVar (maybe (B ()) F . Fin.strengthen) b))
 
 lams :: (Eq a, Foldable t, Carrier sig m, Member Intro sig) => t (Maybe Name, a) -> m a -> m a
 lams names body = foldr (uncurry lam) body names

From 95298aa511efbbc75ad9a2812cf93169593f9b97 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 10:59:40 -0500
Subject: [PATCH 096/318] Avoid loading every package five times.

---
 script/repl | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/script/repl b/script/repl
index 60ed3bc0e..3ce51c3b1 100755
--- a/script/repl
+++ b/script/repl
@@ -11,5 +11,5 @@ repl_builddir=dist-repl
 if [[ ! -d $repl_builddir ]]; then
   echo "$repl_builddir does not exist, first run 'cabal repl --builddir=$repl_builddir', exit, and then re-run $0"
 else
-  cabal exec --builddir=$repl_builddir ghci -- -ghci-script=.ghci.semantic $(script/ghci-flags --builddir "$repl_builddir") -no-ignore-dot-ghci $@
+  cabal exec --builddir=$repl_builddir env -- -u GHC_ENVIRONMENT ghci -ghci-script=.ghci.semantic $(script/ghci-flags --builddir "$repl_builddir") -no-ignore-dot-ghci $@
 fi

From 9f26a4c13e0b2157aed939c22d417d09ebebc5ea Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:11:39 -0500
Subject: [PATCH 097/318] Stub in a module for Name.

---
 semantic-analysis/semantic-analysis.cabal | 1 +
 semantic-analysis/src/Analysis/Name.hs    | 2 ++
 2 files changed, 3 insertions(+)
 create mode 100644 semantic-analysis/src/Analysis/Name.hs

diff --git a/semantic-analysis/semantic-analysis.cabal b/semantic-analysis/semantic-analysis.cabal
index 145619bba..6ab9e27e6 100644
--- a/semantic-analysis/semantic-analysis.cabal
+++ b/semantic-analysis/semantic-analysis.cabal
@@ -49,6 +49,7 @@ library
     Analysis.Effect.Env
     Analysis.Effect.Heap
     Analysis.File
+    Analysis.Name
     Analysis.FlowInsensitive
     Analysis.ImportGraph
     Analysis.Intro
diff --git a/semantic-analysis/src/Analysis/Name.hs b/semantic-analysis/src/Analysis/Name.hs
new file mode 100644
index 000000000..cdef48aa2
--- /dev/null
+++ b/semantic-analysis/src/Analysis/Name.hs
@@ -0,0 +1,2 @@
+module Analysis.Name
+() where

From 967255647606bec9ae9fee722deb7c17b1314312 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:13:15 -0500
Subject: [PATCH 098/318] Move Name into its own module.

---
 semantic-analysis/src/Analysis/Intro.hs |  9 ++-------
 semantic-analysis/src/Analysis/Name.hs  | 11 ++++++++++-
 2 files changed, 12 insertions(+), 8 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Intro.hs b/semantic-analysis/src/Analysis/Intro.hs
index 1ee81596d..0b1d269c7 100644
--- a/semantic-analysis/src/Analysis/Intro.hs
+++ b/semantic-analysis/src/Analysis/Intro.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, DeriveGeneric, DeriveTraversable, FlexibleContexts, GeneralizedNewtypeDeriving, QuantifiedConstraints, StandaloneDeriving #-}
+{-# LANGUAGE DataKinds, DeriveGeneric, DeriveTraversable, FlexibleContexts, QuantifiedConstraints, StandaloneDeriving #-}
 module Analysis.Intro
 ( unit
 , bool
@@ -12,9 +12,9 @@ module Analysis.Intro
 , Name(..)
 ) where
 
+import Analysis.Name
 import Control.Applicative (Alternative(..))
 import Control.Effect.Carrier
-import Data.String (IsString)
 import Data.Text (Text)
 import GHC.Generics (Generic1)
 import Syntax.Fin as Fin
@@ -70,8 +70,3 @@ instance RightModule Intro where
   String s   >>=* _ = String s
   Record fs  >>=* f = Record (map (fmap (>>= f)) fs)
   Lam n b    >>=* f = Lam n (b >>=* f)
-
-
--- | User-specified and -relevant names.
-newtype Name = Name { unName :: Text }
-  deriving (Eq, IsString, Ord, Show)
diff --git a/semantic-analysis/src/Analysis/Name.hs b/semantic-analysis/src/Analysis/Name.hs
index cdef48aa2..99b1f809b 100644
--- a/semantic-analysis/src/Analysis/Name.hs
+++ b/semantic-analysis/src/Analysis/Name.hs
@@ -1,2 +1,11 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Analysis.Name
-() where
+( Name(..)
+) where
+
+import Data.String (IsString)
+import Data.Text (Text)
+
+-- | User-specified and -relevant names.
+newtype Name = Name { unName :: Text }
+  deriving (Eq, IsString, Ord, Show)

From 0e69c0a67ab2dd16557765c4a6fb9f2e316337a0 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:17:09 -0500
Subject: [PATCH 099/318] Use Analysis.Name in Core.

---
 semantic-core/src/Core/Name.hs   | 10 ++--------
 semantic-core/src/Core/Pretty.hs |  2 +-
 2 files changed, 3 insertions(+), 9 deletions(-)

diff --git a/semantic-core/src/Core/Name.hs b/semantic-core/src/Core/Name.hs
index 01efa8b65..27bfb4638 100644
--- a/semantic-core/src/Core/Name.hs
+++ b/semantic-core/src/Core/Name.hs
@@ -12,17 +12,11 @@ module Core.Name
 , needsQuotation
 ) where
 
+import           Analysis.Name
 import qualified Data.Char as Char
 import           Data.HashSet (HashSet)
 import qualified Data.HashSet as HashSet
-import           Data.String (IsString)
-import           Data.Text as Text (Text, any, unpack)
-import           Data.Text.Prettyprint.Doc (Pretty)
-import           GHC.Generics (Generic)
-
--- | User-specified and -relevant names.
-newtype Name = Name { unName :: Text }
-  deriving (Eq, Generic, IsString, Ord, Pretty, Show)
+import           Data.Text as Text (any, unpack)
 
 -- | Annotates an @a@ with a 'Name'-provided name, which is ignored for '==' and 'compare'.
 data Named a = Named (Ignored Name) a
diff --git a/semantic-core/src/Core/Pretty.hs b/semantic-core/src/Core/Pretty.hs
index 5babed821..0afecc39d 100644
--- a/semantic-core/src/Core/Pretty.hs
+++ b/semantic-core/src/Core/Pretty.hs
@@ -43,7 +43,7 @@ primitive = keyword . mappend "#"
 data Style = Unicode | Ascii
 
 name :: Name -> AnsiDoc
-name n = if needsQuotation n then enclose (symbol "#{") (symbol "}") (pretty n) else pretty n
+name (Name n) = if needsQuotation (Name n) then enclose (symbol "#{") (symbol "}") (pretty n) else pretty n
 
 prettyCore :: Style -> Term Core Name -> AnsiDoc
 prettyCore style = unPrec . go . fmap name

From 98acd3adb7f507be953bd4a9258bf97eef2394c4 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:26:01 -0500
Subject: [PATCH 100/318] Specialize concrete analysis to Name.

---
 semantic-analysis/src/Analysis/Concrete.hs | 73 ++++++++++------------
 1 file changed, 32 insertions(+), 41 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index e7b010ac6..bb7e475a6 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -15,6 +15,7 @@ import           Analysis.Analysis
 import qualified Analysis.Carrier.Env.Precise as A
 import qualified Analysis.Carrier.Heap.Precise as A
 import           Analysis.File
+import           Analysis.Name
 import           Control.Applicative (Alternative (..))
 import           Control.Carrier.Fail.WithLoc
 import           Control.Effect
@@ -29,7 +30,6 @@ import qualified Data.IntSet as IntSet
 import qualified Data.Map as Map
 import           Data.Semigroup (Last (..))
 import qualified Data.Set as Set
-import           Data.String (IsString)
 import           Data.Text (Text, pack)
 import           Data.Traversable (for)
 import           Prelude hiding (fail)
@@ -69,19 +69,16 @@ data Edge = Lexical | Import
 
 concrete
   :: ( Foldable term
-     , IsString name
-     , Ord name
-     , Show name
-     , Show (term name)
+     , Show (term Name)
      )
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term name Precise (Concrete term name) m
-     -> (term name -> m (Concrete term name))
-     -> (term name -> m (Concrete term name))
+     => Analysis term Name Precise (Concrete term Name) m
+     -> (term Name -> m (Concrete term Name))
+     -> (term Name -> m (Concrete term Name))
      )
-  -> [File (term name)]
-  -> (Heap term name, [File (Either (Path.AbsRelFile, Span, String) (Concrete term name))])
+  -> [File (term Name)]
+  -> (Heap term Name, [File (Either (Path.AbsRelFile, Span, String) (Concrete term Name))])
 concrete eval
   = run
   . runFresh
@@ -89,51 +86,45 @@ concrete eval
   . traverse (runFile eval)
 
 runFile
-  :: forall term name m sig
+  :: forall term m sig
   .  ( Carrier sig m
      , Effect sig
      , Foldable term
-     , IsString name
      , Member Fresh sig
-     , Member (A.Heap Precise (Concrete term name)) sig
-     , Member (State (Heap term name)) sig
-     , Ord name
-     , Show name
-     , Show (term name)
+     , Member (A.Heap Precise (Concrete term Name)) sig
+     , Member (State (Heap term Name)) sig
+     , Show (term Name)
      )
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term name Precise (Concrete term name) m
-     -> (term name -> m (Concrete term name))
-     -> (term name -> m (Concrete term name))
+     => Analysis term Name Precise (Concrete term Name) m
+     -> (term Name -> m (Concrete term Name))
+     -> (term Name -> m (Concrete term Name))
      )
-  -> File (term name)
-  -> m (File (Either (Path.AbsRelFile, Span, String) (Concrete term name)))
+  -> File (term Name)
+  -> m (File (Either (Path.AbsRelFile, Span, String) (Concrete term Name)))
 runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
             . runFail
-            . runReader @(Env name) mempty
-            . A.runEnv @name
+            . runReader @(Env Name) mempty
+            . A.runEnv @Name
             . fix (eval concreteAnalysis)
 
 concreteAnalysis
-  :: forall term name m sig
+  :: forall term m sig
   .  ( Carrier sig m
      , Foldable term
-     , IsString name
-     , Member (A.Env name Precise) sig
-     , Member (A.Heap Precise (Concrete term name)) sig
-     , Member (Reader (Env name)) sig
+     , Member (A.Env Name Precise) sig
+     , Member (A.Heap Precise (Concrete term Name)) sig
+     , Member (Reader (Env Name)) sig
      , Member (Reader Path.AbsRelFile) sig
      , Member (Reader Span) sig
-     , Member (State (Heap term name)) sig
+     , Member (State (Heap term Name)) sig
      , MonadFail m
-     , Ord name
-     , Show name
-     , Show (term name)
+     , Show (term Name)
      )
-  => Analysis term name Precise (Concrete term name) m
+  => Analysis term Name Precise (Concrete term Name) m
 concreteAnalysis = Analysis{..}
   where abstract _ name body = do
           path <- ask
@@ -160,12 +151,12 @@ concreteAnalysis = Analysis{..}
             pure (name, addr)
           pure (Record (Map.fromList fields'))
         addr ... n = do
-          val <- A.deref @Precise @(Concrete term name) addr
+          val <- A.deref @Precise @(Concrete term Name) addr
           heap <- get
           pure (val >>= lookupConcrete heap n)
 
 
-lookupConcrete :: (IsString name, Ord name) => Heap term name -> name -> Concrete term name -> Maybe Precise
+lookupConcrete :: Heap term Name -> Name -> Concrete term Name -> Maybe Precise
 lookupConcrete heap name = run . evalState IntSet.empty . runNonDet . inConcrete
   where -- look up the name in a concrete value
         inConcrete = inFrame <=< maybeA . recordFrame
@@ -187,7 +178,7 @@ lookupConcrete heap name = run . evalState IntSet.empty . runNonDet . inConcrete
 --   > λ let (heap, res) = concrete [ruby]
 --   > λ writeFile "/Users/rob/Desktop/heap.dot" (export (addressStyle heap) (heapAddressGraph heap))
 --   > λ :!dot -Tsvg < ~/Desktop/heap.dot > ~/Desktop/heap.svg
-heapGraph :: (Precise -> Concrete term name -> a) -> (Either Edge name -> Precise -> G.Graph a) -> Heap term name -> G.Graph a
+heapGraph :: (Precise -> Concrete term Name -> a) -> (Either Edge Name -> Precise -> G.Graph a) -> Heap term Name -> G.Graph a
 heapGraph vertex edge h = foldr (uncurry graph) G.empty (IntMap.toList h)
   where graph k v rest = (G.vertex (vertex k v) `G.connect` outgoing v) `G.overlay` rest
         outgoing = \case
@@ -197,15 +188,15 @@ heapGraph vertex edge h = foldr (uncurry graph) G.empty (IntMap.toList h)
           Closure _ _ _ _ env -> foldr (G.overlay . edge (Left Lexical)) G.empty env
           Record frame -> Map.foldrWithKey (\ k -> G.overlay . edge (Right k)) G.empty frame
 
-heapValueGraph :: Heap term name -> G.Graph (Concrete term name)
+heapValueGraph :: Heap term Name -> G.Graph (Concrete term Name)
 heapValueGraph h = heapGraph (const id) (const fromAddr) h
   where fromAddr addr = maybe G.empty G.vertex (IntMap.lookup addr h)
 
-heapAddressGraph :: Heap term name -> G.Graph (EdgeType term name, Precise)
+heapAddressGraph :: Heap term Name -> G.Graph (EdgeType term Name, Precise)
 heapAddressGraph = heapGraph (\ addr v -> (Value v, addr)) (fmap G.vertex . (,) . either Edge Slot)
 
-addressStyle :: (name -> Text) -> Heap term name -> G.Style (EdgeType term name, Precise) Text
-addressStyle unName heap = (G.defaultStyle vertex) { G.edgeAttributes }
+addressStyle :: Heap term Name -> G.Style (EdgeType term Name, Precise) Text
+addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
   where vertex (_, addr) = pack (show addr) <> " = " <> maybe "?" fromConcrete (IntMap.lookup addr heap)
         edgeAttributes _ (Slot name,    _) = ["label" G.:= unName name]
         edgeAttributes _ (Edge Import,  _) = ["color" G.:= "blue"]

From 924e0d012904a3ddadcdc34601c1eb9b5a51f2d3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:28:18 -0500
Subject: [PATCH 101/318] :fire: Frame.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index bb7e475a6..a23646aee 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -56,11 +56,6 @@ recordFrame :: Concrete term name -> Maybe (Env name)
 recordFrame (Record frame) = Just frame
 recordFrame _              = Nothing
 
-newtype Frame name = Frame
-  { frameSlots :: Env name
-  }
-  deriving (Eq, Ord, Show)
-
 type Heap term name = IntMap.IntMap (Concrete term name)
 
 data Edge = Lexical | Import

From 29b117033bd49b334c9589d545f2a29f67ae774c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:29:05 -0500
Subject: [PATCH 102/318] Move Edge down.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index a23646aee..135b942e1 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -58,9 +58,6 @@ recordFrame _              = Nothing
 
 type Heap term name = IntMap.IntMap (Concrete term name)
 
-data Edge = Lexical | Import
-  deriving (Eq, Ord, Show)
-
 
 concrete
   :: ( Foldable term
@@ -210,3 +207,6 @@ data EdgeType term name
   | Slot name
   | Value (Concrete term name)
   deriving (Eq, Ord, Show)
+
+data Edge = Lexical | Import
+  deriving (Eq, Ord, Show)

From 398d377e355fecdeaf8af375801f796ae7baee34 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:32:22 -0500
Subject: [PATCH 103/318] Specialize Concrete to Name.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 135b942e1..9d3667bb0 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -42,21 +42,21 @@ type Env name = Map.Map name Precise
 newtype FrameId = FrameId { unFrameId :: Precise }
   deriving (Eq, Ord, Show)
 
-data Concrete term name
-  = Closure Path.AbsRelFile Span name (term name) (Env name)
+data Concrete term
+  = Closure Path.AbsRelFile Span Name term (Env Name)
   | Unit
   | Bool Bool
   | String Text
-  | Record (Env name)
+  | Record (Env Name)
   deriving (Eq, Ord, Show)
   -- NB: We derive the 'Semigroup' instance for 'Concrete' to take the second argument. This is equivalent to stating that the return value of an imperative sequence of statements is the value of its final statement.
-  deriving Semigroup via Last (Concrete term name)
+  deriving Semigroup via Last (Concrete term)
 
-recordFrame :: Concrete term name -> Maybe (Env name)
+recordFrame :: Concrete term -> Maybe (Env Name)
 recordFrame (Record frame) = Just frame
 recordFrame _              = Nothing
 
-type Heap term name = IntMap.IntMap (Concrete term name)
+type Heap term = IntMap.IntMap (Concrete term)
 
 
 concrete
@@ -65,12 +65,12 @@ concrete
      )
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term Name Precise (Concrete term Name) m
-     -> (term Name -> m (Concrete term Name))
-     -> (term Name -> m (Concrete term Name))
+     => Analysis term Name Precise (Concrete (term Name)) m
+     -> (term Name -> m (Concrete (term Name)))
+     -> (term Name -> m (Concrete (term Name)))
      )
   -> [File (term Name)]
-  -> (Heap term Name, [File (Either (Path.AbsRelFile, Span, String) (Concrete term Name))])
+  -> (Heap (term Name), [File (Either (Path.AbsRelFile, Span, String) (Concrete (term Name)))])
 concrete eval
   = run
   . runFresh
@@ -83,18 +83,18 @@ runFile
      , Effect sig
      , Foldable term
      , Member Fresh sig
-     , Member (A.Heap Precise (Concrete term Name)) sig
-     , Member (State (Heap term Name)) sig
+     , Member (A.Heap Precise (Concrete (term Name))) sig
+     , Member (State (Heap (term Name))) sig
      , Show (term Name)
      )
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term Name Precise (Concrete term Name) m
-     -> (term Name -> m (Concrete term Name))
-     -> (term Name -> m (Concrete term Name))
+     => Analysis term Name Precise (Concrete (term Name)) m
+     -> (term Name -> m (Concrete (term Name)))
+     -> (term Name -> m (Concrete (term Name)))
      )
   -> File (term Name)
-  -> m (File (Either (Path.AbsRelFile, Span, String) (Concrete term Name)))
+  -> m (File (Either (Path.AbsRelFile, Span, String) (Concrete (term Name))))
 runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
@@ -108,15 +108,15 @@ concreteAnalysis
   .  ( Carrier sig m
      , Foldable term
      , Member (A.Env Name Precise) sig
-     , Member (A.Heap Precise (Concrete term Name)) sig
+     , Member (A.Heap Precise (Concrete (term Name))) sig
      , Member (Reader (Env Name)) sig
      , Member (Reader Path.AbsRelFile) sig
      , Member (Reader Span) sig
-     , Member (State (Heap term Name)) sig
+     , Member (State (Heap (term Name))) sig
      , MonadFail m
      , Show (term Name)
      )
-  => Analysis term Name Precise (Concrete term Name) m
+  => Analysis term Name Precise (Concrete (term Name)) m
 concreteAnalysis = Analysis{..}
   where abstract _ name body = do
           path <- ask
@@ -143,12 +143,12 @@ concreteAnalysis = Analysis{..}
             pure (name, addr)
           pure (Record (Map.fromList fields'))
         addr ... n = do
-          val <- A.deref @Precise @(Concrete term Name) addr
+          val <- A.deref @Precise @(Concrete (term Name)) addr
           heap <- get
           pure (val >>= lookupConcrete heap n)
 
 
-lookupConcrete :: Heap term Name -> Name -> Concrete term Name -> Maybe Precise
+lookupConcrete :: Heap (term Name) -> Name -> Concrete (term Name) -> Maybe Precise
 lookupConcrete heap name = run . evalState IntSet.empty . runNonDet . inConcrete
   where -- look up the name in a concrete value
         inConcrete = inFrame <=< maybeA . recordFrame
@@ -170,7 +170,7 @@ lookupConcrete heap name = run . evalState IntSet.empty . runNonDet . inConcrete
 --   > λ let (heap, res) = concrete [ruby]
 --   > λ writeFile "/Users/rob/Desktop/heap.dot" (export (addressStyle heap) (heapAddressGraph heap))
 --   > λ :!dot -Tsvg < ~/Desktop/heap.dot > ~/Desktop/heap.svg
-heapGraph :: (Precise -> Concrete term Name -> a) -> (Either Edge Name -> Precise -> G.Graph a) -> Heap term Name -> G.Graph a
+heapGraph :: (Precise -> Concrete (term Name) -> a) -> (Either Edge Name -> Precise -> G.Graph a) -> Heap (term Name) -> G.Graph a
 heapGraph vertex edge h = foldr (uncurry graph) G.empty (IntMap.toList h)
   where graph k v rest = (G.vertex (vertex k v) `G.connect` outgoing v) `G.overlay` rest
         outgoing = \case
@@ -180,14 +180,14 @@ heapGraph vertex edge h = foldr (uncurry graph) G.empty (IntMap.toList h)
           Closure _ _ _ _ env -> foldr (G.overlay . edge (Left Lexical)) G.empty env
           Record frame -> Map.foldrWithKey (\ k -> G.overlay . edge (Right k)) G.empty frame
 
-heapValueGraph :: Heap term Name -> G.Graph (Concrete term Name)
+heapValueGraph :: Heap (term Name) -> G.Graph (Concrete (term Name))
 heapValueGraph h = heapGraph (const id) (const fromAddr) h
   where fromAddr addr = maybe G.empty G.vertex (IntMap.lookup addr h)
 
-heapAddressGraph :: Heap term Name -> G.Graph (EdgeType term Name, Precise)
+heapAddressGraph :: Heap (term Name) -> G.Graph (EdgeType (term Name) Name, Precise)
 heapAddressGraph = heapGraph (\ addr v -> (Value v, addr)) (fmap G.vertex . (,) . either Edge Slot)
 
-addressStyle :: Heap term Name -> G.Style (EdgeType term Name, Precise) Text
+addressStyle :: Heap (term Name) -> G.Style (EdgeType (term Name) Name, Precise) Text
 addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
   where vertex (_, addr) = pack (show addr) <> " = " <> maybe "?" fromConcrete (IntMap.lookup addr heap)
         edgeAttributes _ (Slot name,    _) = ["label" G.:= unName name]
@@ -205,7 +205,7 @@ addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
 data EdgeType term name
   = Edge Edge
   | Slot name
-  | Value (Concrete term name)
+  | Value (Concrete term)
   deriving (Eq, Ord, Show)
 
 data Edge = Lexical | Import

From 2f676e892e0fb21b5a7c9d6e1d4c5236f8ffcec8 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:32:55 -0500
Subject: [PATCH 104/318] Specialize the Env synonym to Name.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 9d3667bb0..067c191b9 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -37,22 +37,22 @@ import           Source.Span
 import qualified System.Path as Path
 
 type Precise = Int
-type Env name = Map.Map name Precise
+type Env = Map.Map Name Precise
 
 newtype FrameId = FrameId { unFrameId :: Precise }
   deriving (Eq, Ord, Show)
 
 data Concrete term
-  = Closure Path.AbsRelFile Span Name term (Env Name)
+  = Closure Path.AbsRelFile Span Name term Env
   | Unit
   | Bool Bool
   | String Text
-  | Record (Env Name)
+  | Record Env
   deriving (Eq, Ord, Show)
   -- NB: We derive the 'Semigroup' instance for 'Concrete' to take the second argument. This is equivalent to stating that the return value of an imperative sequence of statements is the value of its final statement.
   deriving Semigroup via Last (Concrete term)
 
-recordFrame :: Concrete term -> Maybe (Env Name)
+recordFrame :: Concrete term -> Maybe Env
 recordFrame (Record frame) = Just frame
 recordFrame _              = Nothing
 
@@ -99,7 +99,7 @@ runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
             . runFail
-            . runReader @(Env Name) mempty
+            . runReader @Env mempty
             . A.runEnv @Name
             . fix (eval concreteAnalysis)
 
@@ -109,7 +109,7 @@ concreteAnalysis
      , Foldable term
      , Member (A.Env Name Precise) sig
      , Member (A.Heap Precise (Concrete (term Name))) sig
-     , Member (Reader (Env Name)) sig
+     , Member (Reader Env) sig
      , Member (Reader Path.AbsRelFile) sig
      , Member (Reader Span) sig
      , Member (State (Heap (term Name))) sig

From 535ec0576ae3b9fa97bc57868bbf281343e881f4 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:33:33 -0500
Subject: [PATCH 105/318] :fire: some quantifiers.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 067c191b9..24caba674 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -78,8 +78,7 @@ concrete eval
   . traverse (runFile eval)
 
 runFile
-  :: forall term m sig
-  .  ( Carrier sig m
+  :: ( Carrier sig m
      , Effect sig
      , Foldable term
      , Member Fresh sig

From 71e49818050aa49e0cd72bf6e20e83b1b016b8dc Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:34:00 -0500
Subject: [PATCH 106/318] Specialize EdgeType to Name.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 24caba674..6998d1eb4 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -183,10 +183,10 @@ heapValueGraph :: Heap (term Name) -> G.Graph (Concrete (term Name))
 heapValueGraph h = heapGraph (const id) (const fromAddr) h
   where fromAddr addr = maybe G.empty G.vertex (IntMap.lookup addr h)
 
-heapAddressGraph :: Heap (term Name) -> G.Graph (EdgeType (term Name) Name, Precise)
+heapAddressGraph :: Heap (term Name) -> G.Graph (EdgeType (term Name), Precise)
 heapAddressGraph = heapGraph (\ addr v -> (Value v, addr)) (fmap G.vertex . (,) . either Edge Slot)
 
-addressStyle :: Heap (term Name) -> G.Style (EdgeType (term Name) Name, Precise) Text
+addressStyle :: Heap (term Name) -> G.Style (EdgeType (term Name), Precise) Text
 addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
   where vertex (_, addr) = pack (show addr) <> " = " <> maybe "?" fromConcrete (IntMap.lookup addr heap)
         edgeAttributes _ (Slot name,    _) = ["label" G.:= unName name]
@@ -201,9 +201,9 @@ addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
           Record _ -> "{}"
         showPos (Pos l c) = pack (show l) <> ":" <> pack (show c)
 
-data EdgeType term name
+data EdgeType term
   = Edge Edge
-  | Slot name
+  | Slot Name
   | Value (Concrete term)
   deriving (Eq, Ord, Show)
 

From 50e123a1101ef111ee6c6801a273e48a0601ad0c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:37:47 -0500
Subject: [PATCH 107/318] Specialize the typechecking analysis to Name.

---
 semantic-analysis/src/Analysis/Typecheck.hs | 56 ++++++++++-----------
 1 file changed, 27 insertions(+), 29 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 986ab5366..b27298c7f 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -12,6 +12,7 @@ import           Analysis.Carrier.Env.Monovariant
 import qualified Analysis.Carrier.Heap.Monovariant as A
 import           Analysis.File
 import           Analysis.FlowInsensitive
+import           Analysis.Name
 import           Control.Applicative (Alternative (..))
 import           Control.Carrier.Fail.WithLoc
 import           Control.Effect.Carrier
@@ -96,16 +97,16 @@ generalize ty = fromJust (closed (forAlls (IntSet.toList (mvs ty)) (hoistTerm R
 
 
 typecheckingFlowInsensitive
-  :: (Ord name, Ord (term name), Show name)
+  :: Ord (term Name)
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term name name (Type name) m
-     -> (term name -> m (Type name))
-     -> (term name -> m (Type name))
+     => Analysis term Name Name (Type Name) m
+     -> (term Name -> m (Type Name))
+     -> (term Name -> m (Type Name))
      )
-  -> [File (term name)]
-  -> ( Heap name (Type name)
-     , [File (Either (Path.AbsRelFile, Span, String) (Term (Polytype :+: Monotype name) Void))]
+  -> [File (term Name)]
+  -> ( Heap Name (Type Name)
+     , [File (Either (Path.AbsRelFile, Span, String) (Term (Polytype :+: Monotype Name) Void))]
      )
 typecheckingFlowInsensitive eval
   = run
@@ -115,59 +116,56 @@ typecheckingFlowInsensitive eval
   . traverse (runFile eval)
 
 runFile
-  :: forall term name m sig
+  :: forall term m sig
   .  ( Carrier sig m
      , Effect sig
      , Member Fresh sig
-     , Member (State (Heap name (Type name))) sig
-     , Ord name
-     , Ord (term name)
-     , Show name
+     , Member (State (Heap Name (Type Name))) sig
+     , Ord (term Name)
      )
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term name name (Type name) m
-     -> (term name -> m (Type name))
-     -> (term name -> m (Type name))
+     => Analysis term Name Name (Type Name) m
+     -> (term Name -> m (Type Name))
+     -> (term Name -> m (Type Name))
      )
-  -> File (term name)
-  -> m (File (Either (Path.AbsRelFile, Span, String) (Type name)))
+  -> File (term Name)
+  -> m (File (Either (Path.AbsRelFile, Span, String) (Type Name)))
 runFile eval file = traverse run file
   where run
           = (\ m -> do
               (subst, t) <- m
-              modify @(Heap name (Type name)) (fmap (Set.map (substAll subst)))
+              modify @(Heap Name (Type Name)) (fmap (Set.map (substAll subst)))
               pure (substAll subst <$> t))
           . runState (mempty :: (Substitution name))
           . runReader (filePath file)
           . runReader (fileSpan file)
-          . runEnv @name
+          . runEnv @Name
           . runFail
           . (\ m -> do
             (cs, t) <- m
-            t <$ solve @name cs)
+            t <$ solve @Name cs)
           . runState (Set.empty :: Set.Set (Constraint name))
           . (\ m -> do
               v <- meta
               bs <- m
               v <$ for_ bs (unify v))
-          . convergeTerm (Proxy @name) (A.runHeap @name @(Type name) . fix (cacheTerm . eval typecheckingAnalysis))
+          . convergeTerm (Proxy @Name) (A.runHeap @Name @(Type Name) . fix (cacheTerm . eval typecheckingAnalysis))
 
 typecheckingAnalysis
-  :: forall term name m sig
+  :: forall term m sig
   .  ( Alternative m
      , Carrier sig m
-     , Member (Env name name) sig
+     , Member (Env Name Name) sig
      , Member Fresh sig
-     , Member (A.Heap name (Type name)) sig
-     , Member (State (Set.Set (Constraint name))) sig
-     , Ord name
+     , Member (A.Heap Name (Type Name)) sig
+     , Member (State (Set.Set (Constraint Name))) sig
      )
-  => Analysis term name name (Type name) m
+  => Analysis term Name Name (Type Name) m
 typecheckingAnalysis = Analysis{..}
   where abstract eval name body = do
           -- FIXME: construct the associated scope
-          addr <- alloc @name @name name
+          addr <- alloc @Name @Name name
           arg <- meta
           A.assign addr arg
           ty <- eval body
@@ -185,7 +183,7 @@ typecheckingAnalysis = Analysis{..}
         asString s = unify (Alg String) s $> mempty
         record fields = do
           fields' <- for fields $ \ (k, v) -> do
-            addr <- alloc @name @name k
+            addr <- alloc @Name @Name k
             (k, v) <$ A.assign addr v
           -- FIXME: should records reference types by address instead?
           pure (Alg (Record (Map.fromList fields')))

From 814f6fe8cf02adae596adf31e93cd650447c7615 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:38:24 -0500
Subject: [PATCH 108/318] :fire: quantifiers.

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

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index b27298c7f..4e833d638 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, MultiParamTypeClasses, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DeriveGeneric, DeriveTraversable, DerivingVia, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses, QuantifiedConstraints, RankNTypes, RecordWildCards, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-}
 module Analysis.Typecheck
 ( Monotype (..)
 , Meta
@@ -116,8 +116,7 @@ typecheckingFlowInsensitive eval
   . traverse (runFile eval)
 
 runFile
-  :: forall term m sig
-  .  ( Carrier sig m
+  :: ( Carrier sig m
      , Effect sig
      , Member Fresh sig
      , Member (State (Heap Name (Type Name))) sig
@@ -153,8 +152,7 @@ runFile eval file = traverse run file
           . convergeTerm (Proxy @Name) (A.runHeap @Name @(Type Name) . fix (cacheTerm . eval typecheckingAnalysis))
 
 typecheckingAnalysis
-  :: forall term m sig
-  .  ( Alternative m
+  :: ( Alternative m
      , Carrier sig m
      , Member (Env Name Name) sig
      , Member Fresh sig

From 18bc19a04ea405355b3914e58d7a30361b7aa017 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:45:59 -0500
Subject: [PATCH 109/318] Specialize Type, Constraint, Solution, & Substitution
 to Name.

---
 semantic-analysis/src/Analysis/Typecheck.hs | 50 ++++++++++-----------
 1 file changed, 25 insertions(+), 25 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 4e833d638..bd63c1837 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -51,7 +51,7 @@ data Monotype name f a
 
 infixr 0 :->
 
-type Type name = Term (Monotype name) Meta
+type Type = Term (Monotype Name) Meta
 
 -- FIXME: Union the effects/annotations on the operands.
 
@@ -100,12 +100,12 @@ typecheckingFlowInsensitive
   :: Ord (term Name)
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term Name Name (Type Name) m
-     -> (term Name -> m (Type Name))
-     -> (term Name -> m (Type Name))
+     => Analysis term Name Name Type m
+     -> (term Name -> m Type)
+     -> (term Name -> m Type)
      )
   -> [File (term Name)]
-  -> ( Heap Name (Type Name)
+  -> ( Heap Name Type
      , [File (Either (Path.AbsRelFile, Span, String) (Term (Polytype :+: Monotype Name) Void))]
      )
 typecheckingFlowInsensitive eval
@@ -119,47 +119,47 @@ runFile
   :: ( Carrier sig m
      , Effect sig
      , Member Fresh sig
-     , Member (State (Heap Name (Type Name))) sig
+     , Member (State (Heap Name Type)) sig
      , Ord (term Name)
      )
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term Name Name (Type Name) m
-     -> (term Name -> m (Type Name))
-     -> (term Name -> m (Type Name))
+     => Analysis term Name Name Type m
+     -> (term Name -> m Type)
+     -> (term Name -> m Type)
      )
   -> File (term Name)
-  -> m (File (Either (Path.AbsRelFile, Span, String) (Type Name)))
+  -> m (File (Either (Path.AbsRelFile, Span, String) Type))
 runFile eval file = traverse run file
   where run
           = (\ m -> do
               (subst, t) <- m
-              modify @(Heap Name (Type Name)) (fmap (Set.map (substAll subst)))
+              modify @(Heap Name Type) (fmap (Set.map (substAll subst)))
               pure (substAll subst <$> t))
-          . runState (mempty :: (Substitution name))
+          . runState @Substitution mempty
           . runReader (filePath file)
           . runReader (fileSpan file)
           . runEnv @Name
           . runFail
           . (\ m -> do
             (cs, t) <- m
-            t <$ solve @Name cs)
-          . runState (Set.empty :: Set.Set (Constraint name))
+            t <$ solve cs)
+          . runState @(Set.Set Constraint) mempty
           . (\ m -> do
               v <- meta
               bs <- m
               v <$ for_ bs (unify v))
-          . convergeTerm (Proxy @Name) (A.runHeap @Name @(Type Name) . fix (cacheTerm . eval typecheckingAnalysis))
+          . convergeTerm (Proxy @Name) (A.runHeap @Name @Type . fix (cacheTerm . eval typecheckingAnalysis))
 
 typecheckingAnalysis
   :: ( Alternative m
      , Carrier sig m
      , Member (Env Name Name) sig
      , Member Fresh sig
-     , Member (A.Heap Name (Type Name)) sig
-     , Member (State (Set.Set (Constraint Name))) sig
+     , Member (A.Heap Name Type) sig
+     , Member (State (Set.Set Constraint)) sig
      )
-  => Analysis term Name Name (Type Name) m
+  => Analysis term Name Name Type m
 typecheckingAnalysis = Analysis{..}
   where abstract eval name body = do
           -- FIXME: construct the associated scope
@@ -188,28 +188,28 @@ typecheckingAnalysis = Analysis{..}
         _ ... m = pure (Just m)
 
 
-data Constraint name = Type name :===: Type name
+data Constraint = Type :===: Type
   deriving (Eq, Ord, Show)
 
 infix 4 :===:
 
-data Solution name
-  = Int := Type name
+data Solution
+  = Int := Type
   deriving (Eq, Ord, Show)
 
 infix 5 :=
 
-meta :: (Carrier sig m, Member Fresh sig) => m (Type name)
+meta :: (Carrier sig m, Member Fresh sig) => m Type
 meta = pure <$> Fresh.fresh
 
-unify :: (Carrier sig m, Member (State (Set.Set (Constraint name))) sig, Ord name) => Type name -> Type name -> m ()
+unify :: (Carrier sig m, Member (State (Set.Set Constraint)) sig) => Type -> Type -> m ()
 unify t1 t2
   | t1 == t2  = pure ()
   | otherwise = modify (<> Set.singleton (t1 :===: t2))
 
-type Substitution name = IntMap.IntMap (Type name)
+type Substitution = IntMap.IntMap Type
 
-solve :: (Member (State (Substitution name)) sig, MonadFail m, Ord name, Show name, Carrier sig m) => Set.Set (Constraint name) -> m ()
+solve :: (Member (State Substitution) sig, MonadFail m, Carrier sig 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 630759d1d701423fd322cb1e2cf0579221af8e3c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:47:01 -0500
Subject: [PATCH 110/318] Specialize Monotype to Name.

---
 semantic-analysis/src/Analysis/Typecheck.hs | 24 ++++++++++-----------
 1 file changed, 12 insertions(+), 12 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index bd63c1837..ab4a7b890 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -41,30 +41,30 @@ import           Syntax.Term
 import           Syntax.Var (closed)
 import qualified System.Path as Path
 
-data Monotype name f a
+data Monotype f a
   = Bool
   | Unit
   | String
   | f a :-> f a
-  | Record (Map.Map name (f a))
+  | Record (Map.Map Name (f a))
   deriving (Foldable, Functor, Generic1, Traversable)
 
 infixr 0 :->
 
-type Type = Term (Monotype Name) Meta
+type Type = Term Monotype Meta
 
 -- FIXME: Union the effects/annotations on the operands.
 
 -- | We derive the 'Semigroup' instance for types to take the second argument. This is equivalent to stating that the type of an imperative sequence of statements is the type of its final statement.
-deriving via (Last (Term (Monotype name) a)) instance Semigroup (Term (Monotype name) a)
+deriving via (Last (Term Monotype a)) instance Semigroup (Term Monotype a)
 
-deriving instance (Eq   name, Eq   a, forall a . Eq   a => Eq   (f a), Monad f) => Eq   (Monotype name f a)
-deriving instance (Ord  name, Ord  a, forall a . Eq   a => Eq   (f a)
-                                    , forall a . Ord  a => Ord  (f a), Monad f) => Ord  (Monotype name f a)
-deriving instance (Show name, Show a, forall a . Show a => Show (f a))          => Show (Monotype name f a)
+deriving instance (Eq   a, forall a . Eq   a => Eq   (f a), Monad f) => Eq   (Monotype f a)
+deriving instance (Ord  a, forall a . Eq   a => Eq   (f a)
+                         , forall a . Ord  a => Ord  (f a), Monad f) => Ord  (Monotype f a)
+deriving instance (Show a, forall a . Show a => Show (f a))          => Show (Monotype f a)
 
-instance HFunctor (Monotype name)
-instance RightModule (Monotype name) where
+instance HFunctor Monotype
+instance RightModule Monotype where
   Unit      >>=* _ = Unit
   Bool      >>=* _ = Bool
   String    >>=* _ = String
@@ -92,7 +92,7 @@ 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 ns body = foldr forAll body ns
 
-generalize :: Term (Monotype name) Meta -> Term (Polytype :+: Monotype name) Void
+generalize :: Term Monotype Meta -> Term (Polytype :+: Monotype) Void
 generalize ty = fromJust (closed (forAlls (IntSet.toList (mvs ty)) (hoistTerm R ty)))
 
 
@@ -106,7 +106,7 @@ typecheckingFlowInsensitive
      )
   -> [File (term Name)]
   -> ( Heap Name Type
-     , [File (Either (Path.AbsRelFile, Span, String) (Term (Polytype :+: Monotype Name) Void))]
+     , [File (Either (Path.AbsRelFile, Span, String) (Term (Polytype :+: Monotype) Void))]
      )
 typecheckingFlowInsensitive eval
   = run

From a3775a1248a06fe6e07e6f4f66f4b69ec16558b3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:48:42 -0500
Subject: [PATCH 111/318] Specialize the import graph analysis to Name.

---
 semantic-analysis/src/Analysis/ImportGraph.hs | 54 +++++++++----------
 1 file changed, 26 insertions(+), 28 deletions(-)

diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index e7105ff28..dce6db26e 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -10,6 +10,7 @@ import           Analysis.Carrier.Env.Monovariant
 import qualified Analysis.Carrier.Heap.Monovariant as A
 import           Analysis.File
 import           Analysis.FlowInsensitive
+import           Analysis.Name
 import           Control.Applicative (Alternative(..))
 import           Control.Carrier.Fail.WithLoc
 import           Control.Effect
@@ -48,16 +49,16 @@ data Semi term name
 
 
 importGraph
-  :: (Ord name, Ord (term name), Show name, Show (term name))
+  :: (Ord (term Name), Show (term Name))
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term name name (Value term name) m
-     -> (term name -> m (Value term name))
-     -> (term name -> m (Value term name))
+     => Analysis term Name Name (Value term Name) m
+     -> (term Name -> m (Value term Name))
+     -> (term Name -> m (Value term Name))
      )
-  -> [File (term name)]
-  -> ( Heap name (Value term name)
-     , [File (Either (Path.AbsRelFile, Span, String) (Value term name))]
+  -> [File (term Name)]
+  -> ( Heap Name (Value term Name)
+     , [File (Either (Path.AbsRelFile, Span, String) (Value term Name))]
      )
 importGraph eval
   = run
@@ -66,53 +67,50 @@ importGraph eval
   . traverse (runFile eval)
 
 runFile
-  :: forall term name m sig
+  :: forall term m sig
   .  ( Carrier sig m
      , Effect sig
      , Member Fresh sig
-     , Member (State (Heap name (Value term name))) sig
-     , Ord  name
-     , Ord  (term name)
-     , Show name
-     , Show (term name)
+     , Member (State (Heap Name (Value term Name))) sig
+     , Ord  (term Name)
+     , Show (term Name)
      )
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term name name (Value term name) m
-     -> (term name -> m (Value term name))
-     -> (term name -> m (Value term name))
+     => Analysis term Name Name (Value term Name) m
+     -> (term Name -> m (Value term Name))
+     -> (term Name -> m (Value term Name))
      )
-  -> File (term name)
-  -> m (File (Either (Path.AbsRelFile, Span, String) (Value term name)))
+  -> File (term Name)
+  -> m (File (Either (Path.AbsRelFile, Span, String) (Value term Name)))
 runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
-            . runEnv @name
+            . runEnv @Name
             . runFail
             . fmap fold
-            . convergeTerm (Proxy @name) (A.runHeap @name @(Value term name) . fix (cacheTerm . eval importGraphAnalysis))
+            . convergeTerm (Proxy @Name) (A.runHeap @Name @(Value term Name) . fix (cacheTerm . eval importGraphAnalysis))
 
 -- FIXME: decompose into a product domain and two atomic domains
 importGraphAnalysis
-  :: forall term name m sig
+  :: forall term m sig
   .  ( Alternative m
      , Carrier sig m
-     , Member (Env name name) sig
-     , Member (A.Heap name (Value term name)) sig
+     , Member (Env Name Name) sig
+     , Member (A.Heap Name (Value term Name)) sig
      , Member (Reader Path.AbsRelFile) sig
      , Member (Reader Span) sig
      , MonadFail m
-     , Show name
-     , Show (term name)
+     , Show (term Name)
      )
-  => Analysis term name name (Value term name) m
+  => Analysis term Name Name (Value term Name) m
 importGraphAnalysis = Analysis{..}
   where abstract _ name body = do
           path <- ask
           span <- ask
           pure (Value (Closure path span name body) mempty)
         apply eval (Value (Closure path span name body) _) a = local (const path) . local (const span) $ do
-          addr <- alloc @name @name name
+          addr <- alloc @Name @Name name
           A.assign addr a
           bind name addr (eval body)
         apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
@@ -124,7 +122,7 @@ importGraphAnalysis = Analysis{..}
         asString _ = pure mempty
         record fields = do
           for_ fields $ \ (k, v) -> do
-            addr <- alloc @name @name k
+            addr <- alloc @Name @Name k
             A.assign addr v
           pure (Value Abstract (foldMap (valueGraph . snd) fields))
         _ ... m = pure (Just m)

From 4962104008f4e575509b5236d099953765dce95d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:50:32 -0500
Subject: [PATCH 112/318] Specialize Value to Name.

---
 semantic-analysis/src/Analysis/ImportGraph.hs | 38 +++++++++----------
 1 file changed, 19 insertions(+), 19 deletions(-)

diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index dce6db26e..5b9423104 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -28,20 +28,20 @@ import qualified System.Path as Path
 
 type ImportGraph = Map.Map Text (Set.Set Text)
 
-data Value term name = Value
-  { valueSemi  :: Semi term name
+data Value term = Value
+  { valueSemi  :: Semi term
   , valueGraph :: ImportGraph
   }
   deriving (Eq, Ord, Show)
 
-instance Semigroup (Value term name) where
+instance Semigroup (Value term) where
   Value _ g1 <> Value _ g2 = Value Abstract (Map.unionWith (<>) g1 g2)
 
-instance Monoid (Value term name) where
+instance Monoid (Value term) where
   mempty = Value Abstract mempty
 
-data Semi term name
-  = Closure Path.AbsRelFile Span name (term name)
+data Semi term
+  = Closure Path.AbsRelFile Span Name term
   -- FIXME: Bound String values.
   | String Text
   | Abstract
@@ -52,13 +52,13 @@ importGraph
   :: (Ord (term Name), Show (term Name))
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term Name Name (Value term Name) m
-     -> (term Name -> m (Value term Name))
-     -> (term Name -> m (Value term Name))
+     => Analysis term Name Name (Value (term Name)) m
+     -> (term Name -> m (Value (term Name)))
+     -> (term Name -> m (Value (term Name)))
      )
   -> [File (term Name)]
-  -> ( Heap Name (Value term Name)
-     , [File (Either (Path.AbsRelFile, Span, String) (Value term Name))]
+  -> ( Heap Name (Value (term Name))
+     , [File (Either (Path.AbsRelFile, Span, String) (Value (term Name)))]
      )
 importGraph eval
   = run
@@ -71,25 +71,25 @@ runFile
   .  ( Carrier sig m
      , Effect sig
      , Member Fresh sig
-     , Member (State (Heap Name (Value term Name))) sig
+     , Member (State (Heap Name (Value (term Name)))) sig
      , Ord  (term Name)
      , Show (term Name)
      )
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term Name Name (Value term Name) m
-     -> (term Name -> m (Value term Name))
-     -> (term Name -> m (Value term Name))
+     => Analysis term Name Name (Value (term Name)) m
+     -> (term Name -> m (Value (term Name)))
+     -> (term Name -> m (Value (term Name)))
      )
   -> File (term Name)
-  -> m (File (Either (Path.AbsRelFile, Span, String) (Value term Name)))
+  -> m (File (Either (Path.AbsRelFile, Span, String) (Value (term Name))))
 runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
             . runEnv @Name
             . runFail
             . fmap fold
-            . convergeTerm (Proxy @Name) (A.runHeap @Name @(Value term Name) . fix (cacheTerm . eval importGraphAnalysis))
+            . convergeTerm (Proxy @Name) (A.runHeap @Name @(Value (term Name)) . fix (cacheTerm . eval importGraphAnalysis))
 
 -- FIXME: decompose into a product domain and two atomic domains
 importGraphAnalysis
@@ -97,13 +97,13 @@ importGraphAnalysis
   .  ( Alternative m
      , Carrier sig m
      , Member (Env Name Name) sig
-     , Member (A.Heap Name (Value term Name)) sig
+     , Member (A.Heap Name (Value (term Name))) sig
      , Member (Reader Path.AbsRelFile) sig
      , Member (Reader Span) sig
      , MonadFail m
      , Show (term Name)
      )
-  => Analysis term Name Name (Value term Name) m
+  => Analysis term Name Name (Value (term Name)) m
 importGraphAnalysis = Analysis{..}
   where abstract _ name body = do
           path <- ask

From 6191f2e1be67233806a9939571c8f9f1dac0fe2c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:52:21 -0500
Subject: [PATCH 113/318] Specialize the scope graph analysis to Name.

---
 semantic-analysis/src/Analysis/ScopeGraph.hs | 51 ++++++++++----------
 1 file changed, 25 insertions(+), 26 deletions(-)

diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index 73bc829b9..c887f1c23 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -12,6 +12,7 @@ import           Analysis.Carrier.Env.Monovariant
 import qualified Analysis.Carrier.Heap.Monovariant as A
 import           Analysis.File
 import           Analysis.FlowInsensitive
+import           Analysis.Name
 import           Control.Applicative (Alternative (..))
 import           Control.Carrier.Fail.WithLoc
 import           Control.Effect.Carrier
@@ -51,15 +52,15 @@ instance Ord name => Monoid (ScopeGraph name) where
   mempty = ScopeGraph Map.empty
 
 scopeGraph
-  :: (Ord name, Ord (term name))
+  :: Ord (term Name)
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term name name (ScopeGraph name) m
-     -> (term name -> m (ScopeGraph name))
-     -> (term name -> m (ScopeGraph name))
+     => Analysis term Name Name (ScopeGraph Name) m
+     -> (term Name -> m (ScopeGraph Name))
+     -> (term Name -> m (ScopeGraph Name))
      )
-  -> [File (term name)]
-  -> (Heap name (ScopeGraph name), [File (Either (Path.AbsRelFile, Span, String) (ScopeGraph name))])
+  -> [File (term Name)]
+  -> (Heap Name (ScopeGraph Name), [File (Either (Path.AbsRelFile, Span, String) (ScopeGraph Name))])
 scopeGraph eval
   = run
   . runFresh
@@ -67,46 +68,44 @@ scopeGraph eval
   . traverse (runFile eval)
 
 runFile
-  :: forall term name m sig
+  :: forall term m sig
   .  ( Carrier sig m
      , Effect sig
      , Member Fresh sig
-     , Member (State (Heap name (ScopeGraph name))) sig
-     , Ord name
-     , Ord (term name)
+     , Member (State (Heap Name (ScopeGraph Name))) sig
+     , Ord (term Name)
      )
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term name name (ScopeGraph name) m
-     -> (term name -> m (ScopeGraph name))
-     -> (term name -> m (ScopeGraph name))
+     => Analysis term Name Name (ScopeGraph Name) m
+     -> (term Name -> m (ScopeGraph Name))
+     -> (term Name -> m (ScopeGraph Name))
      )
-  -> File (term name)
-  -> m (File (Either (Path.AbsRelFile, Span, String) (ScopeGraph name)))
+  -> File (term Name)
+  -> m (File (Either (Path.AbsRelFile, Span, String) (ScopeGraph Name)))
 runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
-            . runEnv @name
-            . runReader (Map.empty @name @Ref)
+            . runEnv @Name
+            . runReader (Map.empty @Name @Ref)
             . runFail
             . fmap fold
-            . convergeTerm (Proxy @name) (A.runHeap @name @(ScopeGraph name) . fix (cacheTerm . eval scopeGraphAnalysis))
+            . convergeTerm (Proxy @Name) (A.runHeap @Name @(ScopeGraph Name) . fix (cacheTerm . eval scopeGraphAnalysis))
 
 scopeGraphAnalysis
-  :: forall term name m sig
+  :: forall term m sig
   .  ( Alternative m
      , Carrier sig m
-     , Member (Env name name) sig
-     , Member (A.Heap name (ScopeGraph name)) sig
+     , Member (Env Name Name) sig
+     , Member (A.Heap Name (ScopeGraph Name)) sig
      , Member (Reader Path.AbsRelFile) sig
      , Member (Reader Span) sig
-     , Ord name
      )
-  => Analysis term name name (ScopeGraph name) m
+  => Analysis term Name Name (ScopeGraph Name) m
 scopeGraphAnalysis = Analysis{..}
   where abstract eval name body = do
-          addr <- alloc @name @name name
-          A.assign @name @(ScopeGraph name) name mempty
+          addr <- alloc @Name @Name name
+          A.assign @Name @(ScopeGraph Name) name mempty
           bind name addr (eval body)
         apply _ f a = pure (f <> a)
         unit = pure mempty
@@ -120,6 +119,6 @@ scopeGraphAnalysis = Analysis{..}
             path <- ask
             span <- ask
             let v' = ScopeGraph (Map.singleton (Decl k path span) mempty) <> v
-            (k, v') <$ A.assign @name addr v'
+            (k, v') <$ A.assign @Name addr v'
           pure (foldMap snd fields')
         _ ... m = pure (Just m)

From 611ae5fb0bf1f3b860cdeb1fbc3d0288ec3aeaf9 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:53:46 -0500
Subject: [PATCH 114/318] :fire: quantifiers.

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

diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index c887f1c23..59bd90746 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -68,8 +68,7 @@ scopeGraph eval
   . traverse (runFile eval)
 
 runFile
-  :: forall term m sig
-  .  ( Carrier sig m
+  :: ( Carrier sig m
      , Effect sig
      , Member Fresh sig
      , Member (State (Heap Name (ScopeGraph Name))) sig
@@ -93,8 +92,7 @@ runFile eval file = traverse run file
             . convergeTerm (Proxy @Name) (A.runHeap @Name @(ScopeGraph Name) . fix (cacheTerm . eval scopeGraphAnalysis))
 
 scopeGraphAnalysis
-  :: forall term m sig
-  .  ( Alternative m
+  :: ( Alternative m
      , Carrier sig m
      , Member (Env Name Name) sig
      , Member (A.Heap Name (ScopeGraph Name)) sig

From f03de00aecab32efbdd2b75edc43844a94707a9c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:54:41 -0500
Subject: [PATCH 115/318] :fire: ScopedTypeVariables.

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

diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index 59bd90746..1de002658 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 FlexibleContexts, OverloadedStrings, RankNTypes, RecordWildCards, TypeApplications, TypeOperators #-}
 module Analysis.ScopeGraph
 ( ScopeGraph(..)
 , Ref (..)

From d06d73c81bd5048c1b7f7fc89764de0c703ef67b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:55:42 -0500
Subject: [PATCH 116/318] Rename a bunch of type parameters.

---
 .../src/Analysis/FlowInsensitive.hs           | 36 +++++++++----------
 1 file changed, 18 insertions(+), 18 deletions(-)

diff --git a/semantic-analysis/src/Analysis/FlowInsensitive.hs b/semantic-analysis/src/Analysis/FlowInsensitive.hs
index 0240d6739..28bea6f30 100644
--- a/semantic-analysis/src/Analysis/FlowInsensitive.hs
+++ b/semantic-analysis/src/Analysis/FlowInsensitive.hs
@@ -18,56 +18,56 @@ 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) }
+newtype Cache term value = Cache { unCache :: Map.Map term (Set.Set value) }
   deriving (Eq, Ord, Show)
 
-type Heap address a = Map.Map address (Set.Set a)
+type Heap address value = Map.Map address (Set.Set value)
 
 newtype FrameId name = FrameId { unFrameId :: name }
   deriving (Eq, Ord, Show)
 
 
-convergeTerm :: forall m sig a term address proxy
+convergeTerm :: forall m sig value term address proxy
              .  ( Carrier sig m
                 , Effect sig
                 , Eq address
                 , Member Fresh sig
-                , Member (State (Heap address a)) sig
-                , Ord a
+                , Member (State (Heap address value)) sig
+                , Ord value
                 , Ord term
                 )
              => proxy address
-             -> (term -> NonDetC (ReaderC (Cache term a) (StateC (Cache term a) m)) a)
+             -> (term -> NonDetC (ReaderC (Cache term value) (StateC (Cache term value) m)) value)
              -> term
-             -> m (Set.Set a)
+             -> m (Set.Set value)
 convergeTerm _ 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
+  (cache, _) <- converge (Cache Map.empty :: Cache term value, heap :: Heap address value) $ \ (prevCache, _) -> runState (Cache Map.empty) . runReader prevCache $ do
     _ <- resetFresh . runNonDetM Set.singleton $ eval body
     get
   pure (fromMaybe mempty (Map.lookup body (unCache cache)))
 
-cacheTerm :: forall m sig a term
+cacheTerm :: forall m sig value term
           .  ( Alternative m
              , Carrier sig m
-             , Member (Reader (Cache term a)) sig
-             , Member (State  (Cache term a)) sig
-             , Ord a
+             , Member (Reader (Cache term value)) sig
+             , Member (State  (Cache term value)) sig
+             , Ord value
              , Ord term
              )
-          => (term -> m a)
-          -> (term -> m a)
+          => (term -> m value)
+          -> (term -> m value)
 cacheTerm eval term = do
   cached <- gets (Map.lookup term . unCache)
-  case cached :: Maybe (Set.Set a) of
+  case cached :: Maybe (Set.Set value) of
     Just results -> foldMapA pure results
     Nothing -> do
       results <- asks (fromMaybe mempty . Map.lookup term . unCache)
-      modify (Cache . Map.insert term (results :: Set.Set a) . unCache)
+      modify (Cache . Map.insert term (results :: Set.Set value) . unCache)
       result <- eval term
-      result <$ modify (Cache . Map.insertWith (<>) term (Set.singleton (result :: a)) . unCache)
+      result <$ modify (Cache . Map.insertWith (<>) term (Set.singleton (result :: value)) . unCache)
 
-runHeap :: StateC (Heap address a) m b -> m (Heap address a, b)
+runHeap :: StateC (Heap address value) m a -> m (Heap address value, a)
 runHeap m = runState Map.empty m
 
 -- | Fold a collection by mapping each element onto an 'Alternative' action.

From b33c6940948dde46dcaeadac5d9dacd78ccf82b4 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:55:54 -0500
Subject: [PATCH 117/318] Sort constraints.

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

diff --git a/semantic-analysis/src/Analysis/FlowInsensitive.hs b/semantic-analysis/src/Analysis/FlowInsensitive.hs
index 28bea6f30..402f46b66 100644
--- a/semantic-analysis/src/Analysis/FlowInsensitive.hs
+++ b/semantic-analysis/src/Analysis/FlowInsensitive.hs
@@ -33,8 +33,8 @@ convergeTerm :: forall m sig value term address proxy
                 , Eq address
                 , Member Fresh sig
                 , Member (State (Heap address value)) sig
-                , Ord value
                 , Ord term
+                , Ord value
                 )
              => proxy address
              -> (term -> NonDetC (ReaderC (Cache term value) (StateC (Cache term value) m)) value)
@@ -52,8 +52,8 @@ cacheTerm :: forall m sig value term
              , Carrier sig m
              , Member (Reader (Cache term value)) sig
              , Member (State  (Cache term value)) sig
-             , Ord value
              , Ord term
+             , Ord value
              )
           => (term -> m value)
           -> (term -> m value)

From 1b61ce56ec6e657d6102d4429e0f90cf3550ace1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:56:22 -0500
Subject: [PATCH 118/318] Sort explicit quantifiers.

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

diff --git a/semantic-analysis/src/Analysis/FlowInsensitive.hs b/semantic-analysis/src/Analysis/FlowInsensitive.hs
index 402f46b66..da8f0818d 100644
--- a/semantic-analysis/src/Analysis/FlowInsensitive.hs
+++ b/semantic-analysis/src/Analysis/FlowInsensitive.hs
@@ -27,7 +27,7 @@ newtype FrameId name = FrameId { unFrameId :: name }
   deriving (Eq, Ord, Show)
 
 
-convergeTerm :: forall m sig value term address proxy
+convergeTerm :: forall term value address proxy m sig
              .  ( Carrier sig m
                 , Effect sig
                 , Eq address
@@ -47,7 +47,7 @@ convergeTerm _ eval body = do
     get
   pure (fromMaybe mempty (Map.lookup body (unCache cache)))
 
-cacheTerm :: forall m sig value term
+cacheTerm :: forall term value m sig
           .  ( Alternative m
              , Carrier sig m
              , Member (Reader (Cache term value)) sig

From e9b6658b5ec1c9fd18487303c19bccaec66ce022 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:59:23 -0500
Subject: [PATCH 119/318] Specialize flow-insensitive caching to Name
 addresses.

---
 .../src/Analysis/FlowInsensitive.hs             | 17 ++++++++---------
 semantic-analysis/src/Analysis/ImportGraph.hs   |  7 +++----
 semantic-analysis/src/Analysis/ScopeGraph.hs    |  7 +++----
 semantic-analysis/src/Analysis/Typecheck.hs     |  9 ++++-----
 4 files changed, 18 insertions(+), 22 deletions(-)

diff --git a/semantic-analysis/src/Analysis/FlowInsensitive.hs b/semantic-analysis/src/Analysis/FlowInsensitive.hs
index da8f0818d..cd16bb868 100644
--- a/semantic-analysis/src/Analysis/FlowInsensitive.hs
+++ b/semantic-analysis/src/Analysis/FlowInsensitive.hs
@@ -8,6 +8,7 @@ module Analysis.FlowInsensitive
 , foldMapA
 ) where
 
+import           Analysis.Name
 import           Control.Effect
 import           Control.Effect.Fresh
 import           Control.Effect.NonDet
@@ -21,28 +22,26 @@ import qualified Data.Set as Set
 newtype Cache term value = Cache { unCache :: Map.Map term (Set.Set value) }
   deriving (Eq, Ord, Show)
 
-type Heap address value = Map.Map address (Set.Set value)
+type Heap value = Map.Map Name (Set.Set value)
 
 newtype FrameId name = FrameId { unFrameId :: name }
   deriving (Eq, Ord, Show)
 
 
-convergeTerm :: forall term value address proxy m sig
+convergeTerm :: forall term value m sig
              .  ( Carrier sig m
                 , Effect sig
-                , Eq address
                 , Member Fresh sig
-                , Member (State (Heap address value)) sig
+                , Member (State (Heap value)) sig
                 , Ord term
                 , Ord value
                 )
-             => proxy address
-             -> (term -> NonDetC (ReaderC (Cache term value) (StateC (Cache term value) m)) value)
+             => (term -> NonDetC (ReaderC (Cache term value) (StateC (Cache term value) m)) value)
              -> term
              -> m (Set.Set value)
-convergeTerm _ eval body = do
+convergeTerm eval body = do
   heap <- get
-  (cache, _) <- converge (Cache Map.empty :: Cache term value, heap :: Heap address value) $ \ (prevCache, _) -> runState (Cache Map.empty) . runReader prevCache $ do
+  (cache, _) <- converge (Cache Map.empty :: Cache term value, heap :: Heap value) $ \ (prevCache, _) -> runState (Cache Map.empty) . runReader prevCache $ do
     _ <- resetFresh . runNonDetM Set.singleton $ eval body
     get
   pure (fromMaybe mempty (Map.lookup body (unCache cache)))
@@ -67,7 +66,7 @@ cacheTerm eval term = do
       result <- eval term
       result <$ modify (Cache . Map.insertWith (<>) term (Set.singleton (result :: value)) . unCache)
 
-runHeap :: StateC (Heap address value) m a -> m (Heap address value, a)
+runHeap :: StateC (Heap value) m a -> m (Heap value, a)
 runHeap m = runState Map.empty m
 
 -- | Fold a collection by mapping each element onto an 'Alternative' action.
diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 5b9423104..ac4b48107 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -19,7 +19,6 @@ import           Control.Effect.Reader
 import           Data.Foldable (fold, for_)
 import           Data.Function (fix)
 import qualified Data.Map as Map
-import           Data.Proxy
 import qualified Data.Set as Set
 import           Data.Text (Text)
 import           Prelude hiding (fail)
@@ -57,7 +56,7 @@ importGraph
      -> (term Name -> m (Value (term Name)))
      )
   -> [File (term Name)]
-  -> ( Heap Name (Value (term Name))
+  -> ( Heap (Value (term Name))
      , [File (Either (Path.AbsRelFile, Span, String) (Value (term Name)))]
      )
 importGraph eval
@@ -71,7 +70,7 @@ runFile
   .  ( Carrier sig m
      , Effect sig
      , Member Fresh sig
-     , Member (State (Heap Name (Value (term Name)))) sig
+     , Member (State (Heap (Value (term Name)))) sig
      , Ord  (term Name)
      , Show (term Name)
      )
@@ -89,7 +88,7 @@ runFile eval file = traverse run file
             . runEnv @Name
             . runFail
             . fmap fold
-            . convergeTerm (Proxy @Name) (A.runHeap @Name @(Value (term Name)) . fix (cacheTerm . eval importGraphAnalysis))
+            . convergeTerm (A.runHeap @Name @(Value (term Name)) . fix (cacheTerm . eval importGraphAnalysis))
 
 -- FIXME: decompose into a product domain and two atomic domains
 importGraphAnalysis
diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index 1de002658..224cef9ea 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -22,7 +22,6 @@ import           Control.Effect.State
 import           Data.Foldable (fold)
 import           Data.Function (fix)
 import qualified Data.Map as Map
-import           Data.Proxy
 import qualified Data.Set as Set
 import           Data.Traversable (for)
 import           Prelude hiding (fail)
@@ -60,7 +59,7 @@ scopeGraph
      -> (term Name -> m (ScopeGraph Name))
      )
   -> [File (term Name)]
-  -> (Heap Name (ScopeGraph Name), [File (Either (Path.AbsRelFile, Span, String) (ScopeGraph Name))])
+  -> (Heap (ScopeGraph Name), [File (Either (Path.AbsRelFile, Span, String) (ScopeGraph Name))])
 scopeGraph eval
   = run
   . runFresh
@@ -71,7 +70,7 @@ runFile
   :: ( Carrier sig m
      , Effect sig
      , Member Fresh sig
-     , Member (State (Heap Name (ScopeGraph Name))) sig
+     , Member (State (Heap (ScopeGraph Name))) sig
      , Ord (term Name)
      )
   => (forall sig m
@@ -89,7 +88,7 @@ runFile eval file = traverse run file
             . runReader (Map.empty @Name @Ref)
             . runFail
             . fmap fold
-            . convergeTerm (Proxy @Name) (A.runHeap @Name @(ScopeGraph Name) . fix (cacheTerm . eval scopeGraphAnalysis))
+            . convergeTerm (A.runHeap @Name @(ScopeGraph Name) . fix (cacheTerm . eval scopeGraphAnalysis))
 
 scopeGraphAnalysis
   :: ( Alternative m
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index ab4a7b890..7380d38ee 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -27,7 +27,6 @@ import qualified Data.IntMap as IntMap
 import qualified Data.IntSet as IntSet
 import qualified Data.Map as Map
 import           Data.Maybe (fromJust, fromMaybe)
-import           Data.Proxy
 import           Data.Semigroup (Last (..))
 import qualified Data.Set as Set
 import           Data.Traversable (for)
@@ -105,7 +104,7 @@ typecheckingFlowInsensitive
      -> (term Name -> m Type)
      )
   -> [File (term Name)]
-  -> ( Heap Name Type
+  -> ( Heap Type
      , [File (Either (Path.AbsRelFile, Span, String) (Term (Polytype :+: Monotype) Void))]
      )
 typecheckingFlowInsensitive eval
@@ -119,7 +118,7 @@ runFile
   :: ( Carrier sig m
      , Effect sig
      , Member Fresh sig
-     , Member (State (Heap Name Type)) sig
+     , Member (State (Heap Type)) sig
      , Ord (term Name)
      )
   => (forall sig m
@@ -134,7 +133,7 @@ runFile eval file = traverse run file
   where run
           = (\ m -> do
               (subst, t) <- m
-              modify @(Heap Name Type) (fmap (Set.map (substAll subst)))
+              modify @(Heap Type) (fmap (Set.map (substAll subst)))
               pure (substAll subst <$> t))
           . runState @Substitution mempty
           . runReader (filePath file)
@@ -149,7 +148,7 @@ runFile eval file = traverse run file
               v <- meta
               bs <- m
               v <$ for_ bs (unify v))
-          . convergeTerm (Proxy @Name) (A.runHeap @Name @Type . fix (cacheTerm . eval typecheckingAnalysis))
+          . convergeTerm (A.runHeap @Name @Type . fix (cacheTerm . eval typecheckingAnalysis))
 
 typecheckingAnalysis
   :: ( Alternative m

From 56b30e4793c8202c0e2f0202fbc1da06eda49e1d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 11:59:59 -0500
Subject: [PATCH 120/318] :fire: FrameId.

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

diff --git a/semantic-analysis/src/Analysis/FlowInsensitive.hs b/semantic-analysis/src/Analysis/FlowInsensitive.hs
index cd16bb868..29d406b52 100644
--- a/semantic-analysis/src/Analysis/FlowInsensitive.hs
+++ b/semantic-analysis/src/Analysis/FlowInsensitive.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE FlexibleContexts, OverloadedStrings, ScopedTypeVariables, TypeOperators #-}
 module Analysis.FlowInsensitive
 ( Heap
-, FrameId(..)
 , convergeTerm
 , cacheTerm
 , runHeap
@@ -24,9 +23,6 @@ newtype Cache term value = Cache { unCache :: Map.Map term (Set.Set value) }
 
 type Heap value = Map.Map Name (Set.Set value)
 
-newtype FrameId name = FrameId { unFrameId :: name }
-  deriving (Eq, Ord, Show)
-
 
 convergeTerm :: forall term value m sig
              .  ( Carrier sig m

From f8c26e72d3e45abb4f4904b4389cf98f66d7b5be Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 12:00:32 -0500
Subject: [PATCH 121/318] :fire: FrameId.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 6998d1eb4..c69c31de7 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -39,9 +39,6 @@ import qualified System.Path as Path
 type Precise = Int
 type Env = Map.Map Name Precise
 
-newtype FrameId = FrameId { unFrameId :: Precise }
-  deriving (Eq, Ord, Show)
-
 data Concrete term
   = Closure Path.AbsRelFile Span Name term Env
   | Unit

From 02ae8de2ba6210e4379f589aa69169454a3cc204 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 12:02:39 -0500
Subject: [PATCH 122/318] Specialize Analysis to Name.

---
 semantic-analysis/src/Analysis/Analysis.hs    | 11 ++++++-----
 semantic-analysis/src/Analysis/Concrete.hs    |  6 +++---
 semantic-analysis/src/Analysis/ImportGraph.hs |  6 +++---
 semantic-analysis/src/Analysis/ScopeGraph.hs  |  6 +++---
 semantic-analysis/src/Analysis/Typecheck.hs   |  6 +++---
 semantic-core/src/Core/Eval.hs                |  2 +-
 6 files changed, 19 insertions(+), 18 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 012bca8a7..85a146a07 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -3,6 +3,7 @@ module Analysis.Analysis
 ( Analysis(..)
 ) where
 
+import Analysis.Name
 import Control.Effect.Carrier
 import Data.Text (Text)
 import GHC.Generics (Generic1)
@@ -10,16 +11,16 @@ import GHC.Generics (Generic1)
 -- | A record of functions necessary to perform analysis.
 --
 -- This is intended to be replaced with a selection of algebraic effects providing these interfaces and carriers providing reusable implementations.
-data Analysis term name address value m = Analysis
-  { abstract  :: (term name -> m value) -> name -> term name -> m value
-  , apply     :: (term name -> m value) -> value -> value -> m value
+data Analysis term address value m = Analysis
+  { abstract  :: (term Name -> m value) -> Name -> term Name -> m value
+  , apply     :: (term Name -> m value) -> value -> value -> m value
   , unit      :: m value
   , bool      :: Bool -> m value
   , asBool    :: value -> m Bool
   , string    :: Text -> m value
   , asString  :: value -> m Text
-  , record    :: [(name, value)] -> m value
-  , (...)     :: address -> name -> m (Maybe address)
+  , record    :: [(Name, value)] -> m value
+  , (...)     :: address -> Name -> m (Maybe address)
   }
 
 
diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index c69c31de7..0128e9a4e 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -62,7 +62,7 @@ concrete
      )
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term Name Precise (Concrete (term Name)) m
+     => Analysis term Precise (Concrete (term Name)) m
      -> (term Name -> m (Concrete (term Name)))
      -> (term Name -> m (Concrete (term Name)))
      )
@@ -85,7 +85,7 @@ runFile
      )
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term Name Precise (Concrete (term Name)) m
+     => Analysis term Precise (Concrete (term Name)) m
      -> (term Name -> m (Concrete (term Name)))
      -> (term Name -> m (Concrete (term Name)))
      )
@@ -112,7 +112,7 @@ concreteAnalysis
      , MonadFail m
      , Show (term Name)
      )
-  => Analysis term Name Precise (Concrete (term Name)) m
+  => Analysis term Precise (Concrete (term Name)) m
 concreteAnalysis = Analysis{..}
   where abstract _ name body = do
           path <- ask
diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index ac4b48107..305e34187 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -51,7 +51,7 @@ importGraph
   :: (Ord (term Name), Show (term Name))
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term Name Name (Value (term Name)) m
+     => Analysis term Name (Value (term Name)) m
      -> (term Name -> m (Value (term Name)))
      -> (term Name -> m (Value (term Name)))
      )
@@ -76,7 +76,7 @@ runFile
      )
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term Name Name (Value (term Name)) m
+     => Analysis term Name (Value (term Name)) m
      -> (term Name -> m (Value (term Name)))
      -> (term Name -> m (Value (term Name)))
      )
@@ -102,7 +102,7 @@ importGraphAnalysis
      , MonadFail m
      , Show (term Name)
      )
-  => Analysis term Name Name (Value (term Name)) m
+  => Analysis term Name (Value (term Name)) m
 importGraphAnalysis = Analysis{..}
   where abstract _ name body = do
           path <- ask
diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index 224cef9ea..0dea2c2ab 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -54,7 +54,7 @@ scopeGraph
   :: Ord (term Name)
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term Name Name (ScopeGraph Name) m
+     => Analysis term Name (ScopeGraph Name) m
      -> (term Name -> m (ScopeGraph Name))
      -> (term Name -> m (ScopeGraph Name))
      )
@@ -75,7 +75,7 @@ runFile
      )
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term Name Name (ScopeGraph Name) m
+     => Analysis term Name (ScopeGraph Name) m
      -> (term Name -> m (ScopeGraph Name))
      -> (term Name -> m (ScopeGraph Name))
      )
@@ -98,7 +98,7 @@ scopeGraphAnalysis
      , Member (Reader Path.AbsRelFile) sig
      , Member (Reader Span) sig
      )
-  => Analysis term Name Name (ScopeGraph Name) m
+  => Analysis term Name (ScopeGraph Name) m
 scopeGraphAnalysis = Analysis{..}
   where abstract eval name body = do
           addr <- alloc @Name @Name name
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 7380d38ee..de01e124f 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -99,7 +99,7 @@ typecheckingFlowInsensitive
   :: Ord (term Name)
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term Name Name Type m
+     => Analysis term Name Type m
      -> (term Name -> m Type)
      -> (term Name -> m Type)
      )
@@ -123,7 +123,7 @@ runFile
      )
   => (forall sig m
      .  (Carrier sig m, Member (Reader Path.AbsRelFile) sig, Member (Reader Span) sig, MonadFail m)
-     => Analysis term Name Name Type m
+     => Analysis term Name Type m
      -> (term Name -> m Type)
      -> (term Name -> m Type)
      )
@@ -158,7 +158,7 @@ typecheckingAnalysis
      , Member (A.Heap Name Type) sig
      , Member (State (Set.Set Constraint)) sig
      )
-  => Analysis term Name Name Type m
+  => Analysis term Name Type m
 typecheckingAnalysis = Analysis{..}
   where abstract eval name body = do
           -- FIXME: construct the associated scope
diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index 20ab76426..88ed761a7 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -38,7 +38,7 @@ eval :: forall address value m sig
         , MonadFail m
         , Semigroup value
         )
-     => Analysis (Term (Ann Span :+: Core)) Name address value m
+     => Analysis (Term (Ann Span :+: Core)) address value m
      -> (Term (Ann Span :+: Core) Name -> m value)
      -> (Term (Ann Span :+: Core) Name -> m value)
 eval Analysis{..} eval = \case

From 23c65d5eb448b15d0bd021da994a9824bbb4cb2c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 12:02:43 -0500
Subject: [PATCH 123/318] Specialize Domain to Name.

---
 semantic-analysis/src/Analysis/Analysis.hs | 24 +++++++++++-----------
 1 file changed, 12 insertions(+), 12 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 85a146a07..849c82d21 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -24,22 +24,22 @@ data Analysis term address value m = Analysis
   }
 
 
-data Domain term name value m k
+data Domain term value m k
   -- Functions construction & elimination
-  = Abstract name (term name)                 (value term name -> m k)
-  | Apply (value term name) (value term name) (value term name -> m k)
+  = Abstract Name (term Name)                 (value term -> m k)
+  | Apply (value term) (value term) (value term -> m k)
   -- Unit construction (no elimination)
-  | Unit (value term name -> m k)
+  | Unit (value term -> m k)
   -- Boolean construction & elimination
-  | Bool   Bool              (value term name -> m k)
-  | AsBool (value term name) (Bool            -> m k)
+  | Bool   Bool              (value term -> m k)
+  | AsBool (value term) (Bool            -> m k)
   -- String construction & elimination
-  | String   Text              (value term name -> m k)
-  | AsString (value term name) (Text            -> m k)
+  | String   Text              (value term -> m k)
+  | AsString (value term) (Text            -> m k)
   -- Record construction & elimination
-  | Record [(name, value term name)] (value term name         -> m k)
-  | Project (value term name) name   (Maybe (value term name) -> m k)
+  | Record [(Name, value term)] (value term         -> m k)
+  | Project (value term) Name   (Maybe (value term) -> m k)
   deriving (Functor, Generic1)
 
-instance HFunctor (Domain term name value)
-instance Effect   (Domain term name value)
+instance HFunctor (Domain term value)
+instance Effect   (Domain term value)

From 7f6680d82579c8f9a9ef6e9b13b5fc166604be6f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 12:08:13 -0500
Subject: [PATCH 124/318] Specialize the Env effect to Name.

---
 .../src/Analysis/Carrier/Env/Monovariant.hs   |  5 +++--
 .../src/Analysis/Carrier/Env/Precise.hs       | 10 ++++-----
 semantic-analysis/src/Analysis/Concrete.hs    |  4 ++--
 semantic-analysis/src/Analysis/Effect/Env.hs  | 21 ++++++++++---------
 semantic-analysis/src/Analysis/ImportGraph.hs |  8 +++----
 semantic-analysis/src/Analysis/ScopeGraph.hs  |  6 +++---
 semantic-analysis/src/Analysis/Typecheck.hs   |  8 +++----
 semantic-core/src/Core/Eval.hs                |  6 +++---
 8 files changed, 35 insertions(+), 33 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Carrier/Env/Monovariant.hs b/semantic-analysis/src/Analysis/Carrier/Env/Monovariant.hs
index cb8a63d11..0db1e2bf4 100644
--- a/semantic-analysis/src/Analysis/Carrier/Env/Monovariant.hs
+++ b/semantic-analysis/src/Analysis/Carrier/Env/Monovariant.hs
@@ -7,14 +7,15 @@ module Analysis.Carrier.Env.Monovariant
 ) where
 
 import Analysis.Effect.Env
+import Analysis.Name
 import Control.Effect.Carrier
 import qualified Control.Monad.Fail as Fail
 
-newtype EnvC name m a = EnvC { runEnv :: m a }
+newtype EnvC m a = EnvC { runEnv :: m a }
   deriving (Applicative, Functor, Monad, Fail.MonadFail)
 
 instance Carrier sig m
-      => Carrier (Env name name :+: sig) (EnvC name m) where
+      => Carrier (Env Name :+: sig) (EnvC m) where
   eff (L (Alloc name k))  = k name
   eff (L (Bind _ _ m k))  = m >>= k
   eff (L (Lookup name k)) = k (Just name)
diff --git a/semantic-analysis/src/Analysis/Carrier/Env/Precise.hs b/semantic-analysis/src/Analysis/Carrier/Env/Precise.hs
index 39c3f51bf..4f30b5deb 100644
--- a/semantic-analysis/src/Analysis/Carrier/Env/Precise.hs
+++ b/semantic-analysis/src/Analysis/Carrier/Env/Precise.hs
@@ -10,6 +10,7 @@ module Analysis.Carrier.Env.Precise
 ) where
 
 import qualified Analysis.Effect.Env as A
+import Analysis.Name
 import Control.Effect.Carrier
 import Control.Effect.Fresh
 import Control.Effect.Reader
@@ -17,17 +18,16 @@ import qualified Control.Monad.Fail as Fail
 import qualified Data.Map as Map
 
 type Precise = Int
-type Env name = Map.Map name Precise
+type Env = Map.Map Name Precise
 
-newtype EnvC name m a = EnvC { runEnv :: m a }
+newtype EnvC m a = EnvC { runEnv :: m a }
   deriving (Applicative, Functor, Monad, Fail.MonadFail)
 
 instance ( Carrier sig m
          , Member Fresh sig
-         , Member (Reader (Env name)) sig
-         , Ord name
+         , Member (Reader Env) sig
          )
-      => Carrier (A.Env name Precise :+: sig) (EnvC name m) where
+      => Carrier (A.Env Precise :+: sig) (EnvC m) where
   eff (L (A.Alloc _ k))          = fresh >>= k
   eff (L (A.Bind name addr m k)) = local (Map.insert name addr) m >>= k
   eff (L (A.Lookup name k))      = asks (Map.lookup name) >>= k
diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 0128e9a4e..f2a07b210 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -96,14 +96,14 @@ runFile eval file = traverse run file
             . runReader (fileSpan file)
             . runFail
             . runReader @Env mempty
-            . A.runEnv @Name
+            . A.runEnv
             . fix (eval concreteAnalysis)
 
 concreteAnalysis
   :: forall term m sig
   .  ( Carrier sig m
      , Foldable term
-     , Member (A.Env Name Precise) sig
+     , Member (A.Env Precise) sig
      , Member (A.Heap Precise (Concrete (term Name))) sig
      , Member (Reader Env) sig
      , Member (Reader Path.AbsRelFile) sig
diff --git a/semantic-analysis/src/Analysis/Effect/Env.hs b/semantic-analysis/src/Analysis/Effect/Env.hs
index 74e7c3b94..8dc1935fe 100644
--- a/semantic-analysis/src/Analysis/Effect/Env.hs
+++ b/semantic-analysis/src/Analysis/Effect/Env.hs
@@ -10,32 +10,33 @@ module Analysis.Effect.Env
 , run
 ) where
 
+import Analysis.Name
 import Control.Effect.Carrier
 
-alloc :: (Member (Env name addr) sig, Carrier sig m) => name -> m addr
+alloc :: (Member (Env addr) sig, Carrier sig m) => Name -> m addr
 alloc name = send (Alloc name pure)
 
-bind :: (Member (Env name addr) sig, Carrier sig m) => name -> addr -> m a -> m a
+bind :: (Member (Env addr) sig, Carrier sig m) => Name -> addr -> m a -> m a
 bind name addr m = send (Bind name addr m pure)
 
-lookupEnv :: (Member (Env name addr) sig, Carrier sig m) => name -> m (Maybe addr)
+lookupEnv :: (Member (Env addr) sig, Carrier sig m) => Name -> m (Maybe addr)
 lookupEnv name = send (Lookup name pure)
 
 
-data Env name addr m k
-  = Alloc name (addr -> m k)
-  | forall a . Bind name addr (m a) (a -> m k)
-  | Lookup name (Maybe addr -> m k)
+data Env addr m k
+  = Alloc Name (addr -> m k)
+  | forall a . Bind Name addr (m a) (a -> m k)
+  | Lookup Name (Maybe addr -> m k)
 
-deriving instance Functor m => Functor (Env name addr m)
+deriving instance Functor m => Functor (Env addr m)
 
-instance HFunctor (Env name addr) where
+instance HFunctor (Env addr) where
   hmap f = \case
     Alloc name k -> Alloc name (f . k)
     Bind name addr m k -> Bind name addr (f m) (f . k)
     Lookup name k -> Lookup name (f . k)
 
-instance Effect (Env name addr) where
+instance Effect (Env addr) where
   handle ctx hdl = \case
     Alloc name k -> Alloc name (hdl . (<$ ctx) . k)
     Bind name addr m k -> Bind name addr (hdl (m <$ ctx)) (hdl . fmap k)
diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 305e34187..17e661675 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -85,7 +85,7 @@ runFile
 runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
-            . runEnv @Name
+            . runEnv
             . runFail
             . fmap fold
             . convergeTerm (A.runHeap @Name @(Value (term Name)) . fix (cacheTerm . eval importGraphAnalysis))
@@ -95,7 +95,7 @@ importGraphAnalysis
   :: forall term m sig
   .  ( Alternative m
      , Carrier sig m
-     , Member (Env Name Name) sig
+     , Member (Env Name) sig
      , Member (A.Heap Name (Value (term Name))) sig
      , Member (Reader Path.AbsRelFile) sig
      , Member (Reader Span) sig
@@ -109,7 +109,7 @@ importGraphAnalysis = Analysis{..}
           span <- ask
           pure (Value (Closure path span name body) mempty)
         apply eval (Value (Closure path span name body) _) a = local (const path) . local (const span) $ do
-          addr <- alloc @Name @Name name
+          addr <- alloc @Name name
           A.assign addr a
           bind name addr (eval body)
         apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
@@ -121,7 +121,7 @@ importGraphAnalysis = Analysis{..}
         asString _ = pure mempty
         record fields = do
           for_ fields $ \ (k, v) -> do
-            addr <- alloc @Name @Name k
+            addr <- alloc @Name k
             A.assign addr v
           pure (Value Abstract (foldMap (valueGraph . snd) fields))
         _ ... m = pure (Just m)
diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index 0dea2c2ab..1285ace90 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -84,7 +84,7 @@ runFile
 runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
-            . runEnv @Name
+            . runEnv
             . runReader (Map.empty @Name @Ref)
             . runFail
             . fmap fold
@@ -93,7 +93,7 @@ runFile eval file = traverse run file
 scopeGraphAnalysis
   :: ( Alternative m
      , Carrier sig m
-     , Member (Env Name Name) sig
+     , Member (Env Name) sig
      , Member (A.Heap Name (ScopeGraph Name)) sig
      , Member (Reader Path.AbsRelFile) sig
      , Member (Reader Span) sig
@@ -101,7 +101,7 @@ scopeGraphAnalysis
   => Analysis term Name (ScopeGraph Name) m
 scopeGraphAnalysis = Analysis{..}
   where abstract eval name body = do
-          addr <- alloc @Name @Name name
+          addr <- alloc @Name name
           A.assign @Name @(ScopeGraph Name) name mempty
           bind name addr (eval body)
         apply _ f a = pure (f <> a)
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index de01e124f..b993fd7be 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -138,7 +138,7 @@ runFile eval file = traverse run file
           . runState @Substitution mempty
           . runReader (filePath file)
           . runReader (fileSpan file)
-          . runEnv @Name
+          . runEnv
           . runFail
           . (\ m -> do
             (cs, t) <- m
@@ -153,7 +153,7 @@ runFile eval file = traverse run file
 typecheckingAnalysis
   :: ( Alternative m
      , Carrier sig m
-     , Member (Env Name Name) sig
+     , Member (Env Name) sig
      , Member Fresh sig
      , Member (A.Heap Name Type) sig
      , Member (State (Set.Set Constraint)) sig
@@ -162,7 +162,7 @@ typecheckingAnalysis
 typecheckingAnalysis = Analysis{..}
   where abstract eval name body = do
           -- FIXME: construct the associated scope
-          addr <- alloc @Name @Name name
+          addr <- alloc @Name name
           arg <- meta
           A.assign addr arg
           ty <- eval body
@@ -180,7 +180,7 @@ typecheckingAnalysis = Analysis{..}
         asString s = unify (Alg String) s $> mempty
         record fields = do
           fields' <- for fields $ \ (k, v) -> do
-            addr <- alloc @Name @Name k
+            addr <- alloc @Name k
             (k, v) <$ A.assign addr v
           -- FIXME: should records reference types by address instead?
           pure (Alg (Record (Map.fromList fields')))
diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index 88ed761a7..9abc3cc31 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -32,7 +32,7 @@ import qualified System.Path as Path
 
 eval :: forall address value m sig
      .  ( Carrier sig m
-        , Member (Env Name address) sig
+        , Member (Env address) sig
         , Member (Heap address value) sig
         , Member (Reader Span) sig
         , MonadFail m
@@ -45,7 +45,7 @@ eval Analysis{..} eval = \case
   Var n -> lookupEnv' n >>= deref' n
   Alg (R c) -> case c of
     Rec (Named (Ignored n) b) -> do
-      addr <- A.alloc @Name @address n
+      addr <- A.alloc @address n
       v <- A.bind n addr (eval (instantiate1 (pure n) b))
       v <$ A.assign addr v
     -- NB: Combining the results of the evaluations allows us to model effects in abstract domains. This in turn means that we can define an abstract domain modelling the types-and-effects of computations by means of a 'Semigroup' instance which takes the type of its second operand and the union of both operands’ effects.
@@ -54,7 +54,7 @@ eval Analysis{..} eval = \case
     a :>> b -> (<>) <$> eval a <*> eval b
     Named (Ignored n) a :>>= b -> do
       a' <- eval a
-      addr <- A.alloc @Name @address n
+      addr <- A.alloc @address n
       A.assign addr a'
       A.bind n addr ((a' <>) <$> eval (instantiate1 (pure n) b))
     Lam (Named (Ignored n) b) -> abstract eval n (instantiate1 (pure n) b)

From daa24d1e311524e3b3119ac217ccb571d53ddf71 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 12:09:19 -0500
Subject: [PATCH 125/318] :fire: a redundant handler.

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

diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index 1285ace90..463528bb4 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -85,7 +85,6 @@ runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
             . runEnv
-            . runReader (Map.empty @Name @Ref)
             . runFail
             . fmap fold
             . convergeTerm (A.runHeap @Name @(ScopeGraph Name) . fix (cacheTerm . eval scopeGraphAnalysis))

From b4c4ddcf159eff0803176f37a47a94b9b79ee715 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 5 Nov 2019 12:51:38 -0500
Subject: [PATCH 126/318] Simplify the sample .ghci file.

---
 .ghci.sample | 9 ++-------
 1 file changed, 2 insertions(+), 7 deletions(-)

diff --git a/.ghci.sample b/.ghci.sample
index dcbd090ba..acf3ad9e9 100644
--- a/.ghci.sample
+++ b/.ghci.sample
@@ -1,10 +1,8 @@
 -- Consider copying this to your ~/.ghc/ghci.conf file:
 
 -- Pretty-printing
-:set -ignore-package pretty-simple -package pretty-simple
-:def! pretty \ _ -> pure ":set -interactive-print Text.Pretty.Simple.pPrint"
-:def! no-pretty \ _ -> pure ":set -interactive-print System.IO.print"
-:def! r \_ -> pure ":reload\n:pretty"
+:set -package-id prtty-smpl-3.1.0.0-b6696d88
+:set -interactive-print Text.Pretty.Simple.pPrint
 
 -- Turn on some language extensions you use a lot
 :seti -XFlexibleContexts -XOverloadedStrings -XTypeApplications
@@ -26,6 +24,3 @@
 
 -- Better typed holes
 :set -funclutter-valid-hole-fits -fabstract-refinement-hole-fits -frefinement-level-hole-fits=2
-
--- Enable pretty-printing immediately
-:pretty

From f8b1b28a2c8a8f2e4099dedf3b2d7d6a1283be95 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 6 Nov 2019 11:47:40 -0500
Subject: [PATCH 127/318] Move lamFin under unlam.

---
 semantic-analysis/src/Analysis/Intro.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Intro.hs b/semantic-analysis/src/Analysis/Intro.hs
index 0b1d269c7..eab57d797 100644
--- a/semantic-analysis/src/Analysis/Intro.hs
+++ b/semantic-analysis/src/Analysis/Intro.hs
@@ -38,9 +38,6 @@ record fs = send (Record fs)
 lam :: (Eq a, Carrier sig m, Member Intro sig) => Maybe Name -> a -> m a -> m a
 lam u n b = send (Lam u (abstract1 n b))
 
-lamFin :: (Carrier sig m, Member Intro sig) => Maybe Name -> m (Fin ('S n)) -> m (Fin n)
-lamFin u b = send (Lam u (abstractVar (maybe (B ()) F . Fin.strengthen) b))
-
 lams :: (Eq a, Foldable t, Carrier sig m, Member Intro sig) => t (Maybe Name, a) -> m a -> m a
 lams names body = foldr (uncurry lam) body names
 
@@ -48,6 +45,9 @@ unlam :: (Alternative m, Member Intro sig, RightModule sig) => a -> Term sig a -
 unlam n (Alg sig) | Just (Lam n' b) <- prj sig = pure (n', n, instantiate1 (pure n) b)
 unlam _ _                                      = empty
 
+lamFin :: (Carrier sig m, Member Intro sig) => Maybe Name -> m (Fin ('S n)) -> m (Fin n)
+lamFin u b = send (Lam u (abstractVar (maybe (B ()) F . Fin.strengthen) b))
+
 
 data Intro f a
   = Unit

From 14ff79759498e7e7d1cc386d425fceec43c04c0f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 6 Nov 2019 11:51:52 -0500
Subject: [PATCH 128/318] Define an eliminator for lambdas using Fin.

---
 semantic-analysis/src/Analysis/Intro.hs | 5 +++++
 1 file changed, 5 insertions(+)

diff --git a/semantic-analysis/src/Analysis/Intro.hs b/semantic-analysis/src/Analysis/Intro.hs
index eab57d797..8a7702f4c 100644
--- a/semantic-analysis/src/Analysis/Intro.hs
+++ b/semantic-analysis/src/Analysis/Intro.hs
@@ -8,6 +8,7 @@ module Analysis.Intro
 , lamFin
 , lams
 , unlam
+, unlamFin
 , Intro(..)
 , Name(..)
 ) where
@@ -48,6 +49,10 @@ unlam _ _                                      = empty
 lamFin :: (Carrier sig m, Member Intro sig) => Maybe Name -> m (Fin ('S n)) -> m (Fin n)
 lamFin u b = send (Lam u (abstractVar (maybe (B ()) F . Fin.strengthen) b))
 
+unlamFin :: (Alternative m, Member Intro sig, RightModule sig) => Term sig (Fin n) -> m (Maybe Name, Term sig (Fin ('S n)))
+unlamFin (Alg sig) | Just (Lam n b) <- prj sig = pure (n, instantiateVar (unVar (const (pure FZ)) (pure . FS)) b)
+unlamFin _                                     = empty
+
 
 data Intro f a
   = Unit

From ef44b295746fc680eb48b2c538e963dce2460843 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 6 Nov 2019 11:55:28 -0500
Subject: [PATCH 129/318] Define a constructor for Lam using Var.

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

diff --git a/semantic-analysis/src/Analysis/Intro.hs b/semantic-analysis/src/Analysis/Intro.hs
index 8a7702f4c..77072faed 100644
--- a/semantic-analysis/src/Analysis/Intro.hs
+++ b/semantic-analysis/src/Analysis/Intro.hs
@@ -9,6 +9,7 @@ module Analysis.Intro
 , lams
 , unlam
 , unlamFin
+, lam'
 , Intro(..)
 , Name(..)
 ) where
@@ -53,6 +54,9 @@ unlamFin :: (Alternative m, Member Intro sig, RightModule sig) => Term sig (Fin
 unlamFin (Alg sig) | Just (Lam n b) <- prj sig = pure (n, instantiateVar (unVar (const (pure FZ)) (pure . FS)) b)
 unlamFin _                                     = empty
 
+lam' :: (Carrier sig m, Member Intro sig) => Maybe Name -> m (Var () a) -> m a
+lam' u b = send (Lam u (toScope b))
+
 
 data Intro f a
   = Unit

From 812a123d8a59bb373317c89cfb0e126a102a0bb4 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 6 Nov 2019 12:32:39 -0500
Subject: [PATCH 130/318] Sort Name down.

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

diff --git a/semantic-analysis/semantic-analysis.cabal b/semantic-analysis/semantic-analysis.cabal
index 6ab9e27e6..7321151e3 100644
--- a/semantic-analysis/semantic-analysis.cabal
+++ b/semantic-analysis/semantic-analysis.cabal
@@ -49,10 +49,10 @@ library
     Analysis.Effect.Env
     Analysis.Effect.Heap
     Analysis.File
-    Analysis.Name
     Analysis.FlowInsensitive
     Analysis.ImportGraph
     Analysis.Intro
+    Analysis.Name
     Analysis.ScopeGraph
     Analysis.Typecheck
     Control.Carrier.Fail.WithLoc

From 903e73cba8d001d828b3c36c0f52d31d24a52a4b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 6 Nov 2019 12:33:15 -0500
Subject: [PATCH 131/318] Stub in a module for the Domain effect.

---
 semantic-analysis/semantic-analysis.cabal       | 1 +
 semantic-analysis/src/Analysis/Effect/Domain.hs | 2 ++
 2 files changed, 3 insertions(+)
 create mode 100644 semantic-analysis/src/Analysis/Effect/Domain.hs

diff --git a/semantic-analysis/semantic-analysis.cabal b/semantic-analysis/semantic-analysis.cabal
index 7321151e3..358141303 100644
--- a/semantic-analysis/semantic-analysis.cabal
+++ b/semantic-analysis/semantic-analysis.cabal
@@ -46,6 +46,7 @@ library
     Analysis.Carrier.Heap.Monovariant
     Analysis.Carrier.Heap.Precise
     Analysis.Concrete
+    Analysis.Effect.Domain
     Analysis.Effect.Env
     Analysis.Effect.Heap
     Analysis.File
diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
new file mode 100644
index 000000000..04d422485
--- /dev/null
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -0,0 +1,2 @@
+module Analysis.Effect.Domain
+() where

From 374f90dc7ea5ecc7f431cd9a1a1733fc86514090 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 6 Nov 2019 12:35:07 -0500
Subject: [PATCH 132/318] Re-export some stuff.

---
 semantic-analysis/src/Analysis/Effect/Domain.hs | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index 04d422485..159366a0a 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -1,2 +1,7 @@
 module Analysis.Effect.Domain
-() where
+( -- * Re-exports
+  Carrier
+, run
+) where
+
+import Control.Effect.Carrier

From e8a47496531b2bc5d15c31a2d0f95dd383ff3e8a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 6 Nov 2019 12:37:58 -0500
Subject: [PATCH 133/318] Stub in a Domain effect with abstraction &
 concretization operations.

---
 semantic-analysis/src/Analysis/Effect/Domain.hs | 12 ++++++++++--
 1 file changed, 10 insertions(+), 2 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index 159366a0a..10250cbb3 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -1,7 +1,15 @@
+{-# LANGUAGE DeriveFunctor #-}
 module Analysis.Effect.Domain
-( -- * Re-exports
-  Carrier
+( -- * Domain effect
+  Domain(..)
+  -- * Re-exports
+, Carrier
 , run
 ) where
 
 import Control.Effect.Carrier
+
+data Domain term value m k
+  = Abstract term (value -> m k)
+  | Concretize value (term -> m k)
+  deriving (Functor)

From 7b9e1c0d8843d823b69d237b7f161195e2267c7d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 6 Nov 2019 12:39:05 -0500
Subject: [PATCH 134/318] Derive a Generic1 instance for Domain.

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

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index 10250cbb3..c8804cf05 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveFunctor, DeriveGeneric #-}
 module Analysis.Effect.Domain
 ( -- * Domain effect
   Domain(..)
@@ -8,8 +8,9 @@ module Analysis.Effect.Domain
 ) where
 
 import Control.Effect.Carrier
+import GHC.Generics (Generic1)
 
 data Domain term value m k
   = Abstract term (value -> m k)
   | Concretize value (term -> m k)
-  deriving (Functor)
+  deriving (Functor, Generic1)

From 6e1503c1ef34525431c973e14ff61f12520bb074 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 6 Nov 2019 12:39:39 -0500
Subject: [PATCH 135/318] Define an HFunctor instance for Domain.

---
 semantic-analysis/src/Analysis/Effect/Domain.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index c8804cf05..bbae815e8 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -14,3 +14,5 @@ data Domain term value m k
   = Abstract term (value -> m k)
   | Concretize value (term -> m k)
   deriving (Functor, Generic1)
+
+instance HFunctor (Domain term value)

From 180af3f1dca26a1d45fb465ba8556b84d237b9f6 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 6 Nov 2019 12:39:44 -0500
Subject: [PATCH 136/318] Define an Effect instance for Domain.

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

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index bbae815e8..c24210425 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -16,3 +16,4 @@ data Domain term value m k
   deriving (Functor, Generic1)
 
 instance HFunctor (Domain term value)
+instance Effect   (Domain term value)

From d4a1080563782e41784fcb48d652d331d0169661 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 6 Nov 2019 12:40:50 -0500
Subject: [PATCH 137/318] Align.

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

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index c24210425..5c552e5cb 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -11,8 +11,8 @@ import Control.Effect.Carrier
 import GHC.Generics (Generic1)
 
 data Domain term value m k
-  = Abstract term (value -> m k)
-  | Concretize value (term -> m k)
+  = Abstract   term  (value -> m k)
+  | Concretize value (term  -> m k)
   deriving (Functor, Generic1)
 
 instance HFunctor (Domain term value)

From 0dd17dcc364bff4a571c3478a5f434854d331da3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 6 Nov 2019 12:44:03 -0500
Subject: [PATCH 138/318] Define a smart constructor for abstracting domain
 values.

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

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index 5c552e5cb..879edc3e8 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -1,7 +1,8 @@
-{-# LANGUAGE DeriveFunctor, DeriveGeneric #-}
+{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts #-}
 module Analysis.Effect.Domain
 ( -- * Domain effect
-  Domain(..)
+  abstract
+, Domain(..)
   -- * Re-exports
 , Carrier
 , run
@@ -10,6 +11,10 @@ module Analysis.Effect.Domain
 import Control.Effect.Carrier
 import GHC.Generics (Generic1)
 
+abstract :: (Member (Domain term value) sig, Carrier sig m) => term -> m value
+abstract term = send (Abstract term pure)
+
+
 data Domain term value m k
   = Abstract   term  (value -> m k)
   | Concretize value (term  -> m k)

From 34f32970cd683b1d1eae83d7690810d3b14a90e9 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 6 Nov 2019 12:44:52 -0500
Subject: [PATCH 139/318] Define a smart constructor for concretization.

---
 semantic-analysis/src/Analysis/Effect/Domain.hs | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index 879edc3e8..255ac9a10 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -2,6 +2,7 @@
 module Analysis.Effect.Domain
 ( -- * Domain effect
   abstract
+, concretize
 , Domain(..)
   -- * Re-exports
 , Carrier
@@ -14,6 +15,9 @@ import GHC.Generics (Generic1)
 abstract :: (Member (Domain term value) sig, Carrier sig m) => term -> m value
 abstract term = send (Abstract term pure)
 
+concretize :: (Member (Domain term value) sig, Carrier sig m) => value -> m term
+concretize value = send (Concretize value pure)
+
 
 data Domain term value m k
   = Abstract   term  (value -> m k)

From 445737a92c2ec90f70a8b0e2d6590caa64386e05 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 6 Nov 2019 12:46:39 -0500
Subject: [PATCH 140/318] :fire: the old Domain effect.

---
 semantic-analysis/src/Analysis/Analysis.hs | 24 ----------------------
 1 file changed, 24 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 849c82d21..84124a618 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -1,12 +1,9 @@
-{-# LANGUAGE DeriveFunctor, DeriveGeneric, ExistentialQuantification, FlexibleContexts, LambdaCase, RankNTypes, StandaloneDeriving #-}
 module Analysis.Analysis
 ( Analysis(..)
 ) where
 
 import Analysis.Name
-import Control.Effect.Carrier
 import Data.Text (Text)
-import GHC.Generics (Generic1)
 
 -- | A record of functions necessary to perform analysis.
 --
@@ -22,24 +19,3 @@ data Analysis term address value m = Analysis
   , record    :: [(Name, value)] -> m value
   , (...)     :: address -> Name -> m (Maybe address)
   }
-
-
-data Domain term value m k
-  -- Functions construction & elimination
-  = Abstract Name (term Name)                 (value term -> m k)
-  | Apply (value term) (value term) (value term -> m k)
-  -- Unit construction (no elimination)
-  | Unit (value term -> m k)
-  -- Boolean construction & elimination
-  | Bool   Bool              (value term -> m k)
-  | AsBool (value term) (Bool            -> m k)
-  -- String construction & elimination
-  | String   Text              (value term -> m k)
-  | AsString (value term) (Text            -> m k)
-  -- Record construction & elimination
-  | Record [(Name, value term)] (value term         -> m k)
-  | Project (value term) Name   (Maybe (value term) -> m k)
-  deriving (Functor, Generic1)
-
-instance HFunctor (Domain term value)
-instance Effect   (Domain term value)

From fd19464be549c4b39cc5aa786f225bd0e16c8c63 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 6 Nov 2019 12:47:40 -0500
Subject: [PATCH 141/318] Rename the parameters to Domain.

---
 .../src/Analysis/Effect/Domain.hs              | 18 +++++++++---------
 1 file changed, 9 insertions(+), 9 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index 255ac9a10..4da0ff521 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -12,17 +12,17 @@ module Analysis.Effect.Domain
 import Control.Effect.Carrier
 import GHC.Generics (Generic1)
 
-abstract :: (Member (Domain term value) sig, Carrier sig m) => term -> m value
-abstract term = send (Abstract term pure)
+abstract :: (Member (Domain concrete abstract) sig, Carrier sig m) => concrete -> m abstract
+abstract concrete = send (Abstract concrete pure)
 
-concretize :: (Member (Domain term value) sig, Carrier sig m) => value -> m term
-concretize value = send (Concretize value pure)
+concretize :: (Member (Domain concrete abstract) sig, Carrier sig m) => abstract -> m concrete
+concretize abstract = send (Concretize abstract pure)
 
 
-data Domain term value m k
-  = Abstract   term  (value -> m k)
-  | Concretize value (term  -> m k)
+data Domain concrete abstract m k
+  = Abstract   concrete (abstract -> m k)
+  | Concretize abstract (concrete -> m k)
   deriving (Functor, Generic1)
 
-instance HFunctor (Domain term value)
-instance Effect   (Domain term value)
+instance HFunctor (Domain concrete abstract)
+instance Effect   (Domain concrete abstract)

From 4a0aa126fd3033504d85ff401c4fa991850d93e9 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 6 Nov 2019 12:48:09 -0500
Subject: [PATCH 142/318] Spacing.

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

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 84124a618..14c29fc57 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -9,13 +9,13 @@ import Data.Text (Text)
 --
 -- This is intended to be replaced with a selection of algebraic effects providing these interfaces and carriers providing reusable implementations.
 data Analysis term address value m = Analysis
-  { abstract  :: (term Name -> m value) -> Name -> term Name -> m value
-  , apply     :: (term Name -> m value) -> value -> value -> m value
-  , unit      :: m value
-  , bool      :: Bool -> m value
-  , asBool    :: value -> m Bool
-  , string    :: Text -> m value
-  , asString  :: value -> m Text
-  , record    :: [(Name, value)] -> m value
-  , (...)     :: address -> Name -> m (Maybe address)
+  { abstract :: (term Name -> m value) -> Name -> term Name -> m value
+  , apply    :: (term Name -> m value) -> value -> value -> m value
+  , unit     :: m value
+  , bool     :: Bool -> m value
+  , asBool   :: value -> m Bool
+  , string   :: Text -> m value
+  , asString :: value -> m Text
+  , record   :: [(Name, value)] -> m value
+  , (...)    :: address -> Name -> m (Maybe address)
   }

From 4185f213e302ebf2df6e9f028f6c5a22cc165bd7 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 7 Nov 2019 10:37:34 -0500
Subject: [PATCH 143/318] Remove everything but the primitives from Intro.

---
 semantic-analysis/src/Analysis/Intro.hs | 76 +------------------------
 1 file changed, 3 insertions(+), 73 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Intro.hs b/semantic-analysis/src/Analysis/Intro.hs
index 77072faed..08b473db2 100644
--- a/semantic-analysis/src/Analysis/Intro.hs
+++ b/semantic-analysis/src/Analysis/Intro.hs
@@ -1,81 +1,11 @@
-{-# LANGUAGE DataKinds, DeriveGeneric, DeriveTraversable, FlexibleContexts, QuantifiedConstraints, StandaloneDeriving #-}
 module Analysis.Intro
-( unit
-, bool
-, string
-, record
-, lam
-, lamFin
-, lams
-, unlam
-, unlamFin
-, lam'
-, Intro(..)
-, Name(..)
+( Intro(..)
 ) where
 
-import Analysis.Name
-import Control.Applicative (Alternative(..))
-import Control.Effect.Carrier
 import Data.Text (Text)
-import GHC.Generics (Generic1)
-import Syntax.Fin as Fin
-import Syntax.Module
-import Syntax.Scope
-import Syntax.Term
-import Syntax.Var
 
-unit :: (Carrier sig m, Member Intro sig) => m a
-unit = send Unit
-
-bool :: (Carrier sig m, Member Intro sig) => Bool -> m a
-bool = send . Bool
-
-string :: (Carrier sig m, Member Intro sig) => Text -> m a
-string = send . String
-
-record :: (Carrier sig m, Member Intro sig) => [(Name, m a)] -> m a
-record fs = send (Record fs)
-
-lam :: (Eq a, Carrier sig m, Member Intro sig) => Maybe Name -> a -> m a -> m a
-lam u n b = send (Lam u (abstract1 n b))
-
-lams :: (Eq a, Foldable t, Carrier sig m, Member Intro sig) => t (Maybe Name, a) -> m a -> m a
-lams names body = foldr (uncurry lam) body names
-
-unlam :: (Alternative m, Member Intro sig, RightModule sig) => a -> Term sig a -> m (Maybe Name, a, Term sig a)
-unlam n (Alg sig) | Just (Lam n' b) <- prj sig = pure (n', n, instantiate1 (pure n) b)
-unlam _ _                                      = empty
-
-lamFin :: (Carrier sig m, Member Intro sig) => Maybe Name -> m (Fin ('S n)) -> m (Fin n)
-lamFin u b = send (Lam u (abstractVar (maybe (B ()) F . Fin.strengthen) b))
-
-unlamFin :: (Alternative m, Member Intro sig, RightModule sig) => Term sig (Fin n) -> m (Maybe Name, Term sig (Fin ('S n)))
-unlamFin (Alg sig) | Just (Lam n b) <- prj sig = pure (n, instantiateVar (unVar (const (pure FZ)) (pure . FS)) b)
-unlamFin _                                     = empty
-
-lam' :: (Carrier sig m, Member Intro sig) => Maybe Name -> m (Var () a) -> m a
-lam' u b = send (Lam u (toScope b))
-
-
-data Intro f a
+data Intro
   = Unit
   | Bool Bool
   | String Text
-  | Record [(Name, f a)]
-  | Lam (Maybe Name) (Scope () f a)
-  deriving (Foldable, Functor, Generic1, Traversable)
-
-deriving instance (Eq   a, forall a . Eq   a => Eq   (f a), Monad f) => Eq   (Intro f a)
-deriving instance (Ord  a, forall a . Eq   a => Eq   (f a)
-                         , forall a . Ord  a => Ord  (f a), Monad f) => Ord  (Intro f a)
-deriving instance (Show a, forall a . Show a => Show (f a))          => Show (Intro f a)
-
-instance HFunctor Intro
-
-instance RightModule Intro where
-  Unit       >>=* _ = Unit
-  Bool b     >>=* _ = Bool b
-  String s   >>=* _ = String s
-  Record fs  >>=* f = Record (map (fmap (>>= f)) fs)
-  Lam n b    >>=* f = Lam n (b >>=* f)
+  deriving (Eq, Ord, Show)

From 27559f8f0eee34d44126e04e62775506d76a742c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 7 Nov 2019 10:53:49 -0500
Subject: [PATCH 144/318] Specialize the Domain effect to Intro.

---
 semantic-analysis/src/Analysis/Effect/Domain.hs | 15 ++++++++-------
 1 file changed, 8 insertions(+), 7 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index 4da0ff521..acda95d19 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -9,20 +9,21 @@ module Analysis.Effect.Domain
 , run
 ) where
 
+import Analysis.Intro
 import Control.Effect.Carrier
 import GHC.Generics (Generic1)
 
-abstract :: (Member (Domain concrete abstract) sig, Carrier sig m) => concrete -> m abstract
+abstract :: (Member (Domain abstract) sig, Carrier sig m) => Intro -> m abstract
 abstract concrete = send (Abstract concrete pure)
 
-concretize :: (Member (Domain concrete abstract) sig, Carrier sig m) => abstract -> m concrete
+concretize :: (Member (Domain abstract) sig, Carrier sig m) => abstract -> m Intro
 concretize abstract = send (Concretize abstract pure)
 
 
-data Domain concrete abstract m k
-  = Abstract   concrete (abstract -> m k)
-  | Concretize abstract (concrete -> m k)
+data Domain abstract m k
+  = Abstract   Intro    (abstract -> m k)
+  | Concretize abstract (Intro    -> m k)
   deriving (Functor, Generic1)
 
-instance HFunctor (Domain concrete abstract)
-instance Effect   (Domain concrete abstract)
+instance HFunctor (Domain abstract)
+instance Effect   (Domain abstract)

From 56cc4e1040d2762b55aaa51512afb19e0abd029b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 7 Nov 2019 11:01:41 -0500
Subject: [PATCH 145/318] Construct Unit, Bool, & String via the Domain effect.

---
 semantic-core/src/Core/Eval.hs | 13 ++++++++-----
 1 file changed, 8 insertions(+), 5 deletions(-)

diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index 9abc3cc31..9cea6d94f 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -11,9 +11,11 @@ module Core.Eval
 ) where
 
 import Analysis.Analysis
+import Analysis.Effect.Domain as A
 import Analysis.Effect.Env as A
 import Analysis.Effect.Heap as A
 import Analysis.File
+import qualified Analysis.Intro as A
 import Control.Applicative (Alternative (..))
 import Control.Effect.Carrier
 import Control.Effect.Fail
@@ -32,6 +34,7 @@ import qualified System.Path as Path
 
 eval :: forall address value m sig
      .  ( Carrier sig m
+        , Member (Domain value) sig
         , Member (Env address) sig
         , Member (Heap address value) sig
         , Member (Reader Span) sig
@@ -62,13 +65,13 @@ eval Analysis{..} eval = \case
       f' <- eval f
       a' <- eval a
       apply eval f' a'
-    Unit -> unit
-    Bool b -> bool b
+    Unit -> A.abstract A.Unit
+    Bool b -> A.abstract (A.Bool b)
     If c t e -> do
       c' <- eval c >>= asBool
       if c' then eval t else eval e
-    String s -> string s
-    Load p -> eval p >>= asString >> unit -- FIXME: add a load command or something
+    String s -> A.abstract (A.String s)
+    Load p -> eval p >>= asString >> A.abstract A.Unit -- FIXME: add a load command or something
     Record fields -> traverse (traverse eval) fields >>= record
     a :. b -> do
       a' <- ref a
@@ -76,7 +79,7 @@ eval Analysis{..} eval = \case
     a :? b -> do
       a' <- ref a
       mFound <- a' ... b
-      bool (isJust mFound)
+      A.abstract (A.Bool (isJust mFound))
 
     a := b -> do
       b' <- eval b

From 4ede4ae68b2da57a446e7b50c6e545e983d48fbc Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 7 Nov 2019 11:03:10 -0500
Subject: [PATCH 146/318] Concretize values via the Domain effect.

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

diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index 9cea6d94f..20a7719e2 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -68,10 +68,10 @@ eval Analysis{..} eval = \case
     Unit -> A.abstract A.Unit
     Bool b -> A.abstract (A.Bool b)
     If c t e -> do
-      c' <- eval c >>= asBool
+      A.Bool c' <- eval c >>= A.concretize
       if c' then eval t else eval e
     String s -> A.abstract (A.String s)
-    Load p -> eval p >>= asString >> A.abstract A.Unit -- FIXME: add a load command or something
+    Load p -> eval p >>= A.concretize >> A.abstract A.Unit -- FIXME: add a load command or something
     Record fields -> traverse (traverse eval) fields >>= record
     a :. b -> do
       a' <- ref a
@@ -97,7 +97,7 @@ eval Analysis{..} eval = \case
           Var n -> lookupEnv' n
           Alg (R c) -> case c of
             If c t e -> do
-              c' <- eval c >>= asBool
+              A.Bool c' <- eval c >>= A.concretize
               if c' then ref t else ref e
             a :. b -> do
               a' <- ref a

From ee8017d8dde55bc835a3d388e9ffe757c92c8b00 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 7 Nov 2019 11:44:42 -0500
Subject: [PATCH 147/318] Define a Domain carrier for typechecking.

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

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index b993fd7be..cf3f3ae6e 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -10,6 +10,8 @@ module Analysis.Typecheck
 import           Analysis.Analysis
 import           Analysis.Carrier.Env.Monovariant
 import qualified Analysis.Carrier.Heap.Monovariant as A
+import           Analysis.Effect.Domain
+import qualified Analysis.Intro as Intro
 import           Analysis.File
 import           Analysis.FlowInsensitive
 import           Analysis.Name
@@ -232,3 +234,19 @@ mvs = foldMap IntSet.singleton
 
 substAll :: Monad t => IntMap.IntMap (t Meta) -> t Meta -> t Meta
 substAll s a = a >>= \ i -> fromMaybe (pure i) (IntMap.lookup i s)
+
+
+newtype DomainC m a = DomainC { runDomain :: m a }
+  deriving (Alternative, Applicative, Functor, Monad, MonadFail)
+
+instance (Alternative m, Carrier sig m, MonadFail m) => Carrier (Domain Type :+: sig) (DomainC m) where
+  eff (L (Abstract v k)) = case v of
+    Intro.Unit     -> k (Alg Unit)
+    Intro.Bool   _ -> k (Alg Bool)
+    Intro.String _ -> k (Alg String)
+  eff (L (Concretize t k)) = case t of
+    Alg Unit   -> k Intro.Unit
+    Alg Bool   -> k (Intro.Bool True) <|> k (Intro.Bool False)
+    Alg String -> k (Intro.String mempty)
+    t -> fail ("can’t concretize " <> show t)
+  eff (R other) = DomainC (eff (handleCoercible other))

From 38e42c0cd98800f5e787c58bd6a41c1839fc1e2f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 7 Nov 2019 12:49:05 -0500
Subject: [PATCH 148/318] Align.

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

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index cf3f3ae6e..ab90a10c4 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -248,5 +248,5 @@ instance (Alternative m, Carrier sig m, MonadFail m) => Carrier (Domain Type :+:
     Alg Unit   -> k Intro.Unit
     Alg Bool   -> k (Intro.Bool True) <|> k (Intro.Bool False)
     Alg String -> k (Intro.String mempty)
-    t -> fail ("can’t concretize " <> show t)
+    t          -> fail ("can’t concretize " <> show t)
   eff (R other) = DomainC (eff (handleCoercible other))

From 99184605bd39d8a3e96ce11ccef749032d7c510e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 7 Nov 2019 13:11:38 -0500
Subject: [PATCH 149/318] Run the domain effect during convergence.

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

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index ab90a10c4..240f0a5c1 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -150,7 +150,7 @@ runFile eval file = traverse run file
               v <- meta
               bs <- m
               v <$ for_ bs (unify v))
-          . convergeTerm (A.runHeap @Name @Type . fix (cacheTerm . eval typecheckingAnalysis))
+          . convergeTerm (runDomain . A.runHeap @Name @Type . fix (cacheTerm . eval typecheckingAnalysis))
 
 typecheckingAnalysis
   :: ( Alternative m

From a468a66e9ed5c43627a17a9bba11b0295c6854e2 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 13 Dec 2019 11:33:58 -0500
Subject: [PATCH 150/318] :fire: bool/asBool.

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

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 14c29fc57..8afb399e1 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -12,8 +12,6 @@ data Analysis term address value m = Analysis
   { abstract :: (term Name -> m value) -> Name -> term Name -> m value
   , apply    :: (term Name -> m value) -> value -> value -> m value
   , unit     :: m value
-  , bool     :: Bool -> m value
-  , asBool   :: value -> m Bool
   , string   :: Text -> m value
   , asString :: value -> m Text
   , record   :: [(Name, value)] -> m value
diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 3c74d3e18..0d649ca61 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -125,9 +125,6 @@ concreteAnalysis = Analysis{..}
             local (const (Map.insert name addr env)) (eval body)
         apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
         unit = pure Unit
-        bool b = pure (Bool b)
-        asBool (Bool b) = pure b
-        asBool v        = fail $ "Cannot coerce " <> show v <> " to Bool"
         string s = pure (String s)
         asString (String s) = pure s
         asString v          = fail $ "Cannot coerce " <> show v <> " to String"
diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 961207618..7581122bf 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -112,8 +112,6 @@ importGraphAnalysis = Analysis{..}
           bind name addr (eval body)
         apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
         unit = pure mempty
-        bool _ = pure mempty
-        asBool _ = pure True <|> pure False
         string s = pure (Value (String s) mempty)
         asString (Value (String s) _) = pure s
         asString _ = pure mempty
diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index d7a3f2d82..1b3466b70 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -103,8 +103,6 @@ scopeGraphAnalysis = Analysis{..}
           bind name addr (eval body)
         apply _ f a = pure (f <> a)
         unit = pure mempty
-        bool _ = pure mempty
-        asBool _ = pure True <|> pure False
         string _ = pure mempty
         asString _ = pure mempty
         record fields = do
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index cf1baa737..be610cd94 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -170,8 +170,6 @@ typecheckingAnalysis = Analysis{..}
           unify _A a
           pure _B
         unit = pure (Alg Unit)
-        bool _ = pure (Alg Bool)
-        asBool b = unify (Alg Bool) b >> pure True <|> pure False
         string _ = pure (Alg String)
         asString s = unify (Alg String) s $> mempty
         record fields = do

From 9a3e06b0704925223f91dd3977dd1b03890600d2 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 13 Dec 2019 11:36:49 -0500
Subject: [PATCH 151/318] Define smart constructors for unit, bool, & string
 construction.

---
 semantic-analysis/src/Analysis/Effect/Domain.hs | 16 +++++++++++++++-
 1 file changed, 15 insertions(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index 72cd4fa22..ce58ac2fb 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -3,6 +3,9 @@ module Analysis.Effect.Domain
 ( -- * Domain effect
   abstract
 , concretize
+, unit
+, bool
+, string
 , Domain(..)
   -- * Re-exports
 , Algebra
@@ -10,8 +13,9 @@ module Analysis.Effect.Domain
 , run
 ) where
 
-import Analysis.Intro
+import Analysis.Intro as A
 import Control.Algebra
+import Data.Text (Text)
 import GHC.Generics (Generic1)
 
 abstract :: Has (Domain abstract) sig m => Intro -> m abstract
@@ -21,6 +25,16 @@ concretize :: Has (Domain abstract) sig m => abstract -> m Intro
 concretize abstract = send (Concretize abstract pure)
 
 
+unit :: Has (Domain abstract) sig m => m abstract
+unit = abstract A.Unit
+
+bool :: Has (Domain abstract) sig m => Bool -> m abstract
+bool = abstract . A.Bool
+
+string :: Has (Domain abstract) sig m => Text -> m abstract
+string = abstract . A.String
+
+
 data Domain abstract m k
   = Abstract   Intro    (abstract -> m k)
   | Concretize abstract (Intro    -> m k)

From d113cc4ea9e759db8c6a3abfdac7a0e242371380 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 13 Dec 2019 11:38:10 -0500
Subject: [PATCH 152/318] Use the smart constructors to tidy up Core.Eval.

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

diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index 07c0cca31..2535859de 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -64,13 +64,13 @@ eval Analysis{..} eval = \case
       f' <- eval f
       a' <- eval a
       apply eval f' a'
-    Unit -> A.abstract A.Unit
-    Bool b -> A.abstract (A.Bool b)
+    Unit -> A.unit
+    Bool b -> A.bool b
     If c t e -> do
       A.Bool c' <- eval c >>= A.concretize
       if c' then eval t else eval e
-    String s -> A.abstract (A.String s)
-    Load p -> eval p >>= A.concretize >> A.abstract A.Unit -- FIXME: add a load command or something
+    String s -> A.string s
+    Load p -> eval p >>= A.concretize >> A.unit -- FIXME: add a load command or something
     Record fields -> traverse (traverse eval) fields >>= record
     a :. b -> do
       a' <- ref a
@@ -78,7 +78,7 @@ eval Analysis{..} eval = \case
     a :? b -> do
       a' <- ref a
       mFound <- a' ... b
-      A.abstract (A.Bool (isJust mFound))
+      A.bool (isJust mFound)
 
     a := b -> do
       b' <- eval b

From a8d670cd190c05c1bd3b8ac53fa42c1660d4e019 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 13 Dec 2019 11:42:58 -0500
Subject: [PATCH 153/318] Define smart constructors for concretization at
 specific types.

---
 .../src/Analysis/Effect/Domain.hs             | 20 ++++++++++++++++++-
 1 file changed, 19 insertions(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index ce58ac2fb..eae38bbf4 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -1,11 +1,13 @@
-{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts #-}
+{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, LambdaCase #-}
 module Analysis.Effect.Domain
 ( -- * Domain effect
   abstract
 , concretize
 , unit
 , bool
+, asBool
 , string
+, asString
 , Domain(..)
   -- * Re-exports
 , Algebra
@@ -15,6 +17,8 @@ module Analysis.Effect.Domain
 
 import Analysis.Intro as A
 import Control.Algebra
+import Control.Monad ((>=>))
+import Control.Monad.Fail as Fail
 import Data.Text (Text)
 import GHC.Generics (Generic1)
 
@@ -31,9 +35,19 @@ unit = abstract A.Unit
 bool :: Has (Domain abstract) sig m => Bool -> m abstract
 bool = abstract . A.Bool
 
+asBool :: (Has (Domain abstract) sig m, MonadFail m) => abstract -> m Bool
+asBool = concretize >=> \case
+  A.Bool b -> pure b
+  other    -> typeError "Bool" other
+
 string :: Has (Domain abstract) sig m => Text -> m abstract
 string = abstract . A.String
 
+asString :: (Has (Domain abstract) sig m, MonadFail m) => abstract -> m Text
+asString = concretize >=> \case
+  A.String t -> pure t
+  other      -> typeError "String" other
+
 
 data Domain abstract m k
   = Abstract   Intro    (abstract -> m k)
@@ -42,3 +56,7 @@ data Domain abstract m k
 
 instance HFunctor (Domain abstract)
 instance Effect   (Domain abstract)
+
+
+typeError :: (Show a, MonadFail m) => String -> a -> m b
+typeError expected actual = Fail.fail $ "expected " <> expected <> ", got " <> show actual

From fbd86f3115918c6ace51d9d36ab9827edaa5ee2c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 13 Dec 2019 11:43:56 -0500
Subject: [PATCH 154/318] Concretize using the smart constructors.

---
 semantic-core/src/Core/Eval.hs | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index 2535859de..abed45aa7 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -15,7 +15,6 @@ import Analysis.Effect.Domain as A
 import Analysis.Effect.Env as A
 import Analysis.Effect.Heap as A
 import Analysis.File
-import qualified Analysis.Intro as A
 import Control.Algebra
 import Control.Applicative (Alternative (..))
 import Control.Effect.Fail
@@ -67,10 +66,10 @@ eval Analysis{..} eval = \case
     Unit -> A.unit
     Bool b -> A.bool b
     If c t e -> do
-      A.Bool c' <- eval c >>= A.concretize
+      c' <- eval c >>= A.asBool
       if c' then eval t else eval e
     String s -> A.string s
-    Load p -> eval p >>= A.concretize >> A.unit -- FIXME: add a load command or something
+    Load p -> eval p >>= A.asString >> A.unit -- FIXME: add a load command or something
     Record fields -> traverse (traverse eval) fields >>= record
     a :. b -> do
       a' <- ref a
@@ -96,7 +95,7 @@ eval Analysis{..} eval = \case
           Var n -> lookupEnv' n
           Alg (R c) -> case c of
             If c t e -> do
-              A.Bool c' <- eval c >>= A.concretize
+              c' <- eval c >>= A.asBool
               if c' then ref t else ref e
             a :. b -> do
               a' <- ref a

From 0fc9f5dc6d97b9117285b21ecfe2d564f2328a8a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 13 Dec 2019 11:44:57 -0500
Subject: [PATCH 155/318] :fire: unit from Analysis.

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

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 8afb399e1..2ae528f2e 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -11,7 +11,6 @@ import Data.Text (Text)
 data Analysis term address value m = Analysis
   { abstract :: (term Name -> m value) -> Name -> term Name -> m value
   , apply    :: (term Name -> m value) -> value -> value -> m value
-  , unit     :: m value
   , string   :: Text -> m value
   , asString :: value -> m Text
   , record   :: [(Name, value)] -> m value
diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 0d649ca61..d2d3d7c40 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -124,7 +124,6 @@ concreteAnalysis = Analysis{..}
             A.assign addr a
             local (const (Map.insert name addr env)) (eval body)
         apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
-        unit = pure Unit
         string s = pure (String s)
         asString (String s) = pure s
         asString v          = fail $ "Cannot coerce " <> show v <> " to String"
diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 7581122bf..f49d72ff8 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -111,7 +111,6 @@ importGraphAnalysis = Analysis{..}
           A.assign addr a
           bind name addr (eval body)
         apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
-        unit = pure mempty
         string s = pure (Value (String s) mempty)
         asString (Value (String s) _) = pure s
         asString _ = pure mempty
diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index 1b3466b70..8355163e3 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -102,7 +102,6 @@ scopeGraphAnalysis = Analysis{..}
           A.assign @Name @(ScopeGraph Name) name mempty
           bind name addr (eval body)
         apply _ f a = pure (f <> a)
-        unit = pure mempty
         string _ = pure mempty
         asString _ = pure mempty
         record fields = do
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index be610cd94..ec1086e13 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -169,7 +169,6 @@ typecheckingAnalysis = Analysis{..}
           unify (Alg (_A :-> _B)) f
           unify _A a
           pure _B
-        unit = pure (Alg Unit)
         string _ = pure (Alg String)
         asString s = unify (Alg String) s $> mempty
         record fields = do

From aac1c92dc98515e9e09e447193bc918e5b81a485 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 13 Dec 2019 11:46:04 -0500
Subject: [PATCH 156/318] :fire: string/asString from Analysis.

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

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 2ae528f2e..3e8904a72 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -3,7 +3,6 @@ module Analysis.Analysis
 ) where
 
 import Analysis.Name
-import Data.Text (Text)
 
 -- | A record of functions necessary to perform analysis.
 --
@@ -11,8 +10,6 @@ import Data.Text (Text)
 data Analysis term address value m = Analysis
   { abstract :: (term Name -> m value) -> Name -> term Name -> m value
   , apply    :: (term Name -> m value) -> value -> value -> m value
-  , string   :: Text -> m value
-  , asString :: value -> m Text
   , record   :: [(Name, value)] -> m value
   , (...)    :: address -> Name -> m (Maybe address)
   }
diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index d2d3d7c40..da2bc59e9 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -124,9 +124,6 @@ concreteAnalysis = Analysis{..}
             A.assign addr a
             local (const (Map.insert name addr env)) (eval body)
         apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
-        string s = pure (String s)
-        asString (String s) = pure s
-        asString v          = fail $ "Cannot coerce " <> show v <> " to String"
         record fields = do
           fields' <- for fields $ \ (name, value) -> do
             addr <- A.alloc name
diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index f49d72ff8..d1c749b5f 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -111,9 +111,6 @@ importGraphAnalysis = Analysis{..}
           A.assign addr a
           bind name addr (eval body)
         apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
-        string s = pure (Value (String s) mempty)
-        asString (Value (String s) _) = pure s
-        asString _ = pure mempty
         record fields = do
           for_ fields $ \ (k, v) -> do
             addr <- alloc @Name k
diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index 8355163e3..0b3f6ba26 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -102,8 +102,6 @@ scopeGraphAnalysis = Analysis{..}
           A.assign @Name @(ScopeGraph Name) name mempty
           bind name addr (eval body)
         apply _ f a = pure (f <> a)
-        string _ = pure mempty
-        asString _ = pure mempty
         record fields = do
           fields' <- for fields $ \ (k, v) -> do
             addr <- alloc k
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index ec1086e13..464868f25 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -169,8 +169,6 @@ typecheckingAnalysis = Analysis{..}
           unify (Alg (_A :-> _B)) f
           unify _A a
           pure _B
-        string _ = pure (Alg String)
-        asString s = unify (Alg String) s $> mempty
         record fields = do
           fields' <- for fields $ \ (k, v) -> do
             addr <- alloc @Name k

From 3ecb1980f83698847be8a096a40946c90f6fcd35 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 16 Dec 2019 11:41:25 -0500
Subject: [PATCH 157/318] Build all the dependencies in the dist-repl dir.

---
 script/repl | 8 +++-----
 1 file changed, 3 insertions(+), 5 deletions(-)

diff --git a/script/repl b/script/repl
index 3ce51c3b1..acfcd1c14 100755
--- a/script/repl
+++ b/script/repl
@@ -8,8 +8,6 @@ cd $(dirname "$0")/..
 
 repl_builddir=dist-repl
 
-if [[ ! -d $repl_builddir ]]; then
-  echo "$repl_builddir does not exist, first run 'cabal repl --builddir=$repl_builddir', exit, and then re-run $0"
-else
-  cabal exec --builddir=$repl_builddir env -- -u GHC_ENVIRONMENT ghci -ghci-script=.ghci.semantic $(script/ghci-flags --builddir "$repl_builddir") -no-ignore-dot-ghci $@
-fi
+cabal build --builddir="$repl_builddir" all --only-dependencies
+
+cabal exec --builddir="$repl_builddir" env -- -u GHC_ENVIRONMENT ghci -ghci-script=.ghci.semantic $(script/ghci-flags --builddir "$repl_builddir") -no-ignore-dot-ghci $@

From 8cca0f12e2857942d3d717a33a2c541c9284f439 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 16 Dec 2019 13:36:55 -0500
Subject: [PATCH 158/318] Make sure fused-syntax gets loaded by ghcide.

---
 script/ghci-flags | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/script/ghci-flags b/script/ghci-flags
index 6e3686fa0..873c08643 100755
--- a/script/ghci-flags
+++ b/script/ghci-flags
@@ -47,6 +47,9 @@ echo "-hide-all-packages"
 # Emit package flags from the environment file, removing comments & prefixing with -
 cabal exec --builddir=$repl_builddir -v0 bash -- -c 'cat $GHC_ENVIRONMENT' | grep -v '^--' | sed -e 's/^/-/'
 
+# Explicit package flags for the -inplace packages (dependencies listed in cabal.project source-repository-package stanzas).
+echo "-package fused-syntax"
+
 echo "-XHaskell2010"
 echo "-XStrictData"
 

From ff4523e25efa6ae1610c2b042a0aa93eac182f6c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 16 Dec 2019 13:50:58 -0500
Subject: [PATCH 159/318] Extract the basic introduction forms into a new
 syntax type.

---
 semantic-core/src/Core/Core.hs              | 50 +++++++++++++--------
 semantic-core/src/Core/Eval.hs              | 30 +++++++------
 semantic-python/src/Language/Python/Core.hs |  6 ++-
 3 files changed, 51 insertions(+), 35 deletions(-)

diff --git a/semantic-core/src/Core/Core.hs b/semantic-core/src/Core/Core.hs
index 743fbb455..5920b6e20 100644
--- a/semantic-core/src/Core/Core.hs
+++ b/semantic-core/src/Core/Core.hs
@@ -18,15 +18,16 @@ module Core.Core
 , ($$*)
 , unapply
 , unapplies
-, unit
-, bool
 , if'
-, string
 , load
 , record
 , (...)
 , (.?)
 , (.=)
+, Intro(..)
+, unit
+, bool
+, string
 , Ann(..)
 , ann
 , annAt
@@ -68,10 +69,7 @@ data Core f a
   | Lam (Named (Scope () f a))
   -- | Function application; analogous to '$'.
   | f a :$ f a
-  | Unit
-  | Bool Bool
   | If (f a) (f a) (f a)
-  | String Text
   -- | Load the specified file (by path).
   | Load (f a)
   -- | A record mapping some keys to some values.
@@ -100,10 +98,7 @@ instance RightModule Core where
   (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
@@ -148,7 +143,7 @@ unbind _ _                                              = empty
 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, Has Core sig m) => t (Maybe (Named a) :<- m a) -> m a
+do' :: (Eq a, Foldable t, Has Core sig m, Has Intro 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
 
@@ -194,18 +189,9 @@ unapplies core = case unapply core of
   Just (f, a) -> (:> a) <$> unapplies f
   Nothing     -> (core, Nil)
 
-unit :: Has Core sig m => m a
-unit = send Unit
-
-bool :: Has Core sig m => Bool -> m a
-bool = send . Bool
-
 if' :: Has Core sig m => m a -> m a -> m a -> m a
 if' c t e = send (If c t e)
 
-string :: Has Core sig m => Text -> m a
-string = send . String
-
 load :: Has Core sig m => m a -> m a
 load = send . Load
 
@@ -228,6 +214,32 @@ a .= b = send (a := b)
 infix 3 .=
 
 
+data Intro (f :: * -> *) a
+  = Unit
+  | Bool Bool
+  | String Text
+  deriving (Eq, Foldable, Functor, Generic1, Ord, Show, Traversable)
+
+instance HFunctor Intro
+instance HFoldable Intro
+instance HTraversable Intro
+
+instance RightModule Intro where
+  Unit     >>=* _ = Unit
+  Bool b   >>=* _ = Bool b
+  String s >>=* _ = String s
+
+
+unit :: Has Intro sig m => m a
+unit = send Unit
+
+bool :: Has Intro sig m => Bool -> m a
+bool = send . Bool
+
+string :: Has Intro sig m => Text -> m a
+string = send . String
+
+
 data Ann ann f a
   = Ann ann (f a)
   deriving (Eq, Foldable, Functor, Generic1, Ord, Show, Traversable)
diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index abed45aa7..e35c23d40 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -39,12 +39,12 @@ eval :: forall address value m sig
         , MonadFail m
         , Semigroup value
         )
-     => Analysis (Term (Ann Span :+: Core)) address value m
-     -> (Term (Ann Span :+: Core) Name -> m value)
-     -> (Term (Ann Span :+: Core) Name -> m value)
+     => Analysis (Term (Ann Span :+: Core :+: Intro)) address value m
+     -> (Term (Ann Span :+: Core :+: Intro) Name -> m value)
+     -> (Term (Ann Span :+: Core :+: Intro) Name -> m value)
 eval Analysis{..} eval = \case
   Var n -> lookupEnv' n >>= deref' n
-  Alg (R c) -> case c of
+  Alg (R (L c)) -> case c of
     Rec (Named (Ignored n) b) -> do
       addr <- A.alloc @address n
       v <- A.bind n addr (eval (instantiate1 (pure n) b))
@@ -63,12 +63,9 @@ eval Analysis{..} eval = \case
       f' <- eval f
       a' <- eval a
       apply eval f' a'
-    Unit -> A.unit
-    Bool b -> A.bool b
     If c t e -> do
       c' <- eval c >>= A.asBool
       if c' then eval t else eval e
-    String s -> A.string s
     Load p -> eval p >>= A.asString >> A.unit -- FIXME: add a load command or something
     Record fields -> traverse (traverse eval) fields >>= record
     a :. b -> do
@@ -83,6 +80,10 @@ eval Analysis{..} eval = \case
       b' <- eval b
       addr <- ref a
       b' <$ A.assign addr b'
+  Alg (R (R c)) -> case c of
+    Unit -> A.unit
+    Bool b -> A.bool b
+    String s -> A.string s
   Alg (L (Ann span c)) -> local (const span) (eval c)
   where freeVariable s = fail ("free variable: " <> s)
         uninitialized s = fail ("uninitialized variable: " <> s)
@@ -93,7 +94,7 @@ eval Analysis{..} eval = \case
 
         ref = \case
           Var n -> lookupEnv' n
-          Alg (R c) -> case c of
+          Alg (R (L c)) -> case c of
             If c t e -> do
               c' <- eval c >>= A.asBool
               if c' then ref t else ref e
@@ -101,17 +102,18 @@ eval Analysis{..} eval = \case
               a' <- ref a
               a' ... b >>= maybe (freeVariable (show b)) pure
             c -> invalidRef (show c)
+          Alg (R (R c)) -> invalidRef (show c)
           Alg (L (Ann span c)) -> local (const span) (ref c)
 
 
-prog1 :: Has Core sig t => File (t Name)
+prog1 :: (Has Core sig t, Has Intro 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 :: Has Core sig t => File (t Name)
+prog2 :: (Has Core sig t, Has Intro sig t) => File (t Name)
 prog2 = fromBody $ fileBody prog1 $$ Core.bool True
 
 prog3 :: Has Core sig t => File (t Name)
@@ -120,14 +122,14 @@ prog3 = fromBody $ lams [named' "foo", named' "bar", named' "quux"]
     (pure "bar")
     (pure "foo"))
 
-prog4 :: Has Core sig t => File (t Name)
+prog4 :: (Has Core sig t, Has Intro sig t) => File (t Name)
 prog4 = fromBody
   (    named' "foo" :<- Core.bool True
   >>>= Core.if' (pure "foo")
     (Core.bool True)
     (Core.bool False))
 
-prog5 :: (Has (Ann Span) sig t, Has Core sig t) => File (t Name)
+prog5 :: (Has (Ann Span) sig t, Has Core sig t, Has Intro sig t) => File (t Name)
 prog5 = fromBody $ ann (do'
   [ Just (named' "mkPoint") :<- lams [named' "_x", named' "_y"] (ann (Core.record
     [ ("x", ann (pure "_x"))
@@ -138,7 +140,7 @@ prog5 = fromBody $ ann (do'
   , Nothing :<- ann (ann (pure "point") Core.... "y") .= ann (ann (pure "point") Core.... "x")
   ])
 
-prog6 :: Has Core sig t => [File (t Name)]
+prog6 :: (Has Core sig t, Has Intro sig t) => [File (t Name)]
 prog6 =
   [ (fromBody (Core.record
     [ ("dep", Core.record [ ("var", Core.bool True) ]) ]))
@@ -150,7 +152,7 @@ prog6 =
     { filePath = Path.absRel "main" }
   ]
 
-ruby :: (Has (Ann Span) sig t, Has Core sig t) => File (t Name)
+ruby :: (Has (Ann Span) sig t, Has Core sig t, Has Intro sig t) => File (t Name)
 ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (do' statements))
   where statements =
           [ Just "Class" :<- record
diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs
index 3bf100958..ceb4f6f46 100644
--- a/semantic-python/src/Language/Python/Core.hs
+++ b/semantic-python/src/Language/Python/Core.hs
@@ -52,6 +52,7 @@ pattern SingleIdentifier name <- Py.ExpressionList
 type CoreSyntax sig t = ( Has Core sig t
                         , Has (Ann Span) sig t
                         , Has Failure sig t
+                        , Has Intro sig t
                         , Foldable t
                         )
 
@@ -75,7 +76,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 :: Has Core sig t => t Name
+none :: Has Intro sig t => t Name
 none = unit
 
 locate :: ( HasField "ann" syntax Span
@@ -192,7 +193,8 @@ instance Compile Py.Call where
 
 instance Compile Py.ClassDefinition where
   compile it@Py.ClassDefinition { body = pybody, name = Py.Identifier _ann (Name -> n) } cc next = do
-    let buildTypeCall _ = do
+    let buildTypeCall :: (Has Core syn t, Has Intro syn t, Has (Reader Bindings) sig m) => w -> m (t Name)
+        buildTypeCall _ = do
           bindings <- asks @Bindings (toList . unBindings)
           let buildName n = (n, pure n)
               contents = record . fmap buildName $ bindings

From 6485f858edb3c8968ad3c30680f1107936788a40 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 18 Dec 2019 10:51:02 -0500
Subject: [PATCH 160/318] Move Named & Ignored into Analysis.Name.

---
 semantic-analysis/src/Analysis/Name.hs | 32 +++++++++++++++++++++++++-
 semantic-core/src/Core/Name.hs         | 31 +------------------------
 2 files changed, 32 insertions(+), 31 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Name.hs b/semantic-analysis/src/Analysis/Name.hs
index 99b1f809b..3056f5f76 100644
--- a/semantic-analysis/src/Analysis/Name.hs
+++ b/semantic-analysis/src/Analysis/Name.hs
@@ -1,6 +1,12 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveTraversable, GeneralizedNewtypeDeriving #-}
 module Analysis.Name
 ( Name(..)
+, Named(..)
+, named
+, named'
+, namedName
+, namedValue
+, Ignored(..)
 ) where
 
 import Data.String (IsString)
@@ -9,3 +15,27 @@ import Data.Text (Text)
 -- | User-specified and -relevant names.
 newtype Name = Name { unName :: Text }
   deriving (Eq, IsString, Ord, Show)
+
+
+-- | Annotates an @a@ with a 'Name'-provided name, which is ignored for '==' and 'compare'.
+data Named a = Named (Ignored Name) a
+  deriving (Eq, Foldable, Functor, Ord, Show, Traversable)
+
+named :: Name -> a -> Named a
+named = Named . Ignored
+
+named' :: Name -> Named Name
+named' u = Named (Ignored u) u
+
+namedName :: Named a -> Name
+namedName (Named (Ignored n) _) = n
+
+namedValue :: Named a -> a
+namedValue (Named _ a) = a
+
+
+newtype Ignored a = Ignored a
+  deriving (Foldable, Functor, Show, Traversable)
+
+instance Eq  (Ignored a) where _ == _ = True
+instance Ord (Ignored a) where compare _ _ = EQ
diff --git a/semantic-core/src/Core/Name.hs b/semantic-core/src/Core/Name.hs
index 27bfb4638..af10a53b3 100644
--- a/semantic-core/src/Core/Name.hs
+++ b/semantic-core/src/Core/Name.hs
@@ -1,12 +1,6 @@
 {-# LANGUAGE DeriveGeneric, DeriveTraversable, GeneralizedNewtypeDeriving, LambdaCase, OverloadedLists #-}
 module Core.Name
-( Name (..)
-, Named(..)
-, named
-, named'
-, namedName
-, namedValue
-, Ignored(..)
+( module Analysis.Name
 , reservedNames
 , isSimpleCharacter
 , needsQuotation
@@ -18,29 +12,6 @@ import           Data.HashSet (HashSet)
 import qualified Data.HashSet as HashSet
 import           Data.Text as Text (any, unpack)
 
--- | Annotates an @a@ with a 'Name'-provided name, which is ignored for '==' and 'compare'.
-data Named a = Named (Ignored Name) a
-  deriving (Eq, Foldable, Functor, Ord, Show, Traversable)
-
-named :: Name -> a -> Named a
-named = Named . Ignored
-
-named' :: Name -> Named Name
-named' u = Named (Ignored u) u
-
-namedName :: Named a -> Name
-namedName (Named (Ignored n) _) = n
-
-namedValue :: Named a -> a
-namedValue (Named _ a) = a
-
-newtype Ignored a = Ignored a
-  deriving (Foldable, Functor, Show, Traversable)
-
-instance Eq  (Ignored a) where _ == _ = True
-instance Ord (Ignored a) where compare _ _ = EQ
-
-
 reservedNames :: HashSet String
 reservedNames = [ "#true", "#false", "if", "then", "else"
                 , "#unit", "load", "rec", "#record"]

From cfc8bdfe380a8d5da1cf18ba21a3c226150c864a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 18 Dec 2019 10:54:54 -0500
Subject: [PATCH 161/318] :fire: Ignored.

---
 semantic-analysis/src/Analysis/Name.hs | 21 ++++++++++-----------
 semantic-core/src/Core/Eval.hs         |  6 +++---
 semantic-core/src/Core/Pretty.hs       |  6 +++---
 3 files changed, 16 insertions(+), 17 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Name.hs b/semantic-analysis/src/Analysis/Name.hs
index 3056f5f76..024b4eda1 100644
--- a/semantic-analysis/src/Analysis/Name.hs
+++ b/semantic-analysis/src/Analysis/Name.hs
@@ -6,9 +6,9 @@ module Analysis.Name
 , named'
 , namedName
 , namedValue
-, Ignored(..)
 ) where
 
+import Data.Function (on)
 import Data.String (IsString)
 import Data.Text (Text)
 
@@ -18,24 +18,23 @@ newtype Name = Name { unName :: Text }
 
 
 -- | Annotates an @a@ with a 'Name'-provided name, which is ignored for '==' and 'compare'.
-data Named a = Named (Ignored Name) a
-  deriving (Eq, Foldable, Functor, Ord, Show, Traversable)
+data Named a = Named Name a
+  deriving (Foldable, Functor, Show, Traversable)
 
 named :: Name -> a -> Named a
-named = Named . Ignored
+named = Named
 
 named' :: Name -> Named Name
-named' u = Named (Ignored u) u
+named' u = Named u u
 
 namedName :: Named a -> Name
-namedName (Named (Ignored n) _) = n
+namedName (Named n _) = n
 
 namedValue :: Named a -> a
 namedValue (Named _ a) = a
 
+instance Eq a => Eq (Named a) where
+  (==) = (==) `on` namedValue
 
-newtype Ignored a = Ignored a
-  deriving (Foldable, Functor, Show, Traversable)
-
-instance Eq  (Ignored a) where _ == _ = True
-instance Ord (Ignored a) where compare _ _ = EQ
+instance Ord a => Ord (Named a) where
+  compare = compare `on` namedValue
diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index e35c23d40..ba06d07e5 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -45,7 +45,7 @@ eval :: forall address value m sig
 eval Analysis{..} eval = \case
   Var n -> lookupEnv' n >>= deref' n
   Alg (R (L c)) -> case c of
-    Rec (Named (Ignored n) b) -> do
+    Rec (Named n b) -> do
       addr <- A.alloc @address n
       v <- A.bind n addr (eval (instantiate1 (pure n) b))
       v <$ A.assign addr v
@@ -53,12 +53,12 @@ eval Analysis{..} eval = \case
     --
     -- It’s also worth noting that we use a semigroup instead of a semilattice because the lattice structure of our abstract domains is instead modelled by nondeterminism effects used by some of them.
     a :>> b -> (<>) <$> eval a <*> eval b
-    Named (Ignored n) a :>>= b -> do
+    Named n a :>>= b -> do
       a' <- eval a
       addr <- A.alloc @address n
       A.assign addr a'
       A.bind n addr ((a' <>) <$> eval (instantiate1 (pure n) b))
-    Lam (Named (Ignored n) b) -> abstract eval n (instantiate1 (pure n) b)
+    Lam (Named n b) -> abstract eval n (instantiate1 (pure n) b)
     f :$ a -> do
       f' <- eval f
       a' <- eval a
diff --git a/semantic-core/src/Core/Pretty.hs b/semantic-core/src/Core/Pretty.hs
index 0afecc39d..6b4d4e914 100644
--- a/semantic-core/src/Core/Pretty.hs
+++ b/semantic-core/src/Core/Pretty.hs
@@ -50,12 +50,12 @@ prettyCore style = unPrec . go . fmap name
   where go = \case
           Var v -> atom v
           Alg t -> case t of
-            Rec (Named (Ignored x) b) -> prec 3 . group . nest 2 $ vsep
+            Rec (Named x b) -> prec 3 . group . nest 2 $ vsep
               [ keyword "rec" <+> name x
               , symbol "=" <+> align (withPrec 0 (go (instantiate1 (pure (name x)) b)))
               ]
 
-            Lam (Named (Ignored x) b) -> prec 3 . group . nest 2 $ vsep
+            Lam (Named x b) -> prec 3 . group . nest 2 $ vsep
               [ lambda <> name x, arrow <+> withPrec 0 (go (instantiate1 (pure (name x)) b)) ]
 
             Record fs -> atom . group . nest 2 $ vsep [ primitive "record", block ", " (map (uncurry keyValue) fs) ]
@@ -90,7 +90,7 @@ prettyCore style = unPrec . go . fmap name
         block _ [] = braces mempty
         block s ss = encloseSep "{ " " }" s ss
         keyValue x v = name x <+> symbol ":" <+> unPrec (go v)
-        prettyStatement names (Just (Named (Ignored u) _) :<- t) = name u <+> arrowL <+> unPrec (go (either (names !!) id <$> t))
+        prettyStatement names (Just (Named u _) :<- t) = name u <+> arrowL <+> unPrec (go (either (names !!) id <$> t))
         prettyStatement names (Nothing                    :<- t) = unPrec (go (either (names !!) id <$> t))
         lambda = case style of
           Unicode -> symbol "λ"

From 63427b9d6095847e2458d05eeab81cf6aa24d057 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 18 Dec 2019 15:12:15 -0500
Subject: [PATCH 162/318] Alignment.

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

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 464868f25..5c7397d4e 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -213,7 +213,7 @@ solve cs = for_ cs solve
               Nothing | m1 `IntSet.member` mvs t2 -> fail ("Occurs check failure: " <> show m1 <> " :===: " <> show t2)
                       | otherwise                 -> modify (IntMap.insert m1 t2 . fmap (substAll (IntMap.singleton m1 t2)))
           t1         :===: Var m2   -> solve (Var m2 :===: t1)
-          t1         :===: t2         -> unless (t1 == t2) $ fail ("Type mismatch:\nexpected: " <> show t1 <> "\n  actual: " <> show t2)
+          t1         :===: t2       -> unless (t1 == t2) $ fail ("Type mismatch:\nexpected: " <> show t1 <> "\n  actual: " <> show t2)
 
         solution m = fmap (m :=) <$> gets (IntMap.lookup m)
 

From 443b4ca8e139df9097a2e095236a2e4cfcf74eec Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 18 Dec 2019 15:13:38 -0500
Subject: [PATCH 163/318] Add lambdas to Intro.

---
 .../src/Analysis/Effect/Domain.hs             | 40 ++++++++--------
 semantic-analysis/src/Analysis/Intro.hs       | 46 ++++++++++++++++++-
 semantic-analysis/src/Analysis/Typecheck.hs   | 45 ++++++++++++++----
 semantic-core/src/Core/Eval.hs                | 42 +++++++++--------
 4 files changed, 122 insertions(+), 51 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index eae38bbf4..6347ceb68 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveFunctor, DeriveGeneric, FlexibleContexts, LambdaCase #-}
+{-# LANGUAGE AllowAmbiguousTypes, DeriveFunctor, DeriveGeneric, FlexibleContexts, LambdaCase, QuantifiedConstraints, ScopedTypeVariables, TypeApplications #-}
 module Analysis.Effect.Domain
 ( -- * Domain effect
   abstract
@@ -15,47 +15,49 @@ module Analysis.Effect.Domain
 , run
 ) where
 
-import Analysis.Intro as A
+import Analysis.Intro (Intro)
+import qualified Analysis.Intro as A
+import Analysis.Name
 import Control.Algebra
 import Control.Monad ((>=>))
 import Control.Monad.Fail as Fail
 import Data.Text (Text)
 import GHC.Generics (Generic1)
 
-abstract :: Has (Domain abstract) sig m => Intro -> m abstract
+abstract :: Has (Domain term abstract) sig m => Intro term Name -> m abstract
 abstract concrete = send (Abstract concrete pure)
 
-concretize :: Has (Domain abstract) sig m => abstract -> m Intro
+concretize :: Has (Domain term abstract) sig m => abstract -> m (Intro term Name)
 concretize abstract = send (Concretize abstract pure)
 
 
-unit :: Has (Domain abstract) sig m => m abstract
-unit = abstract A.Unit
+unit :: forall term abstract m sig . Has (Domain term abstract) sig m => m abstract
+unit = abstract @term A.Unit
 
-bool :: Has (Domain abstract) sig m => Bool -> m abstract
-bool = abstract . A.Bool
+bool :: forall term abstract m sig . Has (Domain term abstract) sig m => Bool -> m abstract
+bool = abstract @term . A.Bool
 
-asBool :: (Has (Domain abstract) sig m, MonadFail m) => abstract -> m Bool
-asBool = concretize >=> \case
+asBool :: forall term abstract m sig . (Has (Domain term abstract) sig m, MonadFail m, forall a . Show a => Show (term a)) => abstract -> m Bool
+asBool = concretize @term >=> \case
   A.Bool b -> pure b
   other    -> typeError "Bool" other
 
-string :: Has (Domain abstract) sig m => Text -> m abstract
-string = abstract . A.String
+string :: forall term abstract m sig . Has (Domain term abstract) sig m => Text -> m abstract
+string = abstract @term . A.String
 
-asString :: (Has (Domain abstract) sig m, MonadFail m) => abstract -> m Text
-asString = concretize >=> \case
+asString :: forall term abstract m sig . (Has (Domain term abstract) sig m, MonadFail m, forall a . Show a => Show (term a)) => abstract -> m Text
+asString = concretize @term >=> \case
   A.String t -> pure t
   other      -> typeError "String" other
 
 
-data Domain abstract m k
-  = Abstract   Intro    (abstract -> m k)
-  | Concretize abstract (Intro    -> m k)
+data Domain term abstract m k
+  = Abstract   (Intro term Name) (abstract        -> m k)
+  | Concretize abstract          (Intro term Name -> m k)
   deriving (Functor, Generic1)
 
-instance HFunctor (Domain abstract)
-instance Effect   (Domain abstract)
+instance HFunctor (Domain term abstract)
+instance Effect   (Domain term abstract)
 
 
 typeError :: (Show a, MonadFail m) => String -> a -> m b
diff --git a/semantic-analysis/src/Analysis/Intro.hs b/semantic-analysis/src/Analysis/Intro.hs
index 08b473db2..12e7bf52f 100644
--- a/semantic-analysis/src/Analysis/Intro.hs
+++ b/semantic-analysis/src/Analysis/Intro.hs
@@ -1,11 +1,53 @@
+{-# LANGUAGE DeriveGeneric, DeriveTraversable, QuantifiedConstraints, StandaloneDeriving #-}
 module Analysis.Intro
 ( Intro(..)
+, unit
+, bool
+, string
+, lam
 ) where
 
+import Analysis.Name
+import Control.Algebra
 import Data.Text (Text)
+import GHC.Generics (Generic1)
+import Syntax.Foldable
+import Syntax.Module
+import Syntax.Scope
+import Syntax.Traversable
 
-data Intro
+data Intro t a
   = Unit
   | Bool Bool
   | String Text
-  deriving (Eq, Ord, Show)
+  | Lam (Named (Scope () t a))
+  deriving (Foldable, Functor, Generic1, Traversable)
+
+deriving instance (Eq   a, forall a . Eq   a => Eq   (f a), Monad f) => Eq   (Intro f a)
+deriving instance (Ord  a, forall a . Eq   a => Eq   (f a)
+                         , forall a . Ord  a => Ord  (f a), Monad f) => Ord  (Intro f a)
+deriving instance (Show a, forall a . Show a => Show (f a))          => Show (Intro f a)
+
+instance HFunctor Intro
+instance HFoldable Intro
+instance HTraversable Intro
+
+instance RightModule Intro where
+  Unit     >>=* _ = Unit
+  Bool b   >>=* _ = Bool b
+  String s >>=* _ = String s
+  Lam b    >>=* f = Lam ((>>=* f) <$> b)
+
+
+unit :: Has Intro sig m => m a
+unit = send Unit
+
+bool :: Has Intro sig m => Bool -> m a
+bool = send . Bool
+
+string :: Has Intro sig m => Text -> m a
+string = send . String
+
+
+lam :: (Eq a, Has Intro sig m) => Named a -> m a -> m a
+lam (Named u n) b = send (Lam (Named u (abstract1 n b)))
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 5c7397d4e..8b9f26af7 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, MultiParamTypeClasses, QuantifiedConstraints, RankNTypes, RecordWildCards, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DeriveGeneric, DeriveTraversable, DerivingVia, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-}
 module Analysis.Typecheck
 ( Monotype (..)
 , Meta
@@ -22,6 +22,7 @@ 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.Trans.Class
 import           Data.Foldable (for_)
 import           Data.Function (fix)
 import           Data.Functor (($>))
@@ -94,7 +95,7 @@ generalize ty = fromJust (closed (forAlls (IntSet.toList (mvs ty)) (hoistTerm R
 
 
 typecheckingFlowInsensitive
-  :: Ord (term Name)
+  :: (Has Intro.Intro syn term, Ord (term Name))
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
      => Analysis term Name Type m
@@ -116,6 +117,7 @@ runFile
   :: ( Effect sig
      , Has Fresh sig m
      , Has (State (Heap Type)) sig m
+     , Has Intro.Intro syn term
      , Ord (term Name)
      )
   => (forall sig m
@@ -145,7 +147,7 @@ runFile eval file = traverse run file
               v <- meta
               bs <- m
               v <$ for_ bs (unify v))
-          . convergeTerm 1 (runDomain . A.runHeap @Name @Type . fix (cacheTerm . eval typecheckingAnalysis))
+          . convergeTerm 1  (A.runHeap @Name @Type . fix (\ eval' -> runDomain (Evaluator eval') . fix (cacheTerm . eval typecheckingAnalysis)))
 
 typecheckingAnalysis
   :: ( Alternative m
@@ -225,17 +227,40 @@ substAll :: Monad t => IntMap.IntMap (t Meta) -> t Meta -> t Meta
 substAll s a = a >>= \ i -> fromMaybe (pure i) (IntMap.lookup i s)
 
 
-newtype DomainC m a = DomainC { runDomain :: m a }
+runDomain :: Evaluator term m -> DomainC term m a -> m a
+runDomain eval (DomainC m) = runReader eval m
+
+newtype Evaluator term m = Evaluator { runEvaluator :: term Name -> m Type }
+
+newtype DomainC term m a = DomainC (ReaderC (Evaluator term m) m a)
   deriving (Alternative, Applicative, Functor, Monad, MonadFail)
 
-instance (Alternative m, Algebra sig m, MonadFail m) => Algebra (Domain Type :+: sig) (DomainC m) where
+instance MonadTrans (DomainC term) where
+  lift = DomainC . lift
+
+instance ( Alternative m
+         , Has (Env Name) sig m
+         , Has Fresh sig m
+         , Has (A.Heap Name Type) sig m
+         , Monad term
+         , MonadFail m
+         , Has Intro.Intro syn term
+         ) => Algebra (Domain term Type :+: sig) (DomainC term m) where
   alg (L (Abstract v k)) = case v of
     Intro.Unit     -> k (Alg Unit)
     Intro.Bool   _ -> k (Alg Bool)
     Intro.String _ -> k (Alg String)
+    Intro.Lam (Named n b) -> do
+      eval <- DomainC (asks runEvaluator)
+      addr <- alloc @Name n
+      arg <- meta
+      A.assign addr arg
+      ty <- lift (eval (instantiate1 (pure n) b))
+      k (Alg (arg :-> ty))
   alg (L (Concretize t k)) = case t of
-    Alg Unit   -> k Intro.Unit
-    Alg Bool   -> k (Intro.Bool True) <|> k (Intro.Bool False)
-    Alg String -> k (Intro.String mempty)
-    t          -> fail ("can’t concretize " <> show t)
-  alg (R other) = DomainC (alg (handleCoercible other))
+    Alg Unit      -> k Intro.Unit
+    Alg Bool      -> k (Intro.Bool True) <|> k (Intro.Bool False)
+    Alg String    -> k (Intro.String mempty)
+    Alg (_ :-> b) -> concretize @term b >>= k . Intro.Lam . Named (Name mempty) . lift . send
+    t             -> fail ("can’t concretize " <> show t)
+  alg (R other) = DomainC (send (handleCoercible other))
diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index ba06d07e5..998f22086 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -28,23 +28,25 @@ import GHC.Stack
 import Prelude hiding (fail)
 import Source.Span
 import Syntax.Scope
-import Syntax.Term
+import qualified Syntax.Term as Term
 import qualified System.Path as Path
 
+type Term = Term.Term (Ann Span :+: Core :+: Intro)
+
 eval :: forall address value m sig
-     .  ( Has (Domain value) sig m
+     .  ( Has (Domain Term value) sig m
         , Has (Env address) sig m
         , Has (Heap address value) sig m
         , Has (Reader Span) sig m
         , MonadFail m
         , Semigroup value
         )
-     => Analysis (Term (Ann Span :+: Core :+: Intro)) address value m
-     -> (Term (Ann Span :+: Core :+: Intro) Name -> m value)
-     -> (Term (Ann Span :+: Core :+: Intro) Name -> m value)
+     => Analysis Term address value m
+     -> (Term Name -> m value)
+     -> (Term Name -> m value)
 eval Analysis{..} eval = \case
-  Var n -> lookupEnv' n >>= deref' n
-  Alg (R (L c)) -> case c of
+  Term.Var n -> lookupEnv' n >>= deref' n
+  Term.Alg (R (L c)) -> case c of
     Rec (Named n b) -> do
       addr <- A.alloc @address n
       v <- A.bind n addr (eval (instantiate1 (pure n) b))
@@ -64,9 +66,9 @@ eval Analysis{..} eval = \case
       a' <- eval a
       apply eval f' a'
     If c t e -> do
-      c' <- eval c >>= A.asBool
+      c' <- eval c >>= A.asBool @Term
       if c' then eval t else eval e
-    Load p -> eval p >>= A.asString >> A.unit -- FIXME: add a load command or something
+    Load p -> eval p >>= A.asString @Term >> A.unit @Term -- FIXME: add a load command or something
     Record fields -> traverse (traverse eval) fields >>= record
     a :. b -> do
       a' <- ref a
@@ -74,17 +76,17 @@ eval Analysis{..} eval = \case
     a :? b -> do
       a' <- ref a
       mFound <- a' ... b
-      A.bool (isJust mFound)
+      A.bool @Term (isJust mFound)
 
     a := b -> do
       b' <- eval b
       addr <- ref a
       b' <$ A.assign addr b'
-  Alg (R (R c)) -> case c of
-    Unit -> A.unit
-    Bool b -> A.bool b
-    String s -> A.string s
-  Alg (L (Ann span c)) -> local (const span) (eval c)
+  Term.Alg (R (R c)) -> case c of
+    Unit -> A.unit @Term
+    Bool b -> A.bool @Term b
+    String s -> A.string @Term s
+  Term.Alg (L (Ann span c)) -> local (const span) (eval c)
   where freeVariable s = fail ("free variable: " <> s)
         uninitialized s = fail ("uninitialized variable: " <> s)
         invalidRef s = fail ("invalid ref: " <> s)
@@ -93,17 +95,17 @@ eval Analysis{..} eval = \case
         deref' n = A.deref @address >=> maybe (uninitialized (show n)) pure
 
         ref = \case
-          Var n -> lookupEnv' n
-          Alg (R (L c)) -> case c of
+          Term.Var n -> lookupEnv' n
+          Term.Alg (R (L c)) -> case c of
             If c t e -> do
-              c' <- eval c >>= A.asBool
+              c' <- eval c >>= A.asBool @Term
               if c' then ref t else ref e
             a :. b -> do
               a' <- ref a
               a' ... b >>= maybe (freeVariable (show b)) pure
             c -> invalidRef (show c)
-          Alg (R (R c)) -> invalidRef (show c)
-          Alg (L (Ann span c)) -> local (const span) (ref c)
+          Term.Alg (R (R c)) -> invalidRef (show c)
+          Term.Alg (L (Ann span c)) -> local (const span) (ref c)
 
 
 prog1 :: (Has Core sig t, Has Intro sig t) => File (t Name)

From 1d292b03950ed6ab037949c211fe8fd57844c86f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 11:06:40 -0500
Subject: [PATCH 164/318] Parameterize terms by addresses.

---
 .../src/Analysis/Effect/Domain.hs             | 35 +++++++--------
 semantic-analysis/src/Analysis/Typecheck.hs   |  2 +-
 semantic-core/src/Core/Eval.hs                | 44 +++++++++++--------
 3 files changed, 44 insertions(+), 37 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index 6347ceb68..46e96ec2e 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -17,47 +17,46 @@ module Analysis.Effect.Domain
 
 import Analysis.Intro (Intro)
 import qualified Analysis.Intro as A
-import Analysis.Name
 import Control.Algebra
 import Control.Monad ((>=>))
 import Control.Monad.Fail as Fail
 import Data.Text (Text)
 import GHC.Generics (Generic1)
 
-abstract :: Has (Domain term abstract) sig m => Intro term Name -> m abstract
+abstract :: Has (Domain term addr abstract) sig m => Intro term addr -> m abstract
 abstract concrete = send (Abstract concrete pure)
 
-concretize :: Has (Domain term abstract) sig m => abstract -> m (Intro term Name)
+concretize :: Has (Domain term addr abstract) sig m => abstract -> m (Intro term addr)
 concretize abstract = send (Concretize abstract pure)
 
 
-unit :: forall term abstract m sig . Has (Domain term abstract) sig m => m abstract
-unit = abstract @term A.Unit
+unit :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => m abstract
+unit = abstract @term @addr A.Unit
 
-bool :: forall term abstract m sig . Has (Domain term abstract) sig m => Bool -> m abstract
-bool = abstract @term . A.Bool
+bool :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => Bool -> m abstract
+bool = abstract @term @addr . A.Bool
 
-asBool :: forall term abstract m sig . (Has (Domain term abstract) sig m, MonadFail m, forall a . Show a => Show (term a)) => abstract -> m Bool
-asBool = concretize @term >=> \case
+asBool :: forall term addr abstract m sig . (Has (Domain term addr abstract) sig m, MonadFail m, forall a . Show a => Show (term a), Show addr) => abstract -> m Bool
+asBool = concretize @term @addr >=> \case
   A.Bool b -> pure b
   other    -> typeError "Bool" other
 
-string :: forall term abstract m sig . Has (Domain term abstract) sig m => Text -> m abstract
-string = abstract @term . A.String
+string :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => Text -> m abstract
+string = abstract @term @addr . A.String
 
-asString :: forall term abstract m sig . (Has (Domain term abstract) sig m, MonadFail m, forall a . Show a => Show (term a)) => abstract -> m Text
-asString = concretize @term >=> \case
+asString :: forall term addr abstract m sig . (Has (Domain term addr abstract) sig m, MonadFail m, forall a . Show a => Show (term a), Show addr) => abstract -> m Text
+asString = concretize @term @addr >=> \case
   A.String t -> pure t
   other      -> typeError "String" other
 
 
-data Domain term abstract m k
-  = Abstract   (Intro term Name) (abstract        -> m k)
-  | Concretize abstract          (Intro term Name -> m k)
+data Domain term addr abstract m k
+  = Abstract   (Intro term addr) (abstract        -> m k)
+  | Concretize abstract          (Intro term addr -> m k)
   deriving (Functor, Generic1)
 
-instance HFunctor (Domain term abstract)
-instance Effect   (Domain term abstract)
+instance HFunctor (Domain term addr abstract)
+instance Effect   (Domain term addr abstract)
 
 
 typeError :: (Show a, MonadFail m) => String -> a -> m b
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 8b9f26af7..156610c03 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -245,7 +245,7 @@ instance ( Alternative m
          , Monad term
          , MonadFail m
          , Has Intro.Intro syn term
-         ) => Algebra (Domain term Type :+: sig) (DomainC term m) where
+         ) => Algebra (Domain term Name Type :+: sig) (DomainC term m) where
   alg (L (Abstract v k)) = case v of
     Intro.Unit     -> k (Alg Unit)
     Intro.Bool   _ -> k (Alg Bool)
diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index 998f22086..a64b02139 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -15,6 +15,7 @@ import Analysis.Effect.Domain as A
 import Analysis.Effect.Env as A
 import Analysis.Effect.Heap as A
 import Analysis.File
+import qualified Analysis.Intro as I
 import Control.Algebra
 import Control.Applicative (Alternative (..))
 import Control.Effect.Fail
@@ -33,23 +34,26 @@ import qualified System.Path as Path
 
 type Term = Term.Term (Ann Span :+: Core :+: Intro)
 
+-- FIXME: we can only parameterize terms by addresses if we have some notion of existentials to bind free vars
+
 eval :: forall address value m sig
-     .  ( Has (Domain Term value) sig m
+     .  ( Has (Domain Term address value) sig m
         , Has (Env address) sig m
         , Has (Heap address value) sig m
         , Has (Reader Span) sig m
         , MonadFail m
         , Semigroup value
+        , Show address
         )
      => Analysis Term address value m
-     -> (Term Name -> m value)
-     -> (Term Name -> m value)
+     -> (Term address -> m value)
+     -> (Term address -> m value)
 eval Analysis{..} eval = \case
-  Term.Var n -> lookupEnv' n >>= deref' n
+  Term.Var n -> deref' n n
   Term.Alg (R (L c)) -> case c of
     Rec (Named n b) -> do
       addr <- A.alloc @address n
-      v <- A.bind n addr (eval (instantiate1 (pure n) b))
+      v <- eval (instantiate1 (pure addr) b)
       v <$ A.assign addr v
     -- NB: Combining the results of the evaluations allows us to model effects in abstract domains. This in turn means that we can define an abstract domain modelling the types-and-effects of computations by means of a 'Semigroup' instance which takes the type of its second operand and the union of both operands’ effects.
     --
@@ -59,16 +63,21 @@ eval Analysis{..} eval = \case
       a' <- eval a
       addr <- A.alloc @address n
       A.assign addr a'
-      A.bind n addr ((a' <>) <$> eval (instantiate1 (pure n) b))
-    Lam (Named n b) -> abstract eval n (instantiate1 (pure n) b)
+      A.bind n addr ((a' <>) <$> eval (instantiate1 (pure addr) b))
+    Lam (Named n b) -> A.abstract (I.Lam (Named n b))
     f :$ a -> do
       f' <- eval f
-      a' <- eval a
-      apply eval f' a'
+      A.concretize @Term @address @value f' >>= \case
+        I.Lam (Named n b) -> do
+          a' <- eval a
+          addr <- A.alloc @address n
+          A.assign addr a'
+          A.bind n addr (eval (instantiate1 (pure addr) b))
+        actual -> fail $ "expected closure, got " <> show actual
     If c t e -> do
-      c' <- eval c >>= A.asBool @Term
+      c' <- eval c >>= A.asBool @Term @address
       if c' then eval t else eval e
-    Load p -> eval p >>= A.asString @Term >> A.unit @Term -- FIXME: add a load command or something
+    Load p -> eval p >>= A.asString @Term @address >> A.unit @Term @address -- FIXME: add a load command or something
     Record fields -> traverse (traverse eval) fields >>= record
     a :. b -> do
       a' <- ref a
@@ -76,29 +85,28 @@ eval Analysis{..} eval = \case
     a :? b -> do
       a' <- ref a
       mFound <- a' ... b
-      A.bool @Term (isJust mFound)
+      A.bool @Term @address (isJust mFound)
 
     a := b -> do
       b' <- eval b
       addr <- ref a
       b' <$ A.assign addr b'
   Term.Alg (R (R c)) -> case c of
-    Unit -> A.unit @Term
-    Bool b -> A.bool @Term b
-    String s -> A.string @Term s
+    Unit -> A.unit @Term @address
+    Bool b -> A.bool @Term @address b
+    String s -> A.string @Term @address s
   Term.Alg (L (Ann span c)) -> local (const span) (eval c)
   where freeVariable s = fail ("free variable: " <> s)
         uninitialized s = fail ("uninitialized variable: " <> s)
         invalidRef s = fail ("invalid ref: " <> s)
 
-        lookupEnv' n = A.lookupEnv n >>= maybe (freeVariable (show n)) pure
         deref' n = A.deref @address >=> maybe (uninitialized (show n)) pure
 
         ref = \case
-          Term.Var n -> lookupEnv' n
+          Term.Var n -> pure n
           Term.Alg (R (L c)) -> case c of
             If c t e -> do
-              c' <- eval c >>= A.asBool @Term
+              c' <- eval c >>= A.asBool @Term @address
               if c' then ref t else ref e
             a :. b -> do
               a' <- ref a

From a60380ad0946faba59af557a7c72ae8570a77437 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 11:06:44 -0500
Subject: [PATCH 165/318] Revert "Parameterize terms by addresses."

This reverts commit 1d292b03950ed6ab037949c211fe8fd57844c86f.
---
 .../src/Analysis/Effect/Domain.hs             | 35 ++++++++-------
 semantic-analysis/src/Analysis/Typecheck.hs   |  2 +-
 semantic-core/src/Core/Eval.hs                | 44 ++++++++-----------
 3 files changed, 37 insertions(+), 44 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index 46e96ec2e..6347ceb68 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -17,46 +17,47 @@ module Analysis.Effect.Domain
 
 import Analysis.Intro (Intro)
 import qualified Analysis.Intro as A
+import Analysis.Name
 import Control.Algebra
 import Control.Monad ((>=>))
 import Control.Monad.Fail as Fail
 import Data.Text (Text)
 import GHC.Generics (Generic1)
 
-abstract :: Has (Domain term addr abstract) sig m => Intro term addr -> m abstract
+abstract :: Has (Domain term abstract) sig m => Intro term Name -> m abstract
 abstract concrete = send (Abstract concrete pure)
 
-concretize :: Has (Domain term addr abstract) sig m => abstract -> m (Intro term addr)
+concretize :: Has (Domain term abstract) sig m => abstract -> m (Intro term Name)
 concretize abstract = send (Concretize abstract pure)
 
 
-unit :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => m abstract
-unit = abstract @term @addr A.Unit
+unit :: forall term abstract m sig . Has (Domain term abstract) sig m => m abstract
+unit = abstract @term A.Unit
 
-bool :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => Bool -> m abstract
-bool = abstract @term @addr . A.Bool
+bool :: forall term abstract m sig . Has (Domain term abstract) sig m => Bool -> m abstract
+bool = abstract @term . A.Bool
 
-asBool :: forall term addr abstract m sig . (Has (Domain term addr abstract) sig m, MonadFail m, forall a . Show a => Show (term a), Show addr) => abstract -> m Bool
-asBool = concretize @term @addr >=> \case
+asBool :: forall term abstract m sig . (Has (Domain term abstract) sig m, MonadFail m, forall a . Show a => Show (term a)) => abstract -> m Bool
+asBool = concretize @term >=> \case
   A.Bool b -> pure b
   other    -> typeError "Bool" other
 
-string :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => Text -> m abstract
-string = abstract @term @addr . A.String
+string :: forall term abstract m sig . Has (Domain term abstract) sig m => Text -> m abstract
+string = abstract @term . A.String
 
-asString :: forall term addr abstract m sig . (Has (Domain term addr abstract) sig m, MonadFail m, forall a . Show a => Show (term a), Show addr) => abstract -> m Text
-asString = concretize @term @addr >=> \case
+asString :: forall term abstract m sig . (Has (Domain term abstract) sig m, MonadFail m, forall a . Show a => Show (term a)) => abstract -> m Text
+asString = concretize @term >=> \case
   A.String t -> pure t
   other      -> typeError "String" other
 
 
-data Domain term addr abstract m k
-  = Abstract   (Intro term addr) (abstract        -> m k)
-  | Concretize abstract          (Intro term addr -> m k)
+data Domain term abstract m k
+  = Abstract   (Intro term Name) (abstract        -> m k)
+  | Concretize abstract          (Intro term Name -> m k)
   deriving (Functor, Generic1)
 
-instance HFunctor (Domain term addr abstract)
-instance Effect   (Domain term addr abstract)
+instance HFunctor (Domain term abstract)
+instance Effect   (Domain term abstract)
 
 
 typeError :: (Show a, MonadFail m) => String -> a -> m b
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 156610c03..8b9f26af7 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -245,7 +245,7 @@ instance ( Alternative m
          , Monad term
          , MonadFail m
          , Has Intro.Intro syn term
-         ) => Algebra (Domain term Name Type :+: sig) (DomainC term m) where
+         ) => Algebra (Domain term Type :+: sig) (DomainC term m) where
   alg (L (Abstract v k)) = case v of
     Intro.Unit     -> k (Alg Unit)
     Intro.Bool   _ -> k (Alg Bool)
diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index a64b02139..998f22086 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -15,7 +15,6 @@ import Analysis.Effect.Domain as A
 import Analysis.Effect.Env as A
 import Analysis.Effect.Heap as A
 import Analysis.File
-import qualified Analysis.Intro as I
 import Control.Algebra
 import Control.Applicative (Alternative (..))
 import Control.Effect.Fail
@@ -34,26 +33,23 @@ import qualified System.Path as Path
 
 type Term = Term.Term (Ann Span :+: Core :+: Intro)
 
--- FIXME: we can only parameterize terms by addresses if we have some notion of existentials to bind free vars
-
 eval :: forall address value m sig
-     .  ( Has (Domain Term address value) sig m
+     .  ( Has (Domain Term value) sig m
         , Has (Env address) sig m
         , Has (Heap address value) sig m
         , Has (Reader Span) sig m
         , MonadFail m
         , Semigroup value
-        , Show address
         )
      => Analysis Term address value m
-     -> (Term address -> m value)
-     -> (Term address -> m value)
+     -> (Term Name -> m value)
+     -> (Term Name -> m value)
 eval Analysis{..} eval = \case
-  Term.Var n -> deref' n n
+  Term.Var n -> lookupEnv' n >>= deref' n
   Term.Alg (R (L c)) -> case c of
     Rec (Named n b) -> do
       addr <- A.alloc @address n
-      v <- eval (instantiate1 (pure addr) b)
+      v <- A.bind n addr (eval (instantiate1 (pure n) b))
       v <$ A.assign addr v
     -- NB: Combining the results of the evaluations allows us to model effects in abstract domains. This in turn means that we can define an abstract domain modelling the types-and-effects of computations by means of a 'Semigroup' instance which takes the type of its second operand and the union of both operands’ effects.
     --
@@ -63,21 +59,16 @@ eval Analysis{..} eval = \case
       a' <- eval a
       addr <- A.alloc @address n
       A.assign addr a'
-      A.bind n addr ((a' <>) <$> eval (instantiate1 (pure addr) b))
-    Lam (Named n b) -> A.abstract (I.Lam (Named n b))
+      A.bind n addr ((a' <>) <$> eval (instantiate1 (pure n) b))
+    Lam (Named n b) -> abstract eval n (instantiate1 (pure n) b)
     f :$ a -> do
       f' <- eval f
-      A.concretize @Term @address @value f' >>= \case
-        I.Lam (Named n b) -> do
-          a' <- eval a
-          addr <- A.alloc @address n
-          A.assign addr a'
-          A.bind n addr (eval (instantiate1 (pure addr) b))
-        actual -> fail $ "expected closure, got " <> show actual
+      a' <- eval a
+      apply eval f' a'
     If c t e -> do
-      c' <- eval c >>= A.asBool @Term @address
+      c' <- eval c >>= A.asBool @Term
       if c' then eval t else eval e
-    Load p -> eval p >>= A.asString @Term @address >> A.unit @Term @address -- FIXME: add a load command or something
+    Load p -> eval p >>= A.asString @Term >> A.unit @Term -- FIXME: add a load command or something
     Record fields -> traverse (traverse eval) fields >>= record
     a :. b -> do
       a' <- ref a
@@ -85,28 +76,29 @@ eval Analysis{..} eval = \case
     a :? b -> do
       a' <- ref a
       mFound <- a' ... b
-      A.bool @Term @address (isJust mFound)
+      A.bool @Term (isJust mFound)
 
     a := b -> do
       b' <- eval b
       addr <- ref a
       b' <$ A.assign addr b'
   Term.Alg (R (R c)) -> case c of
-    Unit -> A.unit @Term @address
-    Bool b -> A.bool @Term @address b
-    String s -> A.string @Term @address s
+    Unit -> A.unit @Term
+    Bool b -> A.bool @Term b
+    String s -> A.string @Term s
   Term.Alg (L (Ann span c)) -> local (const span) (eval c)
   where freeVariable s = fail ("free variable: " <> s)
         uninitialized s = fail ("uninitialized variable: " <> s)
         invalidRef s = fail ("invalid ref: " <> s)
 
+        lookupEnv' n = A.lookupEnv n >>= maybe (freeVariable (show n)) pure
         deref' n = A.deref @address >=> maybe (uninitialized (show n)) pure
 
         ref = \case
-          Term.Var n -> pure n
+          Term.Var n -> lookupEnv' n
           Term.Alg (R (L c)) -> case c of
             If c t e -> do
-              c' <- eval c >>= A.asBool @Term @address
+              c' <- eval c >>= A.asBool @Term
               if c' then ref t else ref e
             a :. b -> do
               a' <- ref a

From 1832212aea25555e74e98e8b91a0323895d02147 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 11:09:33 -0500
Subject: [PATCH 166/318] Interpret functions using the Domain effect.

---
 semantic-core/src/Core/Eval.hs | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index 998f22086..0a6558560 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -15,6 +15,7 @@ import Analysis.Effect.Domain as A
 import Analysis.Effect.Env as A
 import Analysis.Effect.Heap as A
 import Analysis.File
+import qualified Analysis.Intro as I
 import Control.Algebra
 import Control.Applicative (Alternative (..))
 import Control.Effect.Fail
@@ -60,11 +61,16 @@ eval Analysis{..} eval = \case
       addr <- A.alloc @address n
       A.assign addr a'
       A.bind n addr ((a' <>) <$> eval (instantiate1 (pure n) b))
-    Lam (Named n b) -> abstract eval n (instantiate1 (pure n) b)
+    Lam (Named n b) -> A.abstract (I.Lam (Named n b))
     f :$ a -> do
       f' <- eval f
-      a' <- eval a
-      apply eval f' a'
+      A.concretize f' >>= \case
+        I.Lam (Named n b) -> do
+          a' <- eval a
+          addr <- A.alloc @address n
+          A.assign addr a'
+          A.bind n addr (eval (instantiate1 (pure n) b))
+        actual -> fail $ "expected lambda, got " <> show actual
     If c t e -> do
       c' <- eval c >>= A.asBool @Term
       if c' then eval t else eval e

From 9f2a2fc81956036ebec0bd8c1f9d82e108ef5b30 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 11:11:47 -0500
Subject: [PATCH 167/318] Define a smart constructor for constructing lambdas.

---
 semantic-analysis/src/Analysis/Effect/Domain.hs | 6 ++++++
 semantic-core/src/Core/Eval.hs                  | 4 ++--
 2 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index 6347ceb68..71eaf546a 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -8,6 +8,7 @@ module Analysis.Effect.Domain
 , asBool
 , string
 , asString
+, lam
 , Domain(..)
   -- * Re-exports
 , Algebra
@@ -23,6 +24,7 @@ import Control.Monad ((>=>))
 import Control.Monad.Fail as Fail
 import Data.Text (Text)
 import GHC.Generics (Generic1)
+import Syntax.Scope (Scope)
 
 abstract :: Has (Domain term abstract) sig m => Intro term Name -> m abstract
 abstract concrete = send (Abstract concrete pure)
@@ -51,6 +53,10 @@ asString = concretize @term >=> \case
   other      -> typeError "String" other
 
 
+lam :: Has (Domain term abstract) sig m => Named (Scope () term Name) -> m abstract
+lam = abstract . A.Lam
+
+
 data Domain term abstract m k
   = Abstract   (Intro term Name) (abstract        -> m k)
   | Concretize abstract          (Intro term Name -> m k)
diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index 0a6558560..47c462512 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -61,7 +61,7 @@ eval Analysis{..} eval = \case
       addr <- A.alloc @address n
       A.assign addr a'
       A.bind n addr ((a' <>) <$> eval (instantiate1 (pure n) b))
-    Lam (Named n b) -> A.abstract (I.Lam (Named n b))
+    Lam (Named n b) -> A.lam (Named n b)
     f :$ a -> do
       f' <- eval f
       A.concretize f' >>= \case
@@ -115,7 +115,7 @@ eval Analysis{..} eval = \case
 
 
 prog1 :: (Has Core sig t, Has Intro sig t) => File (t Name)
-prog1 = fromBody $ lam (named' "foo")
+prog1 = fromBody $ Core.lam (named' "foo")
   (    named' "bar" :<- pure "foo"
   >>>= Core.if' (pure "bar")
     (Core.bool False)

From 039148aa894d0e1dff492ead53ac0d1e5b8a1b9f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 11:14:01 -0500
Subject: [PATCH 168/318] Define a smart constructor for concretizing lambdas.

---
 semantic-analysis/src/Analysis/Effect/Domain.hs |  6 ++++++
 semantic-core/src/Core/Eval.hs                  | 14 +++++---------
 2 files changed, 11 insertions(+), 9 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index 71eaf546a..46c09d1f5 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -9,6 +9,7 @@ module Analysis.Effect.Domain
 , string
 , asString
 , lam
+, asLam
 , Domain(..)
   -- * Re-exports
 , Algebra
@@ -56,6 +57,11 @@ asString = concretize @term >=> \case
 lam :: Has (Domain term abstract) sig m => Named (Scope () term Name) -> m abstract
 lam = abstract . A.Lam
 
+asLam :: (Has (Domain term abstract) sig m, MonadFail m, forall a . Show a => Show (term a)) => abstract -> m (Named (Scope () term Name))
+asLam = concretize >=> \case
+  A.Lam b -> pure b
+  other   -> typeError "Lam" other
+
 
 data Domain term abstract m k
   = Abstract   (Intro term Name) (abstract        -> m k)
diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index 47c462512..a6afde09f 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -15,7 +15,6 @@ import Analysis.Effect.Domain as A
 import Analysis.Effect.Env as A
 import Analysis.Effect.Heap as A
 import Analysis.File
-import qualified Analysis.Intro as I
 import Control.Algebra
 import Control.Applicative (Alternative (..))
 import Control.Effect.Fail
@@ -63,14 +62,11 @@ eval Analysis{..} eval = \case
       A.bind n addr ((a' <>) <$> eval (instantiate1 (pure n) b))
     Lam (Named n b) -> A.lam (Named n b)
     f :$ a -> do
-      f' <- eval f
-      A.concretize f' >>= \case
-        I.Lam (Named n b) -> do
-          a' <- eval a
-          addr <- A.alloc @address n
-          A.assign addr a'
-          A.bind n addr (eval (instantiate1 (pure n) b))
-        actual -> fail $ "expected lambda, got " <> show actual
+      Named n b <- eval f >>= asLam
+      a' <- eval a
+      addr <- A.alloc @address n
+      A.assign addr a'
+      A.bind n addr (eval (instantiate1 (pure n) b))
     If c t e -> do
       c' <- eval c >>= A.asBool @Term
       if c' then eval t else eval e

From a3ccc126b05d5b638acdff703f39c849bb527d07 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 11:18:08 -0500
Subject: [PATCH 169/318] :fire: abstract & apply from Analysis.

---
 semantic-analysis/src/Analysis/Analysis.hs    |  7 ++--
 semantic-analysis/src/Analysis/Concrete.hs    | 38 +++++++------------
 semantic-analysis/src/Analysis/ImportGraph.hs | 25 +++++-------
 semantic-analysis/src/Analysis/ScopeGraph.hs  | 10 ++---
 semantic-analysis/src/Analysis/Typecheck.hs   | 28 +++++++-------
 5 files changed, 44 insertions(+), 64 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index 3e8904a72..f3627aad8 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE KindSignatures #-}
 module Analysis.Analysis
 ( Analysis(..)
 ) where
@@ -7,9 +8,7 @@ import Analysis.Name
 -- | A record of functions necessary to perform analysis.
 --
 -- This is intended to be replaced with a selection of algebraic effects providing these interfaces and carriers providing reusable implementations.
-data Analysis term address value m = Analysis
-  { abstract :: (term Name -> m value) -> Name -> term Name -> m value
-  , apply    :: (term Name -> m value) -> value -> value -> m value
-  , record   :: [(Name, value)] -> m value
+data Analysis (term :: * -> *) address value m = Analysis
+  { record   :: [(Name, value)] -> m value
   , (...)    :: address -> Name -> m (Maybe address)
   }
diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 19fb72f30..d302814fb 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -30,7 +30,6 @@ import qualified Data.IntMap as IntMap
 import qualified Data.IntSet as IntSet
 import qualified Data.Map as Map
 import           Data.Semigroup (Last (..))
-import qualified Data.Set as Set
 import           Data.Text (Text, pack)
 import           Data.Traversable (for)
 import           Prelude hiding (fail)
@@ -58,10 +57,7 @@ type Heap term = IntMap.IntMap (Concrete term)
 
 
 concrete
-  :: ( Foldable term
-     , Show (term Name)
-     )
-  => (forall sig m
+  :: (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
      => Analysis term Precise (Concrete (term Name)) m
      -> (term Name -> m (Concrete (term Name)))
@@ -78,11 +74,9 @@ concrete eval
 runFile
   :: forall term m sig
   .  ( Effect sig
-     , Foldable term
      , Has Fresh sig m
      , Has (A.Heap Precise (Concrete (term Name))) sig m
      , Has (State (Heap (term Name))) sig m
-     , Show (term Name)
      )
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
@@ -102,29 +96,23 @@ runFile eval file = traverse run file
 
 concreteAnalysis
   :: forall term m sig
-  .  ( Foldable term
-     , Has (A.Env Precise) sig m
+  .  ( Has (A.Env Precise) sig m
      , Has (A.Heap Precise (Concrete (term Name))) sig m
-     , Has (Reader Env) sig m
-     , Has (Reader Path.AbsRelFile) sig m
-     , Has (Reader Span) sig m
      , Has (State (Heap (term Name))) sig m
-     , MonadFail m
-     , Show (term Name)
      )
   => Analysis term Precise (Concrete (term Name)) m
 concreteAnalysis = Analysis{..}
-  where abstract _ name body = do
-          path <- ask
-          span <- ask
-          env <- asks (flip Map.restrictKeys (Set.delete name (foldMap Set.singleton body)))
-          pure (Closure path span name body env)
-        apply eval (Closure path span name body env) a = do
-          local (const path) . local (const span) $ do
-            addr <- A.alloc name
-            A.assign addr a
-            local (const (Map.insert name addr env)) (eval body)
-        apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
+  where -- abstract _ name body = do
+        --   path <- ask
+        --   span <- ask
+        --   env <- asks (flip Map.restrictKeys (Set.delete name (foldMap Set.singleton body)))
+        --   pure (Closure path span name body env)
+        -- apply eval (Closure path span name body env) a = do
+        --   local (const path) . local (const span) $ do
+        --     addr <- A.alloc name
+        --     A.assign addr a
+        --     local (const (Map.insert name addr env)) (eval body)
+        -- apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
         record fields = do
           fields' <- for fields $ \ (name, value) -> do
             addr <- A.alloc name
diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index d1c749b5f..d148ca73d 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -49,7 +49,7 @@ data Semi term
 
 
 importGraph
-  :: (Ord (term Name), Show (term Name))
+  :: Ord (term Name)
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
      => Analysis term Name (Value (term Name)) m
@@ -72,7 +72,6 @@ runFile
      , Has Fresh sig m
      , Has (State (Heap (Value (term Name)))) sig m
      , Ord  (term Name)
-     , Show (term Name)
      )
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
@@ -95,22 +94,18 @@ importGraphAnalysis
   :: ( Alternative m
      , Has (Env Name) sig m
      , Has (A.Heap Name (Value (term Name))) sig m
-     , Has (Reader Path.AbsRelFile) sig m
-     , Has (Reader Span) sig m
-     , MonadFail m
-     , Show (term Name)
      )
   => Analysis term Name (Value (term Name)) m
 importGraphAnalysis = Analysis{..}
-  where abstract _ name body = do
-          path <- ask
-          span <- ask
-          pure (Value (Closure path span name body) mempty)
-        apply eval (Value (Closure path span name body) _) a = local (const path) . local (const span) $ do
-          addr <- alloc @Name name
-          A.assign addr a
-          bind name addr (eval body)
-        apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
+  where -- abstract _ name body = do
+        --   path <- ask
+        --   span <- ask
+        --   pure (Value (Closure path span name body) mempty)
+        -- apply eval (Value (Closure path span name body) _) a = local (const path) . local (const -- span) $ do
+        --   addr <- alloc @Name name
+        --   A.assign addr a
+        --   bind name addr (eval body)
+        -- apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
         record fields = do
           for_ fields $ \ (k, v) -> do
             addr <- alloc @Name k
diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index 0b3f6ba26..42ab3abc3 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -97,11 +97,11 @@ scopeGraphAnalysis
      )
   => Analysis term Name (ScopeGraph Name) m
 scopeGraphAnalysis = Analysis{..}
-  where abstract eval name body = do
-          addr <- alloc @Name name
-          A.assign @Name @(ScopeGraph Name) name mempty
-          bind name addr (eval body)
-        apply _ f a = pure (f <> a)
+  where -- abstract eval name body = do
+        --   addr <- alloc @Name name
+        --   A.assign @Name @(ScopeGraph Name) name mempty
+        --   bind name addr (eval body)
+        -- apply _ f a = pure (f <> a)
         record fields = do
           fields' <- for fields $ \ (k, v) -> do
             addr <- alloc k
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 8b9f26af7..6cb588a1e 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -152,25 +152,23 @@ runFile eval file = traverse run file
 typecheckingAnalysis
   :: ( Alternative m
      , Has (Env Name) sig m
-     , Has Fresh sig m
      , Has (A.Heap Name Type) sig m
-     , Has (State (Set.Set Constraint)) sig m
      )
   => Analysis term Name Type m
 typecheckingAnalysis = Analysis{..}
-  where abstract eval name body = do
-          -- FIXME: construct the associated scope
-          addr <- alloc @Name name
-          arg <- meta
-          A.assign addr arg
-          ty <- eval body
-          pure (Alg (arg :-> ty))
-        apply _ f a = do
-          _A <- meta
-          _B <- meta
-          unify (Alg (_A :-> _B)) f
-          unify _A a
-          pure _B
+  where -- abstract eval name body = do
+        --   -- FIXME: construct the associated scope
+        --   addr <- alloc @Name name
+        --   arg <- meta
+        --   A.assign addr arg
+        --   ty <- eval body
+        --   pure (Alg (arg :-> ty))
+        -- apply _ f a = do
+        --   _A <- meta
+        --   _B <- meta
+        --   unify (Alg (_A :-> _B)) f
+        --   unify _A a
+        --   pure _B
         record fields = do
           fields' <- for fields $ \ (k, v) -> do
             addr <- alloc @Name k

From 1bc3c65efe77a151e98b67f94bfbd0384a41be5c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 11:18:54 -0500
Subject: [PATCH 170/318] :fire: the term parameter from Analysis.

---
 semantic-analysis/src/Analysis/Analysis.hs    | 3 +--
 semantic-analysis/src/Analysis/Concrete.hs    | 6 +++---
 semantic-analysis/src/Analysis/ImportGraph.hs | 6 +++---
 semantic-analysis/src/Analysis/ScopeGraph.hs  | 6 +++---
 semantic-analysis/src/Analysis/Typecheck.hs   | 6 +++---
 semantic-core/src/Core/Eval.hs                | 2 +-
 6 files changed, 14 insertions(+), 15 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
index f3627aad8..e411995d9 100644
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ b/semantic-analysis/src/Analysis/Analysis.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE KindSignatures #-}
 module Analysis.Analysis
 ( Analysis(..)
 ) where
@@ -8,7 +7,7 @@ import Analysis.Name
 -- | A record of functions necessary to perform analysis.
 --
 -- This is intended to be replaced with a selection of algebraic effects providing these interfaces and carriers providing reusable implementations.
-data Analysis (term :: * -> *) address value m = Analysis
+data Analysis address value m = Analysis
   { record   :: [(Name, value)] -> m value
   , (...)    :: address -> Name -> m (Maybe address)
   }
diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index d302814fb..5b041f551 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -59,7 +59,7 @@ type Heap term = IntMap.IntMap (Concrete term)
 concrete
   :: (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => Analysis term Precise (Concrete (term Name)) m
+     => Analysis Precise (Concrete (term Name)) m
      -> (term Name -> m (Concrete (term Name)))
      -> (term Name -> m (Concrete (term Name)))
      )
@@ -80,7 +80,7 @@ runFile
      )
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => Analysis term Precise (Concrete (term Name)) m
+     => Analysis Precise (Concrete (term Name)) m
      -> (term Name -> m (Concrete (term Name)))
      -> (term Name -> m (Concrete (term Name)))
      )
@@ -100,7 +100,7 @@ concreteAnalysis
      , Has (A.Heap Precise (Concrete (term Name))) sig m
      , Has (State (Heap (term Name))) sig m
      )
-  => Analysis term Precise (Concrete (term Name)) m
+  => Analysis Precise (Concrete (term Name)) m
 concreteAnalysis = Analysis{..}
   where -- abstract _ name body = do
         --   path <- ask
diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index d148ca73d..13cdfccd1 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -52,7 +52,7 @@ importGraph
   :: Ord (term Name)
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => Analysis term Name (Value (term Name)) m
+     => Analysis Name (Value (term Name)) m
      -> (term Name -> m (Value (term Name)))
      -> (term Name -> m (Value (term Name)))
      )
@@ -75,7 +75,7 @@ runFile
      )
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => Analysis term Name (Value (term Name)) m
+     => Analysis Name (Value (term Name)) m
      -> (term Name -> m (Value (term Name)))
      -> (term Name -> m (Value (term Name)))
      )
@@ -95,7 +95,7 @@ importGraphAnalysis
      , Has (Env Name) sig m
      , Has (A.Heap Name (Value (term Name))) sig m
      )
-  => Analysis term Name (Value (term Name)) m
+  => Analysis Name (Value (term Name)) m
 importGraphAnalysis = Analysis{..}
   where -- abstract _ name body = do
         --   path <- ask
diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index 42ab3abc3..4a4025050 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -54,7 +54,7 @@ scopeGraph
   :: Ord (term Name)
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => Analysis term Name (ScopeGraph Name) m
+     => Analysis Name (ScopeGraph Name) m
      -> (term Name -> m (ScopeGraph Name))
      -> (term Name -> m (ScopeGraph Name))
      )
@@ -74,7 +74,7 @@ runFile
      )
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => Analysis term Name (ScopeGraph Name) m
+     => Analysis Name (ScopeGraph Name) m
      -> (term Name -> m (ScopeGraph Name))
      -> (term Name -> m (ScopeGraph Name))
      )
@@ -95,7 +95,7 @@ scopeGraphAnalysis
      , Has (Reader Path.AbsRelFile) sig m
      , Has (Reader Span) sig m
      )
-  => Analysis term Name (ScopeGraph Name) m
+  => Analysis Name (ScopeGraph Name) m
 scopeGraphAnalysis = Analysis{..}
   where -- abstract eval name body = do
         --   addr <- alloc @Name name
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 6cb588a1e..bc1d16bad 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -98,7 +98,7 @@ typecheckingFlowInsensitive
   :: (Has Intro.Intro syn term, Ord (term Name))
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => Analysis term Name Type m
+     => Analysis Name Type m
      -> (term Name -> m Type)
      -> (term Name -> m Type)
      )
@@ -122,7 +122,7 @@ runFile
      )
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => Analysis term Name Type m
+     => Analysis Name Type m
      -> (term Name -> m Type)
      -> (term Name -> m Type)
      )
@@ -154,7 +154,7 @@ typecheckingAnalysis
      , Has (Env Name) sig m
      , Has (A.Heap Name Type) sig m
      )
-  => Analysis term Name Type m
+  => Analysis Name Type m
 typecheckingAnalysis = Analysis{..}
   where -- abstract eval name body = do
         --   -- FIXME: construct the associated scope
diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index a6afde09f..cc032c8fc 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -41,7 +41,7 @@ eval :: forall address value m sig
         , MonadFail m
         , Semigroup value
         )
-     => Analysis Term address value m
+     => Analysis address value m
      -> (Term Name -> m value)
      -> (Term Name -> m value)
 eval Analysis{..} eval = \case

From e546950f291f1ee83c886e5db4c21cedbe2b3785 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 11:52:05 -0500
Subject: [PATCH 171/318] Parameterize terms by addresses.

---
 .../src/Analysis/Effect/Domain.hs             | 38 +++++++++----------
 semantic-analysis/src/Analysis/Typecheck.hs   |  2 +-
 semantic-core/src/Core/Eval.hs                | 32 ++++++++--------
 3 files changed, 36 insertions(+), 36 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index 46c09d1f5..4869441d8 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -27,49 +27,49 @@ import Data.Text (Text)
 import GHC.Generics (Generic1)
 import Syntax.Scope (Scope)
 
-abstract :: Has (Domain term abstract) sig m => Intro term Name -> m abstract
+abstract :: Has (Domain term addr abstract) sig m => Intro term addr -> m abstract
 abstract concrete = send (Abstract concrete pure)
 
-concretize :: Has (Domain term abstract) sig m => abstract -> m (Intro term Name)
+concretize :: Has (Domain term addr abstract) sig m => abstract -> m (Intro term addr)
 concretize abstract = send (Concretize abstract pure)
 
 
-unit :: forall term abstract m sig . Has (Domain term abstract) sig m => m abstract
-unit = abstract @term A.Unit
+unit :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => m abstract
+unit = abstract @term @addr A.Unit
 
-bool :: forall term abstract m sig . Has (Domain term abstract) sig m => Bool -> m abstract
-bool = abstract @term . A.Bool
+bool :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => Bool -> m abstract
+bool = abstract @term @addr . A.Bool
 
-asBool :: forall term abstract m sig . (Has (Domain term abstract) sig m, MonadFail m, forall a . Show a => Show (term a)) => abstract -> m Bool
-asBool = concretize @term >=> \case
+asBool :: forall term addr abstract m sig . (Has (Domain term addr abstract) sig m, MonadFail m, Show addr, forall a . Show a => Show (term a)) => abstract -> m Bool
+asBool = concretize @term @addr >=> \case
   A.Bool b -> pure b
   other    -> typeError "Bool" other
 
-string :: forall term abstract m sig . Has (Domain term abstract) sig m => Text -> m abstract
-string = abstract @term . A.String
+string :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => Text -> m abstract
+string = abstract @term @addr . A.String
 
-asString :: forall term abstract m sig . (Has (Domain term abstract) sig m, MonadFail m, forall a . Show a => Show (term a)) => abstract -> m Text
-asString = concretize @term >=> \case
+asString :: forall term addr abstract m sig . (Has (Domain term addr abstract) sig m, MonadFail m, Show addr, forall a . Show a => Show (term a)) => abstract -> m Text
+asString = concretize @term @addr >=> \case
   A.String t -> pure t
   other      -> typeError "String" other
 
 
-lam :: Has (Domain term abstract) sig m => Named (Scope () term Name) -> m abstract
+lam :: Has (Domain term addr abstract) sig m => Named (Scope () term addr) -> m abstract
 lam = abstract . A.Lam
 
-asLam :: (Has (Domain term abstract) sig m, MonadFail m, forall a . Show a => Show (term a)) => abstract -> m (Named (Scope () term Name))
+asLam :: (Has (Domain term addr abstract) sig m, MonadFail m, Show addr, forall a . Show a => Show (term a)) => abstract -> m (Named (Scope () term addr))
 asLam = concretize >=> \case
   A.Lam b -> pure b
   other   -> typeError "Lam" other
 
 
-data Domain term abstract m k
-  = Abstract   (Intro term Name) (abstract        -> m k)
-  | Concretize abstract          (Intro term Name -> m k)
+data Domain term addr abstract m k
+  = Abstract   (Intro term addr) (abstract        -> m k)
+  | Concretize abstract          (Intro term addr -> m k)
   deriving (Functor, Generic1)
 
-instance HFunctor (Domain term abstract)
-instance Effect   (Domain term abstract)
+instance HFunctor (Domain term addr abstract)
+instance Effect   (Domain term addr abstract)
 
 
 typeError :: (Show a, MonadFail m) => String -> a -> m b
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index bc1d16bad..dadd31150 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -243,7 +243,7 @@ instance ( Alternative m
          , Monad term
          , MonadFail m
          , Has Intro.Intro syn term
-         ) => Algebra (Domain term Type :+: sig) (DomainC term m) where
+         ) => Algebra (Domain term Name Type :+: sig) (DomainC term m) where
   alg (L (Abstract v k)) = case v of
     Intro.Unit     -> k (Alg Unit)
     Intro.Bool   _ -> k (Alg Bool)
diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index cc032c8fc..919fed990 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -34,22 +34,23 @@ import qualified System.Path as Path
 type Term = Term.Term (Ann Span :+: Core :+: Intro)
 
 eval :: forall address value m sig
-     .  ( Has (Domain Term value) sig m
+     .  ( Has (Domain Term address value) sig m
         , Has (Env address) sig m
         , Has (Heap address value) sig m
         , Has (Reader Span) sig m
         , MonadFail m
         , Semigroup value
+        , Show address
         )
      => Analysis address value m
-     -> (Term Name -> m value)
-     -> (Term Name -> m value)
+     -> (Term address -> m value)
+     -> (Term address -> m value)
 eval Analysis{..} eval = \case
-  Term.Var n -> lookupEnv' n >>= deref' n
+  Term.Var n -> deref' n n
   Term.Alg (R (L c)) -> case c of
     Rec (Named n b) -> do
       addr <- A.alloc @address n
-      v <- A.bind n addr (eval (instantiate1 (pure n) b))
+      v <- A.bind n addr (eval (instantiate1 (pure addr) b))
       v <$ A.assign addr v
     -- NB: Combining the results of the evaluations allows us to model effects in abstract domains. This in turn means that we can define an abstract domain modelling the types-and-effects of computations by means of a 'Semigroup' instance which takes the type of its second operand and the union of both operands’ effects.
     --
@@ -59,18 +60,18 @@ eval Analysis{..} eval = \case
       a' <- eval a
       addr <- A.alloc @address n
       A.assign addr a'
-      A.bind n addr ((a' <>) <$> eval (instantiate1 (pure n) b))
+      A.bind n addr ((a' <>) <$> eval (instantiate1 (pure addr) b))
     Lam (Named n b) -> A.lam (Named n b)
     f :$ a -> do
       Named n b <- eval f >>= asLam
       a' <- eval a
       addr <- A.alloc @address n
       A.assign addr a'
-      A.bind n addr (eval (instantiate1 (pure n) b))
+      A.bind n addr (eval (instantiate1 (pure addr) b))
     If c t e -> do
-      c' <- eval c >>= A.asBool @Term
+      c' <- eval c >>= A.asBool @Term @address
       if c' then eval t else eval e
-    Load p -> eval p >>= A.asString @Term >> A.unit @Term -- FIXME: add a load command or something
+    Load p -> eval p >>= A.asString @Term @address >> A.unit @Term @address -- FIXME: add a load command or something
     Record fields -> traverse (traverse eval) fields >>= record
     a :. b -> do
       a' <- ref a
@@ -78,29 +79,28 @@ eval Analysis{..} eval = \case
     a :? b -> do
       a' <- ref a
       mFound <- a' ... b
-      A.bool @Term (isJust mFound)
+      A.bool @Term @address (isJust mFound)
 
     a := b -> do
       b' <- eval b
       addr <- ref a
       b' <$ A.assign addr b'
   Term.Alg (R (R c)) -> case c of
-    Unit -> A.unit @Term
-    Bool b -> A.bool @Term b
-    String s -> A.string @Term s
+    Unit -> A.unit @Term @address
+    Bool b -> A.bool @Term @address b
+    String s -> A.string @Term @address s
   Term.Alg (L (Ann span c)) -> local (const span) (eval c)
   where freeVariable s = fail ("free variable: " <> s)
         uninitialized s = fail ("uninitialized variable: " <> s)
         invalidRef s = fail ("invalid ref: " <> s)
 
-        lookupEnv' n = A.lookupEnv n >>= maybe (freeVariable (show n)) pure
         deref' n = A.deref @address >=> maybe (uninitialized (show n)) pure
 
         ref = \case
-          Term.Var n -> lookupEnv' n
+          Term.Var n -> pure n
           Term.Alg (R (L c)) -> case c of
             If c t e -> do
-              c' <- eval c >>= A.asBool @Term
+              c' <- eval c >>= A.asBool @Term @address
               if c' then ref t else ref e
             a :. b -> do
               a' <- ref a

From cb2a9959cead7c681ec64066b89691bb78c2eba6 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 11:56:42 -0500
Subject: [PATCH 172/318] Add records to Intro.

---
 semantic-analysis/src/Analysis/Effect/Domain.hs | 11 +++++++++++
 semantic-analysis/src/Analysis/Intro.hs         |  7 +++++++
 semantic-analysis/src/Analysis/Typecheck.hs     |  9 +++++++++
 3 files changed, 27 insertions(+)

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index 4869441d8..af0d52ee0 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -10,6 +10,8 @@ module Analysis.Effect.Domain
 , asString
 , lam
 , asLam
+, record
+, asRecord
 , Domain(..)
   -- * Re-exports
 , Algebra
@@ -63,6 +65,15 @@ asLam = concretize >=> \case
   other   -> typeError "Lam" other
 
 
+record :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => [(Name, term addr)] -> m abstract
+record = abstract @term . A.Record
+
+asRecord :: forall term addr abstract m sig . (Has (Domain term addr abstract) sig m, MonadFail m, Show addr, forall a . Show a => Show (term a)) => abstract -> m [(Name, term addr)]
+asRecord = concretize @term >=> \case
+  A.Record fs -> pure fs
+  other       -> typeError "Record" other
+
+
 data Domain term addr abstract m k
   = Abstract   (Intro term addr) (abstract        -> m k)
   | Concretize abstract          (Intro term addr -> m k)
diff --git a/semantic-analysis/src/Analysis/Intro.hs b/semantic-analysis/src/Analysis/Intro.hs
index 12e7bf52f..17fb4358a 100644
--- a/semantic-analysis/src/Analysis/Intro.hs
+++ b/semantic-analysis/src/Analysis/Intro.hs
@@ -5,6 +5,7 @@ module Analysis.Intro
 , bool
 , string
 , lam
+, record
 ) where
 
 import Analysis.Name
@@ -21,6 +22,7 @@ data Intro t a
   | Bool Bool
   | String Text
   | Lam (Named (Scope () t a))
+  | Record [(Name, t a)]
   deriving (Foldable, Functor, Generic1, Traversable)
 
 deriving instance (Eq   a, forall a . Eq   a => Eq   (f a), Monad f) => Eq   (Intro f a)
@@ -37,6 +39,7 @@ instance RightModule Intro where
   Bool b   >>=* _ = Bool b
   String s >>=* _ = String s
   Lam b    >>=* f = Lam ((>>=* f) <$> b)
+  Record t >>=* f = Record (map (fmap (>>= f)) t)
 
 
 unit :: Has Intro sig m => m a
@@ -51,3 +54,7 @@ string = send . String
 
 lam :: (Eq a, Has Intro sig m) => Named a -> m a -> m a
 lam (Named u n) b = send (Lam (Named u (abstract1 n b)))
+
+
+record :: Has Intro sig m => [(Name, m a)] -> m a
+record = send . Record
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index dadd31150..7e5e8213e 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -255,6 +255,15 @@ instance ( Alternative m
       A.assign addr arg
       ty <- lift (eval (instantiate1 (pure n) b))
       k (Alg (arg :-> ty))
+    Intro.Record fields -> do
+      eval <- DomainC (asks runEvaluator)
+      fields' <- for fields $ \ (k, t) -> do
+        addr <- alloc @Name k
+        v <- lift (eval t)
+        (k, v) <$ A.assign addr v
+      -- FIXME: should records reference types by address instead?
+      k (Alg (Record (Map.fromList fields')))
+
   alg (L (Concretize t k)) = case t of
     Alg Unit      -> k Intro.Unit
     Alg Bool      -> k (Intro.Bool True) <|> k (Intro.Bool False)

From 76c56e387dad82233105ac5e78651255adc7cdb3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 11:59:39 -0500
Subject: [PATCH 173/318] Concretize records.

---
 semantic-analysis/src/Analysis/Typecheck.hs | 9 +++++----
 1 file changed, 5 insertions(+), 4 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 7e5e8213e..421a90d67 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -265,9 +265,10 @@ instance ( Alternative m
       k (Alg (Record (Map.fromList fields')))
 
   alg (L (Concretize t k)) = case t of
-    Alg Unit      -> k Intro.Unit
-    Alg Bool      -> k (Intro.Bool True) <|> k (Intro.Bool False)
-    Alg String    -> k (Intro.String mempty)
-    Alg (_ :-> b) -> concretize @term b >>= k . Intro.Lam . Named (Name mempty) . lift . send
+    Alg Unit       -> k Intro.Unit
+    Alg Bool       -> k (Intro.Bool True) <|> k (Intro.Bool False)
+    Alg String     -> k (Intro.String mempty)
+    Alg (_ :-> b)  -> concretize @term b >>= k . Intro.Lam . Named (Name mempty) . lift . send
+    Alg (Record t) -> traverse (traverse concretize) (Map.toList t) >>= k . Intro.Record . map (fmap send)
     t             -> fail ("can’t concretize " <> show t)
   alg (R other) = DomainC (send (handleCoercible other))

From 6810624e2c0422704cad9665e5ef874ffee1135b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 12:02:28 -0500
Subject: [PATCH 174/318] Note a fixme.

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

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 421a90d67..d5637f289 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -272,3 +272,5 @@ instance ( Alternative m
     Alg (Record t) -> traverse (traverse concretize) (Map.toList t) >>= k . Intro.Record . map (fmap send)
     t             -> fail ("can’t concretize " <> show t)
   alg (R other) = DomainC (send (handleCoercible other))
+
+-- FIXME: we don’t get the chance to unify anything because concretization asks for an intro form, not an intro form of a specific type

From c4db1c9db4e356c5db41e3da554d8eb9ce1691e5 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 12:09:37 -0500
Subject: [PATCH 175/318] Evaluate records using the Domain effect.

---
 semantic-core/src/Core/Eval.hs | 11 +++++------
 1 file changed, 5 insertions(+), 6 deletions(-)

diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index 919fed990..ddf488d37 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -72,14 +72,13 @@ eval Analysis{..} eval = \case
       c' <- eval c >>= A.asBool @Term @address
       if c' then eval t else eval e
     Load p -> eval p >>= A.asString @Term @address >> A.unit @Term @address -- FIXME: add a load command or something
-    Record fields -> traverse (traverse eval) fields >>= record
+    Record fields -> A.record fields
     a :. b -> do
-      a' <- ref a
-      a' ... b >>= maybe (freeVariable (show b)) (deref' b)
+      a' <- eval a >>= asRecord @Term @address
+      maybe (freeVariable (show b)) eval (lookup b a')
     a :? b -> do
-      a' <- ref a
-      mFound <- a' ... b
-      A.bool @Term @address (isJust mFound)
+      a' <- eval a >>= asRecord @Term @address
+      A.bool @Term @address (isJust (lookup b a'))
 
     a := b -> do
       b' <- eval b

From f68bce11f665fdf590f9af55672903e164699bd0 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 12:11:37 -0500
Subject: [PATCH 176/318] Reference variables using the Domain effect.

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

diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index ddf488d37..655fefe08 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -102,8 +102,8 @@ eval Analysis{..} eval = \case
               c' <- eval c >>= A.asBool @Term @address
               if c' then ref t else ref e
             a :. b -> do
-              a' <- ref a
-              a' ... b >>= maybe (freeVariable (show b)) pure
+              a' <- eval a >>= asRecord @Term @address
+              maybe (freeVariable (show b)) ref (lookup b a')
             c -> invalidRef (show c)
           Term.Alg (R (R c)) -> invalidRef (show c)
           Term.Alg (L (Ann span c)) -> local (const span) (ref c)

From cc403afe27bb91d1881e1ae5f78a3571895bb217 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 12:30:05 -0500
Subject: [PATCH 177/318] :fire: Analysis.

---
 semantic-analysis/semantic-analysis.cabal     |   1 -
 semantic-analysis/src/Analysis/Analysis.hs    |  13 --
 semantic-analysis/src/Analysis/Concrete.hs    | 111 ++++++++----------
 semantic-analysis/src/Analysis/ImportGraph.hs |  57 ++++-----
 semantic-analysis/src/Analysis/ScopeGraph.hs  |  58 ++++-----
 semantic-analysis/src/Analysis/Typecheck.hs   |  64 +++++-----
 semantic-core/src/Core/Eval.hs                |   6 +-
 7 files changed, 134 insertions(+), 176 deletions(-)
 delete mode 100644 semantic-analysis/src/Analysis/Analysis.hs

diff --git a/semantic-analysis/semantic-analysis.cabal b/semantic-analysis/semantic-analysis.cabal
index 6278e92a9..5de05c452 100644
--- a/semantic-analysis/semantic-analysis.cabal
+++ b/semantic-analysis/semantic-analysis.cabal
@@ -40,7 +40,6 @@ library
   import: common
   hs-source-dirs: src
   exposed-modules:
-    Analysis.Analysis
     Analysis.Carrier.Env.Monovariant
     Analysis.Carrier.Env.Precise
     Analysis.Carrier.Heap.Monovariant
diff --git a/semantic-analysis/src/Analysis/Analysis.hs b/semantic-analysis/src/Analysis/Analysis.hs
deleted file mode 100644
index e411995d9..000000000
--- a/semantic-analysis/src/Analysis/Analysis.hs
+++ /dev/null
@@ -1,13 +0,0 @@
-module Analysis.Analysis
-( Analysis(..)
-) where
-
-import Analysis.Name
-
--- | A record of functions necessary to perform analysis.
---
--- This is intended to be replaced with a selection of algebraic effects providing these interfaces and carriers providing reusable implementations.
-data Analysis address value m = Analysis
-  { record   :: [(Name, value)] -> m value
-  , (...)    :: address -> Name -> m (Maybe address)
-  }
diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 5b041f551..b13a437e5 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -4,7 +4,6 @@
 module Analysis.Concrete
 ( Concrete(..)
 , concrete
-, concreteAnalysis
 , heapGraph
 , heapValueGraph
 , heapAddressGraph
@@ -13,7 +12,6 @@ module Analysis.Concrete
 
 import qualified Algebra.Graph as G
 import qualified Algebra.Graph.Export.Dot as G
-import           Analysis.Analysis
 import qualified Analysis.Carrier.Env.Precise as A
 import qualified Analysis.Carrier.Heap.Precise as A
 import           Analysis.File
@@ -21,17 +19,12 @@ import           Analysis.Name
 import           Control.Algebra
 import           Control.Carrier.Fail.WithLoc
 import           Control.Carrier.Fresh.Strict
-import           Control.Carrier.NonDet.Church
 import           Control.Carrier.Reader hiding (Local)
-import           Control.Carrier.State.Strict
-import           Control.Monad ((<=<))
 import           Data.Function (fix)
 import qualified Data.IntMap as IntMap
-import qualified Data.IntSet as IntSet
 import qualified Data.Map as Map
 import           Data.Semigroup (Last (..))
 import           Data.Text (Text, pack)
-import           Data.Traversable (for)
 import           Prelude hiding (fail)
 import           Source.Span
 import qualified System.Path as Path
@@ -49,9 +42,9 @@ data Concrete term
   -- NB: We derive the 'Semigroup' instance for 'Concrete' to take the second argument. This is equivalent to stating that the return value of an imperative sequence of statements is the value of its final statement.
   deriving Semigroup via Last (Concrete term)
 
-recordFrame :: Concrete term -> Maybe Env
-recordFrame (Record frame) = Just frame
-recordFrame _              = Nothing
+-- recordFrame :: Concrete term -> Maybe Env
+-- recordFrame (Record frame) = Just frame
+-- recordFrame _              = Nothing
 
 type Heap term = IntMap.IntMap (Concrete term)
 
@@ -59,8 +52,7 @@ type Heap term = IntMap.IntMap (Concrete term)
 concrete
   :: (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => Analysis Precise (Concrete (term Name)) m
-     -> (term Name -> m (Concrete (term Name)))
+     => (term Name -> m (Concrete (term Name)))
      -> (term Name -> m (Concrete (term Name)))
      )
   -> [File (term Name)]
@@ -75,13 +67,10 @@ runFile
   :: forall term m sig
   .  ( Effect sig
      , Has Fresh sig m
-     , Has (A.Heap Precise (Concrete (term Name))) sig m
-     , Has (State (Heap (term Name))) sig m
      )
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => Analysis Precise (Concrete (term Name)) m
-     -> (term Name -> m (Concrete (term Name)))
+     => (term Name -> m (Concrete (term Name)))
      -> (term Name -> m (Concrete (term Name)))
      )
   -> File (term Name)
@@ -92,54 +81,54 @@ runFile eval file = traverse run file
             . runFail
             . runReader @Env mempty
             . A.runEnv
-            . fix (eval concreteAnalysis)
+            . fix eval
 
-concreteAnalysis
-  :: forall term m sig
-  .  ( Has (A.Env Precise) sig m
-     , Has (A.Heap Precise (Concrete (term Name))) sig m
-     , Has (State (Heap (term Name))) sig m
-     )
-  => Analysis Precise (Concrete (term Name)) m
-concreteAnalysis = Analysis{..}
-  where -- abstract _ name body = do
-        --   path <- ask
-        --   span <- ask
-        --   env <- asks (flip Map.restrictKeys (Set.delete name (foldMap Set.singleton body)))
-        --   pure (Closure path span name body env)
-        -- apply eval (Closure path span name body env) a = do
-        --   local (const path) . local (const span) $ do
-        --     addr <- A.alloc name
-        --     A.assign addr a
-        --     local (const (Map.insert name addr env)) (eval body)
-        -- apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
-        record fields = do
-          fields' <- for fields $ \ (name, value) -> do
-            addr <- A.alloc name
-            A.assign addr value
-            pure (name, addr)
-          pure (Record (Map.fromList fields'))
-        addr ... n = do
-          val <- A.deref @Precise @(Concrete (term Name)) addr
-          heap <- get
-          pure (val >>= lookupConcrete heap n)
+-- concreteAnalysis
+--   :: forall term m sig
+--   .  ( Has (A.Env Precise) sig m
+--      , Has (A.Heap Precise (Concrete (term Name))) sig m
+--      , Has (State (Heap (term Name))) sig m
+--      )
+--   => Analysis Precise (Concrete (term Name)) m
+-- concreteAnalysis = Analysis{..}
+--   where -- abstract _ name body = do
+--         --   path <- ask
+--         --   span <- ask
+--         --   env <- asks (flip Map.restrictKeys (Set.delete name (foldMap Set.singleton body)))
+--         --   pure (Closure path span name body env)
+--         -- apply eval (Closure path span name body env) a = do
+--         --   local (const path) . local (const span) $ do
+--         --     addr <- A.alloc name
+--         --     A.assign addr a
+--         --     local (const (Map.insert name addr env)) (eval body)
+--         -- apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
+--         record fields = do
+--           fields' <- for fields $ \ (name, value) -> do
+--             addr <- A.alloc name
+--             A.assign addr value
+--             pure (name, addr)
+--           pure (Record (Map.fromList fields'))
+--         addr ... n = do
+--           val <- A.deref @Precise @(Concrete (term Name)) addr
+--           heap <- get
+--           pure (val >>= lookupConcrete heap n)
 
 
-lookupConcrete :: Heap (term Name) -> Name -> Concrete (term Name) -> Maybe Precise
-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
-        inFrame fs = maybeA (Map.lookup name fs) <|> (maybeA (Map.lookup "__semantic_super" fs) >>= inAddress)
-        -- look up the name in the value an address points to, if we haven’t already visited it
-        inAddress addr = do
-          visited <- get
-          guard (addr `IntSet.notMember` visited)
-          -- FIXME: throw an error if we can’t deref @addr@
-          val <- maybeA (IntMap.lookup addr heap)
-          modify (IntSet.insert addr)
-          inConcrete val
-        maybeA = maybe empty pure
+-- lookupConcrete :: Heap (term Name) -> Name -> Concrete (term Name) -> Maybe Precise
+-- 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
+--         inFrame fs = maybeA (Map.lookup name fs) <|> (maybeA (Map.lookup "__semantic_super" fs) >>= inAddress)
+--         -- look up the name in the value an address points to, if we haven’t already visited it
+--         inAddress addr = do
+--           visited <- get
+--           guard (addr `IntSet.notMember` visited)
+--           -- FIXME: throw an error if we can’t deref @addr@
+--           val <- maybeA (IntMap.lookup addr heap)
+--           modify (IntSet.insert addr)
+--           inConcrete val
+--         maybeA = maybe empty pure
 
 
 -- | 'heapGraph', 'heapValueGraph', and 'heapAddressGraph' allow us to conveniently export SVGs of the heap:
diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 13cdfccd1..d960d8db6 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -2,22 +2,19 @@
 module Analysis.ImportGraph
 ( ImportGraph
 , importGraph
-, importGraphAnalysis
 ) where
 
-import           Analysis.Analysis
 import           Analysis.Carrier.Env.Monovariant
 import qualified Analysis.Carrier.Heap.Monovariant as A
 import           Analysis.File
 import           Analysis.FlowInsensitive
 import           Analysis.Name
-import           Control.Applicative (Alternative(..))
 import           Control.Algebra
 import           Control.Carrier.Fail.WithLoc
 import           Control.Carrier.Fresh.Strict
 import           Control.Carrier.Reader
 import           Control.Carrier.State.Strict
-import           Data.Foldable (fold, for_)
+import           Data.Foldable (fold)
 import           Data.Function (fix)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
@@ -52,8 +49,7 @@ importGraph
   :: Ord (term Name)
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => Analysis Name (Value (term Name)) m
-     -> (term Name -> m (Value (term Name)))
+     => (term Name -> m (Value (term Name)))
      -> (term Name -> m (Value (term Name)))
      )
   -> [File (term Name)]
@@ -75,8 +71,7 @@ runFile
      )
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => Analysis Name (Value (term Name)) m
-     -> (term Name -> m (Value (term Name)))
+     => (term Name -> m (Value (term Name)))
      -> (term Name -> m (Value (term Name)))
      )
   -> File (term Name)
@@ -87,28 +82,28 @@ runFile eval file = traverse run file
             . runEnv
             . runFail
             . fmap fold
-            . convergeTerm 0 (A.runHeap @Name @(Value (term Name)) . fix (cacheTerm . eval importGraphAnalysis))
+            . convergeTerm 0 (A.runHeap @Name @(Value (term Name)) . fix (cacheTerm . eval))
 
 -- FIXME: decompose into a product domain and two atomic domains
-importGraphAnalysis
-  :: ( Alternative m
-     , Has (Env Name) sig m
-     , Has (A.Heap Name (Value (term Name))) sig m
-     )
-  => Analysis Name (Value (term Name)) m
-importGraphAnalysis = Analysis{..}
-  where -- abstract _ name body = do
-        --   path <- ask
-        --   span <- ask
-        --   pure (Value (Closure path span name body) mempty)
-        -- apply eval (Value (Closure path span name body) _) a = local (const path) . local (const -- span) $ do
-        --   addr <- alloc @Name name
-        --   A.assign addr a
-        --   bind name addr (eval body)
-        -- apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
-        record fields = do
-          for_ fields $ \ (k, v) -> do
-            addr <- alloc @Name k
-            A.assign addr v
-          pure (Value Abstract (foldMap (valueGraph . snd) fields))
-        _ ... m = pure (Just m)
+-- importGraphAnalysis
+--   :: ( Alternative m
+--      , Has (Env Name) sig m
+--      , Has (A.Heap Name (Value (term Name))) sig m
+--      )
+--   => Analysis Name (Value (term Name)) m
+-- importGraphAnalysis = Analysis{..}
+--   where -- abstract _ name body = do
+--         --   path <- ask
+--         --   span <- ask
+--         --   pure (Value (Closure path span name body) mempty)
+--         -- apply eval (Value (Closure path span name body) _) a = local (const path) . local (const -- span) $ do
+--         --   addr <- alloc @Name name
+--         --   A.assign addr a
+--         --   bind name addr (eval body)
+--         -- apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
+--         record fields = do
+--           for_ fields $ \ (k, v) -> do
+--             addr <- alloc @Name k
+--             A.assign addr v
+--           pure (Value Abstract (foldMap (valueGraph . snd) fields))
+--         _ ... m = pure (Just m)
diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index 4a4025050..73d62e5bc 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -4,17 +4,14 @@ module Analysis.ScopeGraph
 , Ref (..)
 , Decl(..)
 , scopeGraph
-, scopeGraphAnalysis
 ) where
 
-import           Analysis.Analysis
 import           Analysis.Carrier.Env.Monovariant
 import qualified Analysis.Carrier.Heap.Monovariant as A
 import           Analysis.File
 import           Analysis.FlowInsensitive
 import           Analysis.Name
 import           Control.Algebra
-import           Control.Applicative (Alternative (..))
 import           Control.Carrier.Reader
 import           Control.Carrier.Fail.WithLoc
 import           Control.Carrier.Fresh.Strict
@@ -23,7 +20,6 @@ import           Data.Foldable (fold)
 import           Data.Function (fix)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-import           Data.Traversable (for)
 import           Prelude hiding (fail)
 import           Source.Span
 import qualified System.Path as Path
@@ -54,8 +50,7 @@ scopeGraph
   :: Ord (term Name)
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => Analysis Name (ScopeGraph Name) m
-     -> (term Name -> m (ScopeGraph Name))
+     => (term Name -> m (ScopeGraph Name))
      -> (term Name -> m (ScopeGraph Name))
      )
   -> [File (term Name)]
@@ -74,8 +69,7 @@ runFile
      )
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => Analysis Name (ScopeGraph Name) m
-     -> (term Name -> m (ScopeGraph Name))
+     => (term Name -> m (ScopeGraph Name))
      -> (term Name -> m (ScopeGraph Name))
      )
   -> File (term Name)
@@ -86,28 +80,28 @@ runFile eval file = traverse run file
             . runEnv
             . runFail
             . fmap fold
-            . convergeTerm 0 (A.runHeap @Name @(ScopeGraph Name) . fix (cacheTerm . eval scopeGraphAnalysis))
+            . convergeTerm 0 (A.runHeap @Name @(ScopeGraph Name) . fix (cacheTerm . eval))
 
-scopeGraphAnalysis
-  :: ( Alternative m
-     , Has (Env Name) sig m
-     , Has (A.Heap Name (ScopeGraph Name)) sig m
-     , Has (Reader Path.AbsRelFile) sig m
-     , Has (Reader Span) sig m
-     )
-  => Analysis Name (ScopeGraph Name) m
-scopeGraphAnalysis = Analysis{..}
-  where -- abstract eval name body = do
-        --   addr <- alloc @Name name
-        --   A.assign @Name @(ScopeGraph Name) name mempty
-        --   bind name addr (eval body)
-        -- apply _ f a = pure (f <> a)
-        record fields = do
-          fields' <- for fields $ \ (k, v) -> do
-            addr <- alloc k
-            path <- ask
-            span <- ask
-            let v' = ScopeGraph (Map.singleton (Decl k path span) mempty) <> v
-            (k, v') <$ A.assign @Name addr v'
-          pure (foldMap snd fields')
-        _ ... m = pure (Just m)
+-- scopeGraphAnalysis
+--   :: ( Alternative m
+--      , Has (Env Name) sig m
+--      , Has (A.Heap Name (ScopeGraph Name)) sig m
+--      , Has (Reader Path.AbsRelFile) sig m
+--      , Has (Reader Span) sig m
+--      )
+--   => Analysis Name (ScopeGraph Name) m
+-- scopeGraphAnalysis = Analysis{..}
+--   where -- abstract eval name body = do
+--         --   addr <- alloc @Name name
+--         --   A.assign @Name @(ScopeGraph Name) name mempty
+--         --   bind name addr (eval body)
+--         -- apply _ f a = pure (f <> a)
+--         record fields = do
+--           fields' <- for fields $ \ (k, v) -> do
+--             addr <- alloc k
+--             path <- ask
+--             span <- ask
+--             let v' = ScopeGraph (Map.singleton (Decl k path span) mempty) <> v
+--             (k, v') <$ A.assign @Name addr v'
+--           pure (foldMap snd fields')
+--         _ ... m = pure (Just m)
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index d5637f289..fed761de2 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -4,10 +4,8 @@ module Analysis.Typecheck
 , Meta
 , Polytype (..)
 , typecheckingFlowInsensitive
-, typecheckingAnalysis
 ) where
 
-import           Analysis.Analysis
 import           Analysis.Carrier.Env.Monovariant
 import qualified Analysis.Carrier.Heap.Monovariant as A
 import           Analysis.Effect.Domain
@@ -98,8 +96,7 @@ typecheckingFlowInsensitive
   :: (Has Intro.Intro syn term, Ord (term Name))
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => Analysis Name Type m
-     -> (term Name -> m Type)
+     => (term Name -> m Type)
      -> (term Name -> m Type)
      )
   -> [File (term Name)]
@@ -122,8 +119,7 @@ runFile
      )
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => Analysis Name Type m
-     -> (term Name -> m Type)
+     => (term Name -> m Type)
      -> (term Name -> m Type)
      )
   -> File (term Name)
@@ -147,35 +143,35 @@ runFile eval file = traverse run file
               v <- meta
               bs <- m
               v <$ for_ bs (unify v))
-          . convergeTerm 1  (A.runHeap @Name @Type . fix (\ eval' -> runDomain (Evaluator eval') . fix (cacheTerm . eval typecheckingAnalysis)))
+          . convergeTerm 1  (A.runHeap @Name @Type . fix (\ eval' -> runDomain (Evaluator eval') . fix (cacheTerm . eval)))
 
-typecheckingAnalysis
-  :: ( Alternative m
-     , Has (Env Name) sig m
-     , Has (A.Heap Name Type) sig m
-     )
-  => Analysis Name Type m
-typecheckingAnalysis = Analysis{..}
-  where -- abstract eval name body = do
-        --   -- FIXME: construct the associated scope
-        --   addr <- alloc @Name name
-        --   arg <- meta
-        --   A.assign addr arg
-        --   ty <- eval body
-        --   pure (Alg (arg :-> ty))
-        -- apply _ f a = do
-        --   _A <- meta
-        --   _B <- meta
-        --   unify (Alg (_A :-> _B)) f
-        --   unify _A a
-        --   pure _B
-        record fields = do
-          fields' <- for fields $ \ (k, v) -> do
-            addr <- alloc @Name k
-            (k, v) <$ A.assign addr v
-          -- FIXME: should records reference types by address instead?
-          pure (Alg (Record (Map.fromList fields')))
-        _ ... m = pure (Just m)
+-- typecheckingAnalysis
+--   :: ( Alternative m
+--      , Has (Env Name) sig m
+--      , Has (A.Heap Name Type) sig m
+--      )
+--   => Analysis Name Type m
+-- typecheckingAnalysis = Analysis{..}
+--   where -- abstract eval name body = do
+--         --   -- FIXME: construct the associated scope
+--         --   addr <- alloc @Name name
+--         --   arg <- meta
+--         --   A.assign addr arg
+--         --   ty <- eval body
+--         --   pure (Alg (arg :-> ty))
+--         -- apply _ f a = do
+--         --   _A <- meta
+--         --   _B <- meta
+--         --   unify (Alg (_A :-> _B)) f
+--         --   unify _A a
+--         --   pure _B
+--         record fields = do
+--           fields' <- for fields $ \ (k, v) -> do
+--             addr <- alloc @Name k
+--             (k, v) <$ A.assign addr v
+--           -- FIXME: should records reference types by address instead?
+--           pure (Alg (Record (Map.fromList fields')))
+--         _ ... m = pure (Just m)
 
 
 data Constraint = Type :===: Type
diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index 655fefe08..4a36c7362 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -10,7 +10,6 @@ module Core.Eval
 , ruby
 ) where
 
-import Analysis.Analysis
 import Analysis.Effect.Domain as A
 import Analysis.Effect.Env as A
 import Analysis.Effect.Heap as A
@@ -42,10 +41,9 @@ eval :: forall address value m sig
         , Semigroup value
         , Show address
         )
-     => Analysis address value m
+     => (Term address -> m value)
      -> (Term address -> m value)
-     -> (Term address -> m value)
-eval Analysis{..} eval = \case
+eval eval = \case
   Term.Var n -> deref' n n
   Term.Alg (R (L c)) -> case c of
     Rec (Named n b) -> do

From 4485d3622d8bdae97823d54ad9d0bfa9e69cf706 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 12:32:13 -0500
Subject: [PATCH 178/318] :fire: Evaluator.

---
 semantic-analysis/src/Analysis/Typecheck.hs | 12 +++++-------
 1 file changed, 5 insertions(+), 7 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index fed761de2..0292665c7 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -143,7 +143,7 @@ runFile eval file = traverse run file
               v <- meta
               bs <- m
               v <$ for_ bs (unify v))
-          . convergeTerm 1  (A.runHeap @Name @Type . fix (\ eval' -> runDomain (Evaluator eval') . fix (cacheTerm . eval)))
+          . convergeTerm 1  (A.runHeap @Name @Type . fix (\ eval' -> runDomain eval' . fix (cacheTerm . eval)))
 
 -- typecheckingAnalysis
 --   :: ( Alternative m
@@ -221,12 +221,10 @@ substAll :: Monad t => IntMap.IntMap (t Meta) -> t Meta -> t Meta
 substAll s a = a >>= \ i -> fromMaybe (pure i) (IntMap.lookup i s)
 
 
-runDomain :: Evaluator term m -> DomainC term m a -> m a
+runDomain :: (term Name -> m Type) -> DomainC term m a -> m a
 runDomain eval (DomainC m) = runReader eval m
 
-newtype Evaluator term m = Evaluator { runEvaluator :: term Name -> m Type }
-
-newtype DomainC term m a = DomainC (ReaderC (Evaluator term m) m a)
+newtype DomainC term m a = DomainC (ReaderC (term Name -> m Type) m a)
   deriving (Alternative, Applicative, Functor, Monad, MonadFail)
 
 instance MonadTrans (DomainC term) where
@@ -245,14 +243,14 @@ instance ( Alternative m
     Intro.Bool   _ -> k (Alg Bool)
     Intro.String _ -> k (Alg String)
     Intro.Lam (Named n b) -> do
-      eval <- DomainC (asks runEvaluator)
+      eval <- DomainC ask
       addr <- alloc @Name n
       arg <- meta
       A.assign addr arg
       ty <- lift (eval (instantiate1 (pure n) b))
       k (Alg (arg :-> ty))
     Intro.Record fields -> do
-      eval <- DomainC (asks runEvaluator)
+      eval <- DomainC ask
       fields' <- for fields $ \ (k, t) -> do
         addr <- alloc @Name k
         v <- lift (eval t)

From fdb0f519d9ee6808f93335b7d4e1eeea5e06c20c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 12:51:45 -0500
Subject: [PATCH 179/318] Define an Addr synonym for typechecking.

---
 semantic-analysis/src/Analysis/Typecheck.hs | 32 +++++++++++----------
 1 file changed, 17 insertions(+), 15 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 0292665c7..c424429bf 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -53,6 +53,8 @@ infixr 0 :->
 
 type Type = Term Monotype Meta
 
+type Addr = Name
+
 -- FIXME: Union the effects/annotations on the operands.
 
 -- | We derive the 'Semigroup' instance for types to take the second argument. This is equivalent to stating that the type of an imperative sequence of statements is the type of its final statement.
@@ -93,13 +95,13 @@ generalize ty = fromJust (closed (forAlls (IntSet.toList (mvs ty)) (hoistTerm R
 
 
 typecheckingFlowInsensitive
-  :: (Has Intro.Intro syn term, Ord (term Name))
+  :: (Has Intro.Intro syn term, Ord (term Addr))
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => (term Name -> m Type)
-     -> (term Name -> m Type)
+     => (term Addr -> m Type)
+     -> (term Addr -> m Type)
      )
-  -> [File (term Name)]
+  -> [File (term Addr)]
   -> ( Heap Type
      , [File (Either (Path.AbsRelFile, Span, String) (Term (Polytype :+: Monotype) Void))]
      )
@@ -115,14 +117,14 @@ runFile
      , Has Fresh sig m
      , Has (State (Heap Type)) sig m
      , Has Intro.Intro syn term
-     , Ord (term Name)
+     , Ord (term Addr)
      )
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => (term Name -> m Type)
-     -> (term Name -> m Type)
+     => (term Addr -> m Type)
+     -> (term Addr -> m Type)
      )
-  -> File (term Name)
+  -> File (term Addr)
   -> m (File (Either (Path.AbsRelFile, Span, String) Type))
 runFile eval file = traverse run file
   where run
@@ -143,7 +145,7 @@ runFile eval file = traverse run file
               v <- meta
               bs <- m
               v <$ for_ bs (unify v))
-          . convergeTerm 1  (A.runHeap @Name @Type . fix (\ eval' -> runDomain eval' . fix (cacheTerm . eval)))
+          . convergeTerm 1  (A.runHeap @Addr @Type . fix (\ eval' -> runDomain eval' . fix (cacheTerm . eval)))
 
 -- typecheckingAnalysis
 --   :: ( Alternative m
@@ -221,23 +223,23 @@ substAll :: Monad t => IntMap.IntMap (t Meta) -> t Meta -> t Meta
 substAll s a = a >>= \ i -> fromMaybe (pure i) (IntMap.lookup i s)
 
 
-runDomain :: (term Name -> m Type) -> DomainC term m a -> m a
+runDomain :: (term Addr -> m Type) -> DomainC term m a -> m a
 runDomain eval (DomainC m) = runReader eval m
 
-newtype DomainC term m a = DomainC (ReaderC (term Name -> m Type) m a)
+newtype DomainC term m a = DomainC (ReaderC (term Addr -> m Type) m a)
   deriving (Alternative, Applicative, Functor, Monad, MonadFail)
 
 instance MonadTrans (DomainC term) where
   lift = DomainC . lift
 
 instance ( Alternative m
-         , Has (Env Name) sig m
+         , Has (Env Addr) sig m
          , Has Fresh sig m
-         , Has (A.Heap Name Type) sig m
+         , Has (A.Heap Addr Type) sig m
          , Monad term
          , MonadFail m
          , Has Intro.Intro syn term
-         ) => Algebra (Domain term Name Type :+: sig) (DomainC term m) where
+         ) => Algebra (Domain term Addr Type :+: sig) (DomainC term m) where
   alg (L (Abstract v k)) = case v of
     Intro.Unit     -> k (Alg Unit)
     Intro.Bool   _ -> k (Alg Bool)
@@ -252,7 +254,7 @@ instance ( Alternative m
     Intro.Record fields -> do
       eval <- DomainC ask
       fields' <- for fields $ \ (k, t) -> do
-        addr <- alloc @Name k
+        addr <- alloc @Addr k
         v <- lift (eval t)
         (k, v) <$ A.assign addr v
       -- FIXME: should records reference types by address instead?

From d22039b7685506b91e4eb60fe0290b4b7ba9c346 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 12:52:30 -0500
Subject: [PATCH 180/318] Rename the Precise synonym to Addr.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index b13a437e5..c13e17e46 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -29,8 +29,8 @@ import           Prelude hiding (fail)
 import           Source.Span
 import qualified System.Path as Path
 
-type Precise = Int
-type Env = Map.Map Name Precise
+type Addr = Int
+type Env = Map.Map Name Addr
 
 data Concrete term
   = Closure Path.AbsRelFile Span Name term Env
@@ -85,11 +85,11 @@ runFile eval file = traverse run file
 
 -- concreteAnalysis
 --   :: forall term m sig
---   .  ( Has (A.Env Precise) sig m
---      , Has (A.Heap Precise (Concrete (term Name))) sig m
+--   .  ( Has (A.Env Addr) sig m
+--      , Has (A.Heap Addr (Concrete (term Name))) sig m
 --      , Has (State (Heap (term Name))) sig m
 --      )
---   => Analysis Precise (Concrete (term Name)) m
+--   => Analysis Addr (Concrete (term Name)) m
 -- concreteAnalysis = Analysis{..}
 --   where -- abstract _ name body = do
 --         --   path <- ask
@@ -109,12 +109,12 @@ runFile eval file = traverse run file
 --             pure (name, addr)
 --           pure (Record (Map.fromList fields'))
 --         addr ... n = do
---           val <- A.deref @Precise @(Concrete (term Name)) addr
+--           val <- A.deref @Addr @(Concrete (term Name)) addr
 --           heap <- get
 --           pure (val >>= lookupConcrete heap n)
 
 
--- lookupConcrete :: Heap (term Name) -> Name -> Concrete (term Name) -> Maybe Precise
+-- lookupConcrete :: Heap (term Name) -> Name -> Concrete (term Name) -> Maybe Addr
 -- lookupConcrete heap name = run . evalState IntSet.empty . runNonDetA . inConcrete
 --   where -- look up the name in a concrete value
 --         inConcrete = inFrame <=< maybeA . recordFrame
@@ -136,7 +136,7 @@ runFile eval file = traverse run file
 --   > λ let (heap, res) = concrete [ruby]
 --   > λ writeFile "/Users/rob/Desktop/heap.dot" (export (addressStyle heap) (heapAddressGraph heap))
 --   > λ :!dot -Tsvg < ~/Desktop/heap.dot > ~/Desktop/heap.svg
-heapGraph :: (Precise -> Concrete (term Name) -> a) -> (Either Edge Name -> Precise -> G.Graph a) -> Heap (term Name) -> G.Graph a
+heapGraph :: (Addr -> Concrete (term Name) -> a) -> (Either Edge Name -> Addr -> G.Graph a) -> Heap (term Name) -> G.Graph a
 heapGraph vertex edge h = foldr (uncurry graph) G.empty (IntMap.toList h)
   where graph k v rest = (G.vertex (vertex k v) `G.connect` outgoing v) `G.overlay` rest
         outgoing = \case
@@ -150,10 +150,10 @@ heapValueGraph :: Heap (term Name) -> G.Graph (Concrete (term Name))
 heapValueGraph h = heapGraph (const id) (const fromAddr) h
   where fromAddr addr = maybe G.empty G.vertex (IntMap.lookup addr h)
 
-heapAddressGraph :: Heap (term Name) -> G.Graph (EdgeType (term Name), Precise)
+heapAddressGraph :: Heap (term Name) -> G.Graph (EdgeType (term Name), Addr)
 heapAddressGraph = heapGraph (\ addr v -> (Value v, addr)) (fmap G.vertex . (,) . either Edge Slot)
 
-addressStyle :: Heap (term Name) -> G.Style (EdgeType (term Name), Precise) Text
+addressStyle :: Heap (term Name) -> G.Style (EdgeType (term Name), Addr) Text
 addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
   where vertex (_, addr) = pack (show addr) <> " = " <> maybe "?" fromConcrete (IntMap.lookup addr heap)
         edgeAttributes _ (Slot name,    _) = ["label" G.:= unName name]

From f7c2c74ef832d4ecd5fd6a411863b49e8496824e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 12:53:39 -0500
Subject: [PATCH 181/318] Take addressed terms in Concrete.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index c13e17e46..71703eb48 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -52,11 +52,11 @@ type Heap term = IntMap.IntMap (Concrete term)
 concrete
   :: (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => (term Name -> m (Concrete (term Name)))
-     -> (term Name -> m (Concrete (term Name)))
+     => (term Addr -> m (Concrete (term Addr)))
+     -> (term Addr -> m (Concrete (term Addr)))
      )
-  -> [File (term Name)]
-  -> (Heap (term Name), [File (Either (Path.AbsRelFile, Span, String) (Concrete (term Name)))])
+  -> [File (term Addr)]
+  -> (Heap (term Addr), [File (Either (Path.AbsRelFile, Span, String) (Concrete (term Addr)))])
 concrete eval
   = run
   . evalFresh 0
@@ -70,11 +70,11 @@ runFile
      )
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => (term Name -> m (Concrete (term Name)))
-     -> (term Name -> m (Concrete (term Name)))
+     => (term Addr -> m (Concrete (term Addr)))
+     -> (term Addr -> m (Concrete (term Addr)))
      )
-  -> File (term Name)
-  -> m (File (Either (Path.AbsRelFile, Span, String) (Concrete (term Name))))
+  -> File (term Addr)
+  -> m (File (Either (Path.AbsRelFile, Span, String) (Concrete (term Addr))))
 runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
@@ -86,10 +86,10 @@ runFile eval file = traverse run file
 -- concreteAnalysis
 --   :: forall term m sig
 --   .  ( Has (A.Env Addr) sig m
---      , Has (A.Heap Addr (Concrete (term Name))) sig m
---      , Has (State (Heap (term Name))) sig m
+--      , Has (A.Heap Addr (Concrete (term Addr))) sig m
+--      , Has (State (Heap (term Addr))) sig m
 --      )
---   => Analysis Addr (Concrete (term Name)) m
+--   => Analysis Addr (Concrete (term Addr)) m
 -- concreteAnalysis = Analysis{..}
 --   where -- abstract _ name body = do
 --         --   path <- ask
@@ -109,12 +109,12 @@ runFile eval file = traverse run file
 --             pure (name, addr)
 --           pure (Record (Map.fromList fields'))
 --         addr ... n = do
---           val <- A.deref @Addr @(Concrete (term Name)) addr
+--           val <- A.deref @Addr @(Concrete (term Addr)) addr
 --           heap <- get
 --           pure (val >>= lookupConcrete heap n)
 
 
--- lookupConcrete :: Heap (term Name) -> Name -> Concrete (term Name) -> Maybe Addr
+-- lookupConcrete :: Heap (term Addr) -> Name -> Concrete (term Addr) -> Maybe Addr
 -- lookupConcrete heap name = run . evalState IntSet.empty . runNonDetA . inConcrete
 --   where -- look up the name in a concrete value
 --         inConcrete = inFrame <=< maybeA . recordFrame
@@ -136,7 +136,7 @@ runFile eval file = traverse run file
 --   > λ let (heap, res) = concrete [ruby]
 --   > λ writeFile "/Users/rob/Desktop/heap.dot" (export (addressStyle heap) (heapAddressGraph heap))
 --   > λ :!dot -Tsvg < ~/Desktop/heap.dot > ~/Desktop/heap.svg
-heapGraph :: (Addr -> Concrete (term Name) -> a) -> (Either Edge Name -> Addr -> G.Graph a) -> Heap (term Name) -> G.Graph a
+heapGraph :: (Addr -> Concrete (term Addr) -> a) -> (Either Edge Name -> Addr -> G.Graph a) -> Heap (term Addr) -> G.Graph a
 heapGraph vertex edge h = foldr (uncurry graph) G.empty (IntMap.toList h)
   where graph k v rest = (G.vertex (vertex k v) `G.connect` outgoing v) `G.overlay` rest
         outgoing = \case
@@ -146,14 +146,14 @@ heapGraph vertex edge h = foldr (uncurry graph) G.empty (IntMap.toList h)
           Closure _ _ _ _ env -> foldr (G.overlay . edge (Left Lexical)) G.empty env
           Record frame -> Map.foldrWithKey (\ k -> G.overlay . edge (Right k)) G.empty frame
 
-heapValueGraph :: Heap (term Name) -> G.Graph (Concrete (term Name))
+heapValueGraph :: Heap (term Addr) -> G.Graph (Concrete (term Addr))
 heapValueGraph h = heapGraph (const id) (const fromAddr) h
   where fromAddr addr = maybe G.empty G.vertex (IntMap.lookup addr h)
 
-heapAddressGraph :: Heap (term Name) -> G.Graph (EdgeType (term Name), Addr)
+heapAddressGraph :: Heap (term Addr) -> G.Graph (EdgeType (term Addr), Addr)
 heapAddressGraph = heapGraph (\ addr v -> (Value v, addr)) (fmap G.vertex . (,) . either Edge Slot)
 
-addressStyle :: Heap (term Name) -> G.Style (EdgeType (term Name), Addr) Text
+addressStyle :: Heap (term Addr) -> G.Style (EdgeType (term Addr), Addr) Text
 addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
   where vertex (_, addr) = pack (show addr) <> " = " <> maybe "?" fromConcrete (IntMap.lookup addr heap)
         edgeAttributes _ (Slot name,    _) = ["label" G.:= unName name]

From e78cc7bbfcc2cb572001b9382b216fc49796844f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 12:54:55 -0500
Subject: [PATCH 182/318] Define an Addr synonym for import graphing.

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

diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index d960d8db6..89d1c54e8 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -25,6 +25,8 @@ import qualified System.Path as Path
 
 type ImportGraph = Map.Map Text (Set.Set Text)
 
+type Addr = Name
+
 data Value term = Value
   { valueSemi  :: Semi term
   , valueGraph :: ImportGraph
@@ -82,7 +84,7 @@ runFile eval file = traverse run file
             . runEnv
             . runFail
             . fmap fold
-            . convergeTerm 0 (A.runHeap @Name @(Value (term Name)) . fix (cacheTerm . eval))
+            . convergeTerm 0 (A.runHeap @Addr @(Value (term Addr)) . fix (cacheTerm . eval))
 
 -- FIXME: decompose into a product domain and two atomic domains
 -- importGraphAnalysis
@@ -97,13 +99,13 @@ runFile eval file = traverse run file
 --         --   span <- ask
 --         --   pure (Value (Closure path span name body) mempty)
 --         -- apply eval (Value (Closure path span name body) _) a = local (const path) . local (const -- span) $ do
---         --   addr <- alloc @Name name
+--         --   addr <- alloc @Addr name
 --         --   A.assign addr a
 --         --   bind name addr (eval body)
 --         -- apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
 --         record fields = do
 --           for_ fields $ \ (k, v) -> do
---             addr <- alloc @Name k
+--             addr <- alloc @Addr k
 --             A.assign addr v
 --           pure (Value Abstract (foldMap (valueGraph . snd) fields))
 --         _ ... m = pure (Just m)

From c3b632fd9df9b4a0f63aa2c012e57e29b18ea096 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 12:55:09 -0500
Subject: [PATCH 183/318] Import graphing uses addressed terms.

---
 semantic-analysis/src/Analysis/ImportGraph.hs | 28 +++++++++----------
 1 file changed, 14 insertions(+), 14 deletions(-)

diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 89d1c54e8..fad7c3348 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -48,15 +48,15 @@ data Semi term
 
 
 importGraph
-  :: Ord (term Name)
+  :: Ord (term Addr)
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => (term Name -> m (Value (term Name)))
-     -> (term Name -> m (Value (term Name)))
+     => (term Addr -> m (Value (term Addr)))
+     -> (term Addr -> m (Value (term Addr)))
      )
-  -> [File (term Name)]
-  -> ( Heap (Value (term Name))
-     , [File (Either (Path.AbsRelFile, Span, String) (Value (term Name)))]
+  -> [File (term Addr)]
+  -> ( Heap (Value (term Addr))
+     , [File (Either (Path.AbsRelFile, Span, String) (Value (term Addr)))]
      )
 importGraph eval
   = run
@@ -68,16 +68,16 @@ runFile
   :: forall term m sig
   .  ( Effect sig
      , Has Fresh sig m
-     , Has (State (Heap (Value (term Name)))) sig m
-     , Ord  (term Name)
+     , Has (State (Heap (Value (term Addr)))) sig m
+     , Ord  (term Addr)
      )
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => (term Name -> m (Value (term Name)))
-     -> (term Name -> m (Value (term Name)))
+     => (term Addr -> m (Value (term Addr)))
+     -> (term Addr -> m (Value (term Addr)))
      )
-  -> File (term Name)
-  -> m (File (Either (Path.AbsRelFile, Span, String) (Value (term Name))))
+  -> File (term Addr)
+  -> m (File (Either (Path.AbsRelFile, Span, String) (Value (term Addr))))
 runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
@@ -90,9 +90,9 @@ runFile eval file = traverse run file
 -- importGraphAnalysis
 --   :: ( Alternative m
 --      , Has (Env Name) sig m
---      , Has (A.Heap Name (Value (term Name))) sig m
+--      , Has (A.Heap Name (Value (term Addr))) sig m
 --      )
---   => Analysis Name (Value (term Name)) m
+--   => Analysis Name (Value (term Addr)) m
 -- importGraphAnalysis = Analysis{..}
 --   where -- abstract _ name body = do
 --         --   path <- ask

From da63c0cf6aa753cf45106efd1b76942c2b1f86bc Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 12:57:57 -0500
Subject: [PATCH 184/318] Define an Addr synonym for scope graphing.

---
 semantic-analysis/src/Analysis/ScopeGraph.hs | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index 73d62e5bc..cc6c8bbde 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -37,6 +37,8 @@ data Ref = Ref
   }
   deriving (Eq, Ord, Show)
 
+type Addr = Name
+
 newtype ScopeGraph name = ScopeGraph { unScopeGraph :: Map.Map (Decl name) (Set.Set Ref) }
   deriving (Eq, Ord, Show)
 
@@ -80,7 +82,7 @@ runFile eval file = traverse run file
             . runEnv
             . runFail
             . fmap fold
-            . convergeTerm 0 (A.runHeap @Name @(ScopeGraph Name) . fix (cacheTerm . eval))
+            . convergeTerm 0 (A.runHeap @Addr @(ScopeGraph Name) . fix (cacheTerm . eval))
 
 -- scopeGraphAnalysis
 --   :: ( Alternative m
@@ -92,8 +94,8 @@ runFile eval file = traverse run file
 --   => Analysis Name (ScopeGraph Name) m
 -- scopeGraphAnalysis = Analysis{..}
 --   where -- abstract eval name body = do
---         --   addr <- alloc @Name name
---         --   A.assign @Name @(ScopeGraph Name) name mempty
+--         --   addr <- alloc @Addr name
+--         --   A.assign @Addr @(ScopeGraph Name) name mempty
 --         --   bind name addr (eval body)
 --         -- apply _ f a = pure (f <> a)
 --         record fields = do
@@ -102,6 +104,6 @@ runFile eval file = traverse run file
 --             path <- ask
 --             span <- ask
 --             let v' = ScopeGraph (Map.singleton (Decl k path span) mempty) <> v
---             (k, v') <$ A.assign @Name addr v'
+--             (k, v') <$ A.assign @Addr addr v'
 --           pure (foldMap snd fields')
 --         _ ... m = pure (Just m)

From d93686e01e222fd3e0b11fc7c9135a54b4bfa093 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 12:58:43 -0500
Subject: [PATCH 185/318] Scope graphing takes addressed terms.

---
 semantic-analysis/src/Analysis/ScopeGraph.hs | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index cc6c8bbde..bceed8ac8 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -49,13 +49,13 @@ instance Ord name => Monoid (ScopeGraph name) where
   mempty = ScopeGraph Map.empty
 
 scopeGraph
-  :: Ord (term Name)
+  :: Ord (term Addr)
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => (term Name -> m (ScopeGraph Name))
-     -> (term Name -> m (ScopeGraph Name))
+     => (term Addr -> m (ScopeGraph Name))
+     -> (term Addr -> m (ScopeGraph Name))
      )
-  -> [File (term Name)]
+  -> [File (term Addr)]
   -> (Heap (ScopeGraph Name), [File (Either (Path.AbsRelFile, Span, String) (ScopeGraph Name))])
 scopeGraph eval
   = run
@@ -67,14 +67,14 @@ runFile
   :: ( Effect sig
      , Has Fresh sig m
      , Has (State (Heap (ScopeGraph Name))) sig m
-     , Ord (term Name)
+     , Ord (term Addr)
      )
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => (term Name -> m (ScopeGraph Name))
-     -> (term Name -> m (ScopeGraph Name))
+     => (term Addr -> m (ScopeGraph Name))
+     -> (term Addr -> m (ScopeGraph Name))
      )
-  -> File (term Name)
+  -> File (term Addr)
   -> m (File (Either (Path.AbsRelFile, Span, String) (ScopeGraph Name)))
 runFile eval file = traverse run file
   where run = runReader (filePath file)

From 585b05fa6141921b41c3f42f033017c826c04c75 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 13:00:35 -0500
Subject: [PATCH 186/318] :fire: the name parameters from Decl & ScopeGraph.

---
 semantic-analysis/src/Analysis/ScopeGraph.hs | 32 ++++++++++----------
 1 file changed, 16 insertions(+), 16 deletions(-)

diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index bceed8ac8..d69b9036d 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -24,8 +24,8 @@ import           Prelude hiding (fail)
 import           Source.Span
 import qualified System.Path as Path
 
-data Decl name = Decl
-  { declSymbol :: name
+data Decl = Decl
+  { declSymbol :: Name
   , declPath   :: Path.AbsRelFile
   , declSpan   :: Span
   }
@@ -39,24 +39,24 @@ data Ref = Ref
 
 type Addr = Name
 
-newtype ScopeGraph name = ScopeGraph { unScopeGraph :: Map.Map (Decl name) (Set.Set Ref) }
+newtype ScopeGraph = ScopeGraph { unScopeGraph :: Map.Map Decl (Set.Set Ref) }
   deriving (Eq, Ord, Show)
 
-instance Ord name => Semigroup (ScopeGraph name) where
+instance Semigroup ScopeGraph where
   ScopeGraph a <> ScopeGraph b = ScopeGraph (Map.unionWith (<>) a b)
 
-instance Ord name => Monoid (ScopeGraph name) where
+instance Monoid ScopeGraph where
   mempty = ScopeGraph Map.empty
 
 scopeGraph
   :: Ord (term Addr)
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => (term Addr -> m (ScopeGraph Name))
-     -> (term Addr -> m (ScopeGraph Name))
+     => (term Addr -> m ScopeGraph)
+     -> (term Addr -> m ScopeGraph)
      )
   -> [File (term Addr)]
-  -> (Heap (ScopeGraph Name), [File (Either (Path.AbsRelFile, Span, String) (ScopeGraph Name))])
+  -> (Heap ScopeGraph, [File (Either (Path.AbsRelFile, Span, String) ScopeGraph)])
 scopeGraph eval
   = run
   . evalFresh 0
@@ -66,36 +66,36 @@ scopeGraph eval
 runFile
   :: ( Effect sig
      , Has Fresh sig m
-     , Has (State (Heap (ScopeGraph Name))) sig m
+     , Has (State (Heap ScopeGraph)) sig m
      , Ord (term Addr)
      )
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => (term Addr -> m (ScopeGraph Name))
-     -> (term Addr -> m (ScopeGraph Name))
+     => (term Addr -> m ScopeGraph)
+     -> (term Addr -> m ScopeGraph)
      )
   -> File (term Addr)
-  -> m (File (Either (Path.AbsRelFile, Span, String) (ScopeGraph Name)))
+  -> m (File (Either (Path.AbsRelFile, Span, String) ScopeGraph))
 runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
             . runEnv
             . runFail
             . fmap fold
-            . convergeTerm 0 (A.runHeap @Addr @(ScopeGraph Name) . fix (cacheTerm . eval))
+            . convergeTerm 0 (A.runHeap @Addr @ScopeGraph . fix (cacheTerm . eval))
 
 -- scopeGraphAnalysis
 --   :: ( Alternative m
 --      , Has (Env Name) sig m
---      , Has (A.Heap Name (ScopeGraph Name)) sig m
+--      , Has (A.Heap Name ScopeGraph) sig m
 --      , Has (Reader Path.AbsRelFile) sig m
 --      , Has (Reader Span) sig m
 --      )
---   => Analysis Name (ScopeGraph Name) m
+--   => Analysis Name ScopeGraph m
 -- scopeGraphAnalysis = Analysis{..}
 --   where -- abstract eval name body = do
 --         --   addr <- alloc @Addr name
---         --   A.assign @Addr @(ScopeGraph Name) name mempty
+--         --   A.assign @Addr @ScopeGraph name mempty
 --         --   bind name addr (eval body)
 --         -- apply _ f a = pure (f <> a)
 --         record fields = do

From e518beb8269b1cf2bfe37a13ef6c6fcf21c76b1b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 13:25:41 -0500
Subject: [PATCH 187/318] Derive some instances for DomainC.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 71703eb48..15c20e0de 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,
+{-# LANGUAGE DerivingVia, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses, NamedFieldPuns,
              OverloadedStrings, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeOperators,
              UndecidableInstances #-}
 module Analysis.Concrete
@@ -130,6 +130,9 @@ runFile eval file = traverse run file
 --           inConcrete val
 --         maybeA = maybe empty pure
 
+newtype DomainC term m a = DomainC (ReaderC (term Addr -> m (Concrete (term Addr))) m a)
+  deriving (Applicative, Functor, Monad, MonadFail)
+
 
 -- | 'heapGraph', 'heapValueGraph', and 'heapAddressGraph' allow us to conveniently export SVGs of the heap:
 --

From de096192baa1500fba817fb4da6c8b9a65951303 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 13:25:47 -0500
Subject: [PATCH 188/318] Define a MonadTrans instance for DomainC.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 15c20e0de..3a57d5d01 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -20,6 +20,7 @@ import           Control.Algebra
 import           Control.Carrier.Fail.WithLoc
 import           Control.Carrier.Fresh.Strict
 import           Control.Carrier.Reader hiding (Local)
+import           Control.Monad.Trans.Class (MonadTrans(..))
 import           Data.Function (fix)
 import qualified Data.IntMap as IntMap
 import qualified Data.Map as Map
@@ -133,6 +134,9 @@ runFile eval file = traverse run file
 newtype DomainC term m a = DomainC (ReaderC (term Addr -> m (Concrete (term Addr))) m a)
   deriving (Applicative, Functor, Monad, MonadFail)
 
+instance MonadTrans (DomainC term) where
+  lift = DomainC . lift
+
 
 -- | 'heapGraph', 'heapValueGraph', and 'heapAddressGraph' allow us to conveniently export SVGs of the heap:
 --

From 1f9e0fa18fef167807212de4cb51372356b123c7 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 13:33:11 -0500
Subject: [PATCH 189/318] Reformat a context.

---
 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 c424429bf..ba52c3492 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -239,7 +239,8 @@ instance ( Alternative m
          , Monad term
          , MonadFail m
          , Has Intro.Intro syn term
-         ) => Algebra (Domain term Addr Type :+: sig) (DomainC term m) where
+         )
+      => Algebra (Domain term Addr Type :+: sig) (DomainC term m) where
   alg (L (Abstract v k)) = case v of
     Intro.Unit     -> k (Alg Unit)
     Intro.Bool   _ -> k (Alg Bool)

From 387824aa7b50c511f264eca8618587fcb8345949 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 13:44:01 -0500
Subject: [PATCH 190/318] Closure holds a Scope.

---
 semantic-analysis/src/Analysis/Concrete.hs | 54 ++++++++++++----------
 1 file changed, 30 insertions(+), 24 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 3a57d5d01..9e34a38ca 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE DerivingVia, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses, NamedFieldPuns,
-             OverloadedStrings, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeOperators,
+             OverloadedStrings, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators,
              UndecidableInstances #-}
 module Analysis.Concrete
 ( Concrete(..)
@@ -28,36 +28,42 @@ import           Data.Semigroup (Last (..))
 import           Data.Text (Text, pack)
 import           Prelude hiding (fail)
 import           Source.Span
+import           Syntax.Scope
 import qualified System.Path as Path
 
 type Addr = Int
 type Env = Map.Map Name Addr
 
 data Concrete term
-  = Closure Path.AbsRelFile Span Name term Env
+  = Closure Path.AbsRelFile Span Name (Scope () term Addr)
   | Unit
   | Bool Bool
   | String Text
   | Record Env
-  deriving (Eq, Ord, Show)
   -- NB: We derive the 'Semigroup' instance for 'Concrete' to take the second argument. This is equivalent to stating that the return value of an imperative sequence of statements is the value of its final statement.
   deriving Semigroup via Last (Concrete term)
 
+deriving instance ( forall a . Eq   a => Eq   (f a), Monad f) => Eq   (Concrete f)
+deriving instance ( forall a . Eq   a => Eq   (f a)
+                  , forall a . Ord  a => Ord  (f a), Monad f) => Ord  (Concrete f)
+deriving instance ( forall a . Show a => Show (f a))          => Show (Concrete f)
+
+
 -- recordFrame :: Concrete term -> Maybe Env
 -- recordFrame (Record frame) = Just frame
 -- recordFrame _              = Nothing
 
-type Heap term = IntMap.IntMap (Concrete term)
+type Heap = IntMap.IntMap
 
 
 concrete
   :: (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => (term Addr -> m (Concrete (term Addr)))
-     -> (term Addr -> m (Concrete (term Addr)))
+     => (term Addr -> m (Concrete term))
+     -> (term Addr -> m (Concrete term))
      )
   -> [File (term Addr)]
-  -> (Heap (term Addr), [File (Either (Path.AbsRelFile, Span, String) (Concrete (term Addr)))])
+  -> (Heap (Concrete term), [File (Either (Path.AbsRelFile, Span, String) (Concrete term))])
 concrete eval
   = run
   . evalFresh 0
@@ -71,11 +77,11 @@ runFile
      )
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => (term Addr -> m (Concrete (term Addr)))
-     -> (term Addr -> m (Concrete (term Addr)))
+     => (term Addr -> m (Concrete term))
+     -> (term Addr -> m (Concrete term))
      )
   -> File (term Addr)
-  -> m (File (Either (Path.AbsRelFile, Span, String) (Concrete (term Addr))))
+  -> m (File (Either (Path.AbsRelFile, Span, String) (Concrete term)))
 runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
@@ -87,10 +93,10 @@ runFile eval file = traverse run file
 -- concreteAnalysis
 --   :: forall term m sig
 --   .  ( Has (A.Env Addr) sig m
---      , Has (A.Heap Addr (Concrete (term Addr))) sig m
---      , Has (State (Heap (term Addr))) sig m
+--      , Has (A.Heap Addr (Concrete term)) sig m
+--      , Has (State (Heap (Concrete term))) sig m
 --      )
---   => Analysis Addr (Concrete (term Addr)) m
+--   => Analysis Addr (Concrete term) m
 -- concreteAnalysis = Analysis{..}
 --   where -- abstract _ name body = do
 --         --   path <- ask
@@ -110,12 +116,12 @@ runFile eval file = traverse run file
 --             pure (name, addr)
 --           pure (Record (Map.fromList fields'))
 --         addr ... n = do
---           val <- A.deref @Addr @(Concrete (term Addr)) addr
+--           val <- A.deref @Addr @(Concrete term) addr
 --           heap <- get
 --           pure (val >>= lookupConcrete heap n)
 
 
--- lookupConcrete :: Heap (term Addr) -> Name -> Concrete (term Addr) -> Maybe Addr
+-- lookupConcrete :: Heap (Concrete term) -> Name -> Concrete (term Addr) -> Maybe Addr
 -- lookupConcrete heap name = run . evalState IntSet.empty . runNonDetA . inConcrete
 --   where -- look up the name in a concrete value
 --         inConcrete = inFrame <=< maybeA . recordFrame
@@ -131,7 +137,7 @@ runFile eval file = traverse run file
 --           inConcrete val
 --         maybeA = maybe empty pure
 
-newtype DomainC term m a = DomainC (ReaderC (term Addr -> m (Concrete (term Addr))) m a)
+newtype DomainC term m a = DomainC (ReaderC (term Addr -> m (Concrete term)) m a)
   deriving (Applicative, Functor, Monad, MonadFail)
 
 instance MonadTrans (DomainC term) where
@@ -143,24 +149,24 @@ instance MonadTrans (DomainC term) where
 --   > λ let (heap, res) = concrete [ruby]
 --   > λ writeFile "/Users/rob/Desktop/heap.dot" (export (addressStyle heap) (heapAddressGraph heap))
 --   > λ :!dot -Tsvg < ~/Desktop/heap.dot > ~/Desktop/heap.svg
-heapGraph :: (Addr -> Concrete (term Addr) -> a) -> (Either Edge Name -> Addr -> G.Graph a) -> Heap (term Addr) -> G.Graph a
+heapGraph :: (Addr -> Concrete term -> a) -> (Either Edge Name -> Addr -> G.Graph a) -> Heap (Concrete term) -> G.Graph a
 heapGraph vertex edge h = foldr (uncurry graph) G.empty (IntMap.toList h)
   where graph k v rest = (G.vertex (vertex k v) `G.connect` outgoing v) `G.overlay` rest
         outgoing = \case
           Unit -> G.empty
           Bool _ -> G.empty
           String _ -> G.empty
-          Closure _ _ _ _ env -> foldr (G.overlay . edge (Left Lexical)) G.empty env
+          -- Closure _ _ _ _ env -> foldr (G.overlay . edge (Left Lexical)) G.empty env
           Record frame -> Map.foldrWithKey (\ k -> G.overlay . edge (Right k)) G.empty frame
 
-heapValueGraph :: Heap (term Addr) -> G.Graph (Concrete (term Addr))
+heapValueGraph :: Heap (Concrete term) -> G.Graph (Concrete term)
 heapValueGraph h = heapGraph (const id) (const fromAddr) h
   where fromAddr addr = maybe G.empty G.vertex (IntMap.lookup addr h)
 
-heapAddressGraph :: Heap (term Addr) -> G.Graph (EdgeType (term Addr), Addr)
+heapAddressGraph :: Heap (Concrete term) -> G.Graph (EdgeType (Concrete term), Addr)
 heapAddressGraph = heapGraph (\ addr v -> (Value v, addr)) (fmap G.vertex . (,) . either Edge Slot)
 
-addressStyle :: Heap (term Addr) -> G.Style (EdgeType (term Addr), Addr) Text
+addressStyle :: Heap (Concrete term) -> G.Style (EdgeType (Concrete term), Addr) Text
 addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
   where vertex (_, addr) = pack (show addr) <> " = " <> maybe "?" fromConcrete (IntMap.lookup addr heap)
         edgeAttributes _ (Slot name,    _) = ["label" G.:= unName name]
@@ -171,14 +177,14 @@ addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
           Unit ->  "()"
           Bool b -> pack $ show b
           String s -> pack $ show s
-          Closure p (Span s e) n _ _ -> "\\\\ " <> unName n <> " [" <> pack (Path.toString p) <> ":" <> showPos s <> "-" <> showPos e <> "]"
+          Closure p (Span s e) n _ -> "\\\\ " <> unName n <> " [" <> pack (Path.toString p) <> ":" <> showPos s <> "-" <> showPos e <> "]"
           Record _ -> "{}"
         showPos (Pos l c) = pack (show l) <> ":" <> pack (show c)
 
-data EdgeType term
+data EdgeType value
   = Edge Edge
   | Slot Name
-  | Value (Concrete term)
+  | Value value
   deriving (Eq, Ord, Show)
 
 data Edge = Lexical | Import

From a64c337b1ec48676fbee253cae80f72fbf902713 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 13:46:16 -0500
Subject: [PATCH 191/318] Graph the heap using the addresses in closure bodies.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 9e34a38ca..f1c5c6a75 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -149,21 +149,21 @@ instance MonadTrans (DomainC term) where
 --   > λ let (heap, res) = concrete [ruby]
 --   > λ writeFile "/Users/rob/Desktop/heap.dot" (export (addressStyle heap) (heapAddressGraph heap))
 --   > λ :!dot -Tsvg < ~/Desktop/heap.dot > ~/Desktop/heap.svg
-heapGraph :: (Addr -> Concrete term -> a) -> (Either Edge Name -> Addr -> G.Graph a) -> Heap (Concrete term) -> G.Graph a
+heapGraph :: Foldable term => (Addr -> Concrete term -> a) -> (Either Edge Name -> Addr -> G.Graph a) -> Heap (Concrete term) -> G.Graph a
 heapGraph vertex edge h = foldr (uncurry graph) G.empty (IntMap.toList h)
   where graph k v rest = (G.vertex (vertex k v) `G.connect` outgoing v) `G.overlay` rest
         outgoing = \case
           Unit -> G.empty
           Bool _ -> G.empty
           String _ -> G.empty
-          -- Closure _ _ _ _ env -> foldr (G.overlay . edge (Left Lexical)) G.empty env
+          Closure _ _ _ b -> foldr (G.overlay . edge (Left Lexical)) G.empty b
           Record frame -> Map.foldrWithKey (\ k -> G.overlay . edge (Right k)) G.empty frame
 
-heapValueGraph :: Heap (Concrete term) -> G.Graph (Concrete term)
+heapValueGraph :: Foldable term => Heap (Concrete term) -> G.Graph (Concrete term)
 heapValueGraph h = heapGraph (const id) (const fromAddr) h
   where fromAddr addr = maybe G.empty G.vertex (IntMap.lookup addr h)
 
-heapAddressGraph :: Heap (Concrete term) -> G.Graph (EdgeType (Concrete term), Addr)
+heapAddressGraph :: Foldable term => Heap (Concrete term) -> G.Graph (EdgeType (Concrete term), Addr)
 heapAddressGraph = heapGraph (\ addr v -> (Value v, addr)) (fmap G.vertex . (,) . either Edge Slot)
 
 addressStyle :: Heap (Concrete term) -> G.Style (EdgeType (Concrete term), Addr) Text

From b013780cc2e1f8d1cfa4867034d6098c4ab0bbf3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 13:56:54 -0500
Subject: [PATCH 192/318] Define an Algebra instance for DomainC.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index f1c5c6a75..2ab006e82 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -14,7 +14,9 @@ import qualified Algebra.Graph as G
 import qualified Algebra.Graph.Export.Dot as G
 import qualified Analysis.Carrier.Env.Precise as A
 import qualified Analysis.Carrier.Heap.Precise as A
+import           Analysis.Effect.Domain
 import           Analysis.File
+import qualified Analysis.Intro as I
 import           Analysis.Name
 import           Control.Algebra
 import           Control.Carrier.Fail.WithLoc
@@ -26,6 +28,7 @@ import qualified Data.IntMap as IntMap
 import qualified Data.Map as Map
 import           Data.Semigroup (Last (..))
 import           Data.Text (Text, pack)
+import           Data.Traversable (for)
 import           Prelude hiding (fail)
 import           Source.Span
 import           Syntax.Scope
@@ -143,6 +146,38 @@ newtype DomainC term m a = DomainC (ReaderC (term Addr -> m (Concrete term)) m a
 instance MonadTrans (DomainC term) where
   lift = DomainC . lift
 
+instance ( Applicative term
+         , Has (A.Env Addr) sig m
+         , Has (A.Heap Addr (Concrete term)) sig m
+         , Has (Reader Path.AbsRelFile) sig m
+         , Has (Reader Span) sig m
+         )
+      => Algebra (Domain term Addr (Concrete term) :+: sig) (DomainC term m) where
+  alg = \case
+    L (Abstract i k) -> case i of
+      I.Unit            -> k Unit
+      I.Bool b          -> k (Bool b)
+      I.String s        -> k (String s)
+      I.Lam (Named n b) -> do
+        path <- ask
+        span <- ask
+        k (Closure path span n b)
+      I.Record fields   -> do
+        eval <- DomainC ask
+        fields' <- for fields $ \ (name, t) -> do
+          addr <- A.alloc name
+          v <- lift (eval t)
+          A.assign @Addr @(Concrete term) addr v
+          pure (name, addr)
+        k (Record (Map.fromList fields'))
+    L (Concretize c k) -> case c of
+      Unit            -> k I.Unit
+      Bool b          -> k (I.Bool b)
+      String s        -> k (I.String s)
+      Closure _ _ n b -> k (I.Lam (Named n b))
+      Record fields   -> k (I.Record (map (fmap pure) (Map.toList fields)))
+    R other -> DomainC (send (handleCoercible other))
+
 
 -- | 'heapGraph', 'heapValueGraph', and 'heapAddressGraph' allow us to conveniently export SVGs of the heap:
 --

From 87433746b7de19cc9d3f87223bb838f7d562c083 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 13:59:47 -0500
Subject: [PATCH 193/318] Run the Domain effect for concrete analysis.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 2ab006e82..e5b4e3a94 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -60,7 +60,8 @@ type Heap = IntMap.IntMap
 
 
 concrete
-  :: (forall sig m
+  :: Applicative term
+  => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
      => (term Addr -> m (Concrete term))
      -> (term Addr -> m (Concrete term))
@@ -75,8 +76,10 @@ concrete eval
 
 runFile
   :: forall term m sig
-  .  ( Effect sig
+  .  ( Applicative term
+     , Effect sig
      , Has Fresh sig m
+     , Has (A.Heap Addr (Concrete term)) sig m
      )
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
@@ -91,7 +94,7 @@ runFile eval file = traverse run file
             . runFail
             . runReader @Env mempty
             . A.runEnv
-            . fix eval
+            . fix (\ eval' -> runDomain eval' . fix eval)
 
 -- concreteAnalysis
 --   :: forall term m sig
@@ -140,6 +143,9 @@ runFile eval file = traverse run file
 --           inConcrete val
 --         maybeA = maybe empty pure
 
+runDomain :: (term Addr -> m (Concrete term)) -> DomainC term m a -> m a
+runDomain eval (DomainC m) = runReader eval m
+
 newtype DomainC term m a = DomainC (ReaderC (term Addr -> m (Concrete term)) m a)
   deriving (Applicative, Functor, Monad, MonadFail)
 

From 875a4087d6f407517c725cc941a992031b688637 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:00:24 -0500
Subject: [PATCH 194/318] Allow the evaluator to use the Domain effect.

---
 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 e5b4e3a94..d27f35909 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -62,7 +62,7 @@ type Heap = IntMap.IntMap
 concrete
   :: Applicative term
   => (forall sig m
-     .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
+     .  (Has (Domain term Addr (Concrete term)) sig m, Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
      => (term Addr -> m (Concrete term))
      -> (term Addr -> m (Concrete term))
      )
@@ -82,7 +82,7 @@ runFile
      , Has (A.Heap Addr (Concrete term)) sig m
      )
   => (forall sig m
-     .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
+     .  (Has (Domain term Addr (Concrete term)) sig m, Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
      => (term Addr -> m (Concrete term))
      -> (term Addr -> m (Concrete term))
      )

From 964d8e20d22f400e98fa63be65d4bd1f3d045a8d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:03:01 -0500
Subject: [PATCH 195/318] Allow the evaluator to use the heap & env effects.

---
 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 d27f35909..5f83d0f60 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -62,7 +62,7 @@ type Heap = IntMap.IntMap
 concrete
   :: Applicative term
   => (forall sig m
-     .  (Has (Domain term Addr (Concrete term)) sig m, Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
+     .  (Has (Domain term Addr (Concrete term)) sig m, Has (A.Env Addr) sig m, Has (A.Heap Addr (Concrete term)) sig m, Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
      => (term Addr -> m (Concrete term))
      -> (term Addr -> m (Concrete term))
      )
@@ -82,7 +82,7 @@ runFile
      , Has (A.Heap Addr (Concrete term)) sig m
      )
   => (forall sig m
-     .  (Has (Domain term Addr (Concrete term)) sig m, Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
+     .  (Has (Domain term Addr (Concrete term)) sig m, Has (A.Env Addr) sig m, Has (A.Heap Addr (Concrete term)) sig m, Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
      => (term Addr -> m (Concrete term))
      -> (term Addr -> m (Concrete term))
      )

From ac274cb336d99a900abcdb22c06990f7eb17728b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:06:35 -0500
Subject: [PATCH 196/318] Combine the Has constraints.

---
 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 5f83d0f60..45fb2cfcf 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -62,7 +62,7 @@ type Heap = IntMap.IntMap
 concrete
   :: Applicative term
   => (forall sig m
-     .  (Has (Domain term Addr (Concrete term)) sig m, Has (A.Env Addr) sig m, Has (A.Heap Addr (Concrete term)) sig m, Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
+     .  (Has (Domain term Addr (Concrete term) :+: A.Env Addr :+: A.Heap Addr (Concrete term) :+: Reader Path.AbsRelFile :+: Reader Span) sig m, MonadFail m)
      => (term Addr -> m (Concrete term))
      -> (term Addr -> m (Concrete term))
      )
@@ -82,7 +82,7 @@ runFile
      , Has (A.Heap Addr (Concrete term)) sig m
      )
   => (forall sig m
-     .  (Has (Domain term Addr (Concrete term)) sig m, Has (A.Env Addr) sig m, Has (A.Heap Addr (Concrete term)) sig m, Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
+     .  (Has (Domain term Addr (Concrete term) :+: A.Env Addr :+: A.Heap Addr (Concrete term) :+: Reader Path.AbsRelFile :+: Reader Span) sig m, MonadFail m)
      => (term Addr -> m (Concrete term))
      -> (term Addr -> m (Concrete term))
      )

From c707fe59df60d8f89aebafaa20e80a43e9914f63 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:07:33 -0500
Subject: [PATCH 197/318] Strengthen the constraints available to typechecked
 evaluators.

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

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index ba52c3492..32e6e83bd 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -97,7 +97,7 @@ generalize ty = fromJust (closed (forAlls (IntSet.toList (mvs ty)) (hoistTerm R
 typecheckingFlowInsensitive
   :: (Has Intro.Intro syn term, Ord (term Addr))
   => (forall sig m
-     .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
+     .  (Has (Domain term Addr Type :+: Env Addr :+: A.Heap Addr Type :+: Reader Path.AbsRelFile :+: Reader Span) sig m, MonadFail m)
      => (term Addr -> m Type)
      -> (term Addr -> m Type)
      )
@@ -120,7 +120,7 @@ runFile
      , Ord (term Addr)
      )
   => (forall sig m
-     .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
+     .  (Has (Domain term Addr Type :+: Env Addr :+: A.Heap Addr Type :+: Reader Path.AbsRelFile :+: Reader Span) sig m, MonadFail m)
      => (term Addr -> m Type)
      -> (term Addr -> m Type)
      )

From abd647ebc4342bf37d9dc24d49d8977571b2c197 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:11:36 -0500
Subject: [PATCH 198/318] Wrap closure bodies in Named.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 45fb2cfcf..9dfe76aaa 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -38,7 +38,7 @@ type Addr = Int
 type Env = Map.Map Name Addr
 
 data Concrete term
-  = Closure Path.AbsRelFile Span Name (Scope () term Addr)
+  = Closure Path.AbsRelFile Span (Named (Scope () term Addr))
   | Unit
   | Bool Bool
   | String Text
@@ -161,14 +161,14 @@ instance ( Applicative term
       => Algebra (Domain term Addr (Concrete term) :+: sig) (DomainC term m) where
   alg = \case
     L (Abstract i k) -> case i of
-      I.Unit            -> k Unit
-      I.Bool b          -> k (Bool b)
-      I.String s        -> k (String s)
-      I.Lam (Named n b) -> do
+      I.Unit          -> k Unit
+      I.Bool b        -> k (Bool b)
+      I.String s      -> k (String s)
+      I.Lam b         -> do
         path <- ask
         span <- ask
-        k (Closure path span n b)
-      I.Record fields   -> do
+        k (Closure path span b)
+      I.Record fields -> do
         eval <- DomainC ask
         fields' <- for fields $ \ (name, t) -> do
           addr <- A.alloc name
@@ -177,11 +177,11 @@ instance ( Applicative term
           pure (name, addr)
         k (Record (Map.fromList fields'))
     L (Concretize c k) -> case c of
-      Unit            -> k I.Unit
-      Bool b          -> k (I.Bool b)
-      String s        -> k (I.String s)
-      Closure _ _ n b -> k (I.Lam (Named n b))
-      Record fields   -> k (I.Record (map (fmap pure) (Map.toList fields)))
+      Unit          -> k I.Unit
+      Bool b        -> k (I.Bool b)
+      String s      -> k (I.String s)
+      Closure _ _ b -> k (I.Lam b)
+      Record fields -> k (I.Record (map (fmap pure) (Map.toList fields)))
     R other -> DomainC (send (handleCoercible other))
 
 
@@ -197,7 +197,7 @@ heapGraph vertex edge h = foldr (uncurry graph) G.empty (IntMap.toList h)
           Unit -> G.empty
           Bool _ -> G.empty
           String _ -> G.empty
-          Closure _ _ _ b -> foldr (G.overlay . edge (Left Lexical)) G.empty b
+          Closure _ _ (Named _ b) -> foldr (G.overlay . edge (Left Lexical)) G.empty b
           Record frame -> Map.foldrWithKey (\ k -> G.overlay . edge (Right k)) G.empty frame
 
 heapValueGraph :: Foldable term => Heap (Concrete term) -> G.Graph (Concrete term)
@@ -218,7 +218,7 @@ addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
           Unit ->  "()"
           Bool b -> pack $ show b
           String s -> pack $ show s
-          Closure p (Span s e) n _ -> "\\\\ " <> unName n <> " [" <> pack (Path.toString p) <> ":" <> showPos s <> "-" <> showPos e <> "]"
+          Closure p (Span s e) (Named n _) -> "\\\\ " <> unName n <> " [" <> pack (Path.toString p) <> ":" <> showPos s <> "-" <> showPos e <> "]"
           Record _ -> "{}"
         showPos (Pos l c) = pack (show l) <> ":" <> pack (show c)
 

From 6e5cb7fa661d962855d929a7aa633e5450aba890 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:16:39 -0500
Subject: [PATCH 199/318] Semi closures wrap a scope.

---
 semantic-analysis/src/Analysis/ImportGraph.hs | 50 +++++++++++--------
 1 file changed, 30 insertions(+), 20 deletions(-)

diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index fad7c3348..8adfb04a3 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 FlexibleContexts, FlexibleInstances, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, UndecidableInstances #-}
 module Analysis.ImportGraph
 ( ImportGraph
 , importGraph
@@ -21,42 +21,50 @@ import qualified Data.Set as Set
 import           Data.Text (Text)
 import           Prelude hiding (fail)
 import           Source.Span
+import           Syntax.Scope (Scope)
 import qualified System.Path as Path
 
 type ImportGraph = Map.Map Text (Set.Set Text)
 
 type Addr = Name
 
-data Value term = Value
-  { valueSemi  :: Semi term
+data Value semi = Value
+  { valueSemi  :: semi
   , valueGraph :: ImportGraph
   }
   deriving (Eq, Ord, Show)
 
-instance Semigroup (Value term) where
+instance Semigroup (Value (Semi term)) where
   Value _ g1 <> Value _ g2 = Value Abstract (Map.unionWith (<>) g1 g2)
 
-instance Monoid (Value term) where
+instance Monoid (Value (Semi term)) where
   mempty = Value Abstract mempty
 
 data Semi term
-  = Closure Path.AbsRelFile Span Name term
+  = Closure Path.AbsRelFile Span (Named (Scope () term Addr))
   -- FIXME: Bound String values.
   | String Text
   | Abstract
-  deriving (Eq, Ord, Show)
+
+deriving instance ( forall a . Eq   a => Eq   (f a), Monad f) => Eq   (Semi f)
+deriving instance ( forall a . Eq   a => Eq   (f a)
+                  , forall a . Ord  a => Ord  (f a), Monad f) => Ord  (Semi f)
+deriving instance ( forall a . Show a => Show (f a))          => Show (Semi f)
 
 
 importGraph
-  :: Ord (term Addr)
+  :: ( Monad term
+     , forall a . Eq  a => Eq  (term a)
+     , forall a . Ord a => Ord (term a)
+     )
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => (term Addr -> m (Value (term Addr)))
-     -> (term Addr -> m (Value (term Addr)))
+     => (term Addr -> m (Value (Semi term)))
+     -> (term Addr -> m (Value (Semi term)))
      )
   -> [File (term Addr)]
-  -> ( Heap (Value (term Addr))
-     , [File (Either (Path.AbsRelFile, Span, String) (Value (term Addr)))]
+  -> ( Heap (Value (Semi term))
+     , [File (Either (Path.AbsRelFile, Span, String) (Value (Semi term)))]
      )
 importGraph eval
   = run
@@ -68,31 +76,33 @@ runFile
   :: forall term m sig
   .  ( Effect sig
      , Has Fresh sig m
-     , Has (State (Heap (Value (term Addr)))) sig m
-     , Ord  (term Addr)
+     , Has (State (Heap (Value (Semi term)))) sig m
+     , Monad term
+     , forall a . Eq  a => Eq  (term a)
+     , forall a . Ord a => Ord (term a)
      )
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
-     => (term Addr -> m (Value (term Addr)))
-     -> (term Addr -> m (Value (term Addr)))
+     => (term Addr -> m (Value (Semi term)))
+     -> (term Addr -> m (Value (Semi term)))
      )
   -> File (term Addr)
-  -> m (File (Either (Path.AbsRelFile, Span, String) (Value (term Addr))))
+  -> m (File (Either (Path.AbsRelFile, Span, String) (Value (Semi term))))
 runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
             . runEnv
             . runFail
             . fmap fold
-            . convergeTerm 0 (A.runHeap @Addr @(Value (term Addr)) . fix (cacheTerm . eval))
+            . convergeTerm 0 (A.runHeap @Addr @(Value (Semi term)) . fix (cacheTerm . eval))
 
 -- FIXME: decompose into a product domain and two atomic domains
 -- importGraphAnalysis
 --   :: ( Alternative m
 --      , Has (Env Name) sig m
---      , Has (A.Heap Name (Value (term Addr))) sig m
+--      , Has (A.Heap Name (Value (Semi term))) sig m
 --      )
---   => Analysis Name (Value (term Addr)) m
+--   => Analysis Name (Value (Semi term)) m
 -- importGraphAnalysis = Analysis{..}
 --   where -- abstract _ name body = do
 --         --   path <- ask

From b007c9df46d9a6583e5ee4d9af334a816f954246 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:18:51 -0500
Subject: [PATCH 200/318] Define a Domain carrier.

---
 semantic-analysis/src/Analysis/ImportGraph.hs | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 8adfb04a3..19cbc40a7 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, UndecidableInstances #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, UndecidableInstances #-}
 module Analysis.ImportGraph
 ( ImportGraph
 , importGraph
@@ -10,6 +10,7 @@ import           Analysis.File
 import           Analysis.FlowInsensitive
 import           Analysis.Name
 import           Control.Algebra
+import           Control.Applicative (Alternative(..))
 import           Control.Carrier.Fail.WithLoc
 import           Control.Carrier.Fresh.Strict
 import           Control.Carrier.Reader
@@ -96,6 +97,11 @@ runFile eval file = traverse run file
             . fmap fold
             . convergeTerm 0 (A.runHeap @Addr @(Value (Semi term)) . fix (cacheTerm . eval))
 
+
+newtype DomainC term m a = DomainC (ReaderC (term Addr -> m (Value (Semi term))) m a)
+  deriving (Alternative, Applicative, Functor, Monad, MonadFail)
+
+
 -- FIXME: decompose into a product domain and two atomic domains
 -- importGraphAnalysis
 --   :: ( Alternative m

From db5ef7be3c37c0ef22a8d24764fc14849e6bbd04 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:19:00 -0500
Subject: [PATCH 201/318] Define a MonadTrans instance for DomainC.

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

diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 19cbc40a7..034602c18 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -15,6 +15,7 @@ import           Control.Carrier.Fail.WithLoc
 import           Control.Carrier.Fresh.Strict
 import           Control.Carrier.Reader
 import           Control.Carrier.State.Strict
+import           Control.Monad.Trans.Class
 import           Data.Foldable (fold)
 import           Data.Function (fix)
 import qualified Data.Map as Map
@@ -101,6 +102,9 @@ runFile eval file = traverse run file
 newtype DomainC term m a = DomainC (ReaderC (term Addr -> m (Value (Semi term))) m a)
   deriving (Alternative, Applicative, Functor, Monad, MonadFail)
 
+instance MonadTrans (DomainC term) where
+  lift = DomainC . lift
+
 
 -- FIXME: decompose into a product domain and two atomic domains
 -- importGraphAnalysis

From 3be69996fb4ce2d456e96232d35250fe0e1ec577 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:29:44 -0500
Subject: [PATCH 202/318] Define an Algebra instance for DomainC.

---
 semantic-analysis/src/Analysis/ImportGraph.hs | 28 ++++++++++++++++++-
 1 file changed, 27 insertions(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 034602c18..64d760b97 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, UndecidableInstances #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, LambdaCase, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-}
 module Analysis.ImportGraph
 ( ImportGraph
 , importGraph
@@ -6,7 +6,9 @@ module Analysis.ImportGraph
 
 import           Analysis.Carrier.Env.Monovariant
 import qualified Analysis.Carrier.Heap.Monovariant as A
+import qualified Analysis.Effect.Domain as A
 import           Analysis.File
+import qualified Analysis.Intro as I
 import           Analysis.FlowInsensitive
 import           Analysis.Name
 import           Control.Algebra
@@ -21,6 +23,7 @@ import           Data.Function (fix)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import           Data.Text (Text)
+import           Data.Traversable (for)
 import           Prelude hiding (fail)
 import           Source.Span
 import           Syntax.Scope (Scope)
@@ -105,6 +108,29 @@ newtype DomainC term m a = DomainC (ReaderC (term Addr -> m (Value (Semi term)))
 instance MonadTrans (DomainC term) where
   lift = DomainC . lift
 
+instance Has (Env Addr :+: A.Heap Addr (Value (Semi term)) :+: Reader Path.AbsRelFile :+: Reader Span) sig m => Algebra (A.Domain term Addr (Value (Semi term)) :+: sig) (DomainC term m) where
+  alg = \case
+    L (A.Abstract i k) -> case i of
+      I.Unit     -> k mempty
+      I.Bool _   -> k mempty
+      I.String s -> k (Value (String s) mempty)
+      I.Lam b    -> do
+        path <- ask
+        span <- ask
+        k (Value (Closure path span b) mempty)
+      I.Record f -> do
+        eval <- DomainC ask
+        fields <- for f $ \ (k, t) -> do
+          addr <- alloc @Addr k
+          v <- lift (eval t)
+          v <$ A.assign @Addr @(Value (Semi term)) addr v
+        k (fold fields)
+    L (A.Concretize (Value s _) k) -> case s of
+      Abstract      -> k I.Unit -- FIXME: this should be broken down for case analysis
+      String s      -> k (I.String s)
+      Closure _ _ b -> k (I.Lam b)
+    R other -> DomainC (send (handleCoercible other))
+
 
 -- FIXME: decompose into a product domain and two atomic domains
 -- importGraphAnalysis

From 0f7188a864769fce964a2e27185a7f10da0331a1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:30:24 -0500
Subject: [PATCH 203/318] Run the Domain effect.

---
 semantic-analysis/src/Analysis/ImportGraph.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 64d760b97..68b0b4eb2 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -99,9 +99,12 @@ runFile eval file = traverse run file
             . runEnv
             . runFail
             . fmap fold
-            . convergeTerm 0 (A.runHeap @Addr @(Value (Semi term)) . fix (cacheTerm . eval))
+            . convergeTerm 0 (A.runHeap @Addr @(Value (Semi term)) . fix (\ eval' -> runDomain eval' . fix (cacheTerm . eval)))
 
 
+runDomain :: (term Addr -> m (Value (Semi term))) -> DomainC term m a -> m a
+runDomain eval (DomainC m) = runReader eval m
+
 newtype DomainC term m a = DomainC (ReaderC (term Addr -> m (Value (Semi term))) m a)
   deriving (Alternative, Applicative, Functor, Monad, MonadFail)
 

From fec21c77f51a01461eaafe9bc40e5add2095e182 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:31:22 -0500
Subject: [PATCH 204/318] Strengthen the constraints available to eval.

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

diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 68b0b4eb2..f8a3e1c52 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -63,7 +63,7 @@ importGraph
      , forall a . Ord a => Ord (term a)
      )
   => (forall sig m
-     .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
+     .  (Has (A.Domain term Addr (Value (Semi term)) :+: Env Addr :+: A.Heap Addr (Value (Semi term)) :+: Reader Path.AbsRelFile :+: Reader Span) sig m, MonadFail m)
      => (term Addr -> m (Value (Semi term)))
      -> (term Addr -> m (Value (Semi term)))
      )
@@ -87,7 +87,7 @@ runFile
      , forall a . Ord a => Ord (term a)
      )
   => (forall sig m
-     .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
+     .  (Has (A.Domain term Addr (Value (Semi term)) :+: Env Addr :+: A.Heap Addr (Value (Semi term)) :+: Reader Path.AbsRelFile :+: Reader Span) sig m, MonadFail m)
      => (term Addr -> m (Value (Semi term)))
      -> (term Addr -> m (Value (Semi term)))
      )

From 17a6f02894b72700cfd73c5a5408f6129f44f444 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:31:40 -0500
Subject: [PATCH 205/318] Note a FIXME.

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

diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index f8a3e1c52..9c3d6d7e9 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -111,6 +111,7 @@ newtype DomainC term m a = DomainC (ReaderC (term Addr -> m (Value (Semi term)))
 instance MonadTrans (DomainC term) where
   lift = DomainC . lift
 
+-- FIXME: decompose into a product domain and two atomic domains
 instance Has (Env Addr :+: A.Heap Addr (Value (Semi term)) :+: Reader Path.AbsRelFile :+: Reader Span) sig m => Algebra (A.Domain term Addr (Value (Semi term)) :+: sig) (DomainC term m) where
   alg = \case
     L (A.Abstract i k) -> case i of

From 3ff821bdde9b1e230d58df7bfee4315e94933b6c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:32:54 -0500
Subject: [PATCH 206/318] Define a Domain carrier.

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

diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index d69b9036d..15ebe1672 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -84,6 +84,10 @@ runFile eval file = traverse run file
             . fmap fold
             . convergeTerm 0 (A.runHeap @Addr @ScopeGraph . fix (cacheTerm . eval))
 
+
+
+newtype DomainC term m a = DomainC (ReaderC (term Addr -> m ScopeGraph) m a)
+
 -- scopeGraphAnalysis
 --   :: ( Alternative m
 --      , Has (Env Name) sig m

From 3f23042191106652eab75deb9b576ab1f5c2464b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:33:02 -0500
Subject: [PATCH 207/318] Derive some instances.

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

diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index 15ebe1672..dba3bb47d 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, OverloadedStrings, RankNTypes, RecordWildCards, TypeApplications, TypeOperators #-}
+{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, OverloadedStrings, RankNTypes, RecordWildCards, TypeApplications, TypeOperators #-}
 module Analysis.ScopeGraph
 ( ScopeGraph(..)
 , Ref (..)
@@ -12,6 +12,7 @@ import           Analysis.File
 import           Analysis.FlowInsensitive
 import           Analysis.Name
 import           Control.Algebra
+import           Control.Applicative (Alternative(..))
 import           Control.Carrier.Reader
 import           Control.Carrier.Fail.WithLoc
 import           Control.Carrier.Fresh.Strict
@@ -87,6 +88,7 @@ runFile eval file = traverse run file
 
 
 newtype DomainC term m a = DomainC (ReaderC (term Addr -> m ScopeGraph) m a)
+  deriving (Alternative, Applicative, Functor, Monad, MonadFail)
 
 -- scopeGraphAnalysis
 --   :: ( Alternative m

From 187284782e95987caa2868ff88a9df56f1b2bdaa Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:33:11 -0500
Subject: [PATCH 208/318] Define a MonadTrans instance.

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

diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index dba3bb47d..d42b34f37 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -17,6 +17,7 @@ import           Control.Carrier.Reader
 import           Control.Carrier.Fail.WithLoc
 import           Control.Carrier.Fresh.Strict
 import           Control.Effect.State
+import           Control.Monad.Trans.Class
 import           Data.Foldable (fold)
 import           Data.Function (fix)
 import qualified Data.Map as Map
@@ -90,6 +91,9 @@ runFile eval file = traverse run file
 newtype DomainC term m a = DomainC (ReaderC (term Addr -> m ScopeGraph) m a)
   deriving (Alternative, Applicative, Functor, Monad, MonadFail)
 
+instance MonadTrans (DomainC term) where
+  lift = DomainC . lift
+
 -- scopeGraphAnalysis
 --   :: ( Alternative m
 --      , Has (Env Name) sig m

From 3003f3fc107204fdfdf59713242f3e0b2b979a31 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:33:15 -0500
Subject: [PATCH 209/318] Define a handler for Domain.

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

diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index d42b34f37..6649e9d7c 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -87,6 +87,8 @@ runFile eval file = traverse run file
             . convergeTerm 0 (A.runHeap @Addr @ScopeGraph . fix (cacheTerm . eval))
 
 
+runDomain :: (term Addr -> m ScopeGraph) -> DomainC term m a -> m a
+runDomain eval (DomainC m) = runReader eval m
 
 newtype DomainC term m a = DomainC (ReaderC (term Addr -> m ScopeGraph) m a)
   deriving (Alternative, Applicative, Functor, Monad, MonadFail)

From bcb4eb99d80f572cf842517aa6f41322d07603e8 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:42:21 -0500
Subject: [PATCH 210/318] Define an Algebra instance for DomainC.

---
 semantic-analysis/src/Analysis/ScopeGraph.hs | 31 +++++++++++++++++++-
 1 file changed, 30 insertions(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index 6649e9d7c..37c19e824 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, OverloadedStrings, RankNTypes, RecordWildCards, TypeApplications, TypeOperators #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses, OverloadedStrings, RankNTypes, RecordWildCards, TypeApplications, TypeOperators, UndecidableInstances #-}
 module Analysis.ScopeGraph
 ( ScopeGraph(..)
 , Ref (..)
@@ -8,7 +8,9 @@ module Analysis.ScopeGraph
 
 import           Analysis.Carrier.Env.Monovariant
 import qualified Analysis.Carrier.Heap.Monovariant as A
+import           Analysis.Effect.Domain
 import           Analysis.File
+import           Analysis.Intro
 import           Analysis.FlowInsensitive
 import           Analysis.Name
 import           Control.Algebra
@@ -22,8 +24,10 @@ import           Data.Foldable (fold)
 import           Data.Function (fix)
 import qualified Data.Map as Map
 import qualified Data.Set as Set
+import           Data.Traversable (for)
 import           Prelude hiding (fail)
 import           Source.Span
+import           Syntax.Scope
 import qualified System.Path as Path
 
 data Decl = Decl
@@ -96,6 +100,31 @@ newtype DomainC term m a = DomainC (ReaderC (term Addr -> m ScopeGraph) m a)
 instance MonadTrans (DomainC term) where
   lift = DomainC . lift
 
+instance (Has (Env Addr :+: A.Heap Addr ScopeGraph :+: Reader Path.AbsRelFile :+: Reader Span) sig m, Monad term) => Algebra (Domain term Addr ScopeGraph :+: sig) (DomainC term m) where
+  alg = \case
+    L (Abstract i k) -> case i of
+      Unit -> k mempty
+      Bool _ -> k mempty
+      String _ -> k mempty
+      Lam (Named n b) -> do
+        eval <- DomainC ask
+        addr <- alloc @Addr n
+        A.assign @Addr @ScopeGraph addr mempty
+        g <- bind n addr (lift (eval (instantiate1 (pure addr) b)))
+        k g
+      Record fields -> do
+        eval <- DomainC ask
+        fields' <- for fields $ \ (k, t) -> do
+          addr <- alloc k
+          path <- ask
+          span <- ask
+          v <- lift (eval t)
+          let v' = ScopeGraph (Map.singleton (Decl k path span) mempty) <> v
+          v' <$ A.assign @Addr addr v'
+        k (fold fields')
+    L (Concretize _ k) -> k Unit
+    R other -> DomainC (send (handleCoercible other))
+
 -- scopeGraphAnalysis
 --   :: ( Alternative m
 --      , Has (Env Name) sig m

From 0f030b3dcc8868b0db416770ebeb4dcbbc7cefa1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:42:39 -0500
Subject: [PATCH 211/318] Note a FIXME.

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

diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index 37c19e824..f0e513257 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -122,7 +122,7 @@ instance (Has (Env Addr :+: A.Heap Addr ScopeGraph :+: Reader Path.AbsRelFile :+
           let v' = ScopeGraph (Map.singleton (Decl k path span) mempty) <> v
           v' <$ A.assign @Addr addr v'
         k (fold fields')
-    L (Concretize _ k) -> k Unit
+    L (Concretize _ k) -> k Unit -- FIXME: break Concretize out by constructor.
     R other -> DomainC (send (handleCoercible other))
 
 -- scopeGraphAnalysis

From 00e506cdecbc789e076a1e3d4b4e6c00d4fce3fe Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:43:28 -0500
Subject: [PATCH 212/318] Run the Domain effect.

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

diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index f0e513257..0cbfe029a 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -55,7 +55,7 @@ instance Monoid ScopeGraph where
   mempty = ScopeGraph Map.empty
 
 scopeGraph
-  :: Ord (term Addr)
+  :: (Monad term, Ord (term Addr))
   => (forall sig m
      .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
      => (term Addr -> m ScopeGraph)
@@ -73,6 +73,7 @@ runFile
   :: ( Effect sig
      , Has Fresh sig m
      , Has (State (Heap ScopeGraph)) sig m
+     , Monad term
      , Ord (term Addr)
      )
   => (forall sig m
@@ -88,7 +89,7 @@ runFile eval file = traverse run file
             . runEnv
             . runFail
             . fmap fold
-            . convergeTerm 0 (A.runHeap @Addr @ScopeGraph . fix (cacheTerm . eval))
+            . convergeTerm 0 (A.runHeap @Addr @ScopeGraph . fix (\ eval' -> runDomain eval' . fix (cacheTerm . eval)))
 
 
 runDomain :: (term Addr -> m ScopeGraph) -> DomainC term m a -> m a

From 89d7bd5aaf120e4cb3916b2ee8704db2764b1595 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:44:08 -0500
Subject: [PATCH 213/318] Strengthen the constraints available to eval.

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

diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index 0cbfe029a..26f0e20e7 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -57,7 +57,7 @@ instance Monoid ScopeGraph where
 scopeGraph
   :: (Monad term, Ord (term Addr))
   => (forall sig m
-     .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
+     .  (Has (Domain term Addr ScopeGraph :+: Env Addr :+: A.Heap Addr ScopeGraph :+: Reader Path.AbsRelFile :+: Reader Span) sig m, MonadFail m)
      => (term Addr -> m ScopeGraph)
      -> (term Addr -> m ScopeGraph)
      )
@@ -77,7 +77,7 @@ runFile
      , Ord (term Addr)
      )
   => (forall sig m
-     .  (Has (Reader Path.AbsRelFile) sig m, Has (Reader Span) sig m, MonadFail m)
+     .  (Has (Domain term Addr ScopeGraph :+: Env Addr :+: A.Heap Addr ScopeGraph :+: Reader Path.AbsRelFile :+: Reader Span) sig m, MonadFail m)
      => (term Addr -> m ScopeGraph)
      -> (term Addr -> m ScopeGraph)
      )

From f00affb9587ae53fff2346a777f31a10b755ca19 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:44:22 -0500
Subject: [PATCH 214/318] :fire: commented-out Analysis implementations.

---
 semantic-analysis/src/Analysis/Concrete.hs    | 46 -------------------
 semantic-analysis/src/Analysis/ImportGraph.hs | 25 ----------
 semantic-analysis/src/Analysis/ScopeGraph.hs  | 24 ----------
 semantic-analysis/src/Analysis/Typecheck.hs   | 28 -----------
 4 files changed, 123 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 9dfe76aaa..f6b47e8a8 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -96,52 +96,6 @@ runFile eval file = traverse run file
             . A.runEnv
             . fix (\ eval' -> runDomain eval' . fix eval)
 
--- concreteAnalysis
---   :: forall term m sig
---   .  ( Has (A.Env Addr) sig m
---      , Has (A.Heap Addr (Concrete term)) sig m
---      , Has (State (Heap (Concrete term))) sig m
---      )
---   => Analysis Addr (Concrete term) m
--- concreteAnalysis = Analysis{..}
---   where -- abstract _ name body = do
---         --   path <- ask
---         --   span <- ask
---         --   env <- asks (flip Map.restrictKeys (Set.delete name (foldMap Set.singleton body)))
---         --   pure (Closure path span name body env)
---         -- apply eval (Closure path span name body env) a = do
---         --   local (const path) . local (const span) $ do
---         --     addr <- A.alloc name
---         --     A.assign addr a
---         --     local (const (Map.insert name addr env)) (eval body)
---         -- apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
---         record fields = do
---           fields' <- for fields $ \ (name, value) -> do
---             addr <- A.alloc name
---             A.assign addr value
---             pure (name, addr)
---           pure (Record (Map.fromList fields'))
---         addr ... n = do
---           val <- A.deref @Addr @(Concrete term) addr
---           heap <- get
---           pure (val >>= lookupConcrete heap n)
-
-
--- lookupConcrete :: Heap (Concrete term) -> Name -> Concrete (term Addr) -> Maybe Addr
--- 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
---         inFrame fs = maybeA (Map.lookup name fs) <|> (maybeA (Map.lookup "__semantic_super" fs) >>= inAddress)
---         -- look up the name in the value an address points to, if we haven’t already visited it
---         inAddress addr = do
---           visited <- get
---           guard (addr `IntSet.notMember` visited)
---           -- FIXME: throw an error if we can’t deref @addr@
---           val <- maybeA (IntMap.lookup addr heap)
---           modify (IntSet.insert addr)
---           inConcrete val
---         maybeA = maybe empty pure
 
 runDomain :: (term Addr -> m (Concrete term)) -> DomainC term m a -> m a
 runDomain eval (DomainC m) = runReader eval m
diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 9c3d6d7e9..06c94cc89 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -134,28 +134,3 @@ instance Has (Env Addr :+: A.Heap Addr (Value (Semi term)) :+: Reader Path.AbsRe
       String s      -> k (I.String s)
       Closure _ _ b -> k (I.Lam b)
     R other -> DomainC (send (handleCoercible other))
-
-
--- FIXME: decompose into a product domain and two atomic domains
--- importGraphAnalysis
---   :: ( Alternative m
---      , Has (Env Name) sig m
---      , Has (A.Heap Name (Value (Semi term))) sig m
---      )
---   => Analysis Name (Value (Semi term)) m
--- importGraphAnalysis = Analysis{..}
---   where -- abstract _ name body = do
---         --   path <- ask
---         --   span <- ask
---         --   pure (Value (Closure path span name body) mempty)
---         -- apply eval (Value (Closure path span name body) _) a = local (const path) . local (const -- span) $ do
---         --   addr <- alloc @Addr name
---         --   A.assign addr a
---         --   bind name addr (eval body)
---         -- apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
---         record fields = do
---           for_ fields $ \ (k, v) -> do
---             addr <- alloc @Addr k
---             A.assign addr v
---           pure (Value Abstract (foldMap (valueGraph . snd) fields))
---         _ ... m = pure (Just m)
diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index 26f0e20e7..d540eb368 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -125,27 +125,3 @@ instance (Has (Env Addr :+: A.Heap Addr ScopeGraph :+: Reader Path.AbsRelFile :+
         k (fold fields')
     L (Concretize _ k) -> k Unit -- FIXME: break Concretize out by constructor.
     R other -> DomainC (send (handleCoercible other))
-
--- scopeGraphAnalysis
---   :: ( Alternative m
---      , Has (Env Name) sig m
---      , Has (A.Heap Name ScopeGraph) sig m
---      , Has (Reader Path.AbsRelFile) sig m
---      , Has (Reader Span) sig m
---      )
---   => Analysis Name ScopeGraph m
--- scopeGraphAnalysis = Analysis{..}
---   where -- abstract eval name body = do
---         --   addr <- alloc @Addr name
---         --   A.assign @Addr @ScopeGraph name mempty
---         --   bind name addr (eval body)
---         -- apply _ f a = pure (f <> a)
---         record fields = do
---           fields' <- for fields $ \ (k, v) -> do
---             addr <- alloc k
---             path <- ask
---             span <- ask
---             let v' = ScopeGraph (Map.singleton (Decl k path span) mempty) <> v
---             (k, v') <$ A.assign @Addr addr v'
---           pure (foldMap snd fields')
---         _ ... m = pure (Just m)
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 32e6e83bd..69c473116 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -147,34 +147,6 @@ runFile eval file = traverse run file
               v <$ for_ bs (unify v))
           . convergeTerm 1  (A.runHeap @Addr @Type . fix (\ eval' -> runDomain eval' . fix (cacheTerm . eval)))
 
--- typecheckingAnalysis
---   :: ( Alternative m
---      , Has (Env Name) sig m
---      , Has (A.Heap Name Type) sig m
---      )
---   => Analysis Name Type m
--- typecheckingAnalysis = Analysis{..}
---   where -- abstract eval name body = do
---         --   -- FIXME: construct the associated scope
---         --   addr <- alloc @Name name
---         --   arg <- meta
---         --   A.assign addr arg
---         --   ty <- eval body
---         --   pure (Alg (arg :-> ty))
---         -- apply _ f a = do
---         --   _A <- meta
---         --   _B <- meta
---         --   unify (Alg (_A :-> _B)) f
---         --   unify _A a
---         --   pure _B
---         record fields = do
---           fields' <- for fields $ \ (k, v) -> do
---             addr <- alloc @Name k
---             (k, v) <$ A.assign addr v
---           -- FIXME: should records reference types by address instead?
---           pure (Alg (Record (Map.fromList fields')))
---         _ ... m = pure (Just m)
-
 
 data Constraint = Type :===: Type
   deriving (Eq, Ord, Show)

From 2e3713db3442e56359d6e0b0f82aeb5fb9993c87 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:56:55 -0500
Subject: [PATCH 215/318] =?UTF-8?q?Represent=20import=20graphs=E2=80=99=20?=
 =?UTF-8?q?semi-abstract=20values=20more=20discretely.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 semantic-analysis/src/Analysis/ImportGraph.hs | 34 ++++++++++++++-----
 1 file changed, 26 insertions(+), 8 deletions(-)

diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 06c94cc89..220a537ab 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -40,16 +40,31 @@ data Value semi = Value
   deriving (Eq, Ord, Show)
 
 instance Semigroup (Value (Semi term)) where
-  Value _ g1 <> Value _ g2 = Value Abstract (Map.unionWith (<>) g1 g2)
+  Value s1 g1 <> Value s2 g2 = Value (s1 <> s2) (Map.unionWith (<>) g1 g2)
 
 instance Monoid (Value (Semi term)) where
-  mempty = Value Abstract mempty
+  mempty = Value mempty mempty
 
 data Semi term
-  = Closure Path.AbsRelFile Span (Named (Scope () term Addr))
+  = Bottom
+  | Closure Path.AbsRelFile Span (Named (Scope () term Addr))
+  | Unit
+  | Bool
   -- FIXME: Bound String values.
   | String Text
-  | Abstract
+  | Top
+
+instance Semigroup (Semi term) where
+  s1        <> Bottom    = s1
+  Bottom    <> s2        = s2
+  Unit      <> Unit      = Unit
+  Bool      <> Bool      = Bool
+  String s1 <> String s2
+    | s1 == s2           = String s1
+  _         <> _         = Top
+
+instance Monoid (Semi term) where
+  mempty = Bottom
 
 deriving instance ( forall a . Eq   a => Eq   (f a), Monad f) => Eq   (Semi f)
 deriving instance ( forall a . Eq   a => Eq   (f a)
@@ -112,11 +127,11 @@ instance MonadTrans (DomainC term) where
   lift = DomainC . lift
 
 -- FIXME: decompose into a product domain and two atomic domains
-instance Has (Env Addr :+: A.Heap Addr (Value (Semi term)) :+: Reader Path.AbsRelFile :+: Reader Span) sig m => Algebra (A.Domain term Addr (Value (Semi term)) :+: sig) (DomainC term m) where
+instance (Alternative m, Has (Env Addr :+: A.Heap Addr (Value (Semi term)) :+: Reader Path.AbsRelFile :+: Reader Span) sig m) => Algebra (A.Domain term Addr (Value (Semi term)) :+: sig) (DomainC term m) where
   alg = \case
     L (A.Abstract i k) -> case i of
-      I.Unit     -> k mempty
-      I.Bool _   -> k mempty
+      I.Unit     -> k (Value Unit mempty)
+      I.Bool _   -> k (Value Bool mempty)
       I.String s -> k (Value (String s) mempty)
       I.Lam b    -> do
         path <- ask
@@ -130,7 +145,10 @@ instance Has (Env Addr :+: A.Heap Addr (Value (Semi term)) :+: Reader Path.AbsRe
           v <$ A.assign @Addr @(Value (Semi term)) addr v
         k (fold fields)
     L (A.Concretize (Value s _) k) -> case s of
-      Abstract      -> k I.Unit -- FIXME: this should be broken down for case analysis
+      Bottom        -> k I.Unit -- FIXME: what should we do when we don’t know anything about the value?
+      Unit          -> k I.Unit
+      Bool          -> k (I.Bool True) <|> k (I.Bool False)
       String s      -> k (I.String s)
       Closure _ _ b -> k (I.Lam b)
+      Top           -> k I.Unit -- FIXME: what should we do when the value comprised multiple things?
     R other -> DomainC (send (handleCoercible other))

From 26cf1d3a15abc1918593151acfd4feb58c6fdafa Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:57:01 -0500
Subject: [PATCH 216/318] =?UTF-8?q?Revert=20"Represent=20import=20graphs?=
 =?UTF-8?q?=E2=80=99=20semi-abstract=20values=20more=20discretely."?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This reverts commit 2e3713db3442e56359d6e0b0f82aeb5fb9993c87.
---
 semantic-analysis/src/Analysis/ImportGraph.hs | 34 +++++--------------
 1 file changed, 8 insertions(+), 26 deletions(-)

diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 220a537ab..06c94cc89 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -40,31 +40,16 @@ data Value semi = Value
   deriving (Eq, Ord, Show)
 
 instance Semigroup (Value (Semi term)) where
-  Value s1 g1 <> Value s2 g2 = Value (s1 <> s2) (Map.unionWith (<>) g1 g2)
+  Value _ g1 <> Value _ g2 = Value Abstract (Map.unionWith (<>) g1 g2)
 
 instance Monoid (Value (Semi term)) where
-  mempty = Value mempty mempty
+  mempty = Value Abstract mempty
 
 data Semi term
-  = Bottom
-  | Closure Path.AbsRelFile Span (Named (Scope () term Addr))
-  | Unit
-  | Bool
+  = Closure Path.AbsRelFile Span (Named (Scope () term Addr))
   -- FIXME: Bound String values.
   | String Text
-  | Top
-
-instance Semigroup (Semi term) where
-  s1        <> Bottom    = s1
-  Bottom    <> s2        = s2
-  Unit      <> Unit      = Unit
-  Bool      <> Bool      = Bool
-  String s1 <> String s2
-    | s1 == s2           = String s1
-  _         <> _         = Top
-
-instance Monoid (Semi term) where
-  mempty = Bottom
+  | Abstract
 
 deriving instance ( forall a . Eq   a => Eq   (f a), Monad f) => Eq   (Semi f)
 deriving instance ( forall a . Eq   a => Eq   (f a)
@@ -127,11 +112,11 @@ instance MonadTrans (DomainC term) where
   lift = DomainC . lift
 
 -- FIXME: decompose into a product domain and two atomic domains
-instance (Alternative m, Has (Env Addr :+: A.Heap Addr (Value (Semi term)) :+: Reader Path.AbsRelFile :+: Reader Span) sig m) => Algebra (A.Domain term Addr (Value (Semi term)) :+: sig) (DomainC term m) where
+instance Has (Env Addr :+: A.Heap Addr (Value (Semi term)) :+: Reader Path.AbsRelFile :+: Reader Span) sig m => Algebra (A.Domain term Addr (Value (Semi term)) :+: sig) (DomainC term m) where
   alg = \case
     L (A.Abstract i k) -> case i of
-      I.Unit     -> k (Value Unit mempty)
-      I.Bool _   -> k (Value Bool mempty)
+      I.Unit     -> k mempty
+      I.Bool _   -> k mempty
       I.String s -> k (Value (String s) mempty)
       I.Lam b    -> do
         path <- ask
@@ -145,10 +130,7 @@ instance (Alternative m, Has (Env Addr :+: A.Heap Addr (Value (Semi term)) :+: R
           v <$ A.assign @Addr @(Value (Semi term)) addr v
         k (fold fields)
     L (A.Concretize (Value s _) k) -> case s of
-      Bottom        -> k I.Unit -- FIXME: what should we do when we don’t know anything about the value?
-      Unit          -> k I.Unit
-      Bool          -> k (I.Bool True) <|> k (I.Bool False)
+      Abstract      -> k I.Unit -- FIXME: this should be broken down for case analysis
       String s      -> k (I.String s)
       Closure _ _ b -> k (I.Lam b)
-      Top           -> k I.Unit -- FIXME: what should we do when the value comprised multiple things?
     R other -> DomainC (send (handleCoercible other))

From 2bbd2e08efc3258306e4471977b72bcebf69e74f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 14:58:30 -0500
Subject: [PATCH 217/318] Reformat the language extensions.

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

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 69c473116..46044d935 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -1,4 +1,19 @@
-{-# LANGUAGE DeriveGeneric, DeriveTraversable, DerivingVia, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
 module Analysis.Typecheck
 ( Monotype (..)
 , Meta

From 3f43fb7290383bd223d71fc85eae21f1b79d651c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 15:11:50 -0500
Subject: [PATCH 218/318] Apply stylish-haskell to Analysis.Effect.Domain.

---
 .../src/Analysis/Effect/Domain.hs             | 19 ++++++++++---------
 1 file changed, 10 insertions(+), 9 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index af0d52ee0..007f64847 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -1,4 +1,5 @@
-{-# LANGUAGE AllowAmbiguousTypes, DeriveFunctor, DeriveGeneric, FlexibleContexts, LambdaCase, QuantifiedConstraints, ScopedTypeVariables, TypeApplications #-}
+{-# LANGUAGE AllowAmbiguousTypes, DeriveFunctor, DeriveGeneric, FlexibleContexts, LambdaCase, QuantifiedConstraints,
+             ScopedTypeVariables, TypeApplications #-}
 module Analysis.Effect.Domain
 ( -- * Domain effect
   abstract
@@ -19,15 +20,15 @@ module Analysis.Effect.Domain
 , run
 ) where
 
-import Analysis.Intro (Intro)
+import           Analysis.Intro (Intro)
 import qualified Analysis.Intro as A
-import Analysis.Name
-import Control.Algebra
-import Control.Monad ((>=>))
-import Control.Monad.Fail as Fail
-import Data.Text (Text)
-import GHC.Generics (Generic1)
-import Syntax.Scope (Scope)
+import           Analysis.Name
+import           Control.Algebra
+import           Control.Monad ((>=>))
+import           Control.Monad.Fail as Fail
+import           Data.Text (Text)
+import           GHC.Generics (Generic1)
+import           Syntax.Scope (Scope)
 
 abstract :: Has (Domain term addr abstract) sig m => Intro term addr -> m abstract
 abstract concrete = send (Abstract concrete pure)

From cd96cdb4da9401db577afce4f637fd4f14128834 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 15:12:40 -0500
Subject: [PATCH 219/318] Change the stylish-haskell config to format language
 pragmas vertically and not align their closing tags.

---
 .stylish-haskell.yaml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml
index 19825baca..086cfc319 100644
--- a/.stylish-haskell.yaml
+++ b/.stylish-haskell.yaml
@@ -173,7 +173,7 @@ steps:
       #   `{-#LANGUAGE #-}'.
       #
       # Default: vertical.
-      style: compact
+      style: vertical
 
       # Align affects alignment of closing pragma brackets.
       #
@@ -183,7 +183,7 @@ steps:
       #   between actual import and closing bracket.
       #
       # Default: true
-      align: true
+      align: false
 
       # stylish-haskell can detect redundancy of some language pragmas. If this
       # is set to true, it will remove those redundant pragmas. Default: true.

From 582c71f355bfcd13b7c971933827332d43d98574 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 19 Dec 2019 15:12:44 -0500
Subject: [PATCH 220/318] Reformat the language pragmas.

---
 semantic-analysis/src/Analysis/Effect/Domain.hs | 10 ++++++++--
 1 file changed, 8 insertions(+), 2 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index 007f64847..12729156e 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -1,5 +1,11 @@
-{-# LANGUAGE AllowAmbiguousTypes, DeriveFunctor, DeriveGeneric, FlexibleContexts, LambdaCase, QuantifiedConstraints,
-             ScopedTypeVariables, TypeApplications #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 module Analysis.Effect.Domain
 ( -- * Domain effect
   abstract

From 37e5ba4986ec792572f74fe3add9c3df539609ab Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 09:57:19 -0500
Subject: [PATCH 221/318] Split concretization into the primitive operations.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This allows us to produce values of the correct type for abstract domains which don’t distinguish between primitive types, and to act on the expected type when e.g. typechecking by unifying.
---
 semantic-analysis/src/Analysis/Concrete.hs    | 27 ++++---
 .../src/Analysis/Effect/Domain.hs             | 41 ++++-------
 semantic-analysis/src/Analysis/ImportGraph.hs | 13 ++--
 semantic-analysis/src/Analysis/ScopeGraph.hs  |  7 +-
 semantic-analysis/src/Analysis/Typecheck.hs   | 72 ++++++++++++-------
 5 files changed, 88 insertions(+), 72 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index f6b47e8a8..c23fa3b1c 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -111,14 +111,15 @@ instance ( Applicative term
          , Has (A.Heap Addr (Concrete term)) sig m
          , Has (Reader Path.AbsRelFile) sig m
          , Has (Reader Span) sig m
+         , MonadFail m
          )
       => Algebra (Domain term Addr (Concrete term) :+: sig) (DomainC term m) where
   alg = \case
     L (Abstract i k) -> case i of
-      I.Unit          -> k Unit
-      I.Bool b        -> k (Bool b)
-      I.String s      -> k (String s)
-      I.Lam b         -> do
+      I.Unit         -> k Unit
+      I.Bool b       -> k (Bool b)
+      I.String s     -> k (String s)
+      I.Lam b        -> do
         path <- ask
         span <- ask
         k (Closure path span b)
@@ -130,12 +131,18 @@ instance ( Applicative term
           A.assign @Addr @(Concrete term) addr v
           pure (name, addr)
         k (Record (Map.fromList fields'))
-    L (Concretize c k) -> case c of
-      Unit          -> k I.Unit
-      Bool b        -> k (I.Bool b)
-      String s      -> k (I.String s)
-      Closure _ _ b -> k (I.Lam b)
-      Record fields -> k (I.Record (map (fmap pure) (Map.toList fields)))
+    L (AsBool   c k) -> case c of
+      Bool   b       -> k b
+      _              -> fail "expected Bool"
+    L (AsString c k) -> case c of
+      String s       -> k s
+      _              -> fail "expected String"
+    L (AsLam    c k) -> case c of
+      Closure _ _ b  -> k b
+      _              -> fail "expected Closure"
+    L (AsRecord c k) -> case c of
+      Record fields  -> k (map (fmap pure) (Map.toList fields))
+      _              -> fail "expected Record"
     R other -> DomainC (send (handleCoercible other))
 
 
diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index 12729156e..49122579c 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -9,7 +9,6 @@
 module Analysis.Effect.Domain
 ( -- * Domain effect
   abstract
-, concretize
 , unit
 , bool
 , asBool
@@ -30,8 +29,6 @@ import           Analysis.Intro (Intro)
 import qualified Analysis.Intro as A
 import           Analysis.Name
 import           Control.Algebra
-import           Control.Monad ((>=>))
-import           Control.Monad.Fail as Fail
 import           Data.Text (Text)
 import           GHC.Generics (Generic1)
 import           Syntax.Scope (Scope)
@@ -39,9 +36,6 @@ import           Syntax.Scope (Scope)
 abstract :: Has (Domain term addr abstract) sig m => Intro term addr -> m abstract
 abstract concrete = send (Abstract concrete pure)
 
-concretize :: Has (Domain term addr abstract) sig m => abstract -> m (Intro term addr)
-concretize abstract = send (Concretize abstract pure)
-
 
 unit :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => m abstract
 unit = abstract @term @addr A.Unit
@@ -49,46 +43,37 @@ unit = abstract @term @addr A.Unit
 bool :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => Bool -> m abstract
 bool = abstract @term @addr . A.Bool
 
-asBool :: forall term addr abstract m sig . (Has (Domain term addr abstract) sig m, MonadFail m, Show addr, forall a . Show a => Show (term a)) => abstract -> m Bool
-asBool = concretize @term @addr >=> \case
-  A.Bool b -> pure b
-  other    -> typeError "Bool" other
+asBool :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => abstract -> m Bool
+asBool v = send (AsBool @term @addr v pure)
 
 string :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => Text -> m abstract
 string = abstract @term @addr . A.String
 
-asString :: forall term addr abstract m sig . (Has (Domain term addr abstract) sig m, MonadFail m, Show addr, forall a . Show a => Show (term a)) => abstract -> m Text
-asString = concretize @term @addr >=> \case
-  A.String t -> pure t
-  other      -> typeError "String" other
+asString :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => abstract -> m Text
+asString v = send (AsString @term @addr v pure)
 
 
 lam :: Has (Domain term addr abstract) sig m => Named (Scope () term addr) -> m abstract
 lam = abstract . A.Lam
 
-asLam :: (Has (Domain term addr abstract) sig m, MonadFail m, Show addr, forall a . Show a => Show (term a)) => abstract -> m (Named (Scope () term addr))
-asLam = concretize >=> \case
-  A.Lam b -> pure b
-  other   -> typeError "Lam" other
+asLam :: Has (Domain term addr abstract) sig m => abstract -> m (Named (Scope () term addr))
+asLam v = send (AsLam v pure)
 
 
 record :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => [(Name, term addr)] -> m abstract
 record = abstract @term . A.Record
 
-asRecord :: forall term addr abstract m sig . (Has (Domain term addr abstract) sig m, MonadFail m, Show addr, forall a . Show a => Show (term a)) => abstract -> m [(Name, term addr)]
-asRecord = concretize @term >=> \case
-  A.Record fs -> pure fs
-  other       -> typeError "Record" other
+asRecord :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => abstract -> m [(Name, term addr)]
+asRecord v = send (AsRecord v pure)
 
 
 data Domain term addr abstract m k
-  = Abstract   (Intro term addr) (abstract        -> m k)
-  | Concretize abstract          (Intro term addr -> m k)
+  = Abstract (Intro term addr) (abstract                   -> m k)
+  | AsBool   abstract          (Bool                       -> m k)
+  | AsString abstract          (Text                       -> m k)
+  | AsLam    abstract          (Named (Scope () term addr) -> m k)
+  | AsRecord abstract          ([(Name, term addr)]        -> m k)
   deriving (Functor, Generic1)
 
 instance HFunctor (Domain term addr abstract)
 instance Effect   (Domain term addr abstract)
-
-
-typeError :: (Show a, MonadFail m) => String -> a -> m b
-typeError expected actual = Fail.fail $ "expected " <> expected <> ", got " <> show actual
diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 06c94cc89..6b55f8e0b 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -112,7 +112,7 @@ instance MonadTrans (DomainC term) where
   lift = DomainC . lift
 
 -- FIXME: decompose into a product domain and two atomic domains
-instance Has (Env Addr :+: A.Heap Addr (Value (Semi term)) :+: Reader Path.AbsRelFile :+: Reader Span) sig m => Algebra (A.Domain term Addr (Value (Semi term)) :+: sig) (DomainC term m) where
+instance (Alternative m, Has (Env Addr :+: A.Heap Addr (Value (Semi term)) :+: Reader Path.AbsRelFile :+: Reader Span) sig m, MonadFail m) => Algebra (A.Domain term Addr (Value (Semi term)) :+: sig) (DomainC term m) where
   alg = \case
     L (A.Abstract i k) -> case i of
       I.Unit     -> k mempty
@@ -129,8 +129,11 @@ instance Has (Env Addr :+: A.Heap Addr (Value (Semi term)) :+: Reader Path.AbsRe
           v <- lift (eval t)
           v <$ A.assign @Addr @(Value (Semi term)) addr v
         k (fold fields)
-    L (A.Concretize (Value s _) k) -> case s of
-      Abstract      -> k I.Unit -- FIXME: this should be broken down for case analysis
-      String s      -> k (I.String s)
-      Closure _ _ b -> k (I.Lam b)
+    L (A.AsBool   _ k) -> k True <|> k False
+    L (A.AsString _ k) -> k mempty
+    L (A.AsLam (Value v _) k) -> case v of
+      Closure _ _ b -> k b
+      String _      -> fail $ "expected closure, got String"
+      Abstract      -> fail $ "expected closure, got Abstract"
+    L (A.AsRecord _ k) -> k []
     R other -> DomainC (send (handleCoercible other))
diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index d540eb368..e19b6b169 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -101,7 +101,7 @@ newtype DomainC term m a = DomainC (ReaderC (term Addr -> m ScopeGraph) m a)
 instance MonadTrans (DomainC term) where
   lift = DomainC . lift
 
-instance (Has (Env Addr :+: A.Heap Addr ScopeGraph :+: Reader Path.AbsRelFile :+: Reader Span) sig m, Monad term) => Algebra (Domain term Addr ScopeGraph :+: sig) (DomainC term m) where
+instance (Alternative m, Has (Env Addr :+: A.Heap Addr ScopeGraph :+: Reader Path.AbsRelFile :+: Reader Span) sig m, Monad term) => Algebra (Domain term Addr ScopeGraph :+: sig) (DomainC term m) where
   alg = \case
     L (Abstract i k) -> case i of
       Unit -> k mempty
@@ -123,5 +123,8 @@ instance (Has (Env Addr :+: A.Heap Addr ScopeGraph :+: Reader Path.AbsRelFile :+
           let v' = ScopeGraph (Map.singleton (Decl k path span) mempty) <> v
           v' <$ A.assign @Addr addr v'
         k (fold fields')
-    L (Concretize _ k) -> k Unit -- FIXME: break Concretize out by constructor.
+    L (AsBool   _ k) -> k True <|> k False
+    L (AsString _ k) -> k mempty
+    L (AsLam    _ k) -> alloc (Name mempty) >>= k . Named (Name mempty) . lift . pure
+    L (AsRecord _ k) -> k []
     R other -> DomainC (send (handleCoercible other))
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 46044d935..128fb490c 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -223,38 +223,56 @@ instance ( Alternative m
          , Has (Env Addr) sig m
          , Has Fresh sig m
          , Has (A.Heap Addr Type) sig m
+         , Has (State (Set.Set Constraint)) sig m
          , Monad term
          , MonadFail m
          , Has Intro.Intro syn term
          )
       => Algebra (Domain term Addr Type :+: sig) (DomainC term m) where
-  alg (L (Abstract v k)) = case v of
-    Intro.Unit     -> k (Alg Unit)
-    Intro.Bool   _ -> k (Alg Bool)
-    Intro.String _ -> k (Alg String)
-    Intro.Lam (Named n b) -> do
-      eval <- DomainC ask
-      addr <- alloc @Name n
-      arg <- meta
-      A.assign addr arg
-      ty <- lift (eval (instantiate1 (pure n) b))
-      k (Alg (arg :-> ty))
-    Intro.Record fields -> do
-      eval <- DomainC ask
-      fields' <- for fields $ \ (k, t) -> do
-        addr <- alloc @Addr k
-        v <- lift (eval t)
-        (k, v) <$ A.assign addr v
-      -- FIXME: should records reference types by address instead?
-      k (Alg (Record (Map.fromList fields')))
+  alg = \case
+    L (Abstract v k) -> case v of
+      Intro.Unit     -> k (Alg Unit)
+      Intro.Bool   _ -> k (Alg Bool)
+      Intro.String _ -> k (Alg String)
+      Intro.Lam (Named n b) -> do
+        eval <- DomainC ask
+        addr <- alloc @Name n
+        arg <- meta
+        A.assign addr arg
+        ty <- lift (eval (instantiate1 (pure n) b))
+        k (Alg (arg :-> ty))
+      Intro.Record fields -> do
+        eval <- DomainC ask
+        fields' <- for fields $ \ (k, t) -> do
+          addr <- alloc @Addr k
+          v <- lift (eval t)
+          (k, v) <$ A.assign addr v
+        -- FIXME: should records reference types by address instead?
+        k (Alg (Record (Map.fromList fields')))
 
-  alg (L (Concretize t k)) = case t of
-    Alg Unit       -> k Intro.Unit
-    Alg Bool       -> k (Intro.Bool True) <|> k (Intro.Bool False)
-    Alg String     -> k (Intro.String mempty)
-    Alg (_ :-> b)  -> concretize @term b >>= k . Intro.Lam . Named (Name mempty) . lift . send
-    Alg (Record t) -> traverse (traverse concretize) (Map.toList t) >>= k . Intro.Record . map (fmap send)
-    t             -> fail ("can’t concretize " <> show t)
-  alg (R other) = DomainC (send (handleCoercible other))
+    L (AsBool   t k) -> do
+      unify t (Alg Bool)
+      k True <|> k False
+    L (AsString t k) -> do
+      unify t (Alg String)
+      k mempty
+    L (AsLam    t k) -> do
+      arg <- meta
+      ret <- meta
+      unify t (Alg (arg :-> ret))
+      b <- concretize ret
+      k (Named (Name mempty) (lift b)) where
+      concretize = \case
+        Alg Unit       -> pure Intro.unit
+        Alg Bool       -> pure (Intro.bool True) <|> pure (Intro.bool False)
+        Alg String     -> pure (Intro.string mempty)
+        Alg (_ :-> b)  -> send . Intro.Lam . Named (Name mempty) . lift <$> concretize b
+        Alg (Record t) -> Intro.record <$> traverse (traverse concretize) (Map.toList t)
+        t              -> fail $ "can’t concretize " <> show t -- FIXME: concretize type variables by incrementally solving constraints
+    L (AsRecord t k) -> do
+      unify t (Alg (Record mempty))
+      k mempty -- FIXME: return whatever fields we have, when it’s actually a Record
+
+    R other -> DomainC (send (handleCoercible other))
 
 -- FIXME: we don’t get the chance to unify anything because concretization asks for an intro form, not an intro form of a specific type

From c05904c607bb07a7702f2c4e8185ec4c6cb7e290 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 09:58:03 -0500
Subject: [PATCH 222/318] Note a couple of FIXMEs.

---
 semantic-analysis/src/Analysis/Effect/Domain.hs | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index 49122579c..fd51b1de0 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -56,6 +56,7 @@ asString v = send (AsString @term @addr v pure)
 lam :: Has (Domain term addr abstract) sig m => Named (Scope () term addr) -> m abstract
 lam = abstract . A.Lam
 
+-- FIXME: Support partial concretization of lambdas.
 asLam :: Has (Domain term addr abstract) sig m => abstract -> m (Named (Scope () term addr))
 asLam v = send (AsLam v pure)
 
@@ -63,6 +64,7 @@ asLam v = send (AsLam v pure)
 record :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => [(Name, term addr)] -> m abstract
 record = abstract @term . A.Record
 
+-- FIXME: Support partial concretization of lambdas and records.
 asRecord :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => abstract -> m [(Name, term addr)]
 asRecord v = send (AsRecord v pure)
 

From 59e5839b678bd01913918dd142b2d7de642c9032 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 09:58:30 -0500
Subject: [PATCH 223/318] :fire: a redundant FIXME.

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

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 128fb490c..d45237eab 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -274,5 +274,3 @@ instance ( Alternative m
       k mempty -- FIXME: return whatever fields we have, when it’s actually a Record
 
     R other -> DomainC (send (handleCoercible other))
-
--- FIXME: we don’t get the chance to unify anything because concretization asks for an intro form, not an intro form of a specific type

From 624483b81203c6190348b43b045796d6e8baae7d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:02:03 -0500
Subject: [PATCH 224/318] Reformat the language pragmas in the Concrete
 analysis.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index c23fa3b1c..3e15e022e 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -1,6 +1,19 @@
-{-# LANGUAGE DerivingVia, FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses, NamedFieldPuns,
-             OverloadedStrings, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators,
-             UndecidableInstances #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
 module Analysis.Concrete
 ( Concrete(..)
 , concrete

From 53dda90d7f99affef7dc9c7c6addc094157e8fa6 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:02:56 -0500
Subject: [PATCH 225/318] :fire: recordFrame.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 3e15e022e..3d6c0ce75 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -65,10 +65,6 @@ deriving instance ( forall a . Eq   a => Eq   (f a)
 deriving instance ( forall a . Show a => Show (f a))          => Show (Concrete f)
 
 
--- recordFrame :: Concrete term -> Maybe Env
--- recordFrame (Record frame) = Just frame
--- recordFrame _              = Nothing
-
 type Heap = IntMap.IntMap
 
 

From 10386f72517106d11dcf7f57862d20adc4c33f4f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:03:27 -0500
Subject: [PATCH 226/318] Sort imports.

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

diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 6b55f8e0b..53c05747d 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -8,11 +8,11 @@ import           Analysis.Carrier.Env.Monovariant
 import qualified Analysis.Carrier.Heap.Monovariant as A
 import qualified Analysis.Effect.Domain as A
 import           Analysis.File
-import qualified Analysis.Intro as I
 import           Analysis.FlowInsensitive
+import qualified Analysis.Intro as I
 import           Analysis.Name
 import           Control.Algebra
-import           Control.Applicative (Alternative(..))
+import           Control.Applicative (Alternative (..))
 import           Control.Carrier.Fail.WithLoc
 import           Control.Carrier.Fresh.Strict
 import           Control.Carrier.Reader

From 7418fbaa7419119c8457206dd013a65aff45a25d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:03:34 -0500
Subject: [PATCH 227/318] Reformat language pragmas.

---
 semantic-analysis/src/Analysis/ImportGraph.hs | 14 +++++++++++++-
 1 file changed, 13 insertions(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 53c05747d..221ce37d4 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -1,4 +1,16 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, LambdaCase, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
 module Analysis.ImportGraph
 ( ImportGraph
 , importGraph

From 2052c70e73187d81463a823963462e459a3d5fe9 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:03:45 -0500
Subject: [PATCH 228/318] Sort imports.

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

diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index e19b6b169..a5ab78bb5 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -10,14 +10,14 @@ import           Analysis.Carrier.Env.Monovariant
 import qualified Analysis.Carrier.Heap.Monovariant as A
 import           Analysis.Effect.Domain
 import           Analysis.File
-import           Analysis.Intro
 import           Analysis.FlowInsensitive
+import           Analysis.Intro
 import           Analysis.Name
 import           Control.Algebra
-import           Control.Applicative (Alternative(..))
-import           Control.Carrier.Reader
+import           Control.Applicative (Alternative (..))
 import           Control.Carrier.Fail.WithLoc
 import           Control.Carrier.Fresh.Strict
+import           Control.Carrier.Reader
 import           Control.Effect.State
 import           Control.Monad.Trans.Class
 import           Data.Foldable (fold)

From 580525a3d85747a3843a986f10736b63dbd97b06 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:03:51 -0500
Subject: [PATCH 229/318] Reformat language pragmas.

---
 semantic-analysis/src/Analysis/ScopeGraph.hs | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
index a5ab78bb5..c7fc0b956 100644
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ b/semantic-analysis/src/Analysis/ScopeGraph.hs
@@ -1,4 +1,14 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, GeneralizedNewtypeDeriving, LambdaCase, MultiParamTypeClasses, OverloadedStrings, RankNTypes, RecordWildCards, TypeApplications, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
 module Analysis.ScopeGraph
 ( ScopeGraph(..)
 , Ref (..)

From 38da7a41ec3d2d35a13e9cfa075978dc089b1eac Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:04:11 -0500
Subject: [PATCH 230/318] Align cases locally.

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

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 3d6c0ce75..f33466d48 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -141,17 +141,17 @@ instance ( Applicative term
           pure (name, addr)
         k (Record (Map.fromList fields'))
     L (AsBool   c k) -> case c of
-      Bool   b       -> k b
-      _              -> fail "expected Bool"
+      Bool   b -> k b
+      _        -> fail "expected Bool"
     L (AsString c k) -> case c of
-      String s       -> k s
-      _              -> fail "expected String"
+      String s -> k s
+      _        -> fail "expected String"
     L (AsLam    c k) -> case c of
-      Closure _ _ b  -> k b
-      _              -> fail "expected Closure"
+      Closure _ _ b -> k b
+      _             -> fail "expected Closure"
     L (AsRecord c k) -> case c of
-      Record fields  -> k (map (fmap pure) (Map.toList fields))
-      _              -> fail "expected Record"
+      Record fields -> k (map (fmap pure) (Map.toList fields))
+      _             -> fail "expected Record"
     R other -> DomainC (send (handleCoercible other))
 
 

From 850811bf06fd755b41aed77e09d3b499f2d4b10e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:04:21 -0500
Subject: [PATCH 231/318] Reformat an import list.

---
 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 f33466d48..12c65bc3a 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -35,7 +35,7 @@ import           Control.Algebra
 import           Control.Carrier.Fail.WithLoc
 import           Control.Carrier.Fresh.Strict
 import           Control.Carrier.Reader hiding (Local)
-import           Control.Monad.Trans.Class (MonadTrans(..))
+import           Control.Monad.Trans.Class (MonadTrans (..))
 import           Data.Function (fix)
 import qualified Data.IntMap as IntMap
 import qualified Data.Map as Map

From 96f520433868abe13684d42af91d0258c423367f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:04:32 -0500
Subject: [PATCH 232/318] Sort imports.

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

diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index d45237eab..1d0786db3 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -24,9 +24,9 @@ module Analysis.Typecheck
 import           Analysis.Carrier.Env.Monovariant
 import qualified Analysis.Carrier.Heap.Monovariant as A
 import           Analysis.Effect.Domain
-import qualified Analysis.Intro as Intro
 import           Analysis.File
 import           Analysis.FlowInsensitive
+import qualified Analysis.Intro as Intro
 import           Analysis.Name
 import           Control.Algebra
 import           Control.Applicative (Alternative (..))

From a50ab433140e485c178cf3881343ac95c5682409 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:06:01 -0500
Subject: [PATCH 233/318] Reformat language extensions.

---
 semantic-analysis/src/Analysis/Intro.hs | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/semantic-analysis/src/Analysis/Intro.hs b/semantic-analysis/src/Analysis/Intro.hs
index 17fb4358a..440f177e3 100644
--- a/semantic-analysis/src/Analysis/Intro.hs
+++ b/semantic-analysis/src/Analysis/Intro.hs
@@ -1,4 +1,7 @@
-{-# LANGUAGE DeriveGeneric, DeriveTraversable, QuantifiedConstraints, StandaloneDeriving #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE StandaloneDeriving #-}
 module Analysis.Intro
 ( Intro(..)
 , unit

From 2fe68f3d0fd55d4f394ae5880fc78e7e71759c47 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:06:32 -0500
Subject: [PATCH 234/318] Alignment.

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

diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index 4a36c7362..7b28371b0 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -83,8 +83,8 @@ eval eval = \case
       addr <- ref a
       b' <$ A.assign addr b'
   Term.Alg (R (R c)) -> case c of
-    Unit -> A.unit @Term @address
-    Bool b -> A.bool @Term @address b
+    Unit     -> A.unit @Term @address
+    Bool b   -> A.bool @Term @address b
     String s -> A.string @Term @address s
   Term.Alg (L (Ann span c)) -> local (const span) (eval c)
   where freeVariable s = fail ("free variable: " <> s)

From 1948e2b619b510279c8f13b6a629959a0fe47c3c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:06:37 -0500
Subject: [PATCH 235/318] Sort/align imports.

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

diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index 7b28371b0..7bc6b2220 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -10,23 +10,23 @@ module Core.Eval
 , ruby
 ) where
 
-import Analysis.Effect.Domain as A
-import Analysis.Effect.Env as A
-import Analysis.Effect.Heap as A
-import Analysis.File
-import Control.Algebra
-import Control.Applicative (Alternative (..))
-import Control.Effect.Fail
-import Control.Effect.Reader
-import Control.Monad ((>=>))
-import Core.Core as Core
-import Core.Name
-import Data.Functor
-import Data.Maybe (fromMaybe, isJust)
-import GHC.Stack
-import Prelude hiding (fail)
-import Source.Span
-import Syntax.Scope
+import           Analysis.Effect.Domain as A
+import           Analysis.Effect.Env as A
+import           Analysis.Effect.Heap as A
+import           Analysis.File
+import           Control.Algebra
+import           Control.Applicative (Alternative (..))
+import           Control.Effect.Fail
+import           Control.Effect.Reader
+import           Control.Monad ((>=>))
+import           Core.Core as Core
+import           Core.Name
+import           Data.Functor
+import           Data.Maybe (fromMaybe, isJust)
+import           GHC.Stack
+import           Prelude hiding (fail)
+import           Source.Span
+import           Syntax.Scope
 import qualified Syntax.Term as Term
 import qualified System.Path as Path
 

From 086018019fddf9f34229aad236f5f9f611465dc6 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:06:42 -0500
Subject: [PATCH 236/318] Reformat language pragmas.

---
 semantic-core/src/Core/Eval.hs | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index 7bc6b2220..bc8f4c0fb 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -1,4 +1,11 @@
-{-# LANGUAGE FlexibleContexts, LambdaCase, OverloadedStrings, RankNTypes, RecordWildCards, ScopedTypeVariables, TypeApplications, TypeOperators #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
 module Core.Eval
 ( eval
 , prog1

From d876d010ff08c39b222139d3dfa78701f3eb4e72 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:07:02 -0500
Subject: [PATCH 237/318] Reformat language pragmas.

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

diff --git a/semantic-core/src/Core/Core.hs b/semantic-core/src/Core/Core.hs
index 5920b6e20..dec0c7af8 100644
--- a/semantic-core/src/Core/Core.hs
+++ b/semantic-core/src/Core/Core.hs
@@ -1,4 +1,16 @@
-{-# LANGUAGE DeriveGeneric, DeriveTraversable, FlexibleContexts, LambdaCase, MultiParamTypeClasses, OverloadedStrings, QuantifiedConstraints, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeFamilies, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuantifiedConstraints #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
 module Core.Core
 ( Core(..)
 , rec

From 1e1bd838f3f4ae8bf7a428f7a31589bae723a13d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:10:02 -0500
Subject: [PATCH 238/318] Reformat the Core destructors using LambdaCase.

stylish-haskell is willing to leave these definitions alone.
---
 semantic-core/src/Core/Core.hs | 20 ++++++++++++--------
 1 file changed, 12 insertions(+), 8 deletions(-)

diff --git a/semantic-core/src/Core/Core.hs b/semantic-core/src/Core/Core.hs
index dec0c7af8..921e1056d 100644
--- a/semantic-core/src/Core/Core.hs
+++ b/semantic-core/src/Core/Core.hs
@@ -132,8 +132,9 @@ a >>> b = send (a :>> b)
 infixr 1 >>>
 
 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
+unseq = \case
+  Alg sig | Just (a :>> b) <- prj sig -> pure (a, b)
+  _                                   -> empty
 
 unseqs :: Project Core sig => Term sig a -> NonEmpty (Term sig a)
 unseqs = go
@@ -149,8 +150,9 @@ Named u n :<- a >>>= b = send (Named u a :>>= abstract1 n b)
 infixr 1 >>>=
 
 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
+unbind n = \case
+  Alg sig | Just (Named u a :>>= b) <- prj sig -> pure (Named u n :<- a, instantiate1 (pure n) b)
+  _                                            -> empty
 
 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
@@ -178,8 +180,9 @@ 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, 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
+unlam n = \case
+  Alg sig | Just (Lam b) <- prj sig -> pure (n <$ b, instantiate1 (pure n) (namedValue b))
+  _                                 -> empty
 
 ($$) :: Has Core sig m => m a -> m a -> m a
 f $$ a = send (f :$ a)
@@ -193,8 +196,9 @@ infixl 8 $$
 infixl 8 $$*
 
 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
+unapply = \case
+  Alg sig | Just (f :$ a) <- prj sig -> pure (f, a)
+  _                                  -> empty
 
 unapplies :: Project Core sig => Term sig a -> (Term sig a, Stack (Term sig a))
 unapplies core = case unapply core of

From 1828a1a43387a08052345fc9722becbe479475c9 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:22:16 -0500
Subject: [PATCH 239/318] =?UTF-8?q?Use=20Analysis.Intro=20in=20Core?=
 =?UTF-8?q?=E2=80=99s=20syntax.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 semantic-analysis/src/Analysis/Intro.hs | 15 +++++++
 semantic-core/src/Core/Core.hs          | 56 +------------------------
 semantic-core/src/Core/Eval.hs          | 12 +++---
 3 files changed, 23 insertions(+), 60 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Intro.hs b/semantic-analysis/src/Analysis/Intro.hs
index 440f177e3..90808fe2c 100644
--- a/semantic-analysis/src/Analysis/Intro.hs
+++ b/semantic-analysis/src/Analysis/Intro.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE StandaloneDeriving #-}
 module Analysis.Intro
@@ -8,16 +10,21 @@ module Analysis.Intro
 , bool
 , string
 , lam
+, lams
+, unlam
 , record
 ) where
 
 import Analysis.Name
 import Control.Algebra
+import Control.Applicative (Alternative (..))
 import Data.Text (Text)
 import GHC.Generics (Generic1)
 import Syntax.Foldable
 import Syntax.Module
 import Syntax.Scope
+import Syntax.Sum
+import Syntax.Term
 import Syntax.Traversable
 
 data Intro t a
@@ -58,6 +65,14 @@ string = send . String
 lam :: (Eq a, Has Intro 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, Has Intro sig m) => t (Named a) -> m a -> m a
+lams names body = foldr lam body names
+
+unlam :: (Alternative m, Project Intro sig, RightModule sig) => a -> Term sig a -> m (Named a, Term sig a)
+unlam n = \case
+  Alg sig | Just (Lam b) <- prj sig -> pure (n <$ b, instantiate1 (pure n) (namedValue b))
+  _                                 -> empty
+
 
 record :: Has Intro sig m => [(Name, m a)] -> m a
 record = send . Record
diff --git a/semantic-core/src/Core/Core.hs b/semantic-core/src/Core/Core.hs
index 921e1056d..20d6d8e47 100644
--- a/semantic-core/src/Core/Core.hs
+++ b/semantic-core/src/Core/Core.hs
@@ -23,23 +23,16 @@ module Core.Core
 , do'
 , unstatements
 , (:<-)(..)
-, lam
-, lams
-, unlam
 , ($$)
 , ($$*)
 , unapply
 , unapplies
 , if'
 , load
-, record
 , (...)
 , (.?)
 , (.=)
-, Intro(..)
-, unit
-, bool
-, string
+, module Analysis.Intro
 , Ann(..)
 , ann
 , annAt
@@ -48,6 +41,7 @@ module Core.Core
 , stripAnnotations
 ) where
 
+import Analysis.Intro
 import Control.Algebra
 import Control.Applicative (Alternative (..))
 import Core.Name
@@ -55,7 +49,6 @@ import Data.Bifunctor (Bifunctor (..))
 import Data.Foldable (foldl')
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Maybe (fromMaybe, listToMaybe)
-import Data.Text (Text)
 import GHC.Generics (Generic1)
 import GHC.Stack
 import Source.Span
@@ -78,14 +71,11 @@ data Core f a
   --
   --   Bindings made with :>>= are sequential, i.e. the name is not bound within the value, only within the consequence.
   | Named (f a) :>>= Scope () f a
-  | Lam (Named (Scope () f a))
   -- | Function application; analogous to '$'.
   | f a :$ f a
   | If (f a) (f a) (f a)
   -- | Load the specified file (by path).
   | Load (f a)
-  -- | A record mapping some keys to some values.
-  | Record [(Name, f a)]
   -- | Projection from a record.
   | f a :. Name
   -- | Projection of a record, with failure.
@@ -108,11 +98,9 @@ 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)
   If c t e   >>=* f = If (c >>= f) (t >>= f) (e >>= f)
   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)
@@ -173,17 +161,6 @@ instance Bifunctor (:<-) where
   bimap f g (a :<- b) = f a :<- g b
 
 
-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, Has Core sig m) => t (Named a) -> m a -> m a
-lams names body = foldr lam body names
-
-unlam :: (Alternative m, Project Core sig, RightModule sig) => a -> Term sig a -> m (Named a, Term sig a)
-unlam n = \case
-  Alg sig | Just (Lam b) <- prj sig -> pure (n <$ b, instantiate1 (pure n) (namedValue b))
-  _                                 -> empty
-
 ($$) :: Has Core sig m => m a -> m a -> m a
 f $$ a = send (f :$ a)
 
@@ -211,9 +188,6 @@ if' c t e = send (If c t e)
 load :: Has Core sig m => m a -> m a
 load = send . Load
 
-record :: Has Core sig m => [(Name, m a)] -> m a
-record fs = send (Record fs)
-
 (...) :: Has Core sig m => m a -> Name -> m a
 a ... b = send (a :. b)
 
@@ -230,32 +204,6 @@ a .= b = send (a := b)
 infix 3 .=
 
 
-data Intro (f :: * -> *) a
-  = Unit
-  | Bool Bool
-  | String Text
-  deriving (Eq, Foldable, Functor, Generic1, Ord, Show, Traversable)
-
-instance HFunctor Intro
-instance HFoldable Intro
-instance HTraversable Intro
-
-instance RightModule Intro where
-  Unit     >>=* _ = Unit
-  Bool b   >>=* _ = Bool b
-  String s >>=* _ = String s
-
-
-unit :: Has Intro sig m => m a
-unit = send Unit
-
-bool :: Has Intro sig m => Bool -> m a
-bool = send . Bool
-
-string :: Has Intro sig m => Text -> m a
-string = send . String
-
-
 data Ann ann f a
   = Ann ann (f a)
   deriving (Eq, Foldable, Functor, Generic1, Ord, Show, Traversable)
diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index bc8f4c0fb..6564077fd 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -66,7 +66,6 @@ eval eval = \case
       addr <- A.alloc @address n
       A.assign addr a'
       A.bind n addr ((a' <>) <$> eval (instantiate1 (pure addr) b))
-    Lam (Named n b) -> A.lam (Named n b)
     f :$ a -> do
       Named n b <- eval f >>= asLam
       a' <- eval a
@@ -77,7 +76,6 @@ eval eval = \case
       c' <- eval c >>= A.asBool @Term @address
       if c' then eval t else eval e
     Load p -> eval p >>= A.asString @Term @address >> A.unit @Term @address -- FIXME: add a load command or something
-    Record fields -> A.record fields
     a :. b -> do
       a' <- eval a >>= asRecord @Term @address
       maybe (freeVariable (show b)) eval (lookup b a')
@@ -90,9 +88,11 @@ eval eval = \case
       addr <- ref a
       b' <$ A.assign addr b'
   Term.Alg (R (R c)) -> case c of
-    Unit     -> A.unit @Term @address
-    Bool b   -> A.bool @Term @address b
-    String s -> A.string @Term @address s
+    Unit            -> A.unit @Term @address
+    Bool b          -> A.bool @Term @address b
+    String s        -> A.string @Term @address s
+    Lam (Named n b) -> A.lam (Named n b)
+    Record fields   -> A.record fields
   Term.Alg (L (Ann span c)) -> local (const span) (eval c)
   where freeVariable s = fail ("free variable: " <> s)
         uninitialized s = fail ("uninitialized variable: " <> s)
@@ -124,7 +124,7 @@ prog1 = fromBody $ Core.lam (named' "foo")
 prog2 :: (Has Core sig t, Has Intro sig t) => File (t Name)
 prog2 = fromBody $ fileBody prog1 $$ Core.bool True
 
-prog3 :: Has Core sig t => File (t Name)
+prog3 :: (Has Core sig t, Has Intro sig t) => File (t Name)
 prog3 = fromBody $ lams [named' "foo", named' "bar", named' "quux"]
   (Core.if' (pure "quux")
     (pure "bar")

From 58f6298ee4ff8ae7dd65be3071b129a2bc9edfc2 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:23:07 -0500
Subject: [PATCH 240/318] =?UTF-8?q?Revert=20"Use=20Analysis.Intro=20in=20C?=
 =?UTF-8?q?ore=E2=80=99s=20syntax."?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This reverts commit 1828a1a43387a08052345fc9722becbe479475c9.
---
 semantic-analysis/src/Analysis/Intro.hs | 15 -------
 semantic-core/src/Core/Core.hs          | 56 ++++++++++++++++++++++++-
 semantic-core/src/Core/Eval.hs          | 12 +++---
 3 files changed, 60 insertions(+), 23 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Intro.hs b/semantic-analysis/src/Analysis/Intro.hs
index 90808fe2c..440f177e3 100644
--- a/semantic-analysis/src/Analysis/Intro.hs
+++ b/semantic-analysis/src/Analysis/Intro.hs
@@ -1,7 +1,5 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE StandaloneDeriving #-}
 module Analysis.Intro
@@ -10,21 +8,16 @@ module Analysis.Intro
 , bool
 , string
 , lam
-, lams
-, unlam
 , record
 ) where
 
 import Analysis.Name
 import Control.Algebra
-import Control.Applicative (Alternative (..))
 import Data.Text (Text)
 import GHC.Generics (Generic1)
 import Syntax.Foldable
 import Syntax.Module
 import Syntax.Scope
-import Syntax.Sum
-import Syntax.Term
 import Syntax.Traversable
 
 data Intro t a
@@ -65,14 +58,6 @@ string = send . String
 lam :: (Eq a, Has Intro 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, Has Intro sig m) => t (Named a) -> m a -> m a
-lams names body = foldr lam body names
-
-unlam :: (Alternative m, Project Intro sig, RightModule sig) => a -> Term sig a -> m (Named a, Term sig a)
-unlam n = \case
-  Alg sig | Just (Lam b) <- prj sig -> pure (n <$ b, instantiate1 (pure n) (namedValue b))
-  _                                 -> empty
-
 
 record :: Has Intro sig m => [(Name, m a)] -> m a
 record = send . Record
diff --git a/semantic-core/src/Core/Core.hs b/semantic-core/src/Core/Core.hs
index 20d6d8e47..921e1056d 100644
--- a/semantic-core/src/Core/Core.hs
+++ b/semantic-core/src/Core/Core.hs
@@ -23,16 +23,23 @@ module Core.Core
 , do'
 , unstatements
 , (:<-)(..)
+, lam
+, lams
+, unlam
 , ($$)
 , ($$*)
 , unapply
 , unapplies
 , if'
 , load
+, record
 , (...)
 , (.?)
 , (.=)
-, module Analysis.Intro
+, Intro(..)
+, unit
+, bool
+, string
 , Ann(..)
 , ann
 , annAt
@@ -41,7 +48,6 @@ module Core.Core
 , stripAnnotations
 ) where
 
-import Analysis.Intro
 import Control.Algebra
 import Control.Applicative (Alternative (..))
 import Core.Name
@@ -49,6 +55,7 @@ import Data.Bifunctor (Bifunctor (..))
 import Data.Foldable (foldl')
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Maybe (fromMaybe, listToMaybe)
+import Data.Text (Text)
 import GHC.Generics (Generic1)
 import GHC.Stack
 import Source.Span
@@ -71,11 +78,14 @@ data Core f a
   --
   --   Bindings made with :>>= are sequential, i.e. the name is not bound within the value, only within the consequence.
   | Named (f a) :>>= Scope () f a
+  | Lam (Named (Scope () f a))
   -- | Function application; analogous to '$'.
   | f a :$ f a
   | If (f a) (f a) (f a)
   -- | Load the specified file (by path).
   | Load (f a)
+  -- | A record mapping some keys to some values.
+  | Record [(Name, f a)]
   -- | Projection from a record.
   | f a :. Name
   -- | Projection of a record, with failure.
@@ -98,9 +108,11 @@ 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)
   If c t e   >>=* f = If (c >>= f) (t >>= f) (e >>= f)
   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)
@@ -161,6 +173,17 @@ instance Bifunctor (:<-) where
   bimap f g (a :<- b) = f a :<- g b
 
 
+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, Has Core sig m) => t (Named a) -> m a -> m a
+lams names body = foldr lam body names
+
+unlam :: (Alternative m, Project Core sig, RightModule sig) => a -> Term sig a -> m (Named a, Term sig a)
+unlam n = \case
+  Alg sig | Just (Lam b) <- prj sig -> pure (n <$ b, instantiate1 (pure n) (namedValue b))
+  _                                 -> empty
+
 ($$) :: Has Core sig m => m a -> m a -> m a
 f $$ a = send (f :$ a)
 
@@ -188,6 +211,9 @@ if' c t e = send (If c t e)
 load :: Has Core sig m => m a -> m a
 load = send . Load
 
+record :: Has Core sig m => [(Name, m a)] -> m a
+record fs = send (Record fs)
+
 (...) :: Has Core sig m => m a -> Name -> m a
 a ... b = send (a :. b)
 
@@ -204,6 +230,32 @@ a .= b = send (a := b)
 infix 3 .=
 
 
+data Intro (f :: * -> *) a
+  = Unit
+  | Bool Bool
+  | String Text
+  deriving (Eq, Foldable, Functor, Generic1, Ord, Show, Traversable)
+
+instance HFunctor Intro
+instance HFoldable Intro
+instance HTraversable Intro
+
+instance RightModule Intro where
+  Unit     >>=* _ = Unit
+  Bool b   >>=* _ = Bool b
+  String s >>=* _ = String s
+
+
+unit :: Has Intro sig m => m a
+unit = send Unit
+
+bool :: Has Intro sig m => Bool -> m a
+bool = send . Bool
+
+string :: Has Intro sig m => Text -> m a
+string = send . String
+
+
 data Ann ann f a
   = Ann ann (f a)
   deriving (Eq, Foldable, Functor, Generic1, Ord, Show, Traversable)
diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index 6564077fd..bc8f4c0fb 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -66,6 +66,7 @@ eval eval = \case
       addr <- A.alloc @address n
       A.assign addr a'
       A.bind n addr ((a' <>) <$> eval (instantiate1 (pure addr) b))
+    Lam (Named n b) -> A.lam (Named n b)
     f :$ a -> do
       Named n b <- eval f >>= asLam
       a' <- eval a
@@ -76,6 +77,7 @@ eval eval = \case
       c' <- eval c >>= A.asBool @Term @address
       if c' then eval t else eval e
     Load p -> eval p >>= A.asString @Term @address >> A.unit @Term @address -- FIXME: add a load command or something
+    Record fields -> A.record fields
     a :. b -> do
       a' <- eval a >>= asRecord @Term @address
       maybe (freeVariable (show b)) eval (lookup b a')
@@ -88,11 +90,9 @@ eval eval = \case
       addr <- ref a
       b' <$ A.assign addr b'
   Term.Alg (R (R c)) -> case c of
-    Unit            -> A.unit @Term @address
-    Bool b          -> A.bool @Term @address b
-    String s        -> A.string @Term @address s
-    Lam (Named n b) -> A.lam (Named n b)
-    Record fields   -> A.record fields
+    Unit     -> A.unit @Term @address
+    Bool b   -> A.bool @Term @address b
+    String s -> A.string @Term @address s
   Term.Alg (L (Ann span c)) -> local (const span) (eval c)
   where freeVariable s = fail ("free variable: " <> s)
         uninitialized s = fail ("uninitialized variable: " <> s)
@@ -124,7 +124,7 @@ prog1 = fromBody $ Core.lam (named' "foo")
 prog2 :: (Has Core sig t, Has Intro sig t) => File (t Name)
 prog2 = fromBody $ fileBody prog1 $$ Core.bool True
 
-prog3 :: (Has Core sig t, Has Intro sig t) => 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")

From 50933159aa58ea433b1041ca444ebf67266873ba Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:26:30 -0500
Subject: [PATCH 241/318] Revert "Extract the basic introduction forms into a
 new syntax type."

This reverts commit ff4523e25efa6ae1610c2b042a0aa93eac182f6c.
---
 semantic-core/src/Core/Core.hs              | 50 ++++++++-------------
 semantic-core/src/Core/Eval.hs              | 26 +++++------
 semantic-python/src/Language/Python/Core.hs |  6 +--
 3 files changed, 33 insertions(+), 49 deletions(-)

diff --git a/semantic-core/src/Core/Core.hs b/semantic-core/src/Core/Core.hs
index 921e1056d..95609be7c 100644
--- a/semantic-core/src/Core/Core.hs
+++ b/semantic-core/src/Core/Core.hs
@@ -30,16 +30,15 @@ module Core.Core
 , ($$*)
 , unapply
 , unapplies
+, unit
+, bool
 , if'
+, string
 , load
 , record
 , (...)
 , (.?)
 , (.=)
-, Intro(..)
-, unit
-, bool
-, string
 , Ann(..)
 , ann
 , annAt
@@ -81,7 +80,10 @@ data Core f a
   | Lam (Named (Scope () f a))
   -- | Function application; analogous to '$'.
   | f a :$ f a
+  | Unit
+  | Bool Bool
   | If (f a) (f a) (f a)
+  | String Text
   -- | Load the specified file (by path).
   | Load (f a)
   -- | A record mapping some keys to some values.
@@ -110,7 +112,10 @@ instance RightModule Core where
   (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
@@ -157,7 +162,7 @@ unbind n = \case
 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, Has Core sig m, Has Intro sig m) => 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
 
@@ -205,9 +210,18 @@ unapplies core = case unapply core of
   Just (f, a) -> (:> a) <$> unapplies f
   Nothing     -> (core, Nil)
 
+unit :: Has Core sig m => m a
+unit = send Unit
+
+bool :: Has Core sig m => Bool -> m a
+bool = send . Bool
+
 if' :: Has Core sig m => m a -> m a -> m a -> m a
 if' c t e = send (If c t e)
 
+string :: Has Core sig m => Text -> m a
+string = send . String
+
 load :: Has Core sig m => m a -> m a
 load = send . Load
 
@@ -230,32 +244,6 @@ a .= b = send (a := b)
 infix 3 .=
 
 
-data Intro (f :: * -> *) a
-  = Unit
-  | Bool Bool
-  | String Text
-  deriving (Eq, Foldable, Functor, Generic1, Ord, Show, Traversable)
-
-instance HFunctor Intro
-instance HFoldable Intro
-instance HTraversable Intro
-
-instance RightModule Intro where
-  Unit     >>=* _ = Unit
-  Bool b   >>=* _ = Bool b
-  String s >>=* _ = String s
-
-
-unit :: Has Intro sig m => m a
-unit = send Unit
-
-bool :: Has Intro sig m => Bool -> m a
-bool = send . Bool
-
-string :: Has Intro sig m => Text -> m a
-string = send . String
-
-
 data Ann ann f a
   = Ann ann (f a)
   deriving (Eq, Foldable, Functor, Generic1, Ord, Show, Traversable)
diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index bc8f4c0fb..b25662a0e 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -37,7 +37,7 @@ import           Syntax.Scope
 import qualified Syntax.Term as Term
 import qualified System.Path as Path
 
-type Term = Term.Term (Ann Span :+: Core :+: Intro)
+type Term = Term.Term (Ann Span :+: Core)
 
 eval :: forall address value m sig
      .  ( Has (Domain Term address value) sig m
@@ -52,7 +52,7 @@ eval :: forall address value m sig
      -> (Term address -> m value)
 eval eval = \case
   Term.Var n -> deref' n n
-  Term.Alg (R (L c)) -> case c of
+  Term.Alg (R c) -> case c of
     Rec (Named n b) -> do
       addr <- A.alloc @address n
       v <- A.bind n addr (eval (instantiate1 (pure addr) b))
@@ -77,6 +77,9 @@ eval eval = \case
       c' <- eval c >>= A.asBool @Term @address
       if c' then eval t else eval e
     Load p -> eval p >>= A.asString @Term @address >> A.unit @Term @address -- FIXME: add a load command or something
+    Unit     -> A.unit @Term @address
+    Bool b   -> A.bool @Term @address b
+    String s -> A.string @Term @address s
     Record fields -> A.record fields
     a :. b -> do
       a' <- eval a >>= asRecord @Term @address
@@ -89,10 +92,6 @@ eval eval = \case
       b' <- eval b
       addr <- ref a
       b' <$ A.assign addr b'
-  Term.Alg (R (R c)) -> case c of
-    Unit     -> A.unit @Term @address
-    Bool b   -> A.bool @Term @address b
-    String s -> A.string @Term @address s
   Term.Alg (L (Ann span c)) -> local (const span) (eval c)
   where freeVariable s = fail ("free variable: " <> s)
         uninitialized s = fail ("uninitialized variable: " <> s)
@@ -102,7 +101,7 @@ eval eval = \case
 
         ref = \case
           Term.Var n -> pure n
-          Term.Alg (R (L c)) -> case c of
+          Term.Alg (R c) -> case c of
             If c t e -> do
               c' <- eval c >>= A.asBool @Term @address
               if c' then ref t else ref e
@@ -110,18 +109,17 @@ eval eval = \case
               a' <- eval a >>= asRecord @Term @address
               maybe (freeVariable (show b)) ref (lookup b a')
             c -> invalidRef (show c)
-          Term.Alg (R (R c)) -> invalidRef (show c)
           Term.Alg (L (Ann span c)) -> local (const span) (ref c)
 
 
-prog1 :: (Has Core sig t, Has Intro sig t) => File (t Name)
+prog1 :: Has Core sig t => File (t Name)
 prog1 = fromBody $ Core.lam (named' "foo")
   (    named' "bar" :<- pure "foo"
   >>>= Core.if' (pure "bar")
     (Core.bool False)
     (Core.bool True))
 
-prog2 :: (Has Core sig t, Has Intro sig t) => File (t Name)
+prog2 :: Has Core sig t => File (t Name)
 prog2 = fromBody $ fileBody prog1 $$ Core.bool True
 
 prog3 :: Has Core sig t => File (t Name)
@@ -130,14 +128,14 @@ prog3 = fromBody $ lams [named' "foo", named' "bar", named' "quux"]
     (pure "bar")
     (pure "foo"))
 
-prog4 :: (Has Core sig t, Has Intro sig t) => 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 :: (Has (Ann Span) sig t, Has Core sig t, Has Intro sig t) => File (t Name)
+prog5 :: (Has (Ann Span) sig t, Has Core sig t) => File (t Name)
 prog5 = fromBody $ ann (do'
   [ Just (named' "mkPoint") :<- lams [named' "_x", named' "_y"] (ann (Core.record
     [ ("x", ann (pure "_x"))
@@ -148,7 +146,7 @@ prog5 = fromBody $ ann (do'
   , Nothing :<- ann (ann (pure "point") Core.... "y") .= ann (ann (pure "point") Core.... "x")
   ])
 
-prog6 :: (Has Core sig t, Has Intro sig t) => [File (t Name)]
+prog6 :: Has Core sig t => [File (t Name)]
 prog6 =
   [ (fromBody (Core.record
     [ ("dep", Core.record [ ("var", Core.bool True) ]) ]))
@@ -160,7 +158,7 @@ prog6 =
     { filePath = Path.absRel "main" }
   ]
 
-ruby :: (Has (Ann Span) sig t, Has Core sig t, Has Intro sig t) => File (t Name)
+ruby :: (Has (Ann Span) sig t, Has Core sig t) => File (t Name)
 ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (do' statements))
   where statements =
           [ Just "Class" :<- record
diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs
index 51a6eab56..f3ca48783 100644
--- a/semantic-python/src/Language/Python/Core.hs
+++ b/semantic-python/src/Language/Python/Core.hs
@@ -52,7 +52,6 @@ pattern SingleIdentifier name <- Py.ExpressionList
 type CoreSyntax sig t = ( Has Core sig t
                         , Has (Ann Span) sig t
                         , Has Failure sig t
-                        , Has Intro sig t
                         , Foldable t
                         )
 
@@ -76,7 +75,7 @@ toplevelCompile py = compile py pure none
 
 -- | TODO: This is not right, it should be a reference to a Preluded
 -- NoneType instance, but it will do for now.
-none :: Has Intro sig t => t Name
+none :: Has Core sig t => t Name
 none = unit
 
 locate :: ( HasField "ann" syntax Span
@@ -193,8 +192,7 @@ instance Compile Py.Call where
 
 instance Compile Py.ClassDefinition where
   compile it@Py.ClassDefinition { body = pybody, name = Py.Identifier _ann (Name -> n) } cc next = do
-    let buildTypeCall :: (Has Core syn t, Has Intro syn t, Has (Reader Bindings) sig m) => w -> m (t Name)
-        buildTypeCall _ = do
+    let buildTypeCall _ = do
           bindings <- asks @Bindings (toList . unBindings)
           let buildName n = (n, pure n)
               contents = record . fmap buildName $ bindings

From 7c9c5f0dce757ce038db2d2d37cd995ddb990754 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:30:20 -0500
Subject: [PATCH 242/318] Declare the dependency on transformers.

---
 semantic-analysis/semantic-analysis.cabal | 1 +
 1 file changed, 1 insertion(+)

diff --git a/semantic-analysis/semantic-analysis.cabal b/semantic-analysis/semantic-analysis.cabal
index 5de05c452..ed1200206 100644
--- a/semantic-analysis/semantic-analysis.cabal
+++ b/semantic-analysis/semantic-analysis.cabal
@@ -70,3 +70,4 @@ library
     , semantic-source             ^>= 0
     , terminal-size               ^>= 0.3
     , text                        ^>= 1.2.3.1
+    , transformers                ^>= 0.5

From 537f3c38da73df7280fc4319d1487000be15c827 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:44:02 -0500
Subject: [PATCH 243/318] Move the cabal build call into script/repl.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Doing it in script/ghci-flags means it has to be silent, which is super confusing/surprising.

Doing it in script/repl means we can see what it’s up to.
---
 script/ghci-flags | 3 ---
 script/repl       | 3 +++
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/script/ghci-flags b/script/ghci-flags
index 34e3b145f..62753c5bd 100755
--- a/script/ghci-flags
+++ b/script/ghci-flags
@@ -10,9 +10,6 @@ ghc_version="$(ghc --numeric-version)"
 # recent hie-bios requires us to output to the file at $HIE_BIOS_OUTPUT, but older builds & script/repl don’t set that var, so we default it to stdout
 output_file="${HIE_BIOS_OUTPUT:-/dev/stdout}"
 
-# do a build of dependencies up front to ensure they’re all available
-cabal v2-build -v0 all --only-dependencies
-
 build_products_dir="dist-newstyle/build/x86_64-osx/ghc-$ghc_version/build-repl"
 
 function flags {
diff --git a/script/repl b/script/repl
index 668f14d30..e3f51b6e6 100755
--- a/script/repl
+++ b/script/repl
@@ -6,5 +6,8 @@ set -e
 
 cd "$(dirname "$0")/.."
 
+# do a build of dependencies up front to ensure they’re all available
+cabal v2-build all --only-dependencies
+
 # exec ghci with the appropriate flags, and without the $GHC_ENVIRONMENT variable interfering
 cabal v2-exec env -- -u GHC_ENVIRONMENT ghci -ghci-script=.ghci.repl $(script/ghci-flags) -no-ignore-dot-ghci $@

From 935fe94381a03f9ee180921695a2a179ff6eaeb2 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:44:16 -0500
Subject: [PATCH 244/318] =?UTF-8?q?Build=20the=20tests=E2=80=99=20dependen?=
 =?UTF-8?q?cies.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 script/repl | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/script/repl b/script/repl
index e3f51b6e6..d579772e9 100755
--- a/script/repl
+++ b/script/repl
@@ -7,7 +7,7 @@ set -e
 cd "$(dirname "$0")/.."
 
 # do a build of dependencies up front to ensure they’re all available
-cabal v2-build all --only-dependencies
+cabal v2-build all --enable-tests --only-dependencies
 
 # exec ghci with the appropriate flags, and without the $GHC_ENVIRONMENT variable interfering
 cabal v2-exec env -- -u GHC_ENVIRONMENT ghci -ghci-script=.ghci.repl $(script/ghci-flags) -no-ignore-dot-ghci $@

From a45de1303437f451d1191aad8c4a7568cbefa1d9 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:44:28 -0500
Subject: [PATCH 245/318] =?UTF-8?q?Build=20the=20benchmarks=E2=80=99=20dep?=
 =?UTF-8?q?endencies.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 script/repl | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/script/repl b/script/repl
index d579772e9..389a07cf0 100755
--- a/script/repl
+++ b/script/repl
@@ -7,7 +7,7 @@ set -e
 cd "$(dirname "$0")/.."
 
 # do a build of dependencies up front to ensure they’re all available
-cabal v2-build all --enable-tests --only-dependencies
+cabal v2-build all --enable-benchmarks --enable-tests --only-dependencies
 
 # exec ghci with the appropriate flags, and without the $GHC_ENVIRONMENT variable interfering
 cabal v2-exec env -- -u GHC_ENVIRONMENT ghci -ghci-script=.ghci.repl $(script/ghci-flags) -no-ignore-dot-ghci $@

From c04c59d772f766f7a566167e5b6d7b022574d186 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:47:17 -0500
Subject: [PATCH 246/318] Fix the semantic-python test build.

---
 semantic-python/test/Directive.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/semantic-python/test/Directive.hs b/semantic-python/test/Directive.hs
index 83634e235..54ee36633 100644
--- a/semantic-python/test/Directive.hs
+++ b/semantic-python/test/Directive.hs
@@ -58,7 +58,7 @@ projects.
 -}
 data Directive = JQ ByteString -- | @# CHECK-JQ: expr@
                | Tree (Term Core Name) -- | @# CHECK-TREE: core@
-               | Result Text (Concrete (Term (Core.Ann Source.Span :+: Core)) Name) -- | @# CHECK-RESULT key: expected
+               | Result Text (Concrete (Term (Core.Ann Source.Span :+: Core))) -- | @# CHECK-RESULT key: expected
                | Fails -- | @# CHECK-FAILS@ fails unless translation fails.
                  deriving (Eq, Show)
 
@@ -104,7 +104,7 @@ result = do
   void $ Trifecta.symbolic ':'
   Result key <$> concrete
 
-concrete :: TokenParsing m => m (Concrete term Name)
+concrete :: TokenParsing m => m (Concrete term)
 concrete = Trifecta.choice
   [ String <$> Trifecta.stringLiteral
   , Bool True <$ Trifecta.symbol "#true"

From 38215571c190f4afef833d739e90757c617d775f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:55:50 -0500
Subject: [PATCH 247/318] Fix a couple of instances.

---
 semantic-python/test/Instances.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/semantic-python/test/Instances.hs b/semantic-python/test/Instances.hs
index 857f0f7b8..112908618 100644
--- a/semantic-python/test/Instances.hs
+++ b/semantic-python/test/Instances.hs
@@ -35,7 +35,7 @@ instance ToJSON Ref where
     , "span" .= span
     ]
 
-instance ToJSON (Decl Name) where
+instance ToJSON Decl where
   toJSON Decl{declSymbol, declPath, declSpan} = object
     [ "kind"   .= ("decl" :: Text)
     , "symbol" .= declSymbol
@@ -43,5 +43,5 @@ instance ToJSON (Decl Name) where
     , "span" .= declSpan
     ]
 
-instance ToJSON (ScopeGraph Name) where
+instance ToJSON ScopeGraph where
   toJSON (ScopeGraph sc) = toJSON . Map.mapKeys declSymbol $ sc

From f305c38228fd4bd9d72347586e14ff8f820d15f8 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:56:51 -0500
Subject: [PATCH 248/318] =?UTF-8?q?Add=20semantic-python=E2=80=99s=20tests?=
 =?UTF-8?q?=20to=20the=20load=20paths.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 script/ghci-flags | 1 +
 1 file changed, 1 insertion(+)

diff --git a/script/ghci-flags b/script/ghci-flags
index 62753c5bd..dd9636bfe 100755
--- a/script/ghci-flags
+++ b/script/ghci-flags
@@ -40,6 +40,7 @@ function flags {
   echo "-isemantic-java/src"
   echo "-isemantic-json/src"
   echo "-isemantic-python/src"
+  echo "-isemantic-python/test"
   echo "-isemantic-ruby/src"
   echo "-isemantic-tags/src"
   echo "-iapp"

From 8894d73bbb99eb82ba6d558b4fd459d2ca36594e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 10:57:33 -0500
Subject: [PATCH 249/318] Correct a type signature.

---
 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 2931598d4..7ffc2983a 100644
--- a/semantic-python/test/Test.hs
+++ b/semantic-python/test/Test.hs
@@ -88,7 +88,7 @@ assertJQExpressionSucceeds directive tree core = do
     HUnit.assertFailure (unlines [errorMsg, dirMsg, jsonMsg, astMsg, treeMsg, treeMsg', show err])
 
 -- handles CHECK-RESULT directives
-assertEvaluatesTo :: Term (Ann Span :+: Core) Name -> Text -> Concrete (Term (Ann Span :+: Core)) Name -> HUnit.Assertion
+assertEvaluatesTo :: Term (Ann Span :+: Core) Name -> Text -> Concrete (Term (Ann Span :+: Core)) -> HUnit.Assertion
 assertEvaluatesTo core k val = do
   prelude <- parsePrelude
   let allTogether = (named' "__semantic_prelude" :<- prelude) >>>= core

From 540b88c5a048b6b753fed2c857e753850cac6baf Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 11:04:42 -0500
Subject: [PATCH 250/318] Evaluate closed terms.

---
 semantic-python/test/Test.hs | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/semantic-python/test/Test.hs b/semantic-python/test/Test.hs
index 7ffc2983a..60f0cdc3f 100644
--- a/semantic-python/test/Test.hs
+++ b/semantic-python/test/Test.hs
@@ -37,6 +37,7 @@ import           Source.Span
 import           Streaming
 import qualified Streaming.Process
 import           Syntax.Term
+import           Syntax.Var (closed)
 import           System.Directory
 import           System.Exit
 import           System.Path ((</>))
@@ -91,7 +92,8 @@ assertJQExpressionSucceeds directive tree core = do
 assertEvaluatesTo :: Term (Ann Span :+: Core) Name -> Text -> Concrete (Term (Ann Span :+: Core)) -> HUnit.Assertion
 assertEvaluatesTo core k val = do
   prelude <- parsePrelude
-  let allTogether = (named' "__semantic_prelude" :<- prelude) >>>= core
+  let withPrelude = (named' "__semantic_prelude" :<- prelude) >>>= core
+  allTogether <- maybe (HUnit.assertFailure ("Can’t evaluate open term: " <> showCore (stripAnnotations withPrelude))) pure (closed withPrelude)
   let filius = [File (Path.absRel "<interactive>") (Span (Pos 1 1) (Pos 1 1)) allTogether]
 
   (heap, env) <- case Concrete.concrete Eval.eval filius of

From bfec95a992f26b9845806a8ec478986d7708e28f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 11:25:32 -0500
Subject: [PATCH 251/318] Correct the package id for the sample .ghci.

---
 .ghci.sample | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.ghci.sample b/.ghci.sample
index acf3ad9e9..8a1e7f506 100644
--- a/.ghci.sample
+++ b/.ghci.sample
@@ -1,7 +1,7 @@
 -- Consider copying this to your ~/.ghc/ghci.conf file:
 
 -- Pretty-printing
-:set -package-id prtty-smpl-3.1.0.0-b6696d88
+:set -package-id prtty-smpl-3.1.1.0-c89f0500
 :set -interactive-print Text.Pretty.Simple.pPrint
 
 -- Turn on some language extensions you use a lot

From f78d90aaaebec5446a91fee795ac6ad27d798c7e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 11:43:15 -0500
Subject: [PATCH 252/318] Remove the CHECK-JQ directive.

---
 semantic-python/test/Directive.hs             | 26 +++-----------
 semantic-python/test/Instances.hs             | 22 +-----------
 semantic-python/test/Test.hs                  | 36 -------------------
 .../test/fixtures/1-01-empty-module.py        |  1 -
 .../test/fixtures/1-02-pass-statement.py      |  1 -
 .../test/fixtures/1-04-toplevel-assignment.py |  1 -
 .../test/fixtures/2-07-closure-over-scope.py  |  2 --
 7 files changed, 6 insertions(+), 83 deletions(-)

diff --git a/semantic-python/test/Directive.hs b/semantic-python/test/Directive.hs
index 54ee36633..6725cdc3f 100644
--- a/semantic-python/test/Directive.hs
+++ b/semantic-python/test/Directive.hs
@@ -4,12 +4,10 @@
 module Directive ( Directive (..)
                  , readDirectivesFromFile
                  , describe
-                 , toProcess
                  ) where
 
 import           Analysis.Concrete (Concrete (..))
 import           Control.Algebra
-import           Control.Applicative
 import           Control.Monad
 import           Control.Monad.Trans.Resource (ResourceT, runResourceT)
 import           Core.Core (Core)
@@ -27,7 +25,6 @@ import qualified Streaming.Prelude as Stream
 import           Syntax.Term (Term)
 import qualified System.Path as Path
 import qualified System.Path.PartClass as Path.Class
-import           System.Process
 import qualified Text.Parser.Token.Style as Style
 import           Text.Trifecta (CharParsing, TokenParsing (..))
 import qualified Text.Trifecta as Trifecta
@@ -39,13 +36,11 @@ describe to the test suite how to query the results of a given test
 case. A directive that looks like this:
 
 @
-  # CHECK-JQ: has("mach")
+  # CHECK-RESULT: key: value
 @
 
-would, after converting the contents of the file to a Core expression,
-dump that expression to JSON and pipe said JSON to @jq -e
-'has("mach")@, which will return an error code unless the passed JSON
-is a hash containing the @"mach"@ key.
+would test that the value for @key@ in the result evaluates to the given
+concrete value.
 
 This syntax was inspired by LLVM's
 [FileCheck](https://llvm.org/docs/CommandGuide/FileCheck.html). This
@@ -56,8 +51,7 @@ significantly and has been a successful strategy for the LLVM and Rust
 projects.
 
 -}
-data Directive = JQ ByteString -- | @# CHECK-JQ: expr@
-               | Tree (Term Core Name) -- | @# CHECK-TREE: core@
+data Directive = Tree (Term Core Name) -- | @# CHECK-TREE: core@
                | Result Text (Concrete (Term (Core.Ann Source.Span :+: Core))) -- | @# CHECK-RESULT key: expected
                | Fails -- | @# CHECK-FAILS@ fails unless translation fails.
                  deriving (Eq, Show)
@@ -81,17 +75,11 @@ readDirectivesFromFile
 describe :: Directive -> String
 describe Fails        = "<expect failure>"
 describe (Tree t)     =  Core.Pretty.showCore t
-describe (JQ b)       = ByteString.unpack b
 describe (Result t e) = T.unpack t <> ": " <> show e
 
 fails :: CharParsing m => m Directive
 fails = Fails <$ Trifecta.string "# CHECK-FAILS"
 
-jq :: (Monad m, CharParsing m) => m Directive
-jq = do
-  void $ Trifecta.string "# CHECK-JQ: "
-  JQ . ByteString.pack <$> many (Trifecta.noneOf "\n")
-
 tree :: (Monad m, TokenParsing m) => m Directive
 tree = do
   void $ Trifecta.string "# CHECK-TREE: "
@@ -113,12 +101,8 @@ concrete = Trifecta.choice
   ]
 
 directive :: (Monad m, TokenParsing m) => m Directive
-directive = Trifecta.choice [ fails, result, jq, tree ]
+directive = Trifecta.choice [ fails, result, tree ]
 
 parseDirective :: ByteString -> Either String Directive
 parseDirective = Trifecta.foldResult (Left . show) Right
                . Trifecta.parseByteString (directive <* Trifecta.eof) mempty
-
-toProcess :: Directive -> CreateProcess
-toProcess (JQ d) = proc "jq" ["-e", ByteString.unpack d]
-toProcess x      = error ("can't call toProcess on " <> show x)
diff --git a/semantic-python/test/Instances.hs b/semantic-python/test/Instances.hs
index 112908618..0ba7abf06 100644
--- a/semantic-python/test/Instances.hs
+++ b/semantic-python/test/Instances.hs
@@ -8,11 +8,9 @@ module Instances () where
 -- we should keep track of them in a dedicated file.
 
 import           Analysis.File
-import           Analysis.ScopeGraph
 import           Core.Name (Name (..))
 import           Data.Aeson
-import qualified Data.Map as Map
-import           Data.Text (Text, pack)
+import           Data.Text (pack)
 import qualified System.Path as Path
 
 deriving newtype instance ToJSON Name
@@ -27,21 +25,3 @@ instance ToJSON a => ToJSON (File a) where
 
 instance ToJSON Path.AbsRelFile where
   toJSON p = toJSON (pack (Path.toString p))
-
-instance ToJSON Ref where
-  toJSON (Ref path span) = object
-    [ "kind" .= ("ref" :: Text)
-    , "path" .= path
-    , "span" .= span
-    ]
-
-instance ToJSON Decl where
-  toJSON Decl{declSymbol, declPath, declSpan} = object
-    [ "kind"   .= ("decl" :: Text)
-    , "symbol" .= declSymbol
-    , "path" .= declPath
-    , "span" .= declSpan
-    ]
-
-instance ToJSON ScopeGraph where
-  toJSON (ScopeGraph sc) = toJSON . Map.mapKeys declSymbol $ sc
diff --git a/semantic-python/test/Test.hs b/semantic-python/test/Test.hs
index 60f0cdc3f..2e402ad66 100644
--- a/semantic-python/test/Test.hs
+++ b/semantic-python/test/Test.hs
@@ -5,23 +5,17 @@ module Main (main) where
 import           Analysis.Concrete (Concrete)
 import qualified Analysis.Concrete as Concrete
 import           Analysis.File
-import           Analysis.ScopeGraph
 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
 import           Core.Core
 import qualified Core.Eval as Eval
 import           Core.Name
 import qualified Core.Parser
 import           Core.Pretty
-import qualified Data.Aeson as Aeson
-import qualified Data.Aeson.Encode.Pretty as Aeson
 import qualified Data.ByteString.Char8 as ByteString
-import qualified Data.ByteString.Lazy.Char8 as ByteString.Lazy
-import qualified Data.ByteString.Streaming.Char8 as ByteStream
 import           Data.Foldable
 import           Data.Function
 import qualified Data.IntMap as IntMap
@@ -34,8 +28,6 @@ import qualified Language.Python.Core as Py
 import           Language.Python.Failure
 import           Prelude hiding (fail)
 import           Source.Span
-import           Streaming
-import qualified Streaming.Process
 import           Syntax.Term
 import           Syntax.Var (closed)
 import           System.Directory
@@ -43,7 +35,6 @@ import           System.Exit
 import           System.Path ((</>))
 import qualified System.Path as Path
 import qualified System.Path.Directory as Path
-import           Text.Show.Pretty (ppShow)
 import qualified Text.Trifecta as Trifecta
 import qualified TreeSitter.Python as TSP
 import qualified TreeSitter.Unmarshal as TS
@@ -62,32 +53,6 @@ parsePrelude = do
     Right r -> pure r
     Left s  -> HUnit.assertFailure ("Couldn't parse prelude: " <> s)
 
-assertJQExpressionSucceeds :: Show a => Directive.Directive -> a -> Term (Ann Span :+: Core) Name -> HUnit.Assertion
-assertJQExpressionSucceeds directive tree core = do
-  prelude <- parsePrelude
-  let allTogether = (named' "__semantic_prelude" :<- prelude) >>>= core
-
-  bod <- case scopeGraph Eval.eval [File (Path.absRel "<interactive>") (Span (Pos 1 1) (Pos 1 1)) allTogether] of
-    (heap, [File _ _ (Right result)]) -> pure $ Aeson.object
-      [ "scope" Aeson..= heap
-      , "heap"  Aeson..= result
-      ]
-    other -> HUnit.assertFailure ("Couldn't run scope dumping mechanism: " <> showCore (stripAnnotations allTogether) <> "\n" <> show other)
-
-  let ignore     = ByteStream.effects . hoist ByteStream.effects
-      sgJSON     = ByteStream.fromLazy $ Aeson.encode bod
-      jqPipeline = Streaming.Process.withStreamingProcess (Directive.toProcess directive) sgJSON ignore
-      errorMsg   = "jq(1) returned non-zero exit code"
-      dirMsg     = "jq expression: " <> show directive
-      jsonMsg    = "JSON value: " <> ByteString.Lazy.unpack (Aeson.encodePretty bod)
-      astMsg     = "AST (pretty): " <> ppShow tree
-      treeMsg    = "Core expr (pretty): " <> showCore (stripAnnotations core)
-      treeMsg'   = "Core expr (Show): " <> ppShow (stripAnnotations core)
-
-
-  catch @_ @Streaming.Process.ProcessExitedUnsuccessfully jqPipeline $ \err -> do
-    HUnit.assertFailure (unlines [errorMsg, dirMsg, jsonMsg, astMsg, treeMsg, treeMsg', show err])
-
 -- handles CHECK-RESULT directives
 assertEvaluatesTo :: Term (Ann Span :+: Core) Name -> Text -> Concrete (Term (Ann Span :+: Core)) -> HUnit.Assertion
 assertEvaluatesTo core k val = do
@@ -137,7 +102,6 @@ checkPythonFile fp = HUnit.testCaseSteps (Path.toString fp) $ \step -> withFroze
       (Right (Left err), _)                      -> HUnit.assertFailure ("Compilation failed: " <> err)
       (Right (Right _), Directive.Fails)         -> HUnit.assertFailure "Expected translation to fail"
       (Right (Right item), Directive.Result k v) -> assertEvaluatesTo item k v
-      (Right (Right item), Directive.JQ _)       -> assertJQExpressionSucceeds directive result item
       (Right (Right item), Directive.Tree t)     -> assertTreeEqual (stripAnnotations item) t
 
 milestoneFixtures :: IO Tasty.TestTree
diff --git a/semantic-python/test/fixtures/1-01-empty-module.py b/semantic-python/test/fixtures/1-01-empty-module.py
index 95226452b..e69de29bb 100644
--- a/semantic-python/test/fixtures/1-01-empty-module.py
+++ b/semantic-python/test/fixtures/1-01-empty-module.py
@@ -1 +0,0 @@
-# CHECK-JQ: .scope | has("__semantic_prelude") # prelude should be present
diff --git a/semantic-python/test/fixtures/1-02-pass-statement.py b/semantic-python/test/fixtures/1-02-pass-statement.py
index d9f8dda1b..2ae28399f 100644
--- a/semantic-python/test/fixtures/1-02-pass-statement.py
+++ b/semantic-python/test/fixtures/1-02-pass-statement.py
@@ -1,2 +1 @@
-# CHECK-JQ: .scope | has("__semantic_prelude")
 pass
diff --git a/semantic-python/test/fixtures/1-04-toplevel-assignment.py b/semantic-python/test/fixtures/1-04-toplevel-assignment.py
index a09f7dc34..995157e5f 100644
--- a/semantic-python/test/fixtures/1-04-toplevel-assignment.py
+++ b/semantic-python/test/fixtures/1-04-toplevel-assignment.py
@@ -1,4 +1,3 @@
-# CHECK-JQ: .scope | has("hello") and has("goodbye")
 # CHECK-TREE: { hello <- #unit; goodbye <- #unit; #record { hello: hello, goodbye: goodbye }}
 # CHECK-RESULT hello: #unit
 hello = ()
diff --git a/semantic-python/test/fixtures/2-07-closure-over-scope.py b/semantic-python/test/fixtures/2-07-closure-over-scope.py
index 0d38c9d0d..582b7b89c 100644
--- a/semantic-python/test/fixtures/2-07-closure-over-scope.py
+++ b/semantic-python/test/fixtures/2-07-closure-over-scope.py
@@ -1,5 +1,3 @@
-# CHECK-JQ: .scope.zilch[0].b[0].span  == { start: [8, 8], end: [ 8, 16 ] }
-# CHECK-JQ: .scope.result[0].a[0].span == { start: [5, 8], end: [ 5, 16 ] }
 
 def const(a, b):
     def result():

From f5efb6a4979b3b7260a3e5369a3bc202aaac5fa6 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 11:44:26 -0500
Subject: [PATCH 253/318] :fire: Analysis.ScopeGraph.

---
 semantic-analysis/semantic-analysis.cabal    |   1 -
 semantic-analysis/src/Analysis/ScopeGraph.hs | 140 -------------------
 2 files changed, 141 deletions(-)
 delete mode 100644 semantic-analysis/src/Analysis/ScopeGraph.hs

diff --git a/semantic-analysis/semantic-analysis.cabal b/semantic-analysis/semantic-analysis.cabal
index ed1200206..22c61b689 100644
--- a/semantic-analysis/semantic-analysis.cabal
+++ b/semantic-analysis/semantic-analysis.cabal
@@ -53,7 +53,6 @@ library
     Analysis.ImportGraph
     Analysis.Intro
     Analysis.Name
-    Analysis.ScopeGraph
     Analysis.Typecheck
     Control.Carrier.Fail.WithLoc
   build-depends:
diff --git a/semantic-analysis/src/Analysis/ScopeGraph.hs b/semantic-analysis/src/Analysis/ScopeGraph.hs
deleted file mode 100644
index c7fc0b956..000000000
--- a/semantic-analysis/src/Analysis/ScopeGraph.hs
+++ /dev/null
@@ -1,140 +0,0 @@
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-module Analysis.ScopeGraph
-( ScopeGraph(..)
-, Ref (..)
-, Decl(..)
-, scopeGraph
-) where
-
-import           Analysis.Carrier.Env.Monovariant
-import qualified Analysis.Carrier.Heap.Monovariant as A
-import           Analysis.Effect.Domain
-import           Analysis.File
-import           Analysis.FlowInsensitive
-import           Analysis.Intro
-import           Analysis.Name
-import           Control.Algebra
-import           Control.Applicative (Alternative (..))
-import           Control.Carrier.Fail.WithLoc
-import           Control.Carrier.Fresh.Strict
-import           Control.Carrier.Reader
-import           Control.Effect.State
-import           Control.Monad.Trans.Class
-import           Data.Foldable (fold)
-import           Data.Function (fix)
-import qualified Data.Map as Map
-import qualified Data.Set as Set
-import           Data.Traversable (for)
-import           Prelude hiding (fail)
-import           Source.Span
-import           Syntax.Scope
-import qualified System.Path as Path
-
-data Decl = Decl
-  { declSymbol :: Name
-  , declPath   :: Path.AbsRelFile
-  , declSpan   :: Span
-  }
-  deriving (Eq, Ord, Show)
-
-data Ref = Ref
-  { refPath :: Path.AbsRelFile
-  , refSpan :: Span
-  }
-  deriving (Eq, Ord, Show)
-
-type Addr = Name
-
-newtype ScopeGraph = ScopeGraph { unScopeGraph :: Map.Map Decl (Set.Set Ref) }
-  deriving (Eq, Ord, Show)
-
-instance Semigroup ScopeGraph where
-  ScopeGraph a <> ScopeGraph b = ScopeGraph (Map.unionWith (<>) a b)
-
-instance Monoid ScopeGraph where
-  mempty = ScopeGraph Map.empty
-
-scopeGraph
-  :: (Monad term, Ord (term Addr))
-  => (forall sig m
-     .  (Has (Domain term Addr ScopeGraph :+: Env Addr :+: A.Heap Addr ScopeGraph :+: Reader Path.AbsRelFile :+: Reader Span) sig m, MonadFail m)
-     => (term Addr -> m ScopeGraph)
-     -> (term Addr -> m ScopeGraph)
-     )
-  -> [File (term Addr)]
-  -> (Heap ScopeGraph, [File (Either (Path.AbsRelFile, Span, String) ScopeGraph)])
-scopeGraph eval
-  = run
-  . evalFresh 0
-  . runHeap
-  . traverse (runFile eval)
-
-runFile
-  :: ( Effect sig
-     , Has Fresh sig m
-     , Has (State (Heap ScopeGraph)) sig m
-     , Monad term
-     , Ord (term Addr)
-     )
-  => (forall sig m
-     .  (Has (Domain term Addr ScopeGraph :+: Env Addr :+: A.Heap Addr ScopeGraph :+: Reader Path.AbsRelFile :+: Reader Span) sig m, MonadFail m)
-     => (term Addr -> m ScopeGraph)
-     -> (term Addr -> m ScopeGraph)
-     )
-  -> File (term Addr)
-  -> m (File (Either (Path.AbsRelFile, Span, String) ScopeGraph))
-runFile eval file = traverse run file
-  where run = runReader (filePath file)
-            . runReader (fileSpan file)
-            . runEnv
-            . runFail
-            . fmap fold
-            . convergeTerm 0 (A.runHeap @Addr @ScopeGraph . fix (\ eval' -> runDomain eval' . fix (cacheTerm . eval)))
-
-
-runDomain :: (term Addr -> m ScopeGraph) -> DomainC term m a -> m a
-runDomain eval (DomainC m) = runReader eval m
-
-newtype DomainC term m a = DomainC (ReaderC (term Addr -> m ScopeGraph) m a)
-  deriving (Alternative, Applicative, Functor, Monad, MonadFail)
-
-instance MonadTrans (DomainC term) where
-  lift = DomainC . lift
-
-instance (Alternative m, Has (Env Addr :+: A.Heap Addr ScopeGraph :+: Reader Path.AbsRelFile :+: Reader Span) sig m, Monad term) => Algebra (Domain term Addr ScopeGraph :+: sig) (DomainC term m) where
-  alg = \case
-    L (Abstract i k) -> case i of
-      Unit -> k mempty
-      Bool _ -> k mempty
-      String _ -> k mempty
-      Lam (Named n b) -> do
-        eval <- DomainC ask
-        addr <- alloc @Addr n
-        A.assign @Addr @ScopeGraph addr mempty
-        g <- bind n addr (lift (eval (instantiate1 (pure addr) b)))
-        k g
-      Record fields -> do
-        eval <- DomainC ask
-        fields' <- for fields $ \ (k, t) -> do
-          addr <- alloc k
-          path <- ask
-          span <- ask
-          v <- lift (eval t)
-          let v' = ScopeGraph (Map.singleton (Decl k path span) mempty) <> v
-          v' <$ A.assign @Addr addr v'
-        k (fold fields')
-    L (AsBool   _ k) -> k True <|> k False
-    L (AsString _ k) -> k mempty
-    L (AsLam    _ k) -> alloc (Name mempty) >>= k . Named (Name mempty) . lift . pure
-    L (AsRecord _ k) -> k []
-    R other -> DomainC (send (handleCoercible other))

From 75a63dd340b8473e4e9051982d58ca57f4d75987 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 12:04:29 -0500
Subject: [PATCH 254/318] Split up abstraction into separate constructors.

---
 semantic-analysis/src/Analysis/Concrete.hs    | 48 ++++++++---------
 .../src/Analysis/Effect/Domain.hs             | 33 ++++++------
 semantic-analysis/src/Analysis/ImportGraph.hs | 30 +++++------
 semantic-analysis/src/Analysis/Typecheck.hs   | 54 +++++++++----------
 semantic-core/src/Core/Eval.hs                | 12 ++---
 5 files changed, 84 insertions(+), 93 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index 12c65bc3a..cf0f1ce65 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -27,9 +27,8 @@ import qualified Algebra.Graph as G
 import qualified Algebra.Graph.Export.Dot as G
 import qualified Analysis.Carrier.Env.Precise as A
 import qualified Analysis.Carrier.Heap.Precise as A
-import           Analysis.Effect.Domain
+import qualified Analysis.Effect.Domain as A
 import           Analysis.File
-import qualified Analysis.Intro as I
 import           Analysis.Name
 import           Control.Algebra
 import           Control.Carrier.Fail.WithLoc
@@ -71,7 +70,7 @@ type Heap = IntMap.IntMap
 concrete
   :: Applicative term
   => (forall sig m
-     .  (Has (Domain term Addr (Concrete term) :+: A.Env Addr :+: A.Heap Addr (Concrete term) :+: Reader Path.AbsRelFile :+: Reader Span) sig m, MonadFail m)
+     .  (Has (A.Domain term Addr (Concrete term) :+: A.Env Addr :+: A.Heap Addr (Concrete term) :+: Reader Path.AbsRelFile :+: Reader Span) sig m, MonadFail m)
      => (term Addr -> m (Concrete term))
      -> (term Addr -> m (Concrete term))
      )
@@ -91,7 +90,7 @@ runFile
      , Has (A.Heap Addr (Concrete term)) sig m
      )
   => (forall sig m
-     .  (Has (Domain term Addr (Concrete term) :+: A.Env Addr :+: A.Heap Addr (Concrete term) :+: Reader Path.AbsRelFile :+: Reader Span) sig m, MonadFail m)
+     .  (Has (A.Domain term Addr (Concrete term) :+: A.Env Addr :+: A.Heap Addr (Concrete term) :+: Reader Path.AbsRelFile :+: Reader Span) sig m, MonadFail m)
      => (term Addr -> m (Concrete term))
      -> (term Addr -> m (Concrete term))
      )
@@ -122,34 +121,33 @@ instance ( Applicative term
          , Has (Reader Span) sig m
          , MonadFail m
          )
-      => Algebra (Domain term Addr (Concrete term) :+: sig) (DomainC term m) where
+      => Algebra (A.Domain term Addr (Concrete term) :+: sig) (DomainC term m) where
   alg = \case
-    L (Abstract i k) -> case i of
-      I.Unit         -> k Unit
-      I.Bool b       -> k (Bool b)
-      I.String s     -> k (String s)
-      I.Lam b        -> do
-        path <- ask
-        span <- ask
-        k (Closure path span b)
-      I.Record fields -> do
-        eval <- DomainC ask
-        fields' <- for fields $ \ (name, t) -> do
-          addr <- A.alloc name
-          v <- lift (eval t)
-          A.assign @Addr @(Concrete term) addr v
-          pure (name, addr)
-        k (Record (Map.fromList fields'))
-    L (AsBool   c k) -> case c of
+    L (A.Unit k) -> k Unit
+    L (A.Bool     b k) -> k (Bool b)
+    L (A.AsBool   c k) -> case c of
       Bool   b -> k b
       _        -> fail "expected Bool"
-    L (AsString c k) -> case c of
+    L (A.String   s k) -> k (String s)
+    L (A.AsString c k) -> case c of
       String s -> k s
       _        -> fail "expected String"
-    L (AsLam    c k) -> case c of
+    L (A.Lam      b k) -> do
+      path <- ask
+      span <- ask
+      k (Closure path span b)
+    L (A.AsLam    c k) -> case c of
       Closure _ _ b -> k b
       _             -> fail "expected Closure"
-    L (AsRecord c k) -> case c of
+    L (A.Record fields k) -> do
+      eval <- DomainC ask
+      fields' <- for fields $ \ (name, t) -> do
+        addr <- A.alloc name
+        v <- lift (eval t)
+        A.assign @Addr @(Concrete term) addr v
+        pure (name, addr)
+      k (Record (Map.fromList fields'))
+    L (A.AsRecord c k) -> case c of
       Record fields -> k (map (fmap pure) (Map.toList fields))
       _             -> fail "expected Record"
     R other -> DomainC (send (handleCoercible other))
diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index fd51b1de0..3a5b9560c 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -8,8 +8,7 @@
 {-# LANGUAGE TypeApplications #-}
 module Analysis.Effect.Domain
 ( -- * Domain effect
-  abstract
-, unit
+  unit
 , bool
 , asBool
 , string
@@ -25,36 +24,30 @@ module Analysis.Effect.Domain
 , run
 ) where
 
-import           Analysis.Intro (Intro)
-import qualified Analysis.Intro as A
 import           Analysis.Name
 import           Control.Algebra
 import           Data.Text (Text)
 import           GHC.Generics (Generic1)
 import           Syntax.Scope (Scope)
 
-abstract :: Has (Domain term addr abstract) sig m => Intro term addr -> m abstract
-abstract concrete = send (Abstract concrete pure)
-
-
 unit :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => m abstract
-unit = abstract @term @addr A.Unit
+unit = send (Unit @term @addr pure)
 
 bool :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => Bool -> m abstract
-bool = abstract @term @addr . A.Bool
+bool b = send (Bool @term @addr b pure)
 
 asBool :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => abstract -> m Bool
 asBool v = send (AsBool @term @addr v pure)
 
 string :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => Text -> m abstract
-string = abstract @term @addr . A.String
+string s = send (String @term @addr s pure)
 
 asString :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => abstract -> m Text
 asString v = send (AsString @term @addr v pure)
 
 
 lam :: Has (Domain term addr abstract) sig m => Named (Scope () term addr) -> m abstract
-lam = abstract . A.Lam
+lam b = send (Lam b pure)
 
 -- FIXME: Support partial concretization of lambdas.
 asLam :: Has (Domain term addr abstract) sig m => abstract -> m (Named (Scope () term addr))
@@ -62,7 +55,7 @@ asLam v = send (AsLam v pure)
 
 
 record :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => [(Name, term addr)] -> m abstract
-record = abstract @term . A.Record
+record fs = send (Record fs pure)
 
 -- FIXME: Support partial concretization of lambdas and records.
 asRecord :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => abstract -> m [(Name, term addr)]
@@ -70,11 +63,15 @@ asRecord v = send (AsRecord v pure)
 
 
 data Domain term addr abstract m k
-  = Abstract (Intro term addr) (abstract                   -> m k)
-  | AsBool   abstract          (Bool                       -> m k)
-  | AsString abstract          (Text                       -> m k)
-  | AsLam    abstract          (Named (Scope () term addr) -> m k)
-  | AsRecord abstract          ([(Name, term addr)]        -> m k)
+  = Unit                                  (abstract                   -> m k)
+  | Bool     Bool                         (abstract                   -> m k)
+  | AsBool   abstract                     (Bool                       -> m k)
+  | String   Text                         (abstract                   -> m k)
+  | AsString abstract                     (Text                       -> m k)
+  | Lam      (Named (Scope () term addr)) (abstract                   -> m k)
+  | AsLam    abstract                     (Named (Scope () term addr) -> m k)
+  | Record   [(Name, term addr)]          (abstract                   -> m k)
+  | AsRecord abstract                     ([(Name, term addr)]        -> m k)
   deriving (Functor, Generic1)
 
 instance HFunctor (Domain term addr abstract)
diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 221ce37d4..9cfecf1e2 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -21,7 +21,6 @@ import qualified Analysis.Carrier.Heap.Monovariant as A
 import qualified Analysis.Effect.Domain as A
 import           Analysis.File
 import           Analysis.FlowInsensitive
-import qualified Analysis.Intro as I
 import           Analysis.Name
 import           Control.Algebra
 import           Control.Applicative (Alternative (..))
@@ -126,26 +125,25 @@ instance MonadTrans (DomainC term) where
 -- FIXME: decompose into a product domain and two atomic domains
 instance (Alternative m, Has (Env Addr :+: A.Heap Addr (Value (Semi term)) :+: Reader Path.AbsRelFile :+: Reader Span) sig m, MonadFail m) => Algebra (A.Domain term Addr (Value (Semi term)) :+: sig) (DomainC term m) where
   alg = \case
-    L (A.Abstract i k) -> case i of
-      I.Unit     -> k mempty
-      I.Bool _   -> k mempty
-      I.String s -> k (Value (String s) mempty)
-      I.Lam b    -> do
-        path <- ask
-        span <- ask
-        k (Value (Closure path span b) mempty)
-      I.Record f -> do
-        eval <- DomainC ask
-        fields <- for f $ \ (k, t) -> do
-          addr <- alloc @Addr k
-          v <- lift (eval t)
-          v <$ A.assign @Addr @(Value (Semi term)) addr v
-        k (fold fields)
+    L (A.Unit     k) -> k mempty
+    L (A.Bool _   k) -> k mempty
     L (A.AsBool   _ k) -> k True <|> k False
+    L (A.String s k) -> k (Value (String s) mempty)
     L (A.AsString _ k) -> k mempty
+    L (A.Lam b    k) -> do
+      path <- ask
+      span <- ask
+      k (Value (Closure path span b) mempty)
     L (A.AsLam (Value v _) k) -> case v of
       Closure _ _ b -> k b
       String _      -> fail $ "expected closure, got String"
       Abstract      -> fail $ "expected closure, got Abstract"
+    L (A.Record f k) -> do
+      eval <- DomainC ask
+      fields <- for f $ \ (k, t) -> do
+        addr <- alloc @Addr k
+        v <- lift (eval t)
+        v <$ A.assign @Addr @(Value (Semi term)) addr v
+      k (fold fields)
     L (A.AsRecord _ k) -> k []
     R other -> DomainC (send (handleCoercible other))
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index 1d0786db3..a752a554f 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -23,7 +23,7 @@ module Analysis.Typecheck
 
 import           Analysis.Carrier.Env.Monovariant
 import qualified Analysis.Carrier.Heap.Monovariant as A
-import           Analysis.Effect.Domain
+import qualified Analysis.Effect.Domain as A
 import           Analysis.File
 import           Analysis.FlowInsensitive
 import qualified Analysis.Intro as Intro
@@ -112,7 +112,7 @@ generalize ty = fromJust (closed (forAlls (IntSet.toList (mvs ty)) (hoistTerm R
 typecheckingFlowInsensitive
   :: (Has Intro.Intro syn term, Ord (term Addr))
   => (forall sig m
-     .  (Has (Domain term Addr Type :+: Env Addr :+: A.Heap Addr Type :+: Reader Path.AbsRelFile :+: Reader Span) sig m, MonadFail m)
+     .  (Has (A.Domain term Addr Type :+: Env Addr :+: A.Heap Addr Type :+: Reader Path.AbsRelFile :+: Reader Span) sig m, MonadFail m)
      => (term Addr -> m Type)
      -> (term Addr -> m Type)
      )
@@ -135,7 +135,7 @@ runFile
      , Ord (term Addr)
      )
   => (forall sig m
-     .  (Has (Domain term Addr Type :+: Env Addr :+: A.Heap Addr Type :+: Reader Path.AbsRelFile :+: Reader Span) sig m, MonadFail m)
+     .  (Has (A.Domain term Addr Type :+: Env Addr :+: A.Heap Addr Type :+: Reader Path.AbsRelFile :+: Reader Span) sig m, MonadFail m)
      => (term Addr -> m Type)
      -> (term Addr -> m Type)
      )
@@ -228,35 +228,25 @@ instance ( Alternative m
          , MonadFail m
          , Has Intro.Intro syn term
          )
-      => Algebra (Domain term Addr Type :+: sig) (DomainC term m) where
+      => Algebra (A.Domain term Addr Type :+: sig) (DomainC term m) where
   alg = \case
-    L (Abstract v k) -> case v of
-      Intro.Unit     -> k (Alg Unit)
-      Intro.Bool   _ -> k (Alg Bool)
-      Intro.String _ -> k (Alg String)
-      Intro.Lam (Named n b) -> do
-        eval <- DomainC ask
-        addr <- alloc @Name n
-        arg <- meta
-        A.assign addr arg
-        ty <- lift (eval (instantiate1 (pure n) b))
-        k (Alg (arg :-> ty))
-      Intro.Record fields -> do
-        eval <- DomainC ask
-        fields' <- for fields $ \ (k, t) -> do
-          addr <- alloc @Addr k
-          v <- lift (eval t)
-          (k, v) <$ A.assign addr v
-        -- FIXME: should records reference types by address instead?
-        k (Alg (Record (Map.fromList fields')))
-
-    L (AsBool   t k) -> do
+    L (A.Unit       k) -> k (Alg Unit)
+    L (A.Bool     _ k) -> k (Alg Bool)
+    L (A.AsBool   t k) -> do
       unify t (Alg Bool)
       k True <|> k False
-    L (AsString t k) -> do
+    L (A.String   _ k) -> k (Alg String)
+    L (A.AsString t k) -> do
       unify t (Alg String)
       k mempty
-    L (AsLam    t k) -> do
+    L (A.Lam (Named n b) k) -> do
+      eval <- DomainC ask
+      addr <- alloc @Name n
+      arg <- meta
+      A.assign addr arg
+      ty <- lift (eval (instantiate1 (pure n) b))
+      k (Alg (arg :-> ty))
+    L (A.AsLam    t k) -> do
       arg <- meta
       ret <- meta
       unify t (Alg (arg :-> ret))
@@ -269,7 +259,15 @@ instance ( Alternative m
         Alg (_ :-> b)  -> send . Intro.Lam . Named (Name mempty) . lift <$> concretize b
         Alg (Record t) -> Intro.record <$> traverse (traverse concretize) (Map.toList t)
         t              -> fail $ "can’t concretize " <> show t -- FIXME: concretize type variables by incrementally solving constraints
-    L (AsRecord t k) -> do
+    L (A.Record fields k) -> do
+      eval <- DomainC ask
+      fields' <- for fields $ \ (k, t) -> do
+        addr <- alloc @Addr k
+        v <- lift (eval t)
+        (k, v) <$ A.assign addr v
+      -- FIXME: should records reference types by address instead?
+      k (Alg (Record (Map.fromList fields')))
+    L (A.AsRecord t k) -> do
       unify t (Alg (Record mempty))
       k mempty -- FIXME: return whatever fields we have, when it’s actually a Record
 
diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index b25662a0e..e6b147d20 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -17,7 +17,7 @@ module Core.Eval
 , ruby
 ) where
 
-import           Analysis.Effect.Domain as A
+import qualified Analysis.Effect.Domain as A
 import           Analysis.Effect.Env as A
 import           Analysis.Effect.Heap as A
 import           Analysis.File
@@ -40,7 +40,7 @@ import qualified System.Path as Path
 type Term = Term.Term (Ann Span :+: Core)
 
 eval :: forall address value m sig
-     .  ( Has (Domain Term address value) sig m
+     .  ( Has (A.Domain Term address value) sig m
         , Has (Env address) sig m
         , Has (Heap address value) sig m
         , Has (Reader Span) sig m
@@ -68,7 +68,7 @@ eval eval = \case
       A.bind n addr ((a' <>) <$> eval (instantiate1 (pure addr) b))
     Lam (Named n b) -> A.lam (Named n b)
     f :$ a -> do
-      Named n b <- eval f >>= asLam
+      Named n b <- eval f >>= A.asLam
       a' <- eval a
       addr <- A.alloc @address n
       A.assign addr a'
@@ -82,10 +82,10 @@ eval eval = \case
     String s -> A.string @Term @address s
     Record fields -> A.record fields
     a :. b -> do
-      a' <- eval a >>= asRecord @Term @address
+      a' <- eval a >>= A.asRecord @Term @address
       maybe (freeVariable (show b)) eval (lookup b a')
     a :? b -> do
-      a' <- eval a >>= asRecord @Term @address
+      a' <- eval a >>= A.asRecord @Term @address
       A.bool @Term @address (isJust (lookup b a'))
 
     a := b -> do
@@ -106,7 +106,7 @@ eval eval = \case
               c' <- eval c >>= A.asBool @Term @address
               if c' then ref t else ref e
             a :. b -> do
-              a' <- eval a >>= asRecord @Term @address
+              a' <- eval a >>= A.asRecord @Term @address
               maybe (freeVariable (show b)) ref (lookup b a')
             c -> invalidRef (show c)
           Term.Alg (L (Ann span c)) -> local (const span) (ref c)

From 661227365abd44d5cb698bbb3d5d1ac37ac94ced Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 12:07:27 -0500
Subject: [PATCH 255/318] =?UTF-8?q?Don=E2=80=99t=20repeat=20ourselves.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index 3a5b9560c..619b3f5bb 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -57,7 +57,7 @@ asLam v = send (AsLam v pure)
 record :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => [(Name, term addr)] -> m abstract
 record fs = send (Record fs pure)
 
--- FIXME: Support partial concretization of lambdas and records.
+-- FIXME: Support partial concretization of records.
 asRecord :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => abstract -> m [(Name, term addr)]
 asRecord v = send (AsRecord v pure)
 

From c07324ff90d224272902980ddaa97d1dd6527f2d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 12:24:04 -0500
Subject: [PATCH 256/318] Split Domain into multiple effects.

---
 semantic-analysis/src/Analysis/Concrete.hs    |  18 +--
 .../src/Analysis/Effect/Domain.hs             | 115 +++++++++++-------
 semantic-analysis/src/Analysis/ImportGraph.hs |  18 +--
 semantic-analysis/src/Analysis/Typecheck.hs   |  18 +--
 semantic-core/src/Core/Eval.hs                |  18 +--
 5 files changed, 110 insertions(+), 77 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Concrete.hs b/semantic-analysis/src/Analysis/Concrete.hs
index cf0f1ce65..0931a3715 100644
--- a/semantic-analysis/src/Analysis/Concrete.hs
+++ b/semantic-analysis/src/Analysis/Concrete.hs
@@ -123,23 +123,23 @@ instance ( Applicative term
          )
       => Algebra (A.Domain term Addr (Concrete term) :+: sig) (DomainC term m) where
   alg = \case
-    L (A.Unit k) -> k Unit
-    L (A.Bool     b k) -> k (Bool b)
-    L (A.AsBool   c k) -> case c of
+    L (L (A.Unit k)) -> k Unit
+    L (R (L (A.Bool     b k))) -> k (Bool b)
+    L (R (L (A.AsBool   c k))) -> case c of
       Bool   b -> k b
       _        -> fail "expected Bool"
-    L (A.String   s k) -> k (String s)
-    L (A.AsString c k) -> case c of
+    L (R (R (L (A.String   s k)))) -> k (String s)
+    L (R (R (L (A.AsString c k)))) -> case c of
       String s -> k s
       _        -> fail "expected String"
-    L (A.Lam      b k) -> do
+    L (R (R (R (L (A.Lam      b k))))) -> do
       path <- ask
       span <- ask
       k (Closure path span b)
-    L (A.AsLam    c k) -> case c of
+    L (R (R (R (L (A.AsLam    c k))))) -> case c of
       Closure _ _ b -> k b
       _             -> fail "expected Closure"
-    L (A.Record fields k) -> do
+    L (R (R (R (R (A.Record fields k))))) -> do
       eval <- DomainC ask
       fields' <- for fields $ \ (name, t) -> do
         addr <- A.alloc name
@@ -147,7 +147,7 @@ instance ( Applicative term
         A.assign @Addr @(Concrete term) addr v
         pure (name, addr)
       k (Record (Map.fromList fields'))
-    L (A.AsRecord c k) -> case c of
+    L (R (R (R (R (A.AsRecord c k))))) -> case c of
       Record fields -> k (map (fmap pure) (Map.toList fields))
       _             -> fail "expected Record"
     R other -> DomainC (send (handleCoercible other))
diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index 619b3f5bb..cb4c024c2 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -1,78 +1,111 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE QuantifiedConstraints #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
 module Analysis.Effect.Domain
 ( -- * Domain effect
   unit
+, UnitDomain(..)
 , bool
 , asBool
+, BoolDomain(..)
 , string
 , asString
+, StringDomain(..)
 , lam
 , asLam
+, FunctionDomain(..)
 , record
 , asRecord
-, Domain(..)
+, RecordDomain(..)
+, Domain
   -- * Re-exports
 , Algebra
 , Has
 , run
 ) where
 
-import           Analysis.Name
-import           Control.Algebra
-import           Data.Text (Text)
-import           GHC.Generics (Generic1)
-import           Syntax.Scope (Scope)
+import Analysis.Name
+import Control.Algebra
+import Data.Text (Text)
+import GHC.Generics (Generic1)
+import Syntax.Scope (Scope)
 
-unit :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => m abstract
-unit = send (Unit @term @addr pure)
+unit :: Has (UnitDomain abstract) sig m => m abstract
+unit = send (Unit pure)
 
-bool :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => Bool -> m abstract
-bool b = send (Bool @term @addr b pure)
+data UnitDomain abstract m k
+  = Unit (abstract -> m k)
+  deriving (Functor, Generic1)
 
-asBool :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => abstract -> m Bool
-asBool v = send (AsBool @term @addr v pure)
-
-string :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => Text -> m abstract
-string s = send (String @term @addr s pure)
-
-asString :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => abstract -> m Text
-asString v = send (AsString @term @addr v pure)
+instance HFunctor (UnitDomain abstract)
+instance Effect   (UnitDomain abstract)
 
 
-lam :: Has (Domain term addr abstract) sig m => Named (Scope () term addr) -> m abstract
+bool :: Has (BoolDomain abstract) sig m => Bool -> m abstract
+bool b = send (Bool b pure)
+
+asBool :: Has (BoolDomain abstract) sig m => abstract -> m Bool
+asBool v = send (AsBool v pure)
+
+data BoolDomain abstract m k
+  = Bool   Bool     (abstract -> m k)
+  | AsBool abstract (Bool     -> m k)
+  deriving (Functor, Generic1)
+
+instance HFunctor (BoolDomain abstract)
+instance Effect   (BoolDomain abstract)
+
+
+string :: Has (StringDomain abstract) sig m => Text -> m abstract
+string s = send (String s pure)
+
+asString :: Has (StringDomain abstract) sig m => abstract -> m Text
+asString v = send (AsString v pure)
+
+data StringDomain abstract m k
+  = String   Text     (abstract -> m k)
+  | AsString abstract (Text     -> m k)
+  deriving (Functor, Generic1)
+
+instance HFunctor (StringDomain abstract)
+instance Effect   (StringDomain abstract)
+
+
+lam :: Has (FunctionDomain term addr abstract) sig m => Named (Scope () term addr) -> m abstract
 lam b = send (Lam b pure)
 
 -- FIXME: Support partial concretization of lambdas.
-asLam :: Has (Domain term addr abstract) sig m => abstract -> m (Named (Scope () term addr))
+asLam :: Has (FunctionDomain term addr abstract) sig m => abstract -> m (Named (Scope () term addr))
 asLam v = send (AsLam v pure)
 
+data FunctionDomain term addr abstract m k
+  = Lam   (Named (Scope () term addr)) (abstract -> m k)
+  | AsLam abstract                     (Named (Scope () term addr)     -> m k)
+  deriving (Functor, Generic1)
 
-record :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => [(Name, term addr)] -> m abstract
+instance HFunctor (FunctionDomain term addr abstract)
+instance Effect   (FunctionDomain term addr abstract)
+
+
+record :: Has (RecordDomain term addr abstract) sig m => [(Name, term addr)] -> m abstract
 record fs = send (Record fs pure)
 
 -- FIXME: Support partial concretization of records.
-asRecord :: forall term addr abstract m sig . Has (Domain term addr abstract) sig m => abstract -> m [(Name, term addr)]
+asRecord :: Has (RecordDomain term addr abstract) sig m => abstract -> m [(Name, term addr)]
 asRecord v = send (AsRecord v pure)
 
-
-data Domain term addr abstract m k
-  = Unit                                  (abstract                   -> m k)
-  | Bool     Bool                         (abstract                   -> m k)
-  | AsBool   abstract                     (Bool                       -> m k)
-  | String   Text                         (abstract                   -> m k)
-  | AsString abstract                     (Text                       -> m k)
-  | Lam      (Named (Scope () term addr)) (abstract                   -> m k)
-  | AsLam    abstract                     (Named (Scope () term addr) -> m k)
-  | Record   [(Name, term addr)]          (abstract                   -> m k)
-  | AsRecord abstract                     ([(Name, term addr)]        -> m k)
+data RecordDomain term addr abstract m k
+  = Record   [(Name, term addr)] (abstract -> m k)
+  | AsRecord abstract            ([(Name, term addr)]     -> m k)
   deriving (Functor, Generic1)
 
-instance HFunctor (Domain term addr abstract)
-instance Effect   (Domain term addr abstract)
+instance HFunctor (RecordDomain term addr abstract)
+instance Effect   (RecordDomain term addr abstract)
+
+
+type Domain term addr abstract
+  =   UnitDomain abstract
+  :+: BoolDomain abstract
+  :+: StringDomain abstract
+  :+: FunctionDomain term addr abstract
+  :+: RecordDomain term addr abstract
diff --git a/semantic-analysis/src/Analysis/ImportGraph.hs b/semantic-analysis/src/Analysis/ImportGraph.hs
index 9cfecf1e2..ee2af77c2 100644
--- a/semantic-analysis/src/Analysis/ImportGraph.hs
+++ b/semantic-analysis/src/Analysis/ImportGraph.hs
@@ -125,25 +125,25 @@ instance MonadTrans (DomainC term) where
 -- FIXME: decompose into a product domain and two atomic domains
 instance (Alternative m, Has (Env Addr :+: A.Heap Addr (Value (Semi term)) :+: Reader Path.AbsRelFile :+: Reader Span) sig m, MonadFail m) => Algebra (A.Domain term Addr (Value (Semi term)) :+: sig) (DomainC term m) where
   alg = \case
-    L (A.Unit     k) -> k mempty
-    L (A.Bool _   k) -> k mempty
-    L (A.AsBool   _ k) -> k True <|> k False
-    L (A.String s k) -> k (Value (String s) mempty)
-    L (A.AsString _ k) -> k mempty
-    L (A.Lam b    k) -> do
+    L (L (A.Unit     k)) -> k mempty
+    L (R (L (A.Bool _   k))) -> k mempty
+    L (R (L (A.AsBool   _ k))) -> k True <|> k False
+    L (R (R (L (A.String s k)))) -> k (Value (String s) mempty)
+    L (R (R (L (A.AsString _ k)))) -> k mempty
+    L (R (R (R (L (A.Lam b    k))))) -> do
       path <- ask
       span <- ask
       k (Value (Closure path span b) mempty)
-    L (A.AsLam (Value v _) k) -> case v of
+    L (R (R (R (L (A.AsLam (Value v _) k))))) -> case v of
       Closure _ _ b -> k b
       String _      -> fail $ "expected closure, got String"
       Abstract      -> fail $ "expected closure, got Abstract"
-    L (A.Record f k) -> do
+    L (R (R (R (R (A.Record f k))))) -> do
       eval <- DomainC ask
       fields <- for f $ \ (k, t) -> do
         addr <- alloc @Addr k
         v <- lift (eval t)
         v <$ A.assign @Addr @(Value (Semi term)) addr v
       k (fold fields)
-    L (A.AsRecord _ k) -> k []
+    L (R (R (R (R (A.AsRecord _ k))))) -> k []
     R other -> DomainC (send (handleCoercible other))
diff --git a/semantic-analysis/src/Analysis/Typecheck.hs b/semantic-analysis/src/Analysis/Typecheck.hs
index a752a554f..01c83bfdb 100644
--- a/semantic-analysis/src/Analysis/Typecheck.hs
+++ b/semantic-analysis/src/Analysis/Typecheck.hs
@@ -230,23 +230,23 @@ instance ( Alternative m
          )
       => Algebra (A.Domain term Addr Type :+: sig) (DomainC term m) where
   alg = \case
-    L (A.Unit       k) -> k (Alg Unit)
-    L (A.Bool     _ k) -> k (Alg Bool)
-    L (A.AsBool   t k) -> do
+    L (L (A.Unit       k)) -> k (Alg Unit)
+    L (R (L (A.Bool     _ k))) -> k (Alg Bool)
+    L (R (L (A.AsBool   t k))) -> do
       unify t (Alg Bool)
       k True <|> k False
-    L (A.String   _ k) -> k (Alg String)
-    L (A.AsString t k) -> do
+    L (R (R (L (A.String   _ k)))) -> k (Alg String)
+    L (R (R (L (A.AsString t k)))) -> do
       unify t (Alg String)
       k mempty
-    L (A.Lam (Named n b) k) -> do
+    L (R (R (R (L (A.Lam (Named n b) k))))) -> do
       eval <- DomainC ask
       addr <- alloc @Name n
       arg <- meta
       A.assign addr arg
       ty <- lift (eval (instantiate1 (pure n) b))
       k (Alg (arg :-> ty))
-    L (A.AsLam    t k) -> do
+    L (R (R (R (L (A.AsLam    t k))))) -> do
       arg <- meta
       ret <- meta
       unify t (Alg (arg :-> ret))
@@ -259,7 +259,7 @@ instance ( Alternative m
         Alg (_ :-> b)  -> send . Intro.Lam . Named (Name mempty) . lift <$> concretize b
         Alg (Record t) -> Intro.record <$> traverse (traverse concretize) (Map.toList t)
         t              -> fail $ "can’t concretize " <> show t -- FIXME: concretize type variables by incrementally solving constraints
-    L (A.Record fields k) -> do
+    L (R (R (R (R (A.Record fields k))))) -> do
       eval <- DomainC ask
       fields' <- for fields $ \ (k, t) -> do
         addr <- alloc @Addr k
@@ -267,7 +267,7 @@ instance ( Alternative m
         (k, v) <$ A.assign addr v
       -- FIXME: should records reference types by address instead?
       k (Alg (Record (Map.fromList fields')))
-    L (A.AsRecord t k) -> do
+    L (R (R (R (R (A.AsRecord t k))))) -> do
       unify t (Alg (Record mempty))
       k mempty -- FIXME: return whatever fields we have, when it’s actually a Record
 
diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index e6b147d20..894877a83 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -74,19 +74,19 @@ eval eval = \case
       A.assign addr a'
       A.bind n addr (eval (instantiate1 (pure addr) b))
     If c t e -> do
-      c' <- eval c >>= A.asBool @Term @address
+      c' <- eval c >>= A.asBool
       if c' then eval t else eval e
-    Load p -> eval p >>= A.asString @Term @address >> A.unit @Term @address -- FIXME: add a load command or something
-    Unit     -> A.unit @Term @address
-    Bool b   -> A.bool @Term @address b
-    String s -> A.string @Term @address s
+    Load p -> eval p >>= A.asString >> A.unit -- FIXME: add a load command or something
+    Unit     -> A.unit
+    Bool b   -> A.bool b
+    String s -> A.string s
     Record fields -> A.record fields
     a :. b -> do
-      a' <- eval a >>= A.asRecord @Term @address
+      a' <- eval a >>= A.asRecord
       maybe (freeVariable (show b)) eval (lookup b a')
     a :? b -> do
       a' <- eval a >>= A.asRecord @Term @address
-      A.bool @Term @address (isJust (lookup b a'))
+      A.bool (isJust (lookup b a'))
 
     a := b -> do
       b' <- eval b
@@ -103,10 +103,10 @@ eval eval = \case
           Term.Var n -> pure n
           Term.Alg (R c) -> case c of
             If c t e -> do
-              c' <- eval c >>= A.asBool @Term @address
+              c' <- eval c >>= A.asBool
               if c' then ref t else ref e
             a :. b -> do
-              a' <- eval a >>= A.asRecord @Term @address
+              a' <- eval a >>= A.asRecord
               maybe (freeVariable (show b)) ref (lookup b a')
             c -> invalidRef (show c)
           Term.Alg (L (Ann span c)) -> local (const span) (ref c)

From a167dedbfc934656845f4f0f01359cf54d6f2638 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 12:26:57 -0500
Subject: [PATCH 257/318] Rename the abstract parameter to value.

---
 .../src/Analysis/Effect/Domain.hs             | 78 +++++++++----------
 1 file changed, 39 insertions(+), 39 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index cb4c024c2..d2d26bf0e 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -30,82 +30,82 @@ import Data.Text (Text)
 import GHC.Generics (Generic1)
 import Syntax.Scope (Scope)
 
-unit :: Has (UnitDomain abstract) sig m => m abstract
+unit :: Has (UnitDomain value) sig m => m value
 unit = send (Unit pure)
 
-data UnitDomain abstract m k
-  = Unit (abstract -> m k)
+data UnitDomain value m k
+  = Unit (value -> m k)
   deriving (Functor, Generic1)
 
-instance HFunctor (UnitDomain abstract)
-instance Effect   (UnitDomain abstract)
+instance HFunctor (UnitDomain value)
+instance Effect   (UnitDomain value)
 
 
-bool :: Has (BoolDomain abstract) sig m => Bool -> m abstract
+bool :: Has (BoolDomain value) sig m => Bool -> m value
 bool b = send (Bool b pure)
 
-asBool :: Has (BoolDomain abstract) sig m => abstract -> m Bool
+asBool :: Has (BoolDomain value) sig m => value -> m Bool
 asBool v = send (AsBool v pure)
 
-data BoolDomain abstract m k
-  = Bool   Bool     (abstract -> m k)
-  | AsBool abstract (Bool     -> m k)
+data BoolDomain value m k
+  = Bool   Bool  (value -> m k)
+  | AsBool value (Bool     -> m k)
   deriving (Functor, Generic1)
 
-instance HFunctor (BoolDomain abstract)
-instance Effect   (BoolDomain abstract)
+instance HFunctor (BoolDomain value)
+instance Effect   (BoolDomain value)
 
 
-string :: Has (StringDomain abstract) sig m => Text -> m abstract
+string :: Has (StringDomain value) sig m => Text -> m value
 string s = send (String s pure)
 
-asString :: Has (StringDomain abstract) sig m => abstract -> m Text
+asString :: Has (StringDomain value) sig m => value -> m Text
 asString v = send (AsString v pure)
 
-data StringDomain abstract m k
-  = String   Text     (abstract -> m k)
-  | AsString abstract (Text     -> m k)
+data StringDomain value m k
+  = String   Text  (value -> m k)
+  | AsString value (Text     -> m k)
   deriving (Functor, Generic1)
 
-instance HFunctor (StringDomain abstract)
-instance Effect   (StringDomain abstract)
+instance HFunctor (StringDomain value)
+instance Effect   (StringDomain value)
 
 
-lam :: Has (FunctionDomain term addr abstract) sig m => Named (Scope () term addr) -> m abstract
+lam :: Has (FunctionDomain term addr value) sig m => Named (Scope () term addr) -> m value
 lam b = send (Lam b pure)
 
 -- FIXME: Support partial concretization of lambdas.
-asLam :: Has (FunctionDomain term addr abstract) sig m => abstract -> m (Named (Scope () term addr))
+asLam :: Has (FunctionDomain term addr value) sig m => value -> m (Named (Scope () term addr))
 asLam v = send (AsLam v pure)
 
-data FunctionDomain term addr abstract m k
-  = Lam   (Named (Scope () term addr)) (abstract -> m k)
-  | AsLam abstract                     (Named (Scope () term addr)     -> m k)
+data FunctionDomain term addr value m k
+  = Lam   (Named (Scope () term addr)) (value -> m k)
+  | AsLam value                        (Named (Scope () term addr)     -> m k)
   deriving (Functor, Generic1)
 
-instance HFunctor (FunctionDomain term addr abstract)
-instance Effect   (FunctionDomain term addr abstract)
+instance HFunctor (FunctionDomain term addr value)
+instance Effect   (FunctionDomain term addr value)
 
 
-record :: Has (RecordDomain term addr abstract) sig m => [(Name, term addr)] -> m abstract
+record :: Has (RecordDomain term addr value) sig m => [(Name, term addr)] -> m value
 record fs = send (Record fs pure)
 
 -- FIXME: Support partial concretization of records.
-asRecord :: Has (RecordDomain term addr abstract) sig m => abstract -> m [(Name, term addr)]
+asRecord :: Has (RecordDomain term addr value) sig m => value -> m [(Name, term addr)]
 asRecord v = send (AsRecord v pure)
 
-data RecordDomain term addr abstract m k
-  = Record   [(Name, term addr)] (abstract -> m k)
-  | AsRecord abstract            ([(Name, term addr)]     -> m k)
+data RecordDomain term addr value m k
+  = Record   [(Name, term addr)] (value -> m k)
+  | AsRecord value               ([(Name, term addr)]     -> m k)
   deriving (Functor, Generic1)
 
-instance HFunctor (RecordDomain term addr abstract)
-instance Effect   (RecordDomain term addr abstract)
+instance HFunctor (RecordDomain term addr value)
+instance Effect   (RecordDomain term addr value)
 
 
-type Domain term addr abstract
-  =   UnitDomain abstract
-  :+: BoolDomain abstract
-  :+: StringDomain abstract
-  :+: FunctionDomain term addr abstract
-  :+: RecordDomain term addr abstract
+type Domain term addr value
+  =   UnitDomain value
+  :+: BoolDomain value
+  :+: StringDomain value
+  :+: FunctionDomain term addr value
+  :+: RecordDomain term addr value

From a6fe9b7a55af06f321f2437a8489c8a04f573d61 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 12:27:39 -0500
Subject: [PATCH 258/318] Alignment.

---
 semantic-analysis/src/Analysis/Effect/Domain.hs | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/semantic-analysis/src/Analysis/Effect/Domain.hs b/semantic-analysis/src/Analysis/Effect/Domain.hs
index d2d26bf0e..1b8c47951 100644
--- a/semantic-analysis/src/Analysis/Effect/Domain.hs
+++ b/semantic-analysis/src/Analysis/Effect/Domain.hs
@@ -49,7 +49,7 @@ asBool v = send (AsBool v pure)
 
 data BoolDomain value m k
   = Bool   Bool  (value -> m k)
-  | AsBool value (Bool     -> m k)
+  | AsBool value (Bool  -> m k)
   deriving (Functor, Generic1)
 
 instance HFunctor (BoolDomain value)
@@ -64,7 +64,7 @@ asString v = send (AsString v pure)
 
 data StringDomain value m k
   = String   Text  (value -> m k)
-  | AsString value (Text     -> m k)
+  | AsString value (Text  -> m k)
   deriving (Functor, Generic1)
 
 instance HFunctor (StringDomain value)
@@ -79,8 +79,8 @@ asLam :: Has (FunctionDomain term addr value) sig m => value -> m (Named (Scope
 asLam v = send (AsLam v pure)
 
 data FunctionDomain term addr value m k
-  = Lam   (Named (Scope () term addr)) (value -> m k)
-  | AsLam value                        (Named (Scope () term addr)     -> m k)
+  = Lam   (Named (Scope () term addr)) (value                      -> m k)
+  | AsLam value                        (Named (Scope () term addr) -> m k)
   deriving (Functor, Generic1)
 
 instance HFunctor (FunctionDomain term addr value)
@@ -95,8 +95,8 @@ asRecord :: Has (RecordDomain term addr value) sig m => value -> m [(Name, term
 asRecord v = send (AsRecord v pure)
 
 data RecordDomain term addr value m k
-  = Record   [(Name, term addr)] (value -> m k)
-  | AsRecord value               ([(Name, term addr)]     -> m k)
+  = Record   [(Name, term addr)] (value               -> m k)
+  | AsRecord value               ([(Name, term addr)] -> m k)
   deriving (Functor, Generic1)
 
 instance HFunctor (RecordDomain term addr value)

From 1a670825de388856bb9aa881585e7633a1fa5f63 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 20 Dec 2019 12:28:19 -0500
Subject: [PATCH 259/318] Simplify a pattern match.

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

diff --git a/semantic-core/src/Core/Eval.hs b/semantic-core/src/Core/Eval.hs
index 894877a83..78229077a 100644
--- a/semantic-core/src/Core/Eval.hs
+++ b/semantic-core/src/Core/Eval.hs
@@ -66,7 +66,7 @@ eval eval = \case
       addr <- A.alloc @address n
       A.assign addr a'
       A.bind n addr ((a' <>) <$> eval (instantiate1 (pure addr) b))
-    Lam (Named n b) -> A.lam (Named n b)
+    Lam b -> A.lam b
     f :$ a -> do
       Named n b <- eval f >>= A.asLam
       a' <- eval a

From d278a01122690ac14a87e675f8d4718514de7f83 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 6 Jan 2020 13:59:29 -0500
Subject: [PATCH 260/318] Placate hlint.

---
 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 2e402ad66..07ec69cc3 100644
--- a/semantic-python/test/Test.hs
+++ b/semantic-python/test/Test.hs
@@ -58,7 +58,7 @@ assertEvaluatesTo :: Term (Ann Span :+: Core) Name -> Text -> Concrete (Term (An
 assertEvaluatesTo core k val = do
   prelude <- parsePrelude
   let withPrelude = (named' "__semantic_prelude" :<- prelude) >>>= core
-  allTogether <- maybe (HUnit.assertFailure ("Can’t evaluate open term: " <> showCore (stripAnnotations withPrelude))) pure (closed withPrelude)
+  allTogether <- maybeM (HUnit.assertFailure ("Can’t evaluate open term: " <> showCore (stripAnnotations withPrelude))) (closed withPrelude)
   let filius = [File (Path.absRel "<interactive>") (Span (Pos 1 1) (Pos 1 1)) allTogether]
 
   (heap, env) <- case Concrete.concrete Eval.eval filius of

From e34444eaf9afe3b3157c6ea11a53371ee7496b29 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 6 Jan 2020 15:13:55 -0500
Subject: [PATCH 261/318] Revert "Placate hlint."

This reverts commit d278a01122690ac14a87e675f8d4718514de7f83.
---
 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 07ec69cc3..2e402ad66 100644
--- a/semantic-python/test/Test.hs
+++ b/semantic-python/test/Test.hs
@@ -58,7 +58,7 @@ assertEvaluatesTo :: Term (Ann Span :+: Core) Name -> Text -> Concrete (Term (An
 assertEvaluatesTo core k val = do
   prelude <- parsePrelude
   let withPrelude = (named' "__semantic_prelude" :<- prelude) >>>= core
-  allTogether <- maybeM (HUnit.assertFailure ("Can’t evaluate open term: " <> showCore (stripAnnotations withPrelude))) (closed withPrelude)
+  allTogether <- maybe (HUnit.assertFailure ("Can’t evaluate open term: " <> showCore (stripAnnotations withPrelude))) pure (closed withPrelude)
   let filius = [File (Path.absRel "<interactive>") (Span (Pos 1 1) (Pos 1 1)) allTogether]
 
   (heap, env) <- case Concrete.concrete Eval.eval filius of

From 29e09bea4d7390db5bbfd30de7771a94e37b2820 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 6 Jan 2020 15:17:53 -0500
Subject: [PATCH 262/318] Trick hlint.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

This is goofy as hell but we don’t have maybeM here.
---
 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 2e402ad66..4078c9b8f 100644
--- a/semantic-python/test/Test.hs
+++ b/semantic-python/test/Test.hs
@@ -58,7 +58,7 @@ assertEvaluatesTo :: Term (Ann Span :+: Core) Name -> Text -> Concrete (Term (An
 assertEvaluatesTo core k val = do
   prelude <- parsePrelude
   let withPrelude = (named' "__semantic_prelude" :<- prelude) >>>= core
-  allTogether <- maybe (HUnit.assertFailure ("Can’t evaluate open term: " <> showCore (stripAnnotations withPrelude))) pure (closed withPrelude)
+  allTogether <- fromMaybe (HUnit.assertFailure ("Can’t evaluate open term: " <> showCore (stripAnnotations withPrelude))) (pure <$> closed withPrelude)
   let filius = [File (Path.absRel "<interactive>") (Span (Pos 1 1) (Pos 1 1)) allTogether]
 
   (heap, env) <- case Concrete.concrete Eval.eval filius of

From 55e573eb7fb76e6ccdb167bb21d0e943800c2668 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 6 Jan 2020 16:37:01 -0500
Subject: [PATCH 263/318] Revert "Trick hlint."

This reverts commit 29e09bea4d7390db5bbfd30de7771a94e37b2820.
---
 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 4078c9b8f..2e402ad66 100644
--- a/semantic-python/test/Test.hs
+++ b/semantic-python/test/Test.hs
@@ -58,7 +58,7 @@ assertEvaluatesTo :: Term (Ann Span :+: Core) Name -> Text -> Concrete (Term (An
 assertEvaluatesTo core k val = do
   prelude <- parsePrelude
   let withPrelude = (named' "__semantic_prelude" :<- prelude) >>>= core
-  allTogether <- fromMaybe (HUnit.assertFailure ("Can’t evaluate open term: " <> showCore (stripAnnotations withPrelude))) (pure <$> closed withPrelude)
+  allTogether <- maybe (HUnit.assertFailure ("Can’t evaluate open term: " <> showCore (stripAnnotations withPrelude))) pure (closed withPrelude)
   let filius = [File (Path.absRel "<interactive>") (Span (Pos 1 1) (Pos 1 1)) allTogether]
 
   (heap, env) <- case Concrete.concrete Eval.eval filius of

From f5c8346740e8dffb804cd174c7b71548399dd83d Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 6 Jan 2020 16:37:49 -0500
Subject: [PATCH 264/318] Ignore hints in assertEvaluatesTo.

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

diff --git a/semantic-python/test/Test.hs b/semantic-python/test/Test.hs
index 2e402ad66..269f3137c 100644
--- a/semantic-python/test/Test.hs
+++ b/semantic-python/test/Test.hs
@@ -71,6 +71,7 @@ assertEvaluatesTo core k val = do
 
   let found = Map.lookup (Name k) env >>= flip IntMap.lookup heap
   found HUnit.@?= Just val
+{-# HLINT ignore assertEvaluatesTo #-}
 
 -- handles CHECK-TREE directives
 assertTreeEqual :: Term Core Name -> Term Core Name -> HUnit.Assertion

From 4022643c42bc8e29db4bdab9b38f1194ff33a8bf Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 6 Jan 2020 16:38:00 -0500
Subject: [PATCH 265/318] =?UTF-8?q?Don=E2=80=99t=20shout=20about=20the=20H?=
 =?UTF-8?q?LINT=20pragma.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 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 269f3137c..e95ccab1d 100644
--- a/semantic-python/test/Test.hs
+++ b/semantic-python/test/Test.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE OverloadedStrings, ScopedTypeVariables, TypeApplications, TypeOperators #-}
-
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 module Main (main) where
 
 import           Analysis.Concrete (Concrete)

From c6d658130d3fd55b07850507f6075ef8bfe93dce Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 12:59:59 -0500
Subject: [PATCH 266/318] Stub in a class for traversal of higher-order subterm
 positions.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 2cf73a6e9..b2c987914 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -6,6 +6,7 @@ module Tags.Tagging.Precise
 , runTagging
 , firstLine
 , GFoldable1(..)
+, GTraversable1(..)
 ) where
 
 import Control.Carrier.Reader
@@ -76,3 +77,6 @@ instance (Foldable f, GFoldable1 c g) => GFoldable1 c (f :.: g) where
 
 instance GFoldable1 c U1 where
   gfoldMap1 _ _ = mempty
+
+
+class GTraversable1 c t where

From e0f6462e7884a0f5d0cdfbfb990c6a02d1aadd61 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:04:25 -0500
Subject: [PATCH 267/318] Add a gtraverse1 method to GTraversable1.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index b2c987914..430587dbf 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -80,3 +80,8 @@ instance GFoldable1 c U1 where
 
 
 class GTraversable1 c t where
+  gtraverse1
+    :: Applicative f
+    => (forall t' . c t' => t' a -> f (t' b))
+    -> t a
+    -> f (t b)

From 35f7094dabc6c57c3b2405d9094c7ba8a9754b91 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:05:55 -0500
Subject: [PATCH 268/318] Define a GTraversable1 instance for M1.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 430587dbf..76c2fa19b 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -85,3 +85,6 @@ class GTraversable1 c t where
     => (forall t' . c t' => t' a -> f (t' b))
     -> t a
     -> f (t b)
+
+instance GTraversable1 c f => GTraversable1 c (M1 i c' f) where
+  gtraverse1 f = fmap M1 . gtraverse1 @c f . unM1

From eecace902420763c891cd0725d2afeadc74929e4 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:07:05 -0500
Subject: [PATCH 269/318] Define a GTraversable1 instance for :*:.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 76c2fa19b..3e6c8033c 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -88,3 +88,6 @@ class GTraversable1 c t where
 
 instance GTraversable1 c f => GTraversable1 c (M1 i c' f) where
   gtraverse1 f = fmap M1 . gtraverse1 @c f . unM1
+
+instance (GTraversable1 c f, GTraversable1 c g) => GTraversable1 c (f :*: g) where
+  gtraverse1 f (l :*: r) = (:*:) <$> gtraverse1 @c f l <*> gtraverse1 @c f r

From c574d56e23dc62d4fbe29c6eceaa50af44d775d3 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:07:43 -0500
Subject: [PATCH 270/318] Define a GTraversable1 instance for :+:.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 3e6c8033c..f846afd7f 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -91,3 +91,7 @@ instance GTraversable1 c f => GTraversable1 c (M1 i c' f) where
 
 instance (GTraversable1 c f, GTraversable1 c g) => GTraversable1 c (f :*: g) where
   gtraverse1 f (l :*: r) = (:*:) <$> gtraverse1 @c f l <*> gtraverse1 @c f r
+
+instance (GTraversable1 c f, GTraversable1 c g) => GTraversable1 c (f :+: g) where
+  gtraverse1 f (L1 l) = L1 <$> gtraverse1 @c f l
+  gtraverse1 f (R1 r) = R1 <$> gtraverse1 @c f r

From e8420faa01fcfe01e7df6a5a87891d41005eb91e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:13:14 -0500
Subject: [PATCH 271/318] Define a GTraversable1 instance for K1.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index f846afd7f..aa4002826 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -95,3 +95,6 @@ instance (GTraversable1 c f, GTraversable1 c g) => GTraversable1 c (f :*: g) whe
 instance (GTraversable1 c f, GTraversable1 c g) => GTraversable1 c (f :+: g) where
   gtraverse1 f (L1 l) = L1 <$> gtraverse1 @c f l
   gtraverse1 f (R1 r) = R1 <$> gtraverse1 @c f r
+
+instance GTraversable1 c (K1 R t) where
+  gtraverse1 _ (K1 k) = pure (K1 k)

From 22adcee7d3a2bb0641e05953f5850806d311ecc1 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:21:28 -0500
Subject: [PATCH 272/318] Pass a parameter for mapping over annotation
 positions.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index aa4002826..40306a8d3 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -82,19 +82,20 @@ instance GFoldable1 c U1 where
 class GTraversable1 c t where
   gtraverse1
     :: Applicative f
-    => (forall t' . c t' => t' a -> f (t' b))
+    => (a -> f b)
+    -> (forall t' . c t' => t' a -> f (t' b))
     -> t a
     -> f (t b)
 
 instance GTraversable1 c f => GTraversable1 c (M1 i c' f) where
-  gtraverse1 f = fmap M1 . gtraverse1 @c f . unM1
+  gtraverse1 f g = fmap M1 . gtraverse1 @c f g . unM1
 
 instance (GTraversable1 c f, GTraversable1 c g) => GTraversable1 c (f :*: g) where
-  gtraverse1 f (l :*: r) = (:*:) <$> gtraverse1 @c f l <*> gtraverse1 @c f r
+  gtraverse1 f g (l :*: r) = (:*:) <$> gtraverse1 @c f g l <*> gtraverse1 @c f g r
 
 instance (GTraversable1 c f, GTraversable1 c g) => GTraversable1 c (f :+: g) where
-  gtraverse1 f (L1 l) = L1 <$> gtraverse1 @c f l
-  gtraverse1 f (R1 r) = R1 <$> gtraverse1 @c f r
+  gtraverse1 f g (L1 l) = L1 <$> gtraverse1 @c f g l
+  gtraverse1 f g (R1 r) = R1 <$> gtraverse1 @c f g r
 
 instance GTraversable1 c (K1 R t) where
-  gtraverse1 _ (K1 k) = pure (K1 k)
+  gtraverse1 _ _ (K1 k) = pure (K1 k)

From 52f0c8b9bd817540f89f3b0dbf500ea13a6f7236 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:23:21 -0500
Subject: [PATCH 273/318] Define a GTraversable1 instance for Par1.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 40306a8d3..b14949413 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -99,3 +99,6 @@ instance (GTraversable1 c f, GTraversable1 c g) => GTraversable1 c (f :+: g) whe
 
 instance GTraversable1 c (K1 R t) where
   gtraverse1 _ _ (K1 k) = pure (K1 k)
+
+instance GTraversable1 c Par1 where
+  gtraverse1 f _ (Par1 a) = Par1 <$> f a

From 925158e7176ede84039cd69ac212e94a49fecd33 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:24:11 -0500
Subject: [PATCH 274/318] Define a GTraversable1 instance for :.:.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index b14949413..ecf120a08 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -102,3 +102,6 @@ instance GTraversable1 c (K1 R t) where
 
 instance GTraversable1 c Par1 where
   gtraverse1 f _ (Par1 a) = Par1 <$> f a
+
+instance (Traversable f, GTraversable1 c g) => GTraversable1 c (f :.: g) where
+  gtraverse1 f g = fmap Comp1 . traverse (gtraverse1 @c f g) . unComp1

From 87db10b9b3680d3b455de6ae6b678357d68f8c55 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:25:21 -0500
Subject: [PATCH 275/318] Define a GTraversable1 instance for U1.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index ecf120a08..5eec7356b 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -105,3 +105,6 @@ instance GTraversable1 c Par1 where
 
 instance (Traversable f, GTraversable1 c g) => GTraversable1 c (f :.: g) where
   gtraverse1 f g = fmap Comp1 . traverse (gtraverse1 @c f g) . unComp1
+
+instance GTraversable1 c U1 where
+  gtraverse1 _ _ _ = pure U1

From 04c3712f3665b583dbd5bfa3b54ff429077f2d2b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:26:11 -0500
Subject: [PATCH 276/318] Define a GTraversable1 instance for Rec1.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 5eec7356b..0eda96d92 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -103,6 +103,9 @@ instance GTraversable1 c (K1 R t) where
 instance GTraversable1 c Par1 where
   gtraverse1 f _ (Par1 a) = Par1 <$> f a
 
+instance c t => GTraversable1 c (Rec1 t) where
+  gtraverse1 _ g (Rec1 t) = Rec1 <$> g t
+
 instance (Traversable f, GTraversable1 c g) => GTraversable1 c (f :.: g) where
   gtraverse1 f g = fmap Comp1 . traverse (gtraverse1 @c f g) . unComp1
 

From 34114ef52d56583033c4008a405bdaafcb762416 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:27:03 -0500
Subject: [PATCH 277/318] :memo: gtraverse1.

---
 semantic-tags/src/Tags/Tagging/Precise.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 0eda96d92..ecbd6facb 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -80,6 +80,7 @@ instance GFoldable1 c U1 where
 
 
 class GTraversable1 c t where
+  -- | Generically map annotations and subterms of kind @* -> *@ into an 'Applicative' context.
   gtraverse1
     :: Applicative f
     => (a -> f b)

From 03c017e590184489c5b4c76964a8a1335d6c6875 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:28:29 -0500
Subject: [PATCH 278/318] Define a Traversable1 class.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index ecbd6facb..f9a9ab8f3 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -6,6 +6,7 @@ module Tags.Tagging.Precise
 , runTagging
 , firstLine
 , GFoldable1(..)
+, Traversable1(..)
 , GTraversable1(..)
 ) where
 
@@ -79,6 +80,14 @@ instance GFoldable1 c U1 where
   gfoldMap1 _ _ = mempty
 
 
+class Traversable1 c t where
+  traverse1
+    :: Applicative f
+    => (a -> f b)
+    -> (forall t' . c t' => t' a -> f (t' b))
+    -> t a
+    -> f (t b)
+
 class GTraversable1 c t where
   -- | Generically map annotations and subterms of kind @* -> *@ into an 'Applicative' context.
   gtraverse1

From 45ec40f1c3d4a2a5cc474b1c17a1d93887815a86 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:28:44 -0500
Subject: [PATCH 279/318] Reformat.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index f9a9ab8f3..18c77dfa1 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -1,4 +1,12 @@
-{-# LANGUAGE AllowAmbiguousTypes, ConstraintKinds, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeApplications, TypeOperators #-}
+{-# LANGUAGE AllowAmbiguousTypes   #-}
+{-# LANGUAGE ConstraintKinds       #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes            #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeApplications      #-}
+{-# LANGUAGE TypeOperators         #-}
 module Tags.Tagging.Precise
 ( Tags
 , ToTags(..)
@@ -13,13 +21,13 @@ module Tags.Tagging.Precise
 import Control.Carrier.Reader
 import Control.Carrier.Writer.Strict
 import Data.Functor.Identity
-import Data.Monoid (Endo(..))
+import Data.Monoid (Endo (..))
 import Data.Text as Text (Text, takeWhile)
 import GHC.Generics
 import Prelude hiding (span)
-import Source.Loc (Loc(..))
-import Source.Span
+import Source.Loc (Loc (..))
 import Source.Source as Source
+import Source.Span
 import Tags.Tag
 
 type Tags = Endo [Tag]

From bf3c17fada3f0529fc3a429457f17a123ce76904 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:29:17 -0500
Subject: [PATCH 280/318] =?UTF-8?q?Don=E2=80=99t=20align=20-#}s=20in=20LAN?=
 =?UTF-8?q?GUAGE=20pragmas.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 .stylish-haskell.yaml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.stylish-haskell.yaml b/.stylish-haskell.yaml
index c830a49e2..086cfc319 100644
--- a/.stylish-haskell.yaml
+++ b/.stylish-haskell.yaml
@@ -183,7 +183,7 @@ steps:
       #   between actual import and closing bracket.
       #
       # Default: true
-      align: true
+      align: false
 
       # stylish-haskell can detect redundancy of some language pragmas. If this
       # is set to true, it will remove those redundant pragmas. Default: true.

From 32dd435843ebab5fc12a6218bf2c1e627af6aed0 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:29:21 -0500
Subject: [PATCH 281/318] Reformat.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 18c77dfa1..a3f2194bd 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -1,12 +1,12 @@
-{-# LANGUAGE AllowAmbiguousTypes   #-}
-{-# LANGUAGE ConstraintKinds       #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE FlexibleInstances     #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE RankNTypes            #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE TypeApplications      #-}
-{-# LANGUAGE TypeOperators         #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
 module Tags.Tagging.Precise
 ( Tags
 , ToTags(..)

From 222c5642bec7112ab18d87c48b58675308f68763 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:30:26 -0500
Subject: [PATCH 282/318] Give a default signature for traverse1.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index a3f2194bd..20b79e027 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
@@ -95,6 +96,13 @@ class Traversable1 c t where
     -> (forall t' . c t' => t' a -> f (t' b))
     -> t a
     -> f (t b)
+  default traverse1
+    :: (Applicative f, Generic1 t, GTraversable1 c (Rep1 t))
+    => (a -> f b)
+    -> (forall t' . c t' => t' a -> f (t' b))
+    -> t a
+    -> f (t b)
+  traverse1 f g = fmap to1 . gtraverse1 @c f g . from1
 
 class GTraversable1 c t where
   -- | Generically map annotations and subterms of kind @* -> *@ into an 'Applicative' context.

From 0c6e09849badb6e057b5f78036b7457a4477709d Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:31:36 -0500
Subject: [PATCH 283/318] :memo: traverse1.

---
 semantic-tags/src/Tags/Tagging/Precise.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 20b79e027..67cd5d2c6 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -90,6 +90,7 @@ instance GFoldable1 c U1 where
 
 
 class Traversable1 c t where
+  -- | Map annotations and subterms of kind @* -> *@ into an 'Applicative' context.
   traverse1
     :: Applicative f
     => (a -> f b)

From a8f666ad5be2a5241b4e315a0cb6aba8998b2480 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:35:18 -0500
Subject: [PATCH 284/318] Define a foldMap1 convenience using traverse1.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 67cd5d2c6..5003ce1aa 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -16,11 +16,13 @@ module Tags.Tagging.Precise
 , firstLine
 , GFoldable1(..)
 , Traversable1(..)
+, foldMap1
 , GTraversable1(..)
 ) where
 
 import Control.Carrier.Reader
 import Control.Carrier.Writer.Strict
+import Data.Functor.Const
 import Data.Functor.Identity
 import Data.Monoid (Endo (..))
 import Data.Text as Text (Text, takeWhile)
@@ -105,6 +107,10 @@ class Traversable1 c t where
     -> f (t b)
   traverse1 f g = fmap to1 . gtraverse1 @c f g . from1
 
+foldMap1 :: forall c t b a . (Traversable1 c t, Monoid b) => (a -> b) -> (forall t' . c t' => t' a -> b) -> t a -> b
+foldMap1 f g = getConst . traverse1 @c (Const . f) (Const . g)
+
+
 class GTraversable1 c t where
   -- | Generically map annotations and subterms of kind @* -> *@ into an 'Applicative' context.
   gtraverse1

From a23ea55bb8f0a62e8b955ec026f6d32230dd58fc Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:39:06 -0500
Subject: [PATCH 285/318] Define a Generics newtype.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 5003ce1aa..d739d7b71 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -18,6 +18,7 @@ module Tags.Tagging.Precise
 , Traversable1(..)
 , foldMap1
 , GTraversable1(..)
+, Generics(..)
 ) where
 
 import Control.Carrier.Reader
@@ -144,3 +145,6 @@ instance (Traversable f, GTraversable1 c g) => GTraversable1 c (f :.: g) where
 
 instance GTraversable1 c U1 where
   gtraverse1 _ _ _ = pure U1
+
+
+newtype Generics t a = Generics { getGenerics :: t a }

From 0a869110b69c0c4d6b0f30df6b02b08ca61c9714 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:39:24 -0500
Subject: [PATCH 286/318] Derive some instances for Generics.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index d739d7b71..f0152d23a 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -1,8 +1,10 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
@@ -148,3 +150,4 @@ instance GTraversable1 c U1 where
 
 
 newtype Generics t a = Generics { getGenerics :: t a }
+  deriving (Foldable, Functor, Traversable)

From 281d62ba3d5b615ea9ab2cbf86d18b0fdb4c76d8 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:42:24 -0500
Subject: [PATCH 287/318] Define a Traversable1 instance for Generics t using
 the GTraversable1 instance for t.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index f0152d23a..90a6f0e8a 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -10,6 +10,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
 module Tags.Tagging.Precise
 ( Tags
 , ToTags(..)
@@ -151,3 +152,6 @@ instance GTraversable1 c U1 where
 
 newtype Generics t a = Generics { getGenerics :: t a }
   deriving (Foldable, Functor, Traversable)
+
+instance (Generic1 t, GTraversable1 c (Rep1 t)) => Traversable1 c (Generics t) where
+  traverse1 f g = fmap (Generics . to1) . gtraverse1 @c f g . from1 . getGenerics

From 37ead274fba05e95181dd7318a163107b51d3a36 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:45:24 -0500
Subject: [PATCH 288/318] :memo: Generics.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 90a6f0e8a..ad77283cb 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -150,6 +150,11 @@ instance GTraversable1 c U1 where
   gtraverse1 _ _ _ = pure U1
 
 
+-- | @'Generics' t@ has a 'Traversable1' instance when @'Rep1' t@ has a 'GTraversable1' instance, making this convenient for applying 'traverse1' to 'Generic1' types lacking 'Traversable1' instances:
+--
+-- @
+-- 'getGenerics' '<$>' 'traverse1' f g ('Generics' t) = 'to1' '<$>' 'gtraverse1' f g ('from1' t)
+-- @
 newtype Generics t a = Generics { getGenerics :: t a }
   deriving (Foldable, Functor, Traversable)
 

From dbe5eeec9f4278a099b94ac168f500205ac4a64c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:45:57 -0500
Subject: [PATCH 289/318] Define Python tagging using GTraversable1.

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

diff --git a/semantic-python/src/Language/Python/Tags.hs b/semantic-python/src/Language/Python/Tags.hs
index 1401121f1..b6c38f449 100644
--- a/semantic-python/src/Language/Python/Tags.hs
+++ b/semantic-python/src/Language/Python/Tags.hs
@@ -80,7 +80,7 @@ keywordFunctionCall
   :: ( Has (Reader Source) sig m
      , Has (Writer Tags.Tags) sig m
      , Generic1 t
-     , Tags.GFoldable1 ToTags (Rep1 t)
+     , Tags.GTraversable1 ToTags (Rep1 t)
      )
   => t Loc -> Loc -> Range -> Text -> m ()
 keywordFunctionCall t loc range name = do
@@ -162,11 +162,11 @@ gtags
   :: ( Has (Reader Source) sig m
      , Has (Writer Tags.Tags) sig m
      , Generic1 t
-     , Tags.GFoldable1 ToTags (Rep1 t)
+     , Tags.GTraversable1 ToTags (Rep1 t)
      )
   => t Loc
   -> m ()
-gtags = getAp . Tags.gfoldMap1 @ToTags (Ap . tags) . from1
+gtags = getAp . Tags.foldMap1 @ToTags (const mempty) (Ap . tags) . Tags.Generics
 
-instance (Generic1 t, Tags.GFoldable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
+instance (Generic1 t, Tags.GTraversable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
   tags' = gtags

From 73d69bdd1551fc33f2b08fcd38f784264fb3ae13 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:46:36 -0500
Subject: [PATCH 290/318] Add some FIXMEs about Traversable1 & GTraversable1.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index ad77283cb..51c85d4f6 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -95,6 +95,7 @@ instance GFoldable1 c U1 where
   gfoldMap1 _ _ = mempty
 
 
+-- FIXME: move Traversable1 into semantic-ast.
 class Traversable1 c t where
   -- | Map annotations and subterms of kind @* -> *@ into an 'Applicative' context.
   traverse1
@@ -115,6 +116,7 @@ foldMap1 :: forall c t b a . (Traversable1 c t, Monoid b) => (a -> b) -> (forall
 foldMap1 f g = getConst . traverse1 @c (Const . f) (Const . g)
 
 
+-- FIXME: move GTraversable1 into semantic-ast.
 class GTraversable1 c t where
   -- | Generically map annotations and subterms of kind @* -> *@ into an 'Applicative' context.
   gtraverse1

From de95f25edf2ee24e3c005d8950549dc7a9636270 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:47:14 -0500
Subject: [PATCH 291/318] Add a FIXME about deriving Traversable1 instances for
 our syntax types.

---
 semantic-tags/src/Tags/Tagging/Precise.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 51c85d4f6..0187e6613 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -96,6 +96,7 @@ instance GFoldable1 c U1 where
 
 
 -- FIXME: move Traversable1 into semantic-ast.
+-- FIXME: derive Traversable1 instances for TH-generated syntax types.
 class Traversable1 c t where
   -- | Map annotations and subterms of kind @* -> *@ into an 'Applicative' context.
   traverse1

From 666c09b7e2525ace462bea54274c3d09a496e30d Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:49:11 -0500
Subject: [PATCH 292/318] :memo: Traversable1.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 0187e6613..65956dc87 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -97,6 +97,8 @@ instance GFoldable1 c U1 where
 
 -- FIXME: move Traversable1 into semantic-ast.
 -- FIXME: derive Traversable1 instances for TH-generated syntax types.
+
+-- | Simultaneous traversal of subterms of kind @*@ and @* -> *@ in an 'Applicative' context.
 class Traversable1 c t where
   -- | Map annotations and subterms of kind @* -> *@ into an 'Applicative' context.
   traverse1

From 7521a810214f42c305e7c67343f6cc7f5260b0a4 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:50:57 -0500
Subject: [PATCH 293/318] A note on expressiveness.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 65956dc87..072a8b13a 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -99,6 +99,8 @@ instance GFoldable1 c U1 where
 -- FIXME: derive Traversable1 instances for TH-generated syntax types.
 
 -- | Simultaneous traversal of subterms of kind @*@ and @* -> *@ in an 'Applicative' context.
+--
+-- 'Traversable1' can express any combination of first- and second-order mapping, folding, and traversal.
 class Traversable1 c t where
   -- | Map annotations and subterms of kind @* -> *@ into an 'Applicative' context.
   traverse1

From a6bb06fb28478604c781ecd181dcf312db3b627f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:55:25 -0500
Subject: [PATCH 294/318] :memo: non-recursiveness.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 072a8b13a..d71400fed 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -103,6 +103,8 @@ instance GFoldable1 c U1 where
 -- 'Traversable1' can express any combination of first- and second-order mapping, folding, and traversal.
 class Traversable1 c t where
   -- | Map annotations and subterms of kind @* -> *@ into an 'Applicative' context.
+  --
+  -- Note that this traversal is non-recursive: any recursion through subterms must be performed by the second function argument.
   traverse1
     :: Applicative f
     => (a -> f b)

From e4aae306ba538836fdcc85855b37b84678359059 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:56:42 -0500
Subject: [PATCH 295/318] :memo: the constraint.

---
 semantic-tags/src/Tags/Tagging/Precise.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index d71400fed..8923b4401 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -102,7 +102,7 @@ instance GFoldable1 c U1 where
 --
 -- 'Traversable1' can express any combination of first- and second-order mapping, folding, and traversal.
 class Traversable1 c t where
-  -- | Map annotations and subterms of kind @* -> *@ into an 'Applicative' context.
+  -- | Map annotations of kind @*@ and heterogeneously-typed subterms of kind @* -> *@ under some constraint @c@ into an 'Applicative' context.
   --
   -- Note that this traversal is non-recursive: any recursion through subterms must be performed by the second function argument.
   traverse1

From cd7bfa12178ad16d040a5041bafdac191ffd4d4f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 13:57:48 -0500
Subject: [PATCH 296/318] :memo: the constraint a bit further.

---
 semantic-tags/src/Tags/Tagging/Precise.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 8923b4401..e350ae5ea 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -102,7 +102,7 @@ instance GFoldable1 c U1 where
 --
 -- 'Traversable1' can express any combination of first- and second-order mapping, folding, and traversal.
 class Traversable1 c t where
-  -- | Map annotations of kind @*@ and heterogeneously-typed subterms of kind @* -> *@ under some constraint @c@ into an 'Applicative' context.
+  -- | Map annotations of kind @*@ and heterogeneously-typed subterms of kind @* -> *@ under some constraint @c@ into an 'Applicative' context. The constraint is necessary to operate on otherwise universally-quantified subterms, since otherwise there would be insufficient information to inspect them at all.
   --
   -- Note that this traversal is non-recursive: any recursion through subterms must be performed by the second function argument.
   traverse1

From e7dff81e1d9dcb6a152a110dd29517a991291650 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 14:10:04 -0500
Subject: [PATCH 297/318] Demonstrate how to provide the constraint type.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index e350ae5ea..2e9587988 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -104,6 +104,12 @@ instance GFoldable1 c U1 where
 class Traversable1 c t where
   -- | Map annotations of kind @*@ and heterogeneously-typed subterms of kind @* -> *@ under some constraint @c@ into an 'Applicative' context. The constraint is necessary to operate on otherwise universally-quantified subterms, since otherwise there would be insufficient information to inspect them at all.
   --
+  -- No proxy is provided for the constraint @c@; instead, @-XTypeApplications@ should be used. E.g. here we ignore the annotations and print all the @* -> *@ subterms using 'Show1':
+  --
+  -- @
+  -- 'traverse1' \@'Data.Functor.Classes.Show1' 'pure' (\ t -> t '<$' 'putStrLn' ('Data.Functor.Classes.showsPrec1' 0 t ""))
+  -- @
+  --
   -- Note that this traversal is non-recursive: any recursion through subterms must be performed by the second function argument.
   traverse1
     :: Applicative f

From 5a57f1b7b429ccc8febb79a3e3b16c78dcac03c3 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 14:11:56 -0500
Subject: [PATCH 298/318] Define a for1 function by analogy with for.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 2e9587988..cd104c742 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -19,6 +19,7 @@ module Tags.Tagging.Precise
 , firstLine
 , GFoldable1(..)
 , Traversable1(..)
+, for1
 , foldMap1
 , GTraversable1(..)
 , Generics(..)
@@ -125,6 +126,15 @@ class Traversable1 c t where
     -> f (t b)
   traverse1 f g = fmap to1 . gtraverse1 @c f g . from1
 
+for1
+  :: forall c t f a b
+  .  (Traversable1 c t, Applicative f)
+  => t a
+  -> (a -> f b)
+  -> (forall t' . c t' => t' a -> f (t' b))
+  -> f (t b)
+for1 t f g = traverse1 @c f g t
+
 foldMap1 :: forall c t b a . (Traversable1 c t, Monoid b) => (a -> b) -> (forall t' . c t' => t' a -> b) -> t a -> b
 foldMap1 f g = getConst . traverse1 @c (Const . f) (Const . g)
 

From 90b99e200be9680664dc68bd83b2ff7fca0e2665 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 14:21:05 -0500
Subject: [PATCH 299/318] Use GTraversable1 for Go.

---
 semantic-go/src/Language/Go/Tags.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/semantic-go/src/Language/Go/Tags.hs b/semantic-go/src/Language/Go/Tags.hs
index 5b0b73542..fdb666ade 100644
--- a/semantic-go/src/Language/Go/Tags.hs
+++ b/semantic-go/src/Language/Go/Tags.hs
@@ -92,13 +92,13 @@ gtags
   :: ( Has (Reader Source) sig m
      , Has (Writer Tags.Tags) sig m
      , Generic1 t
-     , Tags.GFoldable1 ToTags (Rep1 t)
+     , Tags.GTraversable1 ToTags (Rep1 t)
      )
   => t Loc
   -> m ()
-gtags = getAp . Tags.gfoldMap1 @ToTags (Ap . tags) . from1
+gtags = getAp . Tags.foldMap1 @ToTags (const mempty) (Ap . tags) . Tags.Generics
 
-instance (Generic1 t, Tags.GFoldable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
+instance (Generic1 t, Tags.GTraversable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
   tags' = gtags
 
 yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> Kind -> Loc -> Range -> m ()

From d606702573b39e00c16b5b3fa3e87d33e870145f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 14:21:51 -0500
Subject: [PATCH 300/318] Use GTraversable1 for Java.

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

diff --git a/semantic-java/src/Language/Java/Tags.hs b/semantic-java/src/Language/Java/Tags.hs
index 6267e2ddb..d41966397 100644
--- a/semantic-java/src/Language/Java/Tags.hs
+++ b/semantic-java/src/Language/Java/Tags.hs
@@ -90,11 +90,11 @@ gtags
   :: ( Has (Reader Source) sig m
      , Has (Writer Tags.Tags) sig m
      , Generic1 t
-     , Tags.GFoldable1 ToTags (Rep1 t)
+     , Tags.GTraversable1 ToTags (Rep1 t)
      )
   => t Loc
   -> m ()
-gtags = getAp . Tags.gfoldMap1 @ToTags (Ap . tags) . from1
+gtags = getAp . Tags.foldMap1 @ToTags (const mempty) (Ap . tags) . Tags.Generics
 
-instance (Generic1 t, Tags.GFoldable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
+instance (Generic1 t, Tags.GTraversable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
   tags' = gtags

From 4f0a2d708b2139b1273490ab6ef4caa5fa5fe358 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 14:22:33 -0500
Subject: [PATCH 301/318] Use GTraversable1 for TSX.

---
 semantic-tsx/src/Language/TSX/Tags.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/semantic-tsx/src/Language/TSX/Tags.hs b/semantic-tsx/src/Language/TSX/Tags.hs
index d3f9fc2bf..05bfcb32e 100644
--- a/semantic-tsx/src/Language/TSX/Tags.hs
+++ b/semantic-tsx/src/Language/TSX/Tags.hs
@@ -133,13 +133,13 @@ gtags
   :: ( Has (Reader Source) sig m
      , Has (Writer Tags.Tags) sig m
      , Generic1 t
-     , Tags.GFoldable1 ToTags (Rep1 t)
+     , Tags.GTraversable1 ToTags (Rep1 t)
      )
   => t Loc
   -> m ()
-gtags = getAp . Tags.gfoldMap1 @ToTags (Ap . tags) . from1
+gtags = getAp . Tags.foldMap1 @ToTags (const mempty) (Ap . tags) . Tags.Generics
 
-instance (Generic1 t, Tags.GFoldable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
+instance (Generic1 t, Tags.GTraversable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
   tags' = gtags
 
 yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> Kind -> Loc -> Range -> m ()

From 0a44a569adff1666e4bcee99d48ebc97faf811b6 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 14:23:18 -0500
Subject: [PATCH 302/318] Use GTraversable1 for TypeScript.

---
 semantic-typescript/src/Language/TypeScript/Tags.hs | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/semantic-typescript/src/Language/TypeScript/Tags.hs b/semantic-typescript/src/Language/TypeScript/Tags.hs
index d964cdf20..43f5f24e9 100644
--- a/semantic-typescript/src/Language/TypeScript/Tags.hs
+++ b/semantic-typescript/src/Language/TypeScript/Tags.hs
@@ -125,13 +125,13 @@ gtags
   :: ( Has (Reader Source) sig m
      , Has (Writer Tags.Tags) sig m
      , Generic1 t
-     , Tags.GFoldable1 ToTags (Rep1 t)
+     , Tags.GTraversable1 ToTags (Rep1 t)
      )
   => t Loc
   -> m ()
-gtags = getAp . Tags.gfoldMap1 @ToTags (Ap . tags) . from1
+gtags = getAp . Tags.foldMap1 @ToTags (const mempty) (Ap . tags) . Tags.Generics
 
-instance (Generic1 t, Tags.GFoldable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
+instance (Generic1 t, Tags.GTraversable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
   tags' = gtags
 
 yieldTag :: (Has (Reader Source) sig m, Has (Writer Tags.Tags) sig m) => Text -> Kind -> Loc -> Range -> m ()

From 1da4260cd7e126ea3eab8901545cbefc578a7e7d Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 14:24:17 -0500
Subject: [PATCH 303/318] Use GTraversable1 for Ruby.

---
 semantic-ruby/src/Language/Ruby/Tags.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/semantic-ruby/src/Language/Ruby/Tags.hs b/semantic-ruby/src/Language/Ruby/Tags.hs
index 0074e8016..f336112fe 100644
--- a/semantic-ruby/src/Language/Ruby/Tags.hs
+++ b/semantic-ruby/src/Language/Ruby/Tags.hs
@@ -153,7 +153,7 @@ yieldMethodNameTag
      , Has (Reader Source) sig m
      , Has (Writer Tags.Tags) sig m
      , Generic1 t
-     , Tags.GFoldable1 ToTags (Rep1 t)
+     , Tags.GTraversable1 ToTags (Rep1 t)
      ) => t Loc -> Loc -> Range -> Rb.MethodName Loc -> m ()
 yieldMethodNameTag t loc range (Rb.MethodName expr) = enterScope True $ case expr of
   Prj Rb.Identifier { text = name } -> yield name
@@ -307,11 +307,11 @@ gtags
      , Has (Writer Tags.Tags) sig m
      , Has (State [Text]) sig m
      , Generic1 t
-     , Tags.GFoldable1 ToTags (Rep1 t)
+     , Tags.GTraversable1 ToTags (Rep1 t)
      )
   => t Loc
   -> m ()
-gtags = getAp . Tags.gfoldMap1 @ToTags (Ap . tags) . from1
+gtags = getAp . Tags.foldMap1 @ToTags (const mempty) (Ap . tags) . Tags.Generics
 
-instance (Generic1 t, Tags.GFoldable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
+instance (Generic1 t, Tags.GTraversable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
   tags' = gtags

From 81aab02035867556f3cbcc055008320dd1883eec Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 14:24:42 -0500
Subject: [PATCH 304/318] :fire: GFoldable1.

---
 semantic-tags/src/Tags/Tagging/Precise.hs | 36 -----------------------
 1 file changed, 36 deletions(-)

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index cd104c742..08ec098f3 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -17,7 +17,6 @@ module Tags.Tagging.Precise
 , yield
 , runTagging
 , firstLine
-, GFoldable1(..)
 , Traversable1(..)
 , for1
 , foldMap1
@@ -61,41 +60,6 @@ firstLine :: Source -> Text
 firstLine = Text.takeWhile (/= '\n') . toText . Source.take 180
 
 
--- FIXME: move GFoldable1 into semantic-ast.
-class GFoldable1 c t where
-  -- | Generically map functions over fields of kind @* -> *@, monoidally combining the results.
-  gfoldMap1
-    :: Monoid b
-    => (forall f . c f => f a -> b)
-    -> t a
-    -> b
-
-instance GFoldable1 c f => GFoldable1 c (M1 i c' f) where
-  gfoldMap1 alg = gfoldMap1 @c alg . unM1
-
-instance (GFoldable1 c f, GFoldable1 c g) => GFoldable1 c (f :*: g) where
-  gfoldMap1 alg (f :*: g) = gfoldMap1 @c alg f <> gfoldMap1 @c alg g
-
-instance (GFoldable1 c f, GFoldable1 c g) => GFoldable1 c (f :+: g) where
-  gfoldMap1 alg (L1 l) = gfoldMap1 @c alg l
-  gfoldMap1 alg (R1 r) = gfoldMap1 @c alg r
-
-instance GFoldable1 c (K1 R t) where
-  gfoldMap1 _ _ = mempty
-
-instance GFoldable1 c Par1 where
-  gfoldMap1 _ _ = mempty
-
-instance c t => GFoldable1 c (Rec1 t) where
-  gfoldMap1 alg (Rec1 t) = alg t
-
-instance (Foldable f, GFoldable1 c g) => GFoldable1 c (f :.: g) where
-  gfoldMap1 alg = foldMap (gfoldMap1 @c alg) . unComp1
-
-instance GFoldable1 c U1 where
-  gfoldMap1 _ _ = mempty
-
-
 -- FIXME: move Traversable1 into semantic-ast.
 -- FIXME: derive Traversable1 instances for TH-generated syntax types.
 

From d979ce7d19245cab10a2effdb6d6a8c7ed791adc Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 14:27:37 -0500
Subject: [PATCH 305/318] Define a foldMapDefault1 function usable as a default
 definition of foldMap.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 08ec098f3..46a9cb0ed 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -20,6 +20,7 @@ module Tags.Tagging.Precise
 , Traversable1(..)
 , for1
 , foldMap1
+, foldMapDefault1
 , GTraversable1(..)
 , Generics(..)
 ) where
@@ -103,6 +104,11 @@ foldMap1 :: forall c t b a . (Traversable1 c t, Monoid b) => (a -> b) -> (forall
 foldMap1 f g = getConst . traverse1 @c (Const . f) (Const . g)
 
 
+-- | This function may be used as a value for 'foldMap' in a 'Foldable' instance.
+foldMapDefault1 :: (Traversable1 Foldable t, Monoid b) => (a -> b) -> t a -> b
+foldMapDefault1 f = foldMap1 @Foldable f (foldMap f)
+
+
 -- FIXME: move GTraversable1 into semantic-ast.
 class GTraversable1 c t where
   -- | Generically map annotations and subterms of kind @* -> *@ into an 'Applicative' context.

From cf9e9022ccab6c188f92f4ea5cad9741097d2976 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 14:29:35 -0500
Subject: [PATCH 306/318] Define an fmapDefault1 function usable as a default
 definition of fmap.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 46a9cb0ed..2d18b9ded 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -21,6 +21,7 @@ module Tags.Tagging.Precise
 , for1
 , foldMap1
 , foldMapDefault1
+, fmapDefault1
 , GTraversable1(..)
 , Generics(..)
 ) where
@@ -108,6 +109,10 @@ foldMap1 f g = getConst . traverse1 @c (Const . f) (Const . g)
 foldMapDefault1 :: (Traversable1 Foldable t, Monoid b) => (a -> b) -> t a -> b
 foldMapDefault1 f = foldMap1 @Foldable f (foldMap f)
 
+-- | This function may be used as a value for 'fmap' in a 'Functor' instance.
+fmapDefault1 :: Traversable1 Functor t => (a -> b) -> t a -> t b
+fmapDefault1 f = runIdentity . traverse1 @Functor (Identity . f) (Identity . fmap f)
+
 
 -- FIXME: move GTraversable1 into semantic-ast.
 class GTraversable1 c t where

From 19ea5b1bbacdf17db7a137a8d71591e068d69070 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 14:33:30 -0500
Subject: [PATCH 307/318] Define a traverse1_ helper.

---
 semantic-tags/src/Tags/Tagging/Precise.hs | 13 ++++++++++++-
 1 file changed, 12 insertions(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 2d18b9ded..87e26e369 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -19,6 +19,7 @@ module Tags.Tagging.Precise
 , firstLine
 , Traversable1(..)
 , for1
+, traverse1_
 , foldMap1
 , foldMapDefault1
 , fmapDefault1
@@ -28,9 +29,10 @@ module Tags.Tagging.Precise
 
 import Control.Carrier.Reader
 import Control.Carrier.Writer.Strict
+import Data.Functor (void)
 import Data.Functor.Const
 import Data.Functor.Identity
-import Data.Monoid (Endo (..))
+import Data.Monoid (Ap (..), Endo (..))
 import Data.Text as Text (Text, takeWhile)
 import GHC.Generics
 import Prelude hiding (span)
@@ -101,6 +103,15 @@ for1
   -> f (t b)
 for1 t f g = traverse1 @c f g t
 
+traverse1_
+  :: forall c t f a a' a''
+  .  (Traversable1 c t, Applicative f)
+  => (a -> f a')
+  -> (forall t' . c t' => t' a -> f a'')
+  -> t a
+  -> f ()
+traverse1_ f g = getAp . foldMap1 @c (Ap . void . f) (Ap . void . g)
+
 foldMap1 :: forall c t b a . (Traversable1 c t, Monoid b) => (a -> b) -> (forall t' . c t' => t' a -> b) -> t a -> b
 foldMap1 f g = getConst . traverse1 @c (Const . f) (Const . g)
 

From 48420dfcd60fd27a2a824ba6f0fa31e08a16c0ec Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 14:37:18 -0500
Subject: [PATCH 308/318] Define a for1_ helper.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 87e26e369..b08c62c48 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -20,6 +20,7 @@ module Tags.Tagging.Precise
 , Traversable1(..)
 , for1
 , traverse1_
+, for1_
 , foldMap1
 , foldMapDefault1
 , fmapDefault1
@@ -112,6 +113,15 @@ traverse1_
   -> f ()
 traverse1_ f g = getAp . foldMap1 @c (Ap . void . f) (Ap . void . g)
 
+for1_
+  :: forall c t f a a' a''
+  .  (Traversable1 c t, Applicative f)
+  => t a
+  -> (a -> f a')
+  -> (forall t' . c t' => t' a -> f a'')
+  -> f ()
+for1_ t f g = getAp $ foldMap1 @c (Ap . void . f) (Ap . void . g) t
+
 foldMap1 :: forall c t b a . (Traversable1 c t, Monoid b) => (a -> b) -> (forall t' . c t' => t' a -> b) -> t a -> b
 foldMap1 f g = getConst . traverse1 @c (Const . f) (Const . g)
 

From c3a6f7b1b8eb5cb134c35b71212e79986c2fe948 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 14:42:16 -0500
Subject: [PATCH 309/318] Define a traverseDefault1 function usable as a
 default definition of traverse.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index b08c62c48..c5806b64c 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -24,6 +24,7 @@ module Tags.Tagging.Precise
 , foldMap1
 , foldMapDefault1
 , fmapDefault1
+, traverseDefault1
 , GTraversable1(..)
 , Generics(..)
 ) where
@@ -134,6 +135,10 @@ foldMapDefault1 f = foldMap1 @Foldable f (foldMap f)
 fmapDefault1 :: Traversable1 Functor t => (a -> b) -> t a -> t b
 fmapDefault1 f = runIdentity . traverse1 @Functor (Identity . f) (Identity . fmap f)
 
+-- | This function may be used as a value for 'traverse' in a 'Traversable' instance.
+traverseDefault1 :: (Traversable1 Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b)
+traverseDefault1 f = traverse1 @Traversable f (traverse f)
+
 
 -- FIXME: move GTraversable1 into semantic-ast.
 class GTraversable1 c t where

From 8f51d1803f233c63893a8ec34119718bf9d2a58b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 14:42:44 -0500
Subject: [PATCH 310/318] Define the Foldable, Functor, & Traversable instances
 for Generics using Traversable1.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index c5806b64c..ec9b5680d 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DefaultSignatures #-}
-{-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -182,7 +181,15 @@ instance GTraversable1 c U1 where
 -- 'getGenerics' '<$>' 'traverse1' f g ('Generics' t) = 'to1' '<$>' 'gtraverse1' f g ('from1' t)
 -- @
 newtype Generics t a = Generics { getGenerics :: t a }
-  deriving (Foldable, Functor, Traversable)
+
+instance (Generic1 t, GTraversable1 Foldable (Rep1 t)) => Foldable (Generics t) where
+  foldMap = foldMapDefault1
+
+instance (Generic1 t, GTraversable1 Functor (Rep1 t)) => Functor (Generics t) where
+  fmap = fmapDefault1
+
+instance (Generic1 t, GTraversable1 Foldable (Rep1 t), GTraversable1 Functor (Rep1 t), GTraversable1 Traversable (Rep1 t)) => Traversable (Generics t) where
+  traverse = traverseDefault1
 
 instance (Generic1 t, GTraversable1 c (Rep1 t)) => Traversable1 c (Generics t) where
   traverse1 f g = fmap (Generics . to1) . gtraverse1 @c f g . from1 . getGenerics

From 4213fdd7bda28dfabc4950b84f9f8f2f38405956 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 14:43:09 -0500
Subject: [PATCH 311/318] :fire: GeneralizedNewtypeDeriving.

---
 semantic-tags/src/Tags/Tagging/Precise.hs | 1 -
 1 file changed, 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index ec9b5680d..1eb299b3f 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -3,7 +3,6 @@
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}

From adf22f079f401dc0efe564c823ac5c038b7fc1e3 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 14:45:08 -0500
Subject: [PATCH 312/318] :memo: using Generics with -XDerivingVia.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 1eb299b3f..917c5bfe5 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -179,6 +179,8 @@ instance GTraversable1 c U1 where
 -- @
 -- 'getGenerics' '<$>' 'traverse1' f g ('Generics' t) = 'to1' '<$>' 'gtraverse1' f g ('from1' t)
 -- @
+--
+-- It further defines its 'Foldable', 'Functor', and 'Traversable' instances thus, making it suitable for use with @-XDerivingVia@.
 newtype Generics t a = Generics { getGenerics :: t a }
 
 instance (Generic1 t, GTraversable1 Foldable (Rep1 t)) => Foldable (Generics t) where

From 9e966e0ff8b412523d8df4f3271d01481415a1cf Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 14:45:46 -0500
Subject: [PATCH 313/318] Clarify the comment.

---
 semantic-tags/src/Tags/Tagging/Precise.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 917c5bfe5..9a7e3e985 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -180,7 +180,7 @@ instance GTraversable1 c U1 where
 -- 'getGenerics' '<$>' 'traverse1' f g ('Generics' t) = 'to1' '<$>' 'gtraverse1' f g ('from1' t)
 -- @
 --
--- It further defines its 'Foldable', 'Functor', and 'Traversable' instances thus, making it suitable for use with @-XDerivingVia@.
+-- It further defines its 'Foldable', 'Functor', and 'Traversable' instances using 'Traversable1', making it suitable for deriving with @-XDerivingVia@.
 newtype Generics t a = Generics { getGenerics :: t a }
 
 instance (Generic1 t, GTraversable1 Foldable (Rep1 t)) => Foldable (Generics t) where

From 9c4818e827933165894552513d1847129da16f4f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 14:58:09 -0500
Subject: [PATCH 314/318] Perform tagging using traverse1_.

---
 semantic-go/src/Language/Go/Tags.hs                 | 3 +--
 semantic-java/src/Language/Java/Tags.hs             | 3 +--
 semantic-python/src/Language/Python/Tags.hs         | 3 +--
 semantic-ruby/src/Language/Ruby/Tags.hs             | 3 +--
 semantic-tsx/src/Language/TSX/Tags.hs               | 3 +--
 semantic-typescript/src/Language/TypeScript/Tags.hs | 3 +--
 6 files changed, 6 insertions(+), 12 deletions(-)

diff --git a/semantic-go/src/Language/Go/Tags.hs b/semantic-go/src/Language/Go/Tags.hs
index fdb666ade..19e9852e1 100644
--- a/semantic-go/src/Language/Go/Tags.hs
+++ b/semantic-go/src/Language/Go/Tags.hs
@@ -19,7 +19,6 @@ module Language.Go.Tags
 import           AST.Element
 import           Control.Effect.Reader
 import           Control.Effect.Writer
-import           Data.Monoid (Ap (..))
 import           Data.Text as Text
 import           GHC.Generics
 import           Source.Loc
@@ -96,7 +95,7 @@ gtags
      )
   => t Loc
   -> m ()
-gtags = getAp . Tags.foldMap1 @ToTags (const mempty) (Ap . tags) . Tags.Generics
+gtags = Tags.traverse1_ @ToTags (const (pure ())) tags . Tags.Generics
 
 instance (Generic1 t, Tags.GTraversable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
   tags' = gtags
diff --git a/semantic-java/src/Language/Java/Tags.hs b/semantic-java/src/Language/Java/Tags.hs
index d41966397..01ba7226e 100644
--- a/semantic-java/src/Language/Java/Tags.hs
+++ b/semantic-java/src/Language/Java/Tags.hs
@@ -5,7 +5,6 @@ module Language.Java.Tags
 
 import           Control.Effect.Reader
 import           Control.Effect.Writer
-import           Data.Monoid (Ap(..))
 import           GHC.Generics
 import           Source.Loc
 import           Source.Range
@@ -94,7 +93,7 @@ gtags
      )
   => t Loc
   -> m ()
-gtags = getAp . Tags.foldMap1 @ToTags (const mempty) (Ap . tags) . Tags.Generics
+gtags = Tags.traverse1_ @ToTags (const (pure ())) tags . Tags.Generics
 
 instance (Generic1 t, Tags.GTraversable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
   tags' = gtags
diff --git a/semantic-python/src/Language/Python/Tags.hs b/semantic-python/src/Language/Python/Tags.hs
index b6c38f449..497de30f3 100644
--- a/semantic-python/src/Language/Python/Tags.hs
+++ b/semantic-python/src/Language/Python/Tags.hs
@@ -20,7 +20,6 @@ import           AST.Element
 import           Control.Effect.Reader
 import           Control.Effect.Writer
 import           Data.Maybe (listToMaybe)
-import           Data.Monoid (Ap(..))
 import           Data.List.NonEmpty (NonEmpty(..))
 import           Data.Text as Text
 import           GHC.Generics
@@ -166,7 +165,7 @@ gtags
      )
   => t Loc
   -> m ()
-gtags = getAp . Tags.foldMap1 @ToTags (const mempty) (Ap . tags) . Tags.Generics
+gtags = Tags.traverse1_ @ToTags (const (pure ())) tags . Tags.Generics
 
 instance (Generic1 t, Tags.GTraversable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
   tags' = gtags
diff --git a/semantic-ruby/src/Language/Ruby/Tags.hs b/semantic-ruby/src/Language/Ruby/Tags.hs
index f336112fe..4c4f84ae9 100644
--- a/semantic-ruby/src/Language/Ruby/Tags.hs
+++ b/semantic-ruby/src/Language/Ruby/Tags.hs
@@ -22,7 +22,6 @@ import           Control.Effect.Reader
 import           Control.Effect.State
 import           Control.Effect.Writer
 import           Control.Monad
-import           Data.Monoid (Ap (..))
 import           Data.Foldable
 import           Data.Text as Text
 import           GHC.Generics
@@ -311,7 +310,7 @@ gtags
      )
   => t Loc
   -> m ()
-gtags = getAp . Tags.foldMap1 @ToTags (const mempty) (Ap . tags) . Tags.Generics
+gtags = Tags.traverse1_ @ToTags (const (pure ())) tags . Tags.Generics
 
 instance (Generic1 t, Tags.GTraversable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
   tags' = gtags
diff --git a/semantic-tsx/src/Language/TSX/Tags.hs b/semantic-tsx/src/Language/TSX/Tags.hs
index 05bfcb32e..159092838 100644
--- a/semantic-tsx/src/Language/TSX/Tags.hs
+++ b/semantic-tsx/src/Language/TSX/Tags.hs
@@ -21,7 +21,6 @@ import           AST.Element
 import           Control.Effect.Reader
 import           Control.Effect.Writer
 import           Data.Foldable
-import           Data.Monoid (Ap (..))
 import           Data.Text as Text
 import           GHC.Generics
 import           Source.Loc
@@ -137,7 +136,7 @@ gtags
      )
   => t Loc
   -> m ()
-gtags = getAp . Tags.foldMap1 @ToTags (const mempty) (Ap . tags) . Tags.Generics
+gtags = Tags.traverse1_ @ToTags (const (pure ())) tags . Tags.Generics
 
 instance (Generic1 t, Tags.GTraversable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
   tags' = gtags
diff --git a/semantic-typescript/src/Language/TypeScript/Tags.hs b/semantic-typescript/src/Language/TypeScript/Tags.hs
index 43f5f24e9..c810d04cd 100644
--- a/semantic-typescript/src/Language/TypeScript/Tags.hs
+++ b/semantic-typescript/src/Language/TypeScript/Tags.hs
@@ -21,7 +21,6 @@ import           AST.Element
 import           Control.Effect.Reader
 import           Control.Effect.Writer
 import           Data.Foldable
-import           Data.Monoid (Ap (..))
 import           Data.Text as Text
 import           GHC.Generics
 import           Source.Loc
@@ -129,7 +128,7 @@ gtags
      )
   => t Loc
   -> m ()
-gtags = getAp . Tags.foldMap1 @ToTags (const mempty) (Ap . tags) . Tags.Generics
+gtags = Tags.traverse1_ @ToTags (const (pure ())) tags . Tags.Generics
 
 instance (Generic1 t, Tags.GTraversable1 ToTags (Rep1 t)) => ToTagsBy 'Generic t where
   tags' = gtags

From 98f3ff7e8ab96b91e0f68efed1389efe372e0f70 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 15:26:30 -0500
Subject: [PATCH 315/318] Overwrite hlint on install if necessary.

---
 .github/workflows/haskell.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml
index a00a54b46..f50255ec3 100644
--- a/.github/workflows/haskell.yml
+++ b/.github/workflows/haskell.yml
@@ -53,7 +53,7 @@ jobs:
 
     - name: hlint
       run: |
-        cabal install hlint --installdir=dist-newstyle
+        cabal install hlint --installdir=dist-newstyle --overwrite-policy=always
         dist-newstyle/hlint src semantic-python
 
     - name: Build & test

From 766fb12b160855a4bce1466dcb4d6380d941605c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 15:27:36 -0500
Subject: [PATCH 316/318] Revert "Overwrite hlint on install if necessary."

This reverts commit 98f3ff7e8ab96b91e0f68efed1389efe372e0f70.
---
 .github/workflows/haskell.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml
index f50255ec3..a00a54b46 100644
--- a/.github/workflows/haskell.yml
+++ b/.github/workflows/haskell.yml
@@ -53,7 +53,7 @@ jobs:
 
     - name: hlint
       run: |
-        cabal install hlint --installdir=dist-newstyle --overwrite-policy=always
+        cabal install hlint --installdir=dist-newstyle
         dist-newstyle/hlint src semantic-python
 
     - name: Build & test

From 2351ba4adacd11d01b1974094fc727c599695701 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 13 Jan 2020 15:28:40 -0500
Subject: [PATCH 317/318] Use the existing hlint if we have one.

---
 .github/workflows/haskell.yml | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/.github/workflows/haskell.yml b/.github/workflows/haskell.yml
index a00a54b46..9d1b37e48 100644
--- a/.github/workflows/haskell.yml
+++ b/.github/workflows/haskell.yml
@@ -53,7 +53,7 @@ jobs:
 
     - name: hlint
       run: |
-        cabal install hlint --installdir=dist-newstyle
+        test -f dist-newstyle/hlint || cabal install hlint --installdir=dist-newstyle
         dist-newstyle/hlint src semantic-python
 
     - name: Build & test

From 235703c21740057b18cf54201d5fcb3b836dc5d1 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 14 Jan 2020 13:42:40 -0500
Subject: [PATCH 318/318] Note why the 1 suffix.

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

diff --git a/semantic-tags/src/Tags/Tagging/Precise.hs b/semantic-tags/src/Tags/Tagging/Precise.hs
index 9a7e3e985..f8b3d8436 100644
--- a/semantic-tags/src/Tags/Tagging/Precise.hs
+++ b/semantic-tags/src/Tags/Tagging/Precise.hs
@@ -70,6 +70,8 @@ firstLine = Text.takeWhile (/= '\n') . toText . Source.take 180
 -- | Simultaneous traversal of subterms of kind @*@ and @* -> *@ in an 'Applicative' context.
 --
 -- 'Traversable1' can express any combination of first- and second-order mapping, folding, and traversal.
+--
+-- Note that the @1@ suffix is used in the manner of 'Data.Functor.Classes.Show1' or 'Generic1', rather than 'foldr1'; it’s a higher-order traversal which is simultaneously able to traverse (and alter) annotations.
 class Traversable1 c t where
   -- | Map annotations of kind @*@ and heterogeneously-typed subterms of kind @* -> *@ under some constraint @c@ into an 'Applicative' context. The constraint is necessary to operate on otherwise universally-quantified subterms, since otherwise there would be insufficient information to inspect them at all.
   --