[commit: ghc] master: Allow left ∨ (+++) as minimal definition of ArrowChoice instance (6a8ca65)

git at git.haskell.org git at git.haskell.org
Fri Oct 16 19:25:35 UTC 2015


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

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

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

commit 6a8ca65032c6b3ed61b5378765e70120083cf5da
Author: M Farkas-Dyck <mfdyck at google.com>
Date:   Wed Sep 23 10:35:34 2015 -0700

    Allow left ∨ (+++) as minimal definition of ArrowChoice instance
    
    See #10911.
    
    Reviewers: ekmett
    
    Signed-off-by: Austin Seipp <austin at well-typed.com>


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

6a8ca65032c6b3ed61b5378765e70120083cf5da
 libraries/base/Control/Arrow.hs | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

diff --git a/libraries/base/Control/Arrow.hs b/libraries/base/Control/Arrow.hs
index 1cc6062..2e2c470 100644
--- a/libraries/base/Control/Arrow.hs
+++ b/libraries/base/Control/Arrow.hs
@@ -219,17 +219,14 @@ class Arrow a => ArrowChoice a where
     -- | Feed marked inputs through the argument arrow, passing the
     --   rest through unchanged to the output.
     left :: a b c -> a (Either b d) (Either c d)
+    left = (+++ id)
 
     -- | A mirror image of 'left'.
     --
     --   The default definition may be overridden with a more efficient
     --   version if desired.
     right :: a b c -> a (Either d b) (Either d c)
-    right f = arr mirror >>> left f >>> arr mirror
-      where
-        mirror :: Either x y -> Either y x
-        mirror (Left x) = Right x
-        mirror (Right y) = Left y
+    right = (id +++)
 
     -- | Split the input between the two argument arrows, retagging
     --   and merging their outputs.
@@ -238,7 +235,11 @@ class Arrow a => ArrowChoice a where
     --   The default definition may be overridden with a more efficient
     --   version if desired.
     (+++) :: a b c -> a b' c' -> a (Either b b') (Either c c')
-    f +++ g = left f >>> right g
+    f +++ g = left f >>> arr mirror >>> left g >>> arr mirror
+      where
+        mirror :: Either x y -> Either y x
+        mirror (Left x) = Right x
+        mirror (Right y) = Left y
 
     -- | Fanin: Split the input between the two argument arrows and
     --   merge their outputs.



More information about the ghc-commits mailing list