* boot/utility.boot (strinSuffix?): New.

	* boot/translator.boot (shoeRemovebootIfNec): Use it.

5 files changed, 46 insertions, 8 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 6ba9d8bb..503dc47d 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,10 @@
 2012-05-20  Gabriel Dos Reis  <gdr@cs.tamu.edu>
 
+	* boot/utility.boot (strinSuffix?): New.
+	* boot/translator.boot (shoeRemovebootIfNec): Use it.
+
+2012-05-20  Gabriel Dos Reis  <gdr@cs.tamu.edu>
+
 	Fix build breakage with CLozure CL.
 	* lisp/core.lisp.in ($stdin): Demote to DEFPARAMETER.
 	($stdout): Likewise.
diff --git a/src/boot/strap/translator.clisp b/src/boot/strap/translator.clisp
index 9362b70e..ff26ab5c 100644
--- a/src/boot/strap/translator.clisp
+++ b/src/boot/strap/translator.clisp
@@ -785,9 +785,8 @@
 (DEFUN |shoeRemoveStringIfNec| (|str| |s|)
   (PROG (|n|)
     (RETURN
-     (PROGN
-      (SETQ |n| (SEARCH |str| |s| :FROM-END T))
-      (COND ((NULL |n|) |s|) (T (|subString| |s| 0 |n|)))))))
+     (COND ((SETQ |n| (|stringSuffix?| |str| |s|)) (|subString| |s| 0 |n|))
+           (T |s|)))))
 
 (DEFUN DEFUSE (|fn|)
   (PROG (|a|)
diff --git a/src/boot/strap/utility.clisp b/src/boot/strap/utility.clisp
index 83ee8844..f49dbe7e 100644
--- a/src/boot/strap/utility.clisp
+++ b/src/boot/strap/utility.clisp
@@ -21,7 +21,8 @@
                      |substitute!| |setDifference| |setUnion| |setIntersection|
                      |symbolAssoc| |applySubst| |applySubst!| |applySubstNQ|
                      |objectAssoc| |remove| |removeSymbol| |atomic?| |every?|
-                     |any?| |take| |takeWhile| |drop| |copyTree| |finishLine|)))
+                     |any?| |take| |takeWhile| |drop| |copyTree| |finishLine|
+                     |stringSuffix?|)))
 
 (DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing|) |%Thing|) |substitute|))
 
@@ -102,6 +103,9 @@
  (FTYPE (FUNCTION (|%String| |%Short|) (|%Maybe| |%Short|))
   |firstBlankPosition|))
 
+(DECLAIM
+ (FTYPE (FUNCTION (|%String| |%String|) (|%Maybe| |%Short|)) |stringSuffix?|))
+
 (|%defaultReadAndLoadSettings|)
 
 (DEFUN |atomic?| (|x|) (OR (NOT (CONSP |x|)) (EQ (CAR |x|) 'QUOTE)))
@@ -470,5 +474,26 @@
                   (COND (|bfVar#2| (RETURN |bfVar#2|)))))))
      (SETQ |i| (+ |i| 1)))))
 
+(DEFUN |stringSuffix?| (|suf| |str|)
+  (PROG (|n| |n2| |n1|)
+    (RETURN
+     (PROGN
+      (SETQ |n1| (LENGTH |suf|))
+      (SETQ |n2| (LENGTH |str|))
+      (COND ((< |n2| |n1|) NIL)
+            (T (SETQ |n| (- |n2| |n1|))
+             (COND
+              ((LET ((|bfVar#2| T) (|bfVar#1| (- |n1| 1)) (|i| 0) (|j| |n|))
+                 (LOOP
+                  (COND ((> |i| |bfVar#1|) (RETURN |bfVar#2|))
+                        (T
+                         (SETQ |bfVar#2|
+                                 (CHAR= (SCHAR |suf| |i|) (SCHAR |str| |j|)))
+                         (COND ((NOT |bfVar#2|) (RETURN NIL)))))
+                  (SETQ |i| (+ |i| 1))
+                  (SETQ |j| (+ |j| 1))))
+               |n|)
+              (T NIL))))))))
+
 (DEFUN |finishLine| (|out|) (PROGN (TERPRI |out|) (FORCE-OUTPUT |out|)))
 
diff --git a/src/boot/translator.boot b/src/boot/translator.boot
index 430f3909..6fca0944 100644
--- a/src/boot/translator.boot
+++ b/src/boot/translator.boot
@@ -503,9 +503,8 @@ shoeRemovebootIfNec s ==
   shoeRemoveStringIfNec('".boot",s)
 
 shoeRemoveStringIfNec(str,s)==
-  n := SEARCH(str,s,KEYWORD::FROM_-END,true)
-  n = nil => s
-  subString(s,0,n)
+  n := stringSuffix?(str,s) => subString(s,0,n)
+  s
  
 -- DEFUSE prints the definitions not used and the words used and
 -- not defined in the input file and common lisp.
diff --git a/src/boot/utility.boot b/src/boot/utility.boot
index 5ba81a1e..6032f24e 100644
--- a/src/boot/utility.boot
+++ b/src/boot/utility.boot
@@ -49,7 +49,7 @@ module utility (objectMember?, symbolMember?, stringMember?,
   setDifference, setUnion, setIntersection,
   symbolAssoc, applySubst, applySubst!, applySubstNQ, objectAssoc,
   remove, removeSymbol, atomic?, every?, any?, take, takeWhile, drop,
-  copyTree, finishLine) where
+  copyTree, finishLine, stringSuffix?) where
     substitute: (%Thing,%Thing,%Thing) -> %Thing
     substitute!: (%Thing,%Thing,%Thing) -> %Thing
     append: (%List %Thing,%List %Thing) -> %List %Thing
@@ -74,6 +74,7 @@ module utility (objectMember?, symbolMember?, stringMember?,
     --FIXME: Next signature commented out because of GCL bugs
     -- firstNonblankPosition: (%String,%Short) -> %Maybe %Short
     firstBlankPosition: (%String,%Short) -> %Maybe %Short
+    stringSuffix?: (%String,%String) -> %Maybe %Short
 
 %defaultReadAndLoadSettings()
 
@@ -354,6 +355,15 @@ firstNonblankPosition(s,k) ==
 firstBlankPosition(s,k) ==
   or/[i for i in k..#s - 1 | stringChar(s,i) = char " "]
     
+++ If `suf' is a suffix of `str' return the index into `str' at which the
+++ match occurs.  Otherwise return nil.
+stringSuffix?(suf,str) ==
+  n1 := #suf
+  n2 := #str
+  n1 > n2 => nil
+  n := n2 - n1
+  and/[stringChar(suf,i) = stringChar(str,j) for i in 0..n1-1 for j in n..] => n
+  nil
 
 --% I/O