lex
1 GET "LIBHDR" 2 GET "KRC_LISTHDR" 3 GET "KRC_COMPHDR" 4 5 || KRC LEX ANALYSER 6 7 ||---------------------------------------------------------------------- 8 ||The KRC system is Copyright (c) D. A. Turner 1981 9 ||All rights reserved. It is distributed as free software under the 10 ||terms in the file "COPYING", which is included in the distribution. 11 ||---------------------------------------------------------------------- 12 13 STATIC $( EXPECTFILE=FALSE $) 14 15 LET READLINE() || READS THE NEXT LINE INTO "TOKENS" 16 BE $( LET P = @TOKENS 17 LET T = 0 18 TOKENS:= NIL 19 THE.DECIMALS:=0 20 ERRORFLAG:=FALSE 21 EXPFLAG:= FALSE || WILL GET SET IF THE LINE CONTAINS "?" OR "!" 22 COMMENTFLAG:= FALSE 23 EXPECTFILE:= FALSE 24 EQNFLAG:=FALSE ||WILL GET SET IF THE LINE CONTAINS "=" 25 T,!P,P := READTOKEN(),CONS(T,NIL),@TL!(!P) 26 REPEATUNTIL T=EOL | T=ENDSTREAMCH | T=BADTOKEN 27 IF HD!TOKENS=EOL LOOP ||IGNORE BLANK LINES 28 IF T=ENDSTREAMCH & INPUT()=SYSIN 29 DO $( ENDREAD() ; SELECTINPUT(SYSIN) $) 30 ||AN EMAS KLUDGE - IN CASE USER HITS EOT CHAR ON TERMINAL 31 IF T=EOL | T=ENDSTREAMCH RETURN 32 WRITES("Closing quote missing - line ignored*N") 33 $) REPEAT 34 35 AND READTOKEN() = VALOF 36 || TOKEN ::= CHAR | <CERTAIN DIGRAPHS, REPRESENTED BY NOS ABOVE 256> | 37 || | CONS(ID,ATOM) | CONS(CONST,<ATOM|NUM>) 38 $( LET CH = RDCH() 39 WHILE CH=' '|CH='*T' DO CH:= RDCH() 40 IF CH='*N' RESULTIS EOL 41 IF 'a'<=CH<='z'|'A'<=CH<='Z'|EXPECTFILE & ('0'<=CH<='9'|CH='.'|CH='#') 42 DO $( $( BUFCH(UPPERCASE->CASECONV(CH),CH) 43 CH:=RDCH() 44 $) REPEATWHILE 'a'<=CH<='z'|'A'<=CH<='Z'|'0'<=CH<='9'|CH='*''|CH='_'|EXPECTFILE &(CH='.'|CH='#') 45 UNRDCH() 46 $( LET X = PACKBUFFER() 47 IF TOKENS\=NIL & HD!TOKENS='/' & TL!TOKENS=NIL & MEMBER(FILECOMMANDS,X) 48 DO EXPECTFILE:= TRUE 49 RESULTIS CONS(ID,X) $) $) 50 IF '0'<=CH<='9' | CH='.'&TOKENS=NIL&PEEKDIGIT() 51 DO $( TEST CH='.' 52 THEN $( THE.NUM:=0 53 TERMINATOR:='.' $) 54 OR $( UNRDCH() ; THE.NUM:= READN() $) 55 TEST TOKENS=NIL & TERMINATOR='.' ||LINE NUMBERS (ONLY) ARE 56 THEN THE.DECIMALS:=READ.DECIMALS()||ALLOWED A DECIMAL PART 57 OR UNRDCH() 58 RESULTIS CONS(CONST,STONUM(THE.NUM)) $) 59 IF CH='*"' 60 DO $( LET A = NIL 61 CH:= RDCH() 62 UNTIL CH='*"'|CH='*N' 63 DO $( BUFCH(CH) ; CH:=RDCH() $) 64 A:= PACKBUFFER() 65 RESULTIS CH='*N' -> BADTOKEN, CONS(CONST,A) $) 66 $( LET CH2 = RDCH() 67 IF CH=':' & CH2='-' & TOKENS\=NIL & ISCONS(HD!TOKENS) & 68 HD!(HD!TOKENS)=ID & TL!TOKENS=NIL 69 DO $( LET C = NIL 70 COMMENTFLAG:= TRUE 71 SUPPRESSPROMPTS() 72 CH:= RDCH() 73 IF CH=';' RESULTIS NIL 74 UNTIL CH=';' | CH=ENDSTREAMCH 75 DO TEST CH='*N' 76 THEN $( C:= CONS(PACKBUFFER(),C) 77 CH:= RDCH() REPEATWHILE CH='*N' 78 ||IGNORE BLANK LINES IN COMMENT ALSO 79 $) 80 OR $( BUFCH(CH) ; CH:= RDCH() $) 81 C:= CONS(PACKBUFFER(),C) 82 RESULTIS REVERSE(C) $) 83 IF CH='+'=CH2 RESULTIS PLUSPLUS.SY 84 IF CH='.'=CH2 RESULTIS DOTDOT.SY 85 IF CH='<' & CH2='-' RESULTIS BACKARROW.SY 86 IF CH='-'=CH2 RESULTIS DASHDASH.SY 87 IF CH='**'=CH2 RESULTIS STARSTAR.SY 88 IF CH2='=' 89 DO $( IF CH='>' RESULTIS GE.SY 90 IF CH='<' RESULTIS LE.SY 91 IF NOTCH(CH) RESULTIS NE.SY 92 $) 93 UNRDCH() 94 IF CH='?'|CH='!' DO EXPFLAG:= TRUE 95 IF CH='=' DO EQNFLAG:=TRUE 96 RESULTIS NOTCH(CH)-> '\', CH 97 $) $) 98 99 AND CASECONV(CH) = 100 'A'<=CH<='Z' -> CH+'a'-'A', 101 CH 102 103 AND NOTCH(CH) = CH='~'|CH='\' 104 105 AND PEEKDIGIT() = VALOF 106 $( LET CH=RDCH() 107 UNRDCH() 108 TEST '0'<=CH<='9' 109 THEN RESULTIS TRUE 110 ELSE RESULTIS FALSE $) 111 112 AND READ.DECIMALS() = VALOF ||RETURNS VALUE IN HUNDREDTHS 113 $( LET N,F,D = 0,10,? 114 $( D:=RDCH()-'0' 115 UNLESS 0<=D<=9 116 DO $( D:=D+'0' 117 WHILE D=' ' DO D:=RDCH() 118 UNLESS D=')' DO SYNTAX() 119 UNRDCH() 120 RESULTIS N $) 121 N:=N+F*D ||NOTE THAT DECIMAL PLACES AFTER THE 2ND WILL HAVE NO 122 F:=F/10 ||EFFECT ON THE ANSWER 123 $) REPEAT 124 $) 125 126 AND WRITETOKEN(T) 127 BE TEST T<256 THEN WRCH(T) OR 128 SWITCHON T INTO 129 $( CASE PLUSPLUS.SY: WRITES("++"); ENDCASE 130 CASE DASHDASH.SY: WRITES("--"); ENDCASE 131 CASE STARSTAR.SY: WRITES("****"); ENDCASE 132 CASE GE.SY: WRITES(">="); ENDCASE 133 CASE LE.SY: WRITES("<="); ENDCASE 134 CASE NE.SY: WRITES("\="); ENDCASE 135 CASE BACKARROW.SY: WRITES("<-"); ENDCASE 136 CASE DOTDOT.SY: WRITES(".."); ENDCASE 137 DEFAULT: TEST \(ISCONS(T) & (HD!T=ID | HD!T=CONST)) 138 THEN WRITES("<UNKNOWN TOKEN<%N>>",T) OR 139 TEST HD!T=ID 140 THEN WRITES(PRINTNAME(ISCONS(TL!T)&HD!(TL!T)=ALPHA-> 141 TL!(TL!T), TL!T)) OR 142 TEST ISNUM(TL!T) 143 THEN WRITEN(GETNUM(TL!T)) 144 OR WRITEF("*"%S*"",PRINTNAME(TL!T)) 145 $) 146 147 AND HAVE(T) = VALOF 148 $( IF TOKENS=NIL | HD!TOKENS\=T RESULTIS FALSE 149 TOKENS:= TL!TOKENS 150 RESULTIS TRUE $) 151 152 AND CHECK(T) 153 BE UNLESS HAVE(T) DO ERRORFLAG:= TRUE 154 155 AND SYNTAX() 156 BE ERRORFLAG:=TRUE 157 158 AND HAVEID() = VALOF 159 $( UNLESS ISCONS(HD!TOKENS) & HD!(HD!TOKENS)=ID RESULTIS FALSE 160 THE.ID:= TL!(HD!TOKENS) 161 TOKENS:= TL!TOKENS 162 RESULTIS TRUE $) 163 164 AND HAVECONST() = VALOF 165 $( UNLESS ISCONS(HD!TOKENS) & HD!(HD!TOKENS)=CONST RESULTIS FALSE 166 THE.CONST:= TL!(HD!TOKENS) 167 TOKENS:= TL!TOKENS 168 RESULTIS TRUE $) 169 170 AND HAVENUM() = VALOF 171 $( UNLESS ISCONS(HD!TOKENS) & HD!(HD!TOKENS)=CONST & 172 ISNUM(TL!(HD!TOKENS)) RESULTIS FALSE 173 THE.NUM:= GETNUM(TL!(HD!TOKENS)) 174 TOKENS:= TL!TOKENS 175 RESULTIS TRUE $) 176 177