suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs: use nongenerative records in core

Browse Source
This commit is contained in:
Matthew Flatt 2020-12-30 14:22:52 -07:00
parent e604c2deb9
commit 23300fd18d
13 changed files with 1876 additions and 290 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
racket/src/bc/src/startup.inc
View File

@ -20890,6 +20890,7 @@ static const char *startup_source =
" #%struct-predicate"
" #%struct-field-accessor"
" #%struct-field-mutator"
" #%nongenerative-uid"
" unsafe-struct?"
" unsafe-struct"
" raise-binding-result-arity-error"

2
racket/src/cs/compile-file.ss
View File

@ -2,7 +2,7 @@
;; Check to make we're using a build of Chez Scheme
;; that has all the features we need.
(define-values (need-maj need-min need-sub need-dev)
(values 9 5 3 57))
(values 9 5 3 58))
(unless (guard (x [else #f]) (eval 'scheme-fork-version-number))
(error 'compile-file

1
racket/src/cs/primitive/internal.ss
View File

@ -19,6 +19,7 @@
[|#%struct-predicate| (known-constant)]
[|#%struct-field-accessor| (known-constant)]
[|#%struct-field-mutator| (known-constant)]
[|#%nongenerative-uid| (known-constant)]
[make-record-type-descriptor (known-constant)]
[make-record-type-descriptor* (known-constant)]
[make-record-constructor-descriptor (known-constant)]

1
racket/src/cs/rumble.sls
View File

@ -227,6 +227,7 @@
|#%struct-predicate| ; not exported to Racket
|#%struct-field-accessor| ; not exported to Racket
|#%struct-field-mutator| ; not exported to Racket
|#%nongenerative-uid| ; not exported to Racket
struct-property-set! ; not exported to Racket
struct-constructor-procedure?
struct-predicate-procedure?

5
racket/src/cs/rumble/struct.ss
View File

@ -460,6 +460,11 @@
(position-based-mutator-rtd v))
(wrapper-procedure-data v)))
(define-syntax (|#%nongenerative-uid| stx)
(syntax-case stx ()
[(_ name) #`(quote #,(datum->syntax #'name ((current-generate-id) (datum name))))]
[else #'#f]))
;; ----------------------------------------
;; General structure-type creation, but not called when a `schemify`

988
racket/src/cs/schemified/expander.scm
View File

File diff suppressed because it is too large Load Diff

409
racket/src/cs/schemified/io.scm
View File

@ -3589,7 +3589,15 @@
(|#%app| rktio_free h_0)
(loop_0 #t))))))))))
(loop_0 #f))))))
(define struct:exts (make-record-type-descriptor* 'exts #f #f #f #f 2 0))
(define struct:exts
(make-record-type-descriptor*
'exts
#f
(|#%nongenerative-uid| exts)
#f
#f
2
0))
(define effect_2383
(struct-type-install-properties!
struct:exts
@ -3875,7 +3883,14 @@
(wrap-evt (|#%app| (input-port-evt-ref p_0) p_0) (lambda (v_0) p_0))
(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))
(make-record-type-descriptor*
'core-port
#f
(|#%nongenerative-uid| core-port)
#f
#f
7
124))
(define effect_2716
(struct-type-install-properties!
struct:core-port
@ -3924,7 +3939,14 @@
(define set-core-port-count!
(|#%name| set-core-port-count! (record-mutator struct:core-port 6)))
(define struct:core-port-methods.1
(make-record-type-descriptor* 'core-port-methods #f #f #f #f 5 0))
(make-record-type-descriptor*
'core-port-methods
#f
(|#%nongenerative-uid| core-port-methods)
#f
#f
5
0))
(define effect_2750
(struct-type-install-properties!
struct:core-port-methods.1
@ -4052,7 +4074,15 @@
#f
#f
#f))
(define struct:direct (make-record-type-descriptor* 'direct #f #f #f #f 3 7))
(define struct:direct
(make-record-type-descriptor*
'direct
#f
(|#%nongenerative-uid| direct)
#f
#f
3
7))
(define effect_3200
(struct-type-install-properties!
struct:direct
@ -4082,7 +4112,14 @@
(define set-direct-end!
(|#%name| set-direct-end! (record-mutator struct:direct 2)))
(define struct:location
(make-record-type-descriptor* 'location #f #f #f #f 5 31))
(make-record-type-descriptor*
'location
#f
(|#%nongenerative-uid| location)
#f
#f
5
31))
(define effect_2872
(struct-type-install-properties!
struct:location
@ -4185,7 +4222,7 @@
(make-record-type-descriptor*
'core-input-port
struct:core-port
#f
(|#%nongenerative-uid| core-input-port)
#f
#f
2
@ -4260,7 +4297,7 @@
(make-record-type-descriptor*
'core-input-port-methods
struct:core-port-methods.1
#f
(|#%nongenerative-uid| core-input-port-methods)
#f
#f
6
@ -4504,7 +4541,7 @@
(make-record-type-descriptor*
'core-output-port
struct:core-port
#f
(|#%nongenerative-uid| core-output-port)
#f
#f
4
@ -4580,7 +4617,7 @@
(make-record-type-descriptor*
'core-output-port-methods
struct:core-port-methods.1
#f
(|#%nongenerative-uid| core-output-port-methods)
#f
#f
4
@ -4748,7 +4785,14 @@
(values #f (replace-evt v_0 self-evt_0))
(values (list v_0) #f)))))))))
(define struct:write-evt
(make-record-type-descriptor* 'write-evt #f #f #f #f 1 0))
(make-record-type-descriptor*
'write-evt
#f
(|#%nongenerative-uid| write-evt)
#f
#f
1
0))
(define effect_2681
(struct-type-install-properties!
struct:write-evt
@ -4813,7 +4857,14 @@
#f
#f))
(define struct:utf-8-state
(make-record-type-descriptor* 'utf-8-state #f #f #f #f 3 0))
(make-record-type-descriptor*
'utf-8-state
#f
(|#%nongenerative-uid| utf-8-state)
#f
#f
3
0))
(define effect_2417
(struct-type-install-properties!
struct:utf-8-state
@ -6633,7 +6684,14 @@
(set-core-port-offset! in_0 (+ amt_0 old-offset_0))
(void))))))
(define struct:commit-manager
(make-record-type-descriptor* 'commit-manager #f #f #f #f 3 0))
(make-record-type-descriptor*
'commit-manager
#f
(|#%nongenerative-uid| commit-manager)
#f
#f
3
0))
(define effect_3024
(struct-type-install-properties!
struct:commit-manager
@ -6717,7 +6775,14 @@
'commit-manager
'thread))))))
(define struct:commit-request
(make-record-type-descriptor* 'commit-request #f #f #f #f 5 0))
(make-record-type-descriptor*
'commit-request
#f
(|#%nongenerative-uid| commit-request)
#f
#f
5
0))
(define effect_2327
(struct-type-install-properties!
struct:commit-request
@ -6835,7 +6900,14 @@
'commit-request
'result-ch))))))
(define struct:commit-response
(make-record-type-descriptor* 'commit-response #f #f #f #f 2 0))
(make-record-type-descriptor*
'commit-response
#f
(|#%nongenerative-uid| commit-response)
#f
#f
2
0))
(define effect_2424
(struct-type-install-properties!
struct:commit-response
@ -7149,7 +7221,7 @@
(make-record-type-descriptor*
'commit-input-port
struct:core-input-port
#f
(|#%nongenerative-uid| commit-input-port)
#f
#f
2
@ -7194,7 +7266,7 @@
(make-record-type-descriptor*
'commit-input-port-methods
struct:core-input-port-methods.1
#f
(|#%nongenerative-uid| commit-input-port-methods)
#f
#f
0
@ -7366,7 +7438,14 @@
(begin (temp3.1$3 d_0) (temp4.1$2 d_0))
(unsafe-end-atomic))))))))
(define struct:pipe-data
(make-record-type-descriptor* 'pipe-data #f #f #f #f 16 65534))
(make-record-type-descriptor*
'pipe-data
#f
(|#%nongenerative-uid| pipe-data)
#f
#f
16
65534))
(define effect_3136
(struct-type-install-properties!
struct:pipe-data
@ -7461,7 +7540,14 @@
set-pipe-data-write-ready-evt!
(record-mutator struct:pipe-data 15)))
(define struct:pipe-data-methods.1
(make-record-type-descriptor* 'pipe-data-methods #f #f #f #f 0 0))
(make-record-type-descriptor*
'pipe-data-methods
#f
(|#%nongenerative-uid| pipe-data-methods)
#f
#f
0
0))
(define effect_2891
(struct-type-install-properties!
struct:pipe-data-methods.1
@ -7591,7 +7677,7 @@
(make-record-type-descriptor*
'pipe-input-port
struct:commit-input-port
#f
(|#%nongenerative-uid| pipe-input-port)
#f
#f
1
@ -7624,7 +7710,7 @@
(make-record-type-descriptor*
'pipe-input-port-methods
struct:commit-input-port-methods.1
#f
(|#%nongenerative-uid| pipe-input-port-methods)
#f
#f
0
@ -7987,7 +8073,7 @@
(make-record-type-descriptor*
'pipe-output-port
struct:core-output-port
#f
(|#%nongenerative-uid| pipe-output-port)
#f
#f
1
@ -8022,7 +8108,7 @@
(make-record-type-descriptor*
'pipe-output-port-methods
struct:core-output-port-methods.1
#f
(|#%nongenerative-uid| pipe-output-port-methods)
#f
#f
0
@ -8596,7 +8682,14 @@
((limit_0 input-name25_0) (make-pipe_0 limit_0 input-name25_0 'pipe))
((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))
(make-record-type-descriptor*
'pipe-write-poller
#f
(|#%nongenerative-uid| pipe-write-poller)
#f
#f
1
0))
(define effect_2371
(struct-type-install-properties!
struct:pipe-write-poller
@ -8674,7 +8767,14 @@
'pipe-write-poller
'd))))))
(define struct:pipe-read-poller
(make-record-type-descriptor* 'pipe-read-poller #f #f #f #f 1 0))
(make-record-type-descriptor*
'pipe-read-poller
#f
(|#%nongenerative-uid| pipe-read-poller)
#f
#f
1
0))
(define effect_2439
(struct-type-install-properties!
struct:pipe-read-poller
@ -8755,7 +8855,7 @@
(make-record-type-descriptor*
'peek-via-read-input-port
struct:commit-input-port
#f
(|#%nongenerative-uid| peek-via-read-input-port)
#f
#f
5
@ -8829,7 +8929,7 @@
(make-record-type-descriptor*
'peek-via-read-input-port-methods
struct:commit-input-port-methods.1
#f
(|#%nongenerative-uid| peek-via-read-input-port-methods)
#f
#f
1
@ -9535,7 +9635,7 @@
(make-record-type-descriptor*
'fd-input-port
struct:peek-via-read-input-port
#f
(|#%nongenerative-uid| fd-input-port)
#f
#f
3
@ -9589,7 +9689,7 @@
(make-record-type-descriptor*
'fd-input-port-methods
struct:peek-via-read-input-port-methods.1
#f
(|#%nongenerative-uid| fd-input-port-methods)
#f
#f
2
@ -9843,7 +9943,7 @@
(make-record-type-descriptor*
'fd-output-port
struct:core-output-port
#f
(|#%nongenerative-uid| fd-output-port)
#f
#f
8
@ -9955,7 +10055,7 @@
(make-record-type-descriptor*
'fd-output-port-methods
struct:core-output-port-methods.1
#f
(|#%nongenerative-uid| fd-output-port-methods)
#f
#f
2
@ -10552,7 +10652,15 @@
(format-rktio-message 'file-position r_0 base-msg_0)))
(|#%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 struct:fd-evt
(make-record-type-descriptor*
'fd-evt
#f
(|#%nongenerative-uid| fd-evt)
#f
#f
3
4))
(define effect_2551
(struct-type-install-properties!
struct:fd-evt
@ -10684,7 +10792,14 @@
'fd-evt
'closed))))))
(define struct:rktio-fd-flushed-evt
(make-record-type-descriptor* 'rktio-fd-flushed-evt #f #f #f #f 1 0))
(make-record-type-descriptor*
'rktio-fd-flushed-evt
#f
(|#%nongenerative-uid| rktio-fd-flushed-evt)
#f
#f
1
0))
(define effect_2495
(struct-type-install-properties!
struct:rktio-fd-flushed-evt
@ -11469,7 +11584,14 @@
(loop_0 (fx+ i_0 1)))))))))))
(loop_0 pos_0))))))))))
(define struct:progress-evt
(make-record-type-descriptor* 'progress-evt #f #f #f #f 2 0))
(make-record-type-descriptor*
'progress-evt
#f
(|#%nongenerative-uid| progress-evt)
#f
#f
2
0))
(define effect_2813
(struct-type-install-properties!
struct:progress-evt
@ -14785,7 +14907,14 @@
(unsafe-bytes-set! out-bstr_0 j_0 lo_0)
(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))
(make-record-type-descriptor*
'utf-8-converter
#f
(|#%nongenerative-uid| utf-8-converter)
#f
#f
2
0))
(define effect_2723
(struct-type-install-properties!
struct:utf-8-converter
@ -15712,7 +15841,14 @@
(continue_0 v_0 (+ i_0 2)))))))))))))))
(loop_0 in-start20_0 out-start23_0))))))
(define struct:bytes-converter
(make-record-type-descriptor* 'bytes-converter #f #f #f #f 2 3))
(make-record-type-descriptor*
'bytes-converter
#f
(|#%nongenerative-uid| bytes-converter)
#f
#f
2
3))
(define effect_2529
(struct-type-install-properties!
struct:bytes-converter
@ -16581,7 +16717,15 @@
(args (raise-binding-result-arity-error 4 args))))
(void)))
(check-not-unsafe-undefined bstr_0 'bstr_119))))))
(define struct:cache (make-record-type-descriptor* 'cache #f #f #f #f 4 15))
(define struct:cache
(make-record-type-descriptor*
'cache
#f
(|#%nongenerative-uid| cache)
#f
#f
4
15))
(define effect_2666
(struct-type-install-properties!
struct:cache
@ -16947,7 +17091,15 @@
(bytes->string/locale_0 in-bstr_0 err-char_0 start6_0 unsafe-undefined))
((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 struct:path
(make-record-type-descriptor*
'path
#f
(|#%nongenerative-uid| path)
#f
#f
2
0))
(define effect_2481
(struct-type-install-properties!
struct:path
@ -18245,7 +18397,7 @@
(make-record-type-descriptor*
'bytes-input-port
struct:commit-input-port
#f
(|#%nongenerative-uid| bytes-input-port)
#f
#f
3
@ -18294,7 +18446,7 @@
(make-record-type-descriptor*
'bytes-input-port-methods
struct:commit-input-port-methods.1
#f
(|#%nongenerative-uid| bytes-input-port-methods)
#f
#f
0
@ -18525,7 +18677,7 @@
(make-record-type-descriptor*
'bytes-output-port
struct:core-output-port
#f
(|#%nongenerative-uid| bytes-output-port)
#f
#f
3
@ -18578,7 +18730,7 @@
(make-record-type-descriptor*
'bytes-output-port-methods
struct:core-output-port-methods.1
#f
(|#%nongenerative-uid| bytes-output-port-methods)
#f
#f
2
@ -19031,7 +19183,7 @@
(make-record-type-descriptor*
'max-output-port
struct:core-output-port
#f
(|#%nongenerative-uid| max-output-port)
#f
#f
2
@ -19072,7 +19224,7 @@
(make-record-type-descriptor*
'max-output-port-methods
struct:core-output-port-methods.1
#f
(|#%nongenerative-uid| max-output-port-methods)
#f
#f
0
@ -19994,7 +20146,7 @@
(make-record-type-descriptor*
'nowhere-output-port
struct:core-output-port
#f
(|#%nongenerative-uid| nowhere-output-port)
#f
#f
0
@ -20025,7 +20177,7 @@
(make-record-type-descriptor*
'nowhere-output-port-methods
struct:core-output-port-methods.1
#f
(|#%nongenerative-uid| nowhere-output-port-methods)
#f
#f
0
@ -20269,7 +20421,14 @@
fuel_1)))))))))))))
(quick-no-graph?_0 v_0 fuel_0))))
(define struct:as-constructor
(make-record-type-descriptor* 'as-constructor #f #f #f #f 1 0))
(make-record-type-descriptor*
'as-constructor
#f
(|#%nongenerative-uid| as-constructor)
#f
#f
1
0))
(define effect_2971
(struct-type-install-properties!
struct:as-constructor
@ -23260,7 +23419,14 @@
(just-separators-after? s_0 2)
#f))))))
(define struct:starting-point
(make-record-type-descriptor* 'starting-point #f #f #f #f 7 0))
(make-record-type-descriptor*
'starting-point
#f
(|#%nongenerative-uid| starting-point)
#f
#f
7
0))
(define effect_2720
(struct-type-install-properties!
struct:starting-point
@ -25235,7 +25401,14 @@
(define listen-port-number?
(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))
(make-record-type-descriptor*
'security-guard
#f
(|#%nongenerative-uid| security-guard)
#f
#f
4
0))
(define effect_2690
(struct-type-install-properties!
struct:security-guard
@ -29683,7 +29856,14 @@
(1/string->bytes/locale (string-foldcase (1/bytes->string/locale k_0))))
k_0)))
(define struct:environment-variables
(make-record-type-descriptor* 'environment-variables #f #f #f #f 1 1))
(make-record-type-descriptor*
'environment-variables
#f
(|#%nongenerative-uid| environment-variables)
#f
#f
1
1))
(define effect_2652
(struct-type-install-properties!
struct:environment-variables
@ -31408,7 +31588,14 @@
(define adjust-path
(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))
(make-record-type-descriptor*
'logger
#f
(|#%nongenerative-uid| logger)
#f
#f
11
376))
(define effect_2192
(struct-type-install-properties!
struct:logger
@ -31871,7 +32058,15 @@
(loop_0 filters_0 'none))))
(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 struct:queue
(make-record-type-descriptor*
'queue
#f
(|#%nongenerative-uid| queue)
#f
#f
2
3))
(define effect_2520
(struct-type-install-properties!
struct:queue
@ -31897,7 +32092,15 @@
(|#%name| set-queue-start! (record-mutator struct:queue 0)))
(define set-queue-end!
(|#%name| set-queue-end! (record-mutator struct:queue 1)))
(define struct:node (make-record-type-descriptor* 'node #f #f #f #f 3 6))
(define struct:node
(make-record-type-descriptor*
'node
#f
(|#%nongenerative-uid| node)
#f
#f
3
6))
(define effect_2547
(struct-type-install-properties!
struct:node
@ -31954,7 +32157,14 @@
(let ((app_0 (node-next n_0))) (set-node-prev! app_0 (node-prev n_0)))
(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))
(make-record-type-descriptor*
'log-receiver
#f
(|#%nongenerative-uid| log-receiver)
#f
#f
1
0))
(define effect_2708
(struct-type-install-properties!
struct:log-receiver
@ -32008,7 +32218,7 @@
(make-record-type-descriptor*
'log-receiver
struct:log-receiver
#f
(|#%nongenerative-uid| log-receiver)
#f
#f
3
@ -32189,7 +32399,7 @@
(make-record-type-descriptor*
'stdio-log-receiver
struct:log-receiver
#f
(|#%nongenerative-uid| stdio-log-receiver)
#f
#f
2
@ -32335,7 +32545,7 @@
(make-record-type-descriptor*
'syslog-log-receiver
struct:log-receiver
#f
(|#%nongenerative-uid| syslog-log-receiver)
#f
#f
2
@ -33298,7 +33508,14 @@
(loop_0 logger_0))
(void)))))
(define struct:fs-change-evt
(make-record-type-descriptor* 'filesystem-change-evt #f #f #f #f 2 3))
(make-record-type-descriptor*
'filesystem-change-evt
#f
(|#%nongenerative-uid| filesystem-change-evt)
#f
#f
2
3))
(define effect_2322
(struct-type-install-properties!
struct:fs-change-evt
@ -33793,7 +34010,14 @@
(let ((bstr_0 (make-bytes sz_0)))
(begin (|#%app| final_0 p_0 bstr_0) bstr_0))))))))))
(define struct:subprocess
(make-record-type-descriptor* 'subprocess #f #f #f #f 3 3))
(make-record-type-descriptor*
'subprocess
#f
(|#%nongenerative-uid| subprocess)
#f
#f
3
3))
(define effect_2272
(struct-type-install-properties!
struct:subprocess
@ -34666,7 +34890,7 @@
(make-record-type-descriptor*
'tcp-input-port
struct:fd-input-port
#f
(|#%nongenerative-uid| tcp-input-port)
#f
#f
1
@ -34707,7 +34931,7 @@
(make-record-type-descriptor*
'tcp-input-port-methods
struct:fd-input-port-methods.1
#f
(|#%nongenerative-uid| tcp-input-port-methods)
#f
#f
0
@ -34843,7 +35067,7 @@
(make-record-type-descriptor*
'tcp-output-port
struct:fd-output-port
#f
(|#%nongenerative-uid| tcp-output-port)
#f
#f
1
@ -34886,7 +35110,7 @@
(make-record-type-descriptor*
'tcp-output-port-methods
struct:fd-output-port-methods.1
#f
(|#%nongenerative-uid| tcp-output-port-methods)
#f
#f
0
@ -35040,7 +35264,14 @@
(begin (set-tcp-output-port-abandon?! cp_0 #t) (close-port p_0))
(void))))))))
(define struct:rktio-evt
(make-record-type-descriptor* 'rktio-evt #f #f #f #f 2 0))
(make-record-type-descriptor*
'rktio-evt
#f
(|#%nongenerative-uid| rktio-evt)
#f
#f
2
0))
(define effect_2914
(struct-type-install-properties!
struct:rktio-evt
@ -35224,7 +35455,14 @@
(define address-init!
(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))
(make-record-type-descriptor*
'connect-progress
#f
(|#%nongenerative-uid| connect-progress)
#f
#f
2
3))
(define effect_2403
(struct-type-install-properties!
struct:connect-progress
@ -35596,7 +35834,14 @@
(set-connect-progress-trying-fd! conn-prog_0 #f))
(void)))))
(define struct:tcp-listener
(make-record-type-descriptor* 'tcp-listener #f #f #f #f 3 0))
(make-record-type-descriptor*
'tcp-listener
#f
(|#%nongenerative-uid| tcp-listener)
#f
#f
3
0))
(define effect_2611
(struct-type-install-properties!
struct:tcp-listener
@ -35972,7 +36217,14 @@
(raise-argument-error 'tcp-accept-evt "tcp-listener?" listener_0))
(accept-evt6.1 listener_0))))))
(define struct:accept-evt
(make-record-type-descriptor* 'tcp-accept-evt #f #f #f #f 1 0))
(make-record-type-descriptor*
'tcp-accept-evt
#f
(|#%nongenerative-uid| tcp-accept-evt)
#f
#f
1
0))
(define effect_2325
(struct-type-install-properties!
struct:accept-evt
@ -36135,7 +36387,8 @@
v_0))))))
(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 struct:udp
(make-record-type-descriptor* 'udp #f (|#%nongenerative-uid| udp) #f #f 3 7))
(define effect_2368
(struct-type-install-properties!
struct:udp
@ -37309,7 +37562,14 @@
u60_0)))))))
(loop_0)))))))
(define struct:udp-sending-evt
(make-record-type-descriptor* 'udp-send-evt #f #f #f #f 2 0))
(make-record-type-descriptor*
'udp-send-evt
#f
(|#%nongenerative-uid| udp-send-evt)
#f
#f
2
0))
(define effect_2348
(struct-type-install-properties!
struct:udp-sending-evt
@ -37362,7 +37622,7 @@
(make-record-type-descriptor*
'udp-send-ready-evt
struct:rktio-evt
#f
(|#%nongenerative-uid| udp-send-ready-evt)
#f
#f
0
@ -37691,7 +37951,14 @@
(define cell.1$2 (unsafe-make-place-local #vu8()))
(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))
(make-record-type-descriptor*
'udp-receive-evt
#f
(|#%nongenerative-uid| udp-receive-evt)
#f
#f
2
0))
(define effect_2847
(struct-type-install-properties!
struct:udp-receiving-evt
@ -37749,7 +38016,7 @@
(make-record-type-descriptor*
'udp-receive-ready-evt
struct:rktio-evt
#f
(|#%nongenerative-uid| udp-receive-ready-evt)
#f
#f
0

137
racket/src/cs/schemified/regexp.scm
View File

@ -865,7 +865,15 @@
(define rx:line-end 'line-end)
(define rx:word-boundary 'word-boundary)
(define rx:not-word-boundary 'not-word-boundary)
(define struct:rx:alts (make-record-type-descriptor* 'rx:alts #f #f #f #f 2 0))
(define struct:rx:alts
(make-record-type-descriptor*
'rx:alts
#f
(|#%nongenerative-uid| rx:alts)
#f
#f
2
0))
(define effect_2665
(struct-type-install-properties!
struct:rx:alts
@ -914,7 +922,14 @@
($value
(impersonate-ref rx:alts-rx_2917 struct:rx:alts 1 s 'rx:alts 'rx2))))))
(define struct:rx:sequence
(make-record-type-descriptor* 'rx:sequence #f #f #f #f 2 0))
(make-record-type-descriptor*
'rx:sequence
#f
(|#%nongenerative-uid| rx:sequence)
#f
#f
2
0))
(define effect_2137
(struct-type-install-properties!
struct:rx:sequence
@ -978,7 +993,14 @@
'rx:sequence
'needs-backtrack?))))))
(define struct:rx:group
(make-record-type-descriptor* 'rx:group #f #f #f #f 2 0))
(make-record-type-descriptor*
'rx:group
#f
(|#%nongenerative-uid| rx:group)
#f
#f
2
0))
(define effect_2340
(struct-type-install-properties!
struct:rx:group
@ -1039,7 +1061,14 @@
'rx:group
'number))))))
(define struct:rx:repeat
(make-record-type-descriptor* 'rx:repeat #f #f #f #f 4 0))
(make-record-type-descriptor*
'rx:repeat
#f
(|#%nongenerative-uid| rx:repeat)
#f
#f
4
0))
(define effect_2551
(struct-type-install-properties!
struct:rx:repeat
@ -1133,7 +1162,14 @@
'rx:repeat
'non-greedy?))))))
(define struct:rx:maybe
(make-record-type-descriptor* 'rx:maybe #f #f #f #f 2 0))
(make-record-type-descriptor*
'rx:maybe
#f
(|#%nongenerative-uid| rx:maybe)
#f
#f
2
0))
(define effect_2619
(struct-type-install-properties!
struct:rx:maybe
@ -1194,7 +1230,14 @@
'rx:maybe
'non-greedy?))))))
(define struct:rx:conditional
(make-record-type-descriptor* 'rx:conditional #f #f #f #f 6 0))
(make-record-type-descriptor*
'rx:conditional
#f
(|#%nongenerative-uid| rx:conditional)
#f
#f
6
0))
(define effect_2459
(struct-type-install-properties!
struct:rx:conditional
@ -1324,7 +1367,14 @@
'rx:conditional
'needs-backtrack?))))))
(define struct:rx:lookahead
(make-record-type-descriptor* 'rx:lookahead #f #f #f #f 4 0))
(make-record-type-descriptor*
'rx:lookahead
#f
(|#%nongenerative-uid| rx:lookahead)
#f
#f
4
0))
(define effect_2324
(struct-type-install-properties!
struct:rx:lookahead
@ -1420,7 +1470,14 @@
'rx:lookahead
'num-n))))))
(define struct:rx:lookbehind
(make-record-type-descriptor* 'rx:lookbehind #f #f #f #f 6 12))
(make-record-type-descriptor*
'rx:lookbehind
#f
(|#%nongenerative-uid| rx:lookbehind)
#f
#f
6
12))
(define effect_2263
(struct-type-install-properties!
struct:rx:lookbehind
@ -1583,7 +1640,15 @@
v
'rx:lookbehind
'lb-max))))))
(define struct:rx:cut (make-record-type-descriptor* 'rx:cut #f #f #f #f 4 0))
(define struct:rx:cut
(make-record-type-descriptor*
'rx:cut
#f
(|#%nongenerative-uid| rx:cut)
#f
#f
4
0))
(define effect_2942
(struct-type-install-properties!
struct:rx:cut
@ -1669,7 +1734,14 @@
'rx:cut
'needs-backtrack?))))))
(define struct:rx:reference
(make-record-type-descriptor* 'rx:reference #f #f #f #f 2 0))
(make-record-type-descriptor*
'rx:reference
#f
(|#%nongenerative-uid| rx:reference)
#f
#f
2
0))
(define effect_2344
(struct-type-install-properties!
struct:rx:reference
@ -1735,7 +1807,14 @@
'rx:reference
'case-sensitive?))))))
(define struct:rx:range
(make-record-type-descriptor* 'rx:range #f #f #f #f 1 0))
(make-record-type-descriptor*
'rx:range
#f
(|#%nongenerative-uid| rx:range)
#f
#f
1
0))
(define effect_2702
(struct-type-install-properties!
struct:rx:range
@ -1780,7 +1859,14 @@
'rx:range
'range))))))
(define struct:rx:unicode-categories
(make-record-type-descriptor* 'rx:unicode-categories #f #f #f #f 2 0))
(make-record-type-descriptor*
'rx:unicode-categories
#f
(|#%nongenerative-uid| rx:unicode-categories)
#f
#f
2
0))
(define effect_2129
(struct-type-install-properties!
struct:rx:unicode-categories
@ -2044,7 +2130,14 @@
(let ((or-part_0 (needs-backtrack? pces1_0)))
(if or-part_0 or-part_0 (needs-backtrack? pces2_0))))))
(define struct:parse-config
(make-record-type-descriptor* 'parse-config #f #f #f #f 7 0))
(make-record-type-descriptor*
'parse-config
#f
(|#%nongenerative-uid| parse-config)
#f
#f
7
0))
(define effect_2566
(struct-type-install-properties!
struct:parse-config
@ -4605,7 +4698,14 @@
#f)))))))))))))))))))
(define union (lambda (a_0 b_0) (if a_0 (if b_0 (range-union a_0 b_0) #f) #f)))
(define struct:lazy-bytes
(make-record-type-descriptor* 'lazy-bytes #f #f #f #f 13 3075))
(make-record-type-descriptor*
'lazy-bytes
#f
(|#%nongenerative-uid| lazy-bytes)
#f
#f
13
3075))
(define effect_2272
(struct-type-install-properties!
struct:lazy-bytes
@ -7143,7 +7243,14 @@
(range-matcher* (compile-range (rx:range-range rx_0)) max_0)
#f))))))
(define struct:rx:regexp
(make-record-type-descriptor* 'regexp #f #f #f #f 10 0))
(make-record-type-descriptor*
'regexp
#f
(|#%nongenerative-uid| regexp)
#f
#f
10
0))
(define effect_2093
(struct-type-install-properties!
struct:rx:regexp

129
racket/src/cs/schemified/schemify.scm
View File

@ -4435,7 +4435,15 @@
(let ((app_0
(if (string? prefix_0) prefix_0 (symbol->string prefix_0))))
(string-append app_0 (number->string (unbox b_0)))))))))
(define struct:import (make-record-type-descriptor* 'import #f #f #f #f 4 0))
(define struct:import
(make-record-type-descriptor*
'import
#f
(|#%nongenerative-uid| import)
#f
#f
4
0))
(define effect_2897
(struct-type-install-properties!
struct:import
@ -4515,7 +4523,14 @@
'import
'ext-id))))))
(define struct:import-group
(make-record-type-descriptor* 'import-group #f #f #f #f 6 60))
(make-record-type-descriptor*
'import-group
#f
(|#%nongenerative-uid| import-group)
#f
#f
6
60))
(define effect_2514
(struct-type-install-properties!
struct:import-group
@ -4877,7 +4892,15 @@
(|#%app| inc-index!_0)
(|#%app| add-group!_0 grp_0)
grp_0))))))
(define struct:export (make-record-type-descriptor* 'export #f #f #f #f 2 0))
(define struct:export
(make-record-type-descriptor*
'export
#f
(|#%nongenerative-uid| export)
#f
#f
2
0))
(define effect_2166
(struct-type-install-properties!
struct:export
@ -4931,7 +4954,14 @@
'export
'ext-id))))))
(define struct:too-early
(make-record-type-descriptor* 'too-early #f #f #f #f 2 0))
(make-record-type-descriptor*
'too-early
#f
(|#%nongenerative-uid| too-early)
#f
#f
2
0))
(define effect_2681
(struct-type-install-properties!
struct:too-early
@ -7233,7 +7263,14 @@
((k_0 im_0) k_0)
(args (raise-binding-result-arity-error 2 args))))))
(define struct:struct-type-info
(make-record-type-descriptor* 'struct-type-info #f #f #f #f 10 0))
(make-record-type-descriptor*
'struct-type-info
#f
(|#%nongenerative-uid| struct-type-info)
#f
#f
10
0))
(define effect_3042
(struct-type-install-properties!
struct:struct-type-info
@ -15868,7 +15905,8 @@
mutated_0
schemify_0
target_0
no-prompt?_0)
no-prompt?_0
top?_0)
(let ((hd_0
(let ((p_0 (unwrap form_0)))
(if (pair? p_0) (unwrap (car p_0)) #f))))
@ -16926,7 +16964,13 @@
(if (not
(struct-type-info-prefab-immutables
sti_0))
#f
(if (if top?_0
(eq? target_0 'system)
#f)
(list
'|#%nongenerative-uid|
(struct-type-info-name sti_0))
#f)
(let ((app_2
(list
'quote
@ -17921,7 +17965,8 @@
mutated11_0
schemify13_0
target3_0
#t)))
#t
#f)))
(if new-seq_0
(let ((hd_0
(let ((p_0 (unwrap new-seq_0)))
@ -25232,7 +25277,8 @@
'fresh
v_3))
target_0
no-prompt?_0)))
no-prompt?_0
#t)))
(if new-seq_0
new-seq_0
(if (let ((p_0 (unwrap v_2)))
@ -30149,7 +30195,14 @@
(schemify_0 v_1 wcm-state_1)))))))
(schemify/knowns_0 knowns_0 8 wcm-state_0 v_0))))
(define struct:convert-mode
(make-record-type-descriptor* 'convert-mode #f #f #f #f 4 0))
(make-record-type-descriptor*
'convert-mode
#f
(|#%nongenerative-uid| convert-mode)
#f
#f
4
0))
(define effect_2645
(struct-type-install-properties!
struct:convert-mode
@ -39282,7 +39335,14 @@
#t
(if (extflonum? q_0) #t #f))))))))))))))
(define struct:to-unfasl
(make-record-type-descriptor* 'to-unfasl #f #f #f #f 3 0))
(make-record-type-descriptor*
'to-unfasl
#f
(|#%nongenerative-uid| to-unfasl)
#f
#f
3
0))
(define effect_3053
(struct-type-install-properties!
struct:to-unfasl
@ -39425,7 +39485,15 @@
'write
"cannot marshal value that is embedded in compiled code\n value: ~v"
v_0)))
(define struct:node (make-record-type-descriptor* 'node #f #f #f #f 5 0))
(define struct:node
(make-record-type-descriptor*
'node
#f
(|#%nongenerative-uid| node)
#f
#f
5
0))
(define effect_2498
(struct-type-install-properties!
struct:node
@ -39740,7 +39808,14 @@
(stack-set stack_1 pos_1 (car vals_1))))))))))))
(loop_0 pos_0 vals_0 count_0 stack_0))))))
(define struct:stack-info
(make-record-type-descriptor* 'stack-info #f #f #f #f 5 28))
(make-record-type-descriptor*
'stack-info
#f
(|#%nongenerative-uid| stack-info)
#f
#f
5
28))
(define effect_2396
(struct-type-install-properties!
struct:stack-info
@ -40091,7 +40166,14 @@
(lambda (stk-i_0 stack-depth_0)
(set-stack-info-non-tail-call-later?! stk-i_0 #t)))
(define struct:indirect
(make-record-type-descriptor* 'indirect #f #f #f #f 2 0))
(make-record-type-descriptor*
'indirect
#f
(|#%nongenerative-uid| indirect)
#f
#f
2
0))
(define effect_2066
(struct-type-install-properties!
struct:indirect
@ -40151,7 +40233,15 @@
s
'indirect
'element))))))
(define struct:boxed (make-record-type-descriptor* 'boxed #f #f #f #f 1 0))
(define struct:boxed
(make-record-type-descriptor*
'boxed
#f
(|#%nongenerative-uid| boxed)
#f
#f
1
0))
(define effect_2558
(struct-type-install-properties!
struct:boxed
@ -40189,7 +40279,14 @@
($value
(impersonate-ref boxed-pos_2515 struct:boxed 0 s 'boxed 'pos))))))
(define struct:boxed/check
(make-record-type-descriptor* 'boxed/check struct:boxed #f #f #f 0 0))
(make-record-type-descriptor*
'boxed/check
struct:boxed
(|#%nongenerative-uid| boxed/check)
#f
#f
0
0))
(define effect_2563
(struct-type-install-properties!
struct:boxed/check

481
racket/src/cs/schemified/thread.scm
View File

@ -972,7 +972,15 @@
(void)
(raise-argument-error 'hash-empty? "hash?" table_0))
(zero? (hash-count table_0)))))
(define struct:queue (make-record-type-descriptor* 'queue #f #f #f #f 2 3))
(define struct:queue
(make-record-type-descriptor*
'queue
#f
(|#%nongenerative-uid| queue)
#f
#f
2
3))
(define effect_2520
(struct-type-install-properties!
struct:queue
@ -998,7 +1006,15 @@
(|#%name| set-queue-start! (record-mutator struct:queue 0)))
(define set-queue-end!
(|#%name| set-queue-end! (record-mutator struct:queue 1)))
(define struct:node$2 (make-record-type-descriptor* 'node #f #f #f #f 3 6))
(define struct:node$2
(make-record-type-descriptor*
'node
#f
(|#%nongenerative-uid| node)
#f
#f
3
6))
(define effect_2809
(struct-type-install-properties!
struct:node$2
@ -1224,7 +1240,15 @@
(hash-ref (primitive-table '|#%engine|) 'continuation-current-primitive #f))
(define host:prop:unsafe-authentic-override
(hash-ref (primitive-table '|#%engine|) 'prop:unsafe-authentic-override #f))
(define struct:node$1 (make-record-type-descriptor* 'node #f #f #f #f 5 0))
(define struct:node$1
(make-record-type-descriptor*
'node
#f
(|#%nongenerative-uid| node)
#f
#f
5
0))
(define effect_2451
(struct-type-install-properties!
struct:node$1
@ -1954,7 +1978,14 @@
"(or/c evt? (procedure-arity-includes/c 1) exact-nonnegative-integer?)"
v_0))))))))
(define struct:selector-prop-evt-value
(make-record-type-descriptor* 'selector-prop-evt-value #f #f #f #f 1 0))
(make-record-type-descriptor*
'selector-prop-evt-value
#f
(|#%nongenerative-uid| selector-prop-evt-value)
#f
#f
1
0))
(define effect_2090
(struct-type-install-properties!
struct:selector-prop-evt-value
@ -1994,7 +2025,15 @@
(begin
(let ((or-part_0 (primary-evt? v_0)))
(if or-part_0 or-part_0 (secondary-evt? v_0)))))))
(define struct:poller (make-record-type-descriptor* 'poller #f #f #f #f 1 0))
(define struct:poller
(make-record-type-descriptor*
'poller
#f
(|#%nongenerative-uid| poller)
#f
#f
1
0))
(define effect_2384
(struct-type-install-properties!
struct:poller
@ -2016,7 +2055,14 @@
(define poller? (|#%name| poller? (record-predicate struct:poller)))
(define poller-proc (|#%name| poller-proc (record-accessor struct:poller 0)))
(define struct:poll-ctx
(make-record-type-descriptor* 'poll-ctx #f #f #f #f 4 8))
(make-record-type-descriptor*
'poll-ctx
#f
(|#%nongenerative-uid| poll-ctx)
#f
#f
4
8))
(define effect_3060
(struct-type-install-properties!
struct:poll-ctx
@ -2047,7 +2093,14 @@
(define set-poll-ctx-incomplete?!
(|#%name| set-poll-ctx-incomplete?! (record-mutator struct:poll-ctx 3)))
(define struct:never-evt
(make-record-type-descriptor* 'never-evt #f #f #f #f 0 0))
(make-record-type-descriptor*
'never-evt
#f
(|#%nongenerative-uid| never-evt)
#f
#f
0
0))
(define effect_2812
(struct-type-install-properties!
struct:never-evt
@ -2081,7 +2134,14 @@
(if (impersonator? v) (never-evt?_1958 (impersonator-val v)) #f))))))
(define the-never-evt (never-evt4.1))
(define struct:always-evt
(make-record-type-descriptor* 'always-evt #f #f #f #f 0 0))
(make-record-type-descriptor*
'always-evt
#f
(|#%nongenerative-uid| always-evt)
#f
#f
0
0))
(define effect_2453
(struct-type-install-properties!
struct:always-evt
@ -2115,7 +2175,14 @@
(if (impersonator? v) (always-evt?_2466 (impersonator-val v)) #f))))))
(define the-always-evt (always-evt5.1))
(define struct:async-evt
(make-record-type-descriptor* 'async-evt #f #f #f #f 0 0))
(make-record-type-descriptor*
'async-evt
#f
(|#%nongenerative-uid| async-evt)
#f
#f
0
0))
(define effect_2629
(struct-type-install-properties!
struct:async-evt
@ -2148,7 +2215,8 @@
($value
(if (impersonator? v) (async-evt?_2619 (impersonator-val v)) #f))))))
(define the-async-evt (async-evt6.1))
(define struct:wrap-evt (make-record-type-descriptor* 'evt #f #f #f #f 2 0))
(define struct:wrap-evt
(make-record-type-descriptor* 'evt #f (|#%nongenerative-uid| evt) #f #f 2 0))
(define effect_2319
(struct-type-install-properties!
struct:wrap-evt
@ -2206,7 +2274,14 @@
'evt
'wrap))))))
(define struct:handle-evt
(make-record-type-descriptor* 'handle-evt struct:wrap-evt #f #f #f 0 0))
(make-record-type-descriptor*
'handle-evt
struct:wrap-evt
(|#%nongenerative-uid| handle-evt)
#f
#f
0
0))
(define effect_2329
(struct-type-install-properties!
struct:handle-evt
@ -2238,7 +2313,14 @@
(handle-evt?$1_2894 (impersonator-val v))
#f))))))
(define struct:control-state-evt
(make-record-type-descriptor* 'control-state-evt #f #f #f #f 5 0))
(make-record-type-descriptor*
'control-state-evt
#f
(|#%nongenerative-uid| control-state-evt)
#f
#f
5
0))
(define effect_2665
(struct-type-install-properties!
struct:control-state-evt
@ -2363,7 +2445,7 @@
'control-state-evt
'retry-proc))))))
(define struct:poll-guard-evt
(make-record-type-descriptor* 'evt #f #f #f #f 1 0))
(make-record-type-descriptor* 'evt #f (|#%nongenerative-uid| evt) #f #f 1 0))
(define effect_2393
(struct-type-install-properties!
struct:poll-guard-evt
@ -2413,7 +2495,8 @@
s
'evt
'proc))))))
(define struct:choice-evt (make-record-type-descriptor* 'evt #f #f #f #f 1 0))
(define struct:choice-evt
(make-record-type-descriptor* 'evt #f (|#%nongenerative-uid| evt) #f #f 1 0))
(define effect_2512
(struct-type-install-properties!
struct:choice-evt
@ -2492,7 +2575,14 @@
(|#%app| (poller-proc v_1) evt_0 poll-ctx_0)
(if (1/evt? v_1) (values #f v_1) (values #f the-never-evt))))))))
(define struct:delayed-poll
(make-record-type-descriptor* 'delayed-poll #f #f #f #f 1 0))
(make-record-type-descriptor*
'delayed-poll
#f
(|#%nongenerative-uid| delayed-poll)
#f
#f
1
0))
(define effect_3144
(struct-type-install-properties!
struct:delayed-poll
@ -2516,7 +2606,14 @@
(define delayed-poll-resume
(|#%name| delayed-poll-resume (record-accessor struct:delayed-poll 0)))
(define struct:poller-evt
(make-record-type-descriptor* 'poller-evt #f #f #f #f 1 0))
(make-record-type-descriptor*
'poller-evt
#f
(|#%nongenerative-uid| poller-evt)
#f
#f
1
0))
(define effect_2558
(struct-type-install-properties!
struct:poller-evt
@ -2565,7 +2662,14 @@
(prop:waiter waiter? waiter-ref)
(make-struct-type-property 'waiter))
(define struct:waiter-methods
(make-record-type-descriptor* 'waiter-methods #f #f #f #f 2 0))
(make-record-type-descriptor*
'waiter-methods
#f
(|#%nongenerative-uid| waiter-methods)
#f
#f
2
0))
(define effect_3162
(struct-type-install-properties!
struct:waiter-methods
@ -2602,7 +2706,14 @@
(lambda (w_0 interrupt-cb_0)
(|#%app| (waiter-methods-suspend (waiter-ref w_0)) w_0 interrupt-cb_0)))
(define struct:select-waiter
(make-record-type-descriptor* 'select-waiter #f #f #f #f 1 0))
(make-record-type-descriptor*
'select-waiter
#f
(|#%nongenerative-uid| select-waiter)
#f
#f
1
0))
(define effect_2458
(struct-type-install-properties!
struct:select-waiter
@ -2658,7 +2769,14 @@
'select-waiter
'proc))))))
(define struct:custodian
(make-record-type-descriptor* 'custodian #f #f #f #f 13 8188))
(make-record-type-descriptor*
'custodian
#f
(|#%nongenerative-uid| custodian)
#f
#f
13
8188))
(define effect_2364
(struct-type-install-properties!
struct:custodian
@ -2784,7 +2902,14 @@
(prop:place-message place-message? place-message-ref)
(make-struct-type-property 'place-message))
(define struct:message-ized
(make-record-type-descriptor* 'message-ized #f #f #f #f 1 0))
(make-record-type-descriptor*
'message-ized
#f
(|#%nongenerative-uid| message-ized)
#f
#f
1
0))
(define effect_2650
(struct-type-install-properties!
struct:message-ized
@ -3872,7 +3997,14 @@
v_1)))))))))))))
(loop_0 v_0)))))
(define struct:place
(make-record-type-descriptor* 'place #f #f #f #f 19 491440))
(make-record-type-descriptor*
'place
#f
(|#%nongenerative-uid| place)
#f
#f
19
491440))
(define effect_3085
(struct-type-install-properties!
struct:place
@ -4028,7 +4160,14 @@
(void)))))
(void))))
(define struct:semaphore
(make-record-type-descriptor* 'semaphore struct:queue #f #f #f 1 1))
(make-record-type-descriptor*
'semaphore
struct:queue
(|#%nongenerative-uid| semaphore)
#f
#f
1
1))
(define effect_3126
(struct-type-install-properties!
struct:semaphore
@ -4061,7 +4200,14 @@
(|#%name| set-semaphore-count! (record-mutator struct:semaphore 0)))
(define count-field-pos 2)
(define struct:semaphore-peek-evt
(make-record-type-descriptor* 'semaphore-peek-evt #f #f #f #f 1 0))
(make-record-type-descriptor*
'semaphore-peek-evt
#f
(|#%nongenerative-uid| semaphore-peek-evt)
#f
#f
1
0))
(define effect_2127
(struct-type-install-properties!
struct:semaphore-peek-evt
@ -4120,7 +4266,7 @@
(make-record-type-descriptor*
'semaphore-peek-select-waiter
struct:select-waiter
#f
(|#%nongenerative-uid| semaphore-peek-select-waiter)
#f
#f
0
@ -4350,7 +4496,15 @@
(set-semaphore-count! s_0 (sub1 c_0))
(internal-error
"semaphore-wait/atomic: cannot decrement semaphore")))))
(define struct:node (make-record-type-descriptor* 'node #f #f #f #f 2 3))
(define struct:node
(make-record-type-descriptor*
'node
#f
(|#%nongenerative-uid| node)
#f
#f
2
3))
(define effect_2755
(struct-type-install-properties!
struct:node
@ -4379,7 +4533,14 @@
(define child-node (lambda (child_0) child_0))
(define node-child (lambda (n_0) n_0))
(define struct:thread-group
(make-record-type-descriptor* 'thread-group struct:node #f #f #f 4 14))
(make-record-type-descriptor*
'thread-group
struct:node
(|#%nongenerative-uid| thread-group)
#f
#f
4
14))
(define effect_2111
(struct-type-install-properties!
struct:thread-group
@ -4544,7 +4705,14 @@
accum_1)))))))))
(loop_0 (thread-group-chain-start parent_0) accum_0)))))
(define struct:schedule-info
(make-record-type-descriptor* 'schedule-info #f #f #f #f 2 3))
(make-record-type-descriptor*
'schedule-info
#f
(|#%nongenerative-uid| schedule-info)
#f
#f
2
3))
(define effect_2459
(struct-type-install-properties!
struct:schedule-info
@ -4667,7 +4835,15 @@
(lambda (sched-info_0) (set-schedule-info-did-work?! sched-info_0 #t)))
(define reference-sink
(lambda (v_0) (ephemeron-value (make-ephemeron #f (void)) (void) v_0)))
(define struct:plumber (make-record-type-descriptor* 'plumber #f #f #f #f 2 0))
(define struct:plumber
(make-record-type-descriptor*
'plumber
#f
(|#%nongenerative-uid| plumber)
#f
#f
2
0))
(define effect_2525
(struct-type-install-properties!
struct:plumber
@ -4708,7 +4884,14 @@
v_0))
'current-plumber))
(define struct:plumber-flush-handle
(make-record-type-descriptor* 'plumber-flush-handle #f #f #f #f 2 0))
(make-record-type-descriptor*
'plumber-flush-handle
#f
(|#%nongenerative-uid| plumber-flush-handle)
#f
#f
2
0))
(define effect_2524
(struct-type-install-properties!
struct:plumber-flush-handle
@ -4933,7 +5116,14 @@
exit
(case-lambda (() (begin (exit_0 #t))) ((v1_0) (exit_0 v1_0))))))
(define struct:custodian-box
(make-record-type-descriptor* 'custodian-box #f #f #f #f 2 1))
(make-record-type-descriptor*
'custodian-box
#f
(|#%nongenerative-uid| custodian-box)
#f
#f
2
1))
(define effect_2780
(struct-type-install-properties!
struct:custodian-box
@ -4966,7 +5156,14 @@
(define set-custodian-box-v!
(|#%name| set-custodian-box-v! (record-mutator struct:custodian-box 0)))
(define struct:willed-callback
(make-record-type-descriptor* 'willed-callback #f #f #f #f 2 0))
(make-record-type-descriptor*
'willed-callback
#f
(|#%nongenerative-uid| willed-callback)
#f
#f
2
0))
(define effect_2810
(struct-type-install-properties!
struct:willed-callback
@ -4995,7 +5192,7 @@
(make-record-type-descriptor*
'at-exit-callback
struct:willed-callback
#f
(|#%nongenerative-uid| at-exit-callback)
#f
#f
0
@ -5021,7 +5218,14 @@
(define at-exit-callback?
(|#%name| at-exit-callback? (record-predicate struct:at-exit-callback)))
(define struct:custodian-reference
(make-record-type-descriptor* 'custodian-reference #f #f #f #f 1 1))
(make-record-type-descriptor*
'custodian-reference
#f
(|#%nongenerative-uid| custodian-reference)
#f
#f
1
1))
(define effect_2616
(struct-type-install-properties!
struct:custodian-reference
@ -6357,7 +6561,14 @@
(void)))))))
(loop_0 mref_0))))
(define struct:thread
(make-record-type-descriptor* 'thread struct:node #f #f #f 24 16777082))
(make-record-type-descriptor*
'thread
struct:node
(|#%nongenerative-uid| thread)
#f
#f
24
16777082))
(define effect_2521
(struct-type-install-properties!
struct:thread
@ -6860,7 +7071,14 @@
(raise-argument-error 'thread-wait "thread?" t_0))
(1/semaphore-wait (|#%app| get-thread-dead-sema t_0)))))))
(define struct:dead-evt
(make-record-type-descriptor* 'thread-dead-evt #f #f #f #f 1 0))
(make-record-type-descriptor*
'thread-dead-evt
#f
(|#%nongenerative-uid| thread-dead-evt)
#f
#f
1
0))
(define effect_2807
(struct-type-install-properties!
struct:dead-evt
@ -7183,7 +7401,14 @@
(loop_0 app_0 (cons (car crs_0) accum_0))))))))))))
(loop_0 (thread-custodian-references t_0) null))))
(define struct:transitive-resume
(make-record-type-descriptor* 'transitive-resume #f #f #f #f 2 0))
(make-record-type-descriptor*
'transitive-resume
#f
(|#%nongenerative-uid| transitive-resume)
#f
#f
2
0))
(define effect_2586
(struct-type-install-properties!
struct:transitive-resume
@ -7307,7 +7532,14 @@
(|#%app| interrupt-callback_0))
(void)))))
(define struct:suspend-resume-evt
(make-record-type-descriptor* 'suspend-resume-evt #f #f #f #f 2 2))
(make-record-type-descriptor*
'suspend-resume-evt
#f
(|#%nongenerative-uid| suspend-resume-evt)
#f
#f
2
2))
(define effect_2400
(struct-type-install-properties!
struct:suspend-resume-evt
@ -7404,7 +7636,7 @@
(make-record-type-descriptor*
'thread-suspend-evt
struct:suspend-resume-evt
#f
(|#%nongenerative-uid| thread-suspend-evt)
#f
#f
0
@ -7441,7 +7673,7 @@
(make-record-type-descriptor*
'thread-resume-evt
struct:suspend-resume-evt
#f
(|#%nongenerative-uid| thread-resume-evt)
#f
#f
0
@ -7874,7 +8106,14 @@
lst_0))
(end-atomic)))))))
(define struct:thread-receiver-evt
(make-record-type-descriptor* 'thread-receive-evt #f #f #f #f 0 0))
(make-record-type-descriptor*
'thread-receive-evt
#f
(|#%nongenerative-uid| thread-receive-evt)
#f
#f
0
0))
(define effect_2592
(struct-type-install-properties!
struct:thread-receiver-evt
@ -7974,7 +8213,15 @@
#f))))
(begin-unsafe (set! thread-engine-for-roots thread-engine_0))))
(void)))
(define struct:channel (make-record-type-descriptor* 'channel #f #f #f #f 2 0))
(define struct:channel
(make-record-type-descriptor*
'channel
#f
(|#%nongenerative-uid| channel)
#f
#f
2
0))
(define effect_1795
(struct-type-install-properties!
struct:channel
@ -8039,7 +8286,14 @@
'channel
'put-queue))))))
(define struct:channel-put-evt*
(make-record-type-descriptor* 'channel-put-evt #f #f #f #f 2 0))
(make-record-type-descriptor*
'channel-put-evt
#f
(|#%nongenerative-uid| channel-put-evt)
#f
#f
2
0))
(define effect_2694
(struct-type-install-properties!
struct:channel-put-evt*
@ -8116,7 +8370,7 @@
(make-record-type-descriptor*
'channel-select-waiter
struct:select-waiter
#f
(|#%nongenerative-uid| channel-select-waiter)
#f
#f
1
@ -8627,7 +8881,14 @@
(loop_0 (cddr args_1))))))))))
(loop_0 args_0))))
(define struct:syncing
(make-record-type-descriptor* 'syncing #f #f #f #f 5 31))
(make-record-type-descriptor*
'syncing
#f
(|#%nongenerative-uid| syncing)
#f
#f
5
31))
(define effect_2377
(struct-type-install-properties!
struct:syncing
@ -8825,7 +9086,15 @@
v
'syncing
'need-retry?))))))
(define struct:syncer (make-record-type-descriptor* 'syncer #f #f #f #f 9 511))
(define struct:syncer
(make-record-type-descriptor*
'syncer
#f
(|#%nongenerative-uid| syncer)
#f
#f
9
511))
(define effect_2549
(struct-type-install-properties!
struct:syncer
@ -10348,7 +10617,7 @@
(retry_0))
(end-atomic))))))
(define struct:replacing-evt
(make-record-type-descriptor* 'evt #f #f #f #f 1 0))
(make-record-type-descriptor* 'evt #f (|#%nongenerative-uid| evt) #f #f 1 0))
(define effect_2634
(struct-type-install-properties!
struct:replacing-evt
@ -10400,7 +10669,7 @@
'evt
'guard))))))
(define struct:nested-sync-evt
(make-record-type-descriptor* 'evt #f #f #f #f 3 0))
(make-record-type-descriptor* 'evt #f (|#%nongenerative-uid| evt) #f #f 3 0))
(define effect_2232
(struct-type-install-properties!
struct:nested-sync-evt
@ -10617,7 +10886,14 @@
(unsafe-make-place-local
(wrap-evt7.1 (unsafe-place-local-ref cell.1$5) void)))
(define struct:system-idle-evt
(make-record-type-descriptor* 'system-idle-evt #f #f #f #f 0 0))
(make-record-type-descriptor*
'system-idle-evt
#f
(|#%nongenerative-uid| system-idle-evt)
#f
#f
0
0))
(define effect_2282
(struct-type-install-properties!
struct:system-idle-evt
@ -10671,7 +10947,14 @@
(define TICKS 100000)
(define set-schedule-quantum! (lambda (n_0) (set! TICKS n_0)))
(define struct:future*
(make-record-type-descriptor* 'future #f #f #f #f 10 1016))
(make-record-type-descriptor*
'future
#f
(|#%nongenerative-uid| future)
#f
#f
10
1016))
(define effect_2884
(struct-type-install-properties!
struct:future*
@ -11059,7 +11342,14 @@
(define 1/futures-enabled?
(|#%name| futures-enabled? (lambda () (begin (|#%app| threaded?)))))
(define struct:future-evt
(make-record-type-descriptor* 'future-evt #f #f #f #f 1 0))
(make-record-type-descriptor*
'future-evt
#f
(|#%nongenerative-uid| future-evt)
#f
#f
1
0))
(define effect_2445
(struct-type-install-properties!
struct:future-evt
@ -11495,7 +11785,14 @@
(define pthread-count 1)
(define set-processor-count! (lambda (n_0) (set! pthread-count n_0)))
(define struct:scheduler
(make-record-type-descriptor* 'scheduler #f #f #f #f 6 7))
(make-record-type-descriptor*
'scheduler
#f
(|#%nongenerative-uid| scheduler)
#f
#f
6
7))
(define effect_2609
(struct-type-install-properties!
struct:scheduler
@ -11533,7 +11830,15 @@
(|#%name| set-scheduler-futures-head! (record-mutator struct:scheduler 1)))
(define set-scheduler-futures-tail!
(|#%name| set-scheduler-futures-tail! (record-mutator struct:scheduler 2)))
(define struct:worker (make-record-type-descriptor* 'worker #f #f #f #f 5 26))
(define struct:worker
(make-record-type-descriptor*
'worker
#f
(|#%nongenerative-uid| worker)
#f
#f
5
26))
(define effect_2322
(struct-type-install-properties!
struct:worker
@ -12371,7 +12676,14 @@
(define set-check-place-activity!
(lambda (proc_0) (set! check-place-activity proc_0)))
(define struct:alarm-evt
(make-record-type-descriptor* 'alarm-evt #f #f #f #f 1 0))
(make-record-type-descriptor*
'alarm-evt
#f
(|#%nongenerative-uid| alarm-evt)
#f
#f
1
0))
(define effect_2291
(struct-type-install-properties!
struct:alarm-evt
@ -12926,7 +13238,14 @@
((s_0 proc_0 try-fail12_0 . args_0)
(call-with-semaphore/enable-break_0 s_0 proc_0 try-fail12_0 args_0))))))
(define struct:will-executor
(make-record-type-descriptor* 'will-executor #f #f #f #f 2 0))
(make-record-type-descriptor*
'will-executor
#f
(|#%nongenerative-uid| will-executor)
#f
#f
2
0))
(define effect_3021
(struct-type-install-properties!
struct:will-executor
@ -13949,7 +14268,14 @@
(loop_0)))))))))))
(loop_0)))))
(define struct:place-done-evt
(make-record-type-descriptor* 'place-dead-evt #f #f #f #f 2 0))
(make-record-type-descriptor*
'place-dead-evt
#f
(|#%nongenerative-uid| place-dead-evt)
#f
#f
2
0))
(define effect_2146
(struct-type-install-properties!
struct:place-done-evt
@ -14048,7 +14374,14 @@
(raise-argument-error 'place-dead-evt "place?" p_0))
(place-done-evt3.1 p_0 #f))))))
(define struct:message-queue
(make-record-type-descriptor* 'message-queue #f #f #f #f 6 22))
(make-record-type-descriptor*
'message-queue
#f
(|#%nongenerative-uid| message-queue)
#f
#f
6
22))
(define effect_2821
(struct-type-install-properties!
struct:message-queue
@ -14196,7 +14529,14 @@
(|#%app| host:mutex-release lock_0)
(|#%app| success-k_0 (car q_0))))))))))))
(define struct:pchannel
(make-record-type-descriptor* 'place-channel #f #f #f #f 6 0))
(make-record-type-descriptor*
'place-channel
#f
(|#%nongenerative-uid| place-channel)
#f
#f
6
0))
(define effect_2712
(struct-type-install-properties!
struct:pchannel
@ -14478,7 +14818,14 @@
(lambda () (ensure-wakeup-handle!))))
(void)))
(define struct:fsemaphore
(make-record-type-descriptor* 'fsemaphore #f #f #f #f 4 13))
(make-record-type-descriptor*
'fsemaphore
#f
(|#%nongenerative-uid| fsemaphore)
#f
#f
4
13))
(define effect_2870
(struct-type-install-properties!
struct:fsemaphore
@ -14514,7 +14861,14 @@
(define set-fsemaphore-dep-box!
(|#%name| set-fsemaphore-dep-box! (record-mutator struct:fsemaphore 3)))
(define struct:fsemaphore-box-evt
(make-record-type-descriptor* 'fsemaphore-box-evt #f #f #f #f 1 0))
(make-record-type-descriptor*
'fsemaphore-box-evt
#f
(|#%nongenerative-uid| fsemaphore-box-evt)
#f
#f
1
0))
(define effect_2902
(struct-type-install-properties!
struct:fsemaphore-box-evt
@ -14709,7 +15063,14 @@
(lambda () (begin (start-atomic) (|#%app| proc_0))))
(void))))))
(define struct:os-semaphore
(make-record-type-descriptor* 'os-semaphore #f #f #f #f 3 1))
(make-record-type-descriptor*
'os-semaphore
#f
(|#%nongenerative-uid| os-semaphore)
#f
#f
3
1))
(define effect_3038
(struct-type-install-properties!
struct:os-semaphore

1
racket/src/expander/compile/built-in-symbol.rkt
View File

@ -90,6 +90,7 @@
#%struct-predicate
#%struct-field-accessor
#%struct-field-mutator
#%nongenerative-uid
unsafe-struct?
unsafe-struct
raise-binding-result-arity-error

2
racket/src/schemify/schemify.rkt
View File

@ -517,7 +517,7 @@
(define new-seq
(struct-convert v prim-knowns knowns imports exports mutated
(lambda (v knowns) (schemify/knowns knowns inline-fuel 'fresh v))
target no-prompt?))
target no-prompt? #t))
(or new-seq
(match v
[`(,_ ,ids ,rhs)

9
racket/src/schemify/struct-convert.rkt
View File

@ -12,7 +12,7 @@
struct-convert-local)
(define (struct-convert form prim-knowns knowns imports exports mutated
schemify target no-prompt?)
schemify target no-prompt? top?)
(match form
[`(define-values (,struct:s ,make-s ,s? ,acc/muts ...)
(let-values (((,struct: ,make ,?1 ,-ref ,-set!) ,mk))
@ -64,7 +64,10 @@
(define ,struct:s (make-record-type-descriptor* ',(struct-type-info-name sti)
,(schemify (struct-type-info-parent sti) knowns)
,(if (not (struct-type-info-prefab-immutables sti))
#f
(if (and top?
(aim? target 'system))
`(#%nongenerative-uid ,(struct-type-info-name sti))
#f)
`(structure-type-lookup-prefab-uid
',(struct-type-info-name sti)
,(schemify (struct-type-info-parent sti) knowns)
@ -199,7 +202,7 @@
(define new-seq
(struct-convert defn
prim-knowns knowns imports #f mutated
schemify target #t))
schemify target #t #f))
(and new-seq
(match new-seq
[`(begin . ,new-seq)