Commit a7ad8c2f authored by John van Groningen's avatar John van Groningen

fix end of line characters

parent 82bb4b22
definition module TCPChannelClass definition module TCPChannelClass
// ******************************************************************************** // ********************************************************************************
// Clean Standard TCP library, version 1.2.2 // Clean Standard TCP library, version 1.2.2
// //
// StdChannels defines operations on channels // StdChannels defines operations on channels
// Author: Martin Wierich // Author: Martin Wierich
// Modified: 15 October 2001 for Clean 2.0 (Peter Achten) // Modified: 15 October 2001 for Clean 2.0 (Peter Achten)
// ******************************************************************************** // ********************************************************************************
from StdMaybe import :: Maybe from StdMaybe import :: Maybe
from StdOverloaded import class toString, class == from StdOverloaded import class toString, class ==
from tcp import class ChannelEnv from tcp import class ChannelEnv
instance ChannelEnv World instance ChannelEnv World
// ******************************************************************************** // ********************************************************************************
// receive channels // receive channels
// ******************************************************************************** // ********************************************************************************
class Receive ch where class Receive ch where
receive_MT :: !(Maybe Timeout) !*(ch .a) !*env receive_MT :: !(Maybe Timeout) !*(ch .a) !*env
-> (!TimeoutReport, !Maybe .a, !*(ch .a), !*env) -> (!TimeoutReport, !Maybe .a, !*(ch .a), !*env)
| ChannelEnv env | ChannelEnv env
receiveUpTo :: !Int !*(ch .a) !*env receiveUpTo :: !Int !*(ch .a) !*env
-> (![.a], !*(ch .a), !*env) -> (![.a], !*(ch .a), !*env)
| ChannelEnv env | ChannelEnv env
available :: !*(ch .a) !*env available :: !*(ch .a) !*env
-> (!Bool, !*(ch .a), !*env) -> (!Bool, !*(ch .a), !*env)
| ChannelEnv env | ChannelEnv env
eom :: !*(ch .a) !*env eom :: !*(ch .a) !*env
-> (!Bool, !*(ch .a), !*env) -> (!Bool, !*(ch .a), !*env)
| ChannelEnv env | ChannelEnv env
/* receive_MT /* receive_MT
tries to receive on a channel. This function will block until data can be tries to receive on a channel. This function will block until data can be
received, eom becomes true, or the timeout expires. received, eom becomes true, or the timeout expires.
receiveUpTo max ch env receiveUpTo max ch env
receives messages on a channel until available becomes False or max receives messages on a channel until available becomes False or max
messages have been received. messages have been received.
available available
polls on a channel whether some data is ready to be received. If the polls on a channel whether some data is ready to be received. If the
returned Boolean is True, then a following receive_MT will not block and returned Boolean is True, then a following receive_MT will not block and
return TR_Success. return TR_Success.
eom ("end of messages") eom ("end of messages")
polls on a channel whether data can't be received anymore. polls on a channel whether data can't be received anymore.
*/ */
class closeRChannel ch :: !*(ch .a) !*env -> *env | ChannelEnv env class closeRChannel ch :: !*(ch .a) !*env -> *env | ChannelEnv env
// Closes the channel // Closes the channel
// ******************************************************************************** // ********************************************************************************
// send channels // send channels
// ******************************************************************************** // ********************************************************************************
class Send ch where class Send ch where
send_MT :: !(Maybe Timeout) !.a !*(ch .a) !*env send_MT :: !(Maybe Timeout) !.a !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*(ch .a), !*env) -> (!TimeoutReport, !Int, !*(ch .a), !*env)
| ChannelEnv env | ChannelEnv env
nsend_MT :: !(Maybe Timeout) ![.a] !*(ch .a) !*env nsend_MT :: !(Maybe Timeout) ![.a] !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*(ch .a), !*env) -> (!TimeoutReport, !Int, !*(ch .a), !*env)
| ChannelEnv env | ChannelEnv env
flushBuffer_MT :: !(Maybe Timeout) !*(ch .a) !*env flushBuffer_MT :: !(Maybe Timeout) !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*(ch .a), !*env) -> (!TimeoutReport, !Int, !*(ch .a), !*env)
| ChannelEnv env | ChannelEnv env
closeChannel_MT :: !(Maybe Timeout) !*(ch .a) !*env closeChannel_MT :: !(Maybe Timeout) !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*env) -> (!TimeoutReport, !Int, !*env)
| ChannelEnv env | ChannelEnv env
abortConnection :: !*(ch .a) !*env abortConnection :: !*(ch .a) !*env
-> *env -> *env
| ChannelEnv env | ChannelEnv env
disconnected :: !*(ch .a) !*env disconnected :: !*(ch .a) !*env
-> (!Bool, !*(ch .a), !*env) -> (!Bool, !*(ch .a), !*env)
| ChannelEnv env | ChannelEnv env
bufferSize :: !*(ch .a) bufferSize :: !*(ch .a)
-> (!Int, !*(ch .a)) -> (!Int, !*(ch .a))
/* send_MT mbTimeout a ch env /* send_MT mbTimeout a ch env
adds the data a to the channels internal buffer and tries to send this adds the data a to the channels internal buffer and tries to send this
buffer. buffer.
nsend_MT mbTimeout l ch env nsend_MT mbTimeout l ch env
adds the data l to the channels internal buffer and tries to send this adds the data l to the channels internal buffer and tries to send this
buffer. buffer.
flushBuffer_MT flushBuffer_MT
tries to send the channels internal buffer. tries to send the channels internal buffer.
closeSChannel_MT closeSChannel_MT
first tries to send the channels internal buffer and then closes the first tries to send the channels internal buffer and then closes the
channel. channel.
abortConnection abortConnection
will cause an abortive disconnect (sent data can be lost). will cause an abortive disconnect (sent data can be lost).
disconnected disconnected
polls on a channel, whether data can't be sent anymore. If the returned polls on a channel, whether data can't be sent anymore. If the returned
Boolean is True, then a following send_MT will not block and return Boolean is True, then a following send_MT will not block and return
TR_NoSuccess. TR_NoSuccess.
bufferSize bufferSize
returns the size of the channels internal buffer in bytes. returns the size of the channels internal buffer in bytes.
The integer value that is returned by send_MT, nsend_MT, flushBuffer_MT, and The integer value that is returned by send_MT, nsend_MT, flushBuffer_MT, and
closeSChannel_MT is the number of sent bytes. closeSChannel_MT is the number of sent bytes.
*/ */
// ******************************************************************************** // ********************************************************************************
// miscellaneous // miscellaneous
// ******************************************************************************** // ********************************************************************************
class MaxSize ch where class MaxSize ch where
setMaxSize :: !Int !*(ch .a) -> *(ch .a) setMaxSize :: !Int !*(ch .a) -> *(ch .a)
getMaxSize :: !*(ch .a) -> (!Int, !*(ch .a)) getMaxSize :: !*(ch .a) -> (!Int, !*(ch .a))
clearMaxSize :: !*(ch .a) -> *(ch .a) clearMaxSize :: !*(ch .a) -> *(ch .a)
// Set, get, or clear the maximum size of the data that can be received // Set, get, or clear the maximum size of the data that can be received
:: DuplexChannel sChannel rChannel a :: DuplexChannel sChannel rChannel a
= { sChannel:: sChannel a = { sChannel:: sChannel a
, rChannel:: rChannel a , rChannel:: rChannel a
} }
:: TimeoutReport :: TimeoutReport
= TR_Expired = TR_Expired
| TR_Success | TR_Success
| TR_NoSuccess | TR_NoSuccess
:: Timeout :== Int // timeout in ticks :: Timeout :== Int // timeout in ticks
instance == TimeoutReport instance == TimeoutReport
instance toString TimeoutReport instance toString TimeoutReport
// ******************************************************************************** // ********************************************************************************
// derived functions // derived functions
// ******************************************************************************** // ********************************************************************************
nreceive_MT :: !(Maybe Timeout) !Int !*(ch .a) !*env nreceive_MT :: !(Maybe Timeout) !Int !*(ch .a) !*env
-> (!TimeoutReport, ![.a],!*(ch .a),!*env) -> (!TimeoutReport, ![.a],!*(ch .a),!*env)
| Receive ch & ChannelEnv env | Receive ch & ChannelEnv env
/* nreceive_MT mbTimeout n ch env /* nreceive_MT mbTimeout n ch env
tries to call receive_MT n times. If the result is (tReport, l, ch2, env2), tries to call receive_MT n times. If the result is (tReport, l, ch2, env2),
then the following holds: then the following holds:
tReport==TR_Succes <=> length l==n tReport==TR_Succes <=> length l==n
tReport==TR_NoSuccess => length l<n tReport==TR_NoSuccess => length l<n
*/ */
/* The following two receive functions call their "_MT" counterpart with no /* The following two receive functions call their "_MT" counterpart with no
timeout. If the data can't be received because eom became True the function will timeout. If the data can't be received because eom became True the function will
abort. abort.
*/ */
receive :: !*(ch .a) !*env receive :: !*(ch .a) !*env
-> (!.a, !*(ch .a), !*env) -> (!.a, !*(ch .a), !*env)
| ChannelEnv env & Receive ch | ChannelEnv env & Receive ch
nreceive :: !Int !*(ch .a) !*env nreceive :: !Int !*(ch .a) !*env
-> (![.a], !*(ch .a), !*env) -> (![.a], !*(ch .a), !*env)
| ChannelEnv env & Receive ch | ChannelEnv env & Receive ch
/* The following three send functions call their "_MT" counterpart with no timeout. /* The following three send functions call their "_MT" counterpart with no timeout.
*/ */
send :: !.a !*(ch .a) !*env send :: !.a !*(ch .a) !*env
-> (!*(ch .a), !*env) -> (!*(ch .a), !*env)
| ChannelEnv env & Send ch | ChannelEnv env & Send ch
nsend :: ![.a] !*(ch .a) !*env nsend :: ![.a] !*(ch .a) !*env
-> (!*(ch .a), !*env) -> (!*(ch .a), !*env)
| ChannelEnv env & Send ch | ChannelEnv env & Send ch
closeChannel :: !*(ch .a) !*env closeChannel :: !*(ch .a) !*env
-> *env -> *env
| ChannelEnv env & Send ch | ChannelEnv env & Send ch
/* The following two send functions call their "_MT" counterpart with timeout == 0. /* The following two send functions call their "_MT" counterpart with timeout == 0.
"NB" is a shorthand for "non blocking" "NB" is a shorthand for "non blocking"
*/ */
send_NB :: !.a !*(ch .a) !*env send_NB :: !.a !*(ch .a) !*env
-> (!*(ch .a), !*env) -> (!*(ch .a), !*env)
| ChannelEnv env & Send ch | ChannelEnv env & Send ch
flushBuffer_NB :: !*(ch .a) !*env flushBuffer_NB :: !*(ch .a) !*env
-> (!*(ch .a), !*env) -> (!*(ch .a), !*env)
| ChannelEnv env & Send ch | ChannelEnv env & Send ch
implementation module TCPChannelClass implementation module TCPChannelClass
import StdEnv,StdMaybe import StdEnv,StdMaybe
import tcp import tcp
from ostcp import tcp_getcurrenttick from ostcp import tcp_getcurrenttick
instance ChannelEnv World instance ChannelEnv World
where where
channelEnvKind env channelEnvKind env
= (WORLD, env) = (WORLD, env)
mb_close_inet_receiver_without_id _ _ world mb_close_inet_receiver_without_id _ _ world
= world = world
channel_env_get_current_tick env channel_env_get_current_tick env
// = os_getcurrenttick env // = os_getcurrenttick env
= tcp_getcurrenttick env = tcp_getcurrenttick env
///////////////////////////////// receive channels ///////////////////////////////// ///////////////////////////////// receive channels /////////////////////////////////
class Receive ch where class Receive ch where
receive_MT :: !(Maybe Timeout) !*(ch .a) !*env receive_MT :: !(Maybe Timeout) !*(ch .a) !*env
-> (!TimeoutReport, !Maybe .a, !*(ch .a), !*env) -> (!TimeoutReport, !Maybe .a, !*(ch .a), !*env)
| ChannelEnv env | ChannelEnv env
receiveUpTo :: !Int !*(ch .a) !*env receiveUpTo :: !Int !*(ch .a) !*env
-> (![.a], !*(ch .a), !*env) -> (![.a], !*(ch .a), !*env)
| ChannelEnv env | ChannelEnv env
available :: !*(ch .a) !*env available :: !*(ch .a) !*env
-> (!Bool, !*(ch .a), !*env) -> (!Bool, !*(ch .a), !*env)
| ChannelEnv env | ChannelEnv env
eom :: !*(ch .a) !*env eom :: !*(ch .a) !*env
-> (!Bool, !*(ch .a), !*env) -> (!Bool, !*(ch .a), !*env)
| ChannelEnv env | ChannelEnv env
class closeRChannel ch :: !*(ch .a) !*env -> *env | ChannelEnv env class closeRChannel ch :: !*(ch .a) !*env -> *env | ChannelEnv env
//////////////////////////////// send channels ///////////////////////////////////// //////////////////////////////// send channels /////////////////////////////////////
class Send ch class Send ch
where where
send_MT :: !(Maybe Timeout) !.a !*(ch .a) !*env send_MT :: !(Maybe Timeout) !.a !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*(ch .a), !*env) -> (!TimeoutReport, !Int, !*(ch .a), !*env)
| ChannelEnv env | ChannelEnv env
nsend_MT :: !(Maybe Timeout) ![.a] !*(ch .a) !*env nsend_MT :: !(Maybe Timeout) ![.a] !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*(ch .a), !*env) -> (!TimeoutReport, !Int, !*(ch .a), !*env)
| ChannelEnv env | ChannelEnv env
flushBuffer_MT :: !(Maybe Timeout) !*(ch .a) !*env flushBuffer_MT :: !(Maybe Timeout) !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*(ch .a), !*env) -> (!TimeoutReport, !Int, !*(ch .a), !*env)
| ChannelEnv env | ChannelEnv env
closeChannel_MT :: !(Maybe Timeout) !*(ch .a) !*env closeChannel_MT :: !(Maybe Timeout) !*(ch .a) !*env
-> (!TimeoutReport, !Int, !*env) -> (!TimeoutReport, !Int, !*env)
| ChannelEnv env | ChannelEnv env
abortConnection :: !*(ch .a) !*env abortConnection :: !*(ch .a) !*env
-> *env -> *env
| ChannelEnv env | ChannelEnv env
disconnected :: !*(ch .a) !*env disconnected :: !*(ch .a) !*env
-> (!Bool, !*(ch .a), !*env) -> (!Bool, !*(ch .a), !*env)
| ChannelEnv env | ChannelEnv env
bufferSize :: !*(ch .a) bufferSize :: !*(ch .a)
-> (!Int, !*(ch .a)) -> (!Int, !*(ch .a))
class MaxSize ch class MaxSize ch
where where
setMaxSize :: !Int !*(ch .a) -> *(ch .a) setMaxSize :: !Int !*(ch .a) -> *(ch .a)
getMaxSize :: !*(ch .a) -> (!Int, !*(ch .a)) getMaxSize :: !*(ch .a) -> (!Int, !*(ch .a))
clearMaxSize :: !*(ch .a) -> *(ch .a) clearMaxSize :: !*(ch .a) -> *(ch .a)
:: DuplexChannel sChannel rChannel a :: DuplexChannel sChannel rChannel a
= { sChannel :: sChannel a = { sChannel :: sChannel a
, rChannel :: rChannel a , rChannel :: rChannel a
} }
:: TimeoutReport :: TimeoutReport
= TR_Expired = TR_Expired
| TR_Success | TR_Success
| TR_NoSuccess | TR_NoSuccess
:: Timeout :== Int // timeout in ticks :: Timeout :== Int // timeout in ticks
instance == TimeoutReport instance == TimeoutReport
where where
(==) TR_Expired x = case x of TR_Expired -> True (==) TR_Expired x = case x of TR_Expired -> True
_ -> False _ -> False
(==) TR_Success x = case x of TR_Success -> True (==) TR_Success x = case x of TR_Success -> True
_ -> False _ -> False
(==) TR_NoSuccess x = case x of TR_NoSuccess -> True (==) TR_NoSuccess x = case x of TR_NoSuccess -> True
_ -> False _ -> False
instance toString TimeoutReport instance toString TimeoutReport
where where
toString TR_Expired = "TR_Expired" toString TR_Expired = "TR_Expired"
toString TR_Success = "TR_Success" toString TR_Success = "TR_Success"
toString TR_NoSuccess = "TR_NoSuccess" toString TR_NoSuccess = "TR_NoSuccess"
/////////////////// derived functions //////////////////////////////////////////////////// /////////////////// derived functions ////////////////////////////////////////////////////
nreceive_MT :: !(Maybe Timeout) !Int !*(ch .a) !*env nreceive_MT :: !(Maybe Timeout) !Int !*(ch .a) !*env
-> (!TimeoutReport, ![.a], !*(ch .a), !*env) -> (!TimeoutReport, ![.a], !*(ch .a), !*env)
| Receive ch & ChannelEnv env | Receive ch & ChannelEnv env
nreceive_MT mbTimeout n ch env nreceive_MT mbTimeout n ch env
// #! (before, env) = getCurrentTick env // #! (before, env) = getCurrentTick env
#! (before, env) = channel_env_get_current_tick env #! (before, env) = channel_env_get_current_tick env
(l, ch, env) = receiveUpTo n ch env (l, ch, env) = receiveUpTo n ch env
(length, l) = u_length l (length, l) = u_length l
| length==n | length==n
= (TR_Success, l, ch, env) = (TR_Success, l, ch, env)
#! (tReport, mbData, ch, env) = receive_MT mbTimeout ch env #! (tReport, mbData, ch, env) = receive_MT mbTimeout ch env
| tReport<>TR_Success | tReport<>TR_Success
= (tReport, l, ch, env) = (tReport, l, ch, env)
| n-length==1 | n-length==1
= (tReport, l++[fromJust mbData], ch, env) = (tReport, l++[fromJust mbData], ch, env)
// #! (after, env) = getCurrentTick env // #! (after, env) = getCurrentTick env
#! (after, env) = channel_env_get_current_tick env #! (after, env) = channel_env_get_current_tick env
// = nreceive_MT (mbSubtract mbTimeout (tickDifference after before)) (n-length-1) 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 = nreceive_MT (mbSubtract mbTimeout (after-before)) (n-length-1) ch env
where where
mbSubtract Nothing _ = Nothing mbSubtract Nothing _ = Nothing
mbSubtract (Just timeout) i = Just (timeout-i) mbSubtract (Just timeout) i = Just (timeout-i)
u_reverse::![.a] -> [.a] u_reverse::![.a] -> [.a]
u_reverse list = reverse_ list [] u_reverse list = reverse_ list []
where where
reverse_ [hd:tl] list = reverse_ tl [hd:list] reverse_ [hd:tl] list = reverse_ tl [hd:list]
reverse_ [] list = list reverse_ [] list = list
u_length l u_length l
= u_length_ l [] 0 = u_length_ l [] 0
where where
u_length_ [] akku n u_length_ [] akku n
= (n, u_reverse akku) = (n, u_reverse akku)
u_length_ [h:t] akku n u_length_ [h:t] akku n
= u_length_ t [h:akku] (inc n) = u_length_ t [h:akku] (inc n)
receive :: !*(ch .a) !*env -> (!.a, !*(ch .a), !*env) receive :: !*(ch .a) !*env -> (!.a, !*(ch .a), !*env)
| ChannelEnv env & Receive ch | ChannelEnv env & Receive ch
receive ch env receive ch env
#! (timeoutReport, mbMessage, ch, env) = receive_MT Nothing ch env #! (timeoutReport, mbMessage, ch, env) = receive_MT Nothing ch env
| timeoutReport==TR_NoSuccess | timeoutReport==TR_NoSuccess
#! (isEom, ch, env) = eom ch env #! (isEom, ch, env) = eom ch env
| isEom | isEom
= abort "\nStdChannels: receive failed" = abort "\nStdChannels: receive failed"
= receive ch env = receive ch env
= (fromJust mbMessage, ch, env) = (fromJust mbMessage, ch, env)
nreceive :: !Int !*(ch .a) !*env -> (![.a], !*(ch .a), !*env) nreceive :: !Int !*(ch .a) !*env -> (![.a], !*(ch .a), !*env)
| ChannelEnv env & Receive ch | ChannelEnv env & Receive ch
nreceive n ch env