aboutsummaryrefslogtreecommitdiff
path: root/src/boot/strap/scanner.clisp
blob: 1df760be0678ace8f5d2bf5624ee518398d72876 (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
(PROCLAIM '(OPTIMIZE SPEED))
(IMPORT-MODULE "tokens")

(IMPORT-MODULE "includer")

(IN-PACKAGE "BOOTTRAN")

(PROVIDE "scanner")

(DEFCONSTANT |shoeTAB| (CODE-CHAR 9))

(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 |shoeTokConstruct| (|x| |y| |z|) (CONS |x| (CONS |y| |z|)))

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

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

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

(DEFUN |shoeTokPosn| (|x|)
  (PROG (|p|) (RETURN (PROGN (SETQ |p| (CDDR |x|)) |p|))))

(DEFUN |shoeNextLine| (|s|)
  (PROG (|s1| |a|)
    (DECLARE (SPECIAL |$linepos| |$f| |$r| |$ln| |$n| |$sz|))
    (RETURN
     (COND ((|bStreamNull| |s|) NIL)
           (T (SETQ |$linepos| |s|) (SETQ |$f| (CAR |s|)) (SETQ |$r| (CDR |s|))
            (SETQ |$ln| (CAR |$f|))
            (SETQ |$n| (|firstNonblankPosition| |$ln| 0))
            (SETQ |$sz| (LENGTH |$ln|))
            (COND ((NULL |$n|) T)
                  ((CHAR= (SCHAR |$ln| |$n|) |shoeTAB|)
                   (SETQ |a| (|makeString| (- 7 (REM |$n| 8)) (|char| '| |)))
                   (SETF (SCHAR |$ln| |$n|) (|char| '| |))
                   (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| |dq|
         |command|)
    (DECLARE (SPECIAL |$f| |$floatok| |$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|))
            ((CHAR= (SCHAR |$ln| 0) (|char| '|)|))
             (COND
              ((SETQ |command| (|shoeLine?| |$ln|))
               (SETQ |dq|
                       (|dqUnit|
                        (|shoeConstructToken| |$linepos|
                                              (|shoeLeafLine| |command|) 0)))
               (CONS (LIST |dq|) |$r|))
              ((SETQ |command| (|shoeLisp?| |$ln|))
               (|shoeLispToken| |$r| |command|))
              (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 |$ln| |$linepos|))
    (RETURN
     (PROGN
      (COND
       ((OR (EQL (LENGTH |string|) 0) (CHAR= (SCHAR |string| 0) (|char| '|;|)))
        (SETQ |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| |linepos| (|shoeLeafLisp| |st|) 0)))
      (CONS (LIST |dq|) |r|)))))

(DEFUN |shoeAccumulateLines| (|s| |string|)
  (PROG (|a| |command|)
    (DECLARE (SPECIAL |$n| |$r| |$ln|))
    (RETURN
     (COND ((NOT (|shoeNextLine| |s|)) (CONS |s| |string|))
           ((NULL |$n|) (|shoeAccumulateLines| |$r| |string|))
           ((EQL (LENGTH |$ln|) 0) (|shoeAccumulateLines| |$r| |string|))
           ((CHAR= (SCHAR |$ln| 0) (|char| '|)|))
            (SETQ |command| (|shoeLisp?| |$ln|))
            (COND
             ((AND |command| (PLUSP (LENGTH |command|)))
              (COND
               ((CHAR= (SCHAR |command| 0) (|char| '|;|))
                (|shoeAccumulateLines| |$r| |string|))
               ((SETQ |a| (|charPosition| (|char| '|;|) |command| 0))
                (|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|)
  (|symbolMember?| (|shoeKeyWord| |t|) '(CPAREN CBRACK)))

(DEFUN |shoeToken| ()
  (PROG (|b| |ch| |n| |linepos|)
    (DECLARE (SPECIAL |$linepos| |$n| |$ln|))
    (RETURN
     (PROGN
      (SETQ |linepos| |$linepos|)
      (SETQ |n| |$n|)
      (SETQ |ch| (SCHAR |$ln| |$n|))
      (SETQ |b|
              (COND ((|shoeStartsComment|) (|shoeComment|) NIL)
                    ((|shoeStartsNegComment|) (|shoeNegComment|) NIL)
                    ((CHAR= |ch| (|char| '!)) (|shoeLispEscape|))
                    ((|shoePunctuation| (CHAR-CODE |ch|)) (|shoePunct|))
                    ((|shoeStartsId| |ch|) (|shoeWord| NIL))
                    ((CHAR= |ch| (|char| '| |)) (|shoeSpace|) NIL)
                    ((CHAR= |ch| (|char| '|"|)) (|shoeString|))
                    ((DIGIT-CHAR-P |ch|) (|shoeNumber|))
                    ((CHAR= |ch| (|char| '_)) (|shoeEscape|))
                    ((EQUAL |ch| |shoeTAB|) (SETQ |$n| (+ |$n| 1)) NIL)
                    (T (|shoeError|))))
      (COND ((NULL |b|) NIL)
            (T (|dqUnit| (|shoeConstructToken| |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 |$n| |$sz| |$linepos| |$ln|))
    (RETURN
     (PROGN
      (SETQ |$n| (+ |$n| 1))
      (COND
       ((NOT (< |$n| |$sz|))
        (|SoftShoeError| (CONS |$linepos| |$n|) "lisp escape error")
        (|shoeLeafError| (SCHAR |$ln| |$n|)))
       (T (SETQ |a| (|shoeReadLispString| |$ln| |$n|))
        (COND
         ((NULL |a|)
          (|SoftShoeError| (CONS |$linepos| |$n|) "lisp escape error")
          (|shoeLeafError| (SCHAR |$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 |$n| |$sz| |$r| |$ln|))
    (RETURN
     (COND
      ((NOT (< |$n| |$sz|))
       (COND
        ((|shoeNextLine| |$r|)
         (LOOP (COND (|$n| (RETURN NIL)) (T (|shoeNextLine| |$r|))))
         (|shoeEsc|) NIL)
        (T NIL)))
      (T (SETQ |n1| (|firstNonblankPosition| |$ln| |$n|))
       (COND
        ((NULL |n1|) (|shoeNextLine| |$r|)
         (LOOP (COND (|$n| (RETURN NIL)) (T (|shoeNextLine| |$r|))))
         (|shoeEsc|) NIL)
        (T T)))))))

(DEFUN |shoeStartsComment| ()
  (PROG (|www|)
    (DECLARE (SPECIAL |$n| |$sz| |$ln|))
    (RETURN
     (COND
      ((< |$n| |$sz|)
       (COND
        ((CHAR= (SCHAR |$ln| |$n|) (|char| '+)) (SETQ |www| (+ |$n| 1))
         (COND ((NOT (< |www| |$sz|)) NIL)
               (T (CHAR= (SCHAR |$ln| |www|) (|char| '+)))))
        (T NIL)))
      (T NIL)))))

(DEFUN |shoeStartsNegComment| ()
  (PROG (|www|)
    (DECLARE (SPECIAL |$n| |$sz| |$ln|))
    (RETURN
     (COND
      ((< |$n| |$sz|)
       (COND
        ((CHAR= (SCHAR |$ln| |$n|) (|char| '-)) (SETQ |www| (+ |$n| 1))
         (COND ((NOT (< |www| |$sz|)) NIL)
               (T (CHAR= (SCHAR |$ln| |www|) (|char| '-)))))
        (T NIL)))
      (T NIL)))))

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

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

(DEFUN |shoePunct| ()
  (PROG (|sss|)
    (DECLARE (SPECIAL |$ln| |$n|))
    (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 |$n| |$sz| |$ln|))
  (COND
   ((OR (NOT (< |$n| |$sz|)) (NOT (DIGIT-CHAR-P (SCHAR |$ln| |$n|))))
    (|shoeLeafKey| |w|))
   (T (SETQ |w| (|shoeInteger|)) (|shoeExponent| "0" |w|))))

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

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

(DEFUN |shoeS| ()
  (PROG (|b| |a| |str| |mn| |escsym| |strsym| |n|)
    (DECLARE (SPECIAL |$n| |$sz| |$linepos| |$ln|))
    (RETURN
     (COND
      ((NOT (< |$n| |$sz|))
       (|SoftShoeError| (CONS |$linepos| |$n|) "quote added") "")
      (T (SETQ |n| |$n|)
       (SETQ |strsym| (OR (|charPosition| (|char| '|"|) |$ln| |$n|) |$sz|))
       (SETQ |escsym| (OR (|charPosition| (|char| '_) |$ln| |$n|) |$sz|))
       (SETQ |mn| (MIN |strsym| |escsym|))
       (COND
        ((EQUAL |mn| |$sz|) (SETQ |$n| |$sz|)
         (|SoftShoeError| (CONS |$linepos| |$n|) "quote added")
         (|subString| |$ln| |n|))
        ((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| (STRING (SCHAR |$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| (SCHAR |line| |n|))))
      (RETURN NIL))
     (T (SETQ |n| (+ |n| 1)))))
   |n|))

(DEFUN |shoeW| (|b|)
  (PROG (|bb| |a| |str| |endid| |l| |n1|)
    (DECLARE (SPECIAL |$n| |$sz| |$ln|))
    (RETURN
     (PROGN
      (SETQ |n1| |$n|)
      (SETQ |$n| (+ |$n| 1))
      (SETQ |l| |$sz|)
      (SETQ |endid| (|shoeIdEnd| |$ln| |$n|))
      (COND
       ((OR (EQUAL |endid| |l|)
            (NOT (CHAR= (SCHAR |$ln| |endid|) (|char| '_))))
        (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 |$n| |$sz| |$ln|))
    (RETURN
     (PROGN
      (SETQ |n| |$n|)
      (SETQ |l| |$sz|)
      (LOOP
       (COND
        ((NOT (AND (< |$n| |l|) (DIGIT-CHAR-P (SCHAR |$ln| |$n|))))
         (RETURN NIL))
        (T (SETQ |$n| (+ |$n| 1)))))
      (COND
       ((OR (EQUAL |$n| |l|) (NOT (CHAR= (SCHAR |$ln| |$n|) (|char| '_))))
        (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 (SETQ |d| (DIGIT-CHAR-P (SCHAR |s| |i|)))
                (SETQ |ival| (+ (* 10 |ival|) |d|))))
         (SETQ |i| (+ |i| 1))))
      |ival|))))

(DEFUN |shoeNumber| ()
  (PROG (|w| |n| |a|)
    (DECLARE (SPECIAL |$n| |$sz| |$floatok| |$ln|))
    (RETURN
     (PROGN
      (SETQ |a| (|shoeInteger|))
      (COND ((NOT (< |$n| |$sz|)) (|shoeLeafInteger| |a|))
            ((AND |$floatok| (CHAR= (SCHAR |$ln| |$n|) (|char| '|.|)))
             (SETQ |n| |$n|) (SETQ |$n| (+ |$n| 1))
             (COND
              ((AND (< |$n| |$sz|) (CHAR= (SCHAR |$ln| |$n|) (|char| '|.|)))
               (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 |$n| |$sz| |$ln|))
    (RETURN
     (COND ((NOT (< |$n| |$sz|)) (|shoeLeafFloat| |a| |w| 0))
           (T (SETQ |n| |$n|) (SETQ |c| (SCHAR |$ln| |$n|))
            (COND
             ((OR (CHAR= |c| (|char| 'E)) (CHAR= |c| (|char| '|e|)))
              (SETQ |$n| (+ |$n| 1))
              (COND
               ((NOT (< |$n| |$sz|)) (SETQ |$n| |n|)
                (|shoeLeafFloat| |a| |w| 0))
               ((DIGIT-CHAR-P (SCHAR |$ln| |$n|)) (SETQ |e| (|shoeInteger|))
                (SETQ |e| (|shoeIntValue| |e|)) (|shoeLeafFloat| |a| |w| |e|))
               (T (SETQ |c1| (SCHAR |$ln| |$n|))
                (COND
                 ((OR (CHAR= |c1| (|char| '+)) (CHAR= |c1| (|char| '-)))
                  (SETQ |$n| (+ |$n| 1))
                  (COND
                   ((NOT (< |$n| |$sz|)) (SETQ |$n| |n|)
                    (|shoeLeafFloat| |a| |w| 0))
                   ((DIGIT-CHAR-P (SCHAR |$ln| |$n|))
                    (SETQ |e| (|shoeInteger|)) (SETQ |e| (|shoeIntValue| |e|))
                    (|shoeLeafFloat| |a| |w|
                                     (COND ((CHAR= |c1| (|char| '-)) (- |e|))
                                           (T |e|))))
                   (T (SETQ |$n| |n|) (|shoeLeafFloat| |a| |w| 0))))))))
             (T (|shoeLeafFloat| |a| |w| 0))))))))

(DEFUN |shoeError| ()
  (PROG (|n|)
    (DECLARE (SPECIAL |$n| |$linepos| |$ln|))
    (RETURN
     (PROGN
      (SETQ |n| |$n|)
      (SETQ |$n| (+ |$n| 1))
      (|SoftShoeError| (CONS |$linepos| |n|)
                       (CONCAT "The character whose number is "
                               (WRITE-TO-STRING (CHAR-CODE (SCHAR |$ln| |n|)))
                               " is not a Boot character"))
      (|shoeLeafError| (SCHAR |$ln| |n|))))))

(DEFUN |shoeKeyWord| (|st|) (|tableValue| |shoeKeyTable| |st|))

(DEFUN |shoeKeyWordP| (|st|) (|tableValue| |shoeKeyTable| |st|))

(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| (CHAR-CODE (SCHAR |l| |i|)))
      (SETQ |u| (ELT |d| |h|))
      (SETQ |ll| (LENGTH |l|))
      (SETQ |done| NIL)
      (SETQ |s1| "")
      (LET ((|bfVar#1| (- (LENGTH |u|) 1)) (|j| 0))
        (LOOP
         (COND ((OR (> |j| |bfVar#1|) |done|) (RETURN NIL))
               (T (SETQ |s| (ELT |u| |j|)) (SETQ |ls| (LENGTH |s|))
                (SETQ |done|
                        (COND ((< |ll| (+ |ls| |i|)) NIL)
                              (T (SETQ |eql| T)
                               (LET ((|bfVar#2| (- |ls| 1)) (|k| 1))
                                 (LOOP
                                  (COND
                                   ((OR (> |k| |bfVar#2|) (NOT |eql|))
                                    (RETURN NIL))
                                   (T
                                    (SETQ |eql|
                                            (CHAR= (SCHAR |s| |k|)
                                                   (SCHAR |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))