Support generating HIE files

Adds a `-fenable-ide-info` flag which instructs GHC to generate `.hie`
files (see the wiki page:
https://ghc.haskell.org/trac/ghc/wiki/HIEFiles).

This is a rebased version of Zubin Duggal's (@wz1000) GHC changes for
his GSOC project, as posted here:
https://gist.github.com/wz1000/5ed4ddd0d3e96d6bc75e095cef95363d.

Test Plan: ./validate

Reviewers: bgamari, gershomb, nomeata, alanz, sjakobi

Reviewed By: alanz, sjakobi

Subscribers: alanz, hvr, sjakobi, rwbarton, wz1000, carter

Differential Revision: https://phabricator.haskell.org/D5239

17 files changed, 3295 insertions, 52 deletions

diff --git a/compiler/backpack/DriverBkp.hs b/compiler/backpack/DriverBkp.hs
index 7784df2ff5..e10d6d1de1 100644
--- a/compiler/backpack/DriverBkp.hs
+++ b/compiler/backpack/DriverBkp.hs
@@ -677,6 +677,7 @@ summariseRequirement pn mod_name = do
     env <- getBkpEnv
     time <- liftIO $ getModificationUTCTime (bkp_filename env)
     hi_timestamp <- liftIO $ modificationTimeIfExists (ml_hi_file location)
+    hie_timestamp <- liftIO $ modificationTimeIfExists (ml_hie_file location)
     let loc = srcLocSpan (mkSrcLoc (mkFastString (bkp_filename env)) 1 1)
 
     mod <- liftIO $ addHomeModuleToFinder hsc_env mod_name location
@@ -690,6 +691,7 @@ summariseRequirement pn mod_name = do
         ms_hs_date = time,
         ms_obj_date = Nothing,
         ms_iface_date = hi_timestamp,
+        ms_hie_date = hie_timestamp,
         ms_srcimps = [],
         ms_textual_imps = extra_sig_imports,
         ms_parsed_mod = Just (HsParsedModule {
@@ -765,12 +767,13 @@ hsModuleToModSummary pn hsc_src modname
                                 HsSrcFile -> "hs")
     -- DANGEROUS: bootifying can POISON the module finder cache
     let location = case hsc_src of
-                        HsBootFile -> addBootSuffixLocn location0
+                        HsBootFile -> addBootSuffixLocnOut location0
                         _ -> location0
     -- This duplicates a pile of logic in GhcMake
     env <- getBkpEnv
     time <- liftIO $ getModificationUTCTime (bkp_filename env)
     hi_timestamp <- liftIO $ modificationTimeIfExists (ml_hi_file location)
+    hie_timestamp <- liftIO $ modificationTimeIfExists (ml_hie_file location)
 
     -- Also copied from 'getImports'
     let (src_idecls, ord_idecls) = partition (ideclSource.unLoc) imps
@@ -815,7 +818,8 @@ hsModuleToModSummary pn hsc_src modname
                 }),
             ms_hs_date = time,
             ms_obj_date = Nothing, -- TODO do this, but problem: hi_timestamp is BOGUS
-            ms_iface_date = hi_timestamp
+            ms_iface_date = hi_timestamp,
+            ms_hie_date = hie_timestamp
         }
 
 -- | Create a new, externally provided hashed unit id from
diff --git a/compiler/basicTypes/Module.hs b/compiler/basicTypes/Module.hs
index 98476a3131..45fd4c19b5 100644
--- a/compiler/basicTypes/Module.hs
+++ b/compiler/basicTypes/Module.hs
@@ -112,7 +112,8 @@ module Module
 
         -- * The ModuleLocation type
         ModLocation(..),
-        addBootSuffix, addBootSuffix_maybe, addBootSuffixLocn,
+        addBootSuffix, addBootSuffix_maybe,
+        addBootSuffixLocn, addBootSuffixLocnOut,
 
         -- * Module mappings
         ModuleEnv,
@@ -267,11 +268,12 @@ data ModLocation
                 -- yet.  Always of form foo.hi, even if there is an
                 -- hi-boot file (we add the -boot suffix later)
 
-        ml_obj_file  :: FilePath
+        ml_obj_file  :: FilePath,
                 -- Where the .o file is, whether or not it exists yet.
                 -- (might not exist either because the module hasn't
                 -- been compiled yet, or because it is part of a
                 -- package with a .a file)
+        ml_hie_file  :: FilePath
   } deriving Show
 
 instance Outputable ModLocation where
@@ -302,7 +304,16 @@ addBootSuffixLocn :: ModLocation -> ModLocation
 addBootSuffixLocn locn
   = locn { ml_hs_file  = fmap addBootSuffix (ml_hs_file locn)
          , ml_hi_file  = addBootSuffix (ml_hi_file locn)
-         , ml_obj_file = addBootSuffix (ml_obj_file locn) }
+         , ml_obj_file = addBootSuffix (ml_obj_file locn)
+         , ml_hie_file = addBootSuffix (ml_hie_file locn) }
+
+addBootSuffixLocnOut :: ModLocation -> ModLocation
+-- ^ Add the @-boot@ suffix to all output file paths associated with the
+-- module, not including the input file itself
+addBootSuffixLocnOut locn
+  = locn { ml_hi_file  = addBootSuffix (ml_hi_file locn)
+         , ml_obj_file = addBootSuffix (ml_obj_file locn)
+         , ml_hie_file = addBootSuffix (ml_hie_file locn) }
 
 {-
 ************************************************************************
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index a99c6e7526..7f84cac192 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -170,6 +170,7 @@ Library
         typecheck
         types
         utils
+        hieFile
 
     -- we use an explicit Prelude
     Default-Extensions:
@@ -179,6 +180,11 @@ Library
         GhcPrelude
 
     Exposed-Modules:
+        HieTypes
+        HieDebug
+        HieBin
+        HieUtils
+        HieAst
         Ar
         FileCleanup
         DriverBkp
diff --git a/compiler/hieFile/HieAst.hs b/compiler/hieFile/HieAst.hs
new file mode 100644
index 0000000000..6fcc9243f8
--- /dev/null
+++ b/compiler/hieFile/HieAst.hs
@@ -0,0 +1,1713 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+module HieAst ( mkHieFile ) where
+
+import GhcPrelude
+
+import Avail                      ( Avails )
+import Bag                        ( Bag, bagToList )
+import BasicTypes
+import BooleanFormula
+import Class                      ( FunDep )
+import CoreUtils                  ( exprType )
+import ConLike                    ( conLikeName )
+import Config                     ( cProjectVersion )
+import Desugar                    ( deSugarExpr )
+import FieldLabel
+import HsSyn
+import HscTypes
+import Module                     ( ModuleName, ml_hs_file )
+import MonadUtils                 ( concatMapM, liftIO )
+import Name                       ( Name, nameSrcSpan, setNameLoc )
+import SrcLoc
+import TcHsSyn                    ( hsPatType )
+import Type                       ( Type )
+import Var                        ( Id, Var, setVarName, varName, varType )
+
+import HieTypes
+import HieUtils
+
+import qualified Data.Array as A
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BSC
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Data.Data                  ( Data, Typeable )
+import Data.List                  ( foldl1' )
+import Data.Maybe                 ( listToMaybe )
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans.Class  ( lift )
+
+-- These synonyms match those defined in main/GHC.hs
+type RenamedSource     = ( HsGroup GhcRn, [LImportDecl GhcRn]
+                         , Maybe [(LIE GhcRn, Avails)]
+                         , Maybe LHsDocString )
+type TypecheckedSource = LHsBinds GhcTc
+
+
+{- Note [Name Remapping]
+The Typechecker introduces new names for mono names in AbsBinds.
+We don't care about the distinction between mono and poly bindings,
+so we replace all occurrences of the mono name with the poly name.
+-}
+newtype HieState = HieState
+  { name_remapping :: M.Map Name Id
+  }
+
+initState :: HieState
+initState = HieState M.empty
+
+class ModifyState a where -- See Note [Name Remapping]
+  addSubstitution :: a -> a -> HieState -> HieState
+
+instance ModifyState Name where
+  addSubstitution _ _ hs = hs
+
+instance ModifyState Id where
+  addSubstitution mono poly hs =
+    hs{name_remapping = M.insert (varName mono) poly (name_remapping hs)}
+
+modifyState :: ModifyState (IdP p) => [ABExport p] -> HieState -> HieState
+modifyState = foldr go id
+  where
+    go ABE{abe_poly=poly,abe_mono=mono} f = addSubstitution mono poly . f
+    go _ f = f
+
+type HieM = ReaderT HieState Hsc
+
+-- | Construct an 'HieFile' from the outputs of the typechecker.
+mkHieFile :: ModSummary -> TypecheckedSource -> RenamedSource -> Hsc HieFile
+mkHieFile ms ts rs = do
+  (asts', arr) <- getCompressedAsts ts rs
+  let Just src_file = ml_hs_file $ ms_location ms
+  src <- liftIO $ BS.readFile src_file
+  return $ HieFile
+      { hie_version = curHieVersion
+      , hie_ghc_version = BSC.pack cProjectVersion
+      , hie_hs_file = src_file
+      , hie_types = arr
+      , hie_asts = asts'
+      , hie_hs_src = src
+      }
+
+getCompressedAsts :: TypecheckedSource -> RenamedSource
+  -> Hsc (HieASTs TypeIndex, A.Array TypeIndex HieTypeFlat)
+getCompressedAsts ts rs = do
+  asts <- enrichHie ts rs
+  return $ compressTypes asts
+
+enrichHie :: TypecheckedSource -> RenamedSource -> Hsc (HieASTs Type)
+enrichHie ts (hsGrp, imports, exports, _) = flip runReaderT initState $ do
+    tasts <- toHie $ fmap (BC RegularBind ModuleScope) ts
+    rasts <- processGrp hsGrp
+    imps <- toHie $ filter (not . ideclImplicit . unLoc) imports
+    exps <- toHie $ fmap (map $ IEC Export . fst) exports
+    let spanFile children = case children of
+          [] -> mkRealSrcSpan (mkRealSrcLoc "" 1 1) (mkRealSrcLoc "" 1 1)
+          _ -> mkRealSrcSpan (realSrcSpanStart $ nodeSpan $ head children)
+                             (realSrcSpanEnd   $ nodeSpan $ last children)
+
+        modulify xs =
+          Node (simpleNodeInfo "Module" "Module") (spanFile xs) xs
+
+        asts = HieASTs
+          $ resolveTyVarScopes
+          $ M.map (modulify . mergeSortAsts)
+          $ M.fromListWith (++)
+          $ map (\x -> (srcSpanFile (nodeSpan x),[x])) flat_asts
+
+        flat_asts = concat
+          [ tasts
+          , rasts
+          , imps
+          , exps
+          ]
+    return asts
+  where
+    processGrp grp = concatM
+      [ toHie $ fmap (RS ModuleScope ) hs_valds grp
+      , toHie $ hs_splcds grp
+      , toHie $ hs_tyclds grp
+      , toHie $ hs_derivds grp
+      , toHie $ hs_fixds grp
+      , toHie $ hs_defds grp
+      , toHie $ hs_fords grp
+      , toHie $ hs_warnds grp
+      , toHie $ hs_annds grp
+      , toHie $ hs_ruleds grp
+      ]
+
+getRealSpan :: SrcSpan -> Maybe Span
+getRealSpan (RealSrcSpan sp) = Just sp
+getRealSpan _ = Nothing
+
+grhss_span :: GRHSs p body -> SrcSpan
+grhss_span (GRHSs _ xs bs) = foldl' combineSrcSpans (getLoc bs) (map getLoc xs)
+grhss_span (XGRHSs _) = error "XGRHS has no span"
+
+bindingsOnly :: [Context Name] -> [HieAST a]
+bindingsOnly [] = []
+bindingsOnly (C c n : xs) = case nameSrcSpan n of
+  RealSrcSpan span -> Node nodeinfo span [] : bindingsOnly xs
+    where nodeinfo = NodeInfo S.empty [] (M.singleton (Right n) info)
+          info = mempty{identInfo = S.singleton c}
+  _ -> bindingsOnly xs
+
+concatM :: Monad m => [m [a]] -> m [a]
+concatM xs = concat <$> sequence xs
+
+{- Note [Capturing Scopes and other non local information]
+toHie is a local tranformation, but scopes of bindings cannot be known locally,
+hence we have to push the relevant info down into the binding nodes.
+We use the following types (*Context and *Scoped) to wrap things and
+carry the required info
+(Maybe Span) always carries the span of the entire binding, including rhs
+-}
+data Context a = C ContextInfo a -- Used for names and bindings
+
+data RContext a = RC RecFieldContext a
+data RFContext a = RFC RecFieldContext (Maybe Span) a
+-- ^ context for record fields
+
+data IEContext a = IEC IEType a
+-- ^ context for imports/exports
+
+data BindContext a = BC BindType Scope a
+-- ^ context for imports/exports
+
+data PatSynFieldContext a = PSC (Maybe Span) a
+-- ^ context for pattern synonym fields.
+
+data SigContext a = SC SigInfo a
+-- ^ context for type signatures
+
+data SigInfo = SI SigType (Maybe Span)
+
+data SigType = BindSig | ClassSig | InstSig
+
+data RScoped a = RS Scope a
+-- ^ Scope spans over everything to the right of a, (mostly) not
+-- including a itself
+-- (Includes a in a few special cases like recursive do bindings) or
+-- let/where bindings
+
+-- | Pattern scope
+data PScoped a = PS (Maybe Span)
+                    Scope       -- ^ use site of the pattern
+                    Scope       -- ^ pattern to the right of a, not including a
+                    a
+  deriving (Typeable, Data) -- Pattern Scope
+
+{- Note [TyVar Scopes]
+Due to -XScopedTypeVariables, type variables can be in scope quite far from
+their original binding. We resolve the scope of these type variables
+in a seperate pass
+-}
+data TScoped a = TS TyVarScope a -- TyVarScope
+
+data TVScoped a = TVS TyVarScope Scope a -- TyVarScope
+-- ^ First scope remains constant
+-- Second scope is used to build up the scope of a tyvar over
+-- things to its right, ala RScoped
+
+-- | Each element scopes over the elements to the right
+listScopes :: Scope -> [Located a] -> [RScoped (Located a)]
+listScopes _ [] = []
+listScopes rhsScope [pat] = [RS rhsScope pat]
+listScopes rhsScope (pat : pats) = RS sc pat : pats'
+  where
+    pats'@((RS scope p):_) = listScopes rhsScope pats
+    sc = combineScopes scope $ mkScope $ getLoc p
+
+-- | 'listScopes' specialised to 'PScoped' things
+patScopes
+  :: Maybe Span
+  -> Scope
+  -> Scope
+  -> [LPat (GhcPass p)]
+  -> [PScoped (LPat (GhcPass p))]
+patScopes rsp useScope patScope xs =
+  map (\(RS sc a) -> PS rsp useScope sc (unLoc a)) $
+    listScopes patScope (map dL xs)
+
+-- | 'listScopes' specialised to 'TVScoped' things
+tvScopes
+  :: TyVarScope
+  -> Scope
+  -> [LHsTyVarBndr a]
+  -> [TVScoped (LHsTyVarBndr a)]
+tvScopes tvScope rhsScope xs =
+  map (\(RS sc a)-> TVS tvScope sc a) $ listScopes rhsScope xs
+
+{- Note [Scoping Rules for SigPat]
+Explicitly quantified variables in pattern type signatures are not
+brought into scope in the rhs, but implicitly quantified variables
+are (HsWC and HsIB).
+This is unlike other signatures, where explicitly quantified variables
+are brought into the RHS Scope
+For example
+foo :: forall a. ...;
+foo = ... -- a is in scope here
+
+bar (x :: forall a. a -> a) = ... -- a is not in scope here
+--   ^ a is in scope here (pattern body)
+
+bax (x :: a) = ... -- a is in scope here
+Because of HsWC and HsIB pass on their scope to their children
+we must wrap the LHsType in pattern signatures in a
+Shielded explictly, so that the HsWC/HsIB scope is not passed
+on the the LHsType
+-}
+
+data Shielded a = SH Scope a -- Ignores its TScope, uses its own scope instead
+
+type family ProtectedSig a where
+  ProtectedSig GhcRn = HsWildCardBndrs GhcRn (HsImplicitBndrs
+                                                GhcRn
+                                                (Shielded (LHsType GhcRn)))
+  ProtectedSig GhcTc = NoExt
+
+class ProtectSig a where
+  protectSig :: Scope -> LHsSigWcType (NoGhcTc a) -> ProtectedSig a
+
+instance (HasLoc a) => HasLoc (Shielded a) where
+  loc (SH _ a) = loc a
+
+instance (ToHie (TScoped a)) => ToHie (TScoped (Shielded a)) where
+  toHie (TS _ (SH sc a)) = toHie (TS (ResolvedScopes [sc]) a)
+
+instance ProtectSig GhcTc where
+  protectSig _ _ = NoExt
+
+instance ProtectSig GhcRn where
+  protectSig sc (HsWC a (HsIB b sig)) =
+    HsWC a (HsIB b (SH sc sig))
+  protectSig _ _ = error "protectSig not given HsWC (HsIB)"
+
+class HasLoc a where
+  -- ^ defined so that HsImplicitBndrs and HsWildCardBndrs can
+  -- know what their implicit bindings are scoping over
+  loc :: a -> SrcSpan
+
+instance HasLoc thing => HasLoc (TScoped thing) where
+  loc (TS _ a) = loc a
+
+instance HasLoc thing => HasLoc (PScoped thing) where
+  loc (PS _ _ _ a) = loc a
+
+instance HasLoc (LHsQTyVars GhcRn) where
+  loc (HsQTvs _ vs) = loc vs
+  loc _ = noSrcSpan
+
+instance HasLoc thing => HasLoc (HsImplicitBndrs a thing) where
+  loc (HsIB _ a) = loc a
+  loc _ = noSrcSpan
+
+instance HasLoc thing => HasLoc (HsWildCardBndrs a thing) where
+  loc (HsWC _ a) = loc a
+  loc _ = noSrcSpan
+
+instance HasLoc (Located a) where
+  loc (L l _) = l
+
+instance HasLoc a => HasLoc [a] where
+  loc [] = noSrcSpan
+  loc xs = foldl1' combineSrcSpans $ map loc xs
+
+instance (HasLoc a, HasLoc b) => HasLoc (FamEqn s a b) where
+  loc (FamEqn _ a Nothing b _ c) = foldl1' combineSrcSpans [loc a, loc b, loc c]
+  loc (FamEqn _ a (Just tvs) b _ c) = foldl1' combineSrcSpans
+                                              [loc a, loc tvs, loc b, loc c]
+  loc _ = noSrcSpan
+
+instance HasLoc (HsDataDefn GhcRn) where
+  loc def@(HsDataDefn{}) = loc $ dd_cons def
+    -- Only used for data family instances, so we only need rhs
+    -- Most probably the rest will be unhelpful anyway
+  loc _ = noSrcSpan
+
+instance HasLoc (Pat (GhcPass a)) where
+  loc (dL -> L l _) = l
+
+-- | The main worker class
+class ToHie a where
+  toHie :: a -> HieM [HieAST Type]
+
+-- | Used to collect type info
+class Data a => HasType a where
+  getTypeNode :: a -> HieM [HieAST Type]
+
+instance (ToHie a) => ToHie [a] where
+  toHie = concatMapM toHie
+
+instance (ToHie a) => ToHie (Bag a) where
+  toHie = toHie . bagToList
+
+instance (ToHie a) => ToHie (Maybe a) where
+  toHie = maybe (pure []) toHie
+
+instance ToHie (Context (Located NoExt)) where
+  toHie _ = pure []
+
+instance ToHie (TScoped NoExt) where
+  toHie _ = pure []
+
+instance ToHie (IEContext (Located ModuleName)) where
+  toHie (IEC c (L (RealSrcSpan span) mname)) =
+      pure $ [Node (NodeInfo S.empty [] idents) span []]
+    where details = mempty{identInfo = S.singleton (IEThing c)}
+          idents = M.singleton (Left mname) details
+  toHie _ = pure []
+
+instance ToHie (Context (Located Var)) where
+  toHie c = case c of
+      C context (L (RealSrcSpan span) name')
+        -> do
+        m <- asks name_remapping
+        let name = M.findWithDefault name' (varName name') m
+        pure
+          [Node
+            (NodeInfo S.empty [] $
+              M.singleton (Right $ varName name)
+                          (IdentifierDetails (Just $ varType name')
+                                             (S.singleton context)))
+            span
+            []]
+      _ -> pure []
+
+instance ToHie (Context (Located Name)) where
+  toHie c = case c of
+      C context (L (RealSrcSpan span) name') -> do
+        m <- asks name_remapping
+        let name = case M.lookup name' m of
+              Just var -> varName var
+              Nothing -> name'
+        pure
+          [Node
+            (NodeInfo S.empty [] $
+              M.singleton (Right name)
+                          (IdentifierDetails Nothing
+                                             (S.singleton context)))
+            span
+            []]
+      _ -> pure []
+
+-- | Dummy instances - never called
+instance ToHie (TScoped (LHsSigWcType GhcTc)) where
+  toHie _ = pure []
+instance ToHie (TScoped (LHsWcType GhcTc)) where
+  toHie _ = pure []
+instance ToHie (SigContext (LSig GhcTc)) where
+  toHie _ = pure []
+instance ToHie (TScoped Type) where
+  toHie _ = pure []
+
+instance HasType (LHsBind GhcRn) where
+  getTypeNode (L spn bind) = makeNode bind spn
+
+instance HasType (LHsBind GhcTc) where
+  getTypeNode (L spn bind) = case bind of
+      FunBind{fun_id = name} -> makeTypeNode bind spn (varType $ unLoc name)
+      _ -> makeNode bind spn
+
+instance HasType (LPat GhcRn) where
+  getTypeNode (dL -> L spn pat) = makeNode pat spn
+
+instance HasType (LPat GhcTc) where
+  getTypeNode (dL -> L spn opat) = makeTypeNode opat spn (hsPatType opat)
+
+instance HasType (LHsExpr GhcRn) where
+  getTypeNode (L spn e) = makeNode e spn
+
+instance HasType (LHsExpr GhcTc) where
+  getTypeNode e@(L spn e') = lift $ do
+    hs_env <- Hsc $ \e w -> return (e,w)
+    (_,mbe) <- liftIO $ deSugarExpr hs_env e
+    case mbe of
+      Just te -> makeTypeNode e' spn (exprType te)
+      Nothing -> makeNode e' spn
+
+instance ( ToHie (Context (Located (IdP a)))
+         , ToHie (MatchGroup a (LHsExpr a))
+         , ToHie (PScoped (LPat a))
+         , ToHie (GRHSs a (LHsExpr a))
+         , ToHie (LHsExpr a)
+         , ToHie (Located (PatSynBind a a))
+         , HasType (LHsBind a)
+         , ModifyState (IdP a)
+         , Data (HsBind a)
+         ) => ToHie (BindContext (LHsBind a)) where
+  toHie (BC context scope b@(L span bind)) =
+    concatM $ getTypeNode b : case bind of
+      FunBind{fun_id = name, fun_matches = matches} ->
+        [ toHie $ C (ValBind context scope $ getRealSpan span) name
+        , toHie matches
+        ]
+      PatBind{pat_lhs = lhs, pat_rhs = rhs} ->
+        [ toHie $ PS (getRealSpan span) scope NoScope lhs
+        , toHie rhs
+        ]
+      VarBind{var_rhs = expr} ->
+        [ toHie expr
+        ]
+      AbsBinds{abs_exports = xs, abs_binds = binds} ->
+        [ local (modifyState xs) $ -- Note [Name Remapping]
+            toHie $ fmap (BC context scope) binds
+        ]
+      PatSynBind _ psb ->
+        [ toHie $ L span psb -- PatSynBinds only occur at the top level
+        ]
+      XHsBindsLR _ -> []
+
+instance ( ToHie (LMatch a body)
+         ) => ToHie (MatchGroup a body) where
+  toHie mg = concatM $ case mg of
+    MG{ mg_alts = (L span alts) , mg_origin = FromSource } ->
+      [ pure $ locOnly span
+      , toHie alts
+      ]
+    MG{} -> []
+    XMatchGroup _ -> []
+
+instance ( ToHie (Context (Located (IdP a)))
+         , ToHie (PScoped (LPat a))
+         , ToHie (HsPatSynDir a)
+         ) => ToHie (Located (PatSynBind a a)) where
+    toHie (L sp psb) = concatM $ case psb of
+      PSB{psb_id=var, psb_args=dets, psb_def=pat, psb_dir=dir} ->
+        [ toHie $ C (Decl PatSynDec $ getRealSpan sp) var
+        , toHie $ toBind dets
+        , toHie $ PS Nothing lhsScope NoScope pat
+        , toHie dir
+        ]
+        where
+          lhsScope = combineScopes varScope detScope
+          varScope = mkLScope var
+          detScope = case dets of
+            (PrefixCon args) -> foldr combineScopes NoScope $ map mkLScope args
+            (InfixCon a b) -> combineScopes (mkLScope a) (mkLScope b)
+            (RecCon r) -> foldr go NoScope r
+          go (RecordPatSynField a b) c = combineScopes c
+            $ combineScopes (mkLScope a) (mkLScope b)
+          detSpan = case detScope of
+            LocalScope a -> Just a
+            _ -> Nothing
+          toBind (PrefixCon args) = PrefixCon $ map (C Use) args
+          toBind (InfixCon a b) = InfixCon (C Use a) (C Use b)
+          toBind (RecCon r) = RecCon $ map (PSC detSpan) r
+      XPatSynBind _ -> []
+
+instance ( ToHie (MatchGroup a (LHsExpr a))
+         ) => ToHie (HsPatSynDir a) where
+  toHie dir = case dir of
+    ExplicitBidirectional mg -> toHie mg
+    _ -> pure []
+
+instance ( a ~ GhcPass p
+         , ToHie body
+         , ToHie (HsMatchContext (NameOrRdrName (IdP a)))
+         , ToHie (PScoped (LPat a))
+         , ToHie (GRHSs a body)
+         , Data (Match a body)
+         ) => ToHie (LMatch (GhcPass p) body) where
+  toHie (L span m ) = concatM $ makeNode m span : case m of
+    Match{m_ctxt=mctx, m_pats = pats, m_grhss =  grhss } ->
+      [ toHie mctx
+      , let rhsScope = mkScope $ grhss_span grhss
+          in toHie $ patScopes Nothing rhsScope NoScope pats
+      , toHie grhss
+      ]
+    XMatch _ -> []
+
+instance ( ToHie (Context (Located a))
+         ) => ToHie (HsMatchContext a) where
+  toHie (FunRhs{mc_fun=name}) = toHie $ C MatchBind name
+  toHie (StmtCtxt a) = toHie a
+  toHie _ = pure []
+
+instance ( ToHie (HsMatchContext a)
+         ) => ToHie (HsStmtContext a) where
+  toHie (PatGuard a) = toHie a
+  toHie (ParStmtCtxt a) = toHie a
+  toHie (TransStmtCtxt a) = toHie a
+  toHie _ = pure []
+
+instance ( a ~ GhcPass p
+         , ToHie (Context (Located (IdP a)))
+         , ToHie (RContext (HsRecFields a (PScoped (LPat a))))
+         , ToHie (LHsExpr a)
+         , ToHie (TScoped (LHsSigWcType a))
+         , ProtectSig a
+         , ToHie (TScoped (ProtectedSig a))
+         , HasType (LPat a)
+         , Data (HsSplice a)
+         ) => ToHie (PScoped (LPat (GhcPass p))) where
+  toHie (PS rsp scope pscope lpat@(dL -> L ospan opat)) =
+    concatM $ getTypeNode lpat : case opat of
+      WildPat _ ->
+        []
+      VarPat _ lname ->
+        [ toHie $ C (PatternBind scope pscope rsp) lname
+        ]
+      LazyPat _ p ->
+        [ toHie $ PS rsp scope pscope p
+        ]
+      AsPat _ lname pat ->
+        [ toHie $ C (PatternBind scope
+                                 (combineScopes (mkLScope (dL pat)) pscope)
+                                 rsp)
+                    lname
+        , toHie $ PS rsp scope pscope pat
+        ]
+      ParPat _ pat ->
+        [ toHie $ PS rsp scope pscope pat
+        ]
+      BangPat _ pat ->
+        [ toHie $ PS rsp scope pscope pat
+        ]
+      ListPat _ pats ->
+        [ toHie $ patScopes rsp scope pscope pats
+        ]
+      TuplePat _ pats _ ->
+        [ toHie $ patScopes rsp scope pscope pats
+        ]
+      SumPat _ pat _ _ ->
+        [ toHie $ PS rsp scope pscope pat
+        ]
+      ConPatIn c dets ->
+        [ toHie $ C Use c
+        , toHie $ contextify dets
+        ]
+      ConPatOut {pat_con = con, pat_args = dets}->
+        [ toHie $ C Use $ fmap conLikeName con
+        , toHie $ contextify dets
+        ]
+      ViewPat _ expr pat ->
+        [ toHie expr
+        , toHie $ PS rsp scope pscope pat
+        ]
+      SplicePat _ sp ->
+        [ toHie $ L ospan sp
+        ]
+      LitPat _ _ ->
+        []
+      NPat _ _ _ _ ->
+        []
+      NPlusKPat _ n _ _ _ _ ->
+        [ toHie $ C (PatternBind scope pscope rsp) n
+        ]
+      SigPat _ pat sig ->
+        [ toHie $ PS rsp scope pscope pat
+        , let cscope = mkLScope (dL pat) in
+            toHie $ TS (ResolvedScopes [cscope, scope, pscope])
+                       (protectSig @a cscope sig)
+              -- See Note [Scoping Rules for SigPat]
+        ]
+      CoPat _ _ _ _ ->
+        []
+      XPat _ -> []
+    where
+      contextify (PrefixCon args) = PrefixCon $ patScopes rsp scope pscope args
+      contextify (InfixCon a b) = InfixCon a' b'
+        where [a', b'] = patScopes rsp scope pscope [a,b]
+      contextify (RecCon r) = RecCon $ RC RecFieldMatch $ contextify_rec r
+      contextify_rec (HsRecFields fds a) = HsRecFields (map go scoped_fds) a
+        where
+          go (RS fscope (L spn (HsRecField lbl pat pun))) =
+            L spn $ HsRecField lbl (PS rsp scope fscope pat) pun
+          scoped_fds = listScopes pscope fds
+
+instance ( ToHie body
+         , ToHie (LGRHS a body)
+         , ToHie (RScoped (LHsLocalBinds a))
+         ) => ToHie (GRHSs a body) where
+  toHie grhs = concatM $ case grhs of
+    GRHSs _ grhss binds ->
+     [ toHie grhss
+     , toHie $ RS (mkScope $ grhss_span grhs) binds
+     ]
+    XGRHSs _ -> []
+
+instance ( ToHie (Located body)
+         , ToHie (RScoped (GuardLStmt a))
+         , Data (GRHS a (Located body))
+         ) => ToHie (LGRHS a (Located body)) where
+  toHie (L span g) = concatM $ makeNode g span : case g of
+    GRHS _ guards body ->
+      [ toHie $ listScopes (mkLScope body) guards
+      , toHie body
+      ]
+    XGRHS _ -> []
+
+instance ( a ~ GhcPass p
+         , ToHie (Context (Located (IdP a)))
+         , HasType (LHsExpr a)
+         , ToHie (PScoped (LPat a))
+         , ToHie (MatchGroup a (LHsExpr a))
+         , ToHie (LGRHS a (LHsExpr a))
+         , ToHie (RContext (HsRecordBinds a))
+         , ToHie (RFContext (Located (AmbiguousFieldOcc a)))
+         , ToHie (ArithSeqInfo a)
+         , ToHie (LHsCmdTop a)
+         , ToHie (RScoped (GuardLStmt a))
+         , ToHie (RScoped (LHsLocalBinds a))
+         , ToHie (TScoped (LHsWcType (NoGhcTc a)))
+         , ToHie (TScoped (LHsSigWcType (NoGhcTc a)))
+         , Data (HsExpr a)
+         , Data (HsSplice a)
+         , Data (HsTupArg a)
+         , Data (AmbiguousFieldOcc a)
+         ) => ToHie (LHsExpr (GhcPass p)) where
+  toHie e@(L mspan oexpr) = concatM $ getTypeNode e : case oexpr of
+      HsVar _ (L _ var) ->
+        [ toHie $ C Use (L mspan var)
+             -- Patch up var location since typechecker removes it
+        ]
+      HsUnboundVar _ _ ->
+        []
+      HsConLikeOut _ con ->
+        [ toHie $ C Use $ L mspan $ conLikeName con
+        ]
+      HsRecFld _ fld ->
+        [ toHie $ RFC RecFieldOcc Nothing (L mspan fld)
+        ]
+      HsOverLabel _ _ _ -> []
+      HsIPVar _ _ -> []
+      HsOverLit _ _ -> []
+      HsLit _ _ -> []
+      HsLam _ mg ->
+        [ toHie mg
+        ]
+      HsLamCase _ mg ->
+        [ toHie mg
+        ]
+      HsApp _ a b ->
+        [ toHie a
+        , toHie b
+        ]
+      HsAppType _ expr sig ->
+        [ toHie expr
+        , toHie $ TS (ResolvedScopes []) sig
+        ]
+      OpApp _ a b c ->
+        [ toHie a
+        , toHie b
+        , toHie c
+        ]
+      NegApp _ a _ ->
+        [ toHie a
+        ]
+      HsPar _ a ->
+        [ toHie a
+        ]
+      SectionL _ a b ->
+        [ toHie a
+        , toHie b
+        ]
+      SectionR _ a b ->
+        [ toHie a
+        , toHie b
+        ]
+      ExplicitTuple _ args _ ->
+        [ toHie args
+        ]
+      ExplicitSum _ _ _ expr ->
+        [ toHie expr
+        ]
+      HsCase _ expr matches ->
+        [ toHie expr
+        , toHie matches
+        ]
+      HsIf _ _ a b c ->
+        [ toHie a
+        , toHie b
+        , toHie c
+        ]
+      HsMultiIf _ grhss ->
+        [ toHie grhss
+        ]
+      HsLet _ binds expr ->
+        [ toHie $ RS (mkLScope expr) binds
+        , toHie expr
+        ]
+      HsDo _ _ (L ispan stmts) ->
+        [ pure $ locOnly ispan
+        , toHie $ listScopes NoScope stmts
+        ]
+      ExplicitList _ _ exprs ->
+        [ toHie exprs
+        ]
+      RecordCon {rcon_con_name = name, rcon_flds = binds}->
+        [ toHie $ C Use name
+        , toHie $ RC RecFieldAssign $ binds
+        ]
+      RecordUpd {rupd_expr = expr, rupd_flds = upds}->
+        [ toHie expr
+        , toHie $ map (RC RecFieldAssign) upds
+        ]
+      ExprWithTySig _ expr sig ->
+        [ toHie expr
+        , toHie $ TS (ResolvedScopes [mkLScope expr]) sig
+        ]
+      ArithSeq _ _ info ->
+        [ toHie info
+        ]
+      HsSCC _ _ _ expr ->
+        [ toHie expr
+        ]
+      HsCoreAnn _ _ _ expr ->
+        [ toHie expr
+        ]
+      HsProc _ pat cmdtop ->
+        [ toHie $ PS Nothing (mkLScope cmdtop) NoScope pat
+        , toHie cmdtop
+        ]
+      HsStatic _ expr ->
+        [ toHie expr
+        ]
+      HsArrApp _ a b _ _ ->
+        [ toHie a
+        , toHie b
+        ]
+      HsArrForm _ expr _ cmds ->
+        [ toHie expr
+        , toHie cmds
+        ]
+      HsTick _ _ expr ->
+        [ toHie expr
+        ]
+      HsBinTick _ _ _ expr ->
+        [ toHie expr
+        ]
+      HsTickPragma _ _ _ _ expr ->
+        [ toHie expr
+        ]
+      HsWrap _ _ a ->
+        [ toHie $ L mspan a
+        ]
+      HsBracket _ b ->
+        [ toHie b
+        ]
+      HsRnBracketOut _ b p ->
+        [ toHie b
+        , toHie p
+        ]
+      HsTcBracketOut _ b p ->
+        [ toHie b
+        , toHie p
+        ]
+      HsSpliceE _ x ->
+        [ toHie $ L mspan x
+        ]
+      EWildPat _ -> []
+      EAsPat _ a b ->
+        [ toHie $ C Use a
+        , toHie b
+        ]
+      EViewPat _ a b ->
+        [ toHie a
+        , toHie b
+        ]
+      ELazyPat _ a ->
+        [ toHie a
+        ]
+      XExpr _ -> []
+
+instance ( a ~ GhcPass p
+         , ToHie (LHsExpr a)
+         , Data (HsTupArg a)
+         ) => ToHie (LHsTupArg (GhcPass p)) where
+  toHie (L span arg) = concatM $ makeNode arg span : case arg of
+    Present _ expr ->
+      [ toHie expr
+      ]
+    Missing _ -> []
+    XTupArg _ -> []
+
+instance ( a ~ GhcPass p
+         , ToHie (PScoped (LPat a))
+         , ToHie (LHsExpr a)
+         , ToHie (SigContext (LSig a))
+         , ToHie (RScoped (LHsLocalBinds a))
+         , ToHie (RScoped (ApplicativeArg a))
+         , ToHie (Located body)
+         , Data (StmtLR a a (Located body))
+         , Data (StmtLR a a (Located (HsExpr a)))
+         ) => ToHie (RScoped (LStmt (GhcPass p) (Located body))) where
+  toHie (RS scope (L span stmt)) = concatM $ makeNode stmt span : case stmt of
+      LastStmt _ body _ _ ->
+        [ toHie body
+        ]
+      BindStmt _ pat body _ _ ->
+        [ toHie $ PS (getRealSpan $ getLoc body) scope NoScope pat
+        , toHie body
+        ]
+      ApplicativeStmt _ stmts _ ->
+        [ concatMapM (toHie . RS scope . snd) stmts
+        ]
+      BodyStmt _ body _ _ ->
+        [ toHie body
+        ]
+      LetStmt _ binds ->
+        [ toHie $ RS scope binds
+        ]
+      ParStmt _ parstmts _ _ ->
+        [ concatMapM (\(ParStmtBlock _ stmts _ _) ->
+                          toHie $ listScopes NoScope stmts)
+                     parstmts
+        ]
+      TransStmt {trS_stmts = stmts, trS_using = using, trS_by = by} ->
+        [ toHie $ listScopes scope stmts
+        , toHie using
+        , toHie by
+        ]
+      RecStmt {recS_stmts = stmts} ->
+        [ toHie $ map (RS $ combineScopes scope (mkScope span)) stmts
+        ]
+      XStmtLR _ -> []
+
+instance ( ToHie (LHsExpr a)
+         , ToHie (PScoped (LPat a))
+         , ToHie (BindContext (LHsBind a))
+         , ToHie (SigContext (LSig a))
+         , ToHie (RScoped (HsValBindsLR a a))
+         , Data (HsLocalBinds a)
+         ) => ToHie (RScoped (LHsLocalBinds a)) where
+  toHie (RS scope (L sp binds)) = concatM $ makeNode binds sp : case binds of
+      EmptyLocalBinds _ -> []
+      HsIPBinds _ _ -> []
+      HsValBinds _ valBinds ->
+        [ toHie $ RS (combineScopes scope $ mkScope sp)
+                      valBinds
+        ]
+      XHsLocalBindsLR _ -> []
+
+instance ( ToHie (BindContext (LHsBind a))
+         , ToHie (SigContext (LSig a))
+         , ToHie (RScoped (XXValBindsLR a a))
+         ) => ToHie (RScoped (HsValBindsLR a a)) where
+  toHie (RS sc v) = concatM $ case v of
+    ValBinds _ binds sigs ->
+      [ toHie $ fmap (BC RegularBind sc) binds
+      , toHie $ fmap (SC (SI BindSig Nothing)) sigs
+      ]
+    XValBindsLR x -> [ toHie $ RS sc x ]
+
+instance ToHie (RScoped (NHsValBindsLR GhcTc)) where
+  toHie (RS sc (NValBinds binds sigs)) = concatM $
+    [ toHie (concatMap (map (BC RegularBind sc) . bagToList . snd) binds)
+    , toHie $ fmap (SC (SI BindSig Nothing)) sigs
+    ]
+instance ToHie (RScoped (NHsValBindsLR GhcRn)) where
+  toHie (RS sc (NValBinds binds sigs)) = concatM $
+    [ toHie (concatMap (map (BC RegularBind sc) . bagToList . snd) binds)
+    , toHie $ fmap (SC (SI BindSig Nothing)) sigs
+    ]
+
+instance ( ToHie (RContext (LHsRecField a arg))
+         ) => ToHie (RContext (HsRecFields a arg)) where
+  toHie (RC c (HsRecFields fields _)) = toHie $ map (RC c) fields
+
+instance ( ToHie (RFContext (Located label))
+         , ToHie arg
+         , HasLoc arg
+         , Data label
+         , Data arg
+         ) => ToHie (RContext (LHsRecField' label arg)) where
+  toHie (RC c (L span recfld)) = concatM $ makeNode recfld span : case recfld of
+    HsRecField label expr _ ->
+      [ toHie $ RFC c (getRealSpan $ loc expr) label
+      , toHie expr
+      ]
+
+removeDefSrcSpan :: Name -> Name
+removeDefSrcSpan n = setNameLoc n noSrcSpan
+
+instance ToHie (RFContext (LFieldOcc GhcRn)) where
+  toHie (RFC c rhs (L nspan f)) = concatM $ case f of
+    FieldOcc name _ ->
+      [ toHie $ C (RecField c rhs) (L nspan $ removeDefSrcSpan name)
+      ]
+    XFieldOcc _ -> []
+
+instance ToHie (RFContext (LFieldOcc GhcTc)) where
+  toHie (RFC c rhs (L nspan f)) = concatM $ case f of
+    FieldOcc var _ ->
+      let var' = setVarName var (removeDefSrcSpan $ varName var)
+      in [ toHie $ C (RecField c rhs) (L nspan var')
+         ]
+    XFieldOcc _ -> []
+
+instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcRn))) where
+  toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of
+    Unambiguous name _ ->
+      [ toHie $ C (RecField c rhs) $ L nspan $ removeDefSrcSpan name
+      ]
+    Ambiguous _name _ ->
+      [ ]
+    XAmbiguousFieldOcc _ -> []
+
+instance ToHie (RFContext (Located (AmbiguousFieldOcc GhcTc))) where
+  toHie (RFC c rhs (L nspan afo)) = concatM $ case afo of
+    Unambiguous var _ ->
+      let var' = setVarName var (removeDefSrcSpan $ varName var)
+      in [ toHie $ C (RecField c rhs) (L nspan var')
+         ]
+    Ambiguous var _ ->
+      let var' = setVarName var (removeDefSrcSpan $ varName var)
+      in [ toHie $ C (RecField c rhs) (L nspan var')
+         ]
+    XAmbiguousFieldOcc _ -> []
+
+instance ( a ~ GhcPass p
+         , ToHie (PScoped (LPat a))
+         , ToHie (BindContext (LHsBind a))
+         , ToHie (LHsExpr a)
+         , ToHie (SigContext (LSig a))
+         , ToHie (RScoped (HsValBindsLR a a))
+         , Data (StmtLR a a (Located (HsExpr a)))
+         , Data (HsLocalBinds a)
+         ) => ToHie (RScoped (ApplicativeArg (GhcPass p))) where
+  toHie (RS sc (ApplicativeArgOne _ pat expr _)) = concatM
+    [ toHie $ PS Nothing sc NoScope pat
+    , toHie expr
+    ]
+  toHie (RS sc (ApplicativeArgMany _ stmts _ pat)) = concatM
+    [ toHie $ listScopes NoScope stmts
+    , toHie $ PS Nothing sc NoScope pat
+    ]
+  toHie (RS _ (XApplicativeArg _)) = pure []
+
+instance (ToHie arg, ToHie rec) => ToHie (HsConDetails arg rec) where
+  toHie (PrefixCon args) = toHie args
+  toHie (RecCon rec) = toHie rec
+  toHie (InfixCon a b) = concatM [ toHie a, toHie b]
+
+instance ( ToHie (LHsCmd a)
+         , Data  (HsCmdTop a)
+         ) => ToHie (LHsCmdTop a) where
+  toHie (L span top) = concatM $ makeNode top span : case top of
+    HsCmdTop _ cmd ->
+      [ toHie cmd
+      ]
+    XCmdTop _ -> []
+
+instance ( a ~ GhcPass p
+         , ToHie (PScoped (LPat a))
+         , ToHie (BindContext (LHsBind a))
+         , ToHie (LHsExpr a)
+         , ToHie (MatchGroup a (LHsCmd a))
+         , ToHie (SigContext (LSig a))
+         , ToHie (RScoped (HsValBindsLR a a))
+         , Data (HsCmd a)
+         , Data (HsCmdTop a)
+         , Data (StmtLR a a (Located (HsCmd a)))
+         , Data (HsLocalBinds a)
+         , Data (StmtLR a a (Located (HsExpr a)))
+         ) => ToHie (LHsCmd (GhcPass p)) where
+  toHie (L span cmd) = concatM $ makeNode cmd span : case cmd of
+      HsCmdArrApp _ a b _ _ ->
+        [ toHie a
+        , toHie b
+        ]
+      HsCmdArrForm _ a _ _ cmdtops ->
+        [ toHie a
+        , toHie cmdtops
+        ]
+      HsCmdApp _ a b ->
+        [ toHie a
+        , toHie b
+        ]
+      HsCmdLam _ mg ->
+        [ toHie mg
+        ]
+      HsCmdPar _ a ->
+        [ toHie a
+        ]
+      HsCmdCase _ expr alts ->
+        [ toHie expr
+        , toHie alts
+        ]
+      HsCmdIf _ _ a b c ->
+        [ toHie a
+        , toHie b
+        , toHie c
+        ]
+      HsCmdLet _ binds cmd' ->
+        [ toHie $ RS (mkLScope cmd') binds
+        , toHie cmd'
+        ]
+      HsCmdDo _ (L ispan stmts) ->
+        [ pure $ locOnly ispan
+        , toHie $ listScopes NoScope stmts
+        ]
+      HsCmdWrap _ _ _ -> []
+      XCmd _ -> []
+
+instance ToHie (TyClGroup GhcRn) where
+  toHie (TyClGroup _ classes roles instances) = concatM
+    [ toHie classes
+    , toHie roles
+    , toHie instances
+    ]
+  toHie (XTyClGroup _) = pure []
+
+instance ToHie (LTyClDecl GhcRn) where
+  toHie (L span decl) = concatM $ makeNode decl span : case decl of
+      FamDecl {tcdFam = fdecl} ->
+        [ toHie (L span fdecl)
+        ]
+      SynDecl {tcdLName = name, tcdTyVars = vars, tcdRhs = typ} ->
+        [ toHie $ C (Decl SynDec $ getRealSpan span) name
+        , toHie $ TS (ResolvedScopes [mkScope $ getLoc typ]) vars
+        , toHie typ
+        ]
+      DataDecl {tcdLName = name, tcdTyVars = vars, tcdDataDefn = defn} ->
+        [ toHie $ C (Decl DataDec $ getRealSpan span) name
+        , toHie $ TS (ResolvedScopes [quant_scope, rhs_scope]) vars
+        , toHie defn
+        ]
+        where
+          quant_scope = mkLScope $ dd_ctxt defn
+          rhs_scope = sig_sc `combineScopes` con_sc `combineScopes` deriv_sc
+          sig_sc = maybe NoScope mkLScope $ dd_kindSig defn
+          con_sc = foldr combineScopes NoScope $ map mkLScope $ dd_cons defn
+          deriv_sc = mkLScope $ dd_derivs defn
+      ClassDecl { tcdCtxt = context
+                , tcdLName = name
+                , tcdTyVars = vars
+                , tcdFDs = deps
+                , tcdSigs = sigs
+                , tcdMeths = meths
+                , tcdATs = typs
+                , tcdATDefs = deftyps
+                } ->
+        [ toHie $ C (Decl ClassDec $ getRealSpan span) name
+        , toHie context
+        , toHie $ TS (ResolvedScopes [context_scope, rhs_scope]) vars
+        , toHie deps
+        , toHie $ map (SC $ SI ClassSig $ getRealSpan span) sigs
+        , toHie $ fmap (BC InstanceBind ModuleScope) meths
+        , toHie typs
+        , concatMapM (pure . locOnly . getLoc) deftyps
+        , toHie $ map (go . unLoc) deftyps
+        ]
+        where
+          context_scope = mkLScope context
+          rhs_scope = foldl1' combineScopes $ map mkScope
+            [ loc deps, loc sigs, loc (bagToList meths), loc typs, loc deftyps]
+
+          go :: TyFamDefltEqn GhcRn
+             -> FamEqn GhcRn (TScoped (LHsQTyVars GhcRn)) (LHsType GhcRn)
+          go (FamEqn a var bndrs pat b rhs) =
+             FamEqn a var bndrs (TS (ResolvedScopes [mkLScope rhs]) pat) b rhs
+          go (XFamEqn NoExt) = XFamEqn NoExt
+      XTyClDecl _ -> []
+
+instance ToHie (LFamilyDecl GhcRn) where
+  toHie (L span decl) = concatM $ makeNode decl span : case decl of
+      FamilyDecl _ info name vars _ sig inj ->
+        [ toHie $ C (Decl FamDec $ getRealSpan span) name
+        , toHie $ TS (ResolvedScopes [rhsSpan]) vars
+        , toHie info
+        , toHie $ RS injSpan sig
+        , toHie inj
+        ]
+        where
+          rhsSpan = sigSpan `combineScopes` injSpan
+          sigSpan = mkScope $ getLoc sig
+          injSpan = maybe NoScope (mkScope . getLoc) inj
+      XFamilyDecl _ -> []
+
+instance ToHie (FamilyInfo GhcRn) where
+  toHie (ClosedTypeFamily (Just eqns)) = concatM $
+    [ concatMapM (pure . locOnly . getLoc) eqns
+    , toHie $ map go eqns
+    ]
+    where
+      go (L l ib) = TS (ResolvedScopes [mkScope l]) ib
+  toHie _ = pure []
+
+instance ToHie (RScoped (LFamilyResultSig GhcRn)) where
+  toHie (RS sc (L span sig)) = concatM $ makeNode sig span : case sig of
+      NoSig _ ->
+        []
+      KindSig _ k ->
+        [ toHie k
+        ]
+      TyVarSig _ bndr ->
+        [ toHie $ TVS (ResolvedScopes [sc]) NoScope bndr
+        ]
+      XFamilyResultSig _ -> []
+
+instance ToHie (Located (FunDep (Located Name))) where
+  toHie (L span fd@(lhs, rhs)) = concatM $
+    [ makeNode fd span
+    , toHie $ map (C Use) lhs
+    , toHie $ map (C Use) rhs
+    ]
+
+instance (ToHie pats, ToHie rhs, HasLoc pats, HasLoc rhs)
+    => ToHie (TScoped (FamEqn GhcRn pats rhs)) where
+  toHie (TS _ f) = toHie f
+
+instance ( ToHie pats
+         , ToHie rhs
+         , HasLoc pats
+         , HasLoc rhs
+         ) => ToHie (FamEqn GhcRn pats rhs) where
+  toHie fe@(FamEqn _ var tybndrs pats _ rhs) = concatM $
+    [ toHie $ C (Decl InstDec $ getRealSpan $ loc fe) var
+    , toHie $ fmap (tvScopes (ResolvedScopes []) scope) tybndrs
+    , toHie pats
+    , toHie rhs
+    ]
+    where scope = combineScopes patsScope rhsScope
+          patsScope = mkScope (loc pats)
+          rhsScope = mkScope (loc rhs)
+  toHie (XFamEqn _) = pure []
+
+instance ToHie (LInjectivityAnn GhcRn) where
+  toHie (L span ann) = concatM $ makeNode ann span : case ann of
+      InjectivityAnn lhs rhs ->
+        [ toHie $ C Use lhs
+        , toHie $ map (C Use) rhs
+        ]
+
+instance ToHie (HsDataDefn GhcRn) where
+  toHie (HsDataDefn _ _ ctx _ mkind cons derivs) = concatM
+    [ toHie ctx
+    , toHie mkind
+    , toHie cons
+    , toHie derivs
+    ]
+  toHie (XHsDataDefn _) = pure []
+
+instance ToHie (HsDeriving GhcRn) where
+  toHie (L span clauses) = concatM
+    [ pure $ locOnly span
+    , toHie clauses
+    ]
+
+instance ToHie (LHsDerivingClause GhcRn) where
+  toHie (L span cl) = concatM $ makeNode cl span : case cl of
+      HsDerivingClause _ strat (L ispan tys) ->
+        [ toHie strat
+        , pure $ locOnly ispan
+        , toHie $ map (TS (ResolvedScopes [])) tys
+        ]
+      XHsDerivingClause _ -> []
+
+instance ToHie (Located (DerivStrategy GhcRn)) where
+  toHie (L span strat) = concatM $ makeNode strat span : case strat of
+      StockStrategy -> []
+      AnyclassStrategy -> []
+      NewtypeStrategy -> []
+      ViaStrategy s -> [ toHie $ TS (ResolvedScopes []) s ]
+
+instance ToHie (Located OverlapMode) where
+  toHie (L span _) = pure $ locOnly span
+
+instance ToHie (LConDecl GhcRn) where
+  toHie (L span decl) = concatM $ makeNode decl span : case decl of
+      ConDeclGADT { con_names = names, con_qvars = qvars
+                  , con_mb_cxt = ctx, con_args = args, con_res_ty = typ } ->
+        [ toHie $ map (C (Decl ConDec $ getRealSpan span)) names
+        , toHie $ TS (ResolvedScopes [ctxScope, rhsScope]) qvars
+        , toHie ctx
+        , toHie args
+        , toHie typ
+        ]
+        where
+          rhsScope = combineScopes argsScope tyScope
+          ctxScope = maybe NoScope mkLScope ctx
+          argsScope = condecl_scope args
+          tyScope = mkLScope typ
+      ConDeclH98 { con_name = name, con_ex_tvs = qvars
+                 , con_mb_cxt = ctx, con_args = dets } ->
+        [ toHie $ C (Decl ConDec $ getRealSpan span) name
+        , toHie $ tvScopes (ResolvedScopes []) rhsScope qvars
+        , toHie ctx
+        , toHie dets
+        ]
+        where
+          rhsScope = combineScopes ctxScope argsScope
+          ctxScope = maybe NoScope mkLScope ctx
+          argsScope = condecl_scope dets
+      XConDecl _ -> []
+    where condecl_scope args = case args of
+            PrefixCon xs -> foldr combineScopes NoScope $ map mkLScope xs
+            InfixCon a b -> combineScopes (mkLScope a) (mkLScope b)
+            RecCon x -> mkLScope x
+
+instance ToHie (Located [LConDeclField GhcRn]) where
+  toHie (L span decls) = concatM $
+    [ pure $ locOnly span
+    , toHie decls
+    ]
+
+instance ( HasLoc thing
+         , ToHie (TScoped thing)
+         ) => ToHie (TScoped (HsImplicitBndrs GhcRn thing)) where
+  toHie (TS sc (HsIB ibrn a)) = concatM $
+      [ pure $ bindingsOnly $ map (C $ TyVarBind (mkScope span) sc) ibrn
+      , toHie $ TS sc a
+      ]
+    where span = loc a
+  toHie (TS _ (XHsImplicitBndrs _)) = pure []
+
+instance ( HasLoc thing
+         , ToHie (TScoped thing)
+         ) => ToHie (TScoped (HsWildCardBndrs GhcRn thing)) where
+  toHie (TS sc (HsWC names a)) = concatM $
+      [ pure $ bindingsOnly $ map (C $ TyVarBind (mkScope span) sc) names
+      , toHie $ TS sc a
+      ]
+    where span = loc a
+  toHie (TS _ (XHsWildCardBndrs _)) = pure []
+
+instance ToHie (SigContext (LSig GhcRn)) where
+  toHie (SC (SI styp msp) (L sp sig)) = concatM $ makeNode sig sp : case sig of
+      TypeSig _ names typ ->
+        [ toHie $ map (C TyDecl) names
+        , toHie $ TS (UnresolvedScope (map unLoc names) Nothing) typ
+        ]
+      PatSynSig _ names typ ->
+        [ toHie $ map (C TyDecl) names
+        , toHie $ TS (UnresolvedScope (map unLoc names) Nothing) typ
+        ]
+      ClassOpSig _ _ names typ ->
+        [ case styp of
+            ClassSig -> toHie $ map (C $ ClassTyDecl $ getRealSpan sp) names
+            _  -> toHie $ map (C $ TyDecl) names
+        , toHie $ TS (UnresolvedScope (map unLoc names) msp) typ
+        ]
+      IdSig _ _ -> []
+      FixSig _ fsig ->
+        [ toHie $ L sp fsig
+        ]
+      InlineSig _ name _ ->
+        [ toHie $ (C Use) name
+        ]
+      SpecSig _ name typs _ ->
+        [ toHie $ (C Use) name
+        , toHie $ map (TS (ResolvedScopes [])) typs
+        ]
+      SpecInstSig _ _ typ ->
+        [ toHie $ TS (ResolvedScopes []) typ
+        ]
+      MinimalSig _ _ form ->
+        [ toHie form
+        ]
+      SCCFunSig _ _ name mtxt ->
+        [ toHie $ (C Use) name
+        , pure $ maybe [] (locOnly . getLoc) mtxt
+        ]
+      CompleteMatchSig _ _ (L ispan names) typ ->
+        [ pure $ locOnly ispan
+        , toHie $ map (C Use) names
+        , toHie $ fmap (C Use) typ
+        ]
+      XSig _ -> []
+
+instance ToHie (LHsType GhcRn) where
+  toHie x = toHie $ TS (ResolvedScopes []) x
+
+instance ToHie (TScoped (LHsType GhcRn)) where
+  toHie (TS tsc (L span t)) = concatM $ makeNode t span : case t of
+      HsForAllTy _ bndrs body ->
+        [ toHie $ tvScopes tsc (mkScope $ getLoc body) bndrs
+        , toHie body
+        ]
+      HsQualTy _ ctx body ->
+        [ toHie ctx
+        , toHie body
+        ]
+      HsTyVar _ _ var ->
+        [ toHie $ C Use var
+        ]
+      HsAppTy _ a b ->
+        [ toHie a
+        , toHie b
+        ]
+      HsFunTy _ a b ->
+        [ toHie a
+        , toHie b
+        ]
+      HsListTy _ a ->
+        [ toHie a
+        ]
+      HsTupleTy _ _ tys ->
+        [ toHie tys
+        ]
+      HsSumTy _ tys ->
+        [ toHie tys
+        ]
+      HsOpTy _ a op b ->
+        [ toHie a
+        , toHie $ C Use op
+        , toHie b
+        ]
+      HsParTy _ a ->
+        [ toHie a
+        ]
+      HsIParamTy _ ip ty ->
+        [ toHie ip
+        , toHie ty
+        ]
+      HsKindSig _ a b ->
+        [ toHie a
+        , toHie b
+        ]
+      HsSpliceTy _ a ->
+        [ toHie $ L span a
+        ]
+      HsDocTy _ a _ ->
+        [ toHie a
+        ]
+      HsBangTy _ _ ty ->
+        [ toHie ty
+        ]
+      HsRecTy _ fields ->
+        [ toHie fields
+        ]
+      HsExplicitListTy _ _ tys ->
+        [ toHie tys
+        ]
+      HsExplicitTupleTy _ tys ->
+        [ toHie tys
+        ]
+      HsTyLit _ _ -> []
+      HsWildCardTy e ->
+        [ toHie e
+        ]
+      HsStarTy _ _ -> []
+      XHsType _ -> []
+
+instance ToHie HsWildCardInfo where
+  toHie (AnonWildCard name) = toHie $ C Use name
+
+instance ToHie (TVScoped (LHsTyVarBndr GhcRn)) where
+  toHie (TVS tsc sc (L span bndr)) = concatM $ makeNode bndr span : case bndr of
+      UserTyVar _ var ->
+        [ toHie $ C (TyVarBind sc tsc) var
+        ]
+      KindedTyVar _ var kind ->
+        [ toHie $ C (TyVarBind sc tsc) var
+        , toHie kind
+        ]
+      XTyVarBndr _ -> []
+
+instance ToHie (TScoped (LHsQTyVars GhcRn)) where
+  toHie (TS sc (HsQTvs (HsQTvsRn implicits _) vars)) = concatM $
+    [ pure $ bindingsOnly bindings
+    , toHie $ tvScopes sc NoScope vars
+    ]
+    where
+      varLoc = loc vars
+      bindings = map (C $ TyVarBind (mkScope varLoc) sc) implicits
+  toHie (TS _ (XLHsQTyVars _)) = pure []
+
+instance ToHie (LHsContext GhcRn) where
+  toHie (L span tys) = concatM $
+      [ pure $ locOnly span
+      , toHie tys
+      ]
+
+instance ToHie (LConDeclField GhcRn) where
+  toHie (L span field) = concatM $ makeNode field span : case field of
+      ConDeclField _ fields typ _ ->
+        [ toHie $ map (RFC RecFieldDecl (getRealSpan $ loc typ)) fields
+        , toHie typ
+        ]
+      XConDeclField _ -> []
+
+instance ToHie (LHsExpr a) => ToHie (ArithSeqInfo a) where
+  toHie (From expr) = toHie expr
+  toHie (FromThen a b) = concatM $
+    [ toHie a
+    , toHie b
+    ]
+  toHie (FromTo a b) = concatM $
+    [ toHie a
+    , toHie b
+    ]
+  toHie (FromThenTo a b c) = concatM $
+    [ toHie a
+    , toHie b
+    , toHie c
+    ]
+
+instance ToHie (LSpliceDecl GhcRn) where
+  toHie (L span decl) = concatM $ makeNode decl span : case decl of
+      SpliceDecl _ splice _ ->
+        [ toHie splice
+        ]
+      XSpliceDecl _ -> []
+
+instance ToHie (HsBracket a) where
+  toHie _ = pure []
+
+instance ToHie PendingRnSplice where
+  toHie _ = pure []
+
+instance ToHie PendingTcSplice where
+  toHie _ = pure []
+
+instance ToHie (LBooleanFormula (Located Name)) where
+  toHie (L span form) = concatM $ makeNode form span : case form of
+      Var a ->
+        [ toHie $ C Use a
+        ]
+      And forms ->
+        [ toHie forms
+        ]
+      Or forms ->
+        [ toHie forms
+        ]
+      Parens f ->
+        [ toHie f
+        ]
+
+instance ToHie (Located HsIPName) where
+  toHie (L span e) = makeNode e span
+
+instance ( ToHie (LHsExpr a)
+         , Data (HsSplice a)
+         ) => ToHie (Located (HsSplice a)) where
+  toHie (L span sp) = concatM $ makeNode sp span : case sp of
+      HsTypedSplice _ _ _ expr ->
+        [ toHie expr
+        ]
+      HsUntypedSplice _ _ _ expr ->
+        [ toHie expr
+        ]
+      HsQuasiQuote _ _ _ ispan _ ->
+        [ pure $ locOnly ispan
+        ]
+      HsSpliced _ _ _ ->
+        []
+      XSplice _ -> []
+
+instance ToHie (LRoleAnnotDecl GhcRn) where
+  toHie (L span annot) = concatM $ makeNode annot span : case annot of
+      RoleAnnotDecl _ var roles ->
+        [ toHie $ C Use var
+        , concatMapM (pure . locOnly . getLoc) roles
+        ]
+      XRoleAnnotDecl _ -> []
+
+instance ToHie (LInstDecl GhcRn) where
+  toHie (L span decl) = concatM $ makeNode decl span : case decl of
+      ClsInstD _ d ->
+        [ toHie $ L span d
+        ]
+      DataFamInstD _ d ->
+        [ toHie $ L span d
+        ]
+      TyFamInstD _ d ->
+        [ toHie $ L span d
+        ]
+      XInstDecl _ -> []
+
+instance ToHie (LClsInstDecl GhcRn) where
+  toHie (L span decl) = concatM
+    [ toHie $ TS (ResolvedScopes [mkScope span]) $ cid_poly_ty decl
+    , toHie $ fmap (BC InstanceBind ModuleScope) $ cid_binds decl
+    , toHie $ map (SC $ SI InstSig $ getRealSpan span) $ cid_sigs decl
+    , pure $ concatMap (locOnly . getLoc) $ cid_tyfam_insts decl
+    , toHie $ cid_tyfam_insts decl
+    , pure $ concatMap (locOnly . getLoc) $ cid_datafam_insts decl
+    , toHie $ cid_datafam_insts decl
+    , toHie $ cid_overlap_mode decl
+    ]
+
+instance ToHie (LDataFamInstDecl GhcRn) where
+  toHie (L sp (DataFamInstDecl d)) = toHie $ TS (ResolvedScopes [mkScope sp]) d
+
+instance ToHie (LTyFamInstDecl GhcRn) where
+  toHie (L sp (TyFamInstDecl d)) = toHie $ TS (ResolvedScopes [mkScope sp]) d
+
+instance ToHie (Context a)
+         => ToHie (PatSynFieldContext (RecordPatSynField a)) where
+  toHie (PSC sp (RecordPatSynField a b)) = concatM $
+    [ toHie $ C (RecField RecFieldDecl sp) a
+    , toHie $ C Use b
+    ]
+
+instance ToHie (LDerivDecl GhcRn) where
+  toHie (L span decl) = concatM $ makeNode decl span : case decl of
+      DerivDecl _ typ strat overlap ->
+        [ toHie $ TS (ResolvedScopes []) typ
+        , toHie strat
+        , toHie overlap
+        ]
+      XDerivDecl _ -> []
+
+instance ToHie (LFixitySig GhcRn) where
+  toHie (L span sig) = concatM $ makeNode sig span : case sig of
+      FixitySig _ vars _ ->
+        [ toHie $ map (C Use) vars
+        ]
+      XFixitySig _ -> []
+
+instance ToHie (LDefaultDecl GhcRn) where
+  toHie (L span decl) = concatM $ makeNode decl span : case decl of
+      DefaultDecl _ typs ->
+        [ toHie typs
+        ]
+      XDefaultDecl _ -> []
+
+instance ToHie (LForeignDecl GhcRn) where
+  toHie (L span decl) = concatM $ makeNode decl span : case decl of
+      ForeignImport {fd_name = name, fd_sig_ty = sig, fd_fi = fi} ->
+        [ toHie $ C (ValBind RegularBind ModuleScope $ getRealSpan span) name
+        , toHie $ TS (ResolvedScopes []) sig
+        , toHie fi
+        ]
+      ForeignExport {fd_name = name, fd_sig_ty = sig, fd_fe = fe} ->
+        [ toHie $ C Use name
+        , toHie $ TS (ResolvedScopes []) sig
+        , toHie fe
+        ]
+      XForeignDecl _ -> []
+
+instance ToHie ForeignImport where
+  toHie (CImport (L a _) (L b _) _ _ (L c _)) = pure $ concat $
+    [ locOnly a
+    , locOnly b
+    , locOnly c
+    ]
+
+instance ToHie ForeignExport where
+  toHie (CExport (L a _) (L b _)) = pure $ concat $
+    [ locOnly a
+    , locOnly b
+    ]
+
+instance ToHie (LWarnDecls GhcRn) where
+  toHie (L span decl) = concatM $ makeNode decl span : case decl of
+      Warnings _ _ warnings ->
+        [ toHie warnings
+        ]
+      XWarnDecls _ -> []
+
+instance ToHie (LWarnDecl GhcRn) where
+  toHie (L span decl) = concatM $ makeNode decl span : case decl of
+      Warning _ vars _ ->
+        [ toHie $ map (C Use) vars
+        ]
+      XWarnDecl _ -> []
+
+instance ToHie (LAnnDecl GhcRn) where
+  toHie (L span decl) = concatM $ makeNode decl span : case decl of
+      HsAnnotation _ _ prov expr ->
+        [ toHie prov
+        , toHie expr
+        ]
+      XAnnDecl _ -> []
+
+instance ToHie (Context (Located a)) => ToHie (AnnProvenance a) where
+  toHie (ValueAnnProvenance a) = toHie $ C Use a
+  toHie (TypeAnnProvenance a) = toHie $ C Use a
+  toHie ModuleAnnProvenance = pure []
+
+instance ToHie (LRuleDecls GhcRn) where
+  toHie (L span decl) = concatM $ makeNode decl span : case decl of
+      HsRules _ _ rules ->
+        [ toHie rules
+        ]
+      XRuleDecls _ -> []
+
+instance ToHie (LRuleDecl GhcRn) where
+  toHie (L _ (XRuleDecl _)) = pure []
+  toHie (L span r@(HsRule _ rname _ tybndrs bndrs exprA exprB)) = concatM
+        [ makeNode r span
+        , pure $ locOnly $ getLoc rname
+        , toHie $ fmap (tvScopes (ResolvedScopes []) scope) tybndrs
+        , toHie $ map (RS $ mkScope span) bndrs
+        , toHie exprA
+        , toHie exprB
+        ]
+    where scope = bndrs_sc `combineScopes` exprA_sc `combineScopes` exprB_sc
+          bndrs_sc = maybe NoScope mkLScope (listToMaybe bndrs)
+          exprA_sc = mkLScope exprA
+          exprB_sc = mkLScope exprB
+
+instance ToHie (RScoped (LRuleBndr GhcRn)) where
+  toHie (RS sc (L span bndr)) = concatM $ makeNode bndr span : case bndr of
+      RuleBndr _ var ->
+        [ toHie $ C (ValBind RegularBind sc Nothing) var
+        ]
+      RuleBndrSig _ var typ ->
+        [ toHie $ C (ValBind RegularBind sc Nothing) var
+        , toHie $ TS (ResolvedScopes [sc]) typ
+        ]
+      XRuleBndr _ -> []
+
+instance ToHie (LImportDecl GhcRn) where
+  toHie (L span decl) = concatM $ makeNode decl span : case decl of
+      ImportDecl { ideclName = name, ideclAs = as, ideclHiding = hidden } ->
+        [ toHie $ IEC Import name
+        , toHie $ fmap (IEC ImportAs) as
+        , maybe (pure []) goIE hidden
+        ]
+      XImportDecl _ -> []
+    where
+      goIE (hiding, (L sp liens)) = concatM $
+        [ pure $ locOnly sp
+        , toHie $ map (IEC c) liens
+        ]
+        where
+         c = if hiding then ImportHiding else Import
+
+instance ToHie (IEContext (LIE GhcRn)) where
+  toHie (IEC c (L span ie)) = concatM $ makeNode ie span : case ie of
+      IEVar _ n ->
+        [ toHie $ IEC c n
+        ]
+      IEThingAbs _ n ->
+        [ toHie $ IEC c n
+        ]
+      IEThingAll _ n ->
+        [ toHie $ IEC c n
+        ]
+      IEThingWith _ n _ ns flds ->
+        [ toHie $ IEC c n
+        , toHie $ map (IEC c) ns
+        , toHie $ map (IEC c) flds
+        ]
+      IEModuleContents _ n ->
+        [ toHie $ IEC c n
+        ]
+      IEGroup _ _ _ -> []
+      IEDoc _ _ -> []
+      IEDocNamed _ _ -> []
+      XIE _ -> []
+
+instance ToHie (IEContext (LIEWrappedName Name)) where
+  toHie (IEC c (L span iewn)) = concatM $ makeNode iewn span : case iewn of
+      IEName n ->
+        [ toHie $ C (IEThing c) n
+        ]
+      IEPattern p ->
+        [ toHie $ C (IEThing c) p
+        ]
+      IEType n ->
+        [ toHie $ C (IEThing c) n
+        ]
+
+instance ToHie (IEContext (Located (FieldLbl Name))) where
+  toHie (IEC c (L span lbl)) = concatM $ makeNode lbl span : case lbl of
+      FieldLabel _ _ n ->
+        [ toHie $ C (IEThing c) $ L span n
+        ]
diff --git a/compiler/hieFile/HieBin.hs b/compiler/hieFile/HieBin.hs
new file mode 100644
index 0000000000..fa33936f40
--- /dev/null
+++ b/compiler/hieFile/HieBin.hs
@@ -0,0 +1,271 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module HieBin ( readHieFile, writeHieFile, HieName(..), toHieName ) where
+
+import GhcPrelude
+
+import Binary
+import BinIface                   ( getDictFastString )
+import FastMutInt
+import FastString                 ( FastString )
+import Module                     ( Module )
+import Name
+import NameCache
+import Outputable
+import PrelInfo
+import SrcLoc
+import UniqSupply                 ( takeUniqFromSupply )
+import Unique
+import UniqFM
+
+import qualified Data.Array as A
+import Data.IORef
+import Data.List                  ( mapAccumR )
+import Data.Word                  ( Word32 )
+import Control.Monad              ( replicateM )
+
+
+-- | `Name`'s get converted into `HieName`'s before being written into @.hie@
+-- files. See 'toHieName' and 'fromHieName' for logic on how to convert between
+-- these two types.
+data HieName
+  = ExternalName !Module !OccName !SrcSpan
+  | LocalName !OccName !SrcSpan
+  | KnownKeyName !Unique
+  deriving (Eq)
+
+instance Ord HieName where
+  compare (ExternalName a b c) (ExternalName d e f) = compare (a,b,c) (d,e,f)
+  compare (LocalName a b) (LocalName c d) = compare (a,b) (c,d)
+  compare (KnownKeyName a) (KnownKeyName b) = nonDetCmpUnique a b
+    -- Not actually non determinstic as it is a KnownKey
+  compare ExternalName{} _ = LT
+  compare LocalName{} ExternalName{} = GT
+  compare LocalName{} _ = LT
+  compare KnownKeyName{} _ = GT
+
+instance Outputable HieName where
+  ppr (ExternalName m n sp) = text "ExternalName" <+> ppr m <+> ppr n <+> ppr sp
+  ppr (LocalName n sp) = text "LocalName" <+> ppr n <+> ppr sp
+  ppr (KnownKeyName u) = text "KnownKeyName" <+> ppr u
+
+
+data HieSymbolTable = HieSymbolTable
+  { hie_symtab_next :: !FastMutInt
+  , hie_symtab_map  :: !(IORef (UniqFM (Int, HieName)))
+  }
+
+data HieDictionary = HieDictionary
+  { hie_dict_next :: !FastMutInt -- The next index to use
+  , hie_dict_map  :: !(IORef (UniqFM (Int,FastString))) -- indexed by FastString
+  }
+
+initBinMemSize :: Int
+initBinMemSize = 1024*1024
+
+writeHieFile :: Binary a => FilePath -> a -> IO ()
+writeHieFile filename hiefile = do
+  bh0 <- openBinMem initBinMemSize
+
+  -- remember where the dictionary pointer will go
+  dict_p_p <- tellBin bh0
+  put_ bh0 dict_p_p
+
+  -- remember where the symbol table pointer will go
+  symtab_p_p <- tellBin bh0
+  put_ bh0 symtab_p_p
+
+  -- Make some intial state
+  symtab_next <- newFastMutInt
+  writeFastMutInt symtab_next 0
+  symtab_map <- newIORef emptyUFM
+  let hie_symtab = HieSymbolTable {
+                      hie_symtab_next = symtab_next,
+                      hie_symtab_map  = symtab_map }
+  dict_next_ref <- newFastMutInt
+  writeFastMutInt dict_next_ref 0
+  dict_map_ref <- newIORef emptyUFM
+  let hie_dict = HieDictionary {
+                      hie_dict_next = dict_next_ref,
+                      hie_dict_map  = dict_map_ref }
+
+  -- put the main thing
+  let bh = setUserData bh0 $ newWriteState (putName hie_symtab)
+                                           (putName hie_symtab)
+                                           (putFastString hie_dict)
+  put_ bh hiefile
+
+  -- write the symtab pointer at the front of the file
+  symtab_p <- tellBin bh
+  putAt bh symtab_p_p symtab_p
+  seekBin bh symtab_p
+
+  -- write the symbol table itself
+  symtab_next' <- readFastMutInt symtab_next
+  symtab_map'  <- readIORef symtab_map
+  putSymbolTable bh symtab_next' symtab_map'
+
+  -- write the dictionary pointer at the fornt of the file
+  dict_p <- tellBin bh
+  putAt bh dict_p_p dict_p
+  seekBin bh dict_p
+
+  -- write the dictionary itself
+  dict_next <- readFastMutInt dict_next_ref
+  dict_map  <- readIORef dict_map_ref
+  putDictionary bh dict_next dict_map
+
+  -- and send the result to the file
+  writeBinMem bh filename
+  return ()
+
+readHieFile :: Binary a => NameCache -> FilePath -> IO (a, NameCache)
+readHieFile nc file = do
+  bh0 <- readBinMem file
+
+  dict  <- get_dictionary bh0
+
+  -- read the symbol table so we are capable of reading the actual data
+  (bh1, nc') <- do
+      let bh1 = setUserData bh0 $ newReadState (error "getSymtabName")
+                                               (getDictFastString dict)
+      (nc', symtab) <- get_symbol_table bh1
+      let bh1' = setUserData bh1
+               $ newReadState (getSymTabName symtab)
+                              (getDictFastString dict)
+      return (bh1', nc')
+
+  -- load the actual data
+  hiefile <- get bh1
+  return (hiefile, nc')
+  where
+    get_dictionary bin_handle = do
+      dict_p <- get bin_handle
+      data_p <- tellBin bin_handle
+      seekBin bin_handle dict_p
+      dict <- getDictionary bin_handle
+      seekBin bin_handle data_p
+      return dict
+
+    get_symbol_table bh1 = do
+      symtab_p <- get bh1
+      data_p'  <- tellBin bh1
+      seekBin bh1 symtab_p
+      (nc', symtab) <- getSymbolTable bh1 nc
+      seekBin bh1 data_p'
+      return (nc', symtab)
+
+putFastString :: HieDictionary -> BinHandle -> FastString -> IO ()
+putFastString HieDictionary { hie_dict_next = j_r,
+                              hie_dict_map  = out_r}  bh f
+  = do
+    out <- readIORef out_r
+    let unique = getUnique f
+    case lookupUFM out unique of
+        Just (j, _)  -> put_ bh (fromIntegral j :: Word32)
+        Nothing -> do
+           j <- readFastMutInt j_r
+           put_ bh (fromIntegral j :: Word32)
+           writeFastMutInt j_r (j + 1)
+           writeIORef out_r $! addToUFM out unique (j, f)
+
+putSymbolTable :: BinHandle -> Int -> UniqFM (Int,HieName) -> IO ()
+putSymbolTable bh next_off symtab = do
+  put_ bh next_off
+  let names = A.elems (A.array (0,next_off-1) (nonDetEltsUFM symtab))
+  mapM_ (putHieName bh) names
+
+getSymbolTable :: BinHandle -> NameCache -> IO (NameCache, SymbolTable)
+getSymbolTable bh namecache = do
+  sz <- get bh
+  od_names <- replicateM sz (getHieName bh)
+  let arr = A.listArray (0,sz-1) names
+      (namecache', names) = mapAccumR fromHieName namecache od_names
+  return (namecache', arr)
+
+getSymTabName :: SymbolTable -> BinHandle -> IO Name
+getSymTabName st bh = do
+  i :: Word32 <- get bh
+  return $ st A.! (fromIntegral i)
+
+putName :: HieSymbolTable -> BinHandle -> Name -> IO ()
+putName (HieSymbolTable next ref) bh name = do
+  symmap <- readIORef ref
+  case lookupUFM symmap name of
+    Just (off, ExternalName mod occ (UnhelpfulSpan _))
+      | isGoodSrcSpan (nameSrcSpan name) -> do
+      let hieName = ExternalName mod occ (nameSrcSpan name)
+      writeIORef ref $! addToUFM symmap name (off, hieName)
+      put_ bh (fromIntegral off :: Word32)
+    Just (off, LocalName _occ span)
+      | notLocal (toHieName name) || nameSrcSpan name /= span -> do
+      writeIORef ref $! addToUFM symmap name (off, toHieName name)
+      put_ bh (fromIntegral off :: Word32)
+    Just (off, _) -> put_ bh (fromIntegral off :: Word32)
+    Nothing -> do
+        off <- readFastMutInt next
+        writeFastMutInt next (off+1)
+        writeIORef ref $! addToUFM symmap name (off, toHieName name)
+        put_ bh (fromIntegral off :: Word32)
+
+  where
+    notLocal :: HieName -> Bool
+    notLocal LocalName{} = False
+    notLocal _ = True
+
+
+-- ** Converting to and from `HieName`'s
+
+toHieName :: Name -> HieName
+toHieName name
+  | isKnownKeyName name = KnownKeyName (nameUnique name)
+  | isExternalName name = ExternalName (nameModule name)
+                                       (nameOccName name)
+                                       (nameSrcSpan name)
+  | otherwise = LocalName (nameOccName name) (nameSrcSpan name)
+
+fromHieName :: NameCache -> HieName -> (NameCache, Name)
+fromHieName nc (ExternalName mod occ span) =
+    let cache = nsNames nc
+    in case lookupOrigNameCache cache mod occ of
+         Just name -> (nc, name)
+         Nothing ->
+           let (uniq, us) = takeUniqFromSupply (nsUniqs nc)
+               name       = mkExternalName uniq mod occ span
+               new_cache  = extendNameCache cache mod occ name
+           in ( nc{ nsUniqs = us, nsNames = new_cache }, name )
+fromHieName nc (LocalName occ span) =
+    let (uniq, us) = takeUniqFromSupply (nsUniqs nc)
+        name       = mkInternalName uniq occ span
+    in ( nc{ nsUniqs = us }, name )
+fromHieName nc (KnownKeyName u) = case lookupKnownKeyName u of
+    Nothing -> pprPanic "fromHieName:unknown known-key unique"
+                        (ppr (unpkUnique u))
+    Just n -> (nc, n)
+
+-- ** Reading and writing `HieName`'s
+
+putHieName :: BinHandle -> HieName -> IO ()
+putHieName bh (ExternalName mod occ span) = do
+  putByte bh 0
+  put_ bh (mod, occ, span)
+putHieName bh (LocalName occName span) = do
+  putByte bh 1
+  put_ bh (occName, span)
+putHieName bh (KnownKeyName uniq) = do
+  putByte bh 2
+  put_ bh $ unpkUnique uniq
+
+getHieName :: BinHandle -> IO HieName
+getHieName bh = do
+  t <- getByte bh
+  case t of
+    0 -> do
+      (modu, occ, span) <- get bh
+      return $ ExternalName modu occ span
+    1 -> do
+      (occ, span) <- get bh
+      return $ LocalName occ span
+    2 -> do
+      (c,i) <- get bh
+      return $ KnownKeyName $ mkUnique c i
+    _ -> panic "HieBin.getHieName: invalid tag"
diff --git a/compiler/hieFile/HieDebug.hs b/compiler/hieFile/HieDebug.hs
new file mode 100644
index 0000000000..7896cf7720
--- /dev/null
+++ b/compiler/hieFile/HieDebug.hs
@@ -0,0 +1,143 @@
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
+module HieDebug where
+
+import GhcPrelude
+
+import SrcLoc
+import Module
+import FastString
+import Outputable
+
+import HieTypes
+import HieBin
+import HieUtils
+
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Data.Function    ( on )
+import Data.List        ( sortOn )
+import Data.Foldable    ( toList )
+
+ppHies :: Outputable a => (HieASTs a) -> SDoc
+ppHies (HieASTs asts) = M.foldrWithKey go "" asts
+  where
+    go k a rest = vcat $
+      [ "File: " <> ppr k
+      , ppHie a
+      , rest
+      ]
+
+ppHie :: Outputable a => HieAST a -> SDoc
+ppHie = go 0
+  where
+    go n (Node inf sp children) = hang header n rest
+      where
+        rest = vcat $ map (go (n+2)) children
+        header = hsep
+          [ "Node"
+          , ppr sp
+          , ppInfo inf
+          ]
+
+ppInfo :: Outputable a => NodeInfo a -> SDoc
+ppInfo ni = hsep
+  [ ppr $ toList $ nodeAnnotations ni
+  , ppr $ nodeType ni
+  , ppr $ M.toList $ nodeIdentifiers ni
+  ]
+
+type Diff a = a -> a -> [SDoc]
+
+diffFile :: Diff HieFile
+diffFile = diffAsts eqDiff `on` (getAsts . hie_asts)
+
+diffAsts :: (Outputable a, Eq a) => Diff a -> Diff (M.Map FastString (HieAST a))
+diffAsts f = diffList (diffAst f) `on` M.elems
+
+diffAst :: (Outputable a, Eq a) => Diff a -> Diff (HieAST a)
+diffAst diffType (Node info1 span1 xs1) (Node info2 span2 xs2) =
+    infoDiff ++ spanDiff ++ diffList (diffAst diffType) xs1 xs2
+  where
+    spanDiff
+      | span1 /= span2 = [hsep ["Spans", ppr span1, "and", ppr span2, "differ"]]
+      | otherwise = []
+    infoDiff
+      = (diffList eqDiff `on` (S.toAscList . nodeAnnotations)) info1 info2
+     ++ (diffList diffType `on` nodeType) info1 info2
+     ++ (diffIdents `on` nodeIdentifiers) info1 info2
+    diffIdents a b = (diffList diffIdent `on` normalizeIdents) a b
+    diffIdent (a,b) (c,d) = diffName a c
+                         ++ eqDiff b d
+    diffName (Right a) (Right b) = case (a,b) of
+      (ExternalName m o _, ExternalName m' o' _) -> eqDiff (m,o) (m',o')
+      (LocalName o _, ExternalName _ o' _) -> eqDiff o o'
+      _ -> eqDiff a b
+    diffName a b = eqDiff a b
+
+type DiffIdent = Either ModuleName HieName
+
+normalizeIdents :: NodeIdentifiers a -> [(DiffIdent,IdentifierDetails a)]
+normalizeIdents = sortOn fst . map (first toHieName) . M.toList
+  where
+    first f (a,b) = (fmap f a, b)
+
+diffList :: Diff a -> Diff [a]
+diffList f xs ys
+  | length xs == length ys = concat $ zipWith f xs ys
+  | otherwise = ["length of lists doesn't match"]
+
+eqDiff :: (Outputable a, Eq a) => Diff a
+eqDiff a b
+  | a == b = []
+  | otherwise = [hsep [ppr a, "and", ppr b, "do not match"]]
+
+validAst :: HieAST a -> Either SDoc ()
+validAst (Node _ span children) = do
+  checkContainment children
+  checkSorted children
+  mapM_ validAst children
+  where
+    checkSorted [] = return ()
+    checkSorted [_] = return ()
+    checkSorted (x:y:xs)
+      | nodeSpan x `leftOf` nodeSpan y = checkSorted (y:xs)
+      | otherwise = Left $ hsep
+          [ ppr $ nodeSpan x
+          , "is not to the left of"
+          , ppr $ nodeSpan y
+          ]
+    checkContainment [] = return ()
+    checkContainment (x:xs)
+      | span `containsSpan` (nodeSpan x) = checkContainment xs
+      | otherwise = Left $ hsep
+          [ ppr $ span
+          , "does not contain"
+          , ppr $ nodeSpan x
+          ]
+
+-- | Look for any identifiers which occur outside of their supposed scopes.
+-- Returns a list of error messages.
+validateScopes :: M.Map FastString (HieAST a) -> [SDoc]
+validateScopes asts = M.foldrWithKey (\k a b -> valid k a ++ b) [] refMap
+  where
+    refMap = generateReferencesMap asts
+    valid (Left _) _ = []
+    valid (Right n) refs = concatMap inScope refs
+      where
+        mapRef = foldMap getScopeFromContext . identInfo . snd
+        scopes = case foldMap mapRef refs of
+          Just xs -> xs
+          Nothing -> []
+        inScope (sp, dets)
+          |  definedInAsts asts n
+          && any isOccurrence (identInfo dets)
+            = case scopes of
+              [] -> []
+              _ -> if any (`scopeContainsSpan` sp) scopes
+                   then []
+                   else return $ hsep $
+                     [ "Name", ppr n, "at position", ppr sp
+                     , "doesn't occur in calculated scope", ppr scopes]
+          | otherwise = []
diff --git a/compiler/hieFile/HieTypes.hs b/compiler/hieFile/HieTypes.hs
new file mode 100644
index 0000000000..c20887f045
--- /dev/null
+++ b/compiler/hieFile/HieTypes.hs
@@ -0,0 +1,503 @@
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module HieTypes where
+
+import GhcPrelude
+
+import Binary
+import FastString                 ( FastString )
+import IfaceType
+import Module                     ( ModuleName )
+import Name                       ( Name )
+import Outputable hiding ( (<>) )
+import SrcLoc                     ( RealSrcSpan )
+
+import qualified Data.Array as A
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Data.ByteString            ( ByteString )
+import Data.Data                  ( Typeable, Data )
+import Data.Semigroup             ( Semigroup(..) )
+import Data.Word                  ( Word8 )
+import Control.Applicative        ( (<|>) )
+
+type Span = RealSrcSpan
+
+-- | Current version of @.hie@ files
+curHieVersion :: Word8
+curHieVersion = 0
+
+{- |
+GHC builds up a wealth of information about Haskell source as it compiles it.
+@.hie@ files are a way of persisting some of this information to disk so that
+external tools that need to work with haskell source don't need to parse,
+typecheck, and rename all over again. These files contain:
+
+  * a simplified AST
+
+       * nodes are annotated with source positions and types
+       * identifiers are annotated with scope information
+
+  * the raw bytes of the initial Haskell source
+
+Besides saving compilation cycles, @.hie@ files also offer a more stable
+interface than the GHC API.
+-}
+data HieFile = HieFile
+    { hie_version :: Word8
+    -- ^ version of the HIE format
+
+    , hie_ghc_version :: ByteString
+    -- ^ Version of GHC that produced this file
+
+    , hie_hs_file :: FilePath
+    -- ^ Initial Haskell source file path
+
+    , hie_types :: A.Array TypeIndex HieTypeFlat
+    -- ^ Types referenced in the 'hie_asts'.
+    --
+    -- See Note [Efficient serialization of redundant type info]
+
+    , hie_asts :: HieASTs TypeIndex
+    -- ^ Type-annotated abstract syntax trees
+
+    , hie_hs_src :: ByteString
+    -- ^ Raw bytes of the initial Haskell source
+    }
+
+instance Binary HieFile where
+  put_ bh hf = do
+    put_ bh $ hie_version hf
+    put_ bh $ hie_ghc_version hf
+    put_ bh $ hie_hs_file hf
+    put_ bh $ hie_types hf
+    put_ bh $ hie_asts hf
+    put_ bh $ hie_hs_src hf
+
+  get bh = HieFile
+    <$> get bh
+    <*> get bh
+    <*> get bh
+    <*> get bh
+    <*> get bh
+    <*> get bh
+
+
+{-
+Note [Efficient serialization of redundant type info]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The type information in .hie files is highly repetitive and redundant. For
+example, consider the expression
+
+    const True 'a'
+
+There is a lot of shared structure between the types of subterms:
+
+  * const True 'a' ::                 Bool
+  * const True     ::         Char -> Bool
+  * const          :: Bool -> Char -> Bool
+
+Since all 3 of these types need to be stored in the .hie file, it is worth
+making an effort to deduplicate this shared structure. The trick is to define
+a new data type that is a flattened version of 'Type':
+
+    data HieType a = HAppTy a a  -- data Type = AppTy Type Type
+                   | HFunTy a a  --           | FunTy Type Type
+                   | ...
+
+    type TypeIndex = Int
+
+Types in the final AST are stored in an 'A.Array TypeIndex (HieType TypeIndex)',
+where the 'TypeIndex's in the 'HieType' are references to other elements of the
+array. Types recovered from GHC are deduplicated and stored in this compressed
+form with sharing of subtrees.
+-}
+
+type TypeIndex = Int
+
+-- | A flattened version of 'Type'.
+--
+-- See Note [Efficient serialization of redundant type info]
+data HieType a
+  = HTyVarTy Name
+  | HAppTy a (HieArgs a)
+  | HTyConApp IfaceTyCon (HieArgs a)
+  | HForAllTy ((Name, a),ArgFlag) a
+  | HFunTy  a a
+  | HQualTy a a           -- ^ type with constraint: @t1 => t2@ (see 'IfaceDFunTy')
+  | HLitTy IfaceTyLit
+  | HCastTy a
+  | HCoercionTy
+    deriving (Functor, Foldable, Traversable, Eq)
+
+type HieTypeFlat = HieType TypeIndex
+
+-- | Roughly isomorphic to the original core 'Type'.
+newtype HieTypeFix = Roll (HieType (HieTypeFix))
+
+instance Binary (HieType TypeIndex) where
+  put_ bh (HTyVarTy n) = do
+    putByte bh 0
+    put_ bh n
+  put_ bh (HAppTy a b) = do
+    putByte bh 1
+    put_ bh a
+    put_ bh b
+  put_ bh (HTyConApp n xs) = do
+    putByte bh 2
+    put_ bh n
+    put_ bh xs
+  put_ bh (HForAllTy bndr a) = do
+    putByte bh 3
+    put_ bh bndr
+    put_ bh a
+  put_ bh (HFunTy a b) = do
+    putByte bh 4
+    put_ bh a
+    put_ bh b
+  put_ bh (HQualTy a b) = do
+    putByte bh 5
+    put_ bh a
+    put_ bh b
+  put_ bh (HLitTy l) = do
+    putByte bh 6
+    put_ bh l
+  put_ bh (HCastTy a) = do
+    putByte bh 7
+    put_ bh a
+  put_ bh (HCoercionTy) = putByte bh 8
+
+  get bh = do
+    (t :: Word8) <- get bh
+    case t of
+      0 -> HTyVarTy <$> get bh
+      1 -> HAppTy <$> get bh <*> get bh
+      2 -> HTyConApp <$> get bh <*> get bh
+      3 -> HForAllTy <$> get bh <*> get bh
+      4 -> HFunTy <$> get bh <*> get bh
+      5 -> HQualTy <$> get bh <*> get bh
+      6 -> HLitTy <$> get bh
+      7 -> HCastTy <$> get bh
+      8 -> return HCoercionTy
+      _ -> panic "Binary (HieArgs Int): invalid tag"
+
+
+-- | A list of type arguments along with their respective visibilities (ie. is
+-- this an argument that would return 'True' for 'isVisibleArgFlag'?).
+newtype HieArgs a = HieArgs [(Bool,a)]
+  deriving (Functor, Foldable, Traversable, Eq)
+
+instance Binary (HieArgs TypeIndex) where
+  put_ bh (HieArgs xs) = put_ bh xs
+  get bh = HieArgs <$> get bh
+
+-- | Mapping from filepaths (represented using 'FastString') to the
+-- corresponding AST
+newtype HieASTs a = HieASTs { getAsts :: (M.Map FastString (HieAST a)) }
+  deriving (Functor, Foldable, Traversable)
+
+instance Binary (HieASTs TypeIndex) where
+  put_ bh asts = put_ bh $ M.toAscList $ getAsts asts
+  get bh = HieASTs <$> fmap M.fromDistinctAscList (get bh)
+
+
+data HieAST a =
+  Node
+    { nodeInfo :: NodeInfo a
+    , nodeSpan :: Span
+    , nodeChildren :: [HieAST a]
+    } deriving (Functor, Foldable, Traversable)
+
+instance Binary (HieAST TypeIndex) where
+  put_ bh ast = do
+    put_ bh $ nodeInfo ast
+    put_ bh $ nodeSpan ast
+    put_ bh $ nodeChildren ast
+
+  get bh = Node
+    <$> get bh
+    <*> get bh
+    <*> get bh
+
+
+-- | The information stored in one AST node.
+--
+-- The type parameter exists to provide flexibility in representation of types
+-- (see Note [Efficient serialization of redundant type info]).
+data NodeInfo a = NodeInfo
+    { nodeAnnotations :: S.Set (FastString,FastString)
+    -- ^ (name of the AST node constructor, name of the AST node Type)
+
+    , nodeType :: [a]
+    -- ^ The Haskell types of this node, if any.
+
+    , nodeIdentifiers :: NodeIdentifiers a
+    -- ^ All the identifiers and their details
+    } deriving (Functor, Foldable, Traversable)
+
+instance Binary (NodeInfo TypeIndex) where
+  put_ bh ni = do
+    put_ bh $ S.toAscList $ nodeAnnotations ni
+    put_ bh $ nodeType ni
+    put_ bh $ M.toList $ nodeIdentifiers ni
+  get bh = NodeInfo
+    <$> fmap (S.fromDistinctAscList) (get bh)
+    <*> get bh
+    <*> fmap (M.fromList) (get bh)
+
+type Identifier = Either ModuleName Name
+
+type NodeIdentifiers a = M.Map Identifier (IdentifierDetails a)
+
+-- | Information associated with every identifier
+--
+-- We need to include types with identifiers because sometimes multiple
+-- identifiers occur in the same span(Overloaded Record Fields and so on)
+data IdentifierDetails a = IdentifierDetails
+  { identType :: Maybe a
+  , identInfo :: S.Set ContextInfo
+  } deriving (Eq, Functor, Foldable, Traversable)
+
+instance Outputable a => Outputable (IdentifierDetails a) where
+  ppr x = text "IdentifierDetails" <+> ppr (identType x) <+> ppr (identInfo x)
+
+instance Semigroup (IdentifierDetails a) where
+  d1 <> d2 = IdentifierDetails (identType d1 <|> identType d2)
+                               (S.union (identInfo d1) (identInfo d2))
+
+instance Monoid (IdentifierDetails a) where
+  mempty = IdentifierDetails Nothing S.empty
+
+instance Binary (IdentifierDetails TypeIndex) where
+  put_ bh dets = do
+    put_ bh $ identType dets
+    put_ bh $ S.toAscList $ identInfo dets
+  get bh =  IdentifierDetails
+    <$> get bh
+    <*> fmap (S.fromDistinctAscList) (get bh)
+
+
+-- | Different contexts under which identifiers exist
+data ContextInfo
+  = Use                -- ^ regular variable
+  | MatchBind
+  | IEThing IEType     -- ^ import/export
+  | TyDecl
+
+  -- | Value binding
+  | ValBind
+      BindType     -- ^ whether or not the binding is in an instance
+      Scope        -- ^ scope over which the value is bound
+      (Maybe Span) -- ^ span of entire binding
+
+  -- | Pattern binding
+  --
+  -- This case is tricky because the bound identifier can be used in two
+  -- distinct scopes. Consider the following example (with @-XViewPatterns@)
+  --
+  -- @
+  -- do (b, a, (a -> True)) <- bar
+  --    foo a
+  -- @
+  --
+  -- The identifier @a@ has two scopes: in the view pattern @(a -> True)@ and
+  -- in the rest of the @do@-block in @foo a@.
+  | PatternBind
+      Scope        -- ^ scope /in the pattern/ (the variable bound can be used
+                   -- further in the pattern)
+      Scope        -- ^ rest of the scope outside the pattern
+      (Maybe Span) -- ^ span of entire binding
+
+  | ClassTyDecl (Maybe Span)
+
+  -- | Declaration
+  | Decl
+      DeclType     -- ^ type of declaration
+      (Maybe Span) -- ^ span of entire binding
+
+  -- | Type variable
+  | TyVarBind Scope TyVarScope
+
+  -- | Record field
+  | RecField RecFieldContext (Maybe Span)
+    deriving (Eq, Ord, Show)
+
+instance Outputable ContextInfo where
+  ppr = text . show
+
+instance Binary ContextInfo where
+  put_ bh Use = putByte bh 0
+  put_ bh (IEThing t) = do
+    putByte bh 1
+    put_ bh t
+  put_ bh TyDecl = putByte bh 2
+  put_ bh (ValBind bt sc msp) = do
+    putByte bh 3
+    put_ bh bt
+    put_ bh sc
+    put_ bh msp
+  put_ bh (PatternBind a b c) = do
+    putByte bh 4
+    put_ bh a
+    put_ bh b
+    put_ bh c
+  put_ bh (ClassTyDecl sp) = do
+    putByte bh 5
+    put_ bh sp
+  put_ bh (Decl a b) = do
+    putByte bh 6
+    put_ bh a
+    put_ bh b
+  put_ bh (TyVarBind a b) = do
+    putByte bh 7
+    put_ bh a
+    put_ bh b
+  put_ bh (RecField a b) = do
+    putByte bh 8
+    put_ bh a
+    put_ bh b
+  put_ bh MatchBind = putByte bh 9
+
+  get bh = do
+    (t :: Word8) <- get bh
+    case t of
+      0 -> return Use
+      1 -> IEThing <$> get bh
+      2 -> return TyDecl
+      3 -> ValBind <$> get bh <*> get bh <*> get bh
+      4 -> PatternBind <$> get bh <*> get bh <*> get bh
+      5 -> ClassTyDecl <$> get bh
+      6 -> Decl <$> get bh <*> get bh
+      7 -> TyVarBind <$> get bh <*> get bh
+      8 -> RecField <$> get bh <*> get bh
+      9 -> return MatchBind
+      _ -> panic "Binary ContextInfo: invalid tag"
+
+
+-- | Types of imports and exports
+data IEType
+  = Import
+  | ImportAs
+  | ImportHiding
+  | Export
+    deriving (Eq, Enum, Ord, Show)
+
+instance Binary IEType where
+  put_ bh b = putByte bh (fromIntegral (fromEnum b))
+  get bh = do x <- getByte bh; pure $! (toEnum (fromIntegral x))
+
+
+data RecFieldContext
+  = RecFieldDecl
+  | RecFieldAssign
+  | RecFieldMatch
+  | RecFieldOcc
+    deriving (Eq, Enum, Ord, Show)
+
+instance Binary RecFieldContext where
+  put_ bh b = putByte bh (fromIntegral (fromEnum b))
+  get bh = do x <- getByte bh; pure $! (toEnum (fromIntegral x))
+
+
+data BindType
+  = RegularBind
+  | InstanceBind
+    deriving (Eq, Ord, Show, Enum)
+
+instance Binary BindType where
+  put_ bh b = putByte bh (fromIntegral (fromEnum b))
+  get bh = do x <- getByte bh; pure $! (toEnum (fromIntegral x))
+
+
+data DeclType
+  = FamDec     -- ^ type or data family
+  | SynDec     -- ^ type synonym
+  | DataDec    -- ^ data declaration
+  | ConDec     -- ^ constructor declaration
+  | PatSynDec  -- ^ pattern synonym
+  | ClassDec   -- ^ class declaration
+  | InstDec    -- ^ instance declaration
+    deriving (Eq, Ord, Show, Enum)
+
+instance Binary DeclType where
+  put_ bh b = putByte bh (fromIntegral (fromEnum b))
+  get bh = do x <- getByte bh; pure $! (toEnum (fromIntegral x))
+
+
+data Scope
+  = NoScope
+  | LocalScope Span
+  | ModuleScope
+    deriving (Eq, Ord, Show, Typeable, Data)
+
+instance Outputable Scope where
+  ppr NoScope = text "NoScope"
+  ppr (LocalScope sp) = text "LocalScope" <+> ppr sp
+  ppr ModuleScope = text "ModuleScope"
+
+instance Binary Scope where
+  put_ bh NoScope = putByte bh 0
+  put_ bh (LocalScope span) = do
+    putByte bh 1
+    put_ bh span
+  put_ bh ModuleScope = putByte bh 2
+
+  get bh = do
+    (t :: Word8) <- get bh
+    case t of
+      0 -> return NoScope
+      1 -> LocalScope <$> get bh
+      2 -> return ModuleScope
+      _ -> panic "Binary Scope: invalid tag"
+
+
+-- | Scope of a type variable.
+--
+-- This warrants a data type apart from 'Scope' because of complexities
+-- introduced by features like @-XScopedTypeVariables@ and @-XInstanceSigs@. For
+-- example, consider:
+--
+-- @
+-- foo, bar, baz :: forall a. a -> a
+-- @
+--
+-- Here @a@ is in scope in all the definitions of @foo@, @bar@, and @baz@, so we
+-- need a list of scopes to keep track of this. Furthermore, this list cannot be
+-- computed until we resolve the binding sites of @foo@, @bar@, and @baz@.
+--
+-- Consequently, @a@ starts with an @'UnresolvedScope' [foo, bar, baz] Nothing@
+-- which later gets resolved into a 'ResolvedScopes'.
+data TyVarScope
+  = ResolvedScopes [Scope]
+
+  -- | Unresolved scopes should never show up in the final @.hie@ file
+  | UnresolvedScope
+        [Name]        -- ^ names of the definitions over which the scope spans
+        (Maybe Span)  -- ^ the location of the instance/class declaration for
+                      -- the case where the type variable is declared in a
+                      -- method type signature
+    deriving (Eq, Ord)
+
+instance Show TyVarScope where
+  show (ResolvedScopes sc) = show sc
+  show _ = error "UnresolvedScope"
+
+instance Binary TyVarScope where
+  put_ bh (ResolvedScopes xs) = do
+    putByte bh 0
+    put_ bh xs
+  put_ bh (UnresolvedScope ns span) = do
+    putByte bh 1
+    put_ bh ns
+    put_ bh span
+
+  get bh = do
+    (t :: Word8) <- get bh
+    case t of
+      0 -> ResolvedScopes <$> get bh
+      1 -> UnresolvedScope <$> get bh <*> get bh
+      _ -> panic "Binary TyVarScope: invalid tag"
diff --git a/compiler/hieFile/HieUtils.hs b/compiler/hieFile/HieUtils.hs
new file mode 100644
index 0000000000..5259ea1280
--- /dev/null
+++ b/compiler/hieFile/HieUtils.hs
@@ -0,0 +1,455 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleInstances #-}
+module HieUtils where
+
+import GhcPrelude
+
+import CoreMap
+import DynFlags                   ( DynFlags )
+import FastString                 ( FastString, mkFastString )
+import IfaceType
+import Name hiding (varName)
+import Outputable                 ( renderWithStyle, ppr, defaultUserStyle )
+import SrcLoc
+import ToIface
+import TyCon
+import TyCoRep
+import Type
+import Var
+import VarEnv
+
+import HieTypes
+
+import qualified Data.Map as M
+import qualified Data.Set as S
+import qualified Data.IntMap.Strict as IM
+import qualified Data.Array as A
+import Data.Data                  ( typeOf, typeRepTyCon, Data(toConstr) )
+import Data.Maybe                 ( maybeToList )
+import Data.Monoid
+import Data.Traversable           ( for )
+import Control.Monad.Trans.State.Strict hiding (get)
+
+
+generateReferencesMap
+  :: Foldable f
+  => f (HieAST a)
+  -> M.Map Identifier [(Span, IdentifierDetails a)]
+generateReferencesMap = foldr (\ast m -> M.unionWith (++) (go ast) m) M.empty
+  where
+    go ast = M.unionsWith (++) (this : map go (nodeChildren ast))
+      where
+        this = fmap (pure . (nodeSpan ast,)) $ nodeIdentifiers $ nodeInfo ast
+
+renderHieType :: DynFlags -> HieTypeFix -> String
+renderHieType df ht = renderWithStyle df (ppr $ hieTypeToIface ht) sty
+  where sty = defaultUserStyle df
+
+resolveVisibility :: Type -> [Type] -> [(Bool,Type)]
+resolveVisibility kind ty_args
+  = go (mkEmptyTCvSubst in_scope) kind ty_args
+  where
+    in_scope = mkInScopeSet (tyCoVarsOfTypes ty_args)
+
+    go _   _                   []     = []
+    go env ty                  ts
+      | Just ty' <- coreView ty
+      = go env ty' ts
+    go env (ForAllTy (Bndr tv vis) res) (t:ts)
+      | isVisibleArgFlag vis = (True , t) : ts'
+      | otherwise            = (False, t) : ts'
+      where
+        ts' = go (extendTvSubst env tv t) res ts
+
+    go env (FunTy _ res) (t:ts) -- No type-class args in tycon apps
+      = (True,t) : (go env res ts)
+
+    go env (TyVarTy tv) ts
+      | Just ki <- lookupTyVar env tv = go env ki ts
+    go env kind (t:ts) = (True, t) : (go env kind ts) -- Ill-kinded
+
+foldType :: (HieType a -> a) -> HieTypeFix -> a
+foldType f (Roll t) = f $ fmap (foldType f) t
+
+hieTypeToIface :: HieTypeFix -> IfaceType
+hieTypeToIface = foldType go
+  where
+    go (HTyVarTy n) = IfaceTyVar $ occNameFS $ getOccName n
+    go (HAppTy a b) = IfaceAppTy a (hieToIfaceArgs b)
+    go (HLitTy l) = IfaceLitTy l
+    go (HForAllTy ((n,k),af) t) = let b = (occNameFS $ getOccName n, k)
+                                  in IfaceForAllTy (Bndr (IfaceTvBndr b) af) t
+    go (HFunTy a b) = IfaceFunTy a b
+    go (HQualTy pred b) = IfaceDFunTy pred b
+    go (HCastTy a) = a
+    go HCoercionTy = IfaceTyVar "<coercion type>"
+    go (HTyConApp a xs) = IfaceTyConApp a (hieToIfaceArgs xs)
+
+    -- This isn't fully faithful - we can't produce the 'Inferred' case
+    hieToIfaceArgs :: HieArgs IfaceType -> IfaceAppArgs
+    hieToIfaceArgs (HieArgs xs) = go' xs
+      where
+        go' [] = IA_Nil
+        go' ((True ,x):xs) = IA_Arg x Required $ go' xs
+        go' ((False,x):xs) = IA_Arg x Specified $ go' xs
+
+data HieTypeState
+  = HTS
+    { tyMap      :: !(TypeMap TypeIndex)
+    , htyTable   :: !(IM.IntMap HieTypeFlat)
+    , freshIndex :: !TypeIndex
+    }
+
+initialHTS :: HieTypeState
+initialHTS = HTS emptyTypeMap IM.empty 0
+
+freshTypeIndex :: State HieTypeState TypeIndex
+freshTypeIndex = do
+  index <- gets freshIndex
+  modify' $ \hts -> hts { freshIndex = index+1 }
+  return index
+
+compressTypes
+  :: HieASTs Type
+  -> (HieASTs TypeIndex, A.Array TypeIndex HieTypeFlat)
+compressTypes asts = (a, arr)
+  where
+    (a, (HTS _ m i)) = flip runState initialHTS $
+      for asts $ \typ -> do
+        i <- getTypeIndex typ
+        return i
+    arr = A.array (0,i-1) (IM.toList m)
+
+recoverFullType :: TypeIndex -> A.Array TypeIndex HieTypeFlat -> HieTypeFix
+recoverFullType i m = go i
+  where
+    go i = Roll $ fmap go (m A.! i)
+
+getTypeIndex :: Type -> State HieTypeState TypeIndex
+getTypeIndex t
+  | otherwise = do
+      tm <- gets tyMap
+      case lookupTypeMap tm t of
+        Just i -> return i
+        Nothing -> do
+          ht <- go t
+          extendHTS t ht
+  where
+    extendHTS t ht = do
+      i <- freshTypeIndex
+      modify' $ \(HTS tm tt fi) ->
+        HTS (extendTypeMap tm t i) (IM.insert i ht tt) fi
+      return i
+
+    go (TyVarTy v) = return $ HTyVarTy $ varName v
+    go ty@(AppTy _ _) = do
+      let (head,args) = splitAppTys ty
+          visArgs = HieArgs $ resolveVisibility (typeKind head) args
+      ai <- getTypeIndex head
+      argsi <- mapM getTypeIndex visArgs
+      return $ HAppTy ai argsi
+    go (TyConApp f xs) = do
+      let visArgs = HieArgs $ resolveVisibility (tyConKind f) xs
+      is <- mapM getTypeIndex visArgs
+      return $ HTyConApp (toIfaceTyCon f) is
+    go (ForAllTy (Bndr v a) t) = do
+      k <- getTypeIndex (varType v)
+      i <- getTypeIndex t
+      return $ HForAllTy ((varName v,k),a) i
+    go (FunTy a b) = do
+      ai <- getTypeIndex a
+      bi <- getTypeIndex b
+      return $ if isPredTy a
+                  then HQualTy ai bi
+                  else HFunTy ai bi
+    go (LitTy a) = return $ HLitTy $ toIfaceTyLit a
+    go (CastTy t _) = do
+      i <- getTypeIndex t
+      return $ HCastTy i
+    go (CoercionTy _) = return HCoercionTy
+
+resolveTyVarScopes :: M.Map FastString (HieAST a) -> M.Map FastString (HieAST a)
+resolveTyVarScopes asts = M.map go asts
+  where
+    go ast = resolveTyVarScopeLocal ast asts
+
+resolveTyVarScopeLocal :: HieAST a -> M.Map FastString (HieAST a) -> HieAST a
+resolveTyVarScopeLocal ast asts = go ast
+  where
+    resolveNameScope dets = dets{identInfo =
+      S.map resolveScope (identInfo dets)}
+    resolveScope (TyVarBind sc (UnresolvedScope names Nothing)) =
+      TyVarBind sc $ ResolvedScopes
+        [ LocalScope binding
+        | name <- names
+        , Just binding <- [getNameBinding name asts]
+        ]
+    resolveScope (TyVarBind sc (UnresolvedScope names (Just sp))) =
+      TyVarBind sc $ ResolvedScopes
+        [ LocalScope binding
+        | name <- names
+        , Just binding <- [getNameBindingInClass name sp asts]
+        ]
+    resolveScope scope = scope
+    go (Node info span children) = Node info' span $ map go children
+      where
+        info' = info { nodeIdentifiers = idents }
+        idents = M.map resolveNameScope $ nodeIdentifiers info
+
+getNameBinding :: Name -> M.Map FastString (HieAST a) -> Maybe Span
+getNameBinding n asts = do
+  (_,msp) <- getNameScopeAndBinding n asts
+  msp
+
+getNameScope :: Name -> M.Map FastString (HieAST a) -> Maybe [Scope]
+getNameScope n asts = do
+  (scopes,_) <- getNameScopeAndBinding n asts
+  return scopes
+
+getNameBindingInClass
+  :: Name
+  -> Span
+  -> M.Map FastString (HieAST a)
+  -> Maybe Span
+getNameBindingInClass n sp asts = do
+  ast <- M.lookup (srcSpanFile sp) asts
+  getFirst $ foldMap First $ do
+    child <- flattenAst ast
+    dets <- maybeToList
+      $ M.lookup (Right n) $ nodeIdentifiers $ nodeInfo child
+    let binding = foldMap (First . getBindSiteFromContext) (identInfo dets)
+    return (getFirst binding)
+
+getNameScopeAndBinding
+  :: Name
+  -> M.Map FastString (HieAST a)
+  -> Maybe ([Scope], Maybe Span)
+getNameScopeAndBinding n asts = case nameSrcSpan n of
+  RealSrcSpan sp -> do -- @Maybe
+    ast <- M.lookup (srcSpanFile sp) asts
+    defNode <- selectLargestContainedBy sp ast
+    getFirst $ foldMap First $ do -- @[]
+      node <- flattenAst defNode
+      dets <- maybeToList
+        $ M.lookup (Right n) $ nodeIdentifiers $ nodeInfo node
+      scopes <- maybeToList $ foldMap getScopeFromContext (identInfo dets)
+      let binding = foldMap (First . getBindSiteFromContext) (identInfo dets)
+      return $ Just (scopes, getFirst binding)
+  _ -> Nothing
+
+getScopeFromContext :: ContextInfo -> Maybe [Scope]
+getScopeFromContext (ValBind _ sc _) = Just [sc]
+getScopeFromContext (PatternBind a b _) = Just [a, b]
+getScopeFromContext (ClassTyDecl _) = Just [ModuleScope]
+getScopeFromContext (Decl _ _) = Just [ModuleScope]
+getScopeFromContext (TyVarBind a (ResolvedScopes xs)) = Just $ a:xs
+getScopeFromContext (TyVarBind a _) = Just [a]
+getScopeFromContext _ = Nothing
+
+getBindSiteFromContext :: ContextInfo -> Maybe Span
+getBindSiteFromContext (ValBind _ _ sp) = sp
+getBindSiteFromContext (PatternBind _ _ sp) = sp
+getBindSiteFromContext _ = Nothing
+
+flattenAst :: HieAST a -> [HieAST a]
+flattenAst n =
+  n : concatMap flattenAst (nodeChildren n)
+
+smallestContainingSatisfying
+  :: Span
+  -> (HieAST a -> Bool)
+  -> HieAST a
+  -> Maybe (HieAST a)
+smallestContainingSatisfying sp cond node
+  | nodeSpan node `containsSpan` sp = getFirst $ mconcat
+      [ foldMap (First . smallestContainingSatisfying sp cond) $
+          nodeChildren node
+      , First $ if cond node then Just node else Nothing
+      ]
+  | sp `containsSpan` nodeSpan node = Nothing
+  | otherwise = Nothing
+
+selectLargestContainedBy :: Span -> HieAST a -> Maybe (HieAST a)
+selectLargestContainedBy sp node
+  | sp `containsSpan` nodeSpan node = Just node
+  | nodeSpan node `containsSpan` sp =
+      getFirst $ foldMap (First . selectLargestContainedBy sp) $
+        nodeChildren node
+  | otherwise = Nothing
+
+selectSmallestContaining :: Span -> HieAST a -> Maybe (HieAST a)
+selectSmallestContaining sp node
+  | nodeSpan node `containsSpan` sp = getFirst $ mconcat
+      [ foldMap (First . selectSmallestContaining sp) $ nodeChildren node
+      , First (Just node)
+      ]
+  | sp `containsSpan` nodeSpan node = Nothing
+  | otherwise = Nothing
+
+definedInAsts :: M.Map FastString (HieAST a) -> Name -> Bool
+definedInAsts asts n = case nameSrcSpan n of
+  RealSrcSpan sp -> srcSpanFile sp `elem` M.keys asts
+  _ -> False
+
+isOccurrence :: ContextInfo -> Bool
+isOccurrence Use = True
+isOccurrence _ = False
+
+scopeContainsSpan :: Scope -> Span -> Bool
+scopeContainsSpan NoScope _ = False
+scopeContainsSpan ModuleScope _ = True
+scopeContainsSpan (LocalScope a) b = a `containsSpan` b
+
+-- | One must contain the other. Leaf nodes cannot contain anything
+combineAst :: HieAST Type -> HieAST Type -> HieAST Type
+combineAst a@(Node aInf aSpn xs) b@(Node bInf bSpn ys)
+  | aSpn == bSpn = Node (aInf `combineNodeInfo` bInf) aSpn (mergeAsts xs ys)
+  | aSpn `containsSpan` bSpn = combineAst b a
+combineAst a (Node xs span children) = Node xs span (insertAst a children)
+
+-- | Insert an AST in a sorted list of disjoint Asts
+insertAst :: HieAST Type -> [HieAST Type] -> [HieAST Type]
+insertAst x = mergeAsts [x]
+
+-- | Merge two nodes together.
+--
+-- Precondition and postcondition: elements in 'nodeType' are ordered.
+combineNodeInfo :: NodeInfo Type -> NodeInfo Type -> NodeInfo Type
+(NodeInfo as ai ad) `combineNodeInfo` (NodeInfo bs bi bd) =
+  NodeInfo (S.union as bs) (mergeSorted ai bi) (M.unionWith (<>) ad bd)
+  where
+    mergeSorted :: [Type] -> [Type] -> [Type]
+    mergeSorted la@(a:as) lb@(b:bs) = case nonDetCmpType a b of
+                                        LT -> a : mergeSorted as lb
+                                        EQ -> a : mergeSorted as bs
+                                        GT -> b : mergeSorted la bs
+    mergeSorted as [] = as
+    mergeSorted [] bs = bs
+
+
+{- | Merge two sorted, disjoint lists of ASTs, combining when necessary.
+
+In the absence of position-altering pragmas (ex: @# line "file.hs" 3@),
+different nodes in an AST tree should either have disjoint spans (in
+which case you can say for sure which one comes first) or one span
+should be completely contained in the other (in which case the contained
+span corresponds to some child node).
+
+However, since Haskell does have position-altering pragmas it /is/
+possible for spans to be overlapping. Here is an example of a source file
+in which @foozball@ and @quuuuuux@ have overlapping spans:
+
+@
+module Baz where
+
+# line 3 "Baz.hs"
+foozball :: Int
+foozball = 0
+
+# line 3 "Baz.hs"
+bar, quuuuuux :: Int
+bar = 1
+quuuuuux = 2
+@
+
+In these cases, we just do our best to produce sensible `HieAST`'s. The blame
+should be laid at the feet of whoever wrote the line pragmas in the first place
+(usually the C preprocessor...).
+-}
+mergeAsts :: [HieAST Type] -> [HieAST Type] -> [HieAST Type]
+mergeAsts xs [] = xs
+mergeAsts [] ys = ys
+mergeAsts xs@(a:as) ys@(b:bs)
+  | span_a `containsSpan`   span_b = mergeAsts (combineAst a b : as) bs
+  | span_b `containsSpan`   span_a = mergeAsts as (combineAst a b : bs)
+  | span_a `rightOf`        span_b = b : mergeAsts xs bs
+  | span_a `leftOf`         span_b = a : mergeAsts as ys
+
+  -- These cases are to work around ASTs that are not fully disjoint
+  | span_a `startsRightOf`  span_b = b : mergeAsts as ys
+  | otherwise                      = a : mergeAsts as ys
+  where
+    span_a = nodeSpan a
+    span_b = nodeSpan b
+
+rightOf :: Span -> Span -> Bool
+rightOf s1 s2
+  = (srcSpanStartLine s1, srcSpanStartCol s1)
+       >= (srcSpanEndLine s2, srcSpanEndCol s2)
+    && (srcSpanFile s1 == srcSpanFile s2)
+
+leftOf :: Span -> Span -> Bool
+leftOf s1 s2
+  = (srcSpanEndLine s1, srcSpanEndCol s1)
+       <= (srcSpanStartLine s2, srcSpanStartCol s2)
+    && (srcSpanFile s1 == srcSpanFile s2)
+
+startsRightOf :: Span -> Span -> Bool
+startsRightOf s1 s2
+  = (srcSpanStartLine s1, srcSpanStartCol s1)
+       >= (srcSpanStartLine s2, srcSpanStartCol s2)
+
+-- | combines and sorts ASTs using a merge sort
+mergeSortAsts :: [HieAST Type] -> [HieAST Type]
+mergeSortAsts = go . map pure
+  where
+    go [] = []
+    go [xs] = xs
+    go xss = go (mergePairs xss)
+    mergePairs [] = []
+    mergePairs [xs] = [xs]
+    mergePairs (xs:ys:xss) = mergeAsts xs ys : mergePairs xss
+
+simpleNodeInfo :: FastString -> FastString -> NodeInfo a
+simpleNodeInfo cons typ = NodeInfo (S.singleton (cons, typ)) [] M.empty
+
+locOnly :: SrcSpan -> [HieAST a]
+locOnly (RealSrcSpan span) =
+  [Node e span []]
+    where e = NodeInfo S.empty [] M.empty
+locOnly _ = []
+
+mkScope :: SrcSpan -> Scope
+mkScope (RealSrcSpan sp) = LocalScope sp
+mkScope _ = NoScope
+
+mkLScope :: Located a -> Scope
+mkLScope = mkScope . getLoc
+
+combineScopes :: Scope -> Scope -> Scope
+combineScopes ModuleScope _ = ModuleScope
+combineScopes _ ModuleScope = ModuleScope
+combineScopes NoScope x = x
+combineScopes x NoScope = x
+combineScopes (LocalScope a) (LocalScope b) =
+  mkScope $ combineSrcSpans (RealSrcSpan a) (RealSrcSpan b)
+
+{-# INLINEABLE makeNode #-}
+makeNode
+  :: (Applicative m, Data a)
+  => a                       -- ^ helps fill in 'nodeAnnotations' (with 'Data')
+  -> SrcSpan                 -- ^ return an empty list if this is unhelpful
+  -> m [HieAST b]
+makeNode x spn = pure $ case spn of
+  RealSrcSpan span -> [Node (simpleNodeInfo cons typ) span []]
+  _ -> []
+  where
+    cons = mkFastString . show . toConstr $ x
+    typ = mkFastString . show . typeRepTyCon . typeOf $ x
+
+{-# INLINEABLE makeTypeNode #-}
+makeTypeNode
+  :: (Applicative m, Data a)
+  => a                       -- ^ helps fill in 'nodeAnnotations' (with 'Data')
+  -> SrcSpan                 -- ^ return an empty list if this is unhelpful
+  -> Type                    -- ^ type to associate with the node
+  -> m [HieAST Type]
+makeTypeNode x spn etyp = pure $ case spn of
+  RealSrcSpan span ->
+    [Node (NodeInfo (S.singleton (cons,typ)) [etyp] M.empty) span []]
+  _ -> []
+  where
+    cons = mkFastString . show . toConstr $ x
+    typ = mkFastString . show . typeRepTyCon . typeOf $ x
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index 7b66472d7a..c23f577bba 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -1291,6 +1291,8 @@ checkVersions hsc_env mod_summary iface
        ; if recompileRequired recomp then return (recomp, Nothing) else do {
        ; recomp <- checkHsig mod_summary iface
        ; if recompileRequired recomp then return (recomp, Nothing) else do {
+       ; recomp <- checkHie mod_summary
+       ; if recompileRequired recomp then return (recomp, Nothing) else do {
        ; recomp <- checkDependencies hsc_env mod_summary iface
        ; if recompileRequired recomp then return (recomp, Just iface) else do {
        ; recomp <- checkPlugins hsc_env iface
@@ -1313,7 +1315,7 @@ checkVersions hsc_env mod_summary iface
        ; updateEps_ $ \eps  -> eps { eps_is_boot = mod_deps }
        ; recomp <- checkList [checkModUsage this_pkg u | u <- mi_usages iface]
        ; return (recomp, Just iface)
-    }}}}}}}}}
+    }}}}}}}}}}
   where
     this_pkg = thisPackage (hsc_dflags hsc_env)
     -- This is a bit of a hack really
@@ -1365,6 +1367,22 @@ checkHsig mod_summary iface = do
         True -> up_to_date (text "implementing module unchanged")
         False -> return (RecompBecause "implementing module changed")
 
+-- | Check if @.hie@ file is out of date or missing.
+checkHie :: ModSummary -> IfG RecompileRequired
+checkHie mod_summary = do
+    dflags <- getDynFlags
+    let hie_date_opt = ms_hie_date mod_summary
+        hs_date = ms_hs_date mod_summary
+    pure $ case gopt Opt_WriteHie dflags of
+               False -> UpToDate
+               True -> case hie_date_opt of
+                           Nothing -> RecompBecause "HIE file is missing"
+                           Just hie_date
+                               | hie_date < hs_date
+                               -> RecompBecause "HIE file is out of date"
+                               | otherwise
+                               -> UpToDate
+
 -- | Check the flags haven't changed
 checkFlagHash :: HscEnv -> ModIface -> IfG RecompileRequired
 checkFlagHash hsc_env iface = do
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 295d36284f..f1a5cb46e0 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -75,6 +75,8 @@ import Data.Maybe
 import Data.Version
 import Data.Either      ( partitionEithers )
 
+import Data.Time        ( UTCTime )
+
 -- ---------------------------------------------------------------------------
 -- Pre-process
 
@@ -1016,6 +1018,7 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0
 
         let o_file = ml_obj_file location -- The real object file
             hi_file = ml_hi_file location
+            hie_file = ml_hie_file location
             dest_file | writeInterfaceOnlyMode dflags
                             = hi_file
                       | otherwise
@@ -1023,7 +1026,7 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0
 
   -- Figure out if the source has changed, for recompilation avoidance.
   --
-  -- Setting source_unchanged to True means that M.o seems
+  -- Setting source_unchanged to True means that M.o (or M.hie) seems
   -- to be up to date wrt M.hs; so no need to recompile unless imports have
   -- changed (which the compiler itself figures out).
   -- Setting source_unchanged to False tells the compiler that M.o is out of
@@ -1037,13 +1040,14 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0
                 --      (b) we aren't going all the way to .o file (e.g. ghc -S)
              then return SourceModified
                 -- Otherwise look at file modification dates
-             else do dest_file_exists <- doesFileExist dest_file
-                     if not dest_file_exists
-                        then return SourceModified       -- Need to recompile
-                        else do t2 <- getModificationUTCTime dest_file
-                                if t2 > src_timestamp
-                                  then return SourceUnmodified
-                                  else return SourceModified
+             else do dest_file_mod <- sourceModified dest_file src_timestamp
+                     hie_file_mod <- if gopt Opt_WriteHie dflags
+                                        then sourceModified hie_file
+                                                            src_timestamp
+                                        else pure False
+                     if dest_file_mod || hie_file_mod
+                        then return SourceModified
+                        else return SourceUnmodified
 
         PipeState{hsc_env=hsc_env'} <- getPipeState
 
@@ -1062,6 +1066,7 @@ runPhase (RealPhase (Hsc src_flavour)) input_fn dflags0
                                         ms_obj_date  = Nothing,
                                         ms_parsed_mod   = Nothing,
                                         ms_iface_date   = Nothing,
+                                        ms_hie_date     = Nothing,
                                         ms_textual_imps = imps,
                                         ms_srcimps      = src_imps }
 
@@ -1634,8 +1639,9 @@ getLocation src_flavour mod_name = do
         location1 <- liftIO $ mkHomeModLocation2 dflags mod_name basename suff
 
         -- Boot-ify it if necessary
-        let location2 | HsBootFile <- src_flavour = addBootSuffixLocn location1
-                      | otherwise                 = location1
+        let location2
+              | HsBootFile <- src_flavour = addBootSuffixLocnOut location1
+              | otherwise                 = location1
 
 
         -- Take -ohi into account if present
@@ -2251,6 +2257,18 @@ writeInterfaceOnlyMode dflags =
  gopt Opt_WriteInterface dflags &&
  HscNothing == hscTarget dflags
 
+-- | Figure out if a source file was modified after an output file (or if we
+-- anyways need to consider the source file modified since the output is gone).
+sourceModified :: FilePath -- ^ destination file we are looking for
+               -> UTCTime  -- ^ last time of modification of source file
+               -> IO Bool  -- ^ do we need to regenerate the output?
+sourceModified dest_file src_timestamp = do
+  dest_file_exists <- doesFileExist dest_file
+  if not dest_file_exists
+    then return True       -- Need to recompile
+     else do t2 <- getModificationUTCTime dest_file
+             return (t2 <= src_timestamp)
+
 -- | What phase to run after one of the backend code generators has run
 hscPostBackendPhase :: DynFlags -> HscSource -> HscTarget -> Phase
 hscPostBackendPhase _ HsBootFile _    =  StopLn
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 9e93e47eeb..6c4ee86084 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -511,6 +511,7 @@ data GeneralFlag
    | Opt_OmitInterfacePragmas
    | Opt_ExposeAllUnfoldings
    | Opt_WriteInterface -- forces .hi files to be written even with -fno-code
+   | Opt_WriteHie -- generate .hie files
 
    -- profiling opts
    | Opt_AutoSccsOnIndividualCafs
@@ -544,6 +545,7 @@ data GeneralFlag
    | Opt_GhciSandbox
    | Opt_GhciHistory
    | Opt_GhciLeakCheck
+   | Opt_ValidateHie
    | Opt_LocalGhciHistory
    | Opt_NoIt
    | Opt_HelpfulErrors
@@ -942,12 +944,14 @@ data DynFlags = DynFlags {
   objectDir             :: Maybe String,
   dylibInstallName      :: Maybe String,
   hiDir                 :: Maybe String,
+  hieDir                :: Maybe String,
   stubDir               :: Maybe String,
   dumpDir               :: Maybe String,
 
   objectSuf             :: String,
   hcSuf                 :: String,
   hiSuf                 :: String,
+  hieSuf                :: String,
 
   canGenerateDynamicToo :: IORef Bool,
   dynObjectSuf          :: String,
@@ -1910,12 +1914,14 @@ defaultDynFlags mySettings (myLlvmTargets, myLlvmPasses) =
         objectDir               = Nothing,
         dylibInstallName        = Nothing,
         hiDir                   = Nothing,
+        hieDir                  = Nothing,
         stubDir                 = Nothing,
         dumpDir                 = Nothing,
 
         objectSuf               = phaseInputExt StopLn,
         hcSuf                   = phaseInputExt HCc,
         hiSuf                   = "hi",
+        hieSuf                  = "hie",
 
         canGenerateDynamicToo   = panic "defaultDynFlags: No canGenerateDynamicToo",
         dynObjectSuf            = "dyn_" ++ phaseInputExt StopLn,
@@ -2493,10 +2499,10 @@ getVerbFlags dflags
   | verbosity dflags >= 4 = ["-v"]
   | otherwise             = []
 
-setObjectDir, setHiDir, setStubDir, setDumpDir, setOutputDir,
+setObjectDir, setHiDir, setHieDir, setStubDir, setDumpDir, setOutputDir,
          setDynObjectSuf, setDynHiSuf,
          setDylibInstallName,
-         setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
+         setObjectSuf, setHiSuf, setHieSuf, setHcSuf, parseDynLibLoaderMode,
          setPgmP, addOptl, addOptc, addOptP,
          addCmdlineFramework, addHaddockOpts, addGhciScript,
          setInteractivePrint
@@ -2506,18 +2512,24 @@ setOutputFile, setDynOutputFile, setOutputHi, setDumpPrefixForce
 
 setObjectDir  f d = d { objectDir  = Just f}
 setHiDir      f d = d { hiDir      = Just f}
+setHieDir     f d = d { hieDir     = Just f}
 setStubDir    f d = d { stubDir    = Just f
                       , includePaths = addGlobalInclude (includePaths d) [f] }
   -- -stubdir D adds an implicit -I D, so that gcc can find the _stub.h file
   -- \#included from the .hc file when compiling via C (i.e. unregisterised
   -- builds).
 setDumpDir    f d = d { dumpDir    = Just f}
-setOutputDir  f = setObjectDir f . setHiDir f . setStubDir f . setDumpDir f
+setOutputDir  f = setObjectDir f
+                . setHieDir f
+                . setHiDir f
+                . setStubDir f
+                . setDumpDir f
 setDylibInstallName  f d = d { dylibInstallName = Just f}
 
 setObjectSuf    f d = d { objectSuf    = f}
 setDynObjectSuf f d = d { dynObjectSuf = f}
 setHiSuf        f d = d { hiSuf        = f}
+setHieSuf       f d = d { hieSuf       = f}
 setDynHiSuf     f d = d { dynHiSuf     = f}
 setHcSuf        f d = d { hcSuf        = f}
 
@@ -3062,8 +3074,10 @@ dynamic_flags_deps = [
   , make_ord_flag defGhcFlag "dynosuf"           (hasArg setDynObjectSuf)
   , make_ord_flag defGhcFlag "hcsuf"             (hasArg setHcSuf)
   , make_ord_flag defGhcFlag "hisuf"             (hasArg setHiSuf)
+  , make_ord_flag defGhcFlag "hiesuf"            (hasArg setHieSuf)
   , make_ord_flag defGhcFlag "dynhisuf"          (hasArg setDynHiSuf)
   , make_ord_flag defGhcFlag "hidir"             (hasArg setHiDir)
+  , make_ord_flag defGhcFlag "hiedir"            (hasArg setHieDir)
   , make_ord_flag defGhcFlag "tmpdir"            (hasArg setTmpDir)
   , make_ord_flag defGhcFlag "stubdir"           (hasArg setStubDir)
   , make_ord_flag defGhcFlag "dumpdir"           (hasArg setDumpDir)
@@ -4088,6 +4102,7 @@ fFlagsDeps = [
   flagSpec "gen-manifest"                     Opt_GenManifest,
   flagSpec "ghci-history"                     Opt_GhciHistory,
   flagSpec "ghci-leak-check"                  Opt_GhciLeakCheck,
+  flagSpec "validate-ide-info"                Opt_ValidateHie,
   flagGhciSpec "local-ghci-history"           Opt_LocalGhciHistory,
   flagGhciSpec "no-it"                        Opt_NoIt,
   flagSpec "ghci-sandbox"                     Opt_GhciSandbox,
@@ -4143,6 +4158,7 @@ fFlagsDeps = [
   flagSpec "strictness"                       Opt_Strictness,
   flagSpec "use-rpaths"                       Opt_RPath,
   flagSpec "write-interface"                  Opt_WriteInterface,
+  flagSpec "write-ide-info"                   Opt_WriteHie,
   flagSpec "unbox-small-strict-fields"        Opt_UnboxSmallStrictFields,
   flagSpec "unbox-strict-fields"              Opt_UnboxStrictFields,
   flagSpec "version-macros"                   Opt_VersionMacros,
diff --git a/compiler/main/Finder.hs b/compiler/main/Finder.hs
index 57d608bbf7..2db0a5e0b4 100644
--- a/compiler/main/Finder.hs
+++ b/compiler/main/Finder.hs
@@ -482,23 +482,27 @@ mkHomeModLocation2 dflags mod src_basename ext = do
 
        obj_fn = mkObjPath  dflags src_basename mod_basename
        hi_fn  = mkHiPath   dflags src_basename mod_basename
+       hie_fn = mkHiePath  dflags src_basename mod_basename
 
    return (ModLocation{ ml_hs_file   = Just (src_basename <.> ext),
                         ml_hi_file   = hi_fn,
-                        ml_obj_file  = obj_fn })
+                        ml_obj_file  = obj_fn,
+                        ml_hie_file  = hie_fn })
 
 mkHiOnlyModLocation :: DynFlags -> Suffix -> FilePath -> String
                     -> IO ModLocation
 mkHiOnlyModLocation dflags hisuf path basename
  = do let full_basename = path </> basename
           obj_fn = mkObjPath  dflags full_basename basename
+          hie_fn = mkHiePath  dflags full_basename basename
       return ModLocation{    ml_hs_file   = Nothing,
                              ml_hi_file   = full_basename <.> hisuf,
                                 -- Remove the .hi-boot suffix from
                                 -- hi_file, if it had one.  We always
                                 -- want the name of the real .hi file
                                 -- in the ml_hi_file field.
-                             ml_obj_file  = obj_fn
+                             ml_obj_file  = obj_fn,
+                             ml_hie_file  = hie_fn
                   }
 
 -- | Constructs the filename of a .o file for a given source file.
@@ -532,6 +536,21 @@ mkHiPath dflags basename mod_basename = hi_basename <.> hisuf
                 hi_basename | Just dir <- hidir = dir </> mod_basename
                             | otherwise         = basename
 
+-- | Constructs the filename of a .hie file for a given source file.
+-- Does /not/ check whether the .hie file exists
+mkHiePath
+  :: DynFlags
+  -> FilePath           -- the filename of the source file, minus the extension
+  -> String             -- the module name with dots replaced by slashes
+  -> FilePath
+mkHiePath dflags basename mod_basename = hie_basename <.> hiesuf
+ where
+                hiedir = hieDir dflags
+                hiesuf = hieSuf dflags
+
+                hie_basename | Just dir <- hiedir = dir </> mod_basename
+                             | otherwise          = basename
+
 
 
 -- -----------------------------------------------------------------------------
diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs
index 39b6427173..8b2bc01ffe 100644
--- a/compiler/main/GhcMake.hs
+++ b/compiler/main/GhcMake.hs
@@ -2186,6 +2186,8 @@ summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf
                         then liftIO $ getObjTimestamp location NotBoot
                         else return Nothing
                   hi_timestamp <- maybeGetIfaceDate dflags location
+                  let hie_location = ml_hie_file location
+                  hie_timestamp <- modificationTimeIfExists hie_location
 
                   -- We have to repopulate the Finder's cache because it
                   -- was flushed before the downsweep.
@@ -2193,7 +2195,8 @@ summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf
                     (moduleName (ms_mod old_summary)) (ms_location old_summary)
 
                   return old_summary{ ms_obj_date = obj_timestamp
-                                    , ms_iface_date = hi_timestamp }
+                                    , ms_iface_date = hi_timestamp
+                                    , ms_hie_date = hie_timestamp }
            else
                 new_summary src_timestamp
 
@@ -2232,6 +2235,7 @@ summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf
                 else return Nothing
 
         hi_timestamp <- maybeGetIfaceDate dflags location
+        hie_timestamp <- modificationTimeIfExists (ml_hie_file location)
 
         extra_sig_imports <- findExtraSigImports hsc_env hsc_src mod_name
         required_by_imports <- implicitRequirements hsc_env the_imps
@@ -2247,6 +2251,7 @@ summariseFile hsc_env old_summaries file mb_phase obj_allowed maybe_buf
                              ms_textual_imps = the_imps ++ extra_sig_imports ++ required_by_imports,
                              ms_hs_date = src_timestamp,
                              ms_iface_date = hi_timestamp,
+                             ms_hie_date = hie_timestamp,
                              ms_obj_date = obj_timestamp })
 
 findSummaryBySourceFile :: [ModSummary] -> FilePath -> Maybe ModSummary
@@ -2304,8 +2309,10 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
                        then getObjTimestamp location is_boot
                        else return Nothing
                 hi_timestamp <- maybeGetIfaceDate dflags location
+                hie_timestamp <- modificationTimeIfExists (ml_hie_file location)
                 return (Just (Right old_summary{ ms_obj_date = obj_timestamp
-                                               , ms_iface_date = hi_timestamp}))
+                                               , ms_iface_date = hi_timestamp
+                                               , ms_hie_date = hie_timestamp }))
         | otherwise =
                 -- source changed: re-summarise.
                 new_summary location (ms_mod old_summary) src_fn src_timestamp
@@ -2389,6 +2396,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
               else return Nothing
 
         hi_timestamp <- maybeGetIfaceDate dflags location
+        hie_timestamp <- modificationTimeIfExists (ml_hie_file location)
 
         extra_sig_imports <- findExtraSigImports hsc_env hsc_src mod_name
         required_by_imports <- implicitRequirements hsc_env the_imps
@@ -2404,6 +2412,7 @@ summariseModule hsc_env old_summary_map is_boot (L loc wanted_mod)
                               ms_textual_imps = the_imps ++ extra_sig_imports ++ required_by_imports,
                               ms_hs_date   = src_timestamp,
                               ms_iface_date = hi_timestamp,
+                              ms_hie_date = hie_timestamp,
                               ms_obj_date  = obj_timestamp })))
 
 
diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs
index 9b9edf7d21..c2c912451b 100644
--- a/compiler/main/HscMain.hs
+++ b/compiler/main/HscMain.hs
@@ -85,6 +85,7 @@ module HscMain
 import GhcPrelude
 
 import Data.Data hiding (Fixity, TyCon)
+import Data.Maybe       ( fromJust )
 import Id
 import GHCi             ( addSptEntry )
 import GHCi.RemoteTypes ( ForeignHValue )
@@ -167,10 +168,15 @@ import Data.IORef
 import System.FilePath as FilePath
 import System.Directory
 import System.IO (fixIO)
-import qualified Data.Map as Map
+import qualified Data.Map as M
 import qualified Data.Set as S
 import Data.Set (Set)
 
+import HieAst           ( mkHieFile )
+import HieTypes         ( getAsts, hie_asts )
+import HieBin           ( readHieFile, writeHieFile )
+import HieDebug         ( diffFile, validateScopes )
+
 #include "HsVersions.h"
 
 
@@ -379,8 +385,8 @@ hscParse' mod_summary
                       hpm_module    = rdr_module,
                       hpm_src_files = srcs2,
                       hpm_annotations
-                              = (Map.fromListWith (++) $ annotations pst,
-                                 Map.fromList $ ((noSrcSpan,comment_q pst)
+                              = (M.fromListWith (++) $ annotations pst,
+                                 M.fromList $ ((noSrcSpan,comment_q pst)
                                                  :(annotations_comments pst)))
                    }
 
@@ -392,15 +398,41 @@ hscParse' mod_summary
 
 -- -----------------------------------------------------------------------------
 -- | If the renamed source has been kept, extract it. Dump it if requested.
-extract_renamed_stuff :: TcGblEnv -> Hsc (TcGblEnv, RenamedStuff)
-extract_renamed_stuff tc_result = do
+extract_renamed_stuff :: ModSummary -> TcGblEnv -> Hsc RenamedStuff
+extract_renamed_stuff mod_summary tc_result = do
     let rn_info = getRenamedStuff tc_result
 
     dflags <- getDynFlags
     liftIO $ dumpIfSet_dyn dflags Opt_D_dump_rn_ast "Renamer" $
                            showAstData NoBlankSrcSpan rn_info
 
-    return (tc_result, rn_info)
+    -- Create HIE files
+    when (gopt Opt_WriteHie dflags) $ do
+        hieFile <- mkHieFile mod_summary (tcg_binds tc_result)
+                                         (fromJust rn_info)
+        let out_file = ml_hie_file $ ms_location mod_summary
+        liftIO $ writeHieFile out_file hieFile
+
+        -- Validate HIE files
+        when (gopt Opt_ValidateHie dflags) $ do
+            hs_env <- Hsc $ \e w -> return (e, w)
+            liftIO $ do
+              -- Validate Scopes
+              case validateScopes $ getAsts $ hie_asts hieFile of
+                  [] -> putMsg dflags $ text "Got valid scopes"
+                  xs -> do
+                    putMsg dflags $ text "Got invalid scopes"
+                    mapM_ (putMsg dflags) xs
+              -- Roundtrip testing
+              nc <- readIORef $ hsc_NC hs_env
+              (file', _) <- readHieFile nc out_file
+              case diffFile hieFile file' of
+                [] ->
+                  putMsg dflags $ text "Got no roundtrip errors"
+                xs -> do
+                  putMsg dflags $ text "Got roundtrip errors"
+                  mapM_ (putMsg dflags) xs
+    return rn_info
 
 
 -- -----------------------------------------------------------------------------
@@ -408,22 +440,23 @@ extract_renamed_stuff tc_result = do
 hscTypecheckRename :: HscEnv -> ModSummary -> HsParsedModule
                    -> IO (TcGblEnv, RenamedStuff)
 hscTypecheckRename hsc_env mod_summary rdr_module = runHsc hsc_env $ do
-      tc_result <- hscTypecheck True mod_summary (Just rdr_module)
-      extract_renamed_stuff tc_result
+    tc_result <- hsc_typecheck True mod_summary (Just rdr_module)
+    rn_info <- extract_renamed_stuff mod_summary tc_result
+    return (tc_result, rn_info)
 
+-- | Rename and typecheck a module, but don't return the renamed syntax
 hscTypecheck :: Bool -- ^ Keep renamed source?
              -> ModSummary -> Maybe HsParsedModule
              -> Hsc TcGblEnv
 hscTypecheck keep_rn mod_summary mb_rdr_module = do
-    tc_result <- hscTypecheck' keep_rn mod_summary mb_rdr_module
-    _ <- extract_renamed_stuff tc_result
+    tc_result <- hsc_typecheck keep_rn mod_summary mb_rdr_module
+    _ <- extract_renamed_stuff mod_summary tc_result
     return tc_result
 
-
-hscTypecheck' :: Bool -- ^ Keep renamed source?
+hsc_typecheck :: Bool -- ^ Keep renamed source?
               -> ModSummary -> Maybe HsParsedModule
               -> Hsc TcGblEnv
-hscTypecheck' keep_rn mod_summary mb_rdr_module = do
+hsc_typecheck keep_rn mod_summary mb_rdr_module = do
     hsc_env <- getHscEnv
     let hsc_src = ms_hsc_src mod_summary
         dflags = hsc_dflags hsc_env
@@ -433,6 +466,7 @@ hscTypecheck' keep_rn mod_summary mb_rdr_module = do
         inner_mod = canonicalizeHomeModule dflags mod_name
         src_filename  = ms_hspp_file mod_summary
         real_loc = realSrcLocSpan $ mkRealSrcLoc (mkFastString src_filename) 1 1
+        keep_rn' = gopt Opt_WriteHie dflags || keep_rn
     MASSERT( moduleUnitId outer_mod == thisPackage dflags )
     if hsc_src == HsigFile && not (isHoleModule inner_mod)
         then ioMsgMaybe $ tcRnInstantiateSignature hsc_env outer_mod' real_loc
@@ -440,7 +474,7 @@ hscTypecheck' keep_rn mod_summary mb_rdr_module = do
          do hpm <- case mb_rdr_module of
                     Just hpm -> return hpm
                     Nothing -> hscParse' mod_summary
-            tc_result0 <- tcRnModule' mod_summary keep_rn hpm
+            tc_result0 <- tcRnModule' mod_summary keep_rn' hpm
             if hsc_src == HsigFile
                 then do (iface, _, _) <- liftIO $ hscSimpleIface hsc_env tc_result0 Nothing
                         ioMsgMaybe $
@@ -1411,7 +1445,8 @@ hscCompileCmmFile hsc_env filename output_filename = runHsc hsc_env $ do
   where
     no_loc = ModLocation{ ml_hs_file  = Just filename,
                           ml_hi_file  = panic "hscCompileCmmFile: no hi file",
-                          ml_obj_file = panic "hscCompileCmmFile: no obj file" }
+                          ml_obj_file = panic "hscCompileCmmFile: no obj file",
+                          ml_hie_file = panic "hscCompileCmmFile: no hie file"}
 
 -------------------- Stuff for new code gen ---------------------
 
@@ -1591,7 +1626,8 @@ hscDeclsWithLocation hsc_env0 str source linenumber =
     -- We use a basically null location for iNTERACTIVE
     let iNTERACTIVELoc = ModLocation{ ml_hs_file   = Nothing,
                                       ml_hi_file   = panic "hsDeclsWithLocation:ml_hi_file",
-                                      ml_obj_file  = panic "hsDeclsWithLocation:ml_hi_file"}
+                                      ml_obj_file  = panic "hsDeclsWithLocation:ml_obj_file",
+                                      ml_hie_file  = panic "hsDeclsWithLocation:ml_hie_file" }
     ds_result <- hscDesugar' iNTERACTIVELoc tc_gblenv
 
     {- Simplify -}
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index d0cf7e0dd8..456332daeb 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -2752,6 +2752,8 @@ data ModSummary
           -- ^ Timestamp of hi file, if we *only* are typechecking (it is
           -- 'Nothing' otherwise.
           -- See Note [Recompilation checking in -fno-code mode] and #9243
+        ms_hie_date   :: Maybe UTCTime,
+          -- ^ Timestamp of hie file, if we have one
         ms_srcimps      :: [(Maybe FastString, Located ModuleName)],
           -- ^ Source imports of the module
         ms_textual_imps :: [(Maybe FastString, Located ModuleName)],
@@ -2833,7 +2835,7 @@ showModMsg dflags target recomp mod_summary = showSDoc dflags $
 {-
 ************************************************************************
 *                                                                      *
-\subsection{Recmpilation}
+\subsection{Recompilation}
 *                                                                      *
 ************************************************************************
 -}
diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs
index 16b81015e1..77ea116042 100644
--- a/compiler/typecheck/TcRnMonad.hs
+++ b/compiler/typecheck/TcRnMonad.hs
@@ -238,6 +238,8 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
              maybe_rn_syntax empty_val
                 | dopt Opt_D_dump_rn_ast dflags = Just empty_val
 
+                | gopt Opt_WriteHie dflags       = Just empty_val
+
                   -- We want to serialize the documentation in the .hi-files,
                   -- and need to extract it from the renamed syntax first.
                   -- See 'ExtractDocs.extractDocs'.
diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index c8b4989bf3..4bd05da485 100644
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -409,6 +409,15 @@ instance Binary a => Binary [a] where
             loop n = do a <- get bh; as <- loop (n-1); return (a:as)
         loop len
 
+instance (Ix a, Binary a, Binary b) => Binary (Array a b) where
+    put_ bh arr = do
+        put_ bh $ bounds arr
+        put_ bh $ elems arr
+    get bh = do
+        bounds <- get bh
+        xs <- get bh
+        return $ listArray bounds xs
+
 instance (Binary a, Binary b) => Binary (a,b) where
     put_ bh (a,b) = do put_ bh a; put_ bh b
     get bh        = do a <- get bh
@@ -1147,14 +1156,27 @@ instance Binary a => Binary (Located a) where
             x <- get bh
             return (L l x)
 
+instance Binary RealSrcSpan where
+  put_ bh ss = do
+            put_ bh (srcSpanFile ss)
+            put_ bh (srcSpanStartLine ss)
+            put_ bh (srcSpanStartCol ss)
+            put_ bh (srcSpanEndLine ss)
+            put_ bh (srcSpanEndCol ss)
+
+  get bh = do
+            f <- get bh
+            sl <- get bh
+            sc <- get bh
+            el <- get bh
+            ec <- get bh
+            return (mkRealSrcSpan (mkRealSrcLoc f sl sc)
+                                  (mkRealSrcLoc f el ec))
+
 instance Binary SrcSpan where
   put_ bh (RealSrcSpan ss) = do
           putByte bh 0
-          put_ bh (srcSpanFile ss)
-          put_ bh (srcSpanStartLine ss)
-          put_ bh (srcSpanStartCol ss)
-          put_ bh (srcSpanEndLine ss)
-          put_ bh (srcSpanEndCol ss)
+          put_ bh ss
 
   put_ bh (UnhelpfulSpan s) = do
           putByte bh 1
@@ -1163,13 +1185,8 @@ instance Binary SrcSpan where
   get bh = do
           h <- getByte bh
           case h of
-            0 -> do f <- get bh
-                    sl <- get bh
-                    sc <- get bh
-                    el <- get bh
-                    ec <- get bh
-                    return (mkSrcSpan (mkSrcLoc f sl sc)
-                                      (mkSrcLoc f el ec))
+            0 -> do ss <- get bh
+                    return (RealSrcSpan ss)
             _ -> do s <- get bh
                     return (UnhelpfulSpan s)