(SETF CHAR) and move string related code to string.lisp

diff --git a/jscl.lisp b/jscl.lisp
index 6d907a3..720135f 100644 (file)
--- a/jscl.lisp
+++ b/jscl.lisp
@@ -21,6 +21,7 @@
     ("compat"    :host)
     ("utils"     :both)
     ("list"      :target)
+    ("string"    :target)
     ("print"     :target)
     ("package"   :target)
     ("read"      :both)

diff --git a/src/boot.lisp b/src/boot.lisp
index 4cb0fe4..a54291f 100644 (file)
--- a/src/boot.lisp
+++ b/src/boot.lisp
@@ -459,18 +459,6 @@
       (incf pos))
     pos))
 
-(defun string (x)
-  (cond ((stringp x) x)
-        ((symbolp x) (symbol-name x))
-        (t (char-to-string x))))
-
-(defun string= (s1 s2)
-  (let ((n (length s1)))
-    (when (= (length s2) n)
-      (dotimes (i n t)
-        (unless (char= (char s1 i) (char s2 i))
-          (return-from string= nil))))))
-
 (defun equal (x y)
   (cond
     ((eql x y) t)
@@ -612,3 +600,4 @@
 
 (defun error (fmt &rest args)
   (%throw (apply #'format nil fmt args)))
+

diff --git a/src/compiler.lisp b/src/compiler.lisp
index 94e77ce..b8623e1 100644 (file)
--- a/src/compiler.lisp
+++ b/src/compiler.lisp
@@ -1546,7 +1546,7 @@
       (js!selfcall
         "var v = globalEval(xstring(" string "));" *newline*
         "return values.apply(this, forcemv(v));" *newline*)
-      (code "globalEval(xstring(" string ")")))
+      (code "globalEval(xstring(" string "))")))
 
 (define-builtin %throw (string)
   (js!selfcall "throw " string ";" *newline*))
@@ -1565,7 +1565,7 @@
   (code "((" object ")[xstring(" key ")] = " value ")"))
 
 (define-builtin in (key object)
-  (js!bool (code "(xstring(" key ") in (" object ")")))
+  (js!bool (code "(xstring(" key ") in (" object "))")))
 
 (define-builtin functionp (x)
   (js!bool (code "(typeof " x " == 'function')")))

diff --git a/src/string.lisp b/src/string.lisp
new file mode 100644 (file)
index 0000000..1aa09ac
--- /dev/null
+++ b/src/string.lisp
@@ -0,0 +1,36 @@
+;;; string.lisp
+
+;; JSCL is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+;;
+;; JSCL is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with JSCL.  If not, see <http://www.gnu.org/licenses/>.
+
+(defun string (x)
+  (cond ((stringp x) x)
+        ((symbolp x) (symbol-name x))
+        (t (char-to-string x))))
+
+(defun string= (s1 s2)
+  (let ((n (length s1)))
+    (when (= (length s2) n)
+      (dotimes (i n t)
+        (unless (char= (char s1 i) (char s2 i))
+          (return-from string= nil))))))
+
+(define-setf-expander char (string index)
+  (let ((g!string (gensym))
+        (g!index (gensym))
+        (g!value (gensym)))
+    (list (list g!string g!index)
+          (list string index)
+          (list g!value)
+          `(aset ,g!string ,g!index ,g!value)
+          `(char ,g!string ,g!index))))

diff --git a/src/utils.lisp b/src/utils.lisp
index 73fc551..f6d8120 100644 (file)
--- a/src/utils.lisp
+++ b/src/utils.lisp
@@ -16,7 +16,8 @@
 ;; You should have received a copy of the GNU General Public License
 ;; along with JSCL.  If not, see <http://www.gnu.org/licenses/>.
 
-(defvar *newline* (string (code-char 10)))
+(defvar *newline* "
+")
 
 (defmacro concatf (variable &body form)
   `(setq ,variable (concat ,variable (progn ,@form))))

diff --git a/tests/strings.lisp b/tests/strings.lisp
new file mode 100644 (file)
index 0000000..4c5fe15
--- /dev/null
+++ b/tests/strings.lisp
@@ -0,0 +1,18 @@
+(defvar *str* "hello world")
+(defvar *str2* "h")
+
+(test (stringp *str*))
+(test (not (characterp *str*)))
+(test (not (integerp *str*)))
+
+(test (stringp *str2*))
+(test (not (characterp *str2*)))
+(test (not (integerp *str2*)))
+
+(test (= (length "hello world") 11))
+(test (arrayp "hello world"))
+
+(test (string= "h" (string #\h)))
+(test (string= "foo" "foo"))
+(test (not (string= "Foo" "foo")))
+(test (not (string= "foo" "foox")))