[racket] trouble debugging - please help

Hello Racketeers,

I'm getting back into racket/plt-sheme after years away from it (and programming in general). I'm warming back up by updating Jacob Matthews' Quasistring module to Racket. I may have bit off a bit too much as I've run out of ideas for fixing a bug.

I've updated function names and calling conventions. Due to the bug, I've simplified this to a top level program (which may have been a mistake, though I wouldn't know why). 

Using both the debugger and the Macro Stepper have failed me. I've gotten feedback that makes me think that I've got a contract violation, but he error happens very early, before the expansion of the macro call. I'm rather mystified by both the bug and the proper way to debug it.

The error is: 

string-length: expects argument of type <string>; given #"\0"

There is one instance of this call in the program, so it is easy to know that the early fail is not due to either expansion or execution of this code. What else could it be and how do I fix it?

Thanks very much,

Lewis

-----------------------------------------------------------------------------------------
#lang racket
  (define current-quasistring-converter (make-parameter display))
  
  (define (to-string v)
    (let ((p (open-output-string)))
      (parameterize ((current-output-port p))
        ((current-quasistring-converter) v))
      (begin0
        (get-output-string p)
        (close-output-port p))))
  
  (define-syntax (qs stx)
    
    ; rewrite : syntax[string] -> syntax
    ; rewrites a quasistring syntax string into an expression that
    ; evaluates to the proper string
    (define (rewrite val)

      ; start -> syntax
      ; the main function rewrite calls.
      ; [Implementation detail: we know string->strings-and-syntax returns >= 1 object.
      ;  If it returns only one, we don't want to call string-append, because it could
      ;  make strings that were eq? into strings that aren't eq?.]
      (define (start)
        (let ((exprs (string->strings-and-syntax (syntax-e val))))
          (if (pair? (cdr exprs))
              #`(string-append #, at exprs)
              #`(#%datum . #,(car exprs)))))
      
      ; add-lexical-context : syntax -> syntax
      ;   produces a syntax object with structure and source locations equal to the argument
      ;   but with all subexpressions having lexical context of stx, the syntax object that
      ;   this macro accepts as input
      (define (add-lexical-context stx-to-enrich)
        (define (add-lexical-context/slist sl)
          (cond
            [(pair? sl) (cons (add-lexical-context (car sl))
                             (add-lexical-context/slist (cdr sl)))]
            [(null? sl) null]
            [else (add-lexical-context sl)]))
              
        (let ([s (syntax-e stx-to-enrich)])
          (cond
            [(pair? s) 
             (quasisyntax/loc stx-to-enrich #,(add-lexical-context/slist s))]
            [(null? s) stx-to-enrich]
            [else (datum->syntax val s stx-to-enrich stx-to-enrich)])))
            
      ; extra-width : char -> nat
      ; returns a guess at the number of characters needed to represent the given
      ; character on the screen. This number is just a guess!
      (define (width c)
        (define (char-typable? c)
          (let ((n (char->integer c)))
            (and (>= n 32) (<= n 127))))
        
        (cond
          [(memq c (map integer->char '(7 8 9 10 11 12 13 27 92))) 1]
          [(char-typable? c) 0]
          ; this is just a guess. 3 is either a 3-octet or 2-hextet representation,
          ; so I choose it.
          [else 3]))
      
      ; fresh-port : ip (box num) -> ip
      ; makes a new port that just forwards to the original port
      (define (monitored-port p box)
        (make-input-port 'monitored
         (lambda (s)
           (let ((len (a s)))
             (let loop ((idx 0))
               (cond
                 [(and (< idx len) (char-ready? p))
                  (let ((c (read-char p)))
                    (if (eof-object? c)
                        (if (= idx 0) eof idx)
                        (begin 
                          (string-set! s idx c)
                          (set-box! box (+ (unbox box) (width c)))
                          (loop (add1 idx)))))]
                 [else idx]))))
         #f
         void))
      
      
      ; port->syntaxes : input-port -> (listof syntax)
      (define (port->syntaxes ip)
        (define offset (box 0))
        (define p (monitored-port ip offset))
        
        (define (port->syntaxes/str acc-str)
          (define (curr-string) (datum->syntax val (list->string (reverse acc-str))))
          (let ((c (read-char p)))
            (cond
              [(eof-object? c) (list (curr-string))]
              [(eq? c #\$) (cons (curr-string) (port->syntaxes/expr))]
              [(eq? c #\\) (port->syntaxes/escape acc-str)]
              [else (port->syntaxes/str (cons c acc-str))])))

        (define (port->syntaxes/escape acc-str)
          (define (curr-string) (datum->syntax val (list->string (reverse (cons #\\ acc-str)))))
          (let ((c (read-char p)))
            (cond
              [(eof-object? c) (list (curr-string))]
              [(eq? c #\$) (port->syntaxes/str (cons #\$ acc-str))]
              [else (port->syntaxes/str (list* c #\\ acc-str))])))

        (define (port->syntaxes/expr)
          (with-handlers 
              ([exn:fail:read? 
                (lambda (e) 
                  (let* ((srclocs (exn:fail:read-srclocs))
                         (srcloc (car srclocs)))
                    raise-syntax-error 
                    #f 
                    "bad expression inside quasistring"
                    stx
                    (datum->syntax val
                                   (syntax-e val)
                                   (list 
                                    (srcloc-source e)
                                    (srcloc-line e)
                                    (srcloc-column e)
                                    (+ (syntax-position val)
                                       (- (srcloc-position e) (syntax-position stx)))
                                    (srcloc-span e))
                                   #f)))])
            (let* ([string-expr 
                    (read-syntax (syntax-source val)
                                 p
                                 (if (and (syntax-line val) (syntax-column val) (syntax-position val))
                                     (list (syntax-line val)
                                           (syntax-column val)
                                           (+ (syntax-position val) (unbox offset)))
                                     (list 0 0 0)))])
              (if (eof-object? string-expr)
                  (raise-syntax-error #f "no expression follows quasistring delimiter" stx)
                  (cons
                   #`(to-string #,(add-lexical-context string-expr))
                   (port->syntaxes/str '()))))))
        
        (port->syntaxes/str '()))
      
      ; string->strings-and-syntax : string -> listof syntax
      ; given a string, produces a list of syntax objects that when evaluated
      ; produce strings that can be appended to produce the equivalent quasistring value
      (define (string->strings-and-syntax str)
        (let ((p (open-input-string str)))
          (port-count-lines! p)
          (port->syntaxes p)))
      
      (start))
    
    (syntax-case stx ()
      [(_ s) 
       (string? (syntax-e #'s))
       (rewrite #'s)]
      [_ (raise-syntax-error 
          #f
          "not a string"
          stx)]))
  
  (define b "Bob")
  (qs "$b's your uncle.")