Fix types of kernel struct constructors to include parent fields.
Merge to 5.1.2.
(cherry picked from commit 7a763a2da8
)
This commit is contained in:
parent
35bbe90dcb
commit
925a6ae9f2
|
@ -1380,9 +1380,10 @@
|
|||
exn:break
|
||||
arity-at-least
|
||||
date
|
||||
srcloc) -Void)
|
||||
|
||||
|
||||
srcloc)
|
||||
-Void)
|
||||
[tc-e (raise (exn:fail:contract "1" (current-continuation-marks))) (t:Un)]
|
||||
[tc-err (exn:fail:contract)]
|
||||
)
|
||||
(test-suite
|
||||
"check-type tests"
|
||||
|
|
|
@ -289,16 +289,16 @@
|
|||
(c-> identifier? (or/c #f identifier?) (listof identifier?)
|
||||
(listof Type/c) (or/c #f identifier?) #;(listof fld?)
|
||||
any/c)
|
||||
(let* ([parent-name (if parent (make-Name parent) #f)]
|
||||
[parent-flds (if parent (get-parent-flds parent-name) null)])
|
||||
(let ((defs (mk/register-sty nm flds parent-name parent-flds tys
|
||||
#:mutable #t)))
|
||||
(if kernel-maker
|
||||
(let* ((result-type (lookup-type-name nm))
|
||||
(ty (->* tys result-type)))
|
||||
(register-type kernel-maker ty)
|
||||
(cons (make-def-binding kernel-maker ty) defs))
|
||||
defs))))
|
||||
(define parent-name (if parent (make-Name parent) #f))
|
||||
(define parent-flds (if parent (get-parent-flds parent-name) null))
|
||||
(define parent-tys (map fld-t parent-flds))
|
||||
(define defs (mk/register-sty nm flds parent-name parent-flds tys #:mutable #t))
|
||||
(if kernel-maker
|
||||
(let* ([result-type (lookup-type-name nm)]
|
||||
[ty (->* (append parent-tys tys) result-type)])
|
||||
(register-type kernel-maker ty)
|
||||
(cons (make-def-binding kernel-maker ty) defs))
|
||||
defs))
|
||||
|
||||
|
||||
;; syntax for tc/builtin-struct
|
||||
|
|
Loading…
Reference in New Issue
Block a user