<> DIRECTORY Atom USING [MakeAtom, MakeAtomFromChar], CedarScanner USING [CharFromToken, GetProc, GetClosure, Token, GetToken, ContentsFromToken, RealFromToken, IntFromToken, IntegerOverflow, SingleFromToken, RopeFromToken, AtomFromToken], IO USING[CharProc, GetChar, Backup, EndOf, CharsAvail, Error, EndOfStream, BreakProc, SetIndex, GetIndex, NUL, PeekChar, ROPE, STREAM, CR, ESC, LF, TAB, SP, FF, BS], List USING [DReverse], IOExtras USING [FromTokenProc], RefText USING [ObtainScratch, ReleaseScratch, Append], Rope USING [Cat, Equal, FromChar, FromRefText, Concat] ; InputImpl: CEDAR PROGRAM IMPORTS Atom, List, IO, Rope, CedarScanner, RefText EXPORTS IO, IOExtras = BEGIN OPEN IO; <> dot: CHARACTER = '.; comma: CHARACTER = ',; semicolon: CHARACTER = ';; colon: CHARACTER = ':; lpar: CHARACTER = '(; rpar: CHARACTER = '); lbracket: CHARACTER = '[; rbracket: CHARACTER = ']; stringdelim: CHARACTER = '"; minus: CHARACTER = '-; plus: CHARACTER = '+; dollar: CHARACTER = '$; upArrow: CHARACTER = '^; MINUS: ATOM = Atom.MakeAtomFromChar[minus]; PLUS: ATOM = Atom.MakeAtomFromChar[plus]; DOLLAR: ATOM = Atom.MakeAtomFromChar['$]; UPARROW: ATOM = Atom.MakeAtomFromChar['^]; <> SyntaxError: PUBLIC ERROR[stream: STREAM, msg: ROPE _ NIL] = CODE; <> GetSequence: PUBLIC PROC [stream: STREAM, charProc: CharProc _ LineAtATime] RETURNS[value: ROPE] = { text: REF TEXT = RefText.ObtainScratch[100]; { ENABLE UNWIND => RefText.ReleaseScratch[text]; i: NAT _ 0; maxLength: NAT = text.maxLength; char: CHARACTER; quit, include: BOOLEAN _ FALSE; CopyOver: PROC = { rope: ROPE; IF i = 0 THEN RETURN; text.length _ i; rope _ Rope.FromRefText[text]; value _ Rope.Concat[value, rope]; -- if token is NIL, i.e. first time, is a nop which is just what we want. i _ 0; }; -- of CopyOver DO IF stream.EndOf[] THEN EXIT; char _ stream.GetChar[]; [quit, include] _ charProc[char]; IF include THEN {IF i = maxLength THEN CopyOver[]; text[i] _ char; i _ i + 1; } ELSE IF quit THEN stream.Backup[char]; IF quit THEN EXIT; ENDLOOP; CopyOver[]; RefText.ReleaseScratch[text]; }; }; -- of GetSequence LineAtATime: PUBLIC CharProc = {RETURN[char = CR, char # CR]}; EveryThing: PUBLIC CharProc = {RETURN[FALSE, TRUE]}; GetLine: PUBLIC PROC [stream: STREAM] RETURNS[line: ROPE] = { <> line _ GetSequence[stream, LineAtATime]; [] _ stream.GetChar[ ! IO.EndOfStream => CONTINUE]; RETURN[line]; }; <> <> <> CedarScannerToken: TYPE = CedarScanner.Token; GetClosure: TYPE = CedarScanner.GetClosure; FromTokenProc: TYPE = IOExtras.FromTokenProc; GetClosureData: TYPE = RECORD[stream: STREAM, text: REF TEXT]; CreateClosure: PROC [stream: STREAM] RETURNS[closure: GetClosure, closureData: REF GetClosureData] = INLINE {closureData _ NEW[GetClosureData _ [stream: stream, text: RefText.ObtainScratch[16]]]; closure _ GetClosure[GetClosureProc, closureData]; }; GetCedarScannerToken: PUBLIC PROC [stream: STREAM, fromTokenProc: FromTokenProc] = { closure: GetClosure; closureData: REF GetClosureData; token: CedarScannerToken; syntaxError: ROPE; {ENABLE UNWIND => RefText.ReleaseScratch[closureData.text]; [closure, closureData] _ CreateClosure[stream]; token _ GetCedarScannerToken1[stream, closure, closureData]; IF fromTokenProc # NIL THEN fromTokenProc[closure, token ! SyntaxError => {syntaxError _ Rope.Cat[CedarScanner.ContentsFromToken[closure, token], " ", msg]; CONTINUE; }]; RefText.ReleaseScratch[closureData.text]; }; IF syntaxError # NIL THEN ERROR SyntaxError[stream, syntaxError]; }; <> GetCedarScannerToken1: PROC [stream: STREAM, closure: GetClosure, closureData: REF GetClosureData] RETURNS[token: CedarScannerToken] = { text: REF TEXT; tooFar: INT; closureData.text.length _ 0; token _ CedarScanner.GetToken[closure, 0]; text _ closureData.text; -- may have been replaced in case overflowed length. SELECT token.kind FROM tokenEOF => ERROR IO.EndOfStream[stream]; tokenERROR => ERROR SyntaxError[stream, token.msg]; < RETURN[GetCedarScannerToken1[stream, closure, closureData]];>> ENDCASE; IF (tooFar _ text.length - token.next) # 0 THEN -- may have read too far {IF tooFar < 0 THEN ERROR; IF tooFar = 1 THEN stream.Backup[text[text.length - 1]] ELSE stream.SetIndex[stream.GetIndex[] - tooFar]; }; }; GetClosureProc: CedarScanner.GetProc -- [data: REF, index: INT] RETURNS [CHAR] -- = { closureData: REF GetClosureData _ NARROW[data]; char: CHAR; text: REF TEXT _ closureData.text; IF index < text.length THEN RETURN[text[index]]; -- backed up char _ closureData.stream.GetChar[! IO.EndOfStream => GOTO EOF]; IF index # text.length THEN ERROR; -- we make this check here, rather than before the preceding statement, because of the scanner wants eof indicated by two nuls. Thus, we get called again with index one beyond text.length. The reason we don't simply add the NUL to text, is that then Backup in GetCedarScannerToken1 will try to backup over the NUL, which is wrong. We really need a single character that corresponds to EOF. IF text.length >= text.maxLength THEN {newText: REF TEXT = RefText.ObtainScratch[2 * text.maxLength]; newText.length _ 0; RefText.Append[to: newText, from: text]; RefText.ReleaseScratch[text]; closureData.text _ text _ newText; }; text[text.length] _ char; text.length _ text.length + 1; RETURN[IF char = '& THEN 'A ELSE char]; -- treat & like any other character while parsing. EXITS EOF => RETURN[NUL]; }; GetCedarToken: PUBLIC PROC [stream: STREAM] RETURNS[value: ROPE] = { fromTokenProc: FromTokenProc = { IF token.kind = tokenCOMMENT THEN value _ GetCedarToken[stream] ELSE value _ CedarScanner.ContentsFromToken[closure, token]}; GetCedarScannerToken[stream, fromTokenProc]; }; <> GetAtom: PUBLIC PROC [stream: STREAM] RETURNS [value: ATOM] = { fromTokenProc: FromTokenProc = { SELECT token.kind FROM tokenATOM => value _ CedarScanner.AtomFromToken[closure, token]; ENDCASE => ERROR SyntaxError[stream, "is not an atom"]; }; GetCedarScannerToken[stream, fromTokenProc]; }; GetId: PUBLIC PROC [stream: STREAM] RETURNS [value: ROPE] = { fromTokenProc: FromTokenProc = { SELECT token.kind FROM tokenID => value _ CedarScanner.ContentsFromToken[closure, token]; ENDCASE => ERROR SyntaxError[stream, "does not describe an atom"]; }; GetCedarScannerToken[stream, fromTokenProc]; }; GetBool: PUBLIC PROC [stream: STREAM] RETURNS [value: BOOLEAN] = { fromTokenProc: FromTokenProc = { r: ROPE; SELECT token.kind FROM tokenID => r _ CedarScanner.ContentsFromToken[closure, token]; ENDCASE => ERROR SyntaxError[stream, "does not describe a BOOL"]; IF Rope.Equal[s1: r, s2: "TRUE"] THEN value _ TRUE ELSE IF Rope.Equal[s1: r, s2: "FALSE", case: FALSE] THEN value _ FALSE ELSE ERROR SyntaxError[stream, "does not describe a BOOL"]; }; GetCedarScannerToken[stream, fromTokenProc]; }; -- GetBool GetCard: PUBLIC PROC [stream: STREAM] RETURNS [value: LONG CARDINAL] = { fromTokenProc: FromTokenProc = { SELECT token.kind FROM tokenINT => value _ CedarScanner.IntFromToken[closure, token ! CedarScanner.IntegerOverflow => ERROR SyntaxError[stream, " - integer overflow"]]; ENDCASE => ERROR SyntaxError[stream, "does not describe an CARD"]; -- ought to be able to catch errors wrongkind errors and convert them. }; GetCedarScannerToken[stream, fromTokenProc]; }; GetInt: PUBLIC PROC [stream: STREAM] RETURNS [value: INT] = { fromTokenProc: FromTokenProc = { SELECT token.kind FROM tokenINT => value _ CedarScanner.IntFromToken[closure, token ! CedarScanner.IntegerOverflow => ERROR SyntaxError[stream, " - integer overflow"]]; tokenSINGLE => {c: CHAR = CedarScanner.SingleFromToken[closure, token]; SELECT c FROM '- => value _ (-GetInt[stream]); '+ => value _ GetInt[stream]; ENDCASE => GOTO Error; }; ENDCASE => GOTO Error; EXITS Error => ERROR SyntaxError[stream, "does not describe an INT"]; }; GetCedarScannerToken[stream, fromTokenProc]; }; GetReal: PUBLIC PROC [stream: STREAM] RETURNS [value: REAL] = { fromTokenProc: FromTokenProc = { SELECT token.kind FROM tokenREAL => value _ CedarScanner.RealFromToken[closure, token]; tokenINT => value _ CedarScanner.IntFromToken[closure, token]; tokenSINGLE => { c: CHAR = CedarScanner.SingleFromToken[closure, token]; SELECT c FROM '- => value _ (-GetReal[stream]); '+ => value _ GetReal[stream]; ENDCASE => GOTO Error; }; ENDCASE => GOTO Error; EXITS Error => ERROR SyntaxError[stream, "does not describe a REAL"]; }; GetCedarScannerToken[stream, fromTokenProc]; }; GetRope: PUBLIC PROC [stream: STREAM] RETURNS [value: ROPE] = { fromTokenProc: FromTokenProc = { SELECT token.kind FROM tokenROPE => value _ CedarScanner.RopeFromToken[closure, token]; ENDCASE => ERROR SyntaxError[stream, "is not a ROPE"]; -- ought to be able to catch errors wrongkind errors and convert them. }; GetCedarScannerToken[stream, fromTokenProc]; }; <<>> <> <> GetRefAnyLine: PUBLIC PROCEDURE [stream: STREAM] RETURNS[list: LIST OF REF ANY _ NIL] = { temp: REF ANY; list _ LIST[GetRefAny[stream]]; UNTIL NOT IO.CharsAvail[stream] DO IF IO.PeekChar[stream] = IO.CR THEN {[] _ stream.GetChar[]; EXIT}; temp _ GetRefAny[stream: stream]; list _ CONS[temp, list]; ENDLOOP; RETURN[List.DReverse[list]]; }; -- of GetRefAnyLine GetRefAny: PUBLIC PROCEDURE[stream: STREAM] RETURNS[object: REF ANY] = { closure: GetClosure; closureData: REF GetClosureData; RightParen: SIGNAL = CODE; Comma: SIGNAL = CODE; GetRefAny0: PROCEDURE[stream: STREAM] RETURNS[object: REF ANY] = { token: CedarScanner.Token; UNTIL IO.EndOf[stream] DO token _ GetCedarScannerToken1[stream, closure, closureData]; SELECT token.kind FROM tokenID => { r: ROPE = CedarScanner.ContentsFromToken[closure, token]; RETURN[IF Rope.Equal[r, "NIL"] THEN NIL ELSE IF Rope.Equal[r, "TRUE"] THEN NEW[BOOL _ TRUE] ELSE IF Rope.Equal[r, "FALSE"] THEN NEW[BOOL _ FALSE] ELSE Atom.MakeAtom[r]]; }; tokenINT => RETURN[NEW[INT _ CedarScanner.IntFromToken[closure, token]]]; tokenREAL => RETURN[NEW[REAL _ CedarScanner.RealFromToken[closure, token]]]; tokenROPE => RETURN[CedarScanner.RopeFromToken[closure, token]]; tokenCHAR => RETURN[NEW[CHAR _ CedarScanner.CharFromToken[closure, token]]]; tokenATOM => RETURN[CedarScanner.AtomFromToken[closure, token]]; tokenSINGLE => {c: CHAR = CedarScanner.SingleFromToken[closure, token]; SELECT c FROM '( => {lst, tail: LIST OF REF ANY; obj: REF ANY; UNTIL IO.EndOf[stream] DO obj _ GetRefAny0[stream ! RightParen => EXIT; Comma => LOOP]; IF tail # NIL THEN {tail.rest _ LIST[obj]; tail _ tail.rest} ELSE {tail _ LIST[obj]; lst _ tail}; ENDLOOP; RETURN[lst]; }; ') => SIGNAL RightParen; '^ => NULL; -- e.g. ^3, makes print and read be inverses. ', => SIGNAL Comma; '-, '+ => {obj: REF ANY = GetRefAny0[stream]; WITH obj SELECT FROM x: REF INT => IF c = '- THEN x^ _ -x^; x: REF REAL => IF c = '- THEN x^ _ -x^; ENDCASE => ERROR SyntaxError[stream, Rope.Concat["Illegal character: ", Rope.FromChar[c]]]; RETURN[obj]; }; ENDCASE => ERROR SyntaxError[stream, Rope.Concat["Illegal character: ", Rope.FromChar[c]]]; }; tokenDOUBLE => ERROR SyntaxError[stream, Rope.Concat["Illegal input: ", CedarScanner.ContentsFromToken[closure, token]]]; tokenCOMMENT => ERROR SyntaxError[stream, Rope.Concat["Illegal input: ", CedarScanner.ContentsFromToken[closure, token]]]; ENDCASE => ERROR; -- EOF and ERROR are caught in GetCedarScannerToken1 and converted into SyntaxError ENDLOOP; }; -- of GetRefAny0 [closure, closureData] _ CreateClosure[stream]; object _ GetRefAny0[stream ! RightParen => ERROR SyntaxError[stream, "unmatched left paren"]; Comma => ERROR SyntaxError[stream, "Illegal character: ,"] ]; RefText.ReleaseScratch[closureData.text]; }; -- of GetRefAny <> GetToken: PUBLIC PROC [stream: STREAM, breakProc: BreakProc _ TokenProc] RETURNS[ROPE] = { anySeen: BOOL _ FALSE; charProc: CharProc = { SELECT breakProc[char] FROM break => {include _ NOT anySeen; quit _ TRUE}; sepr => {include _ FALSE; quit _ anySeen}; other => {include _ TRUE; quit _ FALSE; anySeen _ TRUE}; ENDCASE => ERROR; }; RETURN[GetSequence[stream, charProc]]; }; SkipOver: PUBLIC PROC [stream: STREAM, skipWhile: BreakProc] = { char: CHARACTER; IF skipWhile = NIL THEN RETURN; DO IF stream.EndOf[] THEN RETURN; SELECT skipWhile[(char _ stream.GetChar[])] FROM other, break => EXIT; ENDCASE; ENDLOOP; stream.Backup[char]; }; -- of SkipOver WhiteSpace: PUBLIC BreakProc = { RETURN[SELECT char FROM IO.SP, IO.CR, IO.LF, IO.TAB => sepr, ENDCASE => other]; }; IDProc: PUBLIC BreakProc = { RETURN[SELECT char FROM SP, CR, ESC, LF, TAB, ',, ':, '; => sepr, ENDCASE => other]; }; TokenProc: PUBLIC BreakProc = { RETURN[SELECT char FROM '[, '], '(, '), '{, '}, '", '+, '-, '*, '/, '@, '_ => break, SP, CR, ESC, LF, TAB, ',, ':, '; => sepr, ENDCASE => other]; }; <> PeekChar: PUBLIC PROC[self: STREAM] RETURNS [char: CHARACTER] = { char _ self.GetChar[]; self.Backup[char] }; BackSlashChar: PUBLIC PROC [char: CHARACTER, stream: STREAM _ NIL] RETURNS [CHARACTER] <> = {SELECT char FROM 'n, 'N, 'r, 'R => RETURN[CR]; 't, 'T => RETURN[TAB]; 'b, 'B => RETURN[BS]; 'l => RETURN[LF]; 'f, 'F => RETURN[FF]; '\\, '\', '\", ESC => RETURN[char]; IN ['0..'7] => IF stream # NIL THEN {d2, d3: CHARACTER; d2 _ stream.GetChar[]; d3 _ stream.GetChar[]; IF d2 IN ['0..'7] AND d3 IN ['0..'7] THEN RETURN[0C + ((char - '0) * 64) + ((d2 - '0) * 8) + (d3 - '0)]; }; ENDCASE; Error [SyntaxError, stream]; }; END. Change Log 8-Mar-82 23:26:47 W.T. Added " to characters recognized by TokenProc 16-Apr-82 17:51:49 W.T. Added +, -, *, @, _ to characters recognized by TokenProc April 23, 1982 12:10 am W.T. took out hack for readrefany reading foo.fie. made it just return an atom June 10, 1982 3:01 pm W.T. fixed bug in GetRope, GetRefText: StopAndPutBackChar was not being checked. June 21, 1982 10:32 pm W.T. fixed bug in ReadStringDelim. If more than 256 characters appeared between "", then caused a boundsfault. <<>> <> <> <> <> <> <> <> <> <> <> <> <> <> <> <<>> <<>>