; balanced delimiters
(define (balanced? str) ; () [] {} <> '' "" escape with \
(let ((delims '((#\( . #\)) (#\[ . #\]) (#\{ . #\}) (#\< . #\>))))
(let loop ((cs (string->list str)) (stack (list)) (single? #f) (double? #f))
(cond ((null? cs) (and (null? stack) (not single?) (not double?)))
((char=? #\\ (car cs))
(if (null? (cdr cs)) (null? stack)
(loop (cddr cs) stack single? double?)))
((and single? (null? cs)) #f)
((and single? (char=? (car cs) #\')) (loop (cdr cs) stack #f #f))
(single? (loop (cdr cs) stack #t #f))
((and double? (null? cs)) #f)
((and double? (char=? (car cs) #\")) (loop (cdr cs) stack #f #f))
(double? (loop (cdr cs) stack #f #t))
((char=? #\' (car cs)) (loop (cdr cs) stack #t #f))
((char=? #\" (car cs)) (loop (cdr cs) stack #f #t))
((assoc (car cs) delims) =>
(lambda (xs) (loop (cdr cs) (cons (cdr xs) stack) #f #f)))
((member (car cs) (map cdr delims))
(if (null? stack) #f
(if (not (char=? (car cs) (car stack))) #f
(loop (cdr cs) (cdr stack) #f #f))))
(else (loop (cdr cs) stack #f #f))))))
(display "These true: ")
(let ((tests '("" "abc" "()" "[[[]]]" "'('" "\\(()")))
(display (map balanced? tests)) (newline))
(display "These false: ")
(let ((tests '("(" "([)]" "'{'}" "\\()")))
(display (map balanced? tests)) (newline))