Skip to content
Snippets Groups Projects
Commit a3309e79 authored by Simon Marlow's avatar Simon Marlow Committed by Simon Marlow
Browse files

Disable NFData instances for GHC types when GHC >= 8.2

parent cdc81a1b
No related branches found
No related tags found
No related merge requests found
{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable, StandaloneDeriving, TypeFamilies, RecordWildCards #-}
{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, DeriveFoldable, DeriveTraversable, StandaloneDeriving, TypeFamilies, RecordWildCards #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
-- in module GHC.PlaceHolder
......@@ -451,10 +451,12 @@ instance (NFData a, NFData mod)
DocExamples a -> a `deepseq` ()
DocHeader a -> a `deepseq` ()
#if __GLASGOW_HASKELL__ < 801
-- These were added to GHC itself in 8.2.1
instance NFData Name where rnf x = seq x ()
instance NFData OccName where rnf x = seq x ()
instance NFData ModuleName where rnf x = seq x ()
#endif
instance NFData id => NFData (Header id) where
rnf (Header a b) = a `deepseq` b `deepseq` ()
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment