CDFeatureCheckImpl.mesa
Copyright © 1986 by Xerox Corporation. All rights reserved.
Created by Christian Jacobi, December 12, 1985 2:19:57 pm PST
Last edited by: Christian Jacobi, October 30, 1986 1:55:06 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,
CDImports,
CDOps,
CDProperties,
CDSequencer,
IO,
RefTab,
Rope,
TerminalIO;
CDFeatureCheckImpl:
CEDAR
PROGRAM
IMPORTS CD, CDBottomUp, CDCells, CDCommandOps, CDDirectory, CDImports, CDOps, CDProperties, CDSequencer, RefTab, Rope, TerminalIO =
BEGIN
MsgProc: TYPE = PROC [ob: CD.Object] RETURNS [msg: Rope.ROPE←NIL];
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.
ROPE←
NIL] =
--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.LayerRope[ob.layer], " used in ", CDOps.ObjectRope[ob]]
};
CheckContainer:
PROC [state: State, ob:
CD.Object]
RETURNS [msg: Rope.
ROPE ←
NIL] =
BEGIN
recurse: BOOL←FALSE;
mustCheckLayer: BOOL←FALSE;
layerFound: BOOL←FALSE;
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.ObjectRope[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.ObjectRope[ob], " too small"];
IF sz.x>rp.x2 OR sz.y>rp.y2 THEN msg ← Rope.Cat[CDOps.ObjectRope[ob], " too large"];
};
r: Rope.ROPE => IF ~Rope.IsEmpty[r] THEN msg ← Rope.Cat[CDOps.ObjectRope[ob], " ", r];
ENDCASE => msg ← Rope.Cat["class forbidden: ", CDOps.ObjectRope[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.
ROPE ←
NIL] =
BEGIN
cnt: INT ← 0;
ob1: CD.Object ← ReadOnlyCell[ob];
IF ob1=NIL THEN msg ← "failed to expand"
ELSE {
EachInst: CDCells.InstEnumerator = {
IF ~inst.ob.class.inDirectory
THEN {
msg1: Rope.ROPE ← CheckContainer[state, inst.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, "|"]
};
}
};
[] ← CDCells.EnumerateInstances[ob1, EachInst];
};
END;
CheckOneLevel:
PROC [state: State, ob:
CD.Object]
RETURNS [msg: Rope.
ROPE ←
NIL] =
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.ImportSpecific ← NARROW[ob.specific];
IF ip.boundInstance#NIL THEN [] ← handle.DoRecurse[ip.boundInstance.ob]
ELSE msg ← "not bound";
};
TerminalIO.PutRopes["checking ", CDOps.ObjectRope[ob]];
IF msg=NIL THEN msg ← CheckOneLevel[NARROW[handle.data], ob];
IF msg=NIL THEN TerminalIO.PutRope[" ok\n"]
ELSE {
handle.cnt ← handle.cnt+1;
TerminalIO.PutRopes["\n ** ", msg, "\n"]
};
val ← msg;
IF handle.design#NIL THEN CDSequencer.CheckAborted[handle.design];
END;
ReUseExt: CDBottomUp.ReUseProc =
BEGIN
TerminalIO.PutRopes["previously checked ", CDOps.ObjectRope[ob]];
WITH previousVal
SELECT
FROM
r: Rope.
ROPE => {
handle.cnt ← handle.cnt+1;
TerminalIO.PutRopes["\n ** ", r, "\n"]
};
ENDCASE => TerminalIO.PutRope[" 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.PutRope["no errors found\n"]
ELSE TerminalIO.PutF1["error(s) found in %g object(s)\n", [integer[h.cnt]]]
END;
inst: CD.Instance ← CDOps.TheInstance[comm.design, "hierarchical feature checking"];
IF inst#
NIL
THEN {
IF ~inst.ob.class.inDirectory
THEN {
TerminalIO.PutRopes[" 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 ← CDOps.ToRope[rt.Fetch[$CDFeatureCheckName].val];
IF key=NIL THEN key←NEW[INT];
TerminalIO.PutRopes["feature set used: [", text, "]\n"];
IF
ISTYPE[key,
ATOM]
THEN
TerminalIO.PutRopes[" [ key = ", CDOps.ToRope[key], " ]\n"];
featureChecker ← CDBottomUp.Register[DoExt, ReUseExt, key, $CDFeatureCheck
! CD.Error => GOTO oops];
HierarchicalFeatureCheck[featureChecker, comm.design, rt, inst.ob];
};
ENDCASE => TerminalIO.PutRope[" no feature table is assigned\n"]
}
EXITS oops => TerminalIO.PutRope[" failed to read parameters from atom\n"]
END;
CDCommandOps.RegisterWithMenu[menu: $ProgramMenu, entry: "Feature checking", doc: "needs commandfile be previously set up", proc: HierarchicalFeatureCheckComm, key: $HFCheck];
END.