fix issues with require-struct accessors
This commit is contained in:
parent
3e13e3e449
commit
db2a8e1cec
|
@ -667,9 +667,10 @@
|
|||
(quasisyntax/loc TypeCons
|
||||
(define-typed-variable-rename+ #,accessor ≫ #,accessor- : (∀+ #,slots (→fn (#,TypeCons #,@slots) #,slot))))))
|
||||
|
||||
(define-for-syntax ((define-struct-accs accs TypeCons lib) stx)
|
||||
(define-for-syntax ((define-struct-accs accs/rev TypeCons lib) stx)
|
||||
(syntax-parse stx
|
||||
[(_ ucons:id)
|
||||
(define accs (cleanup-accs #'ucons accs/rev))
|
||||
(define accs- (map mk-- accs))
|
||||
(define slots (generate-temporaries accs))
|
||||
(define renames (for/list ([acc (in-list accs)]
|
||||
|
@ -730,9 +731,9 @@
|
|||
(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 accs))
|
||||
(user-ctor #'Cons- #'orig-struct-info 'type-tag #'TypeCons (cleanup-accs #'ucons accs/rev) #;accs))
|
||||
(define-syntax mk-struct-accs
|
||||
(define-struct-accs accs #'TypeCons #'lib))
|
||||
(define-struct-accs accs/rev #'TypeCons #'lib))
|
||||
(mk-struct-accs ucons))))]))
|
||||
|
||||
(begin-for-syntax
|
||||
|
|
|
@ -5,6 +5,9 @@
|
|||
|
||||
(define m (msg 1 "hi"))
|
||||
|
||||
(msg-in m)
|
||||
(msg-out m)
|
||||
|
||||
(match m
|
||||
[(msg (bind x Int) discard)
|
||||
(displayln x)])
|
||||
|
|
|
@ -0,0 +1,7 @@
|
|||
#lang typed/syndicate/roles
|
||||
|
||||
(require "typed-out.rkt")
|
||||
|
||||
(define c : (Cow Int) (cow 5))
|
||||
|
||||
(cow-moos c)
|
|
@ -0,0 +1,5 @@
|
|||
#lang typed/syndicate/roles
|
||||
|
||||
(require-struct cow #:as Cow #:from "untyped.rkt")
|
||||
|
||||
(provide (struct-out cow))
|
|
@ -0,0 +1,5 @@
|
|||
#lang racket
|
||||
|
||||
(provide (struct-out cow))
|
||||
|
||||
(struct cow (moos) #:transparent)
|
Loading…
Reference in New Issue