Skip to content
Snippets Groups Projects
Commit c3342505 authored by Gergő Érdi's avatar Gergő Érdi
Browse files

Include pattern synonyms as AConLikes in the type environment,

even for simplified/boot ModDetails (fixes #9417)
parent 78863edb
No related branches found
No related tags found
No related merge requests found
...@@ -17,7 +17,7 @@ module PatSyn ( ...@@ -17,7 +17,7 @@ module PatSyn (
patSynWrapper, patSynMatcher, patSynWrapper, patSynMatcher,
patSynExTyVars, patSynSig, patSynExTyVars, patSynSig,
patSynInstArgTys, patSynInstResTy, patSynInstArgTys, patSynInstResTy,
tidyPatSynIds, patSynIds tidyPatSynIds
) where ) where
#include "HsVersions.h" #include "HsVersions.h"
...@@ -267,12 +267,6 @@ patSynWrapper = psWrapper ...@@ -267,12 +267,6 @@ patSynWrapper = psWrapper
patSynMatcher :: PatSyn -> Id patSynMatcher :: PatSyn -> Id
patSynMatcher = psMatcher patSynMatcher = psMatcher
patSynIds :: PatSyn -> [Id]
patSynIds (MkPatSyn { psMatcher = match_id, psWrapper = mb_wrap_id })
= case mb_wrap_id of
Nothing -> [match_id]
Just wrap_id -> [match_id, wrap_id]
tidyPatSynIds :: (Id -> Id) -> PatSyn -> PatSyn tidyPatSynIds :: (Id -> Id) -> PatSyn -> PatSyn
tidyPatSynIds tidy_fn ps@(MkPatSyn { psMatcher = match_id, psWrapper = mb_wrap_id }) tidyPatSynIds tidy_fn ps@(MkPatSyn { psMatcher = match_id, psWrapper = mb_wrap_id })
= ps { psMatcher = tidy_fn match_id, psWrapper = fmap tidy_fn mb_wrap_id } = ps { psMatcher = tidy_fn match_id, psWrapper = fmap tidy_fn mb_wrap_id }
......
...@@ -142,12 +142,12 @@ mkBootModDetailsTc hsc_env ...@@ -142,12 +142,12 @@ mkBootModDetailsTc hsc_env
; showPass dflags CoreTidy ; showPass dflags CoreTidy
; let { insts' = map (tidyClsInstDFun globaliseAndTidyId) insts ; let { insts' = map (tidyClsInstDFun globaliseAndTidyId) insts
; pat_syns' = map (tidyPatSynIds globaliseAndTidyId) pat_syns
; dfun_ids = map instanceDFunId insts'
; pat_syn_ids = concatMap patSynIds pat_syns'
; type_env1 = mkBootTypeEnv (availsToNameSet exports) ; type_env1 = mkBootTypeEnv (availsToNameSet exports)
(typeEnvIds type_env) tcs fam_insts (typeEnvIds type_env) tcs fam_insts
; type_env' = extendTypeEnvWithIds type_env1 (pat_syn_ids ++ dfun_ids) ; pat_syns' = map (tidyPatSynIds globaliseAndTidyId) pat_syns
; type_env2 = extendTypeEnvWithPatSyns pat_syns' type_env1
; dfun_ids = map instanceDFunId insts'
; type_env' = extendTypeEnvWithIds type_env2 dfun_ids
} }
; return (ModDetails { md_types = type_env' ; return (ModDetails { md_types = type_env'
, md_insts = insts' , md_insts = insts'
...@@ -360,8 +360,7 @@ tidyProgram hsc_env (ModGuts { mg_module = mod ...@@ -360,8 +360,7 @@ tidyProgram hsc_env (ModGuts { mg_module = mod
-- This is really the only reason we keep mg_patsyns at all; otherwise -- This is really the only reason we keep mg_patsyns at all; otherwise
-- they could just stay in type_env -- they could just stay in type_env
; tidy_patsyns = map (tidyPatSynIds (lookup_aux_id tidy_type_env)) patsyns ; tidy_patsyns = map (tidyPatSynIds (lookup_aux_id tidy_type_env)) patsyns
; type_env2 = extendTypeEnvList type_env1 ; type_env2 = extendTypeEnvWithPatSyns tidy_patsyns type_env1
[AConLike (PatSynCon ps) | ps <- tidy_patsyns ]
; tidy_type_env = tidyTypeEnv omit_prags type_env2 ; tidy_type_env = tidyTypeEnv omit_prags type_env2
...@@ -457,6 +456,10 @@ trimThing (AnId id) ...@@ -457,6 +456,10 @@ trimThing (AnId id)
trimThing other_thing trimThing other_thing
= other_thing = other_thing
extendTypeEnvWithPatSyns :: [PatSyn] -> TypeEnv -> TypeEnv
extendTypeEnvWithPatSyns tidy_patsyns type_env
= extendTypeEnvList type_env [AConLike (PatSynCon ps) | ps <- tidy_patsyns ]
\end{code} \end{code}
\begin{code} \begin{code}
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment