bug#3824: This problem persists

["J. Ian Johnson" <ianj@ccs.neu.edu>]

I use #; comments extensively in my Racket code, and have been bitten by emacs's weird handling of it. Taylor pointed me to this bug to follow up.
The following is a snippet from one of my projects, with a single #; comment in it.
When you copy and paste it into emacs, it will likely match the parens correctly. If you save it into a file and reopen it, it will not. If you M-> C-M-b, then it will mark them matching.
My delay in reporting this is because the problem with #; really only manifests in large (more than a screen) sexps. Once I navigate it /enough/, then things match and I can keep working. I don't have a good qualification for "enough," i.e., what navigation is necessary for the parens to be marked matching; I only know that this should be seen as incorrect/buggy behavior.
I do hope that this can be fixed for later releases of emacs23/24.
Thanks,
-Ian

(define (a/equal? d₀ d₁ store-spaces μ)
  (define/match (egal-equal? a₀ a₁)
    [((Address-Egal space a) (Address-Egal space a))
     (match (hash-ref μ a₀ 'ω)
       [1 #t]
       ['ω 'b.⊤]
       [0 (error 'a/match "Live address with count 0: ~a (Counts ~a) (Store ~a)" a₀ μ store-spaces)])]
    [(_ _) #f])

  (define (ffun-equal? f₀ f₁)
    (if abs?
        (b∧ (ffun-⊑? f₀ f₁)
            (ffun-⊑? f₁ f₀))
        (concrete-ffun-equal? f₀ f₁)))

  ;; Slow path: linearly look for a key "equal" to k with "equal" values.
  (define (slow-equal k v f)
    (for/b∨ ([(k₁ v₁) (in-dict f)])
            (b∧ (a/equal? k k₁)
                (a/equal? v v₁))))

  (define (ffun-⊑? dom f₀ f₁)
    (for/b∧ ([(k v) (in-dict f₀)])
            (match (dict-ref f₁ k -unmapped)
              [(== -unmapped eq?) (slow-equal k v f₁)]
              [v₁ ;; fast path: check the structurally equal key
               (b∨ (a/equal? v₀ v₁)
                   (slow-equal k v f₁))])))

  (define (concrete-ffun-equal? m₀ m₁)
    (and (= (dict-count m₀) (dict-count m₁))
         (for/b∧ ([(k₀ v₀) (in-dict m₀)])
                 (match (dict-ref m₁ k₀ -unmapped)
                   ;; Concrete domains w/o structural equality are actually abstract.
                   ;; Note this is different from the concrete semantics.
                   [(== -unmapped eq?) #f]
                   ;; Note we don't use b∨ with the slow path
                   [v₁ (a/equal? v₀ v₁)]))))

  (define (discrete-ffun-equal? m₀ m₁)
    (and (= (dict-count m₀) (dict-count m₁))
         (for/b∧ ([(k₀ v₀) (in-dict m₀)])
                 (match (dict-ref m₁ k₀ -unmapped)
                   [(== -unmapped eq?) #f]
                   [v₁ (b∧
                        ;; Discrete maps get structural equality on keys, but can only be 
                        ;; truly equal if the key has cardinality 1.
                        (if (∣γ∣>1 k₀ μ) 'b.⊤ #t)
                        (a/equal? v₀ v₁))]))))

  (define (equal-step d₀ d₁)
    (match* (d₀ d₁)
      [((variant v ds₀) (variant v ds₁))
       (for/b∧ ([d₀ (in-vector ds₀)]
                [d₁ (in-vector ds₁)])
               (a/equal? d₀ d₁))]

      ;; Addresses are the same if they have cardinality 1. Distinct addresses don't overlap.
      [((? Address-Egal?) (? Address-Egal?))
       (egal-equal? d₀ d₁)]

      [((? Address-Structural? a₀) (? Address-Structural? a₁))
       (if (eq? (egal-equal? a₀ a₁) #t)
           #t
           ;; INVARIANT: not possible to be -unmapped since there must be
           ;; at least one value mapped in a store's address.
           (for*/bδ ([d₀ (in-set (store-ref store-spaces a₀))]
                     [d₁ (in-set (store-ref store-spaces a₁))])
                    (a/equal? d₀ d₁)))]

      [((? dict? m₀) (? dict? m₁)) (concrete-ffun-equal? m₀ m₁)]

      ;; If at least one map has qualification, we can check the other with the expectation of the same.
      ;; We log the incident for future debugging, since it seems like we shouldn't get this far.
      [((? dict? m₀) (abstract-ffun m₁))
       (log-info (format "Qualified/unqualified dictionary equality check ~a ~a" d₀ d₁))
       (ffun-equal? m₀ m₁)]
      [((abstract-ffun m₀) (? dict? m₁))
       (log-info (format "Qualified/unqualified dictionary equality check ~a ~a" d₀ d₁))
       (ffun-equal? m₀ m₁)]
      [((abstract-ffun m₀) (abstract-ffun m₁)) (ffun-equal? m₀ m₁)]
      ;; Discrete cases
      [((discrete-ffun m₀) (? dict? m₁))
       (log-info (format "Qualified/unqualified (discrete) dictionary equality check ~a ~a" d₀ d₁))
       (discrete-ffun-equal? m₀ m₁)]
      [((? dict? m₀) (discrete-ffun m₁))
       (log-info (format "Qualified/unqualified (discrete) dictionary equality check ~a ~a" d₀ d₁))
       (discrete-ffun-equal? m₀ m₁)]
      [((discrete-ffun m₀) (discrete-ffun m₁))
       (discrete-ffun-equal? m₀ m₁)]

      ;; OPT-OP: This has no information on discrete abstractions, thus n²logn instead of sometimes nlogn
      [((? set? s₀) (? set? s₁))
       (define (⊆? s₀ s₁)
         (for/b∧ ([v (in-set s₀)])
                 (for/b∨ ([v* (in-set s₁)])
                         (a/equal? v v*))))
       (b∧ (⊆? s₀ s₁) (⊆? s₁ s₀))]

      [(atom atom) #t]

      [((external ex v₀) (external ex v₁))
       (match-define (External-Space _ card precision special-equality) ex)
       (if special-equality
           (special-equality v₀ v₁ μ #;a/equal?) 
           (match precision
             ['concrete (equal? v₀ v₁)]
             ['discrete-abstraction (b∧ (equal? v₀ v₁) (implies (eq? (card v₀ μ)) 'b.⊤))]
             ['abstract (error 'a/match "Cannot have non-discrete abstraction of external values without a custom equality relation ~a" d₀)]))]
      [(_ _) #f]))

  ;; Circular addresses are possible
  ;; OPT-OP?: Racket impl of equal? uses union-find instead of Map[_,Set[_]].
  ;;          Is that applicable here?
  (define seen (make-hasheq))
  (define (a/equal? d₀ d₁)
    (define checked-against (hash-ref! seen d₀ mutable-seteq))
    ;; already checked ⇒ assume equal
    ;; XXX: should this be #t or 'b.⊤?
    (or (set-member? checked-against d₁)
        (begin (set-add! checked-against d₁)
               (equal-step d₀ d₁))))

  (a/equal? d₀ d₁))