
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 => {
val м Convert.RopeFromLiteral[RefText.TrustTextAsRope[token]];
};
tokenCHAR => {
val м Rope.FromChar[RefText.Fetch[token, 0
! RuntimeError.BoundsFault => {val м Rope.FromChar['Z]; CONTINUE}]];
};
tokenATOM => {
val м Convert.AtomFromRope[RefText.TrustTextAsRope[token]];
};
tokenSINGLE => {
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 => {
};
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;
}
ELSE 
result м "(";

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;
};


GetList: PROC [stream: IO.STREAM, nestingAtom: ATOM] RETURNS [list: LIST OF REF м NIL] = {
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;
};
};

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] = {
keyName м ReadWWord[stream];
ReadChar[stream, ':];
};

ReadWord: PUBLIC PROC [f: IO.STREAM] RETURNS [word: Rope.ROPE] = {
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] = {
WWordBreakProc: SAFE PROC [char: CHAR] RETURNS [IO.CharClass] = {
RETURN[wwordBreaks[char]];
};
[word, ----] м IO.GetTokenRope[f, WWordBreakProc
!IO.EndOfStream => {word м NIL; CONTINUE}];
};

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.

   └  
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.

token has the form: "sdfsdfds".  RopeFromLiteral strips the outer quotes
token has the form: 'g
token has the form: $Foo.  AtomFromRope strips the $ and makes an atom
A single character token like: ; or ,
A two character token like: =>
Parsing Utility Routines
Reads from the stream a list of tokens until the closing paren (or other closing symbol) is found.
General-Purpose Parsing Routines
Looks for "<keyword>:".  Returns <keyword>.  Strips the colon.
[] _ IO.SkipWhitespace[stream, FALSE];
keyName _ IO.GetID[stream];
Read in characters until the next tab, space, carriage return, comma, ], ), }, =, :, ;, or >.
Short for "Read Whitespace and Word"
[] _ IO.SkipWhitespace[f, TRUE];
Initialization

Э╩P  ХNewlineDelimiter
Ц(cedarcode) styleЩ codeЪЬЩKЪЬ	╧eЬ<ЩHKЪЬ"Щ"KЩ&KШ ЧKЪЬQЩQKЩ Ъ╧k	Ш	KЪЬLШLЧKШ Ъ╧nЬЮЬЮШKЪЮЬЮЬЮЬШGKЪЮЬЮШЧKШ KЪЮЬЮЬЮЬШKШ ЪЯЬЮЬЮЬ
ЮЬЮЬЮЬЮЬЮЬЮЬЮЬШ^KЪЬШKЪЬЮЬЮЬШKЪЬЮЬШKЪЬЮЬЮЬШKЪЬШKШ KЪЮЬЮЬЮЬЮЬЮЬЮЬШ+KШ KШ8KЪЬ*ЮЬ╧bЬШJKЪЮЬЮЬЮШ(ЪЮЬЮЬЮЬШKЪЬЮЬKШcKЪЬЮЬШKШЧЪЮЬЮЬЮШKЪЬ#Ш#KЪЮЬЮЬЮЬШKШЧKШ ЪЮЬЮШKЪЬЮЬШЪЬШЪЮЬЮШ$KЪЬЮЬЮЬЮЬШЧЪЮЬЮЬЮШ*KЪЬЮЬЮЬЮШЧЪЮШKШ&ЧKШЧKЪЬЮЬЮЬ<ШYKЪЬЮЬЮЬ;ШVKЪЬЮЬЮЬ<ШUKЪЬЮЬЮЬ9ШTЪЬШKЪЬHЩHKШ>KШЧЪЬШKЪЬЩШ*KШDЧKШЧЪЬШKЪЬFЩFKШ;KШЧЪЬШKЩ%KЪЮЬЮЬаЬ	аЬШGKЪ
ЮЬЮЬЮЬаЬ	аЬШNKЪ
ЮЬЮЬЮЬаЬ	аЬШSKЪЮЬЮЬЮЬШCKЪЮЬЮЬЮЬШ;KЪЮЬЮЬЮЬШ=KЪЮЬЮЬЮЬШBKЪЮЬЮЬЮЬШBKЪЮЬ=╧cШ`KШЧЪЬШKЩKШЧKЪЬЮЬШKЪЬЮЬЮЬШKЪЮЬЮЬШKШ ЧKЪЬ#Ш#KШKШ ЧЪЯЬЮЬЮЬ
ЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬ
ЮЬШiKЪЬЮЬШKЪ	ЬЮЬЮЬЮЬЮЬШKЪЬЮЬЮЬШKЪЬЮЬЮЬШKЪЬЮЬЮЬШKЪЬЮЬЮЬЮЬЮЬЮЬШ+KШ ЪЮЬ
ЮЬЮЬШKШKЪЮЬШKШKШ ЧfromЪЮЬЮЬЮЬ	ЮЬЮЬЮЬЮЬЮЬШ2ЪЬ	ЮЬЮЬЮШ LЪЬЮЬЮЬШ(KЪЬЮЬЮЬШ&KЪЬЮЬЮЬШ(KЪЬЮЬШKЪЬЮЬШ#KЪЮЬШЧKЪЮЬШKШЧKШ KЪЬЮЬ	ШKШ ЪЮЬЮЬЮЬЮЬЮЬЮЬЮЬШVKШKШKЪЬЮЬШKШЧЪЮЬШKШЧKШ ЪЮЬЮЬЮЬШKЪ
ЮЬЮЬЮЬЮЬ
ЮЬШSЪЮЬЮЬЮЬШ$KЪЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШqKШ0KШЧKШKШ ЧKЪЬЮЬШЪЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮШDKЪЮЬ
ЮЬЮЬЮЬЮЬЮЬ&ШYKЪ
ЮЬ
ЮЬЮЬЮЬЮЬ#ШEKШDKЪЬЮЬШKЪЮЬШЧKШ KЪЮЬЮЬ"Ш7KЪЮЬ#Ш'KЪЮЬШKЪЬШKШ ЧKЪЯЬЮЬЮЬШ#procЪ
ЯЬЮЬ
ЮЬЮЬЮЬШ;MЪЬЮЬШ MЪЮЬШMШMШ ЧKШ KЩЪЯЬЮЬ
ЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШZKЩbKЪЬЮЬЮЬШKЪЬЮЬЮЬШKЪ	ЬЮЬЮЬЮЬЮЬШKШ ЪЮЬЮШKЪЬ$бШ9KЪЮЬЮЬЮШKЪЮЬЮЬЮЬЮЬШ$KШ*KЪЮЬШЧKЪЬШKШ ЧЪЯЬЮЬ
ЮЬЮЬЮЬЮЬЮЬЮЬЮЬШNKЪЬЮЬЮЬЮЬШKЪЬЮЬЮЬШKЪЬЮЬЮЬЮЬЮЬЮЬШKШ KЪЬаЬШ/ЪЮЬЮШKШ$KЪЮЬЮЬЮШKЪЮЬЮЬЮЬЮЬШ/KШ+KЪЮЬШЧKЪЬШKШ ЧЪЯЬЮЬЮЬЮЬЮЬ
ЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШqЪЮЬЮЬЮЬЮЬЮЬЮЬЮШ3MШ	MЪЮЬЮЬЮЬЮЬШ5MЪЮЬШЧMШMШ ЧЪЯ	ЬЮЬЮЬ
ЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШyЪЮЬЮЬЮЬШKЪ
ЮЬЮЬЮЬЮЬЮЬШ#KЪЬЮЬ	ЮЬШ%KЪЮЬШKШЧЪЮЬШKШKЪЬЮЬ	ЮЬШKШKШЧKШЧKШ KЩ ЪЯЬЮЬЮЬ
ЮЬЮЬЮЬЮЬЮЬШPKЪЬЮЬШKЪЬЮЬЮШKЪЬЮЬШKШ KЪЬ-б1Ш^KШKШ)ЪЮЬЮЬЮШ$KШKШ)KЪЮЬЮЬШ KЪЮЬЮЬЮЬШ&KЪЮЬШЧKШKЪЬ Ш KШKШ ЧЪЯЬЮЬЮЬ
ЮЬЮЬЮЬЮЬЮЬШWKЪЬЮЬШKЪЬЮЬЮШKЪЬЮЬШKШ KЪЬ-б1Ш^KШKШ)ЪЮЬЮЬЮШ$KШKШ)KЪЮЬЮЬШ KЪЮЬЮЬЮЬШ&KЪЮЬШЧKШKЪЬ Ш KШKШ ЧЪЯЬЮЬЮЬЮЬЮЬЮЬШ1MЪЬ	ЮЬШMЪЬЮЬЮЬШ MЪЬ
ЮЬШЪЮЬЮЬЮЬШMЪЬЮЬDШUMШЧMЪЬШMШ ЧЪЯЬЮЬ
ЮЬЮЬЮЬЮЬШHJЩ>JЪЬЮЬЮЬЩ&JЪЬ
ЮЬЩKШKЪЬШKШKШ ЧЪЯЬЮЬЮЬЮЬЮЬЮЬШBMЩ]ЪЯЬЮЬЮЬЮЬЮЬЮЬЮЬШHЪЮЬЮШMЪЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬ	Ш.MЪЮЬЮЬШ&ЧMЪЬШЧЪЬбЬЮЬШ/MЪЬЮЬЮЬЮЬШ+ЧMЪЬШMШ ЧЪЯ	ЬЮЬЮЬЮЬЮЬЮЬЮЬШCMЩ$ЪЯЬЮЬЮЬЮЬЮЬЮЬШAMЪЮЬШMЪЬШЧMЪЬЮЬЮЬЩ ЪЬбЬЮЬШ0MЪЬЮЬЮЬЮЬШ+ЧMЪЬШMШ ЧKЩKЩ KЪЬЮЬШ*KЪЬЮЬШ,KЪЬЮЬШ1KЪЬЮЬШ1KШ MЪЬЮЬЮЬЮЬЮЬЮЬЮЬШ<KЪЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬ	ШZKШЦKЪЮЬШKШ Ч ЕЧ    Ё  1   