IPErrorImpl.mesa
Errors and Signals known throughout the Interpress interpreter
Last edited by:
Doug Wyatt, March 7, 1984 3:21:50 pm PST
DIRECTORY
IO USING [atom, PutF, rope, STREAM],
IP USING [Get, Integer, IntegerFromAny, MasterErrorType, MasterWarningType, PopInteger, PopVector, Shape, State, Vector, VectorShape],
IPBase USING [],
List USING [AList, Assoc, PutAssoc],
ProcessProps USING [AddPropList, GetPropList],
Rope USING [FromProc, ROPE];
IPErrorImpl: CEDAR PROGRAM
IMPORTS IO, IP, List, ProcessProps, Rope
EXPORTS IP, IPBase
~ BEGIN OPEN IP;
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
Error: PUBLIC ERROR ~ CODE;
stateProp: ATOM ~ $InterpressState;
CallWithStateOnPropList:
PUBLIC
PROC[self: State, inner:
PROC] ~ {
propList: List.AList ~ List.PutAssoc[key: stateProp, val: self, aList: NIL];
ProcessProps.AddPropList[propList, inner];
};
GetState:
PROC
RETURNS[State] ~ {
RETURN[NARROW[List.Assoc[key: stateProp, aList: ProcessProps.GetPropList[]]]];
};
ErrorClass:
TYPE ~ {nil,
masterError, masterWarning,
appearanceError, appearanceWarning,
comment
};
RopeFromClass:
PROC[class: ErrorClass]
RETURNS[
ROPE] ~ {
RETURN[
SELECT class
FROM
masterError => "Master Error",
masterWarning => "Master Warning",
appearanceError => "Appearance Error",
appearanceWarning => "Appearance Warning",
comment => "Comment",
ENDCASE => NIL];
};
LogError:
PROC[class: ErrorClass, code:
ATOM, explanation:
ROPE] ~ {
self: State ~ GetState[];
IF self#
NIL
THEN {
log: STREAM ~ self.log;
IF log=NIL THEN RETURN;
log.PutF["%g (%g):\n", IO.rope[RopeFromClass[class]], IO.atom[code]];
log.PutF[" %g\n", IO.rope[explanation]];
};
};
NonDefaultingATOM: TYPE ~ ATOM ←
MasterErrorCodeTable: TYPE ~ ARRAY MasterErrorType OF NonDefaultingATOM;
MasterWarningCodeTable: TYPE ~ ARRAY MasterWarningType OF NonDefaultingATOM;
masterErrorCode: REF MasterErrorCodeTable ~ NEW[MasterErrorCodeTable ← [bug: $bug, unimplemented: $unimplemented, boundsFault: $boundsFault, nilFault: $nilFault, invalidArgs: $invalidArgs, limitExceeded: $limitExceeded, markMismatch: $markMismatch, missingBody: $missingBody, notInteger: $notInteger, stackOverflow: $stackOverflow, stackUnderflow: $stackUnderflow, undefinedOperation: $undefinedOperation, undefinedProperty: $undefinedProperty, unmarkFailed: $unmarkFailed, wrongType: $wrongType]];
masterWarningCode: REF MasterWarningCodeTable ~ NEW[MasterWarningCodeTable ← [bug: $bug, unimplemented: $unimplemented, nullValue: $nullValue, illegalIdentifier: $illegalIdentifier, illegalString: $illegalString]];
MasterError:
PUBLIC
PROC[type: MasterErrorType, explanation:
ROPE ←,
raiseError: BOOL ← TRUE] ~ {
LogError[$masterError, masterErrorCode[type], explanation];
IF raiseError THEN ERROR Error;
};
MasterWarning:
PUBLIC
PROC[type: MasterWarningType, explanation:
ROPE ←] ~ {
LogError[$masterWarning, masterWarningCode[type], explanation];
};
AppearanceError:
PUBLIC
PROC[code:
ATOM, explanation:
ROPE ←] ~ {
LogError[$appearanceError, code, explanation];
};
AppearanceWarning:
PUBLIC
PROC[code:
ATOM, explanation:
ROPE ←] ~ {
LogError[$appearanceWarning, code, explanation];
};
RopeFromVector:
PUBLIC
PROC[v: Vector]
RETURNS[
ROPE] ~ {
shape: VectorShape ~ Shape[v];
i: Integer ← shape.l;
p:
PROC
RETURNS[
CHAR] ~ {
n: Integer ~ IntegerFromAny[Get[v, i]]; i ← i+1;
IF n IN[0..255] THEN RETURN[0C+n]
ELSE { MasterError[$boundsFault, "Ascii character not in [0..255]."]; RETURN[0C] };
};
RETURN[Rope.FromProc[len: shape.n, p: p]];
};
ApplyERROR:
PUBLIC
PROC[self: State] ~ {
code: Integer ~ PopInteger[self];
message: Vector ~ PopVector[self];
class: ErrorClass ~ (
SELECT code
FROM
0 => $masterError, 10 => $masterWarning,
50 => $appearanceError, 60 => $appearanceWarning,
100 => $comment, ENDCASE => nil);
LogError[class, $ERROR, RopeFromVector[message]];
IF class=$masterError THEN ERROR Error;
};
END.