
<<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.