;; Loading file /home/pjb/.clisprc.lisp ...
;; Reading ASDF packages from /home/pjb/asdf-central-registry.data...
; loading system definition from /usr/local/share/lisp/packages/net/sourceforge/cclan/asdf-install/asdf-install.asd into #<PACKAGE ASDF0>
; registering #<SYSTEM ASDF-INSTALL #x2048F146> as ASDF-INSTALL
0 errors, 0 warnings
[1]> (setf *print-circle* nil)
NIL

;;; First we load the parser generator.

[2]> (load"rdp.lisp")
;; Loading file rdp.lisp ...
;; Loaded file rdp.lisp
T

;;; Second we load the pseudo basic generator.

[5]>  (load"rdp-basic-gen.lisp")
;; Loading file rdp-basic-gen.lisp ...
WARNING: The generic function #<STANDARD-GENERIC-FUNCTION GEN-BOILERPLATE> is
         being modified, but has already been called.
;; Loaded file rdp-basic-gen.lisp
T

;;; Next, we load the grammar definition.
;;; This will generate the scanner and parser for that language.
;;; We could write: (with-open-file (*standard-output* "parser.bas"
;;;                                  :direction :output :if-exists :supersede
;;;                                  :if-does-not-exist :create)
;;;                      (load "example-basic.lisp"))
;;; to save the basic program into the file "parser.bas".


[6]> (load"example-basic.lisp")
;; Loading file example-basic.lisp ...
  10 SCANSRC$="" : SCANFUN$="" : SCANPOS=0
  20 CURTOK$=""  : CURTXT$=""  : CURPOS=0
  30 SPACES$=
  40 DEF SCANEOF : IF LEN(SCANSRC$)<=SCANPOS THEN RETURN 1 ELSE RETURN 0 : ENDFUN
  50 SUB ACCEPT
  60   IF TOKEN$ <> CURTOK$ THEN
  70      PRINT "ERROR: AT POSITION",CURPOS,"EXPECTED ",TOKEN$," NOT ",CURTOK$
  80      STOP
  90   ELSE
 100      ACCEPTOK$=CURTOK$:ACCEPTXT$=CURTXT$:ACCEPPOS$=CURPOS$
 110      CALL SCANFUN$
 120   ENDIF
 130 ENDSUB
 140 MAXCONS=100000
 150 NIL=0:CONS=1:STRING=2:NUMBER=3
 160 TYPELABEL$[NIL]="NIL"
 170 TYPELABEL$[CONS]="CONS"
 180 TYPELABEL$[STRING]="STRING"
 190 TYPELABEL$[NUMBER]="NUMBER"
 200 DIM TYPES[MAXCONS],CAR[MAXCONS],CDR[MAXCONS],STRINGS$[MAXCONS],NUMBERS[MAXCONS]
 210 TYPES[NIL]=NIL:CAR[NIL]=NIL:CDR[NIL]=NIL:STRINGS$[NIL]="NIL":NUMBERS[NIL]=0
 220 FREE=MAXCONS
 230 SUB CONS
 240   IF FREE<=1 THEN PRINT "ERROR: OUT OF CONS SPACE" : STOP : ENDIF
 250   FREE=FREE-1
 260   TYPES[FREE]=CONS
 270   CAR[FREE]=NCAR
 280   CDR[FREE]=NCDR
 290   RES=FREE
 300 ENDSUB
 310 SUB MKSTR
 320   IF FREE<=1 THEN PRINT "ERROR: OUT OF CONS SPACE" : STOP : ENDIF
 330   FREE=FREE-1
 340   TYPES[FREE]=STRING
 350   STRING$[FREE]=NSTRING$
 360   RES=FREE
 370 ENDSUB
 380 SUB MKNUM
 390   IF FREE<=1 THEN PRINT "ERROR: OUT OF CONS SPACE" : STOP : ENDIF
 400   FREE=FREE-1
 410   TYPES[FREE]=NUMBER
 420   NUMBER[FREE]=NNUMBER
 430   RES=FREE
 440 ENDSUB
 450 SUB REVERSE
 460   REV=0:TREV=NIL
 470   WHILE LIST<>0
 480    IF TYPES[LIST]<>CONS THEN
 490       PRINT "ERROR: REVERSE EXPECTS A LIST, NOT A ",TYPELABEL$[TYPES[LIST]]
 500       STOP
 510     ELSE
 520       NEW=CDR[LIST]
 530       CDR[LIST]=REV:TYPES[LIST]=TREV
 540       REV=LIST:TREV=CONS
 550       LIST=NEW
 560     ENDIF
 570   ENDWHILE
 580   RES=REV
 590 ENDSUB
 600 SUB SCANEXAMPLE
 610   WHILE POS(SCANSRC$[SCANPOS],SPACES$)>0 : SCANPOS=SCANPOS+1 : ENDWHILE
 620   CURPOS=SCANPOS
 630   IF SCANEOF<>0 THEN
 640     SCANPOS=LEN(SCANSRC$)
 650     SCANTXT$="<END OF SOURCE>"
 660     SCANTOK$=""
 670   ELSE
 680     REM ASSUMING THERE IS SOME WAY TO MATCH REGEXPS IN BASIC...
 690     MATCHREGEXP  "^\(procedure\>\|begin\>\|while\>\|const\>\|call\>\|then\>\|odd\>\|end\>\|var\>\|<=\|>=\|:=\|if\>\|do\>\|(\|)\|\*\|/\|+\|-\|#\|<\|>\|=\|,\|;\|\.\)" SCANSRC$,SCANPOS INTO START,END
 700     IF START>0 THEN
 710       SCANPOS=END
 720       SCANTXT$=MID$(SCANSRC$,START,END)
 730       SCANTOK$=SCANTXT$
 740     ELSE
 750  MATCHREGEXP "^\\([A-Za-z][A-Za-z0-9]*\\)" SCANSRC$,SCANPOS INTO START,END
 760  IF START>0 THEN
 770       SCANPOS=END
 780       SCANTXT$=MID$(SCANSRC$,START,END)
 790       SCANTOK$="IDENT"
 800  ELSE
 810  MATCHREGEXP "^\\(^\([-+]\?[0-9]\+\.[0-9]\+\([Ee][-+]\?[0-9]\+\)\?\)\\)" SCANSRC$,SCANPOS INTO START,END
 820  IF START>0 THEN
 830       SCANPOS=END
 840       SCANTXT$=MID$(SCANSRC$,START,END)
 850       SCANTOK$="REAL"
 860  ELSE
 870  MATCHREGEXP "^\\([-+]\?[0-9]\+\\)" SCANSRC$,SCANPOS INTO START,END
 880  IF START>0 THEN
 890       SCANPOS=END
 900       SCANTXT$=MID$(SCANSRC$,START,END)
 910       SCANTOK$="INTEGER"
 920  ELSE
 930      PRINT "ERROR: AT POSITION",CURPOS,"EXPECTED ",TOKEN$," NOT ",CURTOK$
 940      STOP
 950  ENDIF
 960  ENDIF
 970  ENDIF
 980     ENDIF
 990   ENDIF
1000 ENDSUB
1010 SUB PARSEPROGRAM
1020 IF (CURTOK$="IDENT" OR CURTOK$="call" OR CURTOK$="begin" OR CURTOK$="if" OR CURTOK$="while" OR CURTOK$="procedure" OR CURTOK$="var" OR CURTOK$="const") THEN
1030   CALL PARSEBLOCK
1040 ELSE
1050   RET=NIL
1060 ENDIF
1070 L1A1=RES
1080 TOKEN$="." : CALL ACCEPT
1090 L1A2=RES
1100 A2=L1A2:NCAR=A2:NCDR=NIL:CALL CONS:A0=RES
1110 A1=L1A1:NCAR=A1:NCDR=A0:CALL CONS:A0=RES
1120 RES=A1
1130 ENDSUB
1140 SUB PARSEFACTOR
1150 IF (CURTOK$="IDENT") THEN
1160 TOKEN$="IDENT" : CALL ACCEPT
1170 ELSE
1180 IF (CURTOK$="INTEGER" OR CURTOK$="REAL") THEN
1190 IF (CURTOK$="INTEGER" OR CURTOK$="REAL") THEN
1200   CALL PARSENUMBER
1210 ELSE
1220   PRINT "ERROR: UNEXPECTED TOKEN ",SCANTOK$
1230   STOP
1240 ENDIF
1250 ELSE
1260 IF (CURTOK$="(") THEN
1270 TOKEN$="(" : CALL ACCEPT
1280 L3A1=RES
1290 IF (CURTOK$="IDENT" OR CURTOK$="INTEGER" OR CURTOK$="REAL" OR CURTOK$="(" OR CURTOK$="+" OR CURTOK$="-") THEN
1300   CALL PARSEEXPRESSION
1310 ELSE
1320   PRINT "ERROR: UNEXPECTED TOKEN ",SCANTOK$
1330   STOP
1340 ENDIF
1350 L3A2=RES
1360 TOKEN$=")" : CALL ACCEPT
1370 L3A3=RES
1380 A3=L3A3:NCAR=A3:NCDR=NIL:CALL CONS:A0=RES
1390 A2=L3A2:NCAR=A2:NCDR=A0:CALL CONS:A0=RES
1400 A1=L3A1:NCAR=A1:NCDR=A0:CALL CONS:A0=RES
1410 RES=A2
1420 ELSE
1430 PRINT "ERROR: DID NOT EXPECT ",CURTOK$
1440 STOP
1450 ENDIF
1460 ENDIF
1470 ENDIF
1480 L2A1=RES
1490 A1=L2A1:NCAR=A1:NCDR=NIL:CALL CONS:A0=RES
1500 RES=A1
1510 ENDSUB
1520 SUB PARSETERM
1530 IF (CURTOK$="IDENT" OR CURTOK$="INTEGER" OR CURTOK$="REAL" OR CURTOK$="(") THEN
1540   CALL PARSEFACTOR
1550 ELSE
1560   PRINT "ERROR: UNEXPECTED TOKEN ",SCANTOK$
1570   STOP
1580 ENDIF
1590 L4A1=RES
1600 L5RES=NIL
1610 WHILE (CURTOK$="*" OR CURTOK$="/")
1620 IF (CURTOK$="*") THEN
1630 TOKEN$="*" : CALL ACCEPT
1640 ELSE
1650 IF (CURTOK$="/") THEN
1660 TOKEN$="/" : CALL ACCEPT
1670 ELSE
1680 PRINT "ERROR: DID NOT EXPECT ",CURTOK$
1690 STOP
1700 ENDIF
1710 ENDIF
1720 L6A1=RES
1730 IF (CURTOK$="IDENT" OR CURTOK$="INTEGER" OR CURTOK$="REAL" OR CURTOK$="(") THEN
1740   CALL PARSEFACTOR
1750 ELSE
1760   PRINT "ERROR: UNEXPECTED TOKEN ",SCANTOK$
1770   STOP
1780 ENDIF
1790 L6A2=RES
1800 A2=L6A2:NCAR=A2:NCDR=NIL:CALL CONS:A0=RES
1810 A1=L6A1:NCAR=A1:NCDR=A0:CALL CONS:A0=RES
1820 $0
1830 NCAR=RET:NCDR=L5RES:CALL CONS:L5RES=RES
1840 ENDWHILE
1850 LIST=L5RES:CALL REVERSE
1860 L4A2=RES
1870 A2=L4A2:NCAR=A2:NCDR=NIL:CALL CONS:A0=RES
1880 A1=L4A1:NCAR=A1:NCDR=A0:CALL CONS:A0=RES
1890 NCAR=A1:NCDR=A2:CALL CONS
1900 ENDSUB
1910 SUB PARSEEXPRESSION
1920 L8RES=NIL
1930 IF (CURTOK$="+" OR CURTOK$="-") THEN
1940 IF (CURTOK$="+") THEN
1950 TOKEN$="+" : CALL ACCEPT
1960 ELSE
1970 IF (CURTOK$="-") THEN
1980 TOKEN$="-" : CALL ACCEPT
1990 ELSE
2000 PRINT "ERROR: DID NOT EXPECT ",CURTOK$
2010 STOP
2020 ENDIF
2030 ENDIF
2040 ELSE
2050   RES=NIL
2060 ENDIF
2070 L7A1=RES
2080 IF (CURTOK$="IDENT" OR CURTOK$="INTEGER" OR CURTOK$="REAL" OR CURTOK$="(") THEN
2090   CALL PARSETERM
2100 ELSE
2110   PRINT "ERROR: UNEXPECTED TOKEN ",SCANTOK$
2120   STOP
2130 ENDIF
2140 L7A2=RES
2150 L9RES=NIL
2160 WHILE (CURTOK$="+" OR CURTOK$="-")
2170 IF (CURTOK$="+") THEN
2180 TOKEN$="+" : CALL ACCEPT
2190 ELSE
2200 IF (CURTOK$="-") THEN
2210 TOKEN$="-" : CALL ACCEPT
2220 ELSE
2230 PRINT "ERROR: DID NOT EXPECT ",CURTOK$
2240 STOP
2250 ENDIF
2260 ENDIF
2270 L10A1=RES
2280 IF (CURTOK$="IDENT" OR CURTOK$="INTEGER" OR CURTOK$="REAL" OR CURTOK$="(") THEN
2290   CALL PARSETERM
2300 ELSE
2310   PRINT "ERROR: UNEXPECTED TOKEN ",SCANTOK$
2320   STOP
2330 ENDIF
2340 L10A2=RES
2350 A2=L10A2:NCAR=A2:NCDR=NIL:CALL CONS:A0=RES
2360 A1=L10A1:NCAR=A1:NCDR=A0:CALL CONS:A0=RES
2370 NCAR=A2:NCDR=NIL:CALL CONS
2380 NCAR=A1:NCDR=RES:CALL CONS
2390 NCAR=RET:NCDR=L9RES:CALL CONS:L9RES=RES
2400 ENDWHILE
2410 LIST=L9RES:CALL REVERSE
2420 L7A3=RES
2430 A3=L7A3:NCAR=A3:NCDR=NIL:CALL CONS:A0=RES
2440 A2=L7A2:NCAR=A2:NCDR=A0:CALL CONS:A0=RES
2450 A1=L7A1:NCAR=A1:NCDR=A0:CALL CONS:A0=RES
2460 IF A1<>0 THEN
2470   NCAR=A2:NCDR=NIL:CALL CONS
2480   NCAR=A1:NCDR=RES:CALL CONS
2490   NCAR=RES
2500 ELSE
2510   NCAR=A2
2520 ENDIF
2530 NCDR=A3:CALL CONS
2540 TMP=RES
2550 NSTRING$="+":CALL MKSTR:NCAR=RES:NCDR=TMP:CALL CONS
2560 ENDSUB
2570 SUB PARSECONDITION
2580 IF (CURTOK$="odd") THEN
2590 TOKEN$="odd" : CALL ACCEPT
2600 L12A1=RES
2610 IF (CURTOK$="IDENT" OR CURTOK$="INTEGER" OR CURTOK$="REAL" OR CURTOK$="(" OR CURTOK$="+" OR CURTOK$="-") THEN
2620   CALL PARSEEXPRESSION
2630 ELSE
2640   PRINT "ERROR: UNEXPECTED TOKEN ",SCANTOK$
2650   STOP
2660 ENDIF
2670 L12A2=RES
2680 A2=L12A2:NCAR=A2:NCDR=NIL:CALL CONS:A0=RES
2690 A1=L12A1:NCAR=A1:NCDR=A0:CALL CONS:A0=RES
2700 NCAR=A2:NCDR=NIL:CALL CONS:TMP=RES
2710 NSTRING$="ODD":CALL MKSTR
2720 NCAR=RES:NCDR=TMP:CALL CONS
2730 ELSE
2740 IF (CURTOK$="IDENT" OR CURTOK$="INTEGER" OR CURTOK$="REAL" OR CURTOK$="(" OR CURTOK$="+" OR CURTOK$="-") THEN
2750 IF (CURTOK$="IDENT" OR CURTOK$="INTEGER" OR CURTOK$="REAL" OR CURTOK$="(" OR CURTOK$="+" OR CURTOK$="-") THEN
2760   CALL PARSEEXPRESSION
2770 ELSE
2780   PRINT "ERROR: UNEXPECTED TOKEN ",SCANTOK$
2790   STOP
2800 ENDIF
2810 L13A1=RES
2820 IF (CURTOK$="=") THEN
2830 TOKEN$="=" : CALL ACCEPT
2840 ELSE
2850 IF (CURTOK$="#") THEN
2860 TOKEN$="#" : CALL ACCEPT
2870 ELSE
2880 IF (CURTOK$="<") THEN
2890 TOKEN$="<" : CALL ACCEPT
2900 ELSE
2910 IF (CURTOK$="<=") THEN
2920 TOKEN$="<=" : CALL ACCEPT
2930 ELSE
2940 IF (CURTOK$=">") THEN
2950 TOKEN$=">" : CALL ACCEPT
2960 ELSE
2970 IF (CURTOK$=">=") THEN
2980 TOKEN$=">=" : CALL ACCEPT
2990 ELSE
3000 PRINT "ERROR: DID NOT EXPECT ",CURTOK$
3010 STOP
3020 ENDIF
3030 ENDIF
3040 ENDIF
3050 ENDIF
3060 ENDIF
3070 ENDIF
3080 L13A2=RES
3090 IF (CURTOK$="IDENT" OR CURTOK$="INTEGER" OR CURTOK$="REAL" OR CURTOK$="(" OR CURTOK$="+" OR CURTOK$="-") THEN
3100   CALL PARSEEXPRESSION
3110 ELSE
3120   PRINT "ERROR: UNEXPECTED TOKEN ",SCANTOK$
3130   STOP
3140 ENDIF
3150 L13A3=RES
3160 A3=L13A3:NCAR=A3:NCDR=NIL:CALL CONS:A0=RES
3170 A2=L13A2:NCAR=A2:NCDR=A0:CALL CONS:A0=RES
3180 A1=L13A1:NCAR=A1:NCDR=A0:CALL CONS:A0=RES
3190 NCAR=A3:NCDR=NIL:CALL CONS
3200 NCAR=A1:NCDR=RES:CALL CONS
3210 NCAR=A2:NCDR=RES:CALL CONS
3220 ELSE
3230 PRINT "ERROR: DID NOT EXPECT ",CURTOK$
3240 STOP
3250 ENDIF
3260 ENDIF
3270 L11A1=RES
3280 A1=L11A1:NCAR=A1:NCDR=NIL:CALL CONS:A0=RES
3290 RES=A1
3300 ENDSUB
3310 SUB PARSENUMBER
3320 IF (CURTOK$="INTEGER") THEN
3330 TOKEN$="INTEGER" : CALL ACCEPT
3340 ELSE
3350 IF (CURTOK$="REAL") THEN
3360 TOKEN$="REAL" : CALL ACCEPT
3370 ELSE
3380 PRINT "ERROR: DID NOT EXPECT ",CURTOK$
3390 STOP
3400 ENDIF
3410 ENDIF
3420 L14A1=RES
3430 A1=L14A1:NCAR=A1:NCDR=NIL:CALL CONS:A0=RES
3440 RES=A1
3450 ENDSUB
3460 SUB PARSESTATEMENT
3470 L16RES=NIL
3480 IF (CURTOK$="IDENT" OR CURTOK$="call" OR CURTOK$="begin" OR CURTOK$="if" OR CURTOK$="while") THEN
3490 IF (CURTOK$="IDENT") THEN
3500 TOKEN$="IDENT" : CALL ACCEPT
3510 L17A1=RES
3520 TOKEN$=":=" : CALL ACCEPT
3530 L17A2=RES
3540 IF (CURTOK$="IDENT" OR CURTOK$="INTEGER" OR CURTOK$="REAL" OR CURTOK$="(" OR CURTOK$="+" OR CURTOK$="-") THEN
3550   CALL PARSEEXPRESSION
3560 ELSE
3570   PRINT "ERROR: UNEXPECTED TOKEN ",SCANTOK$
3580   STOP
3590 ENDIF
3600 L17A3=RES
3610 A3=L17A3:NCAR=A3:NCDR=NIL:CALL CONS:A0=RES
3620 A2=L17A2:NCAR=A2:NCDR=A0:CALL CONS:A0=RES
3630 A1=L17A1:NCAR=A1:NCDR=A0:CALL CONS:A0=RES
3640 NCAR=A3:NCDR=NIL:CALL CONS
3650 NCAR=A1:NCDR=RES:CALL CONS
3660 TMP=RES:NSTRING$="LET":CALL MKSTR
3670 NCAR=RES:NCDR=TMP:CALL CONS
3680 ELSE
3690 IF (CURTOK$="call") THEN
3700 TOKEN$="call" : CALL ACCEPT
3710 L18A1=RES
3720 TOKEN$="IDENT" : CALL ACCEPT
3730 L18A2=RES
3740 A2=L18A2:NCAR=A2:NCDR=NIL:CALL CONS:A0=RES
3750 A1=L18A1:NCAR=A1:NCDR=A0:CALL CONS:A0=RES
3760 NCAR=A2:NCDR=NIL:CALL CONS
3770 TMP=RES:NSTRING$="CALL":CALL MKSTR
3780 NCAR=RES:NCDR=TMP:CALL CONS
3790 ELSE
3800 IF (CURTOK$="begin") THEN
3810 TOKEN$="begin" : CALL ACCEPT
3820 L19A1=RES
3830 IF (CURTOK$="IDENT" OR CURTOK$="call" OR CURTOK$="begin" OR CURTOK$="if" OR CURTOK$="while") THEN
3840   CALL PARSESTATEMENT
3850 ELSE
3860   RET=NIL
3870 ENDIF
3880 L19A2=RES
3890 L20RES=NIL
3900 WHILE (CURTOK$=";")
3910 TOKEN$=";" : CALL ACCEPT
3920 L21A1=RES
3930 IF (CURTOK$="IDENT" OR CURTOK$="call" OR CURTOK$="begin" OR CURTOK$="if" OR CURTOK$="while") THEN
3940   CALL PARSESTATEMENT
3950 ELSE
3960   RET=NIL
3970 ENDIF
3980 L21A2=RES
3990 A2=L21A2:NCAR=A2:NCDR=NIL:CALL CONS:A0=RES
4000 A1=L21A1:NCAR=A1:NCDR=A0:CALL CONS:A0=RES
4010 RES=A2
4020 NCAR=RET:NCDR=L20RES:CALL CONS:L20RES=RES
4030 ENDWHILE
4040 LIST=L20RES:CALL REVERSE
4050 L19A3=RES
4060 TOKEN$="end" : CALL ACCEPT
4070 L19A4=RES
4080 A4=L19A4:NCAR=A4:NCDR=NIL:CALL CONS:A0=RES
4090 A3=L19A3:NCAR=A3:NCDR=A0:CALL CONS:A0=RES
4100 A2=L19A2:NCAR=A2:NCDR=A0:CALL CONS:A0=RES
4110 A1=L19A1:NCAR=A1:NCDR=A0:CALL CONS:A0=RES
4120 NCAR=A2:NCDR=A3:CALL CONS
4130 ELSE
4140 IF (CURTOK$="if") THEN
4150 TOKEN$="if" : CALL ACCEPT
4160 L22A1=RES
4170 IF (CURTOK$="odd" OR CURTOK$="IDENT" OR CURTOK$="INTEGER" OR CURTOK$="REAL" OR CURTOK$="(" OR CURTOK$="+" OR CURTOK$="-") THEN
4180   CALL PARSECONDITION
4190 ELSE
4200   PRINT "ERROR: UNEXPECTED TOKEN ",SCANTOK$
4210   STOP
4220 ENDIF
4230 L22A2=RES
4240 TOKEN$="then" : CALL ACCEPT
4250 L22A3=RES
4260 IF (CURTOK$="IDENT" OR CURTOK$="call" OR CURTOK$="begin" OR CURTOK$="if" OR CURTOK$="while") THEN
4270   CALL PARSESTATEMENT
4280 ELSE
4290   RET=NIL
4300 ENDIF
4310 L22A4=RES
4320 A4=L22A4:NCAR=A4:NCDR=NIL:CALL CONS:A0=RES
4330 A3=L22A3:NCAR=A3:NCDR=A0:CALL CONS:A0=RES
4340 A2=L22A2:NCAR=A2:NCDR=A0:CALL CONS:A0=RES
4350 A1=L22A1:NCAR=A1:NCDR=A0:CALL CONS:A0=RES
4360 NCAR=A4:NCDR=NIL:CALL CONS
4370 NCAR=A2:NCDR=RES:CALL CONS
4380 TMP=RES:NSTRING$="IF":CALL MKSTR
4390 NCAR=RES:NCDR=TMP:CALL CONS
4400 ELSE
4410 IF (CURTOK$="while") THEN
4420 TOKEN$="while" : CALL ACCEPT
4430 L23A1=RES
4440 IF (CURTOK$="odd" OR CURTOK$="IDENT" OR CURTOK$="INTEGER" OR CURTOK$="REAL" OR CURTOK$="(" OR CURTOK$="+" OR CURTOK$="-") THEN
4450   CALL PARSECONDITION
4460 ELSE
4470   PRINT "ERROR: UNEXPECTED TOKEN ",SCANTOK$
4480   STOP
4490 ENDIF
4500 L23A2=RES
4510 TOKEN$="do" : CALL ACCEPT
4520 L23A3=RES
4530 IF (CURTOK$="IDENT" OR CURTOK$="call" OR CURTOK$="begin" OR CURTOK$="if" OR CURTOK$="while") THEN
4540   CALL PARSESTATEMENT
4550 ELSE
4560   RET=NIL
4570 ENDIF
4580 L23A4=RES
4590 A4=L23A4:NCAR=A4:NCDR=NIL:CALL CONS:A0=RES
4600 A3=L23A3:NCAR=A3:NCDR=A0:CALL CONS:A0=RES
4610 A2=L23A2:NCAR=A2:NCDR=A0:CALL CONS:A0=RES
4620 A1=L23A1:NCAR=A1:NCDR=A0:CALL CONS:A0=RES
4630 NCAR=A4:NCDR=NIL:CALL CONS
4640 NCAR=A2:NCDR=RES:CALL CONS
4650 TMP=RES:NSTRING$="WHILE":CALL MKSTR
4660 NCAR=RES:NCDR=TMP:CALL CONS
4670 ELSE
4680 PRINT "ERROR: DID NOT EXPECT ",CURTOK$
4690 STOP
4700 ENDIF
4710 ENDIF
4720 ENDIF
4730 ENDIF
4740 ENDIF
4750 ELSE
4760   RES=NIL
4770 ENDIF
4780 L15A1=RES
4790 A1=L15A1:NCAR=A1:NCDR=NIL:CALL CONS:A0=RES
4800 RES=A1
4810 ENDSUB
4820 SUB PARSEBLOCK
4830 L25RES=NIL
4840 IF (CURTOK$="const") THEN
4850 TOKEN$="const" : CALL ACCEPT
4860 L26A1=RES
4870 TOKEN$="IDENT" : CALL ACCEPT
4880 L26A2=RES
4890 TOKEN$="=" : CALL ACCEPT
4900 L26A3=RES
4910 IF (CURTOK$="INTEGER" OR CURTOK$="REAL") THEN
4920   CALL PARSENUMBER
4930 ELSE
4940   PRINT "ERROR: UNEXPECTED TOKEN ",SCANTOK$
4950   STOP
4960 ENDIF
4970 L26A4=RES
4980 L27RES=NIL
4990 WHILE (CURTOK$=",")
5000 TOKEN$="," : CALL ACCEPT
5010 L28A1=RES
5020 TOKEN$="IDENT" : CALL ACCEPT
5030 L28A2=RES
5040 TOKEN$="=" : CALL ACCEPT
5050 L28A3=RES
5060 IF (CURTOK$="INTEGER" OR CURTOK$="REAL") THEN
5070   CALL PARSENUMBER
5080 ELSE
5090   PRINT "ERROR: UNEXPECTED TOKEN ",SCANTOK$
5100   STOP
5110 ENDIF
5120 L28A4=RES
5130 A4=L28A4:NCAR=A4:NCDR=NIL:CALL CONS:A0=RES
5140 A3=L28A3:NCAR=A3:NCDR=A0:CALL CONS:A0=RES
5150 A2=L28A2:NCAR=A2:NCDR=A0:CALL CONS:A0=RES
5160 A1=L28A1:NCAR=A1:NCDR=A0:CALL CONS:A0=RES
5170 NCAR=A4:NCDR=NIL:CALL CONS
5180 NCAR=A2:NCDR=RES:CALL CONS
5190 NCAR=RET:NCDR=L27RES:CALL CONS:L27RES=RES
5200 ENDWHILE
5210 LIST=L27RES:CALL REVERSE
5220 L26A5=RES
5230 TOKEN$=";" : CALL ACCEPT
5240 L26A6=RES
5250 A6=L26A6:NCAR=A6:NCDR=NIL:CALL CONS:A0=RES
5260 A5=L26A5:NCAR=A5:NCDR=A0:CALL CONS:A0=RES
5270 A4=L26A4:NCAR=A4:NCDR=A0:CALL CONS:A0=RES
5280 A3=L26A3:NCAR=A3:NCDR=A0:CALL CONS:A0=RES
5290 A2=L26A2:NCAR=A2:NCDR=A0:CALL CONS:A0=RES
5300 A1=L26A1:NCAR=A1:NCDR=A0:CALL CONS:A0=RES
5310 NCAR=A4:NCDR=NIL:CALL CONS
5320 NCAR=A2:NCDR=RES:CALL CONS
5330 NCAR=RES:NCDR=A5:CALL CONS
5340 ELSE
5350   RES=NIL
5360 ENDIF
5370 L24A1=RES
5380 L29RES=NIL
5390 IF (CURTOK$="var") THEN
5400 TOKEN$="var" : CALL ACCEPT
5410 L30A1=RES
5420 TOKEN$="IDENT" : CALL ACCEPT
5430 L30A2=RES
5440 L31RES=NIL
5450 WHILE (CURTOK$=",")
5460 TOKEN$="," : CALL ACCEPT
5470 L32A1=RES
5480 TOKEN$="IDENT" : CALL ACCEPT
5490 L32A2=RES
5500 A2=L32A2:NCAR=A2:NCDR=NIL:CALL CONS:A0=RES
5510 A1=L32A1:NCAR=A1:NCDR=A0:CALL CONS:A0=RES
5520 RES=A2
5530 NCAR=RET:NCDR=L31RES:CALL CONS:L31RES=RES
5540 ENDWHILE
5550 LIST=L31RES:CALL REVERSE
5560 L30A3=RES
5570 TOKEN$=";" : CALL ACCEPT
5580 L30A4=RES
5590 A4=L30A4:NCAR=A4:NCDR=NIL:CALL CONS:A0=RES
5600 A3=L30A3:NCAR=A3:NCDR=A0:CALL CONS:A0=RES
5610 A2=L30A2:NCAR=A2:NCDR=A0:CALL CONS:A0=RES
5620 A1=L30A1:NCAR=A1:NCDR=A0:CALL CONS:A0=RES
5630 NCAR=A3:NCDR=NIL:CALL CONS
5640 NCAR=A2:NCDR=RES:CALL CONS
5650 ELSE
5660   RES=NIL
5670 ENDIF
5680 L24A2=RES
5690 L33RES=NIL
5700 WHILE (CURTOK$="procedure")
5710 TOKEN$="procedure" : CALL ACCEPT
5720 L34A1=RES
5730 TOKEN$="IDENT" : CALL ACCEPT
5740 L34A2=RES
5750 TOKEN$=";" : CALL ACCEPT
5760 L34A3=RES
5770 IF (CURTOK$="IDENT" OR CURTOK$="call" OR CURTOK$="begin" OR CURTOK$="if" OR CURTOK$="while" OR CURTOK$="procedure" OR CURTOK$="var" OR CURTOK$="const") THEN
5780   CALL PARSEBLOCK
5790 ELSE
5800   RET=NIL
5810 ENDIF
5820 L34A4=RES
5830 TOKEN$=";" : CALL ACCEPT
5840 L34A5=RES
5850 A5=L34A5:NCAR=A5:NCDR=NIL:CALL CONS:A0=RES
5860 A4=L34A4:NCAR=A4:NCDR=A0:CALL CONS:A0=RES
5870 A3=L34A3:NCAR=A3:NCDR=A0:CALL CONS:A0=RES
5880 A2=L34A2:NCAR=A2:NCDR=A0:CALL CONS:A0=RES
5890 A1=L34A1:NCAR=A1:NCDR=A0:CALL CONS:A0=RES
5900 NCAR=A4:NCDR=NIL:CALL CONS
5910 NCAR=A2:NCDR=RES:CALL CONS
5920 TMP=RES:NSTRING$="PROCEDURE":CALL MKSTR
5930 NCAR=RES:NCDR=TMP:CALL CONS
5940 NCAR=RET:NCDR=L33RES:CALL CONS:L33RES=RES
5950 ENDWHILE
5960 LIST=L33RES:CALL REVERSE
5970 L24A3=RES
5980 IF (CURTOK$="IDENT" OR CURTOK$="call" OR CURTOK$="begin" OR CURTOK$="if" OR CURTOK$="while") THEN
5990   CALL PARSESTATEMENT
6000 ELSE
6010   RET=NIL
6020 ENDIF
6030 L24A4=RES
6040 A4=L24A4:NCAR=A4:NCDR=NIL:CALL CONS:A0=RES
6050 A3=L24A3:NCAR=A3:NCDR=A0:CALL CONS:A0=RES
6060 A2=L24A2:NCAR=A2:NCDR=A0:CALL CONS:A0=RES
6070 A1=L24A1:NCAR=A1:NCDR=A0:CALL CONS:A0=RES
6080 NCAR=A4:NCDR=NIL:CALL CONS
6090 NCAR=A3:NCDR=RES:CALL CONS
6100 NCAR=A2:NCDR=RES:CALL CONS
6110 NCAR=A1:NCDR=RES:CALL CONS
6120 TMP=RES:NSTRING$="BLOCK":CALL MKSTR
6130 NCAR=RES:NCDR=TMP:CALL CONS
6140 ENDSUB
6150 SUB PARSEEXAMPLE
6160   SCANSRC$=SOURCE$ : SCANPOS=0 : SCANFUN$="SCANEXAMPLE"
6170   CALL SCANFUN$
6180   CALL PARSEPROGRAM
6190   IF SCANEOF<>0 THEN
6200     PRINT "ERROR: END OF SOURCE NOT REACHED"
6210     STOP
6220   ENDIF
6230 ENDSUB
;; Loaded file example-basic.lisp
T
[7]>

;;; Parsing a source with this basic program would be done with:

SOURCE$=  "
    const abc = 123,
          pi=3.141592e+0;
    var a,b,c;
    procedure gcd;
    begin
        while a # b do
        begin
             if a<b then b:=b-a ;
             if a>b then a:=a-b
        end
    end;
begin
    a:=42;
    b:=30.0;
    call gcd
end." : CALL PARSEXAMPLE

;;; The resulting parse tree is stored in the CAR,CDR,TYPES,STRING$ and NUMBER
;;; arrays, the root of the tree being pointed to by RES.