* 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.

10 files changed, 119 insertions, 105 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 0a5660c7..c5268333 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,28 @@
 2011-09-30  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* 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.
+
+2011-09-30  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	* interp/br-data.boot (lefts): Iterate directly over table.
 	(mkUsersHashTable): Likewise.
 	(mkDependentsHashTable): Likewise.
diff --git a/src/boot/includer.boot b/src/boot/includer.boot
index a878844d..1095031c 100644
--- a/src/boot/includer.boot
+++ b/src/boot/includer.boot
@@ -219,9 +219,9 @@ shoeLisp?         s  == shoePrefix?('")lisp",        s)
 shoeLine?         s  == shoePrefix?('")line",        s)
  
 shoeBiteOff x ==
-  n :=STRPOSL('" ",x,0,true)
+  n := firstNonblankPosition(x,0)
   n = nil =>  false
-  n1 := STRPOSL ('" ",x,n,nil)
+  n1 := firstBlankPosittion(x,n)
   n1 = nil =>  [subString(x,n),'""]
   [subString(x,n,n1-n),subString(x,n1)]
  
diff --git a/src/boot/initial-env.lisp b/src/boot/initial-env.lisp
index 855ac0da..ecf4963d 100644
--- a/src/boot/initial-env.lisp
+++ b/src/boot/initial-env.lisp
@@ -54,58 +54,3 @@
 	   (progn
 	     (setq *read-default-float-format* 'double-float)
 	     (setq *load-verbose* nil)))
-
-;## need the conditional here so it appears in boottran
-#+:ieee-floating-point (defparameter $ieee t)
-#-:ieee-floating-point (defparameter $ieee nil)
-
-(defvar *lisp-bin-filetype* "o")
-
-(defvar *lisp-source-filetype* "lisp")
-
-(defun shoeprettyprin1 (x &optional (stream *standard-output*))
-  (let ((*print-pretty* t)
-        (*print-array* t)
-        (*print-circle* t)
-        (*print-level* nil)
-        (*print-length* nil))
-    (prin1 x stream)))
- 
-(defun reallyprettyprint (x &optional (stream *terminal-io*))
-  (shoeprettyprin1 x stream) (terpri stream))
- 
-(defun shoeprettyprin0 (x &optional (stream *standard-output*))
-  (let ((*print-pretty* nil)
-        (*print-array* t)
-        (*print-circle* t)
-        (*print-level* nil)
-        (*print-length* nil))
-    (prin1 x stream)))
- 
-(defun shoenotprettyprint (x &optional (stream *terminal-io*))
-  (shoeprettyprin0 x stream) 
-  (terpri stream))
-
-(defun strpos (what in start dontcare)
-  (setq what (string what) in (string in))
-  (if dontcare
-      (progn 
-	(setq dontcare (character dontcare))
-	(search what in :start2 start
-		:test #'(lambda (x y) (or (eql x dontcare)
-					  (eql x y)))))
-    (search what in :start2 start)))
- 
-
-(defun strposl (table cvec sint item)
-  (setq cvec (string cvec))
-  (if (not item)
-      (position table cvec 
-		:test #'(lambda (x y) (position y x))
-		:start sint)
-    (position table cvec 
-	      :test-not #'(lambda (x y) (position y x))
-              :start sint)))
- 
-(defun |shoeReadLisp| (s n)
-  (multiple-value-list (read-from-string s nil nil :start n)))
diff --git a/src/boot/scanner.boot b/src/boot/scanner.boot
index 7a84cb96..a419a9a4 100644
--- a/src/boot/scanner.boot
+++ b/src/boot/scanner.boot
@@ -85,8 +85,8 @@ shoeNextLine(s)==
   $f:= first s
   $r:= rest s
   $ln:=first $f
-  $n:=STRPOSL('" ",$ln,0,true)
-  $sz :=# $ln
+  $n := firstNonblankPosition($ln,0)
+  $sz := #$ln
   $n = nil => true
   stringChar($ln,$n) = shoeTAB =>
     a := makeString(7-REM($n,8),char " ")
@@ -240,7 +240,7 @@ shoeEsc()==
       shoeEsc()
       false
     false
-  n1:=STRPOSL('" ",$ln,$n,true)
+  n1 := firstNonblankPosition($ln,$n)
   n1 = nil =>
     shoeNextLine($r)
     while $n = nil repeat 
@@ -296,7 +296,7 @@ shoePossFloat (w)==
  
 shoeSpace()==
   n := $n
-  $n := STRPOSL('" ",$ln,$n,true)
+  $n := firstNonblankPosition($ln,$n)
   $floatok := true
   $n = nil =>
      shoeLeafSpaces 0
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|)))
 
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index 8904cb00..35db495f 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -48,6 +48,10 @@ $currentModuleName := nil
 ++ Stack of foreign definitions to cope with CLisp's odd FFI interface.
 $foreignsDefsForCLisp := []
 
+reallyPrettyPrint(x,st == _*STANDARD_-OUTPUT_*) ==
+  prettyPrint(x,st)
+  writeNewline st
+
 genModuleFinalization(stream) ==
   %hasFeature KEYWORD::CLISP =>
     $foreignsDefsForCLisp = nil => nil
@@ -58,11 +62,11 @@ genModuleFinalization(stream) ==
         ["MAPC",["FUNCTION", "FMAKUNBOUND"],
           quote [second d for d in $foreignsDefsForCLisp]],
           :[["EVAL",quote d] for d in $foreignsDefsForCLisp]]
-    REALLYPRETTYPRINT(init,stream)
+    reallyPrettyPrint(init,stream)
   nil
 
 genOptimizeOptions stream ==
-  REALLYPRETTYPRINT
+  reallyPrettyPrint
     (["PROCLAIM",quote ["OPTIMIZE",:$LispOptimizeOptions]],stream)
 
 AxiomCore::%sysInit() ==
@@ -170,7 +174,7 @@ evalBootFile fn ==
    b := namespace .
    IN_-PACKAGE '"BOOTTRAN"
    infn:=shoeAddbootIfNec fn
-   outfn := strconc(shoeRemovebootIfNec fn,'".",_*LISP_-SOURCE_-FILETYPE_*)
+   outfn := strconc(shoeRemovebootIfNec fn,'".",'"lisp")
    try
      a := inputTextFile infn
      shoeClLines(a,infn,[],outfn)
@@ -337,19 +341,14 @@ shoeFileTrees(s,st)==
     if a is ["+LINE",:.]
     then shoeFileLine(second a,st)
     else 
-      REALLYPRETTYPRINT(a,st)
+      reallyPrettyPrint(a,st)
       TERPRI st
     s:= rest s
  
- 
-shoePPtoFile(x, stream) ==
-  SHOENOTPRETTYPRINT(x, stream)
-  x
- 
 shoeConsoleTrees s ==
   while not bStreamPackageNull s repeat
     fn:=stripm(first s,namespace .,namespace BOOTTRAN)
-    REALLYPRETTYPRINT fn
+    reallyPrettyPrint fn
     s:= rest s
  
 shoeAddComment l==  
@@ -474,18 +473,16 @@ translateToplevel(b,export?) ==
     otherwise =>
       [translateToplevelExpression b]
 
-
-shoeAddbootIfNec s == 
-  shoeAddStringIfNec('".boot",s)
+shoeAddbootIfNec s ==
+  ext := '".boot"
+  n1 := #ext - 1
+  n2 := #s - n1 - 1
+  and/[stringChar(ext,k) = stringChar(s,n2 + k) for k in 0..n1] => s
+  strconc(s,ext)
  
 shoeRemovebootIfNec s == 
   shoeRemoveStringIfNec('".boot",s)
 
-shoeAddStringIfNec(str,s)==
-  a:=STRPOS(str,s,0,nil)
-  a=nil => strconc(s,str)
-  s
- 
 shoeRemoveStringIfNec(str,s)==
   n := SEARCH(str,s,KEYWORD::FROM_-END,true)
   n = nil => s
@@ -664,7 +661,7 @@ shoePCompile  fn==
  
 shoePCompileTrees s==
   while not bStreamNull s repeat
-    REALLYPRETTYPRINT shoePCompile first s
+    reallyPrettyPrint shoePCompile first s
     s := rest s
  
 bStreamPackageNull s==
diff --git a/src/boot/utility.boot b/src/boot/utility.boot
index 1e60c8e2..5e620d82 100644
--- a/src/boot/utility.boot
+++ b/src/boot/utility.boot
@@ -44,7 +44,7 @@ module utility (objectMember?, symbolMember?, stringMember?,
   charMember?, scalarMember?, listMember?, reverse, reverse!,
   lastNode, append, append!, copyList, substitute, substitute!,
   setDifference, applySubst, applySubst!, applySubstNQ,
-  remove,removeSymbol,atomic?,finishLine) where
+  remove,removeSymbol,atomic?,finishLine,subStringMatch?) where
     substitute: (%Thing,%Thing,%Thing) -> %Thing
     substitute!: (%Thing,%Thing,%Thing) -> %Thing
     append: (%List %Thing,%List %Thing) -> %List %Thing
@@ -55,6 +55,8 @@ module utility (objectMember?, symbolMember?, stringMember?,
     remove: (%List %Thing, %Thing) -> %List %Thing
     atomic?: %Thing -> %Boolean
     finishLine: %Thing -> %Void
+    firstNonblankPosition: (%String,%Short) -> %Maybe %Short
+    firstBlankPosition: (%String,%Short) -> %Maybe %Short
 
 --%
 
@@ -276,6 +278,13 @@ charPosition(c,s,k) ==
     stringChar(s,k) = c => return k
     k := k + 1
 
+firstNonblankPosition(s,k) ==
+  or/[i for i in k..#s - 1 | stringChar(s,i) ~= char " "]
+
+firstBlankPosition(s,k) ==
+  or/[i for i in k..#s - 1 | stringChar(s,i) = char " "]
+    
+
 --% I/O
 
 ++ Add a newline character and flush the output stream.