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

RacketCS: preserve immutability when encoding structs as chez records

Browse Source
This commit is contained in:
yjqww6 2020-11-30 22:29:25 +08:00 committed by GitHub
parent c3c5a33c53
commit 20be8ffc03
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
8 changed files with 539 additions and 289 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -501,8 +501,15 @@
parent-rtd*
prefab-uid #f #f
(+ init-count auto-count)
;; Reporting all as mutable, for now:
(sub1 (general-arithmetic-shift 1 (+ init-count auto-count))))]
(let ([mask (sub1 (general-arithmetic-shift 1 (+ init-count auto-count)))])
(if (eq? insp 'prefab)
mask
(let loop ([imms immutables] [mask mask])
(cond
[(null? imms) mask]
[else
(let ([m (bitwise-not (arithmetic-shift 1 (car imms)))])
(loop (cdr imms) (bitwise-and mask m)))])))))]
[parent-auto*-count (get-field-info-auto*-count parent-fi)]
[parent-init*-count (get-field-info-init*-count parent-fi)]
[parent-total*-count (get-field-info-total*-count parent-fi)]
@ -747,7 +754,6 @@
(let ([rtd (position-based-mutator-rtd pbm)])
(check-accessor-or-mutator-index who rtd pos)
(let* ([abs-pos (+ pos (position-based-mutator-offset pbm))]
[p (record-field-mutator rtd abs-pos)]
[rec-name (record-type-name rtd)]
[mut-name (string->symbol
(string-append "set-"
@ -760,10 +766,11 @@
[wrap-p
(procedure-rename
(if (struct-type-field-mutable? rtd pos)
(lambda (v a)
(if (record? v rtd)
(p v a)
(impersonate-set! p rtd pos abs-pos v a rec-name name)))
(let ([p (record-field-mutator rtd abs-pos)])
(lambda (v a)
(if (record? v rtd)
(p v a)
(impersonate-set! p rtd pos abs-pos v a rec-name name))))
(lambda (v a)
(cannot-modify-by-pos-error mut-name v pos)))
mut-name)])

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

@ -4022,7 +4022,7 @@
(define cell.2$4 (unsafe-make-place-local (make-hasheq)))
(define performance-place-init!
(lambda () (unsafe-place-local-set! cell.2$4 (make-hasheq))))
(define struct:region (make-record-type-descriptor* 'region #f #f #f #f 5 31))
(define struct:region (make-record-type-descriptor* 'region #f #f #f #f 5 30))
(define effect_2100
(struct-type-install-properties!
struct:region
@ -5492,7 +5492,7 @@
#f)
#f)))
(define struct:weak-intern-table
(make-record-type-descriptor* 'weak-intern-table #f #f #f #f 1 1))
(make-record-type-descriptor* 'weak-intern-table #f #f #f #f 1 0))
(define effect_2495
(struct-type-install-properties!
struct:weak-intern-table
@ -5526,7 +5526,7 @@
struct:weak-intern-table
0)
(void)))
(define struct:table (make-record-type-descriptor* 'table #f #f #f #f 3 7))
(define struct:table (make-record-type-descriptor* 'table #f #f #f #f 3 0))
(define effect_2793
(struct-type-install-properties!
struct:table
@ -5729,7 +5729,7 @@
(for-loop_0 0 (hash-iterate-first new-ht_0))))))
(table2.1 new-ht_0 count_0 (max 128 (* 2 count_0)))))))
(define struct:resolved-module-path
(make-record-type-descriptor* 'resolved-module-path #f #f #f #f 1 1))
(make-record-type-descriptor* 'resolved-module-path #f #f #f #f 1 0))
(define effect_2722
(struct-type-install-properties!
struct:resolved-module-path
@ -5910,7 +5910,7 @@
(list* 'submod root-mod-path_0 (cdr name_0))
root-mod-path_0))))))
(define struct:module-path-index
(make-record-type-descriptor* 'module-path-index #f #f #f #f 4 15))
(make-record-type-descriptor* 'module-path-index #f #f #f #f 4 12))
(define effect_2717
(struct-type-install-properties!
struct:module-path-index
@ -6670,7 +6670,7 @@
(set-box! small-ht_0 (hash-set (unbox small-ht_0) key_0 val_0))))
(define small-hash-keys (lambda (small-ht_0) (hash-keys (unbox small-ht_0))))
(define struct:serialize-state
(make-record-type-descriptor* 'serialize-state #f #f #f #f 12 4095))
(make-record-type-descriptor* 'serialize-state #f #f #f #f 12 0))
(define effect_2227
(struct-type-install-properties!
struct:serialize-state
@ -7372,7 +7372,7 @@
(if (immutable? d_0) (positive? (hash-count d_0)) #f)
#f)))))))))))
(define struct:preserved-property-value
(make-record-type-descriptor* 'preserved-property-value #f #f #f #f 1 1))
(make-record-type-descriptor* 'preserved-property-value #f #f #f #f 1 0))
(define effect_2975
(struct-type-install-properties!
struct:preserved-property-value
@ -7593,7 +7593,7 @@
(define deserialize-tamper
(lambda (t_0) (if (eq? t_0 'armed) (current-arm-inspectors) t_0)))
(define struct:modified-content
(make-record-type-descriptor* 'modified-content #f #f #f #f 2 3))
(make-record-type-descriptor* 'modified-content #f #f #f #f 2 0))
(define effect_2941
(struct-type-install-properties!
struct:modified-content
@ -7635,7 +7635,7 @@
struct:modified-content
1)
(void)))
(define struct:syntax (make-record-type-descriptor* 'syntax #f #f #f #f 7 127))
(define struct:syntax (make-record-type-descriptor* 'syntax #f #f #f #f 7 1))
(define effect_2384
(struct-type-install-properties!
struct:syntax
@ -8252,7 +8252,7 @@
(define syntax-place-init!
(lambda () (unsafe-place-local-set! cell.1$7 (make-weak-hasheq))))
(define struct:syntax-state
(make-record-type-descriptor* 'syntax-state #f #f #f #f 3 7))
(make-record-type-descriptor* 'syntax-state #f #f #f #f 3 1))
(define effect_2807
(struct-type-install-properties!
struct:syntax-state
@ -8389,7 +8389,7 @@
inspector_0)))
(datum->syntax$1 s_0 content_0 s_0 s_0))))
(define struct:full-binding
(make-record-type-descriptor* 'full-binding #f #f #f #f 2 3))
(make-record-type-descriptor* 'full-binding #f #f #f #f 2 0))
(define effect_2547
(struct-type-install-properties!
struct:full-binding
@ -8578,7 +8578,7 @@
#f
#f
9
511))
0))
(define effect_2899
(struct-type-install-properties!
struct:full-module-binding
@ -8719,7 +8719,7 @@
8)
(void)))
(define struct:simple-module-binding
(make-record-type-descriptor* 'simple-module-binding #f #f #f #f 4 15))
(make-record-type-descriptor* 'simple-module-binding #f #f #f #f 4 0))
(define effect_2189
(struct-type-install-properties!
struct:simple-module-binding
@ -8862,7 +8862,7 @@
(full-module-binding-extra-nominal-bindings b_0))))
(define empty-binding-table hash2610)
(define struct:table-with-bulk-bindings
(make-record-type-descriptor* 'table-with-bulk-bindings #f #f #f #f 3 7))
(make-record-type-descriptor* 'table-with-bulk-bindings #f #f #f #f 3 0))
(define effect_2548
(struct-type-install-properties!
struct:table-with-bulk-bindings
@ -8931,7 +8931,7 @@
(lambda (syms_0 bulk-bindings_0)
(table-with-bulk-bindings1.1 syms_0 syms_0 bulk-bindings_0)))
(define struct:bulk-binding-at
(make-record-type-descriptor* 'bulk-binding-at #f #f #f #f 2 3))
(make-record-type-descriptor* 'bulk-binding-at #f #f #f #f 2 0))
(define effect_2443
(struct-type-install-properties!
struct:bulk-binding-at
@ -8986,7 +8986,7 @@
(prop:bulk-binding bulk-binding?$1 bulk-binding-ref)
(make-struct-type-property 'bulk-binding))
(define struct:bulk-binding-class
(make-record-type-descriptor* 'bulk-binding-class #f #f #f #f 2 3))
(make-record-type-descriptor* 'bulk-binding-class #f #f #f #f 2 0))
(define effect_2256
(struct-type-install-properties!
struct:bulk-binding-class
@ -10679,7 +10679,7 @@
(begin
(if c_0 (hash-clear! c_0) (void))
(unsafe-set-box*! (unsafe-place-local-ref cell.2$3) #f))))))
(define struct:entry (make-record-type-descriptor* 'entry #f #f #f #f 4 15))
(define struct:entry (make-record-type-descriptor* 'entry #f #f #f #f 4 0))
(define effect_2205
(struct-type-install-properties!
struct:entry
@ -10743,7 +10743,7 @@
(define cell.2$3 (unsafe-make-place-local (box #f)))
(define cell.3$1 (unsafe-make-place-local 0))
(define struct:shifted-entry
(make-record-type-descriptor* 'shifted-entry #f #f #f #f 3 7))
(make-record-type-descriptor* 'shifted-entry #f #f #f #f 3 0))
(define effect_2339
(struct-type-install-properties!
struct:shifted-entry
@ -10959,7 +10959,7 @@
s_0))))))
(define cache-place-init!
(lambda () (begin (resolve-cache-place-init!) (sets-place-init!))))
(define struct:scope (make-record-type-descriptor* 'scope #f #f #f #f 3 7))
(define struct:scope (make-record-type-descriptor* 'scope #f #f #f #f 3 4))
(define effect_2612
(struct-type-install-properties!
struct:scope
@ -11046,7 +11046,7 @@
(define deserialize-scope-fill!
(lambda (s_0 bt_0) (set-scope-binding-table! s_0 bt_0)))
(define struct:interned-scope
(make-record-type-descriptor* 'interned-scope struct:scope #f #f #f 1 1))
(make-record-type-descriptor* 'interned-scope struct:scope #f #f #f 1 0))
(define effect_2683
(struct-type-install-properties!
struct:interned-scope
@ -11101,7 +11101,7 @@
0)
(void)))
(define struct:multi-scope
(make-record-type-descriptor* 'multi-scope #f #f #f #f 5 31))
(make-record-type-descriptor* 'multi-scope #f #f #f #f 5 0))
(define effect_2089
(struct-type-install-properties!
struct:multi-scope
@ -11373,7 +11373,7 @@
(begin-unsafe (set-scope-binding-table! s_0 bt_0))
(set-representative-scope-owner! s_0 owner_0))))
(define struct:shifted-multi-scope
(make-record-type-descriptor* 'shifted-multi-scope #f #f #f #f 2 3))
(make-record-type-descriptor* 'shifted-multi-scope #f #f #f #f 2 0))
(define effect_3041
(struct-type-install-properties!
struct:shifted-multi-scope
@ -12455,7 +12455,7 @@
(let ((f_0 procz1))
(loop_0 f_0 prev-result_0 sms_0 smss/maybe-fallbacks59_0 s_0)))))))
(define struct:propagation
(make-record-type-descriptor* 'propagation #f #f #f #f 7 127))
(make-record-type-descriptor* 'propagation #f #f #f #f 7 0))
(define effect_2826
(struct-type-install-properties!
struct:propagation
@ -14023,7 +14023,7 @@
#f
#f
1
1))
0))
(define effect_2203
(struct-type-install-properties!
struct:full-local-binding
@ -14160,7 +14160,7 @@
id_0))
id_0)))))))))))
(define struct:id-rename-transformer
(make-record-type-descriptor* 'rename-transformer #f #f #f #f 1 1))
(make-record-type-descriptor* 'rename-transformer #f #f #f #f 1 0))
(define effect_2777
(struct-type-install-properties!
struct:id-rename-transformer
@ -14989,7 +14989,7 @@
(syntax-inspector the-struct_0))))))))
(raise-argument-error 'struct-copy "syntax?" the-struct_0))))))))
(define struct:provided
(make-record-type-descriptor* 'provided #f #f #f #f 3 7))
(make-record-type-descriptor* 'provided #f #f #f #f 3 0))
(define effect_2693
(struct-type-install-properties!
struct:provided
@ -15074,7 +15074,7 @@
unsafe-undefined
binding_0))))))))))
(define struct:bulk-binding
(make-record-type-descriptor* 'bulk-binding #f #f #f #f 8 255))
(make-record-type-descriptor* 'bulk-binding #f #f #f #f 8 9))
(define effect_2366
(struct-type-install-properties!
struct:bulk-binding
@ -15303,7 +15303,7 @@
table_0))))))
(for-loop_0 hash2725 (hash-iterate-first provides_0))))))
(define struct:bulk-provide
(make-record-type-descriptor* 'bulk-provide #f #f #f #f 2 3))
(make-record-type-descriptor* 'bulk-provide #f #f #f #f 2 0))
(define effect_2367
(struct-type-install-properties!
struct:bulk-provide
@ -15377,7 +15377,7 @@
1)
(void)))
(define struct:bulk-binding-registry
(make-record-type-descriptor* 'bulk-binding-registry #f #f #f #f 1 1))
(make-record-type-descriptor* 'bulk-binding-registry #f #f #f #f 1 0))
(define effect_2382
(struct-type-install-properties!
struct:bulk-binding-registry
@ -15455,7 +15455,7 @@
#f)))
(define generate-lift-key (lambda () (gensym 'lift)))
(define struct:root-expand-context/outer
(make-record-type-descriptor* 'root-expand-context #f #f #f #f 4 15))
(make-record-type-descriptor* 'root-expand-context #f #f #f #f 4 0))
(define effect_2573
(struct-type-install-properties!
struct:root-expand-context/outer
@ -15519,7 +15519,7 @@
3)
(void)))
(define struct:root-expand-context/inner
(make-record-type-descriptor* 'root-expand-context/inner #f #f #f #f 7 127))
(make-record-type-descriptor* 'root-expand-context/inner #f #f #f #f 7 0))
(define effect_2774
(struct-type-install-properties!
struct:root-expand-context/inner
@ -16107,7 +16107,7 @@
"broken '#%linklet primitive table; maybe you need to use \"bootstrap-run.rkt\"")))
(void)))
(define struct:module-registry
(make-record-type-descriptor* 'module-registry #f #f #f #f 2 3))
(make-record-type-descriptor* 'module-registry #f #f #f #f 2 0))
(define effect_2643
(struct-type-install-properties!
struct:module-registry
@ -16233,7 +16233,7 @@
(let ((lock-box_0 (module-registry-lock-box r_0)))
(loop_0 lock-box_0 proc_0)))))
(define struct:namespace
(make-record-type-descriptor* 'namespace #f #f #f #f 15 32767))
(make-record-type-descriptor* 'namespace #f #f #f #f 15 4096))
(define effect_2453
(struct-type-install-properties!
struct:namespace
@ -16373,7 +16373,7 @@
12)
(void)))
(define struct:definitions
(make-record-type-descriptor* 'definitions #f #f #f #f 2 3))
(make-record-type-descriptor* 'definitions #f #f #f #f 2 0))
(define effect_2279
(struct-type-install-properties!
struct:definitions
@ -16954,7 +16954,7 @@
new-stx_1))))))
(for-loop_0 new-stx_0 old-stxes_0)))))
(define struct:syntax-binding-set
(make-record-type-descriptor* 'syntax-binding-set #f #f #f #f 1 1))
(make-record-type-descriptor* 'syntax-binding-set #f #f #f #f 1 0))
(define effect_2741
(struct-type-install-properties!
struct:syntax-binding-set
@ -17012,7 +17012,7 @@
struct:syntax-binding-set
0)
(void)))
(define struct:bind (make-record-type-descriptor* 'bind #f #f #f #f 3 7))
(define struct:bind (make-record-type-descriptor* 'bind #f #f #f #f 3 0))
(define effect_3043
(struct-type-install-properties!
struct:bind
@ -17489,7 +17489,7 @@
(define set-current-previously-unbound!
(lambda (proc_0) (set! current-previously-unbound proc_0)))
(define struct:module-use
(make-record-type-descriptor* 'module-use #f #f #f #f 2 3))
(make-record-type-descriptor* 'module-use #f #f #f #f 2 0))
(define effect_2861
(struct-type-install-properties!
struct:module-use
@ -17593,8 +17593,7 @@
(register-struct-field-accessor! module-use-module struct:module-use 0)
(register-struct-field-accessor! module-use-phase struct:module-use 1)
(void)))
(define struct:module
(make-record-type-descriptor* 'module #f #f #f #f 20 1048575))
(define struct:module (make-record-type-descriptor* 'module #f #f #f #f 20 16))
(define effect_2359
(struct-type-install-properties!
struct:module
@ -17690,7 +17689,7 @@
(register-struct-field-mutator! set-module-access! struct:module 4)
(void)))
(define struct:module-linklet-info
(make-record-type-descriptor* 'module-linklet-info #f #f #f #f 6 63))
(make-record-type-descriptor* 'module-linklet-info #f #f #f #f 6 0))
(define effect_2516
(struct-type-install-properties!
struct:module-linklet-info
@ -17830,7 +17829,7 @@
supermodule-name19_0
get-all-variables_0))))))))))
(define struct:module-instance
(make-record-type-descriptor* 'module-instance #f #f #f #f 7 127))
(make-record-type-descriptor* 'module-instance #f #f #f #f 7 52))
(define effect_2597
(struct-type-install-properties!
struct:module-instance
@ -19508,7 +19507,7 @@
(lambda (t_0) v_0)))))))))
(define 1/make-set!-transformer
(let ((struct:set!-transformer_0
(make-record-type-descriptor* 'set!-transformer #f #f #f #f 1 1)))
(make-record-type-descriptor* 'set!-transformer #f #f #f #f 1 0)))
(let ((effect2455
(struct-type-install-properties!
struct:set!-transformer_0
@ -19604,7 +19603,7 @@
(let ((or-part_0 (eq? t_0 variable)))
(if or-part_0 or-part_0 (local-variable? t_0)))))
(define struct:local-variable
(make-record-type-descriptor* 'local-variable #f #f #f #f 1 1))
(make-record-type-descriptor* 'local-variable #f #f #f #f 1 0))
(define effect_2447
(struct-type-install-properties!
struct:local-variable
@ -19670,7 +19669,7 @@
(1/set!-transformer-procedure t_0)
(if (1/rename-transformer? t_0) procz1 t_0)))))
(define struct:core-form
(make-record-type-descriptor* 'core-form #f #f #f #f 2 3))
(make-record-type-descriptor* 'core-form #f #f #f #f 2 0))
(define effect_2019
(struct-type-install-properties!
struct:core-form
@ -19973,7 +19972,7 @@
#f
#f
11
2047))
0))
(define effect_2428
(struct-type-install-properties!
struct:expand-context/outer
@ -20095,7 +20094,7 @@
#f
#f
22
4194303))
0))
(define effect_2689
(struct-type-install-properties!
struct:expand-context/inner
@ -22861,7 +22860,7 @@
(for-loop_0 null s_0)))))
s_0))))
(define struct:compile-context
(make-record-type-descriptor* 'compile-context #f #f #f #f 7 127))
(make-record-type-descriptor* 'compile-context #f #f #f #f 7 0))
(define effect_3051
(struct-type-install-properties!
struct:compile-context
@ -25472,7 +25471,7 @@
(let ((len_0 (|#%app| read-fasl-integer i_0)))
(read-bytes/exactly len_0 i_0))))
(define struct:mpi-intern-table
(make-record-type-descriptor* 'mpi-intern-table #f #f #f #f 2 3))
(make-record-type-descriptor* 'mpi-intern-table #f #f #f #f 2 0))
(define effect_2419
(struct-type-install-properties!
struct:mpi-intern-table
@ -25730,7 +25729,7 @@
(define top-level-require!-id (make-built-in-symbol! 'top-level-require!))
(define mpi-vector-id (make-built-in-symbol! 'mpi-vector))
(define struct:module-path-index-table
(make-record-type-descriptor* 'module-path-index-table #f #f #f #f 2 3))
(make-record-type-descriptor* 'module-path-index-table #f #f #f #f 2 0))
(define effect_2891
(struct-type-install-properties!
struct:module-path-index-table
@ -29493,7 +29492,7 @@
module-use1.1
'deserialize
deserialize))
(define struct:parsed (make-record-type-descriptor* 'parsed #f #f #f #f 1 1))
(define struct:parsed (make-record-type-descriptor* 'parsed #f #f #f #f 1 0))
(define effect_3163
(struct-type-install-properties!
struct:parsed
@ -29521,7 +29520,7 @@
(register-struct-field-accessor! parsed-s struct:parsed 0)
(void)))
(define struct:parsed-id
(make-record-type-descriptor* 'parsed-id struct:parsed #f #f #f 2 3))
(make-record-type-descriptor* 'parsed-id struct:parsed #f #f #f 2 0))
(define effect_2786
(struct-type-install-properties!
struct:parsed-id
@ -29616,7 +29615,7 @@
(register-struct-predicate! parsed-top-id?)
(void)))
(define struct:parsed-lambda
(make-record-type-descriptor* 'parsed-lambda struct:parsed #f #f #f 2 3))
(make-record-type-descriptor* 'parsed-lambda struct:parsed #f #f #f 2 0))
(define effect_2930
(struct-type-install-properties!
struct:parsed-lambda
@ -29656,7 +29655,7 @@
#f
#f
1
1))
0))
(define effect_2379
(struct-type-install-properties!
struct:parsed-case-lambda
@ -29691,7 +29690,7 @@
0)
(void)))
(define struct:parsed-app
(make-record-type-descriptor* 'parsed-app struct:parsed #f #f #f 2 3))
(make-record-type-descriptor* 'parsed-app struct:parsed #f #f #f 2 0))
(define effect_3155
(struct-type-install-properties!
struct:parsed-app
@ -29724,7 +29723,7 @@
(register-struct-field-accessor! parsed-app-rands struct:parsed-app 1)
(void)))
(define struct:parsed-if
(make-record-type-descriptor* 'parsed-if struct:parsed #f #f #f 3 7))
(make-record-type-descriptor* 'parsed-if struct:parsed #f #f #f 3 0))
(define effect_2697
(struct-type-install-properties!
struct:parsed-if
@ -29759,7 +29758,7 @@
(register-struct-field-accessor! parsed-if-els struct:parsed-if 2)
(void)))
(define struct:parsed-set!
(make-record-type-descriptor* 'parsed-set! struct:parsed #f #f #f 2 3))
(make-record-type-descriptor* 'parsed-set! struct:parsed #f #f #f 2 0))
(define effect_2794
(struct-type-install-properties!
struct:parsed-set!
@ -29799,7 +29798,7 @@
#f
#f
3
7))
0))
(define effect_2695
(struct-type-install-properties!
struct:parsed-with-continuation-mark
@ -29862,7 +29861,7 @@
#f
#f
1
1))
0))
(define effect_2144
(struct-type-install-properties!
|struct:parsed-#%variable-reference|
@ -29902,7 +29901,7 @@
0)
(void)))
(define struct:parsed-begin
(make-record-type-descriptor* 'parsed-begin struct:parsed #f #f #f 1 1))
(make-record-type-descriptor* 'parsed-begin struct:parsed #f #f #f 1 0))
(define effect_2775
(struct-type-install-properties!
struct:parsed-begin
@ -29932,7 +29931,7 @@
(register-struct-field-accessor! parsed-begin-body struct:parsed-begin 0)
(void)))
(define struct:parsed-begin0
(make-record-type-descriptor* 'parsed-begin0 struct:parsed #f #f #f 1 1))
(make-record-type-descriptor* 'parsed-begin0 struct:parsed #f #f #f 1 0))
(define effect_2776
(struct-type-install-properties!
struct:parsed-begin0
@ -29962,7 +29961,7 @@
(register-struct-field-accessor! parsed-begin0-body struct:parsed-begin0 0)
(void)))
(define struct:parsed-quote
(make-record-type-descriptor* 'parsed-quote struct:parsed #f #f #f 1 1))
(make-record-type-descriptor* 'parsed-quote struct:parsed #f #f #f 1 0))
(define effect_2325
(struct-type-install-properties!
struct:parsed-quote
@ -29999,7 +29998,7 @@
#f
#f
1
1))
0))
(define effect_2251
(struct-type-install-properties!
struct:parsed-quote-syntax
@ -30043,7 +30042,7 @@
#f
#f
3
7))
0))
(define effect_2852
(struct-type-install-properties!
struct:parsed-let_-values
@ -30171,7 +30170,7 @@
#f
#f
3
7))
0))
(define effect_2623
(struct-type-install-properties!
struct:parsed-define-values
@ -30231,7 +30230,7 @@
#f
#f
3
7))
0))
(define effect_1737
(struct-type-install-properties!
struct:parsed-define-syntaxes
@ -30291,7 +30290,7 @@
#f
#f
1
1))
0))
(define effect_2654
(struct-type-install-properties!
struct:parsed-begin-for-syntax
@ -30399,7 +30398,7 @@
#f
#f
1
1))
0))
(define effect_2329
(struct-type-install-properties!
|struct:parsed-#%module-begin|
@ -30439,7 +30438,7 @@
0)
(void)))
(define struct:parsed-module
(make-record-type-descriptor* 'parsed-module struct:parsed #f #f #f 10 1023))
(make-record-type-descriptor* 'parsed-module struct:parsed #f #f #f 10 0))
(define effect_2381
(struct-type-install-properties!
struct:parsed-module
@ -30609,7 +30608,7 @@
(seteq)
(unsafe-immutable-hash-iterate-first s-scs_0)))))))
(define struct:requires+provides
(make-record-type-descriptor* 'requires+provides #f #f #f #f 9 511))
(make-record-type-descriptor* 'requires+provides #f #f #f #f 9 384))
(define effect_2981
(struct-type-install-properties!
struct:requires+provides
@ -30724,7 +30723,7 @@
8)
(void)))
(define struct:required
(make-record-type-descriptor* 'required #f #f #f #f 4 15))
(make-record-type-descriptor* 'required #f #f #f #f 4 0))
(define effect_2154
(struct-type-install-properties!
struct:required
@ -30766,8 +30765,7 @@
struct:required
3)
(void)))
(define struct:nominal
(make-record-type-descriptor* 'nominal #f #f #f #f 4 15))
(define struct:nominal (make-record-type-descriptor* 'nominal #f #f #f #f 4 0))
(define effect_3046
(struct-type-install-properties!
struct:nominal
@ -30804,7 +30802,7 @@
(register-struct-field-accessor! nominal-sym struct:nominal 3)
(void)))
(define struct:bulk-required
(make-record-type-descriptor* 'bulk-required #f #f #f #f 5 31))
(make-record-type-descriptor* 'bulk-required #f #f #f #f 5 0))
(define effect_2563
(struct-type-install-properties!
struct:bulk-required
@ -32278,7 +32276,7 @@
table_0))))))
(for-loop_0 hash2589 (hash-iterate-first provides_0)))))))
(define struct:adjust-only
(make-record-type-descriptor* 'adjust-only #f #f #f #f 1 1))
(make-record-type-descriptor* 'adjust-only #f #f #f #f 1 0))
(define effect_2795
(struct-type-install-properties!
struct:adjust-only
@ -32330,7 +32328,7 @@
(register-struct-field-accessor! adjust-only-syms struct:adjust-only 0)
(void)))
(define struct:adjust-prefix
(make-record-type-descriptor* 'adjust-prefix #f #f #f #f 1 1))
(make-record-type-descriptor* 'adjust-prefix #f #f #f #f 1 0))
(define effect_2781
(struct-type-install-properties!
struct:adjust-prefix
@ -32384,7 +32382,7 @@
(register-struct-field-accessor! adjust-prefix-sym struct:adjust-prefix 0)
(void)))
(define struct:adjust-all-except
(make-record-type-descriptor* 'adjust-all-except #f #f #f #f 2 3))
(make-record-type-descriptor* 'adjust-all-except #f #f #f #f 2 0))
(define effect_3032
(struct-type-install-properties!
struct:adjust-all-except
@ -32465,7 +32463,7 @@
1)
(void)))
(define struct:adjust-rename
(make-record-type-descriptor* 'adjust-rename #f #f #f #f 2 3))
(make-record-type-descriptor* 'adjust-rename #f #f #f #f 2 0))
(define effect_2135
(struct-type-install-properties!
struct:adjust-rename
@ -35586,7 +35584,7 @@
temp14_1
temp15_0)))))))))
(define struct:compiled-in-memory
(make-record-type-descriptor* 'compiled-in-memory #f #f #f #f 13 8191))
(make-record-type-descriptor* 'compiled-in-memory #f #f #f #f 13 0))
(define effect_2489
(struct-type-install-properties!
struct:compiled-in-memory
@ -35976,7 +35974,7 @@
(define correlated-position (lambda (s_0) (syntax-position s_0)))
(define correlated-span (lambda (s_0) (syntax-span s_0)))
(define struct:correlated-linklet
(make-record-type-descriptor* 'correlated-linklet #f #f #f #f 3 7))
(make-record-type-descriptor* 'correlated-linklet #f #f #f #f 3 4))
(define effect_2481
(struct-type-install-properties!
struct:correlated-linklet
@ -37062,7 +37060,7 @@
(lambda (n_0 port_0)
(write-bytes (integer->integer-bytes n_0 4 #f #f) port_0)))
(define struct:linklet-directory
(make-record-type-descriptor* 'linklet-directory #f #f #f #f 1 1))
(make-record-type-descriptor* 'linklet-directory #f #f #f #f 1 0))
(define effect_2457
(struct-type-install-properties!
struct:linklet-directory
@ -37128,7 +37126,7 @@
0)
(void)))
(define struct:linklet-bundle
(make-record-type-descriptor* 'linklet-bundle #f #f #f #f 1 1))
(make-record-type-descriptor* 'linklet-bundle #f #f #f #f 1 0))
(define effect_2330
(struct-type-install-properties!
struct:linklet-bundle
@ -37633,7 +37631,7 @@
struct:syntax-literals
1)
(void)))
(define struct:header (make-record-type-descriptor* 'header #f #f #f #f 8 255))
(define struct:header (make-record-type-descriptor* 'header #f #f #f #f 8 36))
(define effect_2959
(struct-type-install-properties!
struct:header
@ -37878,7 +37876,7 @@
5)
(void)))
(define struct:variable-use
(make-record-type-descriptor* 'variable-use #f #f #f #f 2 3))
(make-record-type-descriptor* 'variable-use #f #f #f #f 2 0))
(define effect_2316
(struct-type-install-properties!
struct:variable-use
@ -39907,7 +39905,7 @@
existing-mu*_0
new-extra-inspectorss_0))))))
(define struct:link-info
(make-record-type-descriptor* 'link-info #f #f #f #f 4 15))
(make-record-type-descriptor* 'link-info #f #f #f #f 4 0))
(define effect_2302
(struct-type-install-properties!
struct:link-info
@ -47244,7 +47242,7 @@
(args (raise-binding-result-arity-error 4 args))))
(if log-performance? (end-performance-region) (void))))))))))
(define struct:instance-data
(make-record-type-descriptor* 'instance-data #f #f #f #f 2 3))
(make-record-type-descriptor* 'instance-data #f #f #f #f 2 0))
(define effect_2509
(struct-type-install-properties!
struct:instance-data
@ -49719,7 +49717,7 @@
(for-loop_0 hash2610 (hash-iterate-first ht_0))))))
c_0))))
(define struct:recompiled
(make-record-type-descriptor* 'recompiled #f #f #f #f 3 7))
(make-record-type-descriptor* 'recompiled #f #f #f #f 3 0))
(define effect_2476
(struct-type-install-properties!
struct:recompiled
@ -51271,7 +51269,7 @@
(define box-clear!
(lambda (b_0) (begin0 (reverse$1 (unbox b_0)) (set-box! b_0 null))))
(define struct:lift-context
(make-record-type-descriptor* 'lift-context #f #f #f #f 3 7))
(make-record-type-descriptor* 'lift-context #f #f #f #f 3 0))
(define effect_2900
(struct-type-install-properties!
struct:lift-context
@ -51313,7 +51311,7 @@
2)
(void)))
(define struct:lifted-bind
(make-record-type-descriptor* 'lifted-bind #f #f #f #f 3 7))
(make-record-type-descriptor* 'lifted-bind #f #f #f #f 3 0))
(define effect_3182
(struct-type-install-properties!
struct:lifted-bind
@ -51575,7 +51573,7 @@
fold-var_0))))))
(for-loop_0 null lifts_0))))))
(define struct:module-lift-context
(make-record-type-descriptor* 'module-lift-context #f #f #f #f 3 7))
(make-record-type-descriptor* 'module-lift-context #f #f #f #f 3 0))
(define effect_2402
(struct-type-install-properties!
struct:module-lift-context
@ -51667,7 +51665,7 @@
(error
"internal error: unrecognized lift-context type for module lift"))))))
(define struct:require-lift-context
(make-record-type-descriptor* 'require-lift-context #f #f #f #f 3 7))
(make-record-type-descriptor* 'require-lift-context #f #f #f #f 3 0))
(define effect_2549
(struct-type-install-properties!
struct:require-lift-context
@ -51731,7 +51729,7 @@
(|#%app| (require-lift-context-do-require require-lifts_0) s_0 phase_0)
(box-cons! (require-lift-context-requires require-lifts_0) s_0))))
(define struct:to-module-lift-context
(make-record-type-descriptor* 'to-module-lift-context #f #f #f #f 4 15))
(make-record-type-descriptor* 'to-module-lift-context #f #f #f #f 4 0))
(define effect_3102
(struct-type-install-properties!
struct:to-module-lift-context
@ -51815,7 +51813,7 @@
(lambda (to-module-lifts_0 s_0 phase_0)
(box-cons! (to-module-lift-context-ends to-module-lifts_0) s_0)))
(define struct:already-expanded
(make-record-type-descriptor* 'expanded-syntax #f #f #f #f 2 3))
(make-record-type-descriptor* 'expanded-syntax #f #f #f #f 2 0))
(define effect_2070
(struct-type-install-properties!
struct:already-expanded
@ -52215,7 +52213,7 @@
(datum->syntax$1 app_0 new4_0 orig-s3_0 (if track?1_0 orig-s3_0 #f)))
orig-s3_0)))))
(define struct:expanded+parsed
(make-record-type-descriptor* 'expanded+parsed #f #f #f #f 2 3))
(make-record-type-descriptor* 'expanded+parsed #f #f #f #f 2 0))
(define effect_2902
(struct-type-install-properties!
struct:expanded+parsed
@ -52254,7 +52252,7 @@
1)
(void)))
(define struct:semi-parsed-define-values
(make-record-type-descriptor* 'semi-parsed-define-values #f #f #f #f 4 15))
(make-record-type-descriptor* 'semi-parsed-define-values #f #f #f #f 4 0))
(define effect_2257
(struct-type-install-properties!
struct:semi-parsed-define-values
@ -52318,7 +52316,7 @@
3)
(void)))
(define struct:semi-parsed-begin-for-syntax
(make-record-type-descriptor* 'semi-parsed-begin-for-syntax #f #f #f #f 2 3))
(make-record-type-descriptor* 'semi-parsed-begin-for-syntax #f #f #f #f 2 0))
(define effect_2603
(struct-type-install-properties!
struct:semi-parsed-begin-for-syntax
@ -54650,7 +54648,7 @@
|#%declare|
|#%stratified-body|)))
(define struct:internal-definition-context
(make-record-type-descriptor* 'internal-definition-context #f #f #f #f 5 31))
(make-record-type-descriptor* 'internal-definition-context #f #f #f #f 5 0))
(define effect_1896
(struct-type-install-properties!
struct:internal-definition-context
@ -54802,7 +54800,7 @@
4)
(void)))
(define struct:env-mixin
(make-record-type-descriptor* 'env-mixin #f #f #f #f 4 15))
(make-record-type-descriptor* 'env-mixin #f #f #f #f 4 0))
(define effect_2814
(struct-type-install-properties!
struct:env-mixin
@ -59734,7 +59732,7 @@
(compile_0 s_0 ns_0 serializable?8_0 unsafe-undefined))
((s_0 ns7_0) (compile_0 s_0 ns7_0 #t unsafe-undefined))))))
(define struct:lifted-parsed-begin
(make-record-type-descriptor* 'lifted-parsed-begin #f #f #f #f 2 3))
(make-record-type-descriptor* 'lifted-parsed-begin #f #f #f #f 2 0))
(define effect_2904
(struct-type-install-properties!
struct:lifted-parsed-begin
@ -62446,7 +62444,7 @@
(find-system-path 'orig-dir)))
(|#%app| thunk_0))))
(define struct:shadow-directory
(make-record-type-descriptor* 'shadow-directory #f #f #f #f 2 3))
(make-record-type-descriptor* 'shadow-directory #f #f #f #f 2 0))
(define effect_2127
(struct-type-install-properties!
struct:shadow-directory
@ -63326,7 +63324,7 @@
v_0))
'current-readtable))
(define struct:read-config/outer
(make-record-type-descriptor* 'read-config #f #f #f #f 7 127))
(make-record-type-descriptor* 'read-config #f #f #f #f 7 0))
(define effect_2456
(struct-type-install-properties!
struct:read-config/outer
@ -63399,7 +63397,7 @@
6)
(void)))
(define struct:read-config/inner
(make-record-type-descriptor* 'read-config/inner #f #f #f #f 13 8191))
(make-record-type-descriptor* 'read-config/inner #f #f #f #f 13 0))
(define effect_2333
(struct-type-install-properties!
struct:read-config/inner
@ -64286,7 +64284,7 @@
(check-parameter 1/read-accept-reader config_0)
(check-parameter 1/read-accept-lang config_0))))))
(define struct:special-comment
(make-record-type-descriptor* 'special-comment #f #f #f #f 1 1))
(make-record-type-descriptor* 'special-comment #f #f #f #f 1 0))
(define effect_2850
(struct-type-install-properties!
struct:special-comment
@ -64319,7 +64317,7 @@
0)
(void)))
(define struct:readtable
(make-record-type-descriptor* 'readtable #f #f #f #f 4 15))
(make-record-type-descriptor* 'readtable #f #f #f #f 4 0))
(define effect_2799
(struct-type-install-properties!
struct:readtable
@ -64709,7 +64707,7 @@
(args (raise-binding-result-arity-error 2 args))))
fold-var_0))))))
(for-loop_0 null (hash-iterate-first ht_0))))))))))
(define struct:special (make-record-type-descriptor* 'special #f #f #f #f 1 1))
(define struct:special (make-record-type-descriptor* 'special #f #f #f #f 1 0))
(define effect_2658
(struct-type-install-properties!
struct:special
@ -65387,7 +65385,7 @@
(begin-unsafe (read-config/inner-st (read-config/outer-inner config_0)))
a_0)))
(define struct:indentation
(make-record-type-descriptor* 'indentation #f #f #f #f 8 255))
(make-record-type-descriptor* 'indentation #f #f #f #f 8 246))
(define effect_2519
(struct-type-install-properties!
struct:indentation
@ -66543,7 +66541,7 @@
convert-mode_0
single-mode_0))))
(define struct:parse-state
(make-record-type-descriptor* 'parse-state #f #f #f #f 5 31))
(make-record-type-descriptor* 'parse-state #f #f #f #f 5 0))
(define effect_2060
(struct-type-install-properties!
struct:parse-state
@ -66599,7 +66597,7 @@
4)
(void)))
(define struct:rect-prefix
(make-record-type-descriptor* 'rect-prefix #f #f #f #f 3 7))
(make-record-type-descriptor* 'rect-prefix #f #f #f #f 3 0))
(define effect_2587
(struct-type-install-properties!
struct:rect-prefix
@ -66635,7 +66633,7 @@
(register-struct-field-accessor! rect-prefix-start struct:rect-prefix 2)
(void)))
(define struct:polar-prefix
(make-record-type-descriptor* 'polar-prefix #f #f #f #f 3 7))
(make-record-type-descriptor* 'polar-prefix #f #f #f #f 3 0))
(define effect_2784
(struct-type-install-properties!
struct:polar-prefix
@ -66761,7 +66759,7 @@
(format "cannot combine extflonum `~a` into a complex number" i_0)
#f)))
(define struct:lazy-expt
(make-record-type-descriptor* 'lazy-expt #f #f #f #f 3 7))
(make-record-type-descriptor* 'lazy-expt #f #f #f #f 3 0))
(define effect_2624
(struct-type-install-properties!
struct:lazy-expt
@ -66796,7 +66794,7 @@
(register-struct-field-accessor! lazy-expt-exp struct:lazy-expt 2)
(void)))
(define struct:lazy-rational
(make-record-type-descriptor* 'lazy-rational #f #f #f #f 2 3))
(make-record-type-descriptor* 'lazy-rational #f #f #f #f 2 0))
(define effect_2285
(struct-type-install-properties!
struct:lazy-rational

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

@ -3700,7 +3700,7 @@
(|#%app| rktio_free h_0)
(loop_0 #t))))))))))
(loop_0 #f))))))
(define struct:exts (make-record-type-descriptor* 'exts #f #f #f #f 2 3))
(define struct:exts (make-record-type-descriptor* 'exts #f #f #f #f 2 0))
(define effect_2383
(struct-type-install-properties!
struct:exts
@ -3992,7 +3992,7 @@
(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 127))
(make-record-type-descriptor* 'core-port #f #f #f #f 7 124))
(define effect_2716
(struct-type-install-properties!
struct:core-port
@ -4061,7 +4061,7 @@
(register-struct-field-mutator! set-core-port-count! struct:core-port 6)
(void)))
(define struct:core-port-methods.1
(make-record-type-descriptor* 'core-port-methods #f #f #f #f 5 31))
(make-record-type-descriptor* 'core-port-methods #f #f #f #f 5 0))
(define effect_2750
(struct-type-install-properties!
struct:core-port-methods.1
@ -4474,7 +4474,7 @@
#f
#f
6
63))
0))
(define effect_3216
(struct-type-install-properties!
struct:core-input-port-methods.1
@ -4861,7 +4861,7 @@
#f
#f
4
15))
0))
(define effect_2581
(struct-type-install-properties!
struct:core-output-port-methods.1
@ -5046,7 +5046,7 @@
(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 1))
(make-record-type-descriptor* 'write-evt #f #f #f #f 1 0))
(define effect_2681
(struct-type-install-properties!
struct:write-evt
@ -5117,7 +5117,7 @@
#f
#f))
(define struct:utf-8-state
(make-record-type-descriptor* 'utf-8-state #f #f #f #f 3 7))
(make-record-type-descriptor* 'utf-8-state #f #f #f #f 3 0))
(define effect_2417
(struct-type-install-properties!
struct:utf-8-state
@ -7270,7 +7270,7 @@
(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 7))
(make-record-type-descriptor* 'commit-manager #f #f #f #f 3 0))
(define effect_3024
(struct-type-install-properties!
struct:commit-manager
@ -7371,7 +7371,7 @@
2)
(void)))
(define struct:commit-request
(make-record-type-descriptor* 'commit-request #f #f #f #f 5 31))
(make-record-type-descriptor* 'commit-request #f #f #f #f 5 0))
(define effect_2327
(struct-type-install-properties!
struct:commit-request
@ -7514,7 +7514,7 @@
4)
(void)))
(define struct:commit-response
(make-record-type-descriptor* 'commit-response #f #f #f #f 2 3))
(make-record-type-descriptor* 'commit-response #f #f #f #f 2 0))
(define effect_2424
(struct-type-install-properties!
struct:commit-response
@ -8088,7 +8088,7 @@
(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 65535))
(make-record-type-descriptor* 'pipe-data #f #f #f #f 16 65534))
(define effect_3136
(struct-type-install-properties!
struct:pipe-data
@ -9419,7 +9419,7 @@
((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 1))
(make-record-type-descriptor* 'pipe-write-poller #f #f #f #f 1 0))
(define effect_2371
(struct-type-install-properties!
struct:pipe-write-poller
@ -9506,7 +9506,7 @@
0)
(void)))
(define struct:pipe-read-poller
(make-record-type-descriptor* 'pipe-read-poller #f #f #f #f 1 1))
(make-record-type-descriptor* 'pipe-read-poller #f #f #f #f 1 0))
(define effect_2394
(struct-type-install-properties!
struct:pipe-read-poller
@ -9720,7 +9720,7 @@
#f
#f
1
1))
0))
(define effect_2651
(struct-type-install-properties!
struct:peek-via-read-input-port-methods.1
@ -10517,7 +10517,7 @@
#f
#f
2
3))
0))
(define effect_2334
(struct-type-install-properties!
struct:fd-input-port-methods.1
@ -10961,7 +10961,7 @@
#f
#f
2
3))
0))
(define effect_2413
(struct-type-install-properties!
struct:fd-output-port-methods.1
@ -11586,7 +11586,7 @@
(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 7))
(define struct:fd-evt (make-record-type-descriptor* 'fd-evt #f #f #f #f 3 4))
(define effect_2590
(struct-type-install-properties!
struct:fd-evt
@ -11731,7 +11731,7 @@
(register-struct-field-mutator! set-fd-evt-closed! struct:fd-evt 2)
(void)))
(define struct:rktio-fd-flushed-evt
(make-record-type-descriptor* 'rktio-fd-flushed-evt #f #f #f #f 1 1))
(make-record-type-descriptor* 'rktio-fd-flushed-evt #f #f #f #f 1 0))
(define effect_2959
(struct-type-install-properties!
struct:rktio-fd-flushed-evt
@ -12546,7 +12546,7 @@
(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 3))
(make-record-type-descriptor* 'progress-evt #f #f #f #f 2 0))
(define effect_2604
(struct-type-install-properties!
struct:progress-evt
@ -15864,7 +15864,7 @@
(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 3))
(make-record-type-descriptor* 'utf-8-converter #f #f #f #f 2 0))
(define effect_2723
(struct-type-install-properties!
struct:utf-8-converter
@ -18171,7 +18171,7 @@
(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 3))
(define struct:path (make-record-type-descriptor* 'path #f #f #f #f 2 0))
(define effect_2407
(struct-type-install-properties!
struct:path
@ -19901,7 +19901,7 @@
#f
#f
2
3))
0))
(define effect_2372
(struct-type-install-properties!
struct:bytes-output-port-methods.1
@ -21728,7 +21728,7 @@
(lambda (v_0 fuel_0 mode_0 print-graph?_0 config_0)
(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 1))
(make-record-type-descriptor* 'as-constructor #f #f #f #f 1 0))
(define effect_2971
(struct-type-install-properties!
struct:as-constructor
@ -25008,7 +25008,7 @@
(just-separators-after? s_0 2)
#f))))))
(define struct:starting-point
(make-record-type-descriptor* 'starting-point #f #f #f #f 7 127))
(make-record-type-descriptor* 'starting-point #f #f #f #f 7 0))
(define effect_2720
(struct-type-install-properties!
struct:starting-point
@ -27109,7 +27109,7 @@
(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 15))
(make-record-type-descriptor* 'security-guard #f #f #f #f 4 0))
(define effect_2690
(struct-type-install-properties!
struct:security-guard
@ -33362,7 +33362,7 @@
(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 2047))
(make-record-type-descriptor* 'logger #f #f #f #f 11 376))
(define effect_2192
(struct-type-install-properties!
struct:logger
@ -33904,7 +33904,7 @@
(register-struct-field-mutator! set-queue-start! struct:queue 0)
(register-struct-field-mutator! set-queue-end! struct:queue 1)
(void)))
(define struct:node (make-record-type-descriptor* 'node #f #f #f #f 3 7))
(define struct:node (make-record-type-descriptor* 'node #f #f #f #f 3 6))
(define effect_2547
(struct-type-install-properties!
struct:node
@ -33971,7 +33971,7 @@
(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 1))
(make-record-type-descriptor* 'log-receiver #f #f #f #f 1 0))
(define effect_2708
(struct-type-install-properties!
struct:log-receiver
@ -34038,7 +34038,7 @@
#f
#f
3
7))
0))
(define effect_2757
(struct-type-install-properties!
struct:queue-log-receiver
@ -34232,7 +34232,7 @@
#f
#f
2
3))
0))
(define effect_2592
(struct-type-install-properties!
struct:stdio-log-receiver
@ -34391,7 +34391,7 @@
#f
#f
2
3))
0))
(define effect_2241
(struct-type-install-properties!
struct:syslog-log-receiver
@ -35914,7 +35914,7 @@
(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 7))
(make-record-type-descriptor* 'subprocess #f #f #f #f 3 3))
(define effect_2272
(struct-type-install-properties!
struct:subprocess
@ -37220,7 +37220,7 @@
(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 3))
(make-record-type-descriptor* 'rktio-evt #f #f #f #f 2 0))
(define effect_3001
(struct-type-install-properties!
struct:rktio-evt
@ -37838,7 +37838,7 @@
(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 7))
(make-record-type-descriptor* 'tcp-listener #f #f #f #f 3 0))
(define effect_2611
(struct-type-install-properties!
struct:tcp-listener
@ -38236,7 +38236,7 @@
(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 1))
(make-record-type-descriptor* 'tcp-accept-evt #f #f #f #f 1 0))
(define effect_2325
(struct-type-install-properties!
struct:accept-evt
@ -39614,7 +39614,7 @@
wait?53_0
who59_0)))))))
(define struct:udp-sending-evt
(make-record-type-descriptor* 'udp-send-evt #f #f #f #f 2 3))
(make-record-type-descriptor* 'udp-send-evt #f #f #f #f 2 0))
(define effect_2358
(struct-type-install-properties!
struct:udp-sending-evt
@ -40036,7 +40036,7 @@
(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 3))
(make-record-type-descriptor* 'udp-receive-evt #f #f #f #f 2 0))
(define effect_2355
(struct-type-install-properties!
struct:udp-receiving-evt

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

@ -931,7 +931,7 @@
(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 3))
(define struct:rx:alts (make-record-type-descriptor* 'rx:alts #f #f #f #f 2 0))
(define effect_2665
(struct-type-install-properties!
struct:rx:alts
@ -987,7 +987,7 @@
(register-struct-field-accessor! rx:alts-rx_2761 struct:rx:alts 1)
(void)))
(define struct:rx:sequence
(make-record-type-descriptor* 'rx:sequence #f #f #f #f 2 3))
(make-record-type-descriptor* 'rx:sequence #f #f #f #f 2 0))
(define effect_2137
(struct-type-install-properties!
struct:rx:sequence
@ -1061,7 +1061,7 @@
1)
(void)))
(define struct:rx:group
(make-record-type-descriptor* 'rx:group #f #f #f #f 2 3))
(make-record-type-descriptor* 'rx:group #f #f #f #f 2 0))
(define effect_2340
(struct-type-install-properties!
struct:rx:group
@ -1129,7 +1129,7 @@
(register-struct-field-accessor! rx:group-number struct:rx:group 1)
(void)))
(define struct:rx:repeat
(make-record-type-descriptor* 'rx:repeat #f #f #f #f 4 15))
(make-record-type-descriptor* 'rx:repeat #f #f #f #f 4 0))
(define effect_2551
(struct-type-install-properties!
struct:rx:repeat
@ -1232,7 +1232,7 @@
(register-struct-field-accessor! rx:repeat-non-greedy? struct:rx:repeat 3)
(void)))
(define struct:rx:maybe
(make-record-type-descriptor* 'rx:maybe #f #f #f #f 2 3))
(make-record-type-descriptor* 'rx:maybe #f #f #f #f 2 0))
(define effect_2619
(struct-type-install-properties!
struct:rx:maybe
@ -1300,7 +1300,7 @@
(register-struct-field-accessor! rx:maybe-non-greedy? struct:rx:maybe 1)
(void)))
(define struct:rx:conditional
(make-record-type-descriptor* 'rx:conditional #f #f #f #f 6 63))
(make-record-type-descriptor* 'rx:conditional #f #f #f #f 6 0))
(define effect_2459
(struct-type-install-properties!
struct:rx:conditional
@ -1459,7 +1459,7 @@
5)
(void)))
(define struct:rx:lookahead
(make-record-type-descriptor* 'rx:lookahead #f #f #f #f 4 15))
(make-record-type-descriptor* 'rx:lookahead #f #f #f #f 4 0))
(define effect_2324
(struct-type-install-properties!
struct:rx:lookahead
@ -1567,7 +1567,7 @@
(register-struct-field-accessor! rx:lookahead-num-n struct:rx:lookahead 3)
(void)))
(define struct:rx:lookbehind
(make-record-type-descriptor* 'rx:lookbehind #f #f #f #f 6 63))
(make-record-type-descriptor* 'rx:lookbehind #f #f #f #f 6 12))
(define effect_2263
(struct-type-install-properties!
struct:rx:lookbehind
@ -1764,7 +1764,7 @@
struct:rx:lookbehind
3)
(void)))
(define struct:rx:cut (make-record-type-descriptor* 'rx:cut #f #f #f #f 4 15))
(define struct:rx:cut (make-record-type-descriptor* 'rx:cut #f #f #f #f 4 0))
(define effect_2942
(struct-type-install-properties!
struct:rx:cut
@ -1859,7 +1859,7 @@
(register-struct-field-accessor! rx:cut-needs-backtrack? struct:rx:cut 3)
(void)))
(define struct:rx:reference
(make-record-type-descriptor* 'rx:reference #f #f #f #f 2 3))
(make-record-type-descriptor* 'rx:reference #f #f #f #f 2 0))
(define effect_2344
(struct-type-install-properties!
struct:rx:reference
@ -1935,7 +1935,7 @@
1)
(void)))
(define struct:rx:range
(make-record-type-descriptor* 'rx:range #f #f #f #f 1 1))
(make-record-type-descriptor* 'rx:range #f #f #f #f 1 0))
(define effect_2702
(struct-type-install-properties!
struct:rx:range
@ -1986,7 +1986,7 @@
(register-struct-field-accessor! rx:range-range struct:rx:range 0)
(void)))
(define struct:rx:unicode-categories
(make-record-type-descriptor* 'rx:unicode-categories #f #f #f #f 2 3))
(make-record-type-descriptor* 'rx:unicode-categories #f #f #f #f 2 0))
(define effect_2129
(struct-type-install-properties!
struct:rx:unicode-categories
@ -2270,7 +2270,7 @@
(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 127))
(make-record-type-descriptor* 'parse-config #f #f #f #f 7 0))
(define effect_2566
(struct-type-install-properties!
struct:parse-config
@ -4926,7 +4926,7 @@
#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 8191))
(make-record-type-descriptor* 'lazy-bytes #f #f #f #f 13 3075))
(define effect_2272
(struct-type-install-properties!
struct:lazy-bytes
@ -7578,7 +7578,7 @@
(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 1023))
(make-record-type-descriptor* 'regexp #f #f #f #f 10 0))
(define effect_2503
(struct-type-install-properties!
struct:rx:regexp

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

@ -4378,7 +4378,7 @@
(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 15))
(define struct:import (make-record-type-descriptor* 'import #f #f #f #f 4 0))
(define effect_2897
(struct-type-install-properties!
struct:import
@ -4467,7 +4467,7 @@
(register-struct-field-accessor! import-ext-id struct:import 3)
(void)))
(define struct:import-group
(make-record-type-descriptor* 'import-group #f #f #f #f 6 63))
(make-record-type-descriptor* 'import-group #f #f #f #f 6 60))
(define effect_2514
(struct-type-install-properties!
struct:import-group
@ -4868,7 +4868,7 @@
(|#%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 3))
(define struct:export (make-record-type-descriptor* 'export #f #f #f #f 2 0))
(define effect_2166
(struct-type-install-properties!
struct:export
@ -4929,7 +4929,7 @@
(register-struct-field-accessor! export-ext-id struct:export 1)
(void)))
(define struct:too-early
(make-record-type-descriptor* 'too-early #f #f #f #f 2 3))
(make-record-type-descriptor* 'too-early #f #f #f #f 2 0))
(define effect_2681
(struct-type-install-properties!
struct:too-early
@ -7034,18 +7034,18 @@
((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 9 511))
(define effect_2978
(make-record-type-descriptor* 'struct-type-info #f #f #f #f 10 0))
(define effect_3042
(struct-type-install-properties!
struct:struct-type-info
'struct-type-info
9
10
0
#f
null
(current-inspector)
#f
'(0 1 2 3 4 5 6 7 8)
'(0 1 2 3 4 5 6 7 8 9)
#f
'struct-type-info))
(define struct-type-info1.1
@ -7189,41 +7189,59 @@
s
'struct-type-info
'prefab-immutables))))))
(define struct-type-info-constructor-name-expr_2507
(define struct-type-info-non-prefab-immutables_2507
(|#%name|
struct-type-info-non-prefab-immutables
(record-accessor struct:struct-type-info 7)))
(define struct-type-info-non-prefab-immutables
(|#%name|
struct-type-info-non-prefab-immutables
(lambda (s)
(if (struct-type-info?_2591 s)
(struct-type-info-non-prefab-immutables_2507 s)
($value
(impersonate-ref
struct-type-info-non-prefab-immutables_2507
struct:struct-type-info
7
s
'struct-type-info
'non-prefab-immutables))))))
(define struct-type-info-constructor-name-expr_2796
(|#%name|
struct-type-info-constructor-name-expr
(record-accessor struct:struct-type-info 7)))
(record-accessor struct:struct-type-info 8)))
(define struct-type-info-constructor-name-expr
(|#%name|
struct-type-info-constructor-name-expr
(lambda (s)
(if (struct-type-info?_2591 s)
(struct-type-info-constructor-name-expr_2507 s)
(struct-type-info-constructor-name-expr_2796 s)
($value
(impersonate-ref
struct-type-info-constructor-name-expr_2507
struct-type-info-constructor-name-expr_2796
struct:struct-type-info
7
8
s
'struct-type-info
'constructor-name-expr))))))
(define struct-type-info-rest_2796
(|#%name| struct-type-info-rest (record-accessor struct:struct-type-info 8)))
(define struct-type-info-rest_2430
(|#%name| struct-type-info-rest (record-accessor struct:struct-type-info 9)))
(define struct-type-info-rest
(|#%name|
struct-type-info-rest
(lambda (s)
(if (struct-type-info?_2591 s)
(struct-type-info-rest_2796 s)
(struct-type-info-rest_2430 s)
($value
(impersonate-ref
struct-type-info-rest_2796
struct-type-info-rest_2430
struct:struct-type-info
8
9
s
'struct-type-info
'rest))))))
(define effect_2648
(define effect_1914
(begin
(register-struct-constructor! struct-type-info1.1)
(register-struct-predicate! struct-type-info?)
@ -7256,13 +7274,17 @@
struct:struct-type-info
6)
(register-struct-field-accessor!
struct-type-info-constructor-name-expr
struct-type-info-non-prefab-immutables
struct:struct-type-info
7)
(register-struct-field-accessor!
struct-type-info-rest
struct-type-info-constructor-name-expr
struct:struct-type-info
8)
(register-struct-field-accessor!
struct-type-info-rest
struct:struct-type-info
9)
(void)))
(define struct-type-info-rest-properties-list-pos 0)
(define make-struct-type-info
@ -8002,53 +8024,225 @@
(if (> (length rest_0) 5)
(list-ref rest_0 5)
#f)))
(if prefab-imms_1
(let ((app_0
(+
fields_0
(if u-parent_0
(known-struct-type-field-count
parent-sti_0)
0))))
(let ((app_1
(if (let ((or-part_0
(not u-parent_0)))
(if or-part_0
or-part_0
(known-struct-type-pure-constructor?
parent-sti_0)))
(let ((non-prefab-imms_0
(if (eq? prefab-imms_1 'non-prefab)
(if (begin-unsafe
(let ((app_0 (unwrap '())))
(eq? app_0 (unwrap rest_0))))
'()
(if (let ((p_0 (unwrap rest_0)))
(if (pair? p_0)
(let ((a_0 (cdr p_0)))
(begin-unsafe
(let ((app_0
(unwrap '())))
(eq?
app_0
(unwrap a_0)))))
#f))
'()
(if (let ((p_0 (unwrap rest_0)))
(if (pair? p_0)
(let ((a_0 (cdr p_0)))
(let ((p_1
(unwrap a_0)))
(if (pair? p_1)
(let ((a_1
(cdr p_1)))
(begin-unsafe
(let ((app_0
(unwrap
'())))
(eq?
app_0
(unwrap
a_1)))))
#f)))
#f))
'()
(if (let ((p_0
(unwrap rest_0)))
(if (pair? p_0)
(let ((a_0 (cdr p_0)))
(let ((p_1
(unwrap a_0)))
(if (pair? p_1)
(let ((a_1
(cdr
p_1)))
(let ((p_2
(unwrap
a_1)))
(if (pair?
p_2)
(let ((a_2
(cdr
p_2)))
(begin-unsafe
(let ((app_0
(unwrap
'())))
(eq?
app_0
(unwrap
a_2)))))
#f)))
#f)))
#f))
'()
(if (let ((p_0
(unwrap rest_0)))
(if (pair? p_0)
(let ((a_0
(cdr p_0)))
(let ((p_1
(unwrap
a_0)))
(if (pair? p_1)
(let ((a_1
(cdr
p_1)))
(let ((p_2
(unwrap
a_1)))
(if (pair?
p_2)
(let ((a_2
(cdr
p_2)))
(let ((p_3
(unwrap
a_2)))
(if (pair?
p_3)
(if (let ((a_3
(car
p_3)))
(let ((p_4
(unwrap
a_3)))
(if (pair?
p_4)
(if (let ((a_4
(car
p_4)))
(begin-unsafe
(let ((app_0
(unwrap
'quote)))
(eq?
app_0
(unwrap
a_4)))))
(let ((a_4
(cdr
p_4)))
(let ((p_5
(unwrap
a_4)))
(if (pair?
p_5)
(let ((a_5
(cdr
p_5)))
(begin-unsafe
(let ((app_0
(unwrap
'())))
(eq?
app_0
(unwrap
a_5)))))
#f)))
#f)
#f)))
#t
#f)
#f)))
#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)
#f)))))
#f)))
(if (if (eq? prefab-imms_1 'non-prefab)
non-prefab-imms_0
prefab-imms_1)
(let ((app_0
(+
fields_0
(if u-parent_0
(known-struct-type-field-count
parent-sti_0)
0))))
(let ((app_1
(if (let ((or-part_0
(<
(length rest_0)
5)))
(not u-parent_0)))
(if or-part_0
or-part_0
(not
(unwrap
(list-ref rest_0 4)))))
(not
(includes-property?_0
rest_0
'prop:chaperone-unsafe-undefined))
#f)
#f)))
(let ((app_2
(includes-property?_0
rest_0
'prop:authentic)))
(struct-type-info1.1
name_0
parent_0
fields_0
app_0
app_1
app_2
(if (eq? prefab-imms_1 'non-prefab)
#f
prefab-imms_1)
constructor-name-expr_0
rest_0))))
#f)))))
(known-struct-type-pure-constructor?
parent-sti_0)))
(if (let ((or-part_0
(<
(length rest_0)
5)))
(if or-part_0
or-part_0
(not
(unwrap
(list-ref
rest_0
4)))))
(not
(includes-property?_0
rest_0
'prop:chaperone-unsafe-undefined))
#f)
#f)))
(let ((app_2
(includes-property?_0
rest_0
'prop:authentic)))
(struct-type-info1.1
name_0
parent_0
fields_0
app_0
app_1
app_2
(if (eq? prefab-imms_1 'non-prefab)
#f
prefab-imms_1)
non-prefab-imms_0
constructor-name-expr_0
rest_0))))
#f))))))
#f)
#f)
#f)))))
@ -16203,7 +16397,34 @@
(let ((n_0
(struct-type-info-immediate-field-count
sti_0)))
(sub1 (arithmetic-shift 1 n_0)))))))))))
(let ((mask_0
(sub1 (arithmetic-shift 1 n_0))))
(let ((c1_0
(struct-type-info-non-prefab-immutables
sti_0)))
(if c1_0
(letrec*
((loop_0
(|#%name|
loop
(lambda (imms_0 mask_1)
(begin
(if (null? imms_0)
mask_1
(let ((m_0
(bitwise-not
(arithmetic-shift
1
(car imms_0)))))
(let ((app_4
(cdr imms_0)))
(loop_0
app_4
(bitwise-and
mask_1
m_0))))))))))
(loop_0 c1_0 mask_0))
mask_0))))))))))))
(list*
'begin
app_0
@ -30592,7 +30813,7 @@
wcm-state_0
v_0))))
(define struct:liftable
(make-record-type-descriptor* 'liftable #f #f #f #f 3 7))
(make-record-type-descriptor* 'liftable #f #f #f #f 3 6))
(define effect_2347
(struct-type-install-properties!
struct:liftable
@ -39664,7 +39885,7 @@
(lift-in_0 find-loops_0 leave-loops-intact?_0 v_0))
v_0)))))
(define struct:convert-mode
(make-record-type-descriptor* 'convert-mode #f #f #f #f 4 15))
(make-record-type-descriptor* 'convert-mode #f #f #f #f 4 0))
(define effect_2645
(struct-type-install-properties!
struct:convert-mode
@ -48892,7 +49113,7 @@
#t
(if (extflonum? q_0) #t #f))))))))))))))
(define struct:to-unfasl
(make-record-type-descriptor* 'to-unfasl #f #f #f #f 3 7))
(make-record-type-descriptor* 'to-unfasl #f #f #f #f 3 0))
(define effect_3053
(struct-type-install-properties!
struct:to-unfasl
@ -49043,7 +49264,7 @@
'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 31))
(define struct:node (make-record-type-descriptor* 'node #f #f #f #f 5 0))
(define effect_2498
(struct-type-install-properties!
struct:node
@ -49373,7 +49594,7 @@
(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 31))
(make-record-type-descriptor* 'stack-info #f #f #f #f 5 28))
(define effect_2396
(struct-type-install-properties!
struct:stack-info
@ -49758,7 +49979,7 @@
(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 3))
(make-record-type-descriptor* 'indirect #f #f #f #f 2 0))
(define effect_2066
(struct-type-install-properties!
struct:indirect
@ -49825,7 +50046,7 @@
(register-struct-field-accessor! indirect-pos struct:indirect 0)
(register-struct-field-accessor! indirect-element struct:indirect 1)
(void)))
(define struct:boxed (make-record-type-descriptor* 'boxed #f #f #f #f 1 1))
(define struct:boxed (make-record-type-descriptor* 'boxed #f #f #f #f 1 0))
(define effect_2559
(struct-type-install-properties!
struct:boxed

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

@ -1075,7 +1075,7 @@
(register-struct-field-mutator! set-queue-start! struct:queue 0)
(register-struct-field-mutator! set-queue-end! struct:queue 1)
(void)))
(define struct:node$2 (make-record-type-descriptor* 'node #f #f #f #f 3 7))
(define struct:node$2 (make-record-type-descriptor* 'node #f #f #f #f 3 6))
(define effect_2809
(struct-type-install-properties!
struct:node$2
@ -1311,7 +1311,7 @@
(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 31))
(define struct:node$1 (make-record-type-descriptor* 'node #f #f #f #f 5 0))
(define effect_2451
(struct-type-install-properties!
struct:node$1
@ -2081,7 +2081,7 @@
"(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 1))
(make-record-type-descriptor* 'selector-prop-evt-value #f #f #f #f 1 0))
(define effect_2090
(struct-type-install-properties!
struct:selector-prop-evt-value
@ -2130,7 +2130,7 @@
(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 1))
(define struct:poller (make-record-type-descriptor* 'poller #f #f #f #f 1 0))
(define effect_2384
(struct-type-install-properties!
struct:poller
@ -2158,7 +2158,7 @@
(register-struct-field-accessor! poller-proc struct:poller 0)
(void)))
(define struct:poll-ctx
(make-record-type-descriptor* 'poll-ctx #f #f #f #f 4 15))
(make-record-type-descriptor* 'poll-ctx #f #f #f #f 4 8))
(define effect_3060
(struct-type-install-properties!
struct:poll-ctx
@ -2318,7 +2318,7 @@
(register-struct-predicate! async-evt?)
(void)))
(define the-async-evt (async-evt6.1))
(define struct:wrap-evt (make-record-type-descriptor* 'evt #f #f #f #f 2 3))
(define struct:wrap-evt (make-record-type-descriptor* 'evt #f #f #f #f 2 0))
(define effect_2319
(struct-type-install-properties!
struct:wrap-evt
@ -2420,7 +2420,7 @@
(register-struct-predicate! handle-evt?$1)
(void)))
(define struct:control-state-evt
(make-record-type-descriptor* 'control-state-evt #f #f #f #f 5 31))
(make-record-type-descriptor* 'control-state-evt #f #f #f #f 5 0))
(define effect_2665
(struct-type-install-properties!
struct:control-state-evt
@ -2570,7 +2570,7 @@
4)
(void)))
(define struct:poll-guard-evt
(make-record-type-descriptor* 'evt #f #f #f #f 1 1))
(make-record-type-descriptor* 'evt #f #f #f #f 1 0))
(define effect_2393
(struct-type-install-properties!
struct:poll-guard-evt
@ -2629,7 +2629,7 @@
struct:poll-guard-evt
0)
(void)))
(define struct:choice-evt (make-record-type-descriptor* 'evt #f #f #f #f 1 1))
(define struct:choice-evt (make-record-type-descriptor* 'evt #f #f #f #f 1 0))
(define effect_2512
(struct-type-install-properties!
struct:choice-evt
@ -2714,7 +2714,7 @@
(|#%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 1))
(make-record-type-descriptor* 'delayed-poll #f #f #f #f 1 0))
(define effect_3144
(struct-type-install-properties!
struct:delayed-poll
@ -2744,7 +2744,7 @@
(register-struct-field-accessor! delayed-poll-resume struct:delayed-poll 0)
(void)))
(define struct:poller-evt
(make-record-type-descriptor* 'poller-evt #f #f #f #f 1 1))
(make-record-type-descriptor* 'poller-evt #f #f #f #f 1 0))
(define effect_2558
(struct-type-install-properties!
struct:poller-evt
@ -2799,7 +2799,7 @@
(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 3))
(make-record-type-descriptor* 'waiter-methods #f #f #f #f 2 0))
(define effect_3162
(struct-type-install-properties!
struct:waiter-methods
@ -2849,7 +2849,7 @@
(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 1))
(make-record-type-descriptor* 'select-waiter #f #f #f #f 1 0))
(define effect_2458
(struct-type-install-properties!
struct:select-waiter
@ -2911,7 +2911,7 @@
(register-struct-field-accessor! select-waiter-proc struct:select-waiter 0)
(void)))
(define struct:custodian
(make-record-type-descriptor* 'custodian #f #f #f #f 13 8191))
(make-record-type-descriptor* 'custodian #f #f #f #f 13 8188))
(define effect_2364
(struct-type-install-properties!
struct:custodian
@ -3132,7 +3132,7 @@
(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 1))
(make-record-type-descriptor* 'message-ized #f #f #f #f 1 0))
(define effect_2650
(struct-type-install-properties!
struct:message-ized
@ -4280,7 +4280,7 @@
v_0)))))))))))))
(lambda (v_0) (let ((graph_0 (box #f))) (loop_0 graph_0 v_0)))))
(define struct:place
(make-record-type-descriptor* 'place #f #f #f #f 19 524287))
(make-record-type-descriptor* 'place #f #f #f #f 19 491440))
(define effect_3017
(struct-type-install-properties!
struct:place
@ -4521,7 +4521,7 @@
(void)))
(define count-field-pos 2)
(define struct:semaphore-peek-evt
(make-record-type-descriptor* 'semaphore-peek-evt #f #f #f #f 1 1))
(make-record-type-descriptor* 'semaphore-peek-evt #f #f #f #f 1 0))
(define effect_2819
(struct-type-install-properties!
struct:semaphore-peek-evt
@ -4862,7 +4862,7 @@
(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 15))
(make-record-type-descriptor* 'thread-group struct:node #f #f #f 4 14))
(define effect_2111
(struct-type-install-properties!
struct:thread-group
@ -5195,7 +5195,7 @@
(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 3))
(define struct:plumber (make-record-type-descriptor* 'plumber #f #f #f #f 2 0))
(define effect_2525
(struct-type-install-properties!
struct:plumber
@ -5243,7 +5243,7 @@
v_0))
'current-plumber))
(define struct:plumber-flush-handle
(make-record-type-descriptor* 'plumber-flush-handle #f #f #f #f 2 3))
(make-record-type-descriptor* 'plumber-flush-handle #f #f #f #f 2 0))
(define effect_2524
(struct-type-install-properties!
struct:plumber-flush-handle
@ -5479,7 +5479,7 @@
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 3))
(make-record-type-descriptor* 'custodian-box #f #f #f #f 2 1))
(define effect_3118
(struct-type-install-properties!
struct:custodian-box
@ -5523,7 +5523,7 @@
0)
(void)))
(define struct:willed-callback
(make-record-type-descriptor* 'willed-callback #f #f #f #f 2 3))
(make-record-type-descriptor* 'willed-callback #f #f #f #f 2 0))
(define effect_2810
(struct-type-install-properties!
struct:willed-callback
@ -6916,7 +6916,7 @@
(void)))))))
(loop_0 mref_0))))
(define struct:thread
(make-record-type-descriptor* 'thread struct:node #f #f #f 24 16777215))
(make-record-type-descriptor* 'thread struct:node #f #f #f 24 16777082))
(define effect_3120
(struct-type-install-properties!
struct:thread
@ -7492,7 +7492,7 @@
(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 1))
(make-record-type-descriptor* 'thread-dead-evt #f #f #f #f 1 0))
(define effect_2381
(struct-type-install-properties!
struct:dead-evt
@ -7823,7 +7823,7 @@
(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 3))
(make-record-type-descriptor* 'transitive-resume #f #f #f #f 2 0))
(define effect_2586
(struct-type-install-properties!
struct:transitive-resume
@ -7956,7 +7956,7 @@
(|#%app| interrupt-callback_0))
(void)))))
(define struct:suspend-resume-evt
(make-record-type-descriptor* 'suspend-resume-evt #f #f #f #f 2 3))
(make-record-type-descriptor* 'suspend-resume-evt #f #f #f #f 2 2))
(define effect_2576
(struct-type-install-properties!
struct:suspend-resume-evt
@ -8658,7 +8658,7 @@
#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 3))
(define struct:channel (make-record-type-descriptor* 'channel #f #f #f #f 2 0))
(define effect_1902
(struct-type-install-properties!
struct:channel
@ -8730,7 +8730,7 @@
(register-struct-field-accessor! channel-put-queue struct:channel 1)
(void)))
(define struct:channel-put-evt*
(make-record-type-descriptor* 'channel-put-evt #f #f #f #f 2 3))
(make-record-type-descriptor* 'channel-put-evt #f #f #f #f 2 0))
(define effect_2960
(struct-type-install-properties!
struct:channel-put-evt*
@ -8826,7 +8826,7 @@
#f
#f
1
1))
0))
(define effect_3243
(struct-type-install-properties!
struct:channel-select-waiter
@ -11116,7 +11116,7 @@
(start-atomic)
(begin0 (retry_0 s_0 timeout-at_0) (end-atomic)))))))
(define struct:replacing-evt
(make-record-type-descriptor* 'evt #f #f #f #f 1 1))
(make-record-type-descriptor* 'evt #f #f #f #f 1 0))
(define effect_2056
(struct-type-install-properties!
struct:replacing-evt
@ -11178,7 +11178,7 @@
0)
(void)))
(define struct:nested-sync-evt
(make-record-type-descriptor* 'evt #f #f #f #f 3 7))
(make-record-type-descriptor* 'evt #f #f #f #f 3 0))
(define effect_2232
(struct-type-install-properties!
struct:nested-sync-evt
@ -11473,7 +11473,7 @@
(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 1023))
(make-record-type-descriptor* 'future #f #f #f #f 10 1016))
(define effect_2884
(struct-type-install-properties!
struct:future*
@ -11906,7 +11906,7 @@
(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 1))
(make-record-type-descriptor* 'future-evt #f #f #f #f 1 0))
(define effect_2234
(struct-type-install-properties!
struct:future-evt
@ -12349,7 +12349,7 @@
(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 63))
(make-record-type-descriptor* 'scheduler #f #f #f #f 6 7))
(define effect_2611
(struct-type-install-properties!
struct:scheduler
@ -12407,7 +12407,7 @@
struct:scheduler
2)
(void)))
(define struct:worker (make-record-type-descriptor* 'worker #f #f #f #f 5 31))
(define struct:worker (make-record-type-descriptor* 'worker #f #f #f #f 5 26))
(define effect_2322
(struct-type-install-properties!
struct:worker
@ -13275,7 +13275,7 @@
(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 1))
(make-record-type-descriptor* 'alarm-evt #f #f #f #f 1 0))
(define effect_2693
(struct-type-install-properties!
struct:alarm-evt
@ -13842,7 +13842,7 @@
((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 3))
(make-record-type-descriptor* 'will-executor #f #f #f #f 2 0))
(define effect_2934
(struct-type-install-properties!
struct:will-executor
@ -14884,7 +14884,7 @@
(loop_0)))))))))))
(loop_0)))))
(define struct:place-done-evt
(make-record-type-descriptor* 'place-dead-evt #f #f #f #f 2 3))
(make-record-type-descriptor* 'place-dead-evt #f #f #f #f 2 0))
(define effect_3079
(struct-type-install-properties!
struct:place-done-evt
@ -14993,7 +14993,7 @@
(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 63))
(make-record-type-descriptor* 'message-queue #f #f #f #f 6 22))
(define effect_2821
(struct-type-install-properties!
struct:message-queue
@ -15181,7 +15181,7 @@
(|#%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 63))
(make-record-type-descriptor* 'place-channel #f #f #f #f 6 0))
(define effect_2691
(struct-type-install-properties!
struct:pchannel
@ -15486,7 +15486,7 @@
(lambda () (ensure-wakeup-handle!))))
(void)))
(define struct:fsemaphore
(make-record-type-descriptor* 'fsemaphore #f #f #f #f 4 15))
(make-record-type-descriptor* 'fsemaphore #f #f #f #f 4 13))
(define effect_2870
(struct-type-install-properties!
struct:fsemaphore
@ -15540,7 +15540,7 @@
3)
(void)))
(define struct:fsemaphore-box-evt
(make-record-type-descriptor* 'fsemaphore-box-evt #f #f #f #f 1 1))
(make-record-type-descriptor* 'fsemaphore-box-evt #f #f #f #f 1 0))
(define effect_2505
(struct-type-install-properties!
struct:fsemaphore-box-evt
@ -15744,7 +15744,7 @@
(lambda () (begin (start-atomic) (|#%app| proc_0))))
(void))))))
(define struct:os-semaphore
(make-record-type-descriptor* 'os-semaphore #f #f #f #f 3 7))
(make-record-type-descriptor* 'os-semaphore #f #f #f #f 3 1))
(define effect_2794
(struct-type-install-properties!
struct:os-semaphore

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

@ -69,9 +69,20 @@
#f
#f
,(struct-type-info-immediate-field-count sti)
;; Reporting all as mutable, for now:
,(let ([n (struct-type-info-immediate-field-count sti)])
(sub1 (arithmetic-shift 1 n)))))
,(let* ([n (struct-type-info-immediate-field-count sti)]
[mask (sub1 (arithmetic-shift 1 n))])
(cond
[(struct-type-info-non-prefab-immutables sti)
=>
(lambda (immutables)
(let loop ([imms immutables] [mask mask])
(cond
[(null? imms) mask]
[else
(let ([m (bitwise-not (arithmetic-shift 1 (car imms)))])
(loop (cdr imms) (bitwise-and mask m)))])))]
[else
mask]))))
,@(if (null? (struct-type-info-rest sti))
null
`((define ,(deterministic-gensym "effect")

15
racket/src/schemify/struct-type-info.rkt
View File

@ -18,6 +18,7 @@
pure-constructor?
authentic?
prefab-immutables ; #f or immutable expression to be quoted
non-prefab-immutables ; #f or immutable expression to be quoted
constructor-name-expr ; an expression
rest)) ; argument expressions after auto-field value
(define struct-type-info-rest-properties-list-pos 0)
@ -61,7 +62,18 @@
[`,_ #f])))
(define constructor-name-expr (and ((length rest) . > . 5)
(list-ref rest 5)))
(and prefab-imms
(define non-prefab-imms
(and (eq? prefab-imms 'non-prefab)
(match rest
[`() '()]
[`(,_) '()]
[`(,_ ,_) '()]
[`(,_ ,_ ,_) '()]
[`(,_ ,_ ,_ ',immutables . ,_) immutables]
[`,_ #f])))
(and (if (eq? prefab-imms 'non-prefab)
non-prefab-imms
prefab-imms)
(struct-type-info name
parent
fields
@ -78,6 +90,7 @@
(if (eq? prefab-imms 'non-prefab)
#f
prefab-imms)
non-prefab-imms
constructor-name-expr
rest)))))]
[`(let-values () ,body)