diff options
| -rw-r--r-- | compiler/GHC/Prelude/Basic.hs | 27 | ||||
| -rw-r--r-- | compiler/GHC/ThToHs.hs | 3 | ||||
| -rw-r--r-- | hadrian/src/Settings/Warnings.hs | 1 | ||||
| -rw-r--r-- | libraries/base/Control/Monad/Fix.hs | 7 | ||||
| -rw-r--r-- | libraries/base/Data/List/NonEmpty.hs | 2 |
5 files changed, 34 insertions, 6 deletions
diff --git a/compiler/GHC/Prelude/Basic.hs b/compiler/GHC/Prelude/Basic.hs index cfa21df26f..ac620a90c4 100644 --- a/compiler/GHC/Prelude/Basic.hs +++ b/compiler/GHC/Prelude/Basic.hs @@ -2,6 +2,9 @@ {-# OPTIONS_HADDOCK not-home #-} {-# OPTIONS_GHC -O2 #-} -- See Note [-O2 Prelude] +-- See Note [Proxies for head and tail] +{-# OPTIONS_GHC -Wno-unrecognised-warning-flags -Wno-x-partial #-} + -- | Custom minimal GHC "Prelude" -- -- This module serves as a replacement for the "Prelude" module @@ -19,6 +22,7 @@ module GHC.Prelude.Basic ,Applicative (..) ,module Bits ,shiftL, shiftR + ,head, tail ) where @@ -50,9 +54,11 @@ NoImplicitPrelude. There are two motivations for this: extensions. -} -import Prelude as X hiding ((<>), Applicative(..)) +import qualified Prelude +import Prelude as X hiding ((<>), Applicative(..), head, tail) import Control.Applicative (Applicative(..)) import Data.Foldable as X (foldl') +import GHC.Stack.Types (HasCallStack) #if MIN_VERSION_base(4,16,0) import GHC.Bits as Bits hiding (shiftL, shiftR) @@ -102,3 +108,22 @@ shiftR = Bits.shiftR shiftL = Bits.unsafeShiftL shiftR = Bits.unsafeShiftR #endif + +{- Note [Proxies for head and tail] + ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Prelude.head and Prelude.tail has recently acquired {-# WARNING in "x-partial" #-}, +but GHC codebase uses them fairly extensively and insists on building warning-free. +Thus instead of adding {-# OPTIONS_GHC -Wno-x-partial #-} to every module which +employs them, we define a warning-less proxies and export them from GHC.Prelude. +-} + +-- See Note [Proxies for head and tail] +head :: HasCallStack => [a] -> a +head = Prelude.head +{-# INLINE head #-} + +-- See Note [Proxies for head and tail] +tail :: HasCallStack => [a] -> [a] +tail = Prelude.tail +{-# INLINE tail #-} diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs index 09a1f4562e..3b2cfc47a7 100644 --- a/compiler/GHC/ThToHs.hs +++ b/compiler/GHC/ThToHs.hs @@ -27,7 +27,7 @@ module GHC.ThToHs ) where -import GHC.Prelude hiding (head, init, last, tail) +import GHC.Prelude hiding (init, last, tail) import GHC.Hs as Hs import GHC.Builtin.Names @@ -60,7 +60,6 @@ import Control.Monad( unless, ap ) import Control.Applicative( (<|>) ) import Data.Bifunctor (first) import Data.Foldable (for_) -import Data.List (head) import Data.List.NonEmpty( NonEmpty (..), nonEmpty ) import qualified Data.List.NonEmpty as NE import Data.Maybe( catMaybes, isNothing ) diff --git a/hadrian/src/Settings/Warnings.hs b/hadrian/src/Settings/Warnings.hs index 4001b8bd91..fdbf253440 100644 --- a/hadrian/src/Settings/Warnings.hs +++ b/hadrian/src/Settings/Warnings.hs @@ -39,6 +39,7 @@ ghcWarningsArgs = do , package haddock ? pure [ "-Wno-unused-imports" , "-Wno-deprecations" ] , package haskeline ? pure [ "-Wno-deprecations" + , "-Wno-x-partial" , "-Wno-unused-imports" , "-Wno-redundant-constraints" , "-Wno-simplifiable-class-constraints" ] diff --git a/libraries/base/Control/Monad/Fix.hs b/libraries/base/Control/Monad/Fix.hs index a42becf778..e8ab93d290 100644 --- a/libraries/base/Control/Monad/Fix.hs +++ b/libraries/base/Control/Monad/Fix.hs @@ -2,6 +2,9 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TypeOperators #-} +-- For head in instance MonadFix [] +{-# OPTIONS_GHC -Wno-x-partial #-} + ----------------------------------------------------------------------------- -- | -- Module : Control.Monad.Fix @@ -32,7 +35,7 @@ import Data.Monoid ( Dual(..), Sum(..), Product(..) import Data.Ord ( Down(..) ) import GHC.Base ( Monad, NonEmpty(..), errorWithoutStackTrace, (.) ) import GHC.Generics -import GHC.List ( head, tail ) +import GHC.List ( head, drop ) import GHC.Tuple (Solo (..)) import Control.Monad.ST.Imp import System.IO @@ -79,7 +82,7 @@ instance MonadFix Maybe where instance MonadFix [] where mfix f = case fix (f . head) of [] -> [] - (x:_) -> x : mfix (tail . f) + (x:_) -> x : mfix (drop 1 . f) -- | @since 4.9.0.0 instance MonadFix NonEmpty where diff --git a/libraries/base/Data/List/NonEmpty.hs b/libraries/base/Data/List/NonEmpty.hs index 6a31569bbb..7a8dedac41 100644 --- a/libraries/base/Data/List/NonEmpty.hs +++ b/libraries/base/Data/List/NonEmpty.hs @@ -243,7 +243,7 @@ inits1 = -- * The only empty element of `inits xs` is the first one (by the definition of `inits`) -- * Therefore, if we take all but the first element of `inits xs` i.e. -- `tail (inits xs)`, we have a nonempty list of nonempty lists - fromList . Prelude.map fromList . List.tail . List.inits . Foldable.toList + fromList . Prelude.map fromList . List.drop 1 . List.inits . Foldable.toList -- | The 'tails' function takes a stream @xs@ and returns all the -- suffixes of @xs@, starting with the longest. The result is 'NonEmpty' |