okay actually they have to be strings, lets parameterize the acons

d-/json.scm

@@ -27,11 +27,16 @@
 (define-peg-pattern eobj     all  (and open-cu close-cu))
 (define-peg-pattern object   all  (or eobj
 				      (and open-cu
-					   (* (and value (ignore ":") ++ value comma))
-					   (and value (ignore ":") ++ value)
+					   (* (and string (ignore ":") ++ value comma))
+					   (and string (ignore ":") ++ value)
 					   close-cu)))
 (define-peg-pattern value    body (or number boolean string array object))
 
+(define *obj-acons*
+  (make-parameter
+   (lambda (key value rest)
+     (acons (string->symbol key) value rest))))
+
 (define (parse-boolean s)
   (if (string= s "true") #t #f))
 
@@ -49,10 +54,10 @@
 (define (parse-object ss)
   (if (or (null? ss) (null? (cdr ss)))
       '()
-      (let ([key (parse-value (car ss))])
-        (acons (if (string? key) (string->symbol key) key)
-	       (parse-value (cadr ss))
-	       (parse-object (cddr ss))))))
+      (let ([key (parse-value (car ss))]
+	    [value (parse-value (cadr ss))]
+	    [rest (parse-object (cddr ss))])
+	((*obj-acons*) key value rest))))
 
 (define flatwords '(boolean number string array object))
 
@@ -69,11 +74,14 @@
 	(make-programming-error)
 	(make-exception-with-irritants s)))))
 
-(define (json string)
+(define* (json string #:key obj-acons)
   "Parses a json string into a sexp"
   (define match (match-pattern value string))
   (if match
-      (parse-value (peg:tree match))
+      (if obj-acons
+	  (parameterize ([*obj-acons* obj-acons])
+	    (parse-value (peg:tree match)))
+	  (parse-value (peg:tree match)))
       (raise-exception (make-exception
 			(make-external-error)
 			(make-exception-with-irritants string)))))

test.scm

@@ -121,9 +121,13 @@
     (assert-equal '() (json "{}"))
     (assert-equal '((cat . 1)
 		    (bat . #t)
-		    (rat . "yessir")
-                    (4   . "what"))
-		  (json "{\"cat\": 1, \"bat\": true, \"rat\": \"yessir\", 4: \"what\"}"))
+		    (rat . "yessir"))
+		  (json "{\"cat\": 1, \"bat\": true, \"rat\": \"yessir\"}"))
     (assert-equal '((butter . 1)
 		    (brownie))
-		  (json "{\"butter\": 1, \"brownie\": {}}"))))
+		  (json "{\"butter\": 1, \"brownie\": {}}"))
+    (assert-equal '(1 2)
+		  (json "{\"hello\": 1, \"world\": 2}"
+			#:obj-acons
+			(lambda (_key value rest)
+			  (cons value rest))))))