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: REF←NIL;
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.NewApplication[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:
REF←
NIL]
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.
ROPE←
NIL, data:
REF←
NIL, condition: ConditionProc←
NIL]
RETURNS [done:
BOOL←
FALSE] =
--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.
ROPE←
NIL] = {
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.ROPE ← NIL;
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.TV ← NIL;
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 ANY ← LOOPHOLE[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]
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:
BOOL←
TRUE]
RETURNS [done:
BOOL←
FALSE] =
--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: BOOL←TRUE;
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.