kyle
/
kutils
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Robust parsing of map literals.

This commit is contained in:
Kyle 2015-04-06 10:09:11 -07:00
parent 55aeec08d3
commit e14ffc164f
1 changed files with 10 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
kutils.lisp
View File

@ -22,15 +22,15 @@
(labels ((finalise-read (x) (labels ((finalise-read (x)
(reverse (concatenate 'string x))) (reverse (concatenate 'string x)))
(finalise-kv-pair () (finalise-kv-pair ()
(if key-p (if key-p
(progn (unless (null k)
(setq key-p nil (setq key-p nil
k (read-from-string (finalise-read k)))) k (read-from-string (finalise-read k))))
(progn (unless (null v)
(setq key-p t (setq key-p t
v (read-from-string (finalise-read v))) v (read-from-string (finalise-read v)))
(setf (gethash k m) v) (setf (gethash k m) v)
(setq k nil v nil))))) (setq k nil v nil)))))
(do ((prev (read-char stream) curr) (do ((prev (read-char stream) curr)
(curr (read-char stream) (read-char stream))) (curr (read-char stream) (read-char stream)))
((and (char= prev #\}) (char= curr #\#))) ((and (char= prev #\}) (char= curr #\#)))
@ -39,8 +39,7 @@
(if key-p (if key-p
(push prev k) (push prev k)
(push prev v)))) (push prev v))))
(if (and (null k) (if (and (null v) (not (null k)))
(null v))
(error "Mismatched key value pairs.") (error "Mismatched key value pairs.")
(progn (progn
(finalise-kv-pair) (finalise-kv-pair)