blob: 6eb0c938813b985bd1876f4e3b17c7e177655c54 (
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
|
(PROCLAIM '(OPTIMIZE SPEED))
(IMPORT-MODULE "includer")
(IMPORT-MODULE "scanner")
(IN-PACKAGE "BOOTTRAN")
(PROVIDE "pile")
(DEFUN |shoeFirstTokPosn| (|t|) (|tokenPosition| (CAAR |t|)))
(DEFUN |shoeLastTokPosn| (|t|) (|tokenPosition| (CADR |t|)))
(DEFUN |shoePileColumn| (|t|) (CDR (|tokenPosition| (CAAR |t|))))
(DEFUN |shoePileInsert| (|s|)
(LET* (|a| |toktype|)
(COND ((|bStreamNull| |s|) (CONS NIL |s|))
(T (SETQ |toktype| (|tokenClass| (CAAAR |s|)))
(COND
((OR (EQ |toktype| 'LISP) (EQ |toktype| 'LINE))
(CONS (LIST (CAR |s|)) (CDR |s|)))
(T (SETQ |a| (|shoePileTree| (- 1) |s|))
(CONS (LIST (ELT |a| 2)) (ELT |a| 3))))))))
(DEFUN |shoePileTree| (|n| |s|)
(LET* (|hh| |t| |h| |LETTMP#1|)
(COND ((|bStreamNull| |s|) (LIST NIL |n| NIL |s|))
(T (SETQ |LETTMP#1| (LIST (CAR |s|) (CDR |s|)))
(SETQ |h| (CAR |LETTMP#1|)) (SETQ |t| (CADR |LETTMP#1|))
(SETQ |hh| (|shoePileColumn| |h|))
(COND ((< |n| |hh|) (|shoePileForests| |h| |hh| |t|))
(T (LIST NIL |n| NIL |s|)))))))
(DEFUN |eqshoePileTree| (|n| |s|)
(LET* (|hh| |t| |h| |LETTMP#1|)
(COND ((|bStreamNull| |s|) (LIST NIL |n| NIL |s|))
(T (SETQ |LETTMP#1| (LIST (CAR |s|) (CDR |s|)))
(SETQ |h| (CAR |LETTMP#1|)) (SETQ |t| (CADR |LETTMP#1|))
(SETQ |hh| (|shoePileColumn| |h|))
(COND ((EQUAL |hh| |n|) (|shoePileForests| |h| |hh| |t|))
(T (LIST NIL |n| NIL |s|)))))))
(DEFUN |shoePileForest| (|n| |s|)
(LET* (|t1| |h1| |t| |h| |hh| |b| |LETTMP#1|)
(PROGN
(SETQ |LETTMP#1| (|shoePileTree| |n| |s|))
(SETQ |b| (CAR |LETTMP#1|))
(SETQ |hh| (CADR . #1=(|LETTMP#1|)))
(SETQ |h| (CADDR . #1#))
(SETQ |t| (CADDDR . #1#))
(COND
(|b| (SETQ |LETTMP#1| (|shoePileForest1| |hh| |t|))
(SETQ |h1| (CAR |LETTMP#1|)) (SETQ |t1| (CADR |LETTMP#1|))
(LIST (CONS |h| |h1|) |t1|))
(T (LIST NIL |s|))))))
(DEFUN |shoePileForest1| (|n| |s|)
(LET* (|t1| |h1| |t| |h| |n1| |b| |LETTMP#1|)
(PROGN
(SETQ |LETTMP#1| (|eqshoePileTree| |n| |s|))
(SETQ |b| (CAR |LETTMP#1|))
(SETQ |n1| (CADR . #1=(|LETTMP#1|)))
(SETQ |h| (CADDR . #1#))
(SETQ |t| (CADDDR . #1#))
(COND
(|b| (SETQ |LETTMP#1| (|shoePileForest1| |n| |t|))
(SETQ |h1| (CAR |LETTMP#1|)) (SETQ |t1| (CADR |LETTMP#1|))
(LIST (CONS |h| |h1|) |t1|))
(T (LIST NIL |s|))))))
(DEFUN |shoePileForests| (|h| |n| |s|)
(LET* (|t1| |h1| |LETTMP#1|)
(PROGN
(SETQ |LETTMP#1| (|shoePileForest| |n| |s|))
(SETQ |h1| (CAR |LETTMP#1|))
(SETQ |t1| (CADR |LETTMP#1|))
(COND ((|bStreamNull| |h1|) (LIST T |n| |h| |s|))
(T (|shoePileForests| (|shoePileCtree| |h| |h1|) |n| |t1|))))))
(DEFUN |shoePileCtree| (|x| |y|) (|dqAppend| |x| (|shoePileCforest| |y|)))
(DEFUN |shoePileCforest| (|x|)
(LET* (|b| |a|)
(COND ((NULL |x|) NIL) ((NULL (CDR |x|)) (CAR |x|))
(T (SETQ |a| (CAR |x|))
(SETQ |b| (|shoePileCoagulate| |a| (CDR |x|)))
(COND ((NULL (CDR |b|)) (CAR |b|))
(T (|shoeEnPile| (|shoeSeparatePiles| |b|))))))))
(DEFUN |shoePileCoagulate| (|a| |b|)
(LET* (|e| |d| |c|)
(COND ((NULL |b|) (LIST |a|))
(T (SETQ |c| (CAR |b|))
(COND
((OR (EQ (|tokenValue| (CAAR |c|)) 'THEN)
(EQ (|tokenValue| (CAAR |c|)) 'ELSE))
(|shoePileCoagulate| (|dqAppend| |a| |c|) (CDR |b|)))
(T (SETQ |d| (CADR |a|)) (SETQ |e| (|tokenValue| |d|))
(COND
((AND (EQ (|tokenClass| |d|) 'KEY)
(OR (GET |e| 'SHOEINF) (EQ |e| 'COMMA)
(EQ |e| 'SEMICOLON)))
(|shoePileCoagulate| (|dqAppend| |a| |c|) (CDR |b|)))
(T (CONS |a| (|shoePileCoagulate| |c| (CDR |b|)))))))))))
(DEFUN |shoeSeparatePiles| (|x|)
(LET* (|semicolon| |a|)
(COND ((NULL |x|) NIL) ((NULL (CDR |x|)) (CAR |x|))
(T (SETQ |a| (CAR |x|))
(SETQ |semicolon|
(|dqUnit|
(|mk%Token| 'KEY 'BACKSET (|shoeLastTokPosn| |a|))))
(|dqConcat|
(LIST |a| |semicolon| (|shoeSeparatePiles| (CDR |x|))))))))
(DEFUN |shoeEnPile| (|x|)
(|dqConcat|
(LIST (|dqUnit| (|mk%Token| 'KEY 'SETTAB (|shoeFirstTokPosn| |x|))) |x|
(|dqUnit| (|mk%Token| 'KEY 'BACKTAB (|shoeLastTokPosn| |x|))))))
|
