On Wed, 07 Jan 2004 22:48:51 +0900, shelarcy 
<shelarcy / capella.freemail.ne.jp> wrote:
> この間から SML のプログラムの移植に取り組んでいるのですが、これ
> まで Network Programming をした事がないこともあってか、API 間の
> 溝の大きさに行き詰まってしまいました。
>
> 何か良いアドバイスがありましたら、御教示の程宜しくお願いします。

すみません、漠然としすぎていました。

Network Programming の経験がなかったための勘違いもありました。
そんなに溝はありませんでした。


Socket.bind (mySock, INetSock.any port)
bindSocket mySock (SockAddrInet port iNADDR_ANY)

間で any の使い方が違うのに気がつき損ねたりしますが……。


残りの問題は……

ML の option は Haskell の Maybe と違って値を与えないで良いみたいです
が、これをどう表現すればいいのかということ。

Impilicit Parameter が良いかと思っているのですが、ドキュメントの例では
良く分かりません。どなたか御教示お願いできませんでしょうか?


http://www.dina.dk/~sestoft/mosmllib/Option.html

Matching
--SML---------------------------------+--ML------------------------------------
  fun getOpt(NONE, d) = d              | let getOpt = function
    | getOpt (SOME x, _) = x;          |     (NONE, d) -> d
                                       |   | (SOME x, _) -> x;;
--------------------------------------+----------------------------------------
  fun getOpt(opt, d) =                 | let getOpt(opt, d) =
    case opt                           |   match opt
      of NONE => d                     |     with NONE -> d
       | SOME x => x;                  |        | SOME x -> x;;
--------------------------------------+----------------------------------------
  <Guards does not exist>              | let rec fac = function
                                       |     n when n > 0 -> n * fac(n - 1)
                                       |   | _ -> raise Hell;;
=====================================================================


> fun spawnNetServer (myPort, startId, tsMb, addTS) = let
>        val mySock = INetSock.TCP.socket()
>        fun loop nextId = let
>              val (newSock, addr) = Socket.accept mySock
>              val proxyConn = spawnBuffers (nextId, newSock, tsMb)
>              val (host, port) = INetSock.fromAddr addr
>              val name = (case NetHostDB.getByAddr host
>                     of (SOME ent) => NetHostDB.name ent
>                     | NONE => "??"
>                     (* end case *))
>              in
>                addTS {name = name, id = nextId, conn = proxyConn};
>                loop (nextId + 1)
>              end
>        val port = getOpt(myPort, 7001)
>        in
>          Socket.bind (mySock, INetSock.any port);
>          Socket.listen (mySock, 5);
>          spawn (fn () => loop startId);
>          NETWORK{shutdown = SyncVar.iVar()}
>        end



spawn を作らなければいけないのは…… GHC にしか thread 生成
がないようなので考え中です。


>      val shutdown : network -> unit

shutdown って Haskell にはあるから楽勝だなと思っていたら、SML INet
にもあるようなので、「読者への宿題として残す」と書いてあったのは本
当にやらないといかないみたい、っていうのもありますが、それは置いて
おきます。


--TsId
type TupleServerId = Int
--data Reply = InReply { transId :: Int, vals :: [ValAtom] }
data Reply = InReply { tranId :: Int, vals :: [ValAtom] }

--type Out = Msg.Message -> IO ()
--type ReplyIO = Reply -> IO ()
--type ReplyIO = Chan Msg.Message -> Msg.Message -> IO()
type ReplyIO = Msg.Message -> IO ()

{-
data ClientReq
   = OutTuple Tuple
   | InReq   { from :: TupleServerId, transId :: Int, remove :: Bool,
               pat :: Template, reply :: Reply}
   | Accept  { from :: TupleServerId, transId :: Int}
   | Cancel  { from :: TupleServerId, transId :: Int}
-}
data ClientReq
   = OutTuple Tuple
   | InReq   { from :: TupleServerId, transId :: Int, remove :: Bool,
               pat :: Template, reply :: ReplyIO}
   | Accept  { from :: TupleServerId, transId :: Int}
   | Cancel  { from :: TupleServerId, transId :: Int}


--data ReqReply = Reply | ClientReq

--data ServerConn = Conn { out :: Message, replyEvt :: (Reply, Event)}
--data ServerConn = Conn { out :: Msg.Message, replyEvent :: Reply}
type MessageIO = Msg.Message -> IO ()
data ServerConn = Conn { out :: MessageIO, replyEvent :: Reply}

data RemoteServerInfo
   = RSI { name :: String, tsId :: TupleServerId, conn :: ServerConn }


parseHost :: String -> IO HostAddress
parseHost str =
    case str == ""  of
      True -> error "bad hostname format"
      False -> inet_addr str

-- localhost 127.0.0.1
--spawnNetServer (myPort, startId, tsMb, addTS) =
spawnNetServer :: PortNumber -> TupleServerId -> Chan ClientReq -> 
ServerConn -> IO ShutdownCmd
spawnNetServer myPort startId tsMb addTS =
     do {
         protoNum <- getProtocolNumber "tcp";
         mySock <- mkSocket 23 AF_INET Datagram protoNum NotConnected;
         bindSocket mySock (SockAddrInet port iNADDR_ANY);
         listen mySock 5;
         --spawn (fn () => loop startId);
         loop startId mySock;
         --NETWORK{shutdown = SyncVar.iVar()}
         return ShutdownBoth -- ShutdownReceive?	ShutdownSend?
     }
     where
         loop nextId mySock = let
           --val (host, port) = INetSock.fromAddr addr
           --(host, port) = SockAddrInet port host
           getSockAddrHost (SockAddrInet _ host) = do {return host}
           in
             do{
                 (newSock, addr) <- accept mySock; -- Network.Socket's 
accept
                 proxyConn <- spawnBuffers nextId newSock tsMb;
                 host <- getSockAddrHost addr;
                 hostName <- inet_ntoa host;
                 --addTS {name = hostName, id = nextId, conn = proxyConn};
                 return RSI {name = hostName, tsId = nextId, conn = 
proxyConn};
                 loop (nextId + 1) mySock }
         --port = getOpt(myPort, 7001)
         port = myPort


--spawn f
--creates a new thread of control to evaluate the body of f. A new unique 
ID for the thread is created and returned.


-- Chan is FIFO, but Chan doesn't block only read data
spawnBuffers :: TupleServerId -> Socket -> Chan ClientReq -> IO ServerConn
spawnBuffers id sock tsMb = let
     outLoop outMb =
       do { -- Lock until recv Message
            sockdata <- readChan outMb;
            Msg.sendMessage sock sockdata;
            outLoop outMb}
     dispatchMessage inMb outMb recvMess =
         case recvMess  of
           Msg.OutTuple t -> writeChan tsMb (OutTuple t)
           Msg.InReq {Msg.transId= x, Msg.pat = y} ->
               -- To use reply here?
               {-
               do {reply outMb Msg.InReq {Msg.transId= x, Msg.pat = 
(TupleRep y)};
                   writeChan tsMb
                      InReq {from=id, transId=x, remove=True, pat=(TupleRep 
y),
                             reply=InReply { tranId =x, vals=patToVals y} }}
               -}
               --reply=reply r
               writeChan tsMb
                      InReq {from=id, transId=x, remove=True, pat=y,
                             reply=inReply }
           Msg.RdReq {Msg.transId = x, Msg.pat = y} ->
               writeChan tsMb
                      InReq {from=id, transId=x, remove=False, pat=y,
                             reply=inReply }
           Msg.Accept {Msg.transId = x} ->
               writeChan tsMb Accept {from=id, transId=x}
           Msg.Cancel{Msg.transId = x} ->
               writeChan tsMb Cancel {from=id, transId=x}
           Msg.InReply {Msg.transId = x, Msg.vals = y} ->
               writeChan inMb InReply { tranId =x, vals = y}
           where
               --reply r = Mailbox.send (outMb, Msg.InReply r)
               inReply r = writeChan outMb r
     inLoop inMb outMb  =
       do {recvMess <- Msg.recvMessage sock;
           --dispatchMessage recvMess;
           dispatchMessage inMb outMb recvMess;
           inLoop inMb outMb}
     --outque outMb = \ req -> writeChan outMb req
     in
       do {
           outMb <- newChan;
           inMb <- newChan;
           --spawn outLoop; spawn inLoop;
           outLoop outMb; inLoop inMb outMb;
           --connout <- readChan outMb;
           repevt <- readChan inMb;
           return
             Conn {
             --out = connout,
             out = \ req -> writeChan outMb req,
             replyEvent = repevt
            }

        }


--initNetwork :: PortNumber -> [String] -> Chan ClientReq -> ServerConn -> 
IO (TupleServerId, ShutdownCmd, [RemoteServerInfo])
initNetwork :: PortNumber -> [String] -> Chan ClientReq -> ServerConn -> 
IO (TupleServerId, IO ShutdownCmd, [RemoteServerInfo])
initNetwork port remote tsReqMb addTS = let
       hosts = map parseHost remote
       startId = length hosts + 1
       network = spawnNetServer port startId tsReqMb addTS
       --mkServer ((host, port), (id, l)) = do
       mkServer (id, l) host = do
           protoNum <- getProtocolNumber "tcp"
           sock <- mkSocket 23 AF_INET Datagram protoNum NotConnected
           connect sock (SockAddrInet port host)
           conn <-  spawnBuffers id sock tsReqMb
           hostName <- inet_ntoa host
           --return (id+1, {name = host, id = id, conn =conn}::l)
           return (id+1, l ++ [RSI {name = hostName, tsId = id, conn = 
conn}])
       myId = 0
       in do
           -- Dosen't mapM count length?
           hostse <- mapM parseHost remote
           server <- liftM snd (foldM  mkServer (1, []) hostse)
           return
             ( myId, network,
               -- #n is label of fieild's nth value
               -- ML for the Working Progarammar p35
               --server = #2 (List.foldl mkServer (1, []) hosts)
               server )


-- 
shelarcy <shelarcy / capella.freemail.ne.jp>
http://page.freett.com/shelarcy/ 

--
ML: haskell-jp / quickml.com
使い方: http://QuickML.com/