Skip to content
GitLab
Commit 4e65e7f6 authored by Peter Achten's avatar Peter Achten
Browse files

PA: Bug removed in syncSend(2).

parent 69ee3529
Hide whitespace changes
Inline Side-by-side
libraries/ObjectIO/ObjectIO/OS Windows/Windows_C_12/Windows_C_12.mak
View file @ 4e65e7f6
...@@ -55,25 +55,25 @@ ALL : "$(OUTDIR)\Windows_C_12.exe" "$(OUTDIR)\Windows_C_12.bsc" ...@@ -55,25 +55,25 @@ ALL : "$(OUTDIR)\Windows_C_12.exe" "$(OUTDIR)\Windows_C_12.bsc"
CLEAN : CLEAN :
-@erase ".\Release\Windows_C_12.bsc" -@erase ".\Release\Windows_C_12.bsc"
-@erase ".\Release\cCrossCall_12.sbr" -@erase ".\Release\cOSGameLib_12.sbr"
-@erase ".\Release\cdebug_12.sbr"
-@erase ".\Release\util_12.sbr"
-@erase ".\Release\cpicture_12.sbr"
-@erase ".\Release\ddutil.sbr" -@erase ".\Release\ddutil.sbr"
-@erase ".\Release\cGameLib_12.sbr"
-@erase ".\Release\cprinter_12.sbr" -@erase ".\Release\cprinter_12.sbr"
-@erase ".\Release\cCrossCall_12.sbr"
-@erase ".\Release\util_12.sbr"
-@erase ".\Release\cdebug_12.sbr"
-@erase ".\Release\Dsutil.sbr" -@erase ".\Release\Dsutil.sbr"
-@erase ".\Release\cOSGameLib_12.sbr" -@erase ".\Release\cGameLib_12.sbr"
-@erase ".\Release\cpicture_12.sbr"
-@erase ".\Release\Windows_C_12.exe" -@erase ".\Release\Windows_C_12.exe"
-@erase ".\Release\cOSGameLib_12.obj"
-@erase ".\Release\cCrossCall_12.obj"
-@erase ".\Release\cdebug_12.obj"
-@erase ".\Release\util_12.obj"
-@erase ".\Release\cpicture_12.obj" -@erase ".\Release\cpicture_12.obj"
-@erase ".\Release\cOSGameLib_12.obj"
-@erase ".\Release\ddutil.obj" -@erase ".\Release\ddutil.obj"
-@erase ".\Release\cGameLib_12.obj"
-@erase ".\Release\cprinter_12.obj" -@erase ".\Release\cprinter_12.obj"
-@erase ".\Release\cCrossCall_12.obj"
-@erase ".\Release\util_12.obj"
-@erase ".\Release\cdebug_12.obj"
-@erase ".\Release\Dsutil.obj" -@erase ".\Release\Dsutil.obj"
-@erase ".\Release\cGameLib_12.obj"
"$(OUTDIR)" : "$(OUTDIR)" :
if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)" if not exist "$(OUTDIR)/$(NULL)" mkdir "$(OUTDIR)"
...@@ -95,15 +95,15 @@ BSC32=bscmake.exe ...@@ -95,15 +95,15 @@ BSC32=bscmake.exe
# ADD BSC32 /nologo # ADD BSC32 /nologo
BSC32_FLAGS=/nologo /o"$(OUTDIR)/Windows_C_12.bsc" BSC32_FLAGS=/nologo /o"$(OUTDIR)/Windows_C_12.bsc"
BSC32_SBRS= \ BSC32_SBRS= \
"$(INTDIR)/cCrossCall_12.sbr" \ "$(INTDIR)/cOSGameLib_12.sbr" \
"$(INTDIR)/cdebug_12.sbr" \
"$(INTDIR)/util_12.sbr" \
"$(INTDIR)/cpicture_12.sbr" \
"$(INTDIR)/ddutil.sbr" \ "$(INTDIR)/ddutil.sbr" \
"$(INTDIR)/cGameLib_12.sbr" \
"$(INTDIR)/cprinter_12.sbr" \ "$(INTDIR)/cprinter_12.sbr" \
"$(INTDIR)/cCrossCall_12.sbr" \
"$(INTDIR)/util_12.sbr" \
"$(INTDIR)/cdebug_12.sbr" \
"$(INTDIR)/Dsutil.sbr" \ "$(INTDIR)/Dsutil.sbr" \
"$(INTDIR)/cOSGameLib_12.sbr" "$(INTDIR)/cGameLib_12.sbr" \
"$(INTDIR)/cpicture_12.sbr"
"$(OUTDIR)\Windows_C_12.bsc" : "$(OUTDIR)" $(BSC32_SBRS) "$(OUTDIR)\Windows_C_12.bsc" : "$(OUTDIR)" $(BSC32_SBRS)
$(BSC32) @<< $(BSC32) @<<
...@@ -119,15 +119,15 @@ LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ ...@@ -119,15 +119,15 @@ LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
/pdb:"$(OUTDIR)/Windows_C_12.pdb" /machine:I386\ /pdb:"$(OUTDIR)/Windows_C_12.pdb" /machine:I386\
/out:"$(OUTDIR)/Windows_C_12.exe" /out:"$(OUTDIR)/Windows_C_12.exe"
LINK32_OBJS= \ LINK32_OBJS= \
"$(INTDIR)/cOSGameLib_12.obj" \
"$(INTDIR)/cCrossCall_12.obj" \
"$(INTDIR)/cdebug_12.obj" \
"$(INTDIR)/util_12.obj" \
"$(INTDIR)/cpicture_12.obj" \ "$(INTDIR)/cpicture_12.obj" \
"$(INTDIR)/cOSGameLib_12.obj" \
"$(INTDIR)/ddutil.obj" \ "$(INTDIR)/ddutil.obj" \
"$(INTDIR)/cGameLib_12.obj" \
"$(INTDIR)/cprinter_12.obj" \ "$(INTDIR)/cprinter_12.obj" \
"$(INTDIR)/Dsutil.obj" "$(INTDIR)/cCrossCall_12.obj" \
"$(INTDIR)/util_12.obj" \
"$(INTDIR)/cdebug_12.obj" \
"$(INTDIR)/Dsutil.obj" \
"$(INTDIR)/cGameLib_12.obj"
"$(OUTDIR)\Windows_C_12.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) "$(OUTDIR)\Windows_C_12.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
$(LINK32) @<< $(LINK32) @<<
...@@ -155,15 +155,15 @@ CLEAN : ...@@ -155,15 +155,15 @@ CLEAN :
-@erase ".\Debug\vc40.pdb" -@erase ".\Debug\vc40.pdb"
-@erase ".\Debug\vc40.idb" -@erase ".\Debug\vc40.idb"
-@erase ".\Debug\Windows_C_12.exe" -@erase ".\Debug\Windows_C_12.exe"
-@erase ".\Debug\util_12.obj" -@erase ".\Debug\cCrossCall_12.obj"
-@erase ".\Debug\ddutil.obj"
-@erase ".\Debug\cpicture_12.obj" -@erase ".\Debug\cpicture_12.obj"
-@erase ".\Debug\cGameLib_12.obj" -@erase ".\Debug\cGameLib_12.obj"
-@erase ".\Debug\Dsutil.obj"
-@erase ".\Debug\cprinter_12.obj"
-@erase ".\Debug\cOSGameLib_12.obj" -@erase ".\Debug\cOSGameLib_12.obj"
-@erase ".\Debug\util_12.obj"
-@erase ".\Debug\cdebug_12.obj" -@erase ".\Debug\cdebug_12.obj"
-@erase ".\Debug\cCrossCall_12.obj"
-@erase ".\Debug\ddutil.obj"
-@erase ".\Debug\cprinter_12.obj"
-@erase ".\Debug\Dsutil.obj"
-@erase ".\Debug\Windows_C_12.ilk" -@erase ".\Debug\Windows_C_12.ilk"
-@erase ".\Debug\Windows_C_12.pdb" -@erase ".\Debug\Windows_C_12.pdb"
...@@ -195,15 +195,15 @@ LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ ...@@ -195,15 +195,15 @@ LINK32_FLAGS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\
/pdb:"$(OUTDIR)/Windows_C_12.pdb" /debug /machine:I386\ /pdb:"$(OUTDIR)/Windows_C_12.pdb" /debug /machine:I386\
/out:"$(OUTDIR)/Windows_C_12.exe" /out:"$(OUTDIR)/Windows_C_12.exe"
LINK32_OBJS= \ LINK32_OBJS= \
"$(INTDIR)/util_12.obj" \
"$(INTDIR)/cpicture_12.obj" \
"$(INTDIR)/cGameLib_12.obj" \
"$(INTDIR)/cOSGameLib_12.obj" \
"$(INTDIR)/cdebug_12.obj" \
"$(INTDIR)/cCrossCall_12.obj" \ "$(INTDIR)/cCrossCall_12.obj" \
"$(INTDIR)/ddutil.obj" \ "$(INTDIR)/ddutil.obj" \
"$(INTDIR)/cpicture_12.obj" \
"$(INTDIR)/cGameLib_12.obj" \
"$(INTDIR)/Dsutil.obj" \
"$(INTDIR)/cprinter_12.obj" \ "$(INTDIR)/cprinter_12.obj" \
"$(INTDIR)/Dsutil.obj" "$(INTDIR)/cOSGameLib_12.obj" \
"$(INTDIR)/util_12.obj" \
"$(INTDIR)/cdebug_12.obj"
"$(OUTDIR)\Windows_C_12.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS) "$(OUTDIR)\Windows_C_12.exe" : "$(OUTDIR)" $(DEF_FILE) $(LINK32_OBJS)
$(LINK32) @<< $(LINK32) @<<
...@@ -253,7 +253,8 @@ DEP_CPP_CCROS=\ ...@@ -253,7 +253,8 @@ DEP_CPP_CCROS=\
".\cCrossCall_12.h"\ ".\cCrossCall_12.h"\
".\cpicture_12.h"\ ".\cpicture_12.h"\
".\cGameLib_12.h"\ ".\cGameLib_12.h"\
".\cprinter_12.c"\ ".\cprinter_12.h"\
".\cTCP.h"\
{$(INCLUDE)}"\htmlhelp.h"\ {$(INCLUDE)}"\htmlhelp.h"\
".\util_12.h"\ ".\util_12.h"\
".\intrface_12.h"\ ".\intrface_12.h"\
...@@ -263,18 +264,15 @@ DEP_CPP_CCROS=\ ...@@ -263,18 +264,15 @@ DEP_CPP_CCROS=\
".\Ddutil.h"\ ".\Ddutil.h"\
".\Dsutil.h"\ ".\Dsutil.h"\
"\dx5sdk\sdk\inc\d3dtypes.h"\ "\dx5sdk\sdk\inc\d3dtypes.h"\
".\..\..\..\..\dx5sdk\sdk\inc\d3dvec.inl"\ "..\..\..\..\..\dx5sdk\sdk\inc\d3dvec.inl"\
".\cprinter_12.h"\
NODEP_CPP_CCROS=\ NODEP_CPP_CCROS=\
".\..\..\..\..\dx5sdk\sdk\inc\subwtype.h"\ "..\..\..\..\..\dx5sdk\sdk\inc\subwtype.h"\
"$(INTDIR)\cCrossCall_12.obj" : $(SOURCE) $(DEP_CPP_CCROS) "$(INTDIR)"\ "$(INTDIR)\cCrossCall_12.obj" : $(SOURCE) $(DEP_CPP_CCROS) "$(INTDIR)"
".\cprinter_12.c"
"$(INTDIR)\cCrossCall_12.sbr" : $(SOURCE) $(DEP_CPP_CCROS) "$(INTDIR)"\ "$(INTDIR)\cCrossCall_12.sbr" : $(SOURCE) $(DEP_CPP_CCROS) "$(INTDIR)"
".\cprinter_12.c"
!ELSEIF "$(CFG)" == "Windows_C_12 - Win32 Debug" !ELSEIF "$(CFG)" == "Windows_C_12 - Win32 Debug"
...@@ -283,18 +281,17 @@ DEP_CPP_CCROS=\ ...@@ -283,18 +281,17 @@ DEP_CPP_CCROS=\
".\cCrossCall_12.h"\ ".\cCrossCall_12.h"\
".\cpicture_12.h"\ ".\cpicture_12.h"\
".\cGameLib_12.h"\ ".\cGameLib_12.h"\
".\cprinter_12.c"\ ".\cprinter_12.h"\
".\cTCP.h"\
{$(INCLUDE)}"\htmlhelp.h"\ {$(INCLUDE)}"\htmlhelp.h"\
".\util_12.h"\ ".\util_12.h"\
".\intrface_12.h"\ ".\intrface_12.h"\
".\cOSGameLib_12.h"\ ".\cOSGameLib_12.h"\
".\Ddutil.h"\ ".\Ddutil.h"\
".\Dsutil.h"\ ".\Dsutil.h"\
".\cprinter_12.h"\
"$(INTDIR)\cCrossCall_12.obj" : $(SOURCE) $(DEP_CPP_CCROS) "$(INTDIR)"\ "$(INTDIR)\cCrossCall_12.obj" : $(SOURCE) $(DEP_CPP_CCROS) "$(INTDIR)"
".\cprinter_12.c"
!ENDIF !ENDIF
...@@ -426,10 +423,10 @@ DEP_CPP_CGAME=\ ...@@ -426,10 +423,10 @@ DEP_CPP_CGAME=\
".\Ddutil.h"\ ".\Ddutil.h"\
".\Dsutil.h"\ ".\Dsutil.h"\
"\dx5sdk\sdk\inc\d3dtypes.h"\ "\dx5sdk\sdk\inc\d3dtypes.h"\
".\..\..\..\..\dx5sdk\sdk\inc\d3dvec.inl"\ "..\..\..\..\..\dx5sdk\sdk\inc\d3dvec.inl"\
NODEP_CPP_CGAME=\ NODEP_CPP_CGAME=\
".\..\..\..\..\dx5sdk\sdk\inc\subwtype.h"\ "..\..\..\..\..\dx5sdk\sdk\inc\subwtype.h"\
"$(INTDIR)\cGameLib_12.obj" : $(SOURCE) $(DEP_CPP_CGAME) "$(INTDIR)" "$(INTDIR)\cGameLib_12.obj" : $(SOURCE) $(DEP_CPP_CGAME) "$(INTDIR)"
...@@ -470,10 +467,10 @@ DEP_CPP_COSGA=\ ...@@ -470,10 +467,10 @@ DEP_CPP_COSGA=\
".\Ddutil.h"\ ".\Ddutil.h"\
".\Dsutil.h"\ ".\Dsutil.h"\
"\dx5sdk\sdk\inc\d3dtypes.h"\ "\dx5sdk\sdk\inc\d3dtypes.h"\
".\..\..\..\..\dx5sdk\sdk\inc\d3dvec.inl"\ "..\..\..\..\..\dx5sdk\sdk\inc\d3dvec.inl"\
NODEP_CPP_COSGA=\ NODEP_CPP_COSGA=\
".\..\..\..\..\dx5sdk\sdk\inc\subwtype.h"\ "..\..\..\..\..\dx5sdk\sdk\inc\subwtype.h"\
"$(INTDIR)\cOSGameLib_12.obj" : $(SOURCE) $(DEP_CPP_COSGA) "$(INTDIR)" "$(INTDIR)\cOSGameLib_12.obj" : $(SOURCE) $(DEP_CPP_COSGA) "$(INTDIR)"
...@@ -538,10 +535,10 @@ DEP_CPP_DSUTI=\ ...@@ -538,10 +535,10 @@ DEP_CPP_DSUTI=\
".\Dsutil.h"\ ".\Dsutil.h"\
"\dx5sdk\sdk\inc\d3dtypes.h"\ "\dx5sdk\sdk\inc\d3dtypes.h"\
"\dx5sdk\sdk\inc\ddraw.h"\ "\dx5sdk\sdk\inc\ddraw.h"\
".\..\..\..\..\dx5sdk\sdk\inc\d3dvec.inl"\ "..\..\..\..\..\dx5sdk\sdk\inc\d3dvec.inl"\
NODEP_CPP_DSUTI=\ NODEP_CPP_DSUTI=\
".\..\..\..\..\dx5sdk\sdk\inc\subwtype.h"\ "..\..\..\..\..\dx5sdk\sdk\inc\subwtype.h"\
"$(INTDIR)\Dsutil.obj" : $(SOURCE) $(DEP_CPP_DSUTI) "$(INTDIR)" "$(INTDIR)\Dsutil.obj" : $(SOURCE) $(DEP_CPP_DSUTI) "$(INTDIR)"
......
libraries/ObjectIO/ObjectIO/StdReceiver.dcl
View file @ 4e65e7f6
...@@ -68,6 +68,7 @@ getReceiverSelectState :: ! Id !(IOSt .l .p) -> (!Maybe SelectState,!IOSt .l .p ...@@ -68,6 +68,7 @@ getReceiverSelectState :: ! Id !(IOSt .l .p) -> (!Maybe SelectState,!IOSt .l .p
| SendUnknownReceiver | SendUnknownReceiver
| SendUnableReceiver | SendUnableReceiver
| SendDeadlock | SendDeadlock
| OtherSendReport !String
instance == SendReport instance == SendReport
instance toString SendReport instance toString SendReport
......
libraries/ObjectIO/ObjectIO/StdReceiver.icl
View file @ 4e65e7f6
...@@ -273,28 +273,33 @@ where ...@@ -273,28 +273,33 @@ where
| SendUnknownReceiver | SendUnknownReceiver
| SendUnableReceiver | SendUnableReceiver
| SendDeadlock | SendDeadlock
| OtherSendReport !String
instance == SendReport where instance == SendReport where
(==) :: !SendReport !SendReport -> Bool (==) :: !SendReport !SendReport -> Bool
(==) SendOk report = case report of (==) SendOk report = case report of
SendOk -> True SendOk -> True
_ -> False _ -> False
(==) SendUnknownReceiver report = case report of (==) SendUnknownReceiver report = case report of
SendUnknownReceiver -> True SendUnknownReceiver -> True
_ -> False _ -> False
(==) SendUnableReceiver report = case report of (==) SendUnableReceiver report = case report of
SendUnableReceiver -> True SendUnableReceiver -> True
_ -> False _ -> False
(==) SendDeadlock report = case report of (==) SendDeadlock report = case report of
SendDeadlock -> True SendDeadlock -> True
_ -> False _ -> False
(==) (OtherSendReport s1) report = case report of
OtherSendReport s2 -> s1==s2
_ -> False
instance toString SendReport where instance toString SendReport where
toString :: !SendReport -> {#Char} toString :: !SendReport -> {#Char}
toString SendOk = "SendOk" toString SendOk = "SendOk"
toString SendUnknownReceiver= "SendUnknownReceiver" toString SendUnknownReceiver = "SendUnknownReceiver"
toString SendUnableReceiver = "SendUnableReceiver" toString SendUnableReceiver = "SendUnableReceiver"
toString SendDeadlock = "SendDeadlock" toString SendDeadlock = "SendDeadlock"
toString (OtherSendReport s) = "(OtherSendReport "+++s+++")"
/* Asynchronous, uni-directional, message passing. /* Asynchronous, uni-directional, message passing.
...@@ -409,8 +414,11 @@ syncSend2 r2id msg pState ...@@ -409,8 +414,11 @@ syncSend2 r2id msg pState
= ((toSendError (fromJust opt_error),Nothing),pState) = ((toSendError (fromJust opt_error),Nothing),pState)
| isEmpty resp | isEmpty resp
= StdReceiverFatalError "syncSend2" "no response received from bi-directional receiver" = StdReceiverFatalError "syncSend2" "no response received from bi-directional receiver"
# maybe_response = readDynamic (R2IdtoDId` r2id) (hd resp)
| isNothing maybe_response
= ((OtherSendReport "incorrect response received from bi-directional receiver",Nothing),pState)
| otherwise | otherwise
= ((SendOk,Just (readDynamic (R2IdtoDId` r2id) (hd resp))),pState) = ((SendOk,maybe_response),pState)
where where
PStHandleSync2Message :: !(DId resp) !SyncMessage !(PSt .l .p) -> (!(!SendReport,!Maybe resp), !PSt .l .p) PStHandleSync2Message :: !(DId resp) !SyncMessage !(PSt .l .p) -> (!(!SendReport,!Maybe resp), !PSt .l .p)
PStHandleSync2Message did sm pState PStHandleSync2Message did sm pState
...@@ -421,12 +429,18 @@ where ...@@ -421,12 +429,18 @@ where
_ -> StdReceiverFatalError "syncSend2" "unexpected scheduler event" _ -> StdReceiverFatalError "syncSend2" "unexpected scheduler event"
errors = sm.smError errors = sm.smError
resps = sm.smResp resps = sm.smResp
resp = if (isEmpty resps ) Nothing (Just (readDynamic did (hd resps))) | not (isEmpty errors)
report = if (isEmpty errors) SendOk (case (hd errors) of # sendReport = case (hd errors) of
ReceiverUnable -> SendUnableReceiver ReceiverUnable -> SendUnableReceiver
ReceiverUnknown -> SendUnknownReceiver ReceiverUnknown -> SendUnknownReceiver
) = ((sendReport,Nothing),pState)
= ((report,resp),pState) | isEmpty resps
= StdReceiverFatalError "syncSend2" "no response received from bi-directional receiver"
# maybe_response = readDynamic did (hd resps)
| isNothing maybe_response
= ((OtherSendReport "incorrect response received from bi-directional receiver",Nothing),pState)
| otherwise
= ((SendOk,maybe_response),pState)
toSendError :: !SwitchError -> SendReport toSendError :: !SwitchError -> SendReport
toSendError SwitchToYourself = SendUnknownReceiver toSendError SwitchToYourself = SendUnknownReceiver
......
libraries/ObjectIO/ObjectIO/id.icl
View file @ 4e65e7f6
...@@ -101,8 +101,7 @@ isSpecialId :: !Id -> Bool ...@@ -101,8 +101,7 @@ isSpecialId :: !Id -> Bool
isSpecialId (SpecialId _) = True isSpecialId (SpecialId _) = True
isSpecialId _ = False isSpecialId _ = False
instance == Id instance == Id where
where
(==) :: !Id !Id -> Bool (==) :: !Id !Id -> Bool
(==) (CustomId id1) id = case id of (==) (CustomId id1) id = case id of
(CustomId id2) -> id1==id2 (CustomId id2) -> id1==id2
......
libraries/ObjectIO/ObjectIO/receiverhandle.icl
View file @ 4e65e7f6
...@@ -5,7 +5,7 @@ implementation module receiverhandle ...@@ -5,7 +5,7 @@ implementation module receiverhandle
import StdBool, StdInt, StdList import StdBool, StdInt, StdList
import receivermessage, semidynamic import cast, receivermessage, semidynamic
from ostoolbox import OSToolbox // MW11++ from ostoolbox import OSToolbox // MW11++
...@@ -39,18 +39,6 @@ from ostoolbox import OSToolbox // MW11++ ...@@ -39,18 +39,6 @@ from ostoolbox import OSToolbox // MW11++
:: InetReceiverCategory` :== Int :: InetReceiverCategory` :== Int
// ..MW11 // ..MW11
/* Conversion functions:
Cast contains abc code because it can't be typed conventionally.
The function Cast is required to break the Existential Type abstraction needed
for message passing. (JVG/RWS)
*/
Cast :: !a -> b
Cast a
= code
{
pop_a 0
}
receiverIdentified :: !Id !(ReceiverHandle .ls .pst) -> Bool receiverIdentified :: !Id !(ReceiverHandle .ls .pst) -> Bool
receiverIdentified id {rId} receiverIdentified id {rId}
= id==rId = id==rId
...@@ -79,14 +67,23 @@ receiverHandleSyncMessage :: !SyncMessage !(ReceiverHandle .ls .pst) (.ls,.pst) ...@@ -79,14 +67,23 @@ receiverHandleSyncMessage :: !SyncMessage !(ReceiverHandle .ls .pst) (.ls,.pst)
receiverHandleSyncMessage {smRecLoc={rlReceiverId},smMsg} rH=:{rFun} context receiverHandleSyncMessage {smRecLoc={rlReceiverId},smMsg} rH=:{rFun} context
| not (receiverIdentified rlReceiverId rH) | not (receiverIdentified rlReceiverId rH)
= ([],rH,context) = ([],rH,context)
| otherwise # maybe_content = getDynamic rlReceiverId smMsg
# (ls,resp,pst) = rFun (Cast (getDynamic rlReceiverId smMsg)) context | isNothing maybe_content
= ([setDynamic rlReceiverId resp smMsg],rH,(ls,pst)) = ([],rH,context)
# (ls,resp,pst) = rFun (Cast (fromJust maybe_content)) context
| 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 !SemiDynamic !(ReceiverHandle .ls .pst) -> ReceiverHandle .ls .pst
receiverAddASyncMessage id sd rH=:{rASMQ} receiverAddASyncMessage id sd rH=:{rASMQ}
| receiverIdentified id rH | receiverIdentified id rH
= {rH & rASMQ=rASMQ++[Cast (getDynamic id sd)]} # maybe_content = getDynamic id sd
| isNothing maybe_content
= rH
// otherwise
= {rH & rASMQ=rASMQ++[Cast (fromJust maybe_content)]}
| otherwise | otherwise
= rH = rH
......
libraries/ObjectIO/ObjectIO/semidynamic.dcl
View file @ 4e65e7f6
...@@ -27,8 +27,8 @@ import id ...@@ -27,8 +27,8 @@ import id
*/ */
openDynamic :: !(DId m) m -> SemiDynamic openDynamic :: !(DId m) m -> SemiDynamic
matchDynamic:: !(DId m) !SemiDynamic -> Bool matchDynamic:: !(DId m) !SemiDynamic -> Bool
readDynamic :: !(DId m) !SemiDynamic -> m readDynamic :: !(DId m) !SemiDynamic -> Maybe m
getDynamic :: !Id !SemiDynamic -> m getDynamic :: !Id !SemiDynamic -> Maybe m
setDynamic :: !Id m !SemiDynamic -> SemiDynamic setDynamic :: !Id m !SemiDynamic -> SemiDynamic
RIdtoDId :: !(RId m ) -> DId m RIdtoDId :: !(RId m ) -> DId m
......
libraries/ObjectIO/ObjectIO/semidynamic.icl
View file @ 4e65e7f6
...@@ -6,7 +6,7 @@ implementation module semidynamic ...@@ -6,7 +6,7 @@ implementation module semidynamic
*/ */
import StdBool import StdBool
import commondef, id import cast, commondef, id
semidynamicFatalError :: String String -> .x semidynamicFatalError :: String String -> .x
semidynamicFatalError function error semidynamicFatalError function error
...@@ -26,19 +26,19 @@ openDynamic did x = {value=x,id=did} ...@@ -26,19 +26,19 @@ openDynamic did x = {value=x,id=did}
matchDynamic :: !(DId m) !SemiDynamic -> Bool matchDynamic :: !(DId m) !SemiDynamic -> Bool
matchDynamic did {id} = did==id matchDynamic did {id} = did==id
readDynamic :: !(DId m) !SemiDynamic -> m readDynamic :: !(DId m) !SemiDynamic -> Maybe m
readDynamic did {value,id} readDynamic did {value,id}
| did==id | did==id
= Cast value = Just (Cast value)
| otherwise | otherwise
= semidynamicFatalError "readDynamic" "SemiDynamic did not match argument DId" = Nothing
getDynamic :: !Id !SemiDynamic -> m getDynamic :: !Id !SemiDynamic -> Maybe m
getDynamic did {value,id} getDynamic did {value,id}
| did==id | did==id
= Cast value = Just (Cast value)
| otherwise | otherwise
= semidynamicFatalError "getDynamic" "SemiDynamic did not match argument Id" = Nothing
setDynamic :: !Id m !SemiDynamic -> SemiDynamic setDynamic :: !Id m !SemiDynamic -> SemiDynamic
setDynamic did x sd=:{id} setDynamic did x sd=:{id}
...@@ -58,14 +58,3 @@ R2IdtoDId` r2id = R2IdtoId r2id ...@@ -58,14 +58,3 @@ R2IdtoDId` r2id = R2IdtoId r2id
DIdtoId :: !(DId m) -> Id DIdtoId :: !(DId m) -> Id
DIdtoId did = did