[ivy]<Satterthwaite>SML>SMBcdImpl.mesa!12

SMBcdImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
last edit by Satterthwaite, May 13, 1986 8:58:47 am PDT
code to produce and read .modelBcd files
DIRECTORY
BasicTime: TYPE USING [GMT],
Convert: TYPE USING [CardFromRope],
CS: TYPE USING [
EndsIn, GMTFromRope, RopeFromGMT, RopeFromStamp, RootName, ShortName,
StampFromRope],
FS: TYPE USING [StreamOpen],
IO: TYPE USING [
card, Close, EndOf, GetChar, GetIndex, PutF, PutRope, RIS, rope, SetIndex,
STREAM],
Rope: TYPE USING [Concat, Equal, Fetch, Flatten, FromProc, Length, ROPE, Substr],
SMBcd: TYPE USING [],
SMCommentTableOps: TYPE USING [CommentM],
SMEval: TYPE USING [Eval],
SMFI: TYPE USING [BcdFileInfo, SrcFileInfo],
SMFIOps: TYPE USING [FindBcd, FindSource],
SMOps: TYPE USING [MS],
SMProj: TYPE USING [Proj, Analyzed, Find],
SMTree: TYPE Tree USING [ApplOp, Handle, Link],
SMTreeOps: TYPE TreeOps USING [GetExt, OpName, Scan, ScanSons],
SMUtil: TYPE USING [ParseStream, PrettyPrint],
TimeStamp: TYPE USING [Stamp];
SMBcdImpl: CEDAR PROGRAM
IMPORTS Convert, CS, FS, IO, Rope, SMEval, SMFIOps, SMProj, SMTreeOps, SMUtil
EXPORTS SMBcd ~ {
OPEN Tree~~SMTree, TreeOps~~SMTreeOps;
SrcFIList: TYPE~LIST OF SMFI.SrcFileInfo;
BcdFIList: TYPE~LIST OF SMFI.BcdFileInfo;
ProjList: TYPE~LIST OF SMProj.Proj;
making .modelBcd files
WriteModelBcd: PUBLIC PROC[ms: SMOps.MS, t: Tree.Link, bcdFileName: Rope.ROPE] ~ {
ENABLE UNWIND => {NULL};
srcFIList: SrcFIList ← NIL;
bcdFIList: BcdFIList ← NIL;
AddSrcFi: PROC[fiSrc: SMFI.SrcFileInfo] ~ {
FOR l: SrcFIList ← srcFIList, l.rest UNTIL l = NIL DO
IF fiSrc = l.first THEN RETURN;
ENDLOOP;
srcFIList ← (ms.z).CONS[fiSrc, srcFIList]};
AddBcdFi: PROC[fiBcd: SMFI.BcdFileInfo] ~ {
FOR l: BcdFIList ← bcdFIList, l.rest UNTIL l = NIL DO
IF fiBcd = l.first THEN RETURN;
ENDLOOP;
bcdFIList ← (ms.z).CONS[fiBcd, bcdFIList]};
projList: ProjList ← NIL;
AddProj: PROC[proj: SMProj.Proj] ~ {
FOR l: ProjList ← projList, l.rest UNTIL l = NIL DO
IF proj = l.first THEN RETURN;
ENDLOOP;
projList ← (ms.z).CONS[proj, projList]};
FindFiles: TreeOps.Scan ~ {
WITH t SELECT FROM
node: Tree.Handle => {
TreeOps.ScanSons[node, FindFiles];
IF TreeOps.OpName[node] IN Tree.ApplOp THEN
WITH TreeOps.GetExt[node] SELECT FROM
proj: SMProj.Proj => AddProj[proj];
ENDCASE;
};
fiSrc: SMFI.SrcFileInfo => AddSrcFi[fiSrc];
fiBcd: SMFI.BcdFileInfo => AddBcdFi[fiBcd];
ENDCASE => NULL;
};
outName: Rope.ROPE ~ (IF CS.EndsIn[bcdFileName, ".modelBcd"]
THEN bcdFileName ELSE CS.RootName[bcdFileName].Concat[".modelBcd"]);
output: IO.STREAM;
FindFiles[t];
output ← FS.StreamOpen[fileName~outName, accessOptions~$create, wDir~ms.wDir];
BuildTypeTables[output, srcFIList, bcdFIList];
BuildProjTable[output, projList];
SMUtil.PrettyPrint[out~output, root~ms.tree, comments~NIL];
output.Close[];
ms.out.PutF["modelBcd file written on %g\n", IO.rope[outName]]};
BuildTypeTables: PROC[output: IO.STREAM, srcFIList: SrcFIList, bcdFIList: BcdFIList] ~ {
FOR l: SrcFIList ← srcFIList, l.rest UNTIL l = NIL DO
fiSrc: SMFI.SrcFileInfo ~ l.first;
output.PutF["%g %g\n",
IO.rope[CS.RopeFromGMT[fiSrc.create]], IO.rope[fiSrc.fName]];
SMUtil.PrettyPrint[out~output, root~fiSrc.type, comments~NIL];
output.PutRope[".\n"];
ENDLOOP;
output.PutRope[".\n"];
FOR l: BcdFIList ← bcdFIList, l.rest UNTIL l = NIL DO
fiBcd: SMFI.BcdFileInfo ~ l.first;
output.PutF["%g %g %g\n",
IO.rope[CS.RopeFromGMT[fiBcd.create]],
IO.rope[fiBcd.fName],
IO.rope[CS.RopeFromStamp[fiBcd.stamp]]];
SMUtil.PrettyPrint[out~output, root~fiBcd.type, comments~NIL];
output.PutRope[".\n"];
ENDLOOP;
output.PutRope[".\n"]};
BuildProjTable: PROC[output: IO.STREAM, projList: ProjList] ~ {
FOR l: ProjList ← projList, l.rest UNTIL l = NIL DO
proj: SMProj.Proj ~ l.first;
output.PutF["%g %g",
IO.rope[CS.RopeFromStamp[proj.stamp]], IO.rope[proj.localName]];
output.PutRope[IF proj.interface THEN " T " ELSE " F "];
output.PutF["%d %d\n",
IO.card[proj.symbolPages.base], IO.card[proj.symbolPages.pages]];
ENDLOOP;
output.PutRope[".\n"]};
reading .modelBcd files
GetLine: PROC[input: IO.STREAM] RETURNS[line: Rope.ROPE] ~ {
start: INT ~ input.GetIndex;
n: INT ← 0;
EachChar: PROC RETURNS[CHAR] ~ {
RETURN[input.GetChar]};
UNTIL input.GetChar = '\n DO n ← n+1 ENDLOOP;
input.SetIndex[start];
line ← Rope.FromProc[n+1, EachChar]};-- include '\n
ReadModelBcdPrefix: PUBLIC PROC[ms: SMOps.MS, input: IO.STREAM] ~ {
ENABLE UNWIND => {NULL};
reconstruct the type table
ended: BOOL;
header, line: Rope.ROPE;
typeRope: Rope.ROPE;
WHILE ~input.EndOf DO
first line has the filename and create time (or terminator)
header ← GetLine[input];
typeRope ← NIL;
IF header.Equal[".\n"] THEN EXIT;
ended ← input.EndOf;
WHILE ~ended DO
line ← GetLine[input];
IF line.Equal[".\n"] THEN ended ← TRUE
ELSE typeRope ← typeRope.Concat[line];
ENDLOOP;
AddSrcFI[ms, header, typeRope];
ENDLOOP;
WHILE ~input.EndOf DO
first line has the filename and version stamp (or terminator)
header ← GetLine[input];
typeRope ← NIL;
IF header.Equal[".\n"] THEN EXIT;
ended ← input.EndOf;
WHILE ~ended DO
line ← GetLine[input];
IF line.Equal[".\n"] THEN ended ← TRUE
ELSE typeRope ← typeRope.Concat[line];
ENDLOOP;
AddBcdFI[ms, header, typeRope];
ENDLOOP;
WHILE ~input.EndOf DO
first line has the filename and create time (or terminator)
line ← GetLine[input];
IF line.Equal[".\n"] THEN EXIT;
AddProj[ms, line];
ENDLOOP;
};
AddSrcFI: PROC[ms: SMOps.MS, header, typeRope: Rope.ROPE] ~ {
createTime: BasicTime.GMT;
fiSrc: SMFI.SrcFileInfo;
start, next: INT ← 0;
length: INT ~ header.Length-1;
NextToken: PROC ~ {
WHILE next < length AND header.Fetch[next] = ' DO next ← next+1 ENDLOOP;
start ← next;
WHILE next < length AND header.Fetch[next] # ' DO next ← next+1 ENDLOOP};
NextToken[];
createTime ← CS.GMTFromRope[header.Substr[start, next-start]];
fiSrc ← SMFIOps.FindSource[createTime];
IF fiSrc.state < $analyzed THEN {-- move to SMFIImpl
NextToken[];
fiSrc.fName ← header.Flatten[start, next-start];
fiSrc.simpleName ← CS.ShortName[fiSrc.fName];
fiSrc.localName ← fiSrc.fName; fiSrc.wDir ← ms.wDir; fiSrc.new ← FALSE;
fiSrc.type ← SMEval.Eval[ms, SMUtil.ParseStream[ms, IO.RIS[typeRope]], NIL];
fiSrc.state ← $analyzed};
};
AddBcdFI: PROC[ms: SMOps.MS, header, typeRope: Rope.ROPE] ~ {
createTime: BasicTime.GMT;
fiBcd: SMFI.BcdFileInfo;
start, next: INT ← 0;
length: INT ~ header.Length-1;
NextToken: PROC ~ {
WHILE next < length AND header.Fetch[next] = ' DO next ← next+1 ENDLOOP;
start ← next;
WHILE next < length AND header.Fetch[next] # ' DO next ← next+1 ENDLOOP};
NextToken[];
createTime ← CS.GMTFromRope[header.Substr[start, next-start]];
fiBcd ← SMFIOps.FindBcd[createTime];
IF fiBcd.state < $analyzed THEN {-- move to SMFIImpl
NextToken[];
fiBcd.fName ← header.Flatten[start, next-start];
fiBcd.simpleName ← CS.ShortName[fiBcd.localName];
fiBcd.localName ← fiBcd.fName; fiBcd.wDir ← ms.wDir;
NextToken[];
fiBcd.stamp ← CS.StampFromRope[header.Substr[start, next-start]];
fiBcd.type ← SMEval.Eval[ms, SMUtil.ParseStream[ms, IO.RIS[typeRope]], NIL];
fiBcd.state ← $analyzed};
};
AddProj: PROC[ms: SMOps.MS, line: Rope.ROPE] ~ {
stamp: TimeStamp.Stamp;
proj: SMProj.Proj;
start, next: INT ← 0;
length: INT ~ line.Length-1;
NextToken: PROC ~ {
WHILE next < length AND line.Fetch[next] = ' DO next ← next+1 ENDLOOP;
start ← next;
WHILE next < length AND line.Fetch[next] # ' DO next ← next+1 ENDLOOP};
NextToken[];
stamp ← CS.StampFromRope[line.Substr[start, next-start]];
proj ← SMProj.Find[stamp];
IF ~proj.Analyzed THEN {-- move to SMProjImpl
NextToken[];
proj.localName ← line.Flatten[start, next-start]; proj.wDir ← ms.wDir;
proj.fName ← NIL;
NextToken[];
proj.interface ← (line.Fetch[start] = 'T);
NextToken[];
proj.symbolPages.base ← Convert.CardFromRope[line.Substr[start, next-start]];
NextToken[];
proj.symbolPages.pages ← Convert.CardFromRope[line.Substr[start, next-start]];
proj.state ← $analyzed};
};
}.