RussellParserImpl.mesa
This module is a parser for Russell 84.
Last Edited by: Demers, March 7, 1984 9:53:30 am PST
DIRECTORY
RussellSyntax USING [TokType, GetRussellToken],
RussellICode,
IO USING [STREAM],
Rope USING [ROPE],
Convert USING [CharFromLiteral, RopeFromLiteral, IntFromRope],
RefText USING [ObtainScratch, ReleaseScratch, line];
RussellParserImpl: CEDAR PROGRAM
IMPORTS RussellSyntax, RefText, Convert
EXPORTS RussellICode
= BEGIN
OPEN RussellICode ;
ParseRussellExpression: PUBLIC PROCEDURE [source: IO.STREAM, errMsgProc: ErrMsgProc] RETURNS [ICExp]
= BEGIN
tokType: RussellSyntax.TokType;
tokVal: REF ANY;
nextTokType: RussellSyntax.TokType;
nextTokVal: REF ANY;
inputPos: INT ← 0;
charsRead: INT;
scanBuf: REF TEXT;
answer: ICExp;
Scan: PROCEDURE []
= BEGIN
tokType ← nextTokType;
tokVal ← nextTokVal;
[tokType~nextTokType, tokVal~nextTokVal, charsRead~charsRead]
← RussellSyntax.GetRussellToken[source~source, buffer~scanBuf];
inputPos ← inputPos + charsRead
END ; -- Scan
LogError: PROCEDURE [errMsg: Rope.ROPE]
= BEGIN
errMsgProc[errPos~inputPos, errMsg~errMsg]
END ; -- LogError
Mandatory: PROCEDURE [typeWanted: RussellSyntax.TokType, errMsg: Rope.ROPE]
= BEGIN
IF tokType = typeWanted
THEN Scan[]
ELSE LogError[errMsg];
END ; -- Mandatory
Optional: PROCEDURE [typeWanted: RussellSyntax.TokType]
= BEGIN
IF tokType = typeWanted
THEN Scan[]
END ; -- Optional
ScanThrough: PROCEDURE [typeWanted: RussellSyntax.TokType, errMsg: Rope.ROPE]
= BEGIN
IF tokType # typeWanted
THEN LogError[errMsg] ;
WHILE (tokType # typeWanted) AND (tokType # tokEOF) DO
Scan[]
ENDLOOP ;
IF tokType = tokEOF
THEN LogError["unexpected EOF"]
ELSE Scan[]
END ; -- ScanThrough
RequireAndRecoverTo: PROCEDURE [typeWanted: RussellSyntax.TokType, errMsg: Rope.ROPE, recoverProc: PROC[]]
= BEGIN
IF tokType # typeWanted
THEN LogError[errMsg~errMsg] ;
DO
SELECT TRUE FROM
tokType = tokEOF => {
LogError["unexpected EOF"] ; EXIT } ;
tokType = typeWanted => {
Scan[]; EXIT } ;
InFirstOfExp[] =>
recoverProc[] ;
ENDCASE =>
Scan[] ;
ENDLOOP
END ; -- RequireAndRecoverTo
RecoverExp: PROCEDURE []
= BEGIN
[] ← ParseExp[]
END ; -- RecoverExp
RecoverBinding: PROCEDURE []
= BEGIN
[] ← ParseBinding[nameRequired~FALSE]
END ; -- RecoverBinding
RecoverTyping: PROCEDURE []
= BEGIN
[] ← ParseTyping[nameRequired~FALSE]
END ; -- RecoverTyping
RecoverGuardedExp: PROCEDURE []
= BEGIN
[] ← ParseGuardedExp[]
END ; -- RecoverGuardedExp
InFirstOfExp: PROCEDURE [] RETURNS [BOOL]
= BEGIN
RETURN[ SELECT tokType FROM
tokId, tokLParen, tokLTupleBrak, tokLRecTupleBrak, tokLBrak, tokKWfunc, tokKWproc, tokKWref, tokKWprod, tokKWunion, tokLUnionBrak, tokKWif, tokKWdo, tokKWopen, tokKWlambda, tokKWtype, tokKWsafetype, tokCharConst, tokStringConst, tokIntConst => TRUE ,
ENDCASE => FALSE ]
END ; -- InFirstOfExp
InFirstOfGuardedExp: PROCEDURE [] RETURNS [BOOL]
= BEGIN
RETURN[ SELECT tokType FROM
tokId, tokLParen, tokLTupleBrak, tokLRecTupleBrak, tokLBrak, tokKWfunc, tokKWproc, tokKWref, tokKWprod, tokKWunion, tokLUnionBrak, tokKWif, tokKWdo, tokKWopen, tokKWlambda, tokKWtype, tokKWsafetype, tokCharConst, tokStringConst, tokIntConst => TRUE ,
ENDCASE => FALSE ]
END ; -- InFirstOfGuardedExp
InFirstOfBinding: PROCEDURE [nameRequired: BOOL] RETURNS [BOOL]
= BEGIN
IF nameRequired
THEN RETURN[ tokType = tokId ];
RETURN[ SELECT tokType FROM
tokId, tokLParen, tokLTupleBrak, tokLRecTupleBrak, tokLBrak, tokKWfunc, tokKWproc, tokKWref, tokKWprod, tokKWunion, tokLUnionBrak, tokKWif, tokKWdo, tokKWopen, tokKWlambda, tokKWtype, tokKWsafetype, tokCharConst, tokStringConst, tokIntConst => TRUE ,
ENDCASE => FALSE ]
END ; -- InFirstOfBinding
InFirstOfTyping: PROCEDURE [nameRequired: BOOL] RETURNS [BOOL]
= BEGIN
IF nameRequired
THEN RETURN[ tokType = tokId ];
RETURN[ SELECT tokType FROM
tokId, tokLParen, tokLTupleBrak, tokLRecTupleBrak, tokLBrak, tokKWfunc, tokKWproc, tokKWref, tokKWprod, tokKWunion, tokLUnionBrak, tokKWif, tokKWdo, tokKWopen, tokKWlambda, tokKWtype, tokKWsafetype, tokCharConst, tokStringConst, tokIntConst => TRUE ,
ENDCASE => FALSE ]
END ; -- InFirstOfTyping
ParseExp: PROCEDURE [] RETURNS [ICExp]
Exp ::= Exp { ; Exp }* -- Sequence, allow ; as terminator.
= BEGIN
tempICExp1, tempICExp2: ICExp;
tempICExp1 ← ParseExp3[];
DO
SELECT tokType FROM
tokStmtSep => BEGIN
Scan[];
IF NOT InFirstOfExp[] THEN EXIT ;
tempICExp2 ← ParseExp3[];
tempICExp1 ← NEW[ SeqICNode ← [ leftPart~tempICExp1, rightPart~tempICExp2 ]]
END ;
ENDCASE => EXIT ;
ENDLOOP ;
RETURN[ tempICExp1 ]
END ; -- ParseExp
ParseExp3: PROCEDURE [] RETURNS [ICExp]
Exp ::= Exp { Exp }* -- Application, left-associative.
= BEGIN
tempICExp1, tempICExp2: ICExp;
tempICExp1 ← ParseExp2[];
WHILE InFirstOfExp[] DO
tempICExp2 ← ParseExp2[];
tempICExp1 ← NEW[ ApplyICNode ← [ proc~tempICExp1, arg~tempICExp2 ]]
ENDLOOP ;
RETURN[ tempICExp1 ]
END ; -- ParseExp3
ParseExp2: PROCEDURE [] RETURNS [ICExp]
Exp ::= Exp { | Exp }* -- Tuple concatentation.
= BEGIN
tempICExp1, tempICExp2: ICExp;
tempICExp1 ← ParseExp1[];
DO
SELECT tokType FROM
tokConcat => BEGIN
Scan[];
tempICExp2 ← ParseExp1[];
tempICExp1 ← NEW[ ConcatICNode ← [ leftPart~tempICExp1, rightPart~tempICExp2 ]]
END ;
ENDCASE => EXIT ;
ENDLOOP ;
RETURN[ tempICExp1 ]
END ; -- ParseExp2
ParseExp1: PROCEDURE [] RETURNS [ICExp]
Exp ::= Exp { . Id }? -- Selection.
= BEGIN
tempICExp: ICExp;
tempICExp ← ParseExp0[];
DO
SELECT tokType FROM
tokSelect => BEGIN
Scan[];
IF tokType = tokId
THEN BEGIN
tempICExp ← NEW[ SelectICNode ← [ tuple~tempICExp, name~NARROW[tokVal]]];
Scan[]
END
ELSE BEGIN
LogError[errMsg~"expecting selector name"]
END
END ;
ENDCASE => EXIT ;
ENDLOOP ;
RETURN[ tempICExp ]
END ; -- ParseExp1
ParseExp0: PROCEDURE [] RETURNS [ICExp]
Exp ::= ... -- All the other cases, see below.
= BEGIN
tempICExp1, tempICExp2: ICExp;
tempICBinding: ICBinding;
tempICTyping: ICTyping;
tempICGuardedExp: ICGuardedExp;
SELECT tokType FROM
tokLParen => BEGIN
Exp ::= ( Exp ) -- Parenthesized expression.
Scan[];
tempICExp1 ← ParseExp[];
RequireAndRecoverTo[typeWanted~tokRParen, errMsg~"expecting right paren", recoverProc~RecoverExp];
RETURN[ tempICExp1 ]
END ;
tokKWtuple, tokLTupleBrak, tokLRecTupleBrak => BEGIN
Exp ::= tuple Id < BindingSeq > -- Tuple formation.
Exp ::= tuple Id <* BindingSeq *> -- Recursive tuple formation.
localName: ATOM ← NIL;
IF tokType = tokKWtuple THEN BEGIN
Scan[];
IF tokType = tokId THEN BEGIN
localName ← NARROW[ tokVal ];
Scan[];
END
END ;
SELECT tokType FROM
tokLTupleBrak => BEGIN
Scan[];
tempICBinding ← ParseBindings[nameRequired~FALSE];
tempICExp1 ← NEW[ MkTupleICNode
← [ bindings~tempICBinding, localName~localName]];
RequireAndRecoverTo[typeWanted~tokRTupleBrak, errMsg~"expecting right tuple bracket", recoverProc~RecoverBinding]
END ;
tokLRecTupleBrak => BEGIN
Scan[];
tempICBinding ← ParseBindings[nameRequired~TRUE];
tempICExp1 ← NEW[ MkRecTupleICNode
← [ bindings~tempICBinding, localName~localName]];
RequireAndRecoverTo[typeWanted~tokRRecTupleBrak, errMsg~"expecting right recursive tuple bracket", recoverProc~RecoverBinding];
END ;
ENDCASE => BEGIN
LogError[ errMsg~"expecting left tuple bracket"];
tempICExp1 ← NIL
END ;
RETURN[ tempICExp1 ]
END ;
tokKWfunc, tokKWproc => BEGIN
Exp ::= func[ Id: Exp -> Exp ] -- Function type.
Exp ::= proc[ Id: Exp -> Exp ] -- Procedure type.
isFunc: BOOL ← (tokType = tokKWfunc);
Scan[];
Mandatory[ typeWanted~tokLBrak, errMsg~"expecting left bracket"];
tempICTyping ← ParseTyping[nameRequired~FALSE];
Mandatory[typeWanted~tokFunctionArrow, errMsg~"expecting arrow"];
tempICExp1 ← ParseExp[];
IF isFunc
THEN tempICExp2 ← NEW[ FuncICNode ← [param~tempICTyping, resultType~tempICExp1]]
ELSE tempICExp2 ← NEW[ ProcICNode ← [param~tempICTyping, resultType~tempICExp1]];
ScanThrough[typeWanted~tokRBrak, errMsg~"expecting right bracket"];
RETURN[ tempICExp2 ]
END ;
tokKWprod, tokLBrak => BEGIN
Exp ::= prod Id [ TypingSequence ] -- Product type with local name.
Exp ::= prod [ TypingSequence ] -- Product type without local name.
Exp ::= [ TypingSequence ] -- Product type without local name.
localName: ATOM ← NIL;
IF tokType = tokKWprod THEN BEGIN
Scan[];
IF tokType = tokId THEN BEGIN
localName ← NARROW[ tokVal ];
Scan[]
END
END;
Mandatory[ typeWanted~tokLBrak, errMsg~"expecting left bracket"];
tempICTyping ← ParseTypings[nameRequired~TRUE];
tempICExp1 ← NEW[ ProductICNode ← [components~tempICTyping] ];
RequireAndRecoverTo[typeWanted~tokRBrak, errMsg~"expecting right bracket", recoverProc~RecoverTyping];
RETURN[ tempICExp1 ]
END ;
tokKWunion, tokLUnionBrak => BEGIN
Exp ::= union [ TypingSequence ]
Exp ::= union { TypingSequence }
Exp ::= { TypingSequence } -- Union type constructor.
brakTypeWanted: RussellSyntax.TokType;
IF tokType = tokKWunion THEN BEGIN
Scan[]
END;
SELECT tokType FROM
tokLBrak =>
{ brakTypeWanted ← tokRBrak; Scan[] } ;
tokLUnionBrak =>
{ brakTypeWanted ← tokRUnionBrak; Scan[] } ;
ENDCASE =>
{ LogError[ errMsg~"expecting left bracket"]; } ;
tempICTyping ← ParseTypings[nameRequired~TRUE];
tempICExp1 ← NEW[ UnionICNode ← [components~tempICTyping] ];
RequireAndRecoverTo[typeWanted~brakTypeWanted, errMsg~"expecting right bracket", recoverProc~RecoverTyping];
RETURN[ tempICExp1 ]
END ;
tokKWref => BEGIN
Exp ::= ref [ Exp ] -- Reference type constructor.
Scan[];
Mandatory[ typeWanted~tokLBrak, errMsg~"expecting left bracket"];
tempICExp1 ← ParseExp[];
tempICExp2 ← NEW[ RefICNode ← [referentType~tempICExp1] ];
RequireAndRecoverTo[typeWanted~tokRBrak, errMsg~"bad ref type", recoverProc~RecoverExp];
RETURN[ tempICExp2 ]
END ;
tokKWif => BEGIN
Exp ::= if GuardedExpSeq fi -- Conditional.
Scan[];
tempICGuardedExp ← ParseGuardedExps[];
IF tokType = tokKWelse
THEN BEGIN
Scan[];
Optional[typeWanted~tokGuardArrow];
tempICExp1 ← ParseExp[]
END
ELSE BEGIN
tempICExp1 ← NIL
END ;
tempICExp2 ← NEW[ CondICNode ← [thenClauses~tempICGuardedExp, elseExp~tempICExp1]];
RequireAndRecoverTo[typeWanted~tokKWfi, errMsg~"bad guarded exp list in conditional", recoverProc~RecoverGuardedExp];
RETURN[ tempICExp2 ]
END ;
tokKWdo => BEGIN
Exp ::= do GuardedExpSeq od -- Loop.
Scan[];
tempICGuardedExp ← ParseGuardedExps[];
tempICExp1 ← NEW[ LoopICNode ← [loopClauses~tempICGuardedExp]];
RequireAndRecoverTo[typeWanted~tokKWod, errMsg~"bad guarded exp list in loop", recoverProc~RecoverGuardedExp];
RETURN[ tempICExp1 ]
END ;
tokKWopen => BEGIN
Exp ::= open Exp in Exp ni -- Block.
Scan[];
tempICExp1 ← ParseExp[];
Mandatory[typeWanted~tokKWin, errMsg~"expecting in"];
tempICExp2 ← ParseExp[];
tempICExp2 ← NEW[ OpenICNode ← [tuple~tempICExp1, body~tempICExp2]];
RequireAndRecoverTo[typeWanted~tokKWni, errMsg~"bad open body", recoverProc~RecoverExp];
RETURN[ tempICExp2 ]
END ;
tokKWlambda => BEGIN
Scan[];
tempICTyping ← ParseTyping[nameRequired~FALSE];
Mandatory[typeWanted~tokKWin, errMsg~"expecting in"];
tempICExp1 ← ParseExp[];
tempICExp2 ← NEW[ LambdaICNode ← [param~tempICTyping, body~tempICExp1] ];
RequireAndRecoverTo[typeWanted~tokKWni, errMsg~"bad function body", recoverProc~RecoverExp];
RETURN[ tempICExp2 ]
END ;
tokId => BEGIN
tempICExp1 ← NEW[ IdICNode ← [name ~ NARROW[tokVal]]];
Scan[];
RETURN[ tempICExp1 ]
END ;
tokKWtype => BEGIN
Scan[];
tempICExp1 ← NEW[ PrimConstICNode ← [which~$type]];
RETURN[ tempICExp1 ]
END ;
tokKWsafetype => BEGIN
Scan[];
tempICExp1 ← NEW[ PrimConstICNode ← [which~$safetype]];
RETURN[ tempICExp1 ]
END ;
tokCharConst => BEGIN
tempICExp1 ← NEW[ CharConstICNode ← [which ~ Convert.CharFromLiteral[r~NARROW[tokVal]]]];
Scan[];
RETURN[ tempICExp1 ]
END ;
tokStringConst => BEGIN
tempICExp1 ← NEW[ StringConstICNode ← [which ~ Convert.RopeFromLiteral[r~NARROW[tokVal]]]];
Scan[];
RETURN[ tempICExp1 ]
END ;
tokIntConst => BEGIN
tempICExp1 ← NEW[ IntConstICNode ← [which ~ Convert.IntFromRope[r~NARROW[tokVal]]]];
Scan[];
RETURN[ tempICExp1 ]
END ;
ENDCASE => BEGIN
LogError[errMsg~"syntax error"];
RETURN[ NIL ]
END ;
END ; -- ParseExp0
ParseBindings: PROCEDURE [nameRequired: BOOL ← TRUE] RETURNS [ICBinding]
= BEGIN
tempICBinding: ICBinding ← NIL;
tail: ICBinding ← NIL;
p: ICBinding;
DO
IF NOT InFirstOfBinding[nameRequired~nameRequired]
THEN RETURN[ tempICBinding ] ;
p ← ParseBinding[nameRequired];
IF p = NIL
THEN RETURN[ tempICBinding ] ;
IF tail = NIL
THEN tempICBinding ← p
ELSE tail.next ← p;
tail ← p;
WHILE tokType = tokListSep DO
Scan[]
ENDLOOP
ENDLOOP
END ; -- ParseBindings
ParseBinding: PROCEDURE [nameRequired: BOOL ← TRUE] RETURNS [ICBinding]
= BEGIN
tempName: ATOM ← NIL;
tempType: ICExp ← NIL;
tempValue: ICExp;
tempICBinding: ICBinding;
SELECT TRUE FROM
(tokType = tokId) AND ((nextTokType = tokHasType) OR (nextTokType = tokIsBoundTo)) => BEGIN
tempName ← NARROW[tokVal];
Scan[];
IF tokType = tokHasType
THEN BEGIN
Scan[];
tempType ← ParseExp[]
END ;
Mandatory[ typeWanted~tokIsBoundTo, errMsg~"expecting binding"]
END ;
nameRequired => BEGIN
LogError[ errMsg~"require name in binding" ];
RETURN[ NIL ]
END
ENDCASE =>
NULL ;
tempValue ← ParseExp[];
tempICBinding ← NEW[ BindingICNode ← [name~tempName, type~tempType, value~tempValue ]];
RETURN[ tempICBinding ]
END ; -- ParseBinding
ParseTypings: PROCEDURE [nameRequired: BOOL ← TRUE] RETURNS [ICTyping]
= BEGIN
tempICTyping: ICTyping ← NIL;
tail: ICTyping ← NIL;
p: ICTyping;
DO
IF NOT InFirstOfTyping[nameRequired~nameRequired]
THEN RETURN[ tempICTyping ] ;
p ← ParseTyping[nameRequired];
IF p = NIL
THEN RETURN[ tempICTyping ] ;
IF tail = NIL
THEN tempICTyping ← p
ELSE tail.next ← p;
tail ← p;
WHILE tokType = tokListSep DO
Scan[]
ENDLOOP
ENDLOOP
END ; -- ParseTypings
ParseTyping: PROCEDURE [nameRequired: BOOL ← TRUE] RETURNS [ICTyping]
= BEGIN
tempName: ATOM;
tempICExp: ICExp;
tempICTyping: ICTyping;
SELECT TRUE FROM
(tokType = tokId) AND (nextTokType = tokHasType) => BEGIN
tempName ← NARROW[tokVal];
Scan[]; Scan[];
END ;
nameRequired => BEGIN
LogError[ errMsg~"require name in typing" ];
RETURN[ NIL ]
END ;
ENDCASE => BEGIN
tempName ← NIL
END ;
tempICExp ← ParseExp[];
tempICTyping ← NEW[ TypingICNode ← [name~tempName, type~tempICExp]];
RETURN[ tempICTyping ]
END ; -- ParseTyping
ParseGuardedExps: PROCEDURE [] RETURNS [ICGuardedExp]
= BEGIN
tempICGuardedExp: ICGuardedExp ← NIL;
tail: ICGuardedExp ← NIL;
p: ICGuardedExp;
DO
IF NOT InFirstOfGuardedExp[]
THEN RETURN[ tempICGuardedExp ] ;
p ← ParseGuardedExp[];
IF p = NIL
THEN RETURN[ tempICGuardedExp ] ;
IF tail = NIL
THEN tempICGuardedExp ← p
ELSE tail.next ← p;
tail ← p;
WHILE tokType = tokGuardedExpSep DO
Scan[]
ENDLOOP
ENDLOOP
END ; -- ParseGuardedExps
ParseGuardedExp: PROCEDURE [] RETURNS [ICGuardedExp]
= BEGIN
tempName: ATOM;
tempTuple: ICExp;
tempResult: ICExp;
tempICGuardedExp: ICGuardedExp;
tempTuple ← ParseExp[];
Mandatory[ typeWanted~tokQuery, errMsg~"invalid guard"];
IF tokType = tokId
THEN BEGIN
tempName ← NARROW[tokVal];
Scan[]
END
ELSE BEGIN
tempName ← NIL;
LogError[ errMsg~"expecting selector name"];
END ;
Mandatory[ typeWanted~tokGuardArrow, errMsg~"invalid guard"];
tempResult ← ParseExp[];
tempICGuardedExp ← NEW[ GuardedExpICNode ← [ tuple~tempTuple, name~tempName, result~tempResult]];
RETURN[ tempICGuardedExp ]
END ; -- ParseGuardedExp
scanBuf ← RefText.ObtainScratch[RefText.line];
Scan[]; Scan[];
answer ← ParseExp[];
RefText.ReleaseScratch[scanBuf];
RETURN[ answer ];
END ; -- ParseRussellExpression
END .