Replace kerncase with syntax-parse.

original commit: 28321ca4edb1e183b5f900598551226267d187d3

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)

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))

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)

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)]