[commit: ghc] wip/merge: Implement new Foldable methods for HsPatSynDetails (b212e83)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/merge
Link       : http://ghc.haskell.org/trac/ghc/changeset/b212e83770f5de300ef5caf5d8637de3201a5be8/ghc

>---------------------------------------------------------------

commit b212e83770f5de300ef5caf5d8637de3201a5be8
Author: David Feuer <David.Feuer at gmail.com>
Date:   Tue Nov 18 22:18:57 2014 -0600

    Implement new Foldable methods for HsPatSynDetails
    
    Summary: Also explicitly define foldl1 and foldr1, which should generally work better with list-specific versions.
    
    Reviewers: austin
    
    Reviewed By: austin
    
    Subscribers: rwbarton, thomie, carter
    
    Differential Revision: https://phabricator.haskell.org/D430


>---------------------------------------------------------------

b212e83770f5de300ef5caf5d8637de3201a5be8
 compiler/hsSyn/HsBinds.lhs | 21 ++++++++++++++++++++-
 1 file changed, 20 insertions(+), 1 deletion(-)

diff --git a/compiler/hsSyn/HsBinds.lhs b/compiler/hsSyn/HsBinds.lhs
index bbf6bc2..95ec98e 100644
--- a/compiler/hsSyn/HsBinds.lhs
+++ b/compiler/hsSyn/HsBinds.lhs
@@ -14,6 +14,7 @@ Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind at .
                                       -- in module PlaceHolder
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE BangPatterns #-}
 
 module HsBinds where
 
@@ -41,8 +42,8 @@ import BooleanFormula (BooleanFormula)
 import Data.Data hiding ( Fixity )
 import Data.List
 import Data.Ord
-#if __GLASGOW_HASKELL__ < 709
 import Data.Foldable ( Foldable(..) )
+#if __GLASGOW_HASKELL__ < 709
 import Data.Traversable ( Traversable(..) )
 import Data.Monoid ( mappend )
 import Control.Applicative hiding (empty)
@@ -807,6 +808,24 @@ instance Foldable HsPatSynDetails where
     foldMap f (InfixPatSyn left right) = f left `mappend` f right
     foldMap f (PrefixPatSyn args) = foldMap f args
 
+    foldl1 f (InfixPatSyn left right) = left `f` right
+    foldl1 f (PrefixPatSyn args) = Data.List.foldl1 f args
+
+    foldr1 f (InfixPatSyn left right) = left `f` right
+    foldr1 f (PrefixPatSyn args) = Data.List.foldr1 f args
+
+-- TODO: After a few more versions, we should probably use these.
+#if __GLASGOW_HASKELL__ >= 709
+    length (InfixPatSyn _ _) = 2
+    length (PrefixPatSyn args) = Data.List.length args
+
+    null (InfixPatSyn _ _) = False
+    null (PrefixPatSyn args) = Data.List.null args
+
+    toList (InfixPatSyn left right) = [left, right]
+    toList (PrefixPatSyn args) = args
+#endif
+
 instance Traversable HsPatSynDetails where
     traverse f (InfixPatSyn left right) = InfixPatSyn <$> f left <*> f right
     traverse f (PrefixPatSyn args) = PrefixPatSyn <$> traverse f args