Ticket #10216: 0001-Allow-arr-first-as-minimal-definition-of-Arrow-insta.patch

File 0001-Allow-arr-first-as-minimal-definition-of-Arrow-insta.patch, 2.1 KB (added by strake888, 4 years ago)
  • libraries/base/Control/Arrow.hs

    From 8ecd2bb77a36d18bfed0f2c1afd09afa2f3ce019 Mon Sep 17 00:00:00 2001
    From: M Farkas-Dyck <strake888@gmail.com>
    Date: Sun, 29 Mar 2015 22:57:46 -0500
    Subject: [PATCH] =?UTF-8?q?Allow=20arr=20=E2=88=A7=20(first=20=E2=88=A8=20?=
     =?UTF-8?q?(***))=20as=20minimal=20definition=20of=20Arrow=20instance?=
    MIME-Version: 1.0
    Content-Type: text/plain; charset=UTF-8
    Content-Transfer-Encoding: 8bit
    
    ---
     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 e9dd781..b5bd6e3 100644
    a b class Category a => Arrow a where 
    9090    -- | Send the first component of the input through the argument
    9191    --   arrow, and copy the rest unchanged to the output.
    9292    first :: a b c -> a (b,d) (c,d)
     93    first = (*** id)
    9394
    9495    -- | A mirror image of 'first'.
    9596    --
    9697    --   The default definition may be overridden with a more efficient
    9798    --   version if desired.
    9899    second :: a b c -> a (d,b) (d,c)
    99     second f = arr swap >>> first f >>> arr swap
    100       where
    101         swap :: (x,y) -> (y,x)
    102         swap ~(x,y) = (y,x)
     100    second = (id ***)
    103101
    104102    -- | Split the input between the two argument arrows and combine
    105103    --   their output.  Note that this is in general not a functor.
    class Category a => Arrow a where 
    107105    --   The default definition may be overridden with a more efficient
    108106    --   version if desired.
    109107    (***) :: a b c -> a b' c' -> a (b,b') (c,c')
    110     f *** g = first f >>> second g
     108    f *** g = first f >>> arr swap >>> first g >>> arr swap
     109      where swap ~(x,y) = (y,x)
    111110
    112111    -- | Fanout: send the input to both argument arrows and combine
    113112    --   their output.
    class Category a => Arrow a where 
    138137
    139138instance Arrow (->) where
    140139    arr f = f
    141     first f = f *** id
    142     second f = id *** f
    143140--  (f *** g) ~(x,y) = (f x, g y)
    144141--  sorry, although the above defn is fully H'98, nhc98 can't parse it.
    145142    (***) f g ~(x,y) = (f x, g y)