aboutsummaryrefslogtreecommitdiff
path: root/src/boot/includer.boot.pamphlet
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2007-10-27 23:21:35 +0000
committerdos-reis <gdr@axiomatics.org>2007-10-27 23:21:35 +0000
commit471d0186fa938e05f69b26dd209544de721de94d (patch)
tree67d612b37680efed7fc53dac4e763789dcaba50a /src/boot/includer.boot.pamphlet
parentaf60761fbae34dc7728fcb8e8a8ab2115bdef94a (diff)
downloadopen-axiom-471d0186fa938e05f69b26dd209544de721de94d.tar.gz
* ast.boot.pamphlet (bfLp1): Simplify loop code generation.
Update cached Lisp translation. * includer.boot.pamphlet: Update cached Lisp translation. * parser.boot.pamphlet: Likewise. * pile.boot.pamphlet: Likewise. * scanner.boot.pamphlet: Likewise. * tokens.boot.pamphlet: Likewise. * translator.boot.pamphlet: Likewise.
Diffstat (limited to 'src/boot/includer.boot.pamphlet')
-rw-r--r--src/boot/includer.boot.pamphlet46
1 files changed, 24 insertions, 22 deletions
diff --git a/src/boot/includer.boot.pamphlet b/src/boot/includer.boot.pamphlet
index e613d5c4..9775aeb1 100644
--- a/src/boot/includer.boot.pamphlet
+++ b/src/boot/includer.boot.pamphlet
@@ -691,7 +691,8 @@ bPremStreamNull(s)==
(DEFUN |shoeCLOSE| (|stream|) (PROG () (RETURN (CLOSE |stream|))))
(DEFUN |shoeNotFound| (|fn|)
- (PROG () (RETURN (PROGN (|coreError| (LIST |fn| " not found")) NIL))))
+ (PROG ()
+ (RETURN (PROGN (|coreError| (LIST |fn| " not found")) NIL))))
(DEFUN |shoeReadLispString| (|s| |n|)
(PROG (|l|)
@@ -804,8 +805,7 @@ bPremStreamNull(s)==
((NULL |lines|) (|shoeConsole| ")package not found")))
(APPEND (REVERSE |lines|) (CAR |b|)))))))))
-(EVAL-WHEN (:EXECUTE :LOAD-TOPLEVEL)
- (DEFPARAMETER |$bStreamNil| (LIST '|nullstream|)))
+(DEFPARAMETER |$bStreamNil| (LIST '|nullstream|))
(DEFUN |bStreamNull| (|x|)
(PROG (|st|)
@@ -814,15 +814,14 @@ bPremStreamNull(s)==
((OR (NULL |x|) (EQCAR |x| '|nullstream|)) T)
('T
(PROGN
- ((LAMBDA ()
- (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|))))))))
+ (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|)
@@ -830,6 +829,7 @@ bPremStreamNull(s)==
(DEFUN |bMap1| (&REST |z|)
(PROG (|x| |f|)
+ (DECLARE (SPECIAL |$bStreamNil|))
(RETURN
(PROGN
(SETQ |f| (CAR |z|))
@@ -840,6 +840,7 @@ bPremStreamNull(s)==
(DEFUN |shoeFileMap| (|f| |fn|)
(PROG (|a|)
+ (DECLARE (SPECIAL |$bStreamNil|))
(RETURN
(PROGN
(SETQ |a| (|shoeInputFile| |fn|))
@@ -941,16 +942,15 @@ bPremStreamNull(s)==
('T
(PROGN
(SETQ |good| T)
- ((LAMBDA (|bfVar#1| |i| |j|)
- (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))))
- (- (LENGTH |prefix|) 1) 0 0)
+ (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|))))))))
@@ -1061,6 +1061,7 @@ bPremStreamNull(s)==
(DEFUN |shoeInclude1| (|s|)
(PROG (|command| |string| |t| |h|)
+ (DECLARE (SPECIAL |$bStreamNil|))
(RETURN
(COND
((|bStreamNull| |s|) |s|)
@@ -1202,6 +1203,7 @@ bPremStreamNull(s)==
(DEFUN |bPremStreamNil| (|h|)
(PROG ()
+ (DECLARE (SPECIAL |$bStreamNil|))
(RETURN
(PROGN
(|shoeConsole|