#lang scheme/base
(require (planet bzlib/base)
)
(define iqs-symbol-escape (make-parameter #\\))
(define iqs-symbol-start (make-parameter #\$))
(define iqs-symbol-allowed-chars (make-parameter '(#\- #\_)))
(define (is-symbol-start? in (acc '()))
(equal? (peek-char in) (iqs-symbol-start)))
(define (read-symbol in)
(define (return acc)
(string->symbol (list->string (reverse acc))))
(define (helper acc)
(let ((c (peek-char in)))
(cond ((eof-object? c)
(if (null? acc) eof (return acc)))
((and (or (char-symbolic? c) (char-punctuation? c))
(not (member c (iqs-symbol-allowed-chars))))
(return acc))
((char-whitespace? c)
(return acc))
(else
(helper (cons (read-char in) acc))))))
(read-char in) (helper '()))
(define (read-string in)
(define (return acc)
(list->string (reverse acc)))
(define (helper acc)
(let ((c (peek-char in)))
(cond ((eof-object? c)
(if (null? acc) eof (return acc)))
((and (equal? c (iqs-symbol-escape))
(equal? (peek-char in 1) (iqs-symbol-start)))
(read-char in)
(helper (cons (read-char in) acc)))
((is-symbol-start? in)
(return acc))
(else
(helper (cons (read-char in) acc))))))
(helper '()))
(define (read-iqs in (read-symbol read-symbol))
(define (helper acc)
(let ((c (peek-char in)))
(cond ((eof-object? c)
(reverse acc))
((equal? c (iqs-symbol-start))
(helper (cons (read-symbol in) acc)))
(else
(helper (cons (read-string in) acc))))))
(helper '()))
(define (assoc-converter args)
(lambda (s)
(assoc*/cdr s
(map (lambda (kv)
(cons (if (number? (car kv))
(string->symbol (number->string (car kv)))
(car kv))
(cdr kv)))
args)
(format "$~a" s))))
(define (iqs in #:converter (converter assoc-converter) . args)
(define (helper in)
(cond ((bytes? in) (open-input-bytes in))
((string? in) (open-input-string in))
((input-port? in) in)))
(iqs-convert (read-iqs (helper in)) converter args))
(define (iqs-convert lst converter args)
(let ((convert (converter args)))
(stringify (map (lambda (s)
(if (symbol? s) (convert s) s))
lst))))
(provide/contract
(iqs-symbol-start (parameter/c char?))
(iqs-symbol-escape (parameter/c char?))
(iqs-symbol-allowed-chars (parameter/c (listof char?)))
(read-iqs (->* (input-port?)
((-> input-port? symbol?))
(listof (or/c symbol? bytes? string?))))
(iqs (->* ((or/c bytes? string? input-port?))
(#:converter (-> (listof any/c) (-> any/c any)))
#:rest (listof any/c)
string?))
(iqs-convert (-> (listof (or/c symbol? string?))
(-> (listof any/c) (-> any/c any))
(listof any/c)
string?))
)