120 lines
4.5 KiB
Plaintext
120 lines
4.5 KiB
Plaintext
COMMENT
|
|
Define an general event handling mechanism on MODE OBJ:
|
|
* try to parallel pythons exception handling flexibility
|
|
END COMMENT
|
|
|
|
COMMENT
|
|
REQUIRES:
|
|
MODE OBJ # These can be a UNION of REF types #
|
|
OP OBJIS
|
|
PROVIDES:
|
|
OP ON, RAISE, RESET
|
|
PROC obj on, obj raise, obj reset
|
|
END COMMENT
|
|
|
|
# define object related to OBJ EVENTS #
|
|
MODE
|
|
RAISEOBJ = PROC(OBJ)VOID, RAWMENDOBJ = PROC(OBJ)BOOL,
|
|
MENDOBJ = UNION(RAWMENDOBJ, PROC VOID), # Generalise: Allow PROC VOID (a GOTO) as a short hand #
|
|
NEWSCOPEOBJ = STRUCT(REF NEWSCOPEOBJ up, FLEXOBJ obj flex, FLEXEVENTOBJ event flex, MENDOBJ mended),
|
|
SCOPEOBJ = REF NEWSCOPEOBJ;
|
|
|
|
MODE FLEXOBJ=FLEX[0]OBJ;
|
|
|
|
# Provide an INIT to convert a GO TO to a MEND ... useful for direct aborts #
|
|
OP INITMENDOBJ = (PROC VOID go to)MENDOBJ: (go to; SKIP);
|
|
|
|
SCOPEOBJ obj scope end = NIL;
|
|
SCOPEOBJ obj scope begin := obj scope end; # INITialise stack #
|
|
OBJ obj any = EMPTY;
|
|
EVENTOBJ obj event any = NIL;
|
|
|
|
# Some crude Singly Linked-List manipulations of the scopes, aka stack ... #
|
|
# An event/mended can be shared for all OBJ of the same type: #
|
|
PRIO INITAB = 1, +=: = 1;
|
|
OP INITAB = (SCOPEOBJ lhs, MENDOBJ obj mend)SCOPEOBJ:
|
|
lhs := (obj scope end, obj any, obj event any, obj mend);
|
|
|
|
OP INITSCOPE = (MENDOBJ obj mend)SCOPEOBJ: HEAP NEWSCOPEOBJ INITAB obj mend;
|
|
OP +=: = (SCOPEOBJ item, REF SCOPEOBJ rhs)SCOPEOBJ: ( up OF item := rhs; rhs := item );
|
|
OP +=: = (MENDOBJ mend, REF SCOPEOBJ rhs)SCOPEOBJ: INITSCOPE mend +=: rhs;
|
|
#OP -=: = (REF SCOPEOBJ scope)SCOPEOBJ: scope := up OF scope;#
|
|
|
|
COMMENT Restore the prio event scope: ~ END COMMENT
|
|
PROC obj reset = (SCOPEOBJ up scope)VOID: obj scope begin := up scope;
|
|
MENDOBJ obj unmendable = (OBJ obj)BOOL: FALSE;
|
|
|
|
MODE NEWEVENTOBJ = STRUCT( # the is simple a typed place holder #
|
|
SCOPEOBJ scope,
|
|
STRING description,
|
|
PROC (OBJ #obj#, MENDOBJ #obj mend#)SCOPEOBJ on,
|
|
PROC (OBJ #obj#, STRING #msg#)VOID raise
|
|
), EVENTOBJ = REF NEWEVENTOBJ;
|
|
|
|
MODE FLEXEVENTOBJ = FLEX[0]EVENTOBJ;
|
|
|
|
COMMENT Define how to catch an event:
|
|
obj - IF obj IS NIL then mend event on all OBJects
|
|
obj mend - PROC to call to repair the object
|
|
return the prior event scope
|
|
END COMMENT
|
|
PROC obj on = (FLEXOBJ obj flex, FLEXEVENTOBJ event flex, MENDOBJ mend)SCOPEOBJ: (
|
|
mend +=: obj scope begin;
|
|
IF obj any ISNTIN obj flex THEN obj flex OF obj scope begin := obj flex FI;
|
|
IF obj event any ISNTIN event flex THEN event flex OF obj scope begin := event flex FI;
|
|
up OF obj scope begin
|
|
);
|
|
|
|
PRIO OBJIS = 4, OBJISNT = 4; # pick the same PRIOrity as EQ and NE #
|
|
OP OBJISNT = (OBJ a,b)BOOL: NOT(a OBJIS b);
|
|
|
|
PRIO ISIN = 4, ISNTIN = 4;
|
|
OP ISNTIN = (OBJ obj, FLEXOBJ obj flex)BOOL: (
|
|
BOOL isnt in := FALSE;
|
|
FOR i TO UPB obj flex WHILE isnt in := obj OBJISNT obj flex[i] DO SKIP OD;
|
|
isnt in
|
|
);
|
|
OP ISIN = (OBJ obj, FLEXOBJ obj flex)BOOL: NOT(obj ISNTIN obj flex);
|
|
|
|
OP ISNTIN = (EVENTOBJ event, FLEXEVENTOBJ event flex)BOOL: (
|
|
BOOL isnt in := TRUE;
|
|
FOR i TO UPB event flex WHILE isnt in := event ISNT event flex[i] DO SKIP OD;
|
|
isnt in
|
|
);
|
|
OP ISIN = (EVENTOBJ event, FLEXEVENTOBJ event flex)BOOL: NOT(event ISNTIN event flex);
|
|
|
|
COMMENT Define how to raise an event, once it is raised try and mend it:
|
|
if all else fails produce an error message and stop
|
|
END COMMENT
|
|
PROC obj raise = (OBJ obj, EVENTOBJ event, STRING msg)VOID:(
|
|
SCOPEOBJ this scope := obj scope begin;
|
|
# until mended this event should cascade through scope event handlers/members #
|
|
FOR i WHILE this scope ISNT SCOPEOBJ(obj scope end) DO
|
|
IF (obj any ISIN obj flex OF this scope OR obj ISIN obj flex OF this scope ) AND
|
|
(obj event any ISIN event flex OF this scope OR event ISIN event flex OF this scope)
|
|
THEN
|
|
CASE mended OF this scope IN
|
|
(RAWMENDOBJ mend):IF mend(obj) THEN break mended FI,
|
|
(PROC VOID go to): (go to; stop)
|
|
OUT put(stand error, "undefined: raise stop"); stop
|
|
ESAC
|
|
FI;
|
|
this scope := up OF this scope
|
|
OD;
|
|
put(stand error, ("OBJ event: ",msg)); stop; FALSE
|
|
EXIT
|
|
break mended: TRUE
|
|
);
|
|
|
|
CO define ON and some useful(?) RAISE OPs CO
|
|
PRIO ON = 1, RAISE = 1;
|
|
OP ON = (MENDOBJ mend, EVENTOBJ event)SCOPEOBJ: obj on(obj any, event, mend),
|
|
RAISE = (OBJ obj, EVENTOBJ event)VOID: obj raise(obj, event, "unnamed event"),
|
|
RAISE = (OBJ obj, MENDOBJ mend)VOID: ( mend ON obj event any; obj RAISE obj event any),
|
|
RAISE = (EVENTOBJ event)VOID: obj raise(obj any, event, "unnamed event"),
|
|
RAISE = (MENDOBJ mend)VOID: ( mend ON obj event any; RAISE obj event any),
|
|
RAISE = (STRING msg, EVENTOBJ event)VOID: obj raise(obj any, event, msg);
|
|
OP (SCOPEOBJ #up scope#)VOID RESET = obj reset;
|
|
|
|
SKIP
|