LichenFromExt1Impl.Mesa
Last tweaked by Mike Spreitzer on October 14, 1987 3:41:54 pm PDT
DIRECTORY Asserting, Atom, Basics, Buttons, Collections, Containers, FS, Icons, IO, LichenArrayStuff, LichenDataOps, LichenDataStructure, LichenFromExtPrivate, List, PairCollections, PieViewers, Process, ProcessProps, RefTab, RefText, Rope, RopeHash, ViewerClasses, ViewerOps, ViewerTools;
LichenFromExt1Impl: CEDAR MONITOR
LOCKS dr USING dr: DesignReading
IMPORTS Asserting, Atom, Buttons, Collections, Containers, FS, Icons, IO, LichenArrayStuff, LichenDataOps, LichenDataStructure, LichenFromExtPrivate, List, PairCollections, PieViewers, Process, ProcessProps, RefTab, RefText, Rope, RopeHash, ViewerOps, ViewerTools
EXPORTS LichenFromExtPrivate
=
BEGIN OPEN Asserting, LichenDataOps, LichenArrayStuff, LichenDataStructure, LichenFromExtPrivate, Colls:Collections, PairColls:PairCollections;
readers: VarFunction ← PairColls.CreateHashDictionary[TRUE];
pacifierIcon: Icons.IconFlavor ← Icons.NewIconFromFile["Lichen.icons", 0];
pacifyPeriod: Process.Milliseconds ← 2500;
labelHeight: INTEGER ← 17;
pauseWidth: INTEGER ← 60;
pieDiameter: INTEGER ← 50;
ReadDesign: PROC [rootCellFileName: ROPE, oldDR: DesignReading ← NIL] RETURNS [dr: DesignReading] =
BEGIN
Doit: PROC = {
dr.stack ← NIL;
[] ← ReadCellType[dr.design, rootCellFileName, dr]};
IF oldDR = NIL THEN {
cp: FS.ComponentPositions;
fullFName, designName: ROPE;
[fullFName, cp, ] ← FS.ExpandName[rootCellFileName];
designName ← fullFName.Substr[start: cp.base.start, len: cp.base.length];
dr ← NEW [DesignReadingRep ← [
design: NEW [DesignPrivate ← [
cellTypes: Colls.CreateHashSet[],
other: Assert1[nameReln, designName, NIL]
]],
wDir: fullFName.Substr[len: cp.base.start],
cellTypesByName: PairColls.CreateHashDictionary[TRUE],
fetTypes: RefTab.Create[hash: HashFetType, equal: CompareFetTypes],
unkosherArrays: Colls.CreateHashSet[],
toMerge: PairColls.CreateHashFn[spaces: [paths, Colls.refs], invable: FALSE],
buffer: RefText.New[200],
pacifier: Containers.Create[info: [name: designName.Cat[" pacifier"], icon: pacifierIcon]],
pie: NIL,
label: NIL,
pause: NIL
]];
TRUSTED {
Process.InitializeCondition[@dr.change, Process.SecondsToTicks[60]];
Process.EnableAborts[@dr.change]};
dr.pause ← Buttons.Create[info: [name: "Pause", parent: dr.pacifier, wx: 0, wy: 0, ww: pauseWidth, wh: labelHeight], proc: TogglePause, clientData: dr];
dr.label ← ViewerTools.MakeNewTextViewer[info: [parent: dr.pacifier, wx: dr.pause.wx+dr.pause.ww, wy: 0, ww: 100, wh: labelHeight]];
Containers.ChildXBound[container: dr.pacifier, child: dr.label];
dr.pie ← PieViewers.Create[parent: dr.pacifier, x: 0, y: dr.label.wy+dr.label.wh, diameter: pieDiameter, total: 1.0, divisions: 100];
Containers.ChildXBound[container: dr.pacifier, child: dr.pie];
Containers.ChildYBound[container: dr.pacifier, child: dr.pie];
ViewerOps.SetOpenHeight[dr.pacifier, dr.pie.wy+dr.pie.wh];
TRUSTED {Process.Detach[FORK Pacify[dr]]};
}
ELSE {
dr ← oldDR;
};
ProcessProps.PushPropList[List.PutAssoc[$WorkingDirectory, dr.wDir, NIL], Doit];
END;
Wait: ENTRY PROC [dr: DesignReading] = {
ENABLE UNWIND => NULL;
WHILE dr.stop DO WAIT dr.change ENDLOOP};
Pacify: PROC [dr: DesignReading] = {
lastStack: SourceList ← NIL;
lastIndex: INT ← 0;
ViewerOps.OpenIcon[icon: dr.pacifier, bottom: FALSE];
WHILE NOT dr.pacifier.destroyed DO
WithLock: ENTRY PROC [dr: DesignReading] = {
ENABLE UNWIND => NULL;
IF dr.stack = NIL THEN {
IF dr.stack # lastStack THEN {
lastStack ← dr.stack;
ViewerTools.SetContents[dr.label, "Idle"];
PieViewers.Set[dr.pie, 0];
};
}
ELSE {
index: INT = dr.stack.first.stream.GetIndex[];
IF dr.stack # lastStack OR index # lastIndex THEN {
lastStack ← dr.stack;
lastIndex ← index;
ViewerTools.SetContents[dr.label, IO.PutFR["%g%g%g[%g]", [rope[dr.prefix]], [rope[dr.curCellTypeName]], [rope[IF dr.curArray THEN ".aext" ELSE ""]], [integer[index]]]];
PieViewers.Set[dr.pie, index/dr.curCellFileLength];
};
};
};
Process.Pause[Process.MsecToTicks[pacifyPeriod]];
WithLock[dr];
ENDLOOP;
RETURN};
TogglePause: Buttons.ButtonProc = {
dr: DesignReading = NARROW[clientData];
Flip: ENTRY PROC [dr: DesignReading] = {
ENABLE UNWIND => NULL;
dr.stop ← NOT dr.stop;
BROADCAST dr.change};
Flip[dr];
Buttons.ReLabel[dr.pause, IF dr.stop THEN "Continue" ELSE "Pause"];
};
DoPushed: PROC [dr: DesignReading, cellTypeName: ROPE, array: BOOL, s: Source, Proc: PROC [Source]] = {
cooler: SourceList = dr.stack;
oldCellTypeName: ROPE = dr.curCellTypeName;
oldArray: BOOL = dr.curArray;
oldPrefix: ROPE = dr.prefix;
oldCellFileLength: REAL = dr.curCellFileLength;
newPrefix: ROPE = FmtStack[cooler];
newCellFileLength: INT = MAX[s.stream.GetLength[], 1];
Push: ENTRY PROC [dr: DesignReading] = {
ENABLE UNWIND => NULL;
dr.stack ← CONS[s, dr.stack];
dr.curCellTypeName ← cellTypeName;
dr.curArray ← array;
dr.prefix ← newPrefix;
dr.curCellFileLength ← newCellFileLength;
};
Pop: ENTRY PROC [dr: DesignReading] = {
ENABLE UNWIND => NULL;
dr.stack ← cooler;
dr.curCellTypeName ← oldCellTypeName;
dr.curArray ← oldArray;
dr.prefix ← oldPrefix;
dr.curCellFileLength ← oldCellFileLength;
};
Push[dr];
Proc[s !UNWIND => Pop[dr]];
Pop[dr];
};
ReadCellType: PUBLIC PROC [design: Design, cellFileName: ROPE, dr: DesignReading] RETURNS [ct: CellType] = {
cp: FS.ComponentPositions;
fullFName, cellTypeName: ROPE;
from: IO.STREAM;
s: Source;
cr: CellReading;
Pushed: PROC [s: Source] = {PushedRead[dr, cr, s, FALSE]};
[fullFName, cp] ← ExpandName[cellFileName, "ext"];
cellTypeName ← fullFName.Substr[start: cp.base.start, len: cp.base.length];
ct ← LocalCreateCellType[design, dr, cellTypeName, TRUE, NIL, NIL];
cr ← NEW[CellReadingRep ← [dr: dr, ct: ct, name: cellTypeName, newArrays: Colls.CreateHashSet[]]];
s ← [from ← FS.StreamOpen[fullFName], fullFName];
DoPushed[dr, cellTypeName, FALSE, s, Pushed];
from.Close[];
RETURN};
TryArrayFile: PUBLIC PROC [cr: CellReading] = {
fullFName: ROPE = ExpandName[cr.name, "aext"].fullFName;
s: Source = [FS.StreamOpen[fullFName], fullFName];
Pushed: PROC [s: Source] = {
PushedRead[cr.dr, cr, s, TRUE];
FinishWaitingMerges[cr];
RETURN};
FinishArray: PROC [ra: REF ANY] ~ {
act: CellType ~ NARROW[ra];
FinishedMakingArrayConnections[act];
RETURN};
IF (NOT cr.dr.toMerge.Empty[]) OR cr.waitingMerges # NIL THEN ERROR;
DoPushed[cr.dr, cr.name, TRUE, s, Pushed];
s.stream.Close[];
cr.newArrays.Enumerate[FinishArray];
RETURN};
PushedRead: PROC [dr: DesignReading, cr: CellReading, s: Source, nested: BOOL] = {
from: IO.STREAM = s.stream;
ct: CellType = cr.ct;
DO
keyword: ROPE;
reader: Reader;
Process.CheckForAbort[];
[] ← from.SkipWhitespace[];
IF from.EndOf[] THEN EXIT;
IF dr.stop THEN Wait[dr];
keyword ← from.GetTokenRope[TokenBreak].token;
reader ← NARROW[readers.Apply[keyword].DVal];
IF reader # NIL
THEN reader.read[s, reader, cr]
ELSE {
terms: Terms ← GetLineTerms[from];
reln: ATOM ← Atom.MakeAtom[keyword];
ct.otherPublic ← Assert[reln, terms, ct.otherPublic];
};
ENDLOOP;
IF (NOT dr.toMerge.Empty[]) THEN {
IF cr.firstMerge THEN ERROR;
DoMerges[s, cr];
}
ELSE IF cr.firstMerge THEN {cr.firstMerge ← FALSE; TryArrayFile[cr]};
IF nested THEN RETURN;
ct.publicKnown ← TRUE;
ct.privateKnown ← TRUE;
{CleanupChild: PROC [ra: REF ANY] = {
ci: CellInstance = NARROW[ra];
childType: CellType = ci.type;
IF childType.asArray # NIL THEN {
IF childType.useCount # 1 THEN ERROR;
};
};
ct.asUnorganized.containedInstances.Enumerate[CleanupChild];
}};
FmtStack: PROC [stack: SourceList] RETURNS [prefix: ROPE] = {
prefix ← NIL;
FOR stack ← stack, stack.rest WHILE stack # NIL DO
full: ROPE;
cp: FS.ComponentPositions;
[full, cp, ] ← FS.ExpandName[stack.first.name];
prefix ← IO.PutFR["%g[%g], %g", [rope[full.Substr[cp.base.start, cp.base.length]]], [integer[IO.GetIndex[stack.first.stream]]], [rope[prefix]]];
ENDLOOP;
RETURN};
paths: PUBLIC Colls.Space ~ NEW [Colls.SpacePrivate ← [
Equal: PathEqual,
Hash: PathHash,
Compare: PathCompare,
other: List.PutAssoc[$Name, "paths", NIL]
]];
PathEqual: PROC [data, elt1, elt2: REF ANY] RETURNS [BOOL] --Colls.EqualProc-- ~ {
p1: Path ~ NARROW[elt1];
p2: Path ~ NARROW[elt2];
RETURN [ComparePaths[p1, p2]=equal]};
PathHash: PROC [data, elt: REF ANY ← ] RETURNS [CARDINAL] --Colls.HashProc-- ~ {
RETURN [HashPath[NARROW[elt]]]};
PathCompare: PROC [data, elt1, elt2: REF ANY ← ] RETURNS [c: Basics.Comparison] --Colls.CompareProc-- ~ {
p1: Path ~ NARROW[elt1];
p2: Path ~ NARROW[elt2];
RETURN ComparePaths[p1, p2]};
ComparePaths: PUBLIC PROC [path1, path2: Path] RETURNS [c: Basics.Comparison] = {
DO
IF path1 = path2 THEN RETURN [equal];
IF path1 = NIL THEN RETURN [less];
IF path2 = NIL THEN RETURN [greater];
WITH path1.first SELECT FROM
r1: ROPE => WITH path2.first SELECT FROM
r2: ROPE => c ← r1.Compare[r2];
x2: REF Range2 => c ← less;
ENDCASE => ERROR;
s1: REF Range2 => WITH path2.first SELECT FROM
r2: ROPE => c ← greater;
s2: REF Range2 =>
IF (c ← IntCompare[s1[Foo].min, s2[Foo].min]) = equal THEN
IF (c ← IntCompare[s1[Foo].maxPlusOne, s2[Foo].maxPlusOne]) = equal THEN
IF (c ← IntCompare[s1[Bar].min, s2[Bar].min]) = equal THEN
c ← IntCompare[s1[Bar].maxPlusOne, s2[Bar].maxPlusOne];
ENDCASE => ERROR;
ENDCASE => ERROR;
IF c # equal THEN RETURN;
path1 ← path1.rest;
path2 ← path2.rest;
ENDLOOP;
};
HashPath: PROC [path: Path] RETURNS [hash: CARDINAL] = {
hash ← 0;
FOR path ← path, path.rest WHILE path # NIL DO
WITH path.first SELECT FROM
r: ROPE => hash ← hash + RopeHash.FromRope[r];
x: REF Range2 => hash ← hash + Colls.HashIntI[x[Foo].min] + Colls.HashIntI[x[Foo].maxPlusOne] + Colls.HashIntI[x[Bar].min] + Colls.HashIntI[x[Bar].maxPlusOne];
ENDCASE => ERROR;
ENDLOOP;
};
IntCompare: PROC [i1, i2: INT] RETURNS [c: Basics.Comparison] = {
c ← SELECT i1 - i2 FROM
>0 => greater,
=0 => equal,
<0 => less,
ENDCASE => ERROR;
};
CompareFetTypes: PROC [key1, key2: REF ANY] RETURNS [equal: BOOL] --RefTab.EqualProc-- = {
k1: FetType = NARROW[key1];
k2: FetType = NARROW[key2];
equal ← k1.className.Equal[k2.className] AND k1.area = k2.area AND k1.perim = k2.perim AND k1.twiceLength = k2.twiceLength;
};
HashFetType: PROC [ra: REF ANY] RETURNS [hash: CARDINAL] --RefTab.HashProc-- = {
ft: FetType = NARROW[ra];
hash ← RopeHash.FromRope[ft.className];
hash ← (hash + 3*ft.area + 11*ft.perim + 101*ft.twiceLength) MOD 65536;
};
Register: PUBLIC PROC [keyword: ROPE, read: PROC [s: Source, reader: Reader, cr: CellReading], data: REF ANY ← NIL] = {
r: Reader ← NEW [ReaderRep ← [keyword, read, data]];
readers.AddNewPair[[keyword, r]];
};
Start: PROC = {
};
Start[];
END.