From db2a8e1cec8666289d5c18a815b12b3abc834184 Mon Sep 17 00:00:00 2001
From: Sam Caldwell <samc@ccs.neu.edu>
Date: Wed, 25 Nov 2020 11:06:50 -0500
Subject: [PATCH] fix issues with require-struct accessors

---
 racket/typed/core-types.rkt                                | 7 ++++---
 racket/typed/examples/roles/require-struct/client.rkt      | 5 ++++-
 racket/typed/examples/roles/struct-out/client.rkt          | 7 +++++++
 racket/typed/examples/roles/{ => struct-out}/struct-in.rkt | 0
 .../typed/examples/roles/{ => struct-out}/struct-out.rkt   | 0
 racket/typed/examples/roles/struct-out/typed-out.rkt       | 5 +++++
 racket/typed/examples/roles/struct-out/untyped.rkt         | 5 +++++
 7 files changed, 25 insertions(+), 4 deletions(-)
 create mode 100644 racket/typed/examples/roles/struct-out/client.rkt
 rename racket/typed/examples/roles/{ => struct-out}/struct-in.rkt (100%)
 rename racket/typed/examples/roles/{ => struct-out}/struct-out.rkt (100%)
 create mode 100644 racket/typed/examples/roles/struct-out/typed-out.rkt
 create mode 100644 racket/typed/examples/roles/struct-out/untyped.rkt

diff --git a/racket/typed/core-types.rkt b/racket/typed/core-types.rkt
index 887ec17..084d0c5 100644
--- a/racket/typed/core-types.rkt
+++ b/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
diff --git a/racket/typed/examples/roles/require-struct/client.rkt b/racket/typed/examples/roles/require-struct/client.rkt
index 9086a84..8066afd 100644
--- a/racket/typed/examples/roles/require-struct/client.rkt
+++ b/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)
\ No newline at end of file
+#;(msg 1 2 3)
diff --git a/racket/typed/examples/roles/struct-out/client.rkt b/racket/typed/examples/roles/struct-out/client.rkt
new file mode 100644
index 0000000..6fd80f6
--- /dev/null
+++ b/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)
diff --git a/racket/typed/examples/roles/struct-in.rkt b/racket/typed/examples/roles/struct-out/struct-in.rkt
similarity index 100%
rename from racket/typed/examples/roles/struct-in.rkt
rename to racket/typed/examples/roles/struct-out/struct-in.rkt
diff --git a/racket/typed/examples/roles/struct-out.rkt b/racket/typed/examples/roles/struct-out/struct-out.rkt
similarity index 100%
rename from racket/typed/examples/roles/struct-out.rkt
rename to racket/typed/examples/roles/struct-out/struct-out.rkt
diff --git a/racket/typed/examples/roles/struct-out/typed-out.rkt b/racket/typed/examples/roles/struct-out/typed-out.rkt
new file mode 100644
index 0000000..790f1df
--- /dev/null
+++ b/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))
diff --git a/racket/typed/examples/roles/struct-out/untyped.rkt b/racket/typed/examples/roles/struct-out/untyped.rkt
new file mode 100644
index 0000000..7e6ef35
--- /dev/null
+++ b/racket/typed/examples/roles/struct-out/untyped.rkt
@@ -0,0 +1,5 @@
+#lang racket
+
+(provide (struct-out cow))
+
+(struct cow (moos) #:transparent)