[Git][ghc/ghc][wip/sand-witch/lazy-skol] Wibble

[Simon Peyton Jones (@simonpj)]

Simon Peyton Jones pushed to branch wip/sand-witch/lazy-skol at Glasgow Haskell Compiler / GHC


Commits:
cd16c8db by Simon Peyton Jones at 2024-01-31T17:48:32+00:00
Wibble

- - - - -


2 changed files:

- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Utils/Unify.hs


Changes:

=====================================
compiler/GHC/Tc/Gen/Match.hs
=====================================
@@ -107,7 +107,7 @@ tcFunBindMatches ctxt fun_name mult matches invis_pat_tys exp_ty
     do  {  -- Check that they all have the same no of arguments
           arity <- checkArgCounts matches
 
-        ; traceTc "tcFunBindMatches" (ppr fun_name $$ ppr mult $$ ppr exp_ty $$ ppr arity)
+        ; traceTc "tcFunBindMatches 1" (ppr fun_name $$ ppr mult $$ ppr exp_ty $$ ppr arity)
 
         ; (wrap_fun, (wrap_mult, r))
              <- matchExpectedFunTys herald ctxt arity exp_ty $ \ pat_tys rhs_ty ->
@@ -115,8 +115,8 @@ tcFunBindMatches ctxt fun_name mult matches invis_pat_tys exp_ty
                    -- Makes sure that if the binding is unrestricted, it counts as
                    -- consuming its rhs Many times.
 
-                do { traceTc "tcFunBindMatches" (vcat [ pprUserTypeCtxt ctxt, ppr invis_pat_tys
-                                                      , ppr pat_tys $$ ppr exp_ty ])
+                do { traceTc "tcFunBindMatches 2" (vcat [ pprUserTypeCtxt ctxt, ppr invis_pat_tys
+                                                      , ppr pat_tys $$ ppr rhs_ty ])
                    ; tcMatches tcBody (invis_pat_tys ++ pat_tys) rhs_ty matches }
 
         ; return (wrap_fun <.> wrap_mult, r) }


=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -400,12 +400,12 @@ tcSkolemiseGeneral
   -> ([(Name, TcInvisTVBinder)] -> TcType -> TcM result)
   -> TcM (HsWrapper, result)
 tcSkolemiseGeneral ds_flag ctxt top_ty expected_ty thing_inside
-  | definitely_mono ds_flag top_ty
+  | definitely_mono ds_flag expected_ty
     -- Fast path for a very very common case: no skolemisation to do
     -- But still call checkConstraints in case we need an implication regardless
   = do { let sig_skol = SigSkol ctxt top_ty []
        ; (ev_binds, result) <- checkConstraints sig_skol [] [] $
-                               thing_inside [] top_ty
+                               thing_inside [] expected_ty
        ; return (mkWpLet ev_binds, result) }
 
   | otherwise



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd16c8dbeea84815dcb67cb8fd2ff05f521fc3ab
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/20240131/fbdf6f89/attachment-0001.html>