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

Last change on this file since 15806 was 15806, checked in by Ivan Raikov, 11 years ago

added copyright notice to csv and json-abnf

File size: 6.7 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;;  Copyright 2009 Ivan Raikov.
9;;
10;;  Redistribution and use in source and binary forms, with or without
11;;  modification, are permitted provided that the following conditions
12;;  are met:
13;;
14;;  - Redistributions of source code must retain the above copyright
15;;  notice, this list of conditions and the following disclaimer.
16;;
17;;  - Redistributions in binary form must reproduce the above
18;;  copyright notice, this list of conditions and the following
19;;  disclaimer in the documentation and/or other materials provided
20;;  with the distribution.
21;;
22;;  - Neither name of the copyright holders nor the names of its
23;;  contributors may be used to endorse or promote products derived
24;;  from this software without specific prior written permission.
25;;
26;;  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE
27;;  CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,
28;;  INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
29;;  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
30;;  DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR THE
31;;  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
32;;  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
33;;  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
34;;  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED
35;;  AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
36;;  LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
37;;  ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
38;;  POSSIBILITY OF SUCH DAMAGE.
39;;
40
41(module json-abnf
42
43        (parser)
44
45        (import scheme chicken data-structures srfi-1 srfi-14)
46
47        (require-library abnf abnf-consumers)
48        (import (prefix abnf abnf:) 
49                (prefix abnf-consumers abnf:) 
50                )
51
52
53;; helper macro for mutually-recursive parser definitions
54
55(define-syntax vac
56  (syntax-rules ()
57    ((_ fn) (lambda args (apply fn args)))))
58
59;; construct numbers from consumed chars
60(define consumed-chars->number
61  (abnf:consumed-chars->list 
62   (compose string->number list->string)))
63
64;; shortcut for (bind consumed-chars->number (longest ... ))
65(define-syntax bind-consumed->number
66  (syntax-rules () 
67    ((_ p)    (abnf:bind
68               consumed-chars->number
69               (abnf:longest p)))
70    ))
71
72(define consumed-chars->char-code
73  (abnf:consumed-chars->list 
74   (compose (lambda (x) (string->number x 16))
75            list->string)))
76
77(define-syntax bind-consumed->char-code
78  (syntax-rules () 
79    ((_ p)    (abnf:bind
80               consumed-chars->char-code
81               (abnf:longest p)))
82    ))
83
84(define (value?  x)    (or (string? x) (number? x) (boolean? x)
85                           (vector? x) (list? x)))
86
87(define consumed-values (abnf:consumed-objects value?))
88(define consumed-values->list (abnf:consumed-objects-lift consumed-values))
89
90;; shortcut for (abnf:bind (consumed-values->list ...) (abnf:longest ... ))
91(define-syntax bind-consumed-values->list
92  (syntax-rules () 
93    ((_ l p)    (abnf:bind (consumed-values->list l)  (abnf:longest p)))
94    ((_ p)      (abnf:bind (consumed-values->list)    (abnf:longest p)))
95    ))
96
97;; construct vectors from consumed values
98(define consumed-values->vector 
99  ((abnf:consumed-objects-lift consumed-values)
100   list->vector))
101
102;; shortcut for (abnf:bind (consumed-values->vector ...) (abnf:longest ... ))
103(define-syntax bind-consumed-values->vector
104  (syntax-rules () 
105    ((_ p)      (abnf:bind consumed-values->vector  (abnf:longest p)))
106    ))
107
108(define ws (abnf:repetition (abnf:set-from-string " \t\r\n")))
109
110(define (structural-char c)
111  (abnf:drop-consumed
112   (abnf:concatenation
113    ws (abnf:char c) ws
114    )))
115
116(define begin-array     (structural-char #\[))
117(define begin-object    (structural-char #\{))
118(define end-array       (structural-char #\]))
119(define end-object      (structural-char #\}))
120(define name-separator  (structural-char #\:)) 
121(define value-separator (structural-char #\,)) 
122
123(define value 
124  (vac
125   (abnf:alternatives 
126    false null true number p-string  object array)))
127
128(define false
129  (abnf:bind
130   (abnf:consumed-chars->list (lambda x #f))
131   (abnf:lit "false")))
132
133(define null
134  (abnf:bind
135   (abnf:consumed-chars->list (lambda x '()))
136   (abnf:lit "null")))
137
138(define true
139  (abnf:bind
140   (abnf:consumed-chars->list (lambda x (list #t)))
141   (abnf:lit "true")))
142
143(define escaped 
144  (abnf:concatenation
145   (abnf:drop-consumed (abnf:char #\\))
146   (abnf:alternatives
147    (abnf:set 
148     (char-set #\" #\\ #\/ #\backspace #\page 
149               #\newline #\return #\tab))
150    (bind-consumed->char-code
151     (abnf:repetition-n 4 abnf:hexadecimal)))))
152
153     
154(define char
155  (abnf:alternatives
156   (abnf:set 
157    (char-set-union
158      (ucs-range->char-set #x20 #x21)
159      (ucs-range->char-set #x23 #x5B)
160      (ucs-range->char-set #x5D #x10FFFF)))
161   escaped))
162
163(define p-string
164  (abnf:bind-consumed->string
165   (abnf:concatenation
166    (abnf:drop-consumed (abnf:char #\"))
167    (abnf:repetition char)
168    (abnf:drop-consumed (abnf:char #\")))))
169
170
171(define number
172  (let* ((digit        (abnf:range #\0 #\9))
173         (digits       (abnf:repetition1 digit))
174         (fraction     (abnf:concatenation (abnf:char #\.) digits))
175         (significand  (abnf:alternatives 
176                        (abnf:concatenation 
177                         digits
178                         (abnf:optional-sequence fraction)) 
179                        fraction))
180         (exp          (abnf:concatenation
181                        (abnf:set-from-string "eE") 
182                        (abnf:concatenation
183                         (abnf:optional-sequence 
184                          (abnf:set-from-string "+-"))
185                         digits)))
186         (sign         (abnf:optional-sequence 
187                        (abnf:char #\-))))
188
189    (bind-consumed->number
190     (abnf:concatenation 
191      sign
192      (abnf:concatenation 
193       significand
194       (abnf:optional-sequence exp))))))
195
196
197(define p-member 
198  (bind-consumed-values->list
199   (abnf:concatenation
200    p-string
201    name-separator 
202    value
203    )))
204
205
206(define object
207  (abnf:bind-consumed-pairs->list 'object
208   (abnf:concatenation
209    begin-object
210    (abnf:optional-sequence
211     (abnf:concatenation
212      p-member 
213      (abnf:repetition
214       (abnf:concatenation 
215        value-separator 
216        p-member))))
217    end-object)))
218
219
220
221 
222(define array
223  (bind-consumed-values->vector
224   (abnf:concatenation
225    begin-array
226    (abnf:optional-sequence
227     (abnf:concatenation
228      value
229      (abnf:repetition
230       (abnf:concatenation
231        value-separator
232        value ) )))
233    end-array))
234  )
235
236
237(define JSON-text
238  (abnf:alternatives object array))
239
240
241(define (->char-list s)
242  (if (string? s) (string->list s) s))
243
244
245(define (err s)
246  (print "JSON parser error on stream: " s)
247  (list))
248
249
250(define (check s) (lambda (s1) (if (null? s1) (err s) s1)))
251
252
253(define parser
254  (let ((p (abnf:longest JSON-text)))
255    (lambda (s)
256      (reverse (caar (p (check s) `((() ,(->char-list s)))))))))
257
258)
Note: See TracBrowser for help on using the repository browser.