DFUtilitiesImpl.mesa
last edited by Levin on December 7, 1983 11:00 am
DIRECTORY
Ascii USING [CR, SP, TAB],
BasicTime USING [
minutesPerHour, nullGMT, OutOfRange, Pack, TimeParametersNotKnown, Unpacked, Unpack, unspecifiedZone],
DFUtilities USING [
CommentItem, Date, DirectoryItem, FileItem, Filter, FilterA, FilterB, FilterC, ImportsItem, IncludeItem, ProcessItemProc, SupplyItemProc, UsingEntry, UsingForm, UsingList, WhiteSpaceItem],
IO USING [
Backup, BreakProc, card, char, EndOfStream, Error, GetChar, GetLineRope, GetToken, GetUnpackedTime, PeekChar, PutChar, PutF, PutFR, PutRope, rope, STREAM, TokenProc],
RefText USING [Equal, Fetch, Length, ObtainScratch, ReleaseScratch, TrustTextAsRope],
Rope USING [Cat, Compare, Concat, Fetch, Find, FromRefText, Index, Length, ROPE, Substr];
DFUtilitiesImpl: CEDAR PROGRAM
IMPORTS BasicTime, IO, RefText, Rope
EXPORTS DFUtilities =
BEGIN
OPEN Utils: DFUtilities;
ROPE: TYPE = Rope.ROPE;
Exported Procedures
ParseFromStream: PUBLIC PROC [
in: IO.STREAM, proc: Utils.ProcessItemProc, filter: Utils.Filter ← []] = {
Abort: ERROR = CODE;
ParseInner: PROC = {
passFileItems: BOOLTRUE;
underDirectory: BOOLFALSE;
blankLineCount: NAT ← 0;
bufferT is used for terminals, like "Directory". bufferN is used for non-terminals, like file names, dates, and the like. Separate buffers are used to simplify the REF TEXT handling by clients of GetTokenAsRefText. They are not released if ParseInner exits with an uncaught signal, but this is claimed to be OK.
bufferT: REF TEXT = RefText.ObtainScratch[20];
bufferN: REF TEXT = RefText.ObtainScratch[100];
SimpleToken: IO.BreakProc -- [char: CHAR] RETURNS [IO.CharClass] -- = {
SELECT char FROM
Ascii.SP, Ascii.TAB => RETURN[$sepr];
Ascii.CR => RETURN[$break];
ENDCASE => RETURN[$other];
};
GetTokenAsRefText: PROC [breakProc: IO.BreakProc]
RETURNS [token: REF TEXT ← "\N"] = {
token ← in.GetToken[breakProc, bufferT ! IO.EndOfStream => CONTINUE].token;
};
GetToken: PROC [breakProc: IO.BreakProc] RETURNS [ROPE] = {
token: REF TEXT ← "\N";
token ← in.GetToken[breakProc, bufferN ! IO.EndOfStream => CONTINUE].token;
RETURN[Rope.FromRefText[token]]
};
PutBack: PROC [x: REF TEXT] = {
FOR i: INT DECREASING IN [0..RefText.Length[x]) DO
in.Backup[RefText.Fetch[x, i]];
ENDLOOP;
};
EndOfLineText: PROC [t: REF TEXT] RETURNS [BOOL] = {
RETURN[RefText.Length[t] = 1 AND RefText.Fetch[t, 0] = Ascii.CR]
};
EndOfLineRope: PROC [t: ROPE] RETURNS [BOOL] = {
RETURN[t.Length[] = 1 AND t.Fetch[0] = Ascii.CR]
};
CheckEndOfLine: PROC = {
IF ~EndOfLineText[GetTokenAsRefText[SimpleToken]] THEN
ERROR SyntaxError["Unrecognizable text where end-of-line was expected."];
};
FlushWhiteSpace: PROC = {
IF blankLineCount ~= 0 AND filter.comments THEN {
IF proc[NEW[Utils.WhiteSpaceItem ← [lines: blankLineCount]]] THEN ERROR Abort;
CancelWhiteSpace[];
};
};
CancelWhiteSpace: PROC = {blankLineCount ← 0};
CancelDirectory: PROC = {underDirectory ← FALSE};
GetDate: PROC RETURNS [Utils.Date] = {
DO
char: CHAR = in.GetChar[ ! IO.EndOfStream => GO TO omitted];
SELECT char FROM
Ascii.SP, Ascii.TAB => NULL; -- leading white space
Ascii.CR => {in.Backup[char]; GO TO omitted};
'# => RETURN[[$notEqual, BasicTime.nullGMT]];
'~ =>
IF in.GetChar[] = '= THEN RETURN[[$notEqual, BasicTime.nullGMT]]
ELSE GO TO bogus;
'> => RETURN[[$greaterThan, BasicTime.nullGMT]];
ENDCASE => {
up: BasicTime.Unpacked;
in.Backup[char];
up ← in.GetUnpackedTime[ ! IO.Error => GO TO bogus];
Since GetUnpackedTime didn't raise Error, we must have either a complete date or a complete time (with or without zone) or both. We want to complain unless both were specified. Therefore, it suffices to test one field each of the date and time for "out-of-bounds" values.
IF up.year = 0 OR up.hour = 24 OR
up.zone = BasicTime.unspecifiedZone OR up.dst = unspecified THEN GO TO bogus;
RETURN[[$explicit, BasicTime.Pack[unpacked: up]]]
};
ENDLOOP;
EXITS
omitted => RETURN[[$omitted, BasicTime.nullGMT]];
bogus => ERROR SyntaxError["Illegal date specification."];
};
ParseDirectoryItem: PROC [exported: BOOL, readOnly: BOOL, path1: ROPENIL]
RETURNS [REF Utils.DirectoryItem] = {
directoryFilterB: Utils.FilterB = IF exported THEN $public ELSE $private;
directoryFilterC: Utils.FilterC = IF readOnly THEN $imported ELSE $defining;
ConsiderDefiningInstance: PROC RETURNS [BOOL] = {
RETURN[
(filter.filterB = $all OR filter.filterB = directoryFilterB) AND
(filter.filterC = $all OR filter.filterC = directoryFilterC)
];
};
path2: ROPENIL;
path2IsCameFrom: BOOLFALSE;
x: REF TEXT;
IF path1 = NIL AND EndOfLineRope[path1 ← GetToken[SimpleToken]] THEN
ERROR SyntaxError["Missing directory path."];
IF ~EndOfLineText[x ← GetTokenAsRefText[SimpleToken]] THEN {
SELECT TRUE FROM
RefText.Equal[x, "ReleaseAs", FALSE] => path2IsCameFrom ← FALSE;
RefText.Equal[x, "CameFrom", FALSE] => path2IsCameFrom ← TRUE;
ENDCASE => ERROR SyntaxError["Unrecognized construct following directory path."];
IF EndOfLineRope[path2 ← GetToken[SimpleToken]] THEN
ERROR SyntaxError[
Rope.Cat["Missing directory path following '", RefText.TrustTextAsRope[x], "'."]];
CheckEndOfLine[];
};
underDirectory ← TRUE;
RETURN[
IF (passFileItems ← ConsiderDefiningInstance[]) THEN
NEW[Utils.DirectoryItem ← [
path1: path1,
path2: path2,
path2IsCameFrom: path2IsCameFrom,
exported: exported,
readOnly: readOnly
]]
ELSE NIL
]
};
ParseFileItem: PROC [verifyRoot: BOOLFALSE, name: ROPENIL]
RETURNS [REF Utils.FileItem] = {
PassesNameFilter: PROC [file: ROPE] RETURNS [BOOL] = {
IF ~(filter.filterA = $all OR ClassifyFileExtension[file] = filter.filterA) THEN
RETURN[FALSE];
RETURN[SearchUsingList[file, filter.list].found]
};
date: Utils.Date;
IF ~underDirectory THEN ERROR SyntaxError["Missing directory statement"];
IF name = NIL AND EndOfLineRope[name ← GetToken[SimpleToken]] THEN
ERROR SyntaxError["Missing file name."];
date ← GetDate[];
CheckEndOfLine[];
RETURN[
IF passFileItems AND PassesNameFilter[RemoveVersionNumber[name]] THEN
NEW[Utils.FileItem ← [
name: name,
date: date,
verifyRoot: verifyRoot
]]
ELSE NIL
]
};
ParseImportsItem: PROC [exported: BOOL] RETURNS [REF Utils.ImportsItem] = {
x: REF TEXT;
path1, path2: ROPENIL;
date: Utils.Date;
form: Utils.UsingForm ← $exports;
list: REF Utils.UsingList ← NIL;
ConsiderImports: PROC RETURNS [BOOL] = {
IF filter.filterC = $defining THEN RETURN[FALSE];
SELECT filter.filterB FROM
$private => IF exported OR form = $exports THEN RETURN[FALSE];
$public => IF ~exported THEN RETURN[FALSE];
ENDCASE;
RETURN[~(form = $list AND list = NIL)]
};
IF EndOfLineRope[path1 ← GetToken[SimpleToken]] THEN
ERROR SyntaxError["Missing file name."];
IF EndOfLineText[x ← GetTokenAsRefText[SimpleToken]] OR
~RefText.Equal[x, "Of", FALSE] THEN
ERROR SyntaxError["Missing 'Of' following DF name"];
date ← GetDate[];
CheckEndOfLine[];
x ← GetTokenAsRefText[SimpleToken];
IF RefText.Equal[x, "CameFrom", FALSE] THEN {
IF EndOfLineRope[path2 ← GetToken[SimpleToken]] THEN
ERROR SyntaxError[
Rope.Cat["Missing directory path following '", RefText.TrustTextAsRope[x], "'."]];
CheckEndOfLine[];
x ← GetTokenAsRefText[SimpleToken];
};
IF RefText.Equal[x, "Using", FALSE] THEN {
x ← GetTokenAsRefText[IO.TokenProc];
SELECT TRUE FROM
RefText.Equal[x, "All", FALSE] => form ← $all;
RefText.Equal[x, "Exports", FALSE] => --form ← $exports-- NULL;
RefText.Equal[x, "[", FALSE] => {
verifyRoot: BOOLFALSE;
form ← $list;
DO
index: NAT;
inList: BOOL;
x ← GetTokenAsRefText[IO.TokenProc];
IF RefText.Length[x] = 1 THEN
SELECT RefText.Fetch[x, 0] FROM
'] => EXIT;
'+ =>
IF ~verifyRoot THEN {verifyRoot ← TRUE; LOOP}
ELSE ERROR SyntaxError["Illegal placed '+' in 'Using' list."];
ENDCASE;
[inList, index] ← SearchUsingList[RefText.TrustTextAsRope[x], filter.list];
IF inList THEN {
enter name in list
SELECT TRUE FROM
list = NIL => {
length: NAT = IF filter.list = NIL THEN 20 ELSE filter.list.nEntries;
list ← NEW[Utils.UsingList[length]];
list.nEntries ← 0;
};
list.nEntries = list.length => {
This case can only happen if filter.list = NIL
newList: REF Utils.UsingList ← NEW[Utils.UsingList[(list.length*3)/2]];
newList.nEntries ← list.nEntries;
FOR i: NAT IN [0..list.nEntries) DO
newList.u[i] ← list.u[i];
ENDLOOP;
list ← newList;
};
ENDCASE;
list.u[list.nEntries] ← [
verifyRoot: verifyRoot,
name:
IF filter.list = NIL THEN Rope.FromRefText[x]
ELSE filter.list.u[index].name
];
list.nEntries ← list.nEntries.SUCC;
};
verifyRoot ← FALSE;
ENDLOOP;
};
ENDCASE => ERROR SyntaxError["Unrecognized construct following 'Using'."];
CheckEndOfLine[];
}
ELSE {
PutBack[x];
--form ← $exports--
};
CancelDirectory[];
RETURN [
IF ConsiderImports[] THEN
NEW[Utils.ImportsItem ← [
path1: path1,
date: date,
path2: path2,
exported: exported,
form: form,
list: list
]]
ELSE NIL
]
};
ParseIncludeItem: PROC RETURNS [REF Utils.IncludeItem] = {
item: REF Utils.IncludeItem = NEW[Utils.IncludeItem ← [
path1: GetToken[SimpleToken],
date: ,
path2: NIL,
path2IsCameFrom:
]];
x: REF TEXT;
IF EndOfLineRope[item.path1] THEN ERROR SyntaxError["Missing file name."];
IF EndOfLineText[x ← GetTokenAsRefText[SimpleToken]] OR
~RefText.Equal[x, "Of", FALSE] THEN
ERROR SyntaxError["Missing 'Of' following DF name"];
item.date ← GetDate[];
CheckEndOfLine[];
x ← GetTokenAsRefText[SimpleToken];
SELECT TRUE FROM
RefText.Equal[x, "ReleaseAs", FALSE] => item.path2IsCameFrom ← FALSE;
RefText.Equal[x, "CameFrom", FALSE] => item.path2IsCameFrom ← TRUE;
ENDCASE => {PutBack[x]; RETURN[item]};
IF EndOfLineRope[item.path2 ← GetToken[SimpleToken]] THEN
ERROR SyntaxError[
Rope.Cat["Missing directory path following '", RefText.TrustTextAsRope[x], "'."]];
CheckEndOfLine[];
CancelDirectory[];
RETURN[item]
};
Main parsing loop
DO
item: REF ANYNIL;
char: CHAR = in.GetChar[ ! IO.EndOfStream => EXIT];
SELECT char FROM
Ascii.SP, Ascii.TAB => LOOP; -- leading white space on line
Ascii.CR => {
blank line
IF filter.comments THEN blankLineCount ← blankLineCount.SUCC;
LOOP
};
'+ => {
FlushWhiteSpace[];
item ← ParseFileItem[verifyRoot: TRUE];
};
'- => {
FlushWhiteSpace[];
IF in.PeekChar[] = '- THEN {
Comment line
comment: ROPE = Rope.Concat["-", in.GetLineRope[]];
IF filter.comments THEN item ← NEW[Utils.CommentItem ← [text: comment]];
}
ELSE {in.Backup[char]; item ← ParseFileItem[]};
};
'/ => {
Remove this code when old-style comments are no longer supported.
FlushWhiteSpace[];
IF in.GetChar[] = '/ THEN {
comment: ROPENIL;
comment ← in.GetLineRope[ ! IO.EndOfStream => CONTINUE];
convert to new style
IF filter.comments THEN
item ← NEW[Utils.CommentItem ← [text: Rope.Concat["--", comment]]];
}
ELSE ERROR SyntaxError["'/' is illegal at the start of a line."];
};
ENDCASE => {
x: REF TEXT;
in.Backup[char];
x ← GetTokenAsRefText[SimpleToken];
SELECT TRUE FROM
RefText.Equal[x, "Directory", FALSE] =>
item ← ParseDirectoryItem[exported: FALSE, readOnly: FALSE];
RefText.Equal[x, "ReadOnly", FALSE] =>
item ← ParseDirectoryItem[exported: FALSE, readOnly: TRUE];
RefText.Equal[x, "Imports", FALSE] => item ← ParseImportsItem[exported: FALSE];
RefText.Equal[x, "Include", FALSE],
RefText.Equal[x, "Includes", FALSE] => item ← ParseIncludeItem[];
RefText.Equal[x, "Exports", FALSE] => {
IF EndOfLineText[x ← GetTokenAsRefText[SimpleToken]] THEN
ERROR SyntaxError["Missing directory path following 'Exports'."];
SELECT TRUE FROM
RefText.Equal[x, "Directory", FALSE] =>
item ← ParseDirectoryItem[exported: TRUE, readOnly: FALSE];
RefText.Equal[x, "ReadOnly", FALSE] =>
item ← ParseDirectoryItem[exported: TRUE, readOnly: TRUE];
RefText.Equal[x, "Imports", FALSE] =>
item ← ParseImportsItem[exported: TRUE];
ENDCASE =>
item ← ParseDirectoryItem[
exported: TRUE, readOnly: FALSE, path1: Rope.FromRefText[x]];
};
ENDCASE => item ← ParseFileItem[name: Rope.FromRefText[x]];
};
IF item ~= NIL THEN {
FlushWhiteSpace[];
IF proc[item] THEN ERROR Abort;
}
ELSE CancelWhiteSpace[];
ENDLOOP;
RefText.ReleaseScratch[bufferN];
RefText.ReleaseScratch[bufferT];
};
SortUsingList[usingList: filter.list, nearlySorted: TRUE];
ParseInner[ !
Abort => CONTINUE;
IO.EndOfStream => ERROR SyntaxError["Unexpected end of DF."];
IO.Error => ERROR SyntaxError[NIL];
]
};
SyntaxError: PUBLIC ERROR [reason: ROPE] = CODE;
WriteToStream: PUBLIC PROC [out: IO.STREAM, proc: Utils.SupplyItemProc] = {
haveDirectory: BOOLFALSE;
DO
item: REF ANY = proc[];
IF item = NIL THEN EXIT;
WITH item SELECT FROM
directory: REF Utils.DirectoryItem => haveDirectory ← TRUE;
file: REF Utils.FileItem =>
IF ~haveDirectory THEN
ERROR SyntaxError["File item without preceding Directory item."];
imports: REF Utils.ImportsItem => haveDirectory ← FALSE;
include: REF Utils.IncludeItem => haveDirectory ← FALSE;
ENDCASE;
WriteItemToStream[out, item];
ENDLOOP;
};
WriteItemToStream: PUBLIC PROC [out: IO.STREAM, item: REF ANY] = {
maxUsingLineLength: INT = 90;
maxReasonableFileNameLength: INT = 45;
WITH item SELECT FROM
directory: REF Utils.DirectoryItem => {
IF directory.exported THEN out.PutRope["Exports "];
IF directory.readOnly THEN out.PutRope["ReadOnly "];
IF ~(directory.exported OR directory.readOnly) THEN out.PutRope["Directory "];
out.PutRope[directory.path1];
IF directory.path2.Length[] ~= 0 THEN {
out.PutRope[" "];
out.PutRope[IF directory.path2IsCameFrom THEN "CameFrom " ELSE "ReleaseAs "];
out.PutRope[directory.path2];
};
};
file: REF Utils.FileItem => {
out.PutRope[" "];
out.PutChar[IF file.verifyRoot THEN '+ ELSE Ascii.SP];
out.PutRope[file.name];
THROUGH [0..MAX[maxReasonableFileNameLength-file.name.Length[], 1]) DO
out.PutChar[Ascii.SP];
ENDLOOP;
DateToStream[out, file.date];
};
imports: REF Utils.ImportsItem => {
IF imports.exported THEN out.PutRope["Exports "];
out.PutRope["Imports "];
out.PutRope[imports.path1];
out.PutRope[" Of "];
DateToStream[out, imports.date];
IF imports.path2.Length[] ~= 0 THEN {
out.PutRope["\N CameFrom "];
out.PutRope[imports.path2];
};
SELECT imports.form FROM
When compatibility is no longer needed, replace the following NULL with
out.PutRope["\N Using Exports"]
exports => NULL;
all => out.PutRope["\N Using All"];
list => {
intro: ROPE = "\N Using [";
charsOnLine: INT ← intro.Length[].PRED;
out.PutRope[intro];
IF imports.list ~= NIL THEN {
FOR i: NAT IN [0..imports.list.nEntries) DO
The following is an approximate check; the line may get a bit longer than `maxUsingLineLength'.
entry: Utils.UsingEntry = imports.list.u[i];
IF charsOnLine + entry.name.Length[] > maxUsingLineLength THEN {
indent: ROPE = "\N ";
IF i ~= 0 THEN out.PutChar[',];
out.PutRope[indent];
charsOnLine ← indent.Length[].PRED;
}
ELSE
IF i ~= 0 THEN {out.PutRope[", "]; charsOnLine ← charsOnLine + 2};
IF entry.verifyRoot THEN {out.PutChar['+]; charsOnLine ← charsOnLine.SUCC};
out.PutRope[entry.name];
charsOnLine ← charsOnLine + entry.name.Length[];
ENDLOOP;
};
out.PutChar[']];
};
ENDCASE;
};
include: REF Utils.IncludeItem => {
out.PutRope["Include "];
out.PutRope[include.path1];
out.PutRope[" Of "];
DateToStream[out, include.date];
IF include.path2.Length[] ~= 0 THEN {
out.PutRope["\N "];
out.PutRope[IF include.path2IsCameFrom THEN "CameFrom " ELSE "ReleaseAs "];
out.PutRope[include.path2];
};
};
comment: REF Utils.CommentItem =>
out.PutRope[comment.text];
whiteSpace: REF Utils.WhiteSpaceItem =>
THROUGH [0..whiteSpace.lines-1) DO out.PutChar[Ascii.CR]; ENDLOOP;
ENDCASE => ERROR SyntaxError["Unrecognizable item."];
out.PutChar[Ascii.CR];
};
SortUsingList: PUBLIC PROC [usingList: REF Utils.UsingList, nearlySorted: BOOLFALSE] = {
IF usingList = NIL THEN RETURN;
IF nearlySorted THEN {
Insertion sort
FOR i: NAT IN [1..usingList.nEntries) DO
item: Utils.UsingEntry = usingList.u[i];
j: NAT ← i; -- 'j' can't be a loop control variable; we want its value on termination.
WHILE Rope.Compare[item.name, usingList.u[j-1].name, FALSE] = less DO
usingList.u[j] ← usingList.u[j-1];
IF (j ← j.PRED) = 0 THEN EXIT;
ENDLOOP;
IF j ~= i THEN usingList.u[j] ← item; -- test avoids unnecessary reference counting.
ENDLOOP;
}
ELSE {
Heap sort
SiftUp: PROC [low, high: NAT] = {
k: NAT ← low;
DO
twoK: NAT = k*2;
son: NAT ← twoK;
IF twoK > high THEN EXIT;
IF twoK+1 <= high AND
Rope.Compare[usingList.u[twoK+1-1].name, usingList.u[twoK-1].name, FALSE] ~= less THEN
son ← twoK+1;
IF Rope.Compare[usingList.u[son-1].name, usingList.u[k-1].name, FALSE] = less THEN EXIT;
Exchange[son-1, k-1];
k ← son;
ENDLOOP;
};
Exchange: PROC [a, b: NAT] = {
temp: Utils.UsingEntry = usingList.u[a];
usingList.u[a] ← usingList.u[b];
usingList.u[b] ← temp;
};
FOR i: NAT DECREASING IN [1..usingList.nEntries/2] DO
SiftUp[i, usingList.nEntries];
ENDLOOP;
FOR i: NAT DECREASING IN [1..usingList.nEntries) DO
Exchange[0, i];
SiftUp[1, i];
ENDLOOP;
};
};
SearchUsingList: PUBLIC PROC [file: ROPE, list: REF Utils.UsingList]
RETURNS [found: BOOLFALSE, index: NAT] = {
Do a binary search for "file" in "list".
IF list = NIL THEN found ← TRUE -- NIL list is interpreted as "everything"
ELSE {
low: INTEGER ← 0;
high: INTEGER ← list.nEntries.PRED;
UNTIL low > high DO
probe: NAT ← (low + high) / 2;
SELECT file.Compare[list.u[probe].name, FALSE] FROM
equal => RETURN[TRUE, probe];
less =>
IF probe = 0 THEN EXIT ELSE high ← probe.PRED;
greater =>
IF probe = list.nEntries.PRED THEN EXIT ELSE low ← probe.SUCC;
ENDCASE;
ENDLOOP;
found ← FALSE;
};
};
DifferenceOfUsingLists: PUBLIC PROC [a, b: REF Utils.UsingList]
RETURNS [diff: REF Utils.UsingList] = {
aI, bI: NAT ← 0;
aL: NAT = a.nEntries;
bL: NAT = b.nEntries;
diff ← NEW[Utils.UsingList[a.nEntries]];
diff.nEntries ← 0;
UNTIL aI = aL OR bI = bL DO
SELECT a.u[aI].name.Compare[b.u[bI].name, FALSE] FROM
equal => {aI ← aI.SUCC; bI ← bI.SUCC};
less => {
diff.u[diff.nEntries] ← a.u[aI];
diff.nEntries ← diff.nEntries.SUCC;
aI ← aI.SUCC;
};
greater => bI ← bI.SUCC;
ENDCASE;
ENDLOOP;
UNTIL aI = aL DO
diff.u[diff.nEntries] ← a.u[aI];
diff.nEntries ← diff.nEntries.SUCC;
aI ← aI.SUCC;
ENDLOOP;
};
DateToRope: PUBLIC PROC [date: Utils.Date] RETURNS [ROPENIL] = {
SELECT date.format FROM
$explicit => {
months: ROPE = "JanFebMarAprMayJunJulAugSepOctNovDec";
up: BasicTime.Unpacked = BasicTime.Unpack[date.gmt
! BasicTime.OutOfRange, BasicTime.TimeParametersNotKnown => GO TO noDate];
ConvertZone: PROC RETURNS [ROPE] = {
dst: BOOL = up.dst = yes;
SELECT up.zone FROM
0 => IF ~dst THEN RETURN["GMT"];
NAT[5*BasicTime.minutesPerHour] => RETURN[IF dst THEN "EDT" ELSE "EST"];
NAT[6*BasicTime.minutesPerHour] => RETURN[IF dst THEN "CDT" ELSE "CST"];
NAT[7*BasicTime.minutesPerHour] => RETURN[IF dst THEN "MDT" ELSE "MST"];
NAT[8*BasicTime.minutesPerHour] => RETURN[IF dst THEN "PDT" ELSE "PST"];
ENDCASE;
RETURN[
IO.PutFR["%g%02d%02d",
IO.char[IF up.zone < 0 THEN '- ELSE '+],
IO.card[up.zone.ABS/BasicTime.minutesPerHour],
IO.card[up.zone.ABS MOD BasicTime.minutesPerHour]
]
]
};
RETURN[
IO.PutFR[
"%02d-%g-%02d %g",
IO.card[up.day],
IO.rope[months.Substr[start: up.month.ORD*3, len: 3]],
IO.card[up.year MOD 100],
IO.rope[IO.PutFR[
"%02d:%02d:%02d %g",
IO.card[up.hour], IO.card[up.minute], IO.card[up.second],
IO.rope[ConvertZone[]]
]]
]
]
};
$notEqual => RETURN["~="];
$greaterThan => RETURN[">"];
ENDCASE;
EXITS
noDate => NULL;
};
DateToStream: PUBLIC PROC [s: IO.STREAM, date: Utils.Date] = {
SELECT date.format FROM
$explicit => {
months: ROPE = "JanFebMarAprMayJunJulAugSepOctNovDec";
up: BasicTime.Unpacked = BasicTime.Unpack[date.gmt
! BasicTime.OutOfRange, BasicTime.TimeParametersNotKnown => GO TO noDate];
ConvertZone: PROC = {
dst: BOOL = up.dst = yes;
SELECT up.zone FROM
0 => IF ~dst THEN s.PutRope["GMT"];
NAT[5*BasicTime.minutesPerHour] => s.PutRope[IF dst THEN "EDT" ELSE "EST"];
NAT[6*BasicTime.minutesPerHour] => s.PutRope[IF dst THEN "CDT" ELSE "CST"];
NAT[7*BasicTime.minutesPerHour] => s.PutRope[IF dst THEN "MDT" ELSE "MST"];
NAT[8*BasicTime.minutesPerHour] => s.PutRope[IF dst THEN "PDT" ELSE "PST"];
ENDCASE =>
s.PutF["%g%02d%02d",
IO.char[IF up.zone < 0 THEN '- ELSE '+],
IO.card[up.zone.ABS/BasicTime.minutesPerHour],
IO.card[up.zone.ABS MOD BasicTime.minutesPerHour]
]
};
s.PutF["%02d-%g-%02d ",
IO.card[up.day],
IO.rope[months.Substr[start: up.month.ORD*3, len: 3]],
IO.card[up.year MOD 100]
];
s.PutF["%02d:%02d:%02d ", IO.card[up.hour], IO.card[up.minute], IO.card[up.second]];
ConvertZone[];
};
$notEqual => s.PutRope["~="];
$greaterThan => s.PutChar['>];
ENDCASE;
EXITS
noDate => NULL;
};
ClassifyFileExtension: PUBLIC PROC [file: ROPE] RETURNS [Utils.FilterA] = {
For now, efficiency concerns prevent us from using FS.ExpandName for this.
exts: ARRAY [0..4) OF ROPE = [".bcd", ".boot", ".press", ".signals"];
FOR i: NAT IN [0..exts.LENGTH) DO
IF file.Length[] >= exts[i].Length[] AND
file.Find[s2: exts[i], pos1: file.Length[]-exts[i].Length[], case: FALSE] >= 0 THEN
RETURN[$derived];
ENDLOOP;
RETURN[$source]
};
GetVersionNumber: PUBLIC PROC [r: ROPE] RETURNS [ROPE] = {
For now, efficiency concerns prevent us from using FS.ExpandName for this.
RETURN[r.Substr[start: r.Index[s2: "!"]]]
};
RemoveVersionNumber: PUBLIC PROC [r: ROPE] RETURNS [ROPE] = {
For now, efficiency concerns prevent us from using FS.ExpandName for this.
RETURN[r.Substr[len: r.Index[s2: "!"]]]
};
END.