source: project/release/4/json-abnf/trunk/json-abnf.scm @ 27930

Last change on this file since 27930 was 27930, checked in by Ivan Raikov, 7 years ago

json-abnf: formatting fix

File size: 6.6 KB
Line 
1;;
2;;
3;;  A parser for JavaScript Object Notation (JSON)
4;;
5;;  Based on RFC 4627, "The application/json Media Type for JavaScript
6;;  Object Notation (JSON)"
7;;
8;;
9;;   Copyright 2009-2012 Ivan Raikov and the Okinawa Institute of
10;;   Science and Technology.
11;;
12;;
13;;   This program is free software: you can redistribute it and/or
14;;   modify it under the terms of the GNU General Public License as
15;;   published by the Free Software Foundation, either version 3 of
16;;   the License, or (at your option) any later version.
17;;
18;;   This program is distributed in the hope that it will be useful,
19;;   but WITHOUT ANY WARRANTY; without even the implied warranty of
20;;   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
21;;   General Public License for more details.
22;;
23;;   A full copy of the GPL license can be found at
24;;   <http://www.gnu.org/licenses/>.
25
26
27(module json-abnf
28
29        (parser)
30
31        (import scheme chicken data-structures srfi-1)
32        (require-extension utf8 utf8-srfi-14)
33        (require-library abnf-charlist abnf-consumers)
34        (import (prefix abnf-charlist abnf:) 
35                (prefix abnf-consumers abnf:) 
36                )
37
38
39;; helper macro for mutually-recursive parser definitions
40
41(define-syntax vac
42  (syntax-rules ()
43    ((_ fn) (lambda args (apply fn args)))))
44
45;; construct numbers from consumed chars
46(define consumed-chars->number
47  (abnf:consumed-chars->list 
48   (compose string->number list->string)))
49
50;; shortcut for (bind consumed-chars->number ... )
51(define-syntax bind-consumed->number
52  (syntax-rules () 
53    ((_ p)    (abnf:bind consumed-chars->number p))
54    ))
55
56
57(define escaped-char->control-char
58  (abnf:consumed-chars->list 
59   (lambda (x) 
60     (case (car x)
61       ((#\b)    #\backspace )
62       ((#\f)    #\page )
63       ((#\n)    #\newline )
64       ((#\r)    #\return )
65       ((#\t)    #\tab )
66       (else     (car x))))))
67                         
68
69(define-syntax bind-consumed->control-char
70  (syntax-rules () 
71    ((_ p)    (abnf:bind escaped-char->control-char p))
72    ))
73
74
75(define consumed-chars->char-code
76  (abnf:consumed-chars->list 
77   (compose (lambda (x) (integer->char (string->number x 16)))
78            list->string)))
79
80
81(define-syntax bind-consumed->char-code
82  (syntax-rules () 
83    ((_ p)    (abnf:bind consumed-chars->char-code p))
84    ))
85
86(define (value?  x)    (or (string? x) (number? x) (boolean? x)
87                           (vector? x) (null? x) (pair? x) (symbol? x)))
88
89(define consumed-values (abnf:consumed-objects value?))
90(define consumed-values->list
91  (abnf:consumed-objects-lift consumed-values))
92
93;; shortcut for (abnf:bind (consumed-values->list ...) ... )
94(define-syntax bind-consumed-values->list
95  (syntax-rules () 
96    ((_ l p)    (abnf:bind (consumed-values->list l)  p))
97    ((_ p)      (abnf:bind (consumed-values->list)    p))
98    ))
99
100;; construct vectors from consumed values
101(define consumed-values->vector 
102  ((abnf:consumed-objects-lift consumed-values)
103   list->vector))
104
105;; shortcut for (abnf:bind (consumed-values->vector ...) ... )
106(define-syntax bind-consumed-values->vector
107  (syntax-rules () 
108    ((_ p)      (abnf:bind consumed-values->vector  p))
109    ))
110
111;; construct pairs from consumed values
112(define consumed-values->pair 
113  ((abnf:consumed-objects-lift consumed-values)
114   (lambda (l)
115     (or (and (null? l) l) 
116         (cons (car l) (cadr l))))
117   ))
118
119;; shortcut for (abnf:bind (consumed-values->pair ...) ... )
120(define-syntax bind-consumed-values->pair
121  (syntax-rules () 
122    ((_ p)      (abnf:bind consumed-values->pair  p))
123    ))
124
125(define ws (abnf:repetition (abnf:set-from-string " \t\r\n")))
126
127(define (structural-char c)
128  (abnf:concatenation ws (abnf:char c) ws))
129
130(define begin-array     (structural-char #\[))
131(define begin-object    (structural-char #\{))
132(define end-array       (structural-char #\]))
133(define end-object      (structural-char #\}))
134(define name-separator  (abnf:drop-consumed (structural-char #\:)) )
135(define value-separator (abnf:drop-consumed (structural-char #\,)) )
136
137(define value 
138  (vac
139   (abnf:alternatives 
140    false null true number p-string object array)))
141
142(define false
143  (abnf:bind
144   (lambda x (list #f))
145   (abnf:lit "false")))
146
147(define null
148  (abnf:bind
149   (lambda x (list 'null))
150   (abnf:lit "null")))
151
152(define true
153  (abnf:bind
154   (lambda x (list #t))
155   (abnf:lit "true")))
156
157(define escaped 
158  (abnf:concatenation
159   (abnf:drop-consumed (abnf:char #\\))
160   (abnf:alternatives
161    (bind-consumed->control-char
162     (abnf:set  (char-set #\" #\\ #\/ #\b #\f #\n #\r #\t)))
163    (abnf:concatenation 
164     (abnf:drop-consumed (abnf:char #\u))
165     (bind-consumed->char-code
166      (abnf:repetition-n 4 abnf:hexadecimal)))
167    )))
168
169     
170(define char
171  (abnf:alternatives
172   (abnf:set 
173    (char-set-union
174      (ucs-range->char-set #x20 #x22)
175      (ucs-range->char-set #x23 #x5C)
176      (ucs-range->char-set #x5D #x10FFFF)))
177   escaped))
178
179
180
181(define p-string
182  (abnf:alternatives
183   (abnf:bind-consumed->string
184    (abnf:concatenation
185     (abnf:drop-consumed (abnf:char #\"))
186     (abnf:repetition1 char)
187     (abnf:drop-consumed (abnf:char #\"))))
188   (abnf:bind (lambda (x) (list ""))  (abnf:concatenation (abnf:char #\") (abnf:char #\")))
189   ))
190   
191
192
193(define number
194  (let* ((digit        (abnf:range #\0 #\9))
195         (digits       (abnf:repetition1 digit))
196         (fraction     (abnf:concatenation (abnf:char #\.) digits))
197         (significand  (abnf:alternatives 
198                        (abnf:concatenation 
199                         digits
200                         (abnf:optional-sequence fraction)) 
201                        fraction))
202         (exp          (abnf:concatenation
203                        (abnf:set-from-string "eE") 
204                        (abnf:concatenation
205                         (abnf:optional-sequence 
206                          (abnf:set-from-string "+-"))
207                         digits)))
208         (sign         (abnf:optional-sequence 
209                        (abnf:char #\-))))
210
211    (bind-consumed->number
212     (abnf:concatenation 
213      sign
214      (abnf:concatenation 
215       significand
216       (abnf:optional-sequence exp))))))
217
218
219(define p-member 
220  (bind-consumed-values->pair
221   (abnf:concatenation
222    p-string
223    name-separator 
224    value
225    )))
226
227
228(define object
229  (bind-consumed-values->list 
230    (abnf:concatenation
231     (abnf:drop-consumed begin-object)
232     (abnf:optional-sequence
233      (abnf:concatenation
234       p-member 
235       (abnf:repetition
236        (abnf:concatenation 
237         value-separator 
238         p-member))))
239     (abnf:drop-consumed end-object))))
240
241
242(define array
243  (bind-consumed-values->vector
244   (abnf:concatenation
245    (abnf:drop-consumed begin-array)
246    (abnf:optional-sequence
247     (abnf:concatenation
248      value
249      (abnf:repetition
250       (abnf:concatenation
251        value-separator
252        value ) )))
253    (abnf:drop-consumed end-array)
254    )))
255
256
257
258(define JSON-text
259  (abnf:alternatives object array))
260
261
262(define (->char-list s)
263  (if (string? s) (string->list s) s))
264
265
266(define (err s)
267  (print "JSON parser error on stream: " s)
268  `(error))
269
270
271(define parser
272  (lambda (s)
273    (JSON-text caar err `(() ,(->char-list s)))))
274
275)
Note: See TracBrowser for help on using the repository browser.