[Git][ghc/ghc][wip/T25281] Yet more
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Sat Oct 5 20:50:57 UTC 2024
Simon Peyton Jones pushed to branch wip/T25281 at Glasgow Haskell Compiler / GHC
Commits:
1768fb71 by Simon Peyton Jones at 2024-10-05T21:50:39+01:00
Yet more
- - - - -
2 changed files:
- compiler/GHC/Rename/Env.hs
- compiler/GHC/Tc/Instance/Typeable.hs
Changes:
=====================================
compiler/GHC/Rename/Env.hs
=====================================
@@ -563,7 +563,7 @@ lookupRecFieldOcc mb_con rdr_name
; Just nm -> return nm } }
| otherwise -- Can't use the data constructor to disambiguate
- = lookupGlobalOccRn' (RelevantGREsFOS WantField) rdr_name
+ = lookupGlobalOccRn' WantField rdr_name
-- This use of Global is right as we are looking up a selector,
-- which can only be defined at the top level.
@@ -1405,20 +1405,23 @@ lookupGlobalOccRn :: RdrName -> RnM Name
-- environment.
--
-- Used by exports_from_avail
-lookupGlobalOccRn = lookupGlobalOccRn' (RelevantGREsFOS WantNormal)
-
-lookupGlobalOccRn' :: WhichGREs GREInfo -> RdrName -> RnM Name
-lookupGlobalOccRn' which_gres rdr_name =
- lookupExactOrOrig rdr_name greName $ do
- mb_gre <- lookupGlobalOccRn_base which_gres rdr_name
- case mb_gre of
- Just gre -> return (greName gre)
- Nothing -> do { traceRn "lookupGlobalOccRn" (ppr rdr_name)
- ; unboundName (LF which_suggest WL_Global) rdr_name }
- where which_suggest = case includeFieldSelectors which_gres of
- WantBoth -> WL_RecField
- WantField -> WL_RecField
- WantNormal -> WL_Anything
+lookupGlobalOccRn = lookupGlobalOccRn' WantNormal
+
+lookupGlobalOccRn' :: FieldsOrSelectors -> RdrName -> RnM Name
+lookupGlobalOccRn' fos rdr_name
+ = lookupExactOrOrig rdr_name greName $
+ do { mb_gre <- lookupGlobalOccRn_base which_gres rdr_name
+ ; case mb_gre of
+ Just gre -> return (greName gre)
+ Nothing -> do { traceRn "lookupGlobalOccRn" (ppr rdr_name)
+ ; unboundName looking_for rdr_name } }
+ where
+ which_gres = RelevantGREsFOS fos
+ looking_for = LF { lf_which = what_looking, lf_where = WL_Global }
+ what_looking = case fos of
+ WantBoth -> WL_RecField
+ WantField -> WL_RecField
+ WantNormal -> WL_Anything
-- Looks up a RdrName occurrence in the GlobalRdrEnv and with
-- lookupQualifiedNameGHCi. Does not try to find an Exact or Orig name first.
=====================================
compiler/GHC/Tc/Instance/Typeable.hs
=====================================
@@ -221,18 +221,21 @@ data TypeableTyCon
, tycon_rep_id :: !Id
}
--- | A group of 'TyCon's in need of type-rep bindings.
data TypeRepTodo
- = TypeRepTodo
- { mod_rep_expr :: LHsExpr GhcTc -- ^ Module's typerep binding
- , pkg_fingerprint :: !Fingerprint -- ^ Package name fingerprint
- , mod_fingerprint :: !Fingerprint -- ^ Module name fingerprint
- , todo_tycons :: [TypeableTyCon]
- -- ^ The 'TyCon's in need of bindings kinds
- }
- | ExportedKindRepsTodo [(Kind, Id)]
+ = TyConTodo TyConTodo
+ | ExportedKindRepsTodo [(Kind, Id)]
-- ^ Build exported 'KindRep' bindings for the given set of kinds.
+
+-- | A group of 'TyCon's in need of type-rep bindings.
+data TyConTodo
+ = TCTD { mod_rep_expr :: LHsExpr GhcTc -- ^ Module's typerep binding
+ , pkg_fingerprint :: !Fingerprint -- ^ Package name fingerprint
+ , mod_fingerprint :: !Fingerprint -- ^ Module name fingerprint
+ , todo_tycons :: [TypeableTyCon]
+ -- ^ The 'TyCon's in need of bindings kinds
+ }
+
todoForTyCons :: Module -> Id -> [TyCon] -> TcM TypeRepTodo
todoForTyCons mod mod_id tycons = do
trTyConTy <- mkTyConTy <$> tcLookupTyCon trTyConTyConName
@@ -255,11 +258,11 @@ todoForTyCons mod mod_id tycons = do
, Just rep_name <- pure $ tyConRepName_maybe tc''
, tyConIsTypeable tc''
]
- return TypeRepTodo { mod_rep_expr = nlHsVar mod_id
- , pkg_fingerprint = pkg_fpr
- , mod_fingerprint = mod_fpr
- , todo_tycons = typeable_tycons
- }
+ return $ TyConTodo $
+ TCTD { mod_rep_expr = nlHsVar mod_id
+ , pkg_fingerprint = pkg_fpr
+ , mod_fingerprint = mod_fpr
+ , todo_tycons = typeable_tycons }
where
mod_fpr = fingerprintString $ moduleNameString $ moduleName mod
pkg_fpr = fingerprintString $ unitString $ moduleUnit mod
@@ -283,8 +286,8 @@ mkTypeRepTodoBinds todos
-- TyCon associated with the applied type constructor).
; let produced_bndrs :: [Id]
produced_bndrs = [ tycon_rep_id
- | todo@(TypeRepTodo{}) <- todos
- , TypeableTyCon {..} <- todo_tycons todo
+ | TyConTodo (TCTD { todo_tycons = tcs }) <- todos
+ , TypeableTyCon {..} <- tcs
] ++
[ rep_id
| ExportedKindRepsTodo kinds <- todos
@@ -293,8 +296,8 @@ mkTypeRepTodoBinds todos
; gbl_env <- tcExtendGlobalValEnv produced_bndrs getGblEnv
; let mk_binds :: TypeRepTodo -> KindRepM [LHsBinds GhcTc]
- mk_binds todo@(TypeRepTodo {}) =
- mapM (mkTyConRepBinds stuff todo) (todo_tycons todo)
+ mk_binds (TyConTodo (todo@(TCTD { todo_tycons = tcs }))) =
+ mapM (mkTyConRepBinds stuff todo) tcs
mk_binds (ExportedKindRepsTodo kinds) =
mkExportedKindReps stuff kinds >> return []
@@ -413,7 +416,7 @@ mkTrNameLit = do
return trNameLit
-- | Make Typeable bindings for the given 'TyCon'.
-mkTyConRepBinds :: TypeableStuff -> TypeRepTodo
+mkTyConRepBinds :: TypeableStuff -> TyConTodo
-> TypeableTyCon -> KindRepM (LHsBinds GhcTc)
mkTyConRepBinds stuff todo (TypeableTyCon {..})
= do -- Make a KindRep
@@ -649,7 +652,7 @@ mkKindRepRhs stuff@(Stuff {..}) in_scope = new_kind_rep_shortcut
= pprPanic "mkTyConKindRepBinds.go(coercion)" (ppr co)
-- | Produce the right-hand-side of a @TyCon@ representation.
-mkTyConRepTyConRHS :: TypeableStuff -> TypeRepTodo
+mkTyConRepTyConRHS :: TypeableStuff -> TyConTodo
-> TyCon -- ^ the 'TyCon' we are producing a binding for
-> LHsExpr GhcTc -- ^ its 'KindRep'
-> LHsExpr GhcTc
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1768fb718bc5a37d667fa91f617767621dad2dae
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1768fb718bc5a37d667fa91f617767621dad2dae
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241005/56058b7a/attachment-0001.html>
More information about the ghc-commits
mailing list