diff --git a/collects/tests/typed-scheme/succeed/empty-or.ss b/collects/tests/typed-scheme/succeed/empty-or.ss new file mode 100644 index 00000000..cb4d8a1f --- /dev/null +++ b/collects/tests/typed-scheme/succeed/empty-or.ss @@ -0,0 +1,22 @@ +#lang typed/scheme + +(require scheme/list) +(define-type-alias Atom (U Number #f)) + +(: mrg ([Listof Atom] [Listof Atom] -> [Listof Number])) +;; add corresponding numbers, drop false, stop at end of shortest list + +;(check-expect (mrg (list 1 false 2) (list 3 4 5 false 10)) (list 4 4 7)) + +(define (mrg l k) + (cond + [(if (empty? l) #t (empty? k)) + empty] + [(and (number? (car l)) (number? (car k))) + (cons (+ (car l) (car k)) (mrg (cdr l) (cdr k)))] + [(number? (car l)) + (cons (car l) (mrg (rest l) (rest k)))] + [else + (error 'fail)])) + +;(test) \ No newline at end of file diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.ss b/collects/typed-scheme/typecheck/tc-expr-unit.ss index a1af3449..3294ca26 100644 --- a/collects/typed-scheme/typecheck/tc-expr-unit.ss +++ b/collects/typed-scheme/typecheck/tc-expr-unit.ss @@ -326,6 +326,12 @@ (#%plain-app _ _ args ...))) (tc/send #'rcvr #'meth #'(args ...) expected)] ;; let + [(let-values ([(or-part) e1]) (if op1 op2 e2)) + (and + (identifier? #'op1) (identifier? #'op2) + (free-identifier=? #'or-part #'op1) + (free-identifier=? #'or-part #'op2)) + (tc-expr/check #'(if e1 e1 (let-values ([(or-part) e1]) e2)) expected)] [(let-values ([(name ...) expr] ...) . body) (tc/let-values #'((name ...) ...) #'(expr ...) #'body form expected)] [(letrec-values ([(name) expr]) name*) @@ -388,6 +394,11 @@ (#%plain-app _ _ args ...))) (tc/send #'rcvr #'meth #'(args ...))] ;; let + [(let-values ([(or-part) e1]) (if op1 op2 e2)) + (and (identifier? #'op1) (identifier? #'op2) + (free-identifier=? #'or-part #'op1) + (free-identifier=? #'or-part #'op2)) + (tc-expr #'(if e1 e1 (let-values ([(or-part) e1]) e2)))] [(let-values ([(name ...) expr] ...) . body) (tc/let-values #'((name ...) ...) #'(expr ...) #'body form)] [(letrec-values ([(name ...) expr] ...) . body)