move memq and memv back to core
This commit partly revertsc305dba649and88fc9a979f, 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
parent
db34c62241
commit
d0feb5c75a
|
|
@ -14,7 +14,7 @@
|
|||
|
||||
;; In the Racket source repo, this version should change only when
|
||||
;; "racket_version.h" changes:
|
||||
(define version "8.0.0.11")
|
||||
(define version "8.0.0.12")
|
||||
|
||||
(define deps `("racket-lib"
|
||||
["racket" #:version ,version]))
|
||||
|
|
|
|||
|
|
@ -328,8 +328,9 @@
|
|||
(if (eq? memq-name 'member)
|
||||
(arity-test memq 2 3)
|
||||
(arity-test memq 2 2))
|
||||
(err/rt-test (memq 'a 1) exn:application:mismatch?)
|
||||
(err/rt-test (memq 'a '(1 . 2)) 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: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 memv 'memv)
|
||||
|
|
|
|||
|
|
@ -1,57 +1,38 @@
|
|||
(module member '#%kernel
|
||||
(#%require "cond.rkt" "qq-and-or.rkt"
|
||||
(for-syntax '#%kernel "qq-and-or.rkt"))
|
||||
(#%provide memq memv member)
|
||||
(#%require "cond.rkt" "qq-and-or.rkt")
|
||||
(#%provide member)
|
||||
|
||||
;; helper for memq/v/ber error cases
|
||||
;; helper for member error cases
|
||||
(define-values (bad-list)
|
||||
(λ (who orig-l)
|
||||
(raise-mismatch-error who "not a proper list: " orig-l)))
|
||||
|
||||
(define-values (memq memv member)
|
||||
(let-values ()
|
||||
;; Create the mem functions
|
||||
(define-syntaxes (mk mk-member)
|
||||
(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
|
||||
(define-values (member)
|
||||
(letrec-values ([(member)
|
||||
(lambda (v orig-l eql?)
|
||||
(let loop ([ls orig-l] [turtle orig-l])
|
||||
(cond
|
||||
[(null? ls) #f]
|
||||
[(not (pair? ls))
|
||||
(bad-list 'member orig-l)]
|
||||
[(eql? v (car ls)) ls]
|
||||
[else
|
||||
(let ([ls (cdr ls)])
|
||||
(cond
|
||||
[(null? ls) #f]
|
||||
[(not (pair? ls))
|
||||
(bad-list ',id orig-l)]
|
||||
[(,eq? v (car ls)) ls]
|
||||
[else (loop (cdr ls))])))])
|
||||
,id)))
|
||||
;; Create the `member` function that takes an extra argument
|
||||
;; Uses `mk` to construct the body
|
||||
(λ (stx)
|
||||
(define-values (forms) (syntax-e stx))
|
||||
(define-values (id) (syntax-e (cadr forms)))
|
||||
(datum->syntax
|
||||
stx
|
||||
`(let* ([default (mk member equal?)]
|
||||
[,id (case-lambda
|
||||
([v orig-l] (default v orig-l))
|
||||
([v orig-l eq?]
|
||||
(if (and (procedure? eq?)
|
||||
(procedure-arity-includes? eq? 2))
|
||||
(void)
|
||||
(raise-argument-error
|
||||
'member
|
||||
"(procedure-arity-includes/c 2)"
|
||||
eq?))
|
||||
((mk member eq?) v orig-l)))])
|
||||
,id)))))
|
||||
(values (mk memq eq?)
|
||||
(mk memv eqv?)
|
||||
;; Note that this uses `mk-member`
|
||||
(mk-member member)))))
|
||||
|
||||
[(or (not (pair? ls))
|
||||
(eq? ls turtle))
|
||||
(bad-list 'member orig-l)]
|
||||
[(eql? v (car ls)) ls]
|
||||
[else (loop (cdr ls) (cdr turtle))]))])))])
|
||||
(case-lambda
|
||||
[(v ls) (member v ls equal?)]
|
||||
[(v ls eql?)
|
||||
(if (and (procedure? eql?)
|
||||
(procedure-arity-includes? eql? 2))
|
||||
(void)
|
||||
(raise-argument-error
|
||||
'member
|
||||
"(procedure-arity-includes/c 2)"
|
||||
eq?))
|
||||
(member v ls eql?)]))))
|
||||
|
|
|
|||
|
|
@ -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 *append_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 *assq (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_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_make_immed_prim(assq,
|
||||
"assq",
|
||||
|
|
@ -1735,6 +1748,39 @@ static void mem_past_end(const char *name, Scheme_Object *s_arg, Scheme_Object *
|
|||
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)
|
||||
{
|
||||
scheme_contract_error(name,
|
||||
|
|
|
|||
|
|
@ -15,7 +15,7 @@
|
|||
|
||||
#define USE_COMPILED_STARTUP 1
|
||||
|
||||
#define EXPECTED_PRIM_COUNT 1501
|
||||
#define EXPECTED_PRIM_COUNT 1503
|
||||
|
||||
#ifdef MZSCHEME_SOMETHING_OMITTED
|
||||
# undef USE_COMPILED_STARTUP
|
||||
|
|
|
|||
|
|
@ -77,94 +77,43 @@ static const char *startup_source =
|
|||
"(bad-list$1)"
|
||||
" (lambda (who_0 orig-l_0) (begin 'bad-list (raise-mismatch-error who_0 \"not a proper list: \" orig-l_0))))"
|
||||
"(define-values"
|
||||
"(memq memv member)"
|
||||
"(let-values()"
|
||||
"(let-values()"
|
||||
"(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)"
|
||||
"(member)"
|
||||
"(letrec-values(((member_0)"
|
||||
"(lambda(v_0 orig-l_0 eql?_0)"
|
||||
"(begin"
|
||||
" 'member"
|
||||
"((letrec-values(((loop_0)"
|
||||
"(lambda(ls_0)"
|
||||
"(lambda(ls_0 turtle_0)"
|
||||
"(begin"
|
||||
" 'loop"
|
||||
"(if(null? ls_0)"
|
||||
"(let-values() #f)"
|
||||
"(if(not(pair? ls_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()(loop_0(cdr ls_0))))))))))"
|
||||
" loop_0)"
|
||||
" orig-l_0)))))"
|
||||
" 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()"
|
||||
"(let-values(((ls_1)(cdr ls_0)))"
|
||||
"(if(null? ls_1)"
|
||||
"(let-values() #f)"
|
||||
"(if(not(pair? ls_0))"
|
||||
"(let-values()(bad-list$1 'member orig-l_1))"
|
||||
"(if(eq?_0 v_1(car ls_0))"
|
||||
"(let-values() ls_0)"
|
||||
"(let-values()(loop_0(cdr ls_0))))))))))"
|
||||
"(if(let-values(((or-part_0)(not(pair? ls_1))))"
|
||||
"(if or-part_0 or-part_0(eq? ls_1 turtle_0)))"
|
||||
"(let-values()(bad-list$1 'member orig-l_0))"
|
||||
"(if(eql?_0 v_0(car ls_1))"
|
||||
"(let-values() ls_1)"
|
||||
"(let-values()"
|
||||
"(loop_0(cdr ls_1)(cdr turtle_0)))))))))))))))"
|
||||
" loop_0)"
|
||||
" orig-l_1)))))"
|
||||
" member_0)"
|
||||
" v_0"
|
||||
" orig-l_0))))))"
|
||||
" member_0))))))"
|
||||
" orig-l_0"
|
||||
" orig-l_0)))))"
|
||||
"(case-lambda"
|
||||
"((v_0 ls_0)(begin(member_0 v_0 ls_0 equal?)))"
|
||||
"((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"
|
||||
"(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)))"
|
||||
"(void)"
|
||||
" (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)"
|
||||
"(andmap"
|
||||
"(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)"
|
||||
"(let-values(((base_0 name_0 dir?_0)(split-path program_0)))(eq? base_0 'relative))"
|
||||
" #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)"
|
||||
"(lambda(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)))"
|
||||
"(if(file-exists? name_0)(found-exec_0 name_0)(loop_0(cdr paths_0))))))))))"
|
||||
" loop_0)"
|
||||
"(win-add_0"
|
||||
"(if paths-str_0(path-list-string->path-list(bytes->string/locale paths-str_0 '#\\?) null) null))))"
|
||||
"(win-add_0(if paths-bstr_0(path-list-string->path-list paths-bstr_0 null) null))))"
|
||||
"(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)(find-executable-path program_0 #f #f))))"
|
||||
|
|
|
|||
|
|
@ -78,8 +78,6 @@
|
|||
[delete-directory chez:delete-directory]
|
||||
[filter chez:filter]
|
||||
[member chez:member]
|
||||
[memv chez:memv]
|
||||
[memq chez:memq]
|
||||
[error chez:error]
|
||||
[raise chez:raise]
|
||||
[exit-handler chez:exit-handler]
|
||||
|
|
|
|||
|
|
@ -559,6 +559,8 @@
|
|||
[mcons (known-procedure/allocates 4)]
|
||||
[memory-order-acquire (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)]
|
||||
[modulo (known-procedure/folding 4)]
|
||||
[mpair? (known-procedure/pure/folding 2)]
|
||||
|
|
|
|||
|
|
@ -59,7 +59,7 @@
|
|||
(check who
|
||||
:test (and (pair? 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))"
|
||||
errno))
|
||||
|
||||
|
|
|
|||
|
|
@ -110,6 +110,8 @@
|
|||
" index: ~s\n"
|
||||
" in: ~s")
|
||||
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")
|
||||
(cond
|
||||
[(exact-nonnegative-integer? (car irritants))
|
||||
|
|
|
|||
|
|
@ -24,7 +24,7 @@
|
|||
(raise-arguments-error 'prop:cpointer
|
||||
"index is out of range"
|
||||
"index" v))
|
||||
(unless (chez:memv v (list-ref info 5))
|
||||
(unless (#%memv v (list-ref info 5))
|
||||
(raise-arguments-error 'prop:cpointer
|
||||
"index does not refer to an immutable field"
|
||||
"index" v))
|
||||
|
|
@ -1485,9 +1485,9 @@
|
|||
(make-cpointer/cell (addr->vector a) #f))
|
||||
|
||||
(define (malloc-mode? v)
|
||||
(chez:memq v '(raw atomic nonatomic tagged
|
||||
atomic-interior interior
|
||||
stubborn uncollectable eternal)))
|
||||
(#%memq v '(raw atomic nonatomic tagged
|
||||
atomic-interior interior
|
||||
stubborn uncollectable eternal)))
|
||||
|
||||
(define (end-stubborn-change p)
|
||||
(raise-unsupported-error 'end-stubborn-change))
|
||||
|
|
@ -1609,7 +1609,7 @@
|
|||
;; An 'array rep is compound, but should be
|
||||
;; passed as a pointer, so only pass 'struct and
|
||||
;; '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)
|
||||
(if (eq? host-rep 'array)
|
||||
'void*
|
||||
|
|
@ -2120,7 +2120,7 @@
|
|||
;; function is called with interrupts disabled
|
||||
(define get-errno
|
||||
(cond
|
||||
[(not (chez:memq (machine-type) '(a6nt ta6nt i3nt ti3nt)))
|
||||
[(not (#%memq (machine-type) '(a6nt ta6nt i3nt ti3nt)))
|
||||
(foreign-procedure "(cs)s_errno" () int)]
|
||||
[else
|
||||
;; On Windows, `errno` could be a different one from
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@
|
|||
"field index >= initialized-field count for structure type"
|
||||
"field index" v
|
||||
"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"
|
||||
"field index" v))
|
||||
(+ v (let ([p (list-ref info 6)])
|
||||
|
|
|
|||
|
|
@ -329,7 +329,7 @@
|
|||
"index for procedure >= initialized-field count"
|
||||
"index" v
|
||||
"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
|
||||
"field is not specified as immutable for a prop:procedure index"
|
||||
"index" v))]
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
|
|
@ -12,113 +12,6 @@
|
|||
(define fixnum-for-every-system?
|
||||
(lambda (v_0)
|
||||
(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
|
||||
(lambda (exnh_0 thunk_0)
|
||||
(begin0
|
||||
|
|
@ -1957,7 +1850,7 @@
|
|||
(define reannotate/new-srcloc
|
||||
(lambda (old-term_0 new-term_0 new-srcloc_0)
|
||||
(datum->syntax #f new-term_0 new-srcloc_0 old-term_0)))
|
||||
(define finish56
|
||||
(define finish48
|
||||
(make-struct-type-install-properties
|
||||
'(known-constant)
|
||||
0
|
||||
|
|
@ -1978,7 +1871,7 @@
|
|||
#f
|
||||
0
|
||||
0))
|
||||
(define effect_2537 (finish56 struct:known-constant))
|
||||
(define effect_2537 (finish48 struct:known-constant))
|
||||
(define known-constant
|
||||
(|#%name|
|
||||
known-constant
|
||||
|
|
@ -1996,7 +1889,7 @@
|
|||
(if (impersonator? v)
|
||||
(known-constant?_2598 (impersonator-val v))
|
||||
#f))))))
|
||||
(define finish59
|
||||
(define finish51
|
||||
(make-struct-type-install-properties
|
||||
'(known-consistent)
|
||||
0
|
||||
|
|
@ -2029,7 +1922,7 @@
|
|||
#f
|
||||
0
|
||||
0))
|
||||
(define effect_2382 (finish59 struct:known-consistent))
|
||||
(define effect_2382 (finish51 struct:known-consistent))
|
||||
(define known-consistent
|
||||
(|#%name|
|
||||
known-consistent
|
||||
|
|
@ -2047,7 +1940,7 @@
|
|||
(if (impersonator? v)
|
||||
(known-consistent?_3048 (impersonator-val v))
|
||||
#f))))))
|
||||
(define finish62
|
||||
(define finish54
|
||||
(make-struct-type-install-properties
|
||||
'(known-authentic)
|
||||
0
|
||||
|
|
@ -2080,7 +1973,7 @@
|
|||
#f
|
||||
0
|
||||
0))
|
||||
(define effect_2570 (finish62 struct:known-authentic))
|
||||
(define effect_2570 (finish54 struct:known-authentic))
|
||||
(define known-authentic
|
||||
(|#%name|
|
||||
known-authentic
|
||||
|
|
@ -2098,7 +1991,7 @@
|
|||
(if (impersonator? v)
|
||||
(known-authentic?_3119 (impersonator-val v))
|
||||
#f))))))
|
||||
(define finish65
|
||||
(define finish57
|
||||
(make-struct-type-install-properties
|
||||
'(known-copy)
|
||||
1
|
||||
|
|
@ -2131,7 +2024,7 @@
|
|||
#f
|
||||
1
|
||||
1))
|
||||
(define effect_2542 (finish65 struct:known-copy))
|
||||
(define effect_2542 (finish57 struct:known-copy))
|
||||
(define known-copy
|
||||
(|#%name|
|
||||
known-copy
|
||||
|
|
@ -2163,7 +2056,7 @@
|
|||
s
|
||||
'known-copy
|
||||
'id))))))
|
||||
(define finish69
|
||||
(define finish61
|
||||
(make-struct-type-install-properties
|
||||
'(known-literal)
|
||||
1
|
||||
|
|
@ -2196,7 +2089,7 @@
|
|||
#f
|
||||
1
|
||||
1))
|
||||
(define effect_2788 (finish69 struct:known-literal))
|
||||
(define effect_2788 (finish61 struct:known-literal))
|
||||
(define known-literal
|
||||
(|#%name|
|
||||
known-literal
|
||||
|
|
@ -2230,7 +2123,7 @@
|
|||
s
|
||||
'known-literal
|
||||
'value))))))
|
||||
(define finish73
|
||||
(define finish65
|
||||
(make-struct-type-install-properties
|
||||
'(known-procedure)
|
||||
1
|
||||
|
|
@ -2263,7 +2156,7 @@
|
|||
#f
|
||||
1
|
||||
1))
|
||||
(define effect_2677 (finish73 struct:known-procedure))
|
||||
(define effect_2677 (finish65 struct:known-procedure))
|
||||
(define known-procedure
|
||||
(|#%name|
|
||||
known-procedure
|
||||
|
|
@ -2299,7 +2192,7 @@
|
|||
s
|
||||
'known-procedure
|
||||
'arity-mask))))))
|
||||
(define finish77
|
||||
(define finish69
|
||||
(make-struct-type-install-properties
|
||||
'(known-procedure/single-valued)
|
||||
0
|
||||
|
|
@ -2332,7 +2225,7 @@
|
|||
#f
|
||||
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
|
||||
(|#%name|
|
||||
known-procedure/single-valued
|
||||
|
|
@ -2355,7 +2248,7 @@
|
|||
(if (impersonator? v)
|
||||
(known-procedure/single-valued?_3105 (impersonator-val v))
|
||||
#f))))))
|
||||
(define finish80
|
||||
(define finish72
|
||||
(make-struct-type-install-properties
|
||||
'(known-procedure/no-prompt)
|
||||
0
|
||||
|
|
@ -2388,7 +2281,7 @@
|
|||
#f
|
||||
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
|
||||
(|#%name|
|
||||
known-procedure/no-prompt
|
||||
|
|
@ -2411,7 +2304,7 @@
|
|||
(if (impersonator? v)
|
||||
(known-procedure/no-prompt?_2036 (impersonator-val v))
|
||||
#f))))))
|
||||
(define finish83
|
||||
(define finish75
|
||||
(make-struct-type-install-properties
|
||||
'(known-procedure/no-prompt/multi)
|
||||
0
|
||||
|
|
@ -2444,7 +2337,7 @@
|
|||
#f
|
||||
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
|
||||
(|#%name|
|
||||
known-procedure/no-prompt/multi
|
||||
|
|
@ -2467,7 +2360,7 @@
|
|||
(if (impersonator? v)
|
||||
(known-procedure/no-prompt/multi?_2394 (impersonator-val v))
|
||||
#f))))))
|
||||
(define finish86
|
||||
(define finish78
|
||||
(make-struct-type-install-properties
|
||||
'(known-procedure/no-return)
|
||||
0
|
||||
|
|
@ -2500,7 +2393,7 @@
|
|||
#f
|
||||
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
|
||||
(|#%name|
|
||||
known-procedure/no-return
|
||||
|
|
@ -2523,7 +2416,7 @@
|
|||
(if (impersonator? v)
|
||||
(known-procedure/no-return?_1763 (impersonator-val v))
|
||||
#f))))))
|
||||
(define finish89
|
||||
(define finish81
|
||||
(make-struct-type-install-properties
|
||||
'(known-procedure/can-inline)
|
||||
1
|
||||
|
|
@ -2556,7 +2449,7 @@
|
|||
#f
|
||||
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
|
||||
(|#%name|
|
||||
known-procedure/can-inline
|
||||
|
|
@ -2597,7 +2490,7 @@
|
|||
s
|
||||
'known-procedure/can-inline
|
||||
'expr))))))
|
||||
(define finish93
|
||||
(define finish85
|
||||
(make-struct-type-install-properties
|
||||
'(known-procedure/can-inline/need-imports)
|
||||
1
|
||||
|
|
@ -2630,7 +2523,7 @@
|
|||
#f
|
||||
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
|
||||
(|#%name|
|
||||
known-procedure/can-inline/need-imports
|
||||
|
|
@ -2671,7 +2564,7 @@
|
|||
s
|
||||
'known-procedure/can-inline/need-imports
|
||||
'needed))))))
|
||||
(define finish97
|
||||
(define finish89
|
||||
(make-struct-type-install-properties
|
||||
'(known-procedure/folding)
|
||||
0
|
||||
|
|
@ -2704,7 +2597,7 @@
|
|||
#f
|
||||
0
|
||||
0))
|
||||
(define effect_2478 (finish97 struct:known-procedure/folding))
|
||||
(define effect_2478 (finish89 struct:known-procedure/folding))
|
||||
(define known-procedure/folding
|
||||
(|#%name|
|
||||
known-procedure/folding
|
||||
|
|
@ -2727,7 +2620,7 @@
|
|||
(if (impersonator? v)
|
||||
(known-procedure/folding?_2882 (impersonator-val v))
|
||||
#f))))))
|
||||
(define finish100
|
||||
(define finish92
|
||||
(make-struct-type-install-properties
|
||||
'(known-procedure/folding/limited)
|
||||
1
|
||||
|
|
@ -2760,7 +2653,7 @@
|
|||
#f
|
||||
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
|
||||
(|#%name|
|
||||
known-procedure/folding/limited
|
||||
|
|
@ -2801,7 +2694,7 @@
|
|||
s
|
||||
'known-procedure/folding/limited
|
||||
'kind))))))
|
||||
(define finish104
|
||||
(define finish96
|
||||
(make-struct-type-install-properties
|
||||
'(known-procedure/succeeds)
|
||||
0
|
||||
|
|
@ -2834,7 +2727,7 @@
|
|||
#f
|
||||
0
|
||||
0))
|
||||
(define effect_2467 (finish104 struct:known-procedure/succeeds))
|
||||
(define effect_2467 (finish96 struct:known-procedure/succeeds))
|
||||
(define known-procedure/succeeds
|
||||
(|#%name|
|
||||
known-procedure/succeeds
|
||||
|
|
@ -2857,7 +2750,7 @@
|
|||
(if (impersonator? v)
|
||||
(known-procedure/succeeds?_3041 (impersonator-val v))
|
||||
#f))))))
|
||||
(define finish107
|
||||
(define finish99
|
||||
(make-struct-type-install-properties
|
||||
'(known-procedure/allocates)
|
||||
0
|
||||
|
|
@ -2890,7 +2783,7 @@
|
|||
#f
|
||||
0
|
||||
0))
|
||||
(define effect_2336 (finish107 struct:known-procedure/allocates))
|
||||
(define effect_2336 (finish99 struct:known-procedure/allocates))
|
||||
(define known-procedure/allocates
|
||||
(|#%name|
|
||||
known-procedure/allocates
|
||||
|
|
@ -2913,7 +2806,7 @@
|
|||
(if (impersonator? v)
|
||||
(known-procedure/allocates?_2244 (impersonator-val v))
|
||||
#f))))))
|
||||
(define finish110
|
||||
(define finish102
|
||||
(make-struct-type-install-properties
|
||||
'(known-procedure/pure)
|
||||
0
|
||||
|
|
@ -2946,7 +2839,7 @@
|
|||
#f
|
||||
0
|
||||
0))
|
||||
(define effect_3058 (finish110 struct:known-procedure/pure))
|
||||
(define effect_3058 (finish102 struct:known-procedure/pure))
|
||||
(define known-procedure/pure
|
||||
(|#%name|
|
||||
known-procedure/pure
|
||||
|
|
@ -2966,7 +2859,7 @@
|
|||
(if (impersonator? v)
|
||||
(known-procedure/pure?_2240 (impersonator-val v))
|
||||
#f))))))
|
||||
(define finish113
|
||||
(define finish105
|
||||
(make-struct-type-install-properties
|
||||
'(known-procedure/pure/folding)
|
||||
0
|
||||
|
|
@ -2999,7 +2892,7 @@
|
|||
#f
|
||||
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
|
||||
(|#%name|
|
||||
known-procedure/pure/folding
|
||||
|
|
@ -3022,7 +2915,7 @@
|
|||
(if (impersonator? v)
|
||||
(known-procedure/pure/folding?_2719 (impersonator-val v))
|
||||
#f))))))
|
||||
(define finish116
|
||||
(define finish108
|
||||
(make-struct-type-install-properties
|
||||
'(known-procedure/pure/folding-unsafe)
|
||||
1
|
||||
|
|
@ -3055,7 +2948,7 @@
|
|||
#f
|
||||
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
|
||||
(|#%name|
|
||||
known-procedure/pure/folding-unsafe
|
||||
|
|
@ -3096,7 +2989,7 @@
|
|||
s
|
||||
'known-procedure/pure/folding-unsafe
|
||||
'safe))))))
|
||||
(define finish120
|
||||
(define finish112
|
||||
(make-struct-type-install-properties
|
||||
'(known-procedure/has-unsafe)
|
||||
1
|
||||
|
|
@ -3129,7 +3022,7 @@
|
|||
#f
|
||||
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
|
||||
(|#%name|
|
||||
known-procedure/has-unsafe
|
||||
|
|
@ -3170,7 +3063,7 @@
|
|||
s
|
||||
'known-procedure/has-unsafe
|
||||
'alternate))))))
|
||||
(define finish124
|
||||
(define finish116
|
||||
(make-struct-type-install-properties
|
||||
'(known-procedure/has-unsafe/folding)
|
||||
0
|
||||
|
|
@ -3203,7 +3096,7 @@
|
|||
#f
|
||||
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
|
||||
(|#%name|
|
||||
known-procedure/has-unsafe/folding
|
||||
|
|
@ -3226,7 +3119,7 @@
|
|||
(if (impersonator? v)
|
||||
(known-procedure/has-unsafe/folding?_2169 (impersonator-val v))
|
||||
#f))))))
|
||||
(define finish127
|
||||
(define finish119
|
||||
(make-struct-type-install-properties
|
||||
'(known-procedure/has-unsafe/folding/limited)
|
||||
1
|
||||
|
|
@ -3260,7 +3153,7 @@
|
|||
1
|
||||
1))
|
||||
(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
|
||||
(|#%name|
|
||||
known-procedure/has-unsafe/folding/limited
|
||||
|
|
@ -3302,7 +3195,7 @@
|
|||
s
|
||||
'known-procedure/has-unsafe/folding/limited
|
||||
'kind))))))
|
||||
(define finish131
|
||||
(define finish123
|
||||
(make-struct-type-install-properties
|
||||
'(known-struct-type)
|
||||
4
|
||||
|
|
@ -3335,7 +3228,7 @@
|
|||
#f
|
||||
4
|
||||
15))
|
||||
(define effect_2667 (finish131 struct:known-struct-type))
|
||||
(define effect_2667 (finish123 struct:known-struct-type))
|
||||
(define known-struct-type
|
||||
(|#%name|
|
||||
known-struct-type
|
||||
|
|
@ -3425,7 +3318,7 @@
|
|||
s
|
||||
'known-struct-type
|
||||
'sealed?))))))
|
||||
(define finish138
|
||||
(define finish130
|
||||
(make-struct-type-install-properties
|
||||
'(known-constructor)
|
||||
1
|
||||
|
|
@ -3458,7 +3351,7 @@
|
|||
#f
|
||||
1
|
||||
1))
|
||||
(define effect_1913 (finish138 struct:known-constructor))
|
||||
(define effect_1913 (finish130 struct:known-constructor))
|
||||
(define known-constructor
|
||||
(|#%name|
|
||||
known-constructor
|
||||
|
|
@ -3494,7 +3387,7 @@
|
|||
s
|
||||
'known-constructor
|
||||
'type))))))
|
||||
(define finish142
|
||||
(define finish134
|
||||
(make-struct-type-install-properties
|
||||
'(known-predicate)
|
||||
1
|
||||
|
|
@ -3527,7 +3420,7 @@
|
|||
#f
|
||||
1
|
||||
1))
|
||||
(define effect_2144 (finish142 struct:known-predicate))
|
||||
(define effect_2144 (finish134 struct:known-predicate))
|
||||
(define known-predicate
|
||||
(|#%name|
|
||||
known-predicate
|
||||
|
|
@ -3561,7 +3454,7 @@
|
|||
s
|
||||
'known-predicate
|
||||
'type))))))
|
||||
(define finish146
|
||||
(define finish138
|
||||
(make-struct-type-install-properties
|
||||
'(known-accessor)
|
||||
1
|
||||
|
|
@ -3594,7 +3487,7 @@
|
|||
#f
|
||||
1
|
||||
1))
|
||||
(define effect_2905 (finish146 struct:known-accessor))
|
||||
(define effect_2905 (finish138 struct:known-accessor))
|
||||
(define known-accessor
|
||||
(|#%name|
|
||||
known-accessor
|
||||
|
|
@ -3628,7 +3521,7 @@
|
|||
s
|
||||
'known-accessor
|
||||
'type))))))
|
||||
(define finish150
|
||||
(define finish142
|
||||
(make-struct-type-install-properties
|
||||
'(known-mutator)
|
||||
1
|
||||
|
|
@ -3661,7 +3554,7 @@
|
|||
#f
|
||||
1
|
||||
1))
|
||||
(define effect_2521 (finish150 struct:known-mutator))
|
||||
(define effect_2521 (finish142 struct:known-mutator))
|
||||
(define known-mutator
|
||||
(|#%name|
|
||||
known-mutator
|
||||
|
|
@ -3695,7 +3588,7 @@
|
|||
s
|
||||
'known-mutator
|
||||
'type))))))
|
||||
(define finish154
|
||||
(define finish146
|
||||
(make-struct-type-install-properties
|
||||
'(known-struct-constructor)
|
||||
1
|
||||
|
|
@ -3728,7 +3621,7 @@
|
|||
#f
|
||||
1
|
||||
1))
|
||||
(define effect_3238 (finish154 struct:known-struct-constructor))
|
||||
(define effect_3238 (finish146 struct:known-struct-constructor))
|
||||
(define known-struct-constructor
|
||||
(|#%name|
|
||||
known-struct-constructor
|
||||
|
|
@ -3769,7 +3662,7 @@
|
|||
s
|
||||
'known-struct-constructor
|
||||
'type-id))))))
|
||||
(define finish158
|
||||
(define finish150
|
||||
(make-struct-type-install-properties
|
||||
'(known-struct-predicate)
|
||||
3
|
||||
|
|
@ -3802,7 +3695,7 @@
|
|||
#f
|
||||
3
|
||||
7))
|
||||
(define effect_2384 (finish158 struct:known-struct-predicate))
|
||||
(define effect_2384 (finish150 struct:known-struct-predicate))
|
||||
(define known-struct-predicate
|
||||
(|#%name|
|
||||
known-struct-predicate
|
||||
|
|
@ -3876,7 +3769,7 @@
|
|||
s
|
||||
'known-struct-predicate
|
||||
'sealed?))))))
|
||||
(define finish164
|
||||
(define finish156
|
||||
(make-struct-type-install-properties
|
||||
'(known-field-accessor)
|
||||
4
|
||||
|
|
@ -3909,7 +3802,7 @@
|
|||
#f
|
||||
4
|
||||
15))
|
||||
(define effect_2259 (finish164 struct:known-field-accessor))
|
||||
(define effect_2259 (finish156 struct:known-field-accessor))
|
||||
(define known-field-accessor
|
||||
(|#%name|
|
||||
known-field-accessor
|
||||
|
|
@ -4001,7 +3894,7 @@
|
|||
s
|
||||
'known-field-accessor
|
||||
'known-immutable?))))))
|
||||
(define finish171
|
||||
(define finish163
|
||||
(make-struct-type-install-properties
|
||||
'(known-field-mutator)
|
||||
3
|
||||
|
|
@ -4034,7 +3927,7 @@
|
|||
#f
|
||||
3
|
||||
7))
|
||||
(define effect_2603 (finish171 struct:known-field-mutator))
|
||||
(define effect_2603 (finish163 struct:known-field-mutator))
|
||||
(define known-field-mutator
|
||||
(|#%name|
|
||||
known-field-mutator
|
||||
|
|
@ -4108,7 +4001,7 @@
|
|||
s
|
||||
'known-field-mutator
|
||||
'pos))))))
|
||||
(define finish177
|
||||
(define finish169
|
||||
(make-struct-type-install-properties
|
||||
'(known-struct-constructor/need-imports)
|
||||
1
|
||||
|
|
@ -4141,7 +4034,7 @@
|
|||
#f
|
||||
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
|
||||
(|#%name|
|
||||
known-struct-constructor/need-imports
|
||||
|
|
@ -4182,7 +4075,7 @@
|
|||
s
|
||||
'known-struct-constructor/need-imports
|
||||
'needed))))))
|
||||
(define finish181
|
||||
(define finish173
|
||||
(make-struct-type-install-properties
|
||||
'(known-struct-predicate/need-imports)
|
||||
1
|
||||
|
|
@ -4215,7 +4108,7 @@
|
|||
#f
|
||||
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
|
||||
(|#%name|
|
||||
known-struct-predicate/need-imports
|
||||
|
|
@ -4256,7 +4149,7 @@
|
|||
s
|
||||
'known-struct-predicate/need-imports
|
||||
'needed))))))
|
||||
(define finish185
|
||||
(define finish177
|
||||
(make-struct-type-install-properties
|
||||
'(known-field-accessor/need-imports)
|
||||
1
|
||||
|
|
@ -4289,7 +4182,7 @@
|
|||
#f
|
||||
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
|
||||
(|#%name|
|
||||
known-field-accessor/need-imports
|
||||
|
|
@ -4330,7 +4223,7 @@
|
|||
s
|
||||
'known-field-accessor/need-imports
|
||||
'needed))))))
|
||||
(define finish189
|
||||
(define finish181
|
||||
(make-struct-type-install-properties
|
||||
'(known-field-mutator/need-imports)
|
||||
1
|
||||
|
|
@ -4363,7 +4256,7 @@
|
|||
#f
|
||||
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
|
||||
(|#%name|
|
||||
known-field-mutator/need-imports
|
||||
|
|
@ -4404,7 +4297,7 @@
|
|||
s
|
||||
'known-field-mutator/need-imports
|
||||
'needed))))))
|
||||
(define finish193
|
||||
(define finish185
|
||||
(make-struct-type-install-properties
|
||||
'(known-struct-type-property/immediate-guard)
|
||||
0
|
||||
|
|
@ -4432,7 +4325,7 @@
|
|||
0
|
||||
0))
|
||||
(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
|
||||
(|#%name|
|
||||
known-struct-type-property/immediate-guard
|
||||
|
|
@ -4473,7 +4366,7 @@
|
|||
(let ((app_0
|
||||
(if (string? prefix_0) prefix_0 (symbol->string prefix_0))))
|
||||
(string-append app_0 (number->string (unbox b_0)))))))))
|
||||
(define finish197
|
||||
(define finish189
|
||||
(make-struct-type-install-properties
|
||||
'(import)
|
||||
4
|
||||
|
|
@ -4494,7 +4387,7 @@
|
|||
#f
|
||||
4
|
||||
0))
|
||||
(define effect_2192 (finish197 struct:import))
|
||||
(define effect_2192 (finish189 struct:import))
|
||||
(define import1.1
|
||||
(|#%name|
|
||||
import
|
||||
|
|
@ -4560,7 +4453,7 @@
|
|||
s
|
||||
'import
|
||||
'ext-id))))))
|
||||
(define finish204
|
||||
(define finish196
|
||||
(make-struct-type-install-properties
|
||||
'(import-group)
|
||||
6
|
||||
|
|
@ -4581,7 +4474,7 @@
|
|||
#f
|
||||
6
|
||||
60))
|
||||
(define effect_2739 (finish204 struct:import-group))
|
||||
(define effect_2739 (finish196 struct:import-group))
|
||||
(define import-group2.1
|
||||
(|#%name|
|
||||
import-group
|
||||
|
|
@ -4930,7 +4823,7 @@
|
|||
(|#%app| inc-index!_0)
|
||||
(|#%app| add-group!_0 grp_0)
|
||||
grp_0))))))
|
||||
(define finish218
|
||||
(define finish210
|
||||
(make-struct-type-install-properties
|
||||
'(export)
|
||||
2
|
||||
|
|
@ -4951,7 +4844,7 @@
|
|||
#f
|
||||
2
|
||||
0))
|
||||
(define effect_2782 (finish218 struct:export))
|
||||
(define effect_2782 (finish210 struct:export))
|
||||
(define export1.1
|
||||
(|#%name|
|
||||
export
|
||||
|
|
@ -4991,7 +4884,7 @@
|
|||
s
|
||||
'export
|
||||
'ext-id))))))
|
||||
(define finish223
|
||||
(define finish215
|
||||
(make-struct-type-install-properties
|
||||
'(too-early)
|
||||
2
|
||||
|
|
@ -5012,7 +4905,7 @@
|
|||
#f
|
||||
2
|
||||
0))
|
||||
(define effect_2833 (finish223 struct:too-early))
|
||||
(define effect_2833 (finish215 struct:too-early))
|
||||
(define too-early1.1
|
||||
(|#%name|
|
||||
too-early
|
||||
|
|
@ -7300,7 +7193,7 @@
|
|||
(case-lambda
|
||||
((k_0 im_0) k_0)
|
||||
(args (raise-binding-result-arity-error 2 args))))))
|
||||
(define finish311
|
||||
(define finish303
|
||||
(make-struct-type-install-properties
|
||||
'(struct-type-info)
|
||||
11
|
||||
|
|
@ -7321,7 +7214,7 @@
|
|||
#f
|
||||
11
|
||||
0))
|
||||
(define effect_2037 (finish311 struct:struct-type-info))
|
||||
(define effect_2037 (finish303 struct:struct-type-info))
|
||||
(define struct-type-info1.1
|
||||
(|#%name|
|
||||
struct-type-info
|
||||
|
|
@ -30749,7 +30642,7 @@
|
|||
(schemify-body_0 (cdr l_0) wcm-state_2))))))))))
|
||||
(schemify_0 v_1 wcm-state_1)))))))
|
||||
(schemify/knowns_0 knowns_0 8 wcm-state_0 v_0))))
|
||||
(define finish1676
|
||||
(define finish1668
|
||||
(make-struct-type-install-properties
|
||||
'(convert-mode)
|
||||
4
|
||||
|
|
@ -30770,7 +30663,7 @@
|
|||
#f
|
||||
4
|
||||
0))
|
||||
(define effect_2443 (finish1676 struct:convert-mode))
|
||||
(define effect_2443 (finish1668 struct:convert-mode))
|
||||
(define convert-mode1.1
|
||||
(|#%name|
|
||||
convert-mode
|
||||
|
|
@ -39893,7 +39786,7 @@
|
|||
(if (|#%app| need-exposed?_0 q_0)
|
||||
#t
|
||||
(if (extflonum? q_0) #t #f))))))))))))))
|
||||
(define finish2146
|
||||
(define finish2138
|
||||
(make-struct-type-install-properties
|
||||
'(to-unfasl)
|
||||
3
|
||||
|
|
@ -39914,7 +39807,7 @@
|
|||
#f
|
||||
3
|
||||
0))
|
||||
(define effect_2898 (finish2146 struct:to-unfasl))
|
||||
(define effect_2898 (finish2138 struct:to-unfasl))
|
||||
(define to-unfasl1.1
|
||||
(|#%name|
|
||||
to-unfasl
|
||||
|
|
@ -40044,7 +39937,7 @@
|
|||
'write
|
||||
"cannot marshal value that is embedded in compiled code\n value: ~v"
|
||||
v_0)))
|
||||
(define finish2154
|
||||
(define finish2146
|
||||
(make-struct-type-install-properties
|
||||
'(node)
|
||||
5
|
||||
|
|
@ -40065,7 +39958,7 @@
|
|||
#f
|
||||
5
|
||||
0))
|
||||
(define effect_2547 (finish2154 struct:node))
|
||||
(define effect_2547 (finish2146 struct:node))
|
||||
(define node1.1
|
||||
(|#%name|
|
||||
node
|
||||
|
|
@ -40366,7 +40259,7 @@
|
|||
app_2
|
||||
(stack-set stack_1 pos_1 (car vals_1))))))))))))
|
||||
(loop_0 pos_0 vals_0 count_0 stack_0))))))
|
||||
(define finish2200
|
||||
(define finish2192
|
||||
(make-struct-type-install-properties
|
||||
'(stack-info)
|
||||
5
|
||||
|
|
@ -40387,7 +40280,7 @@
|
|||
#f
|
||||
5
|
||||
28))
|
||||
(define effect_2334 (finish2200 struct:stack-info))
|
||||
(define effect_2334 (finish2192 struct:stack-info))
|
||||
(define stack-info4.1
|
||||
(|#%name|
|
||||
stack-info
|
||||
|
|
@ -40724,7 +40617,7 @@
|
|||
(define stack-info-non-tail!
|
||||
(lambda (stk-i_0 stack-depth_0)
|
||||
(set-stack-info-non-tail-call-later?! stk-i_0 #t)))
|
||||
(define finish2214
|
||||
(define finish2206
|
||||
(make-struct-type-install-properties
|
||||
'(indirect)
|
||||
2
|
||||
|
|
@ -40745,7 +40638,7 @@
|
|||
#f
|
||||
2
|
||||
0))
|
||||
(define effect_2125 (finish2214 struct:indirect))
|
||||
(define effect_2125 (finish2206 struct:indirect))
|
||||
(define indirect1.1
|
||||
(|#%name|
|
||||
indirect
|
||||
|
|
@ -40792,7 +40685,7 @@
|
|||
s
|
||||
'indirect
|
||||
'element))))))
|
||||
(define finish2219
|
||||
(define finish2211
|
||||
(make-struct-type-install-properties
|
||||
'(boxed)
|
||||
1
|
||||
|
|
@ -40813,7 +40706,7 @@
|
|||
#f
|
||||
1
|
||||
0))
|
||||
(define effect_2970 (finish2219 struct:boxed))
|
||||
(define effect_2970 (finish2211 struct:boxed))
|
||||
(define boxed2.1
|
||||
(|#%name|
|
||||
boxed
|
||||
|
|
@ -40837,7 +40730,7 @@
|
|||
(boxed-pos_2515 s)
|
||||
($value
|
||||
(impersonate-ref boxed-pos_2515 struct:boxed 0 s 'boxed 'pos))))))
|
||||
(define finish2223
|
||||
(define finish2215
|
||||
(make-struct-type-install-properties
|
||||
'(boxed/check)
|
||||
0
|
||||
|
|
@ -40858,7 +40751,7 @@
|
|||
#f
|
||||
0
|
||||
0))
|
||||
(define effect_2937 (finish2223 struct:boxed/check))
|
||||
(define effect_2937 (finish2215 struct:boxed/check))
|
||||
(define boxed/check3.1
|
||||
(|#%name|
|
||||
boxed/check
|
||||
|
|
|
|||
File diff suppressed because it is too large
Load Diff
|
|
@ -16,7 +16,7 @@
|
|||
#define MZSCHEME_VERSION_X 8
|
||||
#define MZSCHEME_VERSION_Y 0
|
||||
#define MZSCHEME_VERSION_Z 0
|
||||
#define MZSCHEME_VERSION_W 11
|
||||
#define MZSCHEME_VERSION_W 12
|
||||
|
||||
/* A level of indirection makes `#` work as needed: */
|
||||
#define AS_a_STR_HELPER(x) #x
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user