From 3f0e7f568f92f2354618d934d3206774f0541980 Mon Sep 17 00:00:00 2001
From: Gary Burgess <gary.burgess@gmail.com>
Date: Sun, 21 Jan 2018 17:28:53 +0000
Subject: [PATCH] Add source spans to name constructors and fix `ShadowedName`
 warning

---
 src/Language/PureScript/AST/Binders.hs        | 17 +++--
 src/Language/PureScript/AST/Declarations.hs   | 12 ++--
 src/Language/PureScript/AST/SourcePos.hs      |  3 +
 src/Language/PureScript/AST/Traversals.hs     | 42 +++++------
 src/Language/PureScript/CoreFn/Desugar.hs     | 18 ++---
 src/Language/PureScript/Interactive/Module.hs |  4 +-
 src/Language/PureScript/Linter.hs             | 10 +--
 src/Language/PureScript/Linter/Exhaustive.hs  | 20 +++---
 src/Language/PureScript/Parser/Common.hs      |  5 ++
 .../PureScript/Parser/Declarations.hs         | 64 +++++++++--------
 src/Language/PureScript/Pretty/Values.hs      | 20 +++---
 src/Language/PureScript/Sugar/AdoNotation.hs  | 14 ++--
 .../PureScript/Sugar/BindingGroups.hs         |  8 +--
 .../PureScript/Sugar/CaseDeclarations.hs      | 24 +++----
 src/Language/PureScript/Sugar/DoNotation.hs   | 12 ++--
 src/Language/PureScript/Sugar/Names.hs        | 28 ++++----
 .../PureScript/Sugar/ObjectWildcards.hs       | 16 ++---
 src/Language/PureScript/Sugar/Operators.hs    | 24 +++----
 .../PureScript/Sugar/Operators/Binders.hs     |  8 +--
 .../PureScript/Sugar/Operators/Common.hs      | 25 ++++---
 .../PureScript/Sugar/Operators/Expr.hs        | 10 +--
 .../PureScript/Sugar/Operators/Types.hs       |  9 +--
 src/Language/PureScript/Sugar/TypeClasses.hs  |  4 +-
 .../PureScript/Sugar/TypeClasses/Deriving.hs  | 72 +++++++++----------
 .../PureScript/TypeChecker/Entailment.hs      | 12 ++--
 .../PureScript/TypeChecker/TypeSearch.hs      |  2 +-
 src/Language/PureScript/TypeChecker/Types.hs  | 45 ++++++------
 27 files changed, 271 insertions(+), 257 deletions(-)

diff --git a/src/Language/PureScript/AST/Binders.hs b/src/Language/PureScript/AST/Binders.hs
index 834b4be9b6..c5054ce216 100644
--- a/src/Language/PureScript/AST/Binders.hs
+++ b/src/Language/PureScript/AST/Binders.hs
@@ -26,16 +26,16 @@ data Binder
   -- |
   -- A binder which binds an identifier
   --
-  | VarBinder Ident
+  | VarBinder SourceSpan Ident
   -- |
   -- A binder which matches a data constructor
   --
-  | ConstructorBinder (Qualified (ProperName 'ConstructorName)) [Binder]
+  | ConstructorBinder SourceSpan (Qualified (ProperName 'ConstructorName)) [Binder]
   -- |
   -- A operator alias binder. During the rebracketing phase of desugaring,
   -- this data constructor will be removed.
   --
-  | OpBinder (Qualified (OpName 'ValueOpName))
+  | OpBinder SourceSpan (Qualified (OpName 'ValueOpName))
   -- |
   -- Binary operator application. During the rebracketing phase of desugaring,
   -- this data constructor will be removed.
@@ -52,7 +52,7 @@ data Binder
   -- |
   -- A binder which binds its input to an identifier
   --
-  | NamedBinder Ident Binder
+  | NamedBinder SourceSpan Ident Binder
   -- |
   -- A binder with source position information
   --
@@ -70,11 +70,11 @@ binderNames :: Binder -> [Ident]
 binderNames = go []
   where
   go ns (LiteralBinder b) = lit ns b
-  go ns (VarBinder name) = name : ns
-  go ns (ConstructorBinder _ bs) = foldl go ns bs
+  go ns (VarBinder _ name) = name : ns
+  go ns (ConstructorBinder _ _ bs) = foldl go ns bs
   go ns (BinaryNoParensBinder b1 b2 b3) = foldl go ns [b1, b2, b3]
   go ns (ParensInBinder b) = go ns b
-  go ns (NamedBinder name b) = go (name : ns) b
+  go ns (NamedBinder _ name b) = go (name : ns) b
   go ns (PositionedBinder _ _ b) = go ns b
   go ns (TypedBinder _ b) = go ns b
   go ns _ = ns
@@ -84,8 +84,7 @@ binderNames = go []
 
 isIrrefutable :: Binder -> Bool
 isIrrefutable NullBinder = True
-isIrrefutable (VarBinder _) = True
+isIrrefutable (VarBinder _ _) = True
 isIrrefutable (PositionedBinder _ _ b) = isIrrefutable b
 isIrrefutable (TypedBinder _ b) = isIrrefutable b
 isIrrefutable _ = False
-
diff --git a/src/Language/PureScript/AST/Declarations.hs b/src/Language/PureScript/AST/Declarations.hs
index 5771fe6f6f..2719701e1a 100644
--- a/src/Language/PureScript/AST/Declarations.hs
+++ b/src/Language/PureScript/AST/Declarations.hs
@@ -697,7 +697,7 @@ data Expr
   -- |
   -- A prefix -, will be desugared
   --
-  | UnaryMinus Expr
+  | UnaryMinus SourceSpan Expr
   -- |
   -- Binary operator application. During the rebracketing phase of desugaring, this data constructor
   -- will be removed.
@@ -737,12 +737,12 @@ data Expr
   -- |
   -- Variable
   --
-  | Var (Qualified Ident)
+  | Var SourceSpan (Qualified Ident)
   -- |
   -- An operator. This will be desugared into a function during the "operators"
   -- phase of desugaring.
   --
-  | Op (Qualified (OpName 'ValueOpName))
+  | Op SourceSpan (Qualified (OpName 'ValueOpName))
   -- |
   -- Conditional (if-then-else expression)
   --
@@ -750,7 +750,7 @@ data Expr
   -- |
   -- A data constructor
   --
-  | Constructor (Qualified (ProperName 'ConstructorName))
+  | Constructor SourceSpan (Qualified (ProperName 'ConstructorName))
   -- |
   -- A case expression. During the case expansion phase of desugaring, top-level binders will get
   -- desugared into case expressions, hence the need for guards and multiple binders per branch here.
@@ -883,8 +883,8 @@ $(deriveJSON (defaultOptions { sumEncoding = ObjectWithSingleField }) ''ImportDe
 
 isTrueExpr :: Expr -> Bool
 isTrueExpr (Literal (BooleanLiteral True)) = True
-isTrueExpr (Var (Qualified (Just (ModuleName [ProperName "Prelude"])) (Ident "otherwise"))) = True
-isTrueExpr (Var (Qualified (Just (ModuleName [ProperName "Data", ProperName "Boolean"])) (Ident "otherwise"))) = True
+isTrueExpr (Var _ (Qualified (Just (ModuleName [ProperName "Prelude"])) (Ident "otherwise"))) = True
+isTrueExpr (Var _ (Qualified (Just (ModuleName [ProperName "Data", ProperName "Boolean"])) (Ident "otherwise"))) = True
 isTrueExpr (TypedValue _ e _) = isTrueExpr e
 isTrueExpr (PositionedValue _ _ e) = isTrueExpr e
 isTrueExpr _ = False
diff --git a/src/Language/PureScript/AST/SourcePos.hs b/src/Language/PureScript/AST/SourcePos.hs
index f208deeb29..60605d7aaa 100644
--- a/src/Language/PureScript/AST/SourcePos.hs
+++ b/src/Language/PureScript/AST/SourcePos.hs
@@ -80,3 +80,6 @@ instance A.FromJSON SourceSpan where
 
 internalModuleSourceSpan :: String -> SourceSpan
 internalModuleSourceSpan name = SourceSpan name (SourcePos 0 0) (SourcePos 0 0)
+
+nullSourceSpan :: SourceSpan
+nullSourceSpan = internalModuleSourceSpan ""
diff --git a/src/Language/PureScript/AST/Traversals.hs b/src/Language/PureScript/AST/Traversals.hs
index 0dce4ae926..88f87eca54 100644
--- a/src/Language/PureScript/AST/Traversals.hs
+++ b/src/Language/PureScript/AST/Traversals.hs
@@ -63,7 +63,7 @@ everywhereOnValues f g h = (f', g', h')
 
   g' :: Expr -> Expr
   g' (Literal l) = g (Literal (lit g' l))
-  g' (UnaryMinus v) = g (UnaryMinus (g' v))
+  g' (UnaryMinus ss v) = g (UnaryMinus ss (g' v))
   g' (BinaryNoParens op v1 v2) = g (BinaryNoParens (g' op) (g' v1) (g' v2))
   g' (Parens v) = g (Parens (g' v))
   g' (TypeClassDictionaryConstructorApp name v) = g (TypeClassDictionaryConstructorApp name (g' v))
@@ -82,11 +82,11 @@ everywhereOnValues f g h = (f', g', h')
   g' other = g other
 
   h' :: Binder -> Binder
-  h' (ConstructorBinder ctor bs) = h (ConstructorBinder ctor (fmap h' bs))
+  h' (ConstructorBinder ss ctor bs) = h (ConstructorBinder ss ctor (fmap h' bs))
   h' (BinaryNoParensBinder b1 b2 b3) = h (BinaryNoParensBinder (h' b1) (h' b2) (h' b3))
   h' (ParensInBinder b) = h (ParensInBinder (h' b))
   h' (LiteralBinder l) = h (LiteralBinder (lit h' l))
-  h' (NamedBinder name b) = h (NamedBinder name (h' b))
+  h' (NamedBinder ss name b) = h (NamedBinder ss name (h' b))
   h' (PositionedBinder pos com b) = h (PositionedBinder pos com (h' b))
   h' (TypedBinder t b) = h (TypedBinder t (h' b))
   h' other = h other
@@ -137,7 +137,7 @@ everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)
 
   g' :: Expr -> m Expr
   g' (Literal l) = Literal <$> litM (g >=> g') l
-  g' (UnaryMinus v) = UnaryMinus <$> (g v >>= g')
+  g' (UnaryMinus ss v) = UnaryMinus ss <$> (g v >>= g')
   g' (BinaryNoParens op v1 v2) = BinaryNoParens <$> (g op >>= g') <*> (g v1 >>= g') <*> (g v2 >>= g')
   g' (Parens v) = Parens <$> (g v >>= g')
   g' (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> (g v >>= g')
@@ -157,10 +157,10 @@ everywhereOnValuesTopDownM f g h = (f' <=< f, g' <=< g, h' <=< h)
 
   h' :: Binder -> m Binder
   h' (LiteralBinder l) = LiteralBinder <$> litM (h >=> h') l
-  h' (ConstructorBinder ctor bs) = ConstructorBinder ctor <$> traverse (h' <=< h) bs
+  h' (ConstructorBinder ss ctor bs) = ConstructorBinder ss ctor <$> traverse (h' <=< h) bs
   h' (BinaryNoParensBinder b1 b2 b3) = BinaryNoParensBinder <$> (h b1 >>= h') <*> (h b2 >>= h') <*> (h b3 >>= h')
   h' (ParensInBinder b) = ParensInBinder <$> (h b >>= h')
-  h' (NamedBinder name b) = NamedBinder name <$> (h b >>= h')
+  h' (NamedBinder ss name b) = NamedBinder ss name <$> (h b >>= h')
   h' (PositionedBinder pos com b) = PositionedBinder pos com <$> (h b >>= h')
   h' (TypedBinder t b) = TypedBinder t <$> (h b >>= h')
   h' other = h other
@@ -206,7 +206,7 @@ everywhereOnValuesM f g h = (f', g', h')
 
   g' :: Expr -> m Expr
   g' (Literal l) = (Literal <$> litM g' l) >>= g
-  g' (UnaryMinus v) = (UnaryMinus <$> g' v) >>= g
+  g' (UnaryMinus ss v) = (UnaryMinus ss <$> g' v) >>= g
   g' (BinaryNoParens op v1 v2) = (BinaryNoParens <$> g' op <*> g' v1 <*> g' v2) >>= g
   g' (Parens v) = (Parens <$> g' v) >>= g
   g' (TypeClassDictionaryConstructorApp name v) = (TypeClassDictionaryConstructorApp name <$> g' v) >>= g
@@ -226,10 +226,10 @@ everywhereOnValuesM f g h = (f', g', h')
 
   h' :: Binder -> m Binder
   h' (LiteralBinder l) = (LiteralBinder <$> litM h' l) >>= h
-  h' (ConstructorBinder ctor bs) = (ConstructorBinder ctor <$> traverse h' bs) >>= h
+  h' (ConstructorBinder ss ctor bs) = (ConstructorBinder ss ctor <$> traverse h' bs) >>= h
   h' (BinaryNoParensBinder b1 b2 b3) = (BinaryNoParensBinder <$> h' b1 <*> h' b2 <*> h' b3) >>= h
   h' (ParensInBinder b) = (ParensInBinder <$> h' b) >>= h
-  h' (NamedBinder name b) = (NamedBinder name <$> h' b) >>= h
+  h' (NamedBinder ss name b) = (NamedBinder ss name <$> h' b) >>= h
   h' (PositionedBinder pos com b) = (PositionedBinder pos com <$> h' b) >>= h
   h' (TypedBinder t b) = (TypedBinder t <$> h' b) >>= h
   h' other = h other
@@ -278,7 +278,7 @@ everythingOnValues (<>) f g h i j = (f', g', h', i', j')
 
   g' :: Expr -> r
   g' v@(Literal l) = lit (g v) g' l
-  g' v@(UnaryMinus v1) = g v <> g' v1
+  g' v@(UnaryMinus _ v1) = g v <> g' v1
   g' v@(BinaryNoParens op v1 v2) = g v <> g' op <> g' v1 <> g' v2
   g' v@(Parens v1) = g v <> g' v1
   g' v@(TypeClassDictionaryConstructorApp _ v1) = g v <> g' v1
@@ -298,10 +298,10 @@ everythingOnValues (<>) f g h i j = (f', g', h', i', j')
 
   h' :: Binder -> r
   h' b@(LiteralBinder l) = lit (h b) h' l
-  h' b@(ConstructorBinder _ bs) = foldl (<>) (h b) (fmap h' bs)
+  h' b@(ConstructorBinder _ _ bs) = foldl (<>) (h b) (fmap h' bs)
   h' b@(BinaryNoParensBinder b1 b2 b3) = h b <> h' b1 <> h' b2 <> h' b3
   h' b@(ParensInBinder b1) = h b <> h' b1
-  h' b@(NamedBinder _ b1) = h b <> h' b1
+  h' b@(NamedBinder _ _ b1) = h b <> h' b1
   h' b@(PositionedBinder _ _ b1) = h b <> h' b1
   h' b@(TypedBinder _ b1) = h b <> h' b1
   h' b = h b
@@ -359,7 +359,7 @@ everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'
 
   g' :: s -> Expr -> r
   g' s (Literal l) = lit g'' s l
-  g' s (UnaryMinus v1) = g'' s v1
+  g' s (UnaryMinus _ v1) = g'' s v1
   g' s (BinaryNoParens op v1 v2) = g'' s op <> g'' s v1 <> g'' s v2
   g' s (Parens v1) = g'' s v1
   g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1
@@ -382,10 +382,10 @@ everythingWithContextOnValues s0 r0 (<>) f g h i j = (f'' s0, g'' s0, h'' s0, i'
 
   h' :: s -> Binder -> r
   h' s (LiteralBinder l) = lit h'' s l
-  h' s (ConstructorBinder _ bs) = foldl (<>) r0 (fmap (h'' s) bs)
+  h' s (ConstructorBinder _ _ bs) = foldl (<>) r0 (fmap (h'' s) bs)
   h' s (BinaryNoParensBinder b1 b2 b3) = h'' s b1 <> h'' s b2 <> h'' s b3
   h' s (ParensInBinder b) = h'' s b
-  h' s (NamedBinder _ b1) = h'' s b1
+  h' s (NamedBinder _ _ b1) = h'' s b1
   h' s (PositionedBinder _ _ b1) = h'' s b1
   h' s (TypedBinder _ b1) = h'' s b1
   h' _ _ = r0
@@ -444,7 +444,7 @@ everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j
   g'' s = uncurry g' <=< g s
 
   g' s (Literal l) = Literal <$> lit g'' s l
-  g' s (UnaryMinus v) = UnaryMinus <$> g'' s v
+  g' s (UnaryMinus ss v) = UnaryMinus ss <$> g'' s v
   g' s (BinaryNoParens op v1 v2) = BinaryNoParens <$> g'' s op <*> g'' s v1 <*> g'' s v2
   g' s (Parens v) = Parens <$> g'' s v
   g' s (TypeClassDictionaryConstructorApp name v) = TypeClassDictionaryConstructorApp name <$> g'' s v
@@ -465,10 +465,10 @@ everywhereWithContextOnValuesM s0 f g h i j = (f'' s0, g'' s0, h'' s0, i'' s0, j
   h'' s = uncurry h' <=< h s
 
   h' s (LiteralBinder l) = LiteralBinder <$> lit h'' s l
-  h' s (ConstructorBinder ctor bs) = ConstructorBinder ctor <$> traverse (h'' s) bs
+  h' s (ConstructorBinder ss ctor bs) = ConstructorBinder ss ctor <$> traverse (h'' s) bs
   h' s (BinaryNoParensBinder b1 b2 b3) = BinaryNoParensBinder <$> h'' s b1 <*> h'' s b2 <*> h'' s b3
   h' s (ParensInBinder b) = ParensInBinder <$> h'' s b
-  h' s (NamedBinder name b) = NamedBinder name <$> h'' s b
+  h' s (NamedBinder ss name b) = NamedBinder ss name <$> h'' s b
   h' s (PositionedBinder pos com b) = PositionedBinder pos com <$> h'' s b
   h' s (TypedBinder t b) = TypedBinder t <$> h'' s b
   h' _ other = return other
@@ -534,7 +534,7 @@ everythingWithScope f g h i j = (f'', g'', h'', i'', \s -> snd . j'' s)
 
   g' :: S.Set Ident -> Expr -> r
   g' s (Literal l) = lit g'' s l
-  g' s (UnaryMinus v1) = g'' s v1
+  g' s (UnaryMinus _ v1) = g'' s v1
   g' s (BinaryNoParens op v1 v2) = g'' s op <> g'' s v1 <> g'' s v2
   g' s (Parens v1) = g'' s v1
   g' s (TypeClassDictionaryConstructorApp _ v1) = g'' s v1
@@ -563,10 +563,10 @@ everythingWithScope f g h i j = (f'', g'', h'', i'', \s -> snd . j'' s)
 
   h' :: S.Set Ident -> Binder -> r
   h' s (LiteralBinder l) = lit h'' s l
-  h' s (ConstructorBinder _ bs) = foldMap (h'' s) bs
+  h' s (ConstructorBinder _ _ bs) = foldMap (h'' s) bs
   h' s (BinaryNoParensBinder b1 b2 b3) = foldMap (h'' s) [b1, b2, b3]
   h' s (ParensInBinder b) = h'' s b
-  h' s (NamedBinder name b1) = h'' (S.insert name s) b1
+  h' s (NamedBinder _ name b1) = h'' (S.insert name s) b1
   h' s (PositionedBinder _ _ b1) = h'' s b1
   h' s (TypedBinder _ b1) = h'' s b1
   h' _ _ = mempty
diff --git a/src/Language/PureScript/CoreFn/Desugar.hs b/src/Language/PureScript/CoreFn/Desugar.hs
index ed788ab63d..decef9f1f7 100644
--- a/src/Language/PureScript/CoreFn/Desugar.hs
+++ b/src/Language/PureScript/CoreFn/Desugar.hs
@@ -79,13 +79,13 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) =
     Accessor (ss, com, ty, Nothing) name (exprToCoreFn ss [] Nothing v)
   exprToCoreFn ss com ty (A.ObjectUpdate obj vs) =
     ObjectUpdate (ss, com, ty, Nothing) (exprToCoreFn ss [] Nothing obj) $ fmap (second (exprToCoreFn ss [] Nothing)) vs
-  exprToCoreFn ss com ty (A.Abs (A.VarBinder name) v) =
+  exprToCoreFn ss com ty (A.Abs (A.VarBinder _ name) v) =
     Abs (ss, com, ty, Nothing) name (exprToCoreFn ss [] Nothing v)
   exprToCoreFn _ _ _ (A.Abs _ _) =
     internalError "Abs with Binder argument was not desugared before exprToCoreFn mn"
   exprToCoreFn ss com ty (A.App v1 v2) =
     App (ss, com, ty, Nothing) (exprToCoreFn ss [] Nothing v1) (exprToCoreFn ss [] Nothing v2)
-  exprToCoreFn ss com ty (A.Var ident) =
+  exprToCoreFn _ com ty (A.Var ss ident) =
     Var (ss, com, ty, getValueMeta ident) ident
   exprToCoreFn ss com ty (A.IfThenElse v1 v2 v3) =
     Case (ss, com, ty, Nothing) [exprToCoreFn ss [] Nothing v1]
@@ -93,7 +93,7 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) =
                         (Right $ exprToCoreFn ss [] Nothing v2)
       , CaseAlternative [NullBinder (ssAnn ss)]
                         (Right $ exprToCoreFn ss [] Nothing v3) ]
-  exprToCoreFn ss com ty (A.Constructor name) =
+  exprToCoreFn _ com ty (A.Constructor ss name) =
     Var (ss, com, ty, Just $ getConstructorMeta name) $ fmap properToIdent name
   exprToCoreFn ss com ty (A.Case vs alts) =
     Case (ss, com, ty, Nothing) (fmap (exprToCoreFn ss [] Nothing) vs) (fmap (altToCoreFn ss) alts)
@@ -137,12 +137,12 @@ moduleToCoreFn env (A.Module modSS coms mn decls (Just exps)) =
     LiteralBinder (ss, com, Nothing, Nothing) (fmap (binderToCoreFn ss com) lit)
   binderToCoreFn ss com A.NullBinder =
     NullBinder (ss, com, Nothing, Nothing)
-  binderToCoreFn ss com (A.VarBinder name) =
+  binderToCoreFn _ com (A.VarBinder ss name) =
     VarBinder (ss, com, Nothing, Nothing) name
-  binderToCoreFn ss com (A.ConstructorBinder dctor@(Qualified mn' _) bs) =
+  binderToCoreFn _ com (A.ConstructorBinder ss dctor@(Qualified mn' _) bs) =
     let (_, tctor, _, _) = lookupConstructor env dctor
     in ConstructorBinder (ss, com, Nothing, Just $ getConstructorMeta dctor) (Qualified mn' tctor) dctor (fmap (binderToCoreFn ss []) bs)
-  binderToCoreFn ss com (A.NamedBinder name b) =
+  binderToCoreFn _ com (A.NamedBinder ss name b) =
     NamedBinder (ss, com, Nothing, Nothing) name (binderToCoreFn ss [] b)
   binderToCoreFn _ com (A.PositionedBinder ss com1 b) =
     binderToCoreFn ss (com ++ com1) b
@@ -198,8 +198,8 @@ findQualModules decls =
   fqDecls _ = []
 
   fqValues :: A.Expr -> [ModuleName]
-  fqValues (A.Var q) = getQual' q
-  fqValues (A.Constructor q) = getQual' q
+  fqValues (A.Var _ q) = getQual' q
+  fqValues (A.Constructor _ q) = getQual' q
   -- Some instances are automatically solved and have their class dictionaries
   -- built inline instead of having a named instance defined and imported.
   -- We therefore need to import these constructors if they aren't already.
@@ -207,7 +207,7 @@ findQualModules decls =
   fqValues _ = []
 
   fqBinders :: A.Binder -> [ModuleName]
-  fqBinders (A.ConstructorBinder q _) = getQual' q
+  fqBinders (A.ConstructorBinder _ q _) = getQual' q
   fqBinders _ = []
 
   getQual' :: Qualified a -> [ModuleName]
diff --git a/src/Language/PureScript/Interactive/Module.hs b/src/Language/PureScript/Interactive/Module.hs
index f68a37351b..a7855cdb68 100644
--- a/src/Language/PureScript/Interactive/Module.hs
+++ b/src/Language/PureScript/Interactive/Module.hs
@@ -49,8 +49,8 @@ createTemporaryModule exec PSCiState{psciImportedModules = imports, psciLetBindi
     effModuleName = P.moduleNameFromString "Control.Monad.Eff"
     effImport     = (effModuleName, P.Implicit, Just (P.ModuleName [P.ProperName "$Eff"]))
     supportImport = (supportModuleName, P.Implicit, Just (P.ModuleName [P.ProperName "$Support"]))
-    eval          = P.Var (P.Qualified (Just (P.ModuleName [P.ProperName "$Support"])) (P.Ident "eval"))
-    mainValue     = P.App eval (P.Var (P.Qualified Nothing (P.Ident "it")))
+    eval          = P.Var internalSpan (P.Qualified (Just (P.ModuleName [P.ProperName "$Support"])) (P.Ident "eval"))
+    mainValue     = P.App eval (P.Var internalSpan (P.Qualified Nothing (P.Ident "it")))
     itDecl        = P.ValueDecl (internalSpan, []) (P.Ident "it") P.Public [] [P.MkUnguarded val]
     typeDecl      = P.TypeDeclaration
                       (P.TypeDeclarationData (internalSpan, []) (P.Ident "$main")
diff --git a/src/Language/PureScript/Linter.hs b/src/Language/PureScript/Linter.hs
index cabb840c20..51b74c2ae6 100644
--- a/src/Language/PureScript/Linter.hs
+++ b/src/Language/PureScript/Linter.hs
@@ -54,24 +54,24 @@ lint (Module _ _ mn ds _) = censor (addHint (ErrorInModule mn)) $ mapM_ lintDecl
     f' s dec = warningsInDecl moduleNames dec <> checkTypeVarsInDecl s dec
 
     stepE :: S.Set Ident -> Expr -> MultipleErrors
-    stepE s (Abs (VarBinder name) _) | name `S.member` s = errorMessage (ShadowedName name)
+    stepE s (Abs (VarBinder ss name) _) | name `S.member` s = errorMessage' ss (ShadowedName name)
     stepE s (Let ds' _) = foldMap go ds'
       where
       go d | Just i <- getDeclIdent d
-           , i `S.member` s = errorMessage (ShadowedName i)
+           , i `S.member` s = errorMessage' (declSourceSpan d) (ShadowedName i)
            | otherwise = mempty
     stepE _ _ = mempty
 
     stepB :: S.Set Ident -> Binder -> MultipleErrors
-    stepB s (VarBinder name) | name `S.member` s = errorMessage (ShadowedName name)
-    stepB s (NamedBinder name _) | name `S.member` s = errorMessage (ShadowedName name)
+    stepB s (VarBinder ss name) | name `S.member` s = errorMessage' ss (ShadowedName name)
+    stepB s (NamedBinder ss name _) | name `S.member` s = errorMessage' ss (ShadowedName name)
     stepB _ _ = mempty
 
     stepDo :: S.Set Ident -> DoNotationElement -> MultipleErrors
     stepDo s (DoNotationLet ds') = foldMap go ds'
       where
       go d | Just i <- getDeclIdent d
-           , i `S.member` s = errorMessage (ShadowedName i)
+           , i `S.member` s = errorMessage' (declSourceSpan d) (ShadowedName i)
            | otherwise = mempty
     stepDo _ _ = mempty
 
diff --git a/src/Language/PureScript/Linter/Exhaustive.hs b/src/Language/PureScript/Linter/Exhaustive.hs
index 23d39d9a8c..53615b8aec 100644
--- a/src/Language/PureScript/Linter/Exhaustive.hs
+++ b/src/Language/PureScript/Linter/Exhaustive.hs
@@ -115,16 +115,16 @@ genericMerge f bsl@((s, b):bs) bsr@((s', b'):bs')
 --
 missingCasesSingle :: Environment -> ModuleName -> Binder -> Binder -> ([Binder], Either RedundancyError Bool)
 missingCasesSingle _ _ _ NullBinder = ([], return True)
-missingCasesSingle _ _ _ (VarBinder _) = ([], return True)
-missingCasesSingle env mn (VarBinder _) b = missingCasesSingle env mn NullBinder b
-missingCasesSingle env mn br (NamedBinder _ bl) = missingCasesSingle env mn br bl
-missingCasesSingle env mn NullBinder cb@(ConstructorBinder con _) =
+missingCasesSingle _ _ _ (VarBinder _ _) = ([], return True)
+missingCasesSingle env mn (VarBinder _ _) b = missingCasesSingle env mn NullBinder b
+missingCasesSingle env mn br (NamedBinder _ _ bl) = missingCasesSingle env mn br bl
+missingCasesSingle env mn NullBinder cb@(ConstructorBinder ss con _) =
   (concatMap (\cp -> fst $ missingCasesSingle env mn cp cb) allPatterns, return True)
   where
-  allPatterns = map (\(p, t) -> ConstructorBinder (qualifyName p mn con) (initialize $ length t))
+  allPatterns = map (\(p, t) -> ConstructorBinder ss (qualifyName p mn con) (initialize $ length t))
                   $ getConstructors env mn con
-missingCasesSingle env mn cb@(ConstructorBinder con bs) (ConstructorBinder con' bs')
-  | con == con' = let (bs'', pr) = missingCasesMultiple env mn bs bs' in (map (ConstructorBinder con) bs'', pr)
+missingCasesSingle env mn cb@(ConstructorBinder ss con bs) (ConstructorBinder _ con' bs')
+  | con == con' = let (bs'', pr) = missingCasesMultiple env mn bs bs' in (map (ConstructorBinder ss con) bs'', pr)
   | otherwise = ([cb], return False)
 missingCasesSingle env mn NullBinder (LiteralBinder (ObjectLiteral bs)) =
   (map (LiteralBinder . ObjectLiteral . zip (map fst bs)) allMisses, pr)
@@ -291,7 +291,7 @@ checkExhaustive ss env mn numArgs cas expr = makeResult . first ordNub $ foldl'
     return $
       Let
         [ partial var tyVar ]
-        $ App (Var (Qualified Nothing UnusedIdent)) e
+        $ App (Var ss (Qualified Nothing UnusedIdent)) e
     where
       partial :: Text -> Text -> Declaration
       partial var tyVar =
@@ -299,7 +299,7 @@ checkExhaustive ss env mn numArgs cas expr = makeResult . first ordNub $ foldl'
         [MkUnguarded
           (TypedValue
            True
-           (Abs (VarBinder (Ident var)) (Var (Qualified Nothing (Ident var))))
+           (Abs (VarBinder ss (Ident var)) (Var ss (Qualified Nothing (Ident var))))
            (ty tyVar))
         ]
 
@@ -336,7 +336,7 @@ checkExhaustiveExpr initSS env mn = onExpr initSS
   onDecl decl = return decl
 
   onExpr :: SourceSpan -> Expr -> m Expr
-  onExpr ss (UnaryMinus e) = UnaryMinus <$> onExpr ss e
+  onExpr _ (UnaryMinus ss e) = UnaryMinus ss <$> onExpr ss e
   onExpr ss (Literal (ArrayLiteral es)) = Literal . ArrayLiteral <$> mapM (onExpr ss) es
   onExpr ss (Literal (ObjectLiteral es)) = Literal . ObjectLiteral <$> mapM (sndM (onExpr ss)) es
   onExpr ss (TypeClassDictionaryConstructorApp x e) = TypeClassDictionaryConstructorApp x <$> onExpr ss e
diff --git a/src/Language/PureScript/Parser/Common.hs b/src/Language/PureScript/Parser/Common.hs
index 4eb5bb69b7..6f21f9f16d 100644
--- a/src/Language/PureScript/Parser/Common.hs
+++ b/src/Language/PureScript/Parser/Common.hs
@@ -154,3 +154,8 @@ withSourceSpan'
   -> P.Parsec [PositionedToken] u a
   -> P.Parsec [PositionedToken] u b
 withSourceSpan' f = withSourceSpan (\ss _ -> f ss)
+
+withSourceSpanF
+  :: P.Parsec [PositionedToken] u (SourceSpan -> a)
+  -> P.Parsec [PositionedToken] u a
+withSourceSpanF = withSourceSpan (\ss _ f -> f ss)
diff --git a/src/Language/PureScript/Parser/Declarations.hs b/src/Language/PureScript/Parser/Declarations.hs
index 585fa75aed..0486696220 100644
--- a/src/Language/PureScript/Parser/Declarations.hs
+++ b/src/Language/PureScript/Parser/Declarations.hs
@@ -101,7 +101,7 @@ parseLocalValueDeclaration = withSourceAnnF .
     join $ go <$> parseBinder <*> P.many parseBinderNoParens
   where
   go :: Binder -> [Binder] -> TokenParser (SourceAnn -> Declaration)
-  go (VarBinder ident) bs = parseValueWithIdentAndBinders ident bs
+  go (VarBinder _ ident) bs = parseValueWithIdentAndBinders ident bs
   go (PositionedBinder _ _ b) bs = go b bs
   go binder [] = do
     boot <- indented *> equals *> parseValueWithWhereClause
@@ -381,8 +381,8 @@ parseObjectLiteral p = ObjectLiteral <$> braces (commaSep p)
 parseIdentifierAndValue :: TokenParser (PSString, Expr)
 parseIdentifierAndValue =
   do
-    name <- indented *> lname
-    b <- P.option (Var $ Qualified Nothing (Ident name)) rest
+    (ss, name) <- indented *> withSourceSpan' (,) lname
+    b <- P.option (Var ss $ Qualified Nothing (Ident name)) rest
     return (mkString name, b)
   <|> (,) <$> (indented *> stringLiteral) <*> rest
   where
@@ -400,10 +400,10 @@ parseAbs = do
   toFunction args value = foldr ($) value args
 
 parseVar :: TokenParser Expr
-parseVar = Var <$> parseQualified parseIdent
+parseVar = withSourceSpan' Var $ parseQualified parseIdent
 
 parseConstructor :: TokenParser Expr
-parseConstructor = Constructor <$> parseQualified dataConstructorName
+parseConstructor = withSourceSpan' Constructor $ parseQualified dataConstructorName
 
 parseCase :: TokenParser Expr
 parseCase = Case <$> P.between (reserved "case") (indented *> reserved "of") (commaSep1 parseValue)
@@ -453,7 +453,7 @@ parseValueAtom = withSourceSpan PositionedValue $ P.choice
                  , parseAdo
                  , parseLet
                  , P.try $ Parens <$> parens parseValue
-                 , Op <$> parseQualified (parens parseOperator)
+                 , withSourceSpan' Op $ parseQualified (parens parseOperator)
                  , parseHole
                  ]
 
@@ -461,7 +461,7 @@ parseValueAtom = withSourceSpan PositionedValue $ P.choice
 parseInfixExpr :: TokenParser Expr
 parseInfixExpr
   = P.between tick tick parseValue
-  <|> withSourceSpan PositionedValue (Op <$> parseQualified parseOperator)
+  <|> withSourceSpan' Op (parseQualified parseOperator)
 
 parseHole :: TokenParser Expr
 parseHole = Hole <$> holeLit
@@ -479,7 +479,7 @@ parsePropertyUpdate = do
     parseNestedUpdate = Branch <$> parseUpdaterBodyFields
 
 parseAccessor :: Expr -> TokenParser Expr
-parseAccessor (Constructor _) = P.unexpected "constructor"
+parseAccessor (Constructor _ _) = P.unexpected "constructor"
 parseAccessor obj = P.try $ Accessor <$> (indented *> dot *> indented *> parseLabel) <*> pure obj
 
 parseDo :: TokenParser Expr
@@ -519,15 +519,15 @@ indexersAndAccessors = buildPostfixParser postfixTable parseValueAtom
 
 -- | Parse an expression
 parseValue :: TokenParser Expr
-parseValue = withSourceSpan PositionedValue
-  (P.buildExpressionParser operators
-    . buildPostfixParser postfixTable
-    $ indexersAndAccessors) P.<?> "expression"
+parseValue =
+  P.buildExpressionParser operators
+    (buildPostfixParser postfixTable indexersAndAccessors)
+    P.<?> "expression"
   where
   postfixTable = [ \v -> P.try (flip App <$> (indented *> indexersAndAccessors)) <*> pure v
                  , \v -> flip (TypedValue True) <$> (indented *> doubleColon *> parsePolyType) <*> pure v
                  ]
-  operators = [ [ P.Prefix (indented *> symbol' "-" *> return UnaryMinus)
+  operators = [ [ P.Prefix (indented *> withSourceSpan' (\ss _ -> UnaryMinus ss) (symbol' "-"))
                 ]
               , [ P.Infix (P.try (indented *> parseInfixExpr P.<?> "infix expression") >>= \ident ->
                     return (BinaryNoParens ident)) P.AssocRight
@@ -559,35 +559,41 @@ parseNumberLiteral = LiteralBinder . NumericLiteral <$> (sign <*> number)
          <|> return id
 
 parseNullaryConstructorBinder :: TokenParser Binder
-parseNullaryConstructorBinder = ConstructorBinder <$> parseQualified dataConstructorName <*> pure []
+parseNullaryConstructorBinder = withSourceSpanF $
+  (\name ss -> ConstructorBinder ss name [])
+    <$> parseQualified dataConstructorName
 
 parseConstructorBinder :: TokenParser Binder
-parseConstructorBinder = ConstructorBinder <$> parseQualified dataConstructorName <*> many (indented *> parseBinderNoParens)
+parseConstructorBinder = withSourceSpanF $
+  (\name args ss -> ConstructorBinder ss name args)
+    <$> parseQualified dataConstructorName
+    <*> many (indented *> parseBinderNoParens)
 
 parseObjectBinder:: TokenParser Binder
-parseObjectBinder = LiteralBinder <$> parseObjectLiteral (indented *> parseIdentifierAndBinder)
+parseObjectBinder =
+  LiteralBinder <$> parseObjectLiteral (indented *> parseEntry)
+  where
+    parseEntry :: TokenParser (PSString, Binder)
+    parseEntry = var <|> (,) <$> stringLiteral <*> rest
+      where
+        var = withSourceSpanF $ do
+          name <- lname
+          b <- P.option (\ss -> VarBinder ss (Ident name)) (const <$> rest)
+          return $ \ss -> (mkString name, b ss)
+        rest = indented *> colon *> indented *> parseBinder
 
 parseArrayBinder :: TokenParser Binder
 parseArrayBinder = LiteralBinder <$> parseArrayLiteral (indented *> parseBinder)
 
 parseVarOrNamedBinder :: TokenParser Binder
-parseVarOrNamedBinder = do
+parseVarOrNamedBinder = withSourceSpanF $ do
   name <- parseIdent
-  let parseNamedBinder = NamedBinder name <$> (at *> indented *> parseBinderAtom)
-  parseNamedBinder <|> return (VarBinder name)
+  let parseNamedBinder = (\b ss -> NamedBinder ss name b) <$> (at *> indented *> parseBinderAtom)
+  parseNamedBinder <|> return (`VarBinder` name)
 
 parseNullBinder :: TokenParser Binder
 parseNullBinder = underscore *> return NullBinder
 
-parseIdentifierAndBinder :: TokenParser (PSString, Binder)
-parseIdentifierAndBinder =
-    do name <- lname
-       b <- P.option (VarBinder (Ident name)) rest
-       return (mkString name, b)
-    <|> (,) <$> stringLiteral <*> rest
-  where
-    rest = indented *> colon *> indented *> parseBinder
-
 -- | Parse a binder
 parseBinder :: TokenParser Binder
 parseBinder =
@@ -607,7 +613,7 @@ parseBinder =
     postfixTable = [ \b -> flip TypedBinder b <$> (indented *> doubleColon *> parsePolyType) ]
 
     parseOpBinder :: TokenParser Binder
-    parseOpBinder = OpBinder <$> parseQualified parseOperator
+    parseOpBinder = withSourceSpan' OpBinder $ parseQualified parseOperator
 
 parseBinderAtom :: TokenParser Binder
 parseBinderAtom = withSourceSpan PositionedBinder
diff --git a/src/Language/PureScript/Pretty/Values.hs b/src/Language/PureScript/Pretty/Values.hs
index 288c0f1030..82832c0cb1 100644
--- a/src/Language/PureScript/Pretty/Values.hs
+++ b/src/Language/PureScript/Pretty/Values.hs
@@ -101,17 +101,17 @@ prettyPrintValue d expr@UnaryMinus{} = prettyPrintValueAtom d expr
 prettyPrintValueAtom :: Int -> Expr -> Box
 prettyPrintValueAtom d (Literal l) = prettyPrintLiteralValue d l
 prettyPrintValueAtom _ AnonymousArgument = text "_"
-prettyPrintValueAtom _ (Constructor name) = text $ T.unpack $ runProperName (disqualify name)
-prettyPrintValueAtom _ (Var ident) = text $ T.unpack $ showIdent (disqualify ident)
+prettyPrintValueAtom _ (Constructor _ name) = text $ T.unpack $ runProperName (disqualify name)
+prettyPrintValueAtom _ (Var _ ident) = text $ T.unpack $ showIdent (disqualify ident)
 prettyPrintValueAtom d (BinaryNoParens op lhs rhs) =
   prettyPrintValue (d - 1) lhs `beforeWithSpace` printOp op `beforeWithSpace` prettyPrintValue (d - 1) rhs
   where
-  printOp (Op (Qualified _ name)) = text $ T.unpack $ runOpName name
+  printOp (Op _ (Qualified _ name)) = text $ T.unpack $ runOpName name
   printOp expr = text "`" <> prettyPrintValue (d - 1) expr `before` text "`"
 prettyPrintValueAtom d (TypedValue _ val _) = prettyPrintValueAtom d val
 prettyPrintValueAtom d (PositionedValue _ _ val) = prettyPrintValueAtom d val
 prettyPrintValueAtom d (Parens expr) = (text "(" <> prettyPrintValue d expr) `before` text ")"
-prettyPrintValueAtom d (UnaryMinus expr) = text "(-" <> prettyPrintValue d expr <> text ")"
+prettyPrintValueAtom d (UnaryMinus _ expr) = text "(-" <> prettyPrintValue d expr <> text ")"
 prettyPrintValueAtom d expr = (text "(" <> prettyPrintValue d expr) `before` text ")"
 
 prettyPrintLiteralValue :: Int -> Literal Expr -> Box
@@ -186,13 +186,13 @@ prettyPrintDoNotationElement d (PositionedDoNotationElement _ _ el) = prettyPrin
 prettyPrintBinderAtom :: Binder -> Text
 prettyPrintBinderAtom NullBinder = "_"
 prettyPrintBinderAtom (LiteralBinder l) = prettyPrintLiteralBinder l
-prettyPrintBinderAtom (VarBinder ident) = showIdent ident
-prettyPrintBinderAtom (ConstructorBinder ctor []) = runProperName (disqualify ctor)
+prettyPrintBinderAtom (VarBinder _ ident) = showIdent ident
+prettyPrintBinderAtom (ConstructorBinder _ ctor []) = runProperName (disqualify ctor)
 prettyPrintBinderAtom b@ConstructorBinder{} = parensT (prettyPrintBinder b)
-prettyPrintBinderAtom (NamedBinder ident binder) = showIdent ident Monoid.<> "@" Monoid.<> prettyPrintBinder binder
+prettyPrintBinderAtom (NamedBinder _ ident binder) = showIdent ident Monoid.<> "@" Monoid.<> prettyPrintBinder binder
 prettyPrintBinderAtom (PositionedBinder _ _ binder) = prettyPrintBinderAtom binder
 prettyPrintBinderAtom (TypedBinder _ binder) = prettyPrintBinderAtom binder
-prettyPrintBinderAtom (OpBinder op) = runOpName (disqualify op)
+prettyPrintBinderAtom (OpBinder _ op) = runOpName (disqualify op)
 prettyPrintBinderAtom (BinaryNoParensBinder op b1 b2) =
   prettyPrintBinderAtom b1 Monoid.<> " " Monoid.<> prettyPrintBinderAtom op Monoid.<> " " Monoid.<> prettyPrintBinderAtom b2
 prettyPrintBinderAtom (ParensInBinder b) = parensT (prettyPrintBinder b)
@@ -219,8 +219,8 @@ prettyPrintLiteralBinder (ArrayLiteral bs) =
 -- Generate a pretty-printed string representing a Binder
 --
 prettyPrintBinder :: Binder -> Text
-prettyPrintBinder (ConstructorBinder ctor []) = runProperName (disqualify ctor)
-prettyPrintBinder (ConstructorBinder ctor args) = (runProperName (disqualify ctor)) Monoid.<> " " Monoid.<> T.unwords (map prettyPrintBinderAtom args)
+prettyPrintBinder (ConstructorBinder _ ctor []) = runProperName (disqualify ctor)
+prettyPrintBinder (ConstructorBinder _ ctor args) = (runProperName (disqualify ctor)) Monoid.<> " " Monoid.<> T.unwords (map prettyPrintBinderAtom args)
 prettyPrintBinder (PositionedBinder _ _ binder) = prettyPrintBinder binder
 prettyPrintBinder (TypedBinder _ binder) = prettyPrintBinder binder
 prettyPrintBinder b = prettyPrintBinderAtom b
diff --git a/src/Language/PureScript/Sugar/AdoNotation.hs b/src/Language/PureScript/Sugar/AdoNotation.hs
index 68b18fc3d9..577f99a316 100644
--- a/src/Language/PureScript/Sugar/AdoNotation.hs
+++ b/src/Language/PureScript/Sugar/AdoNotation.hs
@@ -29,13 +29,13 @@ desugarAdo d =
   in f d
   where
   pure' :: Expr
-  pure' = Var (Qualified Nothing (Ident C.pure'))
+  pure' = Var nullSourceSpan (Qualified Nothing (Ident C.pure'))
 
   map' :: Expr
-  map' = Var (Qualified Nothing (Ident C.map))
+  map' = Var nullSourceSpan (Qualified Nothing (Ident C.map))
 
   apply :: Expr
-  apply = Var (Qualified Nothing (Ident C.apply))
+  apply = Var nullSourceSpan (Qualified Nothing (Ident C.apply))
 
   replace :: Expr -> m Expr
   replace (Ado els yield) = do
@@ -49,12 +49,12 @@ desugarAdo d =
   go :: (Expr, [Expr]) -> DoNotationElement -> m (Expr, [Expr])
   go (yield, args) (DoNotationValue val) =
     return (Abs NullBinder yield, val : args)
-  go (yield, args) (DoNotationBind (VarBinder ident) val) =
-    return (Abs (VarBinder ident) yield, val : args)
+  go (yield, args) (DoNotationBind (VarBinder ss ident) val) =
+    return (Abs (VarBinder ss ident) yield, val : args)
   go (yield, args) (DoNotationBind binder val) = do
     ident <- freshIdent'
-    let abs = Abs (VarBinder ident)
-                  (Case [Var (Qualified Nothing ident)]
+    let abs = Abs (VarBinder nullSourceSpan ident)
+                  (Case [Var nullSourceSpan (Qualified Nothing ident)]
                         [CaseAlternative [binder] [MkUnguarded yield]])
     return (abs, val : args)
   go (yield, args) (DoNotationLet ds) = do
diff --git a/src/Language/PureScript/Sugar/BindingGroups.hs b/src/Language/PureScript/Sugar/BindingGroups.hs
index f31ad3c213..0c801203ac 100644
--- a/src/Language/PureScript/Sugar/BindingGroups.hs
+++ b/src/Language/PureScript/Sugar/BindingGroups.hs
@@ -113,9 +113,9 @@ usedIdents moduleName = ordNub . usedIdents' S.empty . valdeclExpression
   (_, usedIdents', _, _, _) = everythingWithScope def usedNamesE def def def
 
   usedNamesE :: S.Set Ident -> Expr -> [Ident]
-  usedNamesE scope (Var (Qualified Nothing name))
+  usedNamesE scope (Var _ (Qualified Nothing name))
     | name `S.notMember` scope = [name]
-  usedNamesE scope (Var (Qualified (Just moduleName') name))
+  usedNamesE scope (Var _ (Qualified (Just moduleName') name))
     | moduleName == moduleName' && name `S.notMember` scope = [name]
   usedNamesE _ _ = []
 
@@ -127,8 +127,8 @@ usedImmediateIdents moduleName =
   def s _ = (s, [])
 
   usedNamesE :: Bool -> Expr -> (Bool, [Ident])
-  usedNamesE True (Var (Qualified Nothing name)) = (True, [name])
-  usedNamesE True (Var (Qualified (Just moduleName') name))
+  usedNamesE True (Var _ (Qualified Nothing name)) = (True, [name])
+  usedNamesE True (Var _ (Qualified (Just moduleName') name))
     | moduleName == moduleName' = (True, [name])
   usedNamesE True (Abs _ _) = (False, [])
   usedNamesE scope _ = (scope, [])
diff --git a/src/Language/PureScript/Sugar/CaseDeclarations.hs b/src/Language/PureScript/Sugar/CaseDeclarations.hs
index 4963ef685c..5c7eb0edcc 100644
--- a/src/Language/PureScript/Sugar/CaseDeclarations.hs
+++ b/src/Language/PureScript/Sugar/CaseDeclarations.hs
@@ -64,13 +64,13 @@ desugarGuardedExprs ss (Case scrut alternatives)
     -- We bind the scrutinee to Vars here to mitigate this case.
     (scrut', scrut_decls) <- unzip <$> forM scrut (\e -> do
       scrut_id <- freshIdent'
-      pure ( Var (Qualified Nothing scrut_id)
+      pure ( Var ss (Qualified Nothing scrut_id)
            , ValueDecl (ss, []) scrut_id Private [] [MkUnguarded e]
            )
       )
     Let scrut_decls <$> desugarGuardedExprs ss (Case scrut' alternatives)
   where
-    isTrivialExpr (Var _) = True
+    isTrivialExpr (Var _ _) = True
     isTrivialExpr (Literal _) = True
     isTrivialExpr (Accessor _ e) = isTrivialExpr e
     isTrivialExpr (Parens e) = isTrivialExpr e
@@ -226,13 +226,13 @@ desugarGuardedExprs ss (Case scrut alternatives) =
 
         let
           goto_rem_case :: Expr
-          goto_rem_case = Var (Qualified Nothing rem_case_id)
+          goto_rem_case = Var ss (Qualified Nothing rem_case_id)
             `App` Literal (BooleanLiteral True)
           alt_fail = [CaseAlternative [NullBinder] [MkUnguarded goto_rem_case]]
 
         pure $ Let [
           ValueDecl (ss, []) rem_case_id Private []
-            [MkUnguarded (Abs (VarBinder unused_binder) desugared)]
+            [MkUnguarded (Abs (VarBinder ss unused_binder) desugared)]
           ] (mk_body alt_fail)
 
       | otherwise
@@ -308,11 +308,11 @@ desugarAbs = flip parU f
   (f, _, _) = everywhereOnValuesM return replace return
 
   replace :: Expr -> m Expr
-  replace (Abs (stripPositioned -> (VarBinder i)) val) =
-    pure (Abs (VarBinder i) val)
+  replace (Abs (stripPositioned -> (VarBinder ss i)) val) =
+    pure (Abs (VarBinder ss i) val)
   replace (Abs binder val) = do
     ident <- freshIdent'
-    return $ Abs (VarBinder ident) $ Case [Var (Qualified Nothing ident)] [CaseAlternative [binder] [MkUnguarded val]]
+    return $ Abs (VarBinder nullSourceSpan ident) $ Case [Var nullSourceSpan (Qualified Nothing ident)] [CaseAlternative [binder] [MkUnguarded val]]
   replace other = return other
 
 stripPositioned :: Binder -> Binder
@@ -345,13 +345,13 @@ inSameGroup _ _ = False
 toDecls :: forall m. (MonadSupply m, MonadError MultipleErrors m) => [Declaration] -> m [Declaration]
 toDecls [ValueDecl sa@(ss, _) ident nameKind bs [MkUnguarded val]] | all isIrrefutable bs = do
   args <- mapM fromVarBinder bs
-  let body = foldr (Abs . VarBinder) val args
+  let body = foldr (Abs . VarBinder ss) val args
   guardWith (errorMessage' ss (OverlappingArgNames (Just ident))) $ length (ordNub args) == length args
   return [ValueDecl sa ident nameKind [] [MkUnguarded body]]
   where
   fromVarBinder :: Binder -> m Ident
   fromVarBinder NullBinder = freshIdent'
-  fromVarBinder (VarBinder name) = return name
+  fromVarBinder (VarBinder _ name) = return name
   fromVarBinder (PositionedBinder _ _ b) = fromVarBinder b
   fromVarBinder (TypedBinder _ b) = fromVarBinder b
   fromVarBinder _ = internalError "fromVarBinder: Invalid argument"
@@ -380,9 +380,9 @@ makeCaseDeclaration ss ident alternatives = do
   args <- if allUnique (catMaybes argNames)
             then mapM argName argNames
             else replicateM (length argNames) freshIdent'
-  let vars = map (Var . Qualified Nothing) args
+  let vars = map (Var ss . Qualified Nothing) args
       binders = [ CaseAlternative bs result | (bs, result) <- alternatives ]
-  let value = foldr (Abs . VarBinder) (Case vars binders) args
+  let value = foldr (Abs . VarBinder ss) (Case vars binders) args
 
   return $ ValueDecl (ss, []) ident Public [] [MkUnguarded value]
   where
@@ -391,7 +391,7 @@ makeCaseDeclaration ss ident alternatives = do
   -- Everything else becomes Nothing, which indicates that we
   -- have to generate a name.
   findName :: Binder -> Maybe Ident
-  findName (VarBinder name) = Just name
+  findName (VarBinder _ name) = Just name
   findName (PositionedBinder _ _ binder) = findName binder
   findName _ = Nothing
 
diff --git a/src/Language/PureScript/Sugar/DoNotation.hs b/src/Language/PureScript/Sugar/DoNotation.hs
index 713e16d93a..95c77cf560 100644
--- a/src/Language/PureScript/Sugar/DoNotation.hs
+++ b/src/Language/PureScript/Sugar/DoNotation.hs
@@ -29,10 +29,10 @@ desugarDo d =
   in rethrowWithPosition (declSourceSpan d) $ f d
   where
   bind :: Expr
-  bind = Var (Qualified Nothing (Ident C.bind))
+  bind = Var nullSourceSpan (Qualified Nothing (Ident C.bind))
 
   discard :: Expr
-  discard = Var (Qualified Nothing (Ident C.discard))
+  discard = Var nullSourceSpan (Qualified Nothing (Ident C.discard))
 
   replace :: Expr -> m Expr
   replace (Do els) = go els
@@ -44,20 +44,20 @@ desugarDo d =
   go [DoNotationValue val] = return val
   go (DoNotationValue val : rest) = do
     rest' <- go rest
-    return $ App (App discard val) (Abs (VarBinder UnusedIdent) rest')
+    return $ App (App discard val) (Abs (VarBinder nullSourceSpan UnusedIdent) rest')
   go [DoNotationBind _ _] = throwError . errorMessage $ InvalidDoBind
   go (DoNotationBind b _ : _) | First (Just ident) <- foldMap fromIdent (binderNames b) =
       throwError . errorMessage $ CannotUseBindWithDo (Ident ident)
     where
       fromIdent (Ident i) | i `elem` [ C.bind, C.discard ] = First (Just i)
       fromIdent _ = mempty
-  go (DoNotationBind (VarBinder ident) val : rest) = do
+  go (DoNotationBind (VarBinder ss ident) val : rest) = do
     rest' <- go rest
-    return $ App (App bind val) (Abs (VarBinder ident) rest')
+    return $ App (App bind val) (Abs (VarBinder ss ident) rest')
   go (DoNotationBind binder val : rest) = do
     rest' <- go rest
     ident <- freshIdent'
-    return $ App (App bind val) (Abs (VarBinder ident) (Case [Var (Qualified Nothing ident)] [CaseAlternative [binder] [MkUnguarded rest']]))
+    return $ App (App bind val) (Abs (VarBinder nullSourceSpan ident) (Case [Var nullSourceSpan (Qualified Nothing ident)] [CaseAlternative [binder] [MkUnguarded rest']]))
   go [DoNotationLet _] = throwError . errorMessage $ InvalidDoLet
   go (DoNotationLet ds : rest) = do
     let checkBind :: Declaration -> m ()
diff --git a/src/Language/PureScript/Sugar/Names.hs b/src/Language/PureScript/Sugar/Names.hs
index 4afbdccc9e..ca1ee4cb29 100644
--- a/src/Language/PureScript/Sugar/Names.hs
+++ b/src/Language/PureScript/Sugar/Names.hs
@@ -252,21 +252,21 @@ renameInModule imports (Module modSS coms mn decls exps) =
     -> m ((SourceSpan, [Ident]), Expr)
   updateValue (_, bound) v@(PositionedValue pos' _ _) =
     return ((pos', bound), v)
-  updateValue (pos, bound) (Abs (VarBinder arg) val') =
-    return ((pos, arg : bound), Abs (VarBinder arg) val')
+  updateValue (pos, bound) (Abs (VarBinder ss arg) val') =
+    return ((pos, arg : bound), Abs (VarBinder ss arg) val')
   updateValue (pos, bound) (Let ds val') = do
     let args = mapMaybe letBoundVariable ds
     unless (length (ordNub args) == length args) .
       throwError . errorMessage' pos $ OverlappingNamesInLet
     return ((pos, args ++ bound), Let ds val')
-  updateValue (pos, bound) (Var name'@(Qualified Nothing ident)) | ident `notElem` bound =
-    (,) (pos, bound) <$> (Var <$> updateValueName name' pos)
-  updateValue (pos, bound) (Var name'@(Qualified (Just _) _)) =
-    (,) (pos, bound) <$> (Var <$> updateValueName name' pos)
-  updateValue (pos, bound) (Op op) =
-    (,) (pos, bound) <$> (Op <$> updateValueOpName op pos)
-  updateValue s@(pos, _) (Constructor name) =
-    (,) s <$> (Constructor <$> updateDataConstructorName name pos)
+  updateValue (_, bound) (Var ss name'@(Qualified Nothing ident)) | ident `notElem` bound =
+    (,) (ss, bound) <$> (Var ss <$> updateValueName name' ss)
+  updateValue (_, bound) (Var ss name'@(Qualified (Just _) _)) =
+    (,) (ss, bound) <$> (Var ss <$> updateValueName name' ss)
+  updateValue (_, bound) (Op ss op) =
+    (,) (ss, bound) <$> (Op ss <$> updateValueOpName op ss)
+  updateValue (_, bound) (Constructor ss name) =
+    (,) (ss, bound) <$> (Constructor ss <$> updateDataConstructorName name ss)
   updateValue s@(pos, _) (TypedValue check val ty) =
     (,) s <$> (TypedValue check val <$> updateTypesEverywhere pos ty)
   updateValue s v = return (s, v)
@@ -277,10 +277,10 @@ renameInModule imports (Module modSS coms mn decls exps) =
     -> m ((SourceSpan, [Ident]), Binder)
   updateBinder (_, bound) v@(PositionedBinder pos _ _) =
     return ((pos, bound), v)
-  updateBinder s@(pos, _) (ConstructorBinder name b) =
-    (,) s <$> (ConstructorBinder <$> updateDataConstructorName name pos <*> pure b)
-  updateBinder s@(pos, _) (OpBinder op) =
-    (,) s <$> (OpBinder <$> updateValueOpName op pos)
+  updateBinder (_, bound) (ConstructorBinder ss name b) =
+    (,) (ss, bound) <$> (ConstructorBinder ss <$> updateDataConstructorName name ss <*> pure b)
+  updateBinder (_, bound) (OpBinder ss op) =
+    (,) (ss, bound) <$> (OpBinder ss <$> updateValueOpName op ss)
   updateBinder s@(pos, _) (TypedBinder t b) = do
     t' <- updateTypesEverywhere pos t
     return (s, TypedBinder t' b)
diff --git a/src/Language/PureScript/Sugar/ObjectWildcards.hs b/src/Language/PureScript/Sugar/ObjectWildcards.hs
index 7556f940d7..31998c4bf6 100644
--- a/src/Language/PureScript/Sugar/ObjectWildcards.hs
+++ b/src/Language/PureScript/Sugar/ObjectWildcards.hs
@@ -36,27 +36,27 @@ desugarDecl d = rethrowWithPosition (declSourceSpan d) $ fn d
     | b' <- stripPositionInfo b
     , BinaryNoParens op val u <- b'
     , isAnonymousArgument u = do arg <- freshIdent'
-                                 return $ Abs (VarBinder arg) $ App (App op val) (Var (Qualified Nothing arg))
+                                 return $ Abs (VarBinder nullSourceSpan arg) $ App (App op val) (Var nullSourceSpan (Qualified Nothing arg))
     | b' <- stripPositionInfo b
     , BinaryNoParens op u val <- b'
     , isAnonymousArgument u = do arg <- freshIdent'
-                                 return $ Abs (VarBinder arg) $ App (App op (Var (Qualified Nothing arg))) val
+                                 return $ Abs (VarBinder nullSourceSpan arg) $ App (App op (Var nullSourceSpan (Qualified Nothing arg))) val
   desugarExpr (Literal (ObjectLiteral ps)) = wrapLambdaAssoc (Literal . ObjectLiteral) ps
   desugarExpr (ObjectUpdateNested obj ps) = transformNestedUpdate obj ps
   desugarExpr (Accessor prop u)
     | Just props <- peelAnonAccessorChain u = do
       arg <- freshIdent'
-      return $ Abs (VarBinder arg) $ foldr Accessor (argToExpr arg) (prop:props)
+      return $ Abs (VarBinder nullSourceSpan arg) $ foldr Accessor (argToExpr arg) (prop:props)
   desugarExpr (Case args cas) | any isAnonymousArgument args = do
     argIdents <- forM args freshIfAnon
     let args' = zipWith (`maybe` argToExpr) args argIdents
-    return $ foldr (Abs . VarBinder) (Case args' cas) (catMaybes argIdents)
+    return $ foldr (Abs . VarBinder nullSourceSpan) (Case args' cas) (catMaybes argIdents)
   desugarExpr (IfThenElse u t f) | any isAnonymousArgument [u, t, f] = do
     u' <- freshIfAnon u
     t' <- freshIfAnon t
     f' <- freshIfAnon f
     let if_ = IfThenElse (maybe u argToExpr u') (maybe t argToExpr t') (maybe f argToExpr f')
-    return $ foldr (Abs . VarBinder) if_ (catMaybes [u', t', f'])
+    return $ foldr (Abs . VarBinder nullSourceSpan) if_ (catMaybes [u', t', f'])
   desugarExpr e = return e
 
   transformNestedUpdate :: Expr -> PathTree Expr -> m Expr
@@ -66,7 +66,7 @@ desugarDecl d = rethrowWithPosition (declSourceSpan d) $ fn d
     val <- freshIdent'
     let valExpr = argToExpr val
     if isAnonymousArgument obj
-      then Abs (VarBinder val) <$> wrapLambda (buildUpdates valExpr) ps
+      then Abs (VarBinder nullSourceSpan val) <$> wrapLambda (buildUpdates valExpr) ps
       else wrapLambda (buildLet val . buildUpdates valExpr) ps
     where
       buildLet val = Let [ValueDecl (declSourceSpan d, []) val Public [] [MkUnguarded obj]]
@@ -86,7 +86,7 @@ desugarDecl d = rethrowWithPosition (declSourceSpan d) $ fn d
   wrapLambda :: forall t. Traversable t => (t Expr -> Expr) -> t Expr -> m Expr
   wrapLambda mkVal ps = do
     args <- traverse processExpr ps
-    return $ foldr (Abs . VarBinder) (mkVal (snd <$> args)) (catMaybes $ toList (fst <$> args))
+    return $ foldr (Abs . VarBinder nullSourceSpan) (mkVal (snd <$> args)) (catMaybes $ toList (fst <$> args))
     where
       processExpr :: Expr -> m (Maybe Ident, Expr)
       processExpr e = do
@@ -117,4 +117,4 @@ desugarDecl d = rethrowWithPosition (declSourceSpan d) $ fn d
     | otherwise = return Nothing
 
   argToExpr :: Ident -> Expr
-  argToExpr = Var . Qualified Nothing
+  argToExpr = Var nullSourceSpan . Qualified Nothing
diff --git a/src/Language/PureScript/Sugar/Operators.hs b/src/Language/PureScript/Sugar/Operators.hs
index 8d3b3ecbbc..99071c1aa1 100644
--- a/src/Language/PureScript/Sugar/Operators.hs
+++ b/src/Language/PureScript/Sugar/Operators.hs
@@ -47,7 +47,7 @@ desugarSignedLiterals (Module ss coms mn ds exts) =
   Module ss coms mn (map f' ds) exts
   where
   (f', _, _) = everywhereOnValues id go id
-  go (UnaryMinus val) = App (Var (Qualified Nothing (Ident C.negate))) val
+  go (UnaryMinus ss' val) = App (Var ss' (Qualified Nothing (Ident C.negate))) val
   go other = other
 
 -- |
@@ -142,30 +142,26 @@ rebracketFiltered pred_ externs modules = do
 
     goExpr :: Maybe SourceSpan -> Expr -> m (Maybe SourceSpan, Expr)
     goExpr _ e@(PositionedValue pos _ _) = return (Just pos, e)
-    goExpr pos (Op op) =
-      (pos, ) <$> case op `M.lookup` valueAliased of
+    goExpr _ (Op pos op) =
+      (Just pos, ) <$> case op `M.lookup` valueAliased of
         Just (Qualified mn' (Left alias)) ->
-          return $ Var (Qualified mn' alias)
+          return $ Var pos (Qualified mn' alias)
         Just (Qualified mn' (Right alias)) ->
-          return $ Constructor (Qualified mn' alias)
+          return $ Constructor pos (Qualified mn' alias)
         Nothing ->
-          maybe id rethrowWithPosition pos $
-            throwError . errorMessage . UnknownName $ fmap ValOpName op
+          throwError . errorMessage' pos . UnknownName $ fmap ValOpName op
     goExpr pos other = return (pos, other)
 
     goBinder :: Maybe SourceSpan -> Binder -> m (Maybe SourceSpan, Binder)
     goBinder _ b@(PositionedBinder pos _ _) = return (Just pos, b)
-    goBinder pos (BinaryNoParensBinder (OpBinder op) lhs rhs) =
+    goBinder _ (BinaryNoParensBinder (OpBinder pos op) lhs rhs) =
       case op `M.lookup` valueAliased of
         Just (Qualified mn' (Left alias)) ->
-          maybe id rethrowWithPosition pos $
-            throwError . errorMessage $
-              InvalidOperatorInBinder op (Qualified mn' alias)
+          throwError . errorMessage' pos $ InvalidOperatorInBinder op (Qualified mn' alias)
         Just (Qualified mn' (Right alias)) ->
-          return (pos, ConstructorBinder (Qualified mn' alias) [lhs, rhs])
+          return (Just pos, ConstructorBinder pos (Qualified mn' alias) [lhs, rhs])
         Nothing ->
-          maybe id rethrowWithPosition pos $
-            throwError . errorMessage . UnknownName $ fmap ValOpName op
+          throwError . errorMessage' pos . UnknownName $ fmap ValOpName op
     goBinder _ BinaryNoParensBinder{} =
       internalError "BinaryNoParensBinder has no OpBinder"
     goBinder pos other = return (pos, other)
diff --git a/src/Language/PureScript/Sugar/Operators/Binders.hs b/src/Language/PureScript/Sugar/Operators/Binders.hs
index bdc0110d5e..8906703c03 100644
--- a/src/Language/PureScript/Sugar/Operators/Binders.hs
+++ b/src/Language/PureScript/Sugar/Operators/Binders.hs
@@ -18,9 +18,9 @@ matchBinderOperators = matchOperators isBinOp extractOp fromOp reapply id
   extractOp (BinaryNoParensBinder op l r) = Just (op, l, r)
   extractOp _ = Nothing
 
-  fromOp :: Binder -> Maybe (Qualified (OpName 'ValueOpName))
-  fromOp (OpBinder q@(Qualified _ (OpName _))) = Just q
+  fromOp :: Binder -> Maybe (SourceSpan, Qualified (OpName 'ValueOpName))
+  fromOp (OpBinder ss q@(Qualified _ (OpName _))) = Just (ss, q)
   fromOp _ = Nothing
 
-  reapply :: Qualified (OpName 'ValueOpName) -> Binder -> Binder -> Binder
-  reapply = BinaryNoParensBinder . OpBinder
+  reapply :: SourceSpan -> Qualified (OpName 'ValueOpName) -> Binder -> Binder -> Binder
+  reapply ss = BinaryNoParensBinder . OpBinder ss
diff --git a/src/Language/PureScript/Sugar/Operators/Common.hs b/src/Language/PureScript/Sugar/Operators/Common.hs
index dd0e43da4f..34201404d4 100644
--- a/src/Language/PureScript/Sugar/Operators/Common.hs
+++ b/src/Language/PureScript/Sugar/Operators/Common.hs
@@ -16,6 +16,9 @@ import Language.PureScript.Names
 
 type Chain a = [Either a a]
 
+type FromOp nameType a = a -> Maybe (SourceSpan, Qualified (OpName nameType))
+type Reapply nameType a = SourceSpan -> Qualified (OpName nameType) -> a -> a -> a
+
 toAssoc :: Associativity -> P.Assoc
 toAssoc Infixl = P.AssocLeft
 toAssoc Infixr = P.AssocRight
@@ -28,34 +31,34 @@ parseValue :: P.Parsec (Chain a) () a
 parseValue = token (either Just (const Nothing)) P.<?> "expression"
 
 parseOp
-  :: (a -> Maybe (Qualified (OpName nameType)))
-  -> P.Parsec (Chain a) () (Qualified (OpName nameType))
+  :: FromOp nameType a
+  -> P.Parsec (Chain a) () (SourceSpan, Qualified (OpName nameType))
 parseOp fromOp = token (either (const Nothing) fromOp) P.<?> "operator"
 
 matchOp
-  :: (a -> Maybe (Qualified (OpName nameType)))
+  :: FromOp nameType a
   -> Qualified (OpName nameType)
-  -> P.Parsec (Chain a) () ()
+  -> P.Parsec (Chain a) () SourceSpan
 matchOp fromOp op = do
-  ident <- parseOp fromOp
+  (ss, ident) <- parseOp fromOp
   guard $ ident == op
+  pure ss
 
 opTable
   :: [[(Qualified (OpName nameType), Associativity)]]
-  -> (a -> Maybe (Qualified (OpName nameType)))
-  -> (Qualified (OpName nameType) -> a -> a -> a)
+  -> FromOp nameType a
+  -> Reapply nameType a
   -> [[P.Operator (Chain a) () Identity a]]
 opTable ops fromOp reapply =
-  map (map (\(name, a) -> P.Infix (P.try (matchOp fromOp name) >> return (reapply name)) (toAssoc a))) ops
-  ++ [[ P.Infix (P.try (parseOp fromOp >>= \ident -> return (reapply ident))) P.AssocLeft ]]
+  map (map (\(name, a) -> P.Infix (P.try (matchOp fromOp name) >>= \ss -> return (reapply ss name)) (toAssoc a))) ops
 
 matchOperators
   :: forall a nameType
    . Show a
   => (a -> Bool)
   -> (a -> Maybe (a, a, a))
-  -> (a -> Maybe (Qualified (OpName nameType)))
-  -> (Qualified (OpName nameType) -> a -> a -> a)
+  -> FromOp nameType a
+  -> Reapply nameType a
   -> ([[P.Operator (Chain a) () Identity a]] -> P.OperatorTable (Chain a) () Identity a)
   -> [[(Qualified (OpName nameType), Associativity)]]
   -> a
diff --git a/src/Language/PureScript/Sugar/Operators/Expr.hs b/src/Language/PureScript/Sugar/Operators/Expr.hs
index 84a1691ad3..99a0731e24 100644
--- a/src/Language/PureScript/Sugar/Operators/Expr.hs
+++ b/src/Language/PureScript/Sugar/Operators/Expr.hs
@@ -25,12 +25,12 @@ matchExprOperators = matchOperators isBinOp extractOp fromOp reapply modOpTable
     | otherwise = Just (op, l, r)
   extractOp _ = Nothing
 
-  fromOp :: Expr -> Maybe (Qualified (OpName 'ValueOpName))
-  fromOp (Op q@(Qualified _ (OpName _))) = Just q
+  fromOp :: Expr -> Maybe (SourceSpan, Qualified (OpName 'ValueOpName))
+  fromOp (Op ss q@(Qualified _ (OpName _))) = Just (ss, q)
   fromOp _ = Nothing
 
-  reapply :: Qualified (OpName 'ValueOpName) -> Expr -> Expr -> Expr
-  reapply op t1 = App (App (Op op) t1)
+  reapply :: SourceSpan -> Qualified (OpName 'ValueOpName) -> Expr -> Expr -> Expr
+  reapply ss op t1 = App (App (Op ss op) t1)
 
   modOpTable
     :: [[P.Operator (Chain Expr) () Identity Expr]]
@@ -42,5 +42,5 @@ matchExprOperators = matchOperators isBinOp extractOp fromOp reapply modOpTable
   parseTicks :: P.Parsec (Chain Expr) () Expr
   parseTicks = token (either (const Nothing) fromOther) P.<?> "infix function"
     where
-    fromOther (Op _) = Nothing
+    fromOther (Op _ _) = Nothing
     fromOther v = Just v
diff --git a/src/Language/PureScript/Sugar/Operators/Types.hs b/src/Language/PureScript/Sugar/Operators/Types.hs
index f70ecf2d36..a4ef1f8848 100644
--- a/src/Language/PureScript/Sugar/Operators/Types.hs
+++ b/src/Language/PureScript/Sugar/Operators/Types.hs
@@ -3,6 +3,7 @@ module Language.PureScript.Sugar.Operators.Types where
 import Prelude.Compat
 
 import Language.PureScript.AST
+import Language.PureScript.Crash
 import Language.PureScript.Names
 import Language.PureScript.Sugar.Operators.Common
 import Language.PureScript.Types
@@ -19,9 +20,9 @@ matchTypeOperators = matchOperators isBinOp extractOp fromOp reapply id
   extractOp (BinaryNoParensType op l r) = Just (op, l, r)
   extractOp _ = Nothing
 
-  fromOp :: Type -> Maybe (Qualified (OpName 'TypeOpName))
-  fromOp (TypeOp q@(Qualified _ (OpName _))) = Just q
+  fromOp :: Type -> Maybe (a, Qualified (OpName 'TypeOpName))
+  fromOp (TypeOp q@(Qualified _ (OpName _))) = Just (internalError "tried to use type operator source span", q)
   fromOp _ = Nothing
 
-  reapply :: Qualified (OpName 'TypeOpName) -> Type -> Type -> Type
-  reapply = BinaryNoParensType . TypeOp
+  reapply :: a -> Qualified (OpName 'TypeOpName) -> Type -> Type -> Type
+  reapply _ = BinaryNoParensType . TypeOp
diff --git a/src/Language/PureScript/Sugar/TypeClasses.hs b/src/Language/PureScript/Sugar/TypeClasses.hs
index 90476e666e..a0d84182b9 100644
--- a/src/Language/PureScript/Sugar/TypeClasses.hs
+++ b/src/Language/PureScript/Sugar/TypeClasses.hs
@@ -270,7 +270,7 @@ typeInstanceDictionaryDeclaration
   -> [Type]
   -> [Declaration]
   -> Desugar m Declaration
-typeInstanceDictionaryDeclaration sa name mn deps className tys decls =
+typeInstanceDictionaryDeclaration sa@(ss, _) name mn deps className tys decls =
   rethrow (addHint (ErrorInInstance className tys)) $ do
   m <- get
 
@@ -292,7 +292,7 @@ typeInstanceDictionaryDeclaration sa name mn deps className tys decls =
       -- The type is a record type, but depending on type instance dependencies, may be constrained.
       -- The dictionary itself is a record literal.
       let superclasses = superClassDictionaryNames typeClassSuperclasses `zip`
-            [ Abs (VarBinder UnusedIdent) (DeferredDictionary superclass tyArgs)
+            [ Abs (VarBinder ss UnusedIdent) (DeferredDictionary superclass tyArgs)
             | (Constraint superclass suTyArgs _) <- typeClassSuperclasses
             , let tyArgs = map (replaceAllTypeVars (zip (map fst typeClassArguments) tys)) suTyArgs
             ]
diff --git a/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs b/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs
index 27fcf75393..2d833bc8f0 100755
--- a/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs
+++ b/src/Language/PureScript/Sugar/TypeClasses/Deriving.hs
@@ -281,11 +281,11 @@ deriveGenericRep mn syns ds tyConNm tyConArgs repTy = do
                    -- If there are no cases, spin
                    [ ValueDecl (ss, []) (Ident "to") Public [] $ unguarded $
                        lamCase x [ CaseAlternative [NullBinder]
-                                                   (unguarded (App toName (Var (Qualified Nothing x))))
+                                                   (unguarded (App toName (Var nullSourceSpan (Qualified Nothing x))))
                                  ]
                    , ValueDecl (ss, []) (Ident "from") Public [] $ unguarded $
                        lamCase x [ CaseAlternative [NullBinder]
-                                                   (unguarded (App fromName (Var (Qualified Nothing x))))
+                                                   (unguarded (App fromName (Var nullSourceSpan (Qualified Nothing x))))
                                  ]
                    ]
                | otherwise =
@@ -305,10 +305,10 @@ deriveGenericRep mn syns ds tyConNm tyConArgs repTy = do
     select l r n = take (n - 1) (iterate (r .) l) ++ [compN (n - 1) r]
 
     sumBinders :: Int -> [Binder -> Binder]
-    sumBinders = select (ConstructorBinder inl . pure) (ConstructorBinder inr . pure)
+    sumBinders = select (ConstructorBinder nullSourceSpan inl . pure) (ConstructorBinder nullSourceSpan inr . pure)
 
     sumExprs :: Int -> [Expr -> Expr]
-    sumExprs = select (App (Constructor inl)) (App (Constructor inr))
+    sumExprs = select (App (Constructor nullSourceSpan inl)) (App (Constructor nullSourceSpan inr))
 
     compN :: Int -> (a -> a) -> a -> a
     compN 0 _ = id
@@ -323,9 +323,9 @@ deriveGenericRep mn syns ds tyConNm tyConArgs repTy = do
         return ( TypeApp (TypeApp (TypeConstructor constructor)
                                   (TypeLevelString $ mkString (runProperName ctorName)))
                          ctorTy
-               , CaseAlternative [ ConstructorBinder constructor [matchProduct] ]
-                                 (unguarded (foldl' App (Constructor (Qualified (Just mn) ctorName)) ctorArgs))
-               , CaseAlternative [ ConstructorBinder (Qualified (Just mn) ctorName) matchCtor ]
+               , CaseAlternative [ ConstructorBinder nullSourceSpan constructor [matchProduct] ]
+                                 (unguarded (foldl' App (Constructor nullSourceSpan (Qualified (Just mn) ctorName)) ctorArgs))
+               , CaseAlternative [ ConstructorBinder nullSourceSpan (Qualified (Just mn) ctorName) matchCtor ]
                                  (unguarded (constructor' mkProduct))
                )
 
@@ -337,20 +337,20 @@ deriveGenericRep mn syns ds tyConNm tyConArgs repTy = do
     makeProduct args = do
       (tys, bs1, es1, bs2, es2) <- unzip5 <$> traverse makeArg args
       pure ( foldr1 (\f -> TypeApp (TypeApp (TypeConstructor productName) f)) tys
-           , foldr1 (\b1 b2 -> ConstructorBinder productName [b1, b2]) bs1
+           , foldr1 (\b1 b2 -> ConstructorBinder nullSourceSpan productName [b1, b2]) bs1
            , es1
            , bs2
-           , foldr1 (\e1 -> App (App (Constructor productName) e1)) es2
+           , foldr1 (\e1 -> App (App (Constructor nullSourceSpan productName) e1)) es2
            )
 
     makeArg :: Type -> m (Type, Binder, Expr, Binder, Expr)
     makeArg arg = do
       argName <- freshIdent "arg"
       pure ( TypeApp (TypeConstructor argument) arg
-           , ConstructorBinder argument [ VarBinder argName ]
-           , Var (Qualified Nothing argName)
-           , VarBinder argName
-           , argument' (Var (Qualified Nothing argName))
+           , ConstructorBinder nullSourceSpan argument [ VarBinder nullSourceSpan argName ]
+           , Var nullSourceSpan (Qualified Nothing argName)
+           , VarBinder nullSourceSpan argName
+           , argument' (Var nullSourceSpan (Qualified Nothing argName))
            )
 
     underBinder :: (Binder -> Binder) -> CaseAlternative -> CaseAlternative
@@ -366,10 +366,10 @@ deriveGenericRep mn syns ds tyConNm tyConArgs repTy = do
     toRepTy ctors = foldr1 (\f -> TypeApp (TypeApp sumCtor f)) ctors
 
     toName :: Expr
-    toName = Var (Qualified (Just dataGenericRep) (Ident "to"))
+    toName = Var nullSourceSpan (Qualified (Just dataGenericRep) (Ident "to"))
 
     fromName :: Expr
-    fromName = Var (Qualified (Just dataGenericRep) (Ident "from"))
+    fromName = Var nullSourceSpan (Qualified (Just dataGenericRep) (Ident "from"))
 
     noCtors :: Type
     noCtors = TypeConstructor (Qualified (Just dataGenericRep) (ProperName "NoConstructors"))
@@ -378,7 +378,7 @@ deriveGenericRep mn syns ds tyConNm tyConArgs repTy = do
     noArgs = TypeConstructor (Qualified (Just dataGenericRep) (ProperName "NoArguments"))
 
     noArgs' :: Expr
-    noArgs' = Constructor (Qualified (Just dataGenericRep) (ProperName "NoArguments"))
+    noArgs' = Constructor nullSourceSpan (Qualified (Just dataGenericRep) (ProperName "NoArguments"))
 
     sumCtor :: Type
     sumCtor = TypeConstructor (Qualified (Just dataGenericRep) (ProperName "Sum"))
@@ -396,13 +396,13 @@ deriveGenericRep mn syns ds tyConNm tyConArgs repTy = do
     constructor = Qualified (Just dataGenericRep) (ProperName "Constructor")
 
     constructor' :: Expr -> Expr
-    constructor' = App (Constructor constructor)
+    constructor' = App (Constructor nullSourceSpan constructor)
 
     argument :: Qualified (ProperName ty)
     argument = Qualified (Just dataGenericRep) (ProperName "Argument")
 
     argument' :: Expr -> Expr
-    argument' = App (Constructor argument)
+    argument' = App (Constructor nullSourceSpan argument)
 
 checkIsWildcard :: MonadError MultipleErrors m => ProperName 'TypeName -> Type -> m ()
 checkIsWildcard _ (TypeWildcard _) = return ()
@@ -431,10 +431,10 @@ deriveEq ss mn syns ds tyConNm = do
     mkEqFunction _ = internalError "mkEqFunction: expected DataDeclaration"
 
     preludeConj :: Expr -> Expr -> Expr
-    preludeConj = App . App (Var (Qualified (Just (ModuleName [ProperName "Data", ProperName "HeytingAlgebra"])) (Ident C.conj)))
+    preludeConj = App . App (Var nullSourceSpan (Qualified (Just (ModuleName [ProperName "Data", ProperName "HeytingAlgebra"])) (Ident C.conj)))
 
     preludeEq :: Expr -> Expr -> Expr
-    preludeEq = App . App (Var (Qualified (Just dataEq) (Ident C.eq)))
+    preludeEq = App . App (Var nullSourceSpan (Qualified (Just dataEq) (Ident C.eq)))
 
     addCatch :: [CaseAlternative] -> [CaseAlternative]
     addCatch xs
@@ -448,10 +448,10 @@ deriveEq ss mn syns ds tyConNm = do
       identsL <- replicateM (length tys) (freshIdent "l")
       identsR <- replicateM (length tys) (freshIdent "r")
       tys' <- mapM (replaceAllTypeSynonymsM syns) tys
-      let tests = zipWith3 toEqTest (map (Var . Qualified Nothing) identsL) (map (Var . Qualified Nothing) identsR) tys'
+      let tests = zipWith3 toEqTest (map (Var nullSourceSpan . Qualified Nothing) identsL) (map (Var nullSourceSpan . Qualified Nothing) identsR) tys'
       return $ CaseAlternative [caseBinder identsL, caseBinder identsR] (unguarded (conjAll tests))
       where
-      caseBinder idents = ConstructorBinder (Qualified (Just mn) ctorName) (map VarBinder idents)
+      caseBinder idents = ConstructorBinder nullSourceSpan (Qualified (Just mn) ctorName) (map (VarBinder nullSourceSpan) idents)
 
     conjAll :: [Expr] -> Expr
     conjAll [] = Literal (BooleanLiteral True)
@@ -502,26 +502,26 @@ deriveOrd ss mn syns ds tyConNm = do
     orderingName = Qualified (Just (ModuleName [ProperName "Data", ProperName "Ordering"])) . ProperName
 
     orderingCtor :: Text -> Expr
-    orderingCtor = Constructor . orderingName
+    orderingCtor = Constructor nullSourceSpan . orderingName
 
     orderingBinder :: Text -> Binder
-    orderingBinder name = ConstructorBinder (orderingName name) []
+    orderingBinder name = ConstructorBinder nullSourceSpan (orderingName name) []
 
     ordCompare :: Expr -> Expr -> Expr
-    ordCompare = App . App (Var (Qualified (Just dataOrd) (Ident C.compare)))
+    ordCompare = App . App (Var nullSourceSpan (Qualified (Just dataOrd) (Ident C.compare)))
 
     mkCtorClauses :: ((ProperName 'ConstructorName, [Type]), Bool) -> m [CaseAlternative]
     mkCtorClauses ((ctorName, tys), isLast) = do
       identsL <- replicateM (length tys) (freshIdent "l")
       identsR <- replicateM (length tys) (freshIdent "r")
       tys' <- mapM (replaceAllTypeSynonymsM syns) tys
-      let tests = zipWith3 toOrdering (map (Var . Qualified Nothing) identsL) (map (Var . Qualified Nothing) identsR) tys'
-          extras | not isLast = [ CaseAlternative [ ConstructorBinder (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)
+      let tests = zipWith3 toOrdering (map (Var nullSourceSpan . Qualified Nothing) identsL) (map (Var nullSourceSpan . Qualified Nothing) identsR) tys'
+          extras | not isLast = [ CaseAlternative [ ConstructorBinder nullSourceSpan (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)
                                                   , NullBinder
                                                   ]
                                                   (unguarded (orderingCtor "LT"))
                                 , CaseAlternative [ NullBinder
-                                                  , ConstructorBinder (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)
+                                                  , ConstructorBinder nullSourceSpan (Qualified (Just mn) ctorName) (replicate (length tys) NullBinder)
                                                   ]
                                                   (unguarded (orderingCtor "GT"))
                                 ]
@@ -533,7 +533,7 @@ deriveOrd ss mn syns ds tyConNm = do
              : extras
 
       where
-      caseBinder idents = ConstructorBinder (Qualified (Just mn) ctorName) (map VarBinder idents)
+      caseBinder idents = ConstructorBinder nullSourceSpan (Qualified (Just mn) ctorName) (map (VarBinder nullSourceSpan) idents)
 
     appendAll :: [Expr] -> Expr
     appendAll [] = orderingCtor "EQ"
@@ -579,12 +579,12 @@ deriveNewtype mn syns ds tyConNm tyConArgs unwrappedTy = do
       ty' <- replaceAllTypeSynonymsM syns ty
       let inst =
             [ ValueDecl (ss, []) (Ident "wrap") Public [] $ unguarded $
-                Constructor (Qualified (Just mn) ctorName)
+                Constructor nullSourceSpan (Qualified (Just mn) ctorName)
             , ValueDecl (ss, []) (Ident "unwrap") Public [] $ unguarded $
                 lamCase wrappedIdent
                   [ CaseAlternative
-                      [ConstructorBinder (Qualified (Just mn) ctorName) [VarBinder unwrappedIdent]]
-                      (unguarded (Var (Qualified Nothing unwrappedIdent)))
+                      [ConstructorBinder nullSourceSpan (Qualified (Just mn) ctorName) [VarBinder nullSourceSpan unwrappedIdent]]
+                      (unguarded (Var nullSourceSpan (Qualified Nothing unwrappedIdent)))
                   ]
             ]
           subst = zipWith ((,) . fst) args tyConArgs
@@ -603,7 +603,7 @@ findTypeDecl tyConNm = maybe (throwError . errorMessage $ CannotFindDerivingType
   isTypeDecl _ = False
 
 lam :: Ident -> Expr -> Expr
-lam = Abs . VarBinder
+lam = Abs . VarBinder nullSourceSpan
 
 lamCase :: Ident -> [CaseAlternative] -> Expr
 lamCase s = lam s . Case [mkVar s]
@@ -612,7 +612,7 @@ lamCase2 :: Ident -> Ident -> [CaseAlternative] -> Expr
 lamCase2 s t = lam s . lam t . Case [mkVar s, mkVar t]
 
 mkVarMn :: Maybe ModuleName -> Ident -> Expr
-mkVarMn mn = Var . Qualified mn
+mkVarMn mn = Var nullSourceSpan . Qualified mn
 
 mkVar :: Ident -> Expr
 mkVar = mkVarMn Nothing
@@ -660,9 +660,9 @@ deriveFunctor ss mn syns ds tyConNm = do
       idents <- replicateM (length ctorTys) (freshIdent "v")
       ctorTys' <- mapM (replaceAllTypeSynonymsM syns) ctorTys
       args <- zipWithM transformArg idents ctorTys'
-      let ctor = Constructor (Qualified (Just mn) ctorName)
+      let ctor = Constructor nullSourceSpan (Qualified (Just mn) ctorName)
           rebuilt = foldl' App ctor args
-          caseBinder = ConstructorBinder (Qualified (Just mn) ctorName) (VarBinder <$> idents)
+          caseBinder = ConstructorBinder nullSourceSpan (Qualified (Just mn) ctorName) (VarBinder nullSourceSpan <$> idents)
       return $ CaseAlternative [caseBinder] (unguarded rebuilt)
       where
         fVar = mkVar f
diff --git a/src/Language/PureScript/TypeChecker/Entailment.hs b/src/Language/PureScript/TypeChecker/Entailment.hs
index 928e157d19..823a3b47f4 100644
--- a/src/Language/PureScript/TypeChecker/Entailment.hs
+++ b/src/Language/PureScript/TypeChecker/Entailment.hs
@@ -209,7 +209,7 @@ entails SolverOptions{..} constraint context hints =
     findDicts ctx cn = fmap (fmap NamedInstance) . maybe [] M.elems . (>>= M.lookup cn) . flip M.lookup ctx
 
     valUndefined :: Expr
-    valUndefined = Var (Qualified (Just (ModuleName [ProperName C.prim])) (Ident C.undefined))
+    valUndefined = Var nullSourceSpan (Qualified (Just (ModuleName [ProperName C.prim])) (Ident C.undefined))
 
     solve :: Constraint -> WriterT (Any, [(Ident, InstanceContext, Constraint)]) (StateT InstanceContext m) Expr
     solve con = go 0 con
@@ -280,7 +280,7 @@ entails SolverOptions{..} constraint context hints =
                 modify (combineContexts newContext)
                 -- Mark this constraint for generalization
                 tell (mempty, [(ident, context, unsolved)])
-                return (Var qident)
+                return (Var nullSourceSpan qident)
               Deferred ->
                 -- Constraint was deferred, just return the dictionary unchanged,
                 -- with no unsolved constraints. Hopefully, we can solve this later.
@@ -357,10 +357,10 @@ entails SolverOptions{..} constraint context hints =
 
             -- Make a dictionary from subgoal dictionaries by applying the correct function
             mkDictionary :: Evidence -> Maybe [Expr] -> m Expr
-            mkDictionary (NamedInstance n) args = return $ foldl App (Var n) (fold args)
+            mkDictionary (NamedInstance n) args = return $ foldl App (Var nullSourceSpan n) (fold args)
             mkDictionary UnionInstance (Just [e]) =
               -- We need the subgoal dictionary to appear in the term somewhere
-              return $ App (Abs (VarBinder UnusedIdent) valUndefined) e
+              return $ App (Abs (VarBinder nullSourceSpan UnusedIdent) valUndefined) e
             mkDictionary UnionInstance _ = return valUndefined
             mkDictionary ConsInstance _ = return valUndefined
             mkDictionary RowToListInstance _ = return valUndefined
@@ -371,7 +371,7 @@ entails SolverOptions{..} constraint context hints =
               -- So pass an empty placeholder (undefined) instead.
               return valUndefined
             mkDictionary (IsSymbolInstance sym) _ =
-              let fields = [ ("reflectSymbol", Abs (VarBinder UnusedIdent) (Literal (StringLiteral sym))) ] in
+              let fields = [ ("reflectSymbol", Abs (VarBinder nullSourceSpan UnusedIdent) (Literal (StringLiteral sym))) ] in
               return $ TypeClassDictionaryConstructorApp C.IsSymbol (Literal (ObjectLiteral fields))
             mkDictionary CompareSymbolInstance _ =
               return $ TypeClassDictionaryConstructorApp C.CompareSymbol (Literal (ObjectLiteral []))
@@ -399,7 +399,7 @@ entails SolverOptions{..} constraint context hints =
       lhs <- stripSuffix rhs' out'
       pure (TypeLevelString (mkString lhs), arg1, arg2)
     appendSymbols _ _ _ = Nothing
-    
+
     consSymbol :: Type -> Type -> Type -> Maybe (Type, Type, Type)
     consSymbol _ _ arg@(TypeLevelString s) = do
       (h, t) <- T.uncons =<< decodeString s
diff --git a/src/Language/PureScript/TypeChecker/TypeSearch.hs b/src/Language/PureScript/TypeChecker/TypeSearch.hs
index ae550330c4..225410ab5b 100644
--- a/src/Language/PureScript/TypeChecker/TypeSearch.hs
+++ b/src/Language/PureScript/TypeChecker/TypeSearch.hs
@@ -59,7 +59,7 @@ checkSubsume unsolved env st userT envT = checkInEnvironment env st $ do
   userT' <- initializeSkolems userT
   envT' <- initializeSkolems envT
 
-  let dummyExpression = P.Var (P.Qualified Nothing (P.Ident "x"))
+  let dummyExpression = P.Var nullSourceSpan (P.Qualified Nothing (P.Ident "x"))
 
   elab <- subsumes envT' userT'
   subst <- gets TC.checkSubstitution
diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs
index f96771a8b0..309111f9fa 100644
--- a/src/Language/PureScript/TypeChecker/Types.hs
+++ b/src/Language/PureScript/TypeChecker/Types.hs
@@ -122,7 +122,7 @@ typesOf bindingGroupType moduleName vals = withFreshSubstitution $ do
 
       -- Check skolem variables did not escape their scope
       skolemEscapeCheck val'
-      return ((sai, (foldr (Abs . VarBinder . (\(x, _, _) -> x)) val' unsolved, generalized)), unsolved)
+      return ((sai, (foldr (Abs . VarBinder nullSourceSpan . (\(x, _, _) -> x)) val' unsolved, generalized)), unsolved)
 
     -- Show warnings here, since types in wildcards might have been solved during
     -- instance resolution (by functional dependencies).
@@ -353,27 +353,27 @@ infer' (Accessor prop val) = withErrorMessageHint (ErrorCheckingAccessor val pro
   typed <- check val (TypeApp tyRecord (RCons (Label prop) field rest))
   return $ TypedValue True (Accessor prop typed) field
 infer' (Abs binder ret)
-  | VarBinder arg <- binder = do
+  | VarBinder ss arg <- binder = do
       ty <- freshType
       withBindingGroupVisible $ bindLocalVariables [(arg, ty, Defined)] $ do
         body@(TypedValue _ _ bodyTy) <- infer' ret
         (body', bodyTy') <- instantiatePolyTypeWithUnknowns body bodyTy
-        return $ TypedValue True (Abs (VarBinder arg) body') (function ty bodyTy')
+        return $ TypedValue True (Abs (VarBinder ss arg) body') (function ty bodyTy')
   | otherwise = internalError "Binder was not desugared"
 infer' (App f arg) = do
   f'@(TypedValue _ _ ft) <- infer f
   (ret, app) <- checkFunctionApplication f' ft arg
   return $ TypedValue True app ret
-infer' (Var var) = do
+infer' (Var ss var) = do
   checkVisibility var
   ty <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards <=< lookupVariable $ var
   case ty of
     ConstrainedType con ty' -> do
       dicts <- getTypeClassDictionaries
       hints <- getHints
-      return $ TypedValue True (App (Var var) (TypeClassDictionary con dicts hints)) ty'
-    _ -> return $ TypedValue True (Var var) ty
-infer' v@(Constructor c) = do
+      return $ TypedValue True (App (Var ss var) (TypeClassDictionary con dicts hints)) ty'
+    _ -> return $ TypedValue True (Var ss var) ty
+infer' v@(Constructor _ c) = do
   env <- getEnv
   case M.lookup c (dataConstructors env) of
     Nothing -> throwError . errorMessage . UnknownName . fmap DctorName $ c
@@ -435,7 +435,7 @@ inferLetBinding seen (ValueDecl sa@(ss, _) ident nameKind [] [MkUnguarded tv@(Ty
     let dict = M.singleton (Qualified Nothing ident) (ty, nameKind, Undefined)
     ty' <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ ty
     TypedValue _ val' ty'' <- if checkType then withScopedTypeVars moduleName args (bindNames dict (check val ty')) else return tv
-    bindNames (M.singleton (Qualified Nothing ident) (ty'', nameKind, Defined)) 
+    bindNames (M.singleton (Qualified Nothing ident) (ty'', nameKind, Defined))
       $ inferLetBinding (seen ++ [ValueDecl sa ident nameKind [] [MkUnguarded (TypedValue checkType val' ty'')]]) rest ret j
 inferLetBinding seen (ValueDecl sa@(ss, _) ident nameKind [] [MkUnguarded val] : rest) ret j =
   warnAndRethrowWithPositionTC ss $ do
@@ -443,7 +443,7 @@ inferLetBinding seen (ValueDecl sa@(ss, _) ident nameKind [] [MkUnguarded val] :
     let dict = M.singleton (Qualified Nothing ident) (valTy, nameKind, Undefined)
     TypedValue _ val' valTy' <- bindNames dict $ infer val
     unifyTypes valTy valTy'
-    bindNames (M.singleton (Qualified Nothing ident) (valTy', nameKind, Defined)) 
+    bindNames (M.singleton (Qualified Nothing ident) (valTy', nameKind, Defined))
       $ inferLetBinding (seen ++ [ValueDecl sa ident nameKind [] [MkUnguarded val']]) rest ret j
 inferLetBinding seen (BindingGroupDeclaration ds : rest) ret j = do
   Just moduleName <- checkCurrentModule <$> get
@@ -469,8 +469,8 @@ inferBinder val (LiteralBinder (CharLiteral _)) = unifyTypes val tyChar >> retur
 inferBinder val (LiteralBinder (NumericLiteral (Left _))) = unifyTypes val tyInt >> return M.empty
 inferBinder val (LiteralBinder (NumericLiteral (Right _))) = unifyTypes val tyNumber >> return M.empty
 inferBinder val (LiteralBinder (BooleanLiteral _)) = unifyTypes val tyBoolean >> return M.empty
-inferBinder val (VarBinder name) = return $ M.singleton name val
-inferBinder val (ConstructorBinder ctor binders) = do
+inferBinder val (VarBinder _ name) = return $ M.singleton name val
+inferBinder val (ConstructorBinder ss ctor binders) = do
   env <- getEnv
   case M.lookup ctor (dataConstructors env) of
     Just (_, _, ty, _) -> do
@@ -480,7 +480,7 @@ inferBinder val (ConstructorBinder ctor binders) = do
       unless (length args == length binders) . throwError . errorMessage $ IncorrectConstructorArity ctor
       unifyTypes ret val
       M.unions <$> zipWithM inferBinder (reverse args) binders
-    _ -> throwError . errorMessage . UnknownName . fmap DctorName $ ctor
+    _ -> throwError . errorMessage' ss . UnknownName . fmap DctorName $ ctor
   where
   peelArgs :: Type -> ([Type], Type)
   peelArgs = go []
@@ -506,9 +506,10 @@ inferBinder val (LiteralBinder (ArrayLiteral binders)) = do
   m1 <- M.unions <$> traverse (inferBinder el) binders
   unifyTypes val (TypeApp tyArray el)
   return m1
-inferBinder val (NamedBinder name binder) = do
-  m <- inferBinder val binder
-  return $ M.insert name val m
+inferBinder val (NamedBinder ss name binder) =
+  warnAndRethrowWithPositionTC ss $ do
+    m <- inferBinder val binder
+    return $ M.insert name val m
 inferBinder val (PositionedBinder pos _ binder) =
   warnAndRethrowWithPositionTC pos $ inferBinder val binder
 inferBinder val (TypedBinder ty binder) = do
@@ -528,8 +529,8 @@ inferBinder _ ParensInBinder{} =
 -- | If this is the case, we need to instantiate any polymorphic types before checking binders.
 binderRequiresMonotype :: Binder -> Bool
 binderRequiresMonotype NullBinder = False
-binderRequiresMonotype (VarBinder _) = False
-binderRequiresMonotype (NamedBinder _ b) = binderRequiresMonotype b
+binderRequiresMonotype (VarBinder _ _) = False
+binderRequiresMonotype (NamedBinder _ _ b) = binderRequiresMonotype b
 binderRequiresMonotype (PositionedBinder _ _ b) = binderRequiresMonotype b
 binderRequiresMonotype (TypedBinder ty b) = isMonoType ty || binderRequiresMonotype b
 binderRequiresMonotype _ = True
@@ -622,7 +623,7 @@ check' val t@(ConstrainedType con@(Constraint (Qualified _ (ProperName className
   dictName <- freshIdent ("dict" <> className)
   dicts <- newDictionaries [] (Qualified Nothing dictName) con
   val' <- withBindingGroupVisible $ withTypeClassDictionaries dicts $ check val ty
-  return $ TypedValue True (Abs (VarBinder dictName) val') t
+  return $ TypedValue True (Abs (VarBinder nullSourceSpan dictName) val') t
 check' val u@(TUnknown _) = do
   val'@(TypedValue _ _ ty) <- infer val
   -- Don't unify an unknown with an inferred polytype
@@ -644,17 +645,17 @@ check' (Literal (ArrayLiteral vals)) t@(TypeApp a ty) = do
   array <- Literal . ArrayLiteral <$> forM vals (`check` ty)
   return $ TypedValue True array t
 check' (Abs binder ret) ty@(TypeApp (TypeApp t argTy) retTy)
-  | VarBinder arg <- binder = do
+  | VarBinder ss arg <- binder = do
       unifyTypes t tyFunction
       ret' <- withBindingGroupVisible $ bindLocalVariables [(arg, argTy, Defined)] $ check ret retTy
-      return $ TypedValue True (Abs (VarBinder arg) ret') ty
+      return $ TypedValue True (Abs (VarBinder ss arg) ret') ty
   | otherwise = internalError "Binder was not desugared"
 check' (App f arg) ret = do
   f'@(TypedValue _ _ ft) <- infer f
   (retTy, app) <- checkFunctionApplication f' ft arg
   elaborate <- subsumes retTy ret
   return $ TypedValue True (elaborate app) ret
-check' v@(Var var) ty = do
+check' v@(Var _ var) ty = do
   checkVisibility var
   repl <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< lookupVariable $ var
   ty' <- introduceSkolemScope <=< replaceAllTypeSynonyms <=< replaceTypeWildcards $ ty
@@ -712,7 +713,7 @@ check' (Accessor prop val) ty = withErrorMessageHint (ErrorCheckingAccessor val
   rest <- freshType
   val' <- check val (TypeApp tyRecord (RCons (Label prop) ty rest))
   return $ TypedValue True (Accessor prop val') ty
-check' v@(Constructor c) ty = do
+check' v@(Constructor _ c) ty = do
   env <- getEnv
   case M.lookup c (dataConstructors env) of
     Nothing -> throwError . errorMessage . UnknownName . fmap DctorName $ c