[racket-dev] [plt] Push #26939: master branch updated

I don't think this is the right fix to the issue. A core issue (there
may be more) is that calls to subtype during the dynamic extent of a
call to subtype take the same current-seen list as is the current
state of the outer subtype call. This works well when this is supposed
to be part of the same type, but doesn't work so well in other cases.
For example in a reduced version of the test case:

#lang typed/racket

;; Test for PR 13821
;;
;; Make sure type instantiation with struct names doesn't
;; loop forever

(struct: (X) union ([fst : (ISet X)]) #:transparent)
(struct: (X) complement ([fst : (ISet X)]) #:transparent)
(define-type (ISet X) (U (union X) (complement X) (Setof X)))

;; This involves type instantiation and could loop forever
;; with the bug
(: iset->set (All (X) ((ISet X) -> (Setof X))))
(define (iset->set A)
  (union? A)
  (error 'unimplemented))

;; A simpler way to reproduce the problem
(union? 5)

I get the output from my logging:

> > > > (resolve-once (union Any))
> > > > >(Un (Setof Any) (union Any) (complement Any))
Union of ((Setof Any) (union Any) (complement Any))
Merging (Setof Any) and ()
> > > > > (subtype (Setof Any) (U))
Current seen 27457 1 ((27222 . 27457) (27261 . 27457) (27317 . 27222))
< < < < < #f
> > > > > (subtype (U) (Setof Any))
Current seen 1 27457 ((27222 . 27457) (27261 . 27457) (27317 . 27222))
< < < < < #t
Merging (complement Any) and ((Setof Any))
> > > > > (subtype (complement Any) (Setof Any))
Current seen 27261 27457 ((27222 . 27457) (27261 . 27457) (27317 . 27222))
< < < < < #t
Merging (union Any) and ((Setof Any))
> > > > > (subtype (union Any) (Setof Any))
Current seen 27222 27457 ((27222 . 27457) (27261 . 27457) (27317 . 27222))
< < < < < #t
< < < < <(Setof Any)
< < < < #(struct:#<syntax:/Users/endobson/proj/racket/plt/collects/tests/typed-racket/succeed/pr13821.rkt:8:13
union> ((Setof Any)))

Which shows that (union Any) is resolving incorrectly to (struct union
((Setof Any))) instead of (struct union ((U (union Any) (complement
Any) (Setof Any)))).

All your change does is prevent one call site of resolve, and thus
just covers up the issue instead of solving it.

On Fri, Jun 7, 2013 at 12:14 PM,  <asumu at racket-lang.org> wrote:
> asumu has updated `master' from 3d6776680c to 75f0c88feb.
>   http://git.racket-lang.org/plt/3d6776680c..75f0c88feb
>
> =====[ 3 Commits ]======================================================
> Directory summary:
>    8.7% collects/tests/typed-racket/fail/
>   25.5% collects/tests/typed-racket/succeed/
>   15.3% collects/tests/unstable/
>   24.3% collects/typed-racket/types/
>   13.9% collects/unstable/scribblings/
>   12.0% collects/unstable/
>
> ~~~~~~~~~~
>
> 12e5bc6 Asumu Takikawa <asumu at racket-lang.org> 2013-06-07 14:31
> :
> | Add match*? to unstable/match
> :
>   M collects/tests/unstable/match.rkt         | 15 ++++++++++++++-
>   M collects/unstable/match.rkt               | 10 +++++++++-
>   M collects/unstable/scribblings/match.scrbl | 19 +++++++++++++++++++
>
> ~~~~~~~~~~
>
> c8e281a Asumu Takikawa <asumu at racket-lang.org> 2013-06-07 14:32
> :
> | Fix union merging
> |
> | Trying to merge (and thus resolve) applications of struct
> | types would cause infinite looping on type instantiation
> | if the struct type used both a union and recursion.
> |
> | Closes PR 13821
> :
>   A collects/tests/typed-racket/succeed/pr13821.rkt
>   M collects/typed-racket/types/union.rkt | 14 ++++++++++++--
>
> ~~~~~~~~~~
>
> 75f0c88 Asumu Takikawa <asumu at racket-lang.org> 2013-06-07 15:08
> :
> | Improve TR test case
> :
>   M collects/tests/typed-racket/fail/pr13209.rkt | 7 ++++++-
>
> =====[ Overall Diff ]===================================================
>
> collects/tests/typed-racket/fail/pr13209.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/tests/typed-racket/fail/pr13209.rkt
> +++ NEW/collects/tests/typed-racket/fail/pr13209.rkt
> @@ -1,7 +1,12 @@
>  #;
> -(exn-pred exn:fail:syntax?)
> +(exn-pred #rx"arguments for structure type constructor")
>  #lang typed/racket
>
> +;; Test for PR 13209
> +;;
> +;; The use of `node` at the end has the wrong number of
> +;; type arguments. This should not raise an internal error.
> +
>  (struct: (α) leaf ({value : α}))
>  (struct: (α) node ({left : [Tree α]} {right : [Tree α]}))
>
>
> collects/tests/typed-racket/succeed/pr13821.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- /dev/null
> +++ NEW/collects/tests/typed-racket/succeed/pr13821.rkt
> @@ -0,0 +1,22 @@
> +#lang typed/racket
> +
> +;; Test for PR 13821
> +;;
> +;; Make sure type instantiation with struct names doesn't
> +;; loop forever
> +
> +(struct: (X) union ([fst : (ISet X)] [snd : (ISet X)]) #:transparent)
> +(struct: (X) intersection ([fst : (ISet X)] [snd : (ISet X)]) #:transparent)
> +(struct: (X) complement ([fst : (ISet X)] [snd : (ISet X)]) #:transparent)
> +(define-type (ISet X) (U (union X) (intersection X) (complement X) (Setof X)))
> +
> +;; This involves type instantiation and could loop forever
> +;; with the bug
> +(: iset->set (All (X) ((ISet X) -> (Setof X))))
> +(define (iset->set A)
> +  (union? A)
> +  (error 'unimplemented))
> +
> +;; A simpler way to reproduce the problem
> +(union? 5)
> +
>
> collects/tests/unstable/match.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/tests/unstable/match.rkt
> +++ NEW/collects/tests/unstable/match.rkt
> @@ -21,4 +21,17 @@
>       (test
>        (match (list 1 2 3)
>          [(as ([a 0]) (list b c d)) (list a b c d)])
> -      (list 0 1 2 3)))))
> +      (list 0 1 2 3)))
> +   (test-suite "match*?"
> +     (test
> +      (check-true (match*? (1 2 3)
> +                    (a b c)
> +                    (#f y z))))
> +     (test
> +      (check-true (match*? (1 2 3)
> +                    (a b #f)
> +                    (x y z))))
> +     (test
> +      (check-false (match*? (1 2 3)
> +                     (a #f c)
> +                     (#f y z)))))))
>
> collects/typed-racket/types/union.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/typed-racket/types/union.rkt
> +++ NEW/collects/typed-racket/types/union.rkt
> @@ -3,9 +3,10 @@
>  (require "../utils/utils.rkt"
>           (rep type-rep)
>           (prefix-in c: (contract-req))
> -         (types subtype base-abbrev)
> +         (types subtype base-abbrev resolve)
>           racket/match
> -         racket/list)
> +         racket/list
> +         (only-in unstable/match match*?))
>
>
>  (provide/cond-contract
> @@ -24,6 +25,15 @@
>  (define (merge a b)
>    (define b* (make-union* b))
>    (cond
> +    ;; If a union element is a Name application, then it should not
> +    ;; be checked for subtyping since that can cause infinite
> +    ;; loops if this is called during type instantiation.
> +    [(match*? (a b) ((App: (? Name?) _ _) b))
> +     (match-define (App: rator rands stx) a)
> +     ;; However, we should check if it's a well-formed application
> +     ;; so that bad applications are rejected early.
> +     (resolve-app-check-error rator rands stx)
> +     (cons a b)]
>      [(subtype a b*) b]
>      [(subtype b* a) (list a)]
>      [else (cons a b)]))
>
> collects/unstable/match.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/unstable/match.rkt
> +++ NEW/collects/unstable/match.rkt
> @@ -5,7 +5,7 @@
>           (for-syntax racket/base)
>           (for-syntax syntax/parse))
>
> -(provide match? as object)
> +(provide match? match*? as object)
>
>  (define-syntax-rule (match? e p ...)
>    (match e [p #t] ... [_ #f]))
> @@ -15,6 +15,14 @@
>      [(as ([x e] ...) p ...) (and (app (lambda (y) e) x) ... p ...)]))
>
>  ;; Added by asumu
> +;; Like match? but with match*
> +(define-syntax (match*? stx)
> +  (syntax-parse stx
> +   [(_ (e ...) (p ...) ...)
> +    (with-syntax ([(?_ ...) (generate-temporaries #'(e ...))])
> +     #'(match* (e ...) [(p ...) #t] ... [(?_ ...) #f]))]))
> +
> +;; Added by asumu
>  ;; Match expander for objects from racket/class
>  (define-match-expander object
>    (λ (stx)
>
> collects/unstable/scribblings/match.scrbl
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/unstable/scribblings/match.scrbl
> +++ NEW/collects/unstable/scribblings/match.scrbl
> @@ -48,6 +48,25 @@ result value of @racket[rhs-expr], and continues matching each subsequent
>
>  @addition[@author+email["Asumu Takikawa" "asumu at racket-lang.org"]]
>
> + at defform[(match*? (val-expr ...) (pat ...) ...)]{
> +
> +Similar to @racket[match?], but uses @racket[match*] and accepts
> +multiple @racket[val-expr] and corresponding @racket[pat] in each
> +clause to match on.
> +
> + at defexamples[
> +#:eval the-eval
> +(match*? (1 2 3)
> +  (a b c)
> +  (x #f z))
> +(match*? (1 2 3)
> +  (a (? odd?) c)
> +  (x y z))
> +(match*? (#f #f #f)
> +  (1 2 3)
> +  (4 5 6))
> +]}
> +
>  @defform/subs[
>    (define/match (head args)
>      match*-clause ...)