EdMessage.icl 2.17 KB
Newer Older
Diederik van Arkel's avatar
Diederik van Arkel committed
1
2
implementation module EdMessage

3
4
// message passing with the editor

Diederik van Arkel's avatar
Diederik van Arkel committed
5
6
7
8
9
10
11
12
13
14
15
16
import StdFunc, StdMisc
import StdReceiver, StdPSt, StdId
import EdMonad

:: EditId
   :== R2Id Message Message
   
:: Message
   = MsgState EditState	// send/receive the state
   | MsgGet				// ask for the state
   | MsgOk				// signifies that a send operation was successful

17
18
:: EditAction l a :== EditMonad (PSt l) a

Diederik van Arkel's avatar
Diederik van Arkel committed
19
20
21
22
openEditId :: *env -> (EditId, *env) | Ids env
openEditId pstate
  = openR2Id pstate

Diederik van Arkel's avatar
Diederik van Arkel committed
23
openEditReceiver :: !EditId -> Receiver2 Message Message EditState (PSt .l)
Diederik van Arkel's avatar
Diederik van Arkel committed
24
25
26
27
28
openEditReceiver editId
  = Receiver2 editId receive []

// receive a message from the outside world

Diederik van Arkel's avatar
Diederik van Arkel committed
29
30
receive :: Message (EditState, PSt .l) ->
		 (Message, (EditState, PSt .l))
Diederik van Arkel's avatar
Diederik van Arkel committed
31
32
33
34
35
36
37
38
receive message (editState, pstate)
  = case message of
	  MsgGet				-> (MsgState editState, (editState, pstate))
	  MsgState newEditState	-> (MsgOk,			 (newEditState, pstate))
	  _						-> abort "receive (EdMessage.icl): unknown message type"

// hasEditState

Diederik van Arkel's avatar
Diederik van Arkel committed
39
hasEditState :: !EditId !*(PSt .l) -> *(Bool, *PSt .l)
Diederik van Arkel's avatar
Diederik van Arkel committed
40
41
42
43
hasEditState editId pstate
  # ((_, maybeResp), pstate) = syncSend2 editId MsgGet pstate
  = (isJust maybeResp, pstate)

44
45
// appEditState 

Diederik van Arkel's avatar
Diederik van Arkel committed
46
appEditState :: !EditId !.(EditAction .l .r) !*(PSt .l) -> *(.r,*PSt .l)
47
48
49
appEditState editId monad pState
  # (editState, pState)			= getEditState editId pState
  # (x, (editState, pState))	= monad (editState, pState)
Diederik van Arkel's avatar
Diederik van Arkel committed
50
  #!	pState					= setEditState editId editState pState
51
52
  = (x, pState)

Diederik van Arkel's avatar
Diederik van Arkel committed
53
54
// getEditState 

Diederik van Arkel's avatar
Diederik van Arkel committed
55
getEditState :: !EditId !*(PSt .l) -> *(EditState, *PSt .l)
Diederik van Arkel's avatar
Diederik van Arkel committed
56
57
58
59
60
61
62
63
64
getEditState editId pstate
  # ((_, maybeResp), pstate) = syncSend2 editId MsgGet pstate
  | isNothing maybeResp
	= abort "getEditState (EdMessage.icl): no response"
	= case fromJust maybeResp of
		MsgState editState	-> (editState, pstate)
		_					-> abort "getEditState (EdMessage.icl): unknown response"
  

Diederik van Arkel's avatar
Diederik van Arkel committed
65
setEditState :: !EditId !EditState !*(PSt .l) -> *PSt .l
Diederik van Arkel's avatar
Diederik van Arkel committed
66
67
68
69
70
71
72
73
setEditState editId editState pstate
  # ((_, maybeResp), pstate) = syncSend2 editId (MsgState editState) pstate
  | isNothing maybeResp
	= abort "setEditState (EdMessage.icl): no response"
	= case fromJust maybeResp of
		MsgOk	-> pstate
		_		-> abort "setEditState (EdMessage.icl): unknown response"