implementation module SharedCombinators import StdTuple, StdList, StdFunc, Util, Shared, Time, Tuple mapSharedRead :: !(r -> r`) !(ReadWriteShared r w) -> (ReadWriteShared r` w) mapSharedRead f (ReadWriteShared id read write getTimestamp) = ReadWriteShared id (appFst (fmap f) o read) write getTimestamp mapSharedWrite :: !(w` r -> w) !(ReadWriteShared r w) -> (ReadWriteShared r w`) mapSharedWrite f (ReadWriteShared id read write getTimestamp) = ReadWriteShared id read newWrite getTimestamp where newWrite v iworld # (m,iworld) = read iworld | isError m = (liftError m,iworld) = write (f v (fromOk m)) iworld mapShared :: !(!r -> r`,!w` r -> w) !(ReadWriteShared r w) -> ReadWriteShared r` w` mapShared (readMap,writeMap) shared = mapSharedRead readMap (mapSharedWrite writeMap shared) toReadOnlyShared :: !(ReadWriteShared r w) -> ReadOnlyShared r toReadOnlyShared (ReadWriteShared id read write getTimestamp) = ReadWriteShared id read (\_ iworld -> (Ok Void,iworld)) getTimestamp (>+<) infixl 6 :: !(ReadWriteShared r0 w0) !(ReadWriteShared r1 w1) -> ReadWriteShared (r0,r1) (w0,w1) (>+<) (ReadWriteShared id0 read0 write0 getTimestamp0) (ReadWriteShared id1 read1 write1 getTimestamp1) = ReadWriteShared (composeIds id0 id1) (composeReads read0 read1) (composeWrites write0 write1) (composeGetTimestamps getTimestamp0 getTimestamp1) (>+|) infixl 6 :: !(ReadWriteShared r0 w0) !(ReadWriteShared r1 w1) -> ReadWriteShared (r0,r1) w0 (>+|) (ReadWriteShared id0 read0 write0 getTimestamp0) (ReadWriteShared id1 read1 _ getTimestamp1) = ReadWriteShared (composeIds id0 id1) (composeReads read0 read1) write0 (composeGetTimestamps getTimestamp0 getTimestamp1) (|+<) infixl 6 :: !(ReadWriteShared r0 w0) !(ReadWriteShared r1 w1) -> ReadWriteShared (r0,r1) w1 (|+<) (ReadWriteShared id0 read0 _ getTimestamp0) (ReadWriteShared id1 read1 write1 getTimestamp1) = ReadWriteShared (composeIds id0 id1) (composeReads read0 read1) write1 (composeGetTimestamps getTimestamp0 getTimestamp1) (|+|) infixl 6 :: !(ReadWriteShared r0 w0) !(ReadWriteShared r1 w1) -> ReadOnlyShared (r0,r1) (|+|) (ReadWriteShared id0 read0 write0 getTimestamp0) (ReadWriteShared id1 read1 write1 getTimestamp1) = ReadWriteShared (composeIds id0 id1) (composeReads read0 read1) (\_ iworld -> (Ok Void,iworld)) (composeGetTimestamps getTimestamp0 getTimestamp1) (>&<) infixl 6 :: !(Shared a) !(Shared b) -> (Shared (a,b)) | gEq{|*|} a & gEq{|*|} b (>&<) (ReadWriteShared id0 read0 write0 getTimestamp0) (ReadWriteShared id1 read1 write1 getTimestamp1) = ReadWriteShared (composeIds id0 id1) (composeReads read0 read1) writeC (composeGetTimestamps getTimestamp0 getTimestamp1) where writeC (na,nb) iworld # (oa,iworld) = read0 iworld | isError oa = (liftError oa,iworld) # (ob,iworld) = read1 iworld | isError ob = (liftError ob,iworld) # (r,iworld) = if (fromOk oa =!= na) (write0 na iworld) (Ok Void,iworld) | isError r = (liftError r,iworld) = if (fromOk ob =!= nb) (write1 nb iworld) (Ok Void,iworld) composeIds id0 id1 = removeDup (id0 ++ id1) composeReads = compose (\a b -> (a,b)) composeGetTimestamps = compose max composeWrites write0 write1 (v0,v1) = compose const (write0 v0) (write1 v1) compose compF f0 f1 iworld # (res0,iworld) = f0 iworld | isError res0 = (liftError res0,iworld) # (res1,iworld) = f1 iworld | isError res1 = (liftError res1,iworld) = (Ok (compF (fromOk res0) (fromOk res1)),iworld) symmetricLens :: !(a b -> b) !(b a -> a) !(Shared a) !(Shared b) -> (!Shared a,!Shared b) symmetricLens putr putl sharedA sharedB = (newSharedA,newSharedB) where sharedAll = sharedA >+< sharedB newSharedA = mapShared (fst,\a (_,b) -> (a,putr a b)) sharedAll newSharedB = mapShared (snd,\b (a,_) -> (putl b a,b)) sharedAll