[commit: ghc] master: Allow arr ∧ (first ∨ (***)) as minimal definition of Arrow instance (e8c8173)

git at git.haskell.org git at git.haskell.org
Tue Oct 13 12:21:46 UTC 2015


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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/e8c8173923302268ef950c3b21e276779e45ac83/ghc

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

commit e8c8173923302268ef950c3b21e276779e45ac83
Author: M Farkas-Dyck <strake888 at gmail.com>
Date:   Sun Mar 29 22:57:46 2015 -0500

    Allow arr ∧ (first ∨ (***)) as minimal definition of Arrow instance
    
    See #10216.
    
    Signed-off-by: Austin Seipp <austin at well-typed.com>


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

e8c8173923302268ef950c3b21e276779e45ac83
 libraries/base/Control/Arrow.hs | 11 ++++-------
 1 file changed, 4 insertions(+), 7 deletions(-)

diff --git a/libraries/base/Control/Arrow.hs b/libraries/base/Control/Arrow.hs
index c928156..1cc6062 100644
--- a/libraries/base/Control/Arrow.hs
+++ b/libraries/base/Control/Arrow.hs
@@ -93,16 +93,14 @@ class Category a => Arrow a where
     -- | Send the first component of the input through the argument
     --   arrow, and copy the rest unchanged to the output.
     first :: a b c -> a (b,d) (c,d)
+    first = (*** id)
 
     -- | A mirror image of 'first'.
     --
     --   The default definition may be overridden with a more efficient
     --   version if desired.
     second :: a b c -> a (d,b) (d,c)
-    second f = arr swap >>> first f >>> arr swap
-      where
-        swap :: (x,y) -> (y,x)
-        swap ~(x,y) = (y,x)
+    second = (id ***)
 
     -- | Split the input between the two argument arrows and combine
     --   their output.  Note that this is in general not a functor.
@@ -110,7 +108,8 @@ class Category a => Arrow a where
     --   The default definition may be overridden with a more efficient
     --   version if desired.
     (***) :: a b c -> a b' c' -> a (b,b') (c,c')
-    f *** g = first f >>> second g
+    f *** g = first f >>> arr swap >>> first g >>> arr swap
+      where swap ~(x,y) = (y,x)
 
     -- | Fanout: send the input to both argument arrows and combine
     --   their output.
@@ -141,8 +140,6 @@ class Category a => Arrow a where
 
 instance Arrow (->) where
     arr f = f
-    first f = f *** id
-    second f = id *** f
 --  (f *** g) ~(x,y) = (f x, g y)
 --  sorry, although the above defn is fully H'98, nhc98 can't parse it.
     (***) f g ~(x,y) = (f x, g y)



More information about the ghc-commits mailing list