From 455990dbc22beb33a15b42664fe951873323f0a1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Wed, 24 Jul 2019 08:07:35 -0400
Subject: [PATCH 01/27] =?UTF-8?q?Change=20entrySymbol=E2=80=99s=20type=20t?=
 =?UTF-8?q?o=20Text.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index 19fa1dcd1c..09bd29fd2b 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -6,9 +6,10 @@ module Analysis.ScopeGraph
 import           Data.Loc
 import qualified Data.Map as Map
 import qualified Data.Set as Set
+import qualified Data.Text as Text
 
 data Entry = Entry
-  { entrySymbol :: String -- FIXME: Text
+  { entrySymbol :: Text.Text
   , entryLoc    :: Loc
   }
 

From 8c59f9dc42eac94d958da71438dda36e9f241902 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 25 Jul 2019 09:30:02 -0400
Subject: [PATCH 02/27] Only import the one symbol from Data.Text.

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

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index 09bd29fd2b..42c8626214 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -6,10 +6,10 @@ module Analysis.ScopeGraph
 import           Data.Loc
 import qualified Data.Map as Map
 import qualified Data.Set as Set
-import qualified Data.Text as Text
+import           Data.Text (Text)
 
 data Entry = Entry
-  { entrySymbol :: Text.Text
+  { entrySymbol :: Text
   , entryLoc    :: Loc
   }
 

From 5a40e01ff1c743a2a0337fcc76e8beb092f584cb Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 25 Jul 2019 09:30:15 -0400
Subject: [PATCH 03/27] Derive Eq, Ord, & Show instances for Entry.

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

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index 42c8626214..ef631aad7f 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -12,5 +12,6 @@ data Entry = Entry
   { entrySymbol :: Text
   , entryLoc    :: Loc
   }
+  deriving (Eq, Ord, Show)
 
 type ScopeGraph = Map.Map Entry (Set.Set Entry)

From 057a4f8b5a872f06b006643af78e11005118b070 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 25 Jul 2019 09:31:36 -0400
Subject: [PATCH 04/27] Copy in the import graph definition.

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

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index ef631aad7f..b512d2fced 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -1,12 +1,31 @@
+{-# LANGUAGE FlexibleContexts, OverloadedStrings, RecordWildCards, TypeApplications #-}
 module Analysis.ScopeGraph
 ( ScopeGraph
 , Entry(..)
+, scopeGraph
+, scopeGraphAnalysis
 ) where
 
+import           Analysis.Eval
+import           Analysis.FlowInsensitive
+import           Control.Applicative (Alternative (..))
+import           Control.Effect.Carrier
+import           Control.Effect.Fail
+import           Control.Effect.Fresh
+import           Control.Effect.Reader
+import           Control.Effect.State
+import qualified Data.Core as Core
+import           Data.File
+import           Data.Foldable (fold)
+import           Data.Function (fix)
+import           Data.List.NonEmpty
 import           Data.Loc
 import qualified Data.Map as Map
+import           Data.Name
 import qualified Data.Set as Set
 import           Data.Text (Text)
+import           Data.Term
+import           Prelude hiding (fail)
 
 data Entry = Entry
   { entrySymbol :: Text
@@ -15,3 +34,80 @@ data Entry = Entry
   deriving (Eq, Ord, Show)
 
 type ScopeGraph = Map.Map Entry (Set.Set Entry)
+
+
+data Value = Value
+  { valueSemi  :: Semi
+  , valueGraph :: ScopeGraph
+  }
+  deriving (Eq, Ord, Show)
+
+instance Semigroup Value where
+  Value _ g1 <> Value _ g2 = Value Abstract (Map.unionWith (<>) g1 g2)
+
+instance Monoid Value where
+  mempty = Value Abstract mempty
+
+data Semi
+  = Closure Loc User (Term Core.Core User) User
+  -- FIXME: Bound String values.
+  | String Text
+  | Abstract
+  deriving (Eq, Ord, Show)
+
+
+scopeGraph :: [File (Term Core.Core User)] -> (Heap User Value, [File (Either (Loc, String) Value)])
+scopeGraph
+  = run
+  . runFresh
+  . runHeap "__semantic_root"
+  . traverse runFile
+
+runFile
+  :: ( Carrier sig m
+     , Effect sig
+     , Member Fresh sig
+     , Member (Reader (FrameId User)) sig
+     , Member (State (Heap User Value)) sig
+     )
+  => File (Term Core.Core User)
+  -> m (File (Either (Loc, String) Value))
+runFile file = traverse run file
+  where run = runReader (fileLoc file)
+            . runFailWithLoc
+            . fmap fold
+            . convergeTerm (fix (cacheTerm . eval scopeGraphAnalysis))
+
+-- FIXME: decompose into a product domain and two atomic domains
+scopeGraphAnalysis
+  :: ( Alternative m
+     , Carrier sig m
+     , Member (Reader (FrameId User)) sig
+     , Member (Reader Loc) sig
+     , Member (State (Heap User Value)) sig
+     , MonadFail m
+     )
+  => Analysis User Value m
+scopeGraphAnalysis = Analysis{..}
+  where alloc = pure
+        bind _ _ m = m
+        lookupEnv = pure . Just
+        deref addr = gets (Map.lookup addr) >>= maybe (pure Nothing) (foldMapA (pure . Just)) . nonEmpty . maybe [] (Set.toList @Value)
+        assign addr ty = modify (Map.insertWith (<>) addr (Set.singleton ty))
+        abstract _ name body = do
+          loc <- ask
+          FrameId parentAddr <- ask
+          pure (Value (Closure loc name body parentAddr) mempty)
+        apply eval (Value (Closure loc name body _) _) a = local (const loc) $ do
+          addr <- alloc name
+          assign addr a
+          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
+        record fields = pure (Value Abstract (foldMap (valueGraph . snd) fields))
+        _ ... m = pure (Just m)

From 53e08b38baf62dc492124ea75ed2071f755e4626 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 25 Jul 2019 13:03:05 -0400
Subject: [PATCH 05/27] :fire: the specialization of String in the scope graph.

---
 semantic-core/src/Analysis/ScopeGraph.hs | 5 +----
 1 file changed, 1 insertion(+), 4 deletions(-)

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index b512d2fced..ee174dc42c 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -50,8 +50,6 @@ instance Monoid Value where
 
 data Semi
   = Closure Loc User (Term Core.Core User) User
-  -- FIXME: Bound String values.
-  | String Text
   | Abstract
   deriving (Eq, Ord, Show)
 
@@ -106,8 +104,7 @@ scopeGraphAnalysis = Analysis{..}
         unit = pure mempty
         bool _ = pure mempty
         asBool _ = pure True <|> pure False
-        string s = pure (Value (String s) mempty)
-        asString (Value (String s) _) = pure s
+        string _ = pure mempty
         asString _ = pure mempty
         record fields = pure (Value Abstract (foldMap (valueGraph . snd) fields))
         _ ... m = pure (Just m)

From 3654aac2c8d5520a20013f486b1de9b1ff214be6 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 25 Jul 2019 13:09:16 -0400
Subject: [PATCH 06/27] :fire: the parent addr from the import & scope graph
 analyses.

---
 semantic-core/src/Analysis/ImportGraph.hs | 9 +++------
 semantic-core/src/Analysis/ScopeGraph.hs  | 9 +++------
 2 files changed, 6 insertions(+), 12 deletions(-)

diff --git a/semantic-core/src/Analysis/ImportGraph.hs b/semantic-core/src/Analysis/ImportGraph.hs
index 5e87e38ec1..115238cabe 100644
--- a/semantic-core/src/Analysis/ImportGraph.hs
+++ b/semantic-core/src/Analysis/ImportGraph.hs
@@ -41,7 +41,7 @@ instance Monoid Value where
   mempty = Value Abstract mempty
 
 data Semi
-  = Closure Loc User (Term Core.Core User) User
+  = Closure Loc User (Term Core.Core User)
   -- FIXME: Bound String values.
   | String Text
   | Abstract
@@ -58,7 +58,6 @@ importGraph
 runFile :: ( Carrier sig m
            , Effect sig
            , Member Fresh sig
-           , Member (Reader (FrameId User)) sig
            , Member (State (Heap User Value)) sig
            )
         => File (Term Core.Core User)
@@ -72,7 +71,6 @@ runFile file = traverse run file
 -- FIXME: decompose into a product domain and two atomic domains
 importGraphAnalysis :: ( Alternative m
                        , Carrier sig m
-                       , Member (Reader (FrameId User)) sig
                        , Member (Reader Loc) sig
                        , Member (State (Heap User Value)) sig
                        , MonadFail m
@@ -86,9 +84,8 @@ importGraphAnalysis = Analysis{..}
         assign addr ty = modify (Map.insertWith (<>) addr (Set.singleton ty))
         abstract _ name body = do
           loc <- ask
-          FrameId parentAddr <- ask
-          pure (Value (Closure loc name body parentAddr) mempty)
-        apply eval (Value (Closure loc name body _) _) a = local (const loc) $ do
+          pure (Value (Closure loc name body) mempty)
+        apply eval (Value (Closure loc name body) _) a = local (const loc) $ do
           addr <- alloc name
           assign addr a
           bind name addr (eval body)
diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index ee174dc42c..04ba00f5ab 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -49,7 +49,7 @@ instance Monoid Value where
   mempty = Value Abstract mempty
 
 data Semi
-  = Closure Loc User (Term Core.Core User) User
+  = Closure Loc User (Term Core.Core User)
   | Abstract
   deriving (Eq, Ord, Show)
 
@@ -65,7 +65,6 @@ runFile
   :: ( Carrier sig m
      , Effect sig
      , Member Fresh sig
-     , Member (Reader (FrameId User)) sig
      , Member (State (Heap User Value)) sig
      )
   => File (Term Core.Core User)
@@ -80,7 +79,6 @@ runFile file = traverse run file
 scopeGraphAnalysis
   :: ( Alternative m
      , Carrier sig m
-     , Member (Reader (FrameId User)) sig
      , Member (Reader Loc) sig
      , Member (State (Heap User Value)) sig
      , MonadFail m
@@ -94,9 +92,8 @@ scopeGraphAnalysis = Analysis{..}
         assign addr ty = modify (Map.insertWith (<>) addr (Set.singleton ty))
         abstract _ name body = do
           loc <- ask
-          FrameId parentAddr <- ask
-          pure (Value (Closure loc name body parentAddr) mempty)
-        apply eval (Value (Closure loc name body _) _) a = local (const loc) $ do
+          pure (Value (Closure loc name body) mempty)
+        apply eval (Value (Closure loc name body) _) a = local (const loc) $ do
           addr <- alloc name
           assign addr a
           bind name addr (eval body)

From b8f7bb06dbacc6c4388e57dba46ed40a3fe7f6d3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 25 Jul 2019 13:11:07 -0400
Subject: [PATCH 07/27] =?UTF-8?q?Don=E2=80=99t=20provide=20a=20current=20F?=
 =?UTF-8?q?rameId.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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

diff --git a/semantic-core/src/Analysis/FlowInsensitive.hs b/semantic-core/src/Analysis/FlowInsensitive.hs
index ca23d01e8f..2658e295f1 100644
--- a/semantic-core/src/Analysis/FlowInsensitive.hs
+++ b/semantic-core/src/Analysis/FlowInsensitive.hs
@@ -65,8 +65,8 @@ cacheTerm eval term = do
       result <- eval term
       result <$ modify (Map.insertWith (<>) term (Set.singleton (result :: a)))
 
-runHeap :: name -> ReaderC (FrameId name) (StateC (Heap name a) m) b -> m (Heap name a, b)
-runHeap addr m = runState (Map.singleton addr Set.empty) (runReader (FrameId addr) m)
+runHeap :: name -> StateC (Heap name a) m b -> m (Heap name a, b)
+runHeap addr m = runState (Map.singleton addr Set.empty) m
 
 -- | Fold a collection by mapping each element onto an 'Alternative' action.
 foldMapA :: (Alternative m, Foldable t) => (b -> m a) -> t b -> m a

From cb5b0fb2c4680236f6ec9668d2551f46eb91a84a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 25 Jul 2019 13:28:02 -0400
Subject: [PATCH 08/27] =?UTF-8?q?Don=E2=80=99t=20allocate=20a=20pointless?=
 =?UTF-8?q?=20heap=20cell.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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

diff --git a/semantic-core/src/Analysis/FlowInsensitive.hs b/semantic-core/src/Analysis/FlowInsensitive.hs
index 2658e295f1..f5198907f7 100644
--- a/semantic-core/src/Analysis/FlowInsensitive.hs
+++ b/semantic-core/src/Analysis/FlowInsensitive.hs
@@ -65,8 +65,8 @@ cacheTerm eval term = do
       result <- eval term
       result <$ modify (Map.insertWith (<>) term (Set.singleton (result :: a)))
 
-runHeap :: name -> StateC (Heap name a) m b -> m (Heap name a, b)
-runHeap addr m = runState (Map.singleton addr Set.empty) m
+runHeap :: StateC (Heap name a) m b -> m (Heap name a, b)
+runHeap m = runState Map.empty m
 
 -- | Fold a collection by mapping each element onto an 'Alternative' action.
 foldMapA :: (Alternative m, Foldable t) => (b -> m a) -> t b -> m a
diff --git a/semantic-core/src/Analysis/ImportGraph.hs b/semantic-core/src/Analysis/ImportGraph.hs
index 115238cabe..89a0db10a8 100644
--- a/semantic-core/src/Analysis/ImportGraph.hs
+++ b/semantic-core/src/Analysis/ImportGraph.hs
@@ -52,7 +52,7 @@ importGraph :: [File (Term Core.Core User)] -> (Heap User Value, [File (Either (
 importGraph
   = run
   . runFresh
-  . runHeap "__semantic_root"
+  . runHeap
   . traverse runFile
 
 runFile :: ( Carrier sig m
diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index 04ba00f5ab..f3df063632 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -58,7 +58,7 @@ scopeGraph :: [File (Term Core.Core User)] -> (Heap User Value, [File (Either (L
 scopeGraph
   = run
   . runFresh
-  . runHeap "__semantic_root"
+  . runHeap
   . traverse runFile
 
 runFile
diff --git a/semantic-core/src/Analysis/Typecheck.hs b/semantic-core/src/Analysis/Typecheck.hs
index b007bf1807..881fc97c47 100644
--- a/semantic-core/src/Analysis/Typecheck.hs
+++ b/semantic-core/src/Analysis/Typecheck.hs
@@ -90,7 +90,7 @@ typecheckingFlowInsensitive :: [File (Term Core.Core User)] -> (Heap User (Term
 typecheckingFlowInsensitive
   = run
   . runFresh
-  . runHeap "__semantic_root"
+  . runHeap
   . fmap (fmap (fmap (fmap generalize)))
   . traverse runFile
 

From 09f2362cd212f085fd893beffc24b4fa743600df Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 26 Jul 2019 15:13:43 -0400
Subject: [PATCH 09/27] Abstract closures to their graphs.

---
 semantic-core/src/Analysis/ScopeGraph.hs | 50 +++++++-----------------
 1 file changed, 14 insertions(+), 36 deletions(-)

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index f3df063632..e7b0b0fabb 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, OverloadedStrings, RecordWildCards, TypeApplications #-}
+{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, OverloadedStrings, RecordWildCards, TypeApplications #-}
 module Analysis.ScopeGraph
 ( ScopeGraph
 , Entry(..)
@@ -10,7 +10,6 @@ import           Analysis.Eval
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative (..))
 import           Control.Effect.Carrier
-import           Control.Effect.Fail
 import           Control.Effect.Fresh
 import           Control.Effect.Reader
 import           Control.Effect.State
@@ -33,28 +32,13 @@ data Entry = Entry
   }
   deriving (Eq, Ord, Show)
 
-type ScopeGraph = Map.Map Entry (Set.Set Entry)
+newtype ScopeGraph = ScopeGraph { unScopeGraph :: Map.Map Entry (Set.Set Entry) }
+  deriving (Eq, Monoid, Ord, Show)
 
+instance Semigroup ScopeGraph where
+  ScopeGraph a <> ScopeGraph b = ScopeGraph (Map.unionWith (<>) a b)
 
-data Value = Value
-  { valueSemi  :: Semi
-  , valueGraph :: ScopeGraph
-  }
-  deriving (Eq, Ord, Show)
-
-instance Semigroup Value where
-  Value _ g1 <> Value _ g2 = Value Abstract (Map.unionWith (<>) g1 g2)
-
-instance Monoid Value where
-  mempty = Value Abstract mempty
-
-data Semi
-  = Closure Loc User (Term Core.Core User)
-  | Abstract
-  deriving (Eq, Ord, Show)
-
-
-scopeGraph :: [File (Term Core.Core User)] -> (Heap User Value, [File (Either (Loc, String) Value)])
+scopeGraph :: [File (Term Core.Core User)] -> (Heap User ScopeGraph, [File (Either (Loc, String) ScopeGraph)])
 scopeGraph
   = run
   . runFresh
@@ -65,10 +49,10 @@ runFile
   :: ( Carrier sig m
      , Effect sig
      , Member Fresh sig
-     , Member (State (Heap User Value)) sig
+     , Member (State (Heap User ScopeGraph)) sig
      )
   => File (Term Core.Core User)
-  -> m (File (Either (Loc, String) Value))
+  -> m (File (Either (Loc, String) ScopeGraph))
 runFile file = traverse run file
   where run = runReader (fileLoc file)
             . runFailWithLoc
@@ -79,29 +63,23 @@ runFile file = traverse run file
 scopeGraphAnalysis
   :: ( Alternative m
      , Carrier sig m
-     , Member (Reader Loc) sig
-     , Member (State (Heap User Value)) sig
-     , MonadFail m
+     , Member (State (Heap User ScopeGraph)) sig
      )
-  => Analysis User Value m
+  => Analysis User ScopeGraph m
 scopeGraphAnalysis = Analysis{..}
   where alloc = pure
         bind _ _ m = m
         lookupEnv = pure . Just
-        deref addr = gets (Map.lookup addr) >>= maybe (pure Nothing) (foldMapA (pure . Just)) . nonEmpty . maybe [] (Set.toList @Value)
+        deref addr = gets (Map.lookup addr) >>= maybe (pure Nothing) (foldMapA (pure . Just)) . nonEmpty . maybe [] (Set.toList @ScopeGraph)
         assign addr ty = modify (Map.insertWith (<>) addr (Set.singleton ty))
-        abstract _ name body = do
-          loc <- ask
-          pure (Value (Closure loc name body) mempty)
-        apply eval (Value (Closure loc name body) _) a = local (const loc) $ do
+        abstract eval name body = do
           addr <- alloc name
-          assign addr a
           bind name addr (eval body)
-        apply _ f _ = fail $ "Cannot coerce " <> show f <> " to function"
+        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 = pure (Value Abstract (foldMap (valueGraph . snd) fields))
+        record fields = pure (foldMap snd fields)
         _ ... m = pure (Just m)

From 0c106865f7ac41c840e1025ed1f0cae27dae85fd Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 26 Jul 2019 15:19:39 -0400
Subject: [PATCH 10/27] Record where names were bound.

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

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index e7b0b0fabb..9f3ae68abe 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -55,6 +55,7 @@ runFile
   -> m (File (Either (Loc, String) ScopeGraph))
 runFile file = traverse run file
   where run = runReader (fileLoc file)
+            . runReader (Map.empty @User @Loc)
             . runFailWithLoc
             . fmap fold
             . convergeTerm (fix (cacheTerm . eval scopeGraphAnalysis))
@@ -63,12 +64,16 @@ runFile file = traverse run file
 scopeGraphAnalysis
   :: ( Alternative m
      , Carrier sig m
+     , Member (Reader Loc) sig
+     , Member (Reader (Map.Map User Loc)) sig
      , Member (State (Heap User ScopeGraph)) sig
      )
   => Analysis User ScopeGraph m
 scopeGraphAnalysis = Analysis{..}
   where alloc = pure
-        bind _ _ m = m
+        bind name _ m = do
+          loc <- ask @Loc
+          local (Map.insert name loc) m
         lookupEnv = pure . Just
         deref addr = gets (Map.lookup addr) >>= maybe (pure Nothing) (foldMapA (pure . Just)) . nonEmpty . maybe [] (Set.toList @ScopeGraph)
         assign addr ty = modify (Map.insertWith (<>) addr (Set.singleton ty))

From 16b1442b4bc0dce8156426ca2491bc948fbda71a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 26 Jul 2019 15:35:43 -0400
Subject: [PATCH 11/27] Simplify deref slightly.

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

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index 9f3ae68abe..88ddb6ad56 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -13,6 +13,7 @@ import           Control.Effect.Carrier
 import           Control.Effect.Fresh
 import           Control.Effect.Reader
 import           Control.Effect.State
+import           Control.Monad ((>=>))
 import qualified Data.Core as Core
 import           Data.File
 import           Data.Foldable (fold)
@@ -75,7 +76,7 @@ scopeGraphAnalysis = Analysis{..}
           loc <- ask @Loc
           local (Map.insert name loc) m
         lookupEnv = pure . Just
-        deref addr = gets (Map.lookup addr) >>= maybe (pure Nothing) (foldMapA (pure . Just)) . nonEmpty . maybe [] (Set.toList @ScopeGraph)
+        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
           addr <- alloc name

From 99a4f8ed5a59a82be2c242c6a7e64d9d3f2cdb92 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Fri, 26 Jul 2019 15:45:52 -0400
Subject: [PATCH 12/27] Write an empty scope graph into the heap during
 abstraction.

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

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index 88ddb6ad56..c7eb6b889c 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -80,6 +80,7 @@ scopeGraphAnalysis = Analysis{..}
         assign addr ty = modify (Map.insertWith (<>) addr (Set.singleton ty))
         abstract eval name body = do
           addr <- alloc name
+          assign name (mempty @ScopeGraph)
           bind name addr (eval body)
         apply _ f a = pure (f <> a)
         unit = pure mempty

From 4296244f9e4538a3b415db3b2d9c6e09742b044a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 29 Jul 2019 13:19:51 -0400
Subject: [PATCH 13/27] Merge branch 'generalize-analyses-over-the-term-type'
 into scope-graphs

---
 semantic-core/semantic-core.cabal             |  1 +
 semantic-core/src/Analysis/Concrete.hs        | 79 ++++++++++++-------
 semantic-core/src/Analysis/Eval.hs            | 37 ++++-----
 semantic-core/src/Analysis/FlowInsensitive.hs | 50 ++++++------
 semantic-core/src/Analysis/ImportGraph.hs     | 68 ++++++++++------
 semantic-core/src/Analysis/ScopeGraph.hs      | 11 +--
 semantic-core/src/Analysis/Typecheck.hs       | 63 ++++++++++-----
 semantic-core/src/Data/Core.hs                | 27 ++++---
 semantic-core/src/Data/Core/Parser.hs         | 36 ++++-----
 semantic-core/src/Data/Core/Pretty.hs         |  2 -
 semantic-core/test/Generators.hs              | 21 ++---
 semantic-core/test/Spec.hs                    | 19 ++---
 12 files changed, 245 insertions(+), 169 deletions(-)

diff --git a/semantic-core/semantic-core.cabal b/semantic-core/semantic-core.cabal
index 28fd58fd0f..ba80c082eb 100644
--- a/semantic-core/semantic-core.cabal
+++ b/semantic-core/semantic-core.cabal
@@ -84,6 +84,7 @@ test-suite spec
   other-modules:       Generators
   build-depends:       base
                      , semantic-core
+                     , fused-effects
                      , hedgehog ^>= 1
                      , tasty >= 1.2 && <2
                      , tasty-hedgehog ^>= 1.0.0.1
diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index c3cdc3fff9..4e454ab815 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DerivingVia, FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, RecordWildCards, TypeOperators, UndecidableInstances #-}
+{-# LANGUAGE DerivingVia, FlexibleContexts, FlexibleInstances, LambdaCase, MultiParamTypeClasses, NamedFieldPuns, OverloadedStrings, RankNTypes, RecordWildCards, TypeOperators, UndecidableInstances #-}
 module Analysis.Concrete
 ( Concrete(..)
 , concrete
@@ -20,7 +20,6 @@ import           Control.Effect.NonDet
 import           Control.Effect.Reader hiding (Local)
 import           Control.Effect.State
 import           Control.Monad ((<=<), guard)
-import qualified Data.Core as Core
 import           Data.File
 import           Data.Function (fix)
 import qualified Data.IntMap as IntMap
@@ -30,7 +29,6 @@ import qualified Data.Map as Map
 import           Data.Name
 import           Data.Semigroup (Last (..))
 import qualified Data.Set as Set
-import           Data.Term
 import           Data.Text (Text, pack)
 import           Data.Traversable (for)
 import           Prelude hiding (fail)
@@ -41,16 +39,16 @@ type Env = Map.Map User Precise
 newtype FrameId = FrameId { unFrameId :: Precise }
   deriving (Eq, Ord, Show)
 
-data Concrete
-  = Closure Loc User (Term Core.Core User) Env
+data Concrete term
+  = Closure Loc User term Env
   | Unit
   | Bool Bool
   | String Text
   | Record Env
   deriving (Eq, Ord, Show)
-  deriving Semigroup via Last Concrete
+  deriving Semigroup via Last (Concrete term)
 
-recordFrame :: Concrete -> Maybe Env
+recordFrame :: Concrete term -> Maybe Env
 recordFrame (Record frame) = Just frame
 recordFrame _              = Nothing
 
@@ -59,7 +57,7 @@ newtype Frame = Frame
   }
   deriving (Eq, Ord, Show)
 
-type Heap = IntMap.IntMap Concrete
+type Heap term = IntMap.IntMap (Concrete term)
 
 data Edge = Lexical | Import
   deriving (Eq, Ord, Show)
@@ -67,36 +65,56 @@ data Edge = Lexical | Import
 
 -- | Concrete evaluation of a term to a value.
 --
---   >>> map fileBody (snd (concrete [File (Loc "bool" emptySpan) (Core.bool True)]))
+--   >>> map fileBody (snd (concrete eval [File (Loc "bool" emptySpan) (Core.bool True)]))
 --   [Right (Bool True)]
-concrete :: [File (Term Core.Core User)] -> (Heap, [File (Either (Loc, String) Concrete)])
 concrete
+  :: (Foldable term, Show (term User))
+  => (forall sig m
+     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     => Analysis (term User) Precise (Concrete (term User)) m
+     -> (term User -> m (Concrete (term User)))
+     -> (term User -> m (Concrete (term User)))
+     )
+  -> [File (term User)]
+  -> (Heap (term User), [File (Either (Loc, String) (Concrete (term User)))])
+concrete eval
   = run
   . runFresh
   . runHeap
-  . traverse runFile
-
-runFile :: ( Carrier sig m
-           , Effect sig
-           , Member Fresh sig
-           , Member (State Heap) sig
-           )
-        => File (Term Core.Core User)
-        -> m (File (Either (Loc, String) Concrete))
-runFile file = traverse run file
+  . traverse (runFile eval)
+
+runFile
+  :: ( Carrier sig m
+     , Effect sig
+     , Foldable term
+     , Member Fresh sig
+     , Member (State (Heap (term User))) sig
+     , Show (term User)
+     )
+  => (forall sig m
+     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     => Analysis (term User) Precise (Concrete (term User)) m
+     -> (term User -> m (Concrete (term User)))
+     -> (term User -> m (Concrete (term User)))
+     )
+  -> File (term User)
+  -> m (File (Either (Loc, String) (Concrete (term User))))
+runFile eval file = traverse run file
   where run = runReader (fileLoc file)
             . runFailWithLoc
             . runReader (mempty :: Env)
             . fix (eval concreteAnalysis)
 
 concreteAnalysis :: ( Carrier sig m
+                    , Foldable term
                     , Member Fresh sig
                     , Member (Reader Env) sig
                     , Member (Reader Loc) sig
-                    , Member (State Heap) sig
+                    , Member (State (Heap (term User))) sig
                     , MonadFail m
+                    , Show (term User)
                     )
-                 => Analysis Precise Concrete m
+                 => Analysis (term User) Precise (Concrete (term User)) m
 concreteAnalysis = Analysis{..}
   where alloc _ = fresh
         bind name addr m = local (Map.insert name addr) m
@@ -132,7 +150,7 @@ concreteAnalysis = Analysis{..}
           pure (val >>= lookupConcrete heap n)
 
 
-lookupConcrete :: Heap -> User -> Concrete -> Maybe Precise
+lookupConcrete :: Heap term -> User -> Concrete term -> Maybe Precise
 lookupConcrete heap name = run . evalState IntSet.empty . runNonDet . inConcrete
   where -- look up the name in a concrete value
         inConcrete = inFrame <=< maybeA . recordFrame
@@ -149,7 +167,7 @@ lookupConcrete heap name = run . evalState IntSet.empty . runNonDet . inConcrete
         maybeA = maybe empty pure
 
 
-runHeap :: StateC Heap m a -> m (Heap, a)
+runHeap :: StateC (Heap term) m a -> m (Heap term, a)
 runHeap = runState mempty
 
 
@@ -158,7 +176,7 @@ runHeap = runState mempty
 --   > λ 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 -> a) -> (Either Edge User -> Precise -> G.Graph a) -> Heap -> G.Graph a
+heapGraph :: (Precise -> Concrete term -> a) -> (Either Edge User -> Precise -> G.Graph a) -> Heap 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
@@ -168,14 +186,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 -> foldr (G.overlay . uncurry (edge . Right)) G.empty (Map.toList frame)
 
-heapValueGraph :: Heap -> G.Graph Concrete
+heapValueGraph :: Heap 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 -> G.Graph (EdgeType, Precise)
+heapAddressGraph :: Heap term -> G.Graph (EdgeType term, Precise)
 heapAddressGraph = heapGraph (\ addr v -> (Value v, addr)) (fmap G.vertex . (,) . either Edge Slot)
 
-addressStyle :: Heap -> G.Style (EdgeType, Precise) Text
+addressStyle :: Heap term -> G.Style (EdgeType term, 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.:= name]
@@ -190,12 +208,13 @@ addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
           Record _ -> "{}"
         showPos (Pos l c) = pack (show l) <> ":" <> pack (show c)
 
-data EdgeType
+data EdgeType term
   = Edge Edge
   | Slot User
-  | Value Concrete
+  | Value (Concrete term)
   deriving (Eq, Ord, Show)
 
 
 -- $setup
 -- >>> :seti -XOverloadedStrings
+-- >>> import qualified Data.Core as Core
diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index e02ddfce2f..b34cb8a23e 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, LambdaCase, OverloadedStrings, RankNTypes, RecordWildCards #-}
+{-# LANGUAGE FlexibleContexts, LambdaCase, OverloadedStrings, RankNTypes, RecordWildCards, TypeOperators #-}
 module Analysis.Eval
 ( eval
 , prog1
@@ -12,6 +12,7 @@ module Analysis.Eval
 ) where
 
 import Control.Applicative (Alternative (..))
+import Control.Effect.Carrier
 import Control.Effect.Fail
 import Control.Effect.Reader
 import Control.Monad ((>=>))
@@ -32,12 +33,12 @@ eval :: ( Carrier sig m
         , MonadFail m
         , Semigroup value
         )
-     => Analysis address value m
-     -> (Term Core User -> m value)
-     -> (Term Core User -> m value)
+     => Analysis (Term (Ann :+: Core) User) address value m
+     -> (Term (Ann :+: Core) User -> m value)
+     -> (Term (Ann :+: Core) User -> m value)
 eval Analysis{..} eval = \case
   Var n -> lookupEnv' n >>= deref' n
-  Term c -> case c of
+  Term (R c) -> case c of
     Rec (Named (Ignored n) b) -> do
       addr <- alloc n
       v <- bind n addr (eval (instantiate1 (pure n) b))
@@ -68,7 +69,7 @@ eval Analysis{..} eval = \case
       b' <- eval b
       addr <- ref a
       b' <$ assign addr b'
-    Ann loc c -> local (const loc) (eval c)
+  Term (L (Ann loc c)) -> local (const loc) (eval c)
   where freeVariable s = fail ("free variable: " <> s)
         uninitialized s = fail ("uninitialized variable: " <> s)
         invalidRef s = fail ("invalid ref: " <> s)
@@ -78,41 +79,41 @@ eval Analysis{..} eval = \case
 
         ref = \case
           Var n -> lookupEnv' n
-          Term c -> case c of
+          Term (R c) -> case c of
             If c t e -> do
               c' <- eval c >>= asBool
               if c' then ref t else ref e
             a :. b -> do
               a' <- ref a
               a' ... b >>= maybe (freeVariable (show b)) pure
-            Ann loc c -> local (const loc) (ref c)
             c -> invalidRef (show c)
+          Term (L (Ann loc c)) -> local (const loc) (ref c)
 
 
-prog1 :: File (Term Core User)
+prog1 :: (Carrier sig t, Member Core sig) => File (t User)
 prog1 = fromBody $ lam (named' "foo")
   (    named' "bar" :<- pure "foo"
   >>>= Core.if' (pure "bar")
     (Core.bool False)
     (Core.bool True))
 
-prog2 :: File (Term Core User)
+prog2 :: (Carrier sig t, Member Core sig) => File (t User)
 prog2 = fromBody $ fileBody prog1 $$ Core.bool True
 
-prog3 :: File (Term Core User)
+prog3 :: (Carrier sig t, Member Core sig) => File (t User)
 prog3 = fromBody $ lams [named' "foo", named' "bar", named' "quux"]
   (Core.if' (pure "quux")
     (pure "bar")
     (pure "foo"))
 
-prog4 :: File (Term Core User)
+prog4 :: (Carrier sig t, Member Core sig) => File (t User)
 prog4 = fromBody
   (    named' "foo" :<- Core.bool True
   >>>= Core.if' (pure "foo")
     (Core.bool True)
     (Core.bool False))
 
-prog5 :: File (Term Core User)
+prog5 :: (Carrier sig t, Member Ann sig, Member Core sig) => File (t User)
 prog5 = fromBody $ ann (do'
   [ Just (named' "mkPoint") :<- lams [named' "_x", named' "_y"] (ann (Core.record
     [ ("x", ann (pure "_x"))
@@ -123,7 +124,7 @@ prog5 = fromBody $ ann (do'
   , Nothing :<- ann (ann (pure "point") Core.... "y") .= ann (ann (pure "point") Core.... "x")
   ])
 
-prog6 :: [File (Term Core User)]
+prog6 :: (Carrier sig t, Member Core sig) => [File (t User)]
 prog6 =
   [ File (Loc "dep"  (locSpan (fromJust here))) $ Core.record
     [ ("dep", Core.record [ ("var", Core.bool True) ]) ]
@@ -133,7 +134,7 @@ prog6 =
     ])
   ]
 
-ruby :: File (Term Core User)
+ruby :: (Carrier sig t, Member Ann sig, Member Core sig) => File (t User)
 ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (do' statements))
   where statements =
           [ Just "Class" :<- record
@@ -210,14 +211,14 @@ ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (do' stateme
         __semantic_truthy = "__semantic_truthy"
 
 
-data Analysis address value m = Analysis
+data Analysis term address value m = Analysis
   { alloc     :: User -> m address
   , bind      :: forall a . User -> address -> m a -> m a
   , lookupEnv :: User -> m (Maybe address)
   , deref     :: address -> m (Maybe value)
   , assign    :: address -> value -> m ()
-  , abstract  :: (Term Core User -> m value) -> User -> Term Core User -> m value
-  , apply     :: (Term Core User -> m value) -> value -> value -> m value
+  , abstract  :: (term -> m value) -> User -> term -> m value
+  , apply     :: (term -> m value) -> value -> value -> m value
   , unit      :: m value
   , bool      :: Bool -> m value
   , asBool    :: value -> m Bool
diff --git a/semantic-core/src/Analysis/FlowInsensitive.hs b/semantic-core/src/Analysis/FlowInsensitive.hs
index f5198907f7..0240d6739f 100644
--- a/semantic-core/src/Analysis/FlowInsensitive.hs
+++ b/semantic-core/src/Analysis/FlowInsensitive.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, OverloadedStrings, ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts, OverloadedStrings, ScopedTypeVariables, TypeOperators #-}
 module Analysis.FlowInsensitive
 ( Heap
 , FrameId(..)
@@ -13,59 +13,61 @@ import           Control.Effect.Fresh
 import           Control.Effect.NonDet
 import           Control.Effect.Reader
 import           Control.Effect.State
-import qualified Data.Core as Core
 import qualified Data.Map as Map
 import           Data.Maybe (fromMaybe)
 import           Data.Monoid (Alt(..))
 import qualified Data.Set as Set
-import           Data.Term (Term)
 
-type Cache name a = Map.Map (Term Core.Core name) (Set.Set a)
-type Heap name a = Map.Map name (Set.Set a)
+newtype Cache term a = Cache { unCache :: Map.Map term (Set.Set a) }
+  deriving (Eq, Ord, Show)
+
+type Heap address a = Map.Map address (Set.Set a)
 
 newtype FrameId name = FrameId { unFrameId :: name }
   deriving (Eq, Ord, Show)
 
 
-convergeTerm :: forall m sig a name
+convergeTerm :: forall m sig a term address proxy
              .  ( Carrier sig m
                 , Effect sig
+                , Eq address
                 , Member Fresh sig
-                , Member (State (Heap name a)) sig
+                , Member (State (Heap address a)) sig
                 , Ord a
-                , Ord name
+                , Ord term
                 )
-             => (Term Core.Core name -> NonDetC (ReaderC (Cache name a) (StateC (Cache name a) m)) a)
-             -> Term Core.Core name
+             => proxy address
+             -> (term -> NonDetC (ReaderC (Cache term a) (StateC (Cache term a) m)) a)
+             -> term
              -> m (Set.Set a)
-convergeTerm eval body = do
+convergeTerm _ eval body = do
   heap <- get
-  (cache, _) <- converge (Map.empty :: Cache name a, heap :: Heap name a) $ \ (prevCache, _) -> runState 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
-  pure (fromMaybe mempty (Map.lookup body cache))
+  pure (fromMaybe mempty (Map.lookup body (unCache cache)))
 
-cacheTerm :: forall m sig a name
+cacheTerm :: forall m sig a term
           .  ( Alternative m
              , Carrier sig m
-             , Member (Reader (Cache name a)) sig
-             , Member (State  (Cache name a)) sig
+             , Member (Reader (Cache term a)) sig
+             , Member (State  (Cache term a)) sig
              , Ord a
-             , Ord name
+             , Ord term
              )
-          => (Term Core.Core name -> m a)
-          -> (Term Core.Core name -> m a)
+          => (term -> m a)
+          -> (term -> m a)
 cacheTerm eval term = do
-  cached <- gets (Map.lookup term)
+  cached <- gets (Map.lookup term . unCache)
   case cached :: Maybe (Set.Set a) of
     Just results -> foldMapA pure results
     Nothing -> do
-      results <- asks (fromMaybe mempty . Map.lookup term)
-      modify (Map.insert term (results :: Set.Set a))
+      results <- asks (fromMaybe mempty . Map.lookup term . unCache)
+      modify (Cache . Map.insert term (results :: Set.Set a) . unCache)
       result <- eval term
-      result <$ modify (Map.insertWith (<>) term (Set.singleton (result :: a)))
+      result <$ modify (Cache . Map.insertWith (<>) term (Set.singleton (result :: a)) . unCache)
 
-runHeap :: StateC (Heap name a) m b -> m (Heap name a, b)
+runHeap :: StateC (Heap address a) m b -> m (Heap address a, b)
 runHeap m = runState Map.empty m
 
 -- | Fold a collection by mapping each element onto an 'Alternative' action.
diff --git a/semantic-core/src/Analysis/ImportGraph.hs b/semantic-core/src/Analysis/ImportGraph.hs
index 89a0db10a8..6b3bf28cdc 100644
--- a/semantic-core/src/Analysis/ImportGraph.hs
+++ b/semantic-core/src/Analysis/ImportGraph.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, OverloadedStrings, RecordWildCards #-}
+{-# LANGUAGE FlexibleContexts, RankNTypes, RecordWildCards, TypeApplications #-}
 module Analysis.ImportGraph
 ( ImportGraph
 , importGraph
@@ -13,7 +13,7 @@ import           Control.Effect.Fail
 import           Control.Effect.Fresh
 import           Control.Effect.Reader
 import           Control.Effect.State
-import qualified Data.Core as Core
+import           Control.Monad ((>=>))
 import           Data.File
 import           Data.Foldable (fold)
 import           Data.Function (fix)
@@ -21,66 +21,88 @@ import           Data.List.NonEmpty (nonEmpty)
 import           Data.Loc
 import qualified Data.Map as Map
 import           Data.Name
+import           Data.Proxy
 import qualified Data.Set as Set
-import           Data.Term
 import           Data.Text (Text)
 import           Prelude hiding (fail)
 
 type ImportGraph = Map.Map Text (Set.Set Text)
 
-data Value = Value
-  { valueSemi  :: Semi
+data Value term = Value
+  { valueSemi  :: Semi term
   , valueGraph :: ImportGraph
   }
   deriving (Eq, Ord, Show)
 
-instance Semigroup Value where
+instance Semigroup (Value term) where
   Value _ g1 <> Value _ g2 = Value Abstract (Map.unionWith (<>) g1 g2)
 
-instance Monoid Value where
+instance Monoid (Value term) where
   mempty = Value Abstract mempty
 
-data Semi
-  = Closure Loc User (Term Core.Core User)
+data Semi term
+  = Closure Loc User term
   -- FIXME: Bound String values.
   | String Text
   | Abstract
   deriving (Eq, Ord, Show)
 
 
-importGraph :: [File (Term Core.Core User)] -> (Heap User Value, [File (Either (Loc, String) Value)])
 importGraph
+  :: (Ord term, Show term)
+  => (forall sig m
+     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     => Analysis term User (Value term) m
+     -> (term -> m (Value term))
+     -> (term -> m (Value term))
+     )
+  -> [File term]
+  -> ( Heap User (Value term)
+     , [File (Either (Loc, String) (Value term))]
+     )
+importGraph eval
   = run
   . runFresh
   . runHeap
-  . traverse runFile
+  . traverse (runFile eval)
 
-runFile :: ( Carrier sig m
-           , Effect sig
-           , Member Fresh sig
-           , Member (State (Heap User Value)) sig
-           )
-        => File (Term Core.Core User)
-        -> m (File (Either (Loc, String) Value))
-runFile file = traverse run file
+runFile
+  :: ( Carrier sig m
+     , Effect sig
+     , Member Fresh sig
+     , Member (State (Heap User (Value term))) sig
+     , Ord  term
+     , Show term
+     )
+  => (forall sig m
+     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     => Analysis term User (Value term) m
+     -> (term -> m (Value term))
+     -> (term -> m (Value term))
+     )
+  -> File term
+  -> m (File (Either (Loc, String) (Value term)))
+runFile eval file = traverse run file
   where run = runReader (fileLoc file)
             . runFailWithLoc
             . fmap fold
-            . convergeTerm (fix (cacheTerm . eval importGraphAnalysis))
+            . convergeTerm (Proxy @User) (fix (cacheTerm . eval importGraphAnalysis))
 
 -- FIXME: decompose into a product domain and two atomic domains
 importGraphAnalysis :: ( Alternative m
                        , Carrier sig m
                        , Member (Reader Loc) sig
-                       , Member (State (Heap User Value)) sig
+                       , Member (State (Heap User (Value term))) sig
                        , MonadFail m
+                       , Ord  term
+                       , Show term
                        )
-                    => Analysis User Value m
+                    => Analysis term User (Value term) m
 importGraphAnalysis = Analysis{..}
   where alloc = pure
         bind _ _ m = m
         lookupEnv = pure . Just
-        deref addr = gets (Map.lookup addr) >>= maybe (pure Nothing) (foldMapA (pure . Just)) . nonEmpty . maybe [] Set.toList
+        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 _ name body = do
           loc <- ask
diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index c7eb6b889c..08f19c0be6 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, OverloadedStrings, RecordWildCards, TypeApplications #-}
+{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, OverloadedStrings, RecordWildCards, TypeApplications, TypeOperators #-}
 module Analysis.ScopeGraph
 ( ScopeGraph
 , Entry(..)
@@ -22,6 +22,7 @@ import           Data.List.NonEmpty
 import           Data.Loc
 import qualified Data.Map as Map
 import           Data.Name
+import           Data.Proxy
 import qualified Data.Set as Set
 import           Data.Text (Text)
 import           Data.Term
@@ -39,7 +40,7 @@ newtype ScopeGraph = ScopeGraph { unScopeGraph :: Map.Map Entry (Set.Set Entry)
 instance Semigroup ScopeGraph where
   ScopeGraph a <> ScopeGraph b = ScopeGraph (Map.unionWith (<>) a b)
 
-scopeGraph :: [File (Term Core.Core User)] -> (Heap User ScopeGraph, [File (Either (Loc, String) ScopeGraph)])
+scopeGraph :: [File (Term (Core.Ann :+: Core.Core) User)] -> (Heap User ScopeGraph, [File (Either (Loc, String) ScopeGraph)])
 scopeGraph
   = run
   . runFresh
@@ -52,14 +53,14 @@ runFile
      , Member Fresh sig
      , Member (State (Heap User ScopeGraph)) sig
      )
-  => File (Term Core.Core User)
+  => File (Term (Core.Ann :+: Core.Core) User)
   -> m (File (Either (Loc, String) ScopeGraph))
 runFile file = traverse run file
   where run = runReader (fileLoc file)
             . runReader (Map.empty @User @Loc)
             . runFailWithLoc
             . fmap fold
-            . convergeTerm (fix (cacheTerm . eval scopeGraphAnalysis))
+            . convergeTerm (Proxy @User) (fix (cacheTerm . eval scopeGraphAnalysis))
 
 -- FIXME: decompose into a product domain and two atomic domains
 scopeGraphAnalysis
@@ -69,7 +70,7 @@ scopeGraphAnalysis
      , Member (Reader (Map.Map User Loc)) sig
      , Member (State (Heap User ScopeGraph)) sig
      )
-  => Analysis User ScopeGraph m
+  => Analysis term User ScopeGraph m
 scopeGraphAnalysis = Analysis{..}
   where alloc = pure
         bind name _ m = do
diff --git a/semantic-core/src/Analysis/Typecheck.hs b/semantic-core/src/Analysis/Typecheck.hs
index 881fc97c47..9f1e3f9fd3 100644
--- a/semantic-core/src/Analysis/Typecheck.hs
+++ b/semantic-core/src/Analysis/Typecheck.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveGeneric, DeriveTraversable, DerivingVia, FlexibleContexts, FlexibleInstances, LambdaCase, OverloadedStrings, QuantifiedConstraints, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators #-}
+{-# LANGUAGE DeriveGeneric, DeriveTraversable, DerivingVia, FlexibleContexts, FlexibleInstances, LambdaCase, QuantifiedConstraints, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeOperators #-}
 module Analysis.Typecheck
 ( Monotype (..)
 , Meta
@@ -15,9 +15,8 @@ import           Control.Effect.Fail
 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           Control.Monad.Module
-import qualified Data.Core as Core
 import           Data.File
 import           Data.Foldable (for_)
 import           Data.Function (fix)
@@ -29,6 +28,7 @@ import           Data.Loc
 import qualified Data.Map as Map
 import           Data.Maybe (fromJust, fromMaybe)
 import           Data.Name as Name
+import           Data.Proxy
 import           Data.Scope
 import           Data.Semigroup (Last (..))
 import qualified Data.Set as Set
@@ -45,6 +45,8 @@ data Monotype f a
   | Record (Map.Map User (f a))
   deriving (Foldable, Functor, Generic1, Traversable)
 
+type Type = Term Monotype Meta
+
 -- FIXME: Union the effects/annotations on the operands.
 deriving via (Last (Term Monotype a)) instance Semigroup (Term Monotype a)
 
@@ -86,26 +88,45 @@ generalize :: Term Monotype Meta -> Term (Polytype :+: Monotype) Void
 generalize ty = fromJust (closed (forAlls (IntSet.toList (mvs ty)) (hoistTerm R ty)))
 
 
-typecheckingFlowInsensitive :: [File (Term Core.Core User)] -> (Heap User (Term Monotype Meta), [File (Either (Loc, String) (Term (Polytype :+: Monotype) Void))])
 typecheckingFlowInsensitive
+  :: Ord term
+  => (forall sig m
+     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     => Analysis term User Type m
+     -> (term -> m Type)
+     -> (term -> m Type)
+     )
+  -> [File term]
+  -> ( Heap User Type
+     , [File (Either (Loc, String) (Term (Polytype :+: Monotype) Void))]
+     )
+typecheckingFlowInsensitive eval
   = run
   . runFresh
   . runHeap
   . fmap (fmap (fmap (fmap generalize)))
-  . traverse runFile
-
-runFile :: ( Carrier sig m
-           , Effect sig
-           , Member Fresh sig
-           , Member (State (Heap User (Term Monotype Meta))) sig
-           )
-        => File (Term Core.Core User)
-        -> m (File (Either (Loc, String) (Term Monotype Meta)))
-runFile file = traverse run file
+  . traverse (runFile eval)
+
+runFile
+  :: ( Carrier sig m
+     , Effect sig
+     , Member Fresh sig
+     , Member (State (Heap User Type)) sig
+     , Ord term
+     )
+  => (forall sig m
+     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     => Analysis term User Type m
+     -> (term -> m Type)
+     -> (term -> m Type)
+     )
+  -> File term
+  -> m (File (Either (Loc, String) Type))
+runFile eval file = traverse run file
   where run
           = (\ m -> do
               (subst, t) <- m
-              modify @(Heap User (Term Monotype Meta)) (fmap (Set.map (substAll subst)))
+              modify @(Heap User Type) (fmap (Set.map (substAll subst)))
               pure (substAll subst <$> t))
           . runState (mempty :: Substitution)
           . runReader (fileLoc file)
@@ -118,21 +139,21 @@ runFile file = traverse run file
               v <- meta
               bs <- m
               v <$ for_ bs (unify v))
-          . convergeTerm (fix (cacheTerm . eval typecheckingAnalysis))
+          . convergeTerm (Proxy @User) (fix (cacheTerm . eval typecheckingAnalysis))
 
 typecheckingAnalysis
   :: ( Alternative m
      , Carrier sig m
      , Member Fresh sig
      , Member (State (Set.Set Constraint)) sig
-     , Member (State (Heap User (Term Monotype Meta))) sig
+     , Member (State (Heap User Type)) sig
      )
-  => Analysis User (Term Monotype Meta) m
+  => Analysis term User Type m
 typecheckingAnalysis = Analysis{..}
   where alloc = pure
         bind _ _ m = m
         lookupEnv = pure . Just
-        deref addr = gets (Map.lookup addr) >>= maybe (pure Nothing) (foldMapA (pure . Just)) . nonEmpty . maybe [] Set.toList
+        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
@@ -167,7 +188,7 @@ data Solution
 
 infix 5 :=
 
-meta :: (Carrier sig m, Member Fresh sig) => m (Term Monotype Meta)
+meta :: (Carrier sig m, Member Fresh sig) => m Type
 meta = pure <$> Fresh.fresh
 
 unify :: (Carrier sig m, Member (State (Set.Set Constraint)) sig) => Term Monotype Meta -> Term Monotype Meta -> m ()
@@ -175,7 +196,7 @@ unify t1 t2
   | t1 == t2  = pure ()
   | otherwise = modify (<> Set.singleton (t1 :===: t2))
 
-type Substitution = IntMap.IntMap (Term Monotype Meta)
+type Substitution = IntMap.IntMap Type
 
 solve :: (Carrier sig m, Member (State Substitution) sig, MonadFail m) => Set.Set Constraint -> m ()
 solve cs = for_ cs solve
diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 83b6c25b25..af67f2748a 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -27,6 +27,7 @@ module Data.Core
 , record
 , (...)
 , (.=)
+, Ann(..)
 , ann
 , annWith
 , instantiate
@@ -75,7 +76,6 @@ data Core f a
   | f a :. User
   -- | Assignment of a value to the reference returned by the lhs.
   | f a := f a
-  | Ann Loc (f a)
   deriving (Foldable, Functor, Generic1, Traversable)
 
 infixr 1 :>>
@@ -105,7 +105,6 @@ instance RightModule Core where
   Record fs  >>=* f = Record (map (fmap (>>= f)) fs)
   (a :. b)   >>=* f = (a >>= f) :. b
   (a := b)   >>=* f = (a >>= f) := (b >>= f)
-  Ann l b    >>=* f = Ann l (b >>= f)
 
 
 rec :: (Eq a, Carrier sig m, Member Core sig) => Named a -> m a -> m a
@@ -212,15 +211,25 @@ a .= b = send (a := b)
 
 infix 3 .=
 
-ann :: (Carrier sig m, Member Core sig) => HasCallStack => m a -> m a
+
+data Ann f a
+  = Ann Loc (f a)
+  deriving (Eq, Foldable, Functor, Generic1, Ord, Show, Traversable)
+
+instance HFunctor Ann
+
+instance RightModule Ann where
+  Ann l b >>=* f = Ann l (b >>= f)
+
+
+ann :: (Carrier sig m, Member Ann sig) => HasCallStack => m a -> m a
 ann = annWith callStack
 
-annWith :: (Carrier sig m, Member Core sig) => CallStack -> m a -> m a
+annWith :: (Carrier sig m, Member Ann sig) => CallStack -> m a -> m a
 annWith callStack = maybe id (fmap send . Ann) (stackLoc callStack)
 
 
-stripAnnotations :: (Member Core sig, HFunctor sig, forall g . Functor g => Functor (sig g)) => Term sig a -> Term sig a
-stripAnnotations (Var v)  = Var v
-stripAnnotations (Term t)
-  | Just c <- prj t, Ann _ b <- c = stripAnnotations b
-  | otherwise                     = Term (hmap stripAnnotations t)
+stripAnnotations :: (HFunctor sig, forall g . Functor g => Functor (sig g)) => Term (Ann :+: sig) a -> Term sig a
+stripAnnotations (Var v)              = Var v
+stripAnnotations (Term (L (Ann _ b))) = stripAnnotations b
+stripAnnotations (Term (R        b))  = Term (hmap stripAnnotations b)
diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index 45034f4dc8..b5c733eff1 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleContexts, TypeOperators #-}
 module Data.Core.Parser
   ( module Text.Trifecta
   , core
@@ -10,13 +10,13 @@ module Data.Core.Parser
 -- Consult @doc/grammar.md@ for an EBNF grammar.
 
 import           Control.Applicative
+import           Control.Effect.Carrier
 import qualified Data.Char as Char
 import           Data.Core (Core)
 import qualified Data.Core as Core
 import           Data.Foldable (foldl')
 import           Data.Name
 import           Data.String
-import           Data.Term
 import qualified Text.Parser.Token as Token
 import qualified Text.Parser.Token.Highlight as Highlight
 import           Text.Trifecta hiding (ident)
@@ -46,22 +46,22 @@ identifier = choice [quote, plain] <?> "identifier" where
 
 -- * Parsers (corresponding to EBNF)
 
-core :: (TokenParsing m, Monad m) => m (Term Core User)
+core :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
 core = expr
 
-expr :: (TokenParsing m, Monad m) => m (Term Core User)
+expr :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
 expr = ifthenelse <|> lambda <|> rec <|> load <|> assign
 
-assign :: (TokenParsing m, Monad m) => m (Term Core User)
+assign :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
 assign = application <**> (flip (Core..=) <$ symbolic '=' <*> application <|> pure id) <?> "assignment"
 
-application :: (TokenParsing m, Monad m) => m (Term Core User)
+application :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
 application = projection `chainl1` (pure (Core.$$))
 
-projection :: (TokenParsing m, Monad m) => m (Term Core User)
+projection :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
 projection = foldl' (Core....) <$> atom <*> many (namedValue <$ dot <*> name)
 
-atom :: (TokenParsing m, Monad m) => m (Term Core User)
+atom :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
 atom = choice
   [ comp
   , lit
@@ -69,29 +69,29 @@ atom = choice
   , parens expr
   ]
 
-comp :: (TokenParsing m, Monad m) => m (Term Core User)
+comp :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
 comp = braces (Core.do' <$> sepEndByNonEmpty statement semi) <?> "compound statement"
 
-statement :: (TokenParsing m, Monad m) => m (Maybe (Named User) Core.:<- Term Core User)
+statement :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (Maybe (Named User) Core.:<- t User)
 statement
   =   try ((Core.:<-) . Just <$> name <* symbol "<-" <*> expr)
   <|> (Nothing Core.:<-) <$> expr
   <?> "statement"
 
-ifthenelse :: (TokenParsing m, Monad m) => m (Term Core User)
+ifthenelse :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
 ifthenelse = Core.if'
   <$ reserved "if"   <*> expr
   <* reserved "then" <*> expr
   <* reserved "else" <*> expr
   <?> "if-then-else statement"
 
-rec :: (TokenParsing m, Monad m) => m (Term Core User)
+rec :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
 rec = Core.rec <$ reserved "rec" <*> name <* symbolic '=' <*> expr <?> "recursive binding"
 
-load :: (TokenParsing m, Monad m) => m (Term Core User)
+load :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
 load = Core.load <$ reserved "load" <*> expr
 
-lvalue :: (TokenParsing m, Monad m) => m (Term Core User)
+lvalue :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
 lvalue = choice
   [ projection
   , ident
@@ -103,7 +103,7 @@ lvalue = choice
 name :: (TokenParsing m, Monad m) => m (Named User)
 name = named' <$> identifier <?> "name"
 
-lit :: (TokenParsing m, Monad m) => m (Term Core User)
+lit :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
 lit = let x `given` n = x <$ reserved n in choice
   [ Core.bool True  `given` "#true"
   , Core.bool False `given` "#false"
@@ -118,13 +118,13 @@ lit = let x `given` n = x <$ reserved n in choice
           , '\t' <$ string "t"
           ] <?> "escape sequence"
 
-record :: (TokenParsing m, Monad m) => m (Term Core User)
+record :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
 record = Core.record <$ reserved "#record" <*> braces (sepEndBy ((,) <$> identifier <* symbolic ':' <*> expr) comma)
 
-lambda :: (TokenParsing m, Monad m) => m (Term Core User)
+lambda :: (TokenParsing m, Carrier sig t, Member Core sig, Monad m) => m (t User)
 lambda = Core.lam <$ lambduh <*> name <* arrow <*> expr <?> "lambda" where
   lambduh = symbolic 'λ' <|> symbolic '\\'
   arrow   = symbol "→"   <|> symbol "->"
 
-ident :: (Monad m, TokenParsing m) => m (Term Core User)
+ident :: (Applicative t, Monad m, TokenParsing m) => m (t User)
 ident = pure . namedValue <$> name <?> "identifier"
diff --git a/semantic-core/src/Data/Core/Pretty.hs b/semantic-core/src/Data/Core/Pretty.hs
index 2bb0170b6b..d902402120 100644
--- a/semantic-core/src/Data/Core/Pretty.hs
+++ b/semantic-core/src/Data/Core/Pretty.hs
@@ -79,8 +79,6 @@ prettyCore style = precBody . go . fmap name
               , symbol "=" <+> align (withPrec 4 (go rhs))
               ]
 
-            -- Annotations are not pretty-printed, as it lowers the signal/noise ratio too profoundly.
-            Ann _ c -> go c
             statement ->
               let (bindings, return) = unstatements (Term statement)
                   statements = toList (bindings :> (Nothing :<- return))
diff --git a/semantic-core/test/Generators.hs b/semantic-core/test/Generators.hs
index 3ec79e8bef..cab1ee0983 100644
--- a/semantic-core/test/Generators.hs
+++ b/semantic-core/test/Generators.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
 
 module Generators
   ( literal
@@ -18,6 +18,7 @@ import Hedgehog hiding (Var)
 import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Range as Range
 
+import Control.Effect.Carrier
 import qualified Data.Core as Core
 import Data.Name
 import Data.Term
@@ -29,16 +30,16 @@ name :: MonadGen m => m (Named User)
 name = Gen.prune (named' <$> names) where
   names = Gen.text (Range.linear 1 10) Gen.lower
 
-boolean :: MonadGen m => m (Term Core.Core User)
+boolean :: (Carrier sig t, Member Core.Core sig, MonadGen m) => m (t User)
 boolean = Core.bool <$> Gen.bool
 
-variable :: MonadGen m => m (Term Core.Core User)
+variable :: (Carrier sig t, Member Core.Core sig, MonadGen m) => m (t User)
 variable = pure . namedValue <$> name
 
-ifthenelse :: MonadGen m => m (Term Core.Core User) -> m (Term Core.Core User)
+ifthenelse :: (Carrier sig t, Member Core.Core sig, MonadGen m) => m (t User) -> m (t User)
 ifthenelse bod = Gen.subterm3 boolean bod bod Core.if'
 
-apply :: MonadGen m => m (Term Core.Core User) -> m (Term Core.Core User)
+apply :: (Carrier sig t, Member Core.Core sig, MonadGen m) => m (t User) -> m (t User)
 apply gen = go where
   go = Gen.recursive
     Gen.choice
@@ -47,21 +48,21 @@ apply gen = go where
     , Gen.subtermM go (\x -> Core.lam <$> name <*> pure x)
     ]
 
-lambda :: MonadGen m => m (Term Core.Core User) -> m (Term Core.Core User)
+lambda :: (Carrier sig t, Member Core.Core sig, MonadGen m) => m (t User) -> m (t User)
 lambda bod = do
   arg <- name
   Gen.subterm bod (Core.lam arg)
 
-record :: MonadGen m => m (Term Core.Core User) -> m (Term Core.Core User)
+record :: (Carrier sig t, Member Core.Core sig, MonadGen m) => m (t User) -> m (t User)
 record bod = Core.record <$> Gen.list (Range.linear 0 5) ((,) . namedValue <$> name <*> bod)
 
-atoms :: MonadGen m => [m (Term Core.Core User)]
+atoms :: (Carrier sig t, Member Core.Core sig, MonadGen m) => [m (t User)]
 atoms = [variable, pure Core.unit, boolean, Core.string <$> Gen.text (Range.linear 1 10) Gen.lower]
 
-literal :: MonadGen m => m (Term Core.Core User)
+literal :: (Carrier sig t, Member Core.Core sig, MonadGen m) => m (t User)
 literal = Gen.recursive Gen.choice atoms [lambda literal, record literal]
 
-expr :: MonadGen m => m (Term Core.Core User)
+expr :: (Carrier sig t, Member Core.Core sig, MonadGen m) => m (t User)
 expr = Gen.recursive Gen.choice atoms
   [ Gen.subtermM expr (\x -> flip Core.rec x <$> name)
   , Gen.subterm2 expr expr (Core.>>>)
diff --git a/semantic-core/test/Spec.hs b/semantic-core/test/Spec.hs
index b877a4a1ef..85021bcb4a 100644
--- a/semantic-core/test/Spec.hs
+++ b/semantic-core/test/Spec.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, TypeOperators #-}
 module Main (main) where
 
 import           Data.String
@@ -9,6 +9,7 @@ import           Test.Tasty
 import           Test.Tasty.Hedgehog
 import           Test.Tasty.HUnit
 
+import           Control.Effect.Sum
 import           Data.File
 import qualified Generators as Gen
 import qualified Analysis.Eval as Eval
@@ -20,7 +21,7 @@ import           Data.Term
 
 -- * Helpers
 
-true, false :: Term Core User
+true, false :: Term (Ann :+: Core) User
 true  = bool True
 false = bool False
 
@@ -30,10 +31,10 @@ parseEither p = Trifecta.foldResult (Left . show . Trifecta._errDoc) Right . Tri
 -- * Parser roundtripping properties. Note that parsing and prettyprinting is generally
 -- not a roundtrip, because the parser inserts 'Ann' nodes itself.
 
-prop_roundtrips :: Gen (Term Core User) -> Property
+prop_roundtrips :: Gen (Term (Ann :+: Core) User) -> Property
 prop_roundtrips gen = property $ do
   input <- forAll gen
-  tripping input showCore (parseEither (Parse.core <* Trifecta.eof))
+  tripping input (showCore . stripAnnotations) (parseEither (Parse.core <* Trifecta.eof))
 
 parserProps :: TestTree
 parserProps = testGroup "Parsing: roundtripping"
@@ -46,7 +47,7 @@ parserProps = testGroup "Parsing: roundtripping"
 
 -- * Parser specs
 
-parsesInto :: String -> Term Core User -> Assertion
+parsesInto :: String -> Term (Ann :+: Core) User -> Assertion
 parsesInto str res = case parseEither Parse.core str of
   Right x -> x @?= res
   Left m  -> assertFailure m
@@ -56,7 +57,7 @@ assert_booleans_parse = do
   parseEither Parse.core "#true"  @?= Right true
   parseEither Parse.core "#false" @?= Right false
 
-a, f, g, h :: Term Core User
+a, f, g, h :: Term (Ann :+: Core) User
 (a, f, g, h) = (pure "a", pure "f", pure "g", pure "h")
 
 assert_ifthen_parse :: Assertion
@@ -92,9 +93,9 @@ parserSpecs = testGroup "Parsing: simple specs"
   , testCase "quoted names" assert_quoted_name_parse
   ]
 
-assert_roundtrips :: File (Term Core User) -> Assertion
-assert_roundtrips (File _ core) = case parseEither Parse.core (showCore core) of
-  Right v -> v @?= stripAnnotations core
+assert_roundtrips :: File (Term (Ann :+: Core) User) -> Assertion
+assert_roundtrips (File _ core) = case parseEither Parse.core (showCore (stripAnnotations core)) of
+  Right v -> stripAnnotations v @?= stripAnnotations core
   Left e -> assertFailure e
 
 parserExamples :: TestTree

From 3bafa9a8b38fd46953ceb97be2cdefd416aca7d1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 29 Jul 2019 13:21:29 -0400
Subject: [PATCH 14/27] Generalize runFile over the term type.

---
 semantic-core/src/Analysis/ScopeGraph.hs | 16 ++++++++++++----
 1 file changed, 12 insertions(+), 4 deletions(-)

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index 08f19c0be6..cc9dbf028c 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, OverloadedStrings, RecordWildCards, TypeApplications, TypeOperators #-}
+{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, OverloadedStrings, RankNTypes, RecordWildCards, TypeApplications, TypeOperators #-}
 module Analysis.ScopeGraph
 ( ScopeGraph
 , Entry(..)
@@ -10,6 +10,7 @@ import           Analysis.Eval
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative (..))
 import           Control.Effect.Carrier
+import           Control.Effect.Fail
 import           Control.Effect.Fresh
 import           Control.Effect.Reader
 import           Control.Effect.State
@@ -45,17 +46,24 @@ scopeGraph
   = run
   . runFresh
   . runHeap
-  . traverse runFile
+  . traverse (runFile eval)
 
 runFile
   :: ( Carrier sig m
      , Effect sig
      , Member Fresh sig
      , Member (State (Heap User ScopeGraph)) sig
+     , Ord term
      )
-  => File (Term (Core.Ann :+: Core.Core) User)
+  => (forall sig m
+     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     => Analysis term User ScopeGraph m
+     -> (term -> m ScopeGraph)
+     -> (term -> m ScopeGraph)
+     )
+  -> File term
   -> m (File (Either (Loc, String) ScopeGraph))
-runFile file = traverse run file
+runFile eval file = traverse run file
   where run = runReader (fileLoc file)
             . runReader (Map.empty @User @Loc)
             . runFailWithLoc

From c7bee13fd438fd159a670813f964c0fac40505de Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 29 Jul 2019 13:22:18 -0400
Subject: [PATCH 15/27] Generalize scopeGraph over the term type.

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

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index cc9dbf028c..2bbb4ee5cd 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -15,7 +15,6 @@ import           Control.Effect.Fresh
 import           Control.Effect.Reader
 import           Control.Effect.State
 import           Control.Monad ((>=>))
-import qualified Data.Core as Core
 import           Data.File
 import           Data.Foldable (fold)
 import           Data.Function (fix)
@@ -26,7 +25,6 @@ import           Data.Name
 import           Data.Proxy
 import qualified Data.Set as Set
 import           Data.Text (Text)
-import           Data.Term
 import           Prelude hiding (fail)
 
 data Entry = Entry
@@ -41,8 +39,17 @@ newtype ScopeGraph = ScopeGraph { unScopeGraph :: Map.Map Entry (Set.Set Entry)
 instance Semigroup ScopeGraph where
   ScopeGraph a <> ScopeGraph b = ScopeGraph (Map.unionWith (<>) a b)
 
-scopeGraph :: [File (Term (Core.Ann :+: Core.Core) User)] -> (Heap User ScopeGraph, [File (Either (Loc, String) ScopeGraph)])
 scopeGraph
+  :: Ord term
+  => (forall sig m
+     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     => Analysis term User ScopeGraph m
+     -> (term -> m ScopeGraph)
+     -> (term -> m ScopeGraph)
+     )
+  -> [File term]
+  -> (Heap User ScopeGraph, [File (Either (Loc, String) ScopeGraph)])
+scopeGraph eval
   = run
   . runFresh
   . runHeap

From a04ccbb08c40c7711e964d522146d3b4898ad334 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 29 Jul 2019 13:33:07 -0400
Subject: [PATCH 16/27] Write record fields to the heap in the abstract
 analyses.

---
 semantic-core/src/Analysis/ImportGraph.hs | 8 ++++++--
 semantic-core/src/Analysis/ScopeGraph.hs  | 8 ++++++--
 semantic-core/src/Analysis/Typecheck.hs   | 8 +++++++-
 3 files changed, 19 insertions(+), 5 deletions(-)

diff --git a/semantic-core/src/Analysis/ImportGraph.hs b/semantic-core/src/Analysis/ImportGraph.hs
index 6b3bf28cdc..2c0f4c41a8 100644
--- a/semantic-core/src/Analysis/ImportGraph.hs
+++ b/semantic-core/src/Analysis/ImportGraph.hs
@@ -15,7 +15,7 @@ import           Control.Effect.Reader
 import           Control.Effect.State
 import           Control.Monad ((>=>))
 import           Data.File
-import           Data.Foldable (fold)
+import           Data.Foldable (fold, for_)
 import           Data.Function (fix)
 import           Data.List.NonEmpty (nonEmpty)
 import           Data.Loc
@@ -118,5 +118,9 @@ importGraphAnalysis = Analysis{..}
         string s = pure (Value (String s) mempty)
         asString (Value (String s) _) = pure s
         asString _ = pure mempty
-        record fields = pure (Value Abstract (foldMap (valueGraph . snd) fields))
+        record fields = do
+          for_ fields $ \ (k, v) -> do
+            addr <- alloc k
+            assign addr v
+          pure (Value Abstract (foldMap (valueGraph . snd) fields))
         _ ... m = pure (Just m)
diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index 2bbb4ee5cd..915c50a07a 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -16,7 +16,7 @@ import           Control.Effect.Reader
 import           Control.Effect.State
 import           Control.Monad ((>=>))
 import           Data.File
-import           Data.Foldable (fold)
+import           Data.Foldable (fold, for_)
 import           Data.Function (fix)
 import           Data.List.NonEmpty
 import           Data.Loc
@@ -104,5 +104,9 @@ scopeGraphAnalysis = Analysis{..}
         asBool _ = pure True <|> pure False
         string _ = pure mempty
         asString _ = pure mempty
-        record fields = pure (foldMap snd fields)
+        record fields = do
+          for_ fields $ \ (k, v) -> do
+            addr <- alloc k
+            assign addr v
+          pure (foldMap snd fields)
         _ ... m = pure (Just m)
diff --git a/semantic-core/src/Analysis/Typecheck.hs b/semantic-core/src/Analysis/Typecheck.hs
index 9f1e3f9fd3..dfb0ff9aa8 100644
--- a/semantic-core/src/Analysis/Typecheck.hs
+++ b/semantic-core/src/Analysis/Typecheck.hs
@@ -33,6 +33,7 @@ import           Data.Scope
 import           Data.Semigroup (Last (..))
 import qualified Data.Set as Set
 import           Data.Term
+import           Data.Traversable (for)
 import           Data.Void
 import           GHC.Generics (Generic1)
 import           Prelude hiding (fail)
@@ -173,7 +174,12 @@ typecheckingAnalysis = Analysis{..}
         asBool b = unify (Term Bool) b >> pure True <|> pure False
         string _ = pure (Term String)
         asString s = unify (Term String) s $> mempty
-        record fields = pure (Term (Record (Map.fromList fields)))
+        record fields = do
+          fields' <- for fields $ \ (k, v) -> do
+            addr <- alloc k
+            (k, v) <$ assign addr v
+          -- FIXME: should records reference types by address instead?
+          pure (Term (Record (Map.fromList fields')))
         _ ... m = pure (Just m)
 
 

From 34da6ada5cca62e2b712fa950b41c67508eb3be8 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 29 Jul 2019 15:36:37 -0400
Subject: [PATCH 17/27] =?UTF-8?q?Rename=20a=20couple=20of=20copy-pasta?=
 =?UTF-8?q?=E2=80=99d=20variables.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 semantic-core/src/Analysis/ImportGraph.hs | 2 +-
 semantic-core/src/Analysis/ScopeGraph.hs  | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/semantic-core/src/Analysis/ImportGraph.hs b/semantic-core/src/Analysis/ImportGraph.hs
index 2c0f4c41a8..dbc25fafaf 100644
--- a/semantic-core/src/Analysis/ImportGraph.hs
+++ b/semantic-core/src/Analysis/ImportGraph.hs
@@ -103,7 +103,7 @@ importGraphAnalysis = Analysis{..}
         bind _ _ m = m
         lookupEnv = pure . Just
         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))
+        assign addr v = modify (Map.insertWith (<>) addr (Set.singleton v))
         abstract _ name body = do
           loc <- ask
           pure (Value (Closure loc name body) mempty)
diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index 915c50a07a..d0028b7c8c 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -93,7 +93,7 @@ scopeGraphAnalysis = Analysis{..}
           local (Map.insert name loc) m
         lookupEnv = pure . Just
         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))
+        assign addr v = modify (Map.insertWith (<>) addr (Set.singleton v))
         abstract eval name body = do
           addr <- alloc name
           assign name (mempty @ScopeGraph)

From 3bf6cb61fdb1749fbd8d97fd69ea0b93cb7c2d50 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 29 Jul 2019 15:51:38 -0400
Subject: [PATCH 18/27] =?UTF-8?q?Export=20ScopeGraph=E2=80=99s=20construct?=
 =?UTF-8?q?or=20&=20field.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index d0028b7c8c..f0f0562727 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -1,6 +1,6 @@
 {-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, OverloadedStrings, RankNTypes, RecordWildCards, TypeApplications, TypeOperators #-}
 module Analysis.ScopeGraph
-( ScopeGraph
+( ScopeGraph(..)
 , Entry(..)
 , scopeGraph
 , scopeGraphAnalysis

From 6cb9af299e549feafda1df2abe84c05b904685d9 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 29 Jul 2019 15:51:52 -0400
Subject: [PATCH 19/27] Correct the Monoid instance for ScopeGraph.

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

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index f0f0562727..233197dba2 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts, GeneralizedNewtypeDeriving, OverloadedStrings, RankNTypes, RecordWildCards, TypeApplications, TypeOperators #-}
+{-# LANGUAGE FlexibleContexts, OverloadedStrings, RankNTypes, RecordWildCards, TypeApplications, TypeOperators #-}
 module Analysis.ScopeGraph
 ( ScopeGraph(..)
 , Entry(..)
@@ -34,11 +34,14 @@ data Entry = Entry
   deriving (Eq, Ord, Show)
 
 newtype ScopeGraph = ScopeGraph { unScopeGraph :: Map.Map Entry (Set.Set Entry) }
-  deriving (Eq, Monoid, Ord, Show)
+  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
   :: Ord term
   => (forall sig m

From a4066b9df6e721e0d7be42657834974731f138a3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 29 Jul 2019 16:07:29 -0400
Subject: [PATCH 20/27] Construct scope graphs on deref.

---
 semantic-core/src/Analysis/ScopeGraph.hs | 6 +++++-
 1 file changed, 5 insertions(+), 1 deletion(-)

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index 233197dba2..9ad6830b9b 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -95,7 +95,11 @@ scopeGraphAnalysis = Analysis{..}
           loc <- ask @Loc
           local (Map.insert name loc) m
         lookupEnv = pure . Just
-        deref addr = gets (Map.lookup addr >=> nonEmpty . Set.toList) >>= maybe (pure Nothing) (foldMapA (pure . Just))
+        deref addr = do
+          loc <- ask @Loc
+          bindLoc <- asks (Map.lookup addr)
+          cell <- gets (Map.lookup addr >=> nonEmpty . Set.toList)
+          maybe (pure Nothing) (foldMapA (pure . Just . mappend (ScopeGraph (maybe Map.empty (\ bindLoc -> Map.singleton (Entry addr bindLoc) (Set.singleton (Entry addr loc))) bindLoc)))) cell
         assign addr v = modify (Map.insertWith (<>) addr (Set.singleton v))
         abstract eval name body = do
           addr <- alloc name

From ed94104e276337c2f8e1ea720d692956dff58647 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 29 Jul 2019 16:08:56 -0400
Subject: [PATCH 21/27] Map entries to references.

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

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index 9ad6830b9b..c444897960 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -33,7 +33,10 @@ data Entry = Entry
   }
   deriving (Eq, Ord, Show)
 
-newtype ScopeGraph = ScopeGraph { unScopeGraph :: Map.Map Entry (Set.Set Entry) }
+newtype Ref = Ref Loc
+  deriving (Eq, Ord, Show)
+
+newtype ScopeGraph = ScopeGraph { unScopeGraph :: Map.Map Entry (Set.Set Ref) }
   deriving (Eq, Ord, Show)
 
 instance Semigroup ScopeGraph where
@@ -96,10 +99,10 @@ scopeGraphAnalysis = Analysis{..}
           local (Map.insert name loc) m
         lookupEnv = pure . Just
         deref addr = do
-          loc <- ask @Loc
+          ref <- asks Ref
           bindLoc <- asks (Map.lookup addr)
           cell <- gets (Map.lookup addr >=> nonEmpty . Set.toList)
-          maybe (pure Nothing) (foldMapA (pure . Just . mappend (ScopeGraph (maybe Map.empty (\ bindLoc -> Map.singleton (Entry addr bindLoc) (Set.singleton (Entry addr loc))) bindLoc)))) cell
+          maybe (pure Nothing) (foldMapA (pure . Just . mappend (ScopeGraph (maybe Map.empty (\ bindLoc -> Map.singleton (Entry addr bindLoc) (Set.singleton ref)) bindLoc)))) cell
         assign addr v = modify (Map.insertWith (<>) addr (Set.singleton v))
         abstract eval name body = do
           addr <- alloc name

From a73b267ebdd22978cdf89d4c41f05aa432fd5d9f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 29 Jul 2019 16:10:09 -0400
Subject: [PATCH 22/27] Rename Entry to Decl.

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

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index c444897960..760078e563 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE FlexibleContexts, OverloadedStrings, RankNTypes, RecordWildCards, TypeApplications, TypeOperators #-}
 module Analysis.ScopeGraph
 ( ScopeGraph(..)
-, Entry(..)
+, Decl(..)
 , scopeGraph
 , scopeGraphAnalysis
 ) where
@@ -27,16 +27,16 @@ import qualified Data.Set as Set
 import           Data.Text (Text)
 import           Prelude hiding (fail)
 
-data Entry = Entry
-  { entrySymbol :: Text
-  , entryLoc    :: Loc
+data Decl = Decl
+  { declSymbol :: Text
+  , declLoc    :: Loc
   }
   deriving (Eq, Ord, Show)
 
 newtype Ref = Ref Loc
   deriving (Eq, Ord, Show)
 
-newtype ScopeGraph = ScopeGraph { unScopeGraph :: Map.Map Entry (Set.Set Ref) }
+newtype ScopeGraph = ScopeGraph { unScopeGraph :: Map.Map Decl (Set.Set Ref) }
   deriving (Eq, Ord, Show)
 
 instance Semigroup ScopeGraph where
@@ -102,7 +102,7 @@ scopeGraphAnalysis = Analysis{..}
           ref <- asks Ref
           bindLoc <- asks (Map.lookup addr)
           cell <- gets (Map.lookup addr >=> nonEmpty . Set.toList)
-          maybe (pure Nothing) (foldMapA (pure . Just . mappend (ScopeGraph (maybe Map.empty (\ bindLoc -> Map.singleton (Entry addr bindLoc) (Set.singleton ref)) bindLoc)))) cell
+          maybe (pure Nothing) (foldMapA (pure . Just . mappend (ScopeGraph (maybe Map.empty (\ bindLoc -> Map.singleton (Decl addr bindLoc) (Set.singleton ref)) bindLoc)))) cell
         assign addr v = modify (Map.insertWith (<>) addr (Set.singleton v))
         abstract eval name body = do
           addr <- alloc name

From 196f2bff176e310208925838e1f2ee6f6a0fe795 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Mon, 29 Jul 2019 16:16:46 -0400
Subject: [PATCH 23/27] Add declarations to records.

---
 semantic-core/src/Analysis/ScopeGraph.hs | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index 760078e563..2d2db835f3 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -16,7 +16,7 @@ import           Control.Effect.Reader
 import           Control.Effect.State
 import           Control.Monad ((>=>))
 import           Data.File
-import           Data.Foldable (fold, for_)
+import           Data.Foldable (fold)
 import           Data.Function (fix)
 import           Data.List.NonEmpty
 import           Data.Loc
@@ -25,6 +25,7 @@ import           Data.Name
 import           Data.Proxy
 import qualified Data.Set as Set
 import           Data.Text (Text)
+import           Data.Traversable (for)
 import           Prelude hiding (fail)
 
 data Decl = Decl
@@ -115,8 +116,10 @@ scopeGraphAnalysis = Analysis{..}
         string _ = pure mempty
         asString _ = pure mempty
         record fields = do
-          for_ fields $ \ (k, v) -> do
+          fields' <- for fields $ \ (k, v) -> do
             addr <- alloc k
-            assign addr v
-          pure (foldMap snd fields)
+            loc <- ask @Loc
+            let v' = ScopeGraph (Map.singleton (Decl k loc) mempty) <> v
+            (k, v') <$ assign addr v'
+          pure (foldMap snd fields')
         _ ... m = pure (Just m)

From 100d6a18ff368c429eef109838934f7829feda46 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 30 Jul 2019 09:14:32 -0400
Subject: [PATCH 24/27] Extend the scope graph on assignment.

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

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index 2d2db835f3..3253a13a6a 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -104,7 +104,10 @@ scopeGraphAnalysis = Analysis{..}
           bindLoc <- asks (Map.lookup addr)
           cell <- gets (Map.lookup addr >=> nonEmpty . Set.toList)
           maybe (pure Nothing) (foldMapA (pure . Just . mappend (ScopeGraph (maybe Map.empty (\ bindLoc -> Map.singleton (Decl addr bindLoc) (Set.singleton ref)) bindLoc)))) cell
-        assign addr v = modify (Map.insertWith (<>) addr (Set.singleton v))
+        assign addr v = do
+          ref <- asks Ref
+          bindLoc <- asks (Map.lookup addr)
+          modify (Map.insertWith (<>) addr (Set.singleton (ScopeGraph (maybe Map.empty (\ bindLoc -> Map.singleton (Decl addr bindLoc) (Set.singleton ref)) bindLoc) <> v)))
         abstract eval name body = do
           addr <- alloc name
           assign name (mempty @ScopeGraph)

From e58dea96fbe40819843c4caab7d088f365e8e53e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 30 Jul 2019 09:21:03 -0400
Subject: [PATCH 25/27] Factor out how we extend bindings.

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

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index 3253a13a6a..5304b86caf 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -103,11 +103,11 @@ scopeGraphAnalysis = Analysis{..}
           ref <- asks Ref
           bindLoc <- asks (Map.lookup addr)
           cell <- gets (Map.lookup addr >=> nonEmpty . Set.toList)
-          maybe (pure Nothing) (foldMapA (pure . Just . mappend (ScopeGraph (maybe Map.empty (\ bindLoc -> Map.singleton (Decl addr bindLoc) (Set.singleton ref)) bindLoc)))) cell
+          maybe (pure Nothing) (foldMapA (pure . Just . mappend (extendBinding addr ref bindLoc))) cell
         assign addr v = do
           ref <- asks Ref
           bindLoc <- asks (Map.lookup addr)
-          modify (Map.insertWith (<>) addr (Set.singleton (ScopeGraph (maybe Map.empty (\ bindLoc -> Map.singleton (Decl addr bindLoc) (Set.singleton ref)) bindLoc) <> v)))
+          modify (Map.insertWith (<>) addr (Set.singleton (extendBinding addr ref bindLoc <> v)))
         abstract eval name body = do
           addr <- alloc name
           assign name (mempty @ScopeGraph)
@@ -126,3 +126,5 @@ scopeGraphAnalysis = Analysis{..}
             (k, v') <$ assign addr v'
           pure (foldMap snd fields')
         _ ... m = pure (Just m)
+
+        extendBinding addr ref bindLoc = ScopeGraph (maybe Map.empty (\ bindLoc -> Map.singleton (Decl addr bindLoc) (Set.singleton ref)) bindLoc)

From 901014d6ac080cb1621c53894f62fbb1acb72471 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 30 Jul 2019 09:38:09 -0400
Subject: [PATCH 26/27] :fire: a redundant FIXME.

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

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index 5304b86caf..8a5c45d395 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -84,7 +84,6 @@ runFile eval file = traverse run file
             . fmap fold
             . convergeTerm (Proxy @User) (fix (cacheTerm . eval scopeGraphAnalysis))
 
--- FIXME: decompose into a product domain and two atomic domains
 scopeGraphAnalysis
   :: ( Alternative m
      , Carrier sig m

From 0515d7c11dd58e8a9dc2dc8141fa291a83d2147b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Tue, 6 Aug 2019 15:05:15 -0400
Subject: [PATCH 27/27] Let-bind the function extending each value in the cell.

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

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index 8a5c45d395..73686fd396 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -102,7 +102,8 @@ scopeGraphAnalysis = Analysis{..}
           ref <- asks Ref
           bindLoc <- asks (Map.lookup addr)
           cell <- gets (Map.lookup addr >=> nonEmpty . Set.toList)
-          maybe (pure Nothing) (foldMapA (pure . Just . mappend (extendBinding addr ref bindLoc))) cell
+          let extending = mappend (extendBinding addr ref bindLoc)
+          maybe (pure Nothing) (foldMapA (pure . Just . extending)) cell
         assign addr v = do
           ref <- asks Ref
           bindLoc <- asks (Map.lookup addr)