Skip to content

Instantly share code, notes, and snippets.

@latkin
Last active August 29, 2015 14:12
Show Gist options
  • Save latkin/50aceded83cd4129c6ca to your computer and use it in GitHub Desktop.
Save latkin/50aceded83cd4129c6ca to your computer and use it in GitHub Desktop.
Extended 'for' loops for F#

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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment