この問題を解決するパッチ http://saito.hatenablog.jp/entry/2014/04/17/161955

sagittarius-json-revised.diff

diff -r d14ae1e74bea sitelib/json.scm
--- a/sitelib/json.scm	Thu Apr 17 09:23:24 2014 +0200
+++ b/sitelib/json.scm	Fri Apr 18 00:03:02 2014 +0900
@@ -130,15 +130,47 @@
 				    (if (char=? (parse-results-token-value results) (string-ref str pos))
 					(loop (+ pos 1) (parse-results-next results))
 					(make-expected-result (parse-results-position starting-results) str))))))
+                          (define (interpret-string-unicode-escape-low-sarrogate results high)
+                            (let ((ch (parse-results-token-value results)))
+                              (unless (char=? ch #\\)
+                                (error 'json-read "JSON Parse Error"))
+                              (let* ((results (parse-results-next results))
+                                     (ch (parse-results-token-value results)))
+                                (unless (char=?  ch #\u)
+                                  (error 'json-read "JSON Parse Error"))
+                                (let ((results (parse-results-next results)))
+                                  (let loop ((i 0)
+                                             (acc '())
+                                             (results results))
+                                    (let ((ch (parse-results-token-value results)))
+                                      (cond ((= i 4)
+                                             (values
+                                              (let ((cp (string->number (list->string (reverse acc)) 16)))
+                                                (if (<= #xdc00 cp #xdfff)
+                                                    (integer->char
+                                                     (+ #x10000
+                                                        (* (- high #xd800) #x400)
+                                                        (- cp #xdc00)))
+                                                    (error 'json-read "JSON Parse Error")))
+                                              results))
+                                            ((memv ch '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\a #\b #\c #\d #\e #\f #\A #\B #\C #\D #\E #\F))
+                                             (loop (+ i 1)
+                                                   (cons ch acc)
+                                                   (parse-results-next results)))
+                                            (else (error 'json-read "JSON Parse Error")))))))))
 			  (define (interpret-string-unicode-escape results k)
 			    (let loop ((i 0)
 				       (acc '())
 				       (results results))
 			      (let ((ch (parse-results-token-value results)))
 				(cond ((= i 4)
-				       (k
-					(integer->char (string->number (list->string (reverse acc)) 16))
-					results))
+				       (call-with-values
+                                           (lambda()
+                                             (let ((cp (string->number (list->string (reverse acc)) 16)))
+                                               (if (<= #xd800 cp #xdbff)
+                                                   (interpret-string-unicode-escape-low-sarrogate results cp)
+                                                   (values (integer->char cp) results))))
+                                           k))
 				      ((memv ch '(#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 #\a #\b #\c #\d #\e #\f #\A #\B #\C #\D #\E #\F))
 				       (loop (+ i 1)
 					     (cons ch acc)