This program compiles and runs correctly under GHC:
type Church a = (a -> a) -> a -> a
ch :: Int -> Church a
ch 0 _ = id
ch n f = f . ch (n-1) f
unch :: Church Int -> Int
unch n = n (+1) 0
suc :: Church a -> Church a
suc n f = f . n f
pre :: Church ((a -> a) -> a) -> Church a
pre n f a = n s z id
where s g h = h (g f)
z = const a
main :: IO ()
main = do let seven = ch 7
eight = suc seven
six = pre seven
print (unch eight)
print (unch six)
But when compiling with Frege I got the following error:
E /home/xgp/work/flab/src/main/frege/flab/fold.fr:23: type error in expression seven
type is : Int
expected: (t1→t1)→t1
E /home/xgp/work/flab/src/main/frege/flab/fold.fr:23: type error in expression seven
type is : (t1→t1)→t1
expected: Int
E /home/xgp/work/flab/src/main/frege/flab/fold.fr:23: type error in expression seven
type is : (t1→t1)→t1
expected: Int
E /home/xgp/work/flab/src/main/frege/flab/fold.fr:23: type error in
expression seven
type is apparently Int
used as function
Why? Is it possible to modify the program to pass the compilation under Frege?
This is one of those rare cases where generalization of types of let bound variables actually does make a difference.
The point is, Frege acts like GHC with pragma -XMonoLocalBinds in that respect, for details see here: https://github.com/Frege/frege/wiki/GHC-Language-Options-vs.-Frege#Let-Generalization and here: https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/other-type-extensions.html#typing-binds (there is also a link to a paper of SPJ, that explains the rationale)
What this means, in short, is that all unannotated let bound veriabes will have a monomorphic type, and cannot be used at different types. To restore polymorphism, an explicit type signature is needed.
To make your program compile, it is enough to annotate the binding of seven with
seven :: Church a
Regarding print/println: the former one does not flush the output. So you have in the REPL:
frege> print 'a'
IO ()
frege> print 'b'
IO ()
frege> println "dammit!"
abdammit!
IO ()
Related
I couldn't find an answer to my question among several ambiguous type variable error questions.
I'm currently trying to get this code I found to work. (https://gist.github.com/kirelagin/3886243)
My code:
import Control.Arrow
import Data.List
import qualified Data.Map as M
import Data.Function
main = do
putStrLn "Start test"
let foo = "Hello World"
let freqTest = freqList foo
putStrLn "Frequentie list"
print freqTest
putStrLn "Done.."
let treeTest = buildTree freqTest
putStrLn "Huffman Tree"
print treeTest
putStrLn "Done.."
let codeMaphTest = buildCodemap treeTest
putStrLn "Codemap ding"
-- print codeMaphTest
putStrLn "Done.."
--This typeclass is supposed to make life _a bit_ easier.
class Eq a => Bits a where
zer :: a
one :: a
instance Bits Int where
zer = 0
one = 1
instance Bits Bool where
zer = False
one = True
-- Codemap is generated from a Huffman tree. It is used for fast encoding.
type Codemap a = M.Map Char [a]
-- Huffman tree is a simple binary tree. Each leaf contains a Char and its weight.
-- Fork (node with children) also has weight = sum of weights of its children.
data HTree = Leaf Char Int
| Fork HTree HTree Int
deriving (Show)
weight :: HTree -> Int
weight (Leaf _ w) = w
weight (Fork _ _ w) = w
-- The only useful operation on Huffman trees is merging, that is we take
-- two trees and make them children of a new Fork-node.
merge t1 t2 = Fork t1 t2 (weight t1 + weight t2)
-- `freqList` is an utility function. It takes a string and produces a list
-- of pairs (character, number of occurences of this character in the string).
freqList :: String -> [(Char, Int)]
freqList = M.toList . M.fromListWith (+) . map (flip (,) 1)
-- `buildTree` builds a Huffman tree from a list of character frequencies
-- (obtained, for example, from `freqList` or elsewhere).
-- It sorts the list in ascending order by frequency, turns each (char, freq) pair
-- into a one-leaf tree and keeps merging two trees with the smallest frequencies
-- until only one tree is remaining.
buildTree :: [(Char, Int)] -> HTree
buildTree = bld . map (uncurry Leaf) . sortBy (compare `on` snd)
where bld (t:[]) = t
bld (a:b:cs) = bld $ insertBy (compare `on` weight) (merge a b) cs
-- The next function traverses a Huffman tree to obtain a list of codes for
-- all characters and converts this list into a `Map`.
buildCodemap :: Bits a => HTree -> Codemap a
buildCodemap = M.fromList . buildCodelist
where buildCodelist (Leaf c w) = [(c, [])]
buildCodelist (Fork l r w) = map (addBit zer) (buildCodelist l) ++ map (addBit one) (buildCodelist r)
where addBit b = second (b :)
-- Simple functions to get a Huffman tree or a `Codemap` from a `String`.
stringTree :: String -> HTree
stringTree = buildTree . freqList
stringCodemap :: Bits a => String -> Codemap a
stringCodemap = buildCodemap . stringTree
-- Time to do the real encoding and decoding!
-- Encoding function just represents each character of a string by corresponding
-- sequence of `Bit`s.
encode :: Bits a => Codemap a -> String -> [a]
encode m = concat . map (m M.!)
encode' :: Bits a => HTree -> String -> [a]
encode' t = encode $ buildCodemap t
-- Decoding is a little trickier. We have to traverse the tree until
-- we reach a leaf which means we've just finished reading a sequence
-- of `Bit`s corresponding to a single character.
-- We keep doing this to process the whole list of `Bit`s.
decode :: Bits a => HTree -> [a] -> String
decode tree = dcd tree
where dcd (Leaf c _) [] = [c]
dcd (Leaf c _) bs = c : dcd tree bs
dcd (Fork l r _) (b:bs) = dcd (if b == zer then l else r) bs
Output:
huffmancompress.hs:17:24: error:
* Ambiguous type variable `a0' arising from a use of `buildCodemap'
prevents the constraint `(Bits a0)' from being solved.
Relevant bindings include
codeMaphTest :: Codemap a0 (bound at huffmancompress.hs:17:9)
Probable fix: use a type annotation to specify what `a0' should be.
These potential instances exist:
instance Bits Bool -- Defined at huffmancompress.hs:35:10
instance Bits Int -- Defined at huffmancompress.hs:31:10
* In the expression: buildCodemap treeTest
In an equation for `codeMaphTest':
codeMaphTest = buildCodemap treeTest
In the expression:
do putStrLn "Start test"
let foo = "Hello World"
let freqTest = freqList foo
putStrLn "Frequentie list"
....
|
17 | let codeMaphTest = buildCodemap treeTest
| ^^^^^^^^^^^^^^^^^^^^^
I've tried serveral things I found on the internet but nothing worth mentioning to be honest.
Maybe any of you guys can help me out!
On line 17, where the error points you:
let codeMaphTest = buildCodemap treeTest
What type is codeMaphTest? Should it be Codemap Int? Or Codemap String? Or, perhaps, Codemap Bool? The function buildCodemap can return any type, as long as it has an instance of Bit. So what type should it be?
The compiler doesn't know. There is nowhere to glean this information from. It's ambiguous.
And this is exactly what the compiler is telling you: "ambiguous type variable".
One way to fix this is to provide a type annotation (exactly as the error message says, by the way):
let codeMaphTest :: Codemap Int = buildCodemap treeTest
Note that I chose Int just as an example, because I don't know which type you meant (I'm somewhat like the compiler in that respect). Please substitute your own type - the one you actually wanted there.
Your code is indeed ambiguous. buildCodemap treeTest has a polymorphic type Bits a => Codemap a, so it can be used as a Codemap Int, a Codemap Bool, or even as another type if you defines further instances of Bits.
This is not a problem, on its own, but later on you try to use this value (e.g., to print it), so we really need to pick a concrete type a.
You could pick a at the definition point:
let codeMaphTest :: Codemap Int
codeMaphTest = buildCodemap treeTest
Or, alternatively, you could choose a later on, where you use it
print (codeMaphTest :: Codemap Int)
This question already has answers here:
Partially apply several functions in Haskell
(4 answers)
Closed 4 years ago.
Using Haskell I would like to group functions together as I would using object orientation in other languages. Concretely following the reply to this question
Does Haskell support object oriented programming
let's assume I have a type
data Class = Obj { a :: Int -> Int, b :: Int -> Int }
and now I want to define several other functions (methods as it were) that are derived from a and b. One way to do this is to define something like
c :: Class -> Int -> Int
c obj x = myb (mya x)
where mya = a obj
myb = b obj
d :: Class -> Int -> Int
d obj x = myb (myc x)
where myb = b obj
myc = c obj
However this means that in each regular expression pattern I need to list explicitly (in the ``where'' clause) which other functions I am using. My question is: is there a shorter way to achieve this?
If your goal is just to avoid typing too much, you can use the RecordWildCards extension:
{-# LANGUAGE RecordWildCards #-}
data Class = Obj { a :: Int -> Int, b :: Int -> Int }
f :: Class -> Int -> Int
f Obj{..} x = a x + b x
Then you can use it like this: f (Obj id id) 10 == 20
Note that this shadows the actual "field accessors", so this doesn't work if you still want to use those in the same function for some reason.
Without extensions, you can also always just write
f (Obj a b) x = a x + b x
(Record types can still be pattern matched using the regular constructor syntax).
I was reading Idris tutorial. And I can't understand the following code.
disjoint : (n : Nat) -> Z = S n -> Void
disjoint n p = replace {P = disjointTy} p ()
where
disjointTy : Nat -> Type
disjointTy Z = ()
disjointTy (S k) = Void
So far, what I figure out is ...
Void is the empty type which is used to prove something is impossible.
replace : (x = y) -> P x -> P y
replace uses an equality proof to transform a predicate.
My questions are:
which one is an equality proof? (Z = S n)?
which one is a predicate? the disjointTy function?
What's the purpose of disjointTy? Does disjointTy Z = () means Z is in one Type "land" () and (S k) is in another land Void?
In what way can an Void output represent contradiction?
Ps. What I know about proving is "all things are no matched then it is false." or "find one thing that is contradictory"...
which one is an equality proof? (Z = S n)?
The p parameter is the equality proof here. p has type Z = S n.
which one is a predicate? the disjointTy function?
Yes, you are right.
What's the purpose of disjointTy?
Let me repeat the definition of disjointTy here:
disjointTy : Nat -> Type
disjointTy Z = ()
disjointTy (S k) = Void
The purpose of disjointTy is to be that predicate replace function needs. This consideration determines the type of disjointTy, viz. [domain] -> Type. Since we have equality between naturals numbers, [domain] is Nat.
To understand how the body has been constructed we need to take a look at replace one more time:
replace : (x = y) -> P x -> P y
Recall that we have p of Z = S n, so x from the above type is Z and y is S n. To call replace we need to construct a term of type P x, i.e. P Z in our case. This means the type P Z returns must be easily constructible, e.g. the unit type is the ideal candidate for this. We have justified disjointTy Z = () clause of the definition of disjointTy. Of course it's not the only option, we could have used any other inhabited (non-empty) type, like Bool or Nat, etc.
The return value in the second clause of disjointTy is obvious now -- we want replace to return a value of Void type, so P (S n) has to be Void.
Next, we use disjointTy like so:
replace {P = disjointTy} p ()
^ ^ ^
| | |
| | the value of `()` type
| |
| proof term of Z = S n
|
we are saying "this is the predicate"
As a bonus, here is an alternative proof:
disjoint : (n : Nat) -> Z = S n -> Void
disjoint n p = replace {P = disjointTy} p False
where
disjointTy : Nat -> Type
disjointTy Z = Bool
disjointTy (S k) = Void
I have used False, but could have used True -- it doesn't matter. What matters is our ability to construct a term of type disjointTy Z.
In what way can an Void output represent contradiction?
Void is defined like so:
data Void : Type where
It has no constructors! There is no way to create a term of this type whatsoever (under some conditions: like Idris' implementation is correct and the underlying logic of Idris is sane, etc.). So if some function claims it can return a term of type Void there must be something fishy going on. Our function says: if you give me a proof of Z = S n, I will return a term of the empty type. This means Z = S n cannot be constructed in the first place because it leads to a contradiction.
Yes, p : x = y is an equality proof. So p is a equality proof and Z = S k is a equality type.
Also yes, usually any P : a -> Type is called predicate, like IsSucc : Nat -> Type. In boolean logic, a predicate would map Nat to true or false. Here, a predicate holds, if we can construct a proof for it. And it is true, if we can construct it (prf : ItIsSucc 4). And it is false, if we cannot construct it (there is no member of ItIsSucc Z).
At the end, we want Void. Read the replace call as Z = S k -> disjointTy Z -> disjointTy (S k), that is Z = S K -> () -> Void. So replace needs two arguments: the proof p : Z = S k and the unit () : (), and voilà, we have a void. By the way, instead of () you could use any type that you can construct, e.g. disjointTy Z = Nat and then use Z instead of ().
In dependent type theory we construct proofs like prf : IsSucc 4. We would say, we have a proof prf that IsSucc 4 is true. prf is also called a witness for IsSucc 4. But with this alone we could only proove things to be true. This is the definiton for Void:
data Void : Type where
There is no constructor. So we cannot construct a witness that Void holds. If you somehow ended up with a prf : Void, something is wrong and you have a contradiction.
I want a find function for Streams of size-bounded types which is analogous to the find functions for Lists and Vects.
total
find : MaxBound a => (a -> Bool) -> Stream a -> Maybe a
The challenge is it to make it:
be total
consume no more than constant log_2 N space where N is the number of bits required to encode the largest a.
take no longer than a minute to check at compile time
impose no runtime cost
Generally a total find implementation for Streams sounds absurd. Streams are infinite and a predicate of const False would make the search go on forever. A nice way to handle this general case is the infinite fuel technique.
data Fuel = Dry | More (Lazy Fuel)
partial
forever : Fuel
forever = More forever
total
find : Fuel -> (a -> Bool) -> Stream a -> Maybe a
find Dry _ _ = Nothing
find (More fuel) f (value :: xs) = if f value
then Just value
else find fuel f xs
That works well for my use case, but I wonder if in certain specialized cases the totality checker could be convinced without using forever. Otherwise, somebody may suffer a boring life waiting for find forever ?predicateWhichHappensToAlwaysReturnFalse (iterate S Z) to finish.
Consider the special case where a is Bits32.
find32 : (Bits32 -> Bool) -> Stream Bits32 -> Maybe Bits32
find32 f (value :: xs) = if f value then Just value else find32 f xs
Two problems: it's not total and it can't possibly return Nothing even though there's a finite number of Bits32 inhabitants to try. Maybe I could use take (pow 2 32) to build a List and then use List's find...uh, wait...the list alone would take up GBs of space.
In principle it doesn't seem like this should be difficult. There's finitely many inhabitants to try, and a modern computer can iterate through all 32-bit permutations in seconds. Is there a way to have the totality checker verify the (Stream Bits32) $ iterate (+1) 0 eventually cycles back to 0 and once it does assert that all the elements have been tried since (+1) is pure?
Here's a start, although I'm unsure how to fill the holes and specialize find enough to make it total. Maybe an interface would help?
total
IsCyclic : (init : a) -> (succ : a -> a) -> Type
data FinStream : Type -> Type where
MkFinStream : (init : a) ->
(succ : a -> a) ->
{prf : IsCyclic init succ} ->
FinStream a
partial
find : Eq a => (a -> Bool) -> FinStream a -> Maybe a
find pred (MkFinStream {prf} init succ) = if pred init
then Just init
else find' (succ init)
where
partial
find' : a -> Maybe a
find' x = if x == init
then Nothing
else
if pred x
then Just x
else find' (succ x)
total
all32bits : FinStream Bits32
all32bits = MkFinStream 0 (+1) {prf=?prf}
Is there a way to tell the totality checker to use infinite fuel verifying a search over a particular stream is total?
Let's define what it means for a sequence to be cyclic:
%default total
iter : (n : Nat) -> (a -> a) -> (a -> a)
iter Z f = id
iter (S k) f = f . iter k f
isCyclic : (init : a) -> (next : a -> a) -> Type
isCyclic init next = DPair (Nat, Nat) $ \(m, n) => (m `LT` n, iter m next init = iter n next init)
The above means that we have a situation which can be depicted as follows:
-- x0 -> x1 -> ... -> xm -> ... -> x(n-1) --
-- ^ |
-- |---------------------
where m is strictly less than n (but m can be equal to zero). n is some number of steps after which we get an element of the sequence we previously encountered.
data FinStream : Type -> Type where
MkFinStream : (init : a) ->
(next : a -> a) ->
{prf : isCyclic init next} ->
FinStream a
Next, let's define a helper function, which uses an upper bound called fuel to break out from the loop:
findLimited : (p : a -> Bool) -> (next : a -> a) -> (init : a) -> (fuel : Nat) -> Maybe a
findLimited p next x Z = Nothing
findLimited p next x (S k) = if p x then Just x
else findLimited pred next (next x) k
Now find can be defined like so:
find : (a -> Bool) -> FinStream a -> Maybe a
find p (MkFinStream init next {prf = ((_,n) ** _)}) =
findLimited p next init n
Here are some tests:
-- I don't have patience to wait until all32bits typechecks
all8bits : FinStream Bits8
all8bits = MkFinStream 0 (+1) {prf=((0, 256) ** (LTESucc LTEZero, Refl))}
exampleNothing : Maybe Bits8
exampleNothing = find (const False) all8bits -- Nothing
exampleChosenByFairDiceRoll : Maybe Bits8
exampleChosenByFairDiceRoll = find ((==) 4) all8bits -- Just 4
exampleLast : Maybe Bits8
exampleLast = find ((==) 255) all8bits -- Just 255
I'm trying to translate the Haskell core library's Arrows into F# (I think it's a good exercise to understanding Arrows and F# better, and I might be able to use them in a project I'm working on.) However, a direct translation isn't possible due to the difference in paradigms. Haskell uses type-classes to express this stuff, but I'm not sure what F# constructs best map the functionality of type-classes with the idioms of F#. I have a few thoughts, but figured it best to bring it up here and see what was considered to be the closest in functionality.
For the tl;dr crowd: How do I translate type-classes (a Haskell idiom) into F# idiomatic code?
For those accepting of my long explanation:
This code from the Haskell standard lib is an example of what I'm trying to translate:
class Category cat where
id :: cat a a
comp :: cat a b -> cat b c -> cat a c
class Category a => Arrow a where
arr :: (b -> c) -> a b c
first :: a b c -> a (b,d) (c,d)
instance Category (->) where
id f = f
instance Arrow (->) where
arr f = f
first f = f *** id
Attempt 1: Modules, Simple Types, Let Bindings
My first shot at this was to simply map things over directly using Modules for organization, like:
type Arrow<'a,'b> = Arrow of ('a -> 'b)
let arr f = Arrow f
let first f = //some code that does the first op
That works, but it loses out on polymorphism, since I don't implement Categories and can't easily implement more specialized Arrows.
Attempt 1a: Refining using Signatures and types
One way to correct some issues with Attempt 1 is to use a .fsi file to define the methods (so the types enforce easier) and to use some simple type tweaks to specialize.
type ListArrow<'a,'b> = Arrow<['a],['b]>
//or
type ListArrow<'a,'b> = LA of Arrow<['a],['b]>
But the fsi file can't be reused (to enforce the types of the let bound functions) for other implementations, and the type renaming/encapsulating stuff is tricky.
Attempt 2: Object models and interfaces
Rationalizing that F# is built to be OO also, maybe a type hierarchy is the right way to do this.
type IArrow<'a,'b> =
abstract member comp : IArrow<'b,'c> -> IArrow<'a,'c>
type Arrow<'a,'b>(func:'a->'b) =
interface IArrow<'a,'b> with
member this.comp = //fun code involving "Arrow (fun x-> workOn x) :> IArrow"
Aside from how much of a pain it can be to get what should be static methods (like comp and other operators) to act like instance methods, there's also the need to explicitly upcast the results. I'm also not sure that this methodology is still capturing the full expressiveness of type-class polymorphism. It also makes it hard to use things that MUST be static methods.
Attempt 2a: Refining using type extensions
So one more potential refinement is to declare the interfaces as bare as possible, then use extension methods to add functionality to all implementing types.
type IArrow<'a,'b> with
static member (&&&) f = //code to do the fanout operation
Ah, but this locks me into using one method for all types of IArrow. If I wanted a slightly different (&&&) for ListArrows, what can I do? I haven't tried this method yet, but I would guess I can shadow the (&&&), or at least provide a more specialized version, but I feel like I can't enforce the use of the correct variant.
Help me
So what am I supposed to do here? I feel like OO should be powerful enough to replace type-classes, but I can't seem to figure out how to make that happen in F#. Were any of my attempts close? Are any of them "as good as it gets" and that'll have to be good enough?
My brief answer is:
OO is not powerful enough to replace type classes.
The most straightforward translation is to pass a dictionary of operations, as in one typical typeclass implementation. That is if typeclass Foo defines three methods, then define a class/record type named Foo, and then change functions of
Foo a => yadda -> yadda -> yadda
to functions like
Foo -> yadda -> yadda -> yadda
and at each call site you know the concrete 'instance' to pass based on the type at the call-site.
Here's a short example of what I mean:
// typeclass
type Showable<'a> = { show : 'a -> unit; showPretty : 'a -> unit } //'
// instances
let IntShowable =
{ show = printfn "%d"; showPretty = (fun i -> printfn "pretty %d" i) }
let StringShowable =
{ show = printfn "%s"; showPretty = (fun s -> printfn "<<%s>>" s) }
// function using typeclass constraint
// Showable a => [a] -> ()
let ShowAllPretty (s:Showable<'a>) l = //'
l |> List.iter s.showPretty
// callsites
ShowAllPretty IntShowable [1;2;3]
ShowAllPretty StringShowable ["foo";"bar"]
See also
https://web.archive.org/web/20081017141728/http://blog.matthewdoig.com/?p=112
Here's the approach I use to simulate Typeclasses (from http://code.google.com/p/fsharp-typeclasses/ ).
In your case, for Arrows could be something like this:
let inline i2 (a:^a,b:^b ) =
((^a or ^b ) : (static member instance: ^a* ^b -> _) (a,b ))
let inline i3 (a:^a,b:^b,c:^c) =
((^a or ^b or ^c) : (static member instance: ^a* ^b* ^c -> _) (a,b,c))
type T = T with
static member inline instance (a:'a ) =
fun x -> i2(a , Unchecked.defaultof<'r>) x :'r
static member inline instance (a:'a, b:'b) =
fun x -> i3(a, b, Unchecked.defaultof<'r>) x :'r
type Return = Return with
static member instance (_Monad:Return, _:option<'a>) = fun x -> Some x
static member instance (_Monad:Return, _:list<'a> ) = fun x -> [x]
static member instance (_Monad:Return, _: 'r -> 'a ) = fun x _ -> x
let inline return' x = T.instance Return x
type Bind = Bind with
static member instance (_Monad:Bind, x:option<_>, _:option<'b>) = fun f ->
Option.bind f x
static member instance (_Monad:Bind, x:list<_> , _:list<'b> ) = fun f ->
List.collect f x
static member instance (_Monad:Bind, f:'r->'a, _:'r->'b) = fun k r -> k (f r) r
let inline (>>=) x (f:_->'R) : 'R = T.instance (Bind, x) f
let inline (>=>) f g x = f x >>= g
type Kleisli<'a, 'm> = Kleisli of ('a -> 'm)
let runKleisli (Kleisli f) = f
type Id = Id with
static member instance (_Category:Id, _: 'r -> 'r ) = fun () -> id
static member inline instance (_Category:Id, _:Kleisli<'a,'b>) = fun () ->
Kleisli return'
let inline id'() = T.instance Id ()
type Comp = Comp with
static member instance (_Category:Comp, f, _) = (<<) f
static member inline instance (_Category:Comp, Kleisli f, _) =
fun (Kleisli g) -> Kleisli (g >=> f)
let inline (<<<) f g = T.instance (Comp, f) g
let inline (>>>) g f = T.instance (Comp, f) g
type Arr = Arr with
static member instance (_Arrow:Arr, _: _ -> _) = fun (f:_->_) -> f
static member inline instance (_Arrow:Arr, _:Kleisli<_,_>) =
fun f -> Kleisli (return' <<< f)
let inline arr f = T.instance Arr f
type First = First with
static member instance (_Arrow:First, f, _: 'a -> 'b) =
fun () (x,y) -> (f x, y)
static member inline instance (_Arrow:First, Kleisli f, _:Kleisli<_,_>) =
fun () -> Kleisli (fun (b,d) -> f b >>= fun c -> return' (c,d))
let inline first f = T.instance (First, f) ()
let inline second f = let swap (x,y) = (y,x) in arr swap >>> first f >>> arr swap
let inline ( *** ) f g = first f >>> second g
let inline ( &&& ) f g = arr (fun b -> (b,b)) >>> f *** g
Usage:
> let f = Kleisli (fun y -> [y;y*2;y*3]) <<< Kleisli ( fun x -> [ x + 3 ; x * 2 ] ) ;;
val f : Kleisli<int,int list> = Kleisli <fun:f#4-14>
> runKleisli f <| 5 ;;
val it : int list = [8; 16; 24; 10; 20; 30]
> (arr (fun y -> [y;y*2;y*3])) 3 ;;
val it : int list = [3; 6; 9]
> let (x:option<_>) = runKleisli (arr (fun y -> [y;y*2;y*3])) 2 ;;
val x : int list option = Some [2; 4; 6]
> ( (*) 100) *** ((+) 9) <| (5,10) ;;
val it : int * int = (500, 19)
> ( (*) 100) &&& ((+) 9) <| 5 ;;
val it : int * int = (500, 14)
> let x:List<_> = (runKleisli (id'())) 5 ;;
val x : List<int> = [5]
Note: use id'() instead of id
Update: you need F# 3.0 to compile this code, otherwise here's the F# 2.0 version.
And here's a detailed explanation of this technique which is type-safe, extensible and as you can see works even with some Higher Kind Typeclasses.