[Git][ghc/ghc][wip/expand-do] more MR review changes

Apoorv Ingle (@ani) gitlab at gitlab.haskell.org
Sat Oct 14 21:32:13 UTC 2023



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


Commits:
d92591a3 by Apoorv Ingle at 2023-10-14T16:31:44-05:00
more MR review changes

- - - - -


5 changed files:

- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Syn/Type.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Tc/Gen/Do.hs
- compiler/GHC/Tc/Types/Origin.hs


Changes:

=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -466,14 +466,9 @@ isHsThingRnStmt _ = False
 isHsThingRnPat (OrigPat{}) = True
 isHsThingRnPat _ = False
 
-type HsExpansionRn p
-    = HsExpansion         -- See Note [Expanding HsDo with HsExpansion] in `GHC.Tc.Gen.Do`
-        HsThingRn         -- Original source
-        (HsExpr p)        -- Expanded expression in a p pass
-
 data XXExprGhcRn
-  = ExpandedThingRn
-    {-# UNPACK #-} !(HsExpansionRn GhcRn)
+  = ExpandedThingRn { xrn_orig :: HsThingRn           -- The original source thing
+                    , xrn_expanded :: HsExpr GhcRn }  -- The compiler generated expanded thing
 
   | PopErrCtxt                                     -- A hint for typechecker to pop
     {-# UNPACK #-} !(LHsExpr GhcRn)                -- the top of the error context stack
@@ -497,7 +492,7 @@ mkExpandedExpr
   :: HsExpr GhcRn         -- ^ source expression
   -> HsExpr GhcRn         -- ^ expanded expression
   -> HsExpr GhcRn         -- ^ suitably wrapped 'HsExpansion'
-mkExpandedExpr oExpr eExpr = XExpr (ExpandedThingRn (HsExpanded (OrigExpr oExpr) eExpr))
+mkExpandedExpr oExpr eExpr = XExpr (ExpandedThingRn (OrigExpr oExpr) eExpr)
 
 -- | Build an expression using the extension constructor `XExpr`,
 --   and the two components of the expansion: original do stmt and
@@ -506,13 +501,13 @@ mkExpandedStmt
   :: ExprLStmt GhcRn      -- ^ source statement
   -> HsExpr GhcRn         -- ^ expanded expression
   -> HsExpr GhcRn         -- ^ suitably wrapped 'HsExpansion'
-mkExpandedStmt oStmt eExpr = XExpr (ExpandedThingRn (HsExpanded (OrigStmt oStmt) eExpr))
+mkExpandedStmt oStmt eExpr = XExpr (ExpandedThingRn (OrigStmt oStmt) eExpr)
 
 mkExpandedPatRn
   :: LPat   GhcRn      -- ^ source pattern
   -> HsExpr GhcRn      -- ^ expanded expression
   -> HsExpr GhcRn      -- ^ suitably wrapped 'HsExpansion'
-mkExpandedPatRn oPat eExpr = XExpr (ExpandedThingRn (HsExpanded (OrigPat oPat) eExpr))
+mkExpandedPatRn oPat eExpr = XExpr (ExpandedThingRn (OrigPat oPat) eExpr)
 
 -- | Build an expression using the extension constructor `XExpr`,
 --   and the two components of the expansion: original do stmt and
@@ -539,7 +534,8 @@ data XXExprGhcTc
 
   | ExpandedThingTc                         -- See Note [Rebindable syntax and HsExpansion]
                                             -- See Note [Expanding HsDo with HsExpansion] in `GHC.Tc.Gen.Do`
-          {-# UNPACK #-} !(HsExpansionRn GhcTc)
+         { xtc_orig :: HsThingRn            -- The original user written thing
+         , xtc_expanded :: HsExpr GhcTc }   -- The expanded typechecked expression
 
   | ConLikeTc      -- Result of typechecking a data-con
                    -- See Note [Typechecking data constructors] in
@@ -567,7 +563,7 @@ mkExpandedExprTc
   :: HsExpr GhcRn           -- ^ source expression
   -> HsExpr GhcTc           -- ^ expanded typechecked expression
   -> HsExpr GhcTc           -- ^ suitably wrapped 'HsExpansion'
-mkExpandedExprTc oExpr eExpr = XExpr (ExpandedThingTc (HsExpanded (OrigExpr oExpr) eExpr))
+mkExpandedExprTc oExpr eExpr = XExpr (ExpandedThingTc (OrigExpr oExpr) eExpr)
 
 -- | Build a 'HsExpansion' out of an extension constructor.
 --   The two components of the expansion are: original statement and
@@ -576,7 +572,7 @@ mkExpandedStmtTc
   :: ExprLStmt GhcRn        -- ^ source do statement
   -> HsExpr GhcTc           -- ^ expanded typechecked expression
   -> HsExpr GhcTc           -- ^ suitably wrapped 'HsExpansion'
-mkExpandedStmtTc oStmt eExpr = XExpr (ExpandedThingTc (HsExpanded (OrigStmt oStmt) eExpr))
+mkExpandedStmtTc oStmt eExpr = XExpr (ExpandedThingTc (OrigStmt oStmt) eExpr)
 
 {- *********************************************************************
 *                                                                      *
@@ -822,18 +818,19 @@ instance Outputable HsThingRn where
     where ppr_builder prefix x = ifPprDebug (braces (text prefix <+> parens (ppr x))) (ppr x)
 
 instance Outputable XXExprGhcRn where
-  ppr (ExpandedThingRn e) = ppr e
-  ppr (PopErrCtxt e)      = ifPprDebug (braces (text "<PopErrCtxt<" <+> ppr e)) (ppr e)
+  ppr (ExpandedThingRn o e) = ifPprDebug (braces $ vcat [ppr o, ppr e]) (ppr o)
+  ppr (PopErrCtxt e)        = ifPprDebug (braces (text "<PopErrCtxt>" <+> ppr e)) (ppr e)
 
 instance Outputable XXExprGhcTc where
   ppr (WrapExpr (HsWrap co_fn e))
     = pprHsWrapper co_fn (\_parens -> pprExpr e)
 
-  ppr (ExpandedThingTc e)
-    = ppr e -- e is an HsExpansion, we print the original
+  ppr (ExpandedThingTc o e)
+    = ifPprDebug (braces $ vcat [ppr o, ppr e]) (ppr o)
+            -- e is the expanded expression, we print the original
             -- expression (HsExpr GhcRn), not the
             -- expanded typechecked one (HsExpr GhcTc),
-            -- unless we are in ppr's debug mode then both get printed
+            -- unless we are in ppr's debug mode printed both
 
   ppr (ConLikeTc con _ _) = pprPrefixOcc con
    -- Used in error messages generated by
@@ -862,19 +859,19 @@ ppr_infix_expr (XExpr x)            = case ghcPass @p of
 ppr_infix_expr _ = Nothing
 
 ppr_infix_expr_rn :: XXExprGhcRn -> Maybe SDoc
-ppr_infix_expr_rn (ExpandedThingRn thing) = ppr_infix_hs_expansion thing
+ppr_infix_expr_rn (ExpandedThingRn thing _) = ppr_infix_hs_expansion thing
 ppr_infix_expr_rn (PopErrCtxt (L _ a)) = ppr_infix_expr a
 
 ppr_infix_expr_tc :: XXExprGhcTc -> Maybe SDoc
-ppr_infix_expr_tc (WrapExpr (HsWrap _ e))  = ppr_infix_expr e
-ppr_infix_expr_tc (ExpandedThingTc thing)  = ppr_infix_hs_expansion thing
-ppr_infix_expr_tc (ConLikeTc {})                   = Nothing
-ppr_infix_expr_tc (HsTick {})                      = Nothing
-ppr_infix_expr_tc (HsBinTick {})                   = Nothing
+ppr_infix_expr_tc (WrapExpr (HsWrap _ e))    = ppr_infix_expr e
+ppr_infix_expr_tc (ExpandedThingTc thing _)  = ppr_infix_hs_expansion thing
+ppr_infix_expr_tc (ConLikeTc {})             = Nothing
+ppr_infix_expr_tc (HsTick {})                = Nothing
+ppr_infix_expr_tc (HsBinTick {})             = Nothing
 
-ppr_infix_hs_expansion :: HsExpansion HsThingRn b -> Maybe SDoc
-ppr_infix_hs_expansion thing | OrigExpr e <- original thing = ppr_infix_expr e
-                             | otherwise                    = Nothing
+ppr_infix_hs_expansion :: HsThingRn -> Maybe SDoc
+ppr_infix_hs_expansion (OrigExpr e) = ppr_infix_expr e
+ppr_infix_hs_expansion _            = Nothing
 
 ppr_apps :: (OutputableBndrId p)
          => HsExpr (GhcPass p)
@@ -967,18 +964,18 @@ hsExprNeedsParens prec = go
 
     go_x_tc :: XXExprGhcTc -> Bool
     go_x_tc (WrapExpr (HsWrap _ e))          = hsExprNeedsParens prec e
-    go_x_tc (ExpandedThingTc thing)          = hsExpandedNeedsParens thing
+    go_x_tc (ExpandedThingTc thing _)        = hsExpandedNeedsParens thing
     go_x_tc (ConLikeTc {})                   = False
     go_x_tc (HsTick _ (L _ e))               = hsExprNeedsParens prec e
     go_x_tc (HsBinTick _ _ (L _ e))          = hsExprNeedsParens prec e
 
     go_x_rn :: XXExprGhcRn -> Bool
-    go_x_rn (ExpandedThingRn thing)       = hsExpandedNeedsParens thing
-    go_x_rn (PopErrCtxt (L _ a)) = hsExprNeedsParens prec a
+    go_x_rn (ExpandedThingRn thing _)    = hsExpandedNeedsParens thing
+    go_x_rn (PopErrCtxt (L _ a))         = hsExprNeedsParens prec a
 
-    hsExpandedNeedsParens :: HsExpansion HsThingRn a -> Bool
-    hsExpandedNeedsParens thing | OrigExpr e <- original thing = hsExprNeedsParens prec e
-                                | otherwise = False
+    hsExpandedNeedsParens :: HsThingRn -> Bool
+    hsExpandedNeedsParens (OrigExpr e) = hsExprNeedsParens prec e
+    hsExpandedNeedsParens _            = False
 
 -- | Parenthesize an expression without token information
 gHsPar :: LHsExpr (GhcPass id) -> HsExpr (GhcPass id)
@@ -1014,18 +1011,18 @@ isAtomicHsExpr (XExpr x)
   where
     go_x_tc :: XXExprGhcTc -> Bool
     go_x_tc (WrapExpr      (HsWrap _ e))     = isAtomicHsExpr e
-    go_x_tc (ExpandedThingTc thing)          = isAtomicHsExpanded thing
+    go_x_tc (ExpandedThingTc thing _)        = isAtomicHsExpanded thing
     go_x_tc (ConLikeTc {})                   = True
     go_x_tc (HsTick {}) = False
     go_x_tc (HsBinTick {}) = False
 
     go_x_rn :: XXExprGhcRn -> Bool
-    go_x_rn (ExpandedThingRn thing)          = isAtomicHsExpanded thing
-    go_x_rn (PopErrCtxt (L _ a)) = isAtomicHsExpr a
+    go_x_rn (ExpandedThingRn thing _)    = isAtomicHsExpanded thing
+    go_x_rn (PopErrCtxt (L _ a))         = isAtomicHsExpr a
 
-    isAtomicHsExpanded :: HsExpansion HsThingRn b -> Bool
-    isAtomicHsExpanded thing | OrigExpr e <- original thing = isAtomicHsExpr e
-                             | otherwise = False
+    isAtomicHsExpanded :: HsThingRn -> Bool
+    isAtomicHsExpanded (OrigExpr e) = isAtomicHsExpr e
+    isAtomicHsExpanded _            = False
 
 isAtomicHsExpr _ = False
 


=====================================
compiler/GHC/Hs/Syn/Type.hs
=====================================
@@ -144,7 +144,7 @@ hsExprType (HsStatic (_, ty) _s) = ty
 hsExprType (HsPragE _ _ e) = lhsExprType e
 hsExprType (HsEmbTy x _ _) = dataConCantHappen x
 hsExprType (XExpr (WrapExpr (HsWrap wrap e))) = hsWrapperType wrap $ hsExprType e
-hsExprType (XExpr (ExpandedThingTc thing))    = hsExprType $ expanded thing
+hsExprType (XExpr (ExpandedThingTc _ e))  = hsExprType e
 hsExprType (XExpr (ConLikeTc con _ _)) = conLikeType con
 hsExprType (XExpr (HsTick _ e)) = lhsExprType e
 hsExprType (XExpr (HsBinTick _ _ e)) = lhsExprType e


=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -87,6 +87,14 @@ import qualified Data.List.NonEmpty as NE
 
 {- Note [Handling overloaded and rebindable constructs]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Nomenclature
+-------------
+* Expansion (`HsExpr GhcRn -> HsExpr GhcRn`): expand between renaming and
+  typechecking, using the `HsExpansion` constructor of `HsExpr`.
+* Desugaring (`HsExpr GhcTc -> Core.Expr`): convert the typechecked `HsSyn` to Core.  This is done in GHC.HsToCore
+
+
 For overloaded constructs (overloaded literals, lists, strings), and
 rebindable constructs (e.g. if-then-else), our general plan is this,
 using overloaded labels #foo as an example:


=====================================
compiler/GHC/Tc/Gen/Do.hs
=====================================
@@ -17,7 +17,7 @@
 
 -- | Expand @Do@ block statements into @(>>=)@, @(>>)@ and @let at s
 --   After renaming but right ebefore type checking
-module GHC.Tc.Gen.Do where
+module GHC.Tc.Gen.Do (expandDoStmts) where
 
 import GHC.Prelude
 
@@ -66,18 +66,24 @@ expandDoStmts doFlav stmts = do expanded_expr <- expand_do_stmts doFlav stmts
 --   See Note [Expanding HsDo with HsExpansion]
 expand_do_stmts :: HsDoFlavour -> [ExprLStmt GhcRn] -> TcM (LHsExpr GhcRn)
 
-expand_do_stmts ListComp _ = pprPanic "expand_do_stmts: impossible happened. ListComp" empty
+expand_do_stmts ListComp _ =
+  pprPanic "expand_do_stmts: impossible happened. ListComp" empty
+        -- handeled by `GHC.Tc.Gen.Match.tcLcStmt`
 
 expand_do_stmts _ [] = pprPanic "expand_do_stmts: impossible happened. Empty stmts" empty
 
 expand_do_stmts _ (stmt@(L _ (TransStmt {})):_) =
   pprPanic "expand_do_stmts: TransStmt" $ ppr stmt
+  -- handeled by `GHC.Tc.Gen.Match.tcLcStmt`
 
 expand_do_stmts _ (stmt@(L _ (ParStmt {})):_) =
   pprPanic "expand_do_stmts: ParStmt" $ ppr stmt
+  -- handeled by `GHC.Tc.Gen.Match.tcLcStmt`
 
 expand_do_stmts _ (stmt@(L _ (ApplicativeStmt{})): _) =
   pprPanic "expand_do_stmts: Applicative Stmt" $ ppr stmt
+  -- Handeled by tcSyntaxOp see `GHC.Tc.Gen.Match.tcStmtsAndThen`
+
 
 expand_do_stmts _ [stmt@(L loc (LastStmt _ (L body_loc body) _ ret_expr))]
   -- last statement of a list comprehension, needs to explicitly return it
@@ -108,7 +114,6 @@ expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts)
   | SyntaxExprRn bind_op <- xbsrn_bindOp xbsrn
   , fail_op              <- xbsrn_failOp xbsrn
 -- the pattern binding pat can fail
--- instead of making a new internal name, the fail block is just an anonymous lambda
 --      stmts ~~> stmt'    f = \case pat -> stmts';
 --                                   _   -> fail "Pattern match failure .."
 --    -------------------------------------------------------
@@ -124,7 +129,8 @@ expand_do_stmts do_or_lc (stmt@(L loc (BindStmt xbsrn pat e)): lstmts)
   = pprPanic "expand_do_stmts: The impossible happened, missing bind operator from renamer" (text "stmt" <+> ppr  stmt)
 
 expand_do_stmts do_or_lc (stmt@(L loc (BodyStmt _ e (SyntaxExprRn then_op) _)) : lstmts) =
--- See Note [BodyStmt]
+-- See Note [BodyStmt] in Language.Haskell.Syntax.Expr
+-- See  Note [Expanding HsDo with HsExpansion] Equation (1) below
 --              stmts ~~> stmts'
 --    ----------------------------------------------
 --      e ; stmts ~~> (>>) e stmts'
@@ -145,7 +151,8 @@ expand_do_stmts do_or_lc
                                                           -- at the end of expanded rec block
                         }))
          : lstmts) =
--- See Note [Typing a RecStmt]
+-- See Note [Typing a RecStmt] in Language.Haskell.Syntax.Expr
+-- See  Note [Expanding HsDo with HsExpansion] Equation (4) below
 --                                   stmts ~~> stmts'
 --    -------------------------------------------------------------------------------------------
 --      rec { later_ids, local_ids, rec_block } ; stmts
@@ -227,20 +234,20 @@ mk_fail_block _ _ _ _ = pprPanic "mk_fail_block: impossible happened" empty
 
 {- Note [Expanding HsDo with HsExpansion]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We expand `do`-blocks before typechecking it, rather than type checking it and then
-desugaring it by re-using the existing `HsExpansions` and `RebindableSyntax` machinery.
+We expand `do`-blocks before typechecking it, by re-using the existing `HsExpansions` and `RebindableSyntax` machinery.
 This is very similar to:
   1. Expansions done in `GHC.Rename.Expr.rnHsIf` for expanding `HsIf`; and
   2. `desugarRecordUpd` in `GHC.Tc.Gen.Expr.tcExpr` for expanding `RecordUpd`
+See Note [Handling overloaded and rebindable constructs] in GHC.Rename.Expr
 
 To disabmiguate desugaring (`HsExpr GhcTc -> Core.Expr`) we use the phrase expansion
 (`HsExpr GhcRn -> HsExpr GhcRn`)
 
-See Note [Handling overloaded and rebindable constructs] in GHC.Rename.Expr
-
 This expansion is done right before typechecking and after renaming
 See Part 2. of Note [Doing HsExpansion in the Renamer vs Typechecker] in `GHC.Rename.Expr`
 
+Historical note START
+---------------------
 In previous versions of GHC, the `do`-notation wasn't expanded before typechecking,
 instead the typechecker would operate directly on the original.
 Why? because it ensured that type error messages were explained in terms of
@@ -262,8 +269,13 @@ what the programmer has written. In practice, however, this didn't work very wel
   the quantifiers impredicatively (#18324). Again, that happens automatically if
   you typecheck the expanded expression.
 
-* Equationally speaking, we have the following schema for expanding `do`-statements.
-  They capture the essence of statement expansions as implemented in `expand_do_stmts`
+Historical note END
+-------------------
+
+Do Expansions Equationally
+--------------------------
+We have the following schema for expanding `do`-statements.
+They capture the essence of statement expansions as implemented in `expand_do_stmts`
 
   DO【 _ 】 maps a sequence of do statements and recursively converts them into expressions
 
@@ -277,9 +289,21 @@ what the programmer has written. In practice, however, this didn't work very wel
                                                                        _ -> fail "pattern p failure"))
 
           (3) DO【 let x = e; ss 】
-                                = ‹ExpansionStmt (let x = e)› (let x = e in (‹PopErrCtxt›DO【 ss 】))
+                                 = ‹ExpansionStmt (let x = e)› (let x = e in (‹PopErrCtxt›DO【 ss 】))
+
+
+          (4) DO【 rec ss; sss 】
+                                 = (>>=) e (\vars -> ‹PopErrCtxt›DO【 sss 】))
+                                           where (vars, e) = RECDO【 ss 】
+
+          (5) DO【 s 】          = s
+
+  RECDO【 _ 】 maps a sequence of recursively dependent monadic statements and converts it into an expression paired
+              with the variables that the rec finds a fix point of.
+
+          (6) RECDO【 ss 】     = (vars, mfix (\~vars -> (>>=) (DO【 ss 】) (return vars)))
+                                  where vars are all the variables free in ss
 
-          (4) DO【 s 】          = s
 
 For a concrete example, consider a `do`-block written by the user
 
@@ -297,8 +321,7 @@ The {l1} etc are location/source span information stored in the AST by the parse
 {g1} are compiler generated source spans.
 
 
-The 3 main points to consider are:
-
+The 3 non-obvious points to consider are:
  1. Wrap the expression with a `fail` block if the pattern match is not irrefutable.
     See Part 1. Below
  2. Generate appropriate warnings for discarded results in a body statement
@@ -307,10 +330,12 @@ The 3 main points to consider are:
  3. Generating appropriate type error messages which blame the correct source spans
     See Part 3 Below
 
-Part 1. Wrapping failable patterns with fail blocks
----------------------------------------------------
+Part 1. Expanding Patterns Bindings
+-----------------------------------
 If `p` is a failable pattern---checked by `GHC.Tc.Gen.Pat.isIrrefutableHsPatRnTcM`---
-we need to wrap it with a `fail`-block. For example, the expansion of the `do`-block
+we need to wrap it with a `fail`-block. See Equation (2) above.
+
+The expansion of the `do`-block
 
         do { Just p <- e1; e2 }
 
@@ -321,7 +346,7 @@ we need to wrap it with a `fail`-block. For example, the expansion of the `do`-b
                  Just p -> e2
                  _      -> fail "failable pattern p at location")
 
-The `fail`-block wrapping is done in `GHC.Tc.Gen.Do.mk_failable_expr`.
+The `fail`-block wrapping is done by `GHC.Tc.Gen.Do.mk_failable_expr`.
 
 * Note the explicit call to `fail`, in the monad of the `do`-block.  Part of the specification
   of do-notation is that if the pattern match fails, we fail in the monad, *not* just crash
@@ -331,20 +356,19 @@ The `fail`-block wrapping is done in `GHC.Tc.Gen.Do.mk_failable_expr`.
   pattern is irrefuable, we don't want to generate that `fail` alternative, else we'll generate
   a `MonadFail` constraint that isn't needed.
 
-* Why an anonymous continuation lambda?
-  We need a lambda for the types to match: this expression is a second
-  argument to `(>>=)` so it needs to be of type `a -> m b`, a function.
-  It is anonymous because:
-     a. the name will be compiler generated and will never be seen by the user, and;
-     b. we are in the post renaming stage fresh naming will require non-trivial amount of plumbing for little gain.
+* _Wrinkle 1_: For pattern synonyms, we always wrap it with a `fail`-block.
+  When the pattern is irrefutable, we do not add the fail block.
+  This is important because the occurrence of `fail` means that the typechecker
+  will generate a `MonadFail` constraint, and the language spec says that
+  we should not do that for irrefutable patterns.
 
-* Wrinkle 1: For pattern synonyms, we always wrap it with a `fail`-block.
-  The irrefutable pattern checker returns false for pattern synonyms, but then after desugaring
-  we would get a pattern match checker's redundant pattern warnings. To avoid such
-  spurious warnings we filter out those type patterns that appear in a do expansion generated match
-  in `HsToCore.Match.matchWrapper`. (see testcase Typeable1.hs)
+  Note that pattern synonyms count as refutable (see `isIrrefutableHsPat`), and hence will generate
+  a `MonadFail` constraint, also, we would get a pattern match checker's redundant pattern warnings.
+  because after desugaring, it is marked as irrefutable!  To avoid such
+  spurious warnings and type checker errors, we filter out those patterns that appear
+  in a do expansion generated match in `HsToCore.Match.matchWrapper`. (see testcase Typeable1.hs)
 
-* Wrinkle 2: The call to `fail` will give rise to a `MonadFail` constraint. What `CtOrigin` do we
+* _Wrinkle 2_: The call to `fail` will give rise to a `MonadFail` constraint. What `CtOrigin` do we
   attach to that constraint?  It should be a good one, because it'll show up in error
   messages when the `MonadFail` constraint can't be solved.  Ideally, it should identify the
   pattern `p`.  Hence, we wrap the `fail` alternative expression with a `ExpandedPat`
@@ -358,14 +382,15 @@ the value when `-Wunused-binds` flag is turned on. (See testcase T3263-2.hs)
 
 For example the `do`-block
 
-    do { e1;  e2 }
+    do { e1;  e2 } -- where, e1 :: m Int
 
 expands to
 
     (>>) e1 e2
 
-* If `e1` returns a non-() value then we emit a value discarded warning. This check is done during desugaring
-  `HsToCore.dsExpr` in the `HsApp` with a call to `HsToCore.warnUnusedBindValue`.
+* If `e1` returns a non-() value we want to emit a warning, telling the user that they
+  are discarding the value returned by e1. This is done by `HsToCore.dsExpr` in the `HsApp`
+  with a call to `HsToCore.warnUnusedBindValue`.
 
 * The decision to trigger the warning is: if the function is a compiler generated `(>>)`,
   and its first argument `e1` has a non-() type
@@ -398,7 +423,7 @@ It stores the original statement (with location) and the expanded expression
     This is similar to vanilla `HsExpansion` and rebindable syntax
     See Note [Rebindable syntax and HsExpansion] in `GHC.Hs.Expr`.
 
-  * Recall, that when a source function arugment fails to typecheck,
+  * Recall, that when a source function argument fails to typecheck,
     we print an error message like "In the second argument of the function f..".
     However, `(>>)` is generated thus, we don't want to display that to the user; it would be confusing.
     But also, we do not want to completely ignore it as we do want to keep the error blame carets


=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -740,9 +740,9 @@ exprCtOrigin (HsUntypedSplice {})  = Shouldn'tHappenOrigin "TH untyped splice"
 exprCtOrigin (HsProc {})         = Shouldn'tHappenOrigin "proc"
 exprCtOrigin (HsStatic {})       = Shouldn'tHappenOrigin "static expression"
 exprCtOrigin (HsEmbTy {})        = Shouldn'tHappenOrigin "type expression"
-exprCtOrigin (XExpr (ExpandedThingRn thing)) | OrigExpr a <- original thing = exprCtOrigin a
-                                             | OrigStmt _ <- original thing = DoOrigin
-                                             | OrigPat p  <- original thing = DoPatOrigin p
+exprCtOrigin (XExpr (ExpandedThingRn thing _)) | OrigExpr a <- thing = exprCtOrigin a
+                                               | OrigStmt _ <- thing = DoOrigin
+                                               | OrigPat p  <- thing = DoPatOrigin p
 exprCtOrigin (XExpr (PopErrCtxt {})) = Shouldn'tHappenOrigin "PopErrCtxt"
 
 -- | Extract a suitable CtOrigin from a MatchGroup



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

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


More information about the ghc-commits mailing list