Terminate typechecking on cyclic lists.
Closes PR 13687. original commit: b8ab1334d9192720ebb6a37e311880f158276d8b
This commit is contained in:
parent
28a898f4fe
commit
632b14c736
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
|
||||
(types resolve)
|
||||
(contract-req)
|
||||
racket/set
|
||||
(for-syntax racket/base syntax/parse racket/list))
|
||||
|
||||
(provide Listof: List: MListof:)
|
||||
|
@ -27,11 +28,13 @@
|
|||
#'(app untuple (? values elem-pats))])))
|
||||
|
||||
(define (untuple t)
|
||||
(match (resolve t)
|
||||
[(Value: '()) null]
|
||||
[(Pair: a b) (cond [(untuple b) => (lambda (l) (cons a l))]
|
||||
[else #f])]
|
||||
[_ #f]))
|
||||
(let loop ((t t) (seen (set)))
|
||||
(and (not (set-member? seen (Type-seq t)))
|
||||
(match (resolve t)
|
||||
[(Value: '()) null]
|
||||
[(Pair: a b) (cond [(loop b (set-add seen (Type-seq t))) => (lambda (l) (cons a l))]
|
||||
[else #f])]
|
||||
[_ #f]))))
|
||||
|
||||
(define-match-expander MListof:
|
||||
(lambda (stx)
|
||||
|
|
Loading…
Reference in New Issue
Block a user