1
1
mirror of https://github.com/github/semantic.git synced 2025-01-04 05:27:08 +03:00

Implement NFData instances so we can deepseq

This commit is contained in:
Timothy Clem 2017-03-13 16:23:33 -07:00
parent f0cb65eb2e
commit 94dc2ac506
9 changed files with 30 additions and 8 deletions

View File

@ -1,4 +1,5 @@
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# OPTIONS_GHC -funbox-strict-fields #-} {-# OPTIONS_GHC -funbox-strict-fields #-}
module Category where module Category where
@ -227,7 +228,7 @@ data Category
| Modifier Category | Modifier Category
-- | A singleton method declaration, e.g. `def self.foo;end` in Ruby -- | A singleton method declaration, e.g. `def self.foo;end` in Ruby
| SingletonMethod | SingletonMethod
deriving (Eq, Generic, Ord, Show) deriving (Eq, Generic, Ord, Show, NFData)
{-# DEPRECATED RescueModifier "Deprecated; use Modifier Rescue instead." #-} {-# DEPRECATED RescueModifier "Deprecated; use Modifier Rescue instead." #-}

View File

@ -31,3 +31,5 @@ instance (Semigroup a, Monoid a) => Monoid (Join (,) a) where
instance (Semigroup a) => Semigroup (Join (,) a) where instance (Semigroup a) => Semigroup (Join (,) a) where
a <> b = Join $ runJoin a <> runJoin b a <> b = Join $ runJoin a <> runJoin b
instance NFData a => NFData (Join (,) a)

View File

@ -51,6 +51,11 @@ instance {-# OVERLAPPABLE #-} HasField (field ': fields) field where
getField (h :. _) = h getField (h :. _) = h
setField (_ :. t) f = f :. t setField (_ :. t) f = f :. t
instance (NFData h, NFData (Record t)) => NFData (Record (h ': t)) where
rnf (h :. t) = rnf h `seq` rnf t `seq` ()
instance NFData (Record '[]) where
rnf _ = ()
instance (Show h, Show (Record t)) => Show (Record (h ': t)) where instance (Show h, Show (Record t)) => Show (Record (h ': t)) where
showsPrec n (h :. t) = showParen (n > 0) $ showsPrec 1 h . (" :. " <>) . shows t showsPrec n (h :. t) = showParen (n > 0) $ showsPrec 1 h . (" :. " <>) . shows t

View File

@ -1,4 +1,5 @@
{-# LANGUAGE TypeSynonymInstances, ScopedTypeVariables #-} {-# LANGUAGE TypeSynonymInstances, ScopedTypeVariables, UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Diff where module Diff where
import Prologue import Prologue
@ -50,3 +51,8 @@ modifyAnnotations :: (Functor f, Functor g) => (annotation -> annotation) -> Fre
modifyAnnotations f r = case runFree r of modifyAnnotations f r = case runFree r of
Free (ga :< functor) -> wrap (fmap f ga :< functor) Free (ga :< functor) -> wrap (fmap f ga :< functor)
_ -> r _ -> r
instance (NFData (f (Diff f a)), NFData (Cofree f a), NFData a, Functor f) => NFData (Diff f a) where
rnf fa = case runFree fa of
Free f -> rnf f `seq` ()
Pure a -> rnf a `seq` ()

View File

@ -1,3 +1,4 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# OPTIONS_GHC -funbox-strict-fields #-} {-# OPTIONS_GHC -funbox-strict-fields #-}
module Patch module Patch
( Patch(..) ( Patch(..)
@ -24,7 +25,7 @@ data Patch a
= Replace a a = Replace a a
| Insert a | Insert a
| Delete a | Delete a
deriving (Eq, Foldable, Functor, Generic, Ord, Show, Traversable) deriving (Eq, Foldable, Functor, Generic, Ord, Show, Traversable, NFData)
-- DSL -- DSL

View File

@ -1,3 +1,4 @@
{-# LANGUAGE DeriveAnyClass #-}
module Range where module Range where
import qualified Data.Char as Char import qualified Data.Char as Char
@ -10,7 +11,7 @@ import Test.LeanCheck
-- | A half-open interval of integers, defined by start & end indices. -- | A half-open interval of integers, defined by start & end indices.
data Range = Range { start :: Int, end :: Int } data Range = Range { start :: Int, end :: Int }
deriving (Eq, Show, Generic) deriving (Eq, Show, Generic, NFData)
-- | Make a range at a given index. -- | Make a range at a given index.
rangeAt :: Int -> Range rangeAt :: Int -> Range

View File

@ -26,7 +26,7 @@ data SourcePos = SourcePos
-- Column number -- Column number
-- --
, column :: Int , column :: Int
} deriving (Show, Read, Eq, Ord, Generic, Hashable) } deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)
displaySourcePos :: SourcePos -> Text displaySourcePos :: SourcePos -> Text
displaySourcePos SourcePos{..} = displaySourcePos SourcePos{..} =
@ -49,7 +49,7 @@ data SourceSpan = SourceSpan
-- End of the span -- End of the span
-- --
, spanEnd :: SourcePos , spanEnd :: SourcePos
} deriving (Show, Read, Eq, Ord, Generic, Hashable) } deriving (Show, Read, Eq, Ord, Generic, Hashable, NFData)
displayStartEndPos :: SourceSpan -> Text displayStartEndPos :: SourceSpan -> Text
displayStartEndPos sp = displayStartEndPos sp =

View File

@ -106,7 +106,7 @@ data Syntax a f
| Ty [f] | Ty [f]
-- | A send statement has a channel and an expression in Go. -- | A send statement has a channel and an expression in Go.
| Send f f | Send f f
deriving (Eq, Foldable, Functor, Generic, Generic1, Mergeable, Ord, Show, Traversable, ToJSON) deriving (Eq, Foldable, Functor, Generic, Generic1, Mergeable, Ord, Show, Traversable, ToJSON, NFData)
-- Instances -- Instances

View File

@ -1,4 +1,4 @@
{-# LANGUAGE RankNTypes, TypeFamilies, TypeSynonymInstances #-} {-# LANGUAGE RankNTypes, TypeFamilies, TypeSynonymInstances, UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Term where module Term where
@ -17,6 +17,12 @@ type TermF = CofreeF
type SyntaxTerm leaf fields = Term (Syntax leaf) (Record fields) type SyntaxTerm leaf fields = Term (Syntax leaf) (Record fields)
type SyntaxTermF leaf fields = TermF (Syntax leaf) (Record fields) type SyntaxTermF leaf fields = TermF (Syntax leaf) (Record fields)
instance (NFData (f (Cofree f a)), NFData a, Functor f) => NFData (Cofree f a) where
rnf = rnf . runCofree
instance (NFData a, NFData (f b)) => NFData (CofreeF f a b) where
rnf (a :< s) = rnf a `seq` rnf s `seq` ()
-- | Zip two terms by combining their annotations into a pair of annotations. -- | Zip two terms by combining their annotations into a pair of annotations.
-- | If the structure of the two terms don't match, then Nothing will be returned. -- | If the structure of the two terms don't match, then Nothing will be returned.
zipTerms :: (Traversable f, GAlign f) => Term f annotation -> Term f annotation -> Maybe (Term f (Both annotation)) zipTerms :: (Traversable f, GAlign f) => Term f annotation -> Term f annotation -> Maybe (Term f (Both annotation))