Extended 'for' loops for F#

README.md

Backing code and examples for two different mini-frameworks adding extended imperative-style for loops in F#.

Discussed in blog post here.

a_nestedFor.fs

#nowarn "25"

/// The body of each nested loop needs to return one of these actions.
/// Break/Continue/Return behave as normal, Descend simply signals that 
/// the next nesting should start
type LoopAction = Break | Continue | Return | Descend

/// The body of each nested loop gets this information as input.
/// Depth indicates the current level of nesting, Indexes bundles up
/// all of the loop counter values up through the current level of nesting.
///  e.g.  for i1 = 0 to 10 do
///          // here Depth is 1, Indexes is [i1]
///          for i2 = 0 to 10 do
///            // here Depth is 2, Indexes is [i2; i1] 
///            for i3 = 0 to 10 do
///                // here Depth is 3, Indexes is [i3; i2; i1] 
type LoopInput = { Depth : int; Indexes : int list }

/// Simple specification to indicate the range over which the loop
/// counter should run. e.g. for i = Min to Max do
type LoopRange = { Min : int; Max : int }

/// When asked to compute the new counter range, this is the
/// input information. The current level of nesting, and the bundle
/// of index values from previous levels of nesting.
type RangeInput = { Depth : int; Prev : int list }

/// Input to the main looping function.
type LoopConfig = {
      /// Specifies how deep to nest the loops
      Depth : int
      /// Specifies the range for the level-0, outermost loop
      InitialRange : LoopRange
      /// Specifies the function used to compute min and max for new nested loops
      GetNextRange : RangeInput -> LoopRange
      /// Specifies the function used as the body for all loops
      Body : LoopInput -> LoopAction 
}

/// Nested 'for' loops to programmatic deptch
let nestedFor { Depth = maxDepth; InitialRange = range; GetNextRange = getRange; Body = body } =
    let rec loop currDepth (currMin :: minTail as minStack) (currMax :: maxTail as maxStack) prevIdxs =
        // a loop's index has run to the end
        if currMin > currMax then
            ascendOrReturn currDepth prevIdxs minTail maxTail
        else

        // update the bundle of indexes 'active' for this iteration
        let newIndexes = currMin::prevIdxs

        // invoke the body of the loop
        match body {Depth = currDepth; Indexes = newIndexes} with
        // return from the entire thing
        | Return -> ()

        // break out of this nesting depth, up to the previous depth
        | Break -> ascendOrReturn currDepth prevIdxs minTail maxTail

        // keep going in this depth, don't do further nesting
        | Continue -> loop currDepth ((currMin+1)::minTail) maxStack prevIdxs

        // go down to a new level of nesting
        | Descend ->
            let newDepth = currDepth + 1
            if newDepth > maxDepth then invalidOp "Attempted to descend beyond specified depth" else
            // obtain the loop range that should be used in this new level
            let newRange = getRange { Depth = newDepth; Prev = newIndexes }
            loop newDepth (newRange.Min::(currMin+1)::minTail) (newRange.Max::maxStack) newIndexes

    // pop up one level of nesting, or return if already at level 0
    and ascendOrReturn currDepth prevIdxs minTail maxTail =
        if currDepth = 1 then () else
        let _::idxTail = prevIdxs
        loop (currDepth - 1) minTail maxTail idxTail

    loop 1 [range.Min] [range.Max] []

b_imperativeBuilder.fs

// taken from
// http://tomasp.net/blog/imperative-i-return.aspx/  and
// http://tomasp.net/blog/imperative-ii-break.aspx/ 

open System.Collections.Generic

type ImperativeResult<'T> = 
  | ImpValue of 'T
  | ImpJump of int * bool
  | ImpNone 
  
type Imperative<'T> = unit -> ImperativeResult<'T>

type ImperativeBuilder() = 
  member x.Combine(a, b) = (fun () ->
    match a() with 
    | ImpNone -> b() 
    | res -> res)
  member x.Delay(f:unit -> Imperative<_>) = (fun () -> f()())
  member x.Return(v) : Imperative<_> = (fun () -> ImpValue(v))
  member x.Zero() = (fun () -> ImpNone)
  member x.Run<'T>(imp) = 
    match imp() with
    | ImpValue(v) -> v
    | ImpJump _ -> failwith "Invalid use of break/continue!"
    | _ when typeof<'T> = typeof<unit> -> Unchecked.defaultof<'T>
    | _ -> failwith "No value has been returend!"
  member x.CombineLoop(a, b) = (fun () ->
    match a() with 
    | ImpValue(v) -> ImpValue(v) 
    | ImpJump(0, false) -> ImpNone
    | ImpJump(0, true)
    | ImpNone -> b() 
    | ImpJump(depth, b) -> ImpJump(depth - 1, b))
  member x.For(inp:seq<_>, f) =
    let rec loop(en:IEnumerator<_>) = 
      if not(en.MoveNext()) then x.Zero() else
        x.CombineLoop(f(en.Current), x.Delay(fun () -> loop(en)))
    loop(inp.GetEnumerator())
  member x.While(gd, body) = 
    let rec loop() =
      if not(gd()) then x.Zero() else
        x.CombineLoop(body, x.Delay(fun () -> loop()))
    loop()         
  member x.Bind(v:Imperative<unit>, f : unit -> Imperative<_>) = (fun () ->
    match v() with
    | ImpJump(depth, kind) -> ImpJump(depth, kind)
    | _ -> f()() )
     
let imperative = new ImperativeBuilder()  
let break = (fun () -> ImpJump(0, false))
let continue = (fun () -> ImpJump(0, true))

usage.fs

// simple example of using the nestedFor function
nestedFor {
    Depth = 3; InitialRange = { Min=0; Max=1 }
    GetNextRange = fun _ -> { Min=0; Max=1 }
    Body = function
        | { Depth=3; Indexes=idxs } -> 
            printfn "%A" (List.rev idxs)
            Continue
        | _ -> Descend
}

// helper for upcoming examples. Checks if an int is prime.
let isPrime = function
    | 1 -> false
    | 2 | 3 -> true
    | n ->
        if n % 2 = 0 then false else
        if (n+1) % 6 <> 0 && (n-1) % 6 <> 0 then false else
        let q = (int<<floor<<sqrt<<float) n
        let mutable v = 3
        let mutable go = true
        while v < q && go do
            if n % v = 0 then
                go <- false
            v <- v + 2
        go

// finds the first m pairs of prime numbers that sum to a given number n
//  standard F# for loop
let primePairs n m =
    let mutable count = 0
    for i = 2 to n/2 do
        if (count >= m) || not (isPrime i) then
            ()
        else
        let j = n - i
        if isPrime j then
            printfn "%d + %d" i j
            count <- count + 1

// finds the first m pairs of prime numbers that sum to a given number n
//  uses 'imperative' computation expression
let primePairsImperative n m =
    let count = ref 0
    imperative {
        for i = 2 to n/2 do
            if not (isPrime i) then
                do! continue
            let j = n - i
            if isPrime j then
                printfn "%d + %d" i j
                count := !count + 1
                if !count >= m then
                    return ()
    }

// finds the first m triples of prime numbers that sum to a given number n
//  uses 'imperative' computation expression
let primeTriplesImperative n m =
    let count = ref 0
    let result = ref []
    imperative {
        for i = 2 to n/3 do
            if not (isPrime i) then
                do! continue
            for j = i to (n - i)/2 do
                if not (isPrime j) then
                    do! continue
                let k = n - i - j
                if isPrime k then
                    result := [i; j; k] :: !result
                    count := !count + 1
                    if !count >= m then
                        return ()
    }
    result

// finds the first m triples of prime numbers that sum to a given number n
//  uses 'nestedFor' function
let primeTriplesNested n m =
    let count = ref 0
    let result = ref []
    nestedFor {
        Depth = 2; InitialRange = { Min = 2; Max = n/3 }
        GetNextRange = fun { Prev = (prev :: _ ) } ->
            { Min=prev; Max = (n - prev)/2 }
        Body = function
            | { Indexes = [i] } ->
                if not (isPrime i) then Continue else Descend
            | { Indexes = [j; i] } ->
                if not (isPrime j) then Continue else
                let k = n - i - j
                if isPrime k then
                    result := [i; j; k] :: !result
                    count := !count + 1
                    if !count >= m then
                        Return
                    else Continue
                else Continue
        }
    result

// finds the first m k-tuples of prime numbers that sum to a given number n
//  uses 'nestedFor' function
let primeKTuplesNested n m k =
    let count = ref 0
    let result = ref []
    let finalDepth = k - 1
    nestedFor {
        Depth = finalDepth; InitialRange = { Min = 2; Max = n/k }
        GetNextRange = fun { Prev = (prev :: _ ) as p } ->
            { Min = prev; Max = (n - (List.sum p))/2 }
        Body = function
            | { Depth = d; Indexes = i :: _ } when d < finalDepth ->
                if not (isPrime i) then Continue else Descend
            | { Depth = d; Indexes = i :: prev } when d = finalDepth ->
                if not (isPrime i) then Continue else
                let j = n - i - (List.sum prev)
                if isPrime j then
                    result := (j :: i :: prev) :: !result
                    count := !count + 1
                    if !count >= m then
                        Return
                    else Continue
                else Continue
        }
    result