[Git][ghc/ghc][wip/expand-do] some more changes, fixing simpl017 test case

[Apoorv Ingle (@ani)]

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


Commits:
d15b8800 by Apoorv Ingle at 2023-07-21T13:15:59-05:00
some more changes, fixing simpl017 test case

- - - - -


2 changed files:

- compiler/GHC/Tc/Gen/Expr.hs
- testsuite/tests/simplCore/should_compile/simpl017.stderr


Changes:

=====================================
compiler/GHC/Tc/Gen/Expr.hs
=====================================
@@ -238,7 +238,7 @@ tcExpr (XExpr (PopErrCtxt (L loc e))) res_ty
                             -- to get better error messages
                             -- eg. T18324b.hs
 
-tcExpr (XExpr (ExpandedStmt (HsExpanded stmt@(L loc s) expd_expr))) res_ty
+tcExpr e@(XExpr (ExpandedStmt (HsExpanded stmt@(L loc s) expd_expr))) res_ty
   | LetStmt{} <- s
   , HsLet x tkLet binds tkIn e <- expd_expr
   =  do { traceTc "tcDoStmts let" (vcat [ text "stmt:" <+> ppr stmt
@@ -248,7 +248,9 @@ tcExpr (XExpr (ExpandedStmt (HsExpanded stmt@(L loc s) expd_expr))) res_ty
                                     ])
         ; (binds', e') <-  setSrcSpanA loc $
                             addStmtCtxt (text "tcExpr let") stmt $
-                            tcLocalBinds binds $ popErrCtxt $ tcMonoExpr e res_ty
+                            tcLocalBinds binds $
+                            do { traceTc "tcExpr let popErrCtxt" empty
+                               ; popErrCtxt $ tcMonoExpr e res_ty }
         ; return $ HsLet x tkLet binds' tkIn e'
         }
   | BindStmt{} <- s
@@ -258,8 +260,8 @@ tcExpr (XExpr (ExpandedStmt (HsExpanded stmt@(L loc s) expd_expr))) res_ty
                                          , text "loc" <+> ppr loc
                                     ])
         ; setSrcSpanA loc $
-          addStmtCtxt (text "tcExpr bind") stmt $
-          tcExpr expd_expr res_ty
+          -- addStmtCtxt (text "tcExpr bind") stmt $
+          tcApp e res_ty
         }
   | otherwise
   =  do { traceTc "tcDoStmts other" (vcat [ text "stmt:" <+> ppr stmt


=====================================
testsuite/tests/simplCore/should_compile/simpl017.stderr
=====================================
@@ -23,24 +23,3 @@ simpl017.hs:55:5: error: [GHC-83865]
         a :: arr i a (bound at simpl017.hs:50:11)
         liftArray :: arr i a -> E m (forall v. [E m i] -> E' v m a)
           (bound at simpl017.hs:50:1)
-
-simpl017.hs:71:10: error: [GHC-83865]
-    • Couldn't match type: forall v. [E (ST s) Int] -> E' v (ST s) Int
-                     with: [E (ST t0) Int] -> E (ST s) Int
-      Expected: E' RValue (ST s) ([E (ST t0) Int] -> E (ST s) Int)
-        Actual: E (ST s) (forall v. [E (ST s) Int] -> E' v (ST s) Int)
-    • In a stmt of a 'do' block: a <- liftArray ma
-      In the second argument of ‘($)’, namely
-        ‘do a <- liftArray ma
-            let one :: E (ST t) Int
-                one = return 1
-            a [one] `plus` a [one]’
-      In the expression:
-        runE
-          $ do a <- liftArray ma
-               let one :: E (ST t) Int
-                   one = return 1
-               a [one] `plus` a [one]
-    • Relevant bindings include
-        ma :: STArray s Int Int (bound at simpl017.hs:70:5)
-        foo :: STArray s Int Int -> ST s Int (bound at simpl017.hs:70:1)



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

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