diff --git a/typed-racket-lib/typed-racket/private/type-contract.rkt b/typed-racket-lib/typed-racket/private/type-contract.rkt index 855b851ee..b347848be 100644 --- a/typed-racket-lib/typed-racket/private/type-contract.rkt +++ b/typed-racket-lib/typed-racket/private/type-contract.rkt @@ -324,6 +324,17 @@ (loop t 'both recursive-values)) (define (t->sc/fun t) (t->sc/function t fail typed-side recursive-values loop #f)) (define (t->sc/meth t) (t->sc/method t fail typed-side recursive-values loop)) + + (define (struct->recursive-sc name-base key flds sc-ctor) + (define key* (generate-temporary name-base)) + (define rv (hash-set recursive-values + key + (recursive-sc-use key*))) + (define ftsc (for/list ([ft (in-list flds)]) + (t->sc ft #:recursive-values rv))) + (recursive-sc (list key*) (list (sc-ctor ftsc)) + (recursive-sc-use key*))) + (define (prop->sc p) (match p [(TypeProp: o (app t->sc tc)) @@ -715,14 +726,9 @@ [(hash-ref recursive-values nm #f)] [proc (fail #:reason "procedural structs are not supported")] [poly? - (define nm* (generate-temporary #'n*)) - (define fields - (for/list ([fty (in-list flds)]) - (t->sc fty #:recursive-values (hash-set - recursive-values - nm (recursive-sc-use nm*))))) - (recursive-sc (list nm*) (list (struct/sc nm (ormap values mut?) fields)) - (recursive-sc-use nm*))] + (struct->recursive-sc #'n* nm flds + (lambda (ftsc) + (struct/sc nm (ormap values mut?) ftsc)))] [else (flat/sc #`(flat-named-contract '#,(syntax-e pred?) (lambda (x) (#,pred? x))))])] [(StructType: s) (if (from-untyped? typed-side) @@ -754,7 +760,13 @@ "property" #,real-prop-var) (#,pred? x)))))] - [(Prefab: key (list (app t->sc fld/scs) ...)) (prefab/sc key fld/scs)] + [(Prefab: (and key (list key-sym rst ...)) (list flds ...)) + (cond + [(hash-ref recursive-values key #f)] + [else + (struct->recursive-sc key-sym key flds + (lambda (ftsc) + (prefab/sc key ftsc)))])] [(PrefabTop: key) (flat/sc #`(struct-type-make-predicate (prefab-key->struct-type (quote #,(abbreviate-prefab-key key)) diff --git a/typed-racket-lib/typed-racket/types/printer.rkt b/typed-racket-lib/typed-racket/types/printer.rkt index fd91ccabf..7abb422d8 100644 --- a/typed-racket-lib/typed-racket/types/printer.rkt +++ b/typed-racket-lib/typed-racket/types/printer.rkt @@ -22,6 +22,7 @@ "utils/tc-utils.rkt" "types/struct-table.rkt" "infer/infer.rkt" + "env/type-name-env.rkt" "types/substitute.rkt") (for-syntax racket/base syntax/parse)) @@ -573,10 +574,10 @@ ;; type->sexp : Type -> S-expression ;; convert a type to an s-expression that can be printed (define (type->sexp type [ignored-names '()]) - (define (t->s type) + (define (t->s type [ignored-names '()]) (parameterize ([current-print-type-fuel (sub1 (current-print-type-fuel))]) - (type->sexp type))) + (type->sexp type ignored-names))) (define (tuple? t) (match t [(Pair: a (? tuple?)) #t] @@ -600,13 +601,16 @@ [(Univ:) 'Any] [(Bottom:) 'Nothing] ;; struct names are just printed as the original syntax - [(Name/struct: id) (syntax-e id)] + [(Name/struct: id) + (match (lookup-type-name id (lambda () #f)) + [(and (? Prefab?) ty) (t->s ty (cons id ignored-names))] + [_ (syntax-e id)])] ;; If a type has a name, then print it with that name. ;; However, we expand the alias in some cases ;; (i.e., the fuel is > 0) for the :type form. [(app has-name? (? values names)) (=> fail) - (when (not (null? ignored-names)) (fail)) + (unless (null? ignored-names) (fail)) (define fuel (current-print-type-fuel)) (cond [(> fuel 0) (parameterize ([current-print-type-fuel (sub1 fuel)]) diff --git a/typed-racket-test/fail/gh-issue-1041.rkt b/typed-racket-test/fail/gh-issue-1041.rkt new file mode 100644 index 000000000..1b4d0b16d --- /dev/null +++ b/typed-racket-test/fail/gh-issue-1041.rkt @@ -0,0 +1,10 @@ +#; +(exn-pred #rx"expected: \\(Prefab container String\\).*given: \\(Prefab container Positive-Byte\\)") +#lang typed/racket/base + +(define val '#s(container 10)) +(struct container + ([value : String]) + #:prefab) + (ann val container) + diff --git a/typed-racket-test/succeed/gh-issue-906.rkt b/typed-racket-test/succeed/gh-issue-906.rkt new file mode 100644 index 000000000..3b4c420ac --- /dev/null +++ b/typed-racket-test/succeed/gh-issue-906.rkt @@ -0,0 +1,7 @@ +#lang typed/racket/base + +(provide container) + +(struct container + ([value : (U #f container)]) + #:prefab)