15.4.942  src/lib/src/lib/thread-kit/src/lib/simple-rpc.pkg

## simple-rpc.pkg

# Compiled by:
#     src/lib/std/standard.lib

# Generators for simple RPC protocols.



###           "You don't have to burn books to destroy a culture.
###            Just get people to stop reading them."
###
###                                 -- Ray Bradbury



stipulate
    package tk  =  threadkit;                                                   # threadkit     is from   src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg
herein

    package   simple_rpc
    : (weak)  Simple_Rpc                                                        # Simple_Rpc    is from   src/lib/src/lib/thread-kit/src/lib/simple-rpc.api
    {
        include package   threadkit;                                            #

        Mailop(X)
            =
            tk::Mailop(X);

        fun call  request_queue  arg
            =
            {   reply_drop =  make_oneshot_maildrop ();
                #
                put_in_mailqueue (request_queue, (arg, reply_drop));

                get_from_oneshot  reply_drop;
            };

        fun make_rcp f
            =
            {   request_q =  make_mailqueue  (tk::default_microthread);
                #
                entry_mailop
                    =
                    take_from_mailqueue'  request_q
                        ==>
                        (\\ (arg, reply_drop) =  put_in_oneshot (reply_drop, f arg));

                { call => call request_q,
                  entry_mailop
                };
            };

        fun make_rcp_in f
            =
            {   request_q  =  make_mailqueue  (tk::default_microthread);
                req_mailop =  take_from_mailqueue'  request_q;

                fun entry_mailop  state
                    =
                    tk::if_then'                                                # "tk::if_then'" is the plain name for  tk::(==>).
                      (
                        req_mailop,

                        \\ (arg, reply_drop)
                            =
                            put_in_oneshot (reply_drop, f (arg, state))
                      );

                { call => call request_q,
                  entry_mailop
                };
            };

        fun make_rcp_out f
            =
            {   request_q  =  make_mailqueue  (tk::default_microthread);
                req_mailop =  take_from_mailqueue' request_q;

                entry_mailop
                    =
                    req_mailop
                        ==>
                       (\\ (arg, reply_drop)
                            =
                            {   (f arg) ->   (result, state');
                                #
                                put_in_oneshot (reply_drop, result);

                                state';
                            }
                       );

                  { call => call request_q,
                    entry_mailop
                  };
            };

        fun make_rcp_in_out f
            =
            {   request_q  =  make_mailqueue  (tk::default_microthread);
                req_mailop =  take_from_mailqueue'  request_q;

                fun entry_mailop  state
                    =
                    req_mailop
                        ==>
                       (\\ (arg, reply_drop)
                            =
                            {  (f (arg, state)) ->   (result, state');
                                #
                                put_in_oneshot (reply_drop, result);

                                state';
                            });

                { call => call request_q,
                  entry_mailop
                };
            };

    };
end;

## COPYRIGHT (c) 1997 AT&T Labs Research.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.