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

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

json-abnf now uses abnf-consumers

File size: 5.1 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(module json-abnf
10
11        (parser)
12
13        (import scheme chicken data-structures srfi-1 srfi-14)
14
15        (require-library abnf abnf-consumers)
16        (import (prefix abnf abnf:) 
17                (prefix abnf-consumers abnf:) 
18                )
19
20
21;; helper macro for mutually-recursive parser definitions
22
23(define-syntax vac
24  (syntax-rules ()
25    ((_ fn) (lambda args (apply fn args)))))
26
27;; construct numbers from consumed chars
28(define consumed-chars->number
29  (abnf:consumed-chars->list 
30   (compose string->number list->string)))
31
32;; shortcut for (bind consumed-chars->number (longest ... ))
33(define-syntax bind-consumed->number
34  (syntax-rules () 
35    ((_ p)    (abnf:bind
36               consumed-chars->number
37               (abnf:longest p)))
38    ))
39
40(define consumed-chars->char-code
41  (abnf:consumed-chars->list 
42   (compose (lambda (x) (string->number x 16))
43            list->string)))
44
45(define-syntax bind-consumed->char-code
46  (syntax-rules () 
47    ((_ p)    (abnf:bind
48               consumed-chars->char-code
49               (abnf:longest p)))
50    ))
51
52(define (value?  x)    (or (string? x) (number? x) (boolean? x)
53                           (vector? x) (list? x)))
54
55(define consumed-values (abnf:consumed-objects value?))
56(define consumed-values->list (abnf:consumed-objects-lift consumed-values))
57
58;; shortcut for (abnf:bind (consumed-values->list ...) (abnf:longest ... ))
59(define-syntax bind-consumed-values->list
60  (syntax-rules () 
61    ((_ l p)    (abnf:bind (consumed-values->list l)  (abnf:longest p)))
62    ((_ p)      (abnf:bind (consumed-values->list)    (abnf:longest p)))
63    ))
64
65;; construct vectors from consumed values
66(define consumed-values->vector 
67  ((abnf:consumed-objects-lift consumed-values)
68   list->vector))
69
70;; shortcut for (abnf:bind (consumed-values->vector ...) (abnf:longest ... ))
71(define-syntax bind-consumed-values->vector
72  (syntax-rules () 
73    ((_ p)      (abnf:bind consumed-values->vector  (abnf:longest p)))
74    ))
75
76(define ws (abnf:repetition (abnf:set-from-string " \t\r\n")))
77
78(define (structural-char c)
79  (abnf:drop-consumed
80   (abnf:concatenation
81    ws (abnf:char c) ws
82    )))
83
84(define begin-array     (structural-char #\[))
85(define begin-object    (structural-char #\{))
86(define end-array       (structural-char #\]))
87(define end-object      (structural-char #\}))
88(define name-separator  (structural-char #\:)) 
89(define value-separator (structural-char #\,)) 
90
91(define value 
92  (vac
93   (abnf:alternatives 
94    false null true number p-string  object array)))
95
96(define false
97  (abnf:bind
98   (abnf:consumed-chars->list (lambda x #f))
99   (abnf:lit "false")))
100
101(define null
102  (abnf:bind
103   (abnf:consumed-chars->list (lambda x '()))
104   (abnf:lit "null")))
105
106(define true
107  (abnf:bind
108   (abnf:consumed-chars->list (lambda x (list #t)))
109   (abnf:lit "true")))
110
111(define escaped 
112  (abnf:concatenation
113   (abnf:drop-consumed (abnf:char #\\))
114   (abnf:alternatives
115    (abnf:set 
116     (char-set #\" #\\ #\/ #\backspace #\page 
117               #\newline #\return #\tab))
118    (bind-consumed->char-code
119     (abnf:repetition-n 4 abnf:hexadecimal)))))
120
121     
122(define char
123  (abnf:alternatives
124   (abnf:set 
125    (char-set-union
126      (ucs-range->char-set #x20 #x21)
127      (ucs-range->char-set #x23 #x5B)
128      (ucs-range->char-set #x5D #x10FFFF)))
129   escaped))
130
131(define p-string
132  (abnf:bind-consumed->string
133   (abnf:concatenation
134    (abnf:drop-consumed (abnf:char #\"))
135    (abnf:repetition char)
136    (abnf:drop-consumed (abnf:char #\")))))
137
138
139(define number
140  (let* ((digit        (abnf:range #\0 #\9))
141         (digits       (abnf:repetition1 digit))
142         (fraction     (abnf:concatenation (abnf:char #\.) digits))
143         (significand  (abnf:alternatives 
144                        (abnf:concatenation 
145                         digits
146                         (abnf:optional-sequence fraction)) 
147                        fraction))
148         (exp          (abnf:concatenation
149                        (abnf:set-from-string "eE") 
150                        (abnf:concatenation
151                         (abnf:optional-sequence 
152                          (abnf:set-from-string "+-"))
153                         digits)))
154         (sign         (abnf:optional-sequence 
155                        (abnf:char #\-))))
156
157    (bind-consumed->number
158     (abnf:concatenation 
159      sign
160      (abnf:concatenation 
161       significand
162       (abnf:optional-sequence exp))))))
163
164
165(define p-member 
166  (bind-consumed-values->list
167   (abnf:concatenation
168    p-string
169    name-separator 
170    value
171    )))
172
173
174(define object
175  (abnf:bind-consumed-pairs->list 'object
176   (abnf:concatenation
177    begin-object
178    (abnf:optional-sequence
179     (abnf:concatenation
180      p-member 
181      (abnf:repetition
182       (abnf:concatenation 
183        value-separator 
184        p-member))))
185    end-object)))
186
187
188
189 
190(define array
191  (bind-consumed-values->vector
192   (abnf:concatenation
193    begin-array
194    (abnf:optional-sequence
195     (abnf:concatenation
196      value
197      (abnf:repetition
198       (abnf:concatenation
199        value-separator
200        value ) )))
201    end-array))
202  )
203
204
205(define JSON-text
206  (abnf:alternatives object array))
207
208
209(define (->char-list s)
210  (if (string? s) (string->list s) s))
211
212
213(define (err s)
214  (print "JSON parser error on stream: " s)
215  (list))
216
217
218(define (check s) (lambda (s1) (if (null? s1) (err s) s1)))
219
220
221(define parser
222  (let ((p (abnf:longest JSON-text)))
223    (lambda (s)
224      (reverse (caar (p (check s) `((() ,(->char-list s)))))))))
225
226)
Note: See TracBrowser for help on using the repository browser.