diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-structs.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-structs.rkt index 10879a64..e23182fc 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-structs.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-structs.rkt @@ -35,11 +35,10 @@ ...) ...)])) -(define -Srcloc (make-Name #'srcloc null #f #t)) -(define -Date (make-Name #'date null #f #t)) -(define -Arity-At-Least - (make-Name #'arity-at-least null #f #t)) -(define -Exn (make-Name #'exn null #f #t)) +(define -Srcloc (-struct-name #'srcloc)) +(define -Date (-struct-name #'date)) +(define -Arity-At-Least (-struct-name #'arity-at-least)) +(define -Exn (-struct-name #'exn)) (define (initialize-structs) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/env/type-alias-helper.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/env/type-alias-helper.rkt index 48721c92..ad1b03a6 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/env/type-alias-helper.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/env/type-alias-helper.rkt @@ -60,7 +60,7 @@ (define (check-type-alias-contractive id type) (define/match (check type) [((Union: elems)) (andmap check elems)] - [((Name: name-id _ _ _)) + [((Name/simple: name-id)) (and (not (free-identifier=? name-id id)) (check (resolve-once type)))] [((App: rator rands stx)) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/parse-type.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/parse-type.rkt index 2ff52d84..70cba2da 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/parse-type.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/parse-type.rkt @@ -543,7 +543,7 @@ [args (parse-types #'(arg args ...))]) (resolve-app-check-error rator args stx) (match rator - [(Name: _ _ _ _) (make-App rator args stx)] + [(? Name?) (make-App rator args stx)] [(Poly: _ _) (instantiate-poly rator args)] [(Mu: _ _) (loop (unfold rator) args)] [(Error:) Err] diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt index 6465a1ec..6783d6dc 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt @@ -277,7 +277,7 @@ (λ () (loop resolved-name 'both rv))) (lookup-name-sc name-id typed-side)])] ;; Ordinary type applications or struct type names, just resolve - [(or (App: _ _ _) (Name: _ _ _ #t)) (t->sc (resolve-once type))] + [(or (App: _ _ _) (Name/struct:)) (t->sc (resolve-once type))] [(Univ:) (if (from-typed? typed-side) any-wrap/sc any/sc)] [(Mu: var (Union: (list (Value: '()) (Pair: elem-ty (F: var))))) (listof/sc (t->sc elem-ty))] diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/rep/type-rep.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/rep/type-rep.rkt index ce7a711b..db295b6b 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/rep/type-rep.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/rep/type-rep.rkt @@ -32,6 +32,7 @@ type-equal? remove-dups sub-t sub-f sub-o sub-pe + Name/simple: Name/struct: (rename-out [Class:* Class:] [Class* make-Class] [Row* make-Row] @@ -1031,3 +1032,15 @@ (list row-pat inits-pat fields-pat methods-pat augments-pat init-rest-pat)))]))) +;; alternative to Name: that only matches the name part +(define-match-expander Name/simple: + (λ (stx) + (syntax-parse stx + [(_ name-pat) #'(Name: name-pat _ _ _)]))) + +;; alternative to Name: that only matches struct names +(define-match-expander Name/struct: + (λ (stx) + (syntax-parse stx + [(_) #'(Name: _ _ _ #t)] + [(_ name-pat) #'(Name: name-pat _ _ #t)]))) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/abbrev.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/abbrev.rkt index a436720a..288ff5f6 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/abbrev.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/abbrev.rkt @@ -239,6 +239,10 @@ (define/decl -syntax-e (make-SyntaxPE)) (define/decl -force (make-ForcePE)) +;; Type alias names +(define (-struct-name name) + (make-Name name null #f #t)) + ;; Structs (define (-struct name parent flds [proc #f] [poly #f] [pred #'dummy]) (make-Struct name parent flds proc poly pred)) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt index 1b273d1a..d79d51b7 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt @@ -376,7 +376,7 @@ [(? Rep-stx a) (syntax->datum (Rep-stx a))] [(Univ:) 'Any] ;; struct names are just printed as the original syntax - [(Name: id _ _ #t) (syntax-e id)] + [(Name/struct: id) (syntax-e id)] ;; If a type has a name, then print it with that name. ;; However, we expand the alias in some cases ;; (i.e., the fuel is > 0) for the :type form. diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/remove-intersect.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/remove-intersect.rkt index 9fa3dfd6..90f4386f 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/remove-intersect.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/remove-intersect.rkt @@ -38,7 +38,7 @@ [(list _ (F: _)) #t] [(list (Opaque: _) _) #t] [(list _ (Opaque: _)) #t] - [(list (Name: n _ _ _) (Name: n* _ _ _)) + [(list (Name/simple: n) (Name/simple: n*)) (or (free-identifier=? n n*) (overlap (resolve-once t1) (resolve-once t2)))] [(list _ (Name: _ _ _ _)) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/resolve.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/resolve.rkt index a151b808..2c7330b6 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/resolve.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/resolve.rkt @@ -29,8 +29,8 @@ (define (resolve-name t) (match t - [(Name: n _ _ _) (let ([t (lookup-type-name n)]) - (if (Type/c? t) t #f))] + [(Name/simple: n) (let ([t (lookup-type-name n)]) + (if (Type/c? t) t #f))] [_ (int-err "resolve-name: not a name ~a" t)])) (define already-resolving? (make-parameter #f)) @@ -43,7 +43,7 @@ (unless (= n (length rands)) (tc-error "wrong number of arguments to polymorphic type: expected ~a and got ~a" n (length rands)))] - [(Name: n _ _ #t) + [(Name/struct: n) (when (and (current-poly-struct) (free-identifier=? n (poly-name (current-poly-struct)))) (define num-rands (length rands)) @@ -115,7 +115,7 @@ [already-resolving? #t]) (resolve-app-check-error rator rands stx) (match rator - [(Name: _ _ _ _) + [(? Name?) (let ([r (resolve-name rator)]) (and r (resolve-app r rands stx)))] [(Poly: _ _) (instantiate-poly rator rands)] @@ -137,7 +137,7 @@ [(Mu: _ _) (unfold t)] [(App: r r* s) (resolve-app r r* s)] - [(Name: _ _ _ _) (resolve-name t)])]) + [(? Name?) (resolve-name t)])]) (when (and r* (not (currently-subtyping?))) (hash-set! resolver-cache seq r*)) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt index 3e0b570b..cbdca73c 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt @@ -178,9 +178,9 @@ (lambda (stx) (syntax-case stx () [(_ i) - #'(or (and (Name: _ _ _ #t) + #'(or (and (Name/struct:) (app resolve-once (? Struct? i))) - (App: (and (Name: _ _ _ #t) + (App: (and (Name/struct:) (app resolve-once (Poly: _ (? Struct? i)))) _ _))]))) @@ -210,7 +210,7 @@ (or (free-identifier=? s-name p-name) (match s [(Poly: _ (? Struct? s*)) (in-hierarchy? s* par)] - [(Struct: _ (and (Name: _ _ _ #t) p) _ _ _ _) + [(Struct: _ (and (Name/struct:) p) _ _ _ _) (in-hierarchy? (resolve-once p) par)] [(Struct: _ (? Struct? p) _ _ _ _) (in-hierarchy? p par)] [(Struct: _ (Poly: _ p) _ _ _ _) (in-hierarchy? p par)] diff --git a/pkgs/typed-racket-pkgs/typed-racket-more/typed/pict.rkt b/pkgs/typed-racket-pkgs/typed-racket-more/typed/pict.rkt index 0325f42d..ffb15231 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-more/typed/pict.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-more/typed/pict.rkt @@ -8,10 +8,10 @@ make-Union))) (begin-for-syntax - (define -pict (make-Name #'pict null #f #t)) + (define -pict (-struct-name #'pict)) (define -pict-path (make-Union (list (-val #f) -pict (-lst -pict)))) - (define -child (make-Name #'child null #f #t)) + (define -child (-struct-name #'child)) (define -linestyle (one-of/c 'transparent 'solid 'xor 'hilite 'dot 'long-dash 'short-dash 'dot-dash diff --git a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt index 434cdb91..3cc0c05a 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt @@ -1907,7 +1907,7 @@ -Void) [tc-e (raise (exn:fail:contract "1" (current-continuation-marks))) (t:Un)] [tc-err (exn:fail:contract) - #:ret (ret (resolve (make-Name #'exn:fail:contract null #f #t)))] + #:ret (ret (resolve (-struct-name #'exn:fail:contract)))] [tc-e (#%variable-reference) -Variable-Reference] [tc-e (#%variable-reference x) -Variable-Reference] [tc-e (#%variable-reference +) -Variable-Reference]