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.

Copy Source
Copy Link
Tools:

Definition of imperative computations

 1: // For more information about this snippet, see the blog post:
 2: // * http://tomasp.net/blog/imperative-i-return.aspx
 3: 
 4: /// A type that represents imperative computation
 5: /// that runs and may return a result at the end
 6: type Imperative<'T> = unit -> option<'T>
 7: 
 8: type ImperativeBuilder() = 
 9:   // Creatae computation that returns the given value  
10:   member x.Return(v) : Imperative<_> = 
11:     (fun () -> Some(v))
12:   // Create computation that doesn't return any value
13:   member x.Zero() = (fun () -> None)
14: 
15:   // Return a computation that will evaluate the provided function  
16:   // only when the computation is being evaluated
17:   member x.Delay(f:unit -> Imperative<_>) = 
18:     (fun () -> f()())
19:   
20:   // Combines two delayed computations (that may return 
21:   // value imperatively using 'return') into one  
22:   member x.Combine(a, b) = (fun () ->
23:     // run the first part of the computation
24:     match a() with 
25:     // if it returned, we can return the result immediately
26:     | Some(v) -> Some(v) 
27:     // otherwise, we need to run the second part
28:     | _ -> b() )
29:   
30:   // Execute the imperative computation 
31:   // expression given as an argument
32:   member x.Run(imp) = 
33:     // run the computation and return the result or 
34:     // fail when the computation didn't return anything
35:     match imp() with 
36:     | Some(v) -> v 
37:     | None -> failwith "nothing returned!"
38: 
39:   member x.For(inp:seq<_>, f) =
40:     // Process next element from the sequence
41:     let rec loop(en:IEnumerator<_>) = 
42:       // If ther are no more elements, return empty computation
43:       if not(en.MoveNext()) then x.Zero() else
44:         // Otherwise call body and combine it with a 
45:         // computation that continues looping
46:         x.Combine(f(en.Current), x.Delay(fun () -> loop(en)))
47:     // Start enumerating from the first element
48:     loop(inp.GetEnumerator())
49:     
50:   member x.While(gd, body) = 
51:     // Perform one step of the 'looping'
52:     let rec loop() =
53:       // If the condition is false, return empty computation
54:       if not(gd()) then x.Zero() else
55:         // Otherwise, call body and then loop again
56:         x.Combine(body, x.Delay(fun () -> loop()))
57:     loop()
58: 
59: let imperative = new ImperativeBuilder()

Basic examples of imperative computations

 1: // Code following the first 'return' is never executed
 2: let test(b) = imperative {
 3:   if b then 
 4:     return 0
 5:   printfn "after return!"
 6:   return 1 }
 7: 
 8: // Imperatively returns 'false' if string fails to pass a check
 9: let validateName(arg:string) = imperative {
10:   // Should be non-empty and should contain space
11:   if (arg = null) then return false
12:   let idx = arg.IndexOf(" ")
13:   if (idx = -1) then return false
14:     
15:   // Verify the name and the surname
16:   let name = arg.Substring(0, idx)
17:   let surname = arg.Substring(idx + 1, arg.Length - idx - 1)
18:   if (surname.Length < 1 || name.Length < 1) then return false
19:   if (Char.IsLower(surname.[0]) || Char.IsLower(name.[0])) then return false
20: 
21:   // Looks like we've got a valid name!
22:   return true }

Imperatively returning from a loop

 1: let readFirstName() = imperative {
 2:   // Loop until the user enters valid name
 3:   while true do
 4:     let name = Console.ReadLine()
 5:     // If the name is valid, we return it, otherwise
 6:     // we continue looping...
 7:     if (validateName(name)) then return name
 8:     printfn "That's not a valid name! Try again..." }
 9: 
10: /// Imperatively returns 'true' as soon as a value 
11: /// matching the specified predicate is found
12: let exists f inp = imperative {
13:     for v in inp do 
14:       if f(v) then return true
15:     return false }
16: 
17: [ 1 .. 10 ] |> exists (fun v -> v % 3 = 0)
type Imperative<'T> = unit -> 'T option

Full name: Snippet.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: unit
  implements: IComparable
type 'T option = Option<'T>

Full name: Microsoft.FSharp.Core.option<_>

  type: 'T option
  implements: Collections.IStructuralEquatable
  implements: IComparable<Option<'T>>
  implements: IComparable
  implements: Collections.IStructuralComparable
type ImperativeBuilder =
  class
    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)
  end

Full name: Snippet.ImperativeBuilder
val x : ImperativeBuilder
member ImperativeBuilder.Return : v:'h -> Imperative<'h>

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

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

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

Full name: Snippet.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: Snippet.ImperativeBuilder.Run
val imp : (unit -> 'd option)
val v : 'd
val failwith : 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: Snippet.ImperativeBuilder.For
val inp : seq<'b>

  type: seq<'b>
  inherits: Collections.IEnumerable
Multiple items
val seq : seq<'T> -> seq<'T>

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

--------------------

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

Full name: Microsoft.FSharp.Collections.seq<_>

  type: seq<'T>
  inherits: Collections.IEnumerable
val f : ('b -> unit -> 'c option)
val loop : (IEnumerator<'b> -> unit -> 'c option)
val en : IEnumerator<'b>

  type: IEnumerator<'b>
  inherits: IDisposable
  inherits: Collections.IEnumerator
Multiple items
type IEnumerator<'T> =
  interface
    member Current : 'T
  end

Full name: System.Collections.Generic.IEnumerator<_>

  type: IEnumerator<'T>
  inherits: IDisposable
  inherits: Collections.IEnumerator


--------------------

IEnumerator
val not : 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: Snippet.ImperativeBuilder.While
val gd : (unit -> bool)
val body : (unit -> 'a option)
val loop : (unit -> unit -> 'a option)
val imperative : ImperativeBuilder

Full name: Snippet.imperative
val test : bool -> int

Full name: Snippet.test
val b : bool

  type: bool
  implements: IComparable
  implements: IConvertible
  implements: IComparable<bool>
  implements: IEquatable<bool>
  inherits: ValueType
val printfn : Printf.TextWriterFormat<'T> -> 'T

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

Full name: Snippet.validateName
val arg : string

  type: string
  implements: IComparable
  implements: ICloneable
  implements: IConvertible
  implements: IComparable<string>
  implements: seq<char>
  implements: Collections.IEnumerable
  implements: IEquatable<string>
Multiple items
val string : 'T -> string

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

--------------------

type string = String

Full name: Microsoft.FSharp.Core.string

  type: string
  implements: IComparable
  implements: ICloneable
  implements: IConvertible
  implements: IComparable<string>
  implements: seq<char>
  implements: Collections.IEnumerable
  implements: IEquatable<string>
val idx : int

  type: int
  implements: IComparable
  implements: IFormattable
  implements: IConvertible
  implements: IComparable<int>
  implements: IEquatable<int>
  inherits: ValueType
Multiple overloads
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

  type: string
  implements: IComparable
  implements: ICloneable
  implements: IConvertible
  implements: IComparable<string>
  implements: seq<char>
  implements: Collections.IEnumerable
  implements: IEquatable<string>
Multiple overloads
String.Substring(startIndex: int) : string
String.Substring(startIndex: int, length: int) : string
val surname : string

  type: string
  implements: IComparable
  implements: ICloneable
  implements: IConvertible
  implements: IComparable<string>
  implements: seq<char>
  implements: Collections.IEnumerable
  implements: IEquatable<string>
property String.Length: int
type Char =
  struct
    member CompareTo : obj -> int
    member CompareTo : char -> int
    member Equals : obj -> bool
    member Equals : char -> bool
    member GetHashCode : unit -> int
    member GetTypeCode : unit -> System.TypeCode
    member ToString : unit -> string
    member ToString : System.IFormatProvider -> string
    static val MaxValue : char
    static val MinValue : char
    static member ConvertFromUtf32 : int -> string
    static member ConvertToUtf32 : char * char -> int
    static member ConvertToUtf32 : string * int -> int
    static member GetNumericValue : char -> float
    static member GetNumericValue : string * int -> float
    static member GetUnicodeCategory : char -> System.Globalization.UnicodeCategory
    static member GetUnicodeCategory : string * int -> System.Globalization.UnicodeCategory
    static member IsControl : char -> bool
    static member IsControl : string * int -> bool
    static member IsDigit : char -> bool
    static member IsDigit : string * int -> bool
    static member IsHighSurrogate : char -> bool
    static member IsHighSurrogate : string * int -> bool
    static member IsLetter : char -> bool
    static member IsLetter : string * int -> bool
    static member IsLetterOrDigit : char -> bool
    static member IsLetterOrDigit : string * int -> bool
    static member IsLowSurrogate : char -> bool
    static member IsLowSurrogate : string * int -> bool
    static member IsLower : char -> bool
    static member IsLower : string * int -> bool
    static member IsNumber : char -> bool
    static member IsNumber : string * int -> bool
    static member IsPunctuation : char -> bool
    static member IsPunctuation : string * int -> bool
    static member IsSeparator : char -> bool
    static member IsSeparator : string * int -> bool
    static member IsSurrogate : char -> bool
    static member IsSurrogate : string * int -> bool
    static member IsSurrogatePair : string * int -> bool
    static member IsSurrogatePair : char * char -> bool
    static member IsSymbol : char -> bool
    static member IsSymbol : string * int -> bool
    static member IsUpper : char -> bool
    static member IsUpper : string * int -> bool
    static member IsWhiteSpace : char -> bool
    static member IsWhiteSpace : string * int -> bool
    static member Parse : string -> char
    static member ToLower : char -> char
    static member ToLower : char * System.Globalization.CultureInfo -> char
    static member ToLowerInvariant : char -> char
    static member ToString : char -> string
    static member ToUpper : char -> char
    static member ToUpper : char * System.Globalization.CultureInfo -> char
    static member ToUpperInvariant : char -> char
    static member TryParse : string * char -> bool
  end

Full name: System.Char

  type: Char
  implements: IComparable
  implements: IConvertible
  implements: IComparable<char>
  implements: IEquatable<char>
  inherits: ValueType
Multiple overloads
Char.IsLower(c: char) : bool
Char.IsLower(s: string, index: int) : bool
val readFirstName : unit -> string

Full name: Snippet.readFirstName
type Console =
  class
    static member BackgroundColor : System.ConsoleColor with get, set
    static member Beep : unit -> unit
    static member Beep : int * int -> unit
    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
    static member Error : System.IO.TextWriter
    static member ForegroundColor : System.ConsoleColor with get, set
    static member In : System.IO.TextReader
    static member InputEncoding : System.Text.Encoding with get, set
    static member KeyAvailable : bool
    static member LargestWindowHeight : int
    static member LargestWindowWidth : int
    static member MoveBufferArea : int * int * int * int * int * int -> unit
    static member MoveBufferArea : int * int * int * int * int * int * char * System.ConsoleColor * System.ConsoleColor -> unit
    static member NumberLock : bool
    static member OpenStandardError : unit -> System.IO.Stream
    static member OpenStandardError : int -> System.IO.Stream
    static member OpenStandardInput : unit -> System.IO.Stream
    static member OpenStandardInput : int -> System.IO.Stream
    static member OpenStandardOutput : unit -> System.IO.Stream
    static member OpenStandardOutput : int -> System.IO.Stream
    static member Out : System.IO.TextWriter
    static member OutputEncoding : System.Text.Encoding with get, set
    static member Read : unit -> int
    static member ReadKey : unit -> System.ConsoleKeyInfo
    static member ReadKey : bool -> System.ConsoleKeyInfo
    static member ReadLine : unit -> string
    static member ResetColor : unit -> unit
    static member SetBufferSize : int * int -> unit
    static member SetCursorPosition : int * int -> unit
    static member SetError : System.IO.TextWriter -> unit
    static member SetIn : System.IO.TextReader -> unit
    static member SetOut : System.IO.TextWriter -> unit
    static member SetWindowPosition : int * int -> unit
    static member SetWindowSize : int * int -> unit
    static member Title : string with get, set
    static member TreatControlCAsInput : bool with get, set
    static member WindowHeight : int with get, set
    static member WindowLeft : int with get, set
    static member WindowTop : int with get, set
    static member WindowWidth : int with get, set
    static member Write : bool -> unit
    static member Write : char -> unit
    static member Write : char [] -> unit
    static member Write : float -> unit
    static member Write : decimal -> unit
    static member Write : float32 -> unit
    static member Write : int -> unit
    static member Write : uint32 -> unit
    static member Write : int64 -> unit
    static member Write : uint64 -> unit
    static member Write : obj -> unit
    static member Write : string -> unit
    static member Write : string * obj -> unit
    static member Write : string * obj [] -> unit
    static member Write : string * obj * obj -> unit
    static member Write : char [] * int * int -> unit
    static member Write : string * obj * obj * obj -> unit
    static member Write : string * obj * obj * obj * obj -> unit
    static member WriteLine : unit -> unit
    static member WriteLine : bool -> unit
    static member WriteLine : char -> unit
    static member WriteLine : char [] -> unit
    static member WriteLine : decimal -> unit
    static member WriteLine : float -> unit
    static member WriteLine : float32 -> unit
    static member WriteLine : int -> unit
    static member WriteLine : uint32 -> unit
    static member WriteLine : int64 -> unit
    static member WriteLine : uint64 -> unit
    static member WriteLine : obj -> unit
    static member WriteLine : string -> unit
    static member WriteLine : string * obj -> unit
    static member WriteLine : string * obj [] -> unit
    static member WriteLine : char [] * int * int -> unit
    static member WriteLine : string * obj * obj -> unit
    static member WriteLine : string * obj * obj * obj -> unit
    static member WriteLine : string * obj * obj * obj * obj -> unit
  end

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

Full name: Snippet.exists

Imperatively returns 'true' as soon as a value
 matching the specified predicate is found

val f : ('a -> bool)
val inp : seq<'a>

  type: seq<'a>
  inherits: Collections.IEnumerable
val v : 'a
val v : int

  type: int
  implements: IComparable
  implements: IFormattable
  implements: IConvertible
  implements: IComparable<int>
  implements: IEquatable<int>
  inherits: ValueType

More information

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