X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fstring.lisp;h=411c638be89569d6e9c3e2eeeab4423800761f2b;hb=d76123a32e8d5e5afcf9d0c8f407b731ef34edc5;hp=6f88024ace66354f393b33c75facd6e17d4a8e2f;hpb=28a82d590a536e520a46e0703a08829485ae8bf5;p=jscl.git diff --git a/src/string.lisp b/src/string.lisp index 6f88024..411c638 100644 --- a/src/string.lisp +++ b/src/string.lisp @@ -13,13 +13,23 @@ ;; You should have received a copy of the GNU General Public License ;; along with JSCL. If not, see . -;; (defun stringp (x) -;; (and (vectorp x) (eq (array-element-type x) 'character))) +(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* ((s1 (string s1)) @@ -41,9 +51,6 @@ (when (and (= i (1- len-1)) (> len-2 len-1)) (return-from string< (1+ i)))))))) -(defun stringp (s) - (stringp s)) - (define-setf-expander char (string index) (let ((g!string (gensym)) (g!index (gensym)) @@ -54,15 +61,19 @@ `(aset ,g!string ,g!index ,g!value) `(char ,g!string ,g!index)))) -(defun concatenate-two (string1 string2) - (let* ((len1 (length string1)) - (len2 (length string2)) - (string (make-array (+ len1 len2) :element-type 'character)) - (i 0)) - (dotimes (j len1) - (aset string i (char string1 j)) - (incf i)) - (dotimes (j len2) - (aset string i (char string2 j)) - (incf i)) - string)) + +(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))))))