[Git][ghc/ghc][master] 6 commits: Simplify bindLHsTyVarBndrs and bindHsQTyVars

Ben Gamari gitlab at gitlab.haskell.org
Mon Jun 8 13:28:24 UTC 2020



Ben Gamari pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
2dff8141 by Ryan Scott at 2020-06-05T14:21:24-04:00
Simplify bindLHsTyVarBndrs and bindHsQTyVars

Both `bindLHsTyVarBndrs` and `bindHsQTyVars` take two separate
`Maybe` arguments, which I find terribly confusing. Thankfully, it's
possible to remove one `Maybe` argument from each of these functions,
which this patch accomplishes:

* `bindHsQTyVars` takes a `Maybe SDoc` argument, which is `Just` if
  GHC should warn about any of the quantified type variables going
  unused. However, every call site uses `Nothing` in practice. This
  makes sense, since it doesn't really make sense to warn about
  unused type variables bound by an `LHsQTyVars`. For instance, you
  wouldn't warn about the `a` in `data Proxy a = Proxy` going unused.

  As a result, I simply remove this `Maybe SDoc` argument altogether.
* `bindLHsTyVarBndrs` also takes a `Maybe SDoc` argument for the same
  reasons that `bindHsQTyVars` took one. To make things more
  confusing, however, `bindLHsTyVarBndrs` also takes a separate
  `HsDocContext` argument, which is pretty-printed (to an `SDoc`) in
  warnings and error messages.

  In practice, the `Maybe SDoc` and the `HsDocContext` often contain
  the same text. See the call sites for `bindLHsTyVarBndrs` in
  `rnFamInstEqn` and `rnConDecl`, for instance. There are only a
  handful of call sites where the text differs between the
  `Maybe SDoc` and `HsDocContext` arguments:

  * In `rnHsRuleDecl`, where the `Maybe SDoc` says "`In the rule`"
    and the `HsDocContext` says "`In the transformation rule`".
  * In `rnHsTyKi`/`rn_ty`, where the `Maybe SDoc` says
    "`In the type`" but the `HsDocContext` is inhereted from the
    surrounding context (e.g., if `rnHsTyKi` were called on a
    top-level type signature, the `HsDocContext` would be
    "`In the type signature`" instead)

  In both cases, warnings/error messages arguably _improve_ by
  unifying making the `Maybe SDoc`'s text match that of the
  `HsDocContext`. As a result, I decided to remove the `Maybe SDoc`
  argument to `bindLHsTyVarBndrs` entirely and simply reuse the text
  from the `HsDocContext`. (I decided to change the phrase
  "transformation rule" to "rewrite rule" while I was in the area.)

  The `Maybe SDoc` argument has one other purpose: signaling when to
  emit "`Unused quantified type variable`" warnings. To recover this
  functionality, I replaced the `Maybe SDoc` argument with a
  boolean-like `WarnUnusedForalls` argument. The only
  `bindLHsTyVarBndrs` call site that chooses _not_ to emit these
  warnings in `bindHsQTyVars`.

- - - - -
e372331b by Ben Gamari at 2020-06-07T08:46:41-04:00
hadrian: Add missing deriveConstants dependency on ghcplatform.h

deriveConstants wants to compile C sources which #include PosixSource.h,
which itself #includes ghcplatform.h. Make sure that Hadrian knows
about this dependency.

Fixes #18290.

- - - - -
b022051a by Moritz Angermann at 2020-06-07T08:46:42-04:00
ghc-prim needs to depend on libc and libm

libm is just an empty shell on musl, and all the math functions are contained in
libc.

- - - - -
6dae6548 by Moritz Angermann at 2020-06-07T08:46:42-04:00
Disable DLL loading if without system linker

Some platforms (musl, aarch64) do not have a working dynamic linker
implemented in the libc, even though we might see dlopen.  It will
ultimately just return that this is not supported.  Hence we'll add
a flag to the compiler to flat our disable loading dlls.  This is
needed as we will otherwise try to load the shared library even
if this will subsequently fail.  At that point we have given up
looking for static options though.

- - - - -
4a158ffc by Moritz Angermann at 2020-06-07T08:46:43-04:00
Range is actually +/-2^32, not +/-2^31

See also: https://static.docs.arm.com/ihi0056/g/aaelf64.pdf

- - - - -
f1bfb806 by Ben Gamari at 2020-06-07T10:49:30-04:00
OccurAnal: Avoid exponential behavior due to where clauses

Previously the `Var` case of `occAnalApp` could in some cases (namely
in the case of `runRW#` applications) call `occAnalRhs` two. In the case
of nested `runRW#`s this results in exponential complexity. In some
cases the compilation time that resulted would be very long indeed
(see #18296).

Fixes #18296.

Metric Decrease:
    T9961
    T12150
    T12234

- - - - -


23 changed files:

- compiler/GHC/Core.hs
- compiler/GHC/Core/Lint.hs
- compiler/GHC/Core/Opt/OccurAnal.hs
- compiler/GHC/Core/Opt/Simplify.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Driver/Types.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/HsToCore.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Runtime/Linker.hs
- compiler/GHC/Tc/Gen/Rule.hs
- compiler/ghc.cabal.in
- hadrian/src/Rules/Generate.hs
- libraries/ghc-prim/ghc-prim.cabal
- rts/linker/elf_reloc_aarch64.c
- testsuite/tests/dependent/should_fail/T16326_Fail10.stderr
- testsuite/tests/rename/should_compile/ExplicitForAllRules1.stderr
- testsuite/tests/rename/should_compile/T5331.stderr
- testsuite/tests/safeHaskell/ghci/p14.stderr
- testsuite/tests/typecheck/should_compile/T10072.stderr
- testsuite/tests/typecheck/should_fail/T5853.stderr


Changes:

=====================================
compiler/GHC/Core.hs
=====================================
@@ -1291,7 +1291,7 @@ Orphan-hood is computed
 {-
 ************************************************************************
 *                                                                      *
-\subsection{Transformation rules}
+\subsection{Rewrite rules}
 *                                                                      *
 ************************************************************************
 


=====================================
compiler/GHC/Core/Lint.hs
=====================================
@@ -467,7 +467,7 @@ lintCoreBindings dflags pass local_in_scope binds
   where
     all_pairs = flattenBinds binds
      -- Put all the top-level binders in scope at the start
-     -- This is because transformation rules can bring something
+     -- This is because rewrite rules can bring something
      -- into use 'unexpectedly'; see Note [Glomming] in OccurAnal
     binders = map fst all_pairs
 


=====================================
compiler/GHC/Core/Opt/OccurAnal.hs
=====================================
@@ -1568,16 +1568,17 @@ occAnalRhs :: OccEnv -> Maybe JoinArity
            -> CoreExpr   -- RHS
            -> (UsageDetails, CoreExpr)
 occAnalRhs env mb_join_arity rhs
-  = (rhs_usage, rhs')
+  = case occAnalLamOrRhs env bndrs body of { (body_usage, bndrs', body') ->
+    let rhs' = mkLams (markJoinOneShots mb_join_arity bndrs') body'
+               -- For a /non-recursive/ join point we can mark all
+               -- its join-lambda as one-shot; and it's a good idea to do so
+
+        -- Final adjustment
+        rhs_usage = adjustRhsUsage mb_join_arity NonRecursive bndrs' body_usage
+
+    in (rhs_usage, rhs') }
   where
     (bndrs, body) = collectBinders rhs
-    (body_usage, bndrs', body') = occAnalLamOrRhs env bndrs body
-    rhs' = mkLams (markJoinOneShots mb_join_arity bndrs') body'
-           -- For a /non-recursive/ join point we can mark all
-           -- its join-lambda as one-shot; and it's a good idea to do so
-
-    -- Final adjustment
-    rhs_usage = adjustRhsUsage mb_join_arity NonRecursive bndrs' body_usage
 
 occAnalUnfolding :: OccEnv
                  -> Maybe JoinArity   -- See Note [Join points and unfoldings/rules]
@@ -1885,12 +1886,18 @@ occAnalApp :: OccEnv
 occAnalApp env (Var fun, args, ticks)
   -- Account for join arity of runRW# continuation
   -- See Note [Simplification of runRW#]
+  --
+  -- NB: Do not be tempted to make the next (Var fun, args, tick)
+  --     equation into an 'otherwise' clause for this equation
+  --     The former has a bang-pattern to occ-anal the args, and
+  --     we don't want to occ-anal them twice in the runRW# case!
+  --     This caused #18296
   | fun `hasKey` runRWKey
   , [t1, t2, arg]  <- args
   , let (usage, arg') = occAnalRhs env (Just 1) arg
   = (usage, mkTicks ticks $ mkApps (Var fun) [t1, t2, arg'])
 
-  | otherwise
+occAnalApp env (Var fun, args, ticks)
   = (all_uds, mkTicks ticks $ mkApps fun' args')
   where
     (fun', fun_id') = lookupVarEnv (occ_bs_env env) fun


=====================================
compiler/GHC/Core/Opt/Simplify.hs
=====================================
@@ -170,7 +170,7 @@ simplTopBinds :: SimplEnv -> [InBind] -> SimplM (SimplFloats, SimplEnv)
 -- See Note [The big picture]
 simplTopBinds env0 binds0
   = do  {       -- Put all the top-level binders into scope at the start
-                -- so that if a transformation rule has unexpectedly brought
+                -- so that if a rewrite rule has unexpectedly brought
                 -- anything into scope, then we don't get a complaint about that.
                 -- It's rather as if the top-level binders were imported.
                 -- See note [Glomming] in OccurAnal.


=====================================
compiler/GHC/Core/Rules.hs
=====================================
@@ -1,7 +1,7 @@
 {-
 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
 
-\section[CoreRules]{Transformation rules}
+\section[CoreRules]{Rewrite rules}
 -}
 
 {-# LANGUAGE CPP #-}


=====================================
compiler/GHC/Driver/Types.hs
=====================================
@@ -2488,7 +2488,7 @@ lookupFixity env n = case lookupNameEnv env n of
 -- * An instance declaration in a module other than the definition
 --   module for one of the type constructors or classes in the instance head
 --
--- * A transformation rule in a module other than the one defining
+-- * A rewrite rule in a module other than the one defining
 --   the function in the head of the rule
 --
 type WhetherHasOrphans   = Bool


=====================================
compiler/GHC/Hs/Decls.hs
=====================================
@@ -2184,7 +2184,7 @@ instance Outputable ForeignExport where
 {-
 ************************************************************************
 *                                                                      *
-\subsection{Transformation rules}
+\subsection{Rewrite rules}
 *                                                                      *
 ************************************************************************
 -}


=====================================
compiler/GHC/HsToCore.hs
=====================================
@@ -354,7 +354,7 @@ to the binders in the top-level bindings
 
 Reason
   - It makes the rules easier to look up
-  - It means that transformation rules and specialisations for
+  - It means that rewrite rules and specialisations for
     locally defined Ids are handled uniformly
   - It keeps alive things that are referred to only from a rule
     (the occurrence analyser knows about rules attached to Ids)
@@ -368,7 +368,7 @@ Reason
 
 ************************************************************************
 *                                                                      *
-*              Desugaring transformation rules
+*              Desugaring rewrite rules
 *                                                                      *
 ************************************************************************
 -}


=====================================
compiler/GHC/Rename/HsType.hs
=====================================
@@ -23,8 +23,8 @@ module GHC.Rename.HsType (
         checkPrecMatch, checkSectionPrec,
 
         -- Binding related stuff
-        bindLHsTyVarBndr, bindLHsTyVarBndrs, rnImplicitBndrs,
-        bindSigTyVarsFV, bindHsQTyVars, bindLRdrNames,
+        bindLHsTyVarBndr, bindLHsTyVarBndrs, WarnUnusedForalls(..),
+        rnImplicitBndrs, bindSigTyVarsFV, bindHsQTyVars, bindLRdrNames,
         extractHsTyRdrTyVars, extractHsTyRdrTyVarsKindVars,
         extractHsTysRdrTyVarsDups,
         extractRdrKindSigVars, extractDataDefnKindVars,
@@ -41,9 +41,10 @@ import GHC.Driver.Session
 import GHC.Hs
 import GHC.Rename.Doc    ( rnLHsDoc, rnMbLHsDoc )
 import GHC.Rename.Env
-import GHC.Rename.Utils  ( HsDocContext(..), withHsDocContext, mapFvRn
-                         , pprHsDocContext, bindLocalNamesFV, typeAppErr
-                         , newLocalBndrRn, checkDupRdrNames, checkShadowedRdrNames )
+import GHC.Rename.Utils  ( HsDocContext(..), inHsDocContext, withHsDocContext
+                         , mapFvRn, pprHsDocContext, bindLocalNamesFV
+                         , typeAppErr, newLocalBndrRn, checkDupRdrNames
+                         , checkShadowedRdrNames )
 import GHC.Rename.Fixity ( lookupFieldFixityRn, lookupFixityRn
                          , lookupTyFixityRn )
 import GHC.Tc.Utils.Monad
@@ -203,9 +204,10 @@ rnWcBody ctxt nwc_rdrs hs_ty
 
     rn_ty :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
     -- A lot of faff just to allow the extra-constraints wildcard to appear
-    rn_ty env hs_ty@(HsForAllTy { hst_fvf = fvf, hst_bndrs = tvs
-                                , hst_body = hs_body })
-      = bindLHsTyVarBndrs (rtke_ctxt env) (Just $ inTypeDoc hs_ty) Nothing tvs $ \ tvs' ->
+    rn_ty env (HsForAllTy { hst_fvf = fvf, hst_bndrs = tvs
+                          , hst_body = hs_body })
+      = bindLHsTyVarBndrs (rtke_ctxt env) WarnUnusedForalls
+                          Nothing tvs $ \ tvs' ->
         do { (hs_body', fvs) <- rn_lty env hs_body
            ; return (HsForAllTy { hst_fvf = fvf, hst_xforall = noExtField
                                 , hst_bndrs = tvs', hst_body = hs_body' }
@@ -534,7 +536,7 @@ rnHsTyKi :: RnTyKiEnv -> HsType GhcPs -> RnM (HsType GhcRn, FreeVars)
 rnHsTyKi env ty@(HsForAllTy { hst_fvf = fvf, hst_bndrs = tyvars
                             , hst_body = tau })
   = do { checkPolyKinds env ty
-       ; bindLHsTyVarBndrs (rtke_ctxt env) (Just $ inTypeDoc ty)
+       ; bindLHsTyVarBndrs (rtke_ctxt env) WarnUnusedForalls
                            Nothing tyvars $ \ tyvars' ->
     do { (tau',  fvs) <- rnLHsTyKi env tau
        ; return ( HsForAllTy { hst_fvf = fvf, hst_xforall = noExtField
@@ -845,11 +847,9 @@ bindLRdrNames rdrs thing_inside
 ---------------
 bindHsQTyVars :: forall a b.
                  HsDocContext
-              -> Maybe SDoc         -- Just d => check for unused tvs
-                                    --   d is a phrase like "in the type ..."
               -> Maybe a            -- Just _  => an associated type decl
               -> [Located RdrName]  -- Kind variables from scope, no dups
-              -> (LHsQTyVars GhcPs)
+              -> LHsQTyVars GhcPs
               -> (LHsQTyVars GhcRn -> Bool -> RnM (b, FreeVars))
                   -- The Bool is True <=> all kind variables used in the
                   -- kind signature are bound on the left.  Reason:
@@ -863,7 +863,7 @@ bindHsQTyVars :: forall a b.
 --     and  (ii) mentioned in the kinds of hsq_bndrs
 -- (b) Bring type variables into scope
 --
-bindHsQTyVars doc mb_in_doc mb_assoc body_kv_occs hsq_bndrs thing_inside
+bindHsQTyVars doc mb_assoc body_kv_occs hsq_bndrs thing_inside
   = do { let hs_tv_bndrs = hsQTvExplicit hsq_bndrs
              bndr_kv_occs = extractHsTyVarBndrsKVs hs_tv_bndrs
 
@@ -888,7 +888,10 @@ bindHsQTyVars doc mb_in_doc mb_assoc body_kv_occs hsq_bndrs thing_inside
        ; implicit_kv_nms <- mapM (newTyVarNameRn mb_assoc) implicit_kvs
 
        ; bindLocalNamesFV implicit_kv_nms                     $
-         bindLHsTyVarBndrs doc mb_in_doc mb_assoc hs_tv_bndrs $ \ rn_bndrs ->
+         bindLHsTyVarBndrs doc NoWarnUnusedForalls mb_assoc hs_tv_bndrs $ \ rn_bndrs ->
+           -- This is the only call site for bindLHsTyVarBndrs where we pass
+           -- NoWarnUnusedForalls, which suppresses -Wunused-foralls warnings.
+           -- See Note [Suppress -Wunused-foralls when binding LHsQTyVars].
     do { traceRn "bindHsQTyVars" (ppr hsq_bndrs $$ ppr implicit_kv_nms $$ ppr rn_bndrs)
        ; thing_inside (HsQTvs { hsq_ext = implicit_kv_nms
                               , hsq_explicit  = rn_bndrs })
@@ -990,17 +993,50 @@ variable in (a :: k), later in the binding. (This mistake lead to #14710.)
 So tvs is {k,a} and kvs is {k}.
 
 NB: we do this only at the binding site of 'tvs'.
+
+Note [Suppress -Wunused-foralls when binding LHsQTyVars]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The WarnUnusedForalls flag controls whether bindLHsTyVarBndrs should warn about
+explicit type variable binders that go unused (e.g., the `a` in
+`forall a. Int`). We almost always want to warn about these, since unused type
+variables can usually be deleted without any repercussions. There is one
+exception to this rule, however: binding LHsQTyVars. Consider this example:
+
+  data Proxy a = Proxy
+
+The `a` in `Proxy a` is bound by an LHsQTyVars, and the code which brings it
+into scope, bindHsQTyVars, will invoke bindLHsTyVarBndrs in turn. As such, it
+has a choice to make about whether to emit -Wunused-foralls warnings or not.
+If it /did/ emit warnings, then the `a` would be flagged as unused. However,
+this is not what we want! Removing the `a` in `Proxy a` would change its kind
+entirely, which is a huge price to pay for fixing a warning.
+
+Unlike other forms of type variable binders, dropping "unused" variables in
+an LHsQTyVars can be semantically significant. As a result, we suppress
+-Wunused-foralls warnings in exactly one place: in bindHsQTyVars.
 -}
 
+-- | Should GHC warn if a quantified type variable goes unused? Usually, the
+-- answer is \"yes\", but in the particular case of binding 'LHsQTyVars', we
+-- avoid emitting warnings.
+-- See @Note [Suppress -Wunused-foralls when binding LHsQTyVars]@.
+data WarnUnusedForalls
+  = WarnUnusedForalls
+  | NoWarnUnusedForalls
+
+instance Outputable WarnUnusedForalls where
+  ppr wuf = text $ case wuf of
+    WarnUnusedForalls   -> "WarnUnusedForalls"
+    NoWarnUnusedForalls -> "NoWarnUnusedForalls"
+
 bindLHsTyVarBndrs :: (OutputableBndrFlag flag)
                   => HsDocContext
-                  -> Maybe SDoc            -- Just d => check for unused tvs
-                                           --   d is a phrase like "in the type ..."
+                  -> WarnUnusedForalls
                   -> Maybe a               -- Just _  => an associated type decl
                   -> [LHsTyVarBndr flag GhcPs]  -- User-written tyvars
                   -> ([LHsTyVarBndr flag GhcRn] -> RnM (b, FreeVars))
                   -> RnM (b, FreeVars)
-bindLHsTyVarBndrs doc mb_in_doc mb_assoc tv_bndrs thing_inside
+bindLHsTyVarBndrs doc wuf mb_assoc tv_bndrs thing_inside
   = do { when (isNothing mb_assoc) (checkShadowedRdrNames tv_names_w_loc)
        ; checkDupRdrNames tv_names_w_loc
        ; go tv_bndrs thing_inside }
@@ -1014,9 +1050,9 @@ bindLHsTyVarBndrs doc mb_in_doc mb_assoc tv_bndrs thing_inside
                                 ; warn_unused b' fvs
                                 ; return (res, fvs) }
 
-    warn_unused tv_bndr fvs = case mb_in_doc of
-      Just in_doc -> warnUnusedForAll in_doc tv_bndr fvs
-      Nothing     -> return ()
+    warn_unused tv_bndr fvs = case wuf of
+      WarnUnusedForalls   -> warnUnusedForAll doc tv_bndr fvs
+      NoWarnUnusedForalls -> return ()
 
 bindLHsTyVarBndr :: HsDocContext
                  -> Maybe a   -- associated class
@@ -1456,16 +1492,14 @@ dataKindsErr env thing
     pp_what | isRnKindLevel env = text "kind"
             | otherwise          = text "type"
 
-inTypeDoc :: HsType GhcPs -> SDoc
-inTypeDoc ty = text "In the type" <+> quotes (ppr ty)
-
-warnUnusedForAll :: (OutputableBndrFlag flag) => SDoc -> LHsTyVarBndr flag GhcRn -> FreeVars -> TcM ()
-warnUnusedForAll in_doc (L loc tv) used_names
+warnUnusedForAll :: OutputableBndrFlag flag
+                 => HsDocContext -> LHsTyVarBndr flag GhcRn -> FreeVars -> TcM ()
+warnUnusedForAll doc (L loc tv) used_names
   = whenWOptM Opt_WarnUnusedForalls $
     unless (hsTyVarName tv `elemNameSet` used_names) $
     addWarnAt (Reason Opt_WarnUnusedForalls) loc $
     vcat [ text "Unused quantified type variable" <+> quotes (ppr tv)
-         , in_doc ]
+         , inHsDocContext doc ]
 
 opTyErr :: Outputable a => RdrName -> a -> SDoc
 opTyErr op overall_ty


=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -31,7 +31,7 @@ import GHC.Rename.HsType
 import GHC.Rename.Bind
 import GHC.Rename.Env
 import GHC.Rename.Utils ( HsDocContext(..), mapFvRn, bindLocalNames
-                        , checkDupRdrNames, inHsDocContext, bindLocalNamesFV
+                        , checkDupRdrNames, bindLocalNamesFV
                         , checkShadowedRdrNames, warnUnusedTypePatterns
                         , extendTyVarEnvFVRn, newLocalBndrsRn
                         , withHsDocContext )
@@ -720,7 +720,7 @@ rnFamInstEqn doc atfi rhs_kvars
              -- with a sensible binding location
        ; ((bndrs', pats', payload'), fvs)
               <- bindLocalNamesFV all_imp_var_names $
-                 bindLHsTyVarBndrs doc (Just $ inHsDocContext doc)
+                 bindLHsTyVarBndrs doc WarnUnusedForalls
                                    Nothing bndrs $ \bndrs' ->
                  -- Note: If we pass mb_cls instead of Nothing here,
                  --  bindLHsTyVarBndrs will use class variables for any names
@@ -1017,7 +1017,7 @@ rnHsRuleDecl (HsRule { rd_name = rule_name
        ; checkShadowedRdrNames rdr_names_w_loc
        ; names <- newLocalBndrsRn rdr_names_w_loc
        ; let doc = RuleCtx (snd $ unLoc rule_name)
-       ; bindRuleTyVars doc in_rule tyvs $ \ tyvs' ->
+       ; bindRuleTyVars doc tyvs $ \ tyvs' ->
          bindRuleTmVars doc tyvs' tmvs names $ \ tmvs' ->
     do { (lhs', fv_lhs') <- rnLExpr lhs
        ; (rhs', fv_rhs') <- rnLExpr rhs
@@ -1033,7 +1033,6 @@ rnHsRuleDecl (HsRule { rd_name = rule_name
     get_var :: RuleBndr GhcPs -> Located RdrName
     get_var (RuleBndrSig _ v _) = v
     get_var (RuleBndr _ v)      = v
-    in_rule = text "in the rule" <+> pprFullRuleName rule_name
 
 bindRuleTmVars :: HsDocContext -> Maybe ty_bndrs
                -> [LRuleBndr GhcPs] -> [Name]
@@ -1059,17 +1058,17 @@ bindRuleTmVars doc tyvs vars names thing_inside
     bind_free_tvs = case tyvs of Nothing -> AlwaysBind
                                  Just _  -> NeverBind
 
-bindRuleTyVars :: HsDocContext -> SDoc -> Maybe [LHsTyVarBndr () GhcPs]
+bindRuleTyVars :: HsDocContext -> Maybe [LHsTyVarBndr () GhcPs]
                -> (Maybe [LHsTyVarBndr () GhcRn]  -> RnM (b, FreeVars))
                -> RnM (b, FreeVars)
-bindRuleTyVars doc in_doc (Just bndrs) thing_inside
-  = bindLHsTyVarBndrs doc (Just in_doc) Nothing bndrs (thing_inside . Just)
-bindRuleTyVars _ _ _ thing_inside = thing_inside Nothing
+bindRuleTyVars doc (Just bndrs) thing_inside
+  = bindLHsTyVarBndrs doc WarnUnusedForalls Nothing bndrs (thing_inside . Just)
+bindRuleTyVars _ _ thing_inside = thing_inside Nothing
 
 {-
 Note [Rule LHS validity checking]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Check the shape of a transformation rule LHS.  Currently we only allow
+Check the shape of a rewrite rule LHS.  Currently we only allow
 LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
 @forall@'d variables.
 
@@ -1581,7 +1580,7 @@ rnTyClDecl (SynDecl { tcdLName = tycon, tcdTyVars = tyvars,
        ; let kvs = extractHsTyRdrTyVarsKindVars rhs
              doc = TySynCtx tycon
        ; traceRn "rntycl-ty" (ppr tycon <+> ppr kvs)
-       ; bindHsQTyVars doc Nothing Nothing kvs tyvars $ \ tyvars' _ ->
+       ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' _ ->
     do { (rhs', fvs) <- rnTySyn doc rhs
        ; return (SynDecl { tcdLName = tycon', tcdTyVars = tyvars'
                          , tcdFixity = fixity
@@ -1597,7 +1596,7 @@ rnTyClDecl (DataDecl
        ; let kvs = extractDataDefnKindVars defn
              doc = TyDataCtx tycon
        ; traceRn "rntycl-data" (ppr tycon <+> ppr kvs)
-       ; bindHsQTyVars doc Nothing Nothing kvs tyvars $ \ tyvars' no_rhs_kvs ->
+       ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' no_rhs_kvs ->
     do { (defn', fvs) <- rnDataDefn doc defn
        ; cusk <- data_decl_has_cusk tyvars' new_or_data no_rhs_kvs kind_sig
        ; let rn_info = DataDeclRn { tcdDataCusk = cusk
@@ -1621,7 +1620,7 @@ rnTyClDecl (ClassDecl { tcdCtxt = context, tcdLName = lcls,
 
         -- Tyvars scope over superclass context and method signatures
         ; ((tyvars', context', fds', ats'), stuff_fvs)
-            <- bindHsQTyVars cls_doc Nothing Nothing kvs tyvars $ \ tyvars' _ -> do
+            <- bindHsQTyVars cls_doc Nothing kvs tyvars $ \ tyvars' _ -> do
                   -- Checks for distinct tyvars
              { (context', cxt_fvs) <- rnContext cls_doc context
              ; fds'  <- rnFds fds
@@ -1878,7 +1877,7 @@ rnFamDecl mb_cls (FamilyDecl { fdLName = tycon, fdTyVars = tyvars
                              , fdInjectivityAnn = injectivity })
   = do { tycon' <- lookupLocatedTopBndrRn tycon
        ; ((tyvars', res_sig', injectivity'), fv1) <-
-            bindHsQTyVars doc Nothing mb_cls kvs tyvars $ \ tyvars' _ ->
+            bindHsQTyVars doc mb_cls kvs tyvars $ \ tyvars' _ ->
             do { let rn_sig = rnFamResultSig doc
                ; (res_sig', fv_kind) <- wrapLocFstM rn_sig res_sig
                ; injectivity' <- traverse (rnInjectivityAnn tyvars' res_sig')
@@ -2080,7 +2079,7 @@ rnConDecl decl@(ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs
         -- scoping we get.  So no implicit binders at the existential forall
 
         ; let ctxt = ConDeclCtx [new_name]
-        ; bindLHsTyVarBndrs ctxt (Just (inHsDocContext ctxt))
+        ; bindLHsTyVarBndrs ctxt WarnUnusedForalls
                             Nothing ex_tvs $ \ new_ex_tvs ->
     do  { (new_context, fvs1) <- rnMbContext ctxt mcxt
         ; (new_args,    fvs2) <- rnConDeclDetails (unLoc new_name) ctxt args
@@ -2118,11 +2117,11 @@ rnConDecl decl@(ConDeclGADT { con_names   = names
             $ extractHsTvBndrs explicit_tkvs
             $ extractHsTysRdrTyVarsDups (theta ++ arg_tys ++ [res_ty])
 
-        ; let ctxt    = ConDeclCtx new_names
-              mb_ctxt = Just (inHsDocContext ctxt)
+        ; let ctxt = ConDeclCtx new_names
 
         ; rnImplicitBndrs implicit_bndrs $ \ implicit_tkvs ->
-          bindLHsTyVarBndrs ctxt mb_ctxt Nothing explicit_tkvs $ \ explicit_tkvs ->
+          bindLHsTyVarBndrs ctxt WarnUnusedForalls
+                            Nothing explicit_tkvs $ \ explicit_tkvs ->
     do  { (new_cxt, fvs1)    <- rnMbContext ctxt mcxt
         ; (new_args, fvs2)   <- rnConDeclDetails (unLoc (head new_names)) ctxt args
         ; (new_res_ty, fvs3) <- rnLHsType ctxt res_ty


=====================================
compiler/GHC/Rename/Utils.hs
=====================================
@@ -495,7 +495,7 @@ pprHsDocContext PatCtx                = text "a pattern type-signature"
 pprHsDocContext SpecInstSigCtx        = text "a SPECIALISE instance pragma"
 pprHsDocContext DefaultDeclCtx        = text "a `default' declaration"
 pprHsDocContext DerivDeclCtx          = text "a deriving declaration"
-pprHsDocContext (RuleCtx name)        = text "the transformation rule" <+> ftext name
+pprHsDocContext (RuleCtx name)        = text "the rewrite rule" <+> doubleQuotes (ftext name)
 pprHsDocContext (TyDataCtx tycon)     = text "the data type declaration for" <+> quotes (ppr tycon)
 pprHsDocContext (FamPatCtx tycon)     = text "a type pattern of family instance for" <+> quotes (ppr tycon)
 pprHsDocContext (TySynCtx name)       = text "the declaration for type synonym" <+> quotes (ppr name)


=====================================
compiler/GHC/Runtime/Linker.hs
=====================================
@@ -1328,6 +1328,7 @@ linkPackage hsc_env pkg
             ("Loading package " ++ unitPackageIdString pkg ++ " ... ")
 
         -- See comments with partOfGHCi
+#if defined(CAN_LOAD_DLL)
         when (unitPackageName pkg `notElem` partOfGHCi) $ do
             loadFrameworks hsc_env platform pkg
             -- See Note [Crash early load_dyn and locateLib]
@@ -1336,7 +1337,7 @@ linkPackage hsc_env pkg
             -- For remaining `dlls` crash early only when there is surely
             -- no package's DLL around ... (not is_dyn)
             mapM_ (load_dyn hsc_env (not is_dyn) . mkSOName platform) dlls
-
+#endif
         -- After loading all the DLLs, we can load the static objects.
         -- Ordering isn't important here, because we do one final link
         -- step to resolve everything.
@@ -1471,10 +1472,15 @@ locateLib hsc_env is_hs lib_dirs gcc_dirs lib
     --   O(n). Loading an import library is also O(n) so in general we prefer
     --   shared libraries because they are simpler and faster.
     --
-  = findDll   user `orElse`
+  =
+#if defined(CAN_LOAD_DLL)
+    findDll   user `orElse`
+#endif
     tryImpLib user `orElse`
+#if defined(CAN_LOAD_DLL)
     findDll   gcc  `orElse`
     findSysDll     `orElse`
+#endif
     tryImpLib gcc  `orElse`
     findArchive    `orElse`
     tryGcc         `orElse`
@@ -1539,7 +1545,13 @@ locateLib hsc_env is_hs lib_dirs gcc_dirs lib
                          full     = dllpath $ search lib_so_name lib_dirs
                          gcc name = liftM (fmap Archive) $ search name lib_dirs
                          files    = import_libs ++ arch_files
-                     in apply $ short : full : map gcc files
+                         dlls     = [short, full]
+                         archives = map gcc files
+                     in apply $
+#if defined(CAN_LOAD_DLL)
+                          dlls ++
+#endif
+                          archives
      tryImpLib re = case os of
                        OSMinGW32 ->
                         let dirs' = if re == user then lib_dirs else gcc_dirs


=====================================
compiler/GHC/Tc/Gen/Rule.hs
=====================================
@@ -7,7 +7,7 @@
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE TypeFamilies #-}
 
--- | Typechecking transformation rules
+-- | Typechecking rewrite rules
 module GHC.Tc.Gen.Rule ( tcRules ) where
 
 import GHC.Prelude
@@ -239,7 +239,7 @@ tcRuleTmBndrs (L _ (RuleBndrSig _ (L _ name) rn_ty) : rule_bndrs)
         ; return (map snd tvs ++ tyvars, id : tmvars) }
 
 ruleCtxt :: FastString -> SDoc
-ruleCtxt name = text "When checking the transformation rule" <+>
+ruleCtxt name = text "When checking the rewrite rule" <+>
                 doubleQuotes (ftext name)
 
 


=====================================
compiler/ghc.cabal.in
=====================================
@@ -55,6 +55,11 @@ Flag integer-gmp
     Manual: True
     Default: False
 
+Flag dynamic-system-linker
+    Description: The system can load dynamic code. This is not the case for musl.
+    Default: True
+    Manual: False
+
 Library
     Default-Language: Haskell2010
     Exposed: False
@@ -108,6 +113,10 @@ Library
         CPP-Options: -DINTEGER_SIMPLE
         build-depends: integer-simple >= 0.1.1.1
 
+    -- if no dynamic system linker is available, don't try DLLs.
+    if flag(dynamic-system-linker)
+        CPP-Options: -DCAN_LOAD_DLL
+
     Other-Extensions:
         BangPatterns
         CPP


=====================================
hadrian/src/Rules/Generate.hs
=====================================
@@ -185,6 +185,9 @@ generateRules = do
         -- TODO: simplify, get rid of fake rts context
         for_ (fst <$> deriveConstantsPairs) $ \constantsFile ->
             prefix -/- constantsFile %> \file -> do
+                -- N.B. deriveConstants needs to compile programs which #include
+                -- PosixSource.h, which #include's ghcplatform.h. Fixes #18290.
+                need [prefix -/- "ghcplatform.h"]
                 withTempDir $ \dir -> build $
                     target (rtsContext stage) DeriveConstants [] [file, dir]
   where


=====================================
libraries/ghc-prim/ghc-prim.cabal
=====================================
@@ -68,6 +68,11 @@ Library
         --         on Windows. Required because of mingw32.
         extra-libraries: user32, mingw32, mingwex
 
+    if os(linux)
+        -- we need libm, but for musl and other's we might need libc, as libm
+        -- is just an empty shell.
+        extra-libraries: c, m
+
     c-sources:
         cbits/atomic.c
         cbits/bswap.c


=====================================
rts/linker/elf_reloc_aarch64.c
=====================================
@@ -93,12 +93,14 @@ encodeAddendAarch64(Section * section, Elf_Rel * rel, int64_t addend) {
             // ...              hi            ] [     Rd     ]
             //
             // imm64 = SignExtend(hi:lo:0x000,64)
-            assert(isInt64(32, addend));
+            // Range is 21 bits + the 12 page relative bits
+            // known to be 0. -2^32 <= X < 2^32
+            assert(isInt64(21+12, addend));
             assert((addend & 0xfff) == 0); /* page relative */
 
             *(inst_t *)P = (*(inst_t *)P & 0x9f00001f)
-                           | (inst_t) (((uint64_t) addend << 17) & 0x60000000)
-                           | (inst_t) (((uint64_t) addend >> 9) & 0x00ffffe0);
+                        | (inst_t) (((uint64_t) addend << 17) & 0x60000000)
+                        | (inst_t) (((uint64_t) addend >> 9) & 0x00ffffe0);
             break;
         }
         /* - control flow relocations */
@@ -111,8 +113,8 @@ encodeAddendAarch64(Section * section, Elf_Rel * rel, int64_t addend) {
             break;
         }
         case COMPAT_R_AARCH64_ADR_GOT_PAGE: {
-
-            assert(isInt64(32, addend)); /* X in range */
+            /* range is -2^32 <= X < 2^32 */
+            assert(isInt64(21+12, addend)); /* X in range */
             assert((addend & 0xfff) == 0); /* page relative */
 
             *(inst_t *)P = (*(inst_t *)P & 0x9f00001f)


=====================================
testsuite/tests/dependent/should_fail/T16326_Fail10.stderr
=====================================
@@ -4,4 +4,4 @@ T16326_Fail10.hs:12:18: error:
         forall a -> a -> a
       (GHC does not yet support this)
     • In the type signature for ‘x’: forall a -> a -> a
-      When checking the transformation rule "flurmp"
+      When checking the rewrite rule "flurmp"


=====================================
testsuite/tests/rename/should_compile/ExplicitForAllRules1.stderr
=====================================
@@ -1,4 +1,4 @@
 
 ExplicitForAllRules1.hs:49:31: warning: [-Wunused-foralls (in -Wextra)]
     Unused quantified type variable ‘b’
-    in the rule "example7"
+    In the rewrite rule "example7"


=====================================
testsuite/tests/rename/should_compile/T5331.stderr
=====================================
@@ -9,4 +9,4 @@ T5331.hs:11:16: warning: [-Wunused-foralls (in -Wextra)]
 
 T5331.hs:13:13: warning: [-Wunused-foralls (in -Wextra)]
     Unused quantified type variable ‘a’
-    In the type ‘forall a. Int’
+    In the type signature for ‘f’


=====================================
testsuite/tests/safeHaskell/ghci/p14.stderr
=====================================
@@ -1,6 +1,6 @@
 
 <interactive>:9:25: error:
-    No instance for (Num a) arising from a use of ‘f’
-    Possible fix: add (Num a) to the context of the RULE "id/Int"
-    In the expression: f
-    When checking the transformation rule "id/Int"
+    • No instance for (Num a) arising from a use of ‘f’
+      Possible fix: add (Num a) to the context of the RULE "id/Int"
+    • In the expression: f
+      When checking the rewrite rule "id/Int"


=====================================
testsuite/tests/typecheck/should_compile/T10072.stderr
=====================================
@@ -7,4 +7,4 @@ T10072.hs:3:31: error:
       To use the inferred type, enable PartialTypeSignatures
     • In the type ‘a -> _’
       In the type signature for ‘f’: a -> _
-      When checking the transformation rule "map/empty"
+      When checking the rewrite rule "map/empty"


=====================================
testsuite/tests/typecheck/should_fail/T5853.stderr
=====================================
@@ -9,7 +9,7 @@ T5853.hs:15:52: error:
         bound by the RULE "map/map" at T5853.hs:15:2-57
       NB: ‘Subst’ is a non-injective type family
     • In the expression: (f . g) <$> xs
-      When checking the transformation rule "map/map"
+      When checking the rewrite rule "map/map"
     • Relevant bindings include
         f :: Elem fa -> b (bound at T5853.hs:15:19)
         g :: a -> Elem fa (bound at T5853.hs:15:21)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2b792facab46f7cdd09d12e79499f4e0dcd4293f...f1bfb806683b3092fc5ead84e7ecff928c55fbc4

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2b792facab46f7cdd09d12e79499f4e0dcd4293f...f1bfb806683b3092fc5ead84e7ecff928c55fbc4
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/20200608/d7b6cd24/attachment-0001.html>


More information about the ghc-commits mailing list