1
1
mirror of https://github.com/github/semantic.git synced 2024-12-26 08:25:19 +03:00
semantic/src/Data/Quieterm.hs
Patrick Thomson ac543651ee 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 14:08:47 -04:00

48 lines
1.7 KiB
Haskell

{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}
module Data.Quieterm
( Quieterm(..)
, quieterm
) where
import Control.DeepSeq
import Data.Abstract.Declarations (Declarations)
import Data.Abstract.FreeVariables (FreeVariables)
import Data.Functor.Classes
import Data.Functor.Foldable
import Data.Term
import Text.Show (showListWith)
newtype Quieterm syntax ann = Quieterm { unQuieterm :: TermF syntax ann (Quieterm syntax ann) }
deriving (Declarations, FreeVariables)
type instance Base (Quieterm syntax ann) = TermF syntax ann
instance Functor syntax => Recursive (Quieterm syntax ann) where project = unQuieterm
instance Functor syntax => Corecursive (Quieterm syntax ann) where embed = Quieterm
instance Eq1 syntax => Eq1 (Quieterm syntax) where
liftEq eqA = go where go t1 t2 = liftEq2 eqA go (unQuieterm t1) (unQuieterm t2)
instance (Eq1 syntax, Eq ann) => Eq (Quieterm syntax ann) where
(==) = eq1
instance Ord1 syntax => Ord1 (Quieterm syntax) where
liftCompare comp = go where go t1 t2 = liftCompare2 comp go (unQuieterm t1) (unQuieterm t2)
instance (Ord1 syntax, Ord ann) => Ord (Quieterm syntax ann) where
compare = compare1
instance Show1 syntax => Show1 (Quieterm syntax) where
liftShowsPrec _ _ = go where go d = liftShowsPrec go (showListWith (go 0)) d . termFOut . unQuieterm
instance Show1 syntax => Show (Quieterm syntax ann) where
showsPrec = liftShowsPrec (const (const id)) (const id)
instance NFData1 f => NFData1 (Quieterm f) where
liftRnf rnf = go where go x = liftRnf2 rnf go (unQuieterm x)
instance (NFData1 f, NFData a) => NFData (Quieterm f a) where
rnf = liftRnf rnf
quieterm :: (Recursive term, Base term ~ TermF syntax ann) => term -> Quieterm syntax ann
quieterm = cata Quieterm