(require :named-readtables)
(use-package :named-readtables)
(defreadtable ccl (:merge :current)) ; Danger Will Robinson!
(hi::defindent "defreadtable" 1)

(defun make-string-reader (c1 c2)
  (lambda (stream c)
    (declare (ignore c))
    (with-output-to-string (s)
      (loop for c = (read-char stream)
        with cnt = 1
        if (eql c c1) do (incf cnt)
        else if (eql c c2) do (decf cnt)
        until (and (eql c c2) (eql cnt 0))
        do (princ c s)))))

(defreadtable balanced-quotes
  (:merge :standard)
  (:case :upcase)
  (:macro-char #\« (make-string-reader #\« #\»))
  (:macro-char #\“ (make-string-reader #\“ #\”)))

(defun |[...]| (args)
  (make-array (length args) :fill-pointer t :adjustable t :initial-contents args))
(defun |{...}| (args) (cons 'list args))

(defun make-bracket-reader (close-char dispatch-fn)
  (lambda (stream c)
    (declare (ignore c))
    (funcall dispatch-fn (read-delimited-list close-char stream))))

(defreadtable brackets
  (:merge :standard)
  (:case :upcase)
  (:macro-char #\[ (make-bracket-reader #\] '|[...]|))
  (:syntax-from :standard #\) #\])
  (:macro-char #\{ (make-bracket-reader #\} '|{...}|))
  (:syntax-from :standard #\) #\}))

; Byte vectors e.g. #v8(1 2 3 ...)
(defun v-reader (stream c1 c2)
  (declare (ignore c1 c2))
  (let* ((n (read stream))
         (l (read stream)))
    (make-array (length l)
                :element-type (list (if (minusp n) 'signed-byte 'unsigned-byte) (abs n))
                :initial-contents l)))

(defreadtable byte-vectors
  (:merge :standard)
  (:case :upcase)
  (:dispatch-macro-char #\# #\v 'v-reader))

#|
(defreadtable ciel
  (:merge :standard balanced-quotes brackets byte-vectors))

(in-readtable ciel)
[«foo "baz" bar»]
{1 (+ 1 2) 3}
(type-of #v8(1 2 3))
|#