From 26af6f56fc615a008c3f433265ccecbfce815a61 Mon Sep 17 00:00:00 2001
From: =?utf8?q?David=20V=C3=A1zquez?= <davazp@gmail.com>
Date: Fri, 3 May 2013 12:17:06 +0100
Subject: [PATCH] (SETF CHAR) and move string related code to string.lisp

---
 jscl.lisp          |    1 +
 src/boot.lisp      |   13 +------------
 src/compiler.lisp  |    4 ++--
 src/string.lisp    |   36 ++++++++++++++++++++++++++++++++++++
 src/utils.lisp     |    3 ++-
 tests/strings.lisp |   18 ++++++++++++++++++
 6 files changed, 60 insertions(+), 15 deletions(-)
 create mode 100644 src/string.lisp
 create mode 100644 tests/strings.lisp

diff --git a/jscl.lisp b/jscl.lisp
index 6d907a3..720135f 100644
--- 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
--- 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
--- 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
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
--- 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
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")))
-- 
1.7.10.4