Document the semantics of pattern bindings a bit better

This MR is in response to the discussion on #22719

1 files changed, 79 insertions, 28 deletions

diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs
index af222bf98a..5866243824 100644
--- a/compiler/GHC/Hs/Utils.hs
+++ b/compiler/GHC/Hs/Utils.hs
@@ -86,7 +86,7 @@ module GHC.Hs.Utils(
   mkLetStmt,
 
   -- * Collecting binders
-  isUnliftedHsBind, isBangedHsBind,
+  isUnliftedHsBind, isUnliftedHsBinds, isBangedHsBind,
 
   collectLocalBinders, collectHsValBinders, collectHsBindListBinders,
   collectHsIdBinders,
@@ -905,55 +905,106 @@ to return a [Name] or [Id].  Before renaming the record punning
 and wild-card mechanism makes it hard to know what is bound.
 So these functions should not be applied to (HsSyn RdrName)
 
-Note [Unlifted id check in isUnliftedHsBind]
+Note [isUnliftedHsBind]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-The function isUnliftedHsBind is used to complain if we make a top-level
-binding for a variable of unlifted type.
+The function isUnliftedHsBind tells if the binding binds a variable of
+unlifted type.  e.g.
 
-Such a binding is illegal if the top-level binding would be unlifted;
-but also if the local letrec generated by desugaring AbsBinds would be.
-E.g.
-      f :: Num a => (# a, a #)
-      g :: Num a => a -> a
-      f = ...g...
-      g = ...g...
+  - I# x = blah
+  - Just (I# x) = blah
 
-The top-level bindings for f,g are not unlifted (because of the Num a =>),
-but the local, recursive, monomorphic bindings are:
+isUnliftedHsBind is used in two ways:
 
+* To complain if we make a top-level binding for a variable of unlifted
+  type. E.g. any of the above bindings are illegal at top level
+
+* To generate a case expression for a non-recursive local let.  E.g.
+     let Just (I# x) = blah in body
+  ==>
+     case blah of Just (I# x) -> body
+  See GHC.HsToCore.Expr.dsUnliftedBind.
+
+Wrinkles:
+
+(W1) For AbsBinds we must check if the local letrec generated by desugaring
+     AbsBinds would be unlifted; so we just recurse into the abs_binds. E.g.
+       f :: Num a => (# a, a #)
+       g :: Num a => a -> a
+       f = ...g...
+       g = ...g...
+
+    The top-level bindings for f,g are not unlifted (because of the Num a =>),
+    but the local, recursive, monomorphic bindings are:
       t = /\a \(d:Num a).
          letrec fm :: (# a, a #) = ...g...
                 gm :: a -> a = ...f...
          in (fm, gm)
 
-Here the binding for 'fm' is illegal.  So generally we check the abe_mono types.
+   Here the binding for 'fm' is illegal.  So we recurse into the abs_binds
+
+(W2) BUT we have a special case when abs_sig is true;
+     see Note [The abs_sig field of AbsBinds] in GHC.Hs.Binds
+
+(W3) isUnliftedHsBind returns False even if the binding itself is
+     unlifted, provided it binds only lifted variables. E.g.
+      -  (# a,b #) = (# reverse xs, xs #)
+
+      -  x = sqrt# y#  :: Float#
+
+      -  type Unl :: UnliftedType
+         data Unl = MkUnl Int
+         MkUnl z = blah
 
-BUT we have a special case when abs_sig is true;
-  see Note [The abs_sig field of AbsBinds] in GHC.Hs.Binds
+     In each case the RHS of the "=" has unlifted type, but isUnliftedHsBind
+     returns False.  Reason: see GHC Proposal #35
+        https://github.com/ghc-proposals/ghc-proposals/blob/master/
+        proposals/0035-unbanged-strict-patterns.rst
+
+(W4) In particular, (W3) applies to a pattern that binds no variables at all.
+     So   { _ = sqrt# y :: Float# } returns False from isUnliftedHsBind, but
+          { x = sqrt# y :: Float# } returns True.
+     This is arguably a bit confusing (see #22719)
 -}
 
 ----------------- Bindings --------------------------
 
 -- | Should we treat this as an unlifted bind? This will be true for any
 -- bind that binds an unlifted variable, but we must be careful around
--- AbsBinds. See Note [Unlifted id check in isUnliftedHsBind]. For usage
+-- AbsBinds. See Note [isUnliftedHsBind]. For usage
 -- information, see Note [Strict binds checks] is GHC.HsToCore.Binds.
 isUnliftedHsBind :: HsBind GhcTc -> Bool  -- works only over typechecked binds
-isUnliftedHsBind bind
-  | XHsBindsLR (AbsBinds { abs_exports = exports, abs_sig = has_sig }) <- bind
-  = if has_sig
-    then any (is_unlifted_id . abe_poly) exports
-    else any (is_unlifted_id . abe_mono) exports
+isUnliftedHsBind (XHsBindsLR (AbsBinds { abs_exports = exports
+                                       , abs_sig     = has_sig
+                                       , abs_binds   = binds }))
+  | has_sig   = any (is_unlifted_id . abe_poly) exports
+  | otherwise = isUnliftedHsBinds binds
+    -- See wrinkle (W1) and (W2) in Note [isUnliftedHsBind]
     -- If has_sig is True we will never generate a binding for abe_mono,
     -- so we don't need to worry about it being unlifted. The abe_poly
     -- binding might not be: e.g. forall a. Num a => (# a, a #)
+    -- If has_sig is False, just recurse
 
-  | otherwise
-  = any is_unlifted_id (collectHsBindBinders CollNoDictBinders bind)
-  where
-    is_unlifted_id id = isUnliftedType (idType id)
-      -- bindings always have a fixed RuntimeRep, so it's OK
-      -- to call isUnliftedType here
+isUnliftedHsBind (FunBind { fun_id = L _ fun })
+  = is_unlifted_id fun
+
+isUnliftedHsBind (VarBind { var_id = var })
+  = is_unlifted_id var
+
+isUnliftedHsBind (PatBind { pat_lhs = pat })
+  = any is_unlifted_id (collectPatBinders CollNoDictBinders pat)
+    -- If we changed our view on (W3) you could add
+    --    || isUnliftedType pat_ty
+    -- to this check
+
+isUnliftedHsBind (PatSynBind {}) = panic "isUnliftedBind: PatSynBind"
+
+isUnliftedHsBinds :: LHsBinds GhcTc -> Bool
+isUnliftedHsBinds = anyBag (isUnliftedHsBind . unLoc)
+
+is_unlifted_id :: Id -> Bool
+is_unlifted_id id = isUnliftedType (idType id)
+   -- Bindings always have a fixed RuntimeRep, so it's OK
+   -- to call isUnliftedType here
 
 -- | Is a binding a strict variable or pattern bind (e.g. @!x = ...@)?
 isBangedHsBind :: HsBind GhcTc -> Bool