CDFeatureCheckImpl.mesa
Copyright © 1986 by Xerox Corporation. All rights reserved.
Jacobi, December 12, 1985 2:19:57 pm PST
Jacobi, March 28, 1986 6:34:05 pm PST
This tool allows the user to check whether certain features are used or not. It can be used as a mean for subclassing technologies.
DIRECTORY
CD,
CDBottomUp,
CDCells,
CDCommandOps,
CDDirectory,
CDMenus,
CDImports,
CDOps,
CDProperties,
CDSequencer,
IO,
RefTab,
Rope,
TerminalIO;
CDFeatureCheckImpl: CEDAR PROGRAM
IMPORTS CD, CDBottomUp, CDCells, CDCommandOps, CDDirectory, CDImports, CDMenus, CDOps, CDProperties, CDSequencer, RefTab, Rope, TerminalIO =
BEGIN
MsgProc: TYPE = PROC [ob: CD.Object] RETURNS [msg: Rope.ROPENIL];
State: TYPE = RefTab.Ref;
FeatureTab: PROC [state: State] RETURNS [featureTab: RefTab.Ref] = INLINE {
featureTab ← NARROW[state];
};
ReadOnlyCell: PROC [ob: CD.Object] RETURNS [readOnlyCell: CD.Object←NIL] =
BEGIN
readOnlyCell ← ob;
WHILE ob#NIL AND ob.class.inDirectory AND ~CDCells.IsCell[ob] DO
readOnlyCell ← CDDirectory.Expand[ob, NIL, NIL, FALSE].new;
IF readOnlyCell=ob OR readOnlyCell=NIL THEN
readOnlyCell ← CDDirectory.ExpandByDraw[ob];
ob ← readOnlyCell;
ENDLOOP;
END;
CheckClass: PROC [ob: CD.Object] RETURNS [msg: Rope.ROPENIL] =
--this is independent of particular design rules
BEGIN
WITH CDProperties.GetObjectProp[ob, $CDFeatureCheck] SELECT FROM
mp: REF MsgProc => RETURN [mp[ob]];
r: Rope.ROPE => RETURN [r];
ENDCASE =>
WITH CDProperties.GetProp[ob.class, $CDFeatureCheck] SELECT FROM
mp: REF MsgProc => RETURN [mp[ob]];
ENDCASE => RETURN [NIL]
END;
BadLayer: PROC [ob: CD.Object] RETURNS [msg: Rope.ROPE] = {
msg ← Rope.Cat["layer ", CDOps.LayerName[ob.layer], " used in ", CDOps.ObjectInfo[ob]]
};
CheckContainer: PROC [state: State, ob: CD.Object] RETURNS [msg: Rope.ROPENIL] =
BEGIN
recurse: BOOLFALSE;
mustCheckLayer: BOOLFALSE;
layerFound: BOOLFALSE;
CheckRef: PROC [val: REF] =
BEGIN
IF val=NIL THEN {
IF ~ob.class.inDirectory AND ~ob.class.symbolic THEN {
IF recurse
OR (val←RefTab.Fetch[FeatureTab[state], $CDFeatureCheckOthers].val)#NIL THEN
msg ← Rope.Cat["class not enabled: ", CDOps.ObjectInfo[ob]]
ELSE {recurse ← TRUE; CheckRef[val]}
};
}
ELSE WITH val SELECT FROM
a: ATOM => {
IF a=$T THEN layerFound ← TRUE
ELSE IF a=CD.LayerKey[ob.layer] THEN layerFound ← TRUE
ELSE mustCheckLayer ← TRUE
};
lora: LIST OF REF ANY =>
FOR l: LIST OF REF ANY ← lora, l.rest WHILE (l#NIL AND msg=NIL) DO
CheckRef[l.first];
ENDLOOP;
loa: LIST OF ATOM => {layerKey: ATOM ~ CD.LayerKey[ob.layer];
FOR ll: LIST OF ATOM ← loa, ll.rest WHILE ll#NIL DO
IF layerKey=ll.first OR ll.first=$T THEN {layerFound ← TRUE; EXIT};
ENDLOOP;
mustCheckLayer ← TRUE;
};
mp: REF MsgProc => msg ← mp[ob];
rp: REF CD.Rect => {
sz: CD.Position ← CD.InterestSize[ob];
IF sz.x<rp.x1 OR sz.y<rp.y1 THEN msg ← Rope.Cat[CDOps.ObjectInfo[ob], " too small"];
IF sz.x>rp.x2 OR sz.y>rp.y2 THEN msg ← Rope.Cat[CDOps.ObjectInfo[ob], " too large"];
};
r: Rope.ROPE => IF ~Rope.IsEmpty[r] THEN msg ← Rope.Cat[CDOps.ObjectInfo[ob], " ", r];
ENDCASE => msg ← Rope.Cat["class forbidden: ", CDOps.ObjectInfo[ob]];
END;
CheckRef[RefTab.Fetch[FeatureTab[state], ob.class.objectType].val];
IF Rope.IsEmpty[msg] AND mustCheckLayer AND ~layerFound THEN msg ← BadLayer[ob];
IF Rope.IsEmpty[msg] THEN msg ← CheckClass[ob];
IF Rope.IsEmpty[msg] THEN msg ← NIL;
END;
CheckTopChilds: PROC [state: State, ob: CD.Object] RETURNS [msg: Rope.ROPENIL] =
BEGIN
cnt: INT ← 0;
ob1: CD.Object ← ReadOnlyCell[ob];
IF ob1=NIL THEN msg ← "failed to expand"
ELSE {
cp: CD.CellPtr ← NARROW[ob1.specificRef];
FOR l: CD.InstanceList ← cp.contents, l.rest WHILE l#NIL DO
IF ~l.first.ob.class.inDirectory THEN {
msg1: Rope.ROPE ← CheckContainer[state, l.first.ob];
IF msg1#NIL THEN {
cnt ← cnt+1;
IF cnt<4 THEN msg ← Rope.Cat[msg, "\n | ", msg1]
ELSE IF cnt=4 THEN msg ← Rope.Cat[msg, "\n |"]
ELSE msg ← Rope.Cat[msg, "|"]
};
}
ENDLOOP;
};
END;
CheckOneLevel: PROC [state: State, ob: CD.Object] RETURNS [msg: Rope.ROPENIL] =
BEGIN
msg ← CheckContainer[state, ob];
IF Rope.IsEmpty[msg] THEN msg ← CheckTopChilds[state, ob];
END;
DoExt: CDBottomUp.DoProc =
BEGIN
msg: Rope.ROPE ← NIL;
IF CDImports.IsImport[ob] THEN {
ip: CDImports.ImportPtr ← NARROW[ob.specificRef];
IF ip.boundInstance#NIL THEN [] ← handle.DoRecurse[ip.boundInstance.ob]
ELSE msg ← "not bound";
};
TerminalIO.WriteRopes["checking ", CDOps.ObjectInfo[ob]];
IF msg=NIL THEN msg ← CheckOneLevel[NARROW[handle.data], ob];
IF msg=NIL THEN TerminalIO.WriteRope[" ok\n"]
ELSE {
handle.cnt ← handle.cnt+1;
TerminalIO.WriteRopes["\n ** ", msg, "\n"]
};
val ← msg;
IF handle.design#NIL THEN CDSequencer.CheckAborted[handle.design];
END;
ReUseExt: CDBottomUp.ReUseProc =
BEGIN
TerminalIO.WriteRopes["previously checked ", CDOps.ObjectInfo[ob]];
WITH previousVal SELECT FROM
r: Rope.ROPE => {
handle.cnt ← handle.cnt+1;
TerminalIO.WriteRopes["\n ** ", r, "\n"]
};
ENDCASE => TerminalIO.WriteRope[" ok\n"];
IF handle.design#NIL THEN CDSequencer.CheckAborted[handle.design];
END;
HierarchicalFeatureCheckComm: PROC [comm: CDSequencer.Command] =
BEGIN
HierarchicalFeatureCheck: PROC [featureChecker: CDBottomUp.Class, design: CD.Design, state: RefTab.Ref, ob: CD.Object] =
BEGIN
h: CDBottomUp.Handle ← CDBottomUp.StartRecurse[featureChecker, design, ob, state].handle;
IF h.cnt=0 THEN TerminalIO.WriteRope["no errors found\n"]
ELSE TerminalIO.WriteF1["error(s) found in %g object(s)\n", [integer[h.cnt]]]
END;
inst: CD.Instance ← CDCommandOps.TheInstance[comm, "Hierarchical feature checking"];
IF inst#NIL THEN {
IF ~inst.ob.class.inDirectory THEN {
TerminalIO.WriteRopes[" object not composed\n"];
RETURN
};
WITH CDProperties.GetAtomProp[$CDFeatureCheck, $CDFeatureCheck] SELECT FROM
rt: RefTab.Ref => {
featureChecker: CDBottomUp.Class;
key: REF ← rt.Fetch[$CDFeatureCheckKey].val;
text: Rope.ROPE ← CDCommandOps.ToRope[rt.Fetch[$CDFeatureCheckName].val];
IF key=NIL THEN key←NEW[INT];
TerminalIO.WriteRopes["feature set used: [", text, "]\n"];
IF ISTYPE[key, ATOM] THEN
TerminalIO.WriteRopes[" [ key = ", CDCommandOps.ToRope[key], " ]\n"];
featureChecker ← CDBottomUp.Register[DoExt, ReUseExt, key, $CDFeatureCheck
! CD.Error => GOTO oops];
HierarchicalFeatureCheck[featureChecker, comm.design, rt, inst.ob];
};
ENDCASE => TerminalIO.WriteRope[" no feature table is assigned\n"]
}
EXITS oops => TerminalIO.WriteRope[" failed to read parameters from atom\n"]
END;
CDMenus.ImplementEntryCommand[menu: $ProgramMenu, entry: "Feature checking", p: HierarchicalFeatureCheckComm, key: $HFCheck];
END.