aboutsummaryrefslogtreecommitdiff
path: root/src/boot/strap/scanner.clisp
blob: d0fb980079bd3425e329ae4f01055bcc71b077f9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
(PROCLAIM '(OPTIMIZE SPEED))
(IMPORT-MODULE "tokens")

(IMPORT-MODULE "includer")

(IN-PACKAGE "BOOTTRAN")

(PROVIDE "scanner")

(DEFUN |double| (|x|) (FLOAT |x| 1.0))

(DEFUN |dqUnit| (|s|)
  (PROG (|a|) (RETURN (PROGN (SETQ |a| (LIST |s|)) (CONS |a| |a|)))))

(DEFUN |dqAppend| (|x| |y|)
  (COND
    ((NULL |x|) |y|)
    ((NULL |y|) |x|)
    (T (RPLACD (CDR |x|) (CAR |y|)) (RPLACD |x| (CDR |y|)) |x|)))

(DEFUN |dqConcat| (|ld|)
  (COND
    ((NULL |ld|) NIL)
    ((NULL (CDR |ld|)) (CAR |ld|))
    (T (|dqAppend| (CAR |ld|) (|dqConcat| (CDR |ld|))))))

(DEFUN |dqToList| (|s|) (COND ((NULL |s|) NIL) (T (CAR |s|))))

(DEFUN |shoeConstructToken| (|ln| |lp| |b| |n|)
  (CONS (ELT |b| 0) (CONS (ELT |b| 1) (CONS |lp| |n|))))

(DEFUN |shoeTokType| (|x|) (CAR |x|))

(DEFUN |shoeTokPart| (|x|) (CADR |x|))

(DEFUN |shoeTokPosn| (|x|) (CDDR |x|))

(DEFUN |shoeTokConstruct| (|x| |y| |z|) (CONS |x| (CONS |y| |z|)))

(DEFUN |shoeNextLine| (|s|)
  (PROG (|s1| |a|)
    (DECLARE (SPECIAL |$sz| |$n| |$ln| |$r| |$f| |$linepos|))
    (RETURN
      (COND
        ((|bStreamNull| |s|) NIL)
        (T (SETQ |$linepos| |s|) (SETQ |$f| (CAR |s|))
           (SETQ |$r| (CDR |s|)) (SETQ |$ln| (CAR |$f|))
           (SETQ |$n| (STRPOSL " " |$ln| 0 T))
           (SETQ |$sz| (LENGTH |$ln|))
           (COND
             ((NULL |$n|) T)
             ((EQUAL (QENUM |$ln| |$n|) |shoeTAB|)
              (SETQ |a| (MAKE-FULL-CVEC (- 7 (REM |$n| 8)) " "))
              (SETF (ELT |$ln| |$n|) (ELT " " 0))
              (SETQ |$ln| (CONCAT |a| |$ln|))
              (SETQ |s1| (CONS (CONS |$ln| (CDR |$f|)) |$r|))
              (|shoeNextLine| |s1|))
             (T T)))))))

(DEFUN |shoeLineToks| (|s|)
  (PROG (|$linepos| |$floatok| |$sz| |$n| |$ln| |$r| |$f| |toks| |a|
            |dq| |command| |fst|)
    (DECLARE (SPECIAL |$floatok| |$f| |$sz| |$linepos| |$ln| |$r| |$n|))
    (RETURN
      (PROGN
        (SETQ |$f| NIL)
        (SETQ |$r| NIL)
        (SETQ |$ln| NIL)
        (SETQ |$n| NIL)
        (SETQ |$sz| NIL)
        (SETQ |$floatok| T)
        (SETQ |$linepos| |s|)
        (COND
          ((NOT (|shoeNextLine| |s|)) (CONS NIL NIL))
          ((NULL |$n|) (|shoeLineToks| |$r|))
          (T (SETQ |fst| (QENUM |$ln| 0))
             (COND
               ((EQL |fst| |shoeCLOSEPAREN|)
                (COND
                  ((SETQ |command| (|shoeLine?| |$ln|))
                   (SETQ |dq|
                         (|dqUnit|
                             (|shoeConstructToken| |$ln| |$linepos|
                                 (|shoeLeafLine| |command|) 0)))
                   (CONS (LIST |dq|) |$r|))
                  ((SETQ |command| (|shoeLisp?| |$ln|))
                   (|shoeLispToken| |$r| |command|))
                  ((SETQ |command| (|shoePackage?| |$ln|))
                   (SETQ |a| (CONCAT "(IN-PACKAGE " |command| ")"))
                   (SETQ |dq|
                         (|dqUnit|
                             (|shoeConstructToken| |$ln| |$linepos|
                                 (|shoeLeafLisp| |a|) 0)))
                   (CONS (LIST |dq|) |$r|))
                  (T (|shoeLineToks| |$r|))))
               (T (SETQ |toks| NIL)
                  (LOOP
                    (COND
                      ((NOT (< |$n| |$sz|)) (RETURN NIL))
                      (T (SETQ |toks|
                               (|dqAppend| |toks| (|shoeToken|))))))
                  (COND
                    ((NULL |toks|) (|shoeLineToks| |$r|))
                    (T (CONS (LIST |toks|) |$r|)))))))))))

(DEFUN |shoeLispToken| (|s| |string|)
  (PROG (|dq| |st| |r| |LETTMP#1| |linepos| |ln|)
    (DECLARE (SPECIAL |$linepos| |$ln|))
    (RETURN
      (PROGN
        (SETQ |string|
              (COND
                ((OR (EQL (LENGTH |string|) 0)
                     (EQL (QENUM |string| 0) (QENUM ";" 0)))
                 "")
                (T |string|)))
        (SETQ |ln| |$ln|)
        (SETQ |linepos| |$linepos|)
        (SETQ |LETTMP#1| (|shoeAccumulateLines| |s| |string|))
        (SETQ |r| (CAR |LETTMP#1|))
        (SETQ |st| (CDR |LETTMP#1|))
        (SETQ |dq|
              (|dqUnit|
                  (|shoeConstructToken| |ln| |linepos|
                      (|shoeLeafLisp| |st|) 0)))
        (CONS (LIST |dq|) |r|)))))

(DEFUN |shoeAccumulateLines| (|s| |string|)
  (PROG (|a| |command| |fst|)
    (DECLARE (SPECIAL |$ln| |$r| |$n|))
    (RETURN
      (COND
        ((NOT (|shoeNextLine| |s|)) (CONS |s| |string|))
        ((NULL |$n|) (|shoeAccumulateLines| |$r| |string|))
        ((EQL (LENGTH |$ln|) 0) (|shoeAccumulateLines| |$r| |string|))
        (T (SETQ |fst| (QENUM |$ln| 0))
           (COND
             ((EQL |fst| |shoeCLOSEPAREN|)
              (SETQ |command| (|shoeLisp?| |$ln|))
              (COND
                ((AND |command| (PLUSP (LENGTH |command|)))
                 (COND
                   ((EQL (QENUM |command| 0) (QENUM ";" 0))
                    (|shoeAccumulateLines| |$r| |string|))
                   (T (SETQ |a| (STRPOS ";" |command| 0 NIL))
                      (COND
                        (|a| (|shoeAccumulateLines| |$r|
                                 (CONCAT |string|
                                         (SUBSTRING |command| 0
                                          (- |a| 1)))))
                        (T (|shoeAccumulateLines| |$r|
                               (CONCAT |string| |command|)))))))
                (T (|shoeAccumulateLines| |$r| |string|))))
             (T (CONS |s| |string|))))))))

(DEFUN |shoeCloser| (|t|) (MEMQ (|shoeKeyWord| |t|) '(CPAREN CBRACK)))

(DEFUN |shoeToken| ()
  (PROG (|b| |ch| |n| |linepos| |c| |ln|)
    (DECLARE (SPECIAL |$linepos| |$n| |$ln|))
    (RETURN
      (PROGN
        (SETQ |ln| |$ln|)
        (SETQ |c| (QENUM |$ln| |$n|))
        (SETQ |linepos| |$linepos|)
        (SETQ |n| |$n|)
        (SETQ |ch| (ELT |$ln| |$n|))
        (SETQ |b|
              (COND
                ((|shoeStartsComment|) (|shoeComment|) NIL)
                ((|shoeStartsNegComment|) (|shoeNegComment|) NIL)
                ((EQUAL |c| |shoeLispESCAPE|) (|shoeLispEscape|))
                ((|shoePunctuation| |c|) (|shoePunct|))
                ((|shoeStartsId| |ch|) (|shoeWord| NIL))
                ((EQUAL |c| |shoeSPACE|) (|shoeSpace|) NIL)
                ((EQUAL |c| |shoeSTRINGCHAR|) (|shoeString|))
                ((|shoeDigit| |ch|) (|shoeNumber|))
                ((EQUAL |c| |shoeESCAPE|) (|shoeEscape|))
                ((EQUAL |c| |shoeTAB|) (SETQ |$n| (+ |$n| 1)) NIL)
                (T (|shoeError|))))
        (COND
          ((NULL |b|) NIL)
          (T (|dqUnit| (|shoeConstructToken| |ln| |linepos| |b| |n|))))))))

(DEFUN |shoeLeafId| (|x|) (LIST 'ID (INTERN |x|)))

(DEFUN |shoeLeafKey| (|x|) (LIST 'KEY (|shoeKeyWord| |x|)))

(DEFUN |shoeLeafInteger| (|x|) (LIST 'INTEGER (|shoeIntValue| |x|)))

(DEFUN |shoeLeafFloat| (|a| |w| |e|)
  (PROG (|c| |b|)
    (RETURN
      (PROGN
        (SETQ |b| (|shoeIntValue| (CONCAT |a| |w|)))
        (SETQ |c|
              (* (|double| |b|)
                 (EXPT (|double| 10) (- |e| (LENGTH |w|)))))
        (LIST 'FLOAT |c|)))))

(DEFUN |shoeLeafString| (|x|) (LIST 'STRING |x|))

(DEFUN |shoeLeafLisp| (|x|) (LIST 'LISP |x|))

(DEFUN |shoeLeafLispExp| (|x|) (LIST 'LISPEXP |x|))

(DEFUN |shoeLeafLine| (|x|) (LIST 'LINE |x|))

(DEFUN |shoeLeafComment| (|x|) (LIST 'COMMENT |x|))

(DEFUN |shoeLeafNegComment| (|x|) (LIST 'NEGCOMMENT |x|))

(DEFUN |shoeLeafError| (|x|) (LIST 'ERROR |x|))

(DEFUN |shoeLeafSpaces| (|x|) (LIST 'SPACES |x|))

(DEFUN |shoeLispEscape| ()
  (PROG (|n| |exp| |a|)
    (DECLARE (SPECIAL |$ln| |$linepos| |$sz| |$n|))
    (RETURN
      (PROGN
        (SETQ |$n| (+ |$n| 1))
        (COND
          ((NOT (< |$n| |$sz|))
           (|SoftShoeError| (CONS |$linepos| |$n|) "lisp escape error")
           (|shoeLeafError| (ELT |$ln| |$n|)))
          (T (SETQ |a| (|shoeReadLispString| |$ln| |$n|))
             (COND
               ((NULL |a|)
                (|SoftShoeError| (CONS |$linepos| |$n|)
                    "lisp escape error")
                (|shoeLeafError| (ELT |$ln| |$n|)))
               (T (SETQ |exp| (CAR |a|)) (SETQ |n| (CADR |a|))
                  (COND
                    ((NULL |n|) (SETQ |$n| |$sz|)
                     (|shoeLeafLispExp| |exp|))
                    (T (SETQ |$n| |n|) (|shoeLeafLispExp| |exp|)))))))))))

(DEFUN |shoeEscape| ()
  (DECLARE (SPECIAL |$n|))
  (PROGN
    (SETQ |$n| (+ |$n| 1))
    (COND ((|shoeEsc|) (|shoeWord| T)) (T NIL))))

(DEFUN |shoeEsc| ()
  (PROG (|n1|)
    (DECLARE (SPECIAL |$ln| |$r| |$sz| |$n|))
    (RETURN
      (COND
        ((NOT (< |$n| |$sz|))
         (COND
           ((|shoeNextLine| |$r|)
            (LOOP
              (COND (|$n| (RETURN NIL)) (T (|shoeNextLine| |$r|))))
            (|shoeEsc|) NIL)
           (T NIL)))
        (T (SETQ |n1| (STRPOSL " " |$ln| |$n| T))
           (COND
             ((NULL |n1|) (|shoeNextLine| |$r|)
              (LOOP
                (COND (|$n| (RETURN NIL)) (T (|shoeNextLine| |$r|))))
              (|shoeEsc|) NIL)
             (T T)))))))

(DEFUN |shoeStartsComment| ()
  (PROG (|www|)
    (DECLARE (SPECIAL |$ln| |$sz| |$n|))
    (RETURN
      (COND
        ((< |$n| |$sz|)
         (COND
           ((EQUAL (QENUM |$ln| |$n|) |shoePLUSCOMMENT|)
            (SETQ |www| (+ |$n| 1))
            (COND
              ((NOT (< |www| |$sz|)) NIL)
              (T (EQUAL (QENUM |$ln| |www|) |shoePLUSCOMMENT|))))
           (T NIL)))
        (T NIL)))))

(DEFUN |shoeStartsNegComment| ()
  (PROG (|www|)
    (DECLARE (SPECIAL |$ln| |$sz| |$n|))
    (RETURN
      (COND
        ((< |$n| |$sz|)
         (COND
           ((EQUAL (QENUM |$ln| |$n|) |shoeMINUSCOMMENT|)
            (SETQ |www| (+ |$n| 1))
            (COND
              ((NOT (< |www| |$sz|)) NIL)
              (T (EQUAL (QENUM |$ln| |www|) |shoeMINUSCOMMENT|))))
           (T NIL)))
        (T NIL)))))

(DEFUN |shoeNegComment| ()
  (PROG (|n|)
    (DECLARE (SPECIAL |$ln| |$sz| |$n|))
    (RETURN
      (PROGN
        (SETQ |n| |$n|)
        (SETQ |$n| |$sz|)
        (|shoeLeafNegComment| (SUBSTRING |$ln| |n| NIL))))))

(DEFUN |shoeComment| ()
  (PROG (|n|)
    (DECLARE (SPECIAL |$ln| |$sz| |$n|))
    (RETURN
      (PROGN
        (SETQ |n| |$n|)
        (SETQ |$n| |$sz|)
        (|shoeLeafComment| (SUBSTRING |$ln| |n| NIL))))))

(DEFUN |shoePunct| ()
  (PROG (|sss|)
    (DECLARE (SPECIAL |$n| |$ln|))
    (RETURN
      (PROGN
        (SETQ |sss| (|shoeMatch| |$ln| |$n|))
        (SETQ |$n| (+ |$n| (LENGTH |sss|)))
        (|shoeKeyTr| |sss|)))))

(DEFUN |shoeKeyTr| (|w|)
  (DECLARE (SPECIAL |$floatok|))
  (COND
    ((EQ (|shoeKeyWord| |w|) 'DOT)
     (COND (|$floatok| (|shoePossFloat| |w|)) (T (|shoeLeafKey| |w|))))
    (T (SETQ |$floatok| (NOT (|shoeCloser| |w|))) (|shoeLeafKey| |w|))))

(DEFUN |shoePossFloat| (|w|)
  (DECLARE (SPECIAL |$ln| |$sz| |$n|))
  (COND
    ((OR (NOT (< |$n| |$sz|)) (NOT (|shoeDigit| (ELT |$ln| |$n|))))
     (|shoeLeafKey| |w|))
    (T (SETQ |w| (|shoeInteger|)) (|shoeExponent| "0" |w|))))

(DEFUN |shoeSpace| ()
  (PROG (|n|)
    (DECLARE (SPECIAL |$floatok| |$ln| |$n|))
    (RETURN
      (PROGN
        (SETQ |n| |$n|)
        (SETQ |$n| (STRPOSL " " |$ln| |$n| T))
        (SETQ |$floatok| T)
        (COND
          ((NULL |$n|) (|shoeLeafSpaces| 0) (SETQ |$n| (LENGTH |$ln|)))
          (T (|shoeLeafSpaces| (- |$n| |n|))))))))

(DEFUN |shoeString| ()
  (DECLARE (SPECIAL |$floatok| |$n|))
  (PROGN
    (SETQ |$n| (+ |$n| 1))
    (SETQ |$floatok| NIL)
    (|shoeLeafString| (|shoeS|))))

(DEFUN |shoeS| ()
  (PROG (|b| |a| |str| |mn| |escsym| |strsym| |n|)
    (DECLARE (SPECIAL |$ln| |$linepos| |$sz| |$n|))
    (RETURN
      (COND
        ((NOT (< |$n| |$sz|))
         (|SoftShoeError| (CONS |$linepos| |$n|) "quote added") "")
        (T (SETQ |n| |$n|)
           (SETQ |strsym| (OR (STRPOS "\"" |$ln| |$n| NIL) |$sz|))
           (SETQ |escsym| (OR (STRPOS "_" |$ln| |$n| NIL) |$sz|))
           (SETQ |mn| (MIN |strsym| |escsym|))
           (COND
             ((EQUAL |mn| |$sz|) (SETQ |$n| |$sz|)
              (|SoftShoeError| (CONS |$linepos| |$n|) "quote added")
              (SUBSTRING |$ln| |n| NIL))
             ((EQUAL |mn| |strsym|) (SETQ |$n| (+ |mn| 1))
              (SUBSTRING |$ln| |n| (- |mn| |n|)))
             (T (SETQ |str| (SUBSTRING |$ln| |n| (- |mn| |n|)))
                (SETQ |$n| (+ |mn| 1)) (SETQ |a| (|shoeEsc|))
                (SETQ |b|
                      (COND
                        (|a| (SETQ |str|
                                   (CONCAT |str| (ELT |$ln| |$n|)))
                             (SETQ |$n| (+ |$n| 1)) (|shoeS|))
                        (T (|shoeS|))))
                (CONCAT |str| |b|))))))))

(DEFUN |shoeIdEnd| (|line| |n|)
  (PROGN
    (LOOP
      (COND
        ((NOT (AND (< |n| (LENGTH |line|))
                   (|shoeIdChar| (ELT |line| |n|))))
         (RETURN NIL))
        (T (SETQ |n| (+ |n| 1)))))
    |n|))

(DEFUN |shoeDigit| (|x|) (DIGIT-CHAR-P |x|))

(DEFUN |shoeW| (|b|)
  (PROG (|bb| |a| |str| |endid| |l| |n1|)
    (DECLARE (SPECIAL |$ln| |$sz| |$n|))
    (RETURN
      (PROGN
        (SETQ |n1| |$n|)
        (SETQ |$n| (+ |$n| 1))
        (SETQ |l| |$sz|)
        (SETQ |endid| (|shoeIdEnd| |$ln| |$n|))
        (COND
          ((OR (EQUAL |endid| |l|)
               (NOT (EQUAL (QENUM |$ln| |endid|) |shoeESCAPE|)))
           (SETQ |$n| |endid|)
           (LIST |b| (SUBSTRING |$ln| |n1| (- |endid| |n1|))))
          (T (SETQ |str| (SUBSTRING |$ln| |n1| (- |endid| |n1|)))
             (SETQ |$n| (+ |endid| 1)) (SETQ |a| (|shoeEsc|))
             (SETQ |bb| (COND (|a| (|shoeW| T)) (T (LIST |b| ""))))
             (LIST (OR (ELT |bb| 0) |b|) (CONCAT |str| (ELT |bb| 1)))))))))

(DEFUN |shoeWord| (|esp|)
  (PROG (|w| |aaa|)
    (DECLARE (SPECIAL |$floatok|))
    (RETURN
      (PROGN
        (SETQ |aaa| (|shoeW| NIL))
        (SETQ |w| (ELT |aaa| 1))
        (SETQ |$floatok| NIL)
        (COND
          ((OR |esp| (ELT |aaa| 0)) (|shoeLeafId| |w|))
          ((|shoeKeyWordP| |w|) (SETQ |$floatok| T)
           (|shoeLeafKey| |w|))
          (T (|shoeLeafId| |w|)))))))

(DEFUN |shoeInteger| () (|shoeInteger1| NIL))

(DEFUN |shoeInteger1| (|zro|)
  (PROG (|bb| |a| |str| |l| |n|)
    (DECLARE (SPECIAL |$ln| |$sz| |$n|))
    (RETURN
      (PROGN
        (SETQ |n| |$n|)
        (SETQ |l| |$sz|)
        (LOOP
          (COND
            ((NOT (AND (< |$n| |l|) (|shoeDigit| (ELT |$ln| |$n|))))
             (RETURN NIL))
            (T (SETQ |$n| (+ |$n| 1)))))
        (COND
          ((OR (EQUAL |$n| |l|)
               (NOT (EQUAL (QENUM |$ln| |$n|) |shoeESCAPE|)))
           (COND
             ((AND (EQUAL |n| |$n|) |zro|) "0")
             (T (SUBSTRING |$ln| |n| (- |$n| |n|)))))
          (T (SETQ |str| (SUBSTRING |$ln| |n| (- |$n| |n|)))
             (SETQ |$n| (+ |$n| 1)) (SETQ |a| (|shoeEsc|))
             (SETQ |bb| (|shoeInteger1| |zro|)) (CONCAT |str| |bb|)))))))

(DEFUN |shoeIntValue| (|s|)
  (PROG (|d| |ival| |ns|)
    (RETURN
      (PROGN
        (SETQ |ns| (LENGTH |s|))
        (SETQ |ival| 0)
        (LET ((|bfVar#1| (- |ns| 1)) (|i| 0))
          (LOOP
            (COND
              ((> |i| |bfVar#1|) (RETURN NIL))
              (T (PROGN
                   (SETQ |d| (|shoeOrdToNum| (ELT |s| |i|)))
                   (SETQ |ival| (+ (* 10 |ival|) |d|)))))
            (SETQ |i| (+ |i| 1))))
        |ival|))))

(DEFUN |shoeNumber| ()
  (PROG (|w| |n| |a|)
    (DECLARE (SPECIAL |$ln| |$floatok| |$sz| |$n|))
    (RETURN
      (PROGN
        (SETQ |a| (|shoeInteger|))
        (COND
          ((NOT (< |$n| |$sz|)) (|shoeLeafInteger| |a|))
          ((AND |$floatok| (EQUAL (QENUM |$ln| |$n|) |shoeDOT|))
           (SETQ |n| |$n|) (SETQ |$n| (+ |$n| 1))
           (COND
             ((AND (< |$n| |$sz|) (EQUAL (QENUM |$ln| |$n|) |shoeDOT|))
              (SETQ |$n| |n|) (|shoeLeafInteger| |a|))
             (T (SETQ |w| (|shoeInteger1| T)) (|shoeExponent| |a| |w|))))
          (T (|shoeLeafInteger| |a|)))))))

(DEFUN |shoeExponent| (|a| |w|)
  (PROG (|c1| |e| |c| |n|)
    (DECLARE (SPECIAL |$ln| |$sz| |$n|))
    (RETURN
      (COND
        ((NOT (< |$n| |$sz|)) (|shoeLeafFloat| |a| |w| 0))
        (T (SETQ |n| |$n|) (SETQ |c| (QENUM |$ln| |$n|))
           (COND
             ((OR (EQUAL |c| |shoeEXPONENT1|)
                  (EQUAL |c| |shoeEXPONENT2|))
              (SETQ |$n| (+ |$n| 1))
              (COND
                ((NOT (< |$n| |$sz|)) (SETQ |$n| |n|)
                 (|shoeLeafFloat| |a| |w| 0))
                ((|shoeDigit| (ELT |$ln| |$n|))
                 (SETQ |e| (|shoeInteger|))
                 (SETQ |e| (|shoeIntValue| |e|))
                 (|shoeLeafFloat| |a| |w| |e|))
                (T (SETQ |c1| (QENUM |$ln| |$n|))
                   (COND
                     ((OR (EQUAL |c1| |shoePLUSCOMMENT|)
                          (EQUAL |c1| |shoeMINUSCOMMENT|))
                      (SETQ |$n| (+ |$n| 1))
                      (COND
                        ((NOT (< |$n| |$sz|)) (SETQ |$n| |n|)
                         (|shoeLeafFloat| |a| |w| 0))
                        ((|shoeDigit| (ELT |$ln| |$n|))
                         (SETQ |e| (|shoeInteger|))
                         (SETQ |e| (|shoeIntValue| |e|))
                         (|shoeLeafFloat| |a| |w|
                             (COND
                               ((EQUAL |c1| |shoeMINUSCOMMENT|)
                                (- |e|))
                               (T |e|))))
                        (T (SETQ |$n| |n|) (|shoeLeafFloat| |a| |w| 0))))))))
             (T (|shoeLeafFloat| |a| |w| 0))))))))

(DEFUN |shoeError| ()
  (PROG (|n|)
    (DECLARE (SPECIAL |$ln| |$linepos| |$n|))
    (RETURN
      (PROGN
        (SETQ |n| |$n|)
        (SETQ |$n| (+ |$n| 1))
        (|SoftShoeError| (CONS |$linepos| |n|)
            (CONCAT "The character whose number is "
                    (STRINGIMAGE (QENUM |$ln| |n|))
                    " is not a Boot character"))
        (|shoeLeafError| (ELT |$ln| |n|))))))

(DEFUN |shoeOrdToNum| (|x|) (DIGIT-CHAR-P |x|))

(DEFUN |shoeKeyWord| (|st|) (GETHASH |st| |shoeKeyTable|))

(DEFUN |shoeKeyWordP| (|st|) (GETHASH |st| |shoeKeyTable|))

(DEFUN |shoeMatch| (|l| |i|)
  (|shoeSubStringMatch| |l| |shoeDict| |i|))

(DEFUN |shoeSubStringMatch| (|l| |d| |i|)
  (PROG (|eql| |ls| |s| |s1| |done| |ll| |u| |h|)
    (RETURN
      (PROGN
        (SETQ |h| (QENUM |l| |i|))
        (SETQ |u| (ELT |d| |h|))
        (SETQ |ll| (SIZE |l|))
        (SETQ |done| NIL)
        (SETQ |s1| "")
        (LET ((|bfVar#2| (- (SIZE |u|) 1)) (|j| 0))
          (LOOP
            (COND
              ((OR (> |j| |bfVar#2|) |done|) (RETURN NIL))
              (T (PROGN
                   (SETQ |s| (ELT |u| |j|))
                   (SETQ |ls| (SIZE |s|))
                   (SETQ |done|
                         (COND
                           ((< |ll| (+ |ls| |i|)) NIL)
                           (T (SETQ |eql| T)
                              (LET ((|bfVar#3| (- |ls| 1)) (|k| 1))
                                (LOOP
                                  (COND
                                    ((OR (> |k| |bfVar#3|) (NOT |eql|))
                                     (RETURN NIL))
                                    (T
                                     (SETQ |eql|
                                      (EQL (QENUM |s| |k|)
                                       (QENUM |l| (+ |k| |i|))))))
                                  (SETQ |k| (+ |k| 1))))
                              (COND (|eql| (SETQ |s1| |s|) T) (T NIL))))))))
            (SETQ |j| (+ |j| 1))))
        |s1|))))

(DEFUN |shoePunctuation| (|c|) (EQL (ELT |shoePun| |c|) 1))