diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-subforms-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-subforms-unit.rkt index 6c28e49f..b5bfa4c7 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-subforms-unit.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/check-subforms-unit.rkt @@ -1,7 +1,6 @@ #lang racket/unit (require "../utils/utils.rkt" - syntax/kerncase syntax/parse racket/match "signatures.rkt" "tc-metafunctions.rkt" @@ -15,7 +14,7 @@ (export check-subforms^) ;; FIXME -- samth 7/15/11 -;; This code is doing the wrong thing wrt the arguments of exception handlers. +;; This code is doing the wrong thing wrt the arguments of exception handlers. ;; In particular, it allows them to be anything at all, but they might ;; get called with the wrong kind of arguments by the exception ;; mechanism. The right thing is to use the exception predicate. @@ -78,23 +77,23 @@ [_ (void)]))) (apply combine-types body-ty handler-tys)) -;; syntax type -> any +;; syntax tc-results -> tc-results (define (check-subforms/with-handlers/check form expected) (let loop ([form form]) (parameterize ([current-orig-stx form]) - (kernel-syntax-case* form #f () + (syntax-parse form [stx ;; if this needs to be checked - (with-type-property form) + #:when (with-type-property form) ;; the form should be already ascribed the relevant type (tc-expr form)] [stx - ;; this is a hander function - (exn-handler-property form) + ;; this is a handler function + #:when (exn-handler-property form) (tc-expr/check form (ret (-> (Un) (tc-results->values expected))))] [stx ;; this is the body of the with-handlers - (exn-body-property form) + #:when (exn-body-property form) (tc-expr/check form expected)] [(a . b) (begin @@ -107,10 +106,10 @@ ;; syntax -> void (define (check-subforms/ignore form) (let loop ([form form]) - (kernel-syntax-case* form #f () + (syntax-parse form [stx ;; if this needs to be checked - (with-type-property form) + #:when (with-type-property form) ;; the form should be already ascribed the relevant type (void (tc-expr form))] [(a . b) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt index df365276..6de73845 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt @@ -10,7 +10,7 @@ syntax/free-vars (typecheck signatures tc-metafunctions tc-subst) racket/match (contract-req) - syntax/kerncase syntax/parse syntax/stx + syntax/parse syntax/stx (for-template racket/base (typecheck internal-forms))) @@ -82,7 +82,7 @@ expected-types ; types w/o undefined (append p1 p2) ;; typecheck the body - (run + (run (if expected (tc-body/check body (erase-filter expected)) (tc-body body))))))) @@ -108,7 +108,9 @@ [clauses (syntax-case form () [(lv cl . b) (syntax->list #'cl)])]) ;; collect the declarations, which are represented as definitions (for-each (lambda (names body) - (kernel-syntax-case* body #f (values :-internal define-type-alias-internal) + (syntax-parse body + #:literals (values :-internal define-type-alias-internal) + #:literal-sets (kernel-literals) [(begin (quote-syntax (define-type-alias-internal nm ty)) (#%plain-app values)) (register-resolved-type-alias #'nm (parse-type #'ty))] [(begin (quote-syntax (:-internal nm ty)) (#%plain-app values)) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt index fbe30b75..7f7b3bc6 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt @@ -1,7 +1,7 @@ #lang racket/base (require (rename-in "../utils/utils.rkt" [infer r:infer]) - syntax/kerncase racket/syntax syntax/parse syntax/stx syntax/id-table + racket/syntax syntax/parse syntax/stx syntax/id-table racket/list unstable/list racket/dict racket/match unstable/sequence (prefix-in c: (contract-req)) (rep type-rep free-variance) @@ -203,31 +203,27 @@ ;; syntax? -> (or/c void? tc-results/c) (define (tc-toplevel/pass2 form) (parameterize ([current-orig-stx form]) - (kernel-syntax-case* form #f (define-type-alias-internal define-typed-struct-internal define-type-internal - require/typed-internal values module module*) + (syntax-parse form + #:literal-sets (kernel-literals) + #:literals (define-type-alias-internal define-typed-struct-internal + define-type-internal require/typed-internal) ;; these forms we have been instructed to ignore [stx - (ignore-property form) + #:when (ignore-property form) (void)] ;; this is a form that we mostly ignore, but we check some interior parts [stx - (ignore-some-property form) + #:when (ignore-some-property form) (check-subforms/ignore form)] ;; these forms should always be ignored - [(#%require . _) (void)] - [(#%provide . _) (void)] - [(#%declare . _) (void)] - [(define-syntaxes . _) (void)] - [(begin-for-syntax . _) (void)] + [((~or define-syntaxes begin-for-syntax #%require #%provide #%declare) . _) (void)] ;; submodules take care of themselves: - [(module n spec (#%plain-module-begin body ...)) - (void)] + [(module n spec (#%plain-module-begin body ...)) (void)] ;; module* is not expanded, so it doesn't have a `#%plain-module-begin` - [(module* n spec body ...) - (void)] + [(module* n spec body ...) (void)] ;; definitions just need to typecheck their bodies [(define-values () expr) @@ -255,25 +251,28 @@ ;; new implementation of type-check (define-syntax-rule (internal-syntax-pred nm) (lambda (form) - (kernel-syntax-case* form #f - (nm values) - [(define-values () (begin (quote-syntax (nm . rest)) (#%plain-app values))) - #t] + (syntax-parse form + #:literals (nm values) + #:literal-sets (kernel-literals) + [(define-values () (begin (quote-syntax (nm . rest)) (#%plain-app values))) #t] [_ #f]))) (define (parse-def x) - (kernel-syntax-case x #f + (syntax-parse x + #:literal-sets (kernel-literals) [(define-values (nm ...) . rest) (syntax->list #'(nm ...))] [_ #f])) (define (parse-syntax-def x) - (kernel-syntax-case x #f + (syntax-parse x + #:literal-sets (kernel-literals) [(define-syntaxes (nm ...) . rest) (syntax->list #'(nm ...))] [_ #f])) (define (parse-type-alias form) - (kernel-syntax-case* form #f - (define-type-alias-internal values) + (syntax-parse form + #:literals (define-type-alias-internal values) + #:literal-sets (kernel-literals) [(define-values () (begin (quote-syntax (define-type-alias-internal nm ty)) (#%plain-app values))) (values #'nm #'ty)] [_ (int-err "not define-type-alias")])) @@ -319,7 +318,7 @@ ;(printf "after resolving type aliases~n") ;(displayln "Starting pass1") ;; do pass 1, and collect the defintions - (define defs (apply append + (define defs (apply append (append struct-bindings (map tc-toplevel/pass1 forms)))) @@ -376,7 +375,7 @@ [_ (int-err "unknown provide form")])))] [_ (int-err "non-provide form! ~a" (syntax->datum p))]))) ;; compute the new provides - (define-values (new-stx/pre new-stx/post) + (define-values (new-stx/pre new-stx/post) (with-syntax* ([the-variable-reference (generate-temporary #'blame)]) (define-values (code aliasess) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/utils/mutated-vars.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/utils/mutated-vars.rkt index a8e53f03..3bad46ec 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/utils/mutated-vars.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/utils/mutated-vars.rkt @@ -1,7 +1,7 @@ #lang racket/base (require (for-template racket/base) racket/dict - syntax/id-table syntax/kerncase unstable/sequence) + syntax/parse syntax/id-table unstable/sequence) ;; find and add to mapping all the set!'ed variables in form ;; if the supplied mapping is mutable, mutates it @@ -16,7 +16,8 @@ (define (fmv/list lstx) (for/fold ([tbl tbl]) ([stx (in-syntax lstx)]) (loop stx tbl))) - (kernel-syntax-case* stx #f (#%top-interaction) + (syntax-parse stx + #:literal-sets (kernel-literals) ;; what we care about: set! [(set! v e) (add (loop #'e tbl) #'v)]