From d81fa3bba0ef36bc0e503ab7f98d280cd68c9e0c Mon Sep 17 00:00:00 2001
From: yjqww6 <343519265@qq.com>
Date: Sat, 5 Dec 2020 20:49:30 +0800
Subject: [PATCH] get rid of rtd-mutables for non-prefab struct

---
 racket/src/cs/rumble/equal.ss            |   6 +-
 racket/src/cs/rumble/struct.ss           |  48 +++++--
 racket/src/cs/schemified/io.scm          | 162 +++++++++++------------
 racket/src/cs/schemified/schemify.scm    | 155 ++++++++++++++++++----
 racket/src/schemify/struct-type-info.rkt |  23 +++-
 5 files changed, 267 insertions(+), 127 deletions(-)

diff --git a/racket/src/cs/rumble/equal.ss b/racket/src/cs/rumble/equal.ss
index cda6baad37..4ce80ae8b3 100644
--- a/racket/src/cs/rumble/equal.ss
+++ b/racket/src/cs/rumble/equal.ss
@@ -130,7 +130,11 @@
                                                               ;; Make sure record sees only booleans:
                                                               (and (eql? a b) #t)))]
                                  [(and (eq? mode 'chaperone-of?)
-                                       (with-global-lock* (hashtable-contains? rtd-mutables (record-rtd a))))
+                                       (let ([rtd (record-rtd a)])
+                                         (and (not (eq? 0 (struct-type-mpm rtd)))
+                                              (if (struct-type-prefab? rtd)
+                                                  (with-global-lock* (hashtable-contains? rtd-mutables rtd))
+                                                  #t))))
                                   ;; Mutable records must be `eq?` for `chaperone-of?`
                                   #f]
                                  [else
diff --git a/racket/src/cs/rumble/struct.ss b/racket/src/cs/rumble/struct.ss
index 5d190173a1..879dd2995d 100644
--- a/racket/src/cs/rumble/struct.ss
+++ b/racket/src/cs/rumble/struct.ss
@@ -371,7 +371,7 @@
 
 ;; ----------------------------------------
 
-;; Records which fields of an rtd are mutable, where an rtd that is
+;; Records which fields of an prefab rtd are mutable, where an rtd that is
 ;; not in the table has no mutable fields, and the field list can be
 ;; empty if a parent type is mutable; this table is used without
 ;; a lock
@@ -504,7 +504,10 @@
                                                (let ([mask (sub1 (general-arithmetic-shift 1 (+ init-count auto-count)))])
                                                  (if (eq? insp 'prefab)
                                                      mask
-                                                     (let loop ([imms immutables] [mask mask])
+                                                     (let loop ([imms (if (exact-nonnegative-integer? proc-spec)
+                                                                          (cons proc-spec immutables)
+                                                                          immutables)]
+                                                                [mask mask])
                                                        (cond
                                                         [(null? imms) mask]
                                                         [else
@@ -583,8 +586,7 @@
                     '())]
                [all-immutables (if (integer? proc-spec)
                                    (cons proc-spec immutables)
-                                   immutables)]
-               [mutables (immutables->mutables all-immutables init-count auto-count)])
+                                   immutables)])
           (when (not parent-rtd*)
             (record-type-equal-procedure rtd default-struct-equal?)
             (record-type-hash-procedure rtd default-struct-hash))
@@ -594,7 +596,6 @@
                              (cons prop:procedure props)
                              props))])
             (add-to-table! rtd-props rtd props))
-          (register-mutables! mutables rtd parent-rtd*)
           ;; Copy parent properties for this type:
           (for-each (lambda (prop)
                       (let loop ([prop prop])
@@ -854,7 +855,17 @@
                             auto-count
                             (make-position-based-accessor rtd* parent-total*-count (+ init-count auto-count))
                             (make-position-based-mutator rtd* parent-total*-count (+ init-count auto-count))
-                            (mutables->immutables (eq-hashtable-ref rtd-mutables rtd* '#()) init-count)
+                            (if (struct-type-prefab? rtd*)
+                                (mutables->immutables (eq-hashtable-ref rtd-mutables rtd* '#()) init-count)
+                                (let ([end (record-type-field-count rtd*)]
+                                      [offset (fx+ 1 (struct-type-parent-total*-count rtd*))]
+                                      [mpm (struct-type-mpm rtd*)])
+                                  (let loop ([i 0])
+                                    (cond
+                                     [(fx= i end) '()]
+                                     [(bitwise-bit-set? mpm (fx+ offset i))
+                                      (loop (fx+ i 1))]
+                                     [else (cons i (loop (fx+ i 1)))]))))
                             next-rtd*
                             skipped?))])
           (cond
@@ -1020,16 +1031,25 @@
         0)))
 
 ;; ----------------------------------------
+(define struct-type-mpm
+  (let ([mpm (csv7:record-field-accessor #!base-rtd 'mpm)])
+    (lambda (rtd) (mpm rtd))))
+
+(define (struct-type-prefab? rtd)
+  (and (getprop (record-type-uid rtd) 'prefab-key+count #f) #t))
 
 (define (struct-type-field-mutable? rtd pos)
-  (let ([mutables (eq-hashtable-ref rtd-mutables rtd '#())])
-    (let loop ([j (#%vector-length mutables)])
-      (cond
-       [(fx= j 0) #f]
-       [else
-        (let ([j (fx1- j)])
-          (or (eqv? pos (#%vector-ref mutables j))
-              (loop j)))]))))
+  (and (record-field-mutable? rtd pos)
+       (if (struct-type-prefab? rtd)
+           (let ([mutables (eq-hashtable-ref rtd-mutables rtd '#())])
+             (let loop ([j (#%vector-length mutables)])
+               (cond
+                [(fx= j 0) #f]
+                [else
+                 (let ([j (fx1- j)])
+                   (or (eqv? pos (#%vector-ref mutables j))
+                       (loop j)))])))
+           #t)))
 
 ;; Returns a list of (cons guard-proc field-count)
 (define (struct-type-guards rtd)
diff --git a/racket/src/cs/schemified/io.scm b/racket/src/cs/schemified/io.scm
index f5964f8085..e88228da0e 100644
--- a/racket/src/cs/schemified/io.scm
+++ b/racket/src/cs/schemified/io.scm
@@ -2687,7 +2687,7 @@
     (raise
      (let ((app_0 (string-append "internal error: " msg_0)))
        (|#%app| exn:fail app_0 (current-continuation-marks))))))
-(define effect_2977
+(define effect_2501
   (begin
     (void
      (if (primitive-table '|#%pthread|)
@@ -2715,7 +2715,7 @@
    #f
    11
    2047))
-(define effect_2727
+(define effect_2883
   (struct-type-install-properties!
    struct:sandman
    'sandman
@@ -3701,7 +3701,7 @@
                         (loop_0 #t))))))))))
          (loop_0 #f))))))
 (define struct:exts (make-record-type-descriptor* 'exts #f #f #f #f 2 0))
-(define effect_2438
+(define effect_2383
   (struct-type-install-properties!
    struct:exts
    'exts
@@ -3805,7 +3805,7 @@
     (begin
       (unsafe-place-local-set! cell.1$10 sleep_0)
       (unsafe-place-local-set! cell.2$3 fd_0))))
-(define effect_2095
+(define effect_2049
   (begin
     (void
      (|#%app|
@@ -3993,7 +3993,7 @@
       (wrap-evt (|#%app| (output-port-evt-ref p_0) p_0) (lambda (v_0) p_0)))))
 (define struct:core-port
   (make-record-type-descriptor* 'core-port #f #f #f #f 7 124))
-(define effect_3005
+(define effect_2716
   (struct-type-install-properties!
    struct:core-port
    'core-port
@@ -4062,7 +4062,7 @@
     (void)))
 (define struct:core-port-methods.1
   (make-record-type-descriptor* 'core-port-methods #f #f #f #f 5 0))
-(define effect_2884
+(define effect_2750
   (struct-type-install-properties!
    struct:core-port-methods.1
    'core-port-methods
@@ -4215,7 +4215,7 @@
    #f
    #f))
 (define struct:direct (make-record-type-descriptor* 'direct #f #f #f #f 3 7))
-(define effect_2828
+(define effect_3200
   (struct-type-install-properties!
    struct:direct
    'direct
@@ -4256,7 +4256,7 @@
     (void)))
 (define struct:location
   (make-record-type-descriptor* 'location #f #f #f #f 5 31))
-(define effect_2649
+(define effect_2872
   (struct-type-install-properties!
    struct:location
    'location
@@ -4379,7 +4379,7 @@
    #f
    2
    3))
-(define effect_2557
+(define effect_2614
   (struct-type-install-properties!
    struct:core-input-port
    'core-input-port
@@ -4475,7 +4475,7 @@
    #f
    6
    0))
-(define effect_2398
+(define effect_3216
   (struct-type-install-properties!
    struct:core-input-port-methods.1
    'core-input-port-methods
@@ -4749,7 +4749,7 @@
    #f
    4
    15))
-(define effect_2350
+(define effect_2619
   (struct-type-install-properties!
    struct:core-output-port
    'core-output-port
@@ -4862,7 +4862,7 @@
    #f
    4
    0))
-(define effect_2513
+(define effect_2581
   (struct-type-install-properties!
    struct:core-output-port-methods.1
    'core-output-port-methods
@@ -5047,7 +5047,7 @@
                (values (list v_0) #f)))))))))
 (define struct:write-evt
   (make-record-type-descriptor* 'write-evt #f #f #f #f 1 0))
-(define effect_2996
+(define effect_2681
   (struct-type-install-properties!
    struct:write-evt
    'write-evt
@@ -5118,7 +5118,7 @@
    #f))
 (define struct:utf-8-state
   (make-record-type-descriptor* 'utf-8-state #f #f #f #f 3 0))
-(define effect_2404
+(define effect_2417
   (struct-type-install-properties!
    struct:utf-8-state
    'utf-8-state
@@ -7271,7 +7271,7 @@
           (void))))))
 (define struct:commit-manager
   (make-record-type-descriptor* 'commit-manager #f #f #f #f 3 0))
-(define effect_2365
+(define effect_3024
   (struct-type-install-properties!
    struct:commit-manager
    'commit-manager
@@ -7372,7 +7372,7 @@
     (void)))
 (define struct:commit-request
   (make-record-type-descriptor* 'commit-request #f #f #f #f 5 0))
-(define effect_2526
+(define effect_2327
   (struct-type-install-properties!
    struct:commit-request
    'commit-request
@@ -7515,7 +7515,7 @@
     (void)))
 (define struct:commit-response
   (make-record-type-descriptor* 'commit-response #f #f #f #f 2 0))
-(define effect_2717
+(define effect_2424
   (struct-type-install-properties!
    struct:commit-response
    'commit-response
@@ -7850,7 +7850,7 @@
    #f
    2
    3))
-(define effect_2490
+(define effect_2713
   (struct-type-install-properties!
    struct:commit-input-port
    'commit-input-port
@@ -7916,7 +7916,7 @@
    #f
    0
    0))
-(define effect_2304
+(define effect_2628
   (struct-type-install-properties!
    struct:commit-input-port-methods.1
    'commit-input-port-methods
@@ -8089,7 +8089,7 @@
              (unsafe-end-atomic))))))))
 (define struct:pipe-data
   (make-record-type-descriptor* 'pipe-data #f #f #f #f 16 65534))
-(define effect_2355
+(define effect_3136
   (struct-type-install-properties!
    struct:pipe-data
    'pipe-data
@@ -8268,7 +8268,7 @@
     (void)))
 (define struct:pipe-data-methods.1
   (make-record-type-descriptor* 'pipe-data-methods #f #f #f #f 0 0))
-(define effect_2017
+(define effect_2891
   (struct-type-install-properties!
    struct:pipe-data-methods.1
    'pipe-data-methods
@@ -8407,7 +8407,7 @@
    #f
    1
    1))
-(define effect_2673
+(define effect_2367
   (struct-type-install-properties!
    struct:pipe-input-port
    'pipe-input-port
@@ -8453,7 +8453,7 @@
    #f
    0
    0))
-(define effect_2740
+(define effect_2379
   (struct-type-install-properties!
    struct:pipe-input-port-methods.1
    'pipe-input-port-methods
@@ -8828,7 +8828,7 @@
    #f
    1
    1))
-(define effect_2583
+(define effect_2458
   (struct-type-install-properties!
    struct:pipe-output-port
    'pipe-output-port
@@ -8854,7 +8854,7 @@
   (|#%name|
    set-pipe-output-port-d!
    (record-mutator struct:pipe-output-port 0)))
-(define effect_2379
+(define effect_2380
   (begin
     (register-struct-constructor! create-pipe-output-port)
     (register-struct-predicate! pipe-output-port?)
@@ -8876,7 +8876,7 @@
    #f
    0
    0))
-(define effect_2521
+(define effect_2137
   (struct-type-install-properties!
    struct:pipe-output-port-methods.1
    'pipe-output-port-methods
@@ -9420,7 +9420,7 @@
       ((limit24_0) (make-pipe_0 limit24_0 'pipe 'pipe))))))
 (define struct:pipe-write-poller
   (make-record-type-descriptor* 'pipe-write-poller #f #f #f #f 1 0))
-(define effect_2289
+(define effect_2371
   (struct-type-install-properties!
    struct:pipe-write-poller
    'pipe-write-poller
@@ -9507,7 +9507,7 @@
     (void)))
 (define struct:pipe-read-poller
   (make-record-type-descriptor* 'pipe-read-poller #f #f #f #f 1 0))
-(define effect_2446
+(define effect_2394
   (struct-type-install-properties!
    struct:pipe-read-poller
    'pipe-read-poller
@@ -9602,7 +9602,7 @@
    #f
    5
    31))
-(define effect_1948
+(define effect_2246
   (struct-type-install-properties!
    struct:peek-via-read-input-port
    'peek-via-read-input-port
@@ -9721,7 +9721,7 @@
    #f
    1
    0))
-(define effect_2315
+(define effect_2651
   (struct-type-install-properties!
    struct:peek-via-read-input-port-methods.1
    'peek-via-read-input-port-methods
@@ -10438,7 +10438,7 @@
    #f
    3
    7))
-(define effect_2291
+(define effect_2504
   (struct-type-install-properties!
    struct:fd-input-port
    'fd-input-port
@@ -10518,7 +10518,7 @@
    #f
    2
    0))
-(define effect_2561
+(define effect_2334
   (struct-type-install-properties!
    struct:fd-input-port-methods.1
    'fd-input-port-methods
@@ -10784,7 +10784,7 @@
    #f
    8
    255))
-(define effect_2417
+(define effect_2781
   (struct-type-install-properties!
    struct:fd-output-port
    'fd-output-port
@@ -10962,7 +10962,7 @@
    #f
    2
    0))
-(define effect_2541
+(define effect_2413
   (struct-type-install-properties!
    struct:fd-output-port-methods.1
    'fd-output-port-methods
@@ -11587,7 +11587,7 @@
                 (|#%app| exn:fail app_0 (current-continuation-marks)))))))
         (void)))))
 (define struct:fd-evt (make-record-type-descriptor* 'fd-evt #f #f #f #f 3 4))
-(define effect_2836
+(define effect_2590
   (struct-type-install-properties!
    struct:fd-evt
    'fd-evt
@@ -11732,7 +11732,7 @@
     (void)))
 (define struct:rktio-fd-flushed-evt
   (make-record-type-descriptor* 'rktio-fd-flushed-evt #f #f #f #f 1 0))
-(define effect_2592
+(define effect_2959
   (struct-type-install-properties!
    struct:rktio-fd-flushed-evt
    'rktio-fd-flushed-evt
@@ -12547,7 +12547,7 @@
                  (loop_0 pos_0))))))))))
 (define struct:progress-evt
   (make-record-type-descriptor* 'progress-evt #f #f #f #f 2 0))
-(define effect_2476
+(define effect_2604
   (struct-type-install-properties!
    struct:progress-evt
    'progress-evt
@@ -15865,7 +15865,7 @@
         (unsafe-bytes-set! out-bstr_0 (+ j_0 1) hi_0)))))
 (define struct:utf-8-converter
   (make-record-type-descriptor* 'utf-8-converter #f #f #f #f 2 0))
-(define effect_2497
+(define effect_2723
   (struct-type-install-properties!
    struct:utf-8-converter
    'utf-8-converter
@@ -16894,7 +16894,7 @@
           out-start23_0))))))
 (define struct:bytes-converter
   (make-record-type-descriptor* 'bytes-converter #f #f #f #f 2 3))
-(define effect_2305
+(define effect_2529
   (struct-type-install-properties!
    struct:bytes-converter
    'bytes-converter
@@ -17798,7 +17798,7 @@
               (void)))
           (check-not-unsafe-undefined bstr_0 'bstr_119))))))
 (define struct:cache (make-record-type-descriptor* 'cache #f #f #f #f 4 15))
-(define effect_2033
+(define effect_2666
   (struct-type-install-properties!
    struct:cache
    'cache
@@ -18172,7 +18172,7 @@
       ((in-bstr_0 err-char5_0)
        (bytes->string/locale_0 in-bstr_0 err-char5_0 0 unsafe-undefined))))))
 (define struct:path (make-record-type-descriptor* 'path #f #f #f #f 2 0))
-(define effect_3031
+(define effect_2407
   (struct-type-install-properties!
    struct:path
    'path
@@ -19506,7 +19506,7 @@
    #f
    3
    7))
-(define effect_2217
+(define effect_2730
   (struct-type-install-properties!
    struct:bytes-input-port
    'bytes-input-port
@@ -19584,7 +19584,7 @@
    #f
    0
    0))
-(define effect_2813
+(define effect_2624
   (struct-type-install-properties!
    struct:bytes-input-port-methods.1
    'bytes-input-port-methods
@@ -19820,7 +19820,7 @@
    #f
    3
    7))
-(define effect_2227
+(define effect_2717
   (struct-type-install-properties!
    struct:bytes-output-port
    'bytes-output-port
@@ -19902,7 +19902,7 @@
    #f
    2
    0))
-(define effect_3566
+(define effect_2372
   (struct-type-install-properties!
    struct:bytes-output-port-methods.1
    'bytes-output-port-methods
@@ -20367,7 +20367,7 @@
    #f
    2
    3))
-(define effect_2220
+(define effect_3238
   (struct-type-install-properties!
    struct:max-output-port
    'max-output-port
@@ -20429,7 +20429,7 @@
    #f
    0
    0))
-(define effect_2319
+(define effect_2860
   (struct-type-install-properties!
    struct:max-output-port-methods.1
    'max-output-port-methods
@@ -21383,7 +21383,7 @@
    #f
    0
    0))
-(define effect_2619
+(define effect_2671
   (struct-type-install-properties!
    struct:nowhere-output-port
    'nowhere-output-port
@@ -21419,7 +21419,7 @@
    #f
    0
    0))
-(define effect_2409
+(define effect_2396
   (struct-type-install-properties!
    struct:nowhere-output-port-methods.1
    'nowhere-output-port-methods
@@ -21729,7 +21729,7 @@
       (quick-no-graph?_0 config_0 mode_0 print-graph?_0 v_0 fuel_0))))
 (define struct:as-constructor
   (make-record-type-descriptor* 'as-constructor #f #f #f #f 1 0))
-(define effect_2345
+(define effect_2971
   (struct-type-install-properties!
    struct:as-constructor
    'as-constructor
@@ -25012,7 +25012,7 @@
             #f))))))
 (define struct:starting-point
   (make-record-type-descriptor* 'starting-point #f #f #f #f 7 0))
-(define effect_2228
+(define effect_2720
   (struct-type-install-properties!
    struct:starting-point
    'starting-point
@@ -27113,7 +27113,7 @@
   (lambda (v_0) (if (fixnum? v_0) (<= 0 v_0 65535) #f)))
 (define struct:security-guard
   (make-record-type-descriptor* 'security-guard #f #f #f #f 4 0))
-(define effect_2643
+(define effect_2690
   (struct-type-install-properties!
    struct:security-guard
    'security-guard
@@ -31536,7 +31536,7 @@
            (current-directory$1))
          '()
          hash2725)))))
-(define effect_2316
+(define effect_2315
   (begin (void (begin-unsafe (set! simplify-path/dl 1/simplify-path))) (void)))
 (define bytes-no-nuls?
   (lambda (s_0)
@@ -31583,7 +31583,7 @@
       k_0)))
 (define struct:environment-variables
   (make-record-type-descriptor* 'environment-variables #f #f #f #f 1 1))
-(define effect_2491
+(define effect_2652
   (struct-type-install-properties!
    struct:environment-variables
    'environment-variables
@@ -33366,7 +33366,7 @@
   (lambda (p_0) (if (is-path? p_0) (relative-to-user-directory p_0) p_0)))
 (define struct:logger
   (make-record-type-descriptor* 'logger #f #f #f #f 11 376))
-(define effect_2358
+(define effect_2192
   (struct-type-install-properties!
    struct:logger
    'logger
@@ -33873,7 +33873,7 @@
 (define level->user-representation
   (lambda (lvl_0) (if (eq? lvl_0 'none) #f lvl_0)))
 (define struct:queue (make-record-type-descriptor* 'queue #f #f #f #f 2 3))
-(define effect_3001
+(define effect_2520
   (struct-type-install-properties!
    struct:queue
    'queue
@@ -33908,7 +33908,7 @@
     (register-struct-field-mutator! set-queue-end! struct:queue 1)
     (void)))
 (define struct:node (make-record-type-descriptor* 'node #f #f #f #f 3 6))
-(define effect_2107
+(define effect_2547
   (struct-type-install-properties!
    struct:node
    'node
@@ -33975,7 +33975,7 @@
         (set-queue-end! q_0 (node-prev n_0))))))
 (define struct:log-receiver
   (make-record-type-descriptor* 'log-receiver #f #f #f #f 1 0))
-(define effect_1970
+(define effect_2708
   (struct-type-install-properties!
    struct:log-receiver
    'log-receiver
@@ -34042,7 +34042,7 @@
    #f
    3
    0))
-(define effect_3157
+(define effect_2757
   (struct-type-install-properties!
    struct:queue-log-receiver
    'log-receiver
@@ -34174,7 +34174,7 @@
          s
          'log-receiver
          'backref))))))
-(define effect_2529
+(define effect_2530
   (begin
     (register-struct-constructor! queue-log-receiver2.1)
     (register-struct-predicate! queue-log-receiver?)
@@ -34236,7 +34236,7 @@
    #f
    2
    0))
-(define effect_2067
+(define effect_2592
   (struct-type-install-properties!
    struct:stdio-log-receiver
    'stdio-log-receiver
@@ -34395,7 +34395,7 @@
    #f
    2
    0))
-(define effect_2311
+(define effect_2241
   (struct-type-install-properties!
    struct:syslog-log-receiver
    'syslog-log-receiver
@@ -35395,7 +35395,7 @@
           (void))))))
 (define struct:fs-change-evt
   (make-record-type-descriptor* 'filesystem-change-evt #f #f #f #f 2 3))
-(define effect_2451
+(define effect_2322
   (struct-type-install-properties!
    struct:fs-change-evt
    'filesystem-change-evt
@@ -35697,7 +35697,7 @@
            (unsafe-place-local-ref cell.1)
            rfc_0))
         (void)))))
-(define effect_2390
+(define effect_2149
   (begin
     (void
      (|#%app|
@@ -35918,7 +35918,7 @@
                   (begin (|#%app| final_0 p_0 bstr_0) bstr_0))))))))))
 (define struct:subprocess
   (make-record-type-descriptor* 'subprocess #f #f #f #f 3 3))
-(define effect_2587
+(define effect_2272
   (struct-type-install-properties!
    struct:subprocess
    'subprocess
@@ -36054,7 +36054,7 @@
          v
          'subprocess
          'cust-ref))))))
-(define effect_2666
+(define effect_2667
   (begin
     (register-struct-constructor! make-subprocess)
     (register-struct-predicate! 1/subprocess?)
@@ -36820,7 +36820,7 @@
    #f
    1
    1))
-(define effect_2403
+(define effect_2432
   (struct-type-install-properties!
    struct:tcp-input-port
    'tcp-input-port
@@ -36874,7 +36874,7 @@
    #f
    0
    0))
-(define effect_2480
+(define effect_2838
   (struct-type-install-properties!
    struct:tcp-input-port-methods.1
    'tcp-input-port-methods
@@ -37014,7 +37014,7 @@
    #f
    1
    1))
-(define effect_2128
+(define effect_2320
   (struct-type-install-properties!
    struct:tcp-output-port
    'tcp-output-port
@@ -37070,7 +37070,7 @@
    #f
    0
    0))
-(define effect_2961
+(define effect_2727
   (struct-type-install-properties!
    struct:tcp-output-port-methods.1
    'tcp-output-port-methods
@@ -37224,7 +37224,7 @@
              (void))))))))
 (define struct:rktio-evt
   (make-record-type-descriptor* 'rktio-evt #f #f #f #f 2 0))
-(define effect_2172
+(define effect_3001
   (struct-type-install-properties!
    struct:rktio-evt
    'rktio-evt
@@ -37260,7 +37260,7 @@
   (|#%name| rktio-evt-poll (record-accessor struct:rktio-evt 0)))
 (define rktio-evt-add-to-poll-set
   (|#%name| rktio-evt-add-to-poll-set (record-accessor struct:rktio-evt 1)))
-(define effect_2396
+(define effect_2398
   (begin
     (register-struct-constructor! rktio-evt1.1)
     (register-struct-predicate! rktio-evt?)
@@ -37419,7 +37419,7 @@
   (lambda () (unsafe-place-local-set! cell.1$3 (make-will-executor))))
 (define struct:connect-progress
   (make-record-type-descriptor* 'connect-progress #f #f #f #f 2 3))
-(define effect_2584
+(define effect_2403
   (struct-type-install-properties!
    struct:connect-progress
    'connect-progress
@@ -37842,7 +37842,7 @@
         (void)))))
 (define struct:tcp-listener
   (make-record-type-descriptor* 'tcp-listener #f #f #f #f 3 0))
-(define effect_2591
+(define effect_2611
   (struct-type-install-properties!
    struct:tcp-listener
    'tcp-listener
@@ -38240,7 +38240,7 @@
          (accept-evt6.1 listener_0))))))
 (define struct:accept-evt
   (make-record-type-descriptor* 'tcp-accept-evt #f #f #f #f 1 0))
-(define effect_2505
+(define effect_2325
   (struct-type-install-properties!
    struct:accept-evt
    'tcp-accept-evt
@@ -38351,7 +38351,7 @@
          s
          'tcp-accept-evt
          'listener))))))
-(define effect_2644
+(define effect_2643
   (begin
     (register-struct-constructor! accept-evt6.1)
     (register-struct-predicate! accept-evt?)
@@ -38409,7 +38409,7 @@
           (for-loop_0 0 0))))
       (args (raise-binding-result-arity-error 2 args))))))
 (define struct:udp (make-record-type-descriptor* 'udp #f #f #f #f 3 7))
-(define effect_2493
+(define effect_2368
   (struct-type-install-properties!
    struct:udp
    'udp
@@ -39618,7 +39618,7 @@
             who59_0)))))))
 (define struct:udp-sending-evt
   (make-record-type-descriptor* 'udp-send-evt #f #f #f #f 2 0))
-(define effect_2756
+(define effect_2358
   (struct-type-install-properties!
    struct:udp-sending-evt
    'udp-send-evt
@@ -39687,7 +39687,7 @@
    #f
    0
    0))
-(define effect_2742
+(define effect_3039
   (struct-type-install-properties!
    struct:udp-sending-ready-evt
    'udp-send-ready-evt
@@ -40040,7 +40040,7 @@
 (define cell.2 (unsafe-make-place-local ""))
 (define struct:udp-receiving-evt
   (make-record-type-descriptor* 'udp-receive-evt #f #f #f #f 2 0))
-(define effect_2560
+(define effect_2355
   (struct-type-install-properties!
    struct:udp-receiving-evt
    'udp-receive-evt
@@ -40114,7 +40114,7 @@
    #f
    0
    0))
-(define effect_2331
+(define effect_2341
   (struct-type-install-properties!
    struct:udp-receiving-ready-evt
    'udp-receive-ready-evt
diff --git a/racket/src/cs/schemified/schemify.scm b/racket/src/cs/schemified/schemify.scm
index 2228b06499..4223cb48b5 100644
--- a/racket/src/cs/schemified/schemify.scm
+++ b/racket/src/cs/schemified/schemify.scm
@@ -7288,7 +7288,57 @@
     (void)))
 (define struct-type-info-rest-properties-list-pos 0)
 (define make-struct-type-info
-  (letrec ((includes-property?_0
+  (letrec ((handle-proc-spec_0
+            (|#%name|
+             handle-proc-spec
+             (lambda (imports_0
+                      knowns_0
+                      mutated_0
+                      prim-knowns_0
+                      proc-spec_0
+                      imms_0)
+               (begin
+                 (if (not proc-spec_0)
+                   imms_0
+                   (if (exact-nonnegative-integer? proc-spec_0)
+                     (cons proc-spec_0 imms_0)
+                     (let ((proc-spec_1 (unwrap proc-spec_0)))
+                       (if (symbol? proc-spec_1)
+                         (let ((k_0
+                                (begin-unsafe
+                                 (call-with-values
+                                  (lambda ()
+                                    (find-known+import
+                                     proc-spec_1
+                                     prim-knowns_0
+                                     knowns_0
+                                     imports_0
+                                     mutated_0))
+                                  (case-lambda
+                                   ((k_0 im_0) k_0)
+                                   (args
+                                    (raise-binding-result-arity-error
+                                     2
+                                     args)))))))
+                           (if (not k_0)
+                             #f
+                             (if (known-literal? k_0)
+                               (let ((v_0 (known-literal-value k_0)))
+                                 (if (let ((or-part_0 (not v_0)))
+                                       (if or-part_0
+                                         or-part_0
+                                         (exact-nonnegative-integer? v_0)))
+                                   (handle-proc-spec_0
+                                    imports_0
+                                    knowns_0
+                                    mutated_0
+                                    prim-knowns_0
+                                    v_0
+                                    imms_0)
+                                   #f))
+                               (if (known-procedure? k_0) imms_0 #f))))
+                         #f))))))))
+           (includes-property?_0
             (|#%name|
              includes-property?
              (lambda (rest_0 name_0)
@@ -8089,7 +8139,27 @@
                                                                     #f)))
                                                               #f)))
                                                         #f))
-                                                  '()
+                                                  (let ((proc-spec_0
+                                                         (let ((d_0
+                                                                (cdr
+                                                                 (unwrap
+                                                                  rest_0))))
+                                                           (let ((d_1
+                                                                  (cdr
+                                                                   (unwrap
+                                                                    d_0))))
+                                                             (let ((a_0
+                                                                    (car
+                                                                     (unwrap
+                                                                      d_1))))
+                                                               a_0)))))
+                                                    (handle-proc-spec_0
+                                                     imports_0
+                                                     knowns_0
+                                                     mutated_0
+                                                     prim-knowns_0
+                                                     proc-spec_0
+                                                     '()))
                                                   (if (let ((p_0
                                                              (unwrap rest_0)))
                                                         (if (pair? p_0)
@@ -8162,33 +8232,60 @@
                                                                       #f)))
                                                                 #f)))
                                                           #f))
-                                                    (let ((immutables_0
-                                                           (let ((d_0
-                                                                  (cdr
-                                                                   (unwrap
-                                                                    rest_0))))
-                                                             (let ((d_1
-                                                                    (cdr
-                                                                     (unwrap
-                                                                      d_0))))
-                                                               (let ((d_2
-                                                                      (cdr
-                                                                       (unwrap
-                                                                        d_1))))
-                                                                 (let ((a_0
-                                                                        (car
-                                                                         (unwrap
-                                                                          d_2))))
-                                                                   (let ((d_3
-                                                                          (cdr
-                                                                           (unwrap
-                                                                            a_0))))
-                                                                     (let ((a_1
-                                                                            (car
-                                                                             (unwrap
-                                                                              d_3))))
-                                                                       a_1))))))))
-                                                      immutables_0)
+                                                    (call-with-values
+                                                     (lambda ()
+                                                       (let ((d_0
+                                                              (cdr
+                                                               (unwrap
+                                                                rest_0))))
+                                                         (let ((d_1
+                                                                (cdr
+                                                                 (unwrap
+                                                                  d_0))))
+                                                           (let ((p_0
+                                                                  (unwrap
+                                                                   d_1)))
+                                                             (let ((proc-spec_0
+                                                                    (let ((a_0
+                                                                           (car
+                                                                            p_0)))
+                                                                      a_0)))
+                                                               (let ((immutables_0
+                                                                      (let ((d_2
+                                                                             (cdr
+                                                                              p_0)))
+                                                                        (let ((a_0
+                                                                               (car
+                                                                                (unwrap
+                                                                                 d_2))))
+                                                                          (let ((d_3
+                                                                                 (cdr
+                                                                                  (unwrap
+                                                                                   a_0))))
+                                                                            (let ((a_1
+                                                                                   (car
+                                                                                    (unwrap
+                                                                                     d_3))))
+                                                                              a_1))))))
+                                                                 (let ((proc-spec_1
+                                                                        proc-spec_0))
+                                                                   (values
+                                                                    proc-spec_1
+                                                                    immutables_0))))))))
+                                                     (case-lambda
+                                                      ((proc-spec_0
+                                                        immutables_0)
+                                                       (handle-proc-spec_0
+                                                        imports_0
+                                                        knowns_0
+                                                        mutated_0
+                                                        prim-knowns_0
+                                                        proc-spec_0
+                                                        immutables_0))
+                                                      (args
+                                                       (raise-binding-result-arity-error
+                                                        2
+                                                        args))))
                                                     #f)))))
                                           #f)))
                                    (if (if (eq? prefab-imms_1 'non-prefab)
diff --git a/racket/src/schemify/struct-type-info.rkt b/racket/src/schemify/struct-type-info.rkt
index 8083ff1d95..427345bbcc 100644
--- a/racket/src/schemify/struct-type-info.rkt
+++ b/racket/src/schemify/struct-type-info.rkt
@@ -60,6 +60,23 @@
                         (for/or ([prop (in-list props)])
                           (eq? (unwrap prop) name))]
                        [`,_ #f])))
+              (define (handle-proc-spec proc-spec imms)
+                (cond
+                  [(not proc-spec) imms]
+                  [(exact-nonnegative-integer? proc-spec) (cons proc-spec imms)]
+                  [else
+                   (let ([proc-spec (unwrap proc-spec)])
+                     (and
+                      (symbol? proc-spec)
+                      (let ([k (find-known proc-spec prim-knowns knowns imports mutated)])
+                        (cond
+                          [(not k) #f]
+                          [(known-literal? k)
+                           (let ([v (known-literal-value k)])
+                             (and (or (not v) (exact-nonnegative-integer? v))
+                                  (handle-proc-spec v imms)))]
+                          [(known-procedure? k) imms]
+                          [else #f]))))]))
               (define constructor-name-expr (and ((length rest) . > . 5)
                                                  (list-ref rest 5)))
               (define non-prefab-imms
@@ -68,8 +85,10 @@
                        [`() '()]
                        [`(,_) '()]
                        [`(,_ ,_) '()]
-                       [`(,_ ,_ ,_) '()]
-                       [`(,_ ,_ ,_ ',immutables . ,_) immutables]
+                       [`(,_ ,_ ,proc-spec)
+                        (handle-proc-spec proc-spec '())]
+                       [`(,_ ,_ ,proc-spec ',immutables . ,_)
+                        (handle-proc-spec proc-spec immutables)]
                        [`,_ #f])))
               (and (if (eq? prefab-imms 'non-prefab)
                        non-prefab-imms