Commits

Anonymous committed b6706bc

Drop utf8 dependency

  • Participants
  • Parent commits bfb057d

Comments (0)

Files changed (6)

+(let ()
+
 ;; ws <- `[ \t\n\r]*
 
 (define ws
 ;;         -> handle-escape
 
 (define escape
-  (bind (in char-set:json-escaped)
+  (bind (in char-set:json-escape)
         handle-escape))
 
 ;; unicode <- #\u [[:xdigit:]]{4}
 ;; char    <- #\\ ( escape / unicode ) / (![[:cntrl:]"\\] .)
 
 (define char
-  (any-of (preceded-by (is #\\) (any-of escape unicode))
-          (none-of* (satisfies json-char?) item)))
+  (any-of (preceded-by (is #\\) (any-of escape unicode fail))
+          (none-of* (in char-set:json-char) item)))
 
 ;; raw-string <- #\" char* #\"
 ;;            -> handle-string/raw
 
 (define document
   (enclosed-by ws (any-of object (array)) trailing-ws))
+
+document)
 ((synopsis "A JSON parser (and emitter) built with comparse")
  (author "Moritz Heidkamp")
  (test-depends test)
- (needs (comparse 0.0.2) utf8 vector-lib)
+ (needs (comparse 0.0.2) vector-lib)
  (category parsing)
  (license "BSD"))
  json-unparsers
  json->string)
 
-(import chicken (except scheme string member exp))
-(use srfi-14 (except utf8 string) srfi-69 lazy-seq
+(import chicken scheme)
+(use srfi-14 srfi-69 lazy-seq
      (except comparse as-string)
-     (prefix utf8-srfi-14 utf8-)
      (only srfi-1 cons* find remove)
-     (only data-structures compose constantly identity alist-ref)
-     (only utf8-srfi-13 string-concatenate string-pad)
+     (only data-structures compose constantly identity alist-ref conc string-translate*)
+     (only srfi-13 string-pad)
      (only vector-lib vector-for-each)
      (only ports with-output-to-port with-output-to-string))
 
   (result ((parser-ref 'string) string)))
 
 (define (handle-unicode u)
-  (result (integer->char (string->number u 16))))
+  (result (##sys#char->utf8-string (integer->char (string->number u 16)))))
 
 (define (handle-escape e)
   (result
   (sequence* ((parts parser))
     (result (apply conc (remove boolean? parts)))))
 
-(define char-set:json-escaped
-  (string->char-set "\"\\/bfnrt"))
+(define json-escape-chars
+  "\"\\bfnrt/")
 
-(define char-set:json-unescaped
-  (utf8-char-set-union
-   (utf8-ucs-range->char-set #x20 #x22)
-   (utf8-ucs-range->char-set #x23 #x5C)
-   (utf8-ucs-range->char-set #x5D #x110000)))
+(define json-escapes
+  (map (lambda (e c)
+         (cons (string e) (string #\\ c)))
+       (string->list "\"\\\b\f\n\r\t")
+       (string->list json-escape-chars)))
 
-(define char-set:json-char
-  (utf8-char-set-union
-   utf8-char-set:iso-control
-   (utf8-char-set #\" #\\)))
+(define char-set:json-escape
+  (string->char-set json-escape-chars))
 
-(define (json-char? c)
-  (utf8-char-set-contains? char-set:json-char c))
+(define char-set:json-char
+  (char-set-union
+   (ucs-range->char-set #x0 #x20)
+   (char-set #\" #\\)))
 
 (define consume-trailing-whitespace?
   (make-parameter #f))
 
-(include "grammar.scm")
+(define document
+  (include "grammar.scm"))
 
 (define (read-json #!optional (input (current-input-port))
                    #!key (memoize? #t) (consume-trailing-whitespace #t))
            memoize: memoize?)))
 
 (define (unparse-string s)
-  (let ((chars (string->list s)))
-    (display #\")
-    (for-each
-     (lambda (c)
-       (cond ((utf8-char-set-contains? char-set:json-unescaped c)
-              (display c))
-             ((char-set-contains? char-set:json-escaped c)
-              (display "\\")
-              (display c))
-             (else
-              (display "\\u")
-              (display (string-pad (number->string (char->integer c) 16) 4 #\0)))))
-     chars)
-    (display #\")))
+  (display #\")
+  (display (string-translate* s json-escapes))
+  (display #\"))
 
 (define (for-each/delimiter proc list delimiter)
   (let ((size (if (vector? list)

File tests/reading.scm

   (test-read '#("") "[\"\"]")
   (test-read '#("E9") "[\"\\u00459\"]")
   (test-read '#("Дҫ") "[\"\\u0414\\u04ab\"]")
-  (test-read '#("Дҫ") "[\"Дҫ\"]") ; FIXME genturfahi needs utf8 support for that to work
+  (test-read '#("Дҫ") "[\"Дҫ\"]")
   (test-read '#("\f") "[\"\\f\"]")
   (test-read '#("\"") "[\"\\\"\"]")
   (test-read #f "[\"\\x\"]"))

File tests/run.scm

-(load-relative "../medea")
-(import medea)
-(use test)
+(use test medea)
 
 (define-syntax test-read
   (syntax-rules ()

File tests/writing.scm

   (test-write "{\"foo\":[123]}" '((foo . #(123))))
   (test-write "{\"foo\":null,\"bar\":true}" '((foo . null) (bar . #t)))
   (test-write "[1,2,[3],4,{}]" '#(1 2 #(3) 4 ()))
-  (test-write "[\"\\\\\"]" '#("\\")))
+  (test-write "[\"\\\\\"]" '#("\\"))
+  (test-write "[\"Дҫ\"]" '#("Дҫ")))
 
 
 (test-group "writing and reading"