EBMesaLispImpl.mesa
Copyright Ó 1989, 1991, 1992 by Xerox Corporation. All rights reserved.
Bier, August 28, 1991 12:02 pm PDT
Doug Wyatt, April 10, 1992 7:04 pm PDT
Contents: Routines for parsing list expressions whose elements are Cedar tokens.
DIRECTORY
Atom, Convert, EBMesaLisp, EmbeddedButtons, IO, RefText, Rope, RuntimeError;
EBMesaLispImpl:
CEDAR
PROGRAM
IMPORTS Atom, Convert, EmbeddedButtons, IO, RefText, Rope, RuntimeError
EXPORTS EBMesaLisp = BEGIN
ROPE: TYPE = Rope.ROPE;
Parse:
PUBLIC
PROC [stream:
IO.
STREAM]
RETURNS [val:
REF ¬
NIL, endOfStream:
BOOL ¬
FALSE] = {
tokenKind: IO.TokenKind;
token, firstToken: REF TEXT;
charsSkipped: INT;
done: BOOL ¬ FALSE;
error: IO.TokenError;
IF IO.EndOf[stream] THEN RETURN[NIL, TRUE];
firstToken ¬ token ¬ RefText.ObtainScratch[nChars: 100];
[tokenKind, token, charsSkipped, error] ¬ IO.GetCedarToken[stream, token];
IF tokenKind = tokenEOF THEN done ¬ TRUE
ELSE
IF error # none
THEN {
EmbeddedButtons.Error[IO.PutFR1["IO Syntax error at character %g", [integer[stream.GetIndex[]]] ]];
done ¬ TRUE;
};
IF done
THEN
{
RefText.ReleaseScratch[firstToken];
RETURN[NIL, TRUE];
};
SELECT tokenKind
FROM
tokenERROR => ERROR;
tokenID => {
IF RefText.Equal[token, "TRUE"]
THEN
val ¬ NEW[BOOL ¬ TRUE]
ELSE
IF RefText.Equal[token, "FALSE"]
THEN
val ¬ NEW[BOOL ¬ FALSE]
ELSE
val ¬ Atom.MakeAtomFromRefText[token];
};
tokenDECIMAL => val ¬ NEW[INT ¬ Convert.IntFromRope[RefText.TrustTextAsRope[token], 10]];
tokenOCTAL => val ¬ NEW[INT ¬ Convert.IntFromRope[RefText.TrustTextAsRope[token], 8]];
tokenHEX => val ¬ NEW[INT ¬ Convert.IntFromRope[RefText.TrustTextAsRope[token], 16]];
tokenREAL => val ¬ NEW[REAL ¬ Convert.RealFromRope[RefText.TrustTextAsRope[token]]];
tokenROPE => {
token has the form: "sdfsdfds". RopeFromLiteral strips the outer quotes
val ¬ Convert.RopeFromLiteral[RefText.TrustTextAsRope[token]];
};
tokenCHAR => {
token has the form: 'g
val ¬ Rope.FromChar[RefText.Fetch[token, 0
! RuntimeError.BoundsFault => {val ¬ Rope.FromChar['Z]; CONTINUE}]];
};
tokenATOM => {
token has the form: $Foo. AtomFromRope strips the $ and makes an atom
val ¬ Convert.AtomFromRope[RefText.TrustTextAsRope[token]];
};
tokenSINGLE => {
A single character token like: ; or ,
IF RefText.Equal[token, "("] THEN val ¬ GetList[stream, closeParenAtom]
ELSE IF RefText.Equal[token, "["] THEN val ¬ GetList[stream, closeBracketAtom]
ELSE IF RefText.Equal[token, "{"] THEN val ¬ GetList[stream, closeCurlyBracketAtom]
ELSE IF RefText.Equal[token, "<"] THEN val ¬ GetExecuteList[stream]
ELSE IF RefText.Equal[token, ")"] THEN val ¬ closeParenAtom
ELSE IF RefText.Equal[token, "]"] THEN val ¬ closeBracketAtom
ELSE IF RefText.Equal[token, "}"] THEN val ¬ closeCurlyBracketAtom
ELSE IF RefText.Equal[token, ">"] THEN val ¬ closeAngleBracketAtom
ELSE val ¬ Convert.AtomFromRope[RefText.TrustTextAsRope[token]]; -- should include *, /, + and -
};
tokenDOUBLE => {
A two character token like: =>
};
tokenCOMMENT => ERROR;
tokenEOF => val ¬ NIL;
ENDCASE => ERROR;
RefText.ReleaseScratch[firstToken];
};
Unparse:
PUBLIC
PROC [object:
REF
ANY, prettyPrintList:
LIST
OF
REF
ANY ¬
NIL]
RETURNS [result:
ROPE] = {
first: BOOL;
listObject: LIST OF REF ANY;
executeObject: BOOL ¬ FALSE;
insert: ROPE ¬ NIL;
insertFirst: BOOL ¬ FALSE;
prettyPrintListRest: LIST OF REF ANY ¬ NIL;
IF object =
NIL
THEN {
result ¬ "()";
RETURN;
}
ELSE IF
NOT
ISTYPE[object,
LIST
OF
REF
ANY]
THEN {
result ¬
WITH object
SELECT
FROM
v: REF BOOL => Convert.RopeFromBool[v],
v: REF INT => Convert.RopeFromInt[v],
v: REF REAL => Convert.RopeFromReal[v],
v: ATOM => Atom.GetPName[v],
v: ROPE => Rope.Cat["\"", v, "\""],
ENDCASE => "";
RETURN;
};
listObject ¬ NARROW[object];
IF
ISTYPE[listObject.first,
ATOM]
AND
NARROW[listObject.first,
ATOM] = $Execute
THEN {
listObject ¬ listObject.rest;
result ¬ "<";
executeObject ¬ TRUE;
}
IF prettyPrintList #
NIL
THEN {
IF ISTYPE[prettyPrintList.first, ROPE] THEN insert ¬ NARROW[prettyPrintList.first];
IF prettyPrintList.rest #
NIL
THEN {
IF ISTYPE[prettyPrintList.rest.first, REF BOOL] THEN insertFirst ¬ NARROW[prettyPrintList.rest.first, REF BOOL];
prettyPrintListRest ¬ prettyPrintList.rest.rest;
};
};
first ¬ TRUE;
FOR l:
LIST
OF
REF
ANY ¬
NARROW[listObject], l.rest
UNTIL l =
NIL
DO
IF insert # NIL AND (NOT first OR insertFirst) THEN result ¬ Rope.Concat[result, insert];
IF insert = NIL AND NOT first THEN result ¬ Rope.Concat[result, " "];
result ¬ Rope.Concat[result, Unparse[l.first, prettyPrintListRest]];
first ¬ FALSE;
ENDLOOP;
IF executeObject THEN result ¬ Rope.Concat[result, ">"]
ELSE result ¬ Rope.Concat[result, ")"];
RETURN;
};
ParseAborted: PUBLIC SIGNAL = CODE;
SyntaxError:
PUBLIC PROC [stream:
IO.
STREAM, msg:
ROPE] = {
EmbeddedButtons.Error[msg, NIL];
SIGNAL ParseAborted;
};
Parsing Utility Routines
GetList:
PROC [stream:
IO.
STREAM, nestingAtom:
ATOM]
RETURNS [list:
LIST
OF
REF ¬
NIL] = {
Reads from the stream a list of tokens until the closing paren (or other closing symbol) is found.
val: REF ¬ NIL;
endOfStream: BOOL ¬ FALSE;
tail: LIST OF REF ¬ NIL;
WHILE ~stream.EndOf[]
DO
[val, endOfStream] ¬ Parse[stream]; -- get the next token
IF endOfStream THEN LOOP
ELSE IF val = nestingAtom THEN EXIT;
[list, tail] ¬ AddEntity[val, list, tail];
ENDLOOP;
};
GetExecuteList:
PROC [stream:
IO.
STREAM]
RETURNS [list:
LIST
OF
REF ¬
NIL] = {
last: REF ANY ¬ NIL;
endOfStream: BOOL ¬ FALSE;
tail: LIST OF REF ANY ¬ NIL;
[list, tail] ¬ AddEntity[$Execute, list, tail];
WHILE ~stream.EndOf[]
DO
[last, endOfStream] ¬ Parse[stream];
IF endOfStream THEN LOOP
ELSE IF last = closeAngleBracketAtom THEN EXIT;
[list, tail] ¬ AddEntity[last, list, tail];
ENDLOOP;
};
Member:
PUBLIC PROC [list:
LIST
OF
ATOM, member:
REF
ANY]
RETURNS[isMember:
BOOL ¬
FALSE, tail:
LIST
OF
ATOM] = {
FOR l:
LIST
OF
ATOM ¬ list, l.rest
UNTIL l =
NIL
DO
tail ¬ l;
IF l.first = member THEN { isMember ¬ TRUE; RETURN; }
ENDLOOP;
};
AddEntity:
PUBLIC
PROC [entity:
REF
ANY, entityList, ptr:
LIST
OF
REF
ANY]
RETURNS [newList, newPtr:
LIST
OF
REF
ANY] = {
IF ptr =
NIL
THEN {
IF NOT entityList = NIL THEN ERROR;
newPtr ¬ newList ¬ CONS[entity, NIL];
RETURN;
}
ELSE {
newList ¬ entityList;
ptr.rest ¬ CONS[entity, NIL];
newPtr ¬ ptr.rest;
};
};
General-Purpose Parsing Routines
ReadRopeInParens:
PUBLIC
PROC [stream:
IO.
STREAM]
RETURNS [rope:
ROPE ¬
NIL] = {
level: NAT ¬ 1;
scratch, text: REF TEXT;
c: CHAR;
scratch ¬ text ¬ RefText.ObtainScratch[512]; -- numbers larger than 512 always allocate (yuk!)
c ¬ stream.GetChar[];
text ¬ RefText.InlineAppendChar[text, c];
UNTIL level = 0
OR stream.EndOf[]
DO
c ¬ stream.GetChar[];
text ¬ RefText.InlineAppendChar[text, c];
IF c = '( THEN level ¬ level + 1
ELSE IF c = ') THEN level ¬ level - 1;
ENDLOOP;
rope ¬ Rope.FromRefText[text];
RefText.ReleaseScratch[scratch];
};
ReadRopeInAngleBrackets:
PUBLIC
PROC [stream:
IO.
STREAM]
RETURNS [rope:
ROPE ¬
NIL] = {
level: NAT ¬ 1;
scratch, text: REF TEXT;
c: CHAR;
scratch ¬ text ¬ RefText.ObtainScratch[512]; -- numbers larger than 512 always allocate (yuk!)
c ¬ stream.GetChar[];
text ¬ RefText.InlineAppendChar[text, c];
UNTIL level = 0
OR stream.EndOf[]
DO
c ¬ stream.GetChar[];
text ¬ RefText.InlineAppendChar[text, c];
IF c = '< THEN level ¬ level + 1
ELSE IF c = '> THEN level ¬ level - 1;
ENDLOOP;
rope ¬ Rope.FromRefText[text];
RefText.ReleaseScratch[scratch];
};
ReadChar:
PUBLIC
PROC [f:
IO.
STREAM, c:
CHAR] = {
streamC: CHAR;
[] ¬ IO.SkipWhitespace[f, TRUE];
streamC ¬ IO.GetChar[f];
IF
NOT c = streamC
THEN {
SyntaxError[f, IO.PutFR["Expected %g not %g", [character[c]], [character[streamC]]]];
};
};
ReadKeyword:
PUBLIC PROC [stream:
IO.
STREAM]
RETURNS [keyName:
ROPE] = {
Looks for "<keyword>:". Returns <keyword>. Strips the colon.
[] ← IO.SkipWhitespace[stream, FALSE];
keyName ← IO.GetID[stream];
keyName ¬ ReadWWord[stream];
ReadChar[stream, ':];
};
ReadWord:
PUBLIC PROC [f:
IO.
STREAM]
RETURNS [word: Rope.
ROPE] = {
Read in characters until the next tab, space, carriage return, comma, ], ), }, =, :, ;, or >.
WordBreakProc:
SAFE
PROC [char:
CHAR]
RETURNS [
IO.CharClass] =
CHECKED {
SELECT char
FROM
IO.TAB, IO.CR, IO.SP, IO.LF => RETURN [break];
ENDCASE => RETURN [wwordBreaks[char]];
};
[word,
----] ¬
IO.GetTokenRope[f, WordBreakProc
!IO.EndOfStream => {word ¬ NIL; CONTINUE}];
};
ReadWWord:
PUBLIC
PROC [f:
IO.
STREAM]
RETURNS [word: Rope.
ROPE] = {
Short for "Read Whitespace and Word"
WWordBreakProc:
SAFE
PROC [char:
CHAR]
RETURNS [
IO.CharClass] = {
RETURN[wwordBreaks[char]];
};
[] ← IO.SkipWhitespace[f, TRUE];
[word,
----] ¬
IO.GetTokenRope[f, WWordBreakProc
!IO.EndOfStream => {word ¬ NIL; CONTINUE}];
};
Initialization
closeParenAtom: ATOM ¬ Atom.MakeAtom[")"];
closeBracketAtom: ATOM ¬ Atom.MakeAtom["]"];
closeCurlyBracketAtom: ATOM ¬ Atom.MakeAtom["}"];
closeAngleBracketAtom: ATOM ¬ Atom.MakeAtom[">"];
wwordBreaks: PACKED ARRAY CHAR OF IO.CharClass ¬ ALL[other];
wwordBreaks[IO.TAB] ¬ wwordBreaks[IO.CR] ¬ wwordBreaks[IO.SP] ¬ wwordBreaks[IO.LF] ¬ sepr;
wwordBreaks[',] ¬ wwordBreaks[']] ¬ wwordBreaks[')] ¬ wwordBreaks['}] ¬ wwordBreaks['>] ¬ wwordBreaks['=] ¬ wwordBreaks[':] ¬ wwordBreaks[';] ¬ break;
END.