receiveraccess.icl 3.91 KB
Newer Older
Peter Achten's avatar
Peter Achten committed
1
2
3
4
5
implementation module receiveraccess


//	Clean Object I/O library, version 1.2

6
import	StdBool, StdInt, StdList
Peter Achten's avatar
Peter Achten committed
7
import	id, receiverdefaccess, receiverhandle
8
import	cast, semidynamic
Peter Achten's avatar
Peter Achten committed
9

10
// MW11 added connectedIds
11
newReceiverStateHandle :: !Id .ls !SelectState ![Id] !(ReceiverFunction m *(.ls,.pst)) -> ReceiverStateHandle .pst
12
newReceiverStateHandle id localState select connectedIds f
Peter Achten's avatar
Peter Achten committed
13
	= {	rState	= localState
14
	  ,	rHandle	= newReceiverHandle id select connectedIds f	
Peter Achten's avatar
Peter Achten committed
15
16
	  }

17
// MW11 added rInetInfo,rConnected
18
newReceiverHandle :: !Id !SelectState ![Id] !(ReceiverFunction m *(.ls,.pst)) -> ReceiverHandle .ls .pst
19
20
21
22
23
24
25
26
newReceiverHandle id select connectedIds f
	= {	rId			= id
	  ,	rASMQ		= []
	  ,	rSelect		= select
	  ,	rOneWay		= True
	  ,	rFun		= onewaytotriple f
	  , rInetInfo	= Nothing
  	  , rConnected	= connectedIds
Peter Achten's avatar
Peter Achten committed
27
28
	  }

29
onewaytotriple :: !(ReceiverFunction m *(.ls,.pst)) m !*(.ls,.pst) -> *(.ls,[r],.pst)
Peter Achten's avatar
Peter Achten committed
30
31
32
33
onewaytotriple f m (ls,ps)
	# (ls,ps)	= f m (ls,ps)
	= (ls,[],ps)

34
// MW11 added connectedIds
35
newReceiverStateHandle2 :: !Id .ls !SelectState ![Id] !(Receiver2Function m r *(.ls,.pst)) -> ReceiverStateHandle .pst
36
newReceiverStateHandle2 id localState select connectedIds f
Peter Achten's avatar
Peter Achten committed
37
	= {	rState	= localState
38
	  ,	rHandle	= newReceiverHandle2 id select connectedIds f
Peter Achten's avatar
Peter Achten committed
39
40
	  }

41
// MW11 added rInetInfo,rConnected
42
newReceiverHandle2 :: !Id !SelectState ![Id] !(Receiver2Function m r *(.ls,.pst)) -> ReceiverHandle .ls .pst
43
44
45
46
47
48
49
50
newReceiverHandle2 id select connectedIds f
	= {	rId			= id
	  ,	rASMQ		= []
	  ,	rSelect		= select
	  ,	rOneWay		= False
	  ,	rFun		= twowaytotriple f
	  , rInetInfo	= Nothing
  	  , rConnected	= connectedIds
Peter Achten's avatar
Peter Achten committed
51
52
	  }

53
54
55
56
twowaytotriple :: !(Receiver2Function m r *(.ls,.pst)) m !*(.ls,.pst) -> *(.ls,[r],.pst)
twowaytotriple f m (ls,pst)
	# (r, (ls,pst))	= f m (ls,pst)
	= (ls,[r],pst)
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119


//	Functions that have moved from receiverhandle:

receiverIdentified :: !Id !(ReceiverHandle .ls .pst) -> Bool
receiverIdentified id {rId}
	= id==rId

// MW11..
inetReceiverIdentified		::	!(!EndpointRef`, !InetReceiverCategory`)
								!(ReceiverHandle .ls .ps)	-> Bool
inetReceiverIdentified _ {rInetInfo=Nothing}
	= False
inetReceiverIdentified (epR1,type1) {rInetInfo=Just (epR2,type2,_,_)}
	= epR1==epR2 && type1==type2

inetReceiverIdentifiedWithId	::	!(!Id, !InetReceiverCategory`)
									!(ReceiverHandle .ls .ps)	-> Bool
inetReceiverIdentifiedWithId _ {rInetInfo=Nothing}
	= False
inetReceiverIdentifiedWithId (id,category) {rId, rInetInfo=Just (_,rCategory,_,_)}
	= id==rId && category==rCategory
// ..MW11

receiverSetSelectState :: !SelectState !(ReceiverStateHandle .pst) -> ReceiverStateHandle .pst
receiverSetSelectState select rsH=:{rHandle=rH}
	= {rsH & rHandle={rH & rSelect=select}}

receiverHandleSyncMessage :: !SyncMessage !(ReceiverHandle .ls .pst) *(.ls,.pst) -> ([SemiDynamic],ReceiverHandle .ls .pst,*(.ls,.pst))
receiverHandleSyncMessage {smRecLoc={rlReceiverId},smMsg} rH=:{rFun} (ls,pst)
	| not (receiverIdentified rlReceiverId rH)
		= ([],rH,(ls,pst))
	# maybe_content	= getDynamic rlReceiverId smMsg
	| isNothing maybe_content
		= ([],rH,(ls,pst))
	# (ls,resp,pst)	= rFun (Cast (fromJust maybe_content)) (ls,pst)
	| isEmpty resp
		= ([],rH,(ls,pst))
	| otherwise	
		= ([setDynamic rlReceiverId (hd resp) smMsg],rH,(ls,pst))

receiverAddASyncMessage :: !Id !SemiDynamic !(ReceiverHandle .ls .pst) -> ReceiverHandle .ls .pst
receiverAddASyncMessage id sd rH=:{rASMQ}
	| receiverIdentified id rH
		# maybe_content	= getDynamic id sd
		| isNothing maybe_content
			= rH
		// otherwise
			= {rH & rASMQ=rASMQ++[Cast (fromJust maybe_content)]}
	| otherwise
		= rH

// MW11..
receiverApplyInetEvent :: !InetReceiverASMQType !(ReceiverHandle .ls .pst) *(.ls,.pst) -> *(.ls,.pst)
receiverApplyInetEvent eventInfo rH=:{rFun,rInetInfo=Just _} (ls,pst)
	# (ls,_,pst)	= rFun (Cast eventInfo) (ls,pst)
	= (ls,pst)

getInetReceiverRId :: !(ReceiverHandle .ls .ps) -> RId InetReceiverASMQType
// converts an Id into an RId
getInetReceiverRId {rId}
	= toRId (fromId rId)
// ..MW11