-- MUMBLE PARSER IMPLEMENTATION - - - - - - - - - - - - - - - - - - - - - - - - ParserImpl
-- MUMParserImpl.mesa of August 3, 1982 6:34 pm
-- To do: revise for viewers
DIRECTORY
MUMParser USING [],
Rope USING [Ref, Int, Substr, Fetch, Size, Concat, FromString],
BOPTTY USING [PutLine, PutString, PutRope, NewLine],
BOPKeys USING [SP];
MUMParserImpl: PROGRAM
IMPORTS Rope, BOPTTY
EXPORTS MUMParser =
BEGIN OPEN MUMParser, BOPTTY, BOPKeys;
Empty: PROCEDURE [TP: TextPt] RETURNS [BOOLEAN] = INLINE
{RETURN [TP.Length = 0]};
First: PROCEDURE [TP: TextPt] RETURNS [C: CHAR] = INLINE
{RETURN [IF Empty [TP] THEN ETX
ELSE Rope.Fetch [TP.Text, TP.Pos]]};
Next: PROCEDURE [TP: TextPt] RETURNS [NTP: TextPt] = INLINE
{RETURN [IF Empty [TP] THEN TP
ELSE [TP.Text, TP.Pos + 1, TP.Length - 1]]};
CutText: PROCEDURE [TP: TextPt, L: Rope.Int] RETURNS [NTP: TextPt] = INLINE
{RETURN [[TP.Text, TP.Pos, L]]};
CatText: PROCEDURE [TPA, TPB: TextPt] RETURNS [NTP: TextPt] = INLINE
{RETURN [[TPA.Text, TPA.Pos, TPB.Length + (TPB.Pos - TPA.Pos)]]};
GetRope: PROCEDURE [TP: TextPt] RETURNS [R: Rope.Ref] = INLINE
{RETURN [Rope.Substr [TP.Text, TP.Pos, TP.Length]]};
Parse: PUBLIC PROCEDURE [TP: TextPt] RETURNS [EX: RefExpr, RTP: TextPt] =
BEGIN
[EX, RTP] ← ParseExpr [TP, MaxPrio];
RTP ← SkipBlank [RTP];
IF EX # NIL AND First [RTP] # ETX THEN
SyntaxWarning [EX, RTP, "Extra characters - ignored"];
END;
MaxPrio:
INTEGER = 20;
Priority:
TYPE =
INTEGER [0..MaxPrio];
-- ApplyPrio is the priority of the "application" operator, which applies an unary operator or function to an expression, and is denoted by simple justaposition of the two.
ApplyPrio: Priority = 0;
-- Notifies the user that an error or warning has been found in the object EX or in the remaining text RTP. Assumes EX.Source.Length may be still undefined, and uses RTP.Pos - EX.Source.Pos instead.
SyntaxMessage:
PROC [
EX: RefExpr,
RTP: TextPt, Class, Mess:
LONG
STRING] =
BEGIN
R: Rope.Ref; Bg: Rope.Int;
IF
EX #
NIL
THEN
{
EXS: TextPt =
EX.Source;
IF
RTP.Pos -
EXS.Pos < 30
THEN
R ← Rope.Substr [
EXS.Text,
EXS.Pos,
RTP.Pos -
EXS.Pos]
ELSE
R ← Rope.Substr [
EXS.Text,
RTP.Pos - 30, 30]};
R ← Rope.Concat [
R, Rope.Concat [Rope.FromString ["<>"],
Rope.Substr [
RTP.Text,
RTP.Pos,
MIN [
RTP.Length, 40 - Rope.Size [
R]]]]];
NewLine [];
PutLine ["---- "]; PutRope [
R];
PutLine ["---- "]; PutString [Class]; PutString [Mess]
END;
-- Notifies the user of a grave syntax error. The Good flag of EX is set to FALSE.
SyntaxError:
PROC [
EX: RefExpr,
RTP: TextPt, Mess:
LONG
STRING] =
BEGIN
SyntaxMessage [
EX,
RTP, "Error: ", Mess];
IF
EX #
NIL
THEN
EX.Good ←
FALSE
END;
-- Prints a syntax warning.
SyntaxWarning:
PROC [
EX: RefExpr,
RTP: TextPt, Mess:
LONG
STRING] =
BEGIN
SyntaxMessage [
EX,
RTP, "Warning: ", Mess]
END;
-- Parses a <primary> i.e. an identifier, number, string, unary operator or closed expression (delimited by (), [] or {}). Returns NIL if not found.
ParsePrimary: PUBLIC PROCEDURE [TP: TextPt]
RETURNS [EX: RefExpr, RTP: TextPt] =
BEGIN
RTP ← SkipBlank [TP];
[EX, RTP] ← ParseRecordExpr [RTP, Value]; IF EX # NIL THEN RETURN;
[EX, RTP] ← ParseProc [RTP]; IF EX # NIL THEN RETURN;
[EX, RTP] ← ParseGroup [RTP]; IF EX # NIL THEN RETURN;
[EX, RTP] ← ParseString [RTP]; IF EX # NIL THEN RETURN;
[EX, RTP] ← ParseNum [RTP]; IF EX # NIL THEN RETURN;
[EX, RTP] ← ParseId [RTP]; IF EX # NIL THEN RETURN;
[EX, RTP] ← ParseUnaryOp [RTP]
END;
ParseUnaryOp:
PROCEDURE [
TP: TextPt]
RETURNS [
OP:
REF UnaryOp Expr,
RTP: TextPt] =
BEGIN
C:
CHAR;
RTP ← SkipBlank [
TP];
C ← First [
RTP];
FOR Op: UnaryOp
IN UnaryOp
DO
IF
C = UnaryOpChar [Op]
THEN
RETURN [
OP:
NEW [UnaryOp Expr ←
[Good:
TRUE,
Source: CutText [
TP, 1],
Body: UnaryOp [Op: Op]]],
RTP: Next [
TP]]
ENDLOOP;
RETURN [
NIL,
TP];
END;
-- Parses an <ApplyPrio expr> i.e. an <expr> which is zero or more unary operators or primaries applied to a primary. Returns NIL if not found.
ParseApplyExpr:
PUBLIC
PROCEDURE [
TP: TextPt]
RETURNS [
EX: RefExpr,
RTP: TextPt] =
BEGIN
EXB: RefExpr;
[
EX,
RTP] ← ParsePrimary [
TP];
IF
EX =
NIL
THEN
RETURN [
NIL,
TP];
[
EXB,
RTP] ← ParseApplyExpr [
RTP];
IF
EXB #
NIL
THEN
EX ←
NEW [Expr Expr ←
[Good:
TRUE,
Source: CatText [
EX.Source,
EXB.Source],
Body: Expr [Op: Apply,
SA:
EX,
SB:
EXB]]]
ELSE
IF
EX.Kind = UnaryOp
THEN
SyntaxError [
EX,
RTP, "Unary operator not followed by operand"]
END;
-- Parses a <Prio expr> i.e. an <expr> whose outermost binary operator has priority Prio. Returns NIL if not found.
ParseExpr: PUBLIC PROCEDURE [TP: TextPt, Prio: Priority]
RETURNS [EX: RefExpr, RTP: TextPt] =
BEGIN
EXB: RefExpr;
OP: REF BinaryOp Expr;
CurAss, NewAss: BOOLEAN ← TRUE;
CurPrio, NewPrio: Priority ← ApplyPrio;
[EX, RTP] ← ParseApplyExpr [TP];
IF EX = NIL OR Prio = ApplyPrio THEN RETURN;
DO
[OP, RTP] ← ParseBinaryOp [RTP, Prio - 1];
IF OP = NIL THEN RETURN;
[NewPrio, NewAss] ← OpProps [OP.Op];
IF CurPrio = NewPrio THEN
{IF NOT (CurAss AND NewAss) THEN
SyntaxError [OP, RTP, "Mixed associative and non-associative operators"]};
CurPrio ← NewPrio; CurAss ← NewAss;
[EXB, RTP] ← ParseExpr [RTP, CurPrio];
IF EXB = NIL THEN
SyntaxError [OP, RTP, "Binary operator not followed by operand"];
EX ← NEW [Expr Expr ←
[Good: TRUE,
Source: CatText [EX.Source,
IF EXB = NIL THEN OP.Source
ELSE CatText [OP.Source, EXB.Source]],
Body: Expr [Op: OP.Op,
SA: EX, SB: EXB]]]
ENDLOOP
END;
ParseBinaryOp: PROC [TP: TextPt, MaxP: Priority]
RETURNS [OP: REF BinaryOp Expr, RTP: TextPt] =
BEGIN
C: CHAR;
RTP ← SkipBlank [TP];
C ← First [RTP];
FOR Op: BinaryOp IN BinaryOp DO
IF C = BinaryOpChar [Op] AND OpProps [Op].Priority <= MaxP THEN
RETURN [OP: NEW [BinaryOp Expr ←
[Good: TRUE,
Source: CutText [RTP, 1],
Body: BinaryOp [Op: Op]]],
RTP: Next [RTP]]
ENDLOOP;
RETURN [NIL, TP]
END;
SkipBlank: PROC [TP: TextPt] RETURNS [NTP: TextPt] =
{RETURN [IF First [TP] = SP THEN Next [TP] ELSE TP]};
ParseNum: PROC [TP: TextPt] RETURNS [EX: REF Int Expr, RTP: TextPt] =
BEGIN
C: CHAR;
Base: CARDINAL [2..16];
RTP ← SkipBlank [TP];
IF First [RTP] IN ['0..'9] THEN
BEGIN
EX ← NEW [Int Expr ← [Good: TRUE, Source: RTP, Body: Int [Val: 0]]];
DO
RTP ← Next [RTP];
IF First [RTP] NOT IN ['0..'9] THEN EXIT
ENDLOOP;
C ← First [RTP];
Base ← IF C = 'B OR C = 'b THEN 2
ELSE IF C = 'C OR C = 'c THEN 8
ELSE 10;
FOR P: Rope.Int IN [EX.Source.Pos..RTP.Pos) DO
C ← Rope.Fetch [EX.Source.Text, P];
IF EX.Good THEN
{IF C NOT IN ['0..'0 + Base) THEN
SyntaxError [EX, RTP, "Invalid Digit"];
IF EX.Val > (LAST [LONG CARDINAL] - (C - '0))/Base THEN
SyntaxError [EX, RTP, "Number Too Large"]}
ELSE
EX.Val ← EX.Val * Base + (C - '0);
ENDLOOP;
IF Base # 10 THEN RTP ← Next [RTP];
EX.Source.Length ← RTP.Pos - EX.Source.Pos
END
ELSE
EX ← NIL
END;
IsLetter: PROC [C: CHAR] RETURNS [BOOLEAN] = INLINE
{RETURN [C IN ['a..'z] OR C IN ['A..'Z]]};
IsLetterDigit: PROC [C: CHAR] RETURNS [BOOLEAN] = INLINE
{RETURN [C IN ['a..'z] OR C IN ['A..'Z] OR C IN ['0..'9]]};
ParseId: PROC [TP: TextPt] RETURNS [EX: REF Id Expr, RTP: TextPt] =
BEGIN
C: CHAR;
RTP ← SkipBlank [TP];
IF IsLetter [First [RTP]] THEN
BEGIN
EX ← NEW [Id Expr ← [Good: TRUE, Source: RTP, Body: Id [Chars: ]]];
DO
RTP ← Next [RTP];
IF NOT IsLetterDigit [First [RTP]] THEN EXIT
ENDLOOP;
EX.Source.Length ← RTP.Pos - EX.Source.Pos;
EX.Chars ← GetRope [EX.Source];
END
ELSE
EX ← NIL
END;
ParseString: PROC [TP: TextPt] RETURNS [EX: REF String Expr, RTP: TextPt] =
BEGIN
C: CHAR;
RTP ← SkipBlank [TP];
IF First [RTP] = '" THEN
BEGIN
BegChunk: Rope.Int;
EX ← NEW [String Expr ← [Good: TRUE, Source: RTP, Body: String [Chars: NIL]]];
DO
RTP ← Next [RTP];
BegChunk ← RTP.Pos;
WHILE NOT Empty [RTP] AND First [RTP] # '" DO
RTP ← Next [RTP]
ENDLOOP;
IF Empty [RTP] THEN
SyntaxError [EX, RTP, "Missing final quote"];
EX.Chars ← Rope.Concat [EX.Chars, Rope.Substr [TP.Text, BegChunk, RTP.Pos - BegChunk]];
RTP ← Next [RTP];
RTP ← SkipBlank [RTP];
IF First [RTP] # '" THEN EXIT
ENDLOOP;
EX.Source.Length ← EX.Source.Pos - RTP.Pos
END
ELSE
EX ← NIL
END;
ValueOrMold: TYPE = {Value, Mold};
ParseRecordExpr: PROC [TP: TextPt, Usage: ValueOrMold] RETURNS [EX: REF RecExpr Expr, RTP: TextPt] =
BEGIN
C: CHAR; Found: BOOLEAN;
RTP ← SkipBlank [TP];
IF First [RTP] = '[ THEN
BEGIN
T, LR: LIST OF FieldExpr ← NIL;
Field: FieldExpr;
RTPId: TextPt;
EX ← NEW [RecExpr Expr ← [Good: TRUE, Source: RTP, Body: RecExpr [LS: NIL]]];
RTP ← Next [RTP];
DO
[Field.Name, RTPId] ← ParseId [RTP];
RTPId ← SkipBlank [RTPId];
C ← First [RTPId];
IF C = ': THEN
RTP ← Next [RTPId]
ELSE IF C = '] OR C = ', OR C = '! THEN
IF Usage = Mold THEN
RTP ← RTPId
ELSE
Field.Name ← NIL
ELSE
Field.Name ← NIL;
[Field.Val, RTP] ← ParseExpr [RTP];
RTP ← SkipBlank [RTP];
IF First [RTP] = '! THEN
[Field.Mold, RTP] ← ParseMold [Next [RTP]];
LR ← CONS [Field, LR];
RTP ← SkipBlank [RTP];
IF First [RTP] # ', THEN EXIT;
RTP ← Next [RTP]
ENDLOOP;
RTP ← SkipBlank [RTP];
EX.Source.Length ← RTP.Pos - EX.Source.Pos;
IF First [RTP] = '] THEN
{EX.Source.Length ← EX.Source.Length + 1;
RTP ← Next [RTP]}
ELSE
{SyntaxError [EX, RTP, "Right Bracket inserted"]};
WHILE LR # NIL DO
T ← EX.LS; EX.LS ← LR; LR ← LR.rest; EX.LS.rest ← T
ENDLOOP
END
ELSE EX ← NIL
END;
ParseGroup: PROC [TP: TextPt] RETURNS [EX: RefExpr, RTP: TextPt] =
BEGIN
TP ← SkipBlank [TP];
IF First [TP] = '( THEN
BEGIN
RTP ← Next [RTP];
[EX, RTP] ← ParseExpr [RTP, MaxPrio];
IF EX = NIL THEN
{EX ← NEW [Id Expr ← [Good: FALSE, Source: TP, Body: Id [Chars: NIL]]];
SyntaxError [EX, RTP, "Expression expected"]};
RTP ← SkipBlank [RTP];
IF First [RTP] = ') THEN
RTP ← Next [RTP]
ELSE
SyntaxError [EX, RTP, "Right parenthesis inserted"];
EX.Source.length ← RTP.Pos - EX.Source.Pos;
END
ELSE
{EX ← NIL; RTP ← TP}
END;
ParseMold: PROC [TP: TextPt] RETURNS [EX: RefExpr, RTP: TextPt] =
BEGIN
[EX, RTP] ← ParseId [TP]; IF EX # NIL THEN RETURN;
[EX, RTP] ← ParseRecordExpr [TP, Mold]
END;
ParseProc:
PROC [
TP: TextPt]
RETURNS [
EX:
REF Proc Expr,
RTP: TextPt] =
BEGIN
EX ←
NIL;
END;
-- Parses an isolated character C, ignoring blanks. Returns NIL if not found.
ParseChar: PUBLIC PROCEDURE [TP: TextPt, C: CHAR]
RETURNS [Found: BOOLEAN, RTP: TextPt] =
BEGIN
RTP ← SkipBlank [TP];
IF First [RTP] = C THEN
RETURN [TRUE, Next [RTP]]
ELSE
RETURN [FALSE, RTP]
END;
END...