Criminal Investigation at Phase 1

Once upon a time a concerned user encountered a strange error with one of the Racket snapshots. As the investigation unfolded during one of the regular Weekly Qi Meetings.

While building the syntax-spec package an innocuous error showed during raco setup:

raco setup syntax-spec-v3

symbol-set-add: contract violation
  expected: immutable-symbol-set?
  given: #f
  compilation context...:
   /Users/sphillips/projects/contrib/racket/racket/share/pkgs/syntax-spec-v3/tests/symbol-collections.rkt
  context...:
   /Users/sphillips/projects/contrib/racket/racket/collects/compiler/private/cm-minimal.rkt:717:0: compile-zo*
   /Users/sphillips/projects/contrib/racket/racket/collects/compiler/private/cm-minimal.rkt:647:0: compile-zo*/cross-compile
   /Users/sphillips/projects/contrib/racket/racket/collects/compiler/private/cm-minimal.rkt:461:15
   /Users/sphillips/projects/contrib/racket/racket/collects/compiler/private/cm-minimal.rkt:447:12: build
   /Users/sphillips/projects/contrib/racket/racket/collects/compiler/private/cm-minimal.rkt:418:0: maybe-compile-zo
   /Users/sphillips/projects/contrib/racket/racket/collects/compiler/private/cm-minimal.rkt:221:0: compile-root
   /Users/sphillips/projects/contrib/racket/racket/collects/compiler/private/cm-minimal.rkt:109:4
   /Users/sphillips/projects/contrib/racket/racket/collects/setup/parallel-build.rkt:385:9
   /Users/sphillips/projects/contrib/racket/racket/collects/setup/parallel-do.rkt:482:25
   /Users/sphillips/projects/contrib/racket/racket/collects/setup/parallel-do.rkt:468:20: loop

As Qi is build on top of syntax-spec we were concerned it might bring rather unfortunate problems to our own development and therefore we jumped on to investigate.

The first step was to extract the code in question into a single module:

#lang racket/base

(require (for-syntax racket/base
                     syntax/id-table))

(begin-for-syntax

  (define (table-ref table id fail)
    (free-id-table-ref
     table
     (flip-intro-scope id)
     fail))

  (define (symbol-table-ref-error)
    (error 'symbol-table-ref "no value found for key"))

  (define (symbol-table-ref t id [fail symbol-table-ref-error])
    (table-ref (immutable-symbol-table-id-table t) (compiled-from id) fail))

  (define (symbol-set-member? s id)
    (symbol-table-ref (immutable-symbol-set-table s) id #f))

  (define (compiled-from id)
    (define prop (syntax-property id 'compiled-from))
    (when (not prop)
      (raise-syntax-error 'compiled-from "not a compiled identifier" id))
    (flip-intro-scope prop))

  (define (make-intro-scope-introducer)
    (define no-scope (datum->syntax #f 'foo))
    (define intro-scope
      (syntax-local-identifier-as-binding
       (syntax-local-introduce
        no-scope)))
    (make-syntax-delta-introducer
     intro-scope
     no-scope))

  (define (flip-intro-scope stx)
    (if (syntax-transforming?)
        ((make-intro-scope-introducer) stx 'flip)
        stx))

  (struct immutable-symbol-set [table])

  (struct immutable-symbol-table [id-table])

  (define (make-immutable-symbol-table)
    (immutable-symbol-table (make-immutable-free-id-table)))

  (define (symbol-table-set t id val #:allow-overwrite? [allow-overwrite? #f])
    (immutable-symbol-table (free-id-table-set (immutable-symbol-table-id-table t) (flip-intro-scope (compiled-from id)) val)))


  (define (make-immutable-symbol-set . ids)
    (for/fold ([s (immutable-symbol-set (make-immutable-symbol-table))])
              ([id ids])
      (symbol-set-add s id)))

  (define (symbol-set-add s id)
    (if (symbol-set-member? s id)
        s
        (immutable-symbol-set (symbol-table-set (immutable-symbol-set-table s) id #t))))

  (define (asp x)
    (syntax-property x 'compiled-from x))
  (define-values (referenced-vars var-to-symbol)
    (for/fold ([referenced-vars (let ((xx (make-immutable-symbol-set))) (displayln (list 'yyy xx)) xx)]
               [var-to-symbol (make-immutable-symbol-table)])
              ([y (list #'a #'b #'c)])
      (define x (asp y))
      (values referenced-vars ;(symbol-set-add referenced-vars x)
              (symbol-table-set var-to-symbol x (syntax->datum x)))))
  (displayln (list 'xxx referenced-vars)))

Simplifying this code led to a rather small truly minimal example:

#lang racket/base

(require (for-syntax racket/base))

(begin-for-syntax
  (struct a-struct (x))

  (define (f) 1)

  (define-values (a b)
    (for/fold ([a 0] [b 1]) ([x (in-value 2)])
      (values 3 (begin (a-struct (begin (f) 3)) 5))))
  (displayln a))

And thanks to Trice, the core of the issue was tracked to a set of nested let-values forms:

#lang racket/base

(require (for-syntax racket/base))

(begin-for-syntax
  (struct a-struct (x))

  (define (f) 1)

  (define a
    (let-values
        ([(a b)
          (let-values
              ([(a b)
                (let-values ()
                  (values
                   0
                   (begin (a-struct
                           (begin (f) 2))
                          3)))])
            (values a b))])
      a))
  (displayln a))

And filed a better bug report against the right repository. In the meantime we have continued looking for a commit that introduced this weird behaviour and there were some suspects. To narrow down when was the issue introduced the minimal examples were tested with various snapshot versions and it turned out that 9.3.0.8 is not yet expressing the problematic behaviour and 9.3.0.9 does express it.

And there was one suspicious commit between those two snapshots!

That was more than enough for Matthew Flatt to fix the underlying issue in the interpreter.

Hope you liked our little investigation and remember to tune in next time for more!