Skip to content

Instantly share code, notes, and snippets.

Created November 2, 2011 08:22
What would you like to do?
json-encode.l #xyzzy
;;; -*- mode:lisp; package:json -*-
(in-package "json")
(export '(json-encode
(defun json-encode (obj)
(with-output-to-string (s)
(write-json obj s)))
(defun write-json (obj &optional s)
((consp obj) (write-alist obj s))
((stringp obj) (write-js-string obj s))
((characterp obj) (write-js-char obj s))
((symbolp obj) (write-js-symbol obj s))
((or (integerp obj) (single-float-p obj)) (princ obj s))
((realp obj)
(princ (substitute-string (format nil "~F" (* 1d0 obj)) "d" "e") s))
((vectorp obj) (write-array obj s))
(t (type-error obj '(or string char symbol number cons))))
(defun write-alist (al s)
(princ #\{ s)
(format s "~S:" (string (caar al)))
(write-json (cdar al) s)
(loop for (k . v) in (cdr al) do
(format s ",~S:" (string k))
(write-json v s))
(princ #\} s))
(defun write-array (v s)
(format s "[~{~A~^,~}]" (map 'list #'json-encode v)))
(defun write-js-string (str s)
(princ #\" s)
(loop for c across str do (write-js-char c s))
(princ #\" s))
(defun write-js-char (chr s)
(case chr
(#\TAB (format s "\\t"))
(#\LFD (format s "\\n"))
(#\RET (format s "\\r"))
(#\C-h (format s "\\b"))
(#\C-l (format s "\\f"))
(#\\ (format s "\\\\"))
(#\" (format s "\\\""))
(t (let ((uc (char-unicode chr)))
(when uc
(if (<= 32 uc 126)
(princ chr s)
(format s "\\u~4,'0x" uc)))))))
(defun write-js-symbol (sym s)
(cond ((or (eq sym t) (string= sym "true"))
(princ "true" s))
((or (eq sym nil) (string= sym "null"))
(princ "null" s))
((string= sym "false")
(princ "false" sym))
(t (write-js-string (symbol-name sym) s))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment