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

schemify: name raw accessor/mutators

Browse Source 
Inferred names show up as part of the compiled code, so make sure
they're normalized instead of gensyms.
This commit is contained in:
Matthew Flatt 2019-12-05 08:46:15 -07:00
parent 6f919635da
commit f5e6ce4282
1 changed files with 11 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -94,7 +94,9 @@
`(procedure-rename ,ctr-expr ,name-expr))] `(procedure-rename ,ctr-expr ,name-expr))]
[`,_ [`,_
`(procedure-rename ,ctr-expr ,name-expr)]))) `(procedure-rename ,ctr-expr ,name-expr)])))
(define ,raw-s? (record-predicate ,struct:s)) (define ,raw-s? ,(name-procedure
"" (struct-type-info-name sti) "" '|| "?"
`(record-predicate ,struct:s)))
,@(if can-impersonate? ,@(if can-impersonate?
`((define ,s? ,(name-procedure `((define ,s? ,(name-procedure
"" (struct-type-info-name sti) "" '|| "?" "" (struct-type-info-name sti) "" '|| "?"
@ -105,7 +107,10 @@
(define raw-acc/mut (if can-impersonate? (gensym (unwrap acc/mut)) acc/mut)) (define raw-acc/mut (if can-impersonate? (gensym (unwrap acc/mut)) acc/mut))
(match make-acc/mut (match make-acc/mut
[`(make-struct-field-accessor ,(? (lambda (v) (wrap-eq? v -ref))) ,pos ',field-name) [`(make-struct-field-accessor ,(? (lambda (v) (wrap-eq? v -ref))) ,pos ',field-name)
(define raw-def `(define ,raw-acc/mut (record-accessor ,struct:s ,pos))) (define raw-def `(define ,raw-acc/mut
,(name-procedure
"" (struct-type-info-name sti) "-" field-name ""
`(record-accessor ,struct:s ,pos))))
(if can-impersonate? (if can-impersonate?
`(begin `(begin
,raw-def ,raw-def
@ -118,7 +123,10 @@
',(struct-type-info-name sti) ',field-name))))))) ',(struct-type-info-name sti) ',field-name)))))))
raw-def)] raw-def)]
[`(make-struct-field-mutator ,(? (lambda (v) (wrap-eq? v -set!))) ,pos ',field-name) [`(make-struct-field-mutator ,(? (lambda (v) (wrap-eq? v -set!))) ,pos ',field-name)
(define raw-def `(define ,raw-acc/mut (record-mutator ,struct:s ,pos))) (define raw-def `(define ,raw-acc/mut
,(name-procedure
"set-" (struct-type-info-name sti) "-" field-name "!"
`(record-mutator ,struct:s ,pos))))
(define abs-pos (+ pos (- (struct-type-info-field-count sti) (define abs-pos (+ pos (- (struct-type-info-field-count sti)
(struct-type-info-immediate-field-count sti)))) (struct-type-info-immediate-field-count sti))))
(if can-impersonate? (if can-impersonate?