syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

typed: fix required struct type constructors to know their arity

This commit is contained in:
Sam Caldwell 2022-03-23 12:27:03 -04:00
parent e4f72519f0
commit fc038877f5
1 changed files with 38 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
racket/typed/syndicate/core-types.rkt
View File

@ -778,6 +778,7 @@
(define-syntax (require-struct stx)
(syntax-parse stx
[(_ ucons:id #:as ty-cons:id #:from lib (~optional (~and omit-accs #:omit-accs)))
;; TBH I'm not sure why I don't need to SLIAB TypeCons and Cons-
(with-syntax* ([TypeCons #'ty-cons]
[MakeTypeCons (format-id #'TypeCons "make-~a" #'TypeCons)]
[GetTypeParams (format-id #'TypeCons "get-~a-type-params" #'TypeCons)]
@ -800,28 +801,45 @@
(raise-syntax-error #f "structs with super-type not supported" #'#,stx #'ucons))
(define arity (length accs/rev))
)
(define-for-syntax (TypeConsExtraInfo stx)
(list #'type-tag #'MakeTypeCons #'GetTypeParams)
)
(define-product-type TypeCons
;; issue: arity needs to parse as an exact-nonnegative-integer
;; fix: check arity in MakeTypeCons
#:arity >= 0
#:extra-info TypeConsExtraInfo
#:implements get-resugar-info (resugar-ctor #'TypeCons))
(define-syntax MakeTypeCons (mk-ctor-rewriter #'TypeCons))
(define-syntax GetTypeParams (mk-type-params-fetcher #'TypeCons))
(define-syntax Cons- (mk-constructor-type-rule arity #'orig-struct-info #'TypeCons))
(define-syntax ucons
(user-ctor #'Cons- #'orig-struct-info 'type-tag #'TypeCons (cleanup-accs #'ucons accs/rev)))
#,(unless (attribute omit-accs)
(quasisyntax/loc stx
(begin-
(define-syntax mk-struct-accs
(define-struct-accs accs/rev #'TypeCons #'lib))
(mk-struct-accs ucons))))
(define-syntax finish-type-defs
(finish-require-struct-typedef #'lib #'Cons- #'TypeConsExtraInfo #'type-tag #'MakeTypeCons #'GetTypeParams #'orig-struct-info #'accs/rev arity #,(attribute omit-accs)))
(finish-type-defs ucons TypeCons)
)))]))
;; This is so that the arity of the struct can be included in the generated typedef
(define-for-syntax ((finish-require-struct-typedef lib
Cons-
TypeConsExtraInfo
type-tag
MakeTypeCons
GetTypeParams
orig-struct-info
accs/rev
arity
omit-accs?)
stx)
(syntax-parse stx
[(_ ucons:id TypeCons:id)
(quasisyntax/loc #'ucons
(begin-
(define-for-syntax (#,TypeConsExtraInfo stx)
(list #'#,type-tag #'#,MakeTypeCons #'#,GetTypeParams))
(define-product-type TypeCons
#:arity = #,arity
#:extra-info #,TypeConsExtraInfo
#:implements get-resugar-info (resugar-ctor #'TypeCons))
(define-syntax #,MakeTypeCons (mk-ctor-rewriter #'TypeCons))
(define-syntax #,GetTypeParams (mk-type-params-fetcher #'TypeCons))
(define-syntax #,Cons- (mk-constructor-type-rule #,arity #'#,orig-struct-info #'TypeCons))
(define-syntax ucons
(user-ctor #'#,Cons- #'#,orig-struct-info '#,type-tag #'TypeCons (cleanup-accs #'ucons #,accs/rev)))
#,(unless omit-accs?
(quasisyntax/loc #'ucons
(begin-
(define-syntax mk-struct-accs
(define-struct-accs #,accs/rev #'TypeCons #'#,lib))
(mk-struct-accs ucons))))))]))
(begin-for-syntax
(define-syntax ~constructor-extra-info
(pattern-expander