diff --git a/collects/tests/typed-scheme/succeed/match-dots.ss b/collects/tests/typed-scheme/succeed/match-dots.ss new file mode 100644 index 00000000..c8a526c5 --- /dev/null +++ b/collects/tests/typed-scheme/succeed/match-dots.ss @@ -0,0 +1,8 @@ +#lang typed-scheme + +(require scheme/match) + +(: parse-sexpr : Any -> Number) +(define (parse-sexpr sexpr) + (match sexpr + [(list #{(? symbol? a) : (Listof Symbol)} ...) 1])) diff --git a/collects/tests/typed-scheme/xfail/apply-map-bug.ss b/collects/tests/typed-scheme/xfail/apply-map-bug.ss new file mode 100644 index 00000000..d08a5c2f --- /dev/null +++ b/collects/tests/typed-scheme/xfail/apply-map-bug.ss @@ -0,0 +1,8 @@ + +#lang typed-scheme + +(: add-lists ((Listof Number) (Listof Number) * -> (Listof Number))) +(define (add-lists lst . lsts) + (apply map #{+ :: (Number Number * -> Number)} lst lsts)) + +(add-lists '(1 2 3) '(4 5 6) '(7 8 9)) \ No newline at end of file diff --git a/collects/typed-scheme/private/base-env.ss b/collects/typed-scheme/private/base-env.ss index 399202cc..4fbde9fb 100644 --- a/collects/typed-scheme/private/base-env.ss +++ b/collects/typed-scheme/private/base-env.ss @@ -419,11 +419,12 @@ [symbol->string (Sym . -> . -String)] [vector-length (-poly (a) ((-vec a) . -> . -Integer))] -[call-with-input-file (-poly (a) (cl-> [(-String (-Port . -> . a)) a] - [(-String (-Port . -> . a) Sym) a]))] +[call-with-input-file (-poly (a) (-String (-Input-Port . -> . a) #:mode (Un (-val 'binary) (-val 'text)) #f . ->key . a))] +[call-with-output-file (-poly (a) (-String (-Output-Port . -> . a) + #:exists (one-of/c error 'append 'update 'replace 'truncate 'truncate/replace) #f + #:mode (Un (-val 'binary) (-val 'text)) #f + . ->key . a))] -[call-with-output-file (-poly (a) (cl-> [(-String (-Port . -> . a)) a] - [(-String (-Port . -> . a) Sym) a]))] [current-output-port (-Param -Output-Port -Output-Port)] [current-error-port (-Param -Output-Port -Output-Port)] [current-input-port (-Param -Input-Port -Input-Port)] diff --git a/collects/typed-scheme/rep/type-rep.ss b/collects/typed-scheme/rep/type-rep.ss index 1a6aae41..579d1cf8 100644 --- a/collects/typed-scheme/rep/type-rep.ss +++ b/collects/typed-scheme/rep/type-rep.ss @@ -364,8 +364,7 @@ (cons (sb (car drest)) (if (eq? (cdr drest) name) (+ count outer) (cdr drest))) #f) - (for/list ([kw kws]) - (cons (car kw) (sb (cdr kw)))) + (map sb kws) (map (lambda (e) (sub-eff sb e)) thn-eff) (map (lambda (e) (sub-eff sb e)) els-eff))] [#:ValuesDots tys dty dbound @@ -410,8 +409,7 @@ (cons (sb (car drest)) (if (eqv? (cdr drest) (+ count outer)) (F-n image) (cdr drest))) #f) - (for/list ([kw kws]) - (cons (car kw) (sb (cdr kw)))) + (map sb kws) (map (lambda (e) (sub-eff sb e)) thn-eff) (map (lambda (e) (sub-eff sb e)) els-eff))] [#:ValuesDots tys dty dbound diff --git a/collects/typed-scheme/typecheck/tc-app-unit.ss b/collects/typed-scheme/typecheck/tc-app-unit.ss index 61b4f54b..63db7660 100644 --- a/collects/typed-scheme/typecheck/tc-app-unit.ss +++ b/collects/typed-scheme/typecheck/tc-app-unit.ss @@ -576,7 +576,7 @@ [c:lv-clause #:with (#%plain-app reverse n:id) #'c.e #:with (v) #'(c.v ...) - #:when (free-identifier=? name #'v) + #:when (free-identifier=? name #'n) (type-annotation #'v)] [_ #f])) (syntax-parse stx @@ -757,8 +757,8 @@ (match (tc-expr #'fn) [(tc-result: (Function: arities)) (tc-keywords form arities (type->list (tc-expr/t #'kws)) #'kw-arg-list #'pos-args expected)] - [t (tc-error/expr #:return (ret (Un)) - "Cannot apply expression of type ~a, since it is not a function type" t)])] + [(tc-result: t) (tc-error/expr #:return (ret (Un)) + "Cannot apply expression of type ~a, since it is not a function type" t)])] ;; even more special case for match [(#%plain-app (letrec-values ([(lp) (#%plain-lambda args . body)]) lp*) . actuals) (and expected (not (andmap type-annotation (syntax->list #'args))) (free-identifier=? #'lp #'lp*))