[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: docs: Update template-haskell docs to use Code Q a rather than Q (TExp a)

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Sun Apr 16 12:10:57 UTC 2023



Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC


Commits:
2c040246 by Matthew Pickering at 2023-04-15T00:57:14-04:00
docs: Update template-haskell docs to use Code Q a rather than Q (TExp a)

Since GHC Proposal #195, the type of [|| ... ||] has been Code Q a
rather than Q (TExp a). The documentation in the `template-haskell`
library wasn't updated to reflect this change.

Fixes #23148

- - - - -
9bc1c7c7 by Simon Peyton Jones at 2023-04-16T08:10:42-04:00
Transfer DFunId_ness onto specialised bindings

Whether a binding is a DFunId or not has consequences for the `-fdicts-strict`
flag, essentially if we are doing demand analysis for a DFunId then `-fdicts-strict` does
not apply because the constraint solver can create recursive groups of dictionaries.

In #22549 this was fixed for the "normal" case, see
Note [Do not strictify the argument dictionaries of a dfun].
However the loop still existed if the DFunId was being specialised.

The problem was that the specialiser would specialise a DFunId and
turn it into a VanillaId and so the demand analyser didn't know to
apply special treatment to the binding anymore and the whole recursive
group was optimised to bottom.

The solution is to transfer over the DFunId-ness of the binding in the specialiser so
that the demand analyser knows not to apply the `-fstrict-dicts`.

Fixes #22549

- - - - -
c7921c0a by Oleg Grenrus at 2023-04-16T08:10:48-04:00
Add import lists to few GHC.Driver.Session imports

Related to https://gitlab.haskell.org/ghc/ghc/-/issues/23261.
There are a lot of GHC.Driver.Session which only use DynFlags,
but not the parsing code.

- - - - -


6 changed files:

- compiler/GHC/Core/Opt/Specialise.hs
- compiler/GHC/Driver/Errors/Types.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/HsToCore/Errors/Types.hs
- compiler/GHC/Tc/Types/Constraint.hs
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs


Changes:

=====================================
compiler/GHC/Core/Opt/Specialise.hs
=====================================
@@ -48,10 +48,11 @@ import GHC.Types.Unique.DFM
 import GHC.Types.Name
 import GHC.Types.Tickish
 import GHC.Types.Id.Make  ( voidArgId, voidPrimId )
-import GHC.Types.Var      ( PiTyBinder(..), isLocalVar, isInvisibleFunArg )
+import GHC.Types.Var      ( PiTyBinder(..), isLocalVar, isInvisibleFunArg, mkLocalVar )
 import GHC.Types.Var.Set
 import GHC.Types.Var.Env
 import GHC.Types.Id
+import GHC.Types.Id.Info
 import GHC.Types.Error
 
 import GHC.Utils.Error ( mkMCDiagnostic )
@@ -59,6 +60,7 @@ import GHC.Utils.Monad    ( foldlM )
 import GHC.Utils.Misc
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
+import GHC.Utils.Panic.Plain( assert )
 
 import GHC.Unit.Module( Module )
 import GHC.Unit.Module.ModGuts
@@ -1748,12 +1750,44 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
                    | otherwise   = (spec_bndrs1, spec_rhs1, spec_fn_ty1)
 
                  join_arity_decr = length rule_lhs_args - length spec_bndrs
-                 spec_join_arity | Just orig_join_arity <- isJoinId_maybe fn
-                                 = Just (orig_join_arity - join_arity_decr)
-                                 | otherwise
-                                 = Nothing
 
-           ; spec_fn <- newSpecIdSM fn spec_fn_ty spec_join_arity
+                 --------------------------------------
+                 -- Add a suitable unfolding; see Note [Inline specialisations]
+                 -- The wrap_unf_body applies the original unfolding to the specialised
+                 -- arguments, not forgetting to wrap the dx_binds around the outside (#22358)
+                 simpl_opts = initSimpleOpts dflags
+                 wrap_unf_body body = foldr (Let . db_bind) (body `mkApps` spec_args) dx_binds
+                 spec_unf = specUnfolding simpl_opts spec_bndrs wrap_unf_body
+                                          rule_lhs_args fn_unf
+
+                 --------------------------------------
+                 -- Adding arity information just propagates it a bit faster
+                 --      See Note [Arity decrease] in GHC.Core.Opt.Simplify
+                 -- Copy InlinePragma information from the parent Id.
+                 -- So if f has INLINE[1] so does spec_fn
+                 arity_decr     = count isValArg rule_lhs_args - count isId spec_bndrs
+
+                 spec_inl_prag
+                   | not is_local     -- See Note [Specialising imported functions]
+                   , isStrongLoopBreaker (idOccInfo fn) -- in GHC.Core.Opt.OccurAnal
+                   = neverInlinePragma
+                   | otherwise
+                   = inl_prag
+
+                 spec_fn_info
+                   = vanillaIdInfo `setArityInfo`      max 0 (fn_arity - arity_decr)
+                                   `setInlinePragInfo` spec_inl_prag
+                                   `setUnfoldingInfo`  spec_unf
+
+                 -- Compute the IdDetails of the specialise Id
+                 -- See Note [Transfer IdDetails during specialisation]
+                 spec_fn_details
+                   = case idDetails fn of
+                       JoinId join_arity _ -> JoinId (join_arity - join_arity_decr) Nothing
+                       DFunId is_nt        -> DFunId is_nt
+                       _                   -> VanillaId
+
+           ; spec_fn <- newSpecIdSM (idName fn) spec_fn_ty spec_fn_details spec_fn_info
            ; let
                 -- The rule to put in the function's specialisation is:
                 --      forall x @b d1' d2'.
@@ -1768,33 +1802,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs
                                     herald fn rule_bndrs rule_lhs_args
                                     (mkVarApps (Var spec_fn) spec_bndrs)
 
-                simpl_opts = initSimpleOpts dflags
-
-                --------------------------------------
-                -- Add a suitable unfolding; see Note [Inline specialisations]
-                -- The wrap_unf_body applies the original unfolding to the specialised
-                -- arguments, not forgetting to wrap the dx_binds around the outside (#22358)
-                wrap_unf_body body = foldr (Let . db_bind) (body `mkApps` spec_args) dx_binds
-                spec_unf = specUnfolding simpl_opts spec_bndrs wrap_unf_body
-                                         rule_lhs_args fn_unf
-
-                spec_inl_prag
-                  | not is_local     -- See Note [Specialising imported functions]
-                  , isStrongLoopBreaker (idOccInfo fn) -- in GHC.Core.Opt.OccurAnal
-                  = neverInlinePragma
-                  | otherwise
-                  = inl_prag
-
-                --------------------------------------
-                -- Adding arity information just propagates it a bit faster
-                --      See Note [Arity decrease] in GHC.Core.Opt.Simplify
-                -- Copy InlinePragma information from the parent Id.
-                -- So if f has INLINE[1] so does spec_fn
-                arity_decr     = count isValArg rule_lhs_args - count isId spec_bndrs
-                spec_f_w_arity = spec_fn `setIdArity`      max 0 (fn_arity - arity_decr)
-                                         `setInlinePragma` spec_inl_prag
-                                         `setIdUnfolding`  spec_unf
-                                         `asJoinId_maybe`  spec_join_arity
+                spec_f_w_arity = spec_fn
 
                 _rule_trace_doc = vcat [ ppr fn <+> dcolon <+> ppr fn_type
                                        , ppr spec_fn  <+> dcolon <+> ppr spec_fn_ty
@@ -1824,7 +1832,7 @@ specLookupRule env fn args phase rules
 
 {- Note [Specialising DFuns]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-DFuns have a special sort of unfolding (DFunUnfolding), and these are
+DFuns have a special sort of unfolding (DFunUnfolding), and it is
 hard to specialise a DFunUnfolding to give another DFunUnfolding
 unless the DFun is fully applied (#18120).  So, in the case of DFunIds
 we simply extend the CallKey with trailing UnspecTypes/UnspecArgs,
@@ -1833,6 +1841,36 @@ so that we'll generate a rule that completely saturates the DFun.
 There is an ASSERT that checks this, in the DFunUnfolding case of
 GHC.Core.Unfold.Make.specUnfolding.
 
+Note [Transfer IdDetails during specialisation]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When specialising a function, `newSpecIdSM` comes up with a fresh Id the
+specialised RHS will be bound to. It is critical that we get the `IdDetails` of
+the specialised Id correct:
+
+* JoinId: We want the specialised Id to be a join point, too.  But
+  we have to carefully adjust the arity
+
+* DFunId: It is crucial that we also make the new Id a DFunId.
+  - First, because it obviously /is/ a DFun, having a DFunUnfolding and
+    all that; see Note [Specialising DFuns]
+
+  - Second, DFuns get very delicate special treatment in the demand analyser;
+    see GHC.Core.Opt.DmdAnal.enterDFun.  If the specialised function isn't
+    also a DFunId, this special treatment doesn't happen, so the demand
+    analyser makes a too-strict DFun, and we get an infinite loop.  See Note
+    [Do not strictify a DFun's parameter dictionaries] in GHC.Core.Opt.DmdAnal.
+    #22549 describes the loop, and (lower down) a case where a /specialised/
+    DFun caused a loop.
+
+* WorkerLikeId: Introduced by WW, so after Specialise. Nevertheless, they come
+  up when specialising imports. We must keep them as VanillaIds because WW
+  will detect them as WorkerLikeIds again. That is, unless specialisation
+  allows unboxing of all previous CBV args, in which case sticking to
+  VanillaIds was the only correct choice to begin with.
+
+* RecSelId, DataCon*Id, ClassOpId, PrimOpId, FCallId, CoVarId, TickBoxId:
+  Never specialised.
+
 Note [Specialisation Must Preserve Sharing]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider a function:
@@ -3439,15 +3477,14 @@ newDictBndr env@(SE { se_subst = subst }) b
              env' = env { se_subst = subst `Core.extendSubstInScope` b' }
        ; pure (env', b') }
 
-newSpecIdSM :: Id -> Type -> Maybe JoinArity -> SpecM Id
+newSpecIdSM :: Name -> Type -> IdDetails -> IdInfo -> SpecM Id
     -- Give the new Id a similar occurrence name to the old one
-newSpecIdSM old_id new_ty join_arity_maybe
+newSpecIdSM old_name new_ty details info
   = do  { uniq <- getUniqueM
-        ; let name    = idName old_id
-              new_occ = mkSpecOcc (nameOccName name)
-              new_id  = mkUserLocal new_occ uniq ManyTy new_ty (getSrcSpan name)
-                          `asJoinId_maybe` join_arity_maybe
-        ; return new_id }
+        ; let new_occ  = mkSpecOcc (nameOccName old_name)
+              new_name = mkInternalName uniq new_occ  (getSrcSpan old_name)
+        ; return (assert (not (isCoVarType new_ty)) $
+                  mkLocalVar details new_name ManyTy new_ty info) }
 
 {-
                 Old (but interesting) stuff about unboxed bindings


=====================================
compiler/GHC/Driver/Errors/Types.hs
=====================================
@@ -25,7 +25,8 @@ import GHC.Prelude
 import Data.Bifunctor
 import Data.Typeable
 
-import GHC.Driver.Session
+import GHC.Driver.Session (DynFlags, PackageArg, gopt)
+import GHC.Driver.Flags (GeneralFlag (Opt_BuildingCabalPackage))
 import GHC.Types.Error
 import GHC.Unit.Module
 import GHC.Unit.State


=====================================
compiler/GHC/Hs/Pat.hs
=====================================
@@ -82,7 +82,7 @@ import GHC.Types.SrcLoc
 import GHC.Data.Bag -- collect ev vars from pats
 import GHC.Data.Maybe
 import GHC.Types.Name (Name, dataName)
-import GHC.Driver.Session
+import GHC.Driver.Session (DynFlags, xopt)
 import qualified GHC.LanguageExtensions as LangExt
 import Data.Data
 


=====================================
compiler/GHC/HsToCore/Errors/Types.hs
=====================================
@@ -9,7 +9,8 @@ import GHC.Prelude
 import GHC.Core (CoreRule, CoreExpr, RuleName)
 import GHC.Core.DataCon
 import GHC.Core.Type
-import GHC.Driver.Session
+import GHC.Driver.Session (DynFlags, xopt)
+import GHC.Driver.Flags (WarningFlag)
 import GHC.Hs
 import GHC.HsToCore.Pmc.Solver.Types
 import GHC.Types.Basic (Activation)


=====================================
compiler/GHC/Tc/Types/Constraint.hs
=====================================
@@ -117,7 +117,7 @@ import GHC.Core
 import GHC.Core.TyCo.Ppr
 import GHC.Utils.FV
 import GHC.Types.Var.Set
-import GHC.Driver.Session
+import GHC.Driver.Session (DynFlags(reductionDepth))
 import GHC.Types.Basic
 import GHC.Types.Unique
 import GHC.Types.Unique.Set


=====================================
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
=====================================
@@ -335,39 +335,9 @@ type role TExp nominal   -- See Note [Role of TExp]
 newtype TExp (a :: TYPE (r :: RuntimeRep)) = TExp
   { unType :: Exp -- ^ Underlying untyped Template Haskell expression
   }
--- ^ Represents an expression which has type @a at . Built on top of 'Exp', typed
--- expressions allow for type-safe splicing via:
---
---   - typed quotes, written as @[|| ... ||]@ where @...@ is an expression; if
---     that expression has type @a@, then the quotation has type
---     @'Q' ('TExp' a)@
---
---   - typed splices inside of typed quotes, written as @$$(...)@ where @...@
---     is an arbitrary expression of type @'Q' ('TExp' a)@
---
--- Traditional expression quotes and splices let us construct ill-typed
--- expressions:
---
--- >>> fmap ppr $ runQ [| True == $( [| "foo" |] ) |]
--- GHC.Types.True GHC.Classes.== "foo"
--- >>> GHC.Types.True GHC.Classes.== "foo"
--- <interactive> error:
---     • Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
---     • In the second argument of ‘(==)’, namely ‘"foo"’
---       In the expression: True == "foo"
---       In an equation for ‘it’: it = True == "foo"
+-- ^ Typed wrapper around an 'Exp'.
 --
--- With typed expressions, the type error occurs when /constructing/ the
--- Template Haskell expression:
---
--- >>> fmap ppr $ runQ [|| True == $$( [|| "foo" ||] ) ||]
--- <interactive> error:
---     • Couldn't match type ‘[Char]’ with ‘Bool’
---       Expected type: Q (TExp Bool)
---         Actual type: Q (TExp [Char])
---     • In the Template Haskell quotation [|| "foo" ||]
---       In the expression: [|| "foo" ||]
---       In the Template Haskell splice $$([|| "foo" ||])
+-- This is the typed representation of terms produced by typed quotes.
 --
 -- Representation-polymorphic since /template-haskell-2.16.0.0/.
 
@@ -395,13 +365,13 @@ unsafeTExpCoerce m = do { e <- m
 TExp's argument must have a nominal role, not phantom as would
 be inferred (#8459).  Consider
 
-  e :: TExp Age
-  e = MkAge 3
+  e :: Code Q Age
+  e = [|| MkAge 3 ||]
 
   foo = $(coerce e) + 4::Int
 
 The splice will evaluate to (MkAge 3) and you can't add that to
-4::Int. So you can't coerce a (TExp Age) to a (TExp Int). -}
+4::Int. So you can't coerce a (Code Q Age) to a (Code Q Int). -}
 
 -- Code constructor
 
@@ -409,6 +379,40 @@ type role Code representational nominal   -- See Note [Role of TExp]
 newtype Code m (a :: TYPE (r :: RuntimeRep)) = Code
   { examineCode :: m (TExp a) -- ^ Underlying monadic value
   }
+-- ^ Represents an expression which has type @a@, built in monadic context @m at . Built on top of 'TExp', typed
+-- expressions allow for type-safe splicing via:
+--
+--   - typed quotes, written as @[|| ... ||]@ where @...@ is an expression; if
+--     that expression has type @a@, then the quotation has type
+--     @Quote m => Code m a@
+--
+--   - typed splices inside of typed quotes, written as @$$(...)@ where @...@
+--     is an arbitrary expression of type @Quote m => Code m a@
+--
+-- Traditional expression quotes and splices let us construct ill-typed
+-- expressions:
+--
+-- >>> fmap ppr $ runQ (unTypeCode [| True == $( [| "foo" |] ) |])
+-- GHC.Types.True GHC.Classes.== "foo"
+-- >>> GHC.Types.True GHC.Classes.== "foo"
+-- <interactive> error:
+--     • Couldn't match expected type ‘Bool’ with actual type ‘[Char]’
+--     • In the second argument of ‘(==)’, namely ‘"foo"’
+--       In the expression: True == "foo"
+--       In an equation for ‘it’: it = True == "foo"
+--
+-- With typed expressions, the type error occurs when /constructing/ the
+-- Template Haskell expression:
+--
+-- >>> fmap ppr $ runQ (unTypeCode [|| True == $$( [|| "foo" ||] ) ||])
+-- <interactive> error:
+--     • Couldn't match type ‘[Char]’ with ‘Bool’
+--       Expected type: Code Q Bool
+--         Actual type: Code Q [Char]
+--     • In the Template Haskell quotation [|| "foo" ||]
+--       In the expression: [|| "foo" ||]
+--       In the Template Haskell splice $$([|| "foo" ||])
+
 
 -- | Unsafely convert an untyped code representation into a typed code
 -- representation.
@@ -958,7 +962,7 @@ sequenceQ = sequence
 -- Haskell quotation is bound outside the Oxford brackets (@[| ... |]@ or
 -- @[|| ... ||]@) but not at the top level. As an example:
 --
--- > add1 :: Int -> Q (TExp Int)
+-- > add1 :: Int -> Code Q Int
 -- > add1 x = [|| x + 1 ||]
 --
 -- Template Haskell has no way of knowing what value @x@ will take on at
@@ -966,7 +970,7 @@ sequenceQ = sequence
 --
 -- A 'Lift' instance must satisfy @$(lift x) ≡ x@ and @$$(liftTyped x) ≡ x@
 -- for all @x@, where @$(...)@ and @$$(...)@ are Template Haskell splices.
--- It is additionally expected that @'lift' x ≡ 'unTypeQ' ('liftTyped' x)@.
+-- It is additionally expected that @'lift' x ≡ 'unTypeCode' ('liftTyped' x)@.
 --
 -- 'Lift' instances can be derived automatically by use of the @-XDeriveLift@
 -- GHC language extension:



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d6fd7f46f92337c4a48062d0890d617ca06b3c32...c7921c0affebc33d2c503b7ab5b6ff3d6c0cd81d

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d6fd7f46f92337c4a48062d0890d617ca06b3c32...c7921c0affebc33d2c503b7ab5b6ff3d6c0cd81d
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/20230416/ab24bf63/attachment-0001.html>


More information about the ghc-commits mailing list