aboutsummaryrefslogtreecommitdiff
path: root/src/boot/strap/pile.clisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot/strap/pile.clisp')
-rw-r--r--src/boot/strap/pile.clisp158
1 files changed, 70 insertions, 88 deletions
diff --git a/src/boot/strap/pile.clisp b/src/boot/strap/pile.clisp
index 934e6728..eb3ea075 100644
--- a/src/boot/strap/pile.clisp
+++ b/src/boot/strap/pile.clisp
@@ -16,136 +16,118 @@
(DEFUN |shoePileInsert| (|s|)
(PROG (|a| |toktype|)
(RETURN
- (COND
- ((|bStreamNull| |s|) (CONS NIL |s|))
- (T (SETQ |toktype| (|shoeTokType| (CAAAR |s|)))
- (COND
+ (COND ((|bStreamNull| |s|) (CONS NIL |s|))
+ (T (SETQ |toktype| (|shoeTokType| (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)))))))))
+ (CONS (LIST (ELT |a| 2)) (ELT |a| 3)))))))))
(DEFUN |shoePileTree| (|n| |s|)
(PROG (|hh| |t| |h| |LETTMP#1|)
(RETURN
- (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|))))))))
+ (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|)
(PROG (|hh| |t| |h| |LETTMP#1|)
(RETURN
- (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|))))))))
+ (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|)
(PROG (|t1| |h1| |t| |h| |hh| |b| |LETTMP#1|)
(RETURN
- (PROGN
- (SETQ |LETTMP#1| (|shoePileTree| |n| |s|))
- (SETQ |b| (CAR |LETTMP#1|))
- (SETQ |hh| (CADR . #0=(|LETTMP#1|)))
- (SETQ |h| (CADDR . #0#))
- (SETQ |t| (CADDDR . #0#))
- (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|)))))))
+ (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|)
(PROG (|t1| |h1| |t| |h| |n1| |b| |LETTMP#1|)
(RETURN
- (PROGN
- (SETQ |LETTMP#1| (|eqshoePileTree| |n| |s|))
- (SETQ |b| (CAR |LETTMP#1|))
- (SETQ |n1| (CADR . #0=(|LETTMP#1|)))
- (SETQ |h| (CADDR . #0#))
- (SETQ |t| (CADDDR . #0#))
- (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|)))))))
+ (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|)
(PROG (|t1| |h1| |LETTMP#1|)
(RETURN
- (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|)))))))
+ (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 |shoePileCtree| (|x| |y|) (|dqAppend| |x| (|shoePileCforest| |y|)))
(DEFUN |shoePileCforest| (|x|)
(PROG (|b| |a|)
(RETURN
- (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|)))))))))
+ (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|)
(PROG (|e| |d| |c|)
(RETURN
- (COND
- ((NULL |b|) (LIST |a|))
- (T (SETQ |c| (CAR |b|))
- (COND
+ (COND ((NULL |b|) (LIST |a|))
+ (T (SETQ |c| (CAR |b|))
+ (COND
((OR (EQ (|shoeTokPart| (CAAR |c|)) 'THEN)
(EQ (|shoeTokPart| (CAAR |c|)) 'ELSE))
(|shoePileCoagulate| (|dqAppend| |a| |c|) (CDR |b|)))
(T (SETQ |d| (CADR |a|)) (SETQ |e| (|shoeTokPart| |d|))
- (COND
- ((AND (CONSP |d|) (EQ (CAR |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|))))))))))))
+ (COND
+ ((AND (CONSP |d|) (EQ (CAR |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|)
(PROG (|semicolon| |a|)
(RETURN
- (COND
- ((NULL |x|) NIL)
- ((NULL (CDR |x|)) (CAR |x|))
- (T (SETQ |a| (CAR |x|))
- (SETQ |semicolon|
- (|dqUnit|
+ (COND ((NULL |x|) NIL) ((NULL (CDR |x|)) (CAR |x|))
+ (T (SETQ |a| (CAR |x|))
+ (SETQ |semicolon|
+ (|dqUnit|
(|shoeTokConstruct| 'KEY 'BACKSET
- (|shoeLastTokPosn| |a|))))
- (|dqConcat|
- (LIST |a| |semicolon| (|shoeSeparatePiles| (CDR |x|)))))))))
+ (|shoeLastTokPosn| |a|))))
+ (|dqConcat|
+ (LIST |a| |semicolon| (|shoeSeparatePiles| (CDR |x|)))))))))
(DEFUN |shoeEnPile| (|x|)
(|dqConcat|
- (LIST (|dqUnit|
- (|shoeTokConstruct| 'KEY 'SETTAB
- (|shoeFirstTokPosn| |x|)))
- |x|
- (|dqUnit|
- (|shoeTokConstruct| 'KEY 'BACKTAB
- (|shoeLastTokPosn| |x|))))))
+ (LIST (|dqUnit| (|shoeTokConstruct| 'KEY 'SETTAB (|shoeFirstTokPosn| |x|)))
+ |x|
+ (|dqUnit|
+ (|shoeTokConstruct| 'KEY 'BACKTAB (|shoeLastTokPosn| |x|))))))
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-05 01:32:45 +0000