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

move memq and memv back to core

Browse Source 
This commit partly reverts c305dba649 and 88fc9a979f, which was
discusssed in #366.

The original discussion was about allowing an extra argument to
`member` to pick the equality predicate. That change is still in place
in the same (private) Racket module.

The `memq` and `memv` functions are in Scheme for Racket CS and back
to being and in C for Racket BC. The old motivation for moving `memv`
and `memq` --- to get them out of C --- is subsumed by the switch to
CS (granting that some C code got added back to BC meanwhile). The
advantage of moving `memq` and `memv` back to the runtime core is that
the compiler can do more with them, at least in CS.

When `memq` and `memv` were moved previously, they lost checking for
cyclic lists. That wasn't discussed and presumably wasn't on purpose;
check is restored here, including for `member`.

There's no significant performance change in CS, except in cases like
`(memq x '(a b c))` that the compiler unpacks into a combination of
`eq?`s. For BC, the C version is a little faster (10-40%, depending on
the length of the list), but still slower than CS (probably because
`pair?` is slower, which due to representation differences).
This commit is contained in:
Matthew Flatt 2021-03-17 12:52:46 -06:00
parent db34c62241
commit d0feb5c75a
18 changed files with 822 additions and 1212 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

@ -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 "8.0.0.11") (define version "8.0.0.12")
(define deps `("racket-lib" (define deps `("racket-lib"
["racket" #:version ,version])) ["racket" #:version ,version]))

5
pkgs/racket-test-core/tests/racket/basic.rktl
View File

@ -328,8 +328,9 @@
(if (eq? memq-name 'member) (if (eq? memq-name 'member)
(arity-test memq 2 3) (arity-test memq 2 3)
(arity-test memq 2 2)) (arity-test memq 2 2))
(err/rt-test (memq 'a 1) exn:application:mismatch?) (err/rt-test (memq 'a 1) exn:fail:contract? #rx"not a proper list")
(err/rt-test (memq 'a '(1 . 2)) exn:application:mismatch?)) (err/rt-test (memq 'a '(1 . 2)) exn:fail:contract? #rx"not a proper list")
(err/rt-test (memq 'a (read (open-input-string "#0=(1 . #0#)"))) exn:fail:contract? #rx"not a proper list"))
(test-mem memq 'memq) (test-mem memq 'memq)
(test-mem memv 'memv) (test-mem memv 'memv)

67
racket/collects/racket/private/member.rkt
View File

@ -1,57 +1,38 @@
(module member '#%kernel (module member '#%kernel
(#%require "cond.rkt" "qq-and-or.rkt" (#%require "cond.rkt" "qq-and-or.rkt")
(for-syntax '#%kernel "qq-and-or.rkt")) (#%provide member)
(#%provide memq memv member)
;; helper for memq/v/ber error cases ;; helper for member error cases
(define-values (bad-list) (define-values (bad-list)
(λ (who orig-l) (λ (who orig-l)
(raise-mismatch-error who "not a proper list: " orig-l))) (raise-mismatch-error who "not a proper list: " orig-l)))
(define-values (memq memv member) (define-values (member)
(let-values () (letrec-values ([(member)
;; Create the mem functions (lambda (v orig-l eql?)
(define-syntaxes (mk mk-member) (let loop ([ls orig-l] [turtle orig-l])
(values
(λ (stx)
(define-values (forms) (syntax-e stx))
(define-values (id eq?)
(values (syntax-e (cadr forms))
(syntax-e (caddr forms))))
(datum->syntax
stx
`(let-values ([(,id)
(lambda (v orig-l)
(let loop ([ls orig-l])
(cond (cond
[(null? ls) #f] [(null? ls) #f]
[(not (pair? ls)) [(not (pair? ls))
(bad-list ',id orig-l)] (bad-list 'member orig-l)]
[(,eq? v (car ls)) ls] [(eql? v (car ls)) ls]
[else (loop (cdr ls))])))]) [else
,id))) (let ([ls (cdr ls)])
;; Create the `member` function that takes an extra argument (cond
;; Uses `mk` to construct the body [(null? ls) #f]
(λ (stx) [(or (not (pair? ls))
(define-values (forms) (syntax-e stx)) (eq? ls turtle))
(define-values (id) (syntax-e (cadr forms))) (bad-list 'member orig-l)]
(datum->syntax [(eql? v (car ls)) ls]
stx [else (loop (cdr ls) (cdr turtle))]))])))])
`(let* ([default (mk member equal?)] (case-lambda
[,id (case-lambda [(v ls) (member v ls equal?)]
([v orig-l] (default v orig-l)) [(v ls eql?)
([v orig-l eq?] (if (and (procedure? eql?)
(if (and (procedure? eq?) (procedure-arity-includes? eql? 2))
(procedure-arity-includes? eq? 2))
(void) (void)
(raise-argument-error (raise-argument-error
'member 'member
"(procedure-arity-includes/c 2)" "(procedure-arity-includes/c 2)"
eq?)) eq?))
((mk member eq?) v orig-l)))]) (member v ls eql?)]))))
,id)))))
(values (mk memq eq?)
(mk memv eqv?)
;; Note that this uses `mk-member`
(mk-member member)))))

46
racket/src/bc/src/list.c
View File

@ -50,6 +50,8 @@ static Scheme_Object *immutablep (int argc, Scheme_Object *argv[]);
static Scheme_Object *length_prim (int argc, Scheme_Object *argv[]); static Scheme_Object *length_prim (int argc, Scheme_Object *argv[]);
static Scheme_Object *append_prim (int argc, Scheme_Object *argv[]); static Scheme_Object *append_prim (int argc, Scheme_Object *argv[]);
static Scheme_Object *reverse_prim (int argc, Scheme_Object *argv[]); static Scheme_Object *reverse_prim (int argc, Scheme_Object *argv[]);
static Scheme_Object *memv (int argc, Scheme_Object *argv[]);
static Scheme_Object *memq (int argc, Scheme_Object *argv[]);
static Scheme_Object *assv (int argc, Scheme_Object *argv[]); static Scheme_Object *assv (int argc, Scheme_Object *argv[]);
static Scheme_Object *assq (int argc, Scheme_Object *argv[]); static Scheme_Object *assq (int argc, Scheme_Object *argv[]);
static Scheme_Object *assoc (int argc, Scheme_Object *argv[]); static Scheme_Object *assoc (int argc, Scheme_Object *argv[]);
@ -345,6 +347,17 @@ scheme_init_list (Scheme_Startup_Env *env)
| SCHEME_PRIM_AD_HOC_OPT); | SCHEME_PRIM_AD_HOC_OPT);
scheme_addto_prim_instance ("list-ref",p, env); scheme_addto_prim_instance ("list-ref",p, env);
scheme_addto_prim_instance ("memq",
scheme_make_immed_prim(memq,
"memq",
2, 2),
env);
scheme_addto_prim_instance ("memv",
scheme_make_immed_prim(memv,
"memv",
2, 2),
env);
scheme_addto_prim_instance ("assq", scheme_addto_prim_instance ("assq",
scheme_make_immed_prim(assq, scheme_make_immed_prim(assq,
"assq", "assq",
@ -1735,6 +1748,39 @@ static void mem_past_end(const char *name, Scheme_Object *s_arg, Scheme_Object *
NULL); NULL);
} }
#define GEN_MEM(name, scheme_name, comp) \
static Scheme_Object * \
name (int argc, Scheme_Object *argv[]) \
{ \
Scheme_Object *list, *turtle; \
list = turtle = argv[1]; \
while (SCHEME_PAIRP(list)) \
{ \
if (comp (argv[0], SCHEME_CAR (list))) \
{ \
return list; \
} \
list = SCHEME_CDR (list); \
if (SCHEME_PAIRP(list)) { \
if (comp (argv[0], SCHEME_CAR (list))) \
{ \
return list; \
} \
if (SAME_OBJ(list, turtle)) break; \
list = SCHEME_CDR (list); \
turtle = SCHEME_CDR (turtle); \
SCHEME_USE_FUEL(1); \
} \
} \
if (!SCHEME_NULLP(list)) { \
mem_past_end(#scheme_name, argv[0], argv[1]); \
} \
return (scheme_false); \
}
GEN_MEM(memv, memv, scheme_eqv)
GEN_MEM(memq, memq, SAME_OBJ)
static void ass_non_pair(const char *name, Scheme_Object *np, Scheme_Object *s_arg, Scheme_Object *arg) static void ass_non_pair(const char *name, Scheme_Object *np, Scheme_Object *s_arg, Scheme_Object *arg)
{ {
scheme_contract_error(name, scheme_contract_error(name,

2
racket/src/bc/src/schminc.h
View File

@ -15,7 +15,7 @@
#define USE_COMPILED_STARTUP 1 #define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 1501 #define EXPECTED_PRIM_COUNT 1503
#ifdef MZSCHEME_SOMETHING_OMITTED #ifdef MZSCHEME_SOMETHING_OMITTED
# undef USE_COMPILED_STARTUP # undef USE_COMPILED_STARTUP

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

@ -77,94 +77,43 @@ static const char *startup_source =
"(bad-list$1)" "(bad-list$1)"
" (lambda (who_0 orig-l_0) (begin 'bad-list (raise-mismatch-error who_0 \"not a proper list: \" orig-l_0))))" " (lambda (who_0 orig-l_0) (begin 'bad-list (raise-mismatch-error who_0 \"not a proper list: \" orig-l_0))))"
"(define-values" "(define-values"
"(memq memv member)" "(member)"
"(let-values()" "(letrec-values(((member_0)"
"(let-values()" "(lambda(v_0 orig-l_0 eql?_0)"
"(values"
"(let-values(((memq_0)"
"(lambda(v_0 orig-l_0)"
"(begin"
" 'memq"
"((letrec-values(((loop_0)"
"(lambda(ls_0)"
"(begin"
" 'loop"
"(if(null? ls_0)"
"(let-values() #f)"
"(if(not(pair? ls_0))"
"(let-values()(bad-list$1 'memq orig-l_0))"
"(if(eq? v_0(car ls_0))"
"(let-values() ls_0)"
"(let-values()(loop_0(cdr ls_0))))))))))"
" loop_0)"
" orig-l_0)))))"
" memq_0)"
"(let-values(((memv_0)"
"(lambda(v_0 orig-l_0)"
"(begin"
" 'memv"
"((letrec-values(((loop_0)"
"(lambda(ls_0)"
"(begin"
" 'loop"
"(if(null? ls_0)"
"(let-values() #f)"
"(if(not(pair? ls_0))"
"(let-values()(bad-list$1 'memv orig-l_0))"
"(if(eqv? v_0(car ls_0))"
"(let-values() ls_0)"
"(let-values()(loop_0(cdr ls_0))))))))))"
" loop_0)"
" orig-l_0)))))"
" memv_0)"
"(let-values(((default_0)"
"(let-values(((member_0)"
"(lambda(v_0 orig-l_0)"
"(begin" "(begin"
" 'member" " 'member"
"((letrec-values(((loop_0)" "((letrec-values(((loop_0)"
"(lambda(ls_0)" "(lambda(ls_0 turtle_0)"
"(begin" "(begin"
" 'loop" " 'loop"
"(if(null? ls_0)" "(if(null? ls_0)"
"(let-values() #f)" "(let-values() #f)"
"(if(not(pair? ls_0))" "(if(not(pair? ls_0))"
"(let-values()(bad-list$1 'member orig-l_0))" "(let-values()(bad-list$1 'member orig-l_0))"
"(if(equal? v_0(car ls_0))" "(if(eql?_0 v_0(car ls_0))"
"(let-values() ls_0)" "(let-values() ls_0)"
"(let-values()(loop_0(cdr ls_0))))))))))" "(let-values()"
" loop_0)" "(let-values(((ls_1)(cdr ls_0)))"
" orig-l_0)))))" "(if(null? ls_1)"
" member_0)))"
"(let-values(((member_0)"
"(case-lambda"
"((v_0 orig-l_0)(begin 'member(default_0 v_0 orig-l_0)))"
"((v_0 orig-l_0 eq?_0)"
"(begin"
"(if(if(procedure? eq?_0)(procedure-arity-includes? eq?_0 2) #f)"
"(void)"
" (raise-argument-error 'member \"(procedure-arity-includes/c 2)\" eq?_0))"
"((let-values(((member_0)"
"(lambda(v_1 orig-l_1)"
"(begin"
" 'member"
"((letrec-values(((loop_0)"
"(lambda(ls_0)"
"(begin"
" 'loop"
"(if(null? ls_0)"
"(let-values() #f)" "(let-values() #f)"
"(if(not(pair? ls_0))" "(if(let-values(((or-part_0)(not(pair? ls_1))))"
"(let-values()(bad-list$1 'member orig-l_1))" "(if or-part_0 or-part_0(eq? ls_1 turtle_0)))"
"(if(eq?_0 v_1(car ls_0))" "(let-values()(bad-list$1 'member orig-l_0))"
"(let-values() ls_0)" "(if(eql?_0 v_0(car ls_1))"
"(let-values()(loop_0(cdr ls_0))))))))))" "(let-values() ls_1)"
"(let-values()"
"(loop_0(cdr ls_1)(cdr turtle_0)))))))))))))))"
" loop_0)" " loop_0)"
" orig-l_1)))))" " orig-l_0"
" member_0)" " orig-l_0)))))"
" v_0" "(case-lambda"
" orig-l_0))))))" "((v_0 ls_0)(begin(member_0 v_0 ls_0 equal?)))"
" member_0))))))" "((v_0 ls_0 eql?_0)"
"(begin"
"(if(if(procedure? eql?_0)(procedure-arity-includes? eql?_0 2) #f)"
"(void)"
" (raise-argument-error 'member \"(procedure-arity-includes/c 2)\" eq?))"
"(member_0 v_0 ls_0 eql?_0))))))"
"(define-values(current-parameterization)(lambda()(begin(continuation-mark-set-first #f parameterization-key))))" "(define-values(current-parameterization)(lambda()(begin(continuation-mark-set-first #f parameterization-key))))"
"(define-values" "(define-values"
"(call-with-parameterization)" "(call-with-parameterization)"
@ -556,6 +505,15 @@ static const char *startup_source =
"(if(let-values(((or-part_0)(bytes? s_0)))(if or-part_0 or-part_0(string? s_0)))" "(if(let-values(((or-part_0)(bytes? s_0)))(if or-part_0 or-part_0(string? s_0)))"
"(void)" "(void)"
" (let-values () (raise-argument-error 'path-list-string->path-list \"(or/c bytes? string?)\" s_0)))" " (let-values () (raise-argument-error 'path-list-string->path-list \"(or/c bytes? string?)\" s_0)))"
" (if (regexp-match? '#rx#\"\\0\" s_0)"
"(let-values()"
" (let-values (((label_0) (if (bytes? s_0) \"byte string\" \"string\")))"
"(raise-arguments-error"
" 'path-list-string->path-list"
" (format \"given ~a contains a nul character\" label_0)"
" label_0"
" s_0)))"
"(void))"
"(if(if(list? default_0)" "(if(if(list? default_0)"
"(andmap" "(andmap"
"(lambda(p_0)(let-values(((or-part_0)(eq? p_0 'same)))(if or-part_0 or-part_0 path?)))" "(lambda(p_0)(let-values(((or-part_0)(eq? p_0 'same)))(if or-part_0 or-part_0 path?)))"
@ -620,7 +578,7 @@ static const char *startup_source =
"(if(if(relative-path? program_0)" "(if(if(relative-path? program_0)"
"(let-values(((base_0 name_0 dir?_0)(split-path program_0)))(eq? base_0 'relative))" "(let-values(((base_0 name_0 dir?_0)(split-path program_0)))(eq? base_0 'relative))"
" #f)" " #f)"
" (let-values (((paths-str_0) (environment-variables-ref (current-environment-variables) #\"PATH\"))" " (let-values (((paths-bstr_0) (environment-variables-ref (current-environment-variables) #\"PATH\"))"
"((win-add_0)" "((win-add_0)"
"(lambda(s_0)" "(lambda(s_0)"
" (begin 'win-add (if (eq? (system-type) 'windows) (cons (bytes->path #\".\") s_0) s_0)))))" " (begin 'win-add (if (eq? (system-type) 'windows) (cons (bytes->path #\".\") s_0) s_0)))))"
@ -634,8 +592,7 @@ static const char *startup_source =
"(let-values(((name_0)(build-path base_0 program_0)))" "(let-values(((name_0)(build-path base_0 program_0)))"
"(if(file-exists? name_0)(found-exec_0 name_0)(loop_0(cdr paths_0))))))))))" "(if(file-exists? name_0)(found-exec_0 name_0)(loop_0(cdr paths_0))))))))))"
" loop_0)" " loop_0)"
"(win-add_0" "(win-add_0(if paths-bstr_0(path-list-string->path-list paths-bstr_0 null) null))))"
"(if paths-str_0(path-list-string->path-list(bytes->string/locale paths-str_0 '#\\?) null) null))))"
"(let-values(((p_0)(path->complete-path program_0)))(if(file-exists? p_0)(found-exec_0 p_0) #f)))))))" "(let-values(((p_0)(path->complete-path program_0)))(if(file-exists? p_0)(found-exec_0 p_0) #f)))))))"
"((program_0 libpath_0)(find-executable-path program_0 libpath_0 #f))" "((program_0 libpath_0)(find-executable-path program_0 libpath_0 #f))"
"((program_0)(find-executable-path program_0 #f #f))))" "((program_0)(find-executable-path program_0 #f #f))))"

2
racket/src/cs/chezpart.sls
View File

@ -78,8 +78,6 @@
[delete-directory chez:delete-directory] [delete-directory chez:delete-directory]
[filter chez:filter] [filter chez:filter]
[member chez:member] [member chez:member]
[memv chez:memv]
[memq chez:memq]
[error chez:error] [error chez:error]
[raise chez:raise] [raise chez:raise]
[exit-handler chez:exit-handler] [exit-handler chez:exit-handler]

2
racket/src/cs/primitive/kernel.ss
View File

@ -559,6 +559,8 @@
[mcons (known-procedure/allocates 4)] [mcons (known-procedure/allocates 4)]
[memory-order-acquire (known-procedure/single-valued 1)] [memory-order-acquire (known-procedure/single-valued 1)]
[memory-order-release (known-procedure/single-valued 1)] [memory-order-release (known-procedure/single-valued 1)]
[memq (known-procedure/single-valued 4)]
[memv (known-procedure/single-valued 4)]
[min (known-procedure/folding -2)] [min (known-procedure/folding -2)]
[modulo (known-procedure/folding 4)] [modulo (known-procedure/folding 4)]
[mpair? (known-procedure/pure/folding 2)] [mpair? (known-procedure/pure/folding 2)]

2
racket/src/cs/rumble/check.ss
View File

@ -59,7 +59,7 @@
(check who (check who
:test (and (pair? errno) :test (and (pair? errno)
(exact-integer? (car errno)) (exact-integer? (car errno))
(chez:memq (cdr errno) '(posix windows gai))) (#%memq (cdr errno) '(posix windows gai)))
:contract "(cons/c exact-integer? (or/c 'posix 'windows 'gai))" :contract "(cons/c exact-integer? (or/c 'posix 'windows 'gai))"
errno)) errno))

2
racket/src/cs/rumble/error-rewrite.ss
View File

@ -110,6 +110,8 @@
" index: ~s\n" " index: ~s\n"
" in: ~s") " in: ~s")
irritants)] irritants)]
[(or (eq? who 'memq) (eq? who 'memv))
(values "not a proper list: ~s" irritants)]
[(equal? str "~s is not a valid index for ~s") [(equal? str "~s is not a valid index for ~s")
(cond (cond
[(exact-nonnegative-integer? (car irritants)) [(exact-nonnegative-integer? (car irritants))

8
racket/src/cs/rumble/foreign.ss
View File

@ -24,7 +24,7 @@
(raise-arguments-error 'prop:cpointer (raise-arguments-error 'prop:cpointer
"index is out of range" "index is out of range"
"index" v)) "index" v))
(unless (chez:memv v (list-ref info 5)) (unless (#%memv v (list-ref info 5))
(raise-arguments-error 'prop:cpointer (raise-arguments-error 'prop:cpointer
"index does not refer to an immutable field" "index does not refer to an immutable field"
"index" v)) "index" v))
@ -1485,7 +1485,7 @@
(make-cpointer/cell (addr->vector a) #f)) (make-cpointer/cell (addr->vector a) #f))
(define (malloc-mode? v) (define (malloc-mode? v)
(chez:memq v '(raw atomic nonatomic tagged (#%memq v '(raw atomic nonatomic tagged
atomic-interior interior atomic-interior interior
stubborn uncollectable eternal))) stubborn uncollectable eternal)))
@ -1609,7 +1609,7 @@
;; An 'array rep is compound, but should be ;; An 'array rep is compound, but should be
;; passed as a pointer, so only pass 'struct and ;; passed as a pointer, so only pass 'struct and
;; 'union "by value": ;; 'union "by value":
(chez:memq (ctype-host-rep type) '(struct union)))] (#%memq (ctype-host-rep type) '(struct union)))]
[array-rep-to-pointer-rep (lambda (host-rep) [array-rep-to-pointer-rep (lambda (host-rep)
(if (eq? host-rep 'array) (if (eq? host-rep 'array)
'void* 'void*
@ -2120,7 +2120,7 @@
;; function is called with interrupts disabled ;; function is called with interrupts disabled
(define get-errno (define get-errno
(cond (cond
[(not (chez:memq (machine-type) '(a6nt ta6nt i3nt ti3nt))) [(not (#%memq (machine-type) '(a6nt ta6nt i3nt ti3nt)))
(foreign-procedure "(cs)s_errno" () int)] (foreign-procedure "(cs)s_errno" () int)]
[else [else
;; On Windows, `errno` could be a different one from ;; On Windows, `errno` could be a different one from

2
racket/src/cs/rumble/object-name.ss
View File

@ -9,7 +9,7 @@
"field index >= initialized-field count for structure type" "field index >= initialized-field count for structure type"
"field index" v "field index" v
"initialized-field count" (list-ref info 1))) "initialized-field count" (list-ref info 1)))
(unless (chez:memv v (list-ref info 5)) (unless (#%memv v (list-ref info 5))
(raise-arguments-error 'guard-for-prop:object-name "field index not declared immutable" (raise-arguments-error 'guard-for-prop:object-name "field index not declared immutable"
"field index" v)) "field index" v))
(+ v (let ([p (list-ref info 6)]) (+ v (let ([p (list-ref info 6)])

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

@ -329,7 +329,7 @@
"index for procedure >= initialized-field count" "index for procedure >= initialized-field count"
"index" v "index" v
"field count" init-count)) "field count" init-count))
(unless (or (eq? v proc-spec) (chez:memv v immutables)) (unless (or (eq? v proc-spec) (#%memv v immutables))
(raise-arguments-error who (raise-arguments-error who
"field is not specified as immutable for a prop:procedure index" "field is not specified as immutable for a prop:procedure index"
"index" v))] "index" v))]

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

File diff suppressed because it is too large Load Diff

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

File diff suppressed because it is too large Load Diff

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

@ -12,113 +12,6 @@
(define fixnum-for-every-system? (define fixnum-for-every-system?
(lambda (v_0) (lambda (v_0)
(if (fixnum? v_0) (if (fx>= v_0 -536870912) (fx<= v_0 536870911) #f) #f))) (if (fixnum? v_0) (if (fx>= v_0 -536870912) (fx<= v_0 536870911) #f) #f)))
(define bad-list$1
(|#%name|
bad-list
(lambda (who_0 orig-l_0)
(begin (raise-mismatch-error who_0 "not a proper list: " orig-l_0)))))
(define memq
(|#%name|
memq
(lambda (v_0 orig-l_0)
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (ls_0)
(begin
(if (null? ls_0)
#f
(if (not (pair? ls_0))
(begin-unsafe
(raise-mismatch-error
'memq
"not a proper list: "
orig-l_0))
(if (eq? v_0 (car ls_0)) ls_0 (loop_0 (cdr ls_0))))))))))
(loop_0 orig-l_0))))))
(define memv
(|#%name|
memv
(lambda (v_0 orig-l_0)
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (ls_0)
(begin
(if (null? ls_0)
#f
(if (not (pair? ls_0))
(begin-unsafe
(raise-mismatch-error
'memv
"not a proper list: "
orig-l_0))
(if (eqv? v_0 (car ls_0)) ls_0 (loop_0 (cdr ls_0))))))))))
(loop_0 orig-l_0))))))
(define member
(let ((default_0
(|#%name|
member
(lambda (v_0 orig-l_0)
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (ls_0)
(begin
(if (null? ls_0)
#f
(if (not (pair? ls_0))
(begin-unsafe
(raise-mismatch-error
'member
"not a proper list: "
orig-l_0))
(if (equal? v_0 (car ls_0))
ls_0
(loop_0 (cdr ls_0))))))))))
(loop_0 orig-l_0)))))))
(|#%name|
member
(case-lambda
((v_0 orig-l_0) (begin (default_0 v_0 orig-l_0)))
((v_0 orig-l_0 eq?_0)
(begin
(if (if (procedure? eq?_0) (procedure-arity-includes? eq?_0 2) #f)
(void)
(raise-argument-error
'member
"(procedure-arity-includes/c 2)"
eq?_0))
((|#%name|
member
(lambda (v_1 orig-l_1)
(begin
(letrec*
((loop_0
(|#%name|
loop
(lambda (ls_0)
(begin
(if (null? ls_0)
#f
(if (not (pair? ls_0))
(begin-unsafe
(raise-mismatch-error
'member
"not a proper list: "
orig-l_1))
(if (|#%app| eq?_0 v_1 (car ls_0))
ls_0
(loop_0 (cdr ls_0))))))))))
(loop_0 orig-l_1)))))
v_0
orig-l_0)))))))
(define call-with-exception-handler (define call-with-exception-handler
(lambda (exnh_0 thunk_0) (lambda (exnh_0 thunk_0)
(begin0 (begin0
@ -1957,7 +1850,7 @@
(define reannotate/new-srcloc (define reannotate/new-srcloc
(lambda (old-term_0 new-term_0 new-srcloc_0) (lambda (old-term_0 new-term_0 new-srcloc_0)
(datum->syntax #f new-term_0 new-srcloc_0 old-term_0))) (datum->syntax #f new-term_0 new-srcloc_0 old-term_0)))
(define finish56 (define finish48
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-constant) '(known-constant)
0 0
@ -1978,7 +1871,7 @@
#f #f
0 0
0)) 0))
(define effect_2537 (finish56 struct:known-constant)) (define effect_2537 (finish48 struct:known-constant))
(define known-constant (define known-constant
(|#%name| (|#%name|
known-constant known-constant
@ -1996,7 +1889,7 @@
(if (impersonator? v) (if (impersonator? v)
(known-constant?_2598 (impersonator-val v)) (known-constant?_2598 (impersonator-val v))
#f)))))) #f))))))
(define finish59 (define finish51
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-consistent) '(known-consistent)
0 0
@ -2029,7 +1922,7 @@
#f #f
0 0
0)) 0))
(define effect_2382 (finish59 struct:known-consistent)) (define effect_2382 (finish51 struct:known-consistent))
(define known-consistent (define known-consistent
(|#%name| (|#%name|
known-consistent known-consistent
@ -2047,7 +1940,7 @@
(if (impersonator? v) (if (impersonator? v)
(known-consistent?_3048 (impersonator-val v)) (known-consistent?_3048 (impersonator-val v))
#f)))))) #f))))))
(define finish62 (define finish54
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-authentic) '(known-authentic)
0 0
@ -2080,7 +1973,7 @@
#f #f
0 0
0)) 0))
(define effect_2570 (finish62 struct:known-authentic)) (define effect_2570 (finish54 struct:known-authentic))
(define known-authentic (define known-authentic
(|#%name| (|#%name|
known-authentic known-authentic
@ -2098,7 +1991,7 @@
(if (impersonator? v) (if (impersonator? v)
(known-authentic?_3119 (impersonator-val v)) (known-authentic?_3119 (impersonator-val v))
#f)))))) #f))))))
(define finish65 (define finish57
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-copy) '(known-copy)
1 1
@ -2131,7 +2024,7 @@
#f #f
1 1
1)) 1))
(define effect_2542 (finish65 struct:known-copy)) (define effect_2542 (finish57 struct:known-copy))
(define known-copy (define known-copy
(|#%name| (|#%name|
known-copy known-copy
@ -2163,7 +2056,7 @@
s s
'known-copy 'known-copy
'id)))))) 'id))))))
(define finish69 (define finish61
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-literal) '(known-literal)
1 1
@ -2196,7 +2089,7 @@
#f #f
1 1
1)) 1))
(define effect_2788 (finish69 struct:known-literal)) (define effect_2788 (finish61 struct:known-literal))
(define known-literal (define known-literal
(|#%name| (|#%name|
known-literal known-literal
@ -2230,7 +2123,7 @@
s s
'known-literal 'known-literal
'value)))))) 'value))))))
(define finish73 (define finish65
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-procedure) '(known-procedure)
1 1
@ -2263,7 +2156,7 @@
#f #f
1 1
1)) 1))
(define effect_2677 (finish73 struct:known-procedure)) (define effect_2677 (finish65 struct:known-procedure))
(define known-procedure (define known-procedure
(|#%name| (|#%name|
known-procedure known-procedure
@ -2299,7 +2192,7 @@
s s
'known-procedure 'known-procedure
'arity-mask)))))) 'arity-mask))))))
(define finish77 (define finish69
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-procedure/single-valued) '(known-procedure/single-valued)
0 0
@ -2332,7 +2225,7 @@
#f #f
0 0
0)) 0))
(define effect_2532 (finish77 struct:known-procedure/single-valued)) (define effect_2532 (finish69 struct:known-procedure/single-valued))
(define known-procedure/single-valued (define known-procedure/single-valued
(|#%name| (|#%name|
known-procedure/single-valued known-procedure/single-valued
@ -2355,7 +2248,7 @@
(if (impersonator? v) (if (impersonator? v)
(known-procedure/single-valued?_3105 (impersonator-val v)) (known-procedure/single-valued?_3105 (impersonator-val v))
#f)))))) #f))))))
(define finish80 (define finish72
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-procedure/no-prompt) '(known-procedure/no-prompt)
0 0
@ -2388,7 +2281,7 @@
#f #f
0 0
0)) 0))
(define effect_1771 (finish80 struct:known-procedure/no-prompt)) (define effect_1771 (finish72 struct:known-procedure/no-prompt))
(define known-procedure/no-prompt (define known-procedure/no-prompt
(|#%name| (|#%name|
known-procedure/no-prompt known-procedure/no-prompt
@ -2411,7 +2304,7 @@
(if (impersonator? v) (if (impersonator? v)
(known-procedure/no-prompt?_2036 (impersonator-val v)) (known-procedure/no-prompt?_2036 (impersonator-val v))
#f)))))) #f))))))
(define finish83 (define finish75
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-procedure/no-prompt/multi) '(known-procedure/no-prompt/multi)
0 0
@ -2444,7 +2337,7 @@
#f #f
0 0
0)) 0))
(define effect_2793 (finish83 struct:known-procedure/no-prompt/multi)) (define effect_2793 (finish75 struct:known-procedure/no-prompt/multi))
(define known-procedure/no-prompt/multi (define known-procedure/no-prompt/multi
(|#%name| (|#%name|
known-procedure/no-prompt/multi known-procedure/no-prompt/multi
@ -2467,7 +2360,7 @@
(if (impersonator? v) (if (impersonator? v)
(known-procedure/no-prompt/multi?_2394 (impersonator-val v)) (known-procedure/no-prompt/multi?_2394 (impersonator-val v))
#f)))))) #f))))))
(define finish86 (define finish78
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-procedure/no-return) '(known-procedure/no-return)
0 0
@ -2500,7 +2393,7 @@
#f #f
0 0
0)) 0))
(define effect_2517 (finish86 struct:known-procedure/no-return)) (define effect_2517 (finish78 struct:known-procedure/no-return))
(define known-procedure/no-return (define known-procedure/no-return
(|#%name| (|#%name|
known-procedure/no-return known-procedure/no-return
@ -2523,7 +2416,7 @@
(if (impersonator? v) (if (impersonator? v)
(known-procedure/no-return?_1763 (impersonator-val v)) (known-procedure/no-return?_1763 (impersonator-val v))
#f)))))) #f))))))
(define finish89 (define finish81
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-procedure/can-inline) '(known-procedure/can-inline)
1 1
@ -2556,7 +2449,7 @@
#f #f
1 1
1)) 1))
(define effect_2308 (finish89 struct:known-procedure/can-inline)) (define effect_2308 (finish81 struct:known-procedure/can-inline))
(define known-procedure/can-inline (define known-procedure/can-inline
(|#%name| (|#%name|
known-procedure/can-inline known-procedure/can-inline
@ -2597,7 +2490,7 @@
s s
'known-procedure/can-inline 'known-procedure/can-inline
'expr)))))) 'expr))))))
(define finish93 (define finish85
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-procedure/can-inline/need-imports) '(known-procedure/can-inline/need-imports)
1 1
@ -2630,7 +2523,7 @@
#f #f
1 1
1)) 1))
(define effect_2618 (finish93 struct:known-procedure/can-inline/need-imports)) (define effect_2618 (finish85 struct:known-procedure/can-inline/need-imports))
(define known-procedure/can-inline/need-imports (define known-procedure/can-inline/need-imports
(|#%name| (|#%name|
known-procedure/can-inline/need-imports known-procedure/can-inline/need-imports
@ -2671,7 +2564,7 @@
s s
'known-procedure/can-inline/need-imports 'known-procedure/can-inline/need-imports
'needed)))))) 'needed))))))
(define finish97 (define finish89
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-procedure/folding) '(known-procedure/folding)
0 0
@ -2704,7 +2597,7 @@
#f #f
0 0
0)) 0))
(define effect_2478 (finish97 struct:known-procedure/folding)) (define effect_2478 (finish89 struct:known-procedure/folding))
(define known-procedure/folding (define known-procedure/folding
(|#%name| (|#%name|
known-procedure/folding known-procedure/folding
@ -2727,7 +2620,7 @@
(if (impersonator? v) (if (impersonator? v)
(known-procedure/folding?_2882 (impersonator-val v)) (known-procedure/folding?_2882 (impersonator-val v))
#f)))))) #f))))))
(define finish100 (define finish92
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-procedure/folding/limited) '(known-procedure/folding/limited)
1 1
@ -2760,7 +2653,7 @@
#f #f
1 1
1)) 1))
(define effect_2518 (finish100 struct:known-procedure/folding/limited)) (define effect_2518 (finish92 struct:known-procedure/folding/limited))
(define known-procedure/folding/limited (define known-procedure/folding/limited
(|#%name| (|#%name|
known-procedure/folding/limited known-procedure/folding/limited
@ -2801,7 +2694,7 @@
s s
'known-procedure/folding/limited 'known-procedure/folding/limited
'kind)))))) 'kind))))))
(define finish104 (define finish96
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-procedure/succeeds) '(known-procedure/succeeds)
0 0
@ -2834,7 +2727,7 @@
#f #f
0 0
0)) 0))
(define effect_2467 (finish104 struct:known-procedure/succeeds)) (define effect_2467 (finish96 struct:known-procedure/succeeds))
(define known-procedure/succeeds (define known-procedure/succeeds
(|#%name| (|#%name|
known-procedure/succeeds known-procedure/succeeds
@ -2857,7 +2750,7 @@
(if (impersonator? v) (if (impersonator? v)
(known-procedure/succeeds?_3041 (impersonator-val v)) (known-procedure/succeeds?_3041 (impersonator-val v))
#f)))))) #f))))))
(define finish107 (define finish99
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-procedure/allocates) '(known-procedure/allocates)
0 0
@ -2890,7 +2783,7 @@
#f #f
0 0
0)) 0))
(define effect_2336 (finish107 struct:known-procedure/allocates)) (define effect_2336 (finish99 struct:known-procedure/allocates))
(define known-procedure/allocates (define known-procedure/allocates
(|#%name| (|#%name|
known-procedure/allocates known-procedure/allocates
@ -2913,7 +2806,7 @@
(if (impersonator? v) (if (impersonator? v)
(known-procedure/allocates?_2244 (impersonator-val v)) (known-procedure/allocates?_2244 (impersonator-val v))
#f)))))) #f))))))
(define finish110 (define finish102
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-procedure/pure) '(known-procedure/pure)
0 0
@ -2946,7 +2839,7 @@
#f #f
0 0
0)) 0))
(define effect_3058 (finish110 struct:known-procedure/pure)) (define effect_3058 (finish102 struct:known-procedure/pure))
(define known-procedure/pure (define known-procedure/pure
(|#%name| (|#%name|
known-procedure/pure known-procedure/pure
@ -2966,7 +2859,7 @@
(if (impersonator? v) (if (impersonator? v)
(known-procedure/pure?_2240 (impersonator-val v)) (known-procedure/pure?_2240 (impersonator-val v))
#f)))))) #f))))))
(define finish113 (define finish105
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-procedure/pure/folding) '(known-procedure/pure/folding)
0 0
@ -2999,7 +2892,7 @@
#f #f
0 0
0)) 0))
(define effect_2264 (finish113 struct:known-procedure/pure/folding)) (define effect_2264 (finish105 struct:known-procedure/pure/folding))
(define known-procedure/pure/folding (define known-procedure/pure/folding
(|#%name| (|#%name|
known-procedure/pure/folding known-procedure/pure/folding
@ -3022,7 +2915,7 @@
(if (impersonator? v) (if (impersonator? v)
(known-procedure/pure/folding?_2719 (impersonator-val v)) (known-procedure/pure/folding?_2719 (impersonator-val v))
#f)))))) #f))))))
(define finish116 (define finish108
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-procedure/pure/folding-unsafe) '(known-procedure/pure/folding-unsafe)
1 1
@ -3055,7 +2948,7 @@
#f #f
1 1
1)) 1))
(define effect_2657 (finish116 struct:known-procedure/pure/folding-unsafe)) (define effect_2657 (finish108 struct:known-procedure/pure/folding-unsafe))
(define known-procedure/pure/folding-unsafe (define known-procedure/pure/folding-unsafe
(|#%name| (|#%name|
known-procedure/pure/folding-unsafe known-procedure/pure/folding-unsafe
@ -3096,7 +2989,7 @@
s s
'known-procedure/pure/folding-unsafe 'known-procedure/pure/folding-unsafe
'safe)))))) 'safe))))))
(define finish120 (define finish112
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-procedure/has-unsafe) '(known-procedure/has-unsafe)
1 1
@ -3129,7 +3022,7 @@
#f #f
1 1
1)) 1))
(define effect_1752 (finish120 struct:known-procedure/has-unsafe)) (define effect_1752 (finish112 struct:known-procedure/has-unsafe))
(define known-procedure/has-unsafe (define known-procedure/has-unsafe
(|#%name| (|#%name|
known-procedure/has-unsafe known-procedure/has-unsafe
@ -3170,7 +3063,7 @@
s s
'known-procedure/has-unsafe 'known-procedure/has-unsafe
'alternate)))))) 'alternate))))))
(define finish124 (define finish116
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-procedure/has-unsafe/folding) '(known-procedure/has-unsafe/folding)
0 0
@ -3203,7 +3096,7 @@
#f #f
0 0
0)) 0))
(define effect_2489 (finish124 struct:known-procedure/has-unsafe/folding)) (define effect_2489 (finish116 struct:known-procedure/has-unsafe/folding))
(define known-procedure/has-unsafe/folding (define known-procedure/has-unsafe/folding
(|#%name| (|#%name|
known-procedure/has-unsafe/folding known-procedure/has-unsafe/folding
@ -3226,7 +3119,7 @@
(if (impersonator? v) (if (impersonator? v)
(known-procedure/has-unsafe/folding?_2169 (impersonator-val v)) (known-procedure/has-unsafe/folding?_2169 (impersonator-val v))
#f)))))) #f))))))
(define finish127 (define finish119
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-procedure/has-unsafe/folding/limited) '(known-procedure/has-unsafe/folding/limited)
1 1
@ -3260,7 +3153,7 @@
1 1
1)) 1))
(define effect_2512 (define effect_2512
(finish127 struct:known-procedure/has-unsafe/folding/limited)) (finish119 struct:known-procedure/has-unsafe/folding/limited))
(define known-procedure/has-unsafe/folding/limited (define known-procedure/has-unsafe/folding/limited
(|#%name| (|#%name|
known-procedure/has-unsafe/folding/limited known-procedure/has-unsafe/folding/limited
@ -3302,7 +3195,7 @@
s s
'known-procedure/has-unsafe/folding/limited 'known-procedure/has-unsafe/folding/limited
'kind)))))) 'kind))))))
(define finish131 (define finish123
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-struct-type) '(known-struct-type)
4 4
@ -3335,7 +3228,7 @@
#f #f
4 4
15)) 15))
(define effect_2667 (finish131 struct:known-struct-type)) (define effect_2667 (finish123 struct:known-struct-type))
(define known-struct-type (define known-struct-type
(|#%name| (|#%name|
known-struct-type known-struct-type
@ -3425,7 +3318,7 @@
s s
'known-struct-type 'known-struct-type
'sealed?)))))) 'sealed?))))))
(define finish138 (define finish130
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-constructor) '(known-constructor)
1 1
@ -3458,7 +3351,7 @@
#f #f
1 1
1)) 1))
(define effect_1913 (finish138 struct:known-constructor)) (define effect_1913 (finish130 struct:known-constructor))
(define known-constructor (define known-constructor
(|#%name| (|#%name|
known-constructor known-constructor
@ -3494,7 +3387,7 @@
s s
'known-constructor 'known-constructor
'type)))))) 'type))))))
(define finish142 (define finish134
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-predicate) '(known-predicate)
1 1
@ -3527,7 +3420,7 @@
#f #f
1 1
1)) 1))
(define effect_2144 (finish142 struct:known-predicate)) (define effect_2144 (finish134 struct:known-predicate))
(define known-predicate (define known-predicate
(|#%name| (|#%name|
known-predicate known-predicate
@ -3561,7 +3454,7 @@
s s
'known-predicate 'known-predicate
'type)))))) 'type))))))
(define finish146 (define finish138
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-accessor) '(known-accessor)
1 1
@ -3594,7 +3487,7 @@
#f #f
1 1
1)) 1))
(define effect_2905 (finish146 struct:known-accessor)) (define effect_2905 (finish138 struct:known-accessor))
(define known-accessor (define known-accessor
(|#%name| (|#%name|
known-accessor known-accessor
@ -3628,7 +3521,7 @@
s s
'known-accessor 'known-accessor
'type)))))) 'type))))))
(define finish150 (define finish142
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-mutator) '(known-mutator)
1 1
@ -3661,7 +3554,7 @@
#f #f
1 1
1)) 1))
(define effect_2521 (finish150 struct:known-mutator)) (define effect_2521 (finish142 struct:known-mutator))
(define known-mutator (define known-mutator
(|#%name| (|#%name|
known-mutator known-mutator
@ -3695,7 +3588,7 @@
s s
'known-mutator 'known-mutator
'type)))))) 'type))))))
(define finish154 (define finish146
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-struct-constructor) '(known-struct-constructor)
1 1
@ -3728,7 +3621,7 @@
#f #f
1 1
1)) 1))
(define effect_3238 (finish154 struct:known-struct-constructor)) (define effect_3238 (finish146 struct:known-struct-constructor))
(define known-struct-constructor (define known-struct-constructor
(|#%name| (|#%name|
known-struct-constructor known-struct-constructor
@ -3769,7 +3662,7 @@
s s
'known-struct-constructor 'known-struct-constructor
'type-id)))))) 'type-id))))))
(define finish158 (define finish150
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-struct-predicate) '(known-struct-predicate)
3 3
@ -3802,7 +3695,7 @@
#f #f
3 3
7)) 7))
(define effect_2384 (finish158 struct:known-struct-predicate)) (define effect_2384 (finish150 struct:known-struct-predicate))
(define known-struct-predicate (define known-struct-predicate
(|#%name| (|#%name|
known-struct-predicate known-struct-predicate
@ -3876,7 +3769,7 @@
s s
'known-struct-predicate 'known-struct-predicate
'sealed?)))))) 'sealed?))))))
(define finish164 (define finish156
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-field-accessor) '(known-field-accessor)
4 4
@ -3909,7 +3802,7 @@
#f #f
4 4
15)) 15))
(define effect_2259 (finish164 struct:known-field-accessor)) (define effect_2259 (finish156 struct:known-field-accessor))
(define known-field-accessor (define known-field-accessor
(|#%name| (|#%name|
known-field-accessor known-field-accessor
@ -4001,7 +3894,7 @@
s s
'known-field-accessor 'known-field-accessor
'known-immutable?)))))) 'known-immutable?))))))
(define finish171 (define finish163
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-field-mutator) '(known-field-mutator)
3 3
@ -4034,7 +3927,7 @@
#f #f
3 3
7)) 7))
(define effect_2603 (finish171 struct:known-field-mutator)) (define effect_2603 (finish163 struct:known-field-mutator))
(define known-field-mutator (define known-field-mutator
(|#%name| (|#%name|
known-field-mutator known-field-mutator
@ -4108,7 +4001,7 @@
s s
'known-field-mutator 'known-field-mutator
'pos)))))) 'pos))))))
(define finish177 (define finish169
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-struct-constructor/need-imports) '(known-struct-constructor/need-imports)
1 1
@ -4141,7 +4034,7 @@
#f #f
1 1
1)) 1))
(define effect_2146 (finish177 struct:known-struct-constructor/need-imports)) (define effect_2146 (finish169 struct:known-struct-constructor/need-imports))
(define known-struct-constructor/need-imports (define known-struct-constructor/need-imports
(|#%name| (|#%name|
known-struct-constructor/need-imports known-struct-constructor/need-imports
@ -4182,7 +4075,7 @@
s s
'known-struct-constructor/need-imports 'known-struct-constructor/need-imports
'needed)))))) 'needed))))))
(define finish181 (define finish173
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-struct-predicate/need-imports) '(known-struct-predicate/need-imports)
1 1
@ -4215,7 +4108,7 @@
#f #f
1 1
1)) 1))
(define effect_3156 (finish181 struct:known-struct-predicate/need-imports)) (define effect_3156 (finish173 struct:known-struct-predicate/need-imports))
(define known-struct-predicate/need-imports (define known-struct-predicate/need-imports
(|#%name| (|#%name|
known-struct-predicate/need-imports known-struct-predicate/need-imports
@ -4256,7 +4149,7 @@
s s
'known-struct-predicate/need-imports 'known-struct-predicate/need-imports
'needed)))))) 'needed))))))
(define finish185 (define finish177
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-field-accessor/need-imports) '(known-field-accessor/need-imports)
1 1
@ -4289,7 +4182,7 @@
#f #f
1 1
1)) 1))
(define effect_2513 (finish185 struct:known-field-accessor/need-imports)) (define effect_2513 (finish177 struct:known-field-accessor/need-imports))
(define known-field-accessor/need-imports (define known-field-accessor/need-imports
(|#%name| (|#%name|
known-field-accessor/need-imports known-field-accessor/need-imports
@ -4330,7 +4223,7 @@
s s
'known-field-accessor/need-imports 'known-field-accessor/need-imports
'needed)))))) 'needed))))))
(define finish189 (define finish181
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-field-mutator/need-imports) '(known-field-mutator/need-imports)
1 1
@ -4363,7 +4256,7 @@
#f #f
1 1
1)) 1))
(define effect_2273 (finish189 struct:known-field-mutator/need-imports)) (define effect_2273 (finish181 struct:known-field-mutator/need-imports))
(define known-field-mutator/need-imports (define known-field-mutator/need-imports
(|#%name| (|#%name|
known-field-mutator/need-imports known-field-mutator/need-imports
@ -4404,7 +4297,7 @@
s s
'known-field-mutator/need-imports 'known-field-mutator/need-imports
'needed)))))) 'needed))))))
(define finish193 (define finish185
(make-struct-type-install-properties (make-struct-type-install-properties
'(known-struct-type-property/immediate-guard) '(known-struct-type-property/immediate-guard)
0 0
@ -4432,7 +4325,7 @@
0 0
0)) 0))
(define effect_2294 (define effect_2294
(finish193 struct:known-struct-type-property/immediate-guard)) (finish185 struct:known-struct-type-property/immediate-guard))
(define known-struct-type-property/immediate-guard (define known-struct-type-property/immediate-guard
(|#%name| (|#%name|
known-struct-type-property/immediate-guard known-struct-type-property/immediate-guard
@ -4473,7 +4366,7 @@
(let ((app_0 (let ((app_0
(if (string? prefix_0) prefix_0 (symbol->string prefix_0)))) (if (string? prefix_0) prefix_0 (symbol->string prefix_0))))
(string-append app_0 (number->string (unbox b_0))))))))) (string-append app_0 (number->string (unbox b_0)))))))))
(define finish197 (define finish189
(make-struct-type-install-properties (make-struct-type-install-properties
'(import) '(import)
4 4
@ -4494,7 +4387,7 @@
#f #f
4 4
0)) 0))
(define effect_2192 (finish197 struct:import)) (define effect_2192 (finish189 struct:import))
(define import1.1 (define import1.1
(|#%name| (|#%name|
import import
@ -4560,7 +4453,7 @@
s s
'import 'import
'ext-id)))))) 'ext-id))))))
(define finish204 (define finish196
(make-struct-type-install-properties (make-struct-type-install-properties
'(import-group) '(import-group)
6 6
@ -4581,7 +4474,7 @@
#f #f
6 6
60)) 60))
(define effect_2739 (finish204 struct:import-group)) (define effect_2739 (finish196 struct:import-group))
(define import-group2.1 (define import-group2.1
(|#%name| (|#%name|
import-group import-group
@ -4930,7 +4823,7 @@
(|#%app| inc-index!_0) (|#%app| inc-index!_0)
(|#%app| add-group!_0 grp_0) (|#%app| add-group!_0 grp_0)
grp_0)))))) grp_0))))))
(define finish218 (define finish210
(make-struct-type-install-properties (make-struct-type-install-properties
'(export) '(export)
2 2
@ -4951,7 +4844,7 @@
#f #f
2 2
0)) 0))
(define effect_2782 (finish218 struct:export)) (define effect_2782 (finish210 struct:export))
(define export1.1 (define export1.1
(|#%name| (|#%name|
export export
@ -4991,7 +4884,7 @@
s s
'export 'export
'ext-id)))))) 'ext-id))))))
(define finish223 (define finish215
(make-struct-type-install-properties (make-struct-type-install-properties
'(too-early) '(too-early)
2 2
@ -5012,7 +4905,7 @@
#f #f
2 2
0)) 0))
(define effect_2833 (finish223 struct:too-early)) (define effect_2833 (finish215 struct:too-early))
(define too-early1.1 (define too-early1.1
(|#%name| (|#%name|
too-early too-early
@ -7300,7 +7193,7 @@
(case-lambda (case-lambda
((k_0 im_0) k_0) ((k_0 im_0) k_0)
(args (raise-binding-result-arity-error 2 args)))))) (args (raise-binding-result-arity-error 2 args))))))
(define finish311 (define finish303
(make-struct-type-install-properties (make-struct-type-install-properties
'(struct-type-info) '(struct-type-info)
11 11
@ -7321,7 +7214,7 @@
#f #f
11 11
0)) 0))
(define effect_2037 (finish311 struct:struct-type-info)) (define effect_2037 (finish303 struct:struct-type-info))
(define struct-type-info1.1 (define struct-type-info1.1
(|#%name| (|#%name|
struct-type-info struct-type-info
@ -30749,7 +30642,7 @@
(schemify-body_0 (cdr l_0) wcm-state_2)))))))))) (schemify-body_0 (cdr l_0) wcm-state_2))))))))))
(schemify_0 v_1 wcm-state_1))))))) (schemify_0 v_1 wcm-state_1)))))))
(schemify/knowns_0 knowns_0 8 wcm-state_0 v_0)))) (schemify/knowns_0 knowns_0 8 wcm-state_0 v_0))))
(define finish1676 (define finish1668
(make-struct-type-install-properties (make-struct-type-install-properties
'(convert-mode) '(convert-mode)
4 4
@ -30770,7 +30663,7 @@
#f #f
4 4
0)) 0))
(define effect_2443 (finish1676 struct:convert-mode)) (define effect_2443 (finish1668 struct:convert-mode))
(define convert-mode1.1 (define convert-mode1.1
(|#%name| (|#%name|
convert-mode convert-mode
@ -39893,7 +39786,7 @@
(if (|#%app| need-exposed?_0 q_0) (if (|#%app| need-exposed?_0 q_0)
#t #t
(if (extflonum? q_0) #t #f)))))))))))))) (if (extflonum? q_0) #t #f))))))))))))))
(define finish2146 (define finish2138
(make-struct-type-install-properties (make-struct-type-install-properties
'(to-unfasl) '(to-unfasl)
3 3
@ -39914,7 +39807,7 @@
#f #f
3 3
0)) 0))
(define effect_2898 (finish2146 struct:to-unfasl)) (define effect_2898 (finish2138 struct:to-unfasl))
(define to-unfasl1.1 (define to-unfasl1.1
(|#%name| (|#%name|
to-unfasl to-unfasl
@ -40044,7 +39937,7 @@
'write 'write
"cannot marshal value that is embedded in compiled code\n value: ~v" "cannot marshal value that is embedded in compiled code\n value: ~v"
v_0))) v_0)))
(define finish2154 (define finish2146
(make-struct-type-install-properties (make-struct-type-install-properties
'(node) '(node)
5 5
@ -40065,7 +39958,7 @@
#f #f
5 5
0)) 0))
(define effect_2547 (finish2154 struct:node)) (define effect_2547 (finish2146 struct:node))
(define node1.1 (define node1.1
(|#%name| (|#%name|
node node
@ -40366,7 +40259,7 @@
app_2 app_2
(stack-set stack_1 pos_1 (car vals_1)))))))))))) (stack-set stack_1 pos_1 (car vals_1))))))))))))
(loop_0 pos_0 vals_0 count_0 stack_0)))))) (loop_0 pos_0 vals_0 count_0 stack_0))))))
(define finish2200 (define finish2192
(make-struct-type-install-properties (make-struct-type-install-properties
'(stack-info) '(stack-info)
5 5
@ -40387,7 +40280,7 @@
#f #f
5 5
28)) 28))
(define effect_2334 (finish2200 struct:stack-info)) (define effect_2334 (finish2192 struct:stack-info))
(define stack-info4.1 (define stack-info4.1
(|#%name| (|#%name|
stack-info stack-info
@ -40724,7 +40617,7 @@
(define stack-info-non-tail! (define stack-info-non-tail!
(lambda (stk-i_0 stack-depth_0) (lambda (stk-i_0 stack-depth_0)
(set-stack-info-non-tail-call-later?! stk-i_0 #t))) (set-stack-info-non-tail-call-later?! stk-i_0 #t)))
(define finish2214 (define finish2206
(make-struct-type-install-properties (make-struct-type-install-properties
'(indirect) '(indirect)
2 2
@ -40745,7 +40638,7 @@
#f #f
2 2
0)) 0))
(define effect_2125 (finish2214 struct:indirect)) (define effect_2125 (finish2206 struct:indirect))
(define indirect1.1 (define indirect1.1
(|#%name| (|#%name|
indirect indirect
@ -40792,7 +40685,7 @@
s s
'indirect 'indirect
'element)))))) 'element))))))
(define finish2219 (define finish2211
(make-struct-type-install-properties (make-struct-type-install-properties
'(boxed) '(boxed)
1 1
@ -40813,7 +40706,7 @@
#f #f
1 1
0)) 0))
(define effect_2970 (finish2219 struct:boxed)) (define effect_2970 (finish2211 struct:boxed))
(define boxed2.1 (define boxed2.1
(|#%name| (|#%name|
boxed boxed
@ -40837,7 +40730,7 @@
(boxed-pos_2515 s) (boxed-pos_2515 s)
($value ($value
(impersonate-ref boxed-pos_2515 struct:boxed 0 s 'boxed 'pos)))))) (impersonate-ref boxed-pos_2515 struct:boxed 0 s 'boxed 'pos))))))
(define finish2223 (define finish2215
(make-struct-type-install-properties (make-struct-type-install-properties
'(boxed/check) '(boxed/check)
0 0
@ -40858,7 +40751,7 @@
#f #f
0 0
0)) 0))
(define effect_2937 (finish2223 struct:boxed/check)) (define effect_2937 (finish2215 struct:boxed/check))
(define boxed/check3.1 (define boxed/check3.1
(|#%name| (|#%name|
boxed/check boxed/check

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

File diff suppressed because it is too large Load Diff

2
racket/src/version/racket_version.h
View File

@ -16,7 +16,7 @@
#define MZSCHEME_VERSION_X 8 #define MZSCHEME_VERSION_X 8
#define MZSCHEME_VERSION_Y 0 #define MZSCHEME_VERSION_Y 0
#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