-
Notifications
You must be signed in to change notification settings - Fork 380
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
[ base ] Add non-blocking and timeout variants for channelGet #3435
base: main
Are you sure you want to change the base?
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.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
I'm not really a member of this project, so I can't approve it, but I'll at least provide some initial feedback.
Hopefully this will get some other folks to chime in.
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.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Minor nit: since this type isn't indexed, it could be converted to the simpler data
syntax.
data ChannelSchemeObj
= Null
| Cons ChannelSchemeObj ChanelSchemeObj
...
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
libs/base/System/Concurrency.idr
Outdated
Procedure : ChannelObj -> ChannelSchemeObj | ||
|
||
export | ||
interface Scheme a where |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
nit: rename the interface to FromScheme
, for consistency with FromString
, FromInteger
, etc.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
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.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
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.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
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.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Someone familiar with scheme internals really needs to look this whole function over carefully.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
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.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
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
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
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.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
lambda is redundant here: ignore $ traverse threadWait tids
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
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.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
I stand corrected.
let vals' = map (\val => case val of | ||
Nothing => | ||
0 | ||
Just val' => | ||
val' | ||
) vals | ||
s = sum vals' |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
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
.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Thank you for taking your time to look this over and provide feedback. |
export | ||
interface FromScheme a where | ||
fromScheme : ChannelSchemeObj -> Maybe a |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
After thinking about it some more, I'm not totally clear on the ChannelSchemeObj
type even being necessary.
You can factor the common logic into a function, like this:
marshal
: (pred : ChannelObj -> Int)
-> (unsafeGet : ChannelObj -> a)
-> ChannelObj
-> Maybe a
marshal pred get obj = case pred obj of
1 => Just $ unsafeGet obj
_ => Nothing
Now, you can adjust the FromScheme
interface like this:
interface FromScheme a where
fromScheme : ChannelObj -> Maybe a
FromScheme Integer where
fromScheme = marshal prim_isInteger unsafeGetInteger
...
FromScheme Nat where
fromScheme = marshal prim_isInteger (integerToNat . unsafeGetInteger)
...
FromScheme a => FromScheme (List a) where
fromScheme obj = case prim_isNil == 1 of
True => Just []
False => case prim_isPair == 1 of
False => Nothing
True => ...
After going through is exercise, I am starting to wonder if this machinery is already present elsewhere in the compiler.
Description
This PR adds a two new functions in
System.Concurrency
,channelGetNonBlocking
andchannelGetWithTimeout
(only for thechez
backend).This PR closes #3424.
Should this change go in the CHANGELOG?
implementation, I have updated
CHANGELOG_NEXT.md
(and potentially alsoCONTRIBUTORS.md
).