cs: fix name of pending-unmarshal procedures
The new encoding of struct constructors and predicates collided with the encoding of another kind of procedures --- ones that are unmarshaled on demand in especially large modules. The resulting symptom was that `object-name` was broken for on-demand procedures.
This commit is contained in:
parent
1173006212
commit
d228aeb060
|
@ -14,7 +14,7 @@
|
||||||
|
|
||||||
;; In the Racket source repo, this version should change only when
|
;; In the Racket source repo, this version should change only when
|
||||||
;; "racket_version.h" changes:
|
;; "racket_version.h" changes:
|
||||||
(define version "7.9.0.11")
|
(define version "7.9.0.12")
|
||||||
|
|
||||||
(define deps `("racket-lib"
|
(define deps `("racket-lib"
|
||||||
["racket" #:version ,version]))
|
["racket" #:version ,version]))
|
||||||
|
|
|
@ -338,8 +338,9 @@
|
||||||
;; - (vector <symbol-or-#f> <proc> 'method) => is a method
|
;; - (vector <symbol-or-#f> <proc> 'method) => is a method
|
||||||
;; - (box <symbol>) => JIT function generated, name is <symbol>, not a method
|
;; - (box <symbol>) => JIT function generated, name is <symbol>, not a method
|
||||||
;; - <parameter-data> => parameter
|
;; - <parameter-data> => parameter
|
||||||
;; - 'constructor => struct constructor
|
;; - <symbol> => JITted with <symbol> name
|
||||||
;; - 'predicate => struct predicate
|
;; - #\c => struct constructor
|
||||||
|
;; - #\p => struct predicate
|
||||||
;; - (cons rtd pos) => struct accessor
|
;; - (cons rtd pos) => struct accessor
|
||||||
;; - (cons pos rtd) => struct mutator
|
;; - (cons pos rtd) => struct mutator
|
||||||
|
|
||||||
|
@ -584,6 +585,7 @@
|
||||||
[(#%vector? name) (or (#%vector-ref name 0)
|
[(#%vector? name) (or (#%vector-ref name 0)
|
||||||
(object-name (#%vector-ref name 1)))]
|
(object-name (#%vector-ref name 1)))]
|
||||||
[(parameter-data? name) (parameter-data-name name)]
|
[(parameter-data? name) (parameter-data-name name)]
|
||||||
|
[(symbol? name) name]
|
||||||
[else (object-name (wrapper-procedure-procedure p))])))
|
[else (object-name (wrapper-procedure-procedure p))])))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
|
@ -412,10 +412,10 @@
|
||||||
(resize! rtd-props))))
|
(resize! rtd-props))))
|
||||||
|
|
||||||
(define (|#%struct-constructor| p arity-mask)
|
(define (|#%struct-constructor| p arity-mask)
|
||||||
(make-wrapper-procedure p arity-mask 'constructor))
|
(make-wrapper-procedure p arity-mask #\c))
|
||||||
|
|
||||||
(define (|#%struct-predicate| p)
|
(define (|#%struct-predicate| p)
|
||||||
(make-wrapper-procedure p 2 'predicate))
|
(make-wrapper-procedure p 2 #\p))
|
||||||
|
|
||||||
(define (|#%struct-field-accessor| p rtd pos)
|
(define (|#%struct-field-accessor| p rtd pos)
|
||||||
(make-wrapper-procedure p 2 (cons rtd pos)))
|
(make-wrapper-procedure p 2 (cons rtd pos)))
|
||||||
|
@ -426,12 +426,12 @@
|
||||||
(define (struct-constructor-procedure? v)
|
(define (struct-constructor-procedure? v)
|
||||||
(let ([v (strip-impersonator v)])
|
(let ([v (strip-impersonator v)])
|
||||||
(and (wrapper-procedure? v)
|
(and (wrapper-procedure? v)
|
||||||
(eq? 'constructor (wrapper-procedure-data v)))))
|
(eq? #\c (wrapper-procedure-data v)))))
|
||||||
|
|
||||||
(define (struct-predicate-procedure? v)
|
(define (struct-predicate-procedure? v)
|
||||||
(let ([v (strip-impersonator v)])
|
(let ([v (strip-impersonator v)])
|
||||||
(and (wrapper-procedure? v)
|
(and (wrapper-procedure? v)
|
||||||
(eq? 'predicate (wrapper-procedure-data v)))))
|
(eq? #\p (wrapper-procedure-data v)))))
|
||||||
|
|
||||||
(define (struct-accessor-procedure? v)
|
(define (struct-accessor-procedure? v)
|
||||||
(let ([v (strip-impersonator v)])
|
(let ([v (strip-impersonator v)])
|
||||||
|
|
|
@ -16,7 +16,7 @@
|
||||||
#define MZSCHEME_VERSION_X 7
|
#define MZSCHEME_VERSION_X 7
|
||||||
#define MZSCHEME_VERSION_Y 9
|
#define MZSCHEME_VERSION_Y 9
|
||||||
#define MZSCHEME_VERSION_Z 0
|
#define MZSCHEME_VERSION_Z 0
|
||||||
#define MZSCHEME_VERSION_W 11
|
#define MZSCHEME_VERSION_W 12
|
||||||
|
|
||||||
/* A level of indirection makes `#` work as needed: */
|
/* A level of indirection makes `#` work as needed: */
|
||||||
#define AS_a_STR_HELPER(x) #x
|
#define AS_a_STR_HELPER(x) #x
|
||||||
|
|
Loading…
Reference in New Issue
Block a user