diff --git a/typed-racket-doc/typed-racket/scribblings/reference/experimental.scrbl b/typed-racket-doc/typed-racket/scribblings/reference/experimental.scrbl index fda49f8f..c4eb8312 100644 --- a/typed-racket-doc/typed-racket/scribblings/reference/experimental.scrbl +++ b/typed-racket-doc/typed-racket/scribblings/reference/experimental.scrbl @@ -1,8 +1,13 @@ #lang scribble/manual -@begin[(require "../utils.rkt") +@begin[(require "../utils.rkt" scribble/eval) (require (for-label (only-meta-in 0 [except-in typed/racket for])))] +@(define the-top-eval (make-base-eval)) +@(define-syntax-rule (ex . args) + (examples #:eval the-top-eval . args)) + + @title{Experimental Features} These features are currently experimental and subject to change. @@ -15,3 +20,20 @@ predicate @racket[id], which must have been specified with @racket[declare-refinement].} @defform[(define-typed-struct/exec forms ...)]{Defines an executable structure.} + +@defform[(define-new-subtype name (constructor t))]{ +Defines a new type @racket[name] that is a subtype of @racket[t]. +The @racket[constructor] is defined as a function that takes a value of type +@racket[t] and produces a value of the new type @racket[name]. +A @racket[define-new-subtype] definition is only allowed at the top level of a +file or module. +@ex[(module m typed/racket + (provide Radians radians f) + (define-new-subtype Radians (radians Real)) + (: f : [Radians -> Real]) + (define (f a) + (sin a))) + (require 'm) + (radians 0) + (f (radians 0))] +} diff --git a/typed-racket-doc/typed-racket/scribblings/reference/special-forms.scrbl b/typed-racket-doc/typed-racket/scribblings/reference/special-forms.scrbl index ea1bc8a6..d47242a8 100644 --- a/typed-racket-doc/typed-racket/scribblings/reference/special-forms.scrbl +++ b/typed-racket-doc/typed-racket/scribblings/reference/special-forms.scrbl @@ -465,25 +465,6 @@ the type: (define-type Bar (U Bar False))] } -@section{Defining New Subtypes} - -@defform[(define-new-subtype name (constructor t))]{ -Defines a new type @racket[name] that is a subtype of @racket[t]. -The @racket[constructor] is defined as a function that takes a value of type -@racket[t] and produces a value of the new type @racket[name]. -A @racket[define-new-subtype] definition is only allowed at the top level of a -file or module. -@ex[(module m typed/racket - (provide Radians radians f) - (define-new-subtype Radians (radians Real)) - (: f : [Radians -> Real]) - (define (f a) - (sin a))) - (require 'm) - (radians 0) - (f (radians 0))] -} - @section{Generating Predicates Automatically} @defform[(make-predicate t)]{ diff --git a/typed-racket-lib/typed-racket/env/init-envs.rkt b/typed-racket-lib/typed-racket/env/init-envs.rkt index 7c9f66d9..a0cc6d8e 100644 --- a/typed-racket-lib/typed-racket/env/init-envs.rkt +++ b/typed-racket-lib/typed-racket/env/init-envs.rkt @@ -127,8 +127,9 @@ (define ty (force (cdr id/ty))) `(cons (quote-syntax ,id) ,(sub ty))) m)) + (define serialized-extends (and extends `(quote-syntax ,extends))) `(make-Signature (quote-syntax ,name) - (quote-syntax ,extends) + ,serialized-extends (list ,@(serialize-mapping mapping)))] [(arr: dom rng rest drest kws) `(make-arr ,(sub dom) ,(sub rng) ,(sub rest) ,(sub drest) ,(sub kws))] diff --git a/typed-racket-lib/typed-racket/private/parse-type.rkt b/typed-racket-lib/typed-racket/private/parse-type.rkt index 60b985e5..36430912 100644 --- a/typed-racket-lib/typed-racket/private/parse-type.rkt +++ b/typed-racket-lib/typed-racket/private/parse-type.rkt @@ -478,6 +478,11 @@ (-Param ty ty))] [(:Parameter^ t1 t2) (-Param (parse-type #'t1) (parse-type #'t2))] + [((~and p :Parameter^) args ...) + (parse-error + #:stx stx + (~a (syntax-e #'p) " expects one or two type arguments, given " + (sub1 (length (syntax->list #'(args ...))))))] ;; curried function notation [((~and dom:non-keyword-ty (~not :->^)) ... :->^ diff --git a/typed-racket-lib/typed-racket/private/type-contract.rkt b/typed-racket-lib/typed-racket/private/type-contract.rkt index cafa333b..2f0461c0 100644 --- a/typed-racket-lib/typed-racket/private/type-contract.rkt +++ b/typed-racket-lib/typed-racket/private/type-contract.rkt @@ -111,7 +111,7 @@ (λ (#:reason [reason #f]) (set! failure-reason reason)))) (syntax-parse stx #:literal-sets (kernel-literals) - [(define-values ctc-id _) + [(define-values (ctc-id) _) ;; no need for ignore, the optimizer doesn't run on this code (cond [failure-reason #`(define-syntax (#,untyped-id stx) @@ -122,10 +122,15 @@ "type" #,(pretty-format-type type #:indent 8)))] [else (match-define (list defs ctc) result) + (define maybe-inline-val + (should-inline-contract? ctc cache)) #`(begin #,@defs - (define ctc-id #,ctc) + #,@(if maybe-inline-val + null + (list #`(define-values (ctc-id) #,ctc))) (define-module-boundary-contract #,untyped-id - #,orig-id ctc-id + #,orig-id + #,(or maybe-inline-val #'ctc-id) #:pos-source #,blame-id #:srcloc (vector (quote #,(syntax-source orig-id)) #,(syntax-line orig-id) @@ -133,6 +138,20 @@ #,(syntax-position orig-id) #,(syntax-span orig-id))))])])) +;; Syntax (Dict Static-Contract (Cons Id Syntax)) -> (Option Syntax) +;; A helper for generate-contract-def/provide that helps inline contract +;; expressions when needed to cooperate with the contract system's optimizations +(define (should-inline-contract? ctc-stx cache) + (and (identifier? ctc-stx) + (let ([match? (assoc ctc-stx (hash-values cache) free-identifier=?)]) + (and match? + ;; ->* are handled specially by the contract system + (let ([sexp (syntax-e (cdr match?))]) + (and (pair? sexp) + (or (free-identifier=? (car sexp) #'->) + (free-identifier=? (car sexp) #'->*)))) + (cdr match?))))) + ;; The below requires are needed since they provide identifiers that ;; may appear in the residual program. diff --git a/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt b/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt index 451a065a..8bc99561 100644 --- a/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt +++ b/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt @@ -529,8 +529,8 @@ ;; indirection here (see the implementation in ;; provide-handling.rkt). ;; - ;; First, we generate a macro that expands to a - ;; `local-require` of the contracted identifier in the + ;; First, we generate a macro that lifts a + ;; `require` of the contracted identifier in the ;; #%contract-defs submodule: ;; (define-syntax con-f (mk-redirect f)) ;; @@ -542,7 +542,7 @@ ;; because it's important for `export-f` to be a ;; rename-transformer (making things like ;; `syntax-local-value` work right), but `con-f` can't be, - ;; since it expands to a `local-require`. + ;; since it lifts a `require` new-export-defs ... ;; Finally, we do the export: diff --git a/typed-racket-lib/typed-racket/types/union.rkt b/typed-racket-lib/typed-racket/types/union.rkt index 16b7b7d4..00c1f322 100644 --- a/typed-racket-lib/typed-racket/types/union.rkt +++ b/typed-racket-lib/typed-racket/types/union.rkt @@ -49,11 +49,16 @@ ;; Normalizes representation by sorting types. ;; Type * -> Type ;; The input types can overlap and be union types +(define Un-cache (make-weak-hash)) (define Un (case-lambda [() -Bottom] [(t) t] [args - (define ts (foldr merge '() - (remove-dups (sort (append-map flat args) typesyntax id (syntax-e id) stx stx)]) - #`(let () - (local-require (only-in mp [#,(datum->syntax #'mp (syntax-e #'i)) i])) - i))] + (syntax-local-lift-require + #`(rename mp i #,(datum->syntax #'mp (syntax-e #'i))) + #'i))] [else (datum->syntax stx (cons (redirect (car (syntax-e stx))) diff --git a/typed-racket-test/succeed/require-signature-all-typed.rkt b/typed-racket-test/succeed/require-signature-all-typed.rkt new file mode 100644 index 00000000..5ff5fd81 --- /dev/null +++ b/typed-racket-test/succeed/require-signature-all-typed.rkt @@ -0,0 +1,14 @@ +#lang typed/racket + +(module a typed/racket + (provide foo^) + + (define-signature foo^ + ([n : Number]))) + +(require 'a) + +(define-unit foo@ + (import) + (export foo^) + (define n 5)) \ No newline at end of file diff --git a/typed-racket-test/unit-tests/interactive-tests.rkt b/typed-racket-test/unit-tests/interactive-tests.rkt index 1a5fd62e..f903dfa9 100644 --- a/typed-racket-test/unit-tests/interactive-tests.rkt +++ b/typed-racket-test/unit-tests/interactive-tests.rkt @@ -111,7 +111,7 @@ [#:opaque Evt evt?] [alarm-evt (Real -> Evt)] [sync (Evt -> Any)]) - evt?)) + (void evt?))) ;; PR 14380 (test-form-not-exn (begin - (void)))