I find the following C# extension method very useful:
public static bool In<T>(this T x, params T[] xs)
{
return xs.Contains(x);
}
allowing for C# calls such as
var s = "something else";
var rslt = s.In("this","that","other") ? "Yay" : "Boo";
and
var i = 1;
var rslt = i.In(1,2,3) ? "Yay" : "Boo";
I have been trying to come up with an F# (near-)equivalent, allowing e.g.:
let s = "something else"
let rslt = if s.In("this","that","other") then "Yay" else "Boo"
It seems like I would need something like:
type 'T with
static member this.In([ParamArray] xs : 'T )
{
return xs.Contains(x);
}
but that is not legal F# syntax. I can't see how to declare a extension method on a generic class in F#. Is it possible? Or is there a better way to achieve similar results? (I imagine I could just link in the C# project and call it from F#, but that would be cheating! :-)
The best I could come up with was:
let inline In (x : 'a, [<ParamArray>] xs : 'a[]) = Array.Exists( xs, (fun y -> x = y) )
which I expected to allow for calls like (which are not really acceptable anyway imho):
if In(ch, '?', '/') then "Yay" else "Boo"
but in fact required:
if In(ch, [| '?'; '/' |]) then "Yay" else "Boo"
implying that the ParamArray attribute is being ignored (for reasons I've yet to fathom).
Fwiw, the latest version of F# (3.1) contains exactly what I was after (yay!):
[<Extension>]
type ExtraCSharpStyleExtensionMethodsInFSharp () =
[<Extension>]
static member inline In(x: 'T, xs: seq<'T>) = xs |> Seq.exists (fun o -> o = x)
[<Extension>]
static member inline Contains(xs: seq<'T>, x: 'T) = xs |> Seq.exists (fun o -> o = x)
[<Extension>]
static member inline NotIn(x: 'T, xs: seq<'T>) = xs |> Seq.forall (fun o -> o <> x)
providing usages as
if s.In(["this","that","other"]) then ....
if (["this","that","other"]).Contains(s) then ...
etc.
Related
I'm trying to write a functor that takes a pair of ordered things and produces another ordered thing (with ordering defined lexicographically).
However, I want the resulting "ordered type" to be abstract, rather than an OCaml tuple.
This is easy enough to do with an inline/anonymous signature.
(* orderedPairSetInlineSig.ml *)
module type ORDERED_TYPE = sig
type t
val compare : t -> t -> int
end
module MakeOrderedPairSet (X : ORDERED_TYPE) :
sig
type t
val get_fst : t -> X.t
val get_snd : t -> X.t
val make : X.t -> X.t -> t
val compare : t -> t -> int
end = struct
type t = X.t * X.t
let combine_comparisons fst snd =
if fst = 0 then snd else fst
let compare (x, y) (a, b) =
let cmp = X.compare x a in
let cmp' = X.compare y b in
combine_comparisons cmp cmp'
let get_fst ((x, y) : t) = x
let get_snd ((x, y) : t) = y
let make x y = (x, y)
end
I want to give my anonymous signature a name like ORDERED_PAIR_SET_TYPE and move it outside the definition of MakeOrderedPairSet, like so (warning: not syntactically valid) :
(* orderedPairSet.ml *)
module type ORDERED_TYPE = sig
type t
val compare : t -> t -> int
end
module type ORDERED_PAIR_SET_TYPE = sig
type t
type el
val get_fst : t -> el
val get_snd : t -> el
val make : el -> el -> t
val compare : t -> t -> int
end
module MakeOrderedPairSet (X : ORDERED_TYPE) :
(ORDERED_PAIR_SET_TYPE with type el = X.t) = struct
type t = X.t * X.t
let combine_comparisons fst snd =
if fst = 0 then snd else fst
let compare (x, y) (a, b) =
let cmp = X.compare x a in
let cmp' = X.compare y b in
combine_comparisons cmp cmp'
let get_fst ((x, y) : t) = x
let get_snd ((x, y) : t) = y
let make x y = (x, y)
end
with el being an abstract type in the signature that I'm trying to bind to X.t inside the body of MakeOrderedPairSet.
However, I can't figure out how to fit everything together.
(ORDERED_PAIR_SET_TYPE with type el = X.t) is the most obvious way I can think of to say "give me a signature that's just like this one, but with an abstract type replaced with a concrete one (or differently-abstract in this case)". However, it isn't syntactically valid in this case (because of the parentheses). Taking the parentheses off does not result in a valid "module-language-level expression" either; I left it on because I think it makes my intent more obvious.
So ... how do you use a named signature to restrict the visibility into a [module produced by a functor]/[parameterized module]?
If you don't want to add el to the exports of the module then there are two ways:
Use a substitution constraint:
ORDERED_PAIR_SET_TYPE with type el := X.t
That will remove the specification of el from the signature.
Use a parameterised signature. Unfortunately, that is not expressible directly in OCaml, but requires a bit of extra functor gymnastics around the definition of your signature:
module SET_TYPE (X : ORDERED_TYPE) =
struct
module type S =
sig
type t
val get_fst : t -> X.el
val get_snd : t -> X.el
val make : X.el -> X.el -> t
val compare : t -> t -> int
end
end
With that you can write:
module MakeOrderedPairSet (X : ORDERED_TYPE) : SET_TYPE(X).S = ...
I have the following code:
doSomething : (s : String) -> (not (s == "") = True) -> String
doSomething s = ?doSomething
validate : String -> String
validate s = case (not (s == "")) of
False => s
True => doSomething s
After checking the input is not empty I would like to pass it to a function which accepts only validated input (not empty Strings).
As far as I understand the validation is taking place during runtime
but the types are calculated during compile time - thats way it doesn't work. Is there any workaround?
Also while playing with the code I noticed:
:t (("la" == "") == True)
"la" == "" == True : Bool
But
:t (("la" == "") = True)
"la" == "" = True : Type
Why the types are different?
This isn't about runtime vs. compile-time, since you are writing two branches in validate that take care, statically, of both the empty and the non-empty input cases; at runtime you merely choose between the two.
Your problem is Boolean blindness: if you have a value of type Bool, it is just that, a single bit that could have gone either way. This is what == gives you.
= on the other hand is for propositional equality: the only constructor of the type(-as-proposition) a = b is Refl : a = a, so by pattern-matching on a value of type a = b, you learn that a and b are truly equal.
I was able to get your example working by passing the non-equality as a proposition to doSomething:
doSomething : (s : String) -> Not (s = "") -> String
doSomething "" wtf = void $ wtf Refl
doSomething s nonEmpty = ?doSomething
validate : String -> String
validate "" = ""
validate s = doSomething s nonEmpty
where
nonEmpty : Not (s = "")
nonEmpty Refl impossible
As far as I understand the validation is taking place during runtime
but the types are calculated during compile time - thats way it
doesn't work.
That's not correct. It doesn't work because
We need the with form to perform dependent pattern matching, i. e. perform substitution and refinement on the context based on information gained from specific data constructors.
Even if we use with here, not (s == "") isn't anywhere in the context when we do the pattern match, therefore there's nothing to rewrite (in the context), and we can't demonstrate the not (s == "") = True equality later when we'd like to call doSomething.
We can use a wrapper data type here that lets us save a proof that a specific pattern equals the original expression we matched on:
doSomething : (s : String) -> (not (s == "") = True) -> String
doSomething s = ?doSomething
data Inspect : a -> Type where
Match : {A : Type} -> {x : A} -> (y : A) -> x = y -> Inspect x
inspect : {A : Type} -> (x : A) -> Inspect x
inspect x = Match x Refl
validate : String -> String
validate s with (inspect (not (s == "")))
| Match True p = doSomething s p
| Match False p = s
I need a function that produces primes in F#. I found this:
let primesSeq =
let rec nextPrime n p primes =
if primes |> Map.containsKey n then
nextPrime (n + p) p primes
else
primes.Add(n, p)
let rec prime n primes =
seq {
if primes |> Map.containsKey n then
let p = primes.Item n
yield! prime (n + 1) (nextPrime (n + p) p (primes.Remove n))
else
yield n
yield! prime (n + 1) (primes.Add(n * n, n))
}
prime 2 Map.empty
This works very well, but sometimes I need to work with int64/BigInts as well. Is there a more clever way of reusing this code than providing another sequences like these:
let primesSeq64 = Seq.map int64 primesSeq
let primesBigInts = Seq.map (fun (x : int) -> BigInteger(x)) primesSeq
I've heard about modifying a code using "inline" and "LanguagePrimitives", but all I've found was connected with function while my problem is related to a value.
Moreover - I'd like to have a function that works with integer types and computes a floor of a square root.
let inline sqRoot arg = double >> Math.Sqrt >> ... ?
but I can't see a way of returning the same type as "arg" is, as Math.Sqrt returns a double. Again - is there anything better than reimplementing the logic that computes a square root by myself ?
So the general way to do this requires a function and languageprimitives - in your case everywhere you have 1 you write LanguagePrimitives.GenericOne which will produce 1 or 1.0 etc depending on what is required.
To get this to work, you need to create a function value - you can avoid this by doing something like:
let inline primesSeq() = ...
let primesintSeq = primesSeq() //if you use this as an int seq later the compiler will figure it out, otherwise you use
let specified : int seq = primesSeq()
I am not so sure about the sqrt case though - it probably depends on how hacky you are willing to make the solution.
A naïve implementation of generic sqRoot may go along these lines:
let sqRoot arg =
let inline sqrtd a = (double >> sqrt) a
let result = match box(arg) with
| :? int64 as i -> (sqrtd i) |> int64 |> box
| :? int as i -> (sqrtd i) |> int |> box
// cases for other relevant integral types
| _ -> failwith "Unsupported type"
unbox result
and then, checking in FSI:
> let result: int = sqRoot 4;;
val result : int = 2
> let result: int64 = sqRoot 9L;;
val result : int64 = 3L
So I've decided to give F# a try and ported one the algorithms I've written in C# to it. At one point, I have noticed that debug build run faster than the release one. I then played with the optimization settings and got these results:
The times show the total execution time of the algorithm over 100000 runs. I am using the F# compiler that comes with Visual Studio 2010 SP1. Target platform is Any CPU.
Opt off, tail calls off: 5.81s
Opt off, tail calls on : 5.79s
Opt on , tail calls off: 6.48s
Opt on , tail calls on : 6.40s
I am really puzzled by this - why does the optimization make the code run slower? The C# version of the algorithm does not exhibit this behavior (altho it is implemented in a slightly different way)
Here is a stripped down version of the F# code, it is an algorithm that finds patterns in molecules. All the code that this F# program relies on is written in F#.
namespace Motives
module Internal =
type Motive =
{ ResidueSet: Set<Residue>; AtomSet: Set<IAtom> }
member this.Atoms : IAtom seq =
seq {
for r in this.ResidueSet do yield! r.Atoms
yield! this.AtomSet
}
static member fromResidues (residues : Residue seq) = residues |> Seq.fold (fun (m: Set<Residue>) r -> m.Add(r)) Set.empty |> fun rs -> { ResidueSet = rs; AtomSet = Set.empty }
static member fromAtoms (atoms : IAtom seq) = atoms |> Seq.fold (fun (m: Set<IAtom>) a -> m.Add(a)) Set.empty |> fun atoms -> { ResidueSet = Set.empty; AtomSet = atoms }
static member merge (m1: Motive) (m2: Motive) = { ResidueSet = Set.union m1.ResidueSet m2.ResidueSet; AtomSet = Set.union m1.AtomSet m2.AtomSet }
static member distance (m1: Motive) (m2: Motive) = Seq.min (seq { for a in m1.Atoms do for b in m2.Atoms -> a.Position.DistanceTo(b.Position) })
type Structure with
static member fromMotive (m: Motive) (parent: IStructure) (addBonds: bool) : IStructure =
let atoms = AtomCollection.FromUniqueAtoms(m.Atoms)
let bonds =
match addBonds with
| true -> BondCollection.Create(atoms |> Seq.map (fun a -> parent.Bonds.[a]) |> Seq.concat)
| _ -> BondCollection.Empty
Structure.Create (parent.Id + "_" + atoms.[0].Id.ToString(), atoms, bonds)
// KDTree used for range queries
// AminoChains used for regex queries
type StructureContext =
{ Structure: IStructure; KDTree: Lazy<KDAtomTree>; AminoChains: Lazy<(Residue array * string) list> }
static member create (structure: IStructure) =
match structure.IsPdbStructure() with
| false -> { Structure = structure; KDTree = Lazy.Create(fun () -> structure.Atoms.ToKDTree()); AminoChains = Lazy.CreateFromValue([]) }
| true ->
let aminoChains = new System.Func<(Residue array * string) list> (fun () ->
let residues = structure.PdbResidues() |> Seq.filter (fun r -> r.IsAmino)
residues
|> Seq.groupBy (fun r -> r.ChainIdentifier)
|> Seq.map (fun (k,rs) -> rs |> Array.ofSeq, String.concat "" (rs |> Seq.map (fun r -> r.ShortName)))
|> List.ofSeq)
{ Structure = structure; KDTree = Lazy.Create(fun () -> structure.Atoms.ToKDTree()); AminoChains = Lazy.Create(aminoChains) }
// Remember the named motives from named patterns
type MatchContext =
{ StructureContext: StructureContext; NamedMotives: Map<string, Motive> }
static member merge (c1: MatchContext) (c2: MatchContext) =
{ StructureContext = c1.StructureContext; NamedMotives = c2.NamedMotives |> Map.fold (fun m k v -> m.Add(k,v)) c1.NamedMotives }
type MatchedMotive = Motive * MatchContext
type Pattern =
| EmptyPattern
| GeneratingPattern of ( StructureContext -> MatchedMotive seq )
| ConstraintPattern of ( MatchedMotive -> MatchedMotive option ) * Pattern
static member matches (p: Pattern) (context: StructureContext) : MatchedMotive seq =
match p with
| GeneratingPattern generator -> generator context
| ConstraintPattern (transform, pattern) ->
Pattern.matches pattern context
|> Seq.choose (fun m -> transform m)
| _ -> Seq.empty
let ringPattern (names: string list) =
let fingerprint =
names
|> Seq.map (fun s -> ElementSymbol.Create(s).ToString())
|> Seq.sort
|> String.concat ""
let generator (context: StructureContext) =
let rings = context.Structure.Rings().GetRingsByFingerprint(fingerprint)
rings |> Seq.map (fun r -> Motive.fromAtoms r.Atoms, { StructureContext = context; NamedMotives = Map.empty })
GeneratingPattern generator
open Internal
type MotiveFinder (pattern: string) =
// I am using a hard coded pattern here for testing purposes
let pattern = ringPattern ["C"; "C"; "C"; "C"; "C"; "O"]
member this.Matches (structure: IStructure) =
Pattern.matches pattern (StructureContext.create structure)
|> Seq.map (fun (m, mc) -> Structure.fromMotive m mc.StructureContext.Structure false)
|> List.ofSeq
|> List.sortBy (fun s -> s.Atoms.[0].Id)
///////////////////////////////////////////////////////////////////
// performance test
let warmUp = (new MotiveFinder("")).Matches (StructureReader.ReadPdb(filename, computeBonds = true))
printfn "%i" (List.length warmUp)
let structure = StructureReader.ReadPdb(filename, computeBonds = true)
let stopWatch = System.Diagnostics.Stopwatch.StartNew()
let nruns = 100000
let result =
seq {
for i in 1 .. nruns do
yield (new MotiveFinder("")).Matches structure
} |> Seq.nth (nruns-1)
stopWatch.Stop()
printfn "Time elapsed: %f seconds" stopWatch.Elapsed.TotalSeconds
EDIT2:
I seem to have narrowed down the problem to the implementation of the Set type.
For this code:
let stopWatch = System.Diagnostics.Stopwatch.StartNew()
let runs = 1000000
let result =
seq {
for i in 1 .. runs do
let setA = [ 1 .. (i % 10) + 5 ] |> Set.ofList
let setB = [ 1 .. (i % 10) + 5 ] |> Set.ofList
yield Set.union setA setB
} |> Seq.nth (runs - 1)
stopWatch.Stop()
printfn "Time elapsed: %f seconds" stopWatch.Elapsed.TotalSeconds
printfn "%A" result
I get ~7.5s with optimization off and ~8.0s with optimization on. Still target = Any CPU (and I have i7-860 processor).
EDIT3:
And right after I posted the previous edit I figured I should try it on lists only.
So for
let stopWatch = System.Diagnostics.Stopwatch.StartNew()
let runs = 1000000
let result1 =
seq {
for i in 1 .. runs do
let list = [ 1 .. i % 100 + 5 ]
yield list
} |> Seq.nth (runs - 1)
stopWatch.Stop()
printfn "Time elapsed: %f seconds" stopWatch.Elapsed.TotalSeconds
printfn "%A" result1
I get ~3s with opt. off and ~3.5s with opt. on.
EDIT4:
If I remove the seq builder and just do
let stopWatch = System.Diagnostics.Stopwatch.StartNew()
let runs = 1000000
let mutable ret : int list = []
for i in 1 .. runs do
let list = [ 1 .. i % 100 + 5 ]
ret <- list
stopWatch1.Stop()
printfn "Time elapsed: %f seconds" stopWatch.Elapsed.TotalSeconds
printfn "%A" ret
I get ~3s with optimization both on and off. So it seem that the problem is somewhere in optimizing the seq builder code.
Strangely enough, I wrote a test app in C#:
var watch = Stopwatch.StartNew();
int runs = 1000000;
var result = Enumerable.Range(1, runs)
.Select(i => Microsoft.FSharp.Collections.ListModule.OfSeq(Enumerable.Range(1, i % 100 + 5)))
.ElementAt(runs - 1);
watch.Stop();
Console.WriteLine(result);
Console.WriteLine("Time: {0}s", watch.Elapsed.TotalSeconds);
And the code happens to run almost twice as fast as the F# solution at ~1.7s.
EDIT5:
Based on the discussion with Jon Harrop I have found out the thing that is causing the optimized code run slower (I still don't know why tho).
If I change Motive.Atoms from
member this.Atoms : IAtom seq =
seq {
for r in this.ResidueSet do yield! r.Atoms
yield! this.AtomSet
}
to
member this.Atoms : IAtom seq =
Seq.append (this.ResidueSet |> Seq.collect (fun r -> r.Atoms)) this.AtomSet
then the program runs ~7.1s in both optimized and non-optimized version. Which is slower than the seq version, but at least consistent.
So it seems that the F# compiler just can't optimize computation expressions and actually makes them slower by trying so.
I can also observe your wrapper code and penultimate example running slightly slower with optimizations enabled but the difference is less than 10% and, although anomalous, I am not surprised that optimizations can sometimes slightly degrade performance.
I should note that your style of coding leaves a lot of room for optimization but without the entire source code it is not possible for me to help optimize it. Your example uses the following code:
let result1 =
seq {
for i in 1 .. runs do
let list = [ 1 .. i % 100 + 5 ]
yield list
} |> Seq.nth (runs - 1)
when this is shorter, more idiomatic and orders of magnitude faster:
let result1 =
Seq.init runs (fun i -> List.init ((i+1) % 100 + 5) ((+) 1))
|> Seq.nth (runs - 1)
EDIT
In your comments below you say that you want to execute the function argument in which case I would not assume that Seq.nth will do this for you so I would use a for loop instead:
let mutable list = []
for i=1 to runs do
list <- List.init (i % 100 + 5) ((+) 1)
list
This is still 9× faster than the original.
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.