Skip to content
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

Open
wants to merge 50 commits into
base: main
Choose a base branch
from

Conversation

Matthew-Mosior
Copy link
Contributor

@Matthew-Mosior Matthew-Mosior commented Dec 4, 2024

Description

This PR adds a two new functions in System.Concurrency, channelGetNonBlocking and channelGetWithTimeout (only for the chez backend).

This PR closes #3424.

Should this change go in the CHANGELOG?

  • If this is a fix, user-facing change, a compiler change, or a new paper
    implementation, I have updated CHANGELOG_NEXT.md (and potentially also
    CONTRIBUTORS.md).

…g with return values of blodwen-channel-get-non-blocking.
@Matthew-Mosior Matthew-Mosior changed the title [ lib] Add Non-Blocking and Timeout variants for channelGet [ lib ] Add Non-Blocking and Timeout variants for channelGet Dec 4, 2024
@Matthew-Mosior Matthew-Mosior changed the title [ lib ] Add Non-Blocking and Timeout variants for channelGet [ libs ] Add Non-Blocking and Timeout variants for channelGet Dec 4, 2024
@Matthew-Mosior Matthew-Mosior changed the title [ libs ] Add Non-Blocking and Timeout variants for channelGet [ base ] Add Non-Blocking and Timeout variants for channelGet Dec 4, 2024
@Matthew-Mosior Matthew-Mosior changed the title [ base ] Add Non-Blocking and Timeout variants for channelGet [ base ] Add non-blocking and timeout variants for channelGet Dec 4, 2024
Copy link

@emdash emdash left a 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.

Comment on lines 184 to 194
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
Copy link

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
 ...


Copy link
Contributor Author

@Matthew-Mosior Matthew-Mosior Dec 5, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@emdash

This was addressed via 970ace4.

Procedure : ChannelObj -> ChannelSchemeObj

export
interface Scheme a where
Copy link

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.

Copy link
Contributor Author

@Matthew-Mosior Matthew-Mosior Dec 5, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@emdash

This was addressed via 970ace4.

Comment on lines 377 to 388
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
Copy link

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?

Copy link
Contributor Author

@Matthew-Mosior Matthew-Mosior Dec 5, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@emdash

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)))))))

Copy link

@emdash emdash Dec 4, 2024

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.

Copy link
Contributor Author

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.

Comment on lines 1 to 23
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

Copy link

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

Copy link
Contributor Author

@Matthew-Mosior Matthew-Mosior Dec 5, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@emdash

This was addressed via 6a5129f.

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
Copy link

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

Copy link
Contributor Author

@Matthew-Mosior Matthew-Mosior Dec 5, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@emdash

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.

Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I stand corrected.

Comment on lines 21 to 27
let vals' = map (\val => case val of
Nothing =>
0
Just val' =>
val'
) vals
s = sum vals'
Copy link

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.

Copy link
Contributor Author

@Matthew-Mosior Matthew-Mosior Dec 5, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@emdash

This was addressed via 6a5129f.

@Matthew-Mosior
Copy link
Contributor Author

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.

Thank you for taking your time to look this over and provide feedback.

Comment on lines +251 to +253
export
interface FromScheme a where
fromScheme : ChannelSchemeObj -> Maybe a
Copy link

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.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
None yet
Projects
None yet
Development

Successfully merging this pull request may close these issues.

System.Concurrency.channelGet is hard to use and too coupled into scheme support code
2 participants