LexEDIF:
PUBLIC
PROC [source: Source, from:
IO.
STREAM]
RETURNS [pt: ParseTree] = {
ENABLE IO.EndOfStream => IF stream = from THEN LexError[from, from.GetIndex[], "Incomplete something-or-other"];
ParseList:
PROC
RETURNS [pt: ParseTree] = {
c: CHAR ← from.GetChar[];
f:
REF list ParseTreePrivate =
NEW [ParseTreePrivate.list ← [
origin: [
source: source,
where: [start: from.GetIndex[]-1]],
variant: list[
children: NIL
]
]];
tail: ParseTreeList ← NIL;
Append:
PROC [sub: ParseTree] = {
this: ParseTreeList = LIST[sub];
IF f.children =
NIL
THEN f.children ← this
ELSE tail.rest ← this;
tail ← this;
};
IF c # '( THEN ERROR;
DO
d: CHAR;
[] ← from.SkipWhitespace[flushComments: FALSE];
SELECT d ← from.PeekChar[]
FROM
') => {IF from.GetChar[] # ') THEN ERROR; EXIT};
'( => Append[ParseList[]];
IN ['a .. 'z], IN ['A .. 'Z] => Append[ParseIdentifier[]];
'-, '+, IN ['0 .. '9] => Append[ParseInt[]];
'" => Append[ParseString[]];
ENDCASE => Append[ParseIdentifier[]];
ENDLOOP;
f.origin.where.endPlusOne ← from.GetIndex[];
pt ← f;
};
ParseIdentifier:
PROC
RETURNS [pt: ParseTree] = {
keyBuff: REFTEXT;
where: PositionRange;
[keyBuff, where] ← ParseAtom[];
pt ←
NEW [ParseTreePrivate.identifier ← [
origin: [
source: source,
where: where],
variant: identifier[id: Atom.MakeAtomFromRefText[keyBuff]]
]];
};
ParseAtom:
PROC
RETURNS [buff:
REFTEXT, where: PositionRange] = {
oneCharOnly:
BOOL =
SELECT from.PeekChar[]
FROM
IN ['a .. 'z], IN ['A .. 'Z] => FALSE,
ENDCASE => TRUE;
first: BOOL ← TRUE;
next: INT;
buff ← RefText.New[10];
WHILE first
OR
NOT oneCharOnly
DO
c: CHAR = from.PeekChar[];
SELECT c
FROM
IN ['a .. 'z],
IN ['A .. 'Z],
IN ['0 .. '9], '← => {
IF c # from.GetChar[] THEN ERROR;
next ← from.GetIndex[];
IF first THEN where.start ← next-1;
buff ← RefText.InlineReserveChars[buff, 1];
buff ← RefText.InlineAppendChar[buff, c];
};
ENDCASE => EXIT;
first ← FALSE;
ENDLOOP;
IF first THEN ERROR;
where.endPlusOne ← next;
buff ← buff;
};
ParseInt:
PROC
RETURNS [pt: ParseTree] = {
start: INT ← from.GetIndex[] --count on bug in PeekChar:-- -1;
pt ←
NEW [ParseTreePrivate
.integer ← [
origin: [
source: source,
where: [start: start]],
variant: integer[
i: from.GetInt[!
IO.Error =>
IF stream # from THEN NULL
ELSE IF ec = SyntaxError THEN LexError[from, from.GetIndex[], "Syntax error while parsing integer"]
ELSE IF ec = Overflow THEN LexError[from, from.GetIndex[], "EDIF integer out of range"]
]
]
]];
pt.origin.where.endPlusOne ← from.GetIndex[] --count on bug in PeekChar:-- -1;
};
ParseString:
PROC
RETURNS [pt: ParseTree] = {
buff: REF TEXT ← RefText.New[100];
Append:
PROC [c:
CHAR] =
INLINE {
buff ← RefText.InlineReserveChars[buff, 1];
buff ← RefText.InlineAppendChar[buff, c];
};
GetDigit:
PROC
RETURNS [d: Digit] = {
c: CHAR = from.GetChar[];
IF c IN ['0 .. '9] THEN RETURN [c - '0] ELSE LexError[from, from.GetIndex[], IO.PutFR["Got [%c]=%03bC instead of a digit in an escape sequence in a string", [character[c]], [integer[c - 0C]]]];
};
start: INT;
IF from.GetChar[] # '" THEN ERROR;
start ← from.GetIndex[]-1;
DO
c: CHAR = from.GetChar[];
SELECT c
FROM
'" => EXIT;
Ascii.TAB, '\n, '\012, '\015 => NULL;
'% => {
d100: Digit = GetDigit[];
d10: Digit = GetDigit[];
d1: Digit = GetDigit[];
code: INT = (d100*100 + d10*10 + d1) MOD 128;
Append[0C + code];
};
ENDCASE => Append[c];
ENDLOOP;
pt ←
NEW [ParseTreePrivate.string ← [
origin: [
source: source,
where: [start: start, endPlusOne: from.GetIndex[]]
],
variant: string[s: Rope.FromRefText[buff]]
]];
};
[] ← from.SkipWhitespace[flushComments: FALSE];
IF from.PeekChar[] # '( THEN LexError[from, from.GetIndex[], "Not an EDIF statement"];
pt ← ParseList[];
};