1 files changed, 64 insertions, 1 deletions
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index 5c68525f12..333929c956 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -30,7 +30,7 @@ module GHC.HsToCore.Utils (
         wrapBind, wrapBinds,
 
         mkErrorAppDs, mkCoreAppDs, mkCoreAppsDs, mkCastDs,
-        mkFailExpr,
+        mkFailExpr, dsWhenNoErrs,
 
         seqVar,
 
@@ -982,6 +982,69 @@ mk_fail_msg dflags ctx pat
   = showPpr dflags $ text "Pattern match failure in" <+> pprStmtContext ctx
                    <+> text "at" <+> ppr (getLocA pat)
 
+{- Note [Desugaring representation-polymorphic applications]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+To desugar a function application
+
+> HsApp _ f e :: HsExpr GhcTc
+
+into Core, we need to know whether the argument e is lifted or unlifted,
+in order to respect the let/app invariant.
+  (See Note [Core let/app invariant] in GHC.Core)
+
+This causes a problem when e is representation-polymorphic, as we aren't able
+to determine whether to build a Core application
+
+> f_desugared e_desugared
+
+or a strict binding:
+
+> case e_desugared of { x -> f_desugared x }
+
+See GHC.Core.Make.mkValApp, which will call isUnliftedType, which panics
+on a representation-polymorphic type.
+
+These representation-polymorphic applications are disallowed in source Haskell,
+but we might want to continue desugaring as much as possible instead of
+aborting as soon as we see such a problematic function application.
+
+When desugaring an expression which might have problems (such as disallowed
+representation polymorphism as above), we check for errors first, and then:
+
+  - if no problems were detected, desugar normally,
+  - if errors were found, we want to avoid desugaring, so we instead return
+    a runtime error Core expression which has the right type.
+
+This is what the function dsWhenNoErrs achieves:
+
+> dsWhenNoErrs result_ty thing_inside mk_expr
+
+We run thing_inside to check for errors. If there are no errors, we apply
+mk_expr to desugar; otherwise, we construct a runtime error at type result_ty.
+
+Note that result_ty is only used when there is an error, and isn't inspected
+otherwise; this means it's OK to pass something that can be a bit expensive
+to compute.
+
+See #12709 for an example of why this machinery is necessary.
+See also #14765 and #18149 for why it is important to return an expression
+that has the proper type in case of an error.
+-}
+
+-- | Runs the thing_inside. If there are no errors, use the provided
+-- function to construct a Core expression, and return it.
+-- Otherwise, return a runtime error, of the given type.
+-- This is useful for doing a bunch of representation polymorphism checks
+-- and then avoiding making a Core App.
+-- See Note [Desugaring representation-polymorphic applications]
+dsWhenNoErrs :: Type -> DsM a -> (a -> CoreExpr) -> DsM CoreExpr
+dsWhenNoErrs result_ty thing_inside mk_expr
+  = do { (result, no_errs) <- askNoErrsDs thing_inside
+       ; if no_errs
+         then return $ mk_expr result
+         else mkErrorAppDs rUNTIME_ERROR_ID result_ty
+            (text "dsWhenNoErrs found errors") }
+
 {- *********************************************************************
 *                                                                      *
               Ticks