From 2be7c29dadfddb4993ace031915ce41f5250eadd Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 13:06:02 -0400
Subject: [PATCH 01/30] Parameterize Ann with the annotation type.

---
 semantic-core/src/Analysis/Eval.hs | 10 +++++-----
 semantic-core/src/Data/Core.hs     | 16 ++++++++--------
 2 files changed, 13 insertions(+), 13 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index d645d355b..eb88db678 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -33,9 +33,9 @@ eval :: ( Carrier sig m
         , MonadFail m
         , Semigroup value
         )
-     => Analysis (Term (Ann :+: Core) Name) address value m
-     -> (Term (Ann :+: Core) Name -> m value)
-     -> (Term (Ann :+: Core) Name -> m value)
+     => Analysis (Term (Ann Loc :+: Core) Name) address value m
+     -> (Term (Ann Loc :+: Core) Name -> m value)
+     -> (Term (Ann Loc :+: Core) Name -> m value)
 eval Analysis{..} eval = \case
   Var n -> lookupEnv' n >>= deref' n
   Term (R c) -> case c of
@@ -116,7 +116,7 @@ prog4 = fromBody
     (Core.bool True)
     (Core.bool False))
 
-prog5 :: (Carrier sig t, Member Ann sig, Member Core sig) => File (t Name)
+prog5 :: (Carrier sig t, Member (Ann Loc) sig, Member Core sig) => File (t Name)
 prog5 = fromBody $ ann (do'
   [ Just (named' "mkPoint") :<- lams [named' "_x", named' "_y"] (ann (Core.record
     [ ("x", ann (pure "_x"))
@@ -137,7 +137,7 @@ prog6 =
     ])
   ]
 
-ruby :: (Carrier sig t, Member Ann sig, Member Core sig) => File (t Name)
+ruby :: (Carrier sig t, Member (Ann Loc) sig, Member Core sig) => File (t Name)
 ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (do' statements))
   where statements =
           [ Just "Class" :<- record
diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 6691516ae..bd8795fc2 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -215,27 +215,27 @@ a .= b = send (a := b)
 infix 3 .=
 
 
-data Ann f a
-  = Ann Loc (f a)
+data Ann ann f a
+  = Ann ann (f a)
   deriving (Eq, Foldable, Functor, Generic1, Ord, Show, Traversable)
 
-instance HFunctor Ann
+instance HFunctor (Ann ann)
 
-instance RightModule Ann where
+instance RightModule (Ann ann) where
   Ann l b >>=* f = Ann l (b >>= f)
 
 
-ann :: (Carrier sig m, Member Ann sig) => HasCallStack => m a -> m a
+ann :: (Carrier sig m, Member (Ann Loc) sig) => HasCallStack => m a -> m a
 ann = annWith callStack
 
-annAt :: (Carrier sig m, Member Ann sig) => Loc -> m a -> m a
+annAt :: (Carrier sig m, Member (Ann Loc) sig) => Loc -> m a -> m a
 annAt loc = send . Ann loc
 
-annWith :: (Carrier sig m, Member Ann sig) => CallStack -> m a -> m a
+annWith :: (Carrier sig m, Member (Ann Loc) sig) => CallStack -> m a -> m a
 annWith callStack = maybe id annAt (stackLoc callStack)
 
 
-stripAnnotations :: (HFunctor sig, forall g . Functor g => Functor (sig g)) => Term (Ann :+: sig) a -> Term sig a
+stripAnnotations :: (HFunctor sig, forall g . Functor g => Functor (sig g)) => Term (Ann 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)

From d044ea2fc4d08017e25794d024e552cd7e7e2655 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 13:08:14 -0400
Subject: [PATCH 02/30] Add a newtype wrapper around Path.

---
 semantic-core/src/Analysis/Concrete.hs |  2 +-
 semantic-core/src/Analysis/Eval.hs     |  4 ++--
 semantic-core/src/Data/Loc.hs          | 10 +++++++---
 3 files changed, 10 insertions(+), 6 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index a58fde244..979b03a40 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -206,7 +206,7 @@ addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
           Unit ->  "()"
           Bool b -> pack $ show b
           String s -> pack $ show s
-          Closure (Loc p (Span s e)) n _ _ -> "\\\\ " <> unName n <> " [" <> p <> ":" <> showPos s <> "-" <> showPos e <> "]"
+          Closure (Loc p (Span s e)) n _ _ -> "\\\\ " <> unName n <> " [" <> getPath p <> ":" <> showPos s <> "-" <> showPos e <> "]"
           Record _ -> "{}"
         showPos (Pos l c) = pack (show l) <> ":" <> pack (show c)
 
diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index eb88db678..78940fceb 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -129,9 +129,9 @@ prog5 = fromBody $ ann (do'
 
 prog6 :: (Carrier sig t, Member Core sig) => [File (t Name)]
 prog6 =
-  [ File (Loc "dep"  (locSpan (fromJust here))) $ Core.record
+  [ File (Loc (Path "dep")  (locSpan (fromJust here))) $ Core.record
     [ ("dep", Core.record [ ("var", Core.bool True) ]) ]
-  , File (Loc "main" (locSpan (fromJust here))) $ do' (map (Nothing :<-)
+  , File (Loc (Path "main") (locSpan (fromJust here))) $ do' (map (Nothing :<-)
     [ load (Core.string "dep")
     , Core.record [ ("thing", pure "dep" Core.... "var") ]
     ])
diff --git a/semantic-core/src/Data/Loc.hs b/semantic-core/src/Data/Loc.hs
index 250db1742..0afec50af 100644
--- a/semantic-core/src/Data/Loc.hs
+++ b/semantic-core/src/Data/Loc.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE OverloadedStrings, RecordWildCards #-}
 module Data.Loc
 ( Loc(..)
+, Path(..)
 , interactive
 , here
 , stackLoc
@@ -10,14 +11,17 @@ import Data.Text (Text, pack)
 import GHC.Stack
 import Source.Span
 
+newtype Path = Path { getPath :: Text }
+  deriving (Eq, Ord, Show)
+
 data Loc = Loc
-  { locPath :: !Text
+  { locPath :: !Path
   , locSpan :: {-# UNPACK #-} !Span
   }
   deriving (Eq, Ord, Show)
 
 interactive :: Loc
-interactive = Loc "<interactive>" (Span (Pos 1 1) (Pos 1 1))
+interactive = Loc (Path "<interactive>") (Span (Pos 1 1) (Pos 1 1))
 
 
 here :: HasCallStack => Maybe Loc
@@ -29,4 +33,4 @@ stackLoc cs = case getCallStack cs of
   _             -> Nothing
 
 fromGHCSrcLoc :: SrcLoc -> Loc
-fromGHCSrcLoc SrcLoc{..} = Loc (pack srcLocFile) (Span (Pos srcLocStartLine srcLocStartCol) (Pos srcLocEndLine srcLocEndCol))
+fromGHCSrcLoc SrcLoc{..} = Loc (Path (pack srcLocFile)) (Span (Pos srcLocStartLine srcLocStartCol) (Pos srcLocEndLine srcLocEndCol))

From c97c8c7e1208a229b8d1a0d8d92cc702b68d0d38 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 13:12:32 -0400
Subject: [PATCH 03/30] Inline Loc into File.

---
 semantic-core/src/Analysis/Eval.hs |  4 ++--
 semantic-core/src/Data/File.hs     | 11 +++++++++--
 2 files changed, 11 insertions(+), 4 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 78940fceb..b6d73d3f8 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -129,9 +129,9 @@ prog5 = fromBody $ ann (do'
 
 prog6 :: (Carrier sig t, Member Core sig) => [File (t Name)]
 prog6 =
-  [ File (Loc (Path "dep")  (locSpan (fromJust here))) $ Core.record
+  [ File (Path "dep")  (locSpan (fromJust here)) $ Core.record
     [ ("dep", Core.record [ ("var", Core.bool True) ]) ]
-  , File (Loc (Path "main") (locSpan (fromJust here))) $ do' (map (Nothing :<-)
+  , File (Path "main") (locSpan (fromJust here)) $ do' (map (Nothing :<-)
     [ load (Core.string "dep")
     , Core.record [ ("thing", pure "dep" Core.... "var") ]
     ])
diff --git a/semantic-core/src/Data/File.hs b/semantic-core/src/Data/File.hs
index 84f39781e..0f37d0763 100644
--- a/semantic-core/src/Data/File.hs
+++ b/semantic-core/src/Data/File.hs
@@ -1,18 +1,25 @@
 {-# LANGUAGE DeriveTraversable #-}
 module Data.File
 ( File(..)
+, fileLoc
 , fromBody
 ) where
 
 import Data.Loc
 import Data.Maybe (fromJust)
 import GHC.Stack
+import Source.Span
 
 data File a = File
-  { fileLoc  :: !Loc
+  { filePath :: !Path
+  , fileSpan :: {-# UNPACK #-} !Span
   , fileBody :: !a
   }
   deriving (Eq, Foldable, Functor, Ord, Show, Traversable)
 
+fileLoc :: File a -> Loc
+fileLoc (File p s _) = Loc p s
+
 fromBody :: HasCallStack => a -> File a
-fromBody body = File (fromJust (stackLoc callStack)) body
+fromBody body = File path span body where
+  Loc path span = fromJust (stackLoc callStack)

From dfceb329f9d36e0816b110485b72ba9dd2bead82 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 13:26:09 -0400
Subject: [PATCH 04/30] Split Loc annotations into separate Path & Span
 readers.

---
 semantic-core/src/Analysis/Concrete.hs        | 21 ++++++++-------
 semantic-core/src/Analysis/Eval.hs            |  8 +++---
 semantic-core/src/Analysis/ImportGraph.hs     | 21 +++++++++------
 semantic-core/src/Analysis/ScopeGraph.hs      | 26 ++++++++++++-------
 semantic-core/src/Analysis/Typecheck.hs       | 12 +++++----
 .../src/Control/Carrier/Fail/WithLoc.hs       | 14 +++++-----
 6 files changed, 61 insertions(+), 41 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index 979b03a40..65de372c7 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -72,13 +72,13 @@ data Edge = Lexical | Import
 concrete
   :: (Foldable term, Show (term Name))
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     .  (Carrier sig m, Member (Reader Path) 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)))
      )
   -> [File (term Name)]
-  -> (Heap (term Name), [File (Either (Loc, String) (Concrete (term Name)))])
+  -> (Heap (term Name), [File (Either (Path, Span, String) (Concrete (term Name)))])
 concrete eval
   = run
   . runFresh
@@ -94,15 +94,16 @@ runFile
      , Show (term Name)
      )
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     .  (Carrier sig m, Member (Reader Path) 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)))
      )
   -> File (term Name)
-  -> m (File (Either (Loc, String) (Concrete (term Name))))
+  -> m (File (Either (Path, Span, String) (Concrete (term Name))))
 runFile eval file = traverse run file
-  where run = runReader (fileLoc file)
+  where run = runReader (filePath file)
+            . runReader (fileSpan file)
             . runFail
             . runReader @Env mempty
             . fix (eval concreteAnalysis)
@@ -111,7 +112,8 @@ concreteAnalysis :: ( Carrier sig m
                     , Foldable term
                     , Member Fresh sig
                     , Member (Reader Env) sig
-                    , Member (Reader Loc) sig
+                    , Member (Reader Path) sig
+                    , Member (Reader Span) sig
                     , Member (State (Heap (term Name))) sig
                     , MonadFail m
                     , Show (term Name)
@@ -124,11 +126,11 @@ concreteAnalysis = Analysis{..}
         deref = gets . IntMap.lookup
         assign addr value = modify (IntMap.insert addr value)
         abstract _ name body = do
-          loc <- ask
+          loc <- askLoc
           env <- asks (flip Map.restrictKeys (Set.delete name (foldMap Set.singleton body)))
           pure (Closure loc name body env)
-        apply eval (Closure loc name body env) a = do
-          local (const loc) $ do
+        apply eval (Closure (Loc path span) name body env) a = do
+          local (const path) . local (const span) $ do
             addr <- alloc name
             assign addr a
             local (const (Map.insert name addr env)) (eval body)
@@ -150,6 +152,7 @@ concreteAnalysis = Analysis{..}
           val <- deref addr
           heap <- get
           pure (val >>= lookupConcrete heap n)
+        askLoc = Loc <$> ask <*> ask
 
 
 lookupConcrete :: Heap term -> Name -> Concrete term -> Maybe Precise
diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index b6d73d3f8..715b39e63 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -27,9 +27,11 @@ import Data.Term
 import Data.Text (Text)
 import GHC.Stack
 import Prelude hiding (fail)
+import Source.Span
 
 eval :: ( Carrier sig m
-        , Member (Reader Loc) sig
+        , Member (Reader Path) sig
+        , Member (Reader Span) sig
         , MonadFail m
         , Semigroup value
         )
@@ -72,7 +74,7 @@ eval Analysis{..} eval = \case
       b' <- eval b
       addr <- ref a
       b' <$ assign addr b'
-  Term (L (Ann loc c)) -> local (const loc) (eval c)
+  Term (L (Ann (Loc p s) c)) -> local (const p) (local (const s) (eval c))
   where freeVariable s = fail ("free variable: " <> s)
         uninitialized s = fail ("uninitialized variable: " <> s)
         invalidRef s = fail ("invalid ref: " <> s)
@@ -90,7 +92,7 @@ eval Analysis{..} eval = \case
               a' <- ref a
               a' ... b >>= maybe (freeVariable (show b)) pure
             c -> invalidRef (show c)
-          Term (L (Ann loc c)) -> local (const loc) (ref c)
+          Term (L (Ann (Loc p s) c)) -> local (const p) (local (const s) (ref c))
 
 
 prog1 :: (Carrier sig t, Member Core sig) => File (t Name)
diff --git a/semantic-core/src/Analysis/ImportGraph.hs b/semantic-core/src/Analysis/ImportGraph.hs
index 7775479c4..1b576b9f0 100644
--- a/semantic-core/src/Analysis/ImportGraph.hs
+++ b/semantic-core/src/Analysis/ImportGraph.hs
@@ -25,6 +25,7 @@ import           Data.Proxy
 import qualified Data.Set as Set
 import           Data.Text (Text)
 import           Prelude hiding (fail)
+import           Source.Span
 
 type ImportGraph = Map.Map Text (Set.Set Text)
 
@@ -51,14 +52,14 @@ data Semi term
 importGraph
   :: (Ord term, Show term)
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     .  (Carrier sig m, Member (Reader Path) sig, Member (Reader Span) sig, MonadFail m)
      => Analysis term Name (Value term) m
      -> (term -> m (Value term))
      -> (term -> m (Value term))
      )
   -> [File term]
   -> ( Heap Name (Value term)
-     , [File (Either (Loc, String) (Value term))]
+     , [File (Either (Path, Span, String) (Value term))]
      )
 importGraph eval
   = run
@@ -75,15 +76,16 @@ runFile
      , Show term
      )
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     .  (Carrier sig m, Member (Reader Path) sig, Member (Reader Span) sig, MonadFail m)
      => Analysis term Name (Value term) m
      -> (term -> m (Value term))
      -> (term -> m (Value term))
      )
   -> File term
-  -> m (File (Either (Loc, String) (Value term)))
+  -> m (File (Either (Path, Span, String) (Value term)))
 runFile eval file = traverse run file
-  where run = runReader (fileLoc file)
+  where run = runReader (filePath file)
+            . runReader (fileSpan file)
             . runFail
             . fmap fold
             . convergeTerm (Proxy @Name) (fix (cacheTerm . eval importGraphAnalysis))
@@ -91,7 +93,8 @@ runFile eval file = traverse run file
 -- FIXME: decompose into a product domain and two atomic domains
 importGraphAnalysis :: ( Alternative m
                        , Carrier sig m
-                       , Member (Reader Loc) sig
+                       , Member (Reader Path) sig
+                       , Member (Reader Span) sig
                        , Member (State (Heap Name (Value term))) sig
                        , MonadFail m
                        , Ord  term
@@ -105,9 +108,9 @@ importGraphAnalysis = Analysis{..}
         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
-          loc <- ask
+          loc <- askLoc
           pure (Value (Closure loc name body) mempty)
-        apply eval (Value (Closure loc name body) _) a = local (const loc) $ do
+        apply eval (Value (Closure (Loc path span) name body) _) a = local (const path) . local (const span) $ do
           addr <- alloc name
           assign addr a
           bind name addr (eval body)
@@ -124,3 +127,5 @@ importGraphAnalysis = Analysis{..}
             assign addr v
           pure (Value Abstract (foldMap (valueGraph . snd) fields))
         _ ... m = pure (Just m)
+
+        askLoc = Loc <$> ask <*> ask
diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index bd102ac55..0e6f7739a 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -27,6 +27,7 @@ import           Data.Proxy
 import qualified Data.Set as Set
 import           Data.Traversable (for)
 import           Prelude hiding (fail)
+import           Source.Span
 
 data Decl = Decl
   { declSymbol :: Name
@@ -49,13 +50,13 @@ instance Monoid ScopeGraph where
 scopeGraph
   :: Ord term
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     .  (Carrier sig m, Member (Reader Path) sig, Member (Reader Span) sig, MonadFail m)
      => Analysis term Name ScopeGraph m
      -> (term -> m ScopeGraph)
      -> (term -> m ScopeGraph)
      )
   -> [File term]
-  -> (Heap Name ScopeGraph, [File (Either (Loc, String) ScopeGraph)])
+  -> (Heap Name ScopeGraph, [File (Either (Path, Span, String) ScopeGraph)])
 scopeGraph eval
   = run
   . runFresh
@@ -70,15 +71,16 @@ runFile
      , Ord term
      )
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     .  (Carrier sig m, Member (Reader Path) sig, Member (Reader Span) sig, MonadFail m)
      => Analysis term Name ScopeGraph m
      -> (term -> m ScopeGraph)
      -> (term -> m ScopeGraph)
      )
   -> File term
-  -> m (File (Either (Loc, String) ScopeGraph))
+  -> m (File (Either (Path, Span, String) ScopeGraph))
 runFile eval file = traverse run file
-  where run = runReader (fileLoc file)
+  where run = runReader (filePath file)
+            . runReader (fileSpan file)
             . runReader (Map.empty @Name @Loc)
             . runFail
             . fmap fold
@@ -87,7 +89,8 @@ runFile eval file = traverse run file
 scopeGraphAnalysis
   :: ( Alternative m
      , Carrier sig m
-     , Member (Reader Loc) sig
+     , Member (Reader Path) sig
+     , Member (Reader Span) sig
      , Member (Reader (Map.Map Name Loc)) sig
      , Member (State (Heap Name ScopeGraph)) sig
      )
@@ -95,17 +98,17 @@ scopeGraphAnalysis
 scopeGraphAnalysis = Analysis{..}
   where alloc = pure
         bind name _ m = do
-          loc <- ask @Loc
+          loc <- askLoc
           local (Map.insert name loc) m
         lookupEnv = pure . Just
         deref addr = do
-          ref <- asks Ref
+          ref <- askRef
           bindLoc <- asks (Map.lookup addr)
           cell <- gets (Map.lookup addr >=> nonEmpty . Set.toList)
           let extending = mappend (extendBinding addr ref bindLoc)
           maybe (pure Nothing) (foldMapA (pure . Just . extending)) cell
         assign addr v = do
-          ref <- asks Ref
+          ref <- askRef
           bindLoc <- asks (Map.lookup addr)
           modify (Map.insertWith (<>) addr (Set.singleton (extendBinding addr ref bindLoc <> v)))
         abstract eval name body = do
@@ -121,10 +124,13 @@ scopeGraphAnalysis = Analysis{..}
         record fields = do
           fields' <- for fields $ \ (k, v) -> do
             addr <- alloc k
-            loc <- ask @Loc
+            loc <- askLoc
             let v' = ScopeGraph (Map.singleton (Decl k loc) mempty) <> v
             (k, v') <$ assign addr v'
           pure (foldMap snd fields')
         _ ... m = pure (Just m)
 
+        askRef = Ref <$> askLoc
+        askLoc = Loc <$> ask <*> ask
+
         extendBinding addr ref bindLoc = ScopeGraph (maybe Map.empty (\ bindLoc -> Map.singleton (Decl addr bindLoc) (Set.singleton ref)) bindLoc)
diff --git a/semantic-core/src/Analysis/Typecheck.hs b/semantic-core/src/Analysis/Typecheck.hs
index 62171a765..3188c65fd 100644
--- a/semantic-core/src/Analysis/Typecheck.hs
+++ b/semantic-core/src/Analysis/Typecheck.hs
@@ -37,6 +37,7 @@ import           Data.Traversable (for)
 import           Data.Void
 import           GHC.Generics (Generic1)
 import           Prelude hiding (fail)
+import           Source.Span
 
 data Monotype f a
   = Bool
@@ -94,14 +95,14 @@ generalize ty = fromJust (closed (forAlls (IntSet.toList (mvs ty)) (hoistTerm R
 typecheckingFlowInsensitive
   :: Ord term
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     .  (Carrier sig m, Member (Reader Path) sig, Member (Reader Span) sig, MonadFail m)
      => Analysis term Name Type m
      -> (term -> m Type)
      -> (term -> m Type)
      )
   -> [File term]
   -> ( Heap Name Type
-     , [File (Either (Loc, String) (Term (Polytype :+: Monotype) Void))]
+     , [File (Either (Path, Span, String) (Term (Polytype :+: Monotype) Void))]
      )
 typecheckingFlowInsensitive eval
   = run
@@ -118,13 +119,13 @@ runFile
      , Ord term
      )
   => (forall sig m
-     .  (Carrier sig m, Member (Reader Loc) sig, MonadFail m)
+     .  (Carrier sig m, Member (Reader Path) sig, Member (Reader Span) sig, MonadFail m)
      => Analysis term Name Type m
      -> (term -> m Type)
      -> (term -> m Type)
      )
   -> File term
-  -> m (File (Either (Loc, String) Type))
+  -> m (File (Either (Path, Span, String) Type))
 runFile eval file = traverse run file
   where run
           = (\ m -> do
@@ -132,7 +133,8 @@ runFile eval file = traverse run file
               modify @(Heap Name Type) (fmap (Set.map (substAll subst)))
               pure (substAll subst <$> t))
           . runState (mempty :: Substitution)
-          . runReader (fileLoc file)
+          . runReader (filePath file)
+          . runReader (fileSpan file)
           . runFail
           . (\ m -> do
             (cs, t) <- m
diff --git a/semantic-core/src/Control/Carrier/Fail/WithLoc.hs b/semantic-core/src/Control/Carrier/Fail/WithLoc.hs
index e582505ee..33790a5c3 100644
--- a/semantic-core/src/Control/Carrier/Fail/WithLoc.hs
+++ b/semantic-core/src/Control/Carrier/Fail/WithLoc.hs
@@ -14,18 +14,20 @@ import Control.Effect.Fail (Fail(..), MonadFail(..))
 import Control.Effect.Reader
 import Data.Loc
 import Prelude hiding (fail)
+import Source.Span
 
-runFail :: FailC m a -> m (Either (Loc, String) a)
+runFail :: FailC m a -> m (Either (Path, Span, String) a)
 runFail = runError . runFailC
 
-newtype FailC m a = FailC { runFailC :: ErrorC (Loc, String) m a }
+newtype FailC m a = FailC { runFailC :: ErrorC (Path, Span, String) m a }
   deriving (Alternative, Applicative, Functor, Monad)
 
-instance (Carrier sig m, Effect sig, Member (Reader Loc) sig) => MonadFail (FailC m) where
+instance (Carrier sig m, Effect sig, Member (Reader Path) sig, Member (Reader Span) sig) => MonadFail (FailC m) where
   fail s = do
-    loc <- ask
-    FailC (throwError (loc :: Loc, s))
+    path <- ask
+    span <- ask
+    FailC (throwError (path :: Path, span :: Span, s))
 
-instance (Carrier sig m, Effect sig, Member (Reader Loc) sig) => Carrier (Fail :+: sig) (FailC m) where
+instance (Carrier sig m, Effect sig, Member (Reader Path) sig, Member (Reader Span) sig) => Carrier (Fail :+: sig) (FailC m) where
   eff (L (Fail s)) = fail s
   eff (R other)    = FailC (eff (R (handleCoercible other)))

From 200c3edf77f8b0dfaf6aa8ae37d9372aa1de05a3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 13:30:01 -0400
Subject: [PATCH 05/30] Evaluate doubly-annotated terms.

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

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 715b39e63..2fed55d32 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -35,12 +35,12 @@ eval :: ( Carrier sig m
         , MonadFail m
         , Semigroup value
         )
-     => Analysis (Term (Ann Loc :+: Core) Name) address value m
-     -> (Term (Ann Loc :+: Core) Name -> m value)
-     -> (Term (Ann Loc :+: Core) Name -> m value)
+     => Analysis (Term (Ann Path :+: Ann Span :+: Core) Name) address value m
+     -> (Term (Ann Path :+: Ann Span :+: Core) Name -> m value)
+     -> (Term (Ann Path :+: Ann Span :+: Core) Name -> m value)
 eval Analysis{..} eval = \case
   Var n -> lookupEnv' n >>= deref' n
-  Term (R c) -> case c of
+  Term (R (R c)) -> case c of
     Rec (Named (Ignored n) b) -> do
       addr <- alloc n
       v <- bind n addr (eval (instantiate1 (pure n) b))
@@ -74,7 +74,8 @@ eval Analysis{..} eval = \case
       b' <- eval b
       addr <- ref a
       b' <$ assign addr b'
-  Term (L (Ann (Loc p s) c)) -> local (const p) (local (const s) (eval c))
+  Term (R (L (Ann span c))) -> local (const span) (eval c)
+  Term (L (Ann path c)) -> local (const path) (eval c)
   where freeVariable s = fail ("free variable: " <> s)
         uninitialized s = fail ("uninitialized variable: " <> s)
         invalidRef s = fail ("invalid ref: " <> s)
@@ -84,7 +85,7 @@ eval Analysis{..} eval = \case
 
         ref = \case
           Var n -> lookupEnv' n
-          Term (R c) -> case c of
+          Term (R (R c)) -> case c of
             If c t e -> do
               c' <- eval c >>= asBool
               if c' then ref t else ref e
@@ -92,7 +93,8 @@ eval Analysis{..} eval = \case
               a' <- ref a
               a' ... b >>= maybe (freeVariable (show b)) pure
             c -> invalidRef (show c)
-          Term (L (Ann (Loc p s) c)) -> local (const p) (local (const s) (ref c))
+          Term (R (L (Ann span c))) -> local (const span) (ref c)
+          Term (L (Ann path c)) -> local (const path) (ref c)
 
 
 prog1 :: (Carrier sig t, Member Core sig) => File (t Name)

From 6a0be9cf0998cc12c2154e3509b940c56e3eb95a Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 13:36:58 -0400
Subject: [PATCH 06/30] Split up Loc annotations.

---
 semantic-core/src/Analysis/Eval.hs |  8 ++++----
 semantic-core/src/Data/Core.hs     | 11 ++++++-----
 semantic-core/src/Data/File.hs     |  2 +-
 semantic-core/src/Data/Loc.hs      |  8 ++++----
 4 files changed, 15 insertions(+), 14 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 2fed55d32..702115dbf 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -120,7 +120,7 @@ prog4 = fromBody
     (Core.bool True)
     (Core.bool False))
 
-prog5 :: (Carrier sig t, Member (Ann Loc) sig, Member Core sig) => File (t Name)
+prog5 :: (Carrier sig t, Member (Ann Path) sig, Member (Ann Span) sig, Member Core sig) => File (t Name)
 prog5 = fromBody $ ann (do'
   [ Just (named' "mkPoint") :<- lams [named' "_x", named' "_y"] (ann (Core.record
     [ ("x", ann (pure "_x"))
@@ -133,15 +133,15 @@ prog5 = fromBody $ ann (do'
 
 prog6 :: (Carrier sig t, Member Core sig) => [File (t Name)]
 prog6 =
-  [ File (Path "dep")  (locSpan (fromJust here)) $ Core.record
+  [ File (Path "dep")  (snd (fromJust here)) $ Core.record
     [ ("dep", Core.record [ ("var", Core.bool True) ]) ]
-  , File (Path "main") (locSpan (fromJust here)) $ do' (map (Nothing :<-)
+  , File (Path "main") (snd (fromJust here)) $ do' (map (Nothing :<-)
     [ load (Core.string "dep")
     , Core.record [ ("thing", pure "dep" Core.... "var") ]
     ])
   ]
 
-ruby :: (Carrier sig t, Member (Ann Loc) sig, Member Core sig) => File (t Name)
+ruby :: (Carrier sig t, Member (Ann Path) sig, Member (Ann Span) sig, Member Core sig) => File (t Name)
 ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (do' statements))
   where statements =
           [ Just "Class" :<- record
diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index bd8795fc2..35416d8da 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -50,6 +50,7 @@ import Data.Term
 import Data.Text (Text)
 import GHC.Generics (Generic1)
 import GHC.Stack
+import Source.Span
 
 data Core f a
   -- | Recursive local binding of a name in a scope; strict evaluation of the name in the body will diverge.
@@ -225,14 +226,14 @@ instance RightModule (Ann ann) where
   Ann l b >>=* f = Ann l (b >>= f)
 
 
-ann :: (Carrier sig m, Member (Ann Loc) sig) => HasCallStack => m a -> m a
+ann :: (Carrier sig m, Member (Ann Path) sig, Member (Ann Span) sig) => HasCallStack => m a -> m a
 ann = annWith callStack
 
-annAt :: (Carrier sig m, Member (Ann Loc) sig) => Loc -> m a -> m a
-annAt loc = send . Ann loc
+annAt :: (Carrier sig m, Member (Ann ann) sig) => ann -> m a -> m a
+annAt ann = send . Ann ann
 
-annWith :: (Carrier sig m, Member (Ann Loc) sig) => CallStack -> m a -> m a
-annWith callStack = maybe id annAt (stackLoc callStack)
+annWith :: (Carrier sig m, Member (Ann Path) sig, Member (Ann Span) sig) => CallStack -> m a -> m a
+annWith callStack = maybe id (\ (path, span) -> annAt path . annAt span) (stackLoc callStack)
 
 
 stripAnnotations :: (HFunctor sig, forall g . Functor g => Functor (sig g)) => Term (Ann ann :+: sig) a -> Term sig a
diff --git a/semantic-core/src/Data/File.hs b/semantic-core/src/Data/File.hs
index 0f37d0763..41977f4e4 100644
--- a/semantic-core/src/Data/File.hs
+++ b/semantic-core/src/Data/File.hs
@@ -22,4 +22,4 @@ fileLoc (File p s _) = Loc p s
 
 fromBody :: HasCallStack => a -> File a
 fromBody body = File path span body where
-  Loc path span = fromJust (stackLoc callStack)
+  (path, span) = fromJust (stackLoc callStack)
diff --git a/semantic-core/src/Data/Loc.hs b/semantic-core/src/Data/Loc.hs
index 0afec50af..bd72a64a9 100644
--- a/semantic-core/src/Data/Loc.hs
+++ b/semantic-core/src/Data/Loc.hs
@@ -24,13 +24,13 @@ interactive :: Loc
 interactive = Loc (Path "<interactive>") (Span (Pos 1 1) (Pos 1 1))
 
 
-here :: HasCallStack => Maybe Loc
+here :: HasCallStack => Maybe (Path, Span)
 here = stackLoc callStack
 
-stackLoc :: CallStack -> Maybe Loc
+stackLoc :: CallStack -> Maybe (Path, Span)
 stackLoc cs = case getCallStack cs of
   (_, srcLoc):_ -> Just (fromGHCSrcLoc srcLoc)
   _             -> Nothing
 
-fromGHCSrcLoc :: SrcLoc -> Loc
-fromGHCSrcLoc SrcLoc{..} = Loc (Path (pack srcLocFile)) (Span (Pos srcLocStartLine srcLocStartCol) (Pos srcLocEndLine srcLocEndCol))
+fromGHCSrcLoc :: SrcLoc -> (Path, Span)
+fromGHCSrcLoc SrcLoc{..} = (Path (pack srcLocFile), Span (Pos srcLocStartLine srcLocStartCol) (Pos srcLocEndLine srcLocEndCol))

From 4c58f0877ebd4612b160109f98a02f5e8d6f8bea Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 13:38:56 -0400
Subject: [PATCH 07/30] Rename Control.Carrier.Fail.WithLoc to .WithFile.

---
 semantic-core/semantic-core.cabal                               | 2 +-
 semantic-core/src/Analysis/Concrete.hs                          | 2 +-
 semantic-core/src/Analysis/ImportGraph.hs                       | 2 +-
 semantic-core/src/Analysis/ScopeGraph.hs                        | 2 +-
 semantic-core/src/Analysis/Typecheck.hs                         | 2 +-
 .../src/Control/Carrier/Fail/{WithLoc.hs => WithFile.hs}        | 2 +-
 6 files changed, 6 insertions(+), 6 deletions(-)
 rename semantic-core/src/Control/Carrier/Fail/{WithLoc.hs => WithFile.hs} (96%)

diff --git a/semantic-core/semantic-core.cabal b/semantic-core/semantic-core.cabal
index 257373af2..7be321d91 100644
--- a/semantic-core/semantic-core.cabal
+++ b/semantic-core/semantic-core.cabal
@@ -25,7 +25,7 @@ library
                      , Analysis.ImportGraph
                      , Analysis.ScopeGraph
                      , Analysis.Typecheck
-                     , Control.Carrier.Fail.WithLoc
+                     , Control.Carrier.Fail.WithFile
                      , Control.Effect.Readline
                      , Control.Monad.Module
                      , Data.Core
diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index 65de372c7..a05c4a8fe 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -13,7 +13,7 @@ import qualified Algebra.Graph as G
 import qualified Algebra.Graph.Export.Dot as G
 import           Analysis.Eval
 import           Control.Applicative (Alternative (..))
-import           Control.Carrier.Fail.WithLoc
+import           Control.Carrier.Fail.WithFile
 import           Control.Effect
 import           Control.Effect.Fresh
 import           Control.Effect.NonDet
diff --git a/semantic-core/src/Analysis/ImportGraph.hs b/semantic-core/src/Analysis/ImportGraph.hs
index 1b576b9f0..0369f4f65 100644
--- a/semantic-core/src/Analysis/ImportGraph.hs
+++ b/semantic-core/src/Analysis/ImportGraph.hs
@@ -8,7 +8,7 @@ module Analysis.ImportGraph
 import           Analysis.Eval
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative(..))
-import           Control.Carrier.Fail.WithLoc
+import           Control.Carrier.Fail.WithFile
 import           Control.Effect
 import           Control.Effect.Fresh
 import           Control.Effect.Reader
diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index 0e6f7739a..d013adc8a 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -10,7 +10,7 @@ module Analysis.ScopeGraph
 import           Analysis.Eval
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative (..))
-import           Control.Carrier.Fail.WithLoc
+import           Control.Carrier.Fail.WithFile
 import           Control.Effect.Carrier
 import           Control.Effect.Fresh
 import           Control.Effect.Reader
diff --git a/semantic-core/src/Analysis/Typecheck.hs b/semantic-core/src/Analysis/Typecheck.hs
index 3188c65fd..c77d6ab38 100644
--- a/semantic-core/src/Analysis/Typecheck.hs
+++ b/semantic-core/src/Analysis/Typecheck.hs
@@ -10,7 +10,7 @@ module Analysis.Typecheck
 import           Analysis.Eval
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative (..))
-import           Control.Carrier.Fail.WithLoc
+import           Control.Carrier.Fail.WithFile
 import           Control.Effect.Carrier
 import           Control.Effect.Fresh as Fresh
 import           Control.Effect.Reader hiding (Local)
diff --git a/semantic-core/src/Control/Carrier/Fail/WithLoc.hs b/semantic-core/src/Control/Carrier/Fail/WithFile.hs
similarity index 96%
rename from semantic-core/src/Control/Carrier/Fail/WithLoc.hs
rename to semantic-core/src/Control/Carrier/Fail/WithFile.hs
index 33790a5c3..d37c42229 100644
--- a/semantic-core/src/Control/Carrier/Fail/WithLoc.hs
+++ b/semantic-core/src/Control/Carrier/Fail/WithFile.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
-module Control.Carrier.Fail.WithLoc
+module Control.Carrier.Fail.WithFile
 ( -- * Fail effect
   module Control.Effect.Fail
   -- * Fail carrier

From 1ec98e9c059afb2d206dfb116e82f42b11f4df72 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 13:40:49 -0400
Subject: [PATCH 08/30] Return the message in a File.

---
 semantic-core/src/Analysis/Concrete.hs             |  4 ++--
 semantic-core/src/Analysis/ImportGraph.hs          |  4 ++--
 semantic-core/src/Analysis/ScopeGraph.hs           |  4 ++--
 semantic-core/src/Analysis/Typecheck.hs            |  4 ++--
 semantic-core/src/Control/Carrier/Fail/WithFile.hs | 10 ++++------
 5 files changed, 12 insertions(+), 14 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index a05c4a8fe..f6309b1b0 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -78,7 +78,7 @@ concrete
      -> (term Name -> m (Concrete (term Name)))
      )
   -> [File (term Name)]
-  -> (Heap (term Name), [File (Either (Path, Span, String) (Concrete (term Name)))])
+  -> (Heap (term Name), [File (Either (File String) (Concrete (term Name)))])
 concrete eval
   = run
   . runFresh
@@ -100,7 +100,7 @@ runFile
      -> (term Name -> m (Concrete (term Name)))
      )
   -> File (term Name)
-  -> m (File (Either (Path, Span, String) (Concrete (term Name))))
+  -> m (File (Either (File String) (Concrete (term Name))))
 runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
diff --git a/semantic-core/src/Analysis/ImportGraph.hs b/semantic-core/src/Analysis/ImportGraph.hs
index 0369f4f65..638eb7ee8 100644
--- a/semantic-core/src/Analysis/ImportGraph.hs
+++ b/semantic-core/src/Analysis/ImportGraph.hs
@@ -59,7 +59,7 @@ importGraph
      )
   -> [File term]
   -> ( Heap Name (Value term)
-     , [File (Either (Path, Span, String) (Value term))]
+     , [File (Either (File String) (Value term))]
      )
 importGraph eval
   = run
@@ -82,7 +82,7 @@ runFile
      -> (term -> m (Value term))
      )
   -> File term
-  -> m (File (Either (Path, Span, String) (Value term)))
+  -> m (File (Either (File String) (Value term)))
 runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index d013adc8a..daa1363f3 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -56,7 +56,7 @@ scopeGraph
      -> (term -> m ScopeGraph)
      )
   -> [File term]
-  -> (Heap Name ScopeGraph, [File (Either (Path, Span, String) ScopeGraph)])
+  -> (Heap Name ScopeGraph, [File (Either (File String) ScopeGraph)])
 scopeGraph eval
   = run
   . runFresh
@@ -77,7 +77,7 @@ runFile
      -> (term -> m ScopeGraph)
      )
   -> File term
-  -> m (File (Either (Path, Span, String) ScopeGraph))
+  -> m (File (Either (File String) ScopeGraph))
 runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
diff --git a/semantic-core/src/Analysis/Typecheck.hs b/semantic-core/src/Analysis/Typecheck.hs
index c77d6ab38..7e8242328 100644
--- a/semantic-core/src/Analysis/Typecheck.hs
+++ b/semantic-core/src/Analysis/Typecheck.hs
@@ -102,7 +102,7 @@ typecheckingFlowInsensitive
      )
   -> [File term]
   -> ( Heap Name Type
-     , [File (Either (Path, Span, String) (Term (Polytype :+: Monotype) Void))]
+     , [File (Either (File String) (Term (Polytype :+: Monotype) Void))]
      )
 typecheckingFlowInsensitive eval
   = run
@@ -125,7 +125,7 @@ runFile
      -> (term -> m Type)
      )
   -> File term
-  -> m (File (Either (Path, Span, String) Type))
+  -> m (File (Either (File String) Type))
 runFile eval file = traverse run file
   where run
           = (\ m -> do
diff --git a/semantic-core/src/Control/Carrier/Fail/WithFile.hs b/semantic-core/src/Control/Carrier/Fail/WithFile.hs
index d37c42229..e6513c7b6 100644
--- a/semantic-core/src/Control/Carrier/Fail/WithFile.hs
+++ b/semantic-core/src/Control/Carrier/Fail/WithFile.hs
@@ -13,20 +13,18 @@ import Control.Effect.Error
 import Control.Effect.Fail (Fail(..), MonadFail(..))
 import Control.Effect.Reader
 import Data.Loc
+import Data.File
 import Prelude hiding (fail)
 import Source.Span
 
-runFail :: FailC m a -> m (Either (Path, Span, String) a)
+runFail :: FailC m a -> m (Either (File String) a)
 runFail = runError . runFailC
 
-newtype FailC m a = FailC { runFailC :: ErrorC (Path, Span, String) m a }
+newtype FailC m a = FailC { runFailC :: ErrorC (File String) m a }
   deriving (Alternative, Applicative, Functor, Monad)
 
 instance (Carrier sig m, Effect sig, Member (Reader Path) sig, Member (Reader Span) sig) => MonadFail (FailC m) where
-  fail s = do
-    path <- ask
-    span <- ask
-    FailC (throwError (path :: Path, span :: Span, s))
+  fail s = File <$> ask <*> ask <*> pure s >>= FailC . throwError
 
 instance (Carrier sig m, Effect sig, Member (Reader Path) sig, Member (Reader Span) sig) => Carrier (Fail :+: sig) (FailC m) where
   eff (L (Fail s)) = fail s

From c4141616797880767c6fb4672fda86d59bb183f1 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 13:41:14 -0400
Subject: [PATCH 09/30] Revert "Return the message in a File."

This reverts commit 1ec98e9c059afb2d206dfb116e82f42b11f4df72.
---
 semantic-core/src/Analysis/Concrete.hs             |  4 ++--
 semantic-core/src/Analysis/ImportGraph.hs          |  4 ++--
 semantic-core/src/Analysis/ScopeGraph.hs           |  4 ++--
 semantic-core/src/Analysis/Typecheck.hs            |  4 ++--
 semantic-core/src/Control/Carrier/Fail/WithFile.hs | 10 ++++++----
 5 files changed, 14 insertions(+), 12 deletions(-)

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index f6309b1b0..a05c4a8fe 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -78,7 +78,7 @@ concrete
      -> (term Name -> m (Concrete (term Name)))
      )
   -> [File (term Name)]
-  -> (Heap (term Name), [File (Either (File String) (Concrete (term Name)))])
+  -> (Heap (term Name), [File (Either (Path, Span, String) (Concrete (term Name)))])
 concrete eval
   = run
   . runFresh
@@ -100,7 +100,7 @@ runFile
      -> (term Name -> m (Concrete (term Name)))
      )
   -> File (term Name)
-  -> m (File (Either (File String) (Concrete (term Name))))
+  -> m (File (Either (Path, Span, String) (Concrete (term Name))))
 runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
diff --git a/semantic-core/src/Analysis/ImportGraph.hs b/semantic-core/src/Analysis/ImportGraph.hs
index 638eb7ee8..0369f4f65 100644
--- a/semantic-core/src/Analysis/ImportGraph.hs
+++ b/semantic-core/src/Analysis/ImportGraph.hs
@@ -59,7 +59,7 @@ importGraph
      )
   -> [File term]
   -> ( Heap Name (Value term)
-     , [File (Either (File String) (Value term))]
+     , [File (Either (Path, Span, String) (Value term))]
      )
 importGraph eval
   = run
@@ -82,7 +82,7 @@ runFile
      -> (term -> m (Value term))
      )
   -> File term
-  -> m (File (Either (File String) (Value term)))
+  -> m (File (Either (Path, Span, String) (Value term)))
 runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index daa1363f3..d013adc8a 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -56,7 +56,7 @@ scopeGraph
      -> (term -> m ScopeGraph)
      )
   -> [File term]
-  -> (Heap Name ScopeGraph, [File (Either (File String) ScopeGraph)])
+  -> (Heap Name ScopeGraph, [File (Either (Path, Span, String) ScopeGraph)])
 scopeGraph eval
   = run
   . runFresh
@@ -77,7 +77,7 @@ runFile
      -> (term -> m ScopeGraph)
      )
   -> File term
-  -> m (File (Either (File String) ScopeGraph))
+  -> m (File (Either (Path, Span, String) ScopeGraph))
 runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
diff --git a/semantic-core/src/Analysis/Typecheck.hs b/semantic-core/src/Analysis/Typecheck.hs
index 7e8242328..c77d6ab38 100644
--- a/semantic-core/src/Analysis/Typecheck.hs
+++ b/semantic-core/src/Analysis/Typecheck.hs
@@ -102,7 +102,7 @@ typecheckingFlowInsensitive
      )
   -> [File term]
   -> ( Heap Name Type
-     , [File (Either (File String) (Term (Polytype :+: Monotype) Void))]
+     , [File (Either (Path, Span, String) (Term (Polytype :+: Monotype) Void))]
      )
 typecheckingFlowInsensitive eval
   = run
@@ -125,7 +125,7 @@ runFile
      -> (term -> m Type)
      )
   -> File term
-  -> m (File (Either (File String) Type))
+  -> m (File (Either (Path, Span, String) Type))
 runFile eval file = traverse run file
   where run
           = (\ m -> do
diff --git a/semantic-core/src/Control/Carrier/Fail/WithFile.hs b/semantic-core/src/Control/Carrier/Fail/WithFile.hs
index e6513c7b6..d37c42229 100644
--- a/semantic-core/src/Control/Carrier/Fail/WithFile.hs
+++ b/semantic-core/src/Control/Carrier/Fail/WithFile.hs
@@ -13,18 +13,20 @@ import Control.Effect.Error
 import Control.Effect.Fail (Fail(..), MonadFail(..))
 import Control.Effect.Reader
 import Data.Loc
-import Data.File
 import Prelude hiding (fail)
 import Source.Span
 
-runFail :: FailC m a -> m (Either (File String) a)
+runFail :: FailC m a -> m (Either (Path, Span, String) a)
 runFail = runError . runFailC
 
-newtype FailC m a = FailC { runFailC :: ErrorC (File String) m a }
+newtype FailC m a = FailC { runFailC :: ErrorC (Path, Span, String) m a }
   deriving (Alternative, Applicative, Functor, Monad)
 
 instance (Carrier sig m, Effect sig, Member (Reader Path) sig, Member (Reader Span) sig) => MonadFail (FailC m) where
-  fail s = File <$> ask <*> ask <*> pure s >>= FailC . throwError
+  fail s = do
+    path <- ask
+    span <- ask
+    FailC (throwError (path :: Path, span :: Span, s))
 
 instance (Carrier sig m, Effect sig, Member (Reader Path) sig, Member (Reader Span) sig) => Carrier (Fail :+: sig) (FailC m) where
   eff (L (Fail s)) = fail s

From 4ca29903464bf4c8aacb2d42d26ddabf8166e690 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 13:41:17 -0400
Subject: [PATCH 10/30] Revert "Rename Control.Carrier.Fail.WithLoc to
 .WithFile."

This reverts commit 4c58f0877ebd4612b160109f98a02f5e8d6f8bea.
---
 semantic-core/semantic-core.cabal                               | 2 +-
 semantic-core/src/Analysis/Concrete.hs                          | 2 +-
 semantic-core/src/Analysis/ImportGraph.hs                       | 2 +-
 semantic-core/src/Analysis/ScopeGraph.hs                        | 2 +-
 semantic-core/src/Analysis/Typecheck.hs                         | 2 +-
 .../src/Control/Carrier/Fail/{WithFile.hs => WithLoc.hs}        | 2 +-
 6 files changed, 6 insertions(+), 6 deletions(-)
 rename semantic-core/src/Control/Carrier/Fail/{WithFile.hs => WithLoc.hs} (96%)

diff --git a/semantic-core/semantic-core.cabal b/semantic-core/semantic-core.cabal
index 7be321d91..257373af2 100644
--- a/semantic-core/semantic-core.cabal
+++ b/semantic-core/semantic-core.cabal
@@ -25,7 +25,7 @@ library
                      , Analysis.ImportGraph
                      , Analysis.ScopeGraph
                      , Analysis.Typecheck
-                     , Control.Carrier.Fail.WithFile
+                     , Control.Carrier.Fail.WithLoc
                      , Control.Effect.Readline
                      , Control.Monad.Module
                      , Data.Core
diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index a05c4a8fe..65de372c7 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -13,7 +13,7 @@ import qualified Algebra.Graph as G
 import qualified Algebra.Graph.Export.Dot as G
 import           Analysis.Eval
 import           Control.Applicative (Alternative (..))
-import           Control.Carrier.Fail.WithFile
+import           Control.Carrier.Fail.WithLoc
 import           Control.Effect
 import           Control.Effect.Fresh
 import           Control.Effect.NonDet
diff --git a/semantic-core/src/Analysis/ImportGraph.hs b/semantic-core/src/Analysis/ImportGraph.hs
index 0369f4f65..1b576b9f0 100644
--- a/semantic-core/src/Analysis/ImportGraph.hs
+++ b/semantic-core/src/Analysis/ImportGraph.hs
@@ -8,7 +8,7 @@ module Analysis.ImportGraph
 import           Analysis.Eval
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative(..))
-import           Control.Carrier.Fail.WithFile
+import           Control.Carrier.Fail.WithLoc
 import           Control.Effect
 import           Control.Effect.Fresh
 import           Control.Effect.Reader
diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index d013adc8a..0e6f7739a 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -10,7 +10,7 @@ module Analysis.ScopeGraph
 import           Analysis.Eval
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative (..))
-import           Control.Carrier.Fail.WithFile
+import           Control.Carrier.Fail.WithLoc
 import           Control.Effect.Carrier
 import           Control.Effect.Fresh
 import           Control.Effect.Reader
diff --git a/semantic-core/src/Analysis/Typecheck.hs b/semantic-core/src/Analysis/Typecheck.hs
index c77d6ab38..3188c65fd 100644
--- a/semantic-core/src/Analysis/Typecheck.hs
+++ b/semantic-core/src/Analysis/Typecheck.hs
@@ -10,7 +10,7 @@ module Analysis.Typecheck
 import           Analysis.Eval
 import           Analysis.FlowInsensitive
 import           Control.Applicative (Alternative (..))
-import           Control.Carrier.Fail.WithFile
+import           Control.Carrier.Fail.WithLoc
 import           Control.Effect.Carrier
 import           Control.Effect.Fresh as Fresh
 import           Control.Effect.Reader hiding (Local)
diff --git a/semantic-core/src/Control/Carrier/Fail/WithFile.hs b/semantic-core/src/Control/Carrier/Fail/WithLoc.hs
similarity index 96%
rename from semantic-core/src/Control/Carrier/Fail/WithFile.hs
rename to semantic-core/src/Control/Carrier/Fail/WithLoc.hs
index d37c42229..33790a5c3 100644
--- a/semantic-core/src/Control/Carrier/Fail/WithFile.hs
+++ b/semantic-core/src/Control/Carrier/Fail/WithLoc.hs
@@ -1,5 +1,5 @@
 {-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, TypeOperators, UndecidableInstances #-}
-module Control.Carrier.Fail.WithFile
+module Control.Carrier.Fail.WithLoc
 ( -- * Fail effect
   module Control.Effect.Fail
   -- * Fail carrier

From e949f8851767112a199bef61cba66c7ffc12f258 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 13:41:55 -0400
Subject: [PATCH 11/30] :fire: fileLoc.

---
 semantic-core/src/Data/File.hs | 4 ----
 1 file changed, 4 deletions(-)

diff --git a/semantic-core/src/Data/File.hs b/semantic-core/src/Data/File.hs
index 41977f4e4..65b2623a1 100644
--- a/semantic-core/src/Data/File.hs
+++ b/semantic-core/src/Data/File.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE DeriveTraversable #-}
 module Data.File
 ( File(..)
-, fileLoc
 , fromBody
 ) where
 
@@ -17,9 +16,6 @@ data File a = File
   }
   deriving (Eq, Foldable, Functor, Ord, Show, Traversable)
 
-fileLoc :: File a -> Loc
-fileLoc (File p s _) = Loc p s
-
 fromBody :: HasCallStack => a -> File a
 fromBody body = File path span body where
   (path, span) = fromJust (stackLoc callStack)

From 5dd2b1185ddec163e9878369e4b1f741dfd15372 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 13:44:00 -0400
Subject: [PATCH 12/30] Inline the Loc into Semi.

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

diff --git a/semantic-core/src/Analysis/ImportGraph.hs b/semantic-core/src/Analysis/ImportGraph.hs
index 1b576b9f0..acf2f49aa 100644
--- a/semantic-core/src/Analysis/ImportGraph.hs
+++ b/semantic-core/src/Analysis/ImportGraph.hs
@@ -42,7 +42,7 @@ instance Monoid (Value term) where
   mempty = Value Abstract mempty
 
 data Semi term
-  = Closure Loc Name term
+  = Closure Path Span Name term
   -- FIXME: Bound String values.
   | String Text
   | Abstract
@@ -108,9 +108,10 @@ importGraphAnalysis = Analysis{..}
         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
-          loc <- askLoc
-          pure (Value (Closure loc name body) mempty)
-        apply eval (Value (Closure (Loc path span) name body) _) a = local (const path) . local (const span) $ 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
           assign addr a
           bind name addr (eval body)
@@ -127,5 +128,3 @@ importGraphAnalysis = Analysis{..}
             assign addr v
           pure (Value Abstract (foldMap (valueGraph . snd) fields))
         _ ... m = pure (Just m)
-
-        askLoc = Loc <$> ask <*> ask

From 5b4a1d3d9dd6c47e572f5f9141e3329b31edfc69 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 13:44:45 -0400
Subject: [PATCH 13/30] Inline the Loc into Concrete.

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

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index 65de372c7..0abf60017 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -41,7 +41,7 @@ newtype FrameId = FrameId { unFrameId :: Precise }
   deriving (Eq, Ord, Show)
 
 data Concrete term
-  = Closure Loc Name term Env
+  = Closure Path Span Name term Env
   | Unit
   | Bool Bool
   | String Text
@@ -126,10 +126,11 @@ concreteAnalysis = Analysis{..}
         deref = gets . IntMap.lookup
         assign addr value = modify (IntMap.insert addr value)
         abstract _ name body = do
-          loc <- askLoc
+          path <- ask
+          span <- ask
           env <- asks (flip Map.restrictKeys (Set.delete name (foldMap Set.singleton body)))
-          pure (Closure loc name body env)
-        apply eval (Closure (Loc path span) name body env) a = do
+          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
             assign addr a
@@ -152,7 +153,6 @@ concreteAnalysis = Analysis{..}
           val <- deref addr
           heap <- get
           pure (val >>= lookupConcrete heap n)
-        askLoc = Loc <$> ask <*> ask
 
 
 lookupConcrete :: Heap term -> Name -> Concrete term -> Maybe Precise
@@ -188,7 +188,7 @@ heapGraph vertex edge h = foldr (uncurry graph) G.empty (IntMap.toList h)
           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 -> G.Graph (Concrete term)
@@ -209,7 +209,7 @@ addressStyle heap = (G.defaultStyle vertex) { G.edgeAttributes }
           Unit ->  "()"
           Bool b -> pack $ show b
           String s -> pack $ show s
-          Closure (Loc p (Span s e)) n _ _ -> "\\\\ " <> unName n <> " [" <> getPath p <> ":" <> showPos s <> "-" <> showPos e <> "]"
+          Closure p (Span s e) n _ _ -> "\\\\ " <> unName n <> " [" <> getPath p <> ":" <> showPos s <> "-" <> showPos e <> "]"
           Record _ -> "{}"
         showPos (Pos l c) = pack (show l) <> ":" <> pack (show c)
 

From e2092e8a525990e0fc1362dc2d80e126bc06f2ed Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 13:47:12 -0400
Subject: [PATCH 14/30] Inline the Loc into Decl.

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

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index 0e6f7739a..f4c2d7f6a 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -31,7 +31,8 @@ import           Source.Span
 
 data Decl = Decl
   { declSymbol :: Name
-  , declLoc    :: Loc
+  , declPath   :: Path
+  , declSpan   :: Span
   }
   deriving (Eq, Ord, Show)
 
@@ -124,8 +125,9 @@ scopeGraphAnalysis = Analysis{..}
         record fields = do
           fields' <- for fields $ \ (k, v) -> do
             addr <- alloc k
-            loc <- askLoc
-            let v' = ScopeGraph (Map.singleton (Decl k loc) mempty) <> v
+            path <- ask
+            span <- ask
+            let v' = ScopeGraph (Map.singleton (Decl k path span) mempty) <> v
             (k, v') <$ assign addr v'
           pure (foldMap snd fields')
         _ ... m = pure (Just m)
@@ -133,4 +135,4 @@ scopeGraphAnalysis = Analysis{..}
         askRef = Ref <$> askLoc
         askLoc = Loc <$> ask <*> ask
 
-        extendBinding addr ref bindLoc = ScopeGraph (maybe Map.empty (\ bindLoc -> Map.singleton (Decl addr bindLoc) (Set.singleton ref)) bindLoc)
+        extendBinding addr ref bindLoc = ScopeGraph (maybe Map.empty (\ (Loc path span) -> Map.singleton (Decl addr path span) (Set.singleton ref)) bindLoc)

From ef36ded16c5e8994599bc056b963bb95aa77e1c3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 13:48:39 -0400
Subject: [PATCH 15/30] Inline the Loc into Ref.

---
 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 f4c2d7f6a..81cfe40d7 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -36,7 +36,10 @@ data Decl = Decl
   }
   deriving (Eq, Ord, Show)
 
-newtype Ref = Ref Loc
+data Ref = Ref
+  { refPath :: Path
+  , refSpan :: Span
+  }
   deriving (Eq, Ord, Show)
 
 newtype ScopeGraph = ScopeGraph { unScopeGraph :: Map.Map Decl (Set.Set Ref) }
@@ -132,7 +135,7 @@ scopeGraphAnalysis = Analysis{..}
           pure (foldMap snd fields')
         _ ... m = pure (Just m)
 
-        askRef = Ref <$> askLoc
+        askRef = Ref <$> ask <*> ask
         askLoc = Loc <$> ask <*> ask
 
         extendBinding addr ref bindLoc = ScopeGraph (maybe Map.empty (\ (Loc path span) -> Map.singleton (Decl addr path span) (Set.singleton ref)) bindLoc)

From f15feb0ca397e95d97124cc93b4aa9ab9bd07a3c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 13:49:36 -0400
Subject: [PATCH 16/30] :fire: askLoc.

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

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index 81cfe40d7..af9871046 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -102,7 +102,7 @@ scopeGraphAnalysis
 scopeGraphAnalysis = Analysis{..}
   where alloc = pure
         bind name _ m = do
-          loc <- askLoc
+          loc <- Loc <$> ask <*> ask
           local (Map.insert name loc) m
         lookupEnv = pure . Just
         deref addr = do
@@ -136,6 +136,5 @@ scopeGraphAnalysis = Analysis{..}
         _ ... m = pure (Just m)
 
         askRef = Ref <$> ask <*> ask
-        askLoc = Loc <$> ask <*> ask
 
         extendBinding addr ref bindLoc = ScopeGraph (maybe Map.empty (\ (Loc path span) -> Map.singleton (Decl addr path span) (Set.singleton ref)) bindLoc)

From 5433cad0221ab178d90e3907f7a2190c6e6bc5a0 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 13:51:18 -0400
Subject: [PATCH 17/30] Store local Refs.

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

diff --git a/semantic-core/src/Analysis/ScopeGraph.hs b/semantic-core/src/Analysis/ScopeGraph.hs
index af9871046..fafe49f3d 100644
--- a/semantic-core/src/Analysis/ScopeGraph.hs
+++ b/semantic-core/src/Analysis/ScopeGraph.hs
@@ -85,7 +85,7 @@ runFile
 runFile eval file = traverse run file
   where run = runReader (filePath file)
             . runReader (fileSpan file)
-            . runReader (Map.empty @Name @Loc)
+            . runReader (Map.empty @Name @Ref)
             . runFail
             . fmap fold
             . convergeTerm (Proxy @Name) (fix (cacheTerm . eval scopeGraphAnalysis))
@@ -95,26 +95,26 @@ scopeGraphAnalysis
      , Carrier sig m
      , Member (Reader Path) sig
      , Member (Reader Span) sig
-     , Member (Reader (Map.Map Name Loc)) sig
+     , Member (Reader (Map.Map Name Ref)) sig
      , Member (State (Heap Name ScopeGraph)) sig
      )
   => Analysis term Name ScopeGraph m
 scopeGraphAnalysis = Analysis{..}
   where alloc = pure
         bind name _ m = do
-          loc <- Loc <$> ask <*> ask
-          local (Map.insert name loc) m
+          ref <- askRef
+          local (Map.insert name ref) m
         lookupEnv = pure . Just
         deref addr = do
           ref <- askRef
-          bindLoc <- asks (Map.lookup addr)
+          bindRef <- asks (Map.lookup addr)
           cell <- gets (Map.lookup addr >=> nonEmpty . Set.toList)
-          let extending = mappend (extendBinding addr ref bindLoc)
+          let extending = mappend (extendBinding addr ref bindRef)
           maybe (pure Nothing) (foldMapA (pure . Just . extending)) cell
         assign addr v = do
           ref <- askRef
-          bindLoc <- asks (Map.lookup addr)
-          modify (Map.insertWith (<>) addr (Set.singleton (extendBinding addr ref bindLoc <> v)))
+          bindRef <- asks (Map.lookup addr)
+          modify (Map.insertWith (<>) addr (Set.singleton (extendBinding addr ref bindRef <> v)))
         abstract eval name body = do
           addr <- alloc name
           assign name (mempty @ScopeGraph)
@@ -137,4 +137,4 @@ scopeGraphAnalysis = Analysis{..}
 
         askRef = Ref <$> ask <*> ask
 
-        extendBinding addr ref bindLoc = ScopeGraph (maybe Map.empty (\ (Loc path span) -> Map.singleton (Decl addr path span) (Set.singleton ref)) bindLoc)
+        extendBinding addr ref bindRef = ScopeGraph (maybe Map.empty (\ (Ref path span) -> Map.singleton (Decl addr path span) (Set.singleton ref)) bindRef)

From 177fb8d05c10188ce2131244c0a25b018a400de6 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 13:52:07 -0400
Subject: [PATCH 18/30] Correct a doctest.

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

diff --git a/semantic-core/src/Analysis/Concrete.hs b/semantic-core/src/Analysis/Concrete.hs
index 0abf60017..33ddc84ae 100644
--- a/semantic-core/src/Analysis/Concrete.hs
+++ b/semantic-core/src/Analysis/Concrete.hs
@@ -67,7 +67,7 @@ data Edge = Lexical | Import
 
 -- | Concrete evaluation of a term to a value.
 --
---   >>> map fileBody (snd (concrete eval [File (Loc "bool" (Span (Pos 1 1) (Pos 1 5))) (Core.bool True)]))
+--   >>> map fileBody (snd (concrete eval [File (Path "bool") (Span (Pos 1 1) (Pos 1 5)) (Core.bool True)]))
 --   [Right (Bool True)]
 concrete
   :: (Foldable term, Show (term Name))

From 31b1eae78e1233b44fd19b94da12a56d4f0ae41d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 13:55:13 -0400
Subject: [PATCH 19/30] :fire: interactive.

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

diff --git a/semantic-core/src/Data/Loc.hs b/semantic-core/src/Data/Loc.hs
index bd72a64a9..439d687ae 100644
--- a/semantic-core/src/Data/Loc.hs
+++ b/semantic-core/src/Data/Loc.hs
@@ -2,7 +2,6 @@
 module Data.Loc
 ( Loc(..)
 , Path(..)
-, interactive
 , here
 , stackLoc
 ) where
@@ -20,9 +19,6 @@ data Loc = Loc
   }
   deriving (Eq, Ord, Show)
 
-interactive :: Loc
-interactive = Loc (Path "<interactive>") (Span (Pos 1 1) (Pos 1 1))
-
 
 here :: HasCallStack => Maybe (Path, Span)
 here = stackLoc callStack

From 20c6d12b0356fe551262245daa810ecaa254ffb8 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 13:55:52 -0400
Subject: [PATCH 20/30] :fire: a redundant language extension.

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

diff --git a/semantic-core/src/Data/Loc.hs b/semantic-core/src/Data/Loc.hs
index 439d687ae..38fa2b1b8 100644
--- a/semantic-core/src/Data/Loc.hs
+++ b/semantic-core/src/Data/Loc.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
+{-# LANGUAGE RecordWildCards #-}
 module Data.Loc
 ( Loc(..)
 , Path(..)

From 8880278961b5c0261d47f739ea1d994ea558af0e Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 13:56:22 -0400
Subject: [PATCH 21/30] :fire: Loc.

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

diff --git a/semantic-core/src/Data/Loc.hs b/semantic-core/src/Data/Loc.hs
index 38fa2b1b8..0d5f2193e 100644
--- a/semantic-core/src/Data/Loc.hs
+++ b/semantic-core/src/Data/Loc.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE RecordWildCards #-}
 module Data.Loc
-( Loc(..)
-, Path(..)
+( Path(..)
 , here
 , stackLoc
 ) where
@@ -13,12 +12,6 @@ import Source.Span
 newtype Path = Path { getPath :: Text }
   deriving (Eq, Ord, Show)
 
-data Loc = Loc
-  { locPath :: !Path
-  , locSpan :: {-# UNPACK #-} !Span
-  }
-  deriving (Eq, Ord, Show)
-
 
 here :: HasCallStack => Maybe (Path, Span)
 here = stackLoc callStack

From 6681639dd5bcf263f32521095f396a400ba8764f Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 14:05:50 -0400
Subject: [PATCH 22/30] =?UTF-8?q?Rearrange=20stripAnnotations=E2=80=99=20t?=
 =?UTF-8?q?ype=20parameters.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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

diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 35416d8da..1691314cd 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -236,7 +236,7 @@ annWith :: (Carrier sig m, Member (Ann Path) sig, Member (Ann Span) sig) => Call
 annWith callStack = maybe id (\ (path, span) -> annAt path . annAt span) (stackLoc callStack)
 
 
-stripAnnotations :: (HFunctor sig, forall g . Functor g => Functor (sig g)) => Term (Ann ann :+: sig) a -> Term sig a
+stripAnnotations :: forall ann a sig . (HFunctor sig, forall g . Functor g => Functor (sig g)) => Term (Ann 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)

From 1e326d7fb81b8f1e498f77c18afefbcdb402b8a0 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 14:05:59 -0400
Subject: [PATCH 23/30] =?UTF-8?q?Don=E2=80=99t=20re-export=20Trifecta.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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

diff --git a/semantic-core/src/Data/Core/Parser.hs b/semantic-core/src/Data/Core/Parser.hs
index fc4b88c52..c62ffc75d 100644
--- a/semantic-core/src/Data/Core/Parser.hs
+++ b/semantic-core/src/Data/Core/Parser.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE FlexibleContexts, TypeOperators #-}
 module Data.Core.Parser
-  ( module Text.Trifecta
-  , core
+  ( core
   , lit
   , expr
   , record

From c19a373bf3f0ce11007c71090a97666505fc7cb3 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 14:06:47 -0400
Subject: [PATCH 24/30] Fix the tests.

---
 semantic-core/semantic-core.cabal |  1 +
 semantic-core/test/Spec.hs        | 24 +++++++++++++-----------
 2 files changed, 14 insertions(+), 11 deletions(-)

diff --git a/semantic-core/semantic-core.cabal b/semantic-core/semantic-core.cabal
index 257373af2..d92b0bed7 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
+                     , semantic-source ^>= 0
                      , fused-effects
                      , hedgehog ^>= 1
                      , tasty >= 1.2 && <2
diff --git a/semantic-core/test/Spec.hs b/semantic-core/test/Spec.hs
index 23d264b65..656d570ad 100644
--- a/semantic-core/test/Spec.hs
+++ b/semantic-core/test/Spec.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings, TypeOperators #-}
+{-# LANGUAGE OverloadedStrings, TypeApplications, TypeOperators #-}
 module Main (main) where
 
 import           Data.String
@@ -11,6 +11,7 @@ import           Test.Tasty.HUnit
 
 import           Control.Effect.Sum
 import           Data.File
+import           Data.Loc (Path)
 import qualified Generators as Gen
 import qualified Analysis.Eval as Eval
 import           Data.Core
@@ -18,10 +19,11 @@ import           Data.Core.Pretty
 import           Data.Core.Parser as Parse
 import           Data.Name
 import           Data.Term
+import           Source.Span
 
 -- * Helpers
 
-true, false :: Term (Ann :+: Core) Name
+true, false :: Term Core Name
 true  = bool True
 false = bool False
 
@@ -31,10 +33,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 (Ann :+: Core) Name) -> Property
+prop_roundtrips :: Gen (Term Core Name) -> Property
 prop_roundtrips gen = property $ do
   input <- forAll gen
-  tripping input (showCore . stripAnnotations) (parseEither (Parse.core <* Trifecta.eof))
+  tripping input showCore (parseEither (Parse.core <* Trifecta.eof))
 
 parserProps :: TestTree
 parserProps = testGroup "Parsing: roundtripping"
@@ -47,7 +49,7 @@ parserProps = testGroup "Parsing: roundtripping"
 
 -- * Parser specs
 
-parsesInto :: String -> Term (Ann :+: Core) Name -> Assertion
+parsesInto :: String -> Term Core Name -> Assertion
 parsesInto str res = case parseEither Parse.core str of
   Right x -> x @?= res
   Left m  -> assertFailure m
@@ -57,7 +59,7 @@ assert_booleans_parse = do
   parseEither Parse.core "#true"  @?= Right true
   parseEither Parse.core "#false" @?= Right false
 
-a, f, g, h :: Term (Ann :+: Core) Name
+a, f, g, h :: Term Core Name
 (a, f, g, h) = (pure "a", pure "f", pure "g", pure "h")
 
 assert_ifthen_parse :: Assertion
@@ -93,10 +95,10 @@ parserSpecs = testGroup "Parsing: simple specs"
   , testCase "quoted names" assert_quoted_name_parse
   ]
 
-assert_roundtrips :: File (Term (Ann :+: Core) Name) -> Assertion
-assert_roundtrips (File _ core) = case parseEither Parse.core (showCore (stripAnnotations core)) of
-  Right v -> stripAnnotations v @?= stripAnnotations core
-  Left e -> assertFailure e
+assert_roundtrips :: File (Term Core Name) -> Assertion
+assert_roundtrips (File _ _ core) = case parseEither Parse.core (showCore core) of
+  Right v -> v @?= core
+  Left  e -> assertFailure e
 
 parserExamples :: TestTree
 parserExamples = testGroup "Parsing: Eval.hs examples"
@@ -106,7 +108,7 @@ parserExamples = testGroup "Parsing: Eval.hs examples"
   , testCase "prog4" (assert_roundtrips Eval.prog4)
   , testCase "prog6.1" (assert_roundtrips (head Eval.prog6))
   , testCase "prog6.2" (assert_roundtrips (last Eval.prog6))
-  , testCase "ruby" (assert_roundtrips Eval.ruby)
+  , testCase "ruby" (assert_roundtrips (stripAnnotations @Span . stripAnnotations @Path <$> Eval.ruby))
   ]
 
 tests :: TestTree

From 61a2cd396bf97c32f0598a71bf6d832f442dfd8c Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 14:09:30 -0400
Subject: [PATCH 25/30] :fire: some Path annotations.

---
 semantic-core/src/Analysis/Eval.hs | 4 ++--
 semantic-core/src/Data/Core.hs     | 6 +++---
 2 files changed, 5 insertions(+), 5 deletions(-)

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 702115dbf..05abd65a1 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -120,7 +120,7 @@ prog4 = fromBody
     (Core.bool True)
     (Core.bool False))
 
-prog5 :: (Carrier sig t, Member (Ann Path) sig, Member (Ann Span) sig, Member Core sig) => File (t Name)
+prog5 :: (Carrier sig t, Member (Ann Span) sig, Member Core sig) => File (t Name)
 prog5 = fromBody $ ann (do'
   [ Just (named' "mkPoint") :<- lams [named' "_x", named' "_y"] (ann (Core.record
     [ ("x", ann (pure "_x"))
@@ -141,7 +141,7 @@ prog6 =
     ])
   ]
 
-ruby :: (Carrier sig t, Member (Ann Path) sig, Member (Ann Span) sig, Member Core sig) => File (t Name)
+ruby :: (Carrier sig t, Member (Ann Span) sig, Member Core sig) => File (t Name)
 ruby = fromBody $ annWith callStack (rec (named' __semantic_global) (do' statements))
   where statements =
           [ Just "Class" :<- record
diff --git a/semantic-core/src/Data/Core.hs b/semantic-core/src/Data/Core.hs
index 1691314cd..bb7e46b56 100644
--- a/semantic-core/src/Data/Core.hs
+++ b/semantic-core/src/Data/Core.hs
@@ -226,14 +226,14 @@ instance RightModule (Ann ann) where
   Ann l b >>=* f = Ann l (b >>= f)
 
 
-ann :: (Carrier sig m, Member (Ann Path) sig, Member (Ann Span) sig) => HasCallStack => m a -> m a
+ann :: (Carrier sig m, Member (Ann Span) sig) => HasCallStack => m a -> m a
 ann = annWith callStack
 
 annAt :: (Carrier sig m, Member (Ann ann) sig) => ann -> m a -> m a
 annAt ann = send . Ann ann
 
-annWith :: (Carrier sig m, Member (Ann Path) sig, Member (Ann Span) sig) => CallStack -> m a -> m a
-annWith callStack = maybe id (\ (path, span) -> annAt path . annAt span) (stackLoc callStack)
+annWith :: (Carrier sig m, Member (Ann Span) sig) => CallStack -> m a -> m a
+annWith callStack = maybe id (annAt . snd) (stackLoc callStack)
 
 
 stripAnnotations :: forall ann a sig . (HFunctor sig, forall g . Functor g => Functor (sig g)) => Term (Ann ann :+: sig) a -> Term sig a

From a1a6270c01c90935c4a9467f1aea9e18d322e77d Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 14:10:35 -0400
Subject: [PATCH 26/30] :fire: Path annotations.

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

diff --git a/semantic-core/src/Analysis/Eval.hs b/semantic-core/src/Analysis/Eval.hs
index 05abd65a1..21064d82a 100644
--- a/semantic-core/src/Analysis/Eval.hs
+++ b/semantic-core/src/Analysis/Eval.hs
@@ -30,17 +30,16 @@ import Prelude hiding (fail)
 import Source.Span
 
 eval :: ( Carrier sig m
-        , Member (Reader Path) sig
         , Member (Reader Span) sig
         , MonadFail m
         , Semigroup value
         )
-     => Analysis (Term (Ann Path :+: Ann Span :+: Core) Name) address value m
-     -> (Term (Ann Path :+: Ann Span :+: Core) Name -> m value)
-     -> (Term (Ann Path :+: Ann Span :+: Core) Name -> m value)
+     => Analysis (Term (Ann Span :+: Core) Name) address value m
+     -> (Term (Ann Span :+: Core) Name -> m value)
+     -> (Term (Ann Span :+: Core) Name -> m value)
 eval Analysis{..} eval = \case
   Var n -> lookupEnv' n >>= deref' n
-  Term (R (R 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))
@@ -74,8 +73,7 @@ eval Analysis{..} eval = \case
       b' <- eval b
       addr <- ref a
       b' <$ assign addr b'
-  Term (R (L (Ann span c))) -> local (const span) (eval c)
-  Term (L (Ann path c)) -> local (const path) (eval c)
+  Term (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)
@@ -85,7 +83,7 @@ eval Analysis{..} eval = \case
 
         ref = \case
           Var n -> lookupEnv' n
-          Term (R (R 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
@@ -93,8 +91,7 @@ eval Analysis{..} eval = \case
               a' <- ref a
               a' ... b >>= maybe (freeVariable (show b)) pure
             c -> invalidRef (show c)
-          Term (R (L (Ann span c))) -> local (const span) (ref c)
-          Term (L (Ann path c)) -> local (const path) (ref c)
+          Term (L (Ann span c)) -> local (const span) (ref c)
 
 
 prog1 :: (Carrier sig t, Member Core sig) => File (t Name)

From bb81dd0ee1204870c8dff6b2263fb40052159695 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 14:11:34 -0400
Subject: [PATCH 27/30] Drop an obsolete stripAnnotations.

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

diff --git a/semantic-core/test/Spec.hs b/semantic-core/test/Spec.hs
index 656d570ad..4001a4f51 100644
--- a/semantic-core/test/Spec.hs
+++ b/semantic-core/test/Spec.hs
@@ -108,7 +108,7 @@ parserExamples = testGroup "Parsing: Eval.hs examples"
   , testCase "prog4" (assert_roundtrips Eval.prog4)
   , testCase "prog6.1" (assert_roundtrips (head Eval.prog6))
   , testCase "prog6.2" (assert_roundtrips (last Eval.prog6))
-  , testCase "ruby" (assert_roundtrips (stripAnnotations @Span . stripAnnotations @Path <$> Eval.ruby))
+  , testCase "ruby" (assert_roundtrips (stripAnnotations @Span <$> Eval.ruby))
   ]
 
 tests :: TestTree

From 1166a1c789a47c78460804b60ab6b9689644184b Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 14:14:04 -0400
Subject: [PATCH 28/30] :fire: locFromTSSpan.

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

diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs
index 95349d972..bd7f53b51 100644
--- a/semantic-python/src/Language/Python/Core.hs
+++ b/semantic-python/src/Language/Python/Core.hs
@@ -17,8 +17,6 @@ import           Control.Monad.Fail
 import           Data.Coerce
 import           Data.Core as Core
 import           Data.Foldable
-import           Data.Loc (Loc)
-import qualified Data.Loc
 import           Data.Name as Name
 import           Data.Stack (Stack)
 import qualified Data.Stack as Stack
@@ -56,7 +54,7 @@ pattern SingleIdentifier name <- Py.ExpressionList
 -- possible for us to 'cheat' by pattern-matching on or eliminating a
 -- compiled term.
 type CoreSyntax sig t = ( Member Core sig
-                        , Member Ann sig
+                        , Member (Ann Span) sig
                         , Carrier sig t
                         , Foldable t
                         )
@@ -92,20 +90,14 @@ toplevelCompile = flip compile (pure none)
 none :: (Member Core sig, Carrier sig t) => t Name
 none = unit
 
-locFromTSSpan :: SourcePath -> Span -> Loc
-locFromTSSpan fp = Data.Loc.Loc (rawPath fp)
-
 locate :: ( HasField "ann" syntax Span
           , CoreSyntax syn t
-          , Member (Reader SourcePath) sig
-          , Carrier sig m
+          , Applicative m
           )
        => syntax
        -> t a
        -> m (t a)
-locate syn item = do
-  fp <- ask @SourcePath
-  pure (Core.annAt (locFromTSSpan fp (getField @"ann" syn)) item)
+locate syn item = pure (Core.annAt (getField @"ann" syn) item)
 
 defaultCompile :: (MonadFail m, Show py) => py -> m (t Name)
 defaultCompile t = fail $ "compilation unimplemented for " <> show t
@@ -139,7 +131,7 @@ type Desugared = Py.ExpressionList :+: Py.Yield
 
 -- We have to pair locations and names, and tuple syntax is harder to
 -- read in this case than a happy little constructor.
-data Located a = Located Loc a
+data Located a = Located Span a
 
 -- Desugaring an RHS involves walking as deeply as possible into an
 -- assignment, storing the names we encounter as we go and eventually
@@ -149,10 +141,8 @@ desugar :: (Member (Reader SourcePath) sig, Carrier sig m, MonadFail m)
         -> RHS Span
         -> m ([Located Name], Desugared Span)
 desugar acc = \case
-  Prj Py.Assignment { left = SingleIdentifier name, right = Just rhs, ann} -> do
-    loc <- locFromTSSpan <$> ask <*> pure ann
-    let cons = (Located loc name :)
-    desugar (cons acc) rhs
+  Prj Py.Assignment { left = SingleIdentifier name, right = Just rhs, ann} ->
+    desugar (Located ann name : acc) rhs
   R1 any -> pure (acc, any)
   other -> fail ("desugar: couldn't desugar RHS " <> show other)
 
@@ -178,8 +168,7 @@ instance Compile Py.Assignment where
     , right = Just rhs
     , ann
     } cc = do
-    p <- ask @SourcePath
-    (names, val) <- desugar [Located (locFromTSSpan p ann) name] rhs
+    (names, val) <- desugar [Located ann name] rhs
     -- BUG: ignoring the continuation here
     compile val (pure none) >>= foldr collapseDesugared (const cc) names >>= locate it
 

From 13907fd2699299d73eb2aae1e943ef3261f0c4f5 Mon Sep 17 00:00:00 2001
From: Rob Rix <robrix@github.com>
Date: Thu, 10 Oct 2019 14:18:56 -0400
Subject: [PATCH 29/30] Correct the semantic-python tests.

---
 semantic-python/test/Instances.hs | 24 ++++++++++++------------
 semantic-python/test/Test.hs      |  7 ++++---
 2 files changed, 16 insertions(+), 15 deletions(-)

diff --git a/semantic-python/test/Instances.hs b/semantic-python/test/Instances.hs
index 9ec455f26..1f52ab4f9 100644
--- a/semantic-python/test/Instances.hs
+++ b/semantic-python/test/Instances.hs
@@ -19,27 +19,27 @@ deriving newtype instance ToJSON Name
 deriving newtype instance ToJSONKey Name
 
 instance ToJSON a => ToJSON (File a) where
-  toJSON File{fileLoc, fileBody} = object
-    [ "location" .= fileLoc
+  toJSON File{filePath, fileSpan, fileBody} = object
+    [ "path" .= filePath
+    , "span" .= fileSpan
     , "body" .= fileBody
     ]
 
-instance ToJSON Loc where
-  toJSON Loc{locPath, locSpan} = object
-    [ "kind" .= ("loc" :: Text)
-    , "path" .= locPath
-    , "span" .= locSpan
-    ]
+deriving newtype instance ToJSON Path
 
 instance ToJSON Ref where
-  toJSON (Ref loc) = object [ "kind" .= ("ref" :: Text)
-                            , "location" .= loc]
+  toJSON (Ref path span) = object
+    [ "kind" .= ("ref" :: Text)
+    , "path" .= path
+    , "span" .= span
+    ]
 
 instance ToJSON Decl where
-  toJSON Decl{declSymbol, declLoc} = object
+  toJSON Decl{declSymbol, declPath, declSpan} = object
     [ "kind"   .= ("decl" :: Text)
     , "symbol" .= declSymbol
-    , "location" .= declLoc
+    , "path" .= declPath
+    , "span" .= declSpan
     ]
 
 instance ToJSON ScopeGraph where
diff --git a/semantic-python/test/Test.hs b/semantic-python/test/Test.hs
index 41f58d20b..b0a9d3332 100644
--- a/semantic-python/test/Test.hs
+++ b/semantic-python/test/Test.hs
@@ -29,6 +29,7 @@ import           Data.String (fromString)
 import           GHC.Stack
 import qualified Language.Python.Core as Py
 import           Prelude hiding (fail)
+import           Source.Span
 import           Streaming
 import qualified Streaming.Prelude as Stream
 import qualified Streaming.Process
@@ -49,10 +50,10 @@ import qualified Directive
 import           Instances ()
 
 
-assertJQExpressionSucceeds :: Show a => Directive.Directive -> a -> Term (Ann :+: Core) Name -> HUnit.Assertion
+assertJQExpressionSucceeds :: Show a => Directive.Directive -> a -> Term (Ann Span :+: Core) Name -> HUnit.Assertion
 assertJQExpressionSucceeds directive tree core = do
-  bod <- case scopeGraph Eval.eval [File interactive core] of
-    (heap, [File _ (Right result)]) -> pure $ Aeson.object
+  bod <- case scopeGraph Eval.eval [File (Path "<interactive>") (Span (Pos 1 1) (Pos 1 1)) core] of
+    (heap, [File _ _ (Right result)]) -> pure $ Aeson.object
       [ "scope" Aeson..= heap
       , "heap"  Aeson..= result
       ]

From ad385c93aec7d4690a8b1a3032a3ed3e0540bbb2 Mon Sep 17 00:00:00 2001
From: Patrick Thomson <patrickt@github.com>
Date: Thu, 10 Oct 2019 16:12:16 -0400
Subject: [PATCH 30/30] Merge fallout.

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

diff --git a/semantic-python/src/Language/Python/Core.hs b/semantic-python/src/Language/Python/Core.hs
index 506189156..30f28df83 100644
--- a/semantic-python/src/Language/Python/Core.hs
+++ b/semantic-python/src/Language/Python/Core.hs
@@ -5,7 +5,6 @@
 module Language.Python.Core
 ( toplevelCompile
 , Bindings
-, SourcePath
 ) where
 
 import Prelude hiding (fail)
@@ -21,16 +20,10 @@ import           Data.Foldable
 import           Data.Name as Name
 import           Data.Stack (Stack)
 import qualified Data.Stack as Stack
-import           Data.String (IsString)
-import           Data.Text (Text)
 import           GHC.Records
 import           Source.Span (Span)
 import qualified TreeSitter.Python.AST as Py
 
--- | Access to the current filename as Text to stick into location annotations.
-newtype SourcePath = SourcePath { rawPath :: Text }
-  deriving (Eq, IsString, Show)
-
 -- | Keeps track of the current scope's bindings (so that we can, when
 -- compiling a class or module, return the list of bound variables as
 -- a Core record so that all immediate definitions are exposed)
@@ -64,7 +57,6 @@ class Compile (py :: * -> *) where
   -- FIXME: rather than failing the compilation process entirely
   -- with MonadFail, we should emit core that represents failure
   compile :: ( CoreSyntax syn t
-             , Member (Reader SourcePath) sig
              , Member (Reader Bindings) sig
              , Carrier sig m
              , MonadFail m
@@ -77,7 +69,6 @@ class Compile (py :: * -> *) where
   compile a _ _ = defaultCompile a
 
 toplevelCompile :: ( CoreSyntax syn t
-                   , Member (Reader SourcePath) sig
                    , Member (Reader Bindings) sig
                    , Carrier sig m
                    , MonadFail m
@@ -137,7 +128,7 @@ data Located a = Located Span a
 -- Desugaring an RHS involves walking as deeply as possible into an
 -- assignment, storing the names we encounter as we go and eventually
 -- returning a terminal expression. We have to keep track of which
-desugar :: (Member (Reader SourcePath) sig, Carrier sig m, MonadFail m)
+desugar :: MonadFail m
         => [Located Name]
         -> RHS Span
         -> m ([Located Name], Desugared Span)
@@ -170,7 +161,7 @@ instance Compile Py.Assignment where
     , ann
     } cc next = do
     (names, val) <- desugar [Located ann name] rhs
-    compile val pure next >>= foldr collapseDesugared (const cc) names >>= locate it
+    compile val pure next >>= foldr collapseDesugared cc names >>= locate it
 
   compile other _ _ = fail ("Unhandled assignment case: " <> show other)
 
diff --git a/semantic-python/test/Test.hs b/semantic-python/test/Test.hs
index b0a9d3332..8a230ca19 100644
--- a/semantic-python/test/Test.hs
+++ b/semantic-python/test/Test.hs
@@ -25,7 +25,6 @@ import           Data.Loc
 import           Data.Maybe
 import           Data.Name
 import           Data.Term
-import           Data.String (fromString)
 import           GHC.Stack
 import qualified Language.Python.Core as Py
 import           Prelude hiding (fail)
@@ -96,7 +95,6 @@ fixtureTestTreeForFile fp = HUnit.testCaseSteps (Path.toString fp) $ \step -> wi
   result <- ByteString.readFile (Path.toString fullPath) >>= TS.parseByteString TSP.tree_sitter_python
   let coreResult = Control.Effect.run
                    . runFail
-                   . runReader (fromString @Py.SourcePath . Path.toString $ fp)
                    . runReader @Py.Bindings mempty
                    . Py.toplevelCompile
                    <$> result