<> <> <> <> <> <> DIRECTORY Convert, IO, MPLeaves USING [HTIndex, HTNode, LTIndex, LTNode], MPP1, MPParseTable, Real USING [RealException], Rope USING [Fetch, Flatten, Length, ROPE, Size]; MPScanner: PROGRAM IMPORTS Convert, IO, MPParseTable, Real, Rope EXPORTS MPP1 SHARES Rope = BEGIN OPEN MPLeaves, MPParseTable, MPP1; ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; <> hashTab: HashTableRef; scanTab: ScanTableRef Ź NIL; vocab: VocabularyRef Ź NIL; vocabIndex: IndexTableRef Ź NIL; << hashTab: LONG POINTER TO ARRAY HashIndex OF VocabHashEntry Ź NIL; scanTab: LONG POINTER TO ARRAY CHAR [40C..177C] OF TSymbol Ź NIL; vocab: LONG STRING Ź NIL; vocabIndex: LONG POINTER TO ARRAY TSymbol OF CARDINAL Ź NIL; >> rf: ROPE Ź NIL; -- the source rs: STREAM Ź NIL; -- the source as stream toklen: NAT Ź 0; -- current token length tokpos: INT Ź 0; -- source index for start of token nTokens: CARDINAL Ź 0; -- token count nErrors: CARDINAL; -- lexical errors lastToken: INT Ź 0; IdFromRope: PROC [r: ROPE, index: INT] RETURNS [HTIndex] = { RETURN [NEW[HTNode Ź [index: index, name: r]]]}; IdFirst: HTIndex Ź IdFromRope["first", LAST[INT]]; IDLock: HTIndex Ź IdFromRope["LOCK", LAST[INT]]; IDRest: HTIndex Ź IdFromRope["rest", LAST[INT]]; IdOfFirst: PUBLIC SAFE PROC RETURNS [HTIndex] = TRUSTED {RETURN [IdFirst]}; IdOfLock: PUBLIC SAFE PROC RETURNS [HTIndex] = TRUSTED {RETURN [IDLock]}; IdOfRest: PUBLIC SAFE PROC RETURNS [HTIndex] = TRUSTED {RETURN [IDRest]}; Atom: PUBLIC SAFE PROC [errPut: IO.STREAM] RETURNS [token: MPP1.Token Ź MPP1.nullToken] = TRUSTED { tokenKind: IO.TokenKind; rope: ROPE; charsSkipped: INT; DO peek: CHAR Ź 0C; [] Ź IO.SkipWhitespace[rs, TRUE ! IO.EndOfStream => EXIT]; peek Ź IO.PeekChar[rs ! IO.EndOfStream => EXIT]; tokpos Ź IO.GetIndex[rs]; token.index Ź tokpos; SELECT peek FROM '%, '& => { <> DO [] Ź IO.GetChar[rs]; peek Ź IO.PeekChar[rs ! IO.EndOfStream => EXIT]; SELECT peek FROM IN ['a..'z], IN ['A..'Z], IN ['0..'9], '%, '& => {}; ENDCASE => EXIT; ENDLOOP; toklen Ź IO.GetIndex[rs] - tokpos; token.class Ź tokenID; token.value.r Ź IdFromRope[rf.Flatten[tokpos, toklen], tokpos]; EXIT; }; ENDCASE; [tokenKind, rope, charsSkipped] Ź IO.GetCedarTokenRope[rs ! IO.Error => { ErrorContext["Syntax error", IO.GetIndex[rs], errPut]; EXIT}; IO.EndOfStream => { <> tokenKind Ź tokenEOF; rope Ź ""; CONTINUE; } ]; toklen Ź rope.Length[]; tokpos Ź rs.GetIndex[] - toklen; SELECT tokenKind FROM tokenID => { <> allcaps: BOOL Ź TRUE; r: ROPE Ź NIL; token.class Ź tokenID; FOR i: INT IN [0..rope.Size[]) DO IF rope.Fetch[i] IN ['a..'z] THEN {allcaps Ź FALSE; EXIT}; ENDLOOP; IF allcaps THEN { <> first: CARDINAL Ź ORD[rope.Fetch[0]]; last: CARDINAL Ź ORD[rope.Fetch[rope.Size[]-1]]; h: CARDINAL Ź (first * 128 - first + last) MOD LAST[HashIndex] + 1; j: CARDINAL Ź 0; len: NAT Ź rope.Size[]; WHILE (j Ź hashTab[h].symbol) # 0 DO s2: CARDINAL Ź vocabIndex[j - 1]; IF vocabIndex[j] - s2 = len THEN FOR s1: CARDINAL IN [0..len) DO IF rope.Fetch[s1] # vocab[s2] THEN EXIT; s2 Ź s2 + 1; REPEAT FINISHED => {token.class Ź j; GO TO CheckEnd}; ENDLOOP; IF (h Ź hashTab[h].link) = 0 THEN EXIT ENDLOOP; }; token.value.r Ź IdFromRope[rope, tokpos]; }; tokenDECIMAL, tokenOCTAL, tokenHEX => { <> ENABLE Convert.Error => GO TO badNumber; token.class Ź tokenLNUM; token.value.r Ź WrapLit[NEW[DINT Ź Convert.DIntFromRope[rope]]]; }; tokenREAL => { <> ENABLE Convert.Error, Real.RealException => TRUSTED{GO TO badNumber}; token.class Ź tokenFLNUM; token.value.r Ź WrapLit[NEW[REAL Ź Convert.RealFromLiteral[rope]]]; }; tokenROPE => { <> token.class Ź tokenSTR; token.value.r Ź WrapLit[NEW[ROPE Ź Convert.RopeFromLiteral[rope]]]; }; tokenCHAR => { <> token.class Ź tokenCHAR; token.value.r Ź WrapLit[NEW[CHAR Ź Convert.CharFromLiteral[rope]]]; }; tokenATOM => { <> token.class Ź tokenATOM; token.value.r Ź WrapLit[NEW[ATOM Ź Convert.AtomFromRope[rope]]]; }; tokenSINGLE => { <> XeroxOtherDollar: CHAR = 244C; -- ¤ XeroxLeftArrow: CHAR = 254C; -- Ź XeroxUpArrow: CHAR = 255C; -- XeroxMultiply: CHAR = 264C; -- ´ XeroxDivide: CHAR = 270C; -- ¸ c: CHAR Ź rf.Fetch[tokpos]; SELECT c FROM XeroxOtherDollar => c Ź '$; XeroxLeftArrow => c Ź '_; XeroxUpArrow => c Ź '^; XeroxMultiply => c Ź '*; XeroxDivide => c Ź '/; ENDCASE; IF c = ': AND NOT IO.EndOf[rs] AND IO.PeekChar[rs]='= THEN { <> [] Ź IO.GetChar[rs]; rope Ź ":="; toklen Ź 2; token.class Ź scanTab['_]; } ELSE { token.class Ź scanTab[c] }; }; tokenDOUBLE => { <> c1: CHAR Ź rf.Fetch[tokpos]; SELECT c1 FROM '* => token.class Ź tokenPOWER; -- for ** '= => token.class Ź tokenARROW; -- for == '< => token.class Ź tokenLE; -- for <= '> => token.class Ź tokenGE; -- for >= '. => token.class Ź tokenDOTS; -- for .. ': => token.class Ź scanTab['_]; -- for := '~ => SELECT rf.Fetch[tokpos+1] FROM '= => token.class Ź scanTab['#]; -- for ~= '< => token.class Ź tokenGE; -- for ~< '> => token.class Ź tokenLE; -- for ~> ENDCASE => GO TO syntaxError; ENDCASE => GO TO syntaxError; }; tokenCOMMENT => { <> LOOP; }; tokenEOF => { token.class Ź endMarker; token.value Ź MPP1.nullValue; }; tokenERROR => GO TO syntaxError; <> ENDCASE => ERROR; -- all cases should have been covered EXIT; REPEAT syntaxError => { ErrorContext["Syntax error", tokpos, errPut]; }; badNumber => { ErrorContext["invalid number", tokpos, errPut]; }; CheckEnd => {}; ENDLOOP; <> nTokens Ź nTokens + 1; lastToken Ź tokpos; RETURN; }; <> WrapLit: PROC [r: REF ANY] RETURNS [LTIndex] = { RETURN [NEW[LTNode Ź [index: tokpos, value: r, literal: rf.Flatten[tokpos, toklen]]]]}; <> ScanInit: PUBLIC SAFE PROC [source: ROPE] RETURNS [vIndex: IndexTableRef, vBody: VocabularyRef] = TRUSTED { IF vocab = NIL THEN { scanTab Ź MPParseTable.InitScanTable[]; hashTab Ź MPParseTable.InitHashTable[]; vocabIndex Ź MPParseTable.InitIndexTable[]; vocab Ź MPParseTable.InitVocabulary[]; }; << hashTab Ź @table[table.scanTable.hashTab]; scanTab Ź @table[table.scanTable.scanTab]; vocab Ź LOOPHOLE[@table[table.scanTable.vocabBody]]; vocabIndex Ź @table[table.scanTable.vocabIndex]; >> rf Ź source; rs Ź IO.RIS[rf]; tokpos Ź 0; lastToken Ź 0; nTokens Ź nErrors Ź 0; RETURN[vIndex, vBody]; }; ScanReset: PUBLIC SAFE PROC RETURNS [CARDINAL, CARDINAL] = TRUSTED { rf Ź NIL; rs Ź NIL; RETURN [nTokens, nErrors]; }; <> ResetScanIndex: PUBLIC SAFE PROC [index: INT] RETURNS [success: BOOL] = TRUSTED { tokpos Ź index; RETURN [TRUE]; }; ErrorContext: PUBLIC SAFE PROC [message: ROPE, tokenIndex: INT, put: IO.STREAM] = TRUSTED { low: INT Ź tokenIndex - 40; high: INT Ź tokenIndex + 40; nErrors Ź nErrors + 1; IF low < 0 THEN low Ź 0; IF high >= rf.Size[] THEN high Ź rf.Size[]-1; put.PutChar['\n]; IF low > 0 THEN put.PutRope["..."]; FOR i: INT IN [low..high] DO c: CHAR Ź rf.Fetch[i]; IF i = tokenIndex THEN put.PutRope[" *^* "]; put.PutChar[c]; ENDLOOP; IF high < rf.Size[]-1 THEN put.PutRope["..."]; put.PutChar['\n]; put.PutRope[message]; put.PutChar['\n]; }; END.