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

  (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-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 <>))))

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