Verified Commit 0987b0f8 authored by Camil Staps's avatar Camil Staps
Browse files

Use strict maybe types in TCPIP library

parent db2c7cb1
......@@ -7,7 +7,6 @@ definition module ostcp
// Modified: 15 October 2001 for Clean 2.0 (Peter Achten)
// ********************************************************************************
import StdMaybe
import TCPDef
from TCPChannelClass import :: Timeout
import tcp
......@@ -27,5 +26,5 @@ os_connectTCP_sync :: !Int !(!Bool,!Int) !(!Int,!Int) !*env
// not block: (referencecount=1, hasSNotif=False, hasRNotif=True)
// if timeout or error occurs, then resources (endpoint and dictionary entry) will be removed
getMbStopTime :: !(Maybe Timeout) !*env -> (!(!Bool, !Int), !*env) | ChannelEnv env
getMbStopTime :: !(?Timeout) !*env -> (!(!Bool, !Int), !*env) | ChannelEnv env
tcp_getcurrenttick :: !*World -> (!Int, !*World)
implementation module ostcp
import StdInt, StdTuple
import StdMaybe
import TCPDef,TCPChannelClass
import tcp
......@@ -91,10 +90,10 @@ os_connectTCP_sync32 onlyForMac time addr e
ccall os_connectTCP_syncC "IIIII:VIII:A"
}
getMbStopTime :: !(Maybe Timeout) !*env -> (!(!Bool, !Int), !*env) | ChannelEnv env
getMbStopTime Nothing env
getMbStopTime :: !(?Timeout) !*env -> (!(!Bool, !Int), !*env) | ChannelEnv env
getMbStopTime ?None env
=((False,0), env)
getMbStopTime (Just timeout) env
getMbStopTime (?Just timeout) env
# (now, env) = channel_env_get_current_tick env
= ((True, timeout + now), env)
......
......@@ -8,7 +8,6 @@ definition module TCPChannelClass
// Modified: 15 October 2001 for Clean 2.0 (Peter Achten)
// ********************************************************************************
from StdMaybe import :: Maybe
from StdOverloaded import class toString, class ==
from tcp import class ChannelEnv
......@@ -19,11 +18,11 @@ instance ChannelEnv World
// ********************************************************************************
class Receive ch where
receive_MT :: !(Maybe Timeout) !*(ch .a) !*env
-> (!TimeoutReport, !Maybe .a, !*(ch .a), !*env)
receive_MT :: !(?Timeout) !*(ch .a) !*env
-> (!TimeoutReport, !? .a, !*(ch .a), !*env)
| ChannelEnv env
receiveUpTo :: !Int !*(ch .a) !*env
-> (![.a], !*(ch .a), !*env)
receiveUpTo :: !Int !*(ch .a) !*env
-> (![.a], !*(ch .a), !*env)
| ChannelEnv env
available :: !*(ch .a) !*env
-> (!Bool, !*(ch .a), !*env)
......@@ -54,24 +53,24 @@ class closeRChannel ch :: !*(ch .a) !*env -> *env | ChannelEnv env
// ********************************************************************************
class Send ch where
send_MT :: !(Maybe Timeout) !.a !*(ch .a) !*env
send_MT :: !(?Timeout) !.a !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*(ch .a), !*env)
| ChannelEnv env
nsend_MT :: !(Maybe Timeout) ![.a] !*(ch .a) !*env
| ChannelEnv env
nsend_MT :: !(?Timeout) ![.a] !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*(ch .a), !*env)
| ChannelEnv env
flushBuffer_MT :: !(Maybe Timeout) !*(ch .a) !*env
| ChannelEnv env
flushBuffer_MT :: !(?Timeout) !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*(ch .a), !*env)
| ChannelEnv env
closeChannel_MT :: !(Maybe Timeout) !*(ch .a) !*env
| ChannelEnv env
closeChannel_MT :: !(?Timeout) !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*env)
| ChannelEnv env
| ChannelEnv env
abortConnection :: !*(ch .a) !*env
-> *env
| ChannelEnv env
| ChannelEnv env
disconnected :: !*(ch .a) !*env
-> (!Bool, !*(ch .a), !*env)
| ChannelEnv env
| ChannelEnv env
bufferSize :: !*(ch .a)
-> (!Int, !*(ch .a))
/* send_MT mbTimeout a ch env
......@@ -129,7 +128,7 @@ instance toString TimeoutReport
// derived functions
// ********************************************************************************
nreceive_MT :: !(Maybe Timeout) !Int !*(ch .a) !*env
nreceive_MT :: !(?Timeout) !Int !*(ch .a) !*env
-> (!TimeoutReport, ![.a],!*(ch .a),!*env)
| Receive ch & ChannelEnv env
/* nreceive_MT mbTimeout n ch env
......
......@@ -17,11 +17,11 @@ instance ChannelEnv World
///////////////////////////////// receive channels /////////////////////////////////
class Receive ch where
receive_MT :: !(Maybe Timeout) !*(ch .a) !*env
-> (!TimeoutReport, !Maybe .a, !*(ch .a), !*env)
receive_MT :: !(?Timeout) !*(ch .a) !*env
-> (!TimeoutReport, !? .a, !*(ch .a), !*env)
| ChannelEnv env
receiveUpTo :: !Int !*(ch .a) !*env
-> (![.a], !*(ch .a), !*env)
receiveUpTo :: !Int !*(ch .a) !*env
-> (![.a], !*(ch .a), !*env)
| ChannelEnv env
available :: !*(ch .a) !*env
-> (!Bool, !*(ch .a), !*env)
......@@ -36,26 +36,26 @@ class closeRChannel ch :: !*(ch .a) !*env -> *env | ChannelEnv env
class Send ch
where
send_MT :: !(Maybe Timeout) !.a !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*(ch .a), !*env)
| ChannelEnv env
nsend_MT :: !(Maybe Timeout) ![.a] !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*(ch .a), !*env)
| ChannelEnv env
flushBuffer_MT :: !(Maybe Timeout) !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*(ch .a), !*env)
| ChannelEnv env
closeChannel_MT :: !(Maybe Timeout) !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*env)
| ChannelEnv env
abortConnection :: !*(ch .a) !*env
-> *env
| ChannelEnv env
disconnected :: !*(ch .a) !*env
-> (!Bool, !*(ch .a), !*env)
| ChannelEnv env
bufferSize :: !*(ch .a)
-> (!Int, !*(ch .a))
send_MT :: !(?Timeout) !.a !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*(ch .a), !*env)
| ChannelEnv env
nsend_MT :: !(?Timeout) ![.a] !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*(ch .a), !*env)
| ChannelEnv env
flushBuffer_MT :: !(?Timeout) !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*(ch .a), !*env)
| ChannelEnv env
closeChannel_MT :: !(?Timeout) !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*env)
| ChannelEnv env
abortConnection :: !*(ch .a) !*env
-> *env
| ChannelEnv env
disconnected :: !*(ch .a) !*env
-> (!Bool, !*(ch .a), !*env)
| ChannelEnv env
bufferSize :: !*(ch .a)
-> (!Int, !*(ch .a))
class MaxSize ch
where
......@@ -92,9 +92,9 @@ instance toString TimeoutReport
/////////////////// derived functions ////////////////////////////////////////////////////
nreceive_MT :: !(Maybe Timeout) !Int !*(ch .a) !*env
-> (!TimeoutReport, ![.a], !*(ch .a), !*env)
| Receive ch & ChannelEnv env
nreceive_MT :: !(?Timeout) !Int !*(ch .a) !*env
-> (!TimeoutReport, ![.a], !*(ch .a), !*env)
| Receive ch & ChannelEnv env
nreceive_MT mbTimeout n ch env
// #! (before, env) = getCurrentTick env
#! (before, env) = channel_env_get_current_tick env
......@@ -112,8 +112,8 @@ nreceive_MT mbTimeout n ch env
// = nreceive_MT (mbSubtract mbTimeout (tickDifference after before)) (n-length-1) ch env
= nreceive_MT (mbSubtract mbTimeout (after-before)) (n-length-1) ch env
where
mbSubtract Nothing _ = Nothing
mbSubtract (Just timeout) i = Just (timeout-i)
mbSubtract ?None _ = ?None
mbSubtract (?Just timeout) i = ?Just (timeout-i)
u_reverse::![.a] -> [.a]
u_reverse list = reverse_ list []
......@@ -134,7 +134,7 @@ u_length l
receive :: !*(ch .a) !*env -> (!.a, !*(ch .a), !*env)
| ChannelEnv env & Receive ch
receive ch env
#! (timeoutReport, mbMessage, ch, env) = receive_MT Nothing ch env
#! (timeoutReport, mbMessage, ch, env) = receive_MT ?None ch env
| timeoutReport==TR_NoSuccess
#! (isEom, ch, env) = eom ch env
| isEom
......@@ -145,7 +145,7 @@ receive ch env
nreceive :: !Int !*(ch .a) !*env -> (![.a], !*(ch .a), !*env)
| ChannelEnv env & Receive ch
nreceive n ch env
#! (timeoutReport, l, ch, env) = nreceive_MT Nothing n ch env
#! (timeoutReport, l, ch, env) = nreceive_MT ?None n ch env
| timeoutReport==TR_NoSuccess
#! (isEom, ch, env) = eom ch env
| isEom
......@@ -156,29 +156,29 @@ nreceive n ch env
send :: !.a !*(ch .a) !*env -> (!*(ch .a), !*env)
| ChannelEnv env & Send ch
send msg ch env
#! (_,_,ch,env) = send_MT Nothing msg ch env
#! (_,_,ch,env) = send_MT ?None msg ch env
= (ch, env)
closeChannel:: !*(ch .a) !*env -> *env | ChannelEnv env & Send ch
closeChannel ch env
#! (_,_,env) = closeChannel_MT Nothing ch env
#! (_,_,env) = closeChannel_MT ?None ch env
= env
nsend :: ![.a] !*(ch .a) !*env
-> (!*(ch .a), !*env) | ChannelEnv env & Send ch
nsend msg ch env
#! (_,_,ch,env) = nsend_MT Nothing msg ch env
#! (_,_,ch,env) = nsend_MT ?None msg ch env
= (ch, env)
send_NB :: !.a !*(ch .a) !*env -> (!*(ch .a), !*env)
| ChannelEnv env & Send ch
send_NB msg ch env
#! (_,_,ch,env) = send_MT (Just 0) msg ch env
#! (_,_,ch,env) = send_MT (?Just 0) msg ch env
= (ch, env)
flushBuffer_NB :: !*(ch .a) !*env
-> (!*(ch .a), !*env)
| ChannelEnv env & Send ch
flushBuffer_NB ch env
#! (_,_,ch,env) = flushBuffer_MT (Just 0) ch env
#! (_,_,ch,env) = flushBuffer_MT (?Just 0) ch env
= (ch, env)
......@@ -67,13 +67,13 @@ instance Send TCP_SCharStream_
// ********************************************************************************
lookupIPAddress :: !String !*env
-> (!Maybe IPAddress, !*env)
-> (!?IPAddress, !*env)
| ChannelEnv env
connectTCP_MT :: !(Maybe Timeout) !(!IPAddress,!Port) !*env
-> (!TimeoutReport, !Maybe TCP_DuplexChannel, !*env)
connectTCP_MT :: !(?Timeout) !(!IPAddress,!Port) !*env
-> (!TimeoutReport, !?TCP_DuplexChannel, !*env)
| ChannelEnv env
openTCP_Listener:: !Port !*env
-> (!Bool, !Maybe TCP_Listener, !*env)
-> (!Bool, !?TCP_Listener, !*env)
| ChannelEnv env
tcpPossible :: !*env
-> (!Bool, !*env)
......@@ -93,7 +93,7 @@ tcpPossible :: !*env
// multiplexing
// ********************************************************************************
selectChannel_MT:: !(Maybe Timeout) !*r_channels !*s_channels !*env
selectChannel_MT:: !(?Timeout) !*r_channels !*s_channels !*env
-> (![(Int, SelectResult)],!*r_channels,!*s_channels,!*env)
| SelectReceive r_channels & SelectSend s_channels & ChannelEnv env
/* selectChannel_MT mbTimeout r_channels s_channels world
......@@ -118,7 +118,7 @@ class SelectReceive channels where
accRChannels :: (PrimitiveRChannel -> (x, PrimitiveRChannel)) !*channels
-> (![x], !*channels)
getRState :: !Int !*channels !*env
-> (!Maybe SelectResult, !*channels, !*env) | ChannelEnv env
-> (!?SelectResult, !*channels, !*env) | ChannelEnv env
/* accRChannels f channels
applies a function on each channel in channels and returns a list which
contains the result for each application.
......
implementation module TCPChannels
import StdEnv
import StdEnv, StdMaybe
from StdFunc import seq
import TCPDef, TCPChannelClass
import tcp, ostcp, tcp_bytestreams
......@@ -28,7 +28,7 @@ instance Receive TCP_Listener_
receiveUpToGeneral akku max ch env
| max<=0
= (u_reverse akku, ch, env)
#! (tReport, mbData, ch, env) = receive_MT (Just 0) ch env
#! (tReport, mbData, ch, env) = receive_MT (?Just 0) ch env
| tReport<>TR_Success
= (u_reverse akku, ch, env)
= receiveUpToGeneral [fromJust mbData:akku] (dec max) ch env
......@@ -39,11 +39,11 @@ instance closeRChannel TCP_Listener_
# endpointRef = unpack_tcplistener ch
= close_listener endpointRef env
receive_mb_Listener :: !(Maybe Timeout) !EndpointRef !*env
-> (!TimeoutReport, !Maybe (!IPAddress, !TCP_DuplexChannel), !*env) | ChannelEnv env
receive_mb_Listener :: !(?Timeout) !EndpointRef !*env
-> (!TimeoutReport, !?(!IPAddress, !TCP_DuplexChannel), !*env) | ChannelEnv env
receive_mb_Listener mbTimeout endpointRef env
| isJust mbTimeout && (fromJust mbTimeout)<0
= (TR_Expired, Nothing, env)
= (TR_Expired, ?None, env)
#! (cReqAvail, env) = os_connectrequestavailable endpointRef env
= if cReqAvail (accept endpointRef env) (wait endpointRef env)
where
......@@ -52,15 +52,15 @@ receive_mb_Listener mbTimeout endpointRef env
(mbStopTime, env) = getMbStopTime mbTimeout env
(errCode, env) = selectChC isIOProg False mbStopTime {endpointRef} {LISTENER} {} env
| errCode<>0 // the timeout expired (or some fatal error)
= (TR_Expired, Nothing, env)
= (TR_Expired, ?None, env)
= accept endpointRef env
accept endpointRef env
# ((errCode,host,newEpRef), env)
= acceptC endpointRef env
| errCode<>0
= (TR_NoSuccess, Nothing, env)
= (TR_NoSuccess, ?None, env)
# (duplexChan, env) = createDuplexChan newEpRef env
= (TR_Success, Just (pack_ipaddr host, duplexChan), env)
= (TR_Success, ?Just (pack_ipaddr host, duplexChan), env)
/////////////////////// TCP channels /////////////////////////////////
......@@ -88,26 +88,26 @@ instance closeRChannel TCP_RChannel_
# (endpointRef, _) = unpack_tcprchan ch
= close_tcprchan endpointRef env
receive_mb_TCP :: !(Maybe Timeout) !(!EndpointRef,!Int) !*env
-> (!TimeoutReport, !Maybe ByteSeq, !*env)
receive_mb_TCP :: !(?Timeout) !(!EndpointRef,!Int) !*env
-> (!TimeoutReport, !?ByteSeq, !*env)
| ChannelEnv env
receive_mb_TCP mbTimeout rchan=:(endpointRef,maxSize) env
| isJust mbTimeout && (fromJust mbTimeout)<0
= (TR_Expired, Nothing, env)
= (TR_Expired, ?None, env)
#! (receivedData, env) = receiveC endpointRef maxSize env
| size receivedData>0
= (TR_Success, Just (toByteSeq receivedData), env)
= (TR_Success, ?Just (toByteSeq receivedData), env)
#! (mbStopTime, env) = getMbStopTime mbTimeout env
(isIOProg, env) = channelEnvKind env
(errCode, env) = selectChC isIOProg False mbStopTime {endpointRef} {RCHANNEL} {} env
| errCode == 1 // timeout expired
= (TR_Expired, Nothing, env)
= (TR_Expired, ?None, env)
| errCode == 3 // some error
= (TR_NoSuccess, Nothing, env)
= (TR_NoSuccess, ?None, env)
#! (receivedData, env) = receiveC endpointRef maxSize env
| size receivedData>0
= (TR_Success, Just (toByteSeq receivedData), env)
= (TR_NoSuccess, Nothing, env)
= (TR_Success, ?Just (toByteSeq receivedData), env)
= (TR_NoSuccess, ?None, env)
instance Send TCP_SChannel_
where
......@@ -204,16 +204,16 @@ flushBuffers_Loop nonBlocking mbStopTime isIOProg endpointRef
= flushBuffers_Loop nonBlocking mbStopTime isIOProg endpointRef {buffer & bBegin=bBegin+bytesSent}
(bytesSent+akku) env
lookupIPAddress :: !String !*env
-> (!Maybe IPAddress, !*env)
-> (!?IPAddress, !*env)
| ChannelEnv env
lookupIPAddress inetAddr env
# ((errCode, inetHost), env) = lookupHost_syncC (inetAddr+++"\0") env
| errCode<>0
= (Nothing, env)
= (Just (pack_ipaddr inetHost), env)
= (?None, env)
= (?Just (pack_ipaddr inetHost), env)
connectTCP_MT :: !(Maybe Timeout) !(!IPAddress,!Port) !*env
-> (!TimeoutReport, !Maybe TCP_DuplexChannel, !*env)
connectTCP_MT :: !(?Timeout) !(!IPAddress,!Port) !*env
-> (!TimeoutReport, !?TCP_DuplexChannel, !*env)
| ChannelEnv env
connectTCP_MT mbTimeout (inetHost,inetPort) env
#! destination = (unpack_ipaddr inetHost, inetPort)
......@@ -222,20 +222,20 @@ connectTCP_MT mbTimeout (inetHost,inetPort) env
((errCode,timeoutExpired,endpointRef), env)
= os_connectTCP_sync chanEnvKind mbStopTime destination env
| timeoutExpired
= (TR_Expired, Nothing, env)
= (TR_Expired, ?None, env)
| errCode<>0
= (TR_NoSuccess, Nothing, env)
= (TR_NoSuccess, ?None, env)
#! (duplexChan, env) = createDuplexChan endpointRef env
= (TR_Success, Just duplexChan, env)
= (TR_Success, ?Just duplexChan, env)
openTCP_Listener :: !Port !*env
-> (!Bool, !Maybe TCP_Listener, !*env)
-> (!Bool, !?TCP_Listener, !*env)
| ChannelEnv env
openTCP_Listener port env
# ((errCode,endpointRef), env) = openTCP_ListenerC port env
| errCode<>0
= (False, Nothing, env)
= (True, Just (pack_tcplistener endpointRef), env)
= (False, ?None, env)
= (True, ?Just (pack_tcplistener endpointRef), env)
instance MaxSize TCP_RChannel_
where
......@@ -307,7 +307,7 @@ class SelectReceive channels
accRChannels :: (PrimitiveRChannel -> (x, PrimitiveRChannel)) !*channels
-> (![x], !*channels)
getRState :: !Int !*channels !*env
-> (!Maybe SelectResult, !*channels, !*env) | ChannelEnv env
-> (!?SelectResult, !*channels, !*env) | ChannelEnv env
class SelectSend channels
where
......@@ -409,7 +409,7 @@ instance SelectReceive TCP_Listeners
getState listener env
#! endpointRef = unpack_tcplistener listener
(cReqAvail, env) = os_connectrequestavailable endpointRef env
= ( if cReqAvail (Just SR_Available) Nothing,
= ( if cReqAvail (?Just SR_Available) ?None,
pack_tcplistener endpointRef,
env)
......@@ -434,16 +434,16 @@ instance SelectReceive TCP_Void
accRChannels _ void
= ([],void)
getRState _ void env
= (Nothing, void, env)
= (?None, void, env)
getStateRchan channel env
#! (isAvailable, channel, env) = available channel env
| isAvailable
= (Just SR_Available, channel, env)
= (?Just SR_Available, channel, env)
#! (isEom, channel, env) = eom channel env
| isEom
= (Just SR_EOM, channel, env)
= (Nothing, channel, env)
= (?Just SR_EOM, channel, env)
= (?None, channel, env)
instance getNrOfChannels (TCP_Pair *x *y) | getNrOfChannels x & getNrOfChannels y
where
......@@ -499,7 +499,7 @@ instance toString SelectResult
toString SR_Sendable = "SR_Sendable"
toString SR_Disconnected = "SR_Disconnected"
selectChannel_MT :: !(Maybe Timeout) !*r_channels !*s_channels !*env
selectChannel_MT :: !(?Timeout) !*r_channels !*s_channels !*env
-> (![(Int, SelectResult)], !*r_channels, !*s_channels, !*env)
| SelectReceive r_channels & SelectSend s_channels & ChannelEnv env
selectChannel_MT mbTimeout r_channels s_channels env
......@@ -548,7 +548,7 @@ pollRState [] akku r_channels env
= (reverse akku, r_channels, env)
pollRState [rcvIndex:rcvIndices] akku r_channels env
#! (mbResult, r_channels, env) = getRState rcvIndex r_channels env
| isNothing mbResult
| isNone mbResult
= pollRState rcvIndices akku r_channels env
#! result = fromJust mbResult
| result<>SR_Available && result<>SR_EOM
......@@ -579,25 +579,25 @@ instance Receive TCP_RCharStream_
where
receive_MT mbTimeout rbs=:{ rbs_buffer, rbs_index } env
| isJust mbTimeout && (fromJust mbTimeout)<0
= (TR_Expired, Nothing, rbs, env)
= (TR_Expired, ?None, rbs, env)
| rbs_index < (size rbs_buffer)
= ( TR_Success, Cast (Just rbs_buffer.[rbs_index]), { rbs & rbs_index=inc rbs_index }, env)
= ( TR_Success, Cast (?Just rbs_buffer.[rbs_index]), { rbs & rbs_index=inc rbs_index }, env)
#! rbs_rchan = rbs.rbs_rchan
(toReport, mbData, rbs_rchan, env) = receive_MT mbTimeout rbs_rchan env
| toReport==TR_Success
#! data = toString (fromJust mbData)
= ( toReport, Cast (Just data.[0]),
= ( toReport, Cast (?Just data.[0]),
{ rbs & rbs_rchan=rbs_rchan, rbs_index=1, rbs_buffer=data }, env)
= ( toReport, Nothing, { rbs & rbs_rchan=rbs_rchan, rbs_buffer="", rbs_index=0 }, env)
= ( toReport, ?None, { rbs & rbs_rchan=rbs_rchan, rbs_buffer="", rbs_index=0 }, env)
receiveUpTo maxLength rbs=:{ rbs_buffer, rbs_index } env
| maxLength<=0
=([], rbs, env)
#! nrOfCharsInBuffer = max (size rbs_buffer - rbs_index) 0
| nrOfCharsInBuffer>=maxLength // enough data is buffered in rbs_buffer
= (Cast [rbs_buffer.[i] \\ i<-[rbs_index..rbs_index+maxLength-1]], { rbs & rbs_index=rbs_index+maxLength }, env)
#! (_, mbData, rbs_rchan, env) = receive_MT (Just 0) rbs.rbs_rchan env
#! (_, mbData, rbs_rchan, env) = receive_MT (?Just 0) rbs.rbs_rchan env
charsInBuffer = [rbs_buffer.[i] \\ i<-[rbs_index..(size rbs_buffer)-1]]
| isNothing mbData // available is False->return the rbs_buffer
| isNone mbData // available is False->return the rbs_buffer
= ( Cast charsInBuffer, { rbs & rbs_rchan=rbs_rchan, rbs_buffer="", rbs_index=0 }, env)
#! (l, ch, env) = receiveUpTo (maxLength-nrOfCharsInBuffer)
{rbs & rbs_rchan=rbs_rchan, rbs_buffer=toString (fromJust mbData),
......
......@@ -8,7 +8,6 @@ definition module TCPDef
// Modified: 7 September 2001 for Clean 2.0 (Peter Achten)
// ********************************************************************************
from StdMaybe import :: Maybe
from StdOverloaded import class ==, class toString
from TCPChannelClass import :: DuplexChannel
......
implementation module TCPDef
import StdEnv,StdMaybe
import StdEnv
import TCPChannelClass
import tcp
......
......@@ -16,24 +16,24 @@ toStringRChannel tcp_rchan
instance Receive StringRChannel_ where
receive_MT mbTimeout rchan=:{receivedStrings, maxSize} env
| isJust mbTimeout && (fromJust mbTimeout)<0
= (TR_Expired, Nothing, rchan, env)
= (TR_Expired, ?None, rchan, env)
| not (isEmpty receivedStrings)
= (TR_Success, Just (Cast (hd receivedStrings)), { rchan & receivedStrings=tl receivedStrings }, env)
= (TR_Success, ?Just (Cast (hd receivedStrings)), { rchan & receivedStrings=tl receivedStrings }, env)
#! (timeBeforeReceive, env) = channel_env_get_current_tick env
(toReport, mbByteSeq, tcp_rchan, env) = receive_MT mbTimeout rchan.tcp_rchan env
| toReport==TR_Expired
= (toReport, Nothing, { rchan & tcp_rchan=tcp_rchan }, env)
= (toReport, ?None, { rchan & tcp_rchan=tcp_rchan }, env)
| toReport==TR_NoSuccess
= (toReport, Nothing, { rchan & tcp_rchan=tcp_rchan, readPhase=EndOfMessages }, env)
= (toReport, ?None, { rchan & tcp_rchan=tcp_rchan, readPhase=EndOfMessages }, env)
#! (newStrings, readPhase) = addString (toString (fromJust mbByteSeq), 0) rchan.readPhase maxSize
| not (isEmpty newStrings)
= ( TR_Success, Just (Cast (hd newStrings))
= ( TR_Success, ?Just (Cast (hd newStrings))
, { rchan & tcp_rchan=tcp_rchan, readPhase=readPhase, receivedStrings=tl newStrings }
, env
)
#! (timeAfterReceive, env) = channel_env_get_current_tick env
usedTime = timeAfterReceive-timeBeforeReceive
newMbTimeout = if (isNothing mbTimeout) mbTimeout (Just ((fromJust mbTimeout)-usedTime))
newMbTimeout = if (isNone mbTimeout) mbTimeout (?Just ((fromJust mbTimeout)-usedTime))
= receive_MT newMbTimeout { rchan & tcp_rchan=tcp_rchan, readPhase=readPhase } env
receiveUpTo max ch env
......@@ -70,7 +70,7 @@ instance Receive StringRChannel_ where