CDConditionsImpl.mesa (part of Chipndale)
by Christian Jacobi May 4, 1984 10:12:34 am PDT
last edited by Christian Jacobi May 9, 1984 6:13:34 pm PDT
some code stolen from Russ Atkinson's HandCodingDriver
DIRECTORY
AMBridge,
AMModel,
AMTypes,
Basics USING [bytesPerWord],
BcdDefs USING [VersionStamp],
CD,
CDApplications,
CDCallSpecific,
CDConditions,
CDDirectory,
CDExtras,
CDInline,
CDIO,
CDOps,
CDProperties,
CDValue,
FS,
Interpreter USING [Evaluate],
IO,
Loader USING [Instantiate, IRItem],
PrincOps USING [ControlModule],
Rope,
--RuntimeError,
TerminalIO,
TokenIO,
WorldVM USING [LocalWorld];
CDConditionsImpl: CEDAR PROGRAM
IMPORTS AMBridge, AMModel, AMTypes, CD, CDApplications, CDDirectory, CDExtras, CDInline, CDIO, CDOps, CDProperties, CDValue, FS, Interpreter, IO, Loader, Rope, --RuntimeError,-- TerminalIO, TokenIO, WorldVM
EXPORTS CDConditions
SHARES CDDirectory =
BEGIN
ConditionProc: TYPE = CDConditions.ConditionProc;
CondPtr: TYPE = CDConditions.CondPtr;
CondRec: TYPE = CDConditions.CondRec;
pForConditions: REF CD.ObjectProcs ~ CD.RegisterObjectType[$Cond];
ConditionList: TYPE = LIST OF CD.ObPtr;
DrawMe: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation,
pr: CD.DrawRef] =
BEGIN
cptr: CondPtr = NARROW[aptr.ob.specificRef];
IF cptr.condition=NIL OR cptr.condition[aptr, pr] THEN {
cptr.app.ob.p.drawMe[cptr.app, pos, orient, pr];
}
END;
DescribeCond: PROC[me: CD.ObPtr] RETURNS [Rope.ROPE] = {
cptr: CondPtr = NARROW[me.specificRef];
RETURN [Rope.Concat["conditional ", CDOps.Info[cptr.app.ob]]]
};
GetProp: PUBLIC PROC [environment: CD.DrawRef, prop: REF, skipInnerMost: NAT𡤀] RETURNS [REF] =
BEGIN
x: REFNIL;
FOR al: CD.ApplicationList ← environment.nesting, al.rest WHILE al#NIL DO
x ← CDProperties.GetPropFromApplication[al.first, prop];
IF x#NIL THEN
IF skipInnerMost=0 THEN RETURN [x] ELSE skipInnerMost ← skipInnerMost-1
ENDLOOP;
RETURN [NIL]
END;
GetIntProp: PUBLIC PROC[environment: CD.DrawRef, prop: REF, skipInnerMost: NAT𡤀, ifNotFound: INT𡤀] RETURNS [INT] =
BEGIN
x: INT ← ifNotFound;
WITH GetProp[environment: environment, prop: prop, skipInnerMost: skipInnerMost] SELECT FROM
intP: REF INT => x ← intP^;
ENDCASE => NULL;
RETURN [x]
END;
Index: PUBLIC PROC[environment: CD.DrawRef, skipInnerMost: NAT𡤀, ifNotFound: INT𡤀] RETURNS [INT] =
BEGIN
RETURN [GetIntProp[environment, $CDxIndex, skipInnerMost, ifNotFound]]
END;
RepositionElementsC: CDDirectory.RepositionElementsProc
-- PROC [me: CD.ObPtr, objToReposition: CD.ObPtr, oldSize: CD.DesignPosition, newBound: CD.DesignRect, design: CD.Design] -- =
BEGIN
cp: CondPtr ~ NARROW[me.specificRef];
IF cp.app.ob=objToReposition THEN {
cp.app.location ← CDInline.AddPoints[cp.app.location, CDInline.BaseOfRect[newBound]];
CDDirectory.RepositionAnObject[design, me];
}
END;
ComputeBoundsC: CDDirectory.ComputeBoundsProc
-- PROC [ob: CD.ObPtr] RETURNS [CD.DesignRect] -- =
BEGIN
cp: CondPtr = NARROW[ob.specificRef];
RETURN CDInline.RectAt[cp.app.location, cp.app.ob.size];
END;
AdjustItselfC: CDDirectory.AdjustItselfProc
-- PROC [objToReposition: CD.ObPtr, newBound: CD.DesignRect] -- =
BEGIN
cp: CondPtr = NARROW[objToReposition.specificRef];
IF cp.app.location#CDInline.BaseOfRect[newBound] THEN ERROR;
cp.app.location ← [0, 0]
END;
GetConditionList: PROC[design: CD.Design] RETURNS [REF ConditionList] =
BEGIN
x: REF ← CDValue.Fetch[design, $ConditionList];
IF x=NIL OR ~ISTYPE[x, REF ConditionList] THEN {
x ← NEW[ConditionList←NIL];
CDValue.Store[design, $ConditionList, x];
};
RETURN [NARROW[x, REF ConditionList]];
END;
InternalCreateCondOb: PROC [design: CD.Design, ob: CD.ObPtr, condition: ConditionProc, data: REF] RETURNS [CD.ObPtr] =
BEGIN
refcl: REF ConditionList = GetConditionList[design];
cOb: CD.ObPtr = NEW[CD.ObjectDefinition];
cp: CondPtr = NEW[CondRec];
cOb.p ← pForConditions;
cOb.size ← ob.size;
cOb.level ← ob.level;
cOb.specificRef ← cp;
cp.app ← CDApplications.NewApplicationI[ob: ob];
cp.condition ← condition;
cp.data ← data;
refcl^ ← CONS[cOb, refcl^];
RETURN [cOb];
END;
CreateCondition: PUBLIC PROC [design: CD.Design, ob: CD.ObPtr, condition: ConditionProc←NIL, data: REFNIL] RETURNS [CD.ObPtr] =
--there are restrictions on the type of data; (because of IO!)
BEGIN
cOb: CD.ObPtr = InternalCreateCondOb[design, ob, condition, data];
[] ← CDDirectory.Include[design, cOb];
RETURN [cOb];
END;
ChangeCondition: PUBLIC PROC [design: CD.Design, ob: CD.ObPtr, fileName, procName: Rope.ROPENIL, data: REFNIL, condition: ConditionProc←NIL] RETURNS [done: BOOLFALSE] =
--if condition is nil, tries to evaluate fileName, procName
--redraws the complete design
--there are restrictions on the type of data
BEGIN
WriteNames: PROC [r: Rope.ROPENIL] = {
TerminalIO.WriteRope[" Condition proc "];
TerminalIO.WriteRope[procName];
TerminalIO.WriteRope[" on file "];
TerminalIO.WriteRope[fileName];
TerminalIO.WriteRope["; "];
IF ~Rope.IsEmpty[r] THEN TerminalIO.WriteRope[r];
};
cptr: CondPtr = NARROW[ob.specificRef];
cptr.data ← data;
cptr.fileName ← fileName;
cptr.procName ← procName;
IF condition#NIL THEN {
cptr.condition ← condition;
done ← TRUE;
}
ELSE IF Rope.IsEmpty[procName] THEN {
cptr.condition ← NIL;
done ← TRUE;
}
ELSE {
procAlone, modName: Rope.ROPE←NIL;
cptr.condition ← NIL;
cptr.data ← data;
cptr.fileName ← fileName;
cptr.procName ← procName;
BEGIN -- determine procAlone, modName
procDot: INT = TrailingDot[procName];
IF procDot < Rope.Length[procName] THEN {
procAlone ← Rope.Flatten[procName, procDot+1];
modName ← Rope.Flatten[procName, 0, procDot]
}
ELSE procAlone ← procName;
IF Rope.IsEmpty[modName] THEN modName ← SuggestedModule[fileName];
IF Rope.IsEmpty[procAlone] THEN procAlone ← "Condition";
END;
TRUSTED BEGIN -- compare the file with the wanted module; load the file
root: AMModel.Context = AMModel.RootContext[WorldVM.LocalWorld[]];
ctxVersion, fileVersion: BcdDefs.VersionStamp;
modCtx: AMModel.Context;
fileStream: IO.STREAM;
--Read the version stamp of the file
fileStream ← FS.StreamOpen[CDExtras.AppendExt[fileName, "bcd"]
! FS.Error => IF error.group # bug THEN {
WriteNames[];
TerminalIO.WriteRope["Could not open "];
TerminalIO.WriteRope[fileName];
TerminalIO.WriteRope[" "];
TerminalIO.WriteRope[error.explanation];
TerminalIO.WriteLn[];
GOTO NotDone
}];
IO.SetIndex[fileStream, SIZE[CARDINAL]*Basics.bytesPerWord];
[] ← IO.UnsafeGetBlock[fileStream, [
base: LOOPHOLE[LONG[@fileVersion]],
startIndex: 0,
count: SIZE[BcdDefs.VersionStamp]*Basics.bytesPerWord]];
--Get the version stamp of the loaded bcd.
modCtx ← AMModel.MostRecentNamedContext[modName, root];
IF modCtx # NIL THEN
ctxVersion ← AMModel.SectionVersion[AMModel.ContextSection[modCtx]];
IF modCtx = NIL OR ctxVersion # fileVersion THEN {
--We must try to load this file dynamically
msg: Rope.ROPENIL;
unboundImports: LIST OF Loader.IRItem ← NIL;
cm: PrincOps.ControlModule;
file: FS.OpenFile = FS.OpenFileFromStream[fileStream];
fullName: Rope.ROPE = FS.GetName[file].fullFName;
TerminalIO.WriteRope["Loading "];
TerminalIO.WriteRope[fullName];
TerminalIO.WriteLn[];
[cm, unboundImports] ← Loader.Instantiate[file];
IF unboundImports # NIL THEN {
TerminalIO.WriteRope["Warning! Unbound imports:"];
FOR eachIR: LIST OF Loader.IRItem ← unboundImports, eachIR.rest WHILE eachIR # NIL DO
TerminalIO.WriteRope[eachIR.first.interfaceName];
TerminalIO.WriteRope["#"];
TerminalIO.WriteInt[eachIR.first.index];
ENDLOOP;
TerminalIO.WriteLn[];
};
};
IO.Close[fileStream];
--At this point we have found the named module, and we want to find the named procedure in the module, if there is one. If one was not specified, default to "Condition".
END;
TRUSTED BEGIN -- get the procedure we want
errorRope: Rope.ROPE;
noResult: BOOL;
tv: AMTypes.TVNIL;
type: AMTypes.Type;
[tv, errorRope, noResult] ← Interpreter.Evaluate[Rope.Cat[modName, ".", procAlone]];
IF noResult OR tv=NIL OR ~Rope.IsEmpty[errorRope] THEN {
WriteNames[];
TerminalIO.WriteRope[" no condition procedure: "];
TerminalIO.WriteRope[errorRope];
TerminalIO.WriteLn[];
RETURN
};
type ← AMTypes.TVType[tv];
WHILE AMTypes.TypeClass[type]=definition DO
tv ← AMTypes.Coerce[tv, AMTypes.UnderType[type]];
type ← AMTypes.TVType[tv];
ENDLOOP;
IF AMTypes.TypeClass[type]=ref THEN {
WITH AMBridge.SomeRefFromTV[tv] SELECT FROM
cond: REF ConditionProc => {
cptr.condition ← cond^;
done ← TRUE
};
ENDCASE => NULL;
}
ELSE IF AMTypes.TypeClass[type]=procedure THEN {
p: PROC ANY RETURNS ANYLOOPHOLE[AMBridge.TVToProc[tv]];
WITH p SELECT FROM
cond: ConditionProc => {
cptr.condition ← cond;
done ← TRUE
};
ENDCASE => NULL;
};
IF ~done THEN WriteNames[" has wrong type; not done\n"];
END;
};
IF done THEN CDOps.DelayedRedraw[design]
EXITS
NotDone => NULL;
END;
SuggestedModule: PROC [base: Rope.ROPE] RETURNS [Rope.ROPE] = {
--given a filename, suggests a modulename
len, dot: INT;
base ← ShortName[base];
len ← Rope.Length[base];
dot ← TrailingDot[base];
IF len>dot AND Rope.Equal[Rope.Substr[base, dot+1], "bcd", FALSE] THEN
base ← Rope.Flatten[base, 0, dot];
RETURN [base]
};
TrailingDot: PROC [base: Rope.ROPE] RETURNS [INT] = {
--position of last dot
len: INT ← Rope.Length[base];
pos: INT ← len;
WHILE pos > 0 DO
SELECT Rope.Fetch[base, pos ← pos - 1] FROM
'. => RETURN [pos];
'!, '], '>, '/ => EXIT;
ENDCASE;
ENDLOOP;
RETURN [len];
};
ShortName: PROC [base: Rope.ROPE] RETURNS [Rope.ROPE] = {
len: INT ← Rope.Length[base];
pos: INT ← len;
bang: INT ← len;
WHILE pos > 0 DO
SELECT Rope.Fetch[base, pos ← pos - 1] FROM
'! => bang ← pos;
'], '>, '/ => RETURN [Rope.Flatten[base, pos+1, bang-pos-1]];
ENDCASE;
ENDLOOP;
RETURN [Rope.Flatten[base, 0, bang]];
};
EnumerateCondOb: PROC [me: CD.ObPtr, p: CDDirectory.EnumerateObjectsProc, x: REF] =
BEGIN
cptr: CondPtr = NARROW[me.specificRef];
p[cptr.app.ob, x];
END;
ReadCondOb: CD.InternalReadProc --PROC [] RETURNS [ObPtr]-- =
BEGIN
ob: CD.ObPtr = CDIO.ReadObject[];
procName: Rope.ROPE = TokenIO.ReadRope[];
fileName: Rope.ROPE = TokenIO.ReadRope[];
cOb: CD.ObPtr = InternalCreateCondOb[CDIO.DesignInReadOperation[], ob, NIL, NIL];
[] ← ChangeCondition[design: CDIO.DesignInReadOperation[], ob: cOb, procName: procName, fileName: fileName];
RETURN [cOb]
END;
WriteCondOb: CD.InternalWriteProc -- PROC [me: ObPtr] -- =
BEGIN
specific: CondPtr = NARROW[me.specificRef];
CDIO.WriteObject[specific.app.ob];
TokenIO.WriteRope[specific.procName];
TokenIO.WriteRope[specific.fileName];
END;
UpdateConditions: PUBLIC PROC [design: CD.Design, doAll: BOOLTRUE] RETURNS [done: BOOLFALSE] =
--checks if any conditions have been recompiled and reloads them
--doAll TRUE: checks all, including already loded conditions
--doAll FALSE: checks the conditions which are not already loded
BEGIN
doneSoFar: BOOLTRUE;
cl: ConditionList ← GetConditionList[design]^;
FOR l: ConditionList ← cl, l.rest WHILE l#NIL DO
WITH l.first.specificRef SELECT FROM
cptr: CondPtr => IF doAll OR cptr.condition=NIL THEN {
doneSoFar ← doneSoFar AND ChangeCondition[design, l.first, cptr.fileName, cptr.procName, cptr.data]
};
ENDCASE => doneSoFar←FALSE;
ENDLOOP;
RETURN [doneSoFar]
END;
InitConditions: PROC [] =
BEGIN
cp: REF CDDirectory.DirectoryProcs ~ CDDirectory.InstallDirectoryProcs[pForConditions];
cp.enumerateChildObjects ← EnumerateCondOb;
cp.adjustItself ← AdjustItselfC;
cp.repositionElements ← RepositionElementsC;
cp.computeBounds ← ComputeBoundsC;
pForConditions.drawMe ← DrawMe;
pForConditions.internalRead ← ReadCondOb;
pForConditions.internalWrite ← WriteCondOb;
pForConditions.describe ← DescribeCond;
CDValue.EnregisterKey[$ConditionList];
END;
InitConditions[];
END.