Make tc-expr unit use the new syntax classes.
This commit is contained in:
parent
d582245395
commit
2a99e418d5
|
@ -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)]
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user