[Git][ghc/ghc][wip/expand-do] something good in sight

[Apoorv Ingle (@ani)]

Apoorv Ingle pushed to branch wip/expand-do at Glasgow Haskell Compiler / GHC


Commits:
69fa92cb by Apoorv Ingle at 2023-05-05T23:07:55-05:00
something good in sight

- - - - -


3 changed files:

- compiler/GHC/HsToCore/Docs.hs
- compiler/GHC/HsToCore/Pmc/Utils.hs
- compiler/GHC/Tc/Gen/Pat.hs


Changes:

=====================================
compiler/GHC/HsToCore/Docs.hs
=====================================
@@ -346,10 +346,10 @@ subordinates env instMap decl = case decl of
     data_fams = do
       DataFamInstDecl { dfid_eqn =
         (FamEqn { feqn_tycon = L l _
-               , feqn_rhs   = defn } :: FamEqn GhcRn (HsDataDefn GhcRn))} <- unLoc <$> cid_datafam_insts d
+               , feqn_rhs   = defn })} <- unLoc <$> cid_datafam_insts d
       [ (n, [], IM.empty) | Just n <- [lookupSrcSpan (locA l) instMap] ] ++ dataSubs defn
     ty_fams = do
-      TyFamInstDecl { tfid_eqn = (FamEqn { feqn_tycon = L l _ } :: FamEqn GhcRn (LHsType GhcRn)) } <- unLoc <$> cid_tyfam_insts d
+      TyFamInstDecl { tfid_eqn = (FamEqn { feqn_tycon = L l _ }) } <- unLoc <$> cid_tyfam_insts d
       [ (n, [], IM.empty) | Just n <- [lookupSrcSpan (locA l) instMap] ]
     in data_fams ++ ty_fams
 


=====================================
compiler/GHC/HsToCore/Pmc/Utils.hs
=====================================
@@ -108,8 +108,8 @@ arrowMatchContextExhaustiveWarningFlag = \ case
 -- 'HsMatchContext' (does not matter whether it is the redundancy check or the
 -- exhaustiveness check).
 isMatchContextPmChecked :: DynFlags -> Origin -> HsMatchContext id -> Bool
-isMatchContextPmChecked _ origin LambdaExpr -- It is likely that this is generated by expanding do stmts
-  = isGenerated origin
+-- isMatchContextPmChecked _ origin LambdaExpr -- It is likely that this is generated by expanding do stmts
+--   = isGenerated origin
 isMatchContextPmChecked dflags origin kind
   | isGenerated origin
   = False


=====================================
compiler/GHC/Tc/Gen/Pat.hs
=====================================
@@ -1623,8 +1623,9 @@ checkGADT conlike ex_tvs arg_tys = \case
     has_existentials = any (`elemVarSet` tyCoVarsOfTypes arg_tys) ex_tvs
 
 -- | Very similar to GHC.Tc.Pat.isIrrefutableHsPat, but doesn't depend on type checking
+-- does depend on the type environment however
 isIrrefutableHsPatRn :: TcGblEnv -> Bool -> LPat GhcRn -> TcM Bool
-isIrrefutableHsPatRn _ is_strict pat =
+isIrrefutableHsPatRn tc_env is_strict pat =
   do traceTc "isIrrefutableHsPatRn" empty
      goL pat
   where
@@ -1662,9 +1663,7 @@ isIrrefutableHsPatRn _ is_strict pat =
                       ; traceTc "isIrrefutableHsPatRn ATyCon" (vcat [ ppr tycon
                                                       , ppr (isNewTyCon tycon)
                                                       , ppr (tcHasFixedRuntimeRep tycon)])
-                      ; let b' = (isJust (tyConSingleDataCon_maybe tycon)
-                                          || isNewTyCon tycon
-                                          || tcHasFixedRuntimeRep tycon)
+                      ; let b' = isJust (tyConSingleDataCon_maybe tycon)
                       ; return (b && b') }
               id@(AnId _) -> pprPanic "isIrrefutableHsPatRn AnId" (ppr id)
               (AConLike cl) ->
@@ -1676,9 +1675,7 @@ isIrrefutableHsPatRn _ is_strict pat =
                             traceTc "isIrrefutableHsPatRn AConLike" (vcat [ ppr tycon
                                                                      , ppr (isNewTyCon tycon)
                                                                      , ppr (tcHasFixedRuntimeRep tycon)] )
-                            let b' = (isJust (tyConSingleDataCon_maybe tycon)
-                                              || isNewTyCon tycon
-                                              || tcHasFixedRuntimeRep tycon)
+                            let b' = isJust (tyConSingleDataCon_maybe tycon)
                             return (b && b')
                        PatSynCon con -> do traceTc "isIrrefutableHsPatRn AConLike" (ppr con)
                                            return False -- conservative



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/69fa92cb1ec0c366ca13046697019123e2b9673a

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/69fa92cb1ec0c366ca13046697019123e2b9673a
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/20230506/960290e0/attachment-0001.html>