Make tc-expr unit use the new syntax classes.

This commit is contained in:
Eric Dobson 2013-11-12 09:26:15 -08:00
parent d582245395
commit 2a99e418d5
2 changed files with 10 additions and 7 deletions

View File

@ -8,13 +8,13 @@
(types utils abbrev union subtype type-table) (types utils abbrev union subtype type-table)
(private-in parse-type type-annotation syntax-properties) (private-in parse-type type-annotation syntax-properties)
(rep type-rep filter-rep object-rep) (rep type-rep filter-rep object-rep)
(utils tc-utils) (utils tc-utils syntax-classes)
(env lexical-env tvar-env index-env) (env lexical-env tvar-env index-env)
racket/private/class-internal racket/private/class-internal
syntax/parse syntax/stx syntax/parse syntax/stx
unstable/syntax unstable/syntax
(only-in srfi/1 split-at) (only-in srfi/1 split-at)
(for-template "internal-forms.rkt" (only-in '#%paramz [parameterization-key pz:pk]))) (for-template (only-in '#%paramz [parameterization-key pz:pk])))
(require (for-template racket/base racket/private/class-internal)) (require (for-template racket/base racket/private/class-internal))
@ -188,8 +188,8 @@
;; We trust ignore to be only on syntax objects objects that are well typed ;; We trust ignore to be only on syntax objects objects that are well typed
expected] expected]
;; explicit failure ;; explicit failure
[(quote-syntax ((~literal typecheck-fail-internal) stx msg:str var)) [t:failed-typecheck
(explicit-fail #'stx #'msg #'var)] (explicit-fail #'t.stx #'t.message #'t.var)]
;; data ;; data
[(quote #f) (ret (-val #f) -false-filter)] [(quote #f) (ret (-val #f) -false-filter)]
[(quote #t) (ret (-val #t) -true-filter)] [(quote #t) (ret (-val #t) -true-filter)]
@ -328,8 +328,8 @@
(check-subforms/ignore form) (check-subforms/ignore form)
(ret Univ)] (ret Univ)]
;; explicit failure ;; explicit failure
[(quote-syntax ((~literal typecheck-fail-internal) stx msg var)) [t:failed-typecheck
(explicit-fail #'stx #'msg #'var)] (explicit-fail #'t.stx #'t.message #'t.var)]
;; data ;; data
[(quote #f) (ret (-val #f) -false-filter)] [(quote #f) (ret (-val #f) -false-filter)]
[(quote #t) (ret (-val #t) -true-filter)] [(quote #t) (ret (-val #t) -true-filter)]

View File

@ -16,6 +16,7 @@
typed-require/struct typed-require/struct
predicate-assertion predicate-assertion
type-declaration type-declaration
failed-typecheck
type-alias? type-alias?
typed-struct? typed-struct?
@ -65,7 +66,9 @@
[predicate-assertion [predicate-assertion
(assert-predicate-internal type predicate)] (assert-predicate-internal type predicate)]
[type-declaration [type-declaration
(:-internal id:identifier type)]) (:-internal id:identifier type)]
[failed-typecheck
(typecheck-fail-internal stx message:str var:id)])
;;; Helpers ;;; Helpers