diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 5 | ||||
| -rw-r--r-- | src/boot/strap/translator.clisp | 5 | ||||
| -rw-r--r-- | src/boot/strap/utility.clisp | 27 | ||||
| -rw-r--r-- | src/boot/translator.boot | 5 | ||||
| -rw-r--r-- | src/boot/utility.boot | 12 |
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 |