I'm writing a simple ini file parser and I'm having a little problem with the initialization of the object in the "do" clause. It wants me to return a unit but i can't get the blankity function to do the side effects if I try to pipe into an "ignore" or if i return "()" directly.
This code works as a separate function because I can ignore the results.
#light
module Utilities.Config
open System
open System.IO
open System.Text.RegularExpressions
open System.Collections.Generic
type Config(?fileName : string) =
let fileName = defaultArg fileName #"C:\path\myConfigs.ini"
static let defaultSettings =
dict[ "Setting1", "1";
"Setting2", "2";
"Debug", "0";
"State", "Disarray";]
let settingRegex = new Regex(#"\s*(?<key>([^;#=]*[^;#= ]))\s*=\s*(?<value>([^;#]*[^;# ]))")
let fileSettings = new Dictionary<string, string>()
let addFileSetting (groups : GroupCollection) =
fileSettings.Add(groups.Item("key").Value, groups.Item("value").Value)
do File.ReadAllLines(fileName)
|> Seq.map(fun line -> settingRegex.Match(line))
|> Seq.filter(fun mtch -> mtch.Success)
|> Seq.map(fun mtch -> addFileSetting(mtch.Groups) // Does not have the correct return type
//|> ignore //#1 Does not init the dictionary
//() //#2 Does not init the dictionary
//The extra step will work
member c.ReadFile =
File.ReadAllLines(fileName)
|> Seq.map(fun line -> settingRegex.Match(line))
|> Seq.filter(fun mtch -> mtch.Success)
|> Seq.map(fun mtch -> addFileSetting(mtch.Groups))
Use Seq.iter (executing an action for each element - returning unit) instead of Seq.map (transforming elements).
The code doesn't work with ignore because Seq's are evaluated lazily and when you ignore the result, there is no need to run any code at all. Read this article
Related
Notes
Why a type method that should return a string returns a 'unit -> string' instead and how to solve it? does not answer my question because it refers to incorrect input, while I do not have it.
I'm currently having a problem with the functions "ToString" returning a (unit -> string) type and not a string, and "ToArray" returning (unit -> string[]) and not string[]. Attempting to upcast to string[] or string has no success.
Here is the code:
let readZip filepath = ZipFile.OpenRead filepath
let replaceEnvs str = Environment.ExpandEnvironmentVariables str
let listFiles rawDir =
replaceEnvs rawDir
|> Directory.EnumerateFiles
let readModMetadata filepath =
let archive = readZip filepath
(archive.GetEntry "mcmod.info").ToString // Also becomes (unit -> string) and not string
[<EntryPoint>]
let main args =
let mods = listFiles modsFolder
let modAsArray = mods.ToArray // Becomes (unit -> string[]) and not string[]?
0
Why is this so, and is there a way to get only strings?
So I found it out.
You need to specify that no parameters go into the functions. The parenthesis in ToString() do just that, as they differentiate returning a function from returning a result.
I need more coffee.
I'm trying to write an F# computational expression that permits reading and writing thread-safe variables only from within a critical section.
I've got a type, ThreadSafeVar<'t> that wraps a value, a CriticalSection<'t> and a computational expression builder, LockContext, as follows:
// wraps a value and restricts access to it
type ThreadSafeVar<'t> (value: 't) =
member val internal Value = value with get, set
// Encapsulates a critical section
type CriticalSection<'t> =
private
{ LockObj: obj
fn: unit -> 't }
static member Lock(lc: CriticalSection<'t>) = lock lc.LockObj lc.fn
// Expression builder for a locked context
type LockContext () =
member internal this.SyncRoot = obj()
member this.Return(value: 'v) = value
member this.ReturnFrom(value: ThreadSafeVar<'t>) = value.Value
member __.Bind(value: ThreadSafeVar<'t>, fn: 't -> 'u) = fn value.Value
// returns a CriticalSection
member this.Run(fn : unit -> 'u) = { LockObj = this.SyncRoot
fn=fn }
.
.
.
Reading the thread-safe values from within a lock context is simple enough thanks to Bind. e.g.
let lockedInt = ThreadSafeVar(1) // create a thread-safe variable
let context = LockContext()
let wrapperVal = context {
let! i = lockedInt // get the wrapper value inside lockedInt
return i
} |> CriticalSection.Lock
But I'm struggling to understand how to implement a means setting the value from within a LockContext instance. The approach I've thus taken is to implement a custom operation called, for instance, setVal. I've included my attempts thus far but I'm afraid they'd just muddy the waters. It seems that custom operations operate upon the computation built so far within the expression, encoded as a tuple, but I don't see that this is required in my case.
Any hints, pointing to resources, or direct help would be appreciated.
I'm not at all sure of the wisdom of this, but I came up with something based on the State monad that might work for you. First, define a "stateful" function as one that takes a ThreadSafeVar and returns some type of result:
ThreadSafeVar<'state> -> 'result
We then put that signature into a type that represents a stateful computation:
type Stateful<'state, 'result> =
MkStateful of (ThreadSafeVar<'state> -> 'result)
Now we need a way to run such a computation safely using a given TSV:
let run (tsv : ThreadSafeVar<_>) (MkStateful f) =
lock tsv (fun () -> f tsv)
Note that I've gotten rid of your CriticalSection type and instead just lock the TSV itself.
Next, we need a way to lift a pure value into a stateful computation:
let lift value =
MkStateful (fun _ -> value)
And a way to bind two stateful computations together:
let bind binder stateful =
MkStateful (fun tsv ->
run tsv stateful
|> binder
|> run tsv)
Defining the builder is then trivial:
type LockContext () =
member __.Return(value) = lift value
member __.Bind(stateful, binder) = bind binder stateful
let context = LockContext()
We also need helper computations for setting and getting a value safely:
let getValue =
MkStateful (fun tsv ->
tsv.Value)
let setValue value =
MkStateful (fun tsv ->
tsv.Value <- value)
Putting it all together, we can define a computation that increments the value of a TSV:
let comp =
context {
let! oldValue = getValue
let newValue = oldValue + 1
do! setValue newValue
return newValue
}
And we can run it like this:
let lockedInt = ThreadSafeVar(1)
let result = comp |> run lockedInt
printfn "%A" result // output is: 2
You can see the full solution and try it yourself here.
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
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.
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.