@;
@; 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 """)@(or)@\
       \\@(bind s "\\\\")@(or)@\
       \/@(bind s "\\/")@(or)@\
       \b@(bind s "")@(or)@\
       \f@(bind s "")@(or)@\
       \n@(bind s "
")@(or)@\
       \r@(bind s "
")@(or)@\
       \t@(bind s "	")@(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)