Backing code and examples for two different mini-frameworks adding extended imperative-style for
loops in F#.
Discussed in blog post here.
#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] [] |
// 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)) |
// 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 |