Merge branch 'master' into arrays

Conflicts:
	jscl.lisp
	src/prelude.js

diff --combined jscl.lisp
index 8cc5f71,c975422..4b2ac4a
--- 1/jscl.lisp
--- 2/jscl.lisp
+++ b/jscl.lisp
@@@ -26,15 -26,15 +26,16 @@@
    '(("boot"             :target)
      ("compat"           :host)
      ("utils"            :both)
 +    ("numbers"          :target)
++    ("char"             :target)
      ("list"             :target)
 +    ("array"            :target)
      ("string"           :target)
      ("sequence"         :target)
      ("print"            :target)
      ("package"          :target)
      ("ffi"              :target)
      ("misc"             :target)
 -    ("numbers"          :target)
 -    ("char"             :target)
      ("read"             :both)
      ("defstruct"        :both)
      ("lambda-list"      :both)

diff --combined src/compiler.lisp
index 40a5b2b,e2f9fca..1fb6305
--- 1/src/compiler.lisp
--- 2/src/compiler.lisp
+++ b/src/compiler.lisp
@@@ -1178,29 -1178,58 +1178,29 @@@
  
  (define-builtin char-code (x)
    (type-check (("x" "string" x))
-     "x.charCodeAt(0)"))
+     "char_to_codepoint(x)"))
  
  (define-builtin code-char (x)
    (type-check (("x" "number" x))
-     "String.fromCharCode(x)"))
+     "char_from_codepoint(x)"))
  
  (define-builtin characterp (x)
    (js!bool
     (js!selfcall
       "var x = " x ";" *newline*
-      "return (typeof(" x ") == \"string\") && x.length == 1;")))
+      "return (typeof(" x ") == \"string\") && (x.length == 1 || x.length == 2);")))
  
 -(define-builtin char-to-string (x)
 -  (js!selfcall
 -    "var r = [" x "];" *newline*
 -    "r.type = 'character';"
 -    "return r"))
 -
  (define-builtin char-upcase (x)
-   (code x ".toUpperCase()"))
+   (code "safe_char_upcase(" x ")"))
  
  (define-builtin char-downcase (x)
-   (code x ".toLowerCase()"))
+   (code "safe_char_downcase(" x ")"))
  
  (define-builtin stringp (x)
    (js!bool
     (js!selfcall
       "var x = " x ";" *newline*
 -     "return typeof(x) == 'object' && 'length' in x && x.type == 'character';")))
 -
 -(define-builtin string-upcase (x)
 -  (code "make_lisp_string(xstring(" x ").toUpperCase())"))
 -
 -(define-builtin string-length (x)
 -  (code x ".length"))
 -
 -(define-raw-builtin slice (vector a &optional b)
 -  (js!selfcall
 -    "var vector = " (ls-compile vector) ";" *newline*
 -    "var a = " (ls-compile a) ";" *newline*
 -    "var b;" *newline*
 -    (when b (code "b = " (ls-compile b) ";" *newline*))
 -    "return vector.slice(a,b);" *newline*))
 -
 -(define-builtin char (string index)
 -  (code string "[" index "]"))
 -
 -(define-builtin concat-two (string1 string2)
 -  (js!selfcall
 -    "var r = " string1 ".concat(" string2 ");" *newline*
 -    "r.type = 'character';"
 -    "return r;" *newline*))
 +     "return typeof(x) == 'object' && 'length' in x && x.stringp == 1;")))
  
  (define-raw-builtin funcall (func &rest args)
    (js!selfcall
@@@ -1274,42 -1303,51 +1274,42 @@@
  (define-builtin write-string (x)
    (code "lisp.write(" x ")"))
  
 -(define-builtin make-array (n)
 -  (js!selfcall
 -    "var r = [];" *newline*
 -    "for (var i = 0; i < " n "; i++)" *newline*
 -    (indent "r.push(" (ls-compile nil) ");" *newline*)
 -    "return r;" *newline*))
  
 -;;; FIXME: should take optional min-extension.
 -;;; FIXME: should use fill-pointer instead of the absolute end of array
 -(define-builtin vector-push-extend (new vector)
 -  (js!selfcall
 -    "var v = " vector ";" *newline*
 -    "v.push(" new ");" *newline*
 -    "return v;"))
 +;;; Storage vectors. They are used to implement arrays and (in the
 +;;; future) structures.
  
 -(define-builtin arrayp (x)
 +(define-builtin storage-vector-p (x)
    (js!bool
     (js!selfcall
       "var x = " x ";" *newline*
       "return typeof x === 'object' && 'length' in x;")))
  
 -(define-builtin aref (array n)
 +(define-builtin make-storage-vector (n)
 +  (js!selfcall
 +    "var r = [];" *newline*
 +    "r.length = " n ";" *newline*
 +    "return r;" *newline*))
 +
 +(define-builtin storage-vector-size (x)
 +  (code x ".length"))
 +
 +(define-builtin resize-storage-vector (vector new-size)
 +  (code "(" vector ".length = " new-size ")"))
 +
 +(define-builtin storage-vector-ref (vector n)
    (js!selfcall
 -    "var x = " "(" array ")[" n "];" *newline*
 +    "var x = " "(" vector ")[" n "];" *newline*
      "if (x === undefined) throw 'Out of range';" *newline*
      "return x;" *newline*))
  
 -(define-builtin aset (array n value)
 +(define-builtin storage-vector-set (vector n value)
    (js!selfcall
 -    "var x = " array ";" *newline*
 +    "var x = " vector ";" *newline*
      "var i = " n ";" *newline*
      "if (i < 0 || i >= x.length) throw 'Out of range';" *newline*
      "return x[i] = " value ";" *newline*))
  
 -(define-builtin afind (value array)
 -  (js!selfcall
 -    "var v = " value ";" *newline*
 -    "var x = " array ";" *newline*
 -    "return x.indexOf(v);" *newline*))
  
 -(define-builtin aresize (array new-size)
 -  (js!selfcall
 -    "var x = " array ";" *newline*
 -    "var n = " new-size ";" *newline*
 -    "return x.length = n;" *newline*))
  
  (define-builtin get-internal-real-time ()
    "(new Date()).getTime()")

diff --combined src/prelude.js
index 433462b,162058e..c40d0fa
--- 1/src/prelude.js
--- 2/src/prelude.js
+++ b/src/prelude.js
@@@ -51,14 -51,57 +51,57 @@@ function QIList()
      }
  }
  
+ // Return a new Array of strings, each either length-1, or length-2 (a UTF-16 surrogate pair).
+ function codepoints(string) {
+     return string.split(/(?![\udc00-\udfff])/);
+ }
  
  // Create and return a lisp string for the Javascript string STRING.
  function make_lisp_string (string){
-     var array = string.split("");
-     array.stringp = 1;
+     var array = codepoints(string);
 -    array.type = 'character'
++    array.stringp = 1
      return array;
  }
  
+ function char_to_codepoint(ch) {
+     if (ch.length == 1) {
+         return ch.charCodeAt(0);
+     } else {
+         var xh = ch.charCodeAt(0) - 0xD800;
+         var xl = ch.charCodeAt(1) - 0xDC00;
+         return 0x10000 + (xh << 10) + (xl);
+     }
+ }
+ 
+ function char_from_codepoint(x) {
+     if (x <= 0xFFFF) {
+         return String.fromCharCode(x);
+     } else {
+         x -= 0x10000;
+         var xh = x >> 10;
+         var xl = x & 0x3FF;
+         return String.fromCharCode(0xD800 + xh) + String.fromCharCode(0xDC00 + xl);
+     }
+ }
+ 
+ // if a char (JS string) has the same number of codepoints after .toUpperCase(), return that, else the original.
+ function safe_char_upcase(x) {
+     var xu = x.toUpperCase();
+     if (codepoints(xu).length == 1) {
+         return xu;
+     } else {
+         return x;
+     }
+ }
+ function safe_char_downcase(x) {
+     var xl = x.toLowerCase();
+     if (codepoints(xl).length == 1) {
+         return xl;
+     } else {
+         return x;
+     }
+ }
+ 
  function xstring(x){ return x.join(''); }
  
  
@@@ -69,7 -112,7 +112,7 @@@ function Symbol(name, package_name)
  }
  
  function lisp_to_js (x) {
 -    if (typeof x == 'object' && 'length' in x && x.type == 'character')
 +    if (typeof x == 'object' && 'length' in x && x.stringp == 1)
          return xstring(x);
      else if (typeof x == 'function'){
          // Trampoline calling the Lisp function