codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; json: parsing input (define json-null (string->symbol "the-json-null-object")) (define (json-null? obj) (eqv? json-null obj)) (define (read-json . args) (let ((port (if (pair? args) (car args) (current-input-port)))) (define (eat char) (let ((c (peek-char port))) (if (eof-object? c) (error 'read-json "eat unexpected end of file") (if (char=? c char) (read-char port) (error 'read-json "eat unexpected character"))))) (define (skip-white-space) (let ((c (peek-char port))) (if (and (not (eof-object? c)) (char-whitespace? c)) (begin (eat c) (skip-white-space))))) (define (read-member) (skip-white-space) (let ((key (read-string))) (skip-white-space) (eat #\:) (skip-white-space) (let ((val (read-value))) (skip-white-space) (cons key val)))) (define (read-object) (eat #\{) (skip-white-space) (let ((c (peek-char port))) (if (eof-object? c) (error 'read-json "read-object unexpected end of file") (if (char=? (peek-char port) #\}) (begin (eat #\}) (list)) (let loop ((xs (list (read-member)))) (skip-white-space) (let ((c (peek-char port))) (cond ((char=? c #\}) (reverse xs)) ((char=? c #\,) (eat #\,) (skip-white-space) (loop (cons (read-member) xs))) (else (error 'read-json "read-object syntax error"))))))))) (define (read-array) (eat #\[) (skip-white-space) (let ((c (peek-char port))) (if (eof-object? c) (error 'read-json "read-array unexpected end of file") (if (char=? c #\]) (begin (eat #\]) (vector)) (let loop ((xs (list (read-value)))) (skip-white-space) (let ((c (peek-char port))) (cond ((eof-object? c) (error 'read-json "read-array unexpected end of file")) ((char=? c #\]) (list->vector (reverse xs))) ((char=? c #\,) (eat #\,) (skip-white-space) (loop (cons (read-value) xs))) (else (error 'read-json "read-array syntax error"))))))))) (define (read-escape) (let ((c (peek-char port))) (cond ((eof-object? c) (error 'read-json "read-escape unexpected end of file")) ((char=? c #\\) (eat #\\) (let ((c (peek-char port))) (cond ((eof-object? c) (error 'read-json "read-escape unexpected end of file")) ((char=? c #\") (read-char port) #\") ((char=? c #\\) (read-char port) #\\) ((char=? c #\/) (read-char port) #\/) ((char=? c #\b) (read-char port) #\backspace) ((char=? c #\f) (read-char port) #\page) ((char=? c #\n) (read-char port) #\newline) ((char=? c #\r) (read-char port) #\return) ((char=? c #\t) (read-char port) #\tab) ((char=? c #\u) (error 'read-json "unicode not supported")) (else (error 'read-json "unrecognized escape sequence"))))) (else (read-char port))))) (define (read-string) (eat #\") (let loop ((c (peek-char port)) (cs '())) (cond ((eof-object? c) (error 'read-json "read-string unexpected end of file")) ((char=? c #\") (eat c) (skip-white-space) (list->string (reverse cs))) (else (let ((c (read-escape))) (loop (peek-char port) (cons c cs))))))) (define (read-number) (define (char->digit c) (- (char->integer c) 48)) (let* ((sign (let ((c (peek-char port))) (cond ((eof-object? c) (error 'read-json "read-number unexpected end of file")) ((char=? c #\-) (eat #\-) (let ((c (read-char port))) (if (and (not (eof-object? c)) (char-numeric? c)) -1 (error 'read-json "read-number syntax error")))) ((char-numeric? c) 1) (else (error 'read-json "read-number syntax error"))))) (numb (let loop ((c (peek-char port)) (n 0)) (cond ((eof-object? c) n) ((char-numeric? c) (eat c) (loop (peek-char port) (+ (* n 10) (char->digit c)))) (else n)))) (frac (let ((c (peek-char port))) (if (or (eof-object? c) (not (char=? c #\.))) 0 (begin (eat #\.) (let ((c (peek-char port))) (if (or (eof-object? c) (not (char-numeric? c))) (error 'read-json "read-number syntax error") (let loop ((c c) (tens 10) (n 0)) (cond ((eof-object? c) n) ((char-numeric? c) (eat c) (loop (peek-char port) (* tens 10) (+ n (/ (char->digit c) tens)))) (else n))))))))) (expo (let ((c (peek-char port))) (if (or (eof-object? c) (not (char-ci=? c #\E))) 0 (begin (eat c) (let* ((sign (let ((c (peek-char port))) (cond ((char=? c #\+) (eat c) 1) ((char=? c #\-) (eat c) -1) ((char-numeric? c) 1) (else (error 'read-json "read-number syntax error"))))) (numb (let loop ((c (peek-char port)) (n 0)) (cond ((eof-object? c) n) ((char-numeric? c) (eat c) (loop (peek-char port) (+ (* n 10) (char->digit c)))) (else n))))) (* sign numb))))))) (if (and (zero? frac) (zero? expo)) (* sign numb) (exact->inexact (* sign (+ numb frac) (expt 10 expo)))))) (define (read-constant) (let loop ((c (peek-char port)) (cs '())) (if (and (not (eof-object? c)) (char-alphabetic? c)) (begin (eat c) (loop (peek-char port) (cons c cs))) (let ((str (list->string (reverse cs)))) (cond ((string=? str "true") (skip-white-space) #t) ((string=? str "false") (skip-white-space) #f) ((string=? str "null") (skip-white-space) json-null) (else (error 'read-json "unrecognized constant"))))))) (define (read-value) (skip-white-space) (let ((c (peek-char port))) (cond ((eof-object? c) (error 'read-json "read-value unexpected end of file")) ((char=? c #\{) (read-object)) ((char=? c #\[) (read-array)) ((char=? c #\") (read-string)) ((or (char-numeric? c) (char=? c #\-)) (read-number)) ((char-alphabetic? c) (read-constant)) (else (error 'read-json "read-value syntax error"))))) (if (eof-object? (peek-char port)) (read-char port) (read-value))))
Private
[
?
]
Run code
Submit