compiler
1 ||KRC COMPILER 2 3 GET "LIBHDR" 4 GET "KRC_LISTHDR" 5 GET "KRC_COMPHDR" 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 $( INFIXNAMEVEC=?; INFIXPRIOVEC=? 14 $) 15 16 LET SETUP.INFIXES() 17 BE $( LET V1 = TABLE ':',PLUSPLUS.SY,DASHDASH.SY,'|','&','>',GE.SY,NE.SY,'=', 18 LE.SY,'<','+','-','**','/','%',STARSTAR.SY,'.' 19 LET V2 = TABLE 0,0,0,1,2,3,3,3,3,3,3,4,4,5,5,5,6,6 20 INFIXNAMEVEC:=V1-1 21 INFIXPRIOVEC:=V2-1 22 $) 23 24 AND ISOP(X) = ALPHA<=X<=QUOTE.OP 25 26 AND ISINFIX(X) = COLON.OP<=X<= DOT.OP 27 28 AND ISRELOP(X) = GR.OP<=X<=LS.OP 29 30 AND DIPRIO(OP) = OP=-1-> -1, INFIXPRIOVEC!OP 31 32 AND MKINFIX(T) = VALOF || TAKES A TOKEN , RETURNS AN OPERATOR 33 || OR -1 IF T NOT THE NAME OF AN INFIX 34 $( LET I = 1 35 UNTIL I>DOT.OP | INFIXNAMEVEC!I=T DO I:= I+1 36 IF I>DOT.OP RESULTIS -1 37 RESULTIS I $) 38 39 AND PRINTEXP(E,N) || N IS THE PRIORITY LEVEL 40 BE TEST E=NIL 41 THEN WRITES("[]") OR 42 TEST ISATOM(E) 43 THEN WRITES(PRINTNAME(E)) OR 44 TEST ISNUM(E) 45 THEN WRITEN(GETNUM(E)) 46 OR $( UNLESS ISCONS(E) 47 DO $( TEST E=NOT.OP THEN WRITES("'\'") OR 48 TEST E=LENGTH.OP THEN WRITES("'#'") 49 OR WRITEF("<internal value:%N>",E) 50 RETURN $) 51 $( LET OP=HD!E 52 TEST \ISOP(OP) & N<=7 53 THEN $( PRINTEXP(OP,7) 54 WRCH(' ') 55 PRINTEXP(TL!E,8) $) OR 56 TEST OP=QUOTE 57 THEN PRINTATOM(TL!E,TRUE) OR 58 TEST OP=INDIR | OP=ALPHA 59 THEN PRINTEXP(TL!E,N) OR 60 TEST OP=DOTDOT.OP | OP=COMMADOTDOT.OP 61 THEN $( WRCH('[') 62 E:=TL!E 63 PRINTEXP(HD!E,0) 64 IF OP=COMMADOTDOT.OP 65 DO $( WRCH(',') 66 E:=TL!E 67 PRINTEXP(HD!E,0) $) 68 WRITES("..") 69 UNLESS TL!E=INFINITY DO PRINTEXP(TL!E,0) 70 WRCH(']') $) OR 71 TEST OP=ZF.OP 72 THEN $( WRCH('{') 73 PRINTZF.EXP(TL!E) 74 WRCH('}') $) OR 75 TEST OP=NOT.OP & N<=3 76 THEN $( WRCH('\') 77 PRINTEXP(TL!E,3) $) OR 78 TEST OP=NEG.OP & N<=5 79 THEN $( WRCH('-') 80 PRINTEXP(TL!E,5) $) OR 81 TEST OP=LENGTH.OP & N<=7 82 THEN $( WRCH('#') 83 PRINTEXP(TL!E,7) $) OR 84 TEST OP=QUOTE.OP 85 THEN $( WRCH('*'') ; WRITETOKEN(INFIXNAMEVEC!(TL!E)) ; WRCH('*'') $) OR 86 TEST ISLISTEXP(E) 87 THEN $( WRCH('[') 88 UNTIL E=NIL 89 DO $( PRINTEXP(HD!(TL!E),0) 90 UNLESS TL!(TL!E)=NIL DO WRCH(',') 91 E:= TL!(TL!E) $) 92 WRCH(']') $) OR 93 TEST OP=AND.OP & N<=3 & ROTATE(E) & ISRELATION(HD!(TL!E)) & 94 ISRELATION.BEGINNING(TL!(TL!(HD!(TL!E))),TL!(TL!E)) 95 THEN $( ||CONTINUED RELATIONS 96 PRINTEXP(HD!(TL!(HD!(TL!E))),4) 97 WRCH(' ') 98 WRITETOKEN(INFIXNAMEVEC!(HD!(HD!(TL!E)))) 99 WRCH(' ') 100 PRINTEXP(TL!(TL!E),2) $) OR 101 TEST ISINFIX(OP) & INFIXPRIOVEC!OP>=N 102 THEN $( PRINTEXP(HD!(TL!E),LEFTPREC(OP)) 103 UNLESS OP=COLON.OP|OP=DOT.OP DO WRCH(' ') 104 WRITETOKEN(INFIXNAMEVEC!OP) 105 UNLESS OP=COLON.OP|OP=DOT.OP DO WRCH(' ') 106 PRINTEXP(TL!(TL!E),RIGHTPREC(OP)) $) 107 OR $( WRCH('(') 108 PRINTEXP(E,0) 109 WRCH(')') $) 110 $) $) 111 112 AND PRINTZF.EXP(X) 113 BE 114 $( LET Y=X 115 UNTIL TL!Y=NIL DO Y:=TL!Y 116 PRINTEXP(HD!Y,0) ||BODY 117 || TEST ISCONS(HD!X) & HD!(HD!X)=GENERATOR & EQUAL(HD!(TL!(HD!X)),HD!Y) 118 || THEN $( WRITES("<-") ||IMPLICIT ZF BODY, NO LONGER SUPPORTED - DT OCT 81 119 || PRINTEXP(TL!(TL!(HD!X)),0) 120 || X:= TL!X 121 || WRCH(';') $) OR 122 ||PRINT "SUCH THAT" AS BAR IFF A GENERATOR DIRECTLY FOLLOWS 123 TEST ISCONS(HD!X) & HD!(HD!X)=GENERATOR THEN WRCH('|') OR WRCH(';') 124 UNTIL TL!X=NIL 125 DO $( LET QUALIFIER=HD!X 126 TEST ISCONS(QUALIFIER) & HD!QUALIFIER=GENERATOR 127 THEN $( PRINTEXP(HD!(TL!QUALIFIER),0) 128 WHILE ISCONS(TL!X) & ||DEALS WITH REPEATED GENERATORS 129 HD!(HD!(TL!X))=GENERATOR & 130 EQUAL(TL!(TL!(HD!(TL!X))),TL!(TL!QUALIFIER)) 131 DO $( X:= TL!X 132 QUALIFIER:= HD!X 133 WRCH(',') 134 PRINTEXP(HD!(TL!QUALIFIER),0) $) 135 WRITES("<-") 136 PRINTEXP(TL!(TL!QUALIFIER),0) $) 137 OR PRINTEXP(QUALIFIER,0) 138 X:=TL!X 139 UNLESS TL!X=NIL DO WRCH(';') $) 140 $) 141 142 AND ISLISTEXP(E) = VALOF 143 $( WHILE ISCONS(E) & HD!E=COLON.OP 144 DO $( LET E1=TL!(TL!E) 145 WHILE ISCONS(E1) & HD!E1=INDIR 146 DO E1:=TL!E1 147 TL!(TL!E):=E1 148 E:=E1 $) 149 RESULTIS E=NIL $) 150 151 AND ISRELATION(X) = ISCONS(X) & ISRELOP(HD!X) -> TRUE, FALSE 152 153 AND ISRELATION.BEGINNING(A,X) = 154 ISRELATION(X) & EQUAL(HD!(TL!X),A) | 155 ISCONS(X) & HD!X=AND.OP & 156 ISRELATION.BEGINNING(A,HD!(TL!X)) -> TRUE, FALSE 157 158 AND LEFTPREC(OP) = 159 OP=COLON.OP|OP=APPEND.OP|OP=LISTDIFF.OP|OP=AND.OP|OP=OR.OP|OP=EXP.OP|ISRELOP(OP) -> 160 INFIXPRIOVEC!OP + 1, INFIXPRIOVEC!OP 161 162 || RELOPS ARE NON-ASSOCIATIVE 163 || COLON, APPEND, AND, OR ARE RIGHT-ASSOCIATIVE 164 || ALL OTHER INFIXES ARE LEFT-ASSOCIATIVE 165 166 AND RIGHTPREC(OP) = 167 OP =COLON.OP | OP=APPEND.OP | OP=LISTDIFF.OP | OP=AND.OP | OP=OR.OP | OP=EXP.OP -> 168 INFIXPRIOVEC!OP, INFIXPRIOVEC!OP +1 169 170 AND ROTATE(E) ||PUTS NESTED AND'S INTO RIGHTIST FORM TO ENSURE 171 = VALOF ||DETECTION OF CONTINUED RELATIONS 172 $( WHILE ISCONS(HD!(TL!E)) & HD!(HD!(TL!E))=AND.OP 173 DO $( LET X,C = TL!(HD!(TL!E)),TL!(TL!E) 174 LET A,B = HD!X,TL!X 175 HD!(TL!E),TL!(TL!E) := A,CONS(AND.OP,CONS(B,C)) $) 176 RESULTIS TRUE $) 177 178 ||DECOMPILER 179 180 LET DISPLAY(ID,WITHNOS,DOUBLESPACING) || THE VAL FIELD OF EACH USER DEFINED NAME 181 || CONTAINS - CONS(CONS(NARGS,COMMENT),<LIST OF EQNS>) 182 BE $( IF VAL!ID=NIL 183 DO $( WRITEF("*"%S*" - not defined*N",PRINTNAME(ID)) 184 RETURN $) 185 $( LET X,EQNS = HD!(VAL!ID),TL!(VAL!ID) 186 LET NARGS,COMMENT = HD!X,TL!X 187 LET N = LENGTH(EQNS) 188 LASTLHS:=NIL 189 UNLESS COMMENT=NIL 190 DO $( LET C=COMMENT 191 WRITEF(" %S :-",PRINTNAME(ID)) 192 UNTIL C=NIL 193 DO $( WRITES(PRINTNAME(HD!C)) 194 C:= TL!C 195 UNLESS C=NIL 196 DO $( NEWLINE() 197 IF DOUBLESPACING DO NEWLINE() $) 198 $) 199 WRITES(";*N") 200 IF DOUBLESPACING DO NEWLINE() $) 201 IF COMMENT\=NIL & N=1 & HD!(TL!(HD!EQNS))=CALL.C RETURN 202 FOR I=1 TO N 203 DO $( TEST WITHNOS & (N>1 | COMMENT\=NIL) 204 THEN WRITEF("%I2) ",I) 205 OR WRITES(" ") 206 REMOVELINENO(HD!EQNS) 207 DISPLAYEQN(ID,NARGS,HD!EQNS) 208 IF DOUBLESPACING DO NEWLINE() 209 EQNS:=TL!EQNS $) 210 $) $) 211 212 AND DISPLAYEQN(ID,NARGS,EQN) ||EQUATION DECODER 213 BE $( LET LHS,CODE = HD!EQN,TL!EQN 214 TEST NARGS=0 215 THEN $( WRITES(PRINTNAME(ID)) ; LASTLHS:=ID $) 216 OR $( TEST EQUAL(LHS,LASTLHS) 217 THEN WRCH:=SHCH 218 OR LASTLHS:=LHS 219 PRINTEXP(LHS,0) 220 WRCH:=TRUEWRCH $) 221 WRITES(" = ") 222 TEST HD!CODE=CALL.C THEN WRITES("<primitive function>") 223 OR DISPLAYRHS(LHS,NARGS,CODE) 224 NEWLINE() 225 $) 226 227 AND SHCH(CH) 228 BE TRUEWRCH(' ') 229 230 ||AND DECODE.EXP(CODE) 231 ||BE DISPLAYRHS(NIL,0,CODE) 232 233 AND DISPLAYRHS(LHS,NARGS,CODE) 234 BE $( LET V = VEC 100 235 LET I,IF.FLAG = NARGS,FALSE 236 WHILE I>0 ||UNPACK FORMAL PARAMETERS INTO V 237 DO $( I:= I-1 238 V!I:= TL!LHS 239 LHS:= HD!LHS $) 240 I:= NARGS-1 241 $( SWITCHON HD!CODE INTO 242 $( CASE LOAD.C: CODE:=TL!CODE 243 I:=I+1 244 V!I:=HD!CODE 245 ENDCASE 246 CASE LOADARG.C: CODE:=TL!CODE 247 I:=I+1 248 V!I:=V!(HD!CODE) 249 ENDCASE 250 CASE APPLY.C: I:=I-1 251 V!I:=CONS(V!I,V!(I+1)) 252 ENDCASE 253 CASE APPLYINFIX.C: CODE:=TL!CODE 254 I:=I-1 255 V!I:=CONS(HD!CODE,CONS(V!I,V!(I+1))) 256 ENDCASE 257 CASE CONTINUE.INFIX.C: CODE:=TL!CODE 258 V!(I-1):=CONS(HD!CODE, 259 CONS(V!(I-1),V!I)) 260 ||NOTE THAT 2ND ARG IS LEFT IN PLACE ABOVE 261 ||NEW EXPRESSION 262 ENDCASE 263 CASE IF.C: IF.FLAG:=TRUE 264 ENDCASE 265 CASE FORMLIST.C: CODE:=TL!CODE 266 I:=I+1 267 V!I:=NIL 268 FOR J=1 TO HD!CODE 269 DO $( I:=I-1 270 V!I:=CONS(COLON.OP,CONS(V!I,V!(I+1))) 271 $) 272 ENDCASE 273 CASE FORMZF.C: CODE:=TL!CODE 274 I:=I-HD!CODE 275 V!I:=CONS(V!I,NIL) 276 FOR J = HD!CODE TO 1 BY -1 277 DO V!I:= CONS(V!(I+J),V!I) 278 V!I:= CONS(ZF.OP,V!I) 279 ENDCASE 280 CASE CONT.GENERATOR.C: 281 CODE:= TL!CODE 282 FOR J = 1 TO HD!CODE 283 DO V!(I-J):= CONS(GENERATOR,CONS(V!(I-J), 284 TL!(TL!(V!I)))) 285 ENDCASE 286 CASE MATCH.C: 287 CASE MATCHARG.C: 288 CODE:=TL!CODE 289 CODE:=TL!CODE 290 ENDCASE 291 CASE MATCHPAIR.C: CODE:=TL!CODE 292 $( LET X = V!(HD!CODE) 293 I:=I+2 294 V!(I-1),V!I := HD!(TL!X),TL!(TL!X) $) 295 ENDCASE 296 CASE STOP.C: PRINTEXP(V!I,0) 297 UNLESS IF.FLAG RETURN 298 WRITES(", ") 299 PRINTEXP(V!(I-1),0) 300 RETURN 301 DEFAULT: WRITES("IMPOSSIBLE INSTRUCTION IN *"DISPLAYRHS*"*N") 302 $) ||END OF SWITCH 303 CODE:=TL!CODE 304 $) REPEAT 305 $) 306 307 AND PROFILE(EQN) = VALOF ||EXTRACTS THAT PART OF THE CODE WHICH 308 ||DETERMINES WHICH CASES THIS EQUATION APPLIES TO 309 $( LET CODE=TL!EQN 310 IF HD!CODE=LINENO.C 311 DO CODE:=TL!(TL!CODE) 312 $( LET C=CODE 313 WHILE PARMY(HD!C) DO C:=REST(C) 314 $( LET HOLD=C 315 UNTIL HD!C=IF.C|HD!C=STOP.C DO C:=REST(C) 316 TEST HD!C=IF.C 317 THEN RESULTIS SUBTRACT(CODE,C) 318 OR RESULTIS SUBTRACT(CODE,HOLD) 319 $) $) $) 320 321 AND PARMY(X) = 322 X=MATCH.C|X=MATCHARG.C|X=MATCHPAIR.C -> TRUE, FALSE 323 324 AND REST(C) = VALOF ||REMOVES ONE COMPLETE INSTRUCTION FROM C 325 $( LET X=HD!C 326 C:=TL!C 327 IF X=APPLY.C|X=IF.C|X=STOP.C RESULTIS C 328 C:=TL!C 329 UNLESS X=MATCH.C|X=MATCHARG.C RESULTIS C 330 RESULTIS TL!C $) 331 332 AND SUBTRACT(X,Y) = VALOF ||LIST SUBTRACTION 333 $( LET Z=NIL 334 UNTIL X=Y 335 DO Z,X:= CONS(HD!X,Z),TL!X 336 RESULTIS Z ||NOTE THE RESULT IS REVERSED - FOR OUR PURPOSES THIS 337 $) ||DOES NOT MATTER 338 339 AND REMOVELINENO(EQN) ||CALLED WHENEVER THE DEFINIENDUM IS SUBJECT OF A 340 ||DISPLAY,REORDER OR (PARTIAL)DELETE COMMAND - HAS THE EFFECT OF 341 ||RESTORING THE STANDARD LINE NUMBERING 342 BE IF HD!(TL!EQN)=LINENO.C 343 DO TL!EQN:=TL!(TL!(TL!EQN)) 344 345 ||COMPILER FOR KRC EXPRESSIONS AND EQUATIONS 346 347 LET EXP()=VALOF 348 $( ENVP,CODEP:=-1,-1 349 EXPR(0) 350 PLANT(STOP.C) 351 RESULTIS COLLECTCODE() 352 $) 353 354 AND EQUATION() = VALOF ||RETURNS A TRIPLE: CONS(SUBJECT,CONS(NARGS,EQN)) 355 $( LET SUBJECT,LHS,NARGS = 0,0,0 356 ENVP,CODEP:=-1,-1 357 TEST HAVEID() 358 THEN $( SUBJECT,LHS:=THE.ID,THE.ID 359 WHILE STARTSIMPLE(HD!TOKENS) 360 DO $( LHS:=CONS(LHS,FORMAL()) 361 NARGS:=NARGS+1 $) 362 $) OR 363 TEST HD!TOKENS='=' & LASTLHS\=NIL 364 THEN $( SUBJECT,LHS:=LASTLHS,LASTLHS 365 WHILE ISCONS(SUBJECT) 366 DO SUBJECT,NARGS:=HD!SUBJECT,NARGS+1 367 $) 368 OR $( SYNTAX() 369 RESULTIS NIL $) 370 COMPILELHS(LHS,NARGS) 371 $( LET CODE=COLLECTCODE() 372 CHECK('=') 373 EXPR(0) 374 PLANT(STOP.C) 375 $( LET EXPCODE=COLLECTCODE() 376 TEST NARGS>0 & HAVE(',') 377 THEN $( EXPR(0) 378 PLANT(IF.C) 379 CODE:=APPEND(CODE,APPEND(COLLECTCODE(),EXPCODE)) $) 380 OR CODE:=APPEND(CODE,EXPCODE) 381 CHECK(EOL) 382 UNLESS ERRORFLAG DO LASTLHS:=LHS 383 IF NARGS=0 DO LHS:=0 ||IN THIS CASE THE LHS FIELD IS USED TO REMEMBER 384 ||THE VALUE OF THE VARIABLE - 0 MEANS NOT YET SET 385 RESULTIS CONS(SUBJECT,CONS(NARGS,CONS(LHS,CODE))) 386 $) $) $) 387 388 AND EXPR(N) ||N IS THE PRIORITY LEVEL 389 BE $( TEST HAVE('\') 390 THEN $( PLANT(LOAD.C,NOT.OP) 391 EXPR(3) 392 PLANT(APPLY.C) $) OR 393 TEST HAVE('+') THEN EXPR(5) OR 394 TEST HAVE('-') 395 THEN $( PLANT(LOAD.C,NEG.OP) 396 EXPR(5) 397 PLANT(APPLY.C) $) OR 398 TEST HAVE('#') 399 THEN $( PLANT(LOAD.C,LENGTH.OP) 400 EXPR(6) 401 PLANT(APPLY.C) $) 402 OR $( SIMPLE() 403 WHILE STARTSIMPLE(HD!TOKENS) 404 DO $( SIMPLE() 405 PLANT(APPLY.C) $) $) 406 $( LET OP=MKINFIX(HD!TOKENS) 407 WHILE DIPRIO(OP)>=N 408 DO $( LET AND.COUNT=0 ||FOR CONTINUED RELATIONS 409 TOKENS:=TL!TOKENS 410 EXPR(RIGHTPREC(OP)) 411 WHILE ISRELOP(OP) & ISRELOP(MKINFIX(HD!TOKENS)) 412 DO $( ||CONTINUED RELATIONS 413 AND.COUNT:=AND.COUNT+1 414 PLANT(CONTINUE.INFIX.C,OP) 415 OP:=MKINFIX(HD!TOKENS) 416 TOKENS:=TL!TOKENS 417 EXPR(4) $) 418 PLANT(APPLYINFIX.C,OP) 419 FOR I=1 TO AND.COUNT DO PLANT(APPLYINFIX.C,AND.OP) 420 ||FOR CONTINUED RELATIONS 421 OP:=MKINFIX(HD!TOKENS) $) 422 $) $) 423 424 AND STARTSIMPLE(T) = 425 ISCONS(T) -> HD!T=ID | HD!T=CONST, 426 T='(' | T='[' | T='{' | T='*'' 427 428 AND SIMPLE() 429 BE TEST HAVEID() 430 THEN COMPILENAME(THE.ID) OR 431 TEST HAVECONST() 432 THEN PLANT(LOAD.C,INTERNALISE(THE.CONST)) OR 433 TEST HAVE('(') 434 THEN $( EXPR(0); CHECK(')') $) OR 435 TEST HAVE('[') 436 THEN TEST HAVE(']') 437 THEN PLANT(LOAD.C,NIL) 438 OR $( LET N=1 439 EXPR(0) 440 IF HAVE(',') 441 DO $( EXPR(0) 442 N:=N+1 $) 443 TEST HAVE(DOTDOT.SY) 444 THEN $( TEST HD!TOKENS=']' 445 THEN PLANT(LOAD.C,INFINITY) 446 OR EXPR(0) 447 IF N=2 DO PLANT(APPLY.C) 448 PLANT(APPLYINFIX.C,N=1->DOTDOT.OP, COMMADOTDOT.OP) $) 449 OR $( WHILE HAVE(',') 450 DO $( EXPR(0) 451 N:=N+1 $) 452 PLANT(FORMLIST.C,N) $) 453 CHECK(']') $) OR 454 TEST HAVE('{') || ZF EXPRESSIONS 455 THEN $( LET N = 0 456 LET HOLD = TOKENS 457 PERFORM.ALPHA.CONVERSIONS() 458 EXPR(0) 459 TEST HD!TOKENS=BACKARROW.SY ||IMPLICIT ZF BODY 460 ||NO LONGER LEGAL BUT ACCEPTED FOR A TRANSTIONAL PERIOD 461 THEN TOKENS:= HOLD 462 OR CHECK(';') 463 N:= N + QUALIFIER() REPEATWHILE HAVE(';') 464 PLANT(FORMZF.C,N) 465 CHECK('}') $) OR 466 TEST HAVE('*'') ||OPERATOR DENOTATION 467 THEN $( TEST HAVE('\') THEN PLANT(LOAD.C,NOT.OP) OR 468 TEST HAVE('#') THEN PLANT(LOAD.C,LENGTH.OP) 469 OR $( LET OP=MKINFIX(HD!TOKENS) 470 TEST ISINFIX(OP) THEN TOKENS:= TL!TOKENS OR SYNTAX() 471 PLANT(LOAD.C,QUOTE.OP) 472 PLANT(LOAD.C,OP) 473 PLANT(APPLY.C) $) 474 CHECK('*'') $) 475 OR SYNTAX() 476 477 AND COMPILENAME(N) 478 BE $( LET I=0 479 UNTIL I>ENVP | ENV!I=N 480 DO I:=I+1 481 TEST I>ENVP 482 THEN PLANT(LOAD.C,N) 483 OR PLANT(LOADARG.C,I) 484 $) 485 486 AND QUALIFIER() = VALOF 487 TEST ISGENERATOR(TL!TOKENS) ||WHAT ABOUT MORE GENERAL FORMALS? 488 THEN $( LET N=0 489 $( HAVEID() 490 PLANT(LOAD.C,THE.ID) 491 N:= N+1 492 $) REPEATWHILE HAVE(',') 493 CHECK(BACKARROW.SY) 494 EXPR(0) 495 PLANT(APPLYINFIX.C,GENERATOR) 496 IF N>1 DO PLANT(CONT.GENERATOR.C,N-1) 497 RESULTIS N $) 498 OR $( EXPR(0) ; RESULTIS 1 $) 499 500 AND PERFORM.ALPHA.CONVERSIONS() 501 ||ALSO RECOGNISES "SUCH THAT" BAR AND CONVERTS IT TO ';' 502 ||TO DISTINGUISH IT FROM "OR" 503 BE $( LET P=TOKENS 504 UNTIL HD!P='}' | HD!P=']' | HD!P=EOL 505 DO $( IF HD!P='[' | HD!P='{' 506 DO $( P:= SKIPCHUNK(P) 507 LOOP $) 508 IF HD!P='|' & ISID(HD!(TL!P)) & ISGENERATOR(TL!(TL!P)) 509 DO HD!P:= ';' 510 IF ISID(HD!P) & ISGENERATOR(TL!P) 511 DO ALPHA.CONVERT(HD!P,TL!P) 512 P:=TL!P $) $) 513 514 AND ISID(X) = ISCONS(X) & HD!X=ID -> TRUE, FALSE 515 516 AND ISGENERATOR(T) = 517 \ISCONS(T) -> FALSE, 518 HD!T=BACKARROW.SY | 519 HD!T=',' & ISID(HD!(TL!T)) & ISGENERATOR(TL!(TL!T)) -> TRUE, FALSE 520 521 AND ALPHA.CONVERT(VAR,P) 522 BE $( LET T=TOKENS 523 LET VAR1=CONS(ALPHA,TL!VAR) 524 LET EDGE=T 525 UNTIL HD!EDGE=';' | HD!EDGE=BACKARROW.SY | HD!EDGE=EOL 526 DO EDGE:= SKIPCHUNK(EDGE) 527 UNTIL T=EDGE 528 DO $( CONV1(T,VAR,VAR1) 529 T:=TL!T $) 530 T:= P 531 UNTIL HD!T=';' | HD!T=EOL DO T:= SKIPCHUNK(T) 532 EDGE:= T 533 UNTIL HD!EDGE='}' | HD!EDGE=']' | HD!EDGE=EOL 534 DO EDGE:= SKIPCHUNK(EDGE) 535 UNTIL T=EDGE 536 DO $( CONV1(T,VAR,VAR1) 537 T:= TL!T $) 538 TL!VAR:= VAR1 539 $) 540 541 AND SKIPCHUNK(P) = VALOF 542 $( LET KET = HD!P='{' -> '}', HD!P='[' -> ']', -1 543 P:= TL!P 544 IF KET=-1 RESULTIS P 545 UNTIL HD!P=KET | HD!P=EOL 546 DO P:= SKIPCHUNK(P) 547 UNLESS HD!P=EOL DO P:= TL!P 548 RESULTIS(P) 549 $) 550 551 AND CONV1(T,VAR,VAR1) 552 BE IF EQUAL(HD!T,VAR) & HD!T\=VAR DO TL!(HD!T):= VAR1 553 554 AND FORMAL() = VALOF 555 TEST HAVEID() THEN RESULTIS THE.ID OR 556 TEST HAVECONST() THEN RESULTIS INTERNALISE(THE.CONST) OR 557 TEST HAVE('(') 558 THEN $( LET P=PATTERN() 559 CHECK(')') 560 RESULTIS P $) OR 561 TEST HAVE('[') 562 THEN $( LET PLIST,P=NIL,NIL 563 IF HAVE(']') RESULTIS NIL 564 PLIST:=CONS(PATTERN(),PLIST) 565 REPEATWHILE HAVE(',') ||NOTE THEY ARE IN REVERSE ORDER 566 CHECK(']') 567 UNTIL PLIST=NIL 568 DO $( P:=CONS(COLON.OP,CONS(HD!PLIST,P)) 569 PLIST:=TL!PLIST $) ||NOW THEY ARE IN CORRECT ORDER 570 RESULTIS P $) OR 571 TEST HAVE('-') & HAVENUM() 572 THEN $( THE.NUM:= -GETNUM(THE.NUM) 573 RESULTIS STONUM(THE.NUM) $) 574 OR $( SYNTAX() 575 RESULTIS NIL $) 576 577 AND INTERNALISE(VAL) = 578 VAL=TL!TRUTH->TRUTH, 579 VAL=TL!FALSITY->FALSITY, 580 ISATOM(VAL) -> CONS(QUOTE,VAL), VAL 581 582 AND PATTERN() = VALOF 583 $( LET P=FORMAL() 584 IF HAVE(':') 585 DO P:=CONS(COLON.OP,CONS(P,PATTERN())) 586 RESULTIS P $) 587 588 AND COMPILELHS(LHS,NARGS) 589 BE $( ENVP:=NARGS-1 590 FOR I=1 TO NARGS 591 DO $( ENV!(NARGS-I):=TL!LHS 592 LHS:=HD!LHS $) 593 FOR I=0 TO NARGS-1 DO COMPILEFORMAL(ENV!I,I) 594 $) 595 596 AND COMPILEFORMAL(X,I) 597 BE TEST ISATOM(X) ||IDENTIFIER 598 THEN $( LET J=0 599 UNTIL J>=I | ENV!J=X 600 DO J:=J+1 || IS THIS A REPEATED NAME? 601 TEST J>=I 602 THEN RETURN || NO, NO CODE COMPILED 603 OR PLANT(MATCHARG.C,I,J) $) OR 604 TEST ISNUM(X) | X=NIL | ISCONS(X)&HD!X=QUOTE 605 THEN PLANT(MATCH.C,I,X) OR 606 TEST ISCONS(X) & HD!X=COLON.OP & ISCONS(TL!X) 607 THEN $( PLANT(MATCHPAIR.C,I) 608 ENVP:=ENVP+2 609 $( LET A,B=ENVP-1,ENVP 610 ENV!A,ENV!B:= HD!(TL!X) , TL!(TL!X) 611 COMPILEFORMAL(ENV!A,A) 612 COMPILEFORMAL(ENV!B,B) 613 $) $) 614 OR WRITES("Impossible event in *"COMPILEFORMAL*"*N") 615 616 AND PLANT(OP,A,B) 617 BE $( CODEP:=CODEP+1 618 CODEV!CODEP:=OP 619 IF OP=APPLY.C|OP=IF.C|OP=STOP.C RETURN 620 CODEP:=CODEP+1 621 CODEV!CODEP:=A 622 UNLESS OP=MATCH.C|OP=MATCHARG.C RETURN 623 CODEP:=CODEP+1 624 CODEV!CODEP:=B 625 $) 626 627 AND COLLECTCODE() = VALOF ||FLUSHES THE CODE BUFFER 628 $( LET X=NIL 629 FOR I=CODEP TO 0 BY -1 DO X:=CONS(CODEV!I,X) 630 CODEP:=-1 631 RESULTIS X 632 $) 633 634