11 people like it.

Imperative computation builder

Defines an F# computation builder for encoding imperative computations. The 'return' construct returns immediately and terminates the rest of the computation. It is also possible to return value from a 'for' or 'while' loop.

Definition of imperative computations

 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: 
// For more information about this snippet, see the blog post:
// * http://tomasp.net/blog/imperative-i-return.aspx

/// A type that represents imperative computation
/// that runs and may return a result at the end
type Imperative<'T> = unit -> option<'T>

type ImperativeBuilder() = 
  // Creatae computation that returns the given value  
  member x.Return(v) : Imperative<_> = 
    (fun () -> Some(v))
  // Create computation that doesn't return any value
  member x.Zero() = (fun () -> None)

  // Return a computation that will evaluate the provided function  
  // only when the computation is being evaluated
  member x.Delay(f:unit -> Imperative<_>) = 
    (fun () -> f()())
  
  // Combines two delayed computations (that may return 
  // value imperatively using 'return') into one  
  member x.Combine(a, b) = (fun () ->
    // run the first part of the computation
    match a() with 
    // if it returned, we can return the result immediately
    | Some(v) -> Some(v) 
    // otherwise, we need to run the second part
    | _ -> b() )
  
  // Execute the imperative computation 
  // expression given as an argument
  member x.Run(imp) = 
    // run the computation and return the result or 
    // fail when the computation didn't return anything
    match imp() with 
    | Some(v) -> v 
    | None -> failwith "nothing returned!"

  member x.For(inp:seq<_>, f) =
    // Process next element from the sequence
    let rec loop(en:IEnumerator<_>) = 
      // If ther are no more elements, return empty computation
      if not(en.MoveNext()) then x.Zero() else
        // Otherwise call body and combine it with a 
        // computation that continues looping
        x.Combine(f(en.Current), x.Delay(fun () -> loop(en)))
    // Start enumerating from the first element
    loop(inp.GetEnumerator())
    
  member x.While(gd, body) = 
    // Perform one step of the 'looping'
    let rec loop() =
      // If the condition is false, return empty computation
      if not(gd()) then x.Zero() else
        // Otherwise, call body and then loop again
        x.Combine(body, x.Delay(fun () -> loop()))
    loop()

let imperative = new ImperativeBuilder()

Basic examples of imperative computations

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
// Code following the first 'return' is never executed
let test(b) = imperative {
  if b then 
    return 0
  printfn "after return!"
  return 1 }

// Imperatively returns 'false' if string fails to pass a check
let validateName(arg:string) = imperative {
  // Should be non-empty and should contain space
  if (arg = null) then return false
  let idx = arg.IndexOf(" ")
  if (idx = -1) then return false
    
  // Verify the name and the surname
  let name = arg.Substring(0, idx)
  let surname = arg.Substring(idx + 1, arg.Length - idx - 1)
  if (surname.Length < 1 || name.Length < 1) then return false
  if (Char.IsLower(surname.[0]) || Char.IsLower(name.[0])) then return false

  // Looks like we've got a valid name!
  return true }

Imperatively returning from a loop

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
let readFirstName() = imperative {
  // Loop until the user enters valid name
  while true do
    let name = Console.ReadLine()
    // If the name is valid, we return it, otherwise
    // we continue looping...
    if (validateName(name)) then return name
    printfn "That's not a valid name! Try again..." }

/// Imperatively returns 'true' as soon as a value 
/// matching the specified predicate is found
let exists f inp = imperative {
    for v in inp do 
      if f(v) then return true
    return false }

[ 1 .. 10 ] |> exists (fun v -> v % 3 = 0)
type Imperative<'T> = unit -> 'T option

Full name: Script.Imperative<_>


 A type that represents imperative computation
 that runs and may return a result at the end
type unit = Unit

Full name: Microsoft.FSharp.Core.unit
type 'T option = Option<'T>

Full name: Microsoft.FSharp.Core.option<_>
Multiple items
type ImperativeBuilder =
  new : unit -> ImperativeBuilder
  member Combine : a:(unit -> 'e option) * b:(unit -> 'e option) -> (unit -> 'e option)
  member Delay : f:(unit -> Imperative<'f>) -> (unit -> 'f option)
  member For : inp:seq<'b> * f:('b -> unit -> 'c option) -> (unit -> 'c option)
  member Return : v:'h -> Imperative<'h>
  member Run : imp:(unit -> 'd option) -> 'd
  member While : gd:(unit -> bool) * body:(unit -> 'a option) -> (unit -> 'a option)
  member Zero : unit -> (unit -> 'g option)

Full name: Script.ImperativeBuilder

--------------------
new : unit -> ImperativeBuilder
val x : ImperativeBuilder
member ImperativeBuilder.Return : v:'h -> Imperative<'h>

Full name: Script.ImperativeBuilder.Return
val v : 'h
union case Option.Some: Value: 'T -> Option<'T>
member ImperativeBuilder.Zero : unit -> (unit -> 'g option)

Full name: Script.ImperativeBuilder.Zero
union case Option.None: Option<'T>
member ImperativeBuilder.Delay : f:(unit -> Imperative<'f>) -> (unit -> 'f option)

Full name: Script.ImperativeBuilder.Delay
val f : (unit -> Imperative<'f>)
member ImperativeBuilder.Combine : a:(unit -> 'e option) * b:(unit -> 'e option) -> (unit -> 'e option)

Full name: Script.ImperativeBuilder.Combine
val a : (unit -> 'e option)
val b : (unit -> 'e option)
val v : 'e
member ImperativeBuilder.Run : imp:(unit -> 'd option) -> 'd

Full name: Script.ImperativeBuilder.Run
val imp : (unit -> 'd option)
val v : 'd
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
member ImperativeBuilder.For : inp:seq<'b> * f:('b -> unit -> 'c option) -> (unit -> 'c option)

Full name: Script.ImperativeBuilder.For
val inp : seq<'b>
Multiple items
val seq : sequence:seq<'T> -> seq<'T>

Full name: Microsoft.FSharp.Core.Operators.seq

--------------------
type seq<'T> = IEnumerable<'T>

Full name: Microsoft.FSharp.Collections.seq<_>
val f : ('b -> unit -> 'c option)
val loop : (IEnumerator<'b> -> unit -> 'c option)
val en : IEnumerator<'b>
type IEnumerator<'T> =
  member Current : 'T

Full name: System.Collections.Generic.IEnumerator<_>
val not : value:bool -> bool

Full name: Microsoft.FSharp.Core.Operators.not
Collections.IEnumerator.MoveNext() : bool
member ImperativeBuilder.Zero : unit -> (unit -> 'g option)
member ImperativeBuilder.Combine : a:(unit -> 'e option) * b:(unit -> 'e option) -> (unit -> 'e option)
property IEnumerator.Current: 'b
member ImperativeBuilder.Delay : f:(unit -> Imperative<'f>) -> (unit -> 'f option)
IEnumerable.GetEnumerator() : IEnumerator<'b>
member ImperativeBuilder.While : gd:(unit -> bool) * body:(unit -> 'a option) -> (unit -> 'a option)

Full name: Script.ImperativeBuilder.While
val gd : (unit -> bool)
val body : (unit -> 'a option)
val loop : (unit -> unit -> 'a option)
val imperative : ImperativeBuilder

Full name: Script.imperative
val test : b:bool -> int

Full name: Script.test
val b : bool
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
val validateName : arg:string -> bool

Full name: Script.validateName
val arg : string
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = String

Full name: Microsoft.FSharp.Core.string
val idx : int
String.IndexOf(value: string) : int
String.IndexOf(value: char) : int
String.IndexOf(value: string, comparisonType: StringComparison) : int
String.IndexOf(value: string, startIndex: int) : int
String.IndexOf(value: char, startIndex: int) : int
String.IndexOf(value: string, startIndex: int, comparisonType: StringComparison) : int
String.IndexOf(value: string, startIndex: int, count: int) : int
String.IndexOf(value: char, startIndex: int, count: int) : int
String.IndexOf(value: string, startIndex: int, count: int, comparisonType: StringComparison) : int
val name : string
String.Substring(startIndex: int) : string
String.Substring(startIndex: int, length: int) : string
val surname : string
property String.Length: int
type Char =
  struct
    member CompareTo : value:obj -> int + 1 overload
    member Equals : obj:obj -> bool + 1 overload
    member GetHashCode : unit -> int
    member GetTypeCode : unit -> TypeCode
    member ToString : unit -> string + 1 overload
    static val MaxValue : char
    static val MinValue : char
    static member ConvertFromUtf32 : utf32:int -> string
    static member ConvertToUtf32 : highSurrogate:char * lowSurrogate:char -> int + 1 overload
    static member GetNumericValue : c:char -> float + 1 overload
    ...
  end

Full name: System.Char
Char.IsLower(c: char) : bool
Char.IsLower(s: string, index: int) : bool
val readFirstName : unit -> string

Full name: Script.readFirstName
type Console =
  static member BackgroundColor : ConsoleColor with get, set
  static member Beep : unit -> unit + 1 overload
  static member BufferHeight : int with get, set
  static member BufferWidth : int with get, set
  static member CapsLock : bool
  static member Clear : unit -> unit
  static member CursorLeft : int with get, set
  static member CursorSize : int with get, set
  static member CursorTop : int with get, set
  static member CursorVisible : bool with get, set
  ...

Full name: System.Console
Console.ReadLine() : string
val exists : f:('a -> bool) -> inp:seq<'a> -> bool

Full name: Script.exists


 Imperatively returns 'true' as soon as a value
 matching the specified predicate is found
val f : ('a -> bool)
val inp : seq<'a>
val v : 'a
val v : int
Raw view Test code New version

More information

Link:http://fssnip.net/40
Posted:12 years ago
Author:Tomas Petricek
Tags: imperative , computation builder , return , break