Control Structures
These are examples of control structures. You may also be interested in:

 Conditional structures
 Exceptions
 Flow-control structures
 Loops

This task is to give an example of an exception handling routine
and to "throw" a new exception.



Related task

   Exceptions Through Nested Calls


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