X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fstring.lisp;h=411c638be89569d6e9c3e2eeeab4423800761f2b;hb=b2de12c4e1a6e77e7f3f22d056adcfeda79d085b;hp=756bf96ec82f85340e7eef8642bc24a3b0284cd4;hpb=fde8e7678f3a194026bf14d630d3b7e979e3ce6e;p=jscl.git diff --git a/src/string.lisp b/src/string.lisp index 756bf96..411c638 100644 --- a/src/string.lisp +++ b/src/string.lisp @@ -13,19 +13,33 @@ ;; You should have received a copy of the GNU General Public License ;; along with JSCL. If not, see . +(defun stringp (s) + (stringp s)) + +(defun string-length (string) + (storage-vector-size string)) + +(defun make-string (n &key initial-element) + (make-array n :element-type 'character :initial-element initial-element)) + +(defun char (string index) + (unless (stringp string) (error "~S is not a string" string)) + (storage-vector-ref string index)) + (defun string (x) (cond ((stringp x) x) ((symbolp x) (symbol-name x)) - (t (char-to-string x)))) + (t (make-string 1 :initial-element x)))) (defun string= (s1 s2) - (let ((n (length s1))) + (let* ((s1 (string s1)) + (s2 (string s2)) + (n (length s1))) (when (= (length s2) n) (dotimes (i n t) (unless (char= (char s1 i) (char s2 i)) (return-from string= nil)))))) -<<<<<<< HEAD (defun string< (s1 s2) (let ((len-1 (length s1)) (len-2 (length s2))) @@ -36,10 +50,6 @@ (return-from string< i)) (when (and (= i (1- len-1)) (> len-2 len-1)) (return-from string< (1+ i)))))))) -======= -(defun stringp (s) - (stringp s)) ->>>>>>> ee0ae303e9d3f7f99eeb3af1824b61f2616f5925 (define-setf-expander char (string index) (let ((g!string (gensym)) @@ -50,3 +60,20 @@ (list g!value) `(aset ,g!string ,g!index ,g!value) `(char ,g!string ,g!index)))) + + +(defun concat (&rest strs) + (flet ((concat-two (str1 str2) + (concatenate-storage-vector str1 str2))) + (!reduce #'concat-two strs ""))) + + +(defun string-upcase (string) + (let ((new (make-string (length string)))) + (dotimes (i (length string) new) + (aset new i (char-upcase (char string i)))))) + +(defun string-downcase (string) + (let ((new (make-string (length string)))) + (dotimes (i (length string) new) + (aset new i (char-downcase (char string i))))))