My favorites | Sign in
Project Home Downloads Wiki Issues Source
Repository:
Checkout   Browse   Changes   Clones  
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
´╗┐module Control.Arrow

open Prelude
open Control.Monad.Base

type Kleisli<'a, 'm> = Kleisli of ('a -> 'm)
let runKleisli (Kleisli f) = f

type Id = Id with
static member (?<-) (_Category:Id, _: 'r -> 'r , _) = fun () -> id : 'r -> 'r
static member inline (?<-) (_Category:Id, _:Kleisli<'a,'b>, _) = fun () -> Kleisli return' :Kleisli<'a,'b>

let inline id'() = Inline.instance Id ()

type Comp = Comp with
static member (?<-) (_Category:Comp, f, _) = fun (g: _ -> _) -> g >> f
static member inline (?<-) (_Category:Comp, Kleisli f, _) = fun (Kleisli g) -> Kleisli (g >=> f)

let inline (<<<) f g = Inline.instance (Comp, f) g
let inline (>>>) g f = Inline.instance (Comp, f) g


type Arr = Arr with
static member (?<-) (_Arrow:Arr, _: _ -> _ , _) = fun (f:_->_) -> f
static member inline (?<-) (_Arrow:Arr, _:Kleisli<_,_>, _) = fun f -> Kleisli (return' <<< f)

let inline arr f = Inline.instance Arr f

type First = First with
static member (?<-) (_Arrow:First, f , _: 'a -> 'b ) = fun () -> fun (x,y) -> (f x, y)
static member inline (?<-) (_Arrow:First, Kleisli f, _:Kleisli<_,_>) = fun () -> Kleisli (fun (b,d) -> f b >>= fun c -> return' (c,d))

let inline first f = Inline.instance (First, f) ()

let inline second f =
let swap (x,y) = (y,x)
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


type AcEither = AcEither with
static member inline (?<-) (_ArrowChoice:AcEither, _:Either<_,_>->_, _) = fun ( f , g ) -> either f g
static member inline (?<-) (_ArrowChoice:AcEither, _:Kleisli<_,_> , _) = fun ((Kleisli f), (Kleisli g)) -> Kleisli (either f g)

let inline (|||) f g = Inline.instance AcEither (f, g)

type AcMerge = AcMerge with
static member inline (?<-) (_ArrowChoice:AcMerge, _: _-> Either<_,_> , _) = fun (f, g) -> (Left << f) ||| (Right << g)
static member inline (?<-) (_ArrowChoice:AcMerge, _:Kleisli<Either<'t,'v>,'z>, _) = fun ((Kleisli (f:'t->'u)), (Kleisli (g:'v->'w))) ->
Kleisli (f >=> (return' <<< Left)) ||| Kleisli (g >=> (return' <<< Right)) :Kleisli<Either<'t,'v>,'z>

let inline (+++) f g = Inline.instance AcMerge (f, g)


type AcLeft = AcLeft with
static member inline (?<-) (_ArrowChoice:AcLeft, f:_->_ , _) = fun () -> f +++ id
static member inline (?<-) (_ArrowChoice:AcLeft, Kleisli f, _) = fun () -> (Kleisli f) +++ arr (id'())

let inline left f = Inline.instance (AcLeft, f) ()

type AcRight = AcRight with
static member inline (?<-) (_ArrowChoice:AcRight, f:_->_ , _) = fun () -> id +++ f
static member inline (?<-) (_ArrowChoice:AcRight, Kleisli f, _) = fun () -> arr (id'()) +++ Kleisli f

let inline right f = Inline.instance (AcRight, f) ()


type Apply = Apply with
static member (?<-) (_ArrowApply:Apply, _: ('a -> 'b) * 'a -> 'b , _) = fun () -> fun (f,x) -> f x
static member (?<-) (_ArrowApply:Apply, _: Kleisli<Kleisli<'a,'b> * 'a,'b>, _) = fun () -> Kleisli (fun (Kleisli f, x) -> f x)

let inline app() = Inline.instance Apply ()

Change log

a6389b6ea46e by gust...@gustavo-LT on Aug 18, 2012   Diff
+ Inline Class.
No more stuff like :'R ... defaultof<'R>
All this logic to match the return type is
handled by the Inline Class.
Go to: 
Sign in to write a code review

Older revisions

38fa982d1d5c by gust...@gustavo-LT on Aug 15, 2012   Diff
Removed all "hat types" except from
explicit static member constraints.
11f4ae8033fb by gust...@gustavo-LT on Aug 15, 2012   Diff
Re-order the parameters:
First the Class
Then  the instance value(s) (if any)
Then  the return value      (if any)
Fill with () values the 3rd argument
...
f33a086281e1 by gust...@gustavo-LT on Aug 15, 2012   Diff
Arrow:
. fixed function: first.
+ test cases.
- function f from overload resolution
of Arr.
...
All revisions of this file

File info

Size: 3314 bytes, 74 lines
Powered by Google Project Hosting