Browse Source

fix issues with require-struct accessors

wip-typedefs
Sam Caldwell 1 year ago
parent
commit
db2a8e1cec
  1. 7
      racket/typed/core-types.rkt
  2. 5
      racket/typed/examples/roles/require-struct/client.rkt
  3. 7
      racket/typed/examples/roles/struct-out/client.rkt
  4. 0
      racket/typed/examples/roles/struct-out/struct-in.rkt
  5. 0
      racket/typed/examples/roles/struct-out/struct-out.rkt
  6. 5
      racket/typed/examples/roles/struct-out/typed-out.rkt
  7. 5
      racket/typed/examples/roles/struct-out/untyped.rkt

7
racket/typed/core-types.rkt

@ -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
racket/typed/examples/roles/require-struct/client.rkt

@ -5,9 +5,12 @@
(define m (msg 1 "hi"))
(msg-in m)
(msg-out m)
(match m
[(msg (bind x Int) discard)
(displayln x)])
;; error: msg/checked: arity mismatch
#;(msg 1 2 3)
#;(msg 1 2 3)

7
racket/typed/examples/roles/struct-out/client.rkt

@ -0,0 +1,7 @@
#lang typed/syndicate/roles
(require "typed-out.rkt")
(define c : (Cow Int) (cow 5))
(cow-moos c)

0
racket/typed/examples/roles/struct-in.rkt → racket/typed/examples/roles/struct-out/struct-in.rkt

0
racket/typed/examples/roles/struct-out.rkt → racket/typed/examples/roles/struct-out/struct-out.rkt

5
racket/typed/examples/roles/struct-out/typed-out.rkt

@ -0,0 +1,5 @@
#lang typed/syndicate/roles
(require-struct cow #:as Cow #:from "untyped.rkt")
(provide (struct-out cow))

5
racket/typed/examples/roles/struct-out/untyped.rkt

@ -0,0 +1,5 @@
#lang racket
(provide (struct-out cow))
(struct cow (moos) #:transparent)
Loading…
Cancel
Save