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

Remove extraneous old feature of do-inst.

Browse Source 
original commit: a6789164d86118643598ebb3b02500ba4dc6fc87
This commit is contained in:
Eric Dobson 2013-05-26 23:40:49 -07:00
parent 09ecd240d1
commit 9b7f36f7cb
1 changed files with 38 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -45,59 +45,52 @@
(and lst (pair? lst)
(eq? (syntax-e (car lst)) '#:row)))
;; do-normal-inst : Syntax Syntax Type -> Type
;; do-normal-inst : Syntax (Option Syntax) Type -> Type
;; Instantiate a normal polymorphic type
(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))))
(define (in-improper-stx stx)
(let loop ([l stx])
(match l
[#f null]
[(cons a b) (cons a (loop b))]
[e (list e)])))
(match ty
[(list ty)
(list
(for/fold ([ty ty])
([inst (in-list (in-improper-stx inst))])
(cond [(not inst) ty]
[(not (or (Poly? ty) (PolyDots? ty)))
(tc-error/expr #:return (Un) "Cannot instantiate non-polymorphic type ~a"
(cleanup-type ty))]
[(and (Poly? ty)
(not (= (syntax-length inst) (Poly-n ty))))
(tc-error/expr #:return (Un)
"Wrong number of type arguments to polymorphic type ~a:\nexpected: ~a\ngot: ~a"
(cleanup-type ty) (Poly-n ty) (syntax-length inst))]
[(and (PolyDots? ty) (not (>= (syntax-length inst) (sub1 (PolyDots-n ty)))))
;; we can provide 0 arguments for the ... var
(tc-error/expr #:return (Un)
"Wrong number of type arguments to polymorphic type ~a:\nexpected at least: ~a\ngot: ~a"
(cleanup-type ty) (sub1 (PolyDots-n ty)) (syntax-length inst))]
[(PolyDots? ty)
;; 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.
;; In the case that the list is empty we also do the normal thing
(let ((stx-list (syntax->list inst)))
(if (null? stx-list)
(instantiate-poly ty (map parse-type stx-list))
(let-values ([(all-but-last last-stx) (split-last stx-list)])
(match (syntax-e last-stx)
[(cons last-ty-stx (? identifier? last-id-stx))
(unless (bound-index? (syntax-e last-id-stx))
(tc-error/stx last-id-stx "~a is not a type variable bound with ..." (syntax-e last-id-stx)))
(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"
ty (sub1 (PolyDots-n ty)) (length all-but-last)))]
[_
(instantiate-poly ty (map parse-type stx-list))]))))]
[else
(instantiate-poly ty (stx-map parse-type inst))])))]
(cond
[(not inst) ty]
[(not (or (Poly? ty) (PolyDots? ty)))
(tc-error/expr #:return (Un) "Cannot instantiate non-polymorphic type ~a"
(cleanup-type ty))]
[(and (Poly? ty)
(not (= (syntax-length inst) (Poly-n ty))))
(tc-error/expr #:return (Un)
"Wrong number of type arguments to polymorphic type ~a:\nexpected: ~a\ngot: ~a"
(cleanup-type ty) (Poly-n ty) (syntax-length inst))]
[(and (PolyDots? ty) (not (>= (syntax-length inst) (sub1 (PolyDots-n ty)))))
;; we can provide 0 arguments for the ... var
(tc-error/expr #:return (Un)
"Wrong number of type arguments to polymorphic type ~a:\nexpected at least: ~a\ngot: ~a"
(cleanup-type ty) (sub1 (PolyDots-n ty)) (syntax-length inst))]
[(PolyDots? ty)
;; 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.
;; In the case that the list is empty we also do the normal thing
(let ((stx-list (syntax->list inst)))
(if (null? stx-list)
(instantiate-poly ty (map parse-type stx-list))
(let-values ([(all-but-last last-stx) (split-last stx-list)])
(match (syntax-e last-stx)
[(cons last-ty-stx (? identifier? last-id-stx))
(unless (bound-index? (syntax-e last-id-stx))
(tc-error/stx last-id-stx "~a is not a type variable bound with ..." (syntax-e last-id-stx)))
(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"
ty (sub1 (PolyDots-n ty)) (length all-but-last)))]
[_
(instantiate-poly ty (map parse-type stx-list))]))))]
[else
(instantiate-poly ty (stx-map parse-type inst))]))]
[_ (if inst
(tc-error/expr #:return (Un)
"Cannot instantiate expression that produces ~a values"