diff --git a/typed-racket-lib/typed-racket/core.rkt b/typed-racket-lib/typed-racket/core.rkt index bd5ef1496..9e2369137 100644 --- a/typed-racket-lib/typed-racket/core.rkt +++ b/typed-racket-lib/typed-racket/core.rkt @@ -50,9 +50,7 @@ (with-refinements?)) (unless (eq? te-mode deep) (raise-arguments-error - (string->symbol (format "typed/racket/~a" - (keyword->string - (syntax-e te-attr)))) + (format-symbol "typed/racket/~a" te-attr) "#:with-refinements unsupported")))]) (tc-module/full te-mode stx pmb-form (λ (new-mod pre-before-code pre-after-code) diff --git a/typed-racket-lib/typed-racket/env/init-envs.rkt b/typed-racket-lib/typed-racket/env/init-envs.rkt index 4b0614fe1..a8c3eb68d 100644 --- a/typed-racket-lib/typed-racket/env/init-envs.rkt +++ b/typed-racket-lib/typed-racket/env/init-envs.rkt @@ -437,9 +437,11 @@ (define (bound-in-this-module id) (define binding (identifier-binding id)) - (and (and (list? binding) (module-path-index? (car binding))) - (let-values ([(mp base) (module-path-index-split (car binding))]) - (not mp)))) + (cond + [(and (list? binding) (module-path-index? (car binding))) + (define-values (mp base) (module-path-index-split (car binding))) + (not mp)] + [else #f])) (define (make-init-code map f) (define (bound-f id v) diff --git a/typed-racket-lib/typed-racket/logic/ineq.rkt b/typed-racket-lib/typed-racket/logic/ineq.rkt index 6f5b8b644..93f44468e 100644 --- a/typed-racket-lib/typed-racket/logic/ineq.rkt +++ b/typed-racket-lib/typed-racket/logic/ineq.rkt @@ -439,10 +439,9 @@ ;; --> (ax - bx) <= ...3 + ...4 - ...1 - ...2 [else (define lhs* (lexp 0 (make-terms x (- x-lhs-coeff x-rhs-coeff)))) - (define rhs* - (let ([rhs-c* (- rhs-c lhs-c)] - [rhs-h* (terms-subtract rhs-ts lhs-ts)]) - (lexp rhs-c* (terms-remove rhs-h* x)))) + (define rhs-c* (- rhs-c lhs-c)) + (define rhs-h* (terms-subtract rhs-ts lhs-ts)) + (define rhs* (lexp rhs-c* (terms-remove rhs-h* x))) (leq lhs* rhs*)])])) ; x lhs diff --git a/typed-racket-lib/typed-racket/typecheck/possible-domains.rkt b/typed-racket-lib/typed-racket/typecheck/possible-domains.rkt index 9be78c7ae..377f3ed7f 100644 --- a/typed-racket-lib/typed-racket/typecheck/possible-domains.rkt +++ b/typed-racket-lib/typed-racket/typecheck/possible-domains.rkt @@ -156,20 +156,18 @@ (match t ;; function type, prune if possible. [(Fun: (list (Arrow: doms rests _ rngs rngs-T+) ...)) - (match-let ([(list pdoms rngs rests) - (possible-domains doms rests rngs - (and expected (ret expected)) - permissive?)]) - (if (= (length pdoms) (length doms)) - ;; pruning didn't improve things, return the original - ;; (Note: pruning may have reordered clauses, so may not be `equal?' to - ;; the original, which may confuse `:print-type''s pruning detection) - t - ;; pruning helped, return pruned type - (make-Fun (for/list ([pdom (in-list pdoms)] - [rst (in-list rests)] - [rng (in-list rngs)] - [T+ (in-list rngs-T+)]) - (make-Arrow pdom rst null rng T+)))))] + (match-define (list pdoms rngs rests) + (possible-domains doms rests rngs (and expected (ret expected)) permissive?)) + (if (= (length pdoms) (length doms)) + ;; pruning didn't improve things, return the original + ;; (Note: pruning may have reordered clauses, so may not be `equal?' to + ;; the original, which may confuse `:print-type''s pruning detection) + t + ;; pruning helped, return pruned type + (make-Fun (for/list ([pdom (in-list pdoms)] + [rst (in-list rests)] + [rng (in-list rngs)] + [T+ (in-list rngs-T+)]) + (make-Arrow pdom rst null rng T+))))] ;; not a function type. keep as is. [_ t])) diff --git a/typed-racket-lib/typed-racket/typed-reader.rkt b/typed-racket-lib/typed-racket/typed-reader.rkt index a9f157bcc..5da5979ee 100644 --- a/typed-racket-lib/typed-racket/typed-reader.rkt +++ b/typed-racket-lib/typed-racket/typed-reader.rkt @@ -31,40 +31,39 @@ (define (parse port read-one src) (skip-whitespace port) (define name (read-one)) - (begin0 (begin - (skip-whitespace port) - (let ([next (read-one)]) - (case (syntax-e next) - ;; type annotation - [(:) - (skip-whitespace port) - (type-label-property name (syntax->datum (read-one)))] - [(::) - (skip-whitespace port) - (datum->syntax name `(ann ,name : ,(read-one)))] - [(@) - (let ([elems (let loop ([es '()]) - (skip-whitespace port) - (if (equal? #\} (peek-char port)) - (reverse es) - (loop (cons (read-one) es))))]) - (datum->syntax name `(inst ,name : ,@elems)))] - ;; arbitrary property annotation - [(PROP) + (skip-whitespace port) + (begin0 (let ([next (read-one)]) + (case (syntax-e next) + ;; type annotation + [(:) + (skip-whitespace port) + (type-label-property name (syntax->datum (read-one)))] + [(::) + (skip-whitespace port) + (datum->syntax name `(ann ,name : ,(read-one)))] + [(@) + (let ([elems (let loop ([es '()]) + (skip-whitespace port) + (if (equal? #\} (peek-char port)) + (reverse es) + (loop (cons (read-one) es))))]) + (datum->syntax name `(inst ,name : ,@elems)))] + ;; arbitrary property annotation + [(PROP) + (skip-whitespace port) + (let* ([prop-name (syntax-e (read-one))]) (skip-whitespace port) - (let* ([prop-name (syntax-e (read-one))]) - (skip-whitespace port) - (syntax-property name prop-name (read-one)))] - ;; otherwise error - [else - (let-values ([(l c p) (port-next-location port)]) - (raise-read-error (format "typed expression ~a must be followed by :, ::, or @" - (syntax->datum name)) - src - l - c - p - 1))]))) + (syntax-property name prop-name (read-one)))] + ;; otherwise error + [else + (let-values ([(l c p) (port-next-location port)]) + (raise-read-error (format "typed expression ~a must be followed by :, ::, or @" + (syntax->datum name)) + src + l + c + p + 1))])) (skip-whitespace port) (let ([c (read-char port)]) (unless (equal? #\} c) diff --git a/typed-racket-test/succeed/shallow/pr241-variation-5.rkt b/typed-racket-test/succeed/shallow/pr241-variation-5.rkt index bcbd4741e..1b048a664 100644 --- a/typed-racket-test/succeed/shallow/pr241-variation-5.rkt +++ b/typed-racket-test/succeed/shallow/pr241-variation-5.rkt @@ -388,7 +388,8 @@ (filtered-in (if WARN-MISSING (lambda (str) - (when (not (known-string? str)) (printf "WARNING: Missing test for base type '~a'\n" str)) + (unless (known-string? str) + (printf "WARNING: Missing test for base type '~a'\n" str)) #f) (lambda (str) #f)) typed-racket/base-env/base-types)) diff --git a/typed-racket-test/succeed/shallow/untyped-struct-properties-with-self.rkt b/typed-racket-test/succeed/shallow/untyped-struct-properties-with-self.rkt index a53de7d5b..6eaf2e9eb 100644 --- a/typed-racket-test/succeed/shallow/untyped-struct-properties-with-self.rkt +++ b/typed-racket-test/succeed/shallow/untyped-struct-properties-with-self.rkt @@ -8,7 +8,7 @@ (module ty-foo typed/racket/shallow (require/typed (submod ".." foo) [prop:hi (Struct-Property (-> Self Any))] [hi-ref (-> Any (-> Any Void))]) (struct bar () #:property prop:hi (λ ([self : bar]) - (display (format "instance bar\n" )))) + (display "instance bar\n"))) (hi-ref (bar)) ) diff --git a/typed-racket-test/unit-tests/type-alias-helper.rkt b/typed-racket-test/unit-tests/type-alias-helper.rkt index d0452a5b8..83e226678 100644 --- a/typed-racket-test/unit-tests/type-alias-helper.rkt +++ b/typed-racket-test/unit-tests/type-alias-helper.rkt @@ -13,27 +13,27 @@ ;; two aliases in their own components (define example-1 - (list (cons #'x (list #'x)) - (cons #'y (list #'y)))) + (list (list #'x #'x) + (list #'y #'y))) ;; all one component (define example-2 - (list (cons #'x (list #'x #'y)) - (cons #'y (list #'x)))) + (list (list #'x #'x #'y) + (list #'y #'x))) ;; two components, one with two nodes (define example-3 - (list (cons #'x (list #'y)) - (cons #'y (list #'x)) - (cons #'z (list)))) + (list (list #'x #'y) + (list #'y #'x) + (list #'z))) ;; one with cycles, two that form a line (define example-4 - (list (cons #'x (list #'y)) - (cons #'y (list #'x)) - (cons #'a (list #'b)) - (cons #'b (list)))) + (list (list #'x #'y) + (list #'y #'x) + (list #'a #'b) + (list #'b))) ;; two large cycles (define example-5 - (list (cons #'x (list #'y #'z)) - (cons #'y (list #'x)) + (list (list #'x #'y #'z) + (list #'y #'x) (cons #'z (list #'x #'y)) (cons #'a (list #'b)) (cons #'b (list #'c))