From 8238d2a6bd837d27b6bd28046871cb99734b241a Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Sun, 22 Jun 2014 15:18:35 -0700 Subject: [PATCH] Move logic of numbering rest/drest arg to abstract results. original commit: 3c179e021720addc3bd33f98ac1b09a922b25201 --- .../typed-racket/typecheck/tc-lambda-unit.rkt | 14 ++++++-------- .../typed-racket/typecheck/tc-metafunctions.rkt | 9 ++++++--- 2 files changed, 12 insertions(+), 11 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt index b61321ca..f0f93d8b 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt @@ -27,14 +27,12 @@ (define (lam-result->type lr) (match lr [(struct lam-result ((list (list arg-ids arg-tys) ...) rest drest body)) - (let ([arg-names (append arg-ids - (if rest (list (first rest)) null) - (if drest (list (first drest)) null))]) - (make-arr* - arg-tys - (abstract-results body arg-names) - #:rest (and rest (second rest)) - #:drest (and drest (second drest))))])) + (make-arr* + arg-tys + (abstract-results body arg-ids + #:rest-id (or (and rest (first rest))) (and drest (first drest))) + #:rest (and rest (second rest)) + #:drest (and drest (second drest)))])) (define-syntax-class cl-rhs #:literal-sets (kernel-literals) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-metafunctions.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-metafunctions.rkt index 3a6e1e2a..2183e061 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-metafunctions.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-metafunctions.rkt @@ -14,11 +14,14 @@ tc-results->values) -(define/cond-contract (abstract-results results arg-names) - (tc-results/c (listof identifier?) . -> . SomeValues/c) +(define/cond-contract (abstract-results results arg-names #:rest-id [rest-id #f]) + ((tc-results/c (listof identifier?)) (#:rest-id (or/c #f identifier?)) + . ->* . SomeValues/c) + (define arg-names* (append arg-names (if rest-id (list rest-id) null))) (tc-results->values (replace-names - (for/list ([(nm k) (in-indexed (in-list arg-names))]) (list nm (make-Path null (list 0 k)))) + (for/list ([(nm k) (in-indexed (in-list arg-names*))]) + (list nm (make-Path null (list 0 k)))) results))) (define (tc-results->values tc)