* boot/utility.boot (firstNonblankPosition): New.

	(firstBlankPosition): Likewis.
	* boot/translator.boot (reallyPrettyPrint): New.
	(genOptimizeOptions): Use it.
	(evalBootFile): Tidy.
	(shoePPtoFile): Remove as deadcode.
	(shoeAddbootIfNec): Rewrite.
	(shoeAddStringIfNec): Remove.
	* boot/scanner.boot (shoeNextLine): Use firstNonblankPosition.
	(shoeEsc): Likewise.
	(shoePossFloat): Likewise.
	* boot/initial-env.lisp ($IEEE): Remove.
	(*LISP-BIN-FILETYPE*): Likewise.
	(*LISP-SOURCE-FILETYPE*): Likewise.
	(SHOEPRETTYPRINT1): Likewise,
	(REALLYPRETTYPRINT): Likewise.
	(SHOENOPRETTYPRINT): Likewise.
	(STRPOS): Likewise.
	(STRPOSL): Likewise.
	(shoeReadLisp): Likewise.

4 files changed, 64 insertions, 24 deletions

diff --git a/src/boot/strap/includer.clisp b/src/boot/strap/includer.clisp
index 61c7e369..28ade94d 100644
--- a/src/boot/strap/includer.clisp
+++ b/src/boot/strap/includer.clisp
@@ -186,9 +186,9 @@
   (PROG (|n1| |n|)
     (RETURN
      (PROGN
-      (SETQ |n| (STRPOSL " " |x| 0 T))
+      (SETQ |n| (|firstNonblankPosition| |x| 0))
       (COND ((NULL |n|) NIL)
-            (T (SETQ |n1| (STRPOSL " " |x| |n| NIL))
+            (T (SETQ |n1| (|firstBlankPosittion| |x| |n|))
              (COND ((NULL |n1|) (LIST (|subString| |x| |n|) ""))
                    (T
                     (LIST (|subString| |x| |n| (- |n1| |n|))
diff --git a/src/boot/strap/scanner.clisp b/src/boot/strap/scanner.clisp
index 78c63d07..166a9dce 100644
--- a/src/boot/strap/scanner.clisp
+++ b/src/boot/strap/scanner.clisp
@@ -41,7 +41,8 @@
     (RETURN
      (COND ((|bStreamNull| |s|) NIL)
            (T (SETQ |$linepos| |s|) (SETQ |$f| (CAR |s|)) (SETQ |$r| (CDR |s|))
-            (SETQ |$ln| (CAR |$f|)) (SETQ |$n| (STRPOSL " " |$ln| 0 T))
+            (SETQ |$ln| (CAR |$f|))
+            (SETQ |$n| (|firstNonblankPosition| |$ln| 0))
             (SETQ |$sz| (LENGTH |$ln|))
             (COND ((NULL |$n|) T)
                   ((CHAR= (SCHAR |$ln| |$n|) |shoeTAB|)
@@ -216,7 +217,7 @@
          (LOOP (COND (|$n| (RETURN NIL)) (T (|shoeNextLine| |$r|))))
          (|shoeEsc|) NIL)
         (T NIL)))
-      (T (SETQ |n1| (STRPOSL " " |$ln| |$n| T))
+      (T (SETQ |n1| (|firstNonblankPosition| |$ln| |$n|))
        (COND
         ((NULL |n1|) (|shoeNextLine| |$r|)
          (LOOP (COND (|$n| (RETURN NIL)) (T (|shoeNextLine| |$r|))))
@@ -296,7 +297,7 @@
     (RETURN
      (PROGN
       (SETQ |n| |$n|)
-      (SETQ |$n| (STRPOSL " " |$ln| |$n| T))
+      (SETQ |$n| (|firstNonblankPosition| |$ln| |$n|))
       (SETQ |$floatok| T)
       (COND ((NULL |$n|) (|shoeLeafSpaces| 0) (SETQ |$n| (LENGTH |$ln|)))
             (T (|shoeLeafSpaces| (- |$n| |n|))))))))
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index 22d6f918..4ab03112 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -22,6 +22,9 @@
 
 (DEFPARAMETER |$foreignsDefsForCLisp| NIL)
 
+(DEFUN |reallyPrettyPrint| (|x| &OPTIONAL (|st| *STANDARD-OUTPUT*))
+  (PROGN (|prettyPrint| |x| |st|) (TERPRI |st|)))
+
 (DEFUN |genModuleFinalization| (|stream|)
   (PROG (|init|)
     (DECLARE (SPECIAL |$foreignsDefsForCLisp| |$currentModuleName|))
@@ -83,11 +86,11 @@
                                         (T (RPLACD |bfVar#6| #2#)
                                          (SETQ |bfVar#6| (CDR |bfVar#6|))))
                                        (SETQ |bfVar#4| (CDR |bfVar#4|)))))))))
-              (REALLYPRETTYPRINT |init| |stream|))))
+              (|reallyPrettyPrint| |init| |stream|))))
       (T NIL)))))
 
 (DEFUN |genOptimizeOptions| (|stream|)
-  (REALLYPRETTYPRINT
+  (|reallyPrettyPrint|
    (LIST 'PROCLAIM (|quote| (CONS 'OPTIMIZE |$LispOptimizeOptions|))) |stream|))
 
 (DEFUN |AxiomCore|::|%sysInit| ()
@@ -226,8 +229,7 @@
       (SETQ |b| *PACKAGE*)
       (IN-PACKAGE "BOOTTRAN")
       (SETQ |infn| (|shoeAddbootIfNec| |fn|))
-      (SETQ |outfn|
-              (CONCAT (|shoeRemovebootIfNec| |fn|) "." *LISP-SOURCE-FILETYPE*))
+      (SETQ |outfn| (CONCAT (|shoeRemovebootIfNec| |fn|) "." "lisp"))
       (UNWIND-PROTECT
           (PROGN
            (SETQ |a| (|inputTextFile| |infn|))
@@ -434,12 +436,9 @@
              (COND
               ((AND (CONSP |a|) (EQ (CAR |a|) '+LINE))
                (|shoeFileLine| (CADR |a|) |st|))
-              (T (REALLYPRETTYPRINT |a| |st|) (TERPRI |st|)))
+              (T (|reallyPrettyPrint| |a| |st|) (TERPRI |st|)))
              (SETQ |s| (CDR |s|))))))))
 
-(DEFUN |shoePPtoFile| (|x| |stream|)
-  (PROGN (SHOENOTPRETTYPRINT |x| |stream|) |x|))
-
 (DEFUN |shoeConsoleTrees| (|s|)
   (PROG (|fn|)
     (RETURN
@@ -448,7 +447,7 @@
             (T
              (SETQ |fn|
                      (|stripm| (CAR |s|) *PACKAGE* (FIND-PACKAGE "BOOTTRAN")))
-             (REALLYPRETTYPRINT |fn|) (SETQ |s| (CDR |s|))))))))
+             (|reallyPrettyPrint| |fn|) (SETQ |s| (CDR |s|))))))))
 
 (DEFUN |shoeAddComment| (|l|) (CONCAT "; " (CAR |l|)))
 
@@ -702,16 +701,26 @@
                  (|shoeReadLispString| |s| 0)))
               (T (LIST (|translateToplevelExpression| |b|)))))))))
 
-(DEFUN |shoeAddbootIfNec| (|s|) (|shoeAddStringIfNec| ".boot" |s|))
-
-(DEFUN |shoeRemovebootIfNec| (|s|) (|shoeRemoveStringIfNec| ".boot" |s|))
-
-(DEFUN |shoeAddStringIfNec| (|str| |s|)
-  (PROG (|a|)
+(DEFUN |shoeAddbootIfNec| (|s|)
+  (PROG (|n2| |n1| |ext|)
     (RETURN
      (PROGN
-      (SETQ |a| (STRPOS |str| |s| 0 NIL))
-      (COND ((NULL |a|) (CONCAT |s| |str|)) (T |s|))))))
+      (SETQ |ext| ".boot")
+      (SETQ |n1| (- (LENGTH |ext|) 1))
+      (SETQ |n2| (- (- (LENGTH |s|) |n1|) 1))
+      (COND
+       ((LET ((|bfVar#1| T) (|k| 0))
+          (LOOP
+           (COND ((> |k| |n1|) (RETURN |bfVar#1|))
+                 (T
+                  (SETQ |bfVar#1|
+                          (CHAR= (SCHAR |ext| |k|) (SCHAR |s| (+ |n2| |k|))))
+                  (COND ((NOT |bfVar#1|) (RETURN NIL)))))
+           (SETQ |k| (+ |k| 1))))
+        |s|)
+       (T (CONCAT |s| |ext|)))))))
+
+(DEFUN |shoeRemovebootIfNec| (|s|) (|shoeRemoveStringIfNec| ".boot" |s|))
 
 (DEFUN |shoeRemoveStringIfNec| (|str| |s|)
   (PROG (|n|)
@@ -1120,7 +1129,7 @@
 (DEFUN |shoePCompileTrees| (|s|)
   (LOOP
    (COND ((|bStreamNull| |s|) (RETURN NIL))
-         (T (REALLYPRETTYPRINT (|shoePCompile| (CAR |s|)))
+         (T (|reallyPrettyPrint| (|shoePCompile| (CAR |s|)))
           (SETQ |s| (CDR |s|))))))
 
 (DEFUN |bStreamPackageNull| (|s|)
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index 4c2f649b..a4c6aa61 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -12,7 +12,7 @@
                      |lastNode| |append| |append!| |copyList| |substitute|
                      |substitute!| |setDifference| |applySubst| |applySubst!|
                      |applySubstNQ| |remove| |removeSymbol| |atomic?|
-                     |finishLine|)))
+                     |finishLine| |subStringMatch?|)))
 
 (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%Thing|) |substitute|))
 
@@ -43,6 +43,14 @@
 
 (DECLAIM (FTYPE (FUNCTION (|%Thing|) |%Void|) |finishLine|))
 
+(DECLAIM
+ (FTYPE (FUNCTION (|%String| |%Short|) (|%Maybe| |%Short|))
+  |firstNonblankPosition|))
+
+(DECLAIM
+ (FTYPE (FUNCTION (|%String| |%Short|) (|%Maybe| |%Short|))
+  |firstBlankPosition|))
+
 (DEFUN |atomic?| (|x|) (OR (NOT (CONSP |x|)) (EQ (CAR |x|) 'QUOTE)))
 
 (DEFUN |objectMember?| (|x| |l|)
@@ -274,5 +282,27 @@
              ((CHAR= (SCHAR |s| |k|) |c|) (RETURN |k|))
              (T (SETQ |k| (+ |k| 1)))))))))
 
+(DEFUN |firstNonblankPosition| (|s| |k|)
+  (LET ((|bfVar#2| NIL) (|bfVar#1| (- (LENGTH |s|) 1)) (|i| |k|))
+    (LOOP
+     (COND ((> |i| |bfVar#1|) (RETURN |bfVar#2|))
+           (T
+            (AND (NOT (CHAR= (SCHAR |s| |i|) (|char| '| |)))
+                 (PROGN
+                  (SETQ |bfVar#2| |i|)
+                  (COND (|bfVar#2| (RETURN |bfVar#2|)))))))
+     (SETQ |i| (+ |i| 1)))))
+
+(DEFUN |firstBlankPosition| (|s| |k|)
+  (LET ((|bfVar#2| NIL) (|bfVar#1| (- (LENGTH |s|) 1)) (|i| |k|))
+    (LOOP
+     (COND ((> |i| |bfVar#1|) (RETURN |bfVar#2|))
+           (T
+            (AND (CHAR= (SCHAR |s| |i|) (|char| '| |))
+                 (PROGN
+                  (SETQ |bfVar#2| |i|)
+                  (COND (|bfVar#2| (RETURN |bfVar#2|)))))))
+     (SETQ |i| (+ |i| 1)))))
+
 (DEFUN |finishLine| (|out|) (PROGN (TERPRI |out|) (FORCE-OUTPUT |out|)))