<> <> <> <> DIRECTORY FS USING [StreamOpen], IO USING [Close, EndOfStream, GetChar, PutChar], PasPrivate, PasPrivateVars, RefText USING [AppendChar], Rope USING [Equal, Fetch, FromRefText, Length]; PasScanner: CEDAR PROGRAM IMPORTS FS, IO, PasPrivate, PasPrivateVars, RefText, Rope EXPORTS PasPrivate = BEGIN OPEN PasPrivate, PasPrivateVars; <> ResWordFirstChar: TYPE = CHARACTER ['A..SUCC['Z]]; ReservedWord: TYPE = RECORD [string: ROPE, sy: Symbol, op: Operator]; ResWordIndex: TYPE = [0..40]; CharTabEntry: TYPE = RECORD [sy: Symbol _ otherSy, op: Operator _ noOp]; <> resWordIndex: ARRAY ResWordFirstChar OF ResWordIndex; resWordTable: ARRAY ResWordIndex OF ReservedWord = [["AND", mulOpSy, andOp], ["ARRAY", arraySy, noOp], ["BEGIN", beginSy, noOp], ["CASE", caseSy, noOp], ["CONST", constSy, noOp], ["DIV", mulOpSy, iDivOp], ["DO", doSy, noOp], ["DOWNTO", downToSy, noOp], ["ELSE", elseSy, noOp], ["END", endSy, noOp], ["EXIT", exitSy, noOp], ["EXTERN", externSy, noOp], ["EXTERNAL", externSy, noOp], ["FILE", fileSy, noOp], ["FOR", forSy, noOp], ["FORWARD", forwardSy, noOp], ["FUNCTION", functionSy, noOp], ["GOTO", gotoSy, noOp], ["IF", ifSy, noOp], ["IN", relOpSy, inOp], ["LABEL", labelSy, noOp], ["LOOP", loopSy, noOp], ["MOD", mulOpSy, modOp], ["NOT", notSy, noOp], ["OF", ofSy, noOp], ["OR", addOpSy, orOp], ["OTHERS", othersSy, noOp], ["PACKED", packedSy, noOp], ["PROCEDURE", procedureSy, noOp], ["PROGRAM", programSy, noOp], ["RECORD", recordSy, noOp], ["REPEAT", repeatSy, noOp], ["SET", setSy, noOp], ["THEN", thenSy, noOp], ["TO", toSy, noOp], ["TYPE", typeSy, noOp], ["UNTIL", untilSy, noOp], ["VAR", varSy, noOp], ["WHILE", whileSy, noOp], ["WITH", withSy, noOp], ["", eofSy, noOp]]; <> scanCh: CHARACTER; capitalizeAlphabetic: BOOLEAN _ TRUE; capitalizeStringConstants: BOOLEAN _ FALSE; string: REF TEXT _ Z.NEW[TEXT[200]]; -- must be long enough for one lexeme readingString: BOOLEAN; source: STREAM; i: ResWordIndex; j: CARDINAL; traceInput: BOOLEAN _ FALSE; charTable: ARRAY CHARACTER OF CharTabEntry; <> EndOfSource, BadInteger: ERROR = CODE; InitContextBuffer: PROCEDURE = BEGIN FOR i:NAT IN [0..contextBufferLength) DO contextBuffer[i] _ ' ; ENDLOOP; contextBufferIndex _ 0; END; SourceFromStream: PUBLIC PROCEDURE [stream: STREAM, name: ROPE] = BEGIN source _ stream; sy _ lBrackSy; -- anything but eofSy ch _ scanCh _ ' ; InitContextBuffer[]; positionInInputFile _ 0; nameOfInputFile _ name; END; -- of SourceFromStream SourceFromNextStream: PUBLIC PROCEDURE = BEGIN fileName: ROPE; source.Close[]; -- close previous file fileName _ ""; IF sourceFileSeq = NIL THEN ERROR IO.EndOfStream[source] ELSE BEGIN os: SourceFileSeqPtr _ sourceFileSeq; source _ FS.StreamOpen[os.name]; positionInInputFile _ 0; nameOfInputFile _ os.name; sourceFileSeq _ os.next; sy _ lBrackSy; -- anything but eofSy InitContextBuffer[]; END END; -- of SourceFromNextStream NextCh: PROCEDURE = <> BEGIN IF sy = eofSy THEN ERROR EndOfSource; ch _ scanCh _ source.GetChar[ ! IO.EndOfStream => IF sourceFileSeq # NIL THEN {SourceFromNextStream[]; RETRY} ]; positionInInputFile _ positionInInputFile + 1; contextBuffer[contextBufferIndex] _ scanCh; contextBufferIndex _ contextBufferIndex + 1; IF contextBufferIndex = contextBufferLength THEN contextBufferIndex _ 0; IF traceInput THEN commandHandle.out.PutChar[ch]; IF ~readingString AND capitalizeAlphabetic AND (scanCh IN ['a..'z]) THEN scanCh _ scanCh - 'a + 'A; END; -- of NextCh InSymbol: PUBLIC PROCEDURE [stopAtCR: BOOLEAN _ FALSE] = <> <> BEGIN SkipComment: PROCEDURE [oneChar: BOOLEAN, endChar: CHARACTER] = <> BEGIN -- looking at the last char of the opening bracket lastCommentCh: CHARACTER; SayCommentCh: PROCEDURE [c: CHARACTER] = BEGIN IF lastCommentCh = '- AND c = '- THEN SayCh[' ]; SayCh[c]; lastCommentCh _ c END; -- of SayCommentCh readingString _ TRUE; Say["--"]; lastCommentCh _ '-; -- start of comment NextCh[]; IF oneChar THEN WHILE scanCh # endChar DO SayCommentCh[scanCh]; IF scanCh = '\n THEN {Say["-- "]; lastCommentCh _ ' }; NextCh[]; ENDLOOP ELSE DO UNTIL scanCh = '* DO SayCommentCh[scanCh]; IF scanCh = '\n THEN {Say["-- "]; lastCommentCh _ ' }; NextCh[]; ENDLOOP; NextCh[]; IF scanCh = ') THEN EXIT; SayCh['*]; lastCommentCh _ '*; ENDLOOP; readingString _ FALSE; NextCh[]; IF scanCh # '\n THEN {SayCommentCh['-]; SayCh['-]}; -- end of comment END; -- of SkipComment AppendToString: PROCEDURE [c: CHARACTER] = INLINE BEGIN string _ RefText.AppendChar[to: string, from: c]; END; AppendChToString: PROCEDURE = INLINE BEGIN AppendToString[scanCh]; NextCh END; AppendDigitsToString: PROCEDURE = BEGIN WHILE scanCh IN ['0..'9] DO string _ RefText.AppendChar[to: string, from: scanCh]; NextCh ENDLOOP; END; AppendHexDigitsToString: PROCEDURE = BEGIN WHILE scanCh IN ['0..'9] OR scanCh IN ['A..'Z] DO string _ RefText.AppendChar[to: string, from: scanCh]; NextCh ENDLOOP; END; readingString _ FALSE; -- beginning of InSymbol string.length _ 0; op _ noOp; DO ENABLE IO.EndOfStream => GO TO SourceExhausted; -- SIGNAL catch SELECT scanCh FROM ' , '\t, '\f => {SayCh[scanCh]; NextCh}; '\n => BEGIN SayCh[scanCh]; NextCh; IF stopAtCR THEN {sy _ CRSy; GOTO GotSymbol}; END; '\032 --Control-Z-- => UNTIL scanCh = '\n DO NextCh ENDLOOP; '{ => SkipComment[TRUE, '}]; '( => BEGIN NextCh; IF scanCh = '* THEN SkipComment[FALSE, ')] ELSE BEGIN sy _ lParentSy; GO TO GotSymbol END END; ': => -- colon or assignment BEGIN NextCh; IF scanCh = '= THEN BEGIN sy _ becomesSy; NextCh END ELSE sy _ colonSy; GO TO GotSymbol END; '. => -- period or "sideways colon" BEGIN NextCh[ ! IO.EndOfStream => {scanCh _ '\n; CONTINUE}]; IF scanCh = '. THEN BEGIN sy _ colonSy; NextCh END ELSE sy _ periodSy; GO TO GotSymbol END; '< => BEGIN sy _ relOpSy; op _ ltOp; NextCh; IF scanCh = '> THEN BEGIN op _ neOp; NextCh END ELSE IF scanCh = '= THEN BEGIN op _ leOp; NextCh END; GO TO GotSymbol; END; '> => BEGIN sy _ relOpSy; op _ gtOp; NextCh; IF scanCh = '= THEN BEGIN op _ geOp; NextCh END; GO TO GotSymbol; END; IN ['0..'9] => <> BEGIN sy _ intConstSy; AppendDigitsToString; SELECT scanCh FROM 'b, 'B => BEGIN AppendToString['B]; NextCh; END; '. => BEGIN NextCh; IF scanCh = '. THEN scanCh _ ': ELSE BEGIN sy _ realConstSy; AppendToString['.]; AppendDigitsToString; IF scanCh = 'E OR scanCh = 'e THEN BEGIN AppendToString['E]; NextCh; IF scanCh = '+ OR scanCh = '- THEN AppendChToString; AppendDigitsToString END; END; END; ENDCASE => NULL; GO TO AlterIdent; END; '! => -- hexadecimal integer constant BEGIN sy _ intConstSy; NextCh; AppendHexDigitsToString; AppendToString['H]; GO TO AlterIdent; END; '' => -- string constant BEGIN sy _ stringConstSy; readingString _ NOT capitalizeStringConstants; NextCh; WHILE scanCh # '' DO AppendChToString; ENDLOOP; NextCh; -- move beyond terminating quote WHILE scanCh = '' DO <> AppendChToString; WHILE scanCh # '' DO AppendChToString; ENDLOOP; NextCh; -- move beyond terminating quote ENDLOOP; readingString _ FALSE; GO TO AlterIdent; END; IN ['a..'z], IN ['A..'Z], '$, '_ => -- symbol BEGIN WHILE (SELECT scanCh FROM IN ['a..'z], IN ['A..'Z], '$, '_, IN ['0..'9] => TRUE, ENDCASE => FALSE) DO AppendChToString; ENDLOOP; IF string.length <= 9 -- the longest reserved word -- AND string[0] IN ['A..'Z] THEN FOR i IN [resWordIndex[string[0]]..resWordIndex[string[0] + 1]) DO BEGIN -- for EXITS IF string.length # resWordTable[i].string.Length[] THEN GO TO MisMatch; FOR j IN [0..string.length) DO IF string[j] # resWordTable[i].string.Fetch[j] THEN GO TO MisMatch ENDLOOP; GO TO ReservedWord; EXITS MisMatch => NULL; END; ENDLOOP; sy _ identSy; -- not a reserved word GO TO AlterIdent; EXITS ReservedWord => BEGIN sy _ resWordTable[i].sy; op _ resWordTable[i].op; GO TO GotSymbol END; END; ENDCASE => BEGIN sy _ charTable[scanCh].sy; op _ charTable[scanCh].op; NextCh; GO TO GotSymbol END; ENDLOOP; EXITS AlterIdent => ident _ Rope.FromRefText[string]; GotSymbol => NULL; SourceExhausted => {scanCh _ ' ; sy _ eofSy}; END; -- of InSymbol CouldBe: PUBLIC PROCEDURE [testSy: Symbol, string: ROPE _ NIL] RETURNS [BOOLEAN] = BEGIN IF sy = testSy THEN {IF string # NIL THEN Say[string]; InSymbol; RETURN[TRUE]} ELSE RETURN[FALSE]; END; -- of CouldBe MustBe: PUBLIC PROCEDURE [testSy: Symbol, string: ROPE _ NIL, e: Errors] = BEGIN IF NOT CouldBe[testSy: testSy, string: string] THEN Error[e]; END; <> SequenceOf: PUBLIC PROCEDURE [ p: PROCEDURE, separatorSy: Symbol _ semiColonSy, separatorString: ROPE _ NIL] = BEGIN LooksPlausible: PROCEDURE RETURNS [BOOLEAN] = { RETURN[SELECT sy FROM endSy, untilSy, othersSy => FALSE, ENDCASE => TRUE]}; IF separatorString = NIL THEN separatorString _ SELECT separatorSy FROM semiColonSy => ";", commaSy => ",", ENDCASE => ""; IF LooksPlausible[] THEN BEGIN p; WHILE sy = separatorSy DO q: OutputQueuePtr; PushOut[]; InSymbol[]; q _ CopyAndPopOut[]; -- get comments IF LooksPlausible[] THEN {Say[separatorString]; MergeQueue[from: q]; p} ELSE {MergeQueue[from: q]; EXIT}; ENDLOOP; END; END; -- of SequenceOf StringToPascalInteger: PUBLIC PROCEDURE [s: ROPE] RETURNS [PascalInteger] = BEGIN radix: INTEGER _ 10; sign: INTEGER _ 1; v: PascalInteger _ 0; i, start: CARDINAL; end: CARDINAL _ s.Length[]; IF end = 0 THEN RETURN[v]; SELECT s.Fetch[end - 1] FROM 'B, 'b => {radix _ 8; end _ end - 1}; -- octal ENDCASE => NULL; FOR start IN [0..end) WHILE s.Fetch[start] NOT IN ['0..'9] DO SELECT s.Fetch[start] FROM '- => sign _ -sign; ENDCASE => NULL; ENDLOOP; WHILE start < end AND s.Fetch[start] = '0 DO start _ start + 1 ENDLOOP; FOR i IN [start..end) DO IF s.Fetch[i] NOT IN ['0..'0 + radix) THEN ERROR BadInteger; v _ radix*v + (s.Fetch[i] - '0); ENDLOOP; <> RETURN[IF sign > 0 THEN v ELSE -v]; END; -- of StringToPascalInteger SayPascalInteger: PUBLIC PROCEDURE [i: PascalInteger] = BEGIN IF i < 0 THEN {SayCh['-]; i _ -i}; IF i >= 10 THEN SayPascalInteger[i/10]; SayCh['0 + NARROW[i MOD 10, INT]]; END; -- of SayPascalInteger SayIdent: PUBLIC PROCEDURE [s: ROPE _ NIL] = BEGIN i: CARDINAL; allCaps: BOOLEAN; capitalize: BOOLEAN _ TRUE; IF s = NIL THEN s _ ident; IF s.Length[] <= 0 THEN RETURN; allCaps _ SELECT s.Fetch[0] FROM 'f, 'F => Rope.Equal[s, "FALSE"], 't, 'T => Rope.Equal[s, "TRUE"], 'n, 'N => Rope.Equal[s, "NIL"], ENDCASE => FALSE; FOR i IN [0..NAT[s.Length[]]) DO SELECT TRUE FROM s.Fetch[i] IN ['a..'z] AND capitalize => { SayCh[s.Fetch[i] + ('A - 'a)]; capitalize _ allCaps}; s.Fetch[i] IN ['A..'Z] AND NOT capitalize => { SayCh[s.Fetch[i] + ('a - 'A)]; capitalize _ allCaps}; s.Fetch[i] = '_ => capitalize _ TRUE; ENDCASE => {SayCh[s.Fetch[i]]; capitalize _ allCaps}; ENDLOOP; END; -- of SayIdent RopeSayIdent: PUBLIC PROCEDURE [s: ROPE _ NIL] RETURNS [r: ROPE] = BEGIN PushOut[]; SayIdent[s]; RETURN[CopyAndPopOut[].contents]; END; -- of RopeSayIdent <> i _ FIRST[ResWordIndex]; -- set up reserved word index FOR scanCh IN ResWordFirstChar DO WHILE i < LAST[ResWordIndex] AND resWordTable[i].string.Fetch[0] < scanCh DO i _ i + 1; ENDLOOP; resWordIndex[scanCh] _ i; ENDLOOP; <> charTable['+] _ CharTabEntry[sy: addOpSy, op: plusOp]; charTable['-] _ CharTabEntry[sy: addOpSy, op: minusOp]; charTable['*] _ CharTabEntry[sy: mulOpSy, op: mulOp]; charTable['/] _ CharTabEntry[sy: mulOpSy, op: rDivOp]; charTable['=] _ CharTabEntry[sy: relOpSy, op: eqOp]; charTable['<] _ CharTabEntry[sy: relOpSy, op: ltOp]; charTable['>] _ CharTabEntry[sy: relOpSy, op: gtOp]; charTable['(] _ CharTabEntry[sy: lParentSy]; charTable[')] _ CharTabEntry[sy: rParentSy]; charTable['[] _ CharTabEntry[sy: lBrackSy]; charTable[']] _ CharTabEntry[sy: rBrackSy]; charTable[':] _ CharTabEntry[sy: colonSy]; charTable[';] _ CharTabEntry[sy: semiColonSy]; charTable['^] _ CharTabEntry[sy: arrowSy]; charTable['.] _ CharTabEntry[sy: periodSy]; charTable[',] _ CharTabEntry[sy: commaSy]; END. -- of PasScanner --