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

(IN-PACKAGE "BOOTTRAN")

(PROVIDE "tokens")

(DEFCONSTANT |shoeKeyWords|
    (LIST (LIST "and" 'AND) (LIST "by" 'BY) (LIST "case" 'CASE)
          (LIST "catch" 'CATCH) (LIST "cross" 'CROSS)
          (LIST "else" 'ELSE) (LIST "for" 'FOR) (LIST "if" 'IF)
          (LIST "import" 'IMPORT) (LIST "in" 'IN) (LIST "is" 'IS)
          (LIST "isnt" 'ISNT) (LIST "module" 'MODULE) (LIST "of" 'OF)
          (LIST "or" 'OR) (LIST "repeat" 'REPEAT)
          (LIST "return" 'RETURN) (LIST "structure" 'STRUCTURE)
          (LIST "then" 'THEN) (LIST "throw" 'THROW) (LIST "try" 'TRY)
          (LIST "until" 'UNTIL) (LIST "where" 'WHERE)
          (LIST "while" 'WHILE) (LIST "." 'DOT) (LIST ":" 'COLON)
          (LIST "::" 'COLON-COLON) (LIST "," 'COMMA)
          (LIST ";" 'SEMICOLON) (LIST "*" 'TIMES) (LIST "**" 'POWER)
          (LIST "/" 'SLASH) (LIST "+" 'PLUS) (LIST "-" 'MINUS)
          (LIST "<" 'LT) (LIST ">" 'GT) (LIST "<=" 'LE) (LIST ">=" 'GE)
          (LIST "=" 'SHOEEQ) (LIST "^" 'NOTRETIRED)
          (LIST "^=" 'SHOENERETIRED) (LIST "~=" 'SHOENE)
          (LIST ".." 'SEG) (LIST "#" 'LENGTH) (LIST "=>" 'EXIT)
          (LIST "->" 'ARROW) (LIST ":=" 'BEC) (LIST "==" 'DEF)
          (LIST "==>" 'MDEF) (LIST "<=>" 'TDEF) (LIST "(" 'OPAREN)
          (LIST ")" 'CPAREN) (LIST "(|" 'OBRACK) (LIST "|)" 'CBRACK)
          (LIST "[" 'OBRACK) (LIST "]" 'CBRACK) (LIST "suchthat" 'BAR)
          (LIST "'" 'QUOTE) (LIST "|" 'BAR)))

(DEFUN |shoeKeyTableCons| ()
  (PROG (|KeyTable|)
    (RETURN
      (PROGN
        (SETQ |KeyTable| (MAKE-HASHTABLE 'CVEC))
        (LET ((|bfVar#1| |shoeKeyWords|) (|st| NIL))
          (LOOP
            (COND
              ((OR (ATOM |bfVar#1|)
                   (PROGN (SETQ |st| (CAR |bfVar#1|)) NIL))
               (RETURN NIL))
              ('T (HPUT |KeyTable| (CAR |st|) (CADR |st|))))
            (SETQ |bfVar#1| (CDR |bfVar#1|))))
        |KeyTable|))))

(DEFPARAMETER |shoeKeyTable| (|shoeKeyTableCons|))

(DEFCONSTANT |shoeSPACE| (QENUM "    " 0))

(DEFCONSTANT |shoeESCAPE| (QENUM "_  " 0))

(DEFPARAMETER |shoeLispESCAPE| (QENUM "!  " 0))

(DEFCONSTANT |shoeSTRINGCHAR| (QENUM "\"  " 0))

(DEFCONSTANT |shoePLUSCOMMENT| (QENUM "+   " 0))

(DEFCONSTANT |shoeMINUSCOMMENT| (QENUM "-   " 0))

(DEFCONSTANT |shoeDOT| (QENUM ".   " 0))

(DEFCONSTANT |shoeEXPONENT1| (QENUM "E   " 0))

(DEFCONSTANT |shoeEXPONENT2| (QENUM "e   " 0))

(DEFCONSTANT |shoeCLOSEPAREN| (QENUM ")   " 0))

(DEFCONSTANT |shoeTAB| 9)

(DEFUN |shoeInsert| (|s| |d|)
  (PROG (|v| |k| |n| |u| |h| |l|)
    (RETURN
      (PROGN
        (SETQ |l| (LENGTH |s|))
        (SETQ |h| (QENUM |s| 0))
        (SETQ |u| (ELT |d| |h|))
        (SETQ |n| (LENGTH |u|))
        (SETQ |k| 0)
        (LOOP
          (COND
            ((< (LENGTH (ELT |u| |k|)) |l|) (RETURN NIL))
            (#0='T (SETQ |k| (+ |k| 1)))))
        (SETQ |v| (MAKE-VEC (+ |n| 1)))
        (LET ((|bfVar#2| (- |k| 1)) (|i| 0))
          (LOOP
            (COND
              ((> |i| |bfVar#2|) (RETURN NIL))
              (#0# (VEC-SETELT |v| |i| (ELT |u| |i|))))
            (SETQ |i| (+ |i| 1))))
        (VEC-SETELT |v| |k| |s|)
        (LET ((|bfVar#3| (- |n| 1)) (|i| |k|))
          (LOOP
            (COND
              ((> |i| |bfVar#3|) (RETURN NIL))
              (#0# (VEC-SETELT |v| (+ |i| 1) (ELT |u| |i|))))
            (SETQ |i| (+ |i| 1))))
        (VEC-SETELT |d| |h| |v|)
        |s|))))

(DEFUN |shoeDictCons| ()
  (PROG (|d| |b| |a| |l|)
    (RETURN
      (PROGN
        (SETQ |l| (HKEYS |shoeKeyTable|))
        (SETQ |d|
              (PROGN
                (SETQ |a| (MAKE-VEC 256))
                (SETQ |b| (MAKE-VEC 1))
                (VEC-SETELT |b| 0 (MAKE-CVEC 0))
                (LET ((|i| 0))
                  (LOOP
                    (COND
                      ((> |i| 255) (RETURN NIL))
                      (#0='T (VEC-SETELT |a| |i| |b|)))
                    (SETQ |i| (+ |i| 1))))
                |a|))
        (LET ((|bfVar#4| |l|) (|s| NIL))
          (LOOP
            (COND
              ((OR (ATOM |bfVar#4|)
                   (PROGN (SETQ |s| (CAR |bfVar#4|)) NIL))
               (RETURN NIL))
              (#0# (|shoeInsert| |s| |d|)))
            (SETQ |bfVar#4| (CDR |bfVar#4|))))
        |d|))))

(DEFPARAMETER |shoeDict| (|shoeDictCons|))

(DEFUN |shoePunCons| ()
  (PROG (|a| |listing|)
    (RETURN
      (PROGN
        (SETQ |listing| (HKEYS |shoeKeyTable|))
        (SETQ |a| (MAKE-BVEC 256))
        (LET ((|i| 0))
          (LOOP
            (COND
              ((> |i| 255) (RETURN NIL))
              (#0='T (BVEC-SETELT |a| |i| 0)))
            (SETQ |i| (+ |i| 1))))
        (LET ((|bfVar#5| |listing|) (|k| NIL))
          (LOOP
            (COND
              ((OR (ATOM |bfVar#5|)
                   (PROGN (SETQ |k| (CAR |bfVar#5|)) NIL))
               (RETURN NIL))
              (#0#
               (COND
                 ((NOT (|shoeStartsId| (ELT |k| 0)))
                  (BVEC-SETELT |a| (QENUM |k| 0) 1)))))
            (SETQ |bfVar#5| (CDR |bfVar#5|))))
        |a|))))

(DEFPARAMETER |shoePun| (|shoePunCons|))

(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
  (LET ((|bfVar#6| (LIST 'NOT 'LENGTH)) (|i| NIL))
    (LOOP
      (COND
        ((OR (ATOM |bfVar#6|) (PROGN (SETQ |i| (CAR |bfVar#6|)) NIL))
         (RETURN NIL))
        ('T (SETF (GET |i| 'SHOEPRE) 'T)))
      (SETQ |bfVar#6| (CDR |bfVar#6|)))))

(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
  (LET ((|bfVar#7| (LIST (LIST 'SHOEEQ '=) (LIST 'TIMES '*)
                         (LIST 'PLUS '+) (LIST 'IS '|is|)
                         (LIST 'ISNT '|isnt|) (LIST 'AND '|and|)
                         (LIST 'OR '|or|) (LIST 'SLASH '/)
                         (LIST 'POWER '**) (LIST 'MINUS '-)
                         (LIST 'LT '<) (LIST 'GT '>) (LIST 'LE '<=)
                         (LIST 'GE '>=) (LIST 'SHOENE '~=)))
        (|i| NIL))
    (LOOP
      (COND
        ((OR (ATOM |bfVar#7|) (PROGN (SETQ |i| (CAR |bfVar#7|)) NIL))
         (RETURN NIL))
        ('T (SETF (GET (CAR |i|) 'SHOEINF) (CADR |i|))))
      (SETQ |bfVar#7| (CDR |bfVar#7|)))))

(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
  (LET ((|bfVar#8|
            (LIST (LIST '+ 0) (LIST '|gcd| 0) (LIST '|lcm| 1)
                  (LIST 'STRCONC "") (LIST '|strconc| "")
                  (LIST 'CONCAT "") (LIST 'MAX (- 999999))
                  (LIST 'MIN 999999) (LIST '* 1) (LIST '|times| 1)
                  (LIST 'CONS NIL) (LIST 'APPEND NIL)
                  (LIST '|append| NIL) (LIST 'UNION NIL)
                  (LIST 'UNIONQ NIL) (LIST '|union| NIL)
                  (LIST 'NCONC NIL) (LIST '|and| 'T) (LIST '|or| NIL)
                  (LIST 'AND 'T) (LIST 'OR NIL)))
        (|i| NIL))
    (LOOP
      (COND
        ((OR (ATOM |bfVar#8|) (PROGN (SETQ |i| (CAR |bfVar#8|)) NIL))
         (RETURN NIL))
        ('T (SETF (GET (CAR |i|) 'SHOETHETA) (CDR |i|))))
      (SETQ |bfVar#8| (CDR |bfVar#8|)))))

(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
  (LET ((|bfVar#9| (LIST (LIST '|and| 'AND) (LIST '|append| 'APPEND)
                         (LIST '|apply| 'APPLY) (LIST '|atom| 'ATOM)
                         (LIST '|car| 'CAR) (LIST '|cdr| 'CDR)
                         (LIST '|cons| 'CONS) (LIST '|copy| 'COPY)
                         (LIST '|croak| 'CROAK) (LIST '|drop| 'DROP)
                         (LIST '|exit| 'EXIT) (LIST '|false| 'NIL)
                         (LIST '|first| 'CAR) (LIST '|fourth| 'CADDDR)
                         (LIST '|function| 'FUNCTION)
                         (LIST '|genvar| 'GENVAR) (LIST 'IN 'MEMBER)
                         (LIST '|is| 'IS) (LIST '|isnt| 'ISNT)
                         (LIST '|lastNode| 'LAST) (LIST 'LAST '|last|)
                         (LIST '|list| 'LIST) (LIST '|mkpf| 'MKPF)
                         (LIST '|nconc| 'NCONC) (LIST '|nil| NIL)
                         (LIST '|not| 'NOT)
                         (LIST '|nreverse| 'NREVERSE)
                         (LIST '|null| 'NULL) (LIST '|or| 'OR)
                         (LIST '|otherwise| 'T) (LIST 'PAIRP 'CONSP)
                         (LIST '|removeDuplicates| 'REMDUP)
                         (LIST '|rest| 'CDR) (LIST '|reverse| 'REVERSE)
                         (LIST '|second| 'CADR)
                         (LIST '|setDifference| 'SETDIFFERENCE)
                         (LIST '|setIntersection| 'INTERSECTION)
                         (LIST '|setPart| 'SETELT)
                         (LIST '|setUnion| 'UNION) (LIST '|size| 'SIZE)
                         (LIST '|strconc| 'CONCAT)
                         (LIST '|substitute| 'SUBST)
                         (LIST '|take| 'TAKE) (LIST '|third| 'CADDR)
                         (LIST '|true| 'T) (LIST 'PLUS '+)
                         (LIST 'MINUS '-) (LIST 'TIMES '*)
                         (LIST 'POWER 'EXPT) (LIST 'SLASH '/)
                         (LIST 'LT '<) (LIST 'GT '>) (LIST 'LE '<=)
                         (LIST 'GE '>=) (LIST 'SHOEEQ 'EQUAL)
                         (LIST 'SHOENE '/=) (LIST 'T 'T$)))
        (|i| NIL))
    (LOOP
      (COND
        ((OR (ATOM |bfVar#9|) (PROGN (SETQ |i| (CAR |bfVar#9|)) NIL))
         (RETURN NIL))
        ('T (SETF (GET (CAR |i|) 'SHOERENAME) (CDR |i|))))
      (SETQ |bfVar#9| (CDR |bfVar#9|)))))

(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
  (LET ((|bfVar#10| (LIST (LIST 'PLUS 'PLUS) (LIST '|and| 'AND)
                          (LIST '|append| 'APPEND)
                          (LIST '|apply| 'APPLY) (LIST '|atom| 'ATOM)
                          (LIST '|brace| 'REMDUP) (LIST '|car| 'CAR)
                          (LIST '|cdr| 'CDR) (LIST '|cons| 'CONS)
                          (LIST '|copy| 'COPY) (LIST '|croak| 'CROAK)
                          (LIST '|drop| 'DROP) (LIST '|exit| 'EXIT)
                          (LIST '|false| 'NIL) (LIST '|first| 'CAR)
                          (LIST '|genvar| 'GENVAR)
                          (LIST '|in| '|member|) (LIST '|is| 'IS)
                          (LIST '|lastNode| 'LASTNODE)
                          (LIST '|list| 'LIST) (LIST '|mkpf| 'MKPF)
                          (LIST '|nconc| 'NCONC) (LIST '|nil| 'NIL)
                          (LIST '|not| 'NOT)
                          (LIST '|nreverse| 'NREVERSE)
                          (LIST '|null| 'NULL) (LIST '|or| 'OR)
                          (LIST '|otherwise| 'T)
                          (LIST '|removeDuplicates| 'REMDUP)
                          (LIST '|rest| 'CDR) (LIST '|return| 'RETURN)
                          (LIST '|reverse| 'REVERSE)
                          (LIST '|setDifference| 'SETDIFFERENCE)
                          (LIST '|setIntersection| '|intersection|)
                          (LIST '|setPart| 'SETELT)
                          (LIST '|setUnion| '|union|)
                          (LIST '|size| 'SIZE)
                          (LIST '|strconc| 'STRCONC)
                          (LIST '|substitute| 'MSUBST)
                          (LIST 'SUBST 'MSUBST) (LIST '|take| 'TAKE)
                          (LIST '|true| 'T) (LIST '|where| 'WHERE)
                          (LIST 'TIMES 'TIMES) (LIST 'POWER 'EXPT)
                          (LIST 'SHOENE 'NEQUAL)
                          (LIST 'MINUS 'SPADDIFFERENCE)
                          (LIST 'SLASH 'QUOTIENT) (LIST '= 'EQUAL)
                          (LIST 'SHOEEQ 'EQUAL) (LIST 'ASSOC '|assoc|)
                          (LIST 'DELETE '|delete|) (LIST 'GET 'GETL)
                          (LIST 'INTERSECTION '|intersection|)
                          (LIST 'LAST '|last|) (LIST 'MEMBER '|member|)
                          (LIST 'RASSOC '|rassoc|) (LIST 'READ 'VMREAD)
                          (LIST 'READ-LINE '|read-line|)
                          (LIST 'REDUCE 'SPADREDUCE)
                          (LIST 'REMOVE '|remove|)
                          (LIST 'BAR 'SUCHTHAT) (LIST 'T 'T$)
                          (LIST 'IN '|member|) (LIST 'UNION '|union|)))
        (|i| NIL))
    (LOOP
      (COND
        ((OR (ATOM |bfVar#10|) (PROGN (SETQ |i| (CAR |bfVar#10|)) NIL))
         (RETURN NIL))
        ('T (SETF (GET (CAR |i|) 'OLD-BOOT) (CDR |i|))))
      (SETQ |bfVar#10| (CDR |bfVar#10|)))))

(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
  (LET ((|bfVar#11|
            (LIST 'LT 'LE 'GT 'GE 'SHOENE 'TIMES 'PLUS 'MINUS
                  '|function| 'PAIRP))
        (|i| NIL))
    (LOOP
      (COND
        ((OR (ATOM |bfVar#11|) (PROGN (SETQ |i| (CAR |bfVar#11|)) NIL))
         (RETURN NIL))
        ('T (SETF (GET |i| 'RENAME-OK) T)))
      (SETQ |bfVar#11| (CDR |bfVar#11|)))))

(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
  (LET ((|bfVar#12| (LIST (LIST '|setName| 0) (LIST '|setLabel| 1)
                          (LIST '|setLevel| 2) (LIST '|setType| 3)
                          (LIST '|setVar| 4) (LIST '|setLeaf| 5)
                          (LIST '|setDef| 6) (LIST '|aGeneral| 4)
                          (LIST '|aMode| 1) (LIST '|aModeSet| 3)
                          (LIST '|aTree| 0) (LIST '|aValue| 2)
                          (LIST '|attributes| 'CADDR)
                          (LIST '|cacheCount| 'CADDDDR)
                          (LIST '|cacheName| 'CADR)
                          (LIST '|cacheReset| 'CADDDR)
                          (LIST '|cacheType| 'CADDR)
                          (LIST '|env| 'CADDR) (LIST '|expr| 'CAR)
                          (LIST 'CAR 'CAR) (LIST '|mmCondition| 'CAADR)
                          (LIST '|mmDC| 'CAAR)
                          (LIST '|mmImplementation| 'CADADR)
                          (LIST '|mmSignature| 'CDAR)
                          (LIST '|mmTarget| 'CADAR)
                          (LIST '|mode| 'CADR) (LIST '|op| 'CAR)
                          (LIST '|opcode| 'CADR) (LIST '|opSig| 'CADR)
                          (LIST 'CDR 'CDR) (LIST '|sig| 'CDDR)
                          (LIST '|source| 'CDR)
                          (LIST '|streamCode| 'CADDDR)
                          (LIST '|streamDef| 'CADDR)
                          (LIST '|streamName| 'CADR)
                          (LIST '|target| 'CAR)))
        (|i| NIL))
    (LOOP
      (COND
        ((OR (ATOM |bfVar#12|) (PROGN (SETQ |i| (CAR |bfVar#12|)) NIL))
         (RETURN NIL))
        ('T (SETF (GET (CAR |i|) 'SHOESELFUNCTION) (CADR |i|))))
      (SETQ |bfVar#12| (CDR |bfVar#12|)))))