Terminate typechecking on cyclic lists.
Closes PR 13687.
(cherry picked from commit b8ab1334d9
)
This commit is contained in:
parent
161986fc56
commit
5f34da6692
8
collects/tests/typed-racket/succeed/cyclic-list.rkt
Normal file
8
collects/tests/typed-racket/succeed/cyclic-list.rkt
Normal file
|
@ -0,0 +1,8 @@
|
||||||
|
#lang typed/racket
|
||||||
|
|
||||||
|
(define-type CyclicSymbols (Rec X (Pair Symbol X)))
|
||||||
|
|
||||||
|
(: mycar : (CyclicSymbols -> Symbol))
|
||||||
|
(define (mycar lst)
|
||||||
|
(car lst))
|
||||||
|
|
|
@ -7,6 +7,7 @@
|
||||||
racket/match
|
racket/match
|
||||||
(types resolve)
|
(types resolve)
|
||||||
(contract-req)
|
(contract-req)
|
||||||
|
racket/set
|
||||||
(for-syntax racket/base syntax/parse racket/list))
|
(for-syntax racket/base syntax/parse racket/list))
|
||||||
|
|
||||||
(provide Listof: List: MListof:)
|
(provide Listof: List: MListof:)
|
||||||
|
@ -27,11 +28,13 @@
|
||||||
#'(app untuple (? values elem-pats))])))
|
#'(app untuple (? values elem-pats))])))
|
||||||
|
|
||||||
(define (untuple t)
|
(define (untuple t)
|
||||||
(match (resolve t)
|
(let loop ((t t) (seen (set)))
|
||||||
[(Value: '()) null]
|
(and (not (set-member? seen (Type-seq t)))
|
||||||
[(Pair: a b) (cond [(untuple b) => (lambda (l) (cons a l))]
|
(match (resolve t)
|
||||||
[else #f])]
|
[(Value: '()) null]
|
||||||
[_ #f]))
|
[(Pair: a b) (cond [(loop b (set-add seen (Type-seq t))) => (lambda (l) (cons a l))]
|
||||||
|
[else #f])]
|
||||||
|
[_ #f]))))
|
||||||
|
|
||||||
(define-match-expander MListof:
|
(define-match-expander MListof:
|
||||||
(lambda (stx)
|
(lambda (stx)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user