SML: How to check if exceptions have been raised? - io

I am writing some simple programs about reading and writing files in SML, and I am thinking to track if a file is successfully opened / overflow happens, etc. If any exceptions are raised during complilation, I want the function to return false else true.
Is such implementation doable? If so, how? If not, any alternative solutions?
I am not sure if I am doing it correctly:
fun getN(file) =
let
val input = TextIO.openIn file
fun num(n) =
case n of
NONE => []
| SOME(str) => str_to_num(str) # num(TextIO.inputLine input)
in
if OS.FileSys.access(file, []) then
num(TextIO.inputLine input) before TextIO.closeIn input
else []
//OR
num(TextIO.inputLine input) before TextIO.closeIn input
handle Io => []
end;
However, neither of these solutions does not return [] when the directory of the file does not exist. Why?

Yes, that is doable:
fun wasExceptionRaised f x = (f x; false) handle e => true
This will execute f x, discard the result and return false, unless an exception was raised, in which case that exception, e, is handled, discarded and true is returned. Although you probably want to handle specific exceptions and not others, for example when testing:
val test_should_not_find_file =
(TextIO.openIn "non-existing-file"; false)
handle Io { cause = SysErr ("No such file or directory", _), ... } => true
| _ => false
If you're just logging if an exception was thrown, you may do something similar:
structure YourLogger =
struct
fun logException e =
let val time = Date.toString (Date.fromTimeLocal (Time.now ()))
val msg = "On " ^ time ^ " an error occurred: "
^ General.exnName e ^ ".\n"
^ General.exnMessage e
in appendFile "myLog.txt" msg end
fun logged f x = f x handle e => (logException e; raise e)
end
Now, instead of calling f x, you may call logged f x to get the same result, but where any exceptions are logged.

Related

OCaml: Issue manipulating string read from file

I am trying to read a file, line by line in OCaml. Each line in the file represents a string I want to parse, in the correct format expected by the Parsing tool. I am saving each line in a list structure.
I an finding an issue parsing the string contained in each element of the list. I am using OCamllex and Menhir as parsing tools.
If I try to use print_string to print the contents of the list at every element, I get the correct file contents.
If I try to pass a string that I defined within the program to the function, then I get the desired output.
However, if I try to parse the string which I have just read from the file, I get an error: Fatal error: exception Failure ("lexing empty token")
Note: that all of this has been tested against the same string.
Here is a snippet of the code:
let parse_mon m = Parser.monitor Lexer.token (from_string m)
let parse_and_print (mon: string)=
print_endline (print_monitor (parse_mon mon) 0)
let get_file_contents file =
let m_list = ref [] in
let read_contents = open_in file in
try
while true; do
m_list := input_line read_contents :: !m_list
done; !m_list
with End_of_file -> close_in read_contents; List.rev !m_list
let rec print_file_contents cont_list = match cont_list with
| [] -> ()
| m::ms -> parse_and_print m
let pt = print_file_contents (get_file_contents filename)
Ocamllex throws an exception Failure "lexing: empty token" when a text in the stream doesn't match any scanner pattern. Therefore, you will need to match with "catch-all" patterns such as ., _, or eof.
{ }
rule scan = parse
| "hello" as w { print_string w; scan lexbuf }
(* need these two for catch-all *)
| _ as c { print_char c; scan lexbuf }
| eof { exit 0 }
Without seeing your grammar and file I can only offer a wild guess: Could it be that the file contains an empty line at the end? Depending on the .mll that might result in the error you see. The reason being that get_file appends new lines to the front of the list and print_file_contents only looks at the head of that list.
I agree with kne, hard to say without seeing the file, but what you can do is trying to isolate the line that causes the trouble by doing :
let rec print_file_contents cont_list =
match cont_list with
| [] -> ()
| m::ms ->
try parse_and_print m
with Failure _ -> print_string m

What are the differences between Lwt.async and Lwt_main.run on OCaml/Node.JS?

I am experimenting with js_of_ocaml and node.js. As you know, node.js makes extensive use of callbacks to implement asynchronous requests without introducing explicit threads.
In OCaml we have a very nice threading library, Lwt, coming with a very useful syntax extension. I wrote a prototype with a binding to some node library (a AWS S3 client) and added a lwt-ish layer to hide the callback.
open Lwt.Infix
open Printf
open Js
let require_module s =
Js.Unsafe.fun_call
(Js.Unsafe.js_expr "require")
[|Js.Unsafe.inject (Js.string s)|]
let _js_aws = require_module "aws-sdk"
let array_to_list a =
let ax = ref [] in
begin
for i = 0 to a##.length - 1 do
Optdef.iter (array_get a i) (fun x -> ax := x :: !ax)
done;
!ax
end
class type error = object
end
class type bucket = object
method _Name : js_string t readonly_prop
method _CreationDate : date t readonly_prop
end
class type listBucketsData = object
method _Buckets : (bucket t) js_array t readonly_prop
end
class type s3 = object
method listBuckets :
(error -> listBucketsData t -> unit) callback -> unit meth
end
let createClient : unit -> s3 t = fun () ->
let constr_s3 = _js_aws##.S3 in
new%js constr_s3 ()
module S3 : sig
type t
val create : unit -> t
val list_buckets : t -> (string * string) list Lwt.t
end = struct
type t = s3 Js.t
let create () =
createClient ()
let list_buckets client =
let cell_of_bucket_data data =
((to_string data##._Name),
(to_string data##._CreationDate##toString))
in
let mvar = Lwt_mvar.create_empty () in
let callback error buckets =
let p () =
if true then
Lwt_mvar.put mvar
(`Ok(List.map cell_of_bucket_data ## array_to_list buckets##._Buckets))
else
Lwt_mvar.put mvar (`Error("Ups"))
in
Lwt.async p
in
begin
client##listBuckets (wrap_callback callback);
Lwt.bind
(Lwt_mvar.take mvar)
(function
| `Ok(whatever) -> Lwt.return whatever
| `Error(mesg) -> Lwt.fail_with mesg)
end
end
let () =
let s3 = S3.create() in
let dump lst =
Lwt_list.iter_s
(fun (name, creation_date) ->
printf "%32s\t%s\n" name creation_date;
Lwt.return_unit)
lst
in
let t () =
S3.list_buckets s3
>>= dump
in
begin
Lwt.async t
end
Since there is no binding to Lwt_main for node.js, I had to run my code with Lwt.async. What are the differences between running the code with Lwt.async rather than with Lwt_main.run – the latter not existing in node.js? Is it guaranteed that the program will wait until the asynchronous threads are completed before exiting, or is this rather a lucky but random behaviour of my code?
The Lwt_main.run function recursively polls the thread whose execution it supervises. At each iteration, if this thread is still running, the scheduler uses one engine (from Lwt_engine) to execute threads waiting for I/Os, either by selecting or synchronising on events.
The natural way to translate this in Node.JS is to use the process.nextTick method, which relies on Node.JS own scheduler. Implementing the Lwt_main.run function in this case can be as simple as:
let next_tick (callback : unit -> unit) =
Js.Unsafe.(fun_call
(js_expr "process.nextTick")
[| inject (Js.wrap_callback callback) |])
let rec run t =
Lwt.wakeup_paused ();
match Lwt.poll t with
| Some x -> x
| None -> next_tick (fun () -> run t)
This function only run threads of type unit Lwt.t but this is the main case for a program. It is possible to compute arbitrary values using a Lwt_mvar.t to communicate.
It is also possible to extend this example to support all sort of hooks, as in the original Lwt_main.run implementation.

Mapping sub-sets of parentheses to chars

I am attempting to create a Scala method that will take one parent group of parentheses, represented as a String, and then map each subgroup of parentheses to a different letter. It should then put these in a map which it returns, so basically I call the following method like this:
val s = "((2((x+3)+6)))"
val map = mapParentheses(s)
Where s could contain any number of sets of parentheses, and the Map returned should contain:
"(x+3)" -> 'a'
"(a+6)" -> 'b'
"(2b)" -> 'c'
"(c)" -> 'd'
So that elsewhere in my program I can recall 'd' and get "(c)" which will become "((2b))" then ((2(a+6))) and finally ((2((x+3)+6))). The string sent to the method mapParentheses will never have unmatched parentheses, or extra chars outside of the main parent parentheses, so the following items will never be sent:
"(fsf)a" because the a is outside the parent parentheses
"(a(aa))(a)" because the (a) is outside the parent parentheses
"((a)" because the parentheses are unmatched
")a(" because the parentheses are unmatched
So I was wondering if anyone knew of an easy (or not easy) way of creating this mapParentheses method.
You can do this pretty easily with Scala's parser combinators. First for the import and some simple data structures:
import scala.collection.mutable.Queue
import scala.util.parsing.combinator._
sealed trait Block {
def text: String
}
case class Stuff(text: String) extends Block
case class Paren(m: List[(String, Char)]) extends Block {
val text = m.head._2.toString
def toMap = m.map { case (k, v) => "(" + k + ")" -> v }.toMap
}
I.e., a block represents a substring of the input that is either some non-parenthetical stuff or a parenthetical.
Now for the parser itself:
class ParenParser(fresh: Queue[Char]) extends RegexParsers {
val stuff: Parser[Stuff] = "[^\\(\\)]+".r ^^ (Stuff(_))
def paren: Parser[Paren] = ("(" ~> insides <~ ")") ^^ {
case (s, m) => Paren((s -> fresh.dequeue) :: m)
}
def insides: Parser[(String, List[(String, Char)])] =
rep1(paren | stuff) ^^ { blocks =>
val s = blocks.flatMap(_.text)(collection.breakOut)
val m = blocks.collect {
case Paren(n) => n
}.foldLeft(List.empty[(String, Char)])(_ ++ _)
(s, m)
}
def parse(input: String) = this.parseAll(paren, input).get.toMap
}
Using get in the last line is very much not ideal, but is justified by your assertion that we can expect well-formed input.
Now we can create a new parser and pass in a mutable queue with some fresh variables:
val parser = new ParenParser(Queue('a', 'b', 'c', 'd', 'e', 'f'))
And now try out your test string:
scala> println(parser parse "((2((x+3)+6)))")
Map((c) -> d, (2b) -> c, (a+6) -> b, (x+3) -> a)
As desired. A more interesting exercise (left to the reader) would be to thread some state through the parser to avoid the mutable queue.
Classic recursive parsing problem. It can be handy to hold the different bits. We'll add a few utility methods to help us out later.
trait Part {
def text: String
override def toString = text
}
class Text(val text: String) extends Part {}
class Parens(val contents: Seq[Part]) extends Part {
val text = "(" + contents.mkString + ")"
def mapText(m: Map[Parens, Char]) = {
val inside = contents.collect{
case p: Parens => m(p).toString
case x => x.toString
}
"(" + inside.mkString + ")"
}
override def equals(a: Any) = a match {
case p: Parens => text == p.text
case _ => false
}
override def hashCode = text.hashCode
}
Now you need to parse into these things:
def str2parens(s: String): (Parens, String) = {
def fail = throw new Exception("Wait, you told me the input would be perfect.")
if (s(0) != '(') fail
def parts(s: String, found: Seq[Part] = Vector.empty): (Seq[Part], String) = {
if (s(0)==')') (found,s)
else if (s(0)=='(') {
val (p,s2) = str2parens(s)
parts(s2, found :+ p)
}
else {
val (tx,s2) = s.span(c => c != '(' && c != ')')
parts(s2, found :+ new Text(tx))
}
}
val (inside, more) = parts(s.tail)
if (more(0)!=')') fail
(new Parens(inside), more.tail)
}
Now we've got the whole thing parsed. So let's find all the bits.
def findParens(p: Parens): Set[Parens] = {
val inside = p.contents.collect{ case q: Parens => findParens(q) }
inside.foldLeft(Set(p)){_ | _}
}
Now we can build the map you want.
def mapParentheses(s: String) = {
val (p,_) = str2parens(s)
val pmap = findParens(p).toSeq.sortBy(_.text.length).zipWithIndex.toMap
val p2c = pmap.mapValues(i => ('a'+i).toChar)
p2c.map{ case(p,c) => (p.mapText(p2c), c) }.toMap
}
Evidence that it works:
scala> val s = "((2((x+3)+6)))"
s: java.lang.String = ((2((x+3)+6)))
scala> val map = mapParentheses(s)
map: scala.collection.immutable.Map[java.lang.String,Char] =
Map((x+3) -> a, (a+6) -> b, (2b) -> c, (c) -> d)
I will leave it as an exercise to the reader to figure out how it works, with the hint that recursion is a really powerful way to parse recursive structures.
def parse(s: String,
c: Char = 'a', out: Map[Char, String] = Map() ): Option[Map[Char, String]] =
"""\([^\(\)]*\)""".r.findFirstIn(s) match {
case Some(m) => parse(s.replace(m, c.toString), (c + 1).toChar , out + (c -> m))
case None if s.length == 1 => Some(out)
case _ => None
}
This outputs an Option containing a Map if it parses, which is better than throwing an exception if it doesn't. I suspect you really wanted a map from Char to the String, so that's what this outputs. c and out are default parameters so you don't need to input them yourself. The regex just means "any number of characters that aren't parens, eclosed in parens" (the paren characters need to be escaped with "\"). findFirstIn finds the first match and returns an Option[String], which we can pattern match on, replacing that string with the relevant character.
val s = "((2((x+3)+6)))"
parse(s) //Some(Map(a -> (x+3), b -> (a+6), c -> (2b), d -> (c)))
parse("(a(aa))(a)") //None

Reading Multiple Inputs from the Same Line the Scala Way

I tried to use readInt() to read two integers from the same line but that is not how it works.
val x = readInt()
val y = readInt()
With an input of 1 727 I get the following exception at runtime:
Exception in thread "main" java.lang.NumberFormatException: For input string: "1 727"
at java.lang.NumberFormatException.forInputString(NumberFormatException.java:65)
at java.lang.Integer.parseInt(Integer.java:492)
at java.lang.Integer.parseInt(Integer.java:527)
at scala.collection.immutable.StringLike$class.toInt(StringLike.scala:231)
at scala.collection.immutable.StringOps.toInt(StringOps.scala:31)
at scala.Console$.readInt(Console.scala:356)
at scala.Predef$.readInt(Predef.scala:201)
at Main$$anonfun$main$1.apply$mcVI$sp(Main.scala:11)
at scala.collection.immutable.Range.foreach$mVc$sp(Range.scala:75)
at Main$.main(Main.scala:10)
at Main.main(Main.scala)
I got the program to work by using readf but it seems pretty awkward and ugly to me:
val (x,y) = readf2("{0,number} {1,number}")
val a = x.asInstanceOf[Int]
val b = y.asInstanceOf[Int]
println(function(a,b))
Someone suggested that I just use Java's Scanner class, (Scanner.nextInt()) but is there a nice idiomatic way to do it in Scala?
Edit:
My solution following paradigmatic's example:
val Array(a,b) = readLine().split(" ").map(_.toInt)
Followup Question: If there were a mix of types in the String how would you extract it? (Say a word, an int and a percentage as a Double)
If you mean how would you convert val s = "Hello 69 13.5%" into a (String, Int, Double) then the most obvious way is
val tokens = s.split(" ")
(tokens(0).toString,
tokens(1).toInt,
tokens(2).init.toDouble / 100)
// (java.lang.String, Int, Double) = (Hello,69,0.135)
Or as mentioned you could match using a regex:
val R = """(.*) (\d+) (\d*\.?\d*)%""".r
s match {
case R(str, int, dbl) => (str, int.toInt, dbl.toDouble / 100)
}
If you don't actually know what data is going to be in the String, then there probably isn't much reason to convert it from a String to the type it represents, since how can you use something that might be a String and might be in Int? Still, you could do something like this:
val int = """(\d+)""".r
val pct = """(\d*\.?\d*)%""".r
val res = s.split(" ").map {
case int(x) => x.toInt
case pct(x) => x.toDouble / 100
case str => str
} // Array[Any] = Array(Hello, 69, 0.135)
now to do anything useful you'll need to match on your values by type:
res.map {
case x: Int => println("It's an Int!")
case x: Double => println("It's a Double!")
case x: String => println("It's a String!")
case _ => println("It's a Fail!")
}
Or if you wanted to take things a bit further, you could define some extractors which will do the conversion for you:
abstract class StringExtractor[A] {
def conversion(s: String): A
def unapply(s: String): Option[A] = try { Some(conversion(s)) }
catch { case _ => None }
}
val intEx = new StringExtractor[Int] {
def conversion(s: String) = s.toInt
}
val pctEx = new StringExtractor[Double] {
val pct = """(\d*\.?\d*)%""".r
def conversion(s: String) = s match { case pct(x) => x.toDouble / 100 }
}
and use:
"Hello 69 13.5%".split(" ").map {
case intEx(x) => println(x + " is Int: " + x.isInstanceOf[Int])
case pctEx(x) => println(x + " is Double: " + x.isInstanceOf[Double])
case str => println(str)
}
prints
Hello
69 is Int: true
0.135 is Double: true
Of course, you can make the extrators match on anything you want (currency mnemonic, name begging with 'J', URL) and return whatever type you want. You're not limited to matching Strings either, if instead of StringExtractor[A] you make it Extractor[A, B].
You can read the line as a whole, split it using spaces and then convert each element (or the one you want) to ints:
scala> "1 727".split(" ").map( _.toInt )
res1: Array[Int] = Array(1, 727)
For most complex inputs, you can have a look at parser combinators.
The input you are describing is not two Ints but a String which just happens to be two Ints. Hence you need to read the String, split by the space and convert the individual Strings into Ints as suggested by #paradigmatic.
One way would be splitting and mapping:
// Assuming whatever is being read is assigned to "input"
val input = "1 727"
val Array(x, y) = input split " " map (_.toInt)
Or, if you have things a bit more complicated than that, a regular expression is usually good enough.
val twoInts = """^\s*(\d+)\s*(\d+)""".r
val Some((x, y)) = for (twoInts(a, b) <- twoInts findFirstIn input) yield (a, b)
There are other ways to use regex. See the Scala API docs about them.
Anyway, if regex patterns are becoming too complicated, then you should appeal to Scala Parser Combinators. Since you can combine both, you don't loose any of regex's power.
import scala.util.parsing.combinator._
object MyParser extends JavaTokenParsers {
def twoInts = wholeNumber ~ wholeNumber ^^ { case a ~ b => (a.toInt, b.toInt) }
}
val MyParser.Success((x, y), _) = MyParser.parse(MyParser.twoInts, input)
The first example was more simple, but harder to adapt to more complex patterns, and more vulnerable to invalid input.
I find that extractors provide some machinery that makes this type of processing nicer. And I think it works up to a certain point nicely.
object Tokens {
def unapplySeq(line: String): Option[Seq[String]] =
Some(line.split("\\s+").toSeq)
}
class RegexToken[T](pattern: String, convert: (String) => T) {
val pat = pattern.r
def unapply(token: String): Option[T] = token match {
case pat(s) => Some(convert(s))
case _ => None
}
}
object IntInput extends RegexToken[Int]("^([0-9]+)$", _.toInt)
object Word extends RegexToken[String]("^([A-Za-z]+)$", identity)
object Percent extends RegexToken[Double](
"""^([0-9]+\.?[0-9]*)%$""", _.toDouble / 100)
Now how to use:
List("1 727", "uptime 365 99.999%") collect {
case Tokens(IntInput(x), IntInput(y)) => "sum " + (x + y)
case Tokens(Word(w), IntInput(i), Percent(p)) => w + " " + (i * p)
}
// List[java.lang.String] = List(sum 728, uptime 364.99634999999995)
To use for reading lines at the console:
Iterator.continually(readLine("prompt> ")).collect{
case Tokens(IntInput(x), IntInput(y)) => "sum " + (x + y)
case Tokens(Word(w), IntInput(i), Percent(p)) => w + " " + (i * p)
case Tokens(Word("done")) => "done"
}.takeWhile(_ != "done").foreach(println)
// type any input and enter, type "done" and enter to finish
The nice thing about extractors and pattern matching is that you can add case clauses as necessary, you can use Tokens(a, b, _*) to ignore some tokens. I think they combine together nicely (for instance with literals as I did with done).

Joining on the first finished thread?

I'm writing up a series of graph-searching algorithms in F# and thought it would be nice to take advantage of parallelization. I wanted to execute several threads in parallel and take the result of the first one to finish. I've got an implementation, but it's not pretty.
Two questions: is there a standard name for this sort of function? Not a Join or a JoinAll, but a JoinFirst? Second, is there a more idiomatic way to do this?
//implementation
let makeAsync (locker:obj) (shared:'a option ref) (f:unit->'a) =
async {
let result = f()
Monitor.Enter locker
shared := Some result
Monitor.Pulse locker
Monitor.Exit locker
}
let firstFinished test work =
let result = ref Option.None
let locker = new obj()
let cancel = new CancellationTokenSource()
work |> List.map (makeAsync locker result) |> List.map (fun a-> Async.StartAsTask(a, TaskCreationOptions.None, cancel.Token)) |> ignore
Monitor.Enter locker
while (result.Value.IsNone || (not <| test result.Value.Value)) do
Monitor.Wait locker |> ignore
Monitor.Exit locker
cancel.Cancel()
match result.Value with
| Some x-> x
| None -> failwith "Don't pass in an empty list"
//end implentation
//testing
let delayReturn (ms:int) value =
fun ()->
Thread.Sleep ms
value
let test () =
let work = [ delayReturn 1000 "First!"; delayReturn 5000 "Second!" ]
let result = firstFinished (fun _->true) work
printfn "%s" result
Would it work to pass the CancellationTokenSource and test to each async and have the first that computes a valid result cancel the others?
let makeAsync (cancel:CancellationTokenSource) test f =
let rec loop() =
async {
if cancel.IsCancellationRequested then
return None
else
let result = f()
if test result then
cancel.Cancel()
return Some result
else return! loop()
}
loop()
let firstFinished test work =
match work with
| [] -> invalidArg "work" "Don't pass in an empty list"
| _ ->
let cancel = new CancellationTokenSource()
work
|> Seq.map (makeAsync cancel test)
|> Seq.toArray
|> Async.Parallel
|> Async.RunSynchronously
|> Array.pick id
This approach makes several improvements: 1) it uses only async (it's not mixed with Task, which is an alternative for doing the same thing--async is more idiomatic in F#); 2) there's no shared state, other than CancellationTokenSource, which was designed for that purpose; 3) the clean function-chaining approach makes it easy to add additional logic/transformations to the pipeline, including trivially enabling/disabling parallelism.
With the Task Parallel Library in .NET 4, this is called WaitAny. For example, the following snippet creates 10 tasks and waits for any of them to complete:
open System.Threading
Array.init 10 (fun _ ->
Tasks.Task.Factory.StartNew(fun () ->
Thread.Sleep 1000))
|> Tasks.Task.WaitAny
In case you are ok to use "Reactive extensions (Rx)" in your project, the joinFirst method can be implemented as:
let joinFirst (f : (unit->'a) list) =
let c = new CancellationTokenSource()
let o = f |> List.map (fun i ->
let j = fun() -> Async.RunSynchronously (async {return i() },-1,c.Token)
Observable.Defer(fun() -> Observable.Start(j))
)
|> Observable.Amb
let r = o.First()
c.Cancel()
r
Example usage:
[20..30] |> List.map (fun i -> fun() -> Thread.Sleep(i*100); printfn "%d" i; i)
|> joinFirst |> printfn "Done %A"
Console.Read() |> ignore
Update:
Using Mailbox processor :
type WorkMessage<'a> =
Done of 'a
| GetFirstDone of AsyncReplyChannel<'a>
let joinFirst (f : (unit->'a) list) =
let c = new CancellationTokenSource()
let m = MailboxProcessor<WorkMessage<'a>>.Start(
fun mbox -> async {
let afterDone a m =
match m with
| GetFirstDone rc ->
rc.Reply(a);
Some(async {return ()})
| _ -> None
let getDone m =
match m with
|Done a ->
c.Cancel()
Some (async {
do! mbox.Scan(afterDone a)
})
|_ -> None
do! mbox.Scan(getDone)
return ()
} )
f
|> List.iter(fun t -> try
Async.RunSynchronously (async {let out = t()
m.Post(Done out)
return ()},-1,c.Token)
with
_ -> ())
m.PostAndReply(fun rc -> GetFirstDone rc)
Unfortunately, there is no built-in operation for this provided by Async, but I'd still use F# asyncs, because they directly support cancellation. When you start a workflow using Async.Start, you can pass it a cancellation token and the workflow will automatically stop if the token is cancelled.
This means that you have to start workflows explicitly (instead of using Async.Parallel), so the synchronizataion must be written by hand. Here is a simple version of Async.Choice method that does that (at the moment, it doesn't handle exceptions):
open System.Threading
type Microsoft.FSharp.Control.Async with
/// Takes several asynchronous workflows and returns
/// the result of the first workflow that successfuly completes
static member Choice(workflows) =
Async.FromContinuations(fun (cont, _, _) ->
let cts = new CancellationTokenSource()
let completed = ref false
let lockObj = new obj()
let synchronized f = lock lockObj f
/// Called when a result is available - the function uses locks
/// to make sure that it calls the continuation only once
let completeOnce res =
let run =
synchronized(fun () ->
if completed.Value then false
else completed := true; true)
if run then cont res
/// Workflow that will be started for each argument - run the
/// operation, cancel pending workflows and then return result
let runWorkflow workflow = async {
let! res = workflow
cts.Cancel()
completeOnce res }
// Start all workflows using cancellation token
for work in workflows do
Async.Start(runWorkflow work, cts.Token) )
Once we write this operation (which is a bit complex, but has to be written only once), solving the problem is quite easy. You can write your operations as async workflows and they'll be cancelled automatically when the first one completes:
let delayReturn n s = async {
do! Async.Sleep(n)
printfn "returning %s" s
return s }
Async.Choice [ delayReturn 1000 "First!"; delayReturn 5000 "Second!" ]
|> Async.RunSynchronously
When you run this, it will print only "returning First!" because the second workflow will be cancelled.

Resources