EdMessage.icl 2.19 KB
Newer Older
Diederik van Arkel's avatar
Diederik van Arkel committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18
/*
 * EdMessage.icl: message passing with the editor
 */

implementation module EdMessage

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

19 20
:: EditAction l a :== EditMonad (PSt l) a

Diederik van Arkel's avatar
Diederik van Arkel committed
21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45
openEditId :: *env -> (EditId, *env) | Ids env
openEditId pstate
  = openR2Id pstate

openEditReceiver :: !EditId -> Receiver2 Message Message EditState (PSt *l)
openEditReceiver editId
  = Receiver2 editId receive []

// receive a message from the outside world

receive :: Message (EditState, PSt *l) ->
		 (Message, (EditState, PSt *l))
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

hasEditState :: !EditId !*(PSt *l) -> *(Bool, *PSt *l)
hasEditState editId pstate
  # ((_, maybeResp), pstate) = syncSend2 editId MsgGet pstate
  = (isJust maybeResp, pstate)

46 47 48 49 50 51
// appEditState 

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

Diederik van Arkel's avatar
Diederik van Arkel committed
55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75
// getEditState 

getEditState :: !EditId !*(PSt *l) -> *(EditState, *PSt *l)
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"
  

setEditState :: !EditId !EditState !*(PSt *l) -> *PSt *l
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"