From 304835664004d5c609dee257d6c70c3ae21f6ff5 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Thu, 10 Oct 2019 13:34:50 -0400 Subject: [PATCH] Don't assume optimization when for recursive function contracts. Currently TR generates contracts that assume parts will be optimized away by static contract optimization. If that doesn't happen, the resulting recursive contracts are invalid. For @camoy. Not intended for merging or general use. --- .../typed-racket/static-contracts/combinators/function.rkt | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/typed-racket-lib/typed-racket/static-contracts/combinators/function.rkt b/typed-racket-lib/typed-racket/static-contracts/combinators/function.rkt index 6535c1aa9..36bb37797 100644 --- a/typed-racket-lib/typed-racket/static-contracts/combinators/function.rkt +++ b/typed-racket-lib/typed-racket/static-contracts/combinators/function.rkt @@ -159,14 +159,15 @@ (match-define (function-combinator args indices mand-kws opt-kws typed-side?) v) (define-values (mand-args opt-args mand-kw-args opt-kw-args rest-arg range-args) (apply split-function-args args indices)) + (define opt-kind (if #f 'flat 'chaperone)) (if (and (not rest-arg) (null? (append mand-kw-args mand-args opt-kw-args opt-args)) typed-side?) ;; arity-0 functions end up being flat contracts when they're ;; from the typed side and the result is flat (if range-args - (merge-restricts* 'flat (map f range-args)) - (merge-restricts* 'flat null)) + (merge-restricts* opt-kind (map f range-args)) + (merge-restricts* opt-kind null)) (merge-restricts* 'chaperone (map f args)))) (define (function-sc-equal? a b recur)