<<>> <> <> <> <> <> <<>> 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] = { <:". Returns . Strips the colon.>> <<[] _ IO.SkipWhitespace[stream, FALSE];>> <> 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]]; }; <<[] _ IO.SkipWhitespace[f, TRUE];>> [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.