darcs patch: Add equating p x y = p x == p y
kahl at cas.mcmaster.ca
kahl at cas.mcmaster.ca
Fri Oct 20 09:16:05 EDT 2006
>
> Control.Combinators? Such general beasts as mapFst, mapSnd
> and >< from Data.Graph.Inductive.Query.Monad could go in
> there, as could other pair handling combinators like (f <&>
> g) x = (f x, g x)
Pair handling combinators could go into Data.Tuple.
I append what I currently have.
(This is a typical instance of the kind of module
where the code is (at least an essential part of) the documentation.
Can Haddock be told to include the code in the documentation?
)
Wolfram
---------------------------------------------------------------
\section{Tuple Utilities}
\begin{code}
module Data.Utils.Tuple where
\end{code}
\begin{code}
swap (x,y) = (y,x)
\end{code}
\begin{code}
pupd f g (x,y) = (f x, g y)
mapPair f (x,y) = (f x, f y)
mapTriple f (x,y,z) = (f x, f y, f z)
pupd1 f (x,y) = (f x, y)
pupd2 g (x,y) = (x, g y)
{-# INLINE pupd #-}
{-# INLINE pupd1 #-}
{-# INLINE pupd2 #-}
\end{code}
\begin{code}
keep1 f p@(x,y) = (x, f p)
keep2 f p@(x,y) = (f p, y)
\end{code}
More information about the Libraries
mailing list