diff options
| author | dos-reis <gdr@axiomatics.org> | 2012-05-20 20:02:50 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2012-05-20 20:02:50 +0000 |
| commit | 47a2fd61be7c98af4d53f8b885a0038a72fcd4e6 (patch) | |
| tree | 4287ba6ee8112a0cb73bbaa4a456333a8e26fed1 /src/boot/strap | |
| parent | d514701a383cf1c0152a5a5e97a1530eccb8ea63 (diff) | |
| download | open-axiom-47a2fd61be7c98af4d53f8b885a0038a72fcd4e6.tar.gz | |
* boot/utility.boot (strinSuffix?): New.
* boot/translator.boot (shoeRemovebootIfNec): Use it.
Diffstat (limited to 'src/boot/strap')
| -rw-r--r-- | src/boot/strap/translator.clisp | 5 | ||||
| -rw-r--r-- | src/boot/strap/utility.clisp | 27 |
2 files changed, 28 insertions, 4 deletions
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|))) |