suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Make inst not do crazy splitting.

Browse Source
This commit is contained in:
Eric Dobson 2013-05-27 00:10:19 -07:00
parent a6789164d8
commit 4766a94470
1 changed files with 12 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
View File

@ -48,9 +48,6 @@
;; do-normal-inst : Syntax (Option Syntax) Type -> Type ;; do-normal-inst : Syntax (Option Syntax) Type -> Type
;; Instantiate a normal polymorphic type ;; Instantiate a normal polymorphic type
(define (do-normal-inst stx inst ty) (define (do-normal-inst stx inst ty)
(define (split-last l)
(let-values ([(all-but last-list) (split-at l (sub1 (length l)))])
(values all-but (car last-list))))
(match ty (match ty
[(list ty) [(list ty)
(list (list
@ -73,22 +70,18 @@
;; In this case, we need to check the last thing. If it's a dotted var, then we need to ;; In this case, we need to check the last thing. If it's a dotted var, then we need to
;; use instantiate-poly-dotted, otherwise we do the normal thing. ;; use instantiate-poly-dotted, otherwise we do the normal thing.
;; In the case that the list is empty we also do the normal thing ;; In the case that the list is empty we also do the normal thing
(let ((stx-list (syntax->list inst))) (match (syntax->list inst)
(if (null? stx-list) [(list ty-stxs ... (app syntax-e (cons bound-ty-stx (? identifier? bound-id))))
(instantiate-poly ty (map parse-type stx-list)) (unless (bound-index? (syntax-e bound-id))
(let-values ([(all-but-last last-stx) (split-last stx-list)]) (tc-error/stx bound-id "~a is not a type variable bound with ..." (syntax-e bound-id)))
(match (syntax-e last-stx) (if (= (length ty-stxs) (sub1 (PolyDots-n ty)))
[(cons last-ty-stx (? identifier? last-id-stx)) (let* ([last-id (syntax-e bound-id)]
(unless (bound-index? (syntax-e last-id-stx)) [last-ty (extend-tvars (list last-id) (parse-type bound-ty-stx))])
(tc-error/stx last-id-stx "~a is not a type variable bound with ..." (syntax-e last-id-stx))) (instantiate-poly-dotted ty (map parse-type ty-stxs) last-ty last-id))
(if (= (length all-but-last) (sub1 (PolyDots-n ty)))
(let* ([last-id (syntax-e last-id-stx)]
[last-ty (extend-tvars (list last-id) (parse-type last-ty-stx))])
(instantiate-poly-dotted ty (map parse-type all-but-last) last-ty last-id))
(tc-error/expr #:return (Un) "Wrong number of fixed type arguments to polymorphic type ~a:\nexpected: ~a\ngot: ~a" (tc-error/expr #:return (Un) "Wrong number of fixed type arguments to polymorphic type ~a:\nexpected: ~a\ngot: ~a"
ty (sub1 (PolyDots-n ty)) (length all-but-last)))] ty (sub1 (PolyDots-n ty)) (length ty-stxs)))]
[_ [stx-list
(instantiate-poly ty (map parse-type stx-list))]))))] (instantiate-poly ty (map parse-type stx-list))])]
[else [else
(instantiate-poly ty (stx-map parse-type inst))]))] (instantiate-poly ty (stx-map parse-type inst))]))]
[_ (if inst [_ (if inst