3
\$\begingroup\$

I was watching the following video about software transactional memory(using a package that maintains an access log). At the moment I am trying to learn about concurrency with shared memory and thought that could be more easily achieved with immutability and checking referential equality.

Never spent much time actually writing code (write mostly front end JavaScript/TypeScript/Fable) but understood the idea:

A function gets an object and takes out what it is going to change (receives an object called data and takes out contents).

Before changing the object (data) the function checks if the current sub object (contents) still has the same referential equality as the sub object had when the function started.

If so; then value can be set, if not then the function needs to fail or retry since another process has changed it while the function was executing.

Both checking referential equality and setting value should run synchronized (only one thread can write to the object at the same time).

Here is some example of that but I'm not sure this is done correctly and how to properly test it.

type 'a Ref = { mutable contents : 'a }
type Data = {id:int}
let ref v = { contents = v }
let (!) r = r.contents
let monitor = System.Object()
let (:=) r v = r.contents <- v
let isSameObject = 
  LanguagePrimitives.PhysicalEquality
type System.Random with
    member this.GetValues(minValue, maxValue) =
        Seq.initInfinite 
          (fun _ -> 
            this.Next(minValue, maxValue))
let setValue data org newValue =
    if (isSameObject !data org) then
      lock monitor (
        fun () -> 
          data := {id=newValue}
      )
      true
    else
      false
let r = System.Random()
let test min max data =
  let vals =
    r.GetValues(min, max) 
      |> Seq.take 10000
      |> Seq.map(
        fun item -> 
        (
          async{
            let value = !data
            do! Async.Sleep item
            let ret = 
              (setValue data value item)
            if ret then
              printfn 
                "changed from %d to %d"
                value.id
                (!data).id
            return ret
          }
        )
      )
      |> Async.Parallel
      |> Async.RunSynchronously 
      |> Seq.fold (
          fun acc item ->
            let (a,b) = acc
            if item then
              ((a+1),b)
            else
              acc
      ) (0,false)
  vals
test 10 1000 (ref {id=88888888})

If this is correct I would like to spend more time trying to figure out how to do an atomic transaction when taking multiple sub objects out of the data without causing a deadlock or updating one while failing the other.

[update]

When refactoring the code to update multiple objects it revealed the advantages of the method mentioned in the video:

  1. Using an abstraction is probably better than writing your own method that works for your particular use case. When the use case changes you may have to deal with maintaining complex code. Like using JQuery to update dom elements as opposed to using React,Vue, riotjs.

  2. The best I could come up with when updating multiple objects is to lock the entire hash table(dictionary). This is more like the second attempt in the video except it has no dead locking risks and has concurrent reads. Writes are not parallel but serial. Having a log on what objects are opened seems to be the only way to achieve parallel writing. Although I would think the log has serial access to prevent concurrency problems.

As for testing the code; how does one test this? You can hammer the data with updates and see if the result was correct or you can test it serially as with the tests below. Having one thread wait for another to change the object is for all intents and purposes just the same as a serial test.

I would love to see someone show a test that would fail due to the complexity that multiple threads sharing data bring to the table other than just hammering it with updates as done in my first example or having serial tests as with my second example.

Here is the code I came up with for multiple updates.

type 'a Ref = { mutable contents : 'a }
type Data = {id:int}
let ref v = { contents = v }
let (!) r = r.contents
let monitor = System.Object()
let (:=) r v = r.contents <- v
let isSameObject = 
  LanguagePrimitives.PhysicalEquality
type System.Collections.Generic.Dictionary<'K, 'V> with
  member x.TryFind(key) =
    match x.TryGetValue(key) with
    | true, v -> Some v
    | _ -> None
let compare pairs =
  pairs
  |> List.fold (
    fun (same,datas) (data,org)->
      if same then
        if (isSameObject !data org) then
          match datas with
            | Some d -> true, (Some (data::d))
            | None -> false, None
         else
          false,None
      else
        false,None
  ) (true,(Some []))
let setValue pairs =
  lock monitor (
    fun () -> 
      let compareArgs =
        pairs
        |> List.map(
          fun (data,org,_,_) ->
            data,org
        )
      let isSame, data = compare compareArgs
      if isSame then
        pairs
        |> List.fold(
          fun acc (data,org,newValue,setValueFunction) ->
            setValueFunction newValue data
            true
        ) true
      else
        false
  ) 




(*
  tests
*)


let liftSome item apply =
  match item with
  | Some value -> Some (apply value)
  | None _ -> None
let unwrap item = 
  match item with
  | Some value -> value
  | None _ -> ref {id=0}

let createStore () =
  let store = 
    System.Collections.Generic.Dictionary<int, Data Ref> () 
  [1..100]
  |> List.map(
      fun number ->
        store.Add(number, (ref {id=number}))
  ) |> ignore
  store
let hasCorrectValue (index,result) (data,_,_,_) =
  if result then
    if (!data).id = (index) then
      (index+1),true
    else
      0,false
  else
    0,false
let ``Set all values`` () =
  let store = createStore ()
  let setValueArgument =
    [1..100]
    |> List.map
      (fun item ->
        unwrap (store.TryFind item)
        ,!(unwrap (store.TryFind item))
        ,item+5
        ,(
          fun newValue data ->
            data := {id=newValue}
        )
      )
  if setValue setValueArgument then
    let index, ret =
      setValueArgument
      |> List.fold
          hasCorrectValue
          (6,true)
    ret
  else
    false
let ``compare should be false if not same`` () =
  let store = createStore ()
  let compareArgument =
    [1..100]
    |> List.map
      (fun item ->
        unwrap (store.TryFind item)
        ,!(unwrap (store.TryFind item))
      )
    |> List.indexed
    |> List.map
      (fun (index,item) ->
          let data, org = item
          if index = 2 then
            data,{id=99}
          else
            data,org
      )
  let result, data = (compare compareArgument)
  not result
let ``Set no values if something changed`` () =
  let store = createStore ()
  let setValueArgument =
    [1..100]
    |> List.map
      (fun item ->
        unwrap (store.TryFind item)
        ,!(unwrap (store.TryFind item))
        ,item+5
        ,(
          fun newValue data ->
            data := {id=newValue}
        )
      )
  (unwrap (store.TryFind 22)):= {id=22}
  if not (setValue setValueArgument) then
    let index, ret =
      setValueArgument
      |> List.fold
          hasCorrectValue
          (1,true)
    ret
  else
    false
``Set all values`` ()
``compare should be false if not same`` ()
``Set no values if something changed`` ()
\$\endgroup\$
  • 1
    \$\begingroup\$ soo ... why are people voting to close this as broken? I don't know F#, but ... \$\endgroup\$ – Vogel612 Aug 13 '17 at 17:55
  • 2
    \$\begingroup\$ You seem to be unsure if your code is working as expected. What kind of testing have you done? Only code that is known to be working to the best of your knowledge is on topic here. It's a frustrating experience for reviewers to spend time reviewing code only to realize later that it was broken. \$\endgroup\$ – RubberDuck Aug 13 '17 at 19:21
  • 1
    \$\begingroup\$ @RubberDuck Thank you for your reply, what I wanted to know if this is the right way to go about doing this, there may be something in the code that could break under certain circumstances but unless you're better in writing concurrent code in F# you'd know about it. This code is working to the best of my knowledge but have to admit that I'm just starting to figure this out. \$\endgroup\$ – HMR Aug 14 '17 at 2:57
  • 1
    \$\begingroup\$ Can you summarise enough of the "following video" for the question to make sense on its own without requiring additional context. I'm not about to install a video player (and buy headphones/speakers) for a resource that could go away with no notice anyway. \$\endgroup\$ – Toby Speight Aug 14 '17 at 15:14
  • 2
    \$\begingroup\$ I meant by editing the question - information in comments is ephemeral, but the question needs to stand for itself. Thanks. \$\endgroup\$ – Toby Speight Aug 15 '17 at 7:57

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.