[ base ] Add non-blocking and timeout variants for channelGet #3435
Conversation
…g with return values of blodwen-channel-get-non-blocking.
… acquired, or the box is empty.
…ng of channelGetNonBlocking.
…ntheses around let*.
…ty box in blodwen-channel-get-non-blocking.
…, and fixing inital test for channelGetNonBlocking.
…ed channelGetWithTimeout function.
Matthew-Mosior
changed the title
Matthew-Mosior
changed the title
Matthew-Mosior
changed the title
Matthew-Mosior
changed the title
libs/base/System/Concurrency.idr
Outdated
| data ChannelSchemeObj : Type where | ||
| Null : ChannelSchemeObj | ||
| Cons : ChannelSchemeObj -> ChannelSchemeObj -> ChannelSchemeObj | ||
| IntegerVal : Integer -> ChannelSchemeObj | ||
| FloatVal : Double -> ChannelSchemeObj | ||
| StringVal : String -> ChannelSchemeObj | ||
| CharVal : Char -> ChannelSchemeObj | ||
| Symbol : String -> ChannelSchemeObj | ||
| Box : ChannelSchemeObj -> ChannelSchemeObj | ||
| Vector : Integer -> List ChannelSchemeObj -> ChannelSchemeObj | ||
| Procedure : ChannelObj -> ChannelSchemeObj |
There was a problem hiding this comment.
Minor nit: since this type isn't indexed, it could be converted to the simpler data syntax.
data ChannelSchemeObj
= Null
| Cons ChannelSchemeObj ChanelSchemeObj
...
libs/base/System/Concurrency.idr
Outdated
| Procedure : ChannelObj -> ChannelSchemeObj | ||
|
|
||
| export | ||
| interface Scheme a where |
There was a problem hiding this comment.
nit: rename the interface to FromScheme, for consistency with FromString, FromInteger, etc.
libs/base/System/Concurrency.idr
Outdated
| if prim_isInteger obj == 1 then IntegerVal (unsafeGetInteger obj) | ||
| else if prim_isVector obj == 1 then Vector (unsafeGetInteger (unsafeVectorRef obj 0)) | ||
| (readVector (unsafeVectorLength obj) 1 obj) | ||
| else if prim_isPair obj == 1 then Cons (decodeObj (unsafeFst obj)) | ||
| (decodeObj (unsafeSnd obj)) | ||
| else if prim_isFloat obj == 1 then FloatVal (unsafeGetFloat obj) | ||
| else if prim_isString obj == 1 then StringVal (unsafeGetString obj) | ||
| else if prim_isChar obj == 1 then CharVal (unsafeGetChar obj) | ||
| else if prim_isSymbol obj == 1 then Symbol (unsafeReadSymbol obj) | ||
| else if prim_isProcedure obj == 1 then Procedure obj | ||
| else if prim_isBox obj == 1 then Box (decodeObj (unsafeUnbox obj)) | ||
| else Null |
There was a problem hiding this comment.
I wonder if there's a better way to express this. I generally think of long conditionals as a code smell.
Not to mention you have essentially the same conditional in the WithTimeout variant below. Could the runtime type checks be be folded into the FromScheme interface implementation, so that you only need to call fromScheme here?
There was a problem hiding this comment.
Haven't changed this implementation, but am open to suggestions should there be a cleaner alternative.
I did however clean-up the duplicated decodeObj function that was present in where clauses in both channelGetNonBlocking and channelGetWithTimeout and moved it above.
| (begin | ||
| (sleep (make-time 'time-duration 1000000 0)) | ||
| (loop start-time))))))) | ||
|
|
There was a problem hiding this comment.
Someone familiar with scheme internals really needs to look this whole function over carefully.
There was a problem hiding this comment.
Yes, would definitely appreciate some additional eyes on this.
| import System | ||
| import System.Concurrency | ||
|
|
||
| -- Test that using channelGetNonBlocking works as expected. | ||
| main : IO () | ||
| main = do | ||
| chan <- makeChannel | ||
| threadID <- fork $ do | ||
| channelPut chan "Hello" | ||
| channelPut chan "Goodbye" | ||
| sleep 1 | ||
| case !(channelGetNonBlocking chan) of | ||
| Nothing => | ||
| putStrLn "Nothing" | ||
| Just val' => | ||
| putStrLn val' | ||
| case !(channelGetNonBlocking chan) of | ||
| Nothing => | ||
| putStrLn "Nothing" | ||
| Just val' => | ||
| putStrLn val' | ||
| sleep 1 | ||
|
|
There was a problem hiding this comment.
Formatting nits: don't need to split these cases over multiple lines.
Nothing => putStrLn "Nothing"
Just val => putStrLn val
This entire case statement can be collapsed to putStrLn $ fromMaybe "Nothing" !(channelGetNonBlocking chan)
or
putStrLn $ show !(channelGetNonBlocking chan), with the caveat that the output will be pretty-printed, but that's probably fine here so long as you adjust your expected values to match
| do c <- makeChannel | ||
| tids <- for [0..11] $ \n => fork $ producer c n | ||
| vals <- for [0..11] $ \_ => channelGetWithTimeout c 5 | ||
| ignore $ traverse (\t => threadWait t) tids |
There was a problem hiding this comment.
lambda is redundant here: ignore $ traverse threadWait tids
There was a problem hiding this comment.
Due to the 1 multiplicity on the threadID parameter of threadWait
threadWait : (1 threadID : ThreadID) -> IO ()
the original ignore $ traverse (\t => threadWait t) tids appears to be the correct way to do this, as ignore $ traverse threadWait tids throws:
Error: While processing right hand side of main. When unifying:
(1 _ : ThreadID) -> IO ()
and:
?a -> ?f ?b
Mismatch between: (1 _ : ThreadID) -> IO () and ?a -> ?f ?b.
| let vals' = map (\val => case val of | ||
| Nothing => | ||
| 0 | ||
| Just val' => | ||
| val' | ||
| ) vals | ||
| s = sum vals' |
There was a problem hiding this comment.
style nit:
lambda can be replaced with partial application of library routine, map with <$>.
sum $ fromMaybe 0 <$> vals
The whole thing can then be:
putStrLn $ sum $ fromMaybe 0 <$> vals
Adjust expected case to simply read 55.
Thank you for taking your time to look this over and provide feedback. |
Description
This PR adds a two new functions in
System.Concurrency,channelGetNonBlockingandchannelGetWithTimeout(only for thechezbackend).This PR closes #3424.
Should this change go in the CHANGELOG?
implementation, I have updated
CHANGELOG_NEXT.md(and potentially alsoCONTRIBUTORS.md).