aboutsummaryrefslogtreecommitdiff
path: root/src/boot/strap/includer.clisp
diff options
context:
space:
mode:
Diffstat (limited to 'src/boot/strap/includer.clisp')
-rw-r--r--src/boot/strap/includer.clisp293
1 files changed, 129 insertions, 164 deletions
diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp
index 08964695..6146ddc7 100644
--- a/src/boot/strap/includer.clisp
+++ b/src/boot/strap/includer.clisp
@@ -93,24 +93,20 @@
(RETURN
(COND
((|bStreamNull| |stream|) (LIST NIL (LIST '|nullstream|)))
- ('T
- (PROGN
- (SETQ |a| (CAAR |stream|))
- (COND
- ((AND (NOT (< (LENGTH |a|) 8))
- (EQUAL (SUBSTRING |a| 0 8) ")package"))
- (|shoePackageStartsAt| (CONS (CAAR |stream|) |lines|)
- |sz| |name| (CDR |stream|)))
- ((< (LENGTH |a|) |sz|)
- (|shoePackageStartsAt| |lines| |sz| |name|
- (CDR |stream|)))
- ((AND (EQUAL (SUBSTRING |a| 0 |sz|) |name|)
- (< |sz| (LENGTH |a|))
- (NOT (|shoeIdChar| (ELT |a| |sz|))))
- (LIST |lines| |stream|))
- ('T
- (|shoePackageStartsAt| |lines| |sz| |name|
- (CDR |stream|))))))))))
+ ('T (SETQ |a| (CAAR |stream|))
+ (COND
+ ((AND (NOT (< (LENGTH |a|) 8))
+ (EQUAL (SUBSTRING |a| 0 8) ")package"))
+ (|shoePackageStartsAt| (CONS (CAAR |stream|) |lines|) |sz|
+ |name| (CDR |stream|)))
+ ((< (LENGTH |a|) |sz|)
+ (|shoePackageStartsAt| |lines| |sz| |name| (CDR |stream|)))
+ ((AND (EQUAL (SUBSTRING |a| 0 |sz|) |name|)
+ (< |sz| (LENGTH |a|))
+ (NOT (|shoeIdChar| (ELT |a| |sz|))))
+ (LIST |lines| |stream|))
+ ('T
+ (|shoePackageStartsAt| |lines| |sz| |name| (CDR |stream|)))))))))
(DEFUN |shoeFindLines| (|fn| |name| |a|)
(PROG (|b| |lines| |LETTMP#1|)
@@ -140,16 +136,15 @@
(COND
((OR (NULL |x|) (EQCAR |x| '|nullstream|)) T)
('T
- (PROGN
- (LOOP
- (COND
- ((NOT (EQCAR |x| '|nonnullstream|)) (RETURN NIL))
- ('T
- (PROGN
- (SETQ |st| (APPLY (CADR |x|) (CDDR |x|)))
- (RPLACA |x| (CAR |st|))
- (RPLACD |x| (CDR |st|))))))
- (EQCAR |x| '|nullstream|)))))))
+ (LOOP
+ (COND
+ ((NOT (EQCAR |x| '|nonnullstream|)) (RETURN NIL))
+ ('T
+ (PROGN
+ (SETQ |st| (APPLY (CADR |x|) (CDDR |x|)))
+ (RPLACA |x| (CAR |st|))
+ (RPLACD |x| (CDR |st|))))))
+ (EQCAR |x| '|nullstream|))))))
(DEFUN |bMap| (|f| |x|) (|bDelay| #'|bMap1| (LIST |f| |x|)))
@@ -171,16 +166,12 @@
(PROGN
(SETQ |a| (|shoeInputFile| |fn|))
(COND
- ((NULL |a|)
- (PROGN
- (|shoeConsole| (CONCAT |fn| " NOT FOUND"))
- |$bStreamNil|))
- ('T
- (PROGN
- (|shoeConsole| (CONCAT "READING " |fn|))
- (|shoeInclude|
- (|bAddLineNumber| (|bMap| |f| (|bRgen| |a|))
- (|bIgen| 0))))))))))
+ ((NULL |a|) (|shoeConsole| (CONCAT |fn| " NOT FOUND"))
+ |$bStreamNil|)
+ ('T (|shoeConsole| (CONCAT "READING " |fn|))
+ (|shoeInclude|
+ (|bAddLineNumber| (|bMap| |f| (|bRgen| |a|))
+ (|bIgen| 0)))))))))
(DEFUN |bDelay| (|f| |x|) (CONS '|nonnullstream| (CONS |f| |x|)))
@@ -201,10 +192,8 @@
(RETURN
(COND
((|bStreamNull| |s|) (LIST '|nullstream|))
- ('T
- (PROGN
- (SETQ |h| (APPLY |f| (LIST |s|)))
- (|bAppend| (CAR |h|) (|bNext| |f| (CDR |h|)))))))))
+ ('T (SETQ |h| (APPLY |f| (LIST |s|)))
+ (|bAppend| (CAR |h|) (|bNext| |f| (CDR |h|))))))))
(DEFUN |bRgen| (|s|) (|bDelay| #'|bRgen1| (LIST |s|)))
@@ -255,21 +244,19 @@
(RETURN
(COND
((< (LENGTH |whole|) (LENGTH |prefix|)) NIL)
- ('T
- (PROGN
- (SETQ |good| T)
- (LET ((|bfVar#1| (- (LENGTH |prefix|) 1)) (|i| 0) (|j| 0))
- (LOOP
- (COND
- ((OR (> |i| |bfVar#1|) (NOT |good|)) (RETURN NIL))
- ('T
- (SETQ |good|
- (EQUAL (ELT |prefix| |i|) (ELT |whole| |j|)))))
- (SETQ |i| (+ |i| 1))
- (SETQ |j| (+ |j| 1))))
- (COND
- (|good| (SUBSTRING |whole| (LENGTH |prefix|) NIL))
- ('T |good|))))))))
+ ('T (SETQ |good| T)
+ (LET ((|bfVar#1| (- (LENGTH |prefix|) 1)) (|i| 0) (|j| 0))
+ (LOOP
+ (COND
+ ((OR (> |i| |bfVar#1|) (NOT |good|)) (RETURN NIL))
+ ('T
+ (SETQ |good|
+ (EQUAL (ELT |prefix| |i|) (ELT |whole| |j|)))))
+ (SETQ |i| (+ |i| 1))
+ (SETQ |j| (+ |j| 1))))
+ (COND
+ (|good| (SUBSTRING |whole| (LENGTH |prefix|) NIL))
+ ('T |good|)))))))
(DEFUN |shoePlainLine?| (|s|)
(COND
@@ -312,14 +299,12 @@
(SETQ |n| (STRPOSL " " |x| 0 T))
(COND
((NULL |n|) NIL)
- (#0='T
- (PROGN
- (SETQ |n1| (STRPOSL " " |x| |n| NIL))
- (COND
- ((NULL |n1|) (LIST (SUBSTRING |x| |n| NIL) ""))
- (#0#
- (LIST (SUBSTRING |x| |n| (- |n1| |n|))
- (SUBSTRING |x| |n1| NIL)))))))))))
+ (#0='T (SETQ |n1| (STRPOSL " " |x| |n| NIL))
+ (COND
+ ((NULL |n1|) (LIST (SUBSTRING |x| |n| NIL) ""))
+ (#0#
+ (LIST (SUBSTRING |x| |n| (- |n1| |n|))
+ (SUBSTRING |x| |n1| NIL))))))))))
(DEFUN |shoeFileName| (|x|)
(PROG (|c| |a|)
@@ -328,12 +313,10 @@
(SETQ |a| (|shoeBiteOff| |x|))
(COND
((NULL |a|) "")
- (#0='T
- (PROGN
- (SETQ |c| (|shoeBiteOff| (CADR |a|)))
- (COND
- ((NULL |c|) (CAR |a|))
- (#0# (CONCAT (CAR |a|) "." (CAR |c|)))))))))))
+ (#0='T (SETQ |c| (|shoeBiteOff| (CADR |a|)))
+ (COND
+ ((NULL |c|) (CAR |a|))
+ (#0# (CONCAT (CAR |a|) "." (CAR |c|))))))))))
(DEFUN |shoeFnFileName| (|x|)
(PROG (|c| |a|)
@@ -342,12 +325,10 @@
(SETQ |a| (|shoeBiteOff| |x|))
(COND
((NULL |a|) (LIST "" ""))
- (#0='T
- (PROGN
- (SETQ |c| (|shoeFileName| (CADR |a|)))
- (COND
- ((NULL |c|) (LIST (CAR |a|) ""))
- (#0# (LIST (CAR |a|) |c|))))))))))
+ (#0='T (SETQ |c| (|shoeFileName| (CADR |a|)))
+ (COND
+ ((NULL |c|) (LIST (CAR |a|) ""))
+ (#0# (LIST (CAR |a|) |c|)))))))))
(DEFUN |shoeFunctionFileInput| (|bfVar#2|)
(PROG (|fn| |fun|)
@@ -368,17 +349,13 @@
(RETURN
(COND
((|bStreamNull| |s|) |s|)
- (#0='T
- (PROGN
- (SETQ |h| (CAR |s|))
- (SETQ |t| (CDR |s|))
- (SETQ |string| (CAR |h|))
- (COND
- ((SETQ |command| (|shoeFin?| |string|)) |$bStreamNil|)
- ((SETQ |command| (|shoeIf?| |string|))
- (|shoeThen| (LIST T) (LIST (STTOMC |command|)) |t|))
- (#0#
- (|bAppend| (|shoeSimpleLine| |h|) (|shoeInclude| |t|))))))))))
+ (#0='T (SETQ |h| (CAR |s|)) (SETQ |t| (CDR |s|))
+ (SETQ |string| (CAR |h|))
+ (COND
+ ((SETQ |command| (|shoeFin?| |string|)) |$bStreamNil|)
+ ((SETQ |command| (|shoeIf?| |string|))
+ (|shoeThen| (LIST T) (LIST (STTOMC |command|)) |t|))
+ (#0# (|bAppend| (|shoeSimpleLine| |h|) (|shoeInclude| |t|)))))))))
(DEFUN |shoeSimpleLine| (|h|)
(PROG (|command| |string|)
@@ -399,10 +376,10 @@
(|shoeFileInput| (|shoeFileName| |command|)))
((SETQ |command| (|shoePackage?| |string|)) (LIST |h|))
((SETQ |command| (|shoeSay?| |string|))
- (PROGN (|shoeConsole| |command|) NIL))
- ((SETQ |command| (|shoeEval?| |string|))
- (PROGN (STTOMC |command|) NIL))
- ('T (PROGN (|shoeLineSyntaxError| |h|) NIL)))))))
+ (|shoeConsole| |command|) NIL)
+ ((SETQ |command| (|shoeEval?| |string|)) (STTOMC |command|)
+ NIL)
+ ('T (|shoeLineSyntaxError| |h|) NIL))))))
(DEFUN |shoeThen| (|keep| |b| |s|)
(|bDelay| #'|shoeThen1| (LIST |keep| |b| |s|)))
@@ -412,50 +389,44 @@
(RETURN
(COND
((|bPremStreamNull| |s|) |s|)
- (#0='T
- (PROGN
- (SETQ |h| (CAR |s|))
- (SETQ |t| (CDR |s|))
- (SETQ |string| (CAR |h|))
- (COND
- ((SETQ |command| (|shoeFin?| |string|))
- (|bPremStreamNil| |h|))
- (#0#
- (PROGN
- (SETQ |keep1| (CAR |keep|))
- (SETQ |b1| (CAR |b|))
- (COND
- ((SETQ |command| (|shoeIf?| |string|))
- (COND
- ((AND |keep1| |b1|)
- (|shoeThen| (CONS T |keep|)
- (CONS (STTOMC |command|) |b|) |t|))
- (#0#
- (|shoeThen| (CONS NIL |keep|) (CONS NIL |b|) |t|))))
- ((SETQ |command| (|shoeElseIf?| |string|))
- (COND
- ((AND |keep1| (NOT |b1|))
- (|shoeThen| (CONS T (CDR |keep|))
- (CONS (STTOMC |command|) (CDR |b|)) |t|))
- (#0#
- (|shoeThen| (CONS NIL (CDR |keep|))
- (CONS NIL (CDR |b|)) |t|))))
- ((SETQ |command| (|shoeElse?| |string|))
- (COND
- ((AND |keep1| (NOT |b1|))
- (|shoeElse| (CONS T (CDR |keep|))
- (CONS T (CDR |b|)) |t|))
- (#0#
- (|shoeElse| (CONS NIL (CDR |keep|))
- (CONS NIL (CDR |b|)) |t|))))
- ((SETQ |command| (|shoeEndIf?| |string|))
- (COND
- ((NULL (CDR |b|)) (|shoeInclude| |t|))
- (#0# (|shoeThen| (CDR |keep|) (CDR |b|) |t|))))
- ((AND |keep1| |b1|)
- (|bAppend| (|shoeSimpleLine| |h|)
- (|shoeThen| |keep| |b| |t|)))
- (#0# (|shoeThen| |keep| |b| |t|))))))))))))
+ (#0='T (SETQ |h| (CAR |s|)) (SETQ |t| (CDR |s|))
+ (SETQ |string| (CAR |h|))
+ (COND
+ ((SETQ |command| (|shoeFin?| |string|))
+ (|bPremStreamNil| |h|))
+ (#0# (SETQ |keep1| (CAR |keep|)) (SETQ |b1| (CAR |b|))
+ (COND
+ ((SETQ |command| (|shoeIf?| |string|))
+ (COND
+ ((AND |keep1| |b1|)
+ (|shoeThen| (CONS T |keep|)
+ (CONS (STTOMC |command|) |b|) |t|))
+ (#0#
+ (|shoeThen| (CONS NIL |keep|) (CONS NIL |b|) |t|))))
+ ((SETQ |command| (|shoeElseIf?| |string|))
+ (COND
+ ((AND |keep1| (NOT |b1|))
+ (|shoeThen| (CONS T (CDR |keep|))
+ (CONS (STTOMC |command|) (CDR |b|)) |t|))
+ (#0#
+ (|shoeThen| (CONS NIL (CDR |keep|))
+ (CONS NIL (CDR |b|)) |t|))))
+ ((SETQ |command| (|shoeElse?| |string|))
+ (COND
+ ((AND |keep1| (NOT |b1|))
+ (|shoeElse| (CONS T (CDR |keep|)) (CONS T (CDR |b|))
+ |t|))
+ (#0#
+ (|shoeElse| (CONS NIL (CDR |keep|))
+ (CONS NIL (CDR |b|)) |t|))))
+ ((SETQ |command| (|shoeEndIf?| |string|))
+ (COND
+ ((NULL (CDR |b|)) (|shoeInclude| |t|))
+ (#0# (|shoeThen| (CDR |keep|) (CDR |b|) |t|))))
+ ((AND |keep1| |b1|)
+ (|bAppend| (|shoeSimpleLine| |h|)
+ (|shoeThen| |keep| |b| |t|)))
+ (#0# (|shoeThen| |keep| |b| |t|))))))))))
(DEFUN |shoeElse| (|keep| |b| |s|)
(|bDelay| #'|shoeElse1| (LIST |keep| |b| |s|)))
@@ -465,34 +436,28 @@
(RETURN
(COND
((|bPremStreamNull| |s|) |s|)
- (#0='T
- (PROGN
- (SETQ |h| (CAR |s|))
- (SETQ |t| (CDR |s|))
- (SETQ |string| (CAR |h|))
- (COND
- ((SETQ |command| (|shoeFin?| |string|))
- (|bPremStreamNil| |h|))
- (#0#
- (PROGN
- (SETQ |b1| (CAR |b|))
- (SETQ |keep1| (CAR |keep|))
- (COND
- ((SETQ |command| (|shoeIf?| |string|))
- (COND
- ((AND |keep1| |b1|)
- (|shoeThen| (CONS T |keep|)
- (CONS (STTOMC |command|) |b|) |t|))
- (#0#
- (|shoeThen| (CONS NIL |keep|) (CONS NIL |b|) |t|))))
- ((SETQ |command| (|shoeEndIf?| |string|))
- (COND
- ((NULL (CDR |b|)) (|shoeInclude| |t|))
- (#0# (|shoeThen| (CDR |keep|) (CDR |b|) |t|))))
- ((AND |keep1| |b1|)
- (|bAppend| (|shoeSimpleLine| |h|)
- (|shoeElse| |keep| |b| |t|)))
- (#0# (|shoeElse| |keep| |b| |t|))))))))))))
+ (#0='T (SETQ |h| (CAR |s|)) (SETQ |t| (CDR |s|))
+ (SETQ |string| (CAR |h|))
+ (COND
+ ((SETQ |command| (|shoeFin?| |string|))
+ (|bPremStreamNil| |h|))
+ (#0# (SETQ |b1| (CAR |b|)) (SETQ |keep1| (CAR |keep|))
+ (COND
+ ((SETQ |command| (|shoeIf?| |string|))
+ (COND
+ ((AND |keep1| |b1|)
+ (|shoeThen| (CONS T |keep|)
+ (CONS (STTOMC |command|) |b|) |t|))
+ (#0#
+ (|shoeThen| (CONS NIL |keep|) (CONS NIL |b|) |t|))))
+ ((SETQ |command| (|shoeEndIf?| |string|))
+ (COND
+ ((NULL (CDR |b|)) (|shoeInclude| |t|))
+ (#0# (|shoeThen| (CDR |keep|) (CDR |b|) |t|))))
+ ((AND |keep1| |b1|)
+ (|bAppend| (|shoeSimpleLine| |h|)
+ (|shoeElse| |keep| |b| |t|)))
+ (#0# (|shoeElse| |keep| |b| |t|))))))))))
(DEFUN |shoeLineSyntaxError| (|h|)
(PROGN
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-06 08:03:37 +0000