2018-02-28 19:27:25 +03:00
|
|
|
{-# LANGUAGE UndecidableInstances #-}
|
2018-03-15 23:25:53 +03:00
|
|
|
module Prologue
|
|
|
|
( module X
|
2019-01-15 21:57:52 +03:00
|
|
|
, eitherM
|
2018-03-15 23:31:24 +03:00
|
|
|
, foldMapA
|
2018-03-15 23:25:53 +03:00
|
|
|
, maybeM
|
2018-04-16 22:48:45 +03:00
|
|
|
, maybeLast
|
|
|
|
, fromMaybeLast
|
2018-03-15 23:25:53 +03:00
|
|
|
) where
|
2018-02-27 18:37:09 +03:00
|
|
|
|
|
|
|
|
2018-11-28 21:31:40 +03:00
|
|
|
import Debug.Trace as X (traceShowM, traceM)
|
Add NFData instances to enable more accurate benchmarking.
Because we're getting serious about benchmarking in the run-up to
Windrose, it's time to bring in the `deepseq` package to ensure that
benchmarks can fully evaluate the result of a test case.
The `deepseq` package provides an `NFData` typeclass:
```
class NFData a where
rnf :: a -> ()
```
Instances use the `seq` combinator to ensure that the argument to
`rnf` is fully evaluated, returning (). If there is a `Generic`
instance for `a`, the implementation can be omitted. This patch adds
NFData for every syntax node, graph vertex, environment data
structures, and exceptions. It is long, but the work is very
straightforward, so don't panick.
The benchmark suite (`stack bench`) now produces more accurate
results. The benchmarks previously mimicked `rnf` by calling `show` on
the result of an evaluation or graph construction; now that we have
actual `NFData` instances we can use the `nfIO` combinator from
criterion. This has sped up the evaluation benchmarks and reduced
their memory consumption, while it has slowed down the call graph
benchmarks, as those benchmarks weren't evaluating the whole of the
graph.
Unfortunately, this patch increases compile times, as we have to
derive a few more Generic instances. I wish this weren't the case, but
there's little we can do about it now. In the future I have some plans
for how to reduce compile time, and I bet that those gains will at
least nullify the speed hit from this patch.
Now that we have NFData instances for every data type, we can start
benchmarking assignments, in preparation for fixing #2205.
This patch also pulls in updates to `effects` and `fastsum` that add
appropriate NFData instances for the data they vend.
2018-10-17 21:08:47 +03:00
|
|
|
import Control.DeepSeq as X
|
2018-02-28 19:33:24 +03:00
|
|
|
import Data.Bifunctor.Join as X
|
2018-03-14 18:25:06 +03:00
|
|
|
import Data.Bits as X
|
2018-02-28 19:33:24 +03:00
|
|
|
import Data.ByteString as X (ByteString)
|
2018-10-30 22:12:45 +03:00
|
|
|
import Data.Coerce as X
|
2019-01-08 21:55:09 +03:00
|
|
|
import Data.Int as X (Int8, Int16, Int32, Int64)
|
2019-01-10 23:53:15 +03:00
|
|
|
import Data.Functor.Both as X (Both (Both), runBothWith)
|
2019-01-11 20:49:56 +03:00
|
|
|
import Data.Either as X (fromLeft, fromRight)
|
2018-02-28 19:33:24 +03:00
|
|
|
import Data.IntMap as X (IntMap)
|
|
|
|
import Data.IntSet as X (IntSet)
|
2018-03-22 20:01:25 +03:00
|
|
|
import Data.Ix as X (Ix (..))
|
|
|
|
import Data.List.NonEmpty as X (NonEmpty (..), nonEmpty, some1)
|
2018-02-28 19:33:24 +03:00
|
|
|
import Data.Map as X (Map)
|
|
|
|
import Data.Maybe as X
|
2018-03-22 20:01:25 +03:00
|
|
|
import Data.Monoid (Alt (..))
|
2018-02-28 19:33:24 +03:00
|
|
|
import Data.Sequence as X (Seq)
|
2018-06-15 18:41:15 +03:00
|
|
|
import Data.Semilattice.Lower as X (Lower(..))
|
2018-02-28 19:33:24 +03:00
|
|
|
import Data.Set as X (Set)
|
2018-05-17 01:25:02 +03:00
|
|
|
import Data.Sum as X (Sum, Element, Elements, (:<), (:<:), Apply (..), inject)
|
2018-02-28 19:33:24 +03:00
|
|
|
import Data.Text as X (Text)
|
|
|
|
import Data.These as X
|
2019-01-08 21:55:09 +03:00
|
|
|
import Data.Word as X (Word8, Word16, Word32, Word64)
|
2018-02-28 01:43:50 +03:00
|
|
|
|
2018-03-22 20:01:25 +03:00
|
|
|
import Control.Exception as X hiding (Handler (..), assert, evaluate, throw, throwIO, throwTo)
|
2018-02-28 02:13:25 +03:00
|
|
|
|
2018-02-28 19:33:24 +03:00
|
|
|
-- Typeclasses
|
|
|
|
import Control.Applicative as X
|
|
|
|
import Control.Arrow as X ((&&&), (***))
|
2018-09-12 01:54:37 +03:00
|
|
|
import Control.Monad as X hiding (fail, return)
|
2018-03-22 20:01:25 +03:00
|
|
|
import Control.Monad.Fail as X (MonadFail (..))
|
2018-10-23 22:28:21 +03:00
|
|
|
import Control.Monad.IO.Class as X (MonadIO (..))
|
2018-02-28 19:33:24 +03:00
|
|
|
import Data.Algebra as X
|
|
|
|
import Data.Bifoldable as X
|
2018-03-22 20:01:25 +03:00
|
|
|
import Data.Bifunctor as X (Bifunctor (..))
|
2018-02-28 19:33:24 +03:00
|
|
|
import Data.Bitraversable as X
|
2018-03-22 20:01:25 +03:00
|
|
|
import Data.Foldable as X hiding (product, sum)
|
2018-02-28 19:33:24 +03:00
|
|
|
import Data.Function as X (fix, on, (&))
|
2018-03-22 20:01:25 +03:00
|
|
|
import Data.Functor as X (void, ($>))
|
2018-02-28 19:33:24 +03:00
|
|
|
import Data.Functor.Classes as X
|
|
|
|
import Data.Functor.Classes.Generic as X
|
2018-03-22 20:01:25 +03:00
|
|
|
import Data.Functor.Foldable as X (Base, Corecursive (..), Recursive (..))
|
|
|
|
import Data.Hashable as X (Hashable, hash, hashUsing, hashWithSalt)
|
2018-05-16 21:43:58 +03:00
|
|
|
import Data.Hashable.Lifted as X (Hashable1(..), hashWithSalt1)
|
2018-03-22 20:01:25 +03:00
|
|
|
import Data.Monoid as X (First (..), Last (..), Monoid (..))
|
2019-01-07 19:23:11 +03:00
|
|
|
import Data.Monoid.Generic as X
|
2019-09-20 23:50:25 +03:00
|
|
|
import Data.Profunctor.Unsafe
|
2018-03-22 20:01:25 +03:00
|
|
|
import Data.Proxy as X (Proxy (..))
|
|
|
|
import Data.Semigroup as X (Semigroup (..))
|
2018-02-28 19:33:24 +03:00
|
|
|
import Data.Traversable as X
|
2018-02-28 02:13:25 +03:00
|
|
|
import Data.Typeable as X (Typeable)
|
2018-02-28 01:43:50 +03:00
|
|
|
|
2018-02-27 20:04:05 +03:00
|
|
|
-- Generics
|
2018-10-13 00:54:57 +03:00
|
|
|
import GHC.Generics as X (Generic, Generic1)
|
2018-02-28 19:33:24 +03:00
|
|
|
import GHC.Stack as X
|
2018-03-15 23:25:53 +03:00
|
|
|
|
2018-03-15 23:14:51 +03:00
|
|
|
-- | Fold a collection by mapping each element onto an 'Alternative' action.
|
|
|
|
foldMapA :: (Alternative m, Foldable t) => (b -> m a) -> t b -> m a
|
2019-09-20 23:44:44 +03:00
|
|
|
foldMapA f = getAlt #. foldMap (Alt #. f)
|
|
|
|
{-# INLINE foldMapA #-}
|
2018-04-16 22:48:45 +03:00
|
|
|
|
|
|
|
maybeLast :: Foldable t => b -> (a -> b) -> t a -> b
|
|
|
|
maybeLast b f = maybe b f . getLast . foldMap (Last . Just)
|
|
|
|
|
|
|
|
fromMaybeLast :: Foldable t => a -> t a -> a
|
|
|
|
fromMaybeLast b = fromMaybe b . getLast . foldMap (Last . Just)
|
|
|
|
|
2018-03-15 23:31:24 +03:00
|
|
|
-- | Extract the 'Just' of a 'Maybe' in an 'Applicative' context or, given 'Nothing', run the provided action.
|
2018-03-15 23:25:53 +03:00
|
|
|
maybeM :: Applicative f => f a -> Maybe a -> f a
|
|
|
|
maybeM f = maybe f pure
|
2019-02-05 00:56:31 +03:00
|
|
|
{-# INLINE maybeM #-}
|
2018-11-05 19:06:59 +03:00
|
|
|
|
2019-02-05 21:54:07 +03:00
|
|
|
-- Promote a function to either-applicatives.
|
2019-01-15 21:57:52 +03:00
|
|
|
eitherM :: Applicative f => (a -> f b) -> Either a b -> f b
|
|
|
|
eitherM f = either f pure
|
2019-02-05 00:56:31 +03:00
|
|
|
{-# INLINE eitherM #-}
|