ParseInner:
PROC = {
passFileItems: BOOL ← TRUE;
underDirectory: BOOL ← FALSE;
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];
};
UsingToken:
IO.BreakProc
-- [char: CHAR] RETURNS [IO.CharClass] -- = {
SELECT char
FROM
'- => RETURN[$other];
ENDCASE => RETURN[IO.TokenProc[char]];
};
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[DFUtilities.WhiteSpaceItem ← [lines: blankLineCount]]] THEN ERROR Abort;
CancelWhiteSpace[];
};
};
CancelWhiteSpace: PROC = {blankLineCount ← 0};
CancelDirectory: PROC = {underDirectory ← FALSE};
GetDate:
PROC
RETURNS [DFUtilities.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:
ROPE ←
NIL]
RETURNS [REF DFUtilities.DirectoryItem] = {
directoryFilterB: DFUtilities.FilterB = IF exported THEN $public ELSE $private;
directoryFilterC: DFUtilities.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: ROPE ← NIL;
path2IsCameFrom: BOOL ← FALSE;
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[DFUtilities.DirectoryItem ← [
path1: path1,
path2: path2,
path2IsCameFrom: path2IsCameFrom,
exported: exported,
readOnly: readOnly
]]
ELSE NIL
]
};
ParseFileItem:
PROC [verifyRoot:
BOOL ←
FALSE, name:
ROPE ←
NIL]
RETURNS [REF DFUtilities.FileItem] = {
PassesNameFilter:
PROC [file:
ROPE]
RETURNS [
BOOL] = {
SELECT
TRUE
FROM
filter.list # NIL => {};
filter.filterA = $all => {};
ClassifyFileExtension[file] = filter.filterA => {};
ENDCASE => RETURN[FALSE];
RETURN[SearchUsingList[file, filter.list].found]
};
date: DFUtilities.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[DFUtilities.FileItem ← [
name: name,
date: date,
verifyRoot: verifyRoot
]]
ELSE NIL
]
};
ParseImportsItem:
PROC [exported:
BOOL]
RETURNS [
REF DFUtilities.ImportsItem] = {
x: REF TEXT;
path1, path2: ROPE ← NIL;
date: DFUtilities.Date;
form: DFUtilities.UsingForm ← $exports;
list: REF DFUtilities.UsingList ← NIL;
ConsiderImports:
PROC
RETURNS [
BOOL] = {
IF filter.filterC = $defining THEN RETURN[FALSE];
IF exported
AND filter.list #
NIL
THEN {
RRA sez: we should consider the imports of any imports item being exported when there is an explicit filter list. Of course, if there is a null intersection (list = NIL), we don't have to consider it unless the form dictates it.
RETURN [form = $all OR form = $exports OR list # NIL];
};
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[UsingToken];
SELECT
TRUE
FROM
RefText.Equal[x, "All", FALSE] => form ← $all;
RefText.Equal[x, "Exports", FALSE] => --form ← $exports-- NULL;
RefText.Equal[x, "[",
FALSE] => {
verifyRoot: BOOL ← FALSE;
form ← $list;
DO
index: NAT;
inList: BOOL;
x ← GetTokenAsRefText[UsingToken];
IF RefText.Length[x] = 1
THEN
SELECT RefText.Fetch[x, 0]
FROM
'] => EXIT;
'+ =>
IF ~verifyRoot THEN {verifyRoot ← TRUE; LOOP}
ELSE ERROR SyntaxError["Illegally 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[DFUtilities.UsingList[length]];
list.nEntries ← 0;
};
list.nEntries = list.length => {
This case can only happen if filter.list = NIL
newList: REF DFUtilities.UsingList ← NEW[DFUtilities.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[DFUtilities.ImportsItem ← [
path1: path1,
date: date,
path2: path2,
exported: exported,
form: form,
list: list
]]
ELSE NIL
]
};
ParseIncludeItem:
PROC
RETURNS [
REF DFUtilities.IncludeItem] = {
item:
REF DFUtilities.IncludeItem =
NEW[DFUtilities.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 ANY ← NIL;
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[DFUtilities.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: ROPE ← NIL;
comment ← in.GetLineRope[ ! IO.EndOfStream => CONTINUE];
convert to new style
IF filter.comments
THEN
item ← NEW[DFUtilities.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];
};