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