summaryrefslogtreecommitdiff
path: root/compiler/rename
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/rename')
-rw-r--r--compiler/rename/RnBinds.hs69
-rw-r--r--compiler/rename/RnEnv.hs36
-rw-r--r--compiler/rename/RnExpr.hs28
-rw-r--r--compiler/rename/RnNames.hs30
-rw-r--r--compiler/rename/RnPat.hs45
-rw-r--r--compiler/rename/RnSource.hs66
-rw-r--r--compiler/rename/RnSplice.hs8
-rw-r--r--compiler/rename/RnTypes.hs17
8 files changed, 168 insertions, 131 deletions
diff --git a/compiler/rename/RnBinds.hs b/compiler/rename/RnBinds.hs
index f6a22f5df2..05a7080425 100644
--- a/compiler/rename/RnBinds.hs
+++ b/compiler/rename/RnBinds.hs
@@ -409,14 +409,15 @@ rnBindLHS name_maker _ bind@(FunBind { fun_id = rdr_name })
rnBindLHS name_maker _ (PatSynBind psb@PSB{ psb_id = rdrname })
| isTopRecNameMaker name_maker
= do { addLocM checkConName rdrname
- ; name <- lookupLocatedTopBndrRn rdrname -- Should be in scope already
- ; return (PatSynBind psb{ psb_id = name }) }
+ ; L _ name <- lookupLocatedTopBndrRn $ unLEmb rdrname
+ -- Should be in scope already
+ ; return (PatSynBind psb{ psb_id = reLEmb rdrname name }) }
| otherwise -- Pattern synonym, not at top level
= do { addErr localPatternSynonymErr -- Complain, but make up a fake
-- name so that we can carry on
- ; name <- applyNameMaker name_maker rdrname
- ; return (PatSynBind psb{ psb_id = name }) }
+ ; L _ name <- applyNameMaker name_maker $ unLEmb rdrname
+ ; return (PatSynBind psb{ psb_id = reLEmb rdrname name }) }
where
localPatternSynonymErr :: SDoc
localPatternSynonymErr
@@ -565,11 +566,11 @@ mkSigTvFn sigs = \n -> lookupNameEnv env n `orElse` []
get_scoped_tvs :: LSig Name -> Maybe ([Located Name], [Name])
-- Returns (binders, scoped tvs for those binders)
get_scoped_tvs (L _ (ClassOpSig _ names sig_ty))
- = Just (names, hsScopedTvs sig_ty)
+ = Just (map unLEmb names, hsScopedTvs sig_ty)
get_scoped_tvs (L _ (TypeSig names sig_ty))
- = Just (names, hsWcScopedTvs sig_ty)
+ = Just (map unLEmb names, hsWcScopedTvs sig_ty)
get_scoped_tvs (L _ (PatSynSig names sig_ty))
- = Just (names, hsScopedTvs sig_ty)
+ = Just (map unLEmb names, hsScopedTvs sig_ty)
get_scoped_tvs _ = Nothing
-- Process the fixity declarations, making a FastString -> (Located Fixity) map
@@ -587,19 +588,19 @@ makeMiniFixityEnv decls = foldlM add_one_sig emptyFsEnv decls
foldlM add_one env [ (loc,name_loc,name,fixity)
| L name_loc name <- names ]
- add_one env (loc, name_loc, name,fixity) = do
+ add_one env (loc, name_loc, name, fixity) = do
{ -- this fixity decl is a duplicate iff
-- the ReaderName's OccName's FastString is already in the env
-- (we only need to check the local fix_env because
-- definitions of non-local will be caught elsewhere)
- let { fs = occNameFS (rdrNameOcc name)
+ let { fs = occNameFS (rdrNameOcc $ unEmb name)
; fix_item = L loc fixity };
case lookupFsEnv env fs of
Nothing -> return $ extendFsEnv env fs fix_item
Just (L loc' _) -> do
{ setSrcSpan loc $
- addErrAt name_loc (dupFixityDecl loc' name)
+ addErrAt name_loc (dupFixityDecl loc' (unEmb name))
; return env}
}
@@ -625,7 +626,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name
-- invariant: no free vars here when it's a FunBind
= do { pattern_synonym_ok <- xoptM LangExt.PatternSynonyms
; unless pattern_synonym_ok (addErr patternSynonymErr)
- ; let sig_tvs = sig_fn name
+ ; let sig_tvs = sig_fn $ unEmb name
; ((pat', details'), fvs1) <- bindSigTyVarsFV sig_tvs $
rnPat PatSyn pat $ \pat' ->
@@ -662,10 +663,10 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name
Unidirectional -> return (Unidirectional, emptyFVs)
ImplicitBidirectional -> return (ImplicitBidirectional, emptyFVs)
ExplicitBidirectional mg ->
- do { (mg', fvs) <- bindSigTyVarsFV sig_tvs $
- rnMatchGroup (FunRhs (L l name) Prefix)
- rnLExpr mg
- ; return (ExplicitBidirectional mg', fvs) }
+ do { (mg', fvs) <- bindSigTyVarsFV sig_tvs $
+ rnMatchGroup (FunRhs (L l $ unEmb name) Prefix)
+ rnLExpr mg
+ ; return (ExplicitBidirectional mg', fvs) }
; mod <- getModule
; let fvs = fvs1 `plusFV` fvs2
@@ -684,7 +685,7 @@ rnPatSynBind sig_fn bind@(PSB { psb_id = L l name
_ -> []
; fvs' `seq` -- See Note [Free-variable space leak]
- return (bind', name : selector_names , fvs1)
+ return (bind', unEmb name : selector_names , fvs1)
-- Why fvs1? See Note [Pattern synonym builders don't yield dependencies]
}
where
@@ -888,7 +889,7 @@ renameSig _ (IdSig x)
= return (IdSig x, emptyFVs) -- Actually this never occurs
renameSig ctxt sig@(TypeSig vs ty)
- = do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
+ = do { new_vs <- mapM (lookupLESigOccRn ctxt sig) vs
; let doc = TypeSigCtx (ppr_sig_bndrs vs)
; (new_ty, fvs) <- rnHsSigWcType doc ty
; return (TypeSig new_vs new_ty, fvs) }
@@ -897,7 +898,7 @@ renameSig ctxt sig@(ClassOpSig is_deflt vs ty)
= do { defaultSigs_on <- xoptM LangExt.DefaultSignatures
; when (is_deflt && not defaultSigs_on) $
addErr (defaultSigErr sig)
- ; new_v <- mapM (lookupSigOccRn ctxt sig) vs
+ ; new_v <- mapM (lookupLESigOccRn ctxt sig) vs
; (new_ty, fvs) <- rnHsSigType ty_ctxt ty
; return (ClassOpSig is_deflt new_v new_ty, fvs) }
where
@@ -915,8 +916,8 @@ renameSig _ (SpecInstSig src ty)
-- then the SPECIALISE pragma is ambiguous, unlike all other signatures
renameSig ctxt sig@(SpecSig v tys inl)
= do { new_v <- case ctxt of
- TopSigCtxt {} -> lookupLocatedOccRn v
- _ -> lookupSigOccRn ctxt sig v
+ TopSigCtxt {} -> lookupLEmbellishedOccRn v
+ _ -> lookupLESigOccRn ctxt sig v
; (new_ty, fvs) <- foldM do_one ([],emptyFVs) tys
; return (SpecSig new_v new_ty inl, fvs) }
where
@@ -927,19 +928,19 @@ renameSig ctxt sig@(SpecSig v tys inl)
; return ( new_ty:tys, fvs_ty `plusFV` fvs) }
renameSig ctxt sig@(InlineSig v s)
- = do { new_v <- lookupSigOccRn ctxt sig v
+ = do { new_v <- lookupLESigOccRn ctxt sig v
; return (InlineSig new_v s, emptyFVs) }
renameSig ctxt sig@(FixSig (FixitySig vs f))
- = do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
+ = do { new_vs <- mapM (lookupLESigOccRn ctxt sig) vs
; return (FixSig (FixitySig new_vs f), emptyFVs) }
renameSig ctxt sig@(MinimalSig s (L l bf))
- = do new_bf <- traverse (lookupSigOccRn ctxt sig) bf
+ = do new_bf <- traverse (lookupLESigOccRn ctxt sig) bf
return (MinimalSig s (L l new_bf), emptyFVs)
renameSig ctxt sig@(PatSynSig vs ty)
- = do { new_vs <- mapM (lookupSigOccRn ctxt sig) vs
+ = do { new_vs <- mapM (lookupLESigOccRn ctxt sig) vs
; (ty', fvs) <- rnHsSigType ty_ctxt ty
; return (PatSynSig new_vs ty', fvs) }
where
@@ -947,17 +948,17 @@ renameSig ctxt sig@(PatSynSig vs ty)
<+> ppr_sig_bndrs vs)
renameSig ctxt sig@(SCCFunSig st v s)
- = do { new_v <- lookupSigOccRn ctxt sig v
+ = do { new_v <- lookupLESigOccRn ctxt sig v
; return (SCCFunSig st new_v s, emptyFVs) }
-- COMPLETE Sigs can refer to imported IDs which is why we use
-- lookupLocatedOccRn rather than lookupSigOccRn
renameSig _ctxt (CompleteMatchSig s (L l bf) mty)
- = do new_bf <- traverse lookupLocatedOccRn bf
- new_mty <- traverse lookupLocatedOccRn mty
+ = do new_bf <- traverse lookupLEmbellishedOccRn bf
+ new_mty <- traverse lookupLEmbellishedOccRn mty
return (CompleteMatchSig s (L l new_bf) new_mty, emptyFVs)
-ppr_sig_bndrs :: [Located RdrName] -> SDoc
+ppr_sig_bndrs :: [LEmbellished RdrName] -> SDoc
ppr_sig_bndrs bs = quotes (pprWithCommas ppr bs)
okHsSig :: HsSigCtxt -> LSig a -> Bool
@@ -1014,12 +1015,12 @@ findDupSigs :: [LSig RdrName] -> [[(Located RdrName, Sig RdrName)]]
findDupSigs sigs
= findDupsEq matching_sig (concatMap (expand_sig . unLoc) sigs)
where
- expand_sig sig@(FixSig (FixitySig ns _)) = zip ns (repeat sig)
- expand_sig sig@(InlineSig n _) = [(n,sig)]
- expand_sig sig@(TypeSig ns _) = [(n,sig) | n <- ns]
- expand_sig sig@(ClassOpSig _ ns _) = [(n,sig) | n <- ns]
- expand_sig sig@(PatSynSig ns _ ) = [(n,sig) | n <- ns]
- expand_sig sig@(SCCFunSig _ n _) = [(n,sig)]
+ expand_sig sig@(FixSig (FixitySig ns _)) = zip (map unLEmb ns) (repeat sig)
+ expand_sig sig@(InlineSig n _) = [(unLEmb n,sig)]
+ expand_sig sig@(TypeSig ns _) = [(unLEmb n,sig) | n <- ns]
+ expand_sig sig@(ClassOpSig _ ns _) = [(unLEmb n,sig) | n <- ns]
+ expand_sig sig@(PatSynSig ns _ ) = [(unLEmb n,sig) | n <- ns]
+ expand_sig sig@(SCCFunSig _ n _) = [(unLEmb n,sig)]
expand_sig _ = []
matching_sig (L _ n1,sig1) (L _ n2,sig2) = n1 == n2 && mtch sig1 sig2
diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index 7c05994c0a..3ed1bf8137 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -9,7 +9,9 @@
module RnEnv (
newTopSrcBinder,
lookupLocatedTopBndrRn, lookupTopBndrRn,
+ lookupLEmbellishedTopBndrRn,
lookupLocatedOccRn, lookupOccRn, lookupOccRn_maybe,
+ lookupLEmbellishedOccRn,
lookupLocalOccRn_maybe, lookupInfoOccRn,
lookupLocalOccThLvl_maybe,
lookupTypeOccRn, lookupKindOccRn,
@@ -19,6 +21,7 @@ module RnEnv (
addNameClashErrRn,
HsSigCtxt(..), lookupLocalTcNames, lookupSigOccRn,
+ lookupLESigOccRn,
lookupSigCtxtOccRn,
lookupFixityRn, lookupFixityRn_help,
@@ -249,6 +252,13 @@ lookupTopBndrRn n = do nopt <- lookupTopBndrRn_maybe n
Nothing -> do traceRn "lookupTopBndrRn fail" (ppr n)
unboundName WL_LocalTop n
+lookupLEmbellishedTopBndrRn :: LEmbellished RdrName -> RnM (LEmbellished Name)
+lookupLEmbellishedTopBndrRn = wrapLocM lookup
+ where
+ lookup en = do
+ n <- lookupTopBndrRn (unEmb en)
+ return (reEmb en n)
+
lookupLocatedTopBndrRn :: Located RdrName -> RnM (Located Name)
lookupLocatedTopBndrRn = wrapLocM lookupTopBndrRn
@@ -668,6 +678,13 @@ getLookupOccRn
mkUnboundNameRdr :: RdrName -> Name
mkUnboundNameRdr rdr = mkUnboundName (rdrNameOcc rdr)
+lookupLEmbellishedOccRn :: LEmbellished RdrName -> RnM (LEmbellished Name)
+lookupLEmbellishedOccRn = wrapLocM lookup
+ where
+ lookup emb = do
+ n <- lookupOccRn (unEmb emb)
+ return (reEmb emb n)
+
lookupLocatedOccRn :: Located RdrName -> RnM (Located Name)
lookupLocatedOccRn = wrapLocM lookupOccRn
@@ -921,7 +938,7 @@ lookupGlobalOccRn_overloaded overload_ok rdr_name
; let
fld_occ :: FieldOcc Name
fld_occ
- = FieldOcc (noLoc rdr_name) (gre_name gre)
+ = FieldOcc (noEmb rdr_name) (gre_name gre)
; return (Just (Right [fld_occ])) }
| otherwise
-> do { addUsedGRE True gre
@@ -931,7 +948,7 @@ lookupGlobalOccRn_overloaded overload_ok rdr_name
-- until we know which is meant
-> return
(Just (Right
- (map (FieldOcc (noLoc rdr_name) . gre_name)
+ (map (FieldOcc (noEmb rdr_name) . gre_name)
gres)))
gres -> do { addNameClashErrRn rdr_name gres
; return (Just (Left (gre_name (head gres)))) } }
@@ -1224,6 +1241,13 @@ instance Outputable HsSigCtxt where
ppr (HsBootCtxt ns) = text "HsBootCtxt" <+> ppr ns
ppr (RoleAnnotCtxt ns) = text "RoleAnnotCtxt" <+> ppr ns
+lookupLESigOccRn :: HsSigCtxt
+ -> Sig RdrName
+ -> LEmbellished RdrName -> RnM (LEmbellished Name)
+lookupLESigOccRn ctxt sig le = do
+ L _ n <- lookupSigOccRn ctxt sig (unLEmb le)
+ return (reLEmb le n )
+
lookupSigOccRn :: HsSigCtxt
-> Sig RdrName
-> Located RdrName -> RnM (Located Name)
@@ -1496,8 +1520,8 @@ lookupTyFixityRn (L _ n) = lookupFixityRn n
-- multiple possible selectors with different fixities, generate an error.
lookupFieldFixityRn :: AmbiguousFieldOcc Name -> RnM Fixity
lookupFieldFixityRn (Unambiguous (L _ rdr) n)
- = lookupFixityRn' n (rdrNameOcc rdr)
-lookupFieldFixityRn (Ambiguous (L _ rdr) _) = get_ambiguous_fixity rdr
+ = lookupFixityRn' n (rdrNameOcc $ unEmb rdr)
+lookupFieldFixityRn (Ambiguous (L _ rdr) _) = get_ambiguous_fixity $ unEmb rdr
where
get_ambiguous_fixity :: RdrName -> RnM Fixity
get_ambiguous_fixity rdr_name = do
@@ -1636,10 +1660,10 @@ lookupSyntaxNames :: [Name] -- Standard names
lookupSyntaxNames std_names
= do { rebindable_on <- xoptM LangExt.RebindableSyntax
; if not rebindable_on then
- return (map (HsVar . noLoc) std_names, emptyFVs)
+ return (map (HsVar . noEmb) std_names, emptyFVs)
else
do { usr_names <- mapM (lookupOccRn . mkRdrUnqual . nameOccName) std_names
- ; return (map (HsVar . noLoc) usr_names, mkFVs usr_names) } }
+ ; return (map (HsVar . noEmb) usr_names, mkFVs usr_names) } }
{-
*********************************************************
diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs
index 4e9192c26e..ddbd76249c 100644
--- a/compiler/rename/RnExpr.hs
+++ b/compiler/rename/RnExpr.hs
@@ -78,14 +78,14 @@ rnLExpr = wrapLocFstM rnExpr
rnExpr :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars)
-finishHsVar :: Located Name -> RnM (HsExpr Name, FreeVars)
+finishHsVar :: LEmbellished Name -> RnM (HsExpr Name, FreeVars)
-- Separated from rnExpr because it's also used
-- when renaming infix expressions
finishHsVar (L l name)
= do { this_mod <- getModule
- ; when (nameIsLocalOrFrom this_mod name) $
- checkThLocalName name
- ; return (HsVar (L l name), unitFV name) }
+ ; when (nameIsLocalOrFrom this_mod $ unEmb name) $
+ checkThLocalName $ unEmb name
+ ; return (HsVar (L l name), unitFV $ unEmb name) }
rnUnboundVar :: RdrName -> RnM (HsExpr Name, FreeVars)
rnUnboundVar v
@@ -101,20 +101,20 @@ rnUnboundVar v
else -- Fail immediately (qualified name)
do { n <- reportUnboundName v
- ; return (HsVar (noLoc n), emptyFVs) } }
+ ; return (HsVar (noEmb n), emptyFVs) } }
rnExpr (HsVar (L l v))
= do { opt_DuplicateRecordFields <- xoptM LangExt.DuplicateRecordFields
- ; mb_name <- lookupOccRn_overloaded opt_DuplicateRecordFields v
+ ; mb_name <- lookupOccRn_overloaded opt_DuplicateRecordFields $ unEmb v
; case mb_name of {
- Nothing -> rnUnboundVar v ;
+ Nothing -> rnUnboundVar $ unEmb v ;
Just (Left name)
| name == nilDataConName -- Treat [] as an ExplicitList, so that
-- OverloadedLists works correctly
-> rnExpr (ExplicitList placeHolderType Nothing [])
| otherwise
- -> finishHsVar (L l name) ;
+ -> finishHsVar (L l (reEmb v name)) ;
Just (Right [f@(FieldOcc (L _ fn) s)]) ->
return (HsRecFld (ambiguousFieldOcc (FieldOcc (L l fn) s))
, unitFV (selectorFieldOcc f)) ;
@@ -170,7 +170,7 @@ rnExpr (OpApp e1 op _ e2)
-- more, so I've removed the test. Adding HsPars in TcGenDeriv
-- should prevent bad things happening.
; fixity <- case op' of
- L _ (HsVar (L _ n)) -> lookupFixityRn n
+ L _ (HsVar (L _ n)) -> lookupFixityRn $ unEmb n
L _ (HsRecFld f) -> lookupFieldFixityRn f
_ -> return (Fixity NoSourceText minPrecedence InfixL)
-- c.f. lookupFixity for unbound
@@ -289,7 +289,7 @@ rnExpr (RecordCon { rcon_con_name = con_id
, rcon_con_expr = noPostTcExpr, rcon_con_like = PlaceHolder }
, fvs `plusFV` plusFVs fvss `addOneFV` con_name) }
where
- mk_hs_var l n = HsVar (L l n)
+ mk_hs_var l n = HsVar (L l $ EName n)
rn_field (L l fld) = do { (arg', fvs) <- rnLExpr (hsRecFieldArg fld)
; return (L l (fld { hsRecFieldArg = arg' }), fvs) }
@@ -481,7 +481,7 @@ rnCmd (HsCmdArrForm op _ (Just _) [arg1, arg2])
; (arg1',fv_arg1) <- rnCmdTop arg1
; (arg2',fv_arg2) <- rnCmdTop arg2
-- Deal with fixity
- ; fixity <- lookupFixityRn op_name
+ ; fixity <- lookupFixityRn $ unEmb op_name
; final_e <- mkOpFormRn arg1' op' fixity arg2'
; return (final_e, fv_arg1 `plusFV` fv_op `plusFV` fv_arg2) }
@@ -972,12 +972,12 @@ lookupStmtNamePoly ctxt name
= do { rebindable_on <- xoptM LangExt.RebindableSyntax
; if rebindable_on
then do { fm <- lookupOccRn (nameRdrName name)
- ; return (HsVar (noLoc fm), unitFV fm) }
+ ; return (HsVar (noEmb fm), unitFV fm) }
else not_rebindable }
| otherwise
= not_rebindable
where
- not_rebindable = return (HsVar (noLoc name), emptyFVs)
+ not_rebindable = return (HsVar (noEmb name), emptyFVs)
-- | Is this a context where we respect RebindableSyntax?
-- but ListComp/PArrComp are never rebindable
@@ -1820,7 +1820,7 @@ isReturnApp monad_names (L _ e) = case e of
where
is_var f (L _ (HsPar e)) = is_var f e
is_var f (L _ (HsAppType e _)) = is_var f e
- is_var f (L _ (HsVar (L _ r))) = f r
+ is_var f (L _ (HsVar (L _ r))) = f $ unEmb r
-- TODO: I don't know how to get this right for rebindable syntax
is_var _ _ = False
diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs
index dc9cdd9063..15e6133393 100644
--- a/compiler/rename/RnNames.hs
+++ b/compiler/rename/RnNames.hs
@@ -577,7 +577,7 @@ getLocalNonValBinders fixity_env
-- type sigs in case of a hs-boot file only
; is_boot <- tcIsHsBootOrSig
; let val_bndrs | is_boot = hs_boot_sig_bndrs
- | otherwise = for_hs_bndrs
+ | otherwise = map lEmb for_hs_bndrs
; val_avails <- mapM new_simple val_bndrs
; let avails = concat nti_availss ++ val_avails
@@ -607,15 +607,16 @@ getLocalNonValBinders fixity_env
-- the SrcSpan attached to the input should be the span of the
-- declaration, not just the name
- new_simple :: Located RdrName -> RnM AvailInfo
- new_simple rdr_name = do{ nm <- newTopSrcBinder rdr_name
+ new_simple :: LEmbellished RdrName -> RnM AvailInfo
+ new_simple rdr_name = do{ nm <- newTopSrcBinder $ unLEmb rdr_name
; return (avail nm) }
new_tc :: Bool -> LTyClDecl RdrName
-> RnM (AvailInfo, [(Name, [FieldLabel])])
new_tc overload_ok tc_decl -- NOT for type/data instances
= do { let (bndrs, flds) = hsLTyClDeclBinders tc_decl
- ; names@(main_name : sub_names) <- mapM newTopSrcBinder bndrs
+ ; names@(main_name : sub_names)
+ <- mapM (newTopSrcBinder . unLEmb) bndrs
; flds' <- mapM (newRecordSelector overload_ok sub_names) flds
; let fld_env = case unLoc tc_decl of
DataDecl { tcdDataDefn = d } -> mk_fld_env d names flds'
@@ -631,12 +632,12 @@ getLocalNonValBinders fixity_env
where
find_con_flds (L _ (ConDeclH98 { con_name = L _ rdr
, con_details = RecCon cdflds }))
- = [( find_con_name rdr
+ = [( find_con_name $ unEmb rdr
, concatMap find_con_decl_flds (unLoc cdflds) )]
find_con_flds (L _ (ConDeclGADT
{ con_names = rdrs
, con_type = (HsIB { hsib_body = res_ty})}))
- = map (\ (L _ rdr) -> ( find_con_name rdr
+ = map (\ (L _ rdr) -> ( find_con_name $ unEmb rdr
, concatMap find_con_decl_flds cdflds))
rdrs
where
@@ -657,7 +658,7 @@ getLocalNonValBinders fixity_env
find_con_decl_fld (L _ (FieldOcc (L _ rdr) _))
= expectJust "getLocalNonValBinders/find_con_decl_fld" $
find (\ fl -> flLabel fl == lbl) flds
- where lbl = occNameFS (rdrNameOcc rdr)
+ where lbl = occNameFS (rdrNameOcc $ unEmb rdr)
new_assoc :: Bool -> LInstDecl RdrName
-> RnM ([AvailInfo], [(Name, [FieldLabel])])
@@ -683,7 +684,7 @@ getLocalNonValBinders fixity_env
new_di overload_ok mb_cls ti_decl
= do { main_name <- lookupFamInstName mb_cls (dfid_tycon ti_decl)
; let (bndrs, flds) = hsDataFamInstBinders ti_decl
- ; sub_names <- mapM newTopSrcBinder bndrs
+ ; sub_names <- mapM (newTopSrcBinder . unLEmb) bndrs
; flds' <- mapM (newRecordSelector overload_ok sub_names) flds
; let avail = AvailTC (unLoc main_name) sub_names flds'
-- main_name is not bound here!
@@ -697,19 +698,19 @@ getLocalNonValBinders fixity_env
newRecordSelector :: Bool -> [Name] -> LFieldOcc RdrName -> RnM FieldLabel
newRecordSelector _ [] _ = error "newRecordSelector: datatype has no constructors!"
newRecordSelector overload_ok (dc:_) (L loc (FieldOcc (L _ fld) _))
- = do { selName <- newTopSrcBinder $ L loc $ field
+ = do { selName <- newTopSrcBinder $ L loc $ unEmb field
; return $ qualFieldLbl { flSelector = selName } }
where
- fieldOccName = occNameFS $ rdrNameOcc fld
+ fieldOccName = occNameFS $ rdrNameOcc $ unEmb fld
qualFieldLbl = mkFieldLabelOccs fieldOccName (nameOccName dc) overload_ok
- field | isExact fld = fld
+ field | isExact $ unEmb fld = fld
-- use an Exact RdrName as is to preserve the bindings
-- of an already renamer-resolved field and its use
-- sites. This is needed to correctly support record
-- selectors in Template Haskell. See Note [Binders in
-- Template Haskell] in Convert.hs and Note [Looking up
-- Exact RdrNames] in RnEnv.hs.
- | otherwise = mkRdrUnqual (flSelector qualFieldLbl)
+ | otherwise = EName $ mkRdrUnqual (flSelector qualFieldLbl)
{-
Note [Looking up family names in family instances]
@@ -1618,8 +1619,9 @@ packageImportErr
-- data T = :% Int Int
-- from interface files, which always print in prefix form
-checkConName :: RdrName -> TcRn ()
-checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
+checkConName :: Embellished RdrName -> TcRn ()
+checkConName name
+ = checkErr (isRdrDataCon $ unEmb name) (badDataCon $ unEmb name)
badDataCon :: RdrName -> SDoc
badDataCon name
diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs
index 3417494e21..fcaf891995 100644
--- a/compiler/rename/RnPat.hs
+++ b/compiler/rename/RnPat.hs
@@ -426,9 +426,9 @@ rnPatAndThen mk (NPlusKPat rdr (L l lit) _ _ _ _)
-- The Report says that n+k patterns must be in Integral
rnPatAndThen mk (AsPat rdr pat)
- = do { new_name <- newPatLName mk rdr
+ = do { new_name <- newPatLName mk $ unLEmb rdr
; pat' <- rnLPatAndThen mk pat
- ; return (AsPat new_name pat') }
+ ; return (AsPat (reLEmb rdr (unLoc new_name)) pat') }
rnPatAndThen mk p@(ViewPat expr pat _ty)
= do { liftCps $ do { vp_flag <- xoptM LangExt.ViewPatterns
@@ -589,13 +589,13 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
= L loc (FieldOcc (L ll lbl) _)
, hsRecFieldArg = arg
, hsRecPun = pun }))
- = do { sel <- setSrcSpan loc $ lookupRecFieldOcc parent doc lbl
+ = do { sel <- setSrcSpan loc $ lookupRecFieldOcc parent doc (unEmb lbl)
; arg' <- if pun
- then do { checkErr pun_ok (badPun (L loc lbl))
- -- Discard any module qualifier (#11662)
- ; let arg_rdr = mkRdrUnqual (rdrNameOcc lbl)
- ; return (L loc (mk_arg loc arg_rdr)) }
- else return arg
+ then do { checkErr pun_ok (badPun (L loc $ unEmb lbl))
+ -- Discard any module qualifier (#11662)
+ ; let arg_rdr = mkRdrUnqual (rdrNameOcc $ unEmb lbl)
+ ; return (L loc (mk_arg loc arg_rdr)) }
+ else return arg
; return (L l (HsRecField { hsRecFieldLbl
= L loc (FieldOcc (L ll lbl) sel)
, hsRecFieldArg = arg'
@@ -640,7 +640,8 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot })
; addUsedGREs dot_dot_gres
; return [ L loc (HsRecField
- { hsRecFieldLbl = L loc (FieldOcc (L loc arg_rdr) sel)
+ { hsRecFieldLbl
+ = L loc (FieldOcc (L loc $ EName arg_rdr) sel)
, hsRecFieldArg = L loc (mk_arg loc arg_rdr)
, hsRecPun = False })
| fl <- dot_dot_fields
@@ -724,17 +725,20 @@ rnHsRecUpdFields flds
-- Defer renaming of overloaded fields to the typechecker
-- See Note [Disambiguating record fields] in TcExpr
if overload_ok
- then do { mb <- lookupGlobalOccRn_overloaded overload_ok lbl
+ then do { mb <- lookupGlobalOccRn_overloaded
+ overload_ok (unEmb lbl)
; case mb of
- Nothing -> do { addErr (unknownSubordinateErr doc lbl)
- ; return (Right []) }
+ Nothing -> do
+ { addErr (unknownSubordinateErr doc
+ (unEmb lbl))
+ ; return (Right []) }
Just r -> return r }
- else fmap Left $ lookupGlobalOccRn lbl
+ else fmap Left $ lookupGlobalOccRn $ unEmb lbl
; arg' <- if pun
- then do { checkErr pun_ok (badPun (L loc lbl))
- -- Discard any module qualifier (#11662)
- ; let arg_rdr = mkRdrUnqual (rdrNameOcc lbl)
- ; return (L loc (HsVar (L loc arg_rdr))) }
+ then do { checkErr pun_ok (badPun (L loc $ unEmb lbl))
+ -- Discard any module qualifier (#11662)
+ ; let arg_rdr = mkRdrUnqual (rdrNameOcc $ unEmb lbl)
+ ; return (L loc (HsVar (L loc (reEmb lbl arg_rdr)))) }
else return arg
; (arg'', fvs) <- rnLExpr arg'
@@ -766,10 +770,11 @@ getFieldIds flds = map (unLoc . hsRecFieldSel . unLoc) flds
getFieldLbls :: [LHsRecField id arg] -> [RdrName]
getFieldLbls flds
- = map (unLoc . rdrNameFieldOcc . unLoc . hsRecFieldLbl . unLoc) flds
+ = map (unLocEmb . rdrNameFieldOcc . unLoc . hsRecFieldLbl . unLoc) flds
getFieldUpdLbls :: [LHsRecUpdField id] -> [RdrName]
-getFieldUpdLbls flds = map (rdrNameAmbiguousFieldOcc . unLoc . hsRecFieldLbl . unLoc) flds
+getFieldUpdLbls flds
+ = map (unEmb . rdrNameAmbiguousFieldOcc . unLoc . hsRecFieldLbl . unLoc) flds
needFlagDotDot :: HsRecFieldContext -> SDoc
needFlagDotDot ctxt = vcat [text "Illegal `..' in record" <+> pprRFC ctxt,
@@ -832,7 +837,7 @@ rnOverLit origLit
; (SyntaxExpr { syn_expr = from_thing_name }, fvs)
<- lookupSyntaxName std_name
; let rebindable = case from_thing_name of
- HsVar (L _ v) -> v /= std_name
+ HsVar (L _ v) -> unEmb v /= std_name
_ -> panic "rnOverLit"
; return (lit { ol_witness = from_thing_name
, ol_rebindable = rebindable
diff --git a/compiler/rename/RnSource.hs b/compiler/rename/RnSource.hs
index 3e462744e1..5234308475 100644
--- a/compiler/rename/RnSource.hs
+++ b/compiler/rename/RnSource.hs
@@ -284,12 +284,12 @@ rnSrcFixityDecls bndr_set fix_decls
return [ L loc (FixitySig name fixity)
| name <- names ]
- lookup_one :: Located RdrName -> RnM [Located Name]
+ lookup_one :: LEmbellished RdrName -> RnM [LEmbellished Name]
lookup_one (L name_loc rdr_name)
= setSrcSpan name_loc $
-- this lookup will fail if the definition isn't local
- do names <- lookupLocalTcNames sig_ctxt what rdr_name
- return [ L name_loc name | (_, name) <- names ]
+ do names <- lookupLocalTcNames sig_ctxt what $ unEmb rdr_name
+ return [ L name_loc (reEmb rdr_name name) | (_, name) <- names ]
what = text "fixity signature"
{-
@@ -325,14 +325,14 @@ rnSrcWarnDecls bndr_set decls'
rn_deprec (Warning rdr_names txt)
-- ensures that the names are defined locally
- = do { names <- concatMapM (lookupLocalTcNames sig_ctxt what . unLoc)
+ = do { names <- concatMapM (lookupLocalTcNames sig_ctxt what . unLocEmb)
rdr_names
; return [(rdrNameOcc rdr, txt) | (rdr, _) <- names] }
what = text "deprecation"
- warn_rdr_dups = findDupRdrNames $ concatMap (\(L _ (Warning ns _)) -> ns)
- decls
+ warn_rdr_dups = findDupRdrNames
+ $ concatMap (\(L _ (Warning ns _)) -> map unLEmb ns) decls
findDupRdrNames :: [Located RdrName] -> [[Located RdrName]]
findDupRdrNames = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
@@ -607,7 +607,7 @@ checkCanonicalInstances cls poly_ty mbinds = do
isAliasMG MG {mg_alts = L _ [L _ (Match { m_pats = [], m_grhss = grhss })]}
| GRHSs [L _ (GRHS [] body)] lbinds <- grhss
, L _ EmptyLocalBinds <- lbinds
- , L _ (HsVar (L _ rhsName)) <- body = Just rhsName
+ , L _ (HsVar (L _ rhsName)) <- body = Just $ unEmb rhsName
isAliasMG _ = Nothing
-- got "lhs = rhs" but expected something different
@@ -1051,7 +1051,7 @@ validRuleLhs foralls lhs
check (OpApp e1 op _ e2) = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2
check (HsApp e1 e2) = checkl e1 `mplus` checkl_e e2
check (HsAppType e _) = checkl e
- check (HsVar (L _ v)) | v `notElem` foralls = Nothing
+ check (HsVar (L _ v)) | unEmb v `notElem` foralls = Nothing
check other = Just other -- Failure
-- Check an argument
@@ -1102,9 +1102,9 @@ rnHsVectDecl :: VectDecl RdrName -> RnM (VectDecl Name, FreeVars)
-- FIXME: For the moment, the right-hand side is restricted to be a variable as we cannot properly
-- typecheck a complex right-hand side without invoking 'vectType' from the vectoriser.
rnHsVectDecl (HsVect s var rhs@(L _ (HsVar _)))
- = do { var' <- lookupLocatedOccRn var
+ = do { var' <- lookupLEmbellishedOccRn var
; (rhs', fv_rhs) <- rnLExpr rhs
- ; return (HsVect s var' rhs', fv_rhs `addOneFV` unLoc var')
+ ; return (HsVect s var' rhs', fv_rhs `addOneFV` unLocEmb var')
}
rnHsVectDecl (HsVect _ _var _rhs)
= failWith $ vcat
@@ -1112,24 +1112,26 @@ rnHsVectDecl (HsVect _ _var _rhs)
, text "must be an identifier"
]
rnHsVectDecl (HsNoVect s var)
- = do { var' <- lookupLocatedTopBndrRn var -- only applies to local (not imported) names
- ; return (HsNoVect s var', unitFV (unLoc var'))
+ = do { var' <- lookupLEmbellishedTopBndrRn var
+ -- only applies to local (not imported) names
+ ; return (HsNoVect s var', unitFV (unLocEmb var'))
}
rnHsVectDecl (HsVectTypeIn s isScalar tycon Nothing)
- = do { tycon' <- lookupLocatedOccRn tycon
- ; return (HsVectTypeIn s isScalar tycon' Nothing, unitFV (unLoc tycon'))
+ = do { tycon' <- lookupLEmbellishedOccRn tycon
+ ; return (HsVectTypeIn s isScalar tycon' Nothing
+ , unitFV (unLocEmb tycon'))
}
rnHsVectDecl (HsVectTypeIn s isScalar tycon (Just rhs_tycon))
- = do { tycon' <- lookupLocatedOccRn tycon
- ; rhs_tycon' <- lookupLocatedOccRn rhs_tycon
+ = do { tycon' <- lookupLEmbellishedOccRn tycon
+ ; rhs_tycon' <- lookupLEmbellishedOccRn rhs_tycon
; return ( HsVectTypeIn s isScalar tycon' (Just rhs_tycon')
- , mkFVs [unLoc tycon', unLoc rhs_tycon'])
+ , mkFVs [unLocEmb tycon', unLocEmb rhs_tycon'])
}
rnHsVectDecl (HsVectTypeOut _ _ _)
= panic "RnSource.rnHsVectDecl: Unexpected 'HsVectTypeOut'"
rnHsVectDecl (HsVectClassIn s cls)
- = do { cls' <- lookupLocatedOccRn cls
- ; return (HsVectClassIn s cls', unitFV (unLoc cls'))
+ = do { cls' <- lookupLEmbellishedOccRn cls
+ ; return (HsVectClassIn s cls', unitFV (unLocEmb cls'))
}
rnHsVectDecl (HsVectClassOut _)
= panic "RnSource.rnHsVectDecl: Unexpected 'HsVectClassOut'"
@@ -1514,8 +1516,8 @@ rnRoleAnnots tc_names role_annots
-- decls defined in this group (see #10263)
tycon' <- lookupSigCtxtOccRn (RoleAnnotCtxt tc_names)
(text "role annotation")
- tycon
- ; return $ RoleAnnotDecl tycon' roles }
+ (unLEmb tycon)
+ ; return $ RoleAnnotDecl (reLEmb tycon (unLoc tycon')) roles }
dupRoleAnnotErr :: [LRoleAnnotDecl RdrName] -> RnM ()
dupRoleAnnotErr [] = panic "dupRoleAnnotErr"
@@ -1701,7 +1703,8 @@ rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls,
-- Check the signatures
-- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
- ; let sig_rdr_names_w_locs = [op | L _ (ClassOpSig False ops _) <- sigs
+ ; let sig_rdr_names_w_locs = [unLEmb op
+ | L _ (ClassOpSig False ops _) <- sigs
, op <- ops]
; checkDupRdrNames sig_rdr_names_w_locs
-- Typechecker is responsible for checking that we only
@@ -2014,8 +2017,8 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_qvars = qtvs
, con_cxt = mcxt, con_details = details
, con_doc = mb_doc })
= do { _ <- addLocM checkConName name
- ; new_name <- lookupLocatedTopBndrRn name
- ; let doc = ConDeclCtx [new_name]
+ ; new_name <- lookupLEmbellishedTopBndrRn name
+ ; let doc = ConDeclCtx [unLEmb new_name]
; mb_doc' <- rnMbLHsDoc mb_doc
; (kvs, qtvs') <- get_con_qtvs (hsConDeclArgTys details)
@@ -2025,7 +2028,8 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_qvars = qtvs
Nothing -> return (Nothing,emptyFVs)
Just lcxt -> do { (lctx',fvs) <- rnContext doc lcxt
; return (Just lctx',fvs) }
- ; (new_details, fvs2) <- rnConDeclDetails (unLoc new_name) doc details
+ ; (new_details, fvs2)
+ <- rnConDeclDetails (unLocEmb new_name) doc details
; let (new_details',fvs3) = (new_details,emptyFVs)
; traceRn "rnConDecl" (ppr name <+> vcat
[ text "free_kvs:" <+> ppr kvs
@@ -2055,8 +2059,8 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_qvars = qtvs
rnConDecl decl@(ConDeclGADT { con_names = names, con_type = ty
, con_doc = mb_doc })
= do { mapM_ (addLocM checkConName) names
- ; new_names <- mapM lookupLocatedTopBndrRn names
- ; let doc = ConDeclCtx new_names
+ ; new_names <- mapM lookupLEmbellishedTopBndrRn names
+ ; let doc = ConDeclCtx $ map unLEmb new_names
; mb_doc' <- rnMbLHsDoc mb_doc
; (ty', fvs) <- rnHsSigType doc ty
@@ -2115,16 +2119,16 @@ extendPatSynEnv val_decls local_fix_env thing = do {
| L bind_loc (PatSynBind (PSB { psb_id = L _ n
, psb_args = RecordPatSyn as })) <- bind
= do
- bnd_name <- newTopSrcBinder (L bind_loc n)
- let rnames = map recordPatSynSelectorId as
- mkFieldOcc :: Located RdrName -> LFieldOcc RdrName
+ bnd_name <- newTopSrcBinder (L bind_loc $ unEmb n)
+ let rnames = map (lEmb . recordPatSynSelectorId) as
+ mkFieldOcc :: LEmbellished RdrName -> LFieldOcc RdrName
mkFieldOcc (L l name) = L l (FieldOcc (L l name) PlaceHolder)
field_occs = map mkFieldOcc rnames
flds <- mapM (newRecordSelector False [bnd_name]) field_occs
return ((bnd_name, flds): names)
| L bind_loc (PatSynBind (PSB { psb_id = L _ n})) <- bind
= do
- bnd_name <- newTopSrcBinder (L bind_loc n)
+ bnd_name <- newTopSrcBinder (L bind_loc $ unEmb n)
return ((bnd_name, []): names)
| otherwise
= return names
diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs
index b927a898c8..7e068c4e21 100644
--- a/compiler/rename/RnSplice.hs
+++ b/compiler/rename/RnSplice.hs
@@ -112,7 +112,7 @@ rnBracket e br_body
rn_bracket :: ThStage -> HsBracket RdrName -> RnM (HsBracket Name, FreeVars)
rn_bracket outer_stage br@(VarBr flg rdr_name)
- = do { name <- lookupOccRn rdr_name
+ = do { name <- lookupOccRn $ unLocEmb rdr_name
; this_mod <- getModule
; when (flg && nameIsLocalOrFrom this_mod name) $
@@ -133,7 +133,7 @@ rn_bracket outer_stage br@(VarBr flg rdr_name)
(quotedNameStageErr br) }
}
}
- ; return (VarBr flg name, unitFV name) }
+ ; return (VarBr flg (reLEmb rdr_name name), unitFV name) }
rn_bracket _ (ExpBr e) = do { (e', fvs) <- rnLExpr e
; return (ExpBr e', fvs) }
@@ -344,11 +344,11 @@ mkQuasiQuoteExpr :: UntypedSpliceFlavour -> Name -> SrcSpan -> FastString -> LHs
-- which is what we must run in a quasi-quote
mkQuasiQuoteExpr flavour quoter q_span quote
= L q_span $ HsApp (L q_span $
- HsApp (L q_span (HsVar (L q_span quote_selector)))
+ HsApp (L q_span (HsVar (L q_span $ EName quote_selector)))
quoterExpr)
quoteExpr
where
- quoterExpr = L q_span $! HsVar $! (L q_span quoter)
+ quoterExpr = L q_span $! HsVar $! (L q_span $ EName quoter)
quoteExpr = L q_span $! HsLit $! HsString NoSourceText quote
quote_selector = case flavour of
UntypedExpSplice -> quoteExpName
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index b74064751d..8fe4abdd79 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -465,8 +465,8 @@ rnHsTyKi env ty@(HsQualTy { hst_ctxt = lctxt, hst_body = tau })
, fvs1 `plusFV` fvs2) }
rnHsTyKi env (HsTyVar ip (L loc rdr_name))
- = do { name <- rnTyVar env rdr_name
- ; return (HsTyVar ip (L loc name), unitFV name) }
+ = do { name <- rnTyVar env $ unEmb rdr_name
+ ; return (HsTyVar ip (L loc (reEmb rdr_name name)), unitFV name) }
rnHsTyKi env ty@(HsOpTy ty1 l_op ty2)
= setSrcSpan (getLoc l_op) $
@@ -563,7 +563,7 @@ rnHsTyKi env overall_ty@(HsAppsTy tys)
let (non_syms, syms) = splitHsAppsTy tys
-- Step 2: rename the pieces
- ; (syms1, fvs1) <- mapFvRn (rnHsTyOp env overall_ty) syms
+ ; (syms1, fvs1) <- mapFvRn (rnHsTyOp env overall_ty . unLEmb) syms
; (non_syms1, fvs2) <- (mapFvRn . mapFvRn) (rnLHsTyKi env) non_syms
-- Step 3: deal with *. See Note [Dealing with *]
@@ -586,7 +586,8 @@ rnHsTyKi env overall_ty@(HsAppsTy tys)
(non_syms1 : non_syms2 : non_syms) (L loc star : ops)
| star `hasKey` starKindTyConKey || star `hasKey` unicodeStarKindTyConKey
= deal_with_star acc1 acc2
- ((non_syms1 ++ L loc (HsTyVar NotPromoted (L loc star))
+ ((non_syms1
+ ++ L loc (HsTyVar NotPromoted (L loc $ EName star))
: non_syms2) : non_syms)
ops
deal_with_star acc1 acc2 (non_syms1 : non_syms) (op1 : ops)
@@ -1104,7 +1105,7 @@ rnField fl_env env (L l (ConDeclField names ty haddock_doc))
lookupField :: FieldOcc RdrName -> FieldOcc Name
lookupField (FieldOcc (L lr rdr) _) = FieldOcc (L lr rdr) (flSelector fl)
where
- lbl = occNameFS $ rdrNameOcc rdr
+ lbl = occNameFS $ rdrNameOcc $ unEmb rdr
fl = expectJust "rnField" $ lookupFsEnv fl_env lbl
{-
@@ -1239,7 +1240,7 @@ instance Outputable OpName where
get_op :: LHsExpr Name -> OpName
-- An unbound name could be either HsVar or HsUnboundVar
-- See RnExpr.rnUnboundVar
-get_op (L _ (HsVar (L _ n))) = NormalOp n
+get_op (L _ (HsVar (L _ n))) = NormalOp $ unEmb n
get_op (L _ (HsUnboundVar uv)) = UnboundOp uv
get_op (L _ (HsRecFld fld)) = RecFldOp fld
get_op other = pprPanic "get_op" (ppr other)
@@ -1643,7 +1644,7 @@ extract_lkind = extract_lty KindLevel
extract_lty :: TypeOrKind -> LHsType RdrName -> FreeKiTyVars -> RnM FreeKiTyVars
extract_lty t_or_k (L _ ty) acc
= case ty of
- HsTyVar _ ltv -> extract_tv t_or_k ltv acc
+ HsTyVar _ ltv -> extract_tv t_or_k (unLEmb ltv) acc
HsBangTy _ ty -> extract_lty t_or_k ty acc
HsRecTy flds -> foldrM (extract_lty t_or_k
. cd_fld_type . unLoc) acc
@@ -1687,7 +1688,7 @@ extract_apps t_or_k tys acc = foldrM (extract_app t_or_k) acc tys
extract_app :: TypeOrKind -> LHsAppType RdrName -> FreeKiTyVars
-> RnM FreeKiTyVars
-extract_app t_or_k (L _ (HsAppInfix tv)) acc = extract_tv t_or_k tv acc
+extract_app t_or_k (L _ (HsAppInfix tv)) acc = extract_tv t_or_k (unLEmb tv) acc
extract_app t_or_k (L _ (HsAppPrefix ty)) acc = extract_lty t_or_k ty acc
extract_hs_tv_bndrs :: [LHsTyVarBndr RdrName] -> FreeKiTyVars
View Lorry Controller Status