tests/009/json.txr


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93

@;
@; A JSON value is a string, number, associative object, keyword or array.
@;
@(define value (v))@\
  @(cases)@\
    @(string v)@(or)@(num v)@(or)@(object v)@(or)@\
    @(keyword v)@(or)@(array v)@\
  @(end)@\
@(end)
@;
@; Pattern function for matching whitespace
@;
@(define ws)@/[\n\t ]*/@(end)
@;
@; Pattern function for matching a JSON string, with all the
@; escape sequences.
@;
@(define string (s))@\
  @(local hex)@\
  @(ws)@\
  "@(coll :gap 0 :vars (s))@\
     @(cases)@\
       \"@(bind s "&quot;")@(or)@\
       \\@(bind s "\\\\")@(or)@\
       \/@(bind s "\\/")@(or)@\
       \b@(bind s "&#8;")@(or)@\
       \f@(bind s "&#12;")@(or)@\
       \n@(bind s "&#10;")@(or)@\
       \r@(bind s "&#13;")@(or)@\
       \t@(bind s "&#9;")@(or)@\
       \u@{hex /[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]/}@\
         @(bind s `&#x@hex;`)@(or)@\
       @{s /[^"\\]*/}@(filter :to_html s)@\
     @(end)@\
     @(until)"@\
   @(end)"@\
  @(ws)@\
  @(cat s "")@\
  @(filter :from_html s)@\
@(end)
@;
@; Pattern function for recognizing a number.
@;
@(define num (n))@\
  @(local tok)@\
  @(ws)@{tok /-?[0-9]+((\.[0-9]+)?([Ee][+\-]?[0-9]+)?)?/}@(ws)@\
  @(bind n @(flo-str tok))@\
@(end)
@;
@; Recognize the JSON keyword true, false and null, turning
@; them into TXR Lisp keywords
@;
@(define keyword (k))@\
  @(local tok)@\
  @(all)@(ws)@{tok /true|false|null/}@(trailer)@/[^A-Za-z0-9_]/@(end)@(ws)@\
  @(bind k @(intern tok keyword-package))@\
@(end)
@;
@; Recognize an object: a collection of string/value pairs,
@; turning them into an equal-based hash table
@;
@(define object (v))@\
  @(local p e pair)@\
  @(ws){@(ws)@(coll :gap 0 :vars (pair))@\
                @(string p):@(value e)@/,?/@\
                @(bind pair (p e))@\
                @(until)}@\
             @(end)}@(ws)@\
  @(bind v @(progn ^#H((:equal-based) ,*pair)))@\
@(end)
@;
@; Recognize an array.
@;
@(define array (v))@\
  @(local e)@\
  @(ws)[@(ws)@(coll :gap 0 :vars (e))@(value e)@/,?/@(until)]@(end)]@(ws)@\
  @(bind v @(progn ^#(,*e)))@\
@(end)
@;
@; Now parse the input as a JSON object
@;
@(next :args)
@(collect)
@file
@(next file)
@(freeform)
@(maybe)@(value ast)@(end)@badsyntax
@;
@; Output resulting abstract syntax tree.
@;
@(do (format t "AST: ~s\n\n" ast)
     (format t "Unmatched junk: ~s\n\n" badsyntax))
@(end)