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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179

 

#light

namespace Common.Monads

type State<'state,'a> = State of ('state -> 'a * 'state)

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]    
module State = begin
  type StateBuilder =
    class
      new : unit -> StateBuilder
      member Bind : m:State<'state,'a> * f:('a -> State<'state,'b>) -> State<'state,'b>
      member BindUsing : m:State<'state,'a> * f:('a -> State<'state,'b>) ->State<'state,'b> when 'a :> System.IDisposable
      member Combine : m1:State<'state,unit> * m2:State<'state,'a> -> State<'state,'a>
      member Delay : f:(unit -> State<'state,'a>) -> State<'state,'a>
      member For : s:#seq<'a> * f:('a -> State<unit,'b>) -> State<unit,unit>
      //member Let : x:'a * f:('a -> 'b) -> 'b
      member Return : x:'a -> State<'state,'a>
      member TryFinally : m:State<'state,'a1> * f:(unit -> unit) -> State<'state,'a1>
      member TryWith : m:State<'state,'a> * f:(exn -> State<'state,'a>) -> State<'state,'a>
      member Using : x:'a * f:('a -> State<'state,'b>) -> State<'state,'b> when 'a :> System.IDisposable
      member While : p:(unit -> bool) * m:State<unit,'a> -> State<unit,unit>
      member Zero : unit -> State<'state,unit>
    end

  ///[state {...}] is the [State] continuation builder. 
  val state : StateBuilder
  
  ///[Run m state] runs [m] with the [state] and returns the value and state. 
  val Run : State<'state,'a> -> 'state -> 'a * 'state
  
  ///[GetState] is a continuation returning the current state of the continuation.
  ///Example of use : [state { let! state = get ... }]
  val GetState : State<'state,'state>
  
  ///[SetState newState] is a continuation putting [newState] as the new state of the continuation.
  ///Example of use : [state { do! put newState }]  
  val SetState : 'state -> State<'state,unit>

  ///[MapState f] is a continuation putting [f oldState] as the new state of the continuation.
  ///Example of use : [state { do! modify (fun oldState -> oldState) }]    
  val MapState : ('state -> 'state) -> State<'state,unit>

  ///[Eval m s] returns the state of [m] at the end of the continuation computation 
  ///which has used [s] as its initial state.    
  val Eval : State<'state,'a> -> 'state -> 'state
  
  ///[Exec m s] returns the value of [m] at the end of the continuation computation 
  ///which has used [s] as its initial state.
  val Exec : State<'state,'a> -> 'state -> 'a
  
  ///[MapStateAndResult f m] returns a new [State] continuation by applying [f value state] where
  ///[value] and [state] are the value and state of [m].
  val MapStateAndResult : ('a -> 'state -> 'b * 'state) -> State<'state,'a> -> State<'state,'b>
end

 


//=======================================

#light

namespace Common.Monads

open System

type State<'state, 'a> = State of ('state ->'a * 'state)

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]      
module State =
  let private succeed x = State (fun s -> x, s)
  let Run (State f) s = f s

  let private bind m f =
    State (fun s ->
      let v, s = Run m s 
      Run (f v) s
    )    
    
  let private delay f = State (fun s -> Run (f()) s)
  
  let private try_with m f = State (fun s -> try Run m s with e -> Run (f e) s)

  let private try_finally m f = State (fun s -> try Run m s finally f())
  let private dispose (x: #IDisposable) = x.Dispose()
  let private using r f = try_finally  (f r) (fun () -> dispose r)

  let rec private do_while p m = 
    if p() then 
      bind m (fun _ -> do_while p m) 
    else 
      succeed ()

  type StateBuilder () = 
    member b.Bind(m, f) = bind m f
    member b.BindUsing(m, f) = bind m (fun r -> using r f)
    member b.Combine(m1, m2) = bind m1 (fun () -> m2)  
    member b.Delay(f) = delay f

    member b.For(s:#seq<_>, f:('a->State<unit, 'b>)) = 
      using (s.GetEnumerator()) (fun ie ->
        do_while (fun () -> ie.MoveNext()) (delay (fun() -> f ie.Current))
      )

//    member b.Let(x, f) = f x

    member b.Return(x) = succeed x
    member b.TryFinally (m, f) = try_finally m f
    member b.TryWith(m, f) = try_with m f
    member b.Using(x : #IDisposable, f) = try_finally (f x) (fun () -> x.Dispose())
    member b.While(p, m:State<unit, 'a>) = do_while p m
    member b.Zero() = succeed ()

  let state = StateBuilder()
  let GetState = State (fun s -> s, s)
  let SetState s = State (fun _ -> (), s)

  let MapState f =
    State (fun s ->(), f s)

  let Eval m s =
    let _, s = Run m s
    s

  let Exec m s =
    let v, _ = Run m s
    v

  let MapStateAndResult f m =
    State (fun s ->
      let v, s = Run m s 
      let v', s' = f v s 
      Run (succeed v') s'
    )    

//Example

#r "FSharp.PowerPack.dll"

open State

//State<int, int>
let test = 
  state 
    { let! x = GetState
      let y = 100
      do! SetState (x + y * 100)
      return x
   }

let _ =
  let seed = 100
  System.Console.WriteLine("seed:{0}", seed)
  System.Console.WriteLine("test : Run:{0}", Run test seed)
  System.Console.WriteLine("test : value:{0} \t state:{1}", Exec test seed, Eval test seed)


//State<foo, int>
//with type foo = {a : int ; mutable b  :int }

type foo = {a : int ; mutable b  :int }

let test =
  state 
   { let! x = GetState
     print_endline ("pre " + any_to_string x)
     do! MapState (fun x -> {x with a = 700})
     let! x = GetState
     print_endline ("post " + any_to_string x)
     let! x = GetState
     return ()
   }

let _ = Run test {a = 0; b = 0}