(module srfi-105 ()
  (import scheme
          chicken.read-syntax
          chicken.port
          chicken.base
          chicken.io
          chicken.irregex
          chicken.string
          chicken.condition
          srfi-13
          srfi-14)

  (include "srfi-105-core.scm")

  (define (unmatched-close str open close)
    (let ((strlst (string->list str)))
      (let loop ((index 0)
                 (stack 0)
                 (lst strlst))
        (cond ((null? lst)
               #f)
              ((char=? (car lst) open)
               (loop (add1 index) (add1 stack) (cdr lst)))
              ((and (char=? (car lst) close)
                    (> stack 0))
               (loop (add1 index) (sub1 stack) (cdr lst)))
              ((char=? (car lst) close)
               index)
              (else (loop (add1 index) stack (cdr lst)))))))

  ;; (define (replace-neoteric str #!optional (sym 'symbol))
  ;;   (or (and-let* ((match (irregex-search `(: (submatch ,sym) (submatch ("{(["))) str))
  ;;                  (symbol (irregex-match-substring match 1))
  ;;                  (open (irregex-match-substring match 2))
  ;;                  (open-char (string-ref open 0))
  ;;                  (close-char (case open-char
  ;;                                ((#\{) #\})
  ;;                                ((#\() #\))
  ;;                                ((#\[) #\])))
  ;;                  (start (irregex-match-start-index match))
  ;;                  (end (irregex-match-end-index match))
  ;;                  (rest (substring str end))
  ;;                  (close-index (+ end (unmatched-close rest open-char close-char))))
  ;;         (replace-neoteric
  ;;          (if (condition-case
  ;;                  (member (string-ref str (add1 close-index)) '(#\{ #\( #\[))
  ;;                ((exn bounds) #f))
  ;;              (let ((newsym (symbol->string (gensym))))
  ;;                (string-translate*
  ;;                 (replace-neoteric (string-replace str newsym start (add1 close-index))
  ;;                                   newsym)
  ;;                 `((,newsym . ,(substring str start (add1 close-index))))))
  ;;              (string-append
  ;;               (substring str 0 start)
  ;;               (case open-char
  ;;                 ((#\()
  ;;                  (string-append open symbol " "
  ;;                                 (replace-neoteric (substring str end close-index))
  ;;                                 (substring str close-index)))
  ;;                 ((#\[)
  ;;                  (string-append "($bracket-apply$ " symbol " "
  ;;                                 (replace-neoteric (substring str end  close-index))
  ;;                                 ")"
  ;;                                 (substring str (add1 close-index))))
  ;;                 ((#\{)
  ;;                  (string-append "(" symbol
  ;;                                 (let ((inside (substring str end (add1 close-index))))
  ;;                                   (newline)
  ;;                                   (if (irregex-match '(: (* whitespace) "}") inside)
  ;;                                       ""
  ;;                                       (string-append
  ;;                                        " "
  ;;                                        open
  ;;                                        (replace-neoteric inside))))
  ;;                                 ")"
  ;;                                 (substring str (add1 close-index)))))))))
  ;;       str))

  (define (read-curly port)
    (let* ((stop-char #\})
           (c (peek-char port)))
      (cond
       ((eof-object? c) (error "unterminated list"))
       ((char-whitespace? c)
        (read-token char-whitespace? port)
        (read-curly port))
       ((char=? c stop-char)
        (read-char port)
        '())
       ((or (eq? c #\)) (eq? c #\]) (eq? c #\}))
        (read-char port)
        (error "list-terminator mismatch" c stop-char))
       (#t
        (let ((datum (read port)))
          (cons datum (read-curly port)))))))

  ;; (define (read-curly-string port)
  ;;   (let* ((stack 0)
  ;;          (str (read-token
  ;;                (lambda (c)
  ;;                  (cond ((char=? c #\{)
  ;;                         (set! stack (add1 stack))
  ;;                         #t)
  ;;                        ((and (char=? c #\})
  ;;                              (> stack 0))
  ;;                         (set! stack (sub1 stack))
  ;;                         #t)
  ;;                        ((char=? c #\})
  ;;                         #f)))
  ;;                port)))
  ;;     (read-char port)
  ;;     str)
  ;;   )

  ;; (define (read-curly port #!optional (stop-char #\}))
  ;;   ;; (let ((str ;; (replace-neoteric
  ;;   ;;            ;;  (read-curly-string port))
  ;;   ;;        (read-curly-string port)
  ;;   ;;            ))
  ;;   ;;   (call-with-input-string str (cut read-list <>)))
  ;;   (read-curly read #\} port)
  ;;   )

  (set-read-syntax! #\{ (lambda (p) (process-curly (read-curly p)))))