Allow non-string json object keys

This commit is contained in:
Dane Johnson 2025-01-29 15:20:32 -06:00
parent 0f04feedcd
commit bd7af0146c
2 changed files with 9 additions and 7 deletions

View File

@ -27,8 +27,8 @@
(define-peg-pattern eobj all (and open-cu close-cu))
(define-peg-pattern object all (or eobj
(and open-cu
(* (and string (ignore ":") ++ value comma))
(and string (ignore ":") ++ value)
(* (and value (ignore ":") ++ value comma))
(and value (ignore ":") ++ value)
close-cu)))
(define-peg-pattern value body (or number boolean string array object))
@ -49,9 +49,10 @@
(define (parse-object ss)
(if (or (null? ss) (null? (cdr ss)))
'()
(acons (string->symbol (parse-value (car ss)))
(parse-value (cadr ss))
(parse-object (cddr ss)))))
(let ([key (parse-value (car ss))])
(acons (if (string? key) (string->symbol key) key)
(parse-value (cadr ss))
(parse-object (cddr ss))))))
(define flatwords '(boolean number string array object))

View File

@ -121,8 +121,9 @@
(assert-equal '() (json "{}"))
(assert-equal '((cat . 1)
(bat . #t)
(rat . "yessir"))
(json "{\"cat\": 1, \"bat\": true, \"rat\": \"yessir\"}"))
(rat . "yessir")
(4 . "what"))
(json "{\"cat\": 1, \"bat\": true, \"rat\": \"yessir\", 4: \"what\"}"))
(assert-equal '((butter . 1)
(brownie))
(json "{\"butter\": 1, \"brownie\": {}}"))))