package ClientServer(
        Client(..), Server(..), ClientServer(..), mkRequestResponseBuffer,
        mkSizedRequestResponseBuffer, mkResponseBuffer, mkRequestBuffer,
        mkRequestResponseBuffer1, joinServersBC, joinServers, splitServer,
        fifosToServer, fifosToClient, fifosToClientServer,
        toGPClient, toGPServer)
    where
import qualified Vector
import List
import FIFO
import Counter
import Connectable
import GetPut
import Clocks

--@ \subsubsection{ClientServer}
--@ \index{ClientServer@\te{ClientServer} (package)|textbf}
--@
--@ The interfaces \te{Client} and \te{Server} can be used for
--@ modules that have a request-response type of interface
--@ (e.g. a RAM).
--@ The server accepts requests and generates responses, and
--@ vice versa for the client.
--@ There are no assumptions about how many (if any) responses
--@ a request will generate.

--@ \index{Client@\te{Client} (interface)|textbf}
--@ \begin{libverbatim}
--@ interface Client #(type a, type b);
--@     interface Get#(a) request();
--@     interface Put#(b) response();
--@ endinterface: Client
--@ \end{libverbatim}
interface Client a b =
    request  :: Get a
    response :: Put b

--@ \index{Server@\te{Server} (interface)|textbf}
--@ \begin{libverbatim}
--@ interface Server #(type a, type b);
--@     interface Put#(a) request();
--@     interface Get#(b) response();
--@ endinterface: Server
--@ \end{libverbatim}
interface Server a b =
    request  :: Put a
    response :: Get b

--@ A \te{Client} can be connected to a \te{Server}
--@ and vice versa.
--@ \begin{libverbatim}
--@ instance Connectable #(Client#(a, b), Server#(a, b));
--@ instance Connectable #(Server#(a, b), Client#(a, b));
--@ \end{libverbatim}
instance Connectable (Client a b) (Server a b)
   where
    mkConnection :: (IsModule m c ) => Client a b -> Server a b -> m Empty
    mkConnection c s =
       module
          rules
            "ClientServerRequest":when True
             ==> action
                    x :: a <- c.request.get
                    s.request.put x
            "ClientServerResponse":when True
             ==> action
                    x :: b <- s.response.get
                    c.response.put x

instance Connectable (Server a b) (Client a b)
   where
    mkConnection s c = mkConnection c s

instance (Bits a sa, Bits b sb) => ClockConv (Client a b) where
    mkConverter :: (Prelude.IsModule m c) => Integer -> Client a b -> m (Client a b)
    mkConverter d cluses =
        module
            req  <- mkConverter d cluses.request
            resp <- mkConverter d cluses.response

            interface
              request  = req
              response = resp

instance (Bits a sa, Bits b sb) => ClockConv (Server a b) where
    mkConverter :: (Prelude.IsModule m c) => Integer -> Server a b -> m (Server a b)
    mkConverter d cluses =
        module
            req  <- mkConverter d cluses.request
            resp <- mkConverter d cluses.response

            interface
              request  = req
              response = resp

--@ \lineup
--@ \begin{libverbatim}
--@ typedef Tuple2 #(Client#(a, b), Server#(a, b)) ClientServer #(type a, type b);
--@ \end{libverbatim}
type ClientServer a b = (Client a b, Server a b)

--@ Create a buffer that just passes requests and responses between the
--@ two generated interfaces.
--@ \index{mkRequestResponseBuffer@\te{mkRequestResponseBuffer} (function)|textbf}
--@ \begin{libverbatim}
--@ module mkRequestResponseBuffer(ClientServer#(a, b))
--@   provisos (Bits#(a, sa), Bits#(b, sb));
--@ \end{libverbatim}
mkRequestResponseBuffer :: (IsModule m c , Bits a sa, Bits b sb) => m (ClientServer a b)
mkRequestResponseBuffer =
    module
        (qget, qput) :: (Get a, Put a) <- mkGetPut
        (sget, sput) :: (Get b, Put b) <- mkGetPut
        let c = interface Client
                    request  = qget
                    response = sput
            s = interface Server
                    request  = qput
                    response = sget
        interface (c, s)

--@ Create a buffer that just passes requests and responses between the
--@ two generated interfaces.  Uses half the flops of
--@ \te{mkRequestResponseBuffer}, but also has half the throughput.
--@ \index{mkRequestResponseBuffer1@\te{mkRequestResponseBuffer1} (function)|textbf}
--@ \begin{libverbatim}
--@ module mkRequestResponseBuffer1(ClientServer#(a, b))
--@   provisos (Bits#(a, sa), Bits#(b, sb));
--@ \end{libverbatim}
mkRequestResponseBuffer1 :: (IsModule m c , Bits a sa, Bits b sb) => m (ClientServer a b)
mkRequestResponseBuffer1 =
    module
        (qget, qput) :: (Get a, Put a) <- mkGPFIFO1
        (sget, sput) :: (Get b, Put b) <- mkGPFIFO1
        let c = interface Client
                    request  = qget
                    response = sput
            s = interface Server
                    request  = qput
                    response = sget
        interface (c, s)

--@ The same, using sized FIFOs.
--@ \index{mkSizedRequestResponseBuffer@\te{mkSizedRequestResponseBuffer} (function)|textbf}
--@ \begin{libverbatim}
--@ module mkSizedRequestResponseBuffer#(Integer sz)(ClientServer#(a, b))
--@   provisos (Bits#(a, sa), Bits#(b, sb));
--@ \end{libverbatim}
mkSizedRequestResponseBuffer :: (IsModule m c , Bits a sa, Bits b sb) => Integer -> m (ClientServer a b)
mkSizedRequestResponseBuffer sz =
    module
        (qget, qput) :: (Get a, Put a) <- mkGPSizedFIFO sz
        (sget, sput) :: (Get b, Put b) <- mkGPSizedFIFO sz
        let c = interface Client
                    request  = qget
                    response = sput
            s = interface Server
                    request  = qput
                    response = sget
        interface (c, s)


--@ Create a new server with buffered requests.
--@ \index{mkRequestBuffer@\te{mkRequestBuffer} (function)|textbf}
--@ \begin{libverbatim}
--@ module mkRequestBuffer#(Server#(a, b) s)(Server#(a, b))
--@   provisos (Bits#(a, sa));
--@ \end{libverbatim}
mkRequestBuffer :: (IsModule m c , Bits a sa) => Server a b -> m (Server a b)
mkRequestBuffer s =
    module
        (qget, qput) :: (Get a, Put a) <- mkGetPut
        rules
              "mkRequestBuffer" : when True ==>
                 action
                   x :: a <- qget.get
                   s.request.put x

        interface -- Server
                    request  = qput
                    response = s.response


--@ Create a new server with buffered responses.
--@ \index{mkResponseBuffer@\te{mkResponseBuffer} (function)|textbf}
--@ \begin{libverbatim}
--@ module mkResponseBuffer#(Server#(a, b) s)(Server#(a, b))
--@   provisos (Bits#(b, sb));
--@ \end{libverbatim}
mkResponseBuffer :: (IsModule m c , Bits b sb) => Server a b -> m (Server a b)
mkResponseBuffer s =
    module
        (sget, sput) :: (Get b, Put b) <- mkGetPut
        rules
              "mkResponseBuffer" : when True ==>
                 action
                   x :: b <- s.response.get
                   sput.put x

        interface -- Server
                    request  = s.request
                    response = sget

--@ Join a list of servers to one server.  All incoming requests are broadcasted
--@ all the servers and all responses are merged.
--@ The function introduces a one cycle latency on the response.
--@ \index{joinServersBC@\te{joinServersBC} (function)|textbf}
--@ \begin{libverbatim}
--@ module joinServersBC#(List#(Server#(a, b)) ifs)(Server#(a, b))
--@   provisos (Bits#(b, sb));
--@ \end{libverbatim}
joinServersBC :: (IsModule m c , Bits b sb) => List (Server a b) -> m (Server a b)
joinServersBC ifs =
  module
    (sget, sput) :: (Get b, Put b) <- mkGetPut
    let rl s =
            rules
              "joinServersBC":
                when True ==>
                 action
                   x <- (s :: Server a b).response.get
                   sput.put x
    addRules $ foldr (<+>) (rules {}) (map rl ifs)
    interface -- Server
            request =
             interface Put
              put req = joinActions (map (\ i -> (i :: Server a b).request.put req) ifs)
            response = sget

--@ Join a list of servers to one server.  All incoming requests are sent to
--@ a selected subset of the servers and all responses are merged.
--@ The selection is my a function that can transform the request type
--@ while testing if it should be sent on.
--@ The function introduces a one cycle latency on the response.
--@ \index{joinServers@\te{joinServers} (function)|textbf}
--@ \begin{libverbatim}
--@ module joinServers#( List#(Tuple2 #(a -> Maybe#(a'),
--@                      Server#(a', b))) ifs)(Server#(a, b))
--@   provisos (Bits#(b, sb));
--@ \end{libverbatim}
joinServers ::  (IsModule m c , Bits b sb) => List (a -> Maybe a', Server a' b) -> m (Server a b)
joinServers ifs =
  module
    (sget, sput) :: (Get b, Put b) <- mkGetPut
    let rl (_, s) =
            rules
              "joinServers":
                when True ==>
                  action
                   x <- (s :: Server a' b).response.get
                   sput.put x
        send req (f, s) =
            case f req of
            Nothing -> noAction
            Just req' -> (s :: Server a' b).request.put req'
    addRules $ foldr (<+>) (rules {}) (map rl ifs)
    interface -- Server
            request =
             interface Put
              put req = joinActions (map (send req) ifs)
            response = sget

type MaxLat = 8        -- XXX This is just wrong
--@ Split a server into a number of identical servers.
--@ The integer argument specifies how many outstanding requests
--@ a returned server may have.  This number should be
--@ the latency of the argument server to sustain full bandwidth.
--@ (A small number still works, as does a larger number.)
--@ \index{splitServer@\te{splitServer} (function)|textbf}
--@ \begin{libverbatim}
--@ module splitServer#(Integer lat, Server#(a, b) serv)(Vector#(n, Server#(a, b)))
--@   provisos (Bits#(b, sb), Log#(n, ln));
--@ \end{libverbatim}
splitServer :: (IsModule m c , Bits b sb, Log n ln) =>
               Integer -> Server a b -> m (Vector.Vector n (Server a b))
splitServer lat serv =
  module
    tags :: FIFO (Bit ln) <- mkSizedFIFO lat
    let mkServ :: (Bit ln) -> m (Server a b)
        mkServ i =
          module
            out :: FIFO b <- mkSizedFIFO lat
            cnt :: Counter MaxLat <- mkCounter (fromInteger lat)
            rules
                when tags.first == i
                 ==> action
                        tags.deq
                        x <- serv.response.get
                        out.enq x
            interface Server
              request =
                interface Put
                  put req =
                        action
                            serv.request.put req
                            tags.enq i
                            cnt.down
                    when cnt.value > 0
              response =
                interface Get
                  get = do
                            out.deq
                            cnt.up
                            return out.first
    Vector.mapM (mkServ · fromInteger) Vector.genList

--@ fifosToServer

fifosToServer :: FIFO rq -> FIFO rs -> Server rq rs
fifosToServer rqf rsf =
    interface Server
       request  = fifoToPut rqf
       response = fifoToGet rsf

fifosToClient :: FIFO rq -> FIFO rs -> Client rq rs
fifosToClient rqf rsf =
    interface Client
       request  = fifoToGet rqf
       response = fifoToPut rsf

fifosToClientServer :: FIFO rq -> FIFO rs -> ClientServer rq rs
fifosToClientServer rqf rsf = (fifosToClient rqf rsf, fifosToServer rqf rsf)

-- toGPClient, toGPServer

toGPClient :: (ToGet rq_ifc rq, ToPut rs_ifc rs) =>
              rq_ifc -> rs_ifc -> Client rq rs
toGPClient rqi rsi =
    interface Client
        request = toGet rqi
        response = toPut rsi

toGPServer :: (ToPut rq_ifc rq, ToGet rs_ifc rs) =>
              rq_ifc -> rs_ifc -> Server rq rs
toGPServer rqi rsi =
    interface Server
        request = toPut rqi
        response = toGet rsi