ref: 51f645a916842c2ea52d52c70a6e554eb32f631f
parent: db94d6ef1f745bfc50211a20c0e4b3553bff72b0
author: JeffBezanson <[email protected]>
date: Sun Aug 9 13:05:40 EDT 2009
adding gensym?, fixing keyword? checking in psyntax library, and more scheme aliases to make it work
--- a/femtolisp/aliases.scm
+++ b/femtolisp/aliases.scm
@@ -1,8 +1,18 @@
; definitions of standard scheme procedures in terms of
; femtolisp procedures
+; sufficient to run the R5RS version of psyntax
(define top-level-bound? bound?)
(define (eval-core x) (eval x))
+(define (symbol-value s) (top-level-value s))
+(define (set-symbol-value! s v) (set-top-level-value! s v))
+(define (void) (if #f #f))
+(define (eval x)
+ ((compile-thunk (expand
+ (if (and (pair? x)
+ (equal? (car x) "noexpand"))
+ (cadr x)
+ x)))))
(define vector-ref aref)
(define vector-set! aset!)
@@ -86,6 +96,7 @@
(io.seek b 0)
b))
(define (open-output-string) (buffer))
+(define open-string-output-port open-output-string)
(define (get-output-string b)
(let ((p (io.pos b)))
(io.seek b 0)
@@ -165,11 +176,13 @@
(or (null? l)
(and (apply proc (car l) (map car ls))
(apply for-all proc (cdr l) (map cdr ls)))))
+(define andmap for-all)
(define (exists proc l . ls)
(and (not (null? l))
(or (apply proc (car l) (map car ls))
(apply exists proc (cdr l) (map cdr ls)))))
+(define ormap exists)
(define cons* list*)
@@ -182,3 +195,28 @@
(define (partition pred lst)
(let ((s (separate pred lst)))
(values (car s) (cdr s))))
+
+(define (dynamic-wind before thunk after)
+ (before)
+ (unwind-protect (thunk)
+ (after)))
+
+(let ((*properties* (table)))
+ (set! putprop
+ (lambda (sym key val)
+ (let ((sp (get *properties* sym #f)))
+ (if (not sp)
+ (let ((t (table)))
+ (put! *properties* sym t)
+ (set! sp t)))
+ (put! sp key val))))
+
+ (set! getprop
+ (lambda (sym key)
+ (let ((sp (get *properties* sym #f)))
+ (and sp (get sp key #f)))))
+
+ (set! remprop
+ (lambda (sym key)
+ (let ((sp (get *properties* sym #f)))
+ (and sp (has? sp key) (del! sp key))))))
--- a/femtolisp/builtins.c
+++ b/femtolisp/builtins.c
@@ -134,8 +134,8 @@
static value_t fl_keywordp(value_t *args, u_int32_t nargs)
{ argcount("keyword?", nargs, 1);- symbol_t *sym = tosymbol(args[0], "keyword?");
- return iskeyword(sym) ? FL_T : FL_F;
+ return (issymbol(args[0]) &&
+ iskeyword((symbol_t*)ptr(args[0]))) ? FL_T : FL_F;
}
static value_t fl_top_level_value(value_t *args, u_int32_t nargs)
--- a/femtolisp/flisp.c
+++ b/femtolisp/flisp.c
@@ -309,6 +309,12 @@
return tagptr(gs, TAG_SYM);
}
+static value_t fl_gensymp(value_t *args, u_int32_t nargs)
+{+ argcount("gensym?", nargs, 1);+ return isgensym(args[0]) ? FL_T : FL_F;
+}
+
char *symbol_name(value_t v)
{ if (ismanaged(v)) {@@ -2063,6 +2069,7 @@
{ "function:name", fl_function_name }, { "stacktrace", fl_stacktrace }, { "gensym", fl_gensym },+ { "gensym?", fl_gensymp }, { "hash", fl_hash }, { "copy-list", fl_copylist }, { "append", fl_append },--- /dev/null
+++ b/femtolisp/lib/psyntax.pp
@@ -1,0 +1,10858 @@
+;;; psyntax.pp
+;;; automatically generated from psyntax.ss
+;;; Mon Feb 26 23:22:05 EST 2007
+;;; see copyright notice in psyntax.ss
+
+((lambda ()
+ (letrec ((noexpand62 '"noexpand")
+ (make-syntax-object63 (lambda (expression2530 wrap2529)
+ (vector
+ 'syntax-object
+ expression2530
+ wrap2529)))
+ (syntax-object?64 (lambda (x2528)
+ (if (vector? x2528)
+ (if (= (vector-length x2528) '3)
+ (eq? (vector-ref x2528 '0)
+ 'syntax-object)
+ '#f)
+ '#f)))
+ (syntax-object-expression65 (lambda (x2527)
+ (vector-ref x2527 '1)))
+ (syntax-object-wrap66 (lambda (x2526)
+ (vector-ref x2526 '2)))
+ (set-syntax-object-expression!67 (lambda (x2525 update2524)
+ (vector-set!
+ x2525
+ '1
+ update2524)))
+ (set-syntax-object-wrap!68 (lambda (x2523 update2522)
+ (vector-set!
+ x2523
+ '2
+ update2522)))
+ (annotation?132 (lambda (x2521) '#f))
+ (top-level-eval-hook133 (lambda (x2520)
+ (eval (list noexpand62 x2520))))
+ (local-eval-hook134 (lambda (x2519)
+ (eval (list noexpand62 x2519))))
+ (define-top-level-value-hook135 (lambda (sym2518 val2517)
+ (top-level-eval-hook133
+ (list
+ 'define
+ sym2518
+ (list 'quote val2517)))))
+ (error-hook136 (lambda (who2516 why2515 what2514)
+ (error who2516 '"~a ~s" why2515 what2514)))
+ (put-cte-hook137 (lambda (symbol2513 val2512)
+ ($sc-put-cte symbol2513 val2512 '*top*)))
+ (get-global-definition-hook138 (lambda (symbol2511)
+ (getprop
+ symbol2511
+ '*sc-expander*)))
+ (put-global-definition-hook139 (lambda (symbol2510 x2509)
+ (if (not x2509)
+ (remprop
+ symbol2510
+ '*sc-expander*)
+ (putprop
+ symbol2510
+ '*sc-expander*
+ x2509))))
+ (read-only-binding?140 (lambda (symbol2508) '#f))
+ (get-import-binding141 (lambda (symbol2507 token2506)
+ (getprop symbol2507 token2506)))
+ (update-import-binding!142 (lambda (symbol2504 token2503
+ p2502)
+ ((lambda (x2505)
+ (if (not x2505)
+ (remprop
+ symbol2504
+ token2503)
+ (putprop
+ symbol2504
+ token2503
+ x2505)))
+ (p2502
+ (get-import-binding141
+ symbol2504
+ token2503)))))
+ (generate-id143 ((lambda (digits2488)
+ ((lambda (base2490 session-key2489)
+ (letrec ((make-digit2491 (lambda (x2501)
+ (string-ref
+ digits2488
+ x2501)))
+ (fmt2492 (lambda (n2495)
+ ((letrec ((fmt2496 (lambda (n2498
+ a2497)
+ (if (< n2498
+ base2490)
+ (list->string
+ (cons
+ (make-digit2491
+ n2498)
+ a2497))
+ ((lambda (r2500
+ rest2499)
+ (fmt2496
+ rest2499
+ (cons
+ (make-digit2491
+ r2500)
+ a2497)))
+ (modulo
+ n2498
+ base2490)
+ (quotient
+ n2498
+ base2490))))))
+ fmt2496)
+ n2495
+ '()))))
+ ((lambda (n2493)
+ (lambda (name2494)
+ (begin
+ (set! n2493 (+ n2493 '1))
+ (string->symbol
+ (string-append
+ session-key2489
+ (fmt2492 n2493))))))
+ '-1)))
+ (string-length digits2488)
+ '"_"))
+ '"0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!$%&*/:<=>?~_^.+-"))
+ (built-lambda?217 (lambda (x2487)
+ (if (pair? x2487)
+ (eq? (car x2487) 'lambda)
+ '#f)))
+ (build-sequence235 (lambda (ae2484 exps2483)
+ ((letrec ((loop2485 (lambda (exps2486)
+ (if (null?
+ (cdr exps2486))
+ (car exps2486)
+ (if (equal?
+ (car exps2486)
+ '(void))
+ (loop2485
+ (cdr exps2486))
+ (cons
+ 'begin
+ exps2486))))))
+ loop2485)
+ exps2483)))
+ (build-letrec236 (lambda (ae2482 vars2481 val-exps2480
+ body-exp2479)
+ (if (null? vars2481)
+ body-exp2479
+ (list
+ 'letrec
+ (map list vars2481 val-exps2480)
+ body-exp2479))))
+ (build-body237 (lambda (ae2478 vars2477 val-exps2476
+ body-exp2475)
+ (build-letrec236
+ ae2478
+ vars2477
+ val-exps2476
+ body-exp2475)))
+ (build-top-module238 (lambda (ae2463 types2462 vars2461
+ val-exps2460 body-exp2459)
+ (call-with-values
+ (lambda ()
+ ((letrec ((f2467 (lambda (types2469
+ vars2468)
+ (if (null?
+ types2469)
+ (values
+ '()
+ '()
+ '())
+ ((lambda (var2470)
+ (call-with-values
+ (lambda ()
+ (f2467
+ (cdr types2469)
+ (cdr vars2468)))
+ (lambda (vars2473
+ defns2472
+ sets2471)
+ (if (eq? (car types2469)
+ 'global)
+ ((lambda (x2474)
+ (values
+ (cons
+ x2474
+ vars2473)
+ (cons
+ (list
+ 'define
+ var2470
+ (chi-void518))
+ defns2472)
+ (cons
+ (list
+ 'set!
+ var2470
+ x2474)
+ sets2471)))
+ (gensym))
+ (values
+ (cons
+ var2470
+ vars2473)
+ defns2472
+ sets2471)))))
+ (car vars2468))))))
+ f2467)
+ types2462
+ vars2461))
+ (lambda (vars2466 defns2465 sets2464)
+ (if (null? defns2465)
+ (build-letrec236
+ ae2463
+ vars2466
+ val-exps2460
+ body-exp2459)
+ (build-sequence235
+ '#f
+ (append
+ defns2465
+ (list
+ (build-letrec236
+ ae2463
+ vars2466
+ val-exps2460
+ (build-sequence235
+ '#f
+ (append
+ sets2464
+ (list
+ body-exp2459))))))))))))
+ (sanitize-binding271 (lambda (b2455)
+ (if (procedure? b2455)
+ (cons 'macro b2455)
+ (if (binding?285 b2455)
+ (if ((lambda (t2456)
+ (if (memv
+ t2456
+ '(core
+ macro
+ macro!
+ deferred))
+ (procedure?
+ (binding-value282
+ b2455))
+ (if (memv
+ t2456
+ '($module))
+ (interface?452
+ (binding-value282
+ b2455))
+ (if (memv
+ t2456
+ '(lexical))
+ '#f
+ (if (memv
+ t2456
+ '(global
+ meta-variable))
+ (symbol?
+ (binding-value282
+ b2455))
+ (if (memv
+ t2456
+ '(syntax))
+ ((lambda (x2457)
+ (if (pair?
+ x2457)
+ (if '#f
+ ((lambda (n2458)
+ (if (integer?
+ n2458)
+ (if (exact?
+ n2458)
+ (>= n2458
+ '0)
+ '#f)
+ '#f))
+ (cdr x2457))
+ '#f)
+ '#f))
+ (binding-value282
+ b2455))
+ (if (memv
+ t2456
+ '(begin
+ define
+ define-syntax
+ set!
+ $module-key
+ $import
+ eval-when
+ meta))
+ (null?
+ (binding-value282
+ b2455))
+ (if (memv
+ t2456
+ '(local-syntax))
+ (boolean?
+ (binding-value282
+ b2455))
+ (if (memv
+ t2456
+ '(displaced-lexical))
+ (eq? (binding-value282
+ b2455)
+ '#f)
+ '#t)))))))))
+ (binding-type281 b2455))
+ b2455
+ '#f)
+ '#f))))
+ (binding-type281 car)
+ (binding-value282 cdr)
+ (set-binding-type!283 set-car!)
+ (set-binding-value!284 set-cdr!)
+ (binding?285 (lambda (x2454)
+ (if (pair? x2454) (symbol? (car x2454)) '#f)))
+ (extend-env295 (lambda (label2453 binding2452 r2451)
+ (cons (cons label2453 binding2452) r2451)))
+ (extend-env*296 (lambda (labels2450 bindings2449 r2448)
+ (if (null? labels2450)
+ r2448
+ (extend-env*296
+ (cdr labels2450)
+ (cdr bindings2449)
+ (extend-env295
+ (car labels2450)
+ (car bindings2449)
+ r2448)))))
+ (extend-var-env*297 (lambda (labels2447 vars2446 r2445)
+ (if (null? labels2447)
+ r2445
+ (extend-var-env*297
+ (cdr labels2447)
+ (cdr vars2446)
+ (extend-env295
+ (car labels2447)
+ (cons 'lexical (car vars2446))
+ r2445)))))
+ (displaced-lexical?298 (lambda (id2442 r2441)
+ ((lambda (n2443)
+ (if n2443
+ ((lambda (b2444)
+ (eq? (binding-type281 b2444)
+ 'displaced-lexical))
+ (lookup301 n2443 r2441))
+ '#f))
+ (id-var-name434 id2442 '(())))))
+ (displaced-lexical-error299 (lambda (id2440)
+ (syntax-error
+ id2440
+ (if (id-var-name434
+ id2440
+ '(()))
+ '"identifier out of context"
+ '"identifier not visible"))))
+ (lookup*300 (lambda (x2437 r2436)
+ ((lambda (t2438)
+ (if t2438
+ (cdr t2438)
+ (if (symbol? x2437)
+ ((lambda (t2439)
+ (if t2439
+ t2439
+ (cons 'global x2437)))
+ (get-global-definition-hook138
+ x2437))
+ '(displaced-lexical . #f))))
+ (assq x2437 r2436))))
+ (lookup301 (lambda (x2431 r2430)
+ (letrec ((whack-binding!2432 (lambda (b2435
+ *b2434)
+ (begin
+ (set-binding-type!283
+ b2435
+ (binding-type281
+ *b2434))
+ (set-binding-value!284
+ b2435
+ (binding-value282
+ *b2434))))))
+ ((lambda (b2433)
+ (begin
+ (if (eq? (binding-type281 b2433) 'deferred)
+ (whack-binding!2432
+ b2433
+ (make-transformer-binding302
+ ((binding-value282 b2433))))
+ (void))
+ b2433))
+ (lookup*300 x2431 r2430)))))
+ (make-transformer-binding302 (lambda (b2428)
+ ((lambda (t2429)
+ (if t2429
+ t2429
+ (syntax-error
+ b2428
+ '"invalid transformer")))
+ (sanitize-binding271 b2428))))
+ (defer-or-eval-transformer303 (lambda (eval2427 x2426)
+ (if (built-lambda?217 x2426)
+ (cons
+ 'deferred
+ (lambda ()
+ (eval2427 x2426)))
+ (make-transformer-binding302
+ (eval2427 x2426)))))
+ (global-extend304 (lambda (type2425 sym2424 val2423)
+ (put-cte-hook137
+ sym2424
+ (cons type2425 val2423))))
+ (nonsymbol-id?305 (lambda (x2421)
+ (if (syntax-object?64 x2421)
+ (symbol?
+ ((lambda (e2422)
+ (if (annotation?132 e2422)
+ (annotation-expression e2422)
+ e2422))
+ (syntax-object-expression65
+ x2421)))
+ '#f)))
+ (id?306 (lambda (x2419)
+ (if (symbol? x2419)
+ '#t
+ (if (syntax-object?64 x2419)
+ (symbol?
+ ((lambda (e2420)
+ (if (annotation?132 e2420)
+ (annotation-expression e2420)
+ e2420))
+ (syntax-object-expression65 x2419)))
+ (if (annotation?132 x2419)
+ (symbol? (annotation-expression x2419))
+ '#f)))))
+ (id-marks312 (lambda (id2418)
+ (if (syntax-object?64 id2418)
+ (wrap-marks316
+ (syntax-object-wrap66 id2418))
+ (wrap-marks316 '((top))))))
+ (id-subst313 (lambda (id2417)
+ (if (syntax-object?64 id2417)
+ (wrap-subst317
+ (syntax-object-wrap66 id2417))
+ (wrap-marks316 '((top))))))
+ (id-sym-name&marks314 (lambda (x2414 w2413)
+ (if (syntax-object?64 x2414)
+ (values
+ ((lambda (e2415)
+ (if (annotation?132 e2415)
+ (annotation-expression
+ e2415)
+ e2415))
+ (syntax-object-expression65
+ x2414))
+ (join-marks423
+ (wrap-marks316 w2413)
+ (wrap-marks316
+ (syntax-object-wrap66
+ x2414))))
+ (values
+ ((lambda (e2416)
+ (if (annotation?132 e2416)
+ (annotation-expression
+ e2416)
+ e2416))
+ x2414)
+ (wrap-marks316 w2413)))))
+ (make-wrap315 cons)
+ (wrap-marks316 car)
+ (wrap-subst317 cdr)
+ (make-indirect-label355 (lambda (label2412)
+ (vector 'indirect-label label2412)))
+ (indirect-label?356 (lambda (x2411)
+ (if (vector? x2411)
+ (if (= (vector-length x2411) '2)
+ (eq? (vector-ref x2411 '0)
+ 'indirect-label)
+ '#f)
+ '#f)))
+ (indirect-label-label357 (lambda (x2410)
+ (vector-ref x2410 '1)))
+ (set-indirect-label-label!358 (lambda (x2409 update2408)
+ (vector-set!
+ x2409
+ '1
+ update2408)))
+ (gen-indirect-label359 (lambda ()
+ (make-indirect-label355
+ (gen-label362))))
+ (get-indirect-label360 (lambda (x2407)
+ (indirect-label-label357 x2407)))
+ (set-indirect-label!361 (lambda (x2406 v2405)
+ (set-indirect-label-label!358
+ x2406
+ v2405)))
+ (gen-label362 (lambda () (string '#\i)))
+ (label?363 (lambda (x2402)
+ ((lambda (t2403)
+ (if t2403
+ t2403
+ ((lambda (t2404)
+ (if t2404
+ t2404
+ (indirect-label?356 x2402)))
+ (symbol? x2402))))
+ (string? x2402))))
+ (gen-labels364 (lambda (ls2401)
+ (if (null? ls2401)
+ '()
+ (cons
+ (gen-label362)
+ (gen-labels364 (cdr ls2401))))))
+ (make-ribcage365 (lambda (symnames2400 marks2399 labels2398)
+ (vector
+ 'ribcage
+ symnames2400
+ marks2399
+ labels2398)))
+ (ribcage?366 (lambda (x2397)
+ (if (vector? x2397)
+ (if (= (vector-length x2397) '4)
+ (eq? (vector-ref x2397 '0) 'ribcage)
+ '#f)
+ '#f)))
+ (ribcage-symnames367 (lambda (x2396) (vector-ref x2396 '1)))
+ (ribcage-marks368 (lambda (x2395) (vector-ref x2395 '2)))
+ (ribcage-labels369 (lambda (x2394) (vector-ref x2394 '3)))
+ (set-ribcage-symnames!370 (lambda (x2393 update2392)
+ (vector-set! x2393 '1 update2392)))
+ (set-ribcage-marks!371 (lambda (x2391 update2390)
+ (vector-set! x2391 '2 update2390)))
+ (set-ribcage-labels!372 (lambda (x2389 update2388)
+ (vector-set! x2389 '3 update2388)))
+ (make-top-ribcage373 (lambda (key2387 mutable?2386)
+ (vector
+ 'top-ribcage
+ key2387
+ mutable?2386)))
+ (top-ribcage?374 (lambda (x2385)
+ (if (vector? x2385)
+ (if (= (vector-length x2385) '3)
+ (eq? (vector-ref x2385 '0)
+ 'top-ribcage)
+ '#f)
+ '#f)))
+ (top-ribcage-key375 (lambda (x2384) (vector-ref x2384 '1)))
+ (top-ribcage-mutable?376 (lambda (x2383)
+ (vector-ref x2383 '2)))
+ (set-top-ribcage-key!377 (lambda (x2382 update2381)
+ (vector-set! x2382 '1 update2381)))
+ (set-top-ribcage-mutable?!378 (lambda (x2380 update2379)
+ (vector-set!
+ x2380
+ '2
+ update2379)))
+ (make-import-interface379 (lambda (interface2378
+ new-marks2377)
+ (vector
+ 'import-interface
+ interface2378
+ new-marks2377)))
+ (import-interface?380 (lambda (x2376)
+ (if (vector? x2376)
+ (if (= (vector-length x2376) '3)
+ (eq? (vector-ref x2376 '0)
+ 'import-interface)
+ '#f)
+ '#f)))
+ (import-interface-interface381 (lambda (x2375)
+ (vector-ref x2375 '1)))
+ (import-interface-new-marks382 (lambda (x2374)
+ (vector-ref x2374 '2)))
+ (set-import-interface-interface!383 (lambda (x2373
+ update2372)
+ (vector-set!
+ x2373
+ '1
+ update2372)))
+ (set-import-interface-new-marks!384 (lambda (x2371
+ update2370)
+ (vector-set!
+ x2371
+ '2
+ update2370)))
+ (make-env385 (lambda (top-ribcage2369 wrap2368)
+ (vector 'env top-ribcage2369 wrap2368)))
+ (env?386 (lambda (x2367)
+ (if (vector? x2367)
+ (if (= (vector-length x2367) '3)
+ (eq? (vector-ref x2367 '0) 'env)
+ '#f)
+ '#f)))
+ (env-top-ribcage387 (lambda (x2366) (vector-ref x2366 '1)))
+ (env-wrap388 (lambda (x2365) (vector-ref x2365 '2)))
+ (set-env-top-ribcage!389 (lambda (x2364 update2363)
+ (vector-set! x2364 '1 update2363)))
+ (set-env-wrap!390 (lambda (x2362 update2361)
+ (vector-set! x2362 '2 update2361)))
+ (anti-mark400 (lambda (w2360)
+ (make-wrap315
+ (cons '#f (wrap-marks316 w2360))
+ (cons 'shift (wrap-subst317 w2360)))))
+ (barrier-marker405 '#f)
+ (extend-ribcage!410 (lambda (ribcage2358 id2357 label2356)
+ (begin
+ (set-ribcage-symnames!370
+ ribcage2358
+ (cons
+ ((lambda (e2359)
+ (if (annotation?132 e2359)
+ (annotation-expression
+ e2359)
+ e2359))
+ (syntax-object-expression65
+ id2357))
+ (ribcage-symnames367 ribcage2358)))
+ (set-ribcage-marks!371
+ ribcage2358
+ (cons
+ (wrap-marks316
+ (syntax-object-wrap66 id2357))
+ (ribcage-marks368 ribcage2358)))
+ (set-ribcage-labels!372
+ ribcage2358
+ (cons
+ label2356
+ (ribcage-labels369
+ ribcage2358))))))
+ (import-extend-ribcage!411 (lambda (ribcage2354
+ new-marks2353 id2352
+ label2351)
+ (begin
+ (set-ribcage-symnames!370
+ ribcage2354
+ (cons
+ ((lambda (e2355)
+ (if (annotation?132
+ e2355)
+ (annotation-expression
+ e2355)
+ e2355))
+ (syntax-object-expression65
+ id2352))
+ (ribcage-symnames367
+ ribcage2354)))
+ (set-ribcage-marks!371
+ ribcage2354
+ (cons
+ (join-marks423
+ new-marks2353
+ (wrap-marks316
+ (syntax-object-wrap66
+ id2352)))
+ (ribcage-marks368
+ ribcage2354)))
+ (set-ribcage-labels!372
+ ribcage2354
+ (cons
+ label2351
+ (ribcage-labels369
+ ribcage2354))))))
+ (extend-ribcage-barrier!412 (lambda (ribcage2350
+ killer-id2349)
+ (extend-ribcage-barrier-help!413
+ ribcage2350
+ (syntax-object-wrap66
+ killer-id2349))))
+ (extend-ribcage-barrier-help!413 (lambda (ribcage2348
+ wrap2347)
+ (begin
+ (set-ribcage-symnames!370
+ ribcage2348
+ (cons
+ barrier-marker405
+ (ribcage-symnames367
+ ribcage2348)))
+ (set-ribcage-marks!371
+ ribcage2348
+ (cons
+ (wrap-marks316
+ wrap2347)
+ (ribcage-marks368
+ ribcage2348))))))
+ (extend-ribcage-subst!414 (lambda (ribcage2346
+ import-iface2345)
+ (set-ribcage-symnames!370
+ ribcage2346
+ (cons
+ import-iface2345
+ (ribcage-symnames367
+ ribcage2346)))))
+ (lookup-import-binding-name415 (lambda (sym2340 marks2339
+ token2338
+ new-marks2337)
+ ((lambda (new2341)
+ (if new2341
+ ((letrec ((f2342 (lambda (new2343)
+ (if (pair?
+ new2343)
+ ((lambda (t2344)
+ (if t2344
+ t2344
+ (f2342
+ (cdr new2343))))
+ (f2342
+ (car new2343)))
+ (if (symbol?
+ new2343)
+ (if (same-marks?425
+ marks2339
+ (join-marks423
+ new-marks2337
+ (wrap-marks316
+ '((top)))))
+ new2343
+ '#f)
+ (if (same-marks?425
+ marks2339
+ (join-marks423
+ new-marks2337
+ (wrap-marks316
+ (syntax-object-wrap66
+ new2343))))
+ new2343
+ '#f))))))
+ f2342)
+ new2341)
+ '#f))
+ (get-import-binding141
+ sym2340
+ token2338))))
+ (store-import-binding416 (lambda (id2321 token2320
+ new-marks2319)
+ (letrec ((cons-id2322 (lambda (id2336
+ x2335)
+ (if (not x2335)
+ id2336
+ (cons
+ id2336
+ x2335))))
+ (weed2323 (lambda (marks2334
+ x2333)
+ (if (pair?
+ x2333)
+ (if (same-marks?425
+ (id-marks312
+ (car x2333))
+ marks2334)
+ (weed2323
+ marks2334
+ (cdr x2333))
+ (cons-id2322
+ (car x2333)
+ (weed2323
+ marks2334
+ (cdr x2333))))
+ (if x2333
+ (if (not (same-marks?425
+ (id-marks312
+ x2333)
+ marks2334))
+ x2333
+ '#f)
+ '#f)))))
+ ((lambda (id2324)
+ ((lambda (sym2325)
+ (if (not (eq? id2324
+ sym2325))
+ ((lambda (marks2326)
+ (update-import-binding!142
+ sym2325
+ token2320
+ (lambda (old-binding2327)
+ ((lambda (x2328)
+ (cons-id2322
+ (if (same-marks?425
+ marks2326
+ (wrap-marks316
+ '((top))))
+ (resolved-id-var-name420
+ id2324)
+ id2324)
+ x2328))
+ (weed2323
+ marks2326
+ old-binding2327)))))
+ (id-marks312 id2324))
+ (void)))
+ ((lambda (x2329)
+ ((lambda (e2330)
+ (if (annotation?132
+ e2330)
+ (annotation-expression
+ e2330)
+ e2330))
+ (if (syntax-object?64
+ x2329)
+ (syntax-object-expression65
+ x2329)
+ x2329)))
+ id2324)))
+ (if (null? new-marks2319)
+ id2321
+ (make-syntax-object63
+ ((lambda (x2331)
+ ((lambda (e2332)
+ (if (annotation?132
+ e2332)
+ (annotation-expression
+ e2332)
+ e2332))
+ (if (syntax-object?64
+ x2331)
+ (syntax-object-expression65
+ x2331)
+ x2331)))
+ id2321)
+ (make-wrap315
+ (join-marks423
+ new-marks2319
+ (id-marks312 id2321))
+ (id-subst313
+ id2321))))))))
+ (make-binding-wrap417 (lambda (ids2309 labels2308 w2307)
+ (if (null? ids2309)
+ w2307
+ (make-wrap315
+ (wrap-marks316 w2307)
+ (cons
+ ((lambda (labelvec2310)
+ ((lambda (n2311)
+ ((lambda (symnamevec2313
+ marksvec2312)
+ (begin
+ ((letrec ((f2314 (lambda (ids2316
+ i2315)
+ (if (not (null?
+ ids2316))
+ (call-with-values
+ (lambda ()
+ (id-sym-name&marks314
+ (car ids2316)
+ w2307))
+ (lambda (symname2318
+ marks2317)
+ (begin
+ (vector-set!
+ symnamevec2313
+ i2315
+ symname2318)
+ (vector-set!
+ marksvec2312
+ i2315
+ marks2317)
+ (f2314
+ (cdr ids2316)
+ (+ i2315
+ '1)))))
+ (void)))))
+ f2314)
+ ids2309
+ '0)
+ (make-ribcage365
+ symnamevec2313
+ marksvec2312
+ labelvec2310)))
+ (make-vector n2311)
+ (make-vector n2311)))
+ (vector-length
+ labelvec2310)))
+ (list->vector labels2308))
+ (wrap-subst317 w2307))))))
+ (make-resolved-id418 (lambda (fromsym2306 marks2305
+ tosym2304)
+ (make-syntax-object63
+ fromsym2306
+ (make-wrap315
+ marks2305
+ (list
+ (make-ribcage365
+ (vector fromsym2306)
+ (vector marks2305)
+ (vector tosym2304)))))))
+ (id->resolved-id419 (lambda (id2299)
+ (call-with-values
+ (lambda ()
+ (id-var-name&marks432 id2299 '(())))
+ (lambda (tosym2301 marks2300)
+ (begin
+ (if (not tosym2301)
+ (syntax-error
+ id2299
+ '"identifier not visible for export")
+ (void))
+ (make-resolved-id418
+ ((lambda (x2302)
+ ((lambda (e2303)
+ (if (annotation?132 e2303)
+ (annotation-expression
+ e2303)
+ e2303))
+ (if (syntax-object?64 x2302)
+ (syntax-object-expression65
+ x2302)
+ x2302)))
+ id2299)
+ marks2300
+ tosym2301))))))
+ (resolved-id-var-name420 (lambda (id2298)
+ (vector-ref
+ (ribcage-labels369
+ (car (wrap-subst317
+ (syntax-object-wrap66
+ id2298))))
+ '0)))
+ (smart-append421 (lambda (m12297 m22296)
+ (if (null? m22296)
+ m12297
+ (append m12297 m22296))))
+ (join-wraps422 (lambda (w12293 w22292)
+ ((lambda (m12295 s12294)
+ (if (null? m12295)
+ (if (null? s12294)
+ w22292
+ (make-wrap315
+ (wrap-marks316 w22292)
+ (join-subst424
+ s12294
+ (wrap-subst317 w22292))))
+ (make-wrap315
+ (join-marks423
+ m12295
+ (wrap-marks316 w22292))
+ (join-subst424
+ s12294
+ (wrap-subst317 w22292)))))
+ (wrap-marks316 w12293)
+ (wrap-subst317 w12293))))
+ (join-marks423 (lambda (m12291 m22290)
+ (smart-append421 m12291 m22290)))
+ (join-subst424 (lambda (s12289 s22288)
+ (smart-append421 s12289 s22288)))
+ (same-marks?425 (lambda (x2286 y2285)
+ ((lambda (t2287)
+ (if t2287
+ t2287
+ (if (not (null? x2286))
+ (if (not (null? y2285))
+ (if (eq? (car x2286)
+ (car y2285))
+ (same-marks?425
+ (cdr x2286)
+ (cdr y2285))
+ '#f)
+ '#f)
+ '#f)))
+ (eq? x2286 y2285))))
+ (diff-marks426 (lambda (m12279 m22278)
+ ((lambda (n12281 n22280)
+ ((letrec ((f2282 (lambda (n12284 m12283)
+ (if (> n12284 n22280)
+ (cons
+ (car m12283)
+ (f2282
+ (- n12284 '1)
+ (cdr m12283)))
+ (if (equal?
+ m12283
+ m22278)
+ '()
+ (error 'sc-expand
+ '"internal error in diff-marks: ~s is not a tail of ~s"
+ m12283
+ m22278))))))
+ f2282)
+ n12281
+ m12279))
+ (length m12279)
+ (length m22278))))
+ (leave-implicit?427 (lambda (token2277)
+ (eq? token2277 '*top*)))
+ (new-binding428 (lambda (sym2274 marks2273 token2272)
+ ((lambda (loc2275)
+ ((lambda (id2276)
+ (begin
+ (store-import-binding416
+ id2276
+ token2272
+ '())
+ (values loc2275 id2276)))
+ (make-resolved-id418
+ sym2274
+ marks2273
+ loc2275)))
+ (if (if (leave-implicit?427 token2272)
+ (same-marks?425
+ marks2273
+ (wrap-marks316 '((top))))
+ '#f)
+ sym2274
+ (generate-id143 sym2274)))))
+ (top-id-bound-var-name429 (lambda (sym2268 marks2267
+ top-ribcage2266)
+ ((lambda (token2269)
+ ((lambda (t2270)
+ (if t2270
+ ((lambda (id2271)
+ (if (symbol? id2271)
+ (if (read-only-binding?140
+ id2271)
+ (new-binding428
+ sym2268
+ marks2267
+ token2269)
+ (values
+ id2271
+ (make-resolved-id418
+ sym2268
+ marks2267
+ id2271)))
+ (values
+ (resolved-id-var-name420
+ id2271)
+ id2271)))
+ t2270)
+ (new-binding428
+ sym2268
+ marks2267
+ token2269)))
+ (lookup-import-binding-name415
+ sym2268
+ marks2267
+ token2269
+ '())))
+ (top-ribcage-key375
+ top-ribcage2266))))
+ (top-id-free-var-name430 (lambda (sym2260 marks2259
+ top-ribcage2258)
+ ((lambda (token2261)
+ ((lambda (t2262)
+ (if t2262
+ ((lambda (id2263)
+ (if (symbol? id2263)
+ id2263
+ (resolved-id-var-name420
+ id2263)))
+ t2262)
+ (if (if (top-ribcage-mutable?376
+ top-ribcage2258)
+ (same-marks?425
+ marks2259
+ (wrap-marks316
+ '((top))))
+ '#f)
+ (call-with-values
+ (lambda ()
+ (new-binding428
+ sym2260
+ (wrap-marks316
+ '((top)))
+ token2261))
+ (lambda (sym2265
+ id2264)
+ sym2265))
+ '#f)))
+ (lookup-import-binding-name415
+ sym2260
+ marks2259
+ token2261
+ '())))
+ (top-ribcage-key375
+ top-ribcage2258))))
+ (id-var-name-loc&marks431 (lambda (id2209 w2208)
+ (letrec ((search2210 (lambda (sym2253
+ subst2252
+ marks2251)
+ (if (null?
+ subst2252)
+ (values
+ '#f
+ marks2251)
+ ((lambda (fst2254)
+ (if (eq? fst2254
+ 'shift)
+ (search2210
+ sym2253
+ (cdr subst2252)
+ (cdr marks2251))
+ (if (ribcage?366
+ fst2254)
+ ((lambda (symnames2255)
+ (if (vector?
+ symnames2255)
+ (search-vector-rib2212
+ sym2253
+ subst2252
+ marks2251
+ symnames2255
+ fst2254)
+ (search-list-rib2211
+ sym2253
+ subst2252
+ marks2251
+ symnames2255
+ fst2254)))
+ (ribcage-symnames367
+ fst2254))
+ (if (top-ribcage?374
+ fst2254)
+ ((lambda (t2256)
+ (if t2256
+ ((lambda (var-name2257)
+ (values
+ var-name2257
+ marks2251))
+ t2256)
+ (search2210
+ sym2253
+ (cdr subst2252)
+ marks2251)))
+ (top-id-free-var-name430
+ sym2253
+ marks2251
+ fst2254))
+ (error 'sc-expand
+ '"internal error in id-var-name-loc&marks: improper subst ~s"
+ subst2252)))))
+ (car subst2252)))))
+ (search-list-rib2211 (lambda (sym2231
+ subst2230
+ marks2229
+ symnames2228
+ ribcage2227)
+ ((letrec ((f2232 (lambda (symnames2234
+ i2233)
+ (if (null?
+ symnames2234)
+ (search2210
+ sym2231
+ (cdr subst2230)
+ marks2229)
+ ((lambda (x2235)
+ (if (if (eq? x2235
+ sym2231)
+ (same-marks?425
+ marks2229
+ (list-ref
+ (ribcage-marks368
+ ribcage2227)
+ i2233))
+ '#f)
+ (values
+ (list-ref
+ (ribcage-labels369
+ ribcage2227)
+ i2233)
+ marks2229)
+ (if (import-interface?380
+ x2235)
+ ((lambda (iface2237
+ new-marks2236)
+ ((lambda (t2238)
+ (if t2238
+ ((lambda (token2239)
+ ((lambda (t2240)
+ (if t2240
+ ((lambda (id2241)
+ (values
+ (if (symbol?
+ id2241)
+ id2241
+ (resolved-id-var-name420
+ id2241))
+ marks2229))
+ t2240)
+ (f2232
+ (cdr symnames2234)
+ i2233)))
+ (lookup-import-binding-name415
+ sym2231
+ marks2229
+ token2239
+ new-marks2236)))
+ t2238)
+ ((lambda (ie2242)
+ ((lambda (n2243)
+ ((lambda ()
+ ((letrec ((g2244 (lambda (j2245)
+ (if (= j2245
+ n2243)
+ (f2232
+ (cdr symnames2234)
+ i2233)
+ ((lambda (id2246)
+ ((lambda (id.sym2248
+ id.marks2247)
+ (if (help-bound-id=?437
+ id.sym2248
+ id.marks2247
+ sym2231
+ marks2229)
+ (values
+ (lookup-import-label506
+ id2246)
+ marks2229)
+ (g2244
+ (+ j2245
+ '1))))
+ ((lambda (x2249)
+ ((lambda (e2250)
+ (if (annotation?132
+ e2250)
+ (annotation-expression
+ e2250)
+ e2250))
+ (if (syntax-object?64
+ x2249)
+ (syntax-object-expression65
+ x2249)
+ x2249)))
+ id2246)
+ (join-marks423
+ new-marks2236
+ (id-marks312
+ id2246))))
+ (vector-ref
+ ie2242
+ j2245))))))
+ g2244)
+ '0))))
+ (vector-length
+ ie2242)))
+ (interface-exports454
+ iface2237))))
+ (interface-token455
+ iface2237)))
+ (import-interface-interface381
+ x2235)
+ (import-interface-new-marks382
+ x2235))
+ (if (if (eq? x2235
+ barrier-marker405)
+ (same-marks?425
+ marks2229
+ (list-ref
+ (ribcage-marks368
+ ribcage2227)
+ i2233))
+ '#f)
+ (values
+ '#f
+ marks2229)
+ (f2232
+ (cdr symnames2234)
+ (+ i2233
+ '1))))))
+ (car symnames2234))))))
+ f2232)
+ symnames2228
+ '0)))
+ (search-vector-rib2212 (lambda (sym2223
+ subst2222
+ marks2221
+ symnames2220
+ ribcage2219)
+ ((lambda (n2224)
+ ((letrec ((f2225 (lambda (i2226)
+ (if (= i2226
+ n2224)
+ (search2210
+ sym2223
+ (cdr subst2222)
+ marks2221)
+ (if (if (eq? (vector-ref
+ symnames2220
+ i2226)
+ sym2223)
+ (same-marks?425
+ marks2221
+ (vector-ref
+ (ribcage-marks368
+ ribcage2219)
+ i2226))
+ '#f)
+ (values
+ (vector-ref
+ (ribcage-labels369
+ ribcage2219)
+ i2226)
+ marks2221)
+ (f2225
+ (+ i2226
+ '1)))))))
+ f2225)
+ '0))
+ (vector-length
+ symnames2220)))))
+ (if (symbol? id2209)
+ (search2210
+ id2209
+ (wrap-subst317 w2208)
+ (wrap-marks316 w2208))
+ (if (syntax-object?64 id2209)
+ ((lambda (sym2214 w12213)
+ (call-with-values
+ (lambda ()
+ (search2210
+ sym2214
+ (wrap-subst317
+ w2208)
+ (join-marks423
+ (wrap-marks316
+ w2208)
+ (wrap-marks316
+ w12213))))
+ (lambda (name2216
+ marks2215)
+ (if name2216
+ (values
+ name2216
+ marks2215)
+ (search2210
+ sym2214
+ (wrap-subst317
+ w12213)
+ marks2215)))))
+ ((lambda (e2217)
+ (if (annotation?132
+ e2217)
+ (annotation-expression
+ e2217)
+ e2217))
+ (syntax-object-expression65
+ id2209))
+ (syntax-object-wrap66
+ id2209))
+ (if (annotation?132
+ id2209)
+ (search2210
+ ((lambda (e2218)
+ (if (annotation?132
+ e2218)
+ (annotation-expression
+ e2218)
+ e2218))
+ id2209)
+ (wrap-subst317
+ w2208)
+ (wrap-marks316
+ w2208))
+ (error-hook136
+ 'id-var-name
+ '"invalid id"
+ id2209)))))))
+ (id-var-name&marks432 (lambda (id2205 w2204)
+ (call-with-values
+ (lambda ()
+ (id-var-name-loc&marks431
+ id2205
+ w2204))
+ (lambda (label2207 marks2206)
+ (values
+ (if (indirect-label?356
+ label2207)
+ (get-indirect-label360
+ label2207)
+ label2207)
+ marks2206)))))
+ (id-var-name-loc433 (lambda (id2201 w2200)
+ (call-with-values
+ (lambda ()
+ (id-var-name-loc&marks431
+ id2201
+ w2200))
+ (lambda (label2203 marks2202)
+ label2203))))
+ (id-var-name434 (lambda (id2197 w2196)
+ (call-with-values
+ (lambda ()
+ (id-var-name-loc&marks431 id2197 w2196))
+ (lambda (label2199 marks2198)
+ (if (indirect-label?356 label2199)
+ (get-indirect-label360 label2199)
+ label2199)))))
+ (free-id=?435 (lambda (i2191 j2190)
+ (if (eq? ((lambda (x2194)
+ ((lambda (e2195)
+ (if (annotation?132 e2195)
+ (annotation-expression
+ e2195)
+ e2195))
+ (if (syntax-object?64 x2194)
+ (syntax-object-expression65
+ x2194)
+ x2194)))
+ i2191)
+ ((lambda (x2192)
+ ((lambda (e2193)
+ (if (annotation?132 e2193)
+ (annotation-expression
+ e2193)
+ e2193))
+ (if (syntax-object?64 x2192)
+ (syntax-object-expression65
+ x2192)
+ x2192)))
+ j2190))
+ (eq? (id-var-name434 i2191 '(()))
+ (id-var-name434 j2190 '(())))
+ '#f)))
+ (literal-id=?436 (lambda (id2180 literal2179)
+ (if (eq? ((lambda (x2183)
+ ((lambda (e2184)
+ (if (annotation?132 e2184)
+ (annotation-expression
+ e2184)
+ e2184))
+ (if (syntax-object?64 x2183)
+ (syntax-object-expression65
+ x2183)
+ x2183)))
+ id2180)
+ ((lambda (x2181)
+ ((lambda (e2182)
+ (if (annotation?132 e2182)
+ (annotation-expression
+ e2182)
+ e2182))
+ (if (syntax-object?64 x2181)
+ (syntax-object-expression65
+ x2181)
+ x2181)))
+ literal2179))
+ ((lambda (n-id2186 n-literal2185)
+ ((lambda (t2187)
+ (if t2187
+ t2187
+ (if ((lambda (t2188)
+ (if t2188
+ t2188
+ (symbol?
+ n-id2186)))
+ (not n-id2186))
+ ((lambda (t2189)
+ (if t2189
+ t2189
+ (symbol?
+ n-literal2185)))
+ (not n-literal2185))
+ '#f)))
+ (eq? n-id2186 n-literal2185)))
+ (id-var-name434 id2180 '(()))
+ (id-var-name434 literal2179 '(())))
+ '#f)))
+ (help-bound-id=?437 (lambda (i.sym2178 i.marks2177 j.sym2176
+ j.marks2175)
+ (if (eq? i.sym2178 j.sym2176)
+ (same-marks?425
+ i.marks2177
+ j.marks2175)
+ '#f)))
+ (bound-id=?438 (lambda (i2170 j2169)
+ (help-bound-id=?437
+ ((lambda (x2173)
+ ((lambda (e2174)
+ (if (annotation?132 e2174)
+ (annotation-expression e2174)
+ e2174))
+ (if (syntax-object?64 x2173)
+ (syntax-object-expression65 x2173)
+ x2173)))
+ i2170)
+ (id-marks312 i2170)
+ ((lambda (x2171)
+ ((lambda (e2172)
+ (if (annotation?132 e2172)
+ (annotation-expression e2172)
+ e2172))
+ (if (syntax-object?64 x2171)
+ (syntax-object-expression65 x2171)
+ x2171)))
+ j2169)
+ (id-marks312 j2169))))
+ (valid-bound-ids?439 (lambda (ids2165)
+ (if ((letrec ((all-ids?2166 (lambda (ids2167)
+ ((lambda (t2168)
+ (if t2168
+ t2168
+ (if (id?306
+ (car ids2167))
+ (all-ids?2166
+ (cdr ids2167))
+ '#f)))
+ (null?
+ ids2167)))))
+ all-ids?2166)
+ ids2165)
+ (distinct-bound-ids?440 ids2165)
+ '#f)))
+ (distinct-bound-ids?440 (lambda (ids2161)
+ ((letrec ((distinct?2162 (lambda (ids2163)
+ ((lambda (t2164)
+ (if t2164
+ t2164
+ (if (not (bound-id-member?442
+ (car ids2163)
+ (cdr ids2163)))
+ (distinct?2162
+ (cdr ids2163))
+ '#f)))
+ (null?
+ ids2163)))))
+ distinct?2162)
+ ids2161)))
+ (invalid-ids-error441 (lambda (ids2157 exp2156 class2155)
+ ((letrec ((find2158 (lambda (ids2160
+ gooduns2159)
+ (if (null?
+ ids2160)
+ (syntax-error
+ exp2156)
+ (if (id?306
+ (car ids2160))
+ (if (bound-id-member?442
+ (car ids2160)
+ gooduns2159)
+ (syntax-error
+ (car ids2160)
+ '"duplicate "
+ class2155)
+ (find2158
+ (cdr ids2160)
+ (cons
+ (car ids2160)
+ gooduns2159)))
+ (syntax-error
+ (car ids2160)
+ '"invalid "
+ class2155))))))
+ find2158)
+ ids2157
+ '())))
+ (bound-id-member?442 (lambda (x2153 list2152)
+ (if (not (null? list2152))
+ ((lambda (t2154)
+ (if t2154
+ t2154
+ (bound-id-member?442
+ x2153
+ (cdr list2152))))
+ (bound-id=?438
+ x2153
+ (car list2152)))
+ '#f)))
+ (wrap443 (lambda (x2151 w2150)
+ (if (if (null? (wrap-marks316 w2150))
+ (null? (wrap-subst317 w2150))
+ '#f)
+ x2151
+ (if (syntax-object?64 x2151)
+ (make-syntax-object63
+ (syntax-object-expression65 x2151)
+ (join-wraps422
+ w2150
+ (syntax-object-wrap66 x2151)))
+ (if (null? x2151)
+ x2151
+ (make-syntax-object63 x2151 w2150))))))
+ (source-wrap444 (lambda (x2149 w2148 ae2147)
+ (wrap443
+ (if (annotation?132 ae2147)
+ (begin
+ (if (not (eq? (annotation-expression
+ ae2147)
+ x2149))
+ (error 'sc-expand
+ '"internal error in source-wrap: ae/x mismatch")
+ (void))
+ ae2147)
+ x2149)
+ w2148)))
+ (chi-when-list445 (lambda (when-list2145 w2144)
+ (map (lambda (x2146)
+ (if (literal-id=?436
+ x2146
+ '#(syntax-object compile ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(when-list w) #((top) (top)) #("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object noexpand let-values define-structure unless when) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (to\ No newline at end of file
+ 'compile
+ (if (literal-id=?436
+ x2146
+ '#(syntax-object load ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(when-list w) #((top) (top)) #("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object noexpand let-values define-structure unless when) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (t\ No newline at end of file
+ 'load
+ (if (literal-id=?436
+ x2146
+ '#(syntax-object visit ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(when-list w) #((top) (top)) #("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object noexpand let-values define-structure unless when) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (to\ No newline at end of file
+ 'visit
+ (if (literal-id=?436
+ x2146
+ '#(syntax-object revisit ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(when-list w) #((top) (top)) #("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object noexpand let-values define-structure unless when) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (to\ No newline at end of file
+ 'revisit
+ (if (literal-id=?436
+ x2146
+ '#(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(when-list w) #((top) (top)) #("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object noexpand let-values define-structure unless when) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (t\ No newline at end of file
+ 'eval
+ (syntax-error
+ (wrap443
+ x2146
+ w2144)
+ '"invalid eval-when situation")))))))
+ when-list2145)))
+ (syntax-type446 (lambda (e2129 r2128 w2127 ae2126 rib2125)
+ (if (symbol? e2129)
+ ((lambda (n2130)
+ ((lambda (b2131)
+ ((lambda (type2132)
+ ((lambda ()
+ ((lambda (t2133)
+ (if (memv
+ t2133
+ '(macro macro!))
+ (syntax-type446
+ (chi-macro502
+ (binding-value282
+ b2131)
+ e2129 r2128 w2127
+ ae2126 rib2125)
+ r2128 '(()) '#f
+ rib2125)
+ (values type2132
+ (binding-value282
+ b2131)
+ e2129 w2127
+ ae2126)))
+ type2132))))
+ (binding-type281 b2131)))
+ (lookup301 n2130 r2128)))
+ (id-var-name434 e2129 w2127))
+ (if (pair? e2129)
+ ((lambda (first2134)
+ (if (id?306 first2134)
+ ((lambda (n2135)
+ ((lambda (b2136)
+ ((lambda (type2137)
+ ((lambda ()
+ ((lambda (t2138)
+ (if (memv
+ t2138
+ '(lexical))
+ (values
+ 'lexical-call
+ (binding-value282
+ b2136)
+ e2129
+ w2127
+ ae2126)
+ (if (memv
+ t2138
+ '(macro
+ macro!))
+ (syntax-type446
+ (chi-macro502
+ (binding-value282
+ b2136)
+ e2129
+ r2128
+ w2127
+ ae2126
+ rib2125)
+ r2128
+ '(())
+ '#f
+ rib2125)
+ (if (memv
+ t2138
+ '(core))
+ (values
+ type2137
+ (binding-value282
+ b2136)
+ e2129
+ w2127
+ ae2126)
+ (if (memv
+ t2138
+ '(begin))
+ (values
+ 'begin-form
+ '#f
+ e2129
+ w2127
+ ae2126)
+ (if (memv
+ t2138
+ '(alias))
+ (values
+ 'alias-form
+ '#f
+ e2129
+ w2127
+ ae2126)
+ (if (memv
+ t2138
+ '(define))
+ (values
+ 'define-form
+ '#f
+ e2129
+ w2127
+ ae2126)
+ (if (memv
+ t2138
+ '(define-syntax))
+ (values
+ 'define-syntax-form
+ '#f
+ e2129
+ w2127
+ ae2126)
+ (if (memv
+ t2138
+ '(set!))
+ (chi-set!501
+ e2129
+ r2128
+ w2127
+ ae2126
+ rib2125)
+ (if (memv
+ t2138
+ '($module-key))
+ (values
+ '$module-form
+ '#f
+ e2129
+ w2127
+ ae2126)
+ (if (memv
+ t2138
+ '($import))
+ (values
+ '$import-form
+ '#f
+ e2129
+ w2127
+ ae2126)
+ (if (memv
+ t2138
+ '(eval-when))
+ (values
+ 'eval-when-form
+ '#f
+ e2129
+ w2127
+ ae2126)
+ (if (memv
+ t2138
+ '(meta))
+ (values
+ 'meta-form
+ '#f
+ e2129
+ w2127
+ ae2126)
+ (if (memv
+ t2138
+ '(local-syntax))
+ (values
+ 'local-syntax-form
+ (binding-value282
+ b2136)
+ e2129
+ w2127
+ ae2126)
+ (values
+ 'call
+ '#f
+ e2129
+ w2127
+ ae2126)))))))))))))))
+ type2137))))
+ (binding-type281
+ b2136)))
+ (lookup301 n2135 r2128)))
+ (id-var-name434
+ first2134
+ w2127))
+ (values 'call '#f e2129 w2127
+ ae2126)))
+ (car e2129))
+ (if (syntax-object?64 e2129)
+ (syntax-type446
+ (syntax-object-expression65
+ e2129)
+ r2128
+ (join-wraps422
+ w2127
+ (syntax-object-wrap66 e2129))
+ '#f rib2125)
+ (if (annotation?132 e2129)
+ (syntax-type446
+ (annotation-expression
+ e2129)
+ r2128 w2127 e2129 rib2125)
+ (if ((lambda (x2139)
+ ((lambda (t2140)
+ (if t2140
+ t2140
+ ((lambda (t2141)
+ (if t2141
+ t2141
+ ((lambda (t2142)
+ (if t2142
+ t2142
+ ((lambda (t2143)
+ (if t2143
+ t2143
+ (null?
+ x2139)))
+ (char?
+ x2139))))
+ (string?
+ x2139))))
+ (number?
+ x2139))))
+ (boolean? x2139)))
+ e2129)
+ (values 'constant '#f
+ e2129 w2127 ae2126)
+ (values 'other '#f e2129
+ w2127 ae2126))))))))
+ (chi-top*447 (lambda (e2120 r2119 w2118 ctem2117 rtem2116
+ meta?2115 top-ribcage2114)
+ ((lambda (meta-residuals2121)
+ (letrec ((meta-residualize!2122 (lambda (x2124)
+ (set! meta-residuals2121
+ (cons
+ x2124
+ meta-residuals2121)))))
+ ((lambda (e2123)
+ (build-sequence235
+ '#f
+ (reverse
+ (cons e2123 meta-residuals2121))))
+ (chi-top449 e2120 r2119 w2118 ctem2117
+ rtem2116 meta?2115 top-ribcage2114
+ meta-residualize!2122 '#f))))
+ '())))
+ (chi-top-sequence448 (lambda (body2110 r2109 w2108 ae2107
+ ctem2106 rtem2105 meta?2104
+ ribcage2103
+ meta-residualize!2102)
+ (build-sequence235
+ ae2107
+ ((letrec ((dobody2111 (lambda (body2112)
+ (if (null?
+ body2112)
+ '()
+ ((lambda (first2113)
+ (cons
+ first2113
+ (dobody2111
+ (cdr body2112))))
+ (chi-top449
+ (car body2112)
+ r2109
+ w2108
+ ctem2106
+ rtem2105
+ meta?2104
+ ribcage2103
+ meta-residualize!2102
+ '#f))))))
+ dobody2111)
+ body2110))))
+ (chi-top449 (lambda (e2047 r2046 w2045 ctem2044 rtem2043
+ meta?2042 top-ribcage2041
+ meta-residualize!2040 meta-seen?2039)
+ (call-with-values
+ (lambda ()
+ (syntax-type446 e2047 r2046 w2045 '#f
+ top-ribcage2041))
+ (lambda (type2052 value2051 e2050 w2049 ae2048)
+ ((lambda (t2053)
+ (if (memv t2053 '(begin-form))
+ ((lambda (forms2054)
+ (if (null? forms2054)
+ (chi-void518)
+ (chi-top-sequence448 forms2054
+ r2046 w2049 ae2048 ctem2044
+ rtem2043 meta?2042
+ top-ribcage2041
+ meta-residualize!2040)))
+ (parse-begin515
+ e2050
+ w2049
+ ae2048
+ '#t))
+ (if (memv t2053 '(local-syntax-form))
+ (call-with-values
+ (lambda ()
+ (chi-local-syntax517 value2051
+ e2050 r2046 r2046 w2049
+ ae2048))
+ (lambda (forms2059 r2058 mr2057
+ w2056 ae2055)
+ (chi-top-sequence448 forms2059
+ r2058 w2056 ae2055 ctem2044
+ rtem2043 meta?2042
+ top-ribcage2041
+ meta-residualize!2040)))
+ (if (memv t2053 '(eval-when-form))
+ (call-with-values
+ (lambda ()
+ (parse-eval-when513
+ e2050
+ w2049
+ ae2048))
+ (lambda (when-list2061
+ forms2060)
+ ((lambda (ctem2063
+ rtem2062)
+ (if (if (null?
+ ctem2063)
+ (null?
+ rtem2062)
+ '#f)
+ (chi-void518)
+ (chi-top-sequence448
+ forms2060 r2046
+ w2049 ae2048
+ ctem2063 rtem2062
+ meta?2042
+ top-ribcage2041
+ meta-residualize!2040)))
+ (update-mode-set490
+ when-list2061
+ ctem2044)
+ (update-mode-set490
+ when-list2061
+ rtem2043))))
+ (if (memv t2053 '(meta-form))
+ (chi-top449
+ (parse-meta512
+ e2050
+ w2049
+ ae2048)
+ r2046 w2049 ctem2044
+ rtem2043 '#t
+ top-ribcage2041
+ meta-residualize!2040
+ '#t)
+ (if (memv
+ t2053
+ '(define-syntax-form))
+ (call-with-values
+ (lambda ()
+ (parse-define-syntax511
+ e2050
+ w2049
+ ae2048))
+ (lambda (id2066
+ rhs2065
+ w2064)
+ ((lambda (id2067)
+ (begin
+ (if (displaced-lexical?298
+ id2067
+ r2046)
+ (displaced-lexical-error299
+ id2067)
+ (void))
+ (if (not (top-ribcage-mutable?376
+ top-ribcage2041))
+ (syntax-error
+ (source-wrap444
+ e2050
+ w2064
+ ae2048)
+ '"invalid definition in read-only environment")
+ (void))
+ ((lambda (sym2068)
+ (call-with-values
+ (lambda ()
+ (top-id-bound-var-name429
+ sym2068
+ (wrap-marks316
+ (syntax-object-wrap66
+ id2067))
+ top-ribcage2041))
+ (lambda (valsym2070
+ bound-id2069)
+ (begin
+ (if (not (eq? (id-var-name434
+ id2067
+ '(()))
+ valsym2070))
+ (syntax-error
+ (source-wrap444
+ e2050
+ w2064
+ ae2048)
+ '"definition not permitted")
+ (void))
+ (if (read-only-binding?140
+ valsym2070)
+ (syntax-error
+ (source-wrap444
+ e2050
+ w2064
+ ae2048)
+ '"invalid definition of read-only identifier")
+ (void))
+ (ct-eval/residualize2493
+ ctem2044
+ (lambda ()
+ (list
+ '$sc-put-cte
+ (list
+ 'quote
+ bound-id2069)
+ (chi498
+ rhs2065
+ r2046
+ r2046
+ w2064
+ '#t)
+ (list
+ 'quote
+ (top-ribcage-key375
+ top-ribcage2041)))))))))
+ ((lambda (x2071)
+ ((lambda (e2072)
+ (if (annotation?132
+ e2072)
+ (annotation-expression
+ e2072)
+ e2072))
+ (if (syntax-object?64
+ x2071)
+ (syntax-object-expression65
+ x2071)
+ x2071)))
+ id2067))))
+ (wrap443
+ id2066
+ w2064))))
+ (if (memv
+ t2053
+ '(define-form))
+ (call-with-values
+ (lambda ()
+ (parse-define510
+ e2050
+ w2049
+ ae2048))
+ (lambda (id2075
+ rhs2074
+ w2073)
+ ((lambda (id2076)
+ (begin
+ (if (displaced-lexical?298
+ id2076
+ r2046)
+ (displaced-lexical-error299
+ id2076)
+ (void))
+ (if (not (top-ribcage-mutable?376
+ top-ribcage2041))
+ (syntax-error
+ (source-wrap444
+ e2050
+ w2073
+ ae2048)
+ '"invalid definition in read-only environment")
+ (void))
+ ((lambda (sym2077)
+ (call-with-values
+ (lambda ()
+ (top-id-bound-var-name429
+ sym2077
+ (wrap-marks316
+ (syntax-object-wrap66
+ id2076))
+ top-ribcage2041))
+ (lambda (valsym2079
+ bound-id2078)
+ (begin
+ (if (not (eq? (id-var-name434
+ id2076
+ '(()))
+ valsym2079))
+ (syntax-error
+ (source-wrap444
+ e2050
+ w2073
+ ae2048)
+ '"definition not permitted")
+ (void))
+ (if (read-only-binding?140
+ valsym2079)
+ (syntax-error
+ (source-wrap444
+ e2050
+ w2073
+ ae2048)
+ '"invalid definition of read-only identifier")
+ (void))
+ (if meta?2042
+ (ct-eval/residualize2493
+ ctem2044
+ (lambda ()
+ (build-sequence235
+ '#f
+ (list
+ (list
+ '$sc-put-cte
+ (list
+ 'quote
+ bound-id2078)
+ (list
+ 'quote
+ (cons
+ 'meta-variable
+ valsym2079))
+ (list
+ 'quote
+ (top-ribcage-key375
+ top-ribcage2041)))
+ (list
+ 'define
+ valsym2079
+ (chi498
+ rhs2074
+ r2046
+ r2046
+ w2073
+ '#t))))))
+ ((lambda (x2080)
+ (build-sequence235
+ '#f
+ (list
+ x2080
+ (rt-eval/residualize492
+ rtem2043
+ (lambda ()
+ (list
+ 'define
+ valsym2079
+ (chi498
+ rhs2074
+ r2046
+ r2046
+ w2073
+ '#f)))))))
+ (ct-eval/residualize2493
+ ctem2044
+ (lambda ()
+ (list
+ '$sc-put-cte
+ (list
+ 'quote
+ bound-id2078)
+ (list
+ 'quote
+ (cons
+ 'global
+ valsym2079))
+ (list
+ 'quote
+ (top-ribcage-key375
+ top-ribcage2041)))))))))))
+ ((lambda (x2081)
+ ((lambda (e2082)
+ (if (annotation?132
+ e2082)
+ (annotation-expression
+ e2082)
+ e2082))
+ (if (syntax-object?64
+ x2081)
+ (syntax-object-expression65
+ x2081)
+ x2081)))
+ id2076))))
+ (wrap443
+ id2075
+ w2073))))
+ (if (memv
+ t2053
+ '($module-form))
+ ((lambda (ribcage2083)
+ (call-with-values
+ (lambda ()
+ (parse-module508
+ e2050
+ w2049
+ ae2048
+ (make-wrap315
+ (wrap-marks316
+ w2049)
+ (cons
+ ribcage2083
+ (wrap-subst317
+ w2049)))))
+ (lambda (orig2087
+ id2086
+ exports2085
+ forms2084)
+ (begin
+ (if (displaced-lexical?298
+ id2086
+ r2046)
+ (displaced-lexical-error299
+ (wrap443
+ id2086
+ w2049))
+ (void))
+ (if (not (top-ribcage-mutable?376
+ top-ribcage2041))
+ (syntax-error
+ orig2087
+ '"invalid definition in read-only environment")
+ (void))
+ (chi-top-module482
+ orig2087
+ r2046
+ r2046
+ top-ribcage2041
+ ribcage2083
+ ctem2044
+ rtem2043
+ meta?2042
+ id2086
+ exports2085
+ forms2084
+ meta-residualize!2040)))))
+ (make-ribcage365
+ '()
+ '()
+ '()))
+ (if (memv
+ t2053
+ '($import-form))
+ (call-with-values
+ (lambda ()
+ (parse-import509
+ e2050
+ w2049
+ ae2048))
+ (lambda (orig2090
+ only?2089
+ mid2088)
+ (begin
+ (if (not (top-ribcage-mutable?376
+ top-ribcage2041))
+ (syntax-error
+ orig2090
+ '"invalid definition in read-only environment")
+ (void))
+ (ct-eval/residualize2493
+ ctem2044
+ (lambda ()
+ ((lambda (binding2091)
+ ((lambda (t2092)
+ (if (memv
+ t2092
+ '($module))
+ (do-top-import489
+ only?2089
+ top-ribcage2041
+ mid2088
+ (interface-token455
+ (binding-value282
+ binding2091)))
+ (if (memv
+ t2092
+ '(displaced-lexical))
+ (displaced-lexical-error299
+ mid2088)
+ (syntax-error
+ mid2088
+ '"unknown module"))))
+ (binding-type281
+ binding2091)))
+ (lookup301
+ (id-var-name434
+ mid2088
+ '(()))
+ '())))))))
+ (if (memv
+ t2053
+ '(alias-form))
+ (call-with-values
+ (lambda ()
+ (parse-alias514
+ e2050
+ w2049
+ ae2048))
+ (lambda (new-id2094
+ old-id2093)
+ ((lambda (new-id2095)
+ (begin
+ (if (displaced-lexical?298
+ new-id2095
+ r2046)
+ (displaced-lexical-error299
+ new-id2095)
+ (void))
+ (if (not (top-ribcage-mutable?376
+ top-ribcage2041))
+ (syntax-error
+ (source-wrap444
+ e2050
+ w2049
+ ae2048)
+ '"invalid definition in read-only environment")
+ (void))
+ ((lambda (sym2096)
+ (call-with-values
+ (lambda ()
+ (top-id-bound-var-name429
+ sym2096
+ (wrap-marks316
+ (syntax-object-wrap66
+ new-id2095))
+ top-ribcage2041))
+ (lambda (valsym2098
+ bound-id2097)
+ (begin
+ (if (not (eq? (id-var-name434
+ new-id2095
+ '(()))
+ valsym2098))
+ (syntax-error
+ (source-wrap444
+ e2050
+ w2049
+ ae2048)
+ '"definition not permitted")
+ (void))
+ (if (read-only-binding?140
+ valsym2098)
+ (syntax-error
+ (source-wrap444
+ e2050
+ w2049
+ ae2048)
+ '"invalid definition of read-only identifier")
+ (void))
+ (ct-eval/residualize2493
+ ctem2044
+ (lambda ()
+ (list
+ '$sc-put-cte
+ (list
+ 'quote
+ (make-resolved-id418
+ sym2096
+ (wrap-marks316
+ (syntax-object-wrap66
+ new-id2095))
+ (id-var-name434
+ old-id2093
+ w2049)))
+ (list
+ 'quote
+ '(do-alias
+ .
+ #f))
+ (list
+ 'quote
+ (top-ribcage-key375
+ top-ribcage2041)))))))))
+ ((lambda (x2099)
+ ((lambda (e2100)
+ (if (annotation?132
+ e2100)
+ (annotation-expression
+ e2100)
+ e2100))
+ (if (syntax-object?64
+ x2099)
+ (syntax-object-expression65
+ x2099)
+ x2099)))
+ new-id2095))))
+ (wrap443
+ new-id2094
+ w2049))))
+ (begin
+ (if meta-seen?2039
+ (syntax-error
+ (source-wrap444
+ e2050
+ w2049
+ ae2048)
+ '"invalid meta definition")
+ (void))
+ (if meta?2042
+ ((lambda (x2101)
+ (begin
+ (top-level-eval-hook133
+ x2101)
+ (ct-eval/residualize3494
+ ctem2044
+ void
+ (lambda ()
+ x2101))))
+ (chi-expr499
+ type2052
+ value2051
+ e2050
+ r2046
+ r2046
+ w2049
+ ae2048
+ '#t))
+ (rt-eval/residualize492
+ rtem2043
+ (lambda ()
+ (chi-expr499
+ type2052
+ value2051
+ e2050
+ r2046
+ r2046
+ w2049
+ ae2048
+ '#f)))))))))))))))
+ type2052)))))
+ (flatten-exports450 (lambda (exports2035)
+ ((letrec ((loop2036 (lambda (exports2038
+ ls2037)
+ (if (null?
+ exports2038)
+ ls2037
+ (loop2036
+ (cdr exports2038)
+ (if (pair?
+ (car exports2038))
+ (loop2036
+ (car exports2038)
+ ls2037)
+ (cons
+ (car exports2038)
+ ls2037)))))))
+ loop2036)
+ exports2035
+ '())))
+ (make-interface451 (lambda (marks2034 exports2033 token2032)
+ (vector
+ 'interface
+ marks2034
+ exports2033
+ token2032)))
+ (interface?452 (lambda (x2031)
+ (if (vector? x2031)
+ (if (= (vector-length x2031) '4)
+ (eq? (vector-ref x2031 '0) 'interface)
+ '#f)
+ '#f)))
+ (interface-marks453 (lambda (x2030) (vector-ref x2030 '1)))
+ (interface-exports454 (lambda (x2029)
+ (vector-ref x2029 '2)))
+ (interface-token455 (lambda (x2028) (vector-ref x2028 '3)))
+ (set-interface-marks!456 (lambda (x2027 update2026)
+ (vector-set! x2027 '1 update2026)))
+ (set-interface-exports!457 (lambda (x2025 update2024)
+ (vector-set!
+ x2025
+ '2
+ update2024)))
+ (set-interface-token!458 (lambda (x2023 update2022)
+ (vector-set! x2023 '3 update2022)))
+ (make-unresolved-interface459 (lambda (mid2020 exports2019)
+ (make-interface451
+ (wrap-marks316
+ (syntax-object-wrap66
+ mid2020))
+ (list->vector
+ (map (lambda (x2021)
+ (if (pair? x2021)
+ (car x2021)
+ x2021))
+ exports2019))
+ '#f)))
+ (make-resolved-interface460 (lambda (mid2017 exports2016
+ token2015)
+ (make-interface451
+ (wrap-marks316
+ (syntax-object-wrap66
+ mid2017))
+ (list->vector
+ (map (lambda (x2018)
+ (id->resolved-id419
+ (if (pair? x2018)
+ (car x2018)
+ x2018)))
+ exports2016))
+ token2015)))
+ (make-module-binding461 (lambda (type2014 id2013 label2012
+ imps2011 val2010 exported2009)
+ (vector 'module-binding type2014
+ id2013 label2012 imps2011 val2010
+ exported2009)))
+ (module-binding?462 (lambda (x2008)
+ (if (vector? x2008)
+ (if (= (vector-length x2008) '7)
+ (eq? (vector-ref x2008 '0)
+ 'module-binding)
+ '#f)
+ '#f)))
+ (module-binding-type463 (lambda (x2007)
+ (vector-ref x2007 '1)))
+ (module-binding-id464 (lambda (x2006)
+ (vector-ref x2006 '2)))
+ (module-binding-label465 (lambda (x2005)
+ (vector-ref x2005 '3)))
+ (module-binding-imps466 (lambda (x2004)
+ (vector-ref x2004 '4)))
+ (module-binding-val467 (lambda (x2003)
+ (vector-ref x2003 '5)))
+ (module-binding-exported468 (lambda (x2002)
+ (vector-ref x2002 '6)))
+ (set-module-binding-type!469 (lambda (x2001 update2000)
+ (vector-set!
+ x2001
+ '1
+ update2000)))
+ (set-module-binding-id!470 (lambda (x1999 update1998)
+ (vector-set!
+ x1999
+ '2
+ update1998)))
+ (set-module-binding-label!471 (lambda (x1997 update1996)
+ (vector-set!
+ x1997
+ '3
+ update1996)))
+ (set-module-binding-imps!472 (lambda (x1995 update1994)
+ (vector-set!
+ x1995
+ '4
+ update1994)))
+ (set-module-binding-val!473 (lambda (x1993 update1992)
+ (vector-set!
+ x1993
+ '5
+ update1992)))
+ (set-module-binding-exported!474 (lambda (x1991 update1990)
+ (vector-set!
+ x1991
+ '6
+ update1990)))
+ (create-module-binding475 (lambda (type1989 id1988 label1987
+ imps1986 val1985)
+ (make-module-binding461 type1989
+ id1988 label1987 imps1986 val1985
+ '#f)))
+ (make-frob476 (lambda (e1984 meta?1983)
+ (vector 'frob e1984 meta?1983)))
+ (frob?477 (lambda (x1982)
+ (if (vector? x1982)
+ (if (= (vector-length x1982) '3)
+ (eq? (vector-ref x1982 '0) 'frob)
+ '#f)
+ '#f)))
+ (frob-e478 (lambda (x1981) (vector-ref x1981 '1)))
+ (frob-meta?479 (lambda (x1980) (vector-ref x1980 '2)))
+ (set-frob-e!480 (lambda (x1979 update1978)
+ (vector-set! x1979 '1 update1978)))
+ (set-frob-meta?!481 (lambda (x1977 update1976)
+ (vector-set! x1977 '2 update1976)))
+ (chi-top-module482 (lambda (orig1917 r1916 mr1915
+ top-ribcage1914 ribcage1913
+ ctem1912 rtem1911 meta?1910 id1909
+ exports1908 forms1907
+ meta-residualize!1906)
+ ((lambda (fexports1918)
+ (call-with-values
+ (lambda ()
+ (chi-external486 ribcage1913
+ orig1917
+ (map (lambda (d1975)
+ (make-frob476
+ d1975
+ meta?1910))
+ forms1907)
+ r1916 mr1915 ctem1912 exports1908
+ fexports1918
+ meta-residualize!1906))
+ (lambda (r1922 mr1921 bindings1920
+ inits1919)
+ ((letrec ((process-exports1923 (lambda (fexports1925
+ ctdefs1924)
+ (if (null?
+ fexports1925)
+ ((letrec ((process-locals1926 (lambda (bs1931
+ r1930
+ dts1929
+ dvs1928
+ des1927)
+ (if (null?
+ bs1931)
+ ((lambda (des1933
+ inits1932)
+ (build-sequence235
+ '#f
+ (append
+ (ctdefs1924)
+ (list
+ (ct-eval/residualize2493
+ ctem1912
+ (lambda ()
+ ((lambda (sym1934)
+ ((lambda (token1935)
+ ((lambda (b1936)
+ ((lambda ()
+ (call-with-values
+ (lambda ()
+ (top-id-bound-var-name429
+ sym1934
+ (wrap-marks316
+ (syntax-object-wrap66
+ id1909))
+ top-ribcage1914))
+ (lambda (valsym1938
+ bound-id1937)
+ (begin
+ (if (not (eq? (id-var-name434
+ id1909
+ '(()))
+ valsym1938))
+ (syntax-error
+ orig1917
+ '"definition not permitted")
+ (void))
+ (if (read-only-binding?140
+ valsym1938)
+ (syntax-error
+ orig1917
+ '"invalid definition of read-only identifier")
+ (void))
+ (list
+ '$sc-put-cte
+ (list
+ 'quote
+ bound-id1937)
+ b1936
+ (list
+ 'quote
+ (top-ribcage-key375
+ top-ribcage1914)))))))))
+ (list
+ 'quote
+ (cons
+ '$module
+ (make-resolved-interface460
+ id1909
+ exports1908
+ token1935)))))
+ (generate-id143
+ sym1934)))
+ ((lambda (x1939)
+ ((lambda (e1940)
+ (if (annotation?132
+ e1940)
+ (annotation-expression
+ e1940)
+ e1940))
+ (if (syntax-object?64
+ x1939)
+ (syntax-object-expression65
+ x1939)
+ x1939)))
+ id1909))))
+ (rt-eval/residualize492
+ rtem1911
+ (lambda ()
+ (build-top-module238
+ '#f
+ dts1929
+ dvs1928
+ des1933
+ (if (null?
+ inits1932)
+ (chi-void518)
+ (build-sequence235
+ '#f
+ (append
+ inits1932
+ (list
+ (chi-void518))))))))))))
+ (chi-frobs495
+ des1927
+ r1930
+ mr1921
+ '#f)
+ (chi-frobs495
+ inits1919
+ r1930
+ mr1921
+ '#f))
+ ((lambda (b1942
+ bs1941)
+ ((lambda (t1943)
+ ((lambda (t1944)
+ (if (memv
+ t1944
+ '(define-form))
+ ((lambda (label1945)
+ (if (module-binding-exported468
+ b1942)
+ ((lambda (var1946)
+ (process-locals1926
+ bs1941
+ r1930
+ (cons
+ 'global
+ dts1929)
+ (cons
+ label1945
+ dvs1928)
+ (cons
+ (module-binding-val467
+ b1942)
+ des1927)))
+ (module-binding-id464
+ b1942))
+ ((lambda (var1947)
+ (process-locals1926
+ bs1941
+ (extend-env295
+ label1945
+ (cons
+ 'lexical
+ var1947)
+ r1930)
+ (cons
+ 'local
+ dts1929)
+ (cons
+ var1947
+ dvs1928)
+ (cons
+ (module-binding-val467
+ b1942)
+ des1927)))
+ (gen-var523
+ (module-binding-id464
+ b1942)))))
+ (get-indirect-label360
+ (module-binding-label465
+ b1942)))
+ (if (memv
+ t1944
+ '(ctdefine-form
+ define-syntax-form
+ $module-form
+ alias-form))
+ (process-locals1926
+ bs1941
+ r1930
+ dts1929
+ dvs1928
+ des1927)
+ (error 'sc-expand-internal
+ '"unexpected module binding type ~s"
+ t1943))))
+ (module-binding-type463
+ b1942)))
+ (module-binding-type463
+ b1942)))
+ (car bs1931)
+ (cdr bs1931))))))
+ process-locals1926)
+ bindings1920
+ r1922
+ '()
+ '()
+ '())
+ ((lambda (id1949
+ fexports1948)
+ ((letrec ((loop1950 (lambda (bs1951)
+ (if (null?
+ bs1951)
+ (process-exports1923
+ fexports1948
+ ctdefs1924)
+ ((lambda (b1953
+ bs1952)
+ (if (free-id=?435
+ (module-binding-id464
+ b1953)
+ id1949)
+ (if (module-binding-exported468
+ b1953)
+ (process-exports1923
+ fexports1948
+ ctdefs1924)
+ ((lambda (t1954)
+ ((lambda (label1955)
+ ((lambda (imps1956)
+ ((lambda (fexports1957)
+ ((lambda ()
+ (begin
+ (set-module-binding-exported!474
+ b1953
+ '#t)
+ ((lambda (t1958)
+ (if (memv
+ t1958
+ '(define-form))
+ ((lambda (sym1959)
+ (begin
+ (set-indirect-label!361
+ label1955
+ sym1959)
+ (process-exports1923
+ fexports1957
+ ctdefs1924)))
+ (generate-id143
+ ((lambda (x1960)
+ ((lambda (e1961)
+ (if (annotation?132
+ e1961)
+ (annotation-expression
+ e1961)
+ e1961))
+ (if (syntax-object?64
+ x1960)
+ (syntax-object-expression65
+ x1960)
+ x1960)))
+ id1949)))
+ (if (memv
+ t1958
+ '(ctdefine-form))
+ ((lambda (b1962)
+ (process-exports1923
+ fexports1957
+ (lambda ()
+ ((lambda (sym1963)
+ (begin
+ (set-indirect-label!361
+ label1955
+ sym1963)
+ (cons
+ (ct-eval/residualize3494
+ ctem1912
+ (lambda ()
+ (put-cte-hook137
+ sym1963
+ b1962))
+ (lambda ()
+ (list
+ '$sc-put-cte
+ (list
+ 'quote
+ sym1963)
+ (list
+ 'quote
+ b1962)
+ (list
+ 'quote
+ '#f))))
+ (ctdefs1924))))
+ (binding-value282
+ b1962)))))
+ (module-binding-val467
+ b1953))
+ (if (memv
+ t1958
+ '(define-syntax-form))
+ ((lambda (sym1964)
+ (process-exports1923
+ fexports1957
+ (lambda ()
+ ((lambda (local-label1965)
+ (begin
+ (set-indirect-label!361
+ label1955
+ sym1964)
+ (cons
+ (ct-eval/residualize3494
+ ctem1912
+ (lambda ()
+ (put-cte-hook137
+ sym1964
+ (car (module-binding-val467
+ b1953))))
+ (lambda ()
+ (list
+ '$sc-put-cte
+ (list
+ 'quote
+ sym1964)
+ (cdr (module-binding-val467
+ b1953))
+ (list
+ 'quote
+ '#f))))
+ (ctdefs1924))))
+ (get-indirect-label360
+ label1955)))))
+ (generate-id143
+ ((lambda (x1966)
+ ((lambda (e1967)
+ (if (annotation?132
+ e1967)
+ (annotation-expression
+ e1967)
+ e1967))
+ (if (syntax-object?64
+ x1966)
+ (syntax-object-expression65
+ x1966)
+ x1966)))
+ id1949)))
+ (if (memv
+ t1958
+ '($module-form))
+ ((lambda (sym1969
+ exports1968)
+ (process-exports1923
+ (append
+ (flatten-exports450
+ exports1968)
+ fexports1957)
+ (lambda ()
+ (begin
+ (set-indirect-label!361
+ label1955
+ sym1969)
+ ((lambda (rest1970)
+ ((lambda (x1971)
+ (cons
+ (ct-eval/residualize3494
+ ctem1912
+ (lambda ()
+ (put-cte-hook137
+ sym1969
+ x1971))
+ (lambda ()
+ (list
+ '$sc-put-cte
+ (list
+ 'quote
+ sym1969)
+ (list
+ 'quote
+ x1971)
+ (list
+ 'quote
+ '#f))))
+ rest1970))
+ (cons
+ '$module
+ (make-resolved-interface460
+ id1949
+ exports1968
+ sym1969))))
+ (ctdefs1924))))))
+ (generate-id143
+ ((lambda (x1972)
+ ((lambda (e1973)
+ (if (annotation?132
+ e1973)
+ (annotation-expression
+ e1973)
+ e1973))
+ (if (syntax-object?64
+ x1972)
+ (syntax-object-expression65
+ x1972)
+ x1972)))
+ id1949))
+ (module-binding-val467
+ b1953))
+ (if (memv
+ t1958
+ '(alias-form))
+ (process-exports1923
+ fexports1957
+ (lambda ()
+ ((lambda (rest1974)
+ (begin
+ (if (indirect-label?356
+ label1955)
+ (if (not (symbol?
+ (get-indirect-label360
+ label1955)))
+ (syntax-error
+ (module-binding-id464
+ b1953)
+ '"unexported target of alias")
+ (void))
+ (void))
+ rest1974))
+ (ctdefs1924))))
+ (error 'sc-expand-internal
+ '"unexpected module binding type ~s"
+ t1954)))))))
+ t1954)))))
+ (append
+ imps1956
+ fexports1948)))
+ (module-binding-imps466
+ b1953)))
+ (module-binding-label465
+ b1953)))
+ (module-binding-type463
+ b1953)))
+ (loop1950
+ bs1952)))
+ (car bs1951)
+ (cdr bs1951))))))
+ loop1950)
+ bindings1920))
+ (car fexports1925)
+ (cdr fexports1925))))))
+ process-exports1923)
+ fexports1918
+ (lambda () '())))))
+ (flatten-exports450 exports1908))))
+ (id-set-diff483 (lambda (exports1905 defs1904)
+ (if (null? exports1905)
+ '()
+ (if (bound-id-member?442
+ (car exports1905)
+ defs1904)
+ (id-set-diff483
+ (cdr exports1905)
+ defs1904)
+ (cons
+ (car exports1905)
+ (id-set-diff483
+ (cdr exports1905)
+ defs1904))))))
+ (check-module-exports484 (lambda (source-exp1879
+ fexports1878 ids1877)
+ (letrec ((defined?1880 (lambda (e1887
+ ids1886)
+ (ormap
+ (lambda (x1888)
+ (if (import-interface?380
+ x1888)
+ ((lambda (x.iface1890
+ x.new-marks1889)
+ ((lambda (t1891)
+ (if t1891
+ ((lambda (token1892)
+ (lookup-import-binding-name415
+ ((lambda (x1893)
+ ((lambda (e1894)
+ (if (annotation?132
+ e1894)
+ (annotation-expression
+ e1894)
+ e1894))
+ (if (syntax-object?64
+ x1893)
+ (syntax-object-expression65
+ x1893)
+ x1893)))
+ e1887)
+ (id-marks312
+ e1887)
+ token1892
+ x.new-marks1889))
+ t1891)
+ ((lambda (v1895)
+ ((letrec ((lp1896 (lambda (i1897)
+ (if (>= i1897
+ '0)
+ ((lambda (t1898)
+ (if t1898
+ t1898
+ (lp1896
+ (- i1897
+ '1))))
+ ((lambda (id1899)
+ (help-bound-id=?437
+ ((lambda (x1902)
+ ((lambda (e1903)
+ (if (annotation?132
+ e1903)
+ (annotation-expression
+ e1903)
+ e1903))
+ (if (syntax-object?64
+ x1902)
+ (syntax-object-expression65
+ x1902)
+ x1902)))
+ id1899)
+ (join-marks423
+ x.new-marks1889
+ (id-marks312
+ id1899))
+ ((lambda (x1900)
+ ((lambda (e1901)
+ (if (annotation?132
+ e1901)
+ (annotation-expression
+ e1901)
+ e1901))
+ (if (syntax-object?64
+ x1900)
+ (syntax-object-expression65
+ x1900)
+ x1900)))
+ e1887)
+ (id-marks312
+ e1887)))
+ (vector-ref
+ v1895
+ i1897)))
+ '#f))))
+ lp1896)
+ (- (vector-length
+ v1895)
+ '1)))
+ (interface-exports454
+ x.iface1890))))
+ (interface-token455
+ x.iface1890)))
+ (import-interface-interface381
+ x1888)
+ (import-interface-new-marks382
+ x1888))
+ (bound-id=?438
+ e1887
+ x1888)))
+ ids1886))))
+ ((letrec ((loop1881 (lambda (fexports1883
+ missing1882)
+ (if (null?
+ fexports1883)
+ (if (not (null?
+ missing1882))
+ (syntax-error
+ (car missing1882)
+ (if (= (length
+ missing1882)
+ '1)
+ '"missing definition for export"
+ '"missing definition for multiple exports, including"))
+ (void))
+ ((lambda (e1885
+ fexports1884)
+ (if (defined?1880
+ e1885
+ ids1877)
+ (loop1881
+ fexports1884
+ missing1882)
+ (loop1881
+ fexports1884
+ (cons
+ e1885
+ missing1882))))
+ (car fexports1883)
+ (cdr fexports1883))))))
+ loop1881)
+ fexports1878
+ '()))))
+ (check-defined-ids485 (lambda (source-exp1826 ls1825)
+ (letrec ((vfold1827 (lambda (v1872
+ p1871
+ cls1870)
+ ((lambda (len1873)
+ ((letrec ((lp1874 (lambda (i1876
+ cls1875)
+ (if (= i1876
+ len1873)
+ cls1875
+ (lp1874
+ (+ i1876
+ '1)
+ (p1871
+ (vector-ref
+ v1872
+ i1876)
+ cls1875))))))
+ lp1874)
+ '0
+ cls1870))
+ (vector-length
+ v1872))))
+ (conflicts1828 (lambda (x1857
+ y1856
+ cls1855)
+ (if (import-interface?380
+ x1857)
+ ((lambda (x.iface1859
+ x.new-marks1858)
+ (if (import-interface?380
+ y1856)
+ ((lambda (y.iface1861
+ y.new-marks1860)
+ ((lambda (xe1863
+ ye1862)
+ (if (> (vector-length
+ xe1863)
+ (vector-length
+ ye1862))
+ (vfold1827
+ ye1862
+ (lambda (id1865
+ cls1864)
+ (id-iface-conflicts1829
+ id1865
+ y.new-marks1860
+ x.iface1859
+ x.new-marks1858
+ cls1864))
+ cls1855)
+ (vfold1827
+ xe1863
+ (lambda (id1867
+ cls1866)
+ (id-iface-conflicts1829
+ id1867
+ x.new-marks1858
+ y.iface1861
+ y.new-marks1860
+ cls1866))
+ cls1855)))
+ (interface-exports454
+ x.iface1859)
+ (interface-exports454
+ y.iface1861)))
+ (import-interface-interface381
+ y1856)
+ (import-interface-new-marks382
+ y1856))
+ (id-iface-conflicts1829
+ y1856
+ '()
+ x.iface1859
+ x.new-marks1858
+ cls1855)))
+ (import-interface-interface381
+ x1857)
+ (import-interface-new-marks382
+ x1857))
+ (if (import-interface?380
+ y1856)
+ ((lambda (y.iface1869
+ y.new-marks1868)
+ (id-iface-conflicts1829
+ x1857
+ '()
+ y.iface1869
+ y.new-marks1868
+ cls1855))
+ (import-interface-interface381
+ y1856)
+ (import-interface-new-marks382
+ y1856))
+ (if (bound-id=?438
+ x1857
+ y1856)
+ (cons
+ x1857
+ cls1855)
+ cls1855)))))
+ (id-iface-conflicts1829 (lambda (id1842
+ id.new-marks1841
+ iface1840
+ iface.new-marks1839
+ cls1838)
+ ((lambda (id.sym1844
+ id.marks1843)
+ ((lambda (t1845)
+ (if t1845
+ ((lambda (token1846)
+ (if (lookup-import-binding-name415
+ id.sym1844
+ id.marks1843
+ token1846
+ iface.new-marks1839)
+ (cons
+ id1842
+ cls1838)
+ cls1838))
+ t1845)
+ (vfold1827
+ (interface-exports454
+ iface1840)
+ (lambda (*id1848
+ cls1847)
+ ((lambda (*id.sym1850
+ *id.marks1849)
+ (if (help-bound-id=?437
+ *id.sym1850
+ *id.marks1849
+ id.sym1844
+ id.marks1843)
+ (cons
+ *id1848
+ cls1847)
+ cls1847))
+ ((lambda (x1851)
+ ((lambda (e1852)
+ (if (annotation?132
+ e1852)
+ (annotation-expression
+ e1852)
+ e1852))
+ (if (syntax-object?64
+ x1851)
+ (syntax-object-expression65
+ x1851)
+ x1851)))
+ *id1848)
+ (join-marks423
+ iface.new-marks1839
+ (id-marks312
+ *id1848))))
+ cls1838)))
+ (interface-token455
+ iface1840)))
+ ((lambda (x1853)
+ ((lambda (e1854)
+ (if (annotation?132
+ e1854)
+ (annotation-expression
+ e1854)
+ e1854))
+ (if (syntax-object?64
+ x1853)
+ (syntax-object-expression65
+ x1853)
+ x1853)))
+ id1842)
+ (join-marks423
+ id.new-marks1841
+ (id-marks312
+ id1842))))))
+ (if (not (null? ls1825))
+ ((letrec ((lp1830 (lambda (x1833
+ ls1832
+ cls1831)
+ (if (null?
+ ls1832)
+ (if (not (null?
+ cls1831))
+ ((lambda (cls1834)
+ (syntax-error
+ source-exp1826
+ '"duplicate definition for "
+ (symbol->string
+ (car cls1834))
+ '" in"))
+ (syntax-object->datum
+ cls1831))
+ (void))
+ ((letrec ((lp21835 (lambda (ls21837
+ cls1836)
+ (if (null?
+ ls21837)
+ (lp1830
+ (car ls1832)
+ (cdr ls1832)
+ cls1836)
+ (lp21835
+ (cdr ls21837)
+ (conflicts1828
+ x1833
+ (car ls21837)
+ cls1836))))))
+ lp21835)
+ ls1832
+ cls1831)))))
+ lp1830)
+ (car ls1825)
+ (cdr ls1825)
+ '())
+ (void)))))
+ (chi-external486 (lambda (ribcage1721 source-exp1720
+ body1719 r1718 mr1717 ctem1716
+ exports1715 fexports1714
+ meta-residualize!1713)
+ (letrec ((return1722 (lambda (r1824 mr1823
+ bindings1822
+ ids1821
+ inits1820)
+ (begin
+ (check-defined-ids485
+ source-exp1720
+ ids1821)
+ (check-module-exports484
+ source-exp1720
+ fexports1714
+ ids1821)
+ (values
+ r1824
+ mr1823
+ bindings1822
+ inits1820))))
+ (get-implicit-exports1723 (lambda (id1817)
+ ((letrec ((f1818 (lambda (exports1819)
+ (if (null?
+ exports1819)
+ '()
+ (if (if (pair?
+ (car exports1819))
+ (bound-id=?438
+ id1817
+ (caar
+ exports1819))
+ '#f)
+ (flatten-exports450
+ (cdar
+ exports1819))
+ (f1818
+ (cdr exports1819)))))))
+ f1818)
+ exports1715)))
+ (update-imp-exports1724 (lambda (bindings1812
+ exports1811)
+ ((lambda (exports1813)
+ (map (lambda (b1814)
+ ((lambda (id1815)
+ (if (not (bound-id-member?442
+ id1815
+ exports1813))
+ b1814
+ (create-module-binding475
+ (module-binding-type463
+ b1814)
+ id1815
+ (module-binding-label465
+ b1814)
+ (append
+ (get-implicit-exports1723
+ id1815)
+ (module-binding-imps466
+ b1814))
+ (module-binding-val467
+ b1814))))
+ (module-binding-id464
+ b1814)))
+ bindings1812))
+ (map (lambda (x1816)
+ (if (pair?
+ x1816)
+ (car x1816)
+ x1816))
+ exports1811)))))
+ ((letrec ((parse1725 (lambda (body1732
+ r1731 mr1730
+ ids1729
+ bindings1728
+ inits1727
+ meta-seen?1726)
+ (if (null?
+ body1732)
+ (return1722
+ r1731 mr1730
+ bindings1728
+ ids1729
+ inits1727)
+ ((lambda (fr1733)
+ ((lambda (e1734)
+ ((lambda (meta?1735)
+ ((lambda ()
+ (call-with-values
+ (lambda ()
+ (syntax-type446
+ e1734
+ r1731
+ '(())
+ '#f
+ ribcage1721))
+ (lambda (type1740
+ value1739
+ e1738
+ w1737
+ ae1736)
+ ((lambda (t1741)
+ (if (memv
+ t1741
+ '(define-form))
+ (call-with-values
+ (lambda ()
+ (parse-define510
+ e1738
+ w1737
+ ae1736))
+ (lambda (id1744
+ rhs1743
+ w1742)
+ ((lambda (id1745)
+ ((lambda (label1746)
+ ((lambda (imps1747)
+ ((lambda ()
+ (begin
+ (extend-ribcage!410
+ ribcage1721
+ id1745
+ label1746)
+ (if meta?1735
+ ((lambda (sym1748)
+ ((lambda (b1749)
+ ((lambda ()
+ ((lambda (mr1750)
+ ((lambda (exp1751)
+ (begin
+ (define-top-level-value-hook135
+ sym1748
+ (top-level-eval-hook133
+ exp1751))
+ (meta-residualize!1713
+ (ct-eval/residualize3494
+ ctem1716
+ void
+ (lambda ()
+ (list
+ 'define
+ sym1748
+ exp1751))))
+ (parse1725
+ (cdr body1732)
+ r1731
+ mr1750
+ (cons
+ id1745
+ ids1729)
+ (cons
+ (create-module-binding475
+ 'ctdefine-form
+ id1745
+ label1746
+ imps1747
+ b1749)
+ bindings1728)
+ inits1727
+ '#f)))
+ (chi498
+ rhs1743
+ mr1750
+ mr1750
+ w1742
+ '#t)))
+ (extend-env295
+ (get-indirect-label360
+ label1746)
+ b1749
+ mr1730)))))
+ (cons
+ 'meta-variable
+ sym1748)))
+ (generate-id143
+ ((lambda (x1752)
+ ((lambda (e1753)
+ (if (annotation?132
+ e1753)
+ (annotation-expression
+ e1753)
+ e1753))
+ (if (syntax-object?64
+ x1752)
+ (syntax-object-expression65
+ x1752)
+ x1752)))
+ id1745)))
+ (parse1725
+ (cdr body1732)
+ r1731
+ mr1730
+ (cons
+ id1745
+ ids1729)
+ (cons
+ (create-module-binding475
+ type1740
+ id1745
+ label1746
+ imps1747
+ (make-frob476
+ (wrap443
+ rhs1743
+ w1742)
+ meta?1735))
+ bindings1728)
+ inits1727
+ '#f))))))
+ (get-implicit-exports1723
+ id1745)))
+ (gen-indirect-label359)))
+ (wrap443
+ id1744
+ w1742))))
+ (if (memv
+ t1741
+ '(define-syntax-form))
+ (call-with-values
+ (lambda ()
+ (parse-define-syntax511
+ e1738
+ w1737
+ ae1736))
+ (lambda (id1756
+ rhs1755
+ w1754)
+ ((lambda (id1757)
+ ((lambda (label1758)
+ ((lambda (imps1759)
+ ((lambda (exp1760)
+ ((lambda ()
+ (begin
+ (extend-ribcage!410
+ ribcage1721
+ id1757
+ label1758)
+ ((lambda (l1762
+ b1761)
+ (parse1725
+ (cdr body1732)
+ (extend-env295
+ l1762
+ b1761
+ r1731)
+ (extend-env295
+ l1762
+ b1761
+ mr1730)
+ (cons
+ id1757
+ ids1729)
+ (cons
+ (create-module-binding475
+ type1740
+ id1757
+ label1758
+ imps1759
+ (cons
+ b1761
+ exp1760))
+ bindings1728)
+ inits1727
+ '#f))
+ (get-indirect-label360
+ label1758)
+ (defer-or-eval-transformer303
+ top-level-eval-hook133
+ exp1760))))))
+ (chi498
+ rhs1755
+ mr1730
+ mr1730
+ w1754
+ '#t)))
+ (get-implicit-exports1723
+ id1757)))
+ (gen-indirect-label359)))
+ (wrap443
+ id1756
+ w1754))))
+ (if (memv
+ t1741
+ '($module-form))
+ ((lambda (*ribcage1763)
+ ((lambda (*w1764)
+ ((lambda ()
+ (call-with-values
+ (lambda ()
+ (parse-module508
+ e1738
+ w1737
+ ae1736
+ *w1764))
+ (lambda (orig1768
+ id1767
+ *exports1766
+ forms1765)
+ (call-with-values
+ (lambda ()
+ (chi-external486
+ *ribcage1763
+ orig1768
+ (map (lambda (d1780)
+ (make-frob476
+ d1780
+ meta?1735))
+ forms1765)
+ r1731
+ mr1730
+ ctem1716
+ *exports1766
+ (flatten-exports450
+ *exports1766)
+ meta-residualize!1713))
+ (lambda (r1772
+ mr1771
+ *bindings1770
+ *inits1769)
+ ((lambda (iface1777
+ bindings1776
+ inits1775
+ label1774
+ imps1773)
+ (begin
+ (extend-ribcage!410
+ ribcage1721
+ id1767
+ label1774)
+ ((lambda (l1779
+ b1778)
+ (parse1725
+ (cdr body1732)
+ (extend-env295
+ l1779
+ b1778
+ r1772)
+ (extend-env295
+ l1779
+ b1778
+ mr1771)
+ (cons
+ id1767
+ ids1729)
+ (cons
+ (create-module-binding475
+ type1740
+ id1767
+ label1774
+ imps1773
+ *exports1766)
+ bindings1776)
+ inits1775
+ '#f))
+ (get-indirect-label360
+ label1774)
+ (cons
+ '$module
+ iface1777))))
+ (make-unresolved-interface459
+ id1767
+ *exports1766)
+ (append
+ *bindings1770
+ bindings1728)
+ (append
+ inits1727
+ *inits1769)
+ (gen-indirect-label359)
+ (get-implicit-exports1723
+ id1767)))))))))
+ (make-wrap315
+ (wrap-marks316
+ w1737)
+ (cons
+ *ribcage1763
+ (wrap-subst317
+ w1737)))))
+ (make-ribcage365
+ '()
+ '()
+ '()))
+ (if (memv
+ t1741
+ '($import-form))
+ (call-with-values
+ (lambda ()
+ (parse-import509
+ e1738
+ w1737
+ ae1736))
+ (lambda (orig1783
+ only?1782
+ mid1781)
+ ((lambda (mlabel1784)
+ ((lambda (binding1785)
+ ((lambda (t1786)
+ (if (memv
+ t1786
+ '($module))
+ ((lambda (iface1787)
+ ((lambda (import-iface1788)
+ ((lambda ()
+ (begin
+ (if only?1782
+ (extend-ribcage-barrier!412
+ ribcage1721
+ mid1781)
+ (void))
+ (do-import!507
+ import-iface1788
+ ribcage1721)
+ (parse1725
+ (cdr body1732)
+ r1731
+ mr1730
+ (cons
+ import-iface1788
+ ids1729)
+ (update-imp-exports1724
+ bindings1728
+ (vector->list
+ (interface-exports454
+ iface1787)))
+ inits1727
+ '#f)))))
+ (make-import-interface379
+ iface1787
+ (import-mark-delta505
+ mid1781
+ iface1787))))
+ (binding-value282
+ binding1785))
+ (if (memv
+ t1786
+ '(displaced-lexical))
+ (displaced-lexical-error299
+ mid1781)
+ (syntax-error
+ mid1781
+ '"unknown module"))))
+ (binding-type281
+ binding1785)))
+ (lookup301
+ mlabel1784
+ r1731)))
+ (id-var-name434
+ mid1781
+ '(())))))
+ (if (memv
+ t1741
+ '(alias-form))
+ (call-with-values
+ (lambda ()
+ (parse-alias514
+ e1738
+ w1737
+ ae1736))
+ (lambda (new-id1790
+ old-id1789)
+ ((lambda (new-id1791)
+ ((lambda (label1792)
+ ((lambda (imps1793)
+ ((lambda ()
+ (begin
+ (extend-ribcage!410
+ ribcage1721
+ new-id1791
+ label1792)
+ (parse1725
+ (cdr body1732)
+ r1731
+ mr1730
+ (cons
+ new-id1791
+ ids1729)
+ (cons
+ (create-module-binding475
+ type1740
+ new-id1791
+ label1792
+ imps1793
+ '#f)
+ bindings1728)
+ inits1727
+ '#f)))))
+ (get-implicit-exports1723
+ new-id1791)))
+ (id-var-name-loc433
+ old-id1789
+ w1737)))
+ (wrap443
+ new-id1790
+ w1737))))
+ (if (memv
+ t1741
+ '(begin-form))
+ (parse1725
+ ((letrec ((f1794 (lambda (forms1795)
+ (if (null?
+ forms1795)
+ (cdr body1732)
+ (cons
+ (make-frob476
+ (wrap443
+ (car forms1795)
+ w1737)
+ meta?1735)
+ (f1794
+ (cdr forms1795)))))))
+ f1794)
+ (parse-begin515
+ e1738
+ w1737
+ ae1736
+ '#t))
+ r1731
+ mr1730
+ ids1729
+ bindings1728
+ inits1727
+ '#f)
+ (if (memv
+ t1741
+ '(eval-when-form))
+ (call-with-values
+ (lambda ()
+ (parse-eval-when513
+ e1738
+ w1737
+ ae1736))
+ (lambda (when-list1797
+ forms1796)
+ (parse1725
+ (if (memq
+ 'eval
+ when-list1797)
+ ((letrec ((f1798 (lambda (forms1799)
+ (if (null?
+ forms1799)
+ (cdr body1732)
+ (cons
+ (make-frob476
+ (wrap443
+ (car forms1799)
+ w1737)
+ meta?1735)
+ (f1798
+ (cdr forms1799)))))))
+ f1798)
+ forms1796)
+ (cdr body1732))
+ r1731
+ mr1730
+ ids1729
+ bindings1728
+ inits1727
+ '#f)))
+ (if (memv
+ t1741
+ '(meta-form))
+ (parse1725
+ (cons
+ (make-frob476
+ (wrap443
+ (parse-meta512
+ e1738
+ w1737
+ ae1736)
+ w1737)
+ '#t)
+ (cdr body1732))
+ r1731
+ mr1730
+ ids1729
+ bindings1728
+ inits1727
+ '#t)
+ (if (memv
+ t1741
+ '(local-syntax-form))
+ (call-with-values
+ (lambda ()
+ (chi-local-syntax517
+ value1739
+ e1738
+ r1731
+ mr1730
+ w1737
+ ae1736))
+ (lambda (forms1804
+ r1803
+ mr1802
+ w1801
+ ae1800)
+ (parse1725
+ ((letrec ((f1805 (lambda (forms1806)
+ (if (null?
+ forms1806)
+ (cdr body1732)
+ (cons
+ (make-frob476
+ (wrap443
+ (car forms1806)
+ w1801)
+ meta?1735)
+ (f1805
+ (cdr forms1806)))))))
+ f1805)
+ forms1804)
+ r1803
+ mr1802
+ ids1729
+ bindings1728
+ inits1727
+ '#f)))
+ (begin
+ (if meta-seen?1726
+ (syntax-error
+ (source-wrap444
+ e1738
+ w1737
+ ae1736)
+ '"invalid meta definition")
+ (void))
+ ((letrec ((f1807 (lambda (body1808)
+ (if ((lambda (t1809)
+ (if t1809
+ t1809
+ (not (frob-meta?479
+ (car body1808)))))
+ (null?
+ body1808))
+ (return1722
+ r1731
+ mr1730
+ bindings1728
+ ids1729
+ (append
+ inits1727
+ body1808))
+ (begin
+ ((lambda (x1810)
+ (begin
+ (top-level-eval-hook133
+ x1810)
+ (meta-residualize!1713
+ (ct-eval/residualize3494
+ ctem1716
+ void
+ (lambda ()
+ x1810)))))
+ (chi-meta-frob496
+ (car body1808)
+ mr1730))
+ (f1807
+ (cdr body1808)))))))
+ f1807)
+ (cons
+ (make-frob476
+ (source-wrap444
+ e1738
+ w1737
+ ae1736)
+ meta?1735)
+ (cdr body1732))))))))))))))
+ type1740))))))
+ (frob-meta?479
+ fr1733)))
+ (frob-e478
+ fr1733)))
+ (car body1732))))))
+ parse1725) body1719 r1718 mr1717 '()
+ '() '() '#f))))
+ (vmap487 (lambda (fn1709 v1708)
+ ((letrec ((do1710 (lambda (i1712 ls1711)
+ (if (< i1712 '0)
+ ls1711
+ (do1710
+ (- i1712 '1)
+ (cons
+ (fn1709
+ (vector-ref
+ v1708
+ i1712))
+ ls1711))))))
+ do1710)
+ (- (vector-length v1708) '1)
+ '())))
+ (vfor-each488 (lambda (fn1704 v1703)
+ ((lambda (len1705)
+ ((letrec ((do1706 (lambda (i1707)
+ (if (not (= i1707
+ len1705))
+ (begin
+ (fn1704
+ (vector-ref
+ v1703
+ i1707))
+ (do1706
+ (+ i1707 '1)))
+ (void)))))
+ do1706)
+ '0))
+ (vector-length v1703))))
+ (do-top-import489 (lambda (import-only?1702 top-ribcage1701
+ mid1700 token1699)
+ (list
+ '$sc-put-cte
+ (list 'quote mid1700)
+ (list 'quote (cons 'do-import token1699))
+ (list
+ 'quote
+ (top-ribcage-key375
+ top-ribcage1701)))))
+ (update-mode-set490 ((lambda (table1690)
+ (lambda (when-list1692 mode-set1691)
+ (letrec ((remq1693 (lambda (x1698
+ ls1697)
+ (if (null?
+ ls1697)
+ '()
+ (if (eq? (car ls1697)
+ x1698)
+ (remq1693
+ x1698
+ (cdr ls1697))
+ (cons
+ (car ls1697)
+ (remq1693
+ x1698
+ (cdr ls1697))))))))
+ (remq1693
+ '-
+ (apply
+ append
+ (map (lambda (m1694)
+ ((lambda (row1695)
+ (map (lambda (s1696)
+ (cdr (assq
+ s1696
+ row1695)))
+ when-list1692))
+ (cdr (assq
+ m1694
+ table1690))))
+ mode-set1691))))))
+ '((l (load . l) (compile . c) (visit . v)
+ (revisit . r) (eval . -))
+ (c (load . -) (compile . -)
+ (visit . -) (revisit . -)
+ (eval . c))
+ (v (load . v) (compile . c)
+ (visit . v) (revisit . -)
+ (eval . -))
+ (r (load . r) (compile . c)
+ (visit . -) (revisit . r)
+ (eval . -))
+ (e (load . -) (compile . -)
+ (visit . -) (revisit . -)
+ (eval . e)))))
+ (initial-mode-set491 (lambda (when-list1686
+ compiling-a-file1685)
+ (apply
+ append
+ (map (lambda (s1687)
+ (if compiling-a-file1685
+ ((lambda (t1688)
+ (if (memv
+ t1688
+ '(compile))
+ '(c)
+ (if (memv
+ t1688
+ '(load))
+ '(l)
+ (if (memv
+ t1688
+ '(visit))
+ '(v)
+ (if (memv
+ t1688
+ '(revisit))
+ '(r)
+ '())))))
+ s1687)
+ ((lambda (t1689)
+ (if (memv t1689 '(eval))
+ '(e)
+ '()))
+ s1687)))
+ when-list1686))))
+ (rt-eval/residualize492 (lambda (rtem1680 thunk1679)
+ (if (memq 'e rtem1680)
+ (thunk1679)
+ ((lambda (thunk1681)
+ (if (memq 'v rtem1680)
+ (if ((lambda (t1682)
+ (if t1682
+ t1682
+ (memq
+ 'r
+ rtem1680)))
+ (memq 'l rtem1680))
+ (thunk1681)
+ (thunk1681))
+ (if ((lambda (t1683)
+ (if t1683
+ t1683
+ (memq
+ 'r
+ rtem1680)))
+ (memq 'l rtem1680))
+ (thunk1681)
+ (chi-void518))))
+ (if (memq 'c rtem1680)
+ ((lambda (x1684)
+ (begin
+ (top-level-eval-hook133
+ x1684)
+ (lambda () x1684)))
+ (thunk1679))
+ thunk1679)))))
+ (ct-eval/residualize2493 (lambda (ctem1676 thunk1675)
+ ((lambda (t1677)
+ (ct-eval/residualize3494
+ ctem1676
+ (lambda ()
+ (begin
+ (if (not t1677)
+ (set! t1677
+ (thunk1675))
+ (void))
+ (top-level-eval-hook133
+ t1677)))
+ (lambda ()
+ ((lambda (t1678)
+ (if t1678
+ t1678
+ (thunk1675)))
+ t1677))))
+ '#f)))
+ (ct-eval/residualize3494 (lambda (ctem1672 eval-thunk1671
+ residualize-thunk1670)
+ (if (memq 'e ctem1672)
+ (begin
+ (eval-thunk1671)
+ (chi-void518))
+ (begin
+ (if (memq 'c ctem1672)
+ (eval-thunk1671)
+ (void))
+ (if (memq 'r ctem1672)
+ (if ((lambda (t1673)
+ (if t1673
+ t1673
+ (memq
+ 'v
+ ctem1672)))
+ (memq 'l ctem1672))
+ (residualize-thunk1670)
+ (residualize-thunk1670))
+ (if ((lambda (t1674)
+ (if t1674
+ t1674
+ (memq
+ 'v
+ ctem1672)))
+ (memq 'l ctem1672))
+ (residualize-thunk1670)
+ (chi-void518)))))))
+ (chi-frobs495 (lambda (frob*1668 r1667 mr1666 m?1665)
+ (map (lambda (x1669)
+ (chi498 (frob-e478 x1669) r1667 mr1666
+ '(()) m?1665))
+ frob*1668)))
+ (chi-meta-frob496 (lambda (x1664 mr1663)
+ (chi498 (frob-e478 x1664) mr1663 mr1663
+ '(()) '#t)))
+ (chi-sequence497 (lambda (body1659 r1658 mr1657 w1656 ae1655
+ m?1654)
+ (build-sequence235
+ ae1655
+ ((letrec ((dobody1660 (lambda (body1661)
+ (if (null?
+ body1661)
+ '()
+ ((lambda (first1662)
+ (cons
+ first1662
+ (dobody1660
+ (cdr body1661))))
+ (chi498
+ (car body1661)
+ r1658
+ mr1657
+ w1656
+ m?1654))))))
+ dobody1660)
+ body1659))))
+ (chi498 (lambda (e1648 r1647 mr1646 w1645 m?1644)
+ (call-with-values
+ (lambda ()
+ (syntax-type446 e1648 r1647 w1645 '#f '#f))
+ (lambda (type1653 value1652 e1651 w1650 ae1649)
+ (chi-expr499 type1653 value1652 e1651 r1647
+ mr1646 w1650 ae1649 m?1644)))))
+ (chi-expr499 (lambda (type1628 value1627 e1626 r1625 mr1624
+ w1623 ae1622 m?1621)
+ ((lambda (t1629)
+ (if (memv t1629 '(lexical))
+ value1627
+ (if (memv t1629 '(core))
+ (value1627 e1626 r1625 mr1624 w1623
+ ae1622 m?1621)
+ (if (memv t1629 '(lexical-call))
+ (chi-application500 value1627
+ e1626 r1625 mr1624 w1623 ae1622
+ m?1621)
+ (if (memv t1629 '(constant))
+ (list
+ 'quote
+ (strip522
+ (source-wrap444
+ e1626
+ w1623
+ ae1622)
+ '(())))
+ (if (memv t1629 '(global))
+ value1627
+ (if (memv
+ t1629
+ '(meta-variable))
+ (if m?1621
+ value1627
+ (displaced-lexical-error299
+ (source-wrap444
+ e1626
+ w1623
+ ae1622)))
+ (if (memv
+ t1629
+ '(call))
+ (chi-application500
+ (chi498
+ (car e1626)
+ r1625 mr1624
+ w1623 m?1621)
+ e1626 r1625
+ mr1624 w1623
+ ae1622 m?1621)
+ (if (memv
+ t1629
+ '(begin-form))
+ (chi-sequence497
+ (parse-begin515
+ e1626
+ w1623
+ ae1622
+ '#f)
+ r1625
+ mr1624
+ w1623
+ ae1622
+ m?1621)
+ (if (memv
+ t1629
+ '(local-syntax-form))
+ (call-with-values
+ (lambda ()
+ (chi-local-syntax517
+ value1627
+ e1626
+ r1625
+ mr1624
+ w1623
+ ae1622))
+ (lambda (forms1634
+ r1633
+ mr1632
+ w1631
+ ae1630)
+ (chi-sequence497
+ forms1634
+ r1633
+ mr1632
+ w1631
+ ae1630
+ m?1621)))
+ (if (memv
+ t1629
+ '(eval-when-form))
+ (call-with-values
+ (lambda ()
+ (parse-eval-when513
+ e1626
+ w1623
+ ae1622))
+ (lambda (when-list1636
+ forms1635)
+ (if (memq
+ 'eval
+ when-list1636)
+ (chi-sequence497
+ forms1635
+ r1625
+ mr1624
+ w1623
+ ae1622
+ m?1621)
+ (chi-void518))))
+ (if (memv
+ t1629
+ '(meta-form))
+ (syntax-error
+ (source-wrap444
+ e1626
+ w1623
+ ae1622)
+ '"invalid context for meta definition")
+ (if (memv
+ t1629
+ '(define-form))
+ (begin
+ (parse-define510
+ e1626
+ w1623
+ ae1622)
+ (syntax-error
+ (source-wrap444
+ e1626
+ w1623
+ ae1622)
+ '"invalid context for definition"))
+ (if (memv
+ t1629
+ '(define-syntax-form))
+ (begin
+ (parse-define-syntax511
+ e1626
+ w1623
+ ae1622)
+ (syntax-error
+ (source-wrap444
+ e1626
+ w1623
+ ae1622)
+ '"invalid context for definition"))
+ (if (memv
+ t1629
+ '($module-form))
+ (call-with-values
+ (lambda ()
+ (parse-module508
+ e1626
+ w1623
+ ae1622
+ w1623))
+ (lambda (orig1640
+ id1639
+ exports1638
+ forms1637)
+ (syntax-error
+ orig1640
+ '"invalid context for definition")))
+ (if (memv
+ t1629
+ '($import-form))
+ (call-with-values
+ (lambda ()
+ (parse-import509
+ e1626
+ w1623
+ ae1622))
+ (lambda (orig1643
+ only?1642
+ mid1641)
+ (syntax-error
+ orig1643
+ '"invalid context for definition")))
+ (if (memv
+ t1629
+ '(alias-form))
+ (begin
+ (parse-alias514
+ e1626
+ w1623
+ ae1622)
+ (syntax-error
+ (source-wrap444
+ e1626
+ w1623
+ ae1622)
+ '"invalid context for definition"))
+ (if (memv
+ t1629
+ '(syntax))
+ (syntax-error
+ (source-wrap444
+ e1626
+ w1623
+ ae1622)
+ '"reference to pattern variable outside syntax form")
+ (if (memv
+ t1629
+ '(displaced-lexical))
+ (displaced-lexical-error299
+ (source-wrap444
+ e1626
+ w1623
+ ae1622))
+ (syntax-error
+ (source-wrap444
+ e1626
+ w1623
+ ae1622)))))))))))))))))))))
+ type1628)))
+ (chi-application500 (lambda (x1613 e1612 r1611 mr1610 w1609
+ ae1608 m?1607)
+ ((lambda (tmp1614)
+ ((lambda (tmp1615)
+ (if tmp1615
+ (apply
+ (lambda (e01617 e11616)
+ (cons
+ x1613
+ (map (lambda (e1619)
+ (chi498 e1619
+ r1611 mr1610
+ w1609 m?1607))
+ e11616)))
+ tmp1615)
+ ((lambda (_1620)
+ (syntax-error
+ (source-wrap444
+ e1612
+ w1609
+ ae1608)))
+ tmp1614)))
+ ($syntax-dispatch
+ tmp1614
+ '(any . each-any))))
+ e1612)))
+ (chi-set!501 (lambda (e1581 r1580 w1579 ae1578 rib1577)
+ ((lambda (tmp1582)
+ ((lambda (tmp1583)
+ (if (if tmp1583
+ (apply
+ (lambda (_1586 id1585 val1584)
+ (id?306 id1585))
+ tmp1583)
+ '#f)
+ (apply
+ (lambda (_1589 id1588 val1587)
+ ((lambda (n1590)
+ ((lambda (b1591)
+ ((lambda (t1592)
+ (if (memv
+ t1592
+ '(macro!))
+ ((lambda (id1594
+ val1593)
+ (syntax-type446
+ (chi-macro502
+ (binding-value282
+ b1591)
+ (list
+ '#(syntax-object set! ((top) #(ribcage () () ()) #(ribcage #(id val) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(t) #(("m" top)) #("i")) #(ribcage () () ()) #(ribcage #(b) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(n) #((top)) #("i")) #(ribcage #(_ id val) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(e r w ae rib) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap s\ No newline at end of file
+ id1594
+ val1593)
+ r1580 '(())
+ '#f rib1577)
+ r1580 '(()) '#f
+ rib1577))
+ (wrap443
+ id1588
+ w1579)
+ (wrap443
+ val1587
+ w1579))
+ (values 'core
+ (lambda (e1600
+ r1599
+ mr1598
+ w1597
+ ae1596
+ m?1595)
+ ((lambda (val1602
+ n1601)
+ ((lambda (b1603)
+ ((lambda (t1604)
+ (if (memv
+ t1604
+ '(lexical))
+ (list
+ 'set!
+ (binding-value282
+ b1603)
+ val1602)
+ (if (memv
+ t1604
+ '(global))
+ ((lambda (sym1605)
+ (begin
+ (if (read-only-binding?140
+ n1601)
+ (syntax-error
+ (source-wrap444
+ e1600
+ w1597
+ ae1596)
+ '"invalid assignment to read-only variable")
+ (void))
+ (list
+ 'set!
+ sym1605
+ val1602)))
+ (binding-value282
+ b1603))
+ (if (memv
+ t1604
+ '(meta-variable))
+ (if m?1595
+ (list
+ 'set!
+ (binding-value282
+ b1603)
+ val1602)
+ (displaced-lexical-error299
+ (wrap443
+ id1588
+ w1597)))
+ (if (memv
+ t1604
+ '(displaced-lexical))
+ (displaced-lexical-error299
+ (wrap443
+ id1588
+ w1597))
+ (syntax-error
+ (source-wrap444
+ e1600
+ w1597
+ ae1596)))))))
+ (binding-type281
+ b1603)))
+ (lookup301
+ n1601
+ r1599)))
+ (chi498 val1587
+ r1599 mr1598
+ w1597 m?1595)
+ (id-var-name434
+ id1588
+ w1597)))
+ e1581 w1579
+ ae1578)))
+ (binding-type281 b1591)))
+ (lookup301 n1590 r1580)))
+ (id-var-name434 id1588 w1579)))
+ tmp1583)
+ ((lambda (_1606)
+ (syntax-error
+ (source-wrap444
+ e1581
+ w1579
+ ae1578)))
+ tmp1582)))
+ ($syntax-dispatch tmp1582 '(any any any))))
+ e1581)))
+ (chi-macro502 (lambda (p1564 e1563 r1562 w1561 ae1560
+ rib1559)
+ (letrec ((rebuild-macro-output1565 (lambda (x1569
+ m1568)
+ (if (pair?
+ x1569)
+ (cons
+ (rebuild-macro-output1565
+ (car x1569)
+ m1568)
+ (rebuild-macro-output1565
+ (cdr x1569)
+ m1568))
+ (if (syntax-object?64
+ x1569)
+ ((lambda (w1570)
+ ((lambda (ms1572
+ s1571)
+ (make-syntax-object63
+ (syntax-object-expression65
+ x1569)
+ (if (if (pair?
+ ms1572)
+ (eq? (car ms1572)
+ '#f)
+ '#f)
+ (make-wrap315
+ (cdr ms1572)
+ (cdr s1571))
+ (make-wrap315
+ (cons
+ m1568
+ ms1572)
+ (if rib1559
+ (cons
+ rib1559
+ (cons
+ 'shift
+ s1571))
+ (cons
+ 'shift
+ s1571))))))
+ (wrap-marks316
+ w1570)
+ (wrap-subst317
+ w1570)))
+ (syntax-object-wrap66
+ x1569))
+ (if (vector?
+ x1569)
+ ((lambda (n1573)
+ ((lambda (v1574)
+ ((lambda ()
+ ((letrec ((do1575 (lambda (i1576)
+ (if (= i1576
+ n1573)
+ v1574
+ (begin
+ (vector-set!
+ v1574
+ i1576
+ (rebuild-macro-output1565
+ (vector-ref
+ x1569
+ i1576)
+ m1568))
+ (do1575
+ (+ i1576
+ '1)))))))
+ do1575)
+ '0))))
+ (make-vector
+ n1573)))
+ (vector-length
+ x1569))
+ (if (symbol?
+ x1569)
+ (syntax-error
+ (source-wrap444
+ e1563
+ w1561
+ ae1560)
+ '"encountered raw symbol "
+ (symbol->string
+ x1569)
+ '" in output of macro")
+ x1569)))))))
+ (rebuild-macro-output1565
+ ((lambda (out1566)
+ (if (procedure? out1566)
+ (out1566
+ (lambda (id1567)
+ (begin
+ (if (not (identifier? id1567))
+ (syntax-error
+ id1567
+ '"environment argument is not an identifier")
+ (void))
+ (lookup301
+ (id-var-name434
+ id1567
+ '(()))
+ r1562))))
+ out1566))
+ (p1564
+ (source-wrap444
+ e1563
+ (anti-mark400 w1561)
+ ae1560)))
+ (string '#\m)))))
+ (chi-body503 (lambda (body1547 outer-form1546 r1545 mr1544
+ w1543 m?1542)
+ ((lambda (ribcage1548)
+ ((lambda (w1549)
+ ((lambda (body1550)
+ ((lambda ()
+ (call-with-values
+ (lambda ()
+ (chi-internal504 ribcage1548
+ outer-form1546 body1550 r1545
+ mr1544 m?1542))
+ (lambda (r1557 mr1556 exprs1555
+ ids1554 vars1553 vals1552
+ inits1551)
+ (begin
+ (if (null? exprs1555)
+ (syntax-error
+ outer-form1546
+ '"no expressions in body")
+ (void))
+ (build-body237
+ '#f
+ (reverse vars1553)
+ (chi-frobs495
+ (reverse vals1552)
+ r1557
+ mr1556
+ m?1542)
+ (build-sequence235
+ '#f
+ (chi-frobs495
+ (append
+ inits1551
+ exprs1555)
+ r1557
+ mr1556
+ m?1542)))))))))
+ (map (lambda (x1558)
+ (make-frob476
+ (wrap443 x1558 w1549)
+ '#f))
+ body1547)))
+ (make-wrap315
+ (wrap-marks316 w1543)
+ (cons
+ ribcage1548
+ (wrap-subst317 w1543)))))
+ (make-ribcage365 '() '() '()))))
+ (chi-internal504 (lambda (ribcage1451 source-exp1450
+ body1449 r1448 mr1447 m?1446)
+ (letrec ((return1452 (lambda (r1541 mr1540
+ exprs1539
+ ids1538
+ vars1537
+ vals1536
+ inits1535)
+ (begin
+ (check-defined-ids485
+ source-exp1450
+ ids1538)
+ (values r1541
+ mr1540 exprs1539
+ ids1538 vars1537
+ vals1536
+ inits1535)))))
+ ((letrec ((parse1453 (lambda (body1461
+ r1460 mr1459
+ ids1458
+ vars1457
+ vals1456
+ inits1455
+ meta-seen?1454)
+ (if (null?
+ body1461)
+ (return1452
+ r1460 mr1459
+ body1461
+ ids1458
+ vars1457
+ vals1456
+ inits1455)
+ ((lambda (fr1462)
+ ((lambda (e1463)
+ ((lambda (meta?1464)
+ ((lambda ()
+ (call-with-values
+ (lambda ()
+ (syntax-type446
+ e1463
+ r1460
+ '(())
+ '#f
+ ribcage1451))
+ (lambda (type1469
+ value1468
+ e1467
+ w1466
+ ae1465)
+ ((lambda (t1470)
+ (if (memv
+ t1470
+ '(define-form))
+ (call-with-values
+ (lambda ()
+ (parse-define510
+ e1467
+ w1466
+ ae1465))
+ (lambda (id1473
+ rhs1472
+ w1471)
+ ((lambda (id1475
+ label1474)
+ (if meta?1464
+ ((lambda (sym1476)
+ (begin
+ (extend-ribcage!410
+ ribcage1451
+ id1475
+ label1474)
+ ((lambda (mr1477)
+ (begin
+ (define-top-level-value-hook135
+ sym1476
+ (top-level-eval-hook133
+ (chi498
+ rhs1472
+ mr1477
+ mr1477
+ w1471
+ '#t)))
+ (parse1453
+ (cdr body1461)
+ r1460
+ mr1477
+ (cons
+ id1475
+ ids1458)
+ vars1457
+ vals1456
+ inits1455
+ '#f)))
+ (extend-env295
+ label1474
+ (cons
+ 'meta-variable
+ sym1476)
+ mr1459))))
+ (generate-id143
+ ((lambda (x1478)
+ ((lambda (e1479)
+ (if (annotation?132
+ e1479)
+ (annotation-expression
+ e1479)
+ e1479))
+ (if (syntax-object?64
+ x1478)
+ (syntax-object-expression65
+ x1478)
+ x1478)))
+ id1475)))
+ ((lambda (var1480)
+ (begin
+ (extend-ribcage!410
+ ribcage1451
+ id1475
+ label1474)
+ (parse1453
+ (cdr body1461)
+ (extend-env295
+ label1474
+ (cons
+ 'lexical
+ var1480)
+ r1460)
+ mr1459
+ (cons
+ id1475
+ ids1458)
+ (cons
+ var1480
+ vars1457)
+ (cons
+ (make-frob476
+ (wrap443
+ rhs1472
+ w1471)
+ meta?1464)
+ vals1456)
+ inits1455
+ '#f)))
+ (gen-var523
+ id1475))))
+ (wrap443
+ id1473
+ w1471)
+ (gen-label362))))
+ (if (memv
+ t1470
+ '(define-syntax-form))
+ (call-with-values
+ (lambda ()
+ (parse-define-syntax511
+ e1467
+ w1466
+ ae1465))
+ (lambda (id1483
+ rhs1482
+ w1481)
+ ((lambda (id1486
+ label1485
+ exp1484)
+ (begin
+ (extend-ribcage!410
+ ribcage1451
+ id1486
+ label1485)
+ ((lambda (b1487)
+ (parse1453
+ (cdr body1461)
+ (extend-env295
+ label1485
+ b1487
+ r1460)
+ (extend-env295
+ label1485
+ b1487
+ mr1459)
+ (cons
+ id1486
+ ids1458)
+ vars1457
+ vals1456
+ inits1455
+ '#f))
+ (defer-or-eval-transformer303
+ local-eval-hook134
+ exp1484))))
+ (wrap443
+ id1483
+ w1481)
+ (gen-label362)
+ (chi498
+ rhs1482
+ mr1459
+ mr1459
+ w1481
+ '#t))))
+ (if (memv
+ t1470
+ '($module-form))
+ ((lambda (*ribcage1488)
+ ((lambda (*w1489)
+ ((lambda ()
+ (call-with-values
+ (lambda ()
+ (parse-module508
+ e1467
+ w1466
+ ae1465
+ *w1489))
+ (lambda (orig1493
+ id1492
+ exports1491
+ forms1490)
+ (call-with-values
+ (lambda ()
+ (chi-internal504
+ *ribcage1488
+ orig1493
+ (map (lambda (d1507)
+ (make-frob476
+ d1507
+ meta?1464))
+ forms1490)
+ r1460
+ mr1459
+ m?1446))
+ (lambda (r1500
+ mr1499
+ *body1498
+ *ids1497
+ *vars1496
+ *vals1495
+ *inits1494)
+ (begin
+ (check-module-exports484
+ source-exp1450
+ (flatten-exports450
+ exports1491)
+ *ids1497)
+ ((lambda (iface1505
+ vars1504
+ vals1503
+ inits1502
+ label1501)
+ (begin
+ (extend-ribcage!410
+ ribcage1451
+ id1492
+ label1501)
+ ((lambda (b1506)
+ (parse1453
+ (cdr body1461)
+ (extend-env295
+ label1501
+ b1506
+ r1500)
+ (extend-env295
+ label1501
+ b1506
+ mr1499)
+ (cons
+ id1492
+ ids1458)
+ vars1504
+ vals1503
+ inits1502
+ '#f))
+ (cons
+ '$module
+ iface1505))))
+ (make-resolved-interface460
+ id1492
+ exports1491
+ '#f)
+ (append
+ *vars1496
+ vars1457)
+ (append
+ *vals1495
+ vals1456)
+ (append
+ inits1455
+ *inits1494
+ *body1498)
+ (gen-label362))))))))))
+ (make-wrap315
+ (wrap-marks316
+ w1466)
+ (cons
+ *ribcage1488
+ (wrap-subst317
+ w1466)))))
+ (make-ribcage365
+ '()
+ '()
+ '()))
+ (if (memv
+ t1470
+ '($import-form))
+ (call-with-values
+ (lambda ()
+ (parse-import509
+ e1467
+ w1466
+ ae1465))
+ (lambda (orig1510
+ only?1509
+ mid1508)
+ ((lambda (mlabel1511)
+ ((lambda (binding1512)
+ ((lambda (t1513)
+ (if (memv
+ t1513
+ '($module))
+ ((lambda (iface1514)
+ ((lambda (import-iface1515)
+ ((lambda ()
+ (begin
+ (if only?1509
+ (extend-ribcage-barrier!412
+ ribcage1451
+ mid1508)
+ (void))
+ (do-import!507
+ import-iface1515
+ ribcage1451)
+ (parse1453
+ (cdr body1461)
+ r1460
+ mr1459
+ (cons
+ import-iface1515
+ ids1458)
+ vars1457
+ vals1456
+ inits1455
+ '#f)))))
+ (make-import-interface379
+ iface1514
+ (import-mark-delta505
+ mid1508
+ iface1514))))
+ (binding-value282
+ binding1512))
+ (if (memv
+ t1513
+ '(displaced-lexical))
+ (displaced-lexical-error299
+ mid1508)
+ (syntax-error
+ mid1508
+ '"unknown module"))))
+ (binding-type281
+ binding1512)))
+ (lookup301
+ mlabel1511
+ r1460)))
+ (id-var-name434
+ mid1508
+ '(())))))
+ (if (memv
+ t1470
+ '(alias-form))
+ (call-with-values
+ (lambda ()
+ (parse-alias514
+ e1467
+ w1466
+ ae1465))
+ (lambda (new-id1517
+ old-id1516)
+ ((lambda (new-id1518)
+ (begin
+ (extend-ribcage!410
+ ribcage1451
+ new-id1518
+ (id-var-name-loc433
+ old-id1516
+ w1466))
+ (parse1453
+ (cdr body1461)
+ r1460
+ mr1459
+ (cons
+ new-id1518
+ ids1458)
+ vars1457
+ vals1456
+ inits1455
+ '#f)))
+ (wrap443
+ new-id1517
+ w1466))))
+ (if (memv
+ t1470
+ '(begin-form))
+ (parse1453
+ ((letrec ((f1519 (lambda (forms1520)
+ (if (null?
+ forms1520)
+ (cdr body1461)
+ (cons
+ (make-frob476
+ (wrap443
+ (car forms1520)
+ w1466)
+ meta?1464)
+ (f1519
+ (cdr forms1520)))))))
+ f1519)
+ (parse-begin515
+ e1467
+ w1466
+ ae1465
+ '#t))
+ r1460
+ mr1459
+ ids1458
+ vars1457
+ vals1456
+ inits1455
+ '#f)
+ (if (memv
+ t1470
+ '(eval-when-form))
+ (call-with-values
+ (lambda ()
+ (parse-eval-when513
+ e1467
+ w1466
+ ae1465))
+ (lambda (when-list1522
+ forms1521)
+ (parse1453
+ (if (memq
+ 'eval
+ when-list1522)
+ ((letrec ((f1523 (lambda (forms1524)
+ (if (null?
+ forms1524)
+ (cdr body1461)
+ (cons
+ (make-frob476
+ (wrap443
+ (car forms1524)
+ w1466)
+ meta?1464)
+ (f1523
+ (cdr forms1524)))))))
+ f1523)
+ forms1521)
+ (cdr body1461))
+ r1460
+ mr1459
+ ids1458
+ vars1457
+ vals1456
+ inits1455
+ '#f)))
+ (if (memv
+ t1470
+ '(meta-form))
+ (parse1453
+ (cons
+ (make-frob476
+ (wrap443
+ (parse-meta512
+ e1467
+ w1466
+ ae1465)
+ w1466)
+ '#t)
+ (cdr body1461))
+ r1460
+ mr1459
+ ids1458
+ vars1457
+ vals1456
+ inits1455
+ '#t)
+ (if (memv
+ t1470
+ '(local-syntax-form))
+ (call-with-values
+ (lambda ()
+ (chi-local-syntax517
+ value1468
+ e1467
+ r1460
+ mr1459
+ w1466
+ ae1465))
+ (lambda (forms1529
+ r1528
+ mr1527
+ w1526
+ ae1525)
+ (parse1453
+ ((letrec ((f1530 (lambda (forms1531)
+ (if (null?
+ forms1531)
+ (cdr body1461)
+ (cons
+ (make-frob476
+ (wrap443
+ (car forms1531)
+ w1526)
+ meta?1464)
+ (f1530
+ (cdr forms1531)))))))
+ f1530)
+ forms1529)
+ r1528
+ mr1527
+ ids1458
+ vars1457
+ vals1456
+ inits1455
+ '#f)))
+ (begin
+ (if meta-seen?1454
+ (syntax-error
+ (source-wrap444
+ e1467
+ w1466
+ ae1465)
+ '"invalid meta definition")
+ (void))
+ ((letrec ((f1532 (lambda (body1533)
+ (if ((lambda (t1534)
+ (if t1534
+ t1534
+ (not (frob-meta?479
+ (car body1533)))))
+ (null?
+ body1533))
+ (return1452
+ r1460
+ mr1459
+ body1533
+ ids1458
+ vars1457
+ vals1456
+ inits1455)
+ (begin
+ (top-level-eval-hook133
+ (chi-meta-frob496
+ (car body1533)
+ mr1459))
+ (f1532
+ (cdr body1533)))))))
+ f1532)
+ (cons
+ (make-frob476
+ (source-wrap444
+ e1467
+ w1466
+ ae1465)
+ meta?1464)
+ (cdr body1461))))))))))))))
+ type1469))))))
+ (frob-meta?479
+ fr1462)))
+ (frob-e478
+ fr1462)))
+ (car body1461))))))
+ parse1453) body1449 r1448 mr1447 '()
+ '() '() '() '#f))))
+ (import-mark-delta505 (lambda (mid1445 iface1444)
+ (diff-marks426
+ (id-marks312 mid1445)
+ (interface-marks453 iface1444))))
+ (lookup-import-label506 (lambda (id1442)
+ ((lambda (label1443)
+ (begin
+ (if (not label1443)
+ (syntax-error
+ id1442
+ '"exported identifier not visible")
+ (void))
+ label1443))
+ (id-var-name-loc433
+ id1442
+ '(())))))
+ (do-import!507 (lambda (import-iface1438 ribcage1437)
+ ((lambda (ie1439)
+ (if (<= (vector-length ie1439) '20)
+ ((lambda (new-marks1440)
+ (vfor-each488
+ (lambda (id1441)
+ (import-extend-ribcage!411
+ ribcage1437
+ new-marks1440
+ id1441
+ (lookup-import-label506
+ id1441)))
+ ie1439))
+ (import-interface-new-marks382
+ import-iface1438))
+ (extend-ribcage-subst!414
+ ribcage1437
+ import-iface1438)))
+ (interface-exports454
+ (import-interface-interface381
+ import-iface1438)))))
+ (parse-module508 (lambda (e1413 w1412 ae1411 *w1410)
+ (letrec ((listify1414 (lambda (exports1431)
+ (if (null?
+ exports1431)
+ '()
+ (cons
+ ((lambda (tmp1432)
+ ((lambda (tmp1433)
+ (if tmp1433
+ (apply
+ (lambda (ex1434)
+ (listify1414
+ ex1434))
+ tmp1433)
+ ((lambda (x1436)
+ (if (id?306
+ x1436)
+ (wrap443
+ x1436
+ *w1410)
+ (syntax-error
+ (source-wrap444
+ e1413
+ w1412
+ ae1411)
+ '"invalid exports list in")))
+ tmp1432)))
+ ($syntax-dispatch
+ tmp1432
+ 'each-any)))
+ (car exports1431))
+ (listify1414
+ (cdr exports1431)))))))
+ ((lambda (tmp1415)
+ ((lambda (tmp1416)
+ (if (if tmp1416
+ (apply
+ (lambda (_1421 orig1420
+ mid1419 ex1418
+ form1417)
+ (id?306 mid1419))
+ tmp1416)
+ '#f)
+ (apply
+ (lambda (_1426 orig1425
+ mid1424 ex1423
+ form1422)
+ (values
+ orig1425
+ (wrap443 mid1424 w1412)
+ (listify1414 ex1423)
+ (map (lambda (x1428)
+ (wrap443
+ x1428
+ *w1410))
+ form1422)))
+ tmp1416)
+ ((lambda (_1430)
+ (syntax-error
+ (source-wrap444
+ e1413
+ w1412
+ ae1411)))
+ tmp1415)))
+ ($syntax-dispatch
+ tmp1415
+ '(any any any each-any .
+ each-any))))
+ e1413))))
+ (parse-import509 (lambda (e1393 w1392 ae1391)
+ ((lambda (tmp1394)
+ ((lambda (tmp1395)
+ (if (if tmp1395
+ (apply
+ (lambda (_1398 orig1397
+ mid1396)
+ (id?306 mid1396))
+ tmp1395)
+ '#f)
+ (apply
+ (lambda (_1401 orig1400 mid1399)
+ (values
+ orig1400
+ '#t
+ (wrap443 mid1399 w1392)))
+ tmp1395)
+ ((lambda (tmp1402)
+ (if (if tmp1402
+ (apply
+ (lambda (_1405
+ orig1404
+ mid1403)
+ (id?306 mid1403))
+ tmp1402)
+ '#f)
+ (apply
+ (lambda (_1408 orig1407
+ mid1406)
+ (values
+ orig1407
+ '#f
+ (wrap443
+ mid1406
+ w1392)))
+ tmp1402)
+ ((lambda (_1409)
+ (syntax-error
+ (source-wrap444
+ e1393
+ w1392
+ ae1391)))
+ tmp1394)))
+ ($syntax-dispatch
+ tmp1394
+ '(any any #(atom #f) any)))))
+ ($syntax-dispatch
+ tmp1394
+ '(any any #(atom #t) any))))
+ e1393)))
+ (parse-define510 (lambda (e1364 w1363 ae1362)
+ ((lambda (tmp1365)
+ ((lambda (tmp1366)
+ (if (if tmp1366
+ (apply
+ (lambda (_1369 name1368
+ val1367)
+ (id?306 name1368))
+ tmp1366)
+ '#f)
+ (apply
+ (lambda (_1372 name1371 val1370)
+ (values
+ name1371
+ val1370
+ w1363))
+ tmp1366)
+ ((lambda (tmp1373)
+ (if (if tmp1373
+ (apply
+ (lambda (_1378
+ name1377
+ args1376
+ e11375
+ e21374)
+ (if (id?306
+ name1377)
+ (valid-bound-ids?439
+ (lambda-var-list524
+ args1376))
+ '#f))
+ tmp1373)
+ '#f)
+ (apply
+ (lambda (_1383 name1382
+ args1381 e11380
+ e21379)
+ (values
+ (wrap443
+ name1382
+ w1363)
+ (cons
+ '#(syntax-object lambda ((top) #(ribcage #(_ name args e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e w ae) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object noexpand let-values define-structure unless when) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) \ No newline at end of file
+ (wrap443
+ (cons
+ args1381
+ (cons
+ e11380
+ e21379))
+ w1363))
+ '(())))
+ tmp1373)
+ ((lambda (tmp1385)
+ (if (if tmp1385
+ (apply
+ (lambda (_1387
+ name1386)
+ (id?306
+ name1386))
+ tmp1385)
+ '#f)
+ (apply
+ (lambda (_1389
+ name1388)
+ (values
+ (wrap443
+ name1388
+ w1363)
+ '#(syntax-object (void) ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(e w ae) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object noexpand let-values define-structure unless when) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) \ No newline at end of file
+ '(())))
+ tmp1385)
+ ((lambda (_1390)
+ (syntax-error
+ (source-wrap444
+ e1364
+ w1363
+ ae1362)))
+ tmp1365)))
+ ($syntax-dispatch
+ tmp1365
+ '(any any)))))
+ ($syntax-dispatch
+ tmp1365
+ '(any (any . any)
+ any
+ .
+ each-any)))))
+ ($syntax-dispatch
+ tmp1365
+ '(any any any))))
+ e1364)))
+ (parse-define-syntax511 (lambda (e1340 w1339 ae1338)
+ ((lambda (tmp1341)
+ ((lambda (tmp1342)
+ (if (if tmp1342
+ (apply
+ (lambda (_1347
+ name1346
+ id1345
+ e11344
+ e21343)
+ (if (id?306
+ name1346)
+ (id?306 id1345)
+ '#f))
+ tmp1342)
+ '#f)
+ (apply
+ (lambda (_1352 name1351
+ id1350 e11349
+ e21348)
+ (values
+ (wrap443
+ name1351
+ w1339)
+ (cons
+ '#(syntax-object lambda ((top) #(ribcage #(_ name id e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(e w ae) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object noexpand let-values define-structure unless when) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (t\ No newline at end of file
+ (cons
+ (wrap443
+ (list id1350)
+ w1339)
+ (wrap443
+ (cons
+ e11349
+ e21348)
+ w1339)))
+ '(())))
+ tmp1342)
+ ((lambda (tmp1354)
+ (if (if tmp1354
+ (apply
+ (lambda (_1357
+ name1356
+ val1355)
+ (id?306
+ name1356))
+ tmp1354)
+ '#f)
+ (apply
+ (lambda (_1360
+ name1359
+ val1358)
+ (values
+ name1359
+ val1358
+ w1339))
+ tmp1354)
+ ((lambda (_1361)
+ (syntax-error
+ (source-wrap444
+ e1340
+ w1339
+ ae1338)))
+ tmp1341)))
+ ($syntax-dispatch
+ tmp1341
+ '(any any any)))))
+ ($syntax-dispatch
+ tmp1341
+ '(any (any any)
+ any
+ .
+ each-any))))
+ e1340)))
+ (parse-meta512 (lambda (e1332 w1331 ae1330)
+ ((lambda (tmp1333)
+ ((lambda (tmp1334)
+ (if tmp1334
+ (apply
+ (lambda (_1336 form1335) form1335)
+ tmp1334)
+ ((lambda (_1337)
+ (syntax-error
+ (source-wrap444
+ e1332
+ w1331
+ ae1330)))
+ tmp1333)))
+ ($syntax-dispatch tmp1333 '(any . any))))
+ e1332)))
+ (parse-eval-when513 (lambda (e1320 w1319 ae1318)
+ ((lambda (tmp1321)
+ ((lambda (tmp1322)
+ (if tmp1322
+ (apply
+ (lambda (_1326 x1325 e11324
+ e21323)
+ (values
+ (chi-when-list445
+ x1325
+ w1319)
+ (cons e11324 e21323)))
+ tmp1322)
+ ((lambda (_1329)
+ (syntax-error
+ (source-wrap444
+ e1320
+ w1319
+ ae1318)))
+ tmp1321)))
+ ($syntax-dispatch
+ tmp1321
+ '(any each-any any . each-any))))
+ e1320)))
+ (parse-alias514 (lambda (e1308 w1307 ae1306)
+ ((lambda (tmp1309)
+ ((lambda (tmp1310)
+ (if (if tmp1310
+ (apply
+ (lambda (_1313 new-id1312
+ old-id1311)
+ (if (id?306 new-id1312)
+ (id?306 old-id1311)
+ '#f))
+ tmp1310)
+ '#f)
+ (apply
+ (lambda (_1316 new-id1315
+ old-id1314)
+ (values new-id1315 old-id1314))
+ tmp1310)
+ ((lambda (_1317)
+ (syntax-error
+ (source-wrap444
+ e1308
+ w1307
+ ae1306)))
+ tmp1309)))
+ ($syntax-dispatch
+ tmp1309
+ '(any any any))))
+ e1308)))
+ (parse-begin515 (lambda (e1295 w1294 ae1293 empty-okay?1292)
+ ((lambda (tmp1296)
+ ((lambda (tmp1297)
+ (if (if tmp1297
+ (apply
+ (lambda (_1298)
+ empty-okay?1292)
+ tmp1297)
+ '#f)
+ (apply
+ (lambda (_1299) '())
+ tmp1297)
+ ((lambda (tmp1300)
+ (if tmp1300
+ (apply
+ (lambda (_1303 e11302
+ e21301)
+ (cons e11302 e21301))
+ tmp1300)
+ ((lambda (_1305)
+ (syntax-error
+ (source-wrap444
+ e1295
+ w1294
+ ae1293)))
+ tmp1296)))
+ ($syntax-dispatch
+ tmp1296
+ '(any any . each-any)))))
+ ($syntax-dispatch tmp1296 '(any))))
+ e1295)))
+ (chi-lambda-clause516 (lambda (e1269 c1268 r1267 mr1266
+ w1265 m?1264)
+ ((lambda (tmp1270)
+ ((lambda (tmp1271)
+ (if tmp1271
+ (apply
+ (lambda (id1274 e11273
+ e21272)
+ ((lambda (ids1275)
+ (if (not (valid-bound-ids?439
+ ids1275))
+ (syntax-error
+ e1269
+ '"invalid parameter list in")
+ ((lambda (labels1277
+ new-vars1276)
+ (values
+ new-vars1276
+ (chi-body503
+ (cons
+ e11273
+ e21272)
+ e1269
+ (extend-var-env*297
+ labels1277
+ new-vars1276
+ r1267)
+ mr1266
+ (make-binding-wrap417
+ ids1275
+ labels1277
+ w1265)
+ m?1264)))
+ (gen-labels364
+ ids1275)
+ (map gen-var523
+ ids1275))))
+ id1274))
+ tmp1271)
+ ((lambda (tmp1280)
+ (if tmp1280
+ (apply
+ (lambda (ids1283
+ e11282
+ e21281)
+ ((lambda (old-ids1284)
+ (if (not (valid-bound-ids?439
+ old-ids1284))
+ (syntax-error
+ e1269
+ '"invalid parameter list in")
+ ((lambda (labels1286
+ new-vars1285)
+ (values
+ ((letrec ((f1288 (lambda (ls11290
+ ls21289)
+ (if (null?
+ ls11290)
+ ls21289
+ (f1288
+ (cdr ls11290)
+ (cons
+ (car ls11290)
+ ls21289))))))
+ f1288)
+ (cdr new-vars1285)
+ (car new-vars1285))
+ (chi-body503
+ (cons
+ e11282
+ e21281)
+ e1269
+ (extend-var-env*297
+ labels1286
+ new-vars1285
+ r1267)
+ mr1266
+ (make-binding-wrap417
+ old-ids1284
+ labels1286
+ w1265)
+ m?1264)))
+ (gen-labels364
+ old-ids1284)
+ (map gen-var523
+ old-ids1284))))
+ (lambda-var-list524
+ ids1283)))
+ tmp1280)
+ ((lambda (_1291)
+ (syntax-error
+ e1269))
+ tmp1270)))
+ ($syntax-dispatch
+ tmp1270
+ '(any any . each-any)))))
+ ($syntax-dispatch
+ tmp1270
+ '(each-any any . each-any))))
+ c1268)))
+ (chi-local-syntax517 (lambda (rec?1245 e1244 r1243 mr1242
+ w1241 ae1240)
+ ((lambda (tmp1246)
+ ((lambda (tmp1247)
+ (if tmp1247
+ (apply
+ (lambda (_1252 id1251
+ val1250 e11249
+ e21248)
+ ((lambda (ids1253)
+ (if (not (valid-bound-ids?439
+ ids1253))
+ (invalid-ids-error441
+ (map (lambda (x1254)
+ (wrap443
+ x1254
+ w1241))
+ ids1253)
+ (source-wrap444
+ e1244
+ w1241
+ ae1240)
+ '"keyword")
+ ((lambda (labels1255)
+ ((lambda (new-w1256)
+ ((lambda (b*1257)
+ (values
+ (cons
+ e11249
+ e21248)
+ (extend-env*296
+ labels1255
+ b*1257
+ r1243)
+ (extend-env*296
+ labels1255
+ b*1257
+ mr1242)
+ new-w1256
+ ae1240))
+ ((lambda (w1259)
+ (map (lambda (x1261)
+ (defer-or-eval-transformer303
+ local-eval-hook134
+ (chi498
+ x1261
+ mr1242
+ mr1242
+ w1259
+ '#t)))
+ val1250))
+ (if rec?1245
+ new-w1256
+ w1241))))
+ (make-binding-wrap417
+ ids1253
+ labels1255
+ w1241)))
+ (gen-labels364
+ ids1253))))
+ id1251))
+ tmp1247)
+ ((lambda (_1263)
+ (syntax-error
+ (source-wrap444
+ e1244
+ w1241
+ ae1240)))
+ tmp1246)))
+ ($syntax-dispatch
+ tmp1246
+ '(any #(each (any any))
+ any
+ .
+ each-any))))
+ e1244)))
+ (chi-void518 (lambda () (cons 'void '())))
+ (ellipsis?519 (lambda (x1239)
+ (if (nonsymbol-id?305 x1239)
+ (literal-id=?436
+ x1239
+ '#(syntax-object ... ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object noexpand let-values define-structure unless when) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) \ No newline at end of file
+ '#f)))
+ (strip-annotation520 (lambda (x1238)
+ (if (pair? x1238)
+ (cons
+ (strip-annotation520 (car x1238))
+ (strip-annotation520 (cdr x1238)))
+ (if (annotation?132 x1238)
+ (annotation-stripped x1238)
+ x1238))))
+ (strip*521 (lambda (x1231 w1230 fn1229)
+ (if (memq 'top (wrap-marks316 w1230))
+ (fn1229 x1231)
+ ((letrec ((f1232 (lambda (x1233)
+ (if (syntax-object?64
+ x1233)
+ (strip*521
+ (syntax-object-expression65
+ x1233)
+ (syntax-object-wrap66
+ x1233)
+ fn1229)
+ (if (pair? x1233)
+ ((lambda (a1235
+ d1234)
+ (if (if (eq? a1235
+ (car x1233))
+ (eq? d1234
+ (cdr x1233))
+ '#f)
+ x1233
+ (cons
+ a1235
+ d1234)))
+ (f1232
+ (car x1233))
+ (f1232
+ (cdr x1233)))
+ (if (vector? x1233)
+ ((lambda (old1236)
+ ((lambda (new1237)
+ (if (andmap
+ eq?
+ old1236
+ new1237)
+ x1233
+ (list->vector
+ new1237)))
+ (map f1232
+ old1236)))
+ (vector->list
+ x1233))
+ x1233))))))
+ f1232)
+ x1231))))
+ (strip522 (lambda (x1226 w1225)
+ (strip*521
+ x1226
+ w1225
+ (lambda (x1227)
+ (if ((lambda (t1228)
+ (if t1228
+ t1228
+ (if (pair? x1227)
+ (annotation?132 (car x1227))
+ '#f)))
+ (annotation?132 x1227))
+ (strip-annotation520 x1227)
+ x1227)))))
+ (gen-var523 (lambda (id1223)
+ ((lambda (id1224)
+ (if (annotation?132 id1224)
+ (gensym)
+ (gensym)))
+ (if (syntax-object?64 id1223)
+ (syntax-object-expression65 id1223)
+ id1223))))
+ (lambda-var-list524 (lambda (vars1218)
+ ((letrec ((lvl1219 (lambda (vars1222
+ ls1221 w1220)
+ (if (pair? vars1222)
+ (lvl1219
+ (cdr vars1222)
+ (cons
+ (wrap443
+ (car vars1222)
+ w1220)
+ ls1221)
+ w1220)
+ (if (id?306
+ vars1222)
+ (cons
+ (wrap443
+ vars1222
+ w1220)
+ ls1221)
+ (if (null?
+ vars1222)
+ ls1221
+ (if (syntax-object?64
+ vars1222)
+ (lvl1219
+ (syntax-object-expression65
+ vars1222)
+ ls1221
+ (join-wraps422
+ w1220
+ (syntax-object-wrap66
+ vars1222)))
+ (if (annotation?132
+ vars1222)
+ (lvl1219
+ (annotation-expression
+ vars1222)
+ ls1221
+ w1220)
+ (cons
+ vars1222
+ ls1221)))))))))
+ lvl1219)
+ vars1218
+ '()
+ '(())))))
+ (begin
+ (set! $sc-put-cte
+ (lambda (id1199 b1198 top-token1197)
+ (letrec ((sc-put-module1200 (lambda (exports1216 token1215
+ new-marks1214)
+ (vfor-each488
+ (lambda (id1217)
+ (store-import-binding416
+ id1217
+ token1215
+ new-marks1214))
+ exports1216)))
+ (put-cte1201 (lambda (id1212 binding1211 token1210)
+ ((lambda (sym1213)
+ (begin
+ (store-import-binding416
+ id1212
+ token1210
+ '())
+ (put-global-definition-hook139
+ sym1213
+ (if (if (eq? (binding-type281
+ binding1211)
+ 'global)
+ (eq? (binding-value282
+ binding1211)
+ sym1213)
+ '#f)
+ '#f
+ binding1211))))
+ (if (symbol? id1212)
+ id1212
+ (id-var-name434 id1212 '(())))))))
+ ((lambda (binding1202)
+ ((lambda (t1203)
+ (if (memv t1203 '($module))
+ (begin
+ ((lambda (iface1204)
+ (sc-put-module1200
+ (interface-exports454 iface1204)
+ (interface-token455 iface1204)
+ '()))
+ (binding-value282 binding1202))
+ (put-cte1201 id1199 binding1202 top-token1197))
+ (if (memv t1203 '(do-alias))
+ (store-import-binding416
+ id1199
+ top-token1197
+ '())
+ (if (memv t1203 '(do-import))
+ ((lambda (token1205)
+ ((lambda (b1206)
+ ((lambda (t1207)
+ (if (memv t1207 '($module))
+ ((lambda (iface1208)
+ ((lambda (exports1209)
+ ((lambda ()
+ (begin
+ (if (not (eq? (interface-token455
+ iface1208)
+ token1205))
+ (syntax-error
+ id1199
+ '"import mismatch for module")
+ (void))
+ (sc-put-module1200
+ (interface-exports454
+ iface1208)
+ top-token1197
+ (import-mark-delta505
+ id1199
+ iface1208))))))
+ (interface-exports454
+ iface1208)))
+ (binding-value282 b1206))
+ (syntax-error
+ id1199
+ '"unknown module")))
+ (binding-type281 b1206)))
+ (lookup301
+ (id-var-name434 id1199 '(()))
+ '())))
+ (binding-value282 b1198))
+ (put-cte1201
+ id1199
+ binding1202
+ top-token1197)))))
+ (binding-type281 binding1202)))
+ (make-transformer-binding302 b1198)))))
+ (global-extend304 'local-syntax 'letrec-syntax '#t)
+ (global-extend304 'local-syntax 'let-syntax '#f)
+ (global-extend304
+ 'core
+ 'fluid-let-syntax
+ (lambda (e1171 r1170 mr1169 w1168 ae1167 m?1166)
+ ((lambda (tmp1172)
+ ((lambda (tmp1173)
+ (if (if tmp1173
+ (apply
+ (lambda (_1178 var1177 val1176 e11175 e21174)
+ (valid-bound-ids?439 var1177))
+ tmp1173)
+ '#f)
+ (apply
+ (lambda (_1184 var1183 val1182 e11181 e21180)
+ ((lambda (names1185)
+ (begin
+ (for-each
+ (lambda (id1192 n1191)
+ ((lambda (t1193)
+ (if (memv t1193 '(displaced-lexical))
+ (displaced-lexical-error299
+ (wrap443 id1192 w1168))
+ (void)))
+ (binding-type281
+ (lookup301 n1191 r1170))))
+ var1183
+ names1185)
+ ((lambda (b*1186)
+ (chi-body503 (cons e11181 e21180)
+ (source-wrap444 e1171 w1168 ae1167)
+ (extend-env*296 names1185 b*1186 r1170)
+ (extend-env*296 names1185 b*1186 mr1169)
+ w1168 m?1166))
+ (map (lambda (x1189)
+ (defer-or-eval-transformer303
+ local-eval-hook134
+ (chi498 x1189 mr1169 mr1169 w1168
+ '#t)))
+ val1182))))
+ (map (lambda (x1195)
+ (id-var-name434 x1195 w1168))
+ var1183)))
+ tmp1173)
+ ((lambda (_1196)
+ (syntax-error (source-wrap444 e1171 w1168 ae1167)))
+ tmp1172)))
+ ($syntax-dispatch
+ tmp1172
+ '(any #(each (any any)) any . each-any))))
+ e1171)))
+ (global-extend304
+ 'core
+ 'quote
+ (lambda (e1160 r1159 mr1158 w1157 ae1156 m?1155)
+ ((lambda (tmp1161)
+ ((lambda (tmp1162)
+ (if tmp1162
+ (apply
+ (lambda (_1164 e1163)
+ (list 'quote (strip522 e1163 w1157)))
+ tmp1162)
+ ((lambda (_1165)
+ (syntax-error (source-wrap444 e1160 w1157 ae1156)))
+ tmp1161)))
+ ($syntax-dispatch tmp1161 '(any any))))
+ e1160)))
+ (global-extend304
+ 'core
+ 'syntax
+ ((lambda ()
+ (letrec ((gen-syntax1039 (lambda (src1100 e1099 r1098
+ maps1097 ellipsis?1096
+ vec?1095)
+ (if (id?306 e1099)
+ ((lambda (label1101)
+ ((lambda (b1102)
+ (if (eq? (binding-type281
+ b1102)
+ 'syntax)
+ (call-with-values
+ (lambda ()
+ ((lambda (var.lev1105)
+ (gen-ref1040
+ src1100
+ (car var.lev1105)
+ (cdr var.lev1105)
+ maps1097))
+ (binding-value282
+ b1102)))
+ (lambda (var1104
+ maps1103)
+ (values
+ (list
+ 'ref
+ var1104)
+ maps1103)))
+ (if (ellipsis?1096
+ e1099)
+ (syntax-error
+ src1100
+ '"misplaced ellipsis in syntax form")
+ (values
+ (list
+ 'quote
+ e1099)
+ maps1097))))
+ (lookup301
+ label1101
+ r1098)))
+ (id-var-name434 e1099 '(())))
+ ((lambda (tmp1106)
+ ((lambda (tmp1107)
+ (if (if tmp1107
+ (apply
+ (lambda (dots1109
+ e1108)
+ (ellipsis?1096
+ dots1109))
+ tmp1107)
+ '#f)
+ (apply
+ (lambda (dots1111
+ e1110)
+ (if vec?1095
+ (syntax-error
+ src1100
+ '"misplaced ellipsis in syntax template")
+ (gen-syntax1039
+ src1100
+ e1110 r1098
+ maps1097
+ (lambda (x1112)
+ '#f)
+ '#f)))
+ tmp1107)
+ ((lambda (tmp1113)
+ (if (if tmp1113
+ (apply
+ (lambda (x1116
+ dots1115
+ y1114)
+ (ellipsis?1096
+ dots1115))
+ tmp1113)
+ '#f)
+ (apply
+ (lambda (x1119
+ dots1118
+ y1117)
+ ((letrec ((f1120 (lambda (y1122
+ k1121)
+ ((lambda (tmp1123)
+ ((lambda (tmp1124)
+ (if (if tmp1124
+ (apply
+ (lambda (dots1126
+ y1125)
+ (ellipsis?1096
+ dots1126))
+ tmp1124)
+ '#f)
+ (apply
+ (lambda (dots1128
+ y1127)
+ (f1120
+ y1127
+ (lambda (maps1129)
+ (call-with-values
+ (lambda ()
+ (k1121
+ (cons
+ '()
+ maps1129)))
+ (lambda (x1131
+ maps1130)
+ (if (null?
+ (car maps1130))
+ (syntax-error
+ src1100
+ '"extra ellipsis in syntax form")
+ (values
+ (gen-mappend1042
+ x1131
+ (car maps1130))
+ (cdr maps1130))))))))
+ tmp1124)
+ ((lambda (_1132)
+ (call-with-values
+ (lambda ()
+ (gen-syntax1039
+ src1100
+ y1122
+ r1098
+ maps1097
+ ellipsis?1096
+ vec?1095))
+ (lambda (y1134
+ maps1133)
+ (call-with-values
+ (lambda ()
+ (k1121
+ maps1133))
+ (lambda (x1136
+ maps1135)
+ (values
+ (gen-append1041
+ x1136
+ y1134)
+ maps1135))))))
+ tmp1123)))
+ ($syntax-dispatch
+ tmp1123
+ '(any .
+ any))))
+ y1122))))
+ f1120)
+ y1117
+ (lambda (maps1137)
+ (call-with-values
+ (lambda ()
+ (gen-syntax1039
+ src1100
+ x1119
+ r1098
+ (cons
+ '()
+ maps1137)
+ ellipsis?1096
+ '#f))
+ (lambda (x1139
+ maps1138)
+ (if (null?
+ (car maps1138))
+ (syntax-error
+ src1100
+ '"extra ellipsis in syntax form")
+ (values
+ (gen-map1043
+ x1139
+ (car maps1138))
+ (cdr maps1138))))))))
+ tmp1113)
+ ((lambda (tmp1140)
+ (if tmp1140
+ (apply
+ (lambda (x1142
+ y1141)
+ (call-with-values
+ (lambda ()
+ (gen-syntax1039
+ src1100
+ x1142
+ r1098
+ maps1097
+ ellipsis?1096
+ '#f))
+ (lambda (xnew1144
+ maps1143)
+ (call-with-values
+ (lambda ()
+ (gen-syntax1039
+ src1100
+ y1141
+ r1098
+ maps1143
+ ellipsis?1096
+ vec?1095))
+ (lambda (ynew1146
+ maps1145)
+ (values
+ (gen-cons1044
+ e1099
+ x1142
+ y1141
+ xnew1144
+ ynew1146)
+ maps1145))))))
+ tmp1140)
+ ((lambda (tmp1147)
+ (if tmp1147
+ (apply
+ (lambda (x11149
+ x21148)
+ ((lambda (ls1150)
+ (call-with-values
+ (lambda ()
+ (gen-syntax1039
+ src1100
+ ls1150
+ r1098
+ maps1097
+ ellipsis?1096
+ '#t))
+ (lambda (lsnew1152
+ maps1151)
+ (values
+ (gen-vector1045
+ e1099
+ ls1150
+ lsnew1152)
+ maps1151))))
+ (cons
+ x11149
+ x21148)))
+ tmp1147)
+ ((lambda (_1154)
+ (values
+ (list
+ 'quote
+ e1099)
+ maps1097))
+ tmp1106)))
+ ($syntax-dispatch
+ tmp1106
+ '#(vector
+ (any .
+ each-any))))))
+ ($syntax-dispatch
+ tmp1106
+ '(any .
+ any)))))
+ ($syntax-dispatch
+ tmp1106
+ '(any any
+ .
+ any)))))
+ ($syntax-dispatch
+ tmp1106
+ '(any any))))
+ e1099))))
+ (gen-ref1040 (lambda (src1090 var1089 level1088
+ maps1087)
+ (if (= level1088 '0)
+ (values var1089 maps1087)
+ (if (null? maps1087)
+ (syntax-error
+ src1090
+ '"missing ellipsis in syntax form")
+ (call-with-values
+ (lambda ()
+ (gen-ref1040
+ src1090
+ var1089
+ (- level1088 '1)
+ (cdr maps1087)))
+ (lambda (outer-var1092
+ outer-maps1091)
+ ((lambda (b1093)
+ (if b1093
+ (values
+ (cdr b1093)
+ maps1087)
+ ((lambda (inner-var1094)
+ (values
+ inner-var1094
+ (cons
+ (cons
+ (cons
+ outer-var1092
+ inner-var1094)
+ (car maps1087))
+ outer-maps1091)))
+ (gen-var523
+ 'tmp))))
+ (assq
+ outer-var1092
+ (car maps1087)))))))))
+ (gen-append1041 (lambda (x1086 y1085)
+ (if (equal? y1085 ''())
+ x1086
+ (list 'append x1086 y1085))))
+ (gen-mappend1042 (lambda (e1084 map-env1083)
+ (list
+ 'apply
+ '(primitive append)
+ (gen-map1043
+ e1084
+ map-env1083))))
+ (gen-map1043 (lambda (e1076 map-env1075)
+ ((lambda (formals1078 actuals1077)
+ (if (eq? (car e1076) 'ref)
+ (car actuals1077)
+ (if (andmap
+ (lambda (x1079)
+ (if (eq? (car x1079)
+ 'ref)
+ (memq
+ (cadr x1079)
+ formals1078)
+ '#f))
+ (cdr e1076))
+ (cons
+ 'map
+ (cons
+ (list
+ 'primitive
+ (car e1076))
+ (map ((lambda (r1080)
+ (lambda (x1081)
+ (cdr (assq
+ (cadr
+ x1081)
+ r1080))))
+ (map cons
+ formals1078
+ actuals1077))
+ (cdr e1076))))
+ (cons
+ 'map
+ (cons
+ (list
+ 'lambda
+ formals1078
+ e1076)
+ actuals1077)))))
+ (map cdr map-env1075)
+ (map (lambda (x1082)
+ (list 'ref (car x1082)))
+ map-env1075))))
+ (gen-cons1044 (lambda (e1071 x1070 y1069 xnew1068
+ ynew1067)
+ ((lambda (t1072)
+ (if (memv t1072 '(quote))
+ (if (eq? (car xnew1068) 'quote)
+ ((lambda (xnew1074
+ ynew1073)
+ (if (if (eq? xnew1074
+ x1070)
+ (eq? ynew1073
+ y1069)
+ '#f)
+ (list 'quote e1071)
+ (list
+ 'quote
+ (cons
+ xnew1074
+ ynew1073))))
+ (cadr xnew1068)
+ (cadr ynew1067))
+ (if (eq? (cadr ynew1067)
+ '())
+ (list 'list xnew1068)
+ (list
+ 'cons
+ xnew1068
+ ynew1067)))
+ (if (memv t1072 '(list))
+ (cons
+ 'list
+ (cons
+ xnew1068
+ (cdr ynew1067)))
+ (list
+ 'cons
+ xnew1068
+ ynew1067))))
+ (car ynew1067))))
+ (gen-vector1045 (lambda (e1066 ls1065 lsnew1064)
+ (if (eq? (car lsnew1064) 'quote)
+ (if (eq? (cadr lsnew1064)
+ ls1065)
+ (list 'quote e1066)
+ (list
+ 'quote
+ (list->vector
+ (cadr lsnew1064))))
+ (if (eq? (car lsnew1064) 'list)
+ (cons
+ 'vector
+ (cdr lsnew1064))
+ (list
+ 'list->vector
+ lsnew1064)))))
+ (regen1046 (lambda (x1061)
+ ((lambda (t1062)
+ (if (memv t1062 '(ref))
+ (cadr x1061)
+ (if (memv t1062 '(primitive))
+ (cadr x1061)
+ (if (memv t1062 '(quote))
+ (list 'quote (cadr x1061))
+ (if (memv t1062 '(lambda))
+ (list
+ 'lambda
+ (cadr x1061)
+ (regen1046
+ (caddr x1061)))
+ (if (memv
+ t1062
+ '(map))
+ ((lambda (ls1063)
+ (cons
+ (if (= (length
+ ls1063)
+ '2)
+ 'map
+ 'map)
+ ls1063))
+ (map regen1046
+ (cdr x1061)))
+ (cons
+ (car x1061)
+ (map regen1046
+ (cdr x1061)))))))))
+ (car x1061)))))
+ (lambda (e1052 r1051 mr1050 w1049 ae1048 m?1047)
+ ((lambda (e1053)
+ ((lambda (tmp1054)
+ ((lambda (tmp1055)
+ (if tmp1055
+ (apply
+ (lambda (_1057 x1056)
+ (call-with-values
+ (lambda ()
+ (gen-syntax1039 e1053 x1056 r1051 '()
+ ellipsis?519 '#f))
+ (lambda (e1059 maps1058)
+ (regen1046 e1059))))
+ tmp1055)
+ ((lambda (_1060) (syntax-error e1053))
+ tmp1054)))
+ ($syntax-dispatch tmp1054 '(any any))))
+ e1053))
+ (source-wrap444 e1052 w1049 ae1048)))))))
+ (global-extend304
+ 'core
+ 'lambda
+ (lambda (e1032 r1031 mr1030 w1029 ae1028 m?1027)
+ ((lambda (tmp1033)
+ ((lambda (tmp1034)
+ (if tmp1034
+ (apply
+ (lambda (_1036 c1035)
+ (call-with-values
+ (lambda ()
+ (chi-lambda-clause516
+ (source-wrap444 e1032 w1029 ae1028) c1035
+ r1031 mr1030 w1029 m?1027))
+ (lambda (vars1038 body1037)
+ (list 'lambda vars1038 body1037))))
+ tmp1034)
+ (syntax-error tmp1033)))
+ ($syntax-dispatch tmp1033 '(any . any))))
+ e1032)))
+ (global-extend304
+ 'core
+ 'letrec
+ (lambda (e1008 r1007 mr1006 w1005 ae1004 m?1003)
+ ((lambda (tmp1009)
+ ((lambda (tmp1010)
+ (if tmp1010
+ (apply
+ (lambda (_1015 id1014 val1013 e11012 e21011)
+ ((lambda (ids1016)
+ (if (not (valid-bound-ids?439 ids1016))
+ (invalid-ids-error441
+ (map (lambda (x1017)
+ (wrap443 x1017 w1005))
+ ids1016)
+ (source-wrap444 e1008 w1005 ae1004)
+ '"bound variable")
+ ((lambda (labels1019 new-vars1018)
+ ((lambda (w1021 r1020)
+ (build-letrec236
+ ae1004
+ new-vars1018
+ (map (lambda (x1024)
+ (chi498 x1024 r1020 mr1006
+ w1021 m?1003))
+ val1013)
+ (chi-body503 (cons e11012 e21011)
+ (source-wrap444
+ e1008
+ w1021
+ ae1004)
+ r1020 mr1006 w1021 m?1003)))
+ (make-binding-wrap417
+ ids1016
+ labels1019
+ w1005)
+ (extend-var-env*297
+ labels1019
+ new-vars1018
+ r1007)))
+ (gen-labels364 ids1016)
+ (map gen-var523 ids1016))))
+ id1014))
+ tmp1010)
+ ((lambda (_1026)
+ (syntax-error (source-wrap444 e1008 w1005 ae1004)))
+ tmp1009)))
+ ($syntax-dispatch
+ tmp1009
+ '(any #(each (any any)) any . each-any))))
+ e1008)))
+ (global-extend304
+ 'core
+ 'if
+ (lambda (e991 r990 mr989 w988 ae987 m?986)
+ ((lambda (tmp992)
+ ((lambda (tmp993)
+ (if tmp993
+ (apply
+ (lambda (_996 test995 then994)
+ (list
+ 'if
+ (chi498 test995 r990 mr989 w988 m?986)
+ (chi498 then994 r990 mr989 w988 m?986)
+ (chi-void518)))
+ tmp993)
+ ((lambda (tmp997)
+ (if tmp997
+ (apply
+ (lambda (_1001 test1000 then999 else998)
+ (list
+ 'if
+ (chi498 test1000 r990 mr989 w988 m?986)
+ (chi498 then999 r990 mr989 w988 m?986)
+ (chi498 else998 r990 mr989 w988 m?986)))
+ tmp997)
+ ((lambda (_1002)
+ (syntax-error
+ (source-wrap444 e991 w988 ae987)))
+ tmp992)))
+ ($syntax-dispatch tmp992 '(any any any any)))))
+ ($syntax-dispatch tmp992 '(any any any))))
+ e991)))
+ (global-extend304 'set! 'set! '())
+ (global-extend304 'alias 'alias '())
+ (global-extend304 'begin 'begin '())
+ (global-extend304 '$module-key '$module '())
+ (global-extend304 '$import '$import '())
+ (global-extend304 'define 'define '())
+ (global-extend304 'define-syntax 'define-syntax '())
+ (global-extend304 'eval-when 'eval-when '())
+ (global-extend304 'meta 'meta '())
+ (global-extend304
+ 'core
+ 'syntax-case
+ ((lambda ()
+ (letrec ((convert-pattern858 (lambda (pattern935 keys934)
+ (letrec ((cvt*936 (lambda (p*981
+ n980
+ ids979)
+ (if (null?
+ p*981)
+ (values
+ '()
+ ids979)
+ (call-with-values
+ (lambda ()
+ (cvt*936
+ (cdr p*981)
+ n980
+ ids979))
+ (lambda (y983
+ ids982)
+ (call-with-values
+ (lambda ()
+ (cvt937
+ (car p*981)
+ n980
+ ids982))
+ (lambda (x985
+ ids984)
+ (values
+ (cons
+ x985
+ y983)
+ ids984))))))))
+ (cvt937 (lambda (p940
+ n939
+ ids938)
+ (if (id?306
+ p940)
+ (if (bound-id-member?442
+ p940
+ keys934)
+ (values
+ (vector
+ 'free-id
+ p940)
+ ids938)
+ (values
+ 'any
+ (cons
+ (cons
+ p940
+ n939)
+ ids938)))
+ ((lambda (tmp941)
+ ((lambda (tmp942)
+ (if (if tmp942
+ (apply
+ (lambda (x944
+ dots943)
+ (ellipsis?519
+ dots943))
+ tmp942)
+ '#f)
+ (apply
+ (lambda (x946
+ dots945)
+ (call-with-values
+ (lambda ()
+ (cvt937
+ x946
+ (+ n939
+ '1)
+ ids938))
+ (lambda (p948
+ ids947)
+ (values
+ (if (eq? p948
+ 'any)
+ 'each-any
+ (vector
+ 'each
+ p948))
+ ids947))))
+ tmp942)
+ ((lambda (tmp949)
+ (if (if tmp949
+ (apply
+ (lambda (x953
+ dots952
+ y951
+ z950)
+ (ellipsis?519
+ dots952))
+ tmp949)
+ '#f)
+ (apply
+ (lambda (x957
+ dots956
+ y955
+ z954)
+ (call-with-values
+ (lambda ()
+ (cvt937
+ z954
+ n939
+ ids938))
+ (lambda (z959
+ ids958)
+ (call-with-values
+ (lambda ()
+ (cvt*936
+ y955
+ n939
+ ids958))
+ (lambda (y961
+ ids960)
+ (call-with-values
+ (lambda ()
+ (cvt937
+ x957
+ (+ n939
+ '1)
+ ids960))
+ (lambda (x963
+ ids962)
+ (values
+ (vector
+ 'each+
+ x963
+ (reverse
+ y961)
+ z959)
+ ids962))))))))
+ tmp949)
+ ((lambda (tmp965)
+ (if tmp965
+ (apply
+ (lambda (x967
+ y966)
+ (call-with-values
+ (lambda ()
+ (cvt937
+ y966
+ n939
+ ids938))
+ (lambda (y969
+ ids968)
+ (call-with-values
+ (lambda ()
+ (cvt937
+ x967
+ n939
+ ids968))
+ (lambda (x971
+ ids970)
+ (values
+ (cons
+ x971
+ y969)
+ ids970))))))
+ tmp965)
+ ((lambda (tmp972)
+ (if tmp972
+ (apply
+ (lambda ()
+ (values
+ '()
+ ids938))
+ tmp972)
+ ((lambda (tmp973)
+ (if tmp973
+ (apply
+ (lambda (x974)
+ (call-with-values
+ (lambda ()
+ (cvt937
+ x974
+ n939
+ ids938))
+ (lambda (p976
+ ids975)
+ (values
+ (vector
+ 'vector
+ p976)
+ ids975))))
+ tmp973)
+ ((lambda (x978)
+ (values
+ (vector
+ 'atom
+ (strip522
+ p940
+ '(())))
+ ids938))
+ tmp941)))
+ ($syntax-dispatch
+ tmp941
+ '#(vector
+ each-any)))))
+ ($syntax-dispatch
+ tmp941
+ '()))))
+ ($syntax-dispatch
+ tmp941
+ '(any .
+ any)))))
+ ($syntax-dispatch
+ tmp941
+ '(any any
+ .
+ #(each+
+ any
+ ()
+ any))))))
+ ($syntax-dispatch
+ tmp941
+ '(any any))))
+ p940)))))
+ (cvt937 pattern935 '0 '()))))
+ (build-dispatch-call859 (lambda (pvars927 exp926 y925
+ r924 mr923 m?922)
+ ((lambda (ids929 levels928)
+ ((lambda (labels931
+ new-vars930)
+ (cons
+ 'apply
+ (list
+ (list
+ 'lambda
+ new-vars930
+ (chi498 exp926
+ (extend-env*296
+ labels931
+ (map (lambda (var933
+ level932)
+ (cons
+ 'syntax
+ (cons
+ var933
+ level932)))
+ new-vars930
+ (map cdr
+ pvars927))
+ r924)
+ mr923
+ (make-binding-wrap417
+ ids929
+ labels931
+ '(()))
+ m?922))
+ y925)))
+ (gen-labels364 ids929)
+ (map gen-var523
+ ids929)))
+ (map car pvars927)
+ (map cdr pvars927))))
+ (gen-clause860 (lambda (x905 keys904 clauses903 r902
+ mr901 m?900 pat899 fender898
+ exp897)
+ (call-with-values
+ (lambda ()
+ (convert-pattern858
+ pat899
+ keys904))
+ (lambda (p907 pvars906)
+ (if (not (distinct-bound-ids?440
+ (map car pvars906)))
+ (invalid-ids-error441
+ (map car pvars906)
+ pat899
+ '"pattern variable")
+ (if (not (andmap
+ (lambda (x908)
+ (not (ellipsis?519
+ (car x908))))
+ pvars906))
+ (syntax-error
+ pat899
+ '"misplaced ellipsis in syntax-case pattern")
+ ((lambda (y909)
+ (cons
+ (list
+ 'lambda
+ (list y909)
+ (list
+ 'if
+ ((lambda (tmp919)
+ ((lambda (tmp920)
+ (if tmp920
+ (apply
+ (lambda ()
+ y909)
+ tmp920)
+ ((lambda (_921)
+ (list
+ 'if
+ y909
+ (build-dispatch-call859
+ pvars906
+ fender898
+ y909
+ r902
+ mr901
+ m?900)
+ (list
+ 'quote
+ '#f)))
+ tmp919)))
+ ($syntax-dispatch
+ tmp919
+ '#(atom
+ #t))))
+ fender898)
+ (build-dispatch-call859
+ pvars906
+ exp897 y909
+ r902 mr901
+ m?900)
+ (gen-syntax-case861
+ x905 keys904
+ clauses903
+ r902 mr901
+ m?900)))
+ (list
+ (if (eq? p907
+ 'any)
+ (cons
+ 'list
+ (list x905))
+ (cons
+ '$syntax-dispatch
+ (list
+ x905
+ (list
+ 'quote
+ p907)))))))
+ (gen-var523
+ 'tmp))))))))
+ (gen-syntax-case861 (lambda (x885 keys884 clauses883
+ r882 mr881 m?880)
+ (if (null? clauses883)
+ (cons
+ 'syntax-error
+ (list x885))
+ ((lambda (tmp886)
+ ((lambda (tmp887)
+ (if tmp887
+ (apply
+ (lambda (pat889
+ exp888)
+ (if (if (id?306
+ pat889)
+ (if (not (bound-id-member?442
+ pat889
+ keys884))
+ (not (ellipsis?519
+ pat889))
+ '#f)
+ '#f)
+ ((lambda (label891
+ var890)
+ (cons
+ (list
+ 'lambda
+ (list
+ var890)
+ (chi498
+ exp888
+ (extend-env295
+ label891
+ (cons
+ 'syntax
+ (cons
+ var890
+ '0))
+ r882)
+ mr881
+ (make-binding-wrap417
+ (list
+ pat889)
+ (list
+ label891)
+ '(()))
+ m?880))
+ (list
+ x885)))
+ (gen-label362)
+ (gen-var523
+ pat889))
+ (gen-clause860
+ x885
+ keys884
+ (cdr clauses883)
+ r882
+ mr881
+ m?880
+ pat889
+ '#t
+ exp888)))
+ tmp887)
+ ((lambda (tmp892)
+ (if tmp892
+ (apply
+ (lambda (pat895
+ fender894
+ exp893)
+ (gen-clause860
+ x885
+ keys884
+ (cdr clauses883)
+ r882
+ mr881
+ m?880
+ pat895
+ fender894
+ exp893))
+ tmp892)
+ ((lambda (_896)
+ (syntax-error
+ (car clauses883)
+ '"invalid syntax-case clause"))
+ tmp886)))
+ ($syntax-dispatch
+ tmp886
+ '(any any
+ any)))))
+ ($syntax-dispatch
+ tmp886
+ '(any any))))
+ (car clauses883))))))
+ (lambda (e867 r866 mr865 w864 ae863 m?862)
+ ((lambda (e868)
+ ((lambda (tmp869)
+ ((lambda (tmp870)
+ (if tmp870
+ (apply
+ (lambda (_874 val873 key872 m871)
+ (if (andmap
+ (lambda (x876)
+ (if (id?306 x876)
+ (not (ellipsis?519 x876))
+ '#f))
+ key872)
+ ((lambda (x877)
+ (cons
+ (list
+ 'lambda
+ (list x877)
+ (gen-syntax-case861 x877 key872
+ m871 r866 mr865 m?862))
+ (list
+ (chi498 val873 r866 mr865 '(())
+ m?862))))
+ (gen-var523 'tmp))
+ (syntax-error
+ e868
+ '"invalid literals list in")))
+ tmp870)
+ (syntax-error tmp869)))
+ ($syntax-dispatch
+ tmp869
+ '(any any each-any . each-any))))
+ e868))
+ (source-wrap444 e867 w864 ae863)))))))
+ (put-cte-hook137
+ 'module
+ (lambda (x827)
+ (letrec ((proper-export?828 (lambda (e851)
+ ((lambda (tmp852)
+ ((lambda (tmp853)
+ (if tmp853
+ (apply
+ (lambda (id855 e854)
+ (if (identifier?
+ id855)
+ (andmap
+ proper-export?828
+ e854)
+ '#f))
+ tmp853)
+ ((lambda (id857)
+ (identifier? id857))
+ tmp852)))
+ ($syntax-dispatch
+ tmp852
+ '(any . each-any))))
+ e851))))
+ ((lambda (tmp829)
+ ((lambda (orig830)
+ ((lambda (tmp831)
+ ((lambda (tmp832)
+ (if tmp832
+ (apply
+ (lambda (_835 e834 d833)
+ (if (andmap proper-export?828 e834)
+ (list
+ '#(syntax-object begin ((top) #(ribcage #(_ e d) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(orig) #((top)) #("i")) #(ribcage (proper-export?) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object noexpand let-values define-structure unless when) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) \ No newline at end of file
+ (cons
+ '#(syntax-object $module ((top) #(ribcage #(_ e d) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(orig) #((top)) #("i")) #(ribcage (proper-export?) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object noexpand let-values define-structure unless when) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (t\ No newline at end of file
+ (cons
+ orig830
+ (cons
+ '#(syntax-object anon ((top) #(ribcage #(_ e d) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(orig) #((top)) #("i")) #(ribcage (proper-export?) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object noexpand let-values define-structure unless when) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (\ No newline at end of file
+ (cons e834 d833))))
+ (cons
+ '#(syntax-object $import ((top) #(ribcage #(_ e d) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(orig) #((top)) #("i")) #(ribcage (proper-export?) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object noexpand let-values define-structure unless when) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (t\ No newline at end of file
+ (cons
+ orig830
+ '#(syntax-object (#f anon) ((top) #(ribcage #(_ e d) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(orig) #((top)) #("i")) #(ribcage (proper-export?) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object noexpand let-values define-structure unless when) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top\ No newline at end of file
+ (syntax-error
+ x827
+ '"invalid exports list in")))
+ tmp832)
+ ((lambda (tmp839)
+ (if (if tmp839
+ (apply
+ (lambda (_843 m842 e841 d840)
+ (identifier? m842))
+ tmp839)
+ '#f)
+ (apply
+ (lambda (_847 m846 e845 d844)
+ (if (andmap proper-export?828 e845)
+ (cons
+ '#(syntax-object $module ((top) #(ribcage #(_ m e d) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage #(orig) #((top)) #("i")) #(ribcage (proper-export?) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object noexpand let-values define-structure unless when) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (to\ No newline at end of file
+ (cons
+ orig830
+ (cons
+ m846
+ (cons e845 d844))))
+ (syntax-error
+ x827
+ '"invalid exports list in")))
+ tmp839)
+ (syntax-error tmp831)))
+ ($syntax-dispatch
+ tmp831
+ '(any any each-any . each-any)))))
+ ($syntax-dispatch
+ tmp831
+ '(any each-any . each-any))))
+ x827))
+ tmp829))
+ x827))))
+ ((lambda ()
+ (letrec (($module-exports628 (lambda (m819 r818)
+ ((lambda (b820)
+ ((lambda (t821)
+ (if (memv t821 '($module))
+ ((lambda (interface822)
+ ((lambda (new-marks823)
+ ((lambda ()
+ (vmap487
+ (lambda (x824)
+ ((lambda (id825)
+ (make-syntax-object63
+ (syntax-object->datum
+ id825)
+ ((lambda (marks826)
+ (make-wrap315
+ marks826
+ (if (eq? (car marks826)
+ '#f)
+ (cons
+ 'shift
+ (wrap-subst317
+ '((top))))
+ (wrap-subst317
+ '((top))))))
+ (join-marks423
+ new-marks823
+ (wrap-marks316
+ (syntax-object-wrap66
+ id825))))))
+ (if (pair?
+ x824)
+ (car x824)
+ x824)))
+ (interface-exports454
+ interface822)))))
+ (import-mark-delta505
+ m819
+ interface822)))
+ (binding-value282
+ b820))
+ (if (memv
+ t821
+ '(displaced-lexical))
+ (displaced-lexical-error299
+ m819)
+ (syntax-error
+ m819
+ '"unknown module"))))
+ (binding-type281 b820)))
+ (r818 m819))))
+ ($import-help629 (lambda (orig633 import-only?632)
+ (lambda (r634)
+ (letrec ((difference635 (lambda (ls1817
+ ls2816)
+ (if (null?
+ ls1817)
+ ls1817
+ (if (bound-id-member?442
+ (car ls1817)
+ ls2816)
+ (difference635
+ (cdr ls1817)
+ ls2816)
+ (cons
+ (car ls1817)
+ (difference635
+ (cdr ls1817)
+ ls2816))))))
+ (prefix-add636 (lambda (prefix-id813)
+ ((lambda (prefix814)
+ (lambda (id815)
+ (datum->syntax-object
+ id815
+ (string->symbol
+ (string-append
+ prefix814
+ (symbol->string
+ (syntax-object->datum
+ id815)))))))
+ (symbol->string
+ (syntax-object->datum
+ prefix-id813)))))
+ (prefix-drop637 (lambda (prefix-id807)
+ ((lambda (prefix808)
+ (lambda (id809)
+ ((lambda (s810)
+ ((lambda (np812
+ ns811)
+ (begin
+ (if (not (if (>= ns811
+ np812)
+ (string=?
+ (substring
+ s810
+ '0
+ np812)
+ prefix808)
+ '#f))
+ (syntax-error
+ id809
+ (string-append
+ '"missing expected prefix "
+ prefix808))
+ (void))
+ (datum->syntax-object
+ id809
+ (string->symbol
+ (substring
+ s810
+ np812
+ ns811)))))
+ (string-length
+ prefix808)
+ (string-length
+ s810)))
+ (symbol->string
+ (syntax-object->datum
+ id809)))))
+ (symbol->string
+ (syntax-object->datum
+ prefix-id807)))))
+ (gen-mid638 (lambda (mid804)
+ (datum->syntax-object
+ mid804
+ (generate-id143
+ ((lambda (x805)
+ ((lambda (e806)
+ (if (annotation?132
+ e806)
+ (annotation-expression
+ e806)
+ e806))
+ (if (syntax-object?64
+ x805)
+ (syntax-object-expression65
+ x805)
+ x805)))
+ mid804)))))
+ (modspec639 (lambda (m655
+ exports?654)
+ ((lambda (tmp656)
+ ((lambda (tmp657)
+ (if tmp657
+ (apply
+ (lambda (orig659
+ import-only?658)
+ ((lambda (tmp660)
+ ((lambda (tmp661)
+ (if (if tmp661
+ (apply
+ (lambda (m663
+ id662)
+ (andmap
+ identifier?
+ id662))
+ tmp661)
+ '#f)
+ (apply
+ (lambda (m666
+ id665)
+ (call-with-values
+ (lambda ()
+ (modspec639
+ m666
+ '#f))
+ (lambda (mid669
+ d668
+ exports667)
+ ((lambda (tmp670)
+ ((lambda (tmp671)
+ (if tmp671
+ (apply
+ (lambda (d673
+ tmid672)
+ (values
+ mid669
+ (list
+ '#(syntax-object begin ((top) #(ribcage #(d tmid) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m id) #((top) (top)) #("i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-bindin\ No newline at end of file
+ (list
+ '#(syntax-object $module ((top) #(ribcage #(d tmid) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m id) #((top) (top)) #("i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-bi\ No newline at end of file
+ orig659
+ tmid672
+ id665
+ d673)
+ (list
+ '#(syntax-object $import ((top) #(ribcage #(d tmid) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m id) #((top) (top)) #("i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-bi\ No newline at end of file
+ orig659
+ import-only?658
+ tmid672))
+ (if exports?654
+ id665
+ '#f)))
+ tmp671)
+ (syntax-error
+ tmp670)))
+ ($syntax-dispatch
+ tmp670
+ '(any any))))
+ (list
+ d668
+ (gen-mid638
+ mid669))))))
+ tmp661)
+ ((lambda (tmp676)
+ (if (if tmp676
+ (apply
+ (lambda (m678
+ id677)
+ (andmap
+ identifier?
+ id677))
+ tmp676)
+ '#f)
+ (apply
+ (lambda (m681
+ id680)
+ (call-with-values
+ (lambda ()
+ (modspec639
+ m681
+ '#t))
+ (lambda (mid684
+ d683
+ exports682)
+ ((lambda (tmp685)
+ ((lambda (tmp687)
+ (if tmp687
+ (apply
+ (lambda (d690
+ tmid689
+ id688)
+ (values
+ mid684
+ (list
+ '#(syntax-object begin ((top) #(ribcage #(d tmid id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m id) #((top) (top)) #("i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-bindin\ No newline at end of file
+ (list
+ '#(syntax-object $module ((top) #(ribcage #(d tmid id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m id) #((top) (top)) #("i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-bi\ No newline at end of file
+ orig659
+ tmid689
+ id688
+ d690)
+ (list
+ '#(syntax-object $import ((top) #(ribcage #(d tmid id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m id) #((top) (top)) #("i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-bi\ No newline at end of file
+ orig659
+ import-only?658
+ tmid689))
+ (if exports?654
+ id688
+ '#f)))
+ tmp687)
+ (syntax-error
+ tmp685)))
+ ($syntax-dispatch
+ tmp685
+ '(any any
+ each-any))))
+ (list
+ d683
+ (gen-mid638
+ mid684)
+ (difference635
+ exports682
+ id680))))))
+ tmp676)
+ ((lambda (tmp693)
+ (if (if tmp693
+ (apply
+ (lambda (m695
+ prefix-id694)
+ (identifier?
+ prefix-id694))
+ tmp693)
+ '#f)
+ (apply
+ (lambda (m697
+ prefix-id696)
+ (call-with-values
+ (lambda ()
+ (modspec639
+ m697
+ '#t))
+ (lambda (mid700
+ d699
+ exports698)
+ ((lambda (tmp701)
+ ((lambda (tmp702)
+ (if tmp702
+ (apply
+ (lambda (d707
+ tmid706
+ old-id705
+ tmp704
+ id703)
+ (values
+ mid700
+ (list
+ '#(syntax-object begin ((top) #(ribcage #(d tmid old-id tmp id) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m prefix-id) #((top) (top)) #("i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build\ No newline at end of file
+ (cons
+ '#(syntax-object $module ((top) #(ribcage #(d tmid old-id tmp id) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m prefix-id) #((top) (top)) #("i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional b\ No newline at end of file
+ (cons
+ orig659
+ (cons
+ tmid706
+ (cons
+ (map list
+ id703
+ tmp704)
+ (cons
+ (cons
+ '#(syntax-object $module ((top) #(ribcage #(d tmid old-id tmp id) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m prefix-id) #((top) (top)) #("i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-con\ No newline at end of file
+ (cons
+ orig659
+ (cons
+ tmid706
+ (cons
+ (map list
+ tmp704
+ old-id705)
+ (cons
+ d707
+ (map (lambda (tmp714
+ tmp713)
+ (list
+ '#(syntax-object alias ((top) #(ribcage #(d tmid old-id tmp id) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m prefix-id) #((top) (top)) #("i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-refe\ No newline at end of file
+ tmp713
+ tmp714))
+ old-id705
+ tmp704))))))
+ (cons
+ (list
+ '#(syntax-object $import ((top) #(ribcage #(d tmid old-id tmp id) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m prefix-id) #((top) (top)) #("i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-c\ No newline at end of file
+ orig659
+ import-only?658
+ tmid706)
+ (map (lambda (tmp716
+ tmp715)
+ (list
+ '#(syntax-object alias ((top) #(ribcage #(d tmid old-id tmp id) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m prefix-id) #((top) (top)) #("i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference bu\ No newline at end of file
+ tmp715
+ tmp716))
+ tmp704
+ id703)))))))
+ (list
+ '#(syntax-object $import ((top) #(ribcage #(d tmid old-id tmp id) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m prefix-id) #((top) (top)) #("i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional b\ No newline at end of file
+ orig659
+ import-only?658
+ tmid706))
+ (if exports?654
+ id703
+ '#f)))
+ tmp702)
+ (syntax-error
+ tmp701)))
+ ($syntax-dispatch
+ tmp701
+ '(any any
+ each-any
+ each-any
+ each-any))))
+ (list
+ d699
+ (gen-mid638
+ mid700)
+ exports698
+ (generate-temporaries
+ exports698)
+ (map (prefix-add636
+ prefix-id696)
+ exports698))))))
+ tmp693)
+ ((lambda (tmp717)
+ (if (if tmp717
+ (apply
+ (lambda (m719
+ prefix-id718)
+ (identifier?
+ prefix-id718))
+ tmp717)
+ '#f)
+ (apply
+ (lambda (m721
+ prefix-id720)
+ (call-with-values
+ (lambda ()
+ (modspec639
+ m721
+ '#t))
+ (lambda (mid724
+ d723
+ exports722)
+ ((lambda (tmp725)
+ ((lambda (tmp726)
+ (if tmp726
+ (apply
+ (lambda (d731
+ tmid730
+ old-id729
+ tmp728
+ id727)
+ (values
+ mid724
+ (list
+ '#(syntax-object begin ((top) #(ribcage #(d tmid old-id tmp id) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m prefix-id) #((top) (top)) #("i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditiona\ No newline at end of file
+ (cons
+ '#(syntax-object $module ((top) #(ribcage #(d tmid old-id tmp id) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m prefix-id) #((top) (top)) #("i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-condit\ No newline at end of file
+ (cons
+ orig659
+ (cons
+ tmid730
+ (cons
+ (map list
+ id727
+ tmp728)
+ (cons
+ (cons
+ '#(syntax-object $module ((top) #(ribcage #(d tmid old-id tmp id) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m prefix-id) #((top) (top)) #("i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference bu\ No newline at end of file
+ (cons
+ orig659
+ (cons
+ tmid730
+ (cons
+ (map list
+ tmp728
+ old-id729)
+ (cons
+ d731
+ (map (lambda (tmp738
+ tmp737)
+ (list
+ '#(syntax-object alias ((top) #(ribcage #(d tmid old-id tmp id) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m prefix-id) #((top) (top)) #("i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexic\ No newline at end of file
+ tmp737
+ tmp738))
+ old-id729
+ tmp728))))))
+ (cons
+ (list
+ '#(syntax-object $import ((top) #(ribcage #(d tmid old-id tmp id) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m prefix-id) #((top) (top)) #("i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference \ No newline at end of file
+ orig659
+ import-only?658
+ tmid730)
+ (map (lambda (tmp740
+ tmp739)
+ (list
+ '#(syntax-object alias ((top) #(ribcage #(d tmid old-id tmp id) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m prefix-id) #((top) (top)) #("i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-refer\ No newline at end of file
+ tmp739
+ tmp740))
+ tmp728
+ id727)))))))
+ (list
+ '#(syntax-object $import ((top) #(ribcage #(d tmid old-id tmp id) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m prefix-id) #((top) (top)) #("i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-condit\ No newline at end of file
+ orig659
+ import-only?658
+ tmid730))
+ (if exports?654
+ id727
+ '#f)))
+ tmp726)
+ (syntax-error
+ tmp725)))
+ ($syntax-dispatch
+ tmp725
+ '(any any
+ each-any
+ each-any
+ each-any))))
+ (list
+ d723
+ (gen-mid638
+ mid724)
+ exports722
+ (generate-temporaries
+ exports722)
+ (map (prefix-drop637
+ prefix-id720)
+ exports722))))))
+ tmp717)
+ ((lambda (tmp741)
+ (if (if tmp741
+ (apply
+ (lambda (m744
+ new-id743
+ old-id742)
+ (if (andmap
+ identifier?
+ new-id743)
+ (andmap
+ identifier?
+ old-id742)
+ '#f))
+ tmp741)
+ '#f)
+ (apply
+ (lambda (m749
+ new-id748
+ old-id747)
+ (call-with-values
+ (lambda ()
+ (modspec639
+ m749
+ '#t))
+ (lambda (mid752
+ d751
+ exports750)
+ ((lambda (tmp753)
+ ((lambda (tmp756)
+ (if tmp756
+ (apply
+ (lambda (d760
+ tmid759
+ tmp758
+ other-id757)
+ (values
+ mid752
+ (list
+ '#(syntax-object begin ((top) #(ribcage #(d tmid tmp other-id) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m new-id old-id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-\ No newline at end of file
+ (cons
+ '#(syntax-object $module ((top) #(ribcage #(d tmid tmp other-id) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m new-id old-id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference bu\ No newline at end of file
+ (cons
+ orig659
+ (cons
+ tmid759
+ (cons
+ (append
+ (map list
+ new-id748
+ tmp758)
+ other-id757)
+ (cons
+ (cons
+ '#(syntax-object $module ((top) #(ribcage #(d tmid tmp other-id) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m new-id old-id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-re\ No newline at end of file
+ (cons
+ orig659
+ (cons
+ tmid759
+ (cons
+ (append
+ other-id757
+ (map list
+ tmp758
+ old-id747))
+ (cons
+ d760
+ (map (lambda (tmp770
+ tmp769)
+ (list
+ '#(syntax-object alias ((top) #(ribcage #(d tmid tmp other-id) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m new-id old-id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment b\ No newline at end of file
+ tmp769
+ tmp770))
+ old-id747
+ tmp758))))))
+ (cons
+ (list
+ '#(syntax-object $import ((top) #(ribcage #(d tmid tmp other-id) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m new-id old-id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-\ No newline at end of file
+ orig659
+ import-only?658
+ tmid759)
+ (map (lambda (tmp772
+ tmp771)
+ (list
+ '#(syntax-object alias ((top) #(ribcage #(d tmid tmp other-id) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m new-id old-id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lex\ No newline at end of file
+ tmp771
+ tmp772))
+ tmp758
+ new-id748)))))))
+ (list
+ '#(syntax-object $import ((top) #(ribcage #(d tmid tmp other-id) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m new-id old-id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference bu\ No newline at end of file
+ orig659
+ import-only?658
+ tmid759))
+ (if exports?654
+ (append
+ new-id748
+ other-id757)
+ '#f)))
+ tmp756)
+ (syntax-error
+ tmp753)))
+ ($syntax-dispatch
+ tmp753
+ '(any any
+ each-any
+ each-any))))
+ (list
+ d751
+ (gen-mid638
+ mid752)
+ (generate-temporaries
+ old-id747)
+ (difference635
+ exports750
+ old-id747))))))
+ tmp741)
+ ((lambda (tmp773)
+ (if (if tmp773
+ (apply
+ (lambda (m776
+ new-id775
+ old-id774)
+ (if (andmap
+ identifier?
+ new-id775)
+ (andmap
+ identifier?
+ old-id774)
+ '#f))
+ tmp773)
+ '#f)
+ (apply
+ (lambda (m781
+ new-id780
+ old-id779)
+ (call-with-values
+ (lambda ()
+ (modspec639
+ m781
+ '#t))
+ (lambda (mid784
+ d783
+ exports782)
+ ((lambda (tmp785)
+ ((lambda (tmp786)
+ (if tmp786
+ (apply
+ (lambda (d789
+ tmid788
+ other-id787)
+ (values
+ mid784
+ (list
+ '#(syntax-object begin ((top) #(ribcage #(d tmid other-id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m new-id old-id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditi\ No newline at end of file
+ (cons
+ '#(syntax-object $module ((top) #(ribcage #(d tmid other-id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m new-id old-id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-con\ No newline at end of file
+ (cons
+ orig659
+ (cons
+ tmid788
+ (cons
+ (append
+ (map list
+ new-id780
+ old-id779)
+ other-id787)
+ (cons
+ d789
+ (map (lambda (tmp796
+ tmp795)
+ (list
+ '#(syntax-object alias ((top) #(ribcage #(d tmid other-id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m new-id old-id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-refe\ No newline at end of file
+ tmp795
+ tmp796))
+ old-id779
+ new-id780))))))
+ (list
+ '#(syntax-object $import ((top) #(ribcage #(d tmid other-id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(mid d exports) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(m new-id old-id) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-con\ No newline at end of file
+ orig659
+ import-only?658
+ tmid788))
+ (if exports?654
+ (append
+ new-id780
+ other-id787)
+ '#f)))
+ tmp786)
+ (syntax-error
+ tmp785)))
+ ($syntax-dispatch
+ tmp785
+ '(any any
+ each-any))))
+ (list
+ d783
+ (gen-mid638
+ mid784)
+ exports782)))))
+ tmp773)
+ ((lambda (tmp797)
+ (if (if tmp797
+ (apply
+ (lambda (mid798)
+ (identifier?
+ mid798))
+ tmp797)
+ '#f)
+ (apply
+ (lambda (mid799)
+ (values
+ mid799
+ (list
+ '#(syntax-object $import ((top) #(ribcage #(mid) #((top)) #("i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-\ No newline at end of file
+ orig659
+ import-only?658
+ mid799)
+ (if exports?654
+ ($module-exports628
+ mid799
+ r634)
+ '#f)))
+ tmp797)
+ ((lambda (tmp800)
+ (if (if tmp800
+ (apply
+ (lambda (mid801)
+ (identifier?
+ mid801))
+ tmp800)
+ '#f)
+ (apply
+ (lambda (mid802)
+ (values
+ mid802
+ (list
+ '#(syntax-object $import ((top) #(ribcage #(mid) #((top)) #("i")) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top\ No newline at end of file
+ orig659
+ import-only?658
+ mid802)
+ (if exports?654
+ ($module-exports628
+ mid802
+ r634)
+ '#f)))
+ tmp800)
+ ((lambda (_803)
+ (syntax-error
+ m655
+ '"invalid module specifier"))
+ tmp660)))
+ ($syntax-dispatch
+ tmp660
+ '(any)))))
+ (list
+ tmp660))))
+ ($syntax-dispatch
+ tmp660
+ '(#(free-id
+ #(syntax-object alias ((top) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook anno\ No newline at end of file
+ any
+ .
+ #(each
+ (any any)))))))
+ ($syntax-dispatch
+ tmp660
+ '(#(free-id
+ #(syntax-object rename ((top) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation\ No newline at end of file
+ any
+ .
+ #(each
+ (any any)))))))
+ ($syntax-dispatch
+ tmp660
+ '(#(free-id
+ #(syntax-object drop-prefix ((top) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? \ No newline at end of file
+ any
+ any)))))
+ ($syntax-dispatch
+ tmp660
+ '(#(free-id
+ #(syntax-object add-prefix ((top) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<\ No newline at end of file
+ any
+ any)))))
+ ($syntax-dispatch
+ tmp660
+ '(#(free-id
+ #(syntax-object except ((top) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< f\ No newline at end of file
+ any
+ .
+ each-any)))))
+ ($syntax-dispatch
+ tmp660
+ '(#(free-id
+ #(syntax-object only ((top) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(m exports?) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx\ No newline at end of file
+ any
+ .
+ each-any))))
+ m655))
+ tmp657)
+ (syntax-error
+ tmp656)))
+ ($syntax-dispatch
+ tmp656
+ '(any any))))
+ (list
+ orig633
+ import-only?632))))
+ (modspec*640 (lambda (m650)
+ (call-with-values
+ (lambda ()
+ (modspec639
+ m650
+ '#f))
+ (lambda (mid653
+ d652
+ exports651)
+ d652)))))
+ ((lambda (tmp641)
+ ((lambda (tmp642)
+ (if tmp642
+ (apply
+ (lambda (_644 m643)
+ ((lambda (tmp645)
+ ((lambda (tmp647)
+ (if tmp647
+ (apply
+ (lambda (d648)
+ (cons
+ '#(syntax-object begin ((top) #(ribcage #(d) #((top)) #("i")) #(ribcage #(_ m) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-obje\ No newline at end of file
+ d648))
+ tmp647)
+ (syntax-error
+ tmp645)))
+ ($syntax-dispatch
+ tmp645
+ 'each-any)))
+ (map modspec*640
+ m643)))
+ tmp642)
+ (syntax-error tmp641)))
+ ($syntax-dispatch
+ tmp641
+ '(any . each-any))))
+ orig633))))))
+ (begin
+ (put-cte-hook137
+ 'import
+ (lambda (orig631) ($import-help629 orig631 '#f)))
+ (put-cte-hook137
+ 'import-only
+ (lambda (orig630) ($import-help629 orig630 '#t)))))))
+ (set! sc-expand
+ ((lambda (ctem625 rtem624)
+ (lambda (x626)
+ ((lambda (env627)
+ (if (if (pair? x626) (equal? (car x626) noexpand62) '#f)
+ (cadr x626)
+ (chi-top*447 x626 '() (env-wrap388 env627) ctem625
+ rtem624 '#f (env-top-ribcage387 env627))))
+ (interaction-environment))))
+ '(e)
+ '(e)))
+ (set! $make-environment
+ (lambda (token622 mutable?621)
+ ((lambda (top-ribcage623)
+ (make-env385
+ top-ribcage623
+ (make-wrap315
+ (wrap-marks316 '((top)))
+ (cons top-ribcage623 (wrap-subst317 '((top)))))))
+ (make-top-ribcage373 token622 mutable?621))))
+ (set! environment? (lambda (x620) (env?386 x620)))
+ (set! interaction-environment
+ ((lambda (e619) (lambda () e619))
+ ($make-environment '*top* '#t)))
+ (set! identifier? (lambda (x618) (nonsymbol-id?305 x618)))
+ (set! datum->syntax-object
+ (lambda (id616 datum615)
+ (begin
+ ((lambda (x617)
+ (if (not (nonsymbol-id?305 x617))
+ (error-hook136
+ 'datum->syntax-object
+ '"invalid argument"
+ x617)
+ (void)))
+ id616)
+ (make-syntax-object63
+ datum615
+ (syntax-object-wrap66 id616)))))
+ (set! syntax->list
+ (lambda (orig-ls606)
+ ((letrec ((f607 (lambda (ls608)
+ ((lambda (tmp609)
+ ((lambda (tmp610)
+ (if tmp610
+ (apply (lambda () '()) tmp610)
+ ((lambda (tmp611)
+ (if tmp611
+ (apply
+ (lambda (x613 r612)
+ (cons x613 (f607 r612)))
+ tmp611)
+ ((lambda (_614)
+ (error 'syntax->list
+ '"invalid argument ~s"
+ orig-ls606))
+ tmp609)))
+ ($syntax-dispatch
+ tmp609
+ '(any . any)))))
+ ($syntax-dispatch tmp609 '())))
+ ls608))))
+ f607)
+ orig-ls606)))
+ (set! syntax->vector
+ (lambda (v600)
+ ((lambda (tmp601)
+ ((lambda (tmp602)
+ (if tmp602
+ (apply
+ (lambda (x603) (apply vector (syntax->list x603)))
+ tmp602)
+ ((lambda (_605)
+ (error 'syntax->vector
+ '"invalid argument ~s"
+ v600))
+ tmp601)))
+ ($syntax-dispatch tmp601 '#(vector each-any))))
+ v600)))
+ (set! syntax-object->datum
+ (lambda (x599) (strip522 x599 '(()))))
+ (set! generate-temporaries
+ ((lambda (n595)
+ (lambda (ls596)
+ (begin
+ ((lambda (x598)
+ (if (not (list? x598))
+ (error-hook136
+ 'generate-temporaries
+ '"invalid argument"
+ x598)
+ (void)))
+ ls596)
+ (map (lambda (x597)
+ (begin
+ (set! n595 (+ n595 '1))
+ (wrap443
+ (string->symbol
+ (string-append '"t" (number->string n595)))
+ '((tmp)))))
+ ls596))))
+ '0))
+ (set! free-identifier=?
+ (lambda (x592 y591)
+ (begin
+ ((lambda (x594)
+ (if (not (nonsymbol-id?305 x594))
+ (error-hook136
+ 'free-identifier=?
+ '"invalid argument"
+ x594)
+ (void)))
+ x592)
+ ((lambda (x593)
+ (if (not (nonsymbol-id?305 x593))
+ (error-hook136
+ 'free-identifier=?
+ '"invalid argument"
+ x593)
+ (void)))
+ y591)
+ (free-id=?435 x592 y591))))
+ (set! bound-identifier=?
+ (lambda (x588 y587)
+ (begin
+ ((lambda (x590)
+ (if (not (nonsymbol-id?305 x590))
+ (error-hook136
+ 'bound-identifier=?
+ '"invalid argument"
+ x590)
+ (void)))
+ x588)
+ ((lambda (x589)
+ (if (not (nonsymbol-id?305 x589))
+ (error-hook136
+ 'bound-identifier=?
+ '"invalid argument"
+ x589)
+ (void)))
+ y587)
+ (bound-id=?438 x588 y587))))
+ (set! literal-identifier=?
+ (lambda (x584 y583)
+ (begin
+ ((lambda (x586)
+ (if (not (nonsymbol-id?305 x586))
+ (error-hook136
+ 'literal-identifier=?
+ '"invalid argument"
+ x586)
+ (void)))
+ x584)
+ ((lambda (x585)
+ (if (not (nonsymbol-id?305 x585))
+ (error-hook136
+ 'literal-identifier=?
+ '"invalid argument"
+ x585)
+ (void)))
+ y583)
+ (literal-id=?436 x584 y583))))
+ (set! syntax-error
+ (lambda (object578 . messages579)
+ (begin
+ (for-each
+ (lambda (x581)
+ ((lambda (x582)
+ (if (not (string? x582))
+ (error-hook136
+ 'syntax-error
+ '"invalid argument"
+ x582)
+ (void)))
+ x581))
+ messages579)
+ ((lambda (message580)
+ (error-hook136 '#f message580 (strip522 object578 '(()))))
+ (if (null? messages579)
+ '"invalid syntax"
+ (apply string-append messages579))))))
+ ((lambda ()
+ (letrec ((match-each525 (lambda (e575 p574 w573)
+ (if (annotation?132 e575)
+ (match-each525
+ (annotation-expression e575)
+ p574
+ w573)
+ (if (pair? e575)
+ ((lambda (first576)
+ (if first576
+ ((lambda (rest577)
+ (if rest577
+ (cons
+ first576
+ rest577)
+ '#f))
+ (match-each525
+ (cdr e575)
+ p574
+ w573))
+ '#f))
+ (match531
+ (car e575)
+ p574
+ w573
+ '()))
+ (if (null? e575)
+ '()
+ (if (syntax-object?64 e575)
+ (match-each525
+ (syntax-object-expression65
+ e575)
+ p574
+ (join-wraps422
+ w573
+ (syntax-object-wrap66
+ e575)))
+ '#f))))))
+ (match-each+526 (lambda (e565 x-pat564 y-pat563 z-pat562
+ w561 r560)
+ ((letrec ((f566 (lambda (e568 w567)
+ (if (pair? e568)
+ (call-with-values
+ (lambda ()
+ (f566
+ (cdr e568)
+ w567))
+ (lambda (xr*571
+ y-pat570
+ r569)
+ (if r569
+ (if (null?
+ y-pat570)
+ ((lambda (xr572)
+ (if xr572
+ (values
+ (cons
+ xr572
+ xr*571)
+ y-pat570
+ r569)
+ (values
+ '#f
+ '#f
+ '#f)))
+ (match531
+ (car e568)
+ x-pat564
+ w567
+ '()))
+ (values
+ '()
+ (cdr y-pat570)
+ (match531
+ (car e568)
+ (car y-pat570)
+ w567
+ r569)))
+ (values
+ '#f
+ '#f
+ '#f))))
+ (if (annotation?132
+ e568)
+ (f566
+ (annotation-expression
+ e568)
+ w567)
+ (if (syntax-object?64
+ e568)
+ (f566
+ (syntax-object-expression65
+ e568)
+ (join-wraps422
+ w567
+ (syntax-object-wrap66
+ e568)))
+ (values
+ '()
+ y-pat563
+ (match531
+ e568
+ z-pat562
+ w567
+ r560))))))))
+ f566)
+ e565
+ w561)))
+ (match-each-any527 (lambda (e558 w557)
+ (if (annotation?132 e558)
+ (match-each-any527
+ (annotation-expression e558)
+ w557)
+ (if (pair? e558)
+ ((lambda (l559)
+ (if l559
+ (cons
+ (wrap443
+ (car e558)
+ w557)
+ l559)
+ '#f))
+ (match-each-any527
+ (cdr e558)
+ w557))
+ (if (null? e558)
+ '()
+ (if (syntax-object?64
+ e558)
+ (match-each-any527
+ (syntax-object-expression65
+ e558)
+ (join-wraps422
+ w557
+ (syntax-object-wrap66
+ e558)))
+ '#f))))))
+ (match-empty528 (lambda (p555 r554)
+ (if (null? p555)
+ r554
+ (if (eq? p555 'any)
+ (cons '() r554)
+ (if (pair? p555)
+ (match-empty528
+ (car p555)
+ (match-empty528
+ (cdr p555)
+ r554))
+ (if (eq? p555 'each-any)
+ (cons '() r554)
+ ((lambda (t556)
+ (if (memv
+ t556
+ '(each))
+ (match-empty528
+ (vector-ref
+ p555
+ '1)
+ r554)
+ (if (memv
+ t556
+ '(each+))
+ (match-empty528
+ (vector-ref
+ p555
+ '1)
+ (match-empty528
+ (reverse
+ (vector-ref
+ p555
+ '2))
+ (match-empty528
+ (vector-ref
+ p555
+ '3)
+ r554)))
+ (if (memv
+ t556
+ '(free-id
+ atom))
+ r554
+ (if (memv
+ t556
+ '(vector))
+ (match-empty528
+ (vector-ref
+ p555
+ '1)
+ r554)
+ (void))))))
+ (vector-ref
+ p555
+ '0))))))))
+ (combine529 (lambda (r*553 r552)
+ (if (null? (car r*553))
+ r552
+ (cons
+ (map car r*553)
+ (combine529
+ (map cdr r*553)
+ r552)))))
+ (match*530 (lambda (e545 p544 w543 r542)
+ (if (null? p544)
+ (if (null? e545) r542 '#f)
+ (if (pair? p544)
+ (if (pair? e545)
+ (match531
+ (car e545)
+ (car p544)
+ w543
+ (match531
+ (cdr e545)
+ (cdr p544)
+ w543
+ r542))
+ '#f)
+ (if (eq? p544 'each-any)
+ ((lambda (l546)
+ (if l546
+ (cons l546 r542)
+ '#f))
+ (match-each-any527
+ e545
+ w543))
+ ((lambda (t547)
+ (if (memv t547 '(each))
+ (if (null? e545)
+ (match-empty528
+ (vector-ref
+ p544
+ '1)
+ r542)
+ ((lambda (r*548)
+ (if r*548
+ (combine529
+ r*548
+ r542)
+ '#f))
+ (match-each525
+ e545
+ (vector-ref
+ p544
+ '1)
+ w543)))
+ (if (memv
+ t547
+ '(free-id))
+ (if (id?306 e545)
+ (if (literal-id=?436
+ (wrap443
+ e545
+ w543)
+ (vector-ref
+ p544
+ '1))
+ r542
+ '#f)
+ '#f)
+ (if (memv
+ t547
+ '(each+))
+ (call-with-values
+ (lambda ()
+ (match-each+526
+ e545
+ (vector-ref
+ p544
+ '1)
+ (vector-ref
+ p544
+ '2)
+ (vector-ref
+ p544
+ '3)
+ w543
+ r542))
+ (lambda (xr*551
+ y-pat550
+ r549)
+ (if r549
+ (if (null?
+ y-pat550)
+ (if (null?
+ xr*551)
+ (match-empty528
+ (vector-ref
+ p544
+ '1)
+ r549)
+ (combine529
+ xr*551
+ r549))
+ '#f)
+ '#f)))
+ (if (memv
+ t547
+ '(atom))
+ (if (equal?
+ (vector-ref
+ p544
+ '1)
+ (strip522
+ e545
+ w543))
+ r542
+ '#f)
+ (if (memv
+ t547
+ '(vector))
+ (if (vector?
+ e545)
+ (match531
+ (vector->list
+ e545)
+ (vector-ref
+ p544
+ '1)
+ w543
+ r542)
+ '#f)
+ (void)))))))
+ (vector-ref p544 '0)))))))
+ (match531 (lambda (e539 p538 w537 r536)
+ (if (not r536)
+ '#f
+ (if (eq? p538 'any)
+ (cons (wrap443 e539 w537) r536)
+ (if (syntax-object?64 e539)
+ (match*530
+ ((lambda (e540)
+ (if (annotation?132 e540)
+ (annotation-expression
+ e540)
+ e540))
+ (syntax-object-expression65
+ e539))
+ p538
+ (join-wraps422
+ w537
+ (syntax-object-wrap66 e539))
+ r536)
+ (match*530
+ ((lambda (e541)
+ (if (annotation?132 e541)
+ (annotation-expression
+ e541)
+ e541))
+ e539)
+ p538
+ w537
+ r536)))))))
+ (set! $syntax-dispatch
+ (lambda (e533 p532)
+ (if (eq? p532 'any)
+ (list e533)
+ (if (syntax-object?64 e533)
+ (match*530
+ ((lambda (e534)
+ (if (annotation?132 e534)
+ (annotation-expression e534)
+ e534))
+ (syntax-object-expression65 e533))
+ p532
+ (syntax-object-wrap66 e533)
+ '())
+ (match*530
+ ((lambda (e535)
+ (if (annotation?132 e535)
+ (annotation-expression e535)
+ e535))
+ e533)
+ p532
+ '(())
+ '()))))))))))))
+($sc-put-cte
+ '#(syntax-object with-syntax ((top) #(ribcage #(with-syntax) #((top)) #(with-syntax))))
+ (lambda (x2531)
+ ((lambda (tmp2532)
+ ((lambda (tmp2533)
+ (if tmp2533
+ (apply
+ (lambda (_2536 e12535 e22534)
+ (cons
+ '#(syntax-object begin ((top) #(ribcage #(_ e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons e12535 e22534)))
+ tmp2533)
+ ((lambda (tmp2538)
+ (if tmp2538
+ (apply
+ (lambda (_2543 out2542 in2541 e12540 e22539)
+ (list
+ '#(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ in2541
+ '()
+ (list
+ out2542
+ (cons
+ '#(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons e12540 e22539)))))
+ tmp2538)
+ ((lambda (tmp2545)
+ (if tmp2545
+ (apply
+ (lambda (_2550 out2549 in2548 e12547 e22546)
+ (list
+ '#(syntax-object syntax-case ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons
+ '#(syntax-object list ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ in2548)
+ '()
+ (list
+ out2549
+ (cons
+ '#(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons e12547 e22546)))))
+ tmp2545)
+ (syntax-error tmp2532)))
+ ($syntax-dispatch
+ tmp2532
+ '(any #(each (any any)) any . each-any)))))
+ ($syntax-dispatch
+ tmp2532
+ '(any ((any any)) any . each-any)))))
+ ($syntax-dispatch tmp2532 '(any () any . each-any))))
+ x2531))
+ '*top*)
+($sc-put-cte
+ '#(syntax-object with-implicit ((top) #(ribcage #(with-implicit) #((top)) #(with-implicit))))
+ (lambda (x2554)
+ ((lambda (tmp2555)
+ ((lambda (tmp2556)
+ (if (if tmp2556
+ (apply
+ (lambda (dummy2561 tid2560 id2559 e12558 e22557)
+ (andmap identifier? (cons tid2560 id2559)))
+ tmp2556)
+ '#f)
+ (apply
+ (lambda (dummy2567 tid2566 id2565 e12564 e22563)
+ (list
+ '#(syntax-object begin ((top) #(ribcage #(dummy tid id e1 e2) #(("m" top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ (list
+ '#(syntax-object unless ((top) #(ribcage #(dummy tid id e1 e2) #(("m" top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ (list
+ '#(syntax-object identifier? ((top) #(ribcage #(dummy tid id e1 e2) #(("m" top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ (list
+ '#(syntax-object syntax ((top) #(ribcage #(dummy tid id e1 e2) #(("m" top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ tid2566))
+ (cons
+ '#(syntax-object syntax-error ((top) #(ribcage #(dummy tid id e1 e2) #(("m" top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ (cons
+ (list
+ '#(syntax-object syntax ((top) #(ribcage #(dummy tid id e1 e2) #(("m" top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ tid2566)
+ '#(syntax-object ("non-identifier with-implicit template") ((top) #(ribcage #(dummy tid id e1 e2) #(("m" top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t))))))+ (cons
+ '#(syntax-object with-syntax ((top) #(ribcage #(dummy tid id e1 e2) #(("m" top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ (cons
+ (map (lambda (tmp2568)
+ (list
+ tmp2568
+ (list
+ '#(syntax-object datum->syntax-object ((top) #(ribcage #(dummy tid id e1 e2) #(("m" top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ (list
+ '#(syntax-object syntax ((top) #(ribcage #(dummy tid id e1 e2) #(("m" top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ tid2566)
+ (list
+ '#(syntax-object quote ((top) #(ribcage #(dummy tid id e1 e2) #(("m" top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ tmp2568))))
+ id2565)
+ (cons e12564 e22563)))))
+ tmp2556)
+ (syntax-error tmp2555)))
+ ($syntax-dispatch
+ tmp2555
+ '(any (any . each-any) any . each-any))))
+ x2554))
+ '*top*)
+($sc-put-cte
+ '#(syntax-object datum ((top) #(ribcage #(datum) #((top)) #(datum))))
+ (lambda (x2570)
+ ((lambda (tmp2571)
+ ((lambda (tmp2572)
+ (if tmp2572
+ (apply
+ (lambda (dummy2574 x2573)
+ (list
+ '#(syntax-object syntax-object->datum ((top) #(ribcage #(dummy x) #(("m" top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ (list
+ '#(syntax-object syntax ((top) #(ribcage #(dummy x) #(("m" top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ x2573)))
+ tmp2572)
+ (syntax-error tmp2571)))
+ ($syntax-dispatch tmp2571 '(any any))))
+ x2570))
+ '*top*)
+($sc-put-cte
+ '#(syntax-object syntax-rules ((top) #(ribcage #(syntax-rules) #((top)) #(syntax-rules))))
+ (lambda (x2575)
+ (letrec ((clause2576 (lambda (y2592)
+ ((lambda (tmp2593)
+ ((lambda (tmp2594)
+ (if tmp2594
+ (apply
+ (lambda (keyword2597 pattern2596
+ template2595)
+ (list
+ (cons
+ '#(syntax-object dummy ((top) #(ribcage #(keyword pattern template) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(y) #((top)) #("i")) #(ribcage (clause) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ pattern2596)
+ (list
+ '#(syntax-object syntax ((top) #(ribcage #(keyword pattern template) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(y) #((top)) #("i")) #(ribcage (clause) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ template2595)))
+ tmp2594)
+ ((lambda (tmp2598)
+ (if tmp2598
+ (apply
+ (lambda (keyword2602
+ pattern2601
+ fender2600
+ template2599)
+ (list
+ (cons
+ '#(syntax-object dummy ((top) #(ribcage #(keyword pattern fender template) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(y) #((top)) #("i")) #(ribcage (clause) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ pattern2601)
+ fender2600
+ (list
+ '#(syntax-object syntax ((top) #(ribcage #(keyword pattern fender template) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(y) #((top)) #("i")) #(ribcage (clause) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ template2599)))
+ tmp2598)
+ ((lambda (_2603)
+ (syntax-error x2575))
+ tmp2593)))
+ ($syntax-dispatch
+ tmp2593
+ '((any . any) any any)))))
+ ($syntax-dispatch
+ tmp2593
+ '((any . any) any))))
+ y2592))))
+ ((lambda (tmp2577)
+ ((lambda (tmp2578)
+ (if (if tmp2578
+ (apply
+ (lambda (_2581 k2580 cl2579)
+ (andmap identifier? k2580))
+ tmp2578)
+ '#f)
+ (apply
+ (lambda (_2585 k2584 cl2583)
+ ((lambda (tmp2586)
+ ((lambda (tmp2588)
+ (if tmp2588
+ (apply
+ (lambda (cl2589)
+ (list
+ '#(syntax-object lambda ((top) #(ribcage #(cl) #((top)) #("i")) #(ribcage #(_ k cl) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (clause) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ '#(syntax-object (x) ((top) #(ribcage #(cl) #((top)) #("i")) #(ribcage #(_ k cl) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (clause) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons
+ '#(syntax-object syntax-case ((top) #(ribcage #(cl) #((top)) #("i")) #(ribcage #(_ k cl) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (clause) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons
+ '#(syntax-object x ((top) #(ribcage #(cl) #((top)) #("i")) #(ribcage #(_ k cl) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (clause) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons k2584 cl2589)))))
+ tmp2588)
+ (syntax-error tmp2586)))
+ ($syntax-dispatch tmp2586 'each-any)))
+ (map clause2576 cl2583)))
+ tmp2578)
+ (syntax-error tmp2577)))
+ ($syntax-dispatch tmp2577 '(any each-any . each-any))))
+ x2575)))
+ '*top*)
+($sc-put-cte
+ '#(syntax-object or ((top) #(ribcage #(or) #((top)) #(or))))
+ (lambda (x2604)
+ ((lambda (tmp2605)
+ ((lambda (tmp2606)
+ (if tmp2606
+ (apply
+ (lambda (_2607)
+ '#(syntax-object #f ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t))))+ tmp2606)
+ ((lambda (tmp2608)
+ (if tmp2608
+ (apply (lambda (_2610 e2609) e2609) tmp2608)
+ ((lambda (tmp2611)
+ (if tmp2611
+ (apply
+ (lambda (_2615 e12614 e22613 e32612)
+ (list
+ '#(syntax-object let ((top) #(ribcage #(_ e1 e2 e3) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (list
+ (list
+ '#(syntax-object t ((top) #(ribcage #(_ e1 e2 e3) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ e12614))
+ (list
+ '#(syntax-object if ((top) #(ribcage #(_ e1 e2 e3) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ '#(syntax-object t ((top) #(ribcage #(_ e1 e2 e3) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ '#(syntax-object t ((top) #(ribcage #(_ e1 e2 e3) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons
+ '#(syntax-object or ((top) #(ribcage #(_ e1 e2 e3) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons e22613 e32612)))))
+ tmp2611)
+ (syntax-error tmp2605)))
+ ($syntax-dispatch
+ tmp2605
+ '(any any any . each-any)))))
+ ($syntax-dispatch tmp2605 '(any any)))))
+ ($syntax-dispatch tmp2605 '(any))))
+ x2604))
+ '*top*)
+($sc-put-cte
+ '#(syntax-object and ((top) #(ribcage #(and) #((top)) #(and))))
+ (lambda (x2617)
+ ((lambda (tmp2618)
+ ((lambda (tmp2619)
+ (if tmp2619
+ (apply
+ (lambda (_2623 e12622 e22621 e32620)
+ (cons
+ '#(syntax-object if ((top) #(ribcage #(_ e1 e2 e3) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons
+ e12622
+ (cons
+ (cons
+ '#(syntax-object and ((top) #(ribcage #(_ e1 e2 e3) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons e22621 e32620))
+ '#(syntax-object (#f) ((top) #(ribcage #(_ e1 e2 e3) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))))))+ tmp2619)
+ ((lambda (tmp2625)
+ (if tmp2625
+ (apply (lambda (_2627 e2626) e2626) tmp2625)
+ ((lambda (tmp2628)
+ (if tmp2628
+ (apply
+ (lambda (_2629)
+ '#(syntax-object #t ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t))))+ tmp2628)
+ (syntax-error tmp2618)))
+ ($syntax-dispatch tmp2618 '(any)))))
+ ($syntax-dispatch tmp2618 '(any any)))))
+ ($syntax-dispatch tmp2618 '(any any any . each-any))))
+ x2617))
+ '*top*)
+($sc-put-cte
+ '#(syntax-object let ((top) #(ribcage #(let) #((top)) #(let))))
+ (lambda (x2630)
+ ((lambda (tmp2631)
+ ((lambda (tmp2632)
+ (if (if tmp2632
+ (apply
+ (lambda (_2637 x2636 v2635 e12634 e22633)
+ (andmap identifier? x2636))
+ tmp2632)
+ '#f)
+ (apply
+ (lambda (_2643 x2642 v2641 e12640 e22639)
+ (cons
+ (cons
+ '#(syntax-object lambda ((top) #(ribcage #(_ x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons x2642 (cons e12640 e22639)))
+ v2641))
+ tmp2632)
+ ((lambda (tmp2647)
+ (if (if tmp2647
+ (apply
+ (lambda (_2653 f2652 x2651 v2650 e12649 e22648)
+ (andmap identifier? (cons f2652 x2651)))
+ tmp2647)
+ '#f)
+ (apply
+ (lambda (_2660 f2659 x2658 v2657 e12656 e22655)
+ (cons
+ (list
+ '#(syntax-object letrec ((top) #(ribcage #(_ f x v e1 e2) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (list
+ (list
+ f2659
+ (cons
+ '#(syntax-object lambda ((top) #(ribcage #(_ f x v e1 e2) #((top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons x2658 (cons e12656 e22655)))))
+ f2659)
+ v2657))
+ tmp2647)
+ (syntax-error tmp2631)))
+ ($syntax-dispatch
+ tmp2631
+ '(any any #(each (any any)) any . each-any)))))
+ ($syntax-dispatch
+ tmp2631
+ '(any #(each (any any)) any . each-any))))
+ x2630))
+ '*top*)
+($sc-put-cte
+ '#(syntax-object let* ((top) #(ribcage #(let*) #((top)) #(let*))))
+ (lambda (x2664)
+ ((lambda (tmp2665)
+ ((lambda (tmp2666)
+ (if (if tmp2666
+ (apply
+ (lambda (let*2671 x2670 v2669 e12668 e22667)
+ (andmap identifier? x2670))
+ tmp2666)
+ '#f)
+ (apply
+ (lambda (let*2677 x2676 v2675 e12674 e22673)
+ ((letrec ((f2678 (lambda (bindings2679)
+ (if (null? bindings2679)
+ (cons
+ '#(syntax-object let ((top) #(ribcage () () ()) #(ribcage #(bindings) #((top)) #("i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons '() (cons e12674 e22673)))
+ ((lambda (tmp2681)
+ ((lambda (tmp2682)
+ (if tmp2682
+ (apply
+ (lambda (body2684
+ binding2683)
+ (list
+ '#(syntax-object let ((top) #(ribcage #(body binding) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(bindings) #((top)) #("i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(let* x v e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (list binding2683)
+ body2684))
+ tmp2682)
+ (syntax-error tmp2681)))
+ ($syntax-dispatch
+ tmp2681
+ '(any any))))
+ (list
+ (f2678 (cdr bindings2679))
+ (car bindings2679)))))))
+ f2678)
+ (map list x2676 v2675)))
+ tmp2666)
+ (syntax-error tmp2665)))
+ ($syntax-dispatch
+ tmp2665
+ '(any #(each (any any)) any . each-any))))
+ x2664))
+ '*top*)
+($sc-put-cte
+ '#(syntax-object cond ((top) #(ribcage #(cond) #((top)) #(cond))))
+ (lambda (x2687)
+ ((lambda (tmp2688)
+ ((lambda (tmp2689)
+ (if tmp2689
+ (apply
+ (lambda (_2692 m12691 m22690)
+ ((letrec ((f2693 (lambda (clause2695 clauses2694)
+ (if (null? clauses2694)
+ ((lambda (tmp2696)
+ ((lambda (tmp2697)
+ (if tmp2697
+ (apply
+ (lambda (e12699
+ e22698)
+ (cons
+ '#(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons
+ e12699
+ e22698)))
+ tmp2697)
+ ((lambda (tmp2701)
+ (if tmp2701
+ (apply
+ (lambda (e02702)
+ (cons
+ '#(syntax-object let ((top) #(ribcage #(e0) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons
+ (list
+ (list
+ '#(syntax-object t ((top) #(ribcage #(e0) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ e02702))
+ '#(syntax-object ((if t t)) ((top) #(ribcage #(e0) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t))))))+ tmp2701)
+ ((lambda (tmp2703)
+ (if tmp2703
+ (apply
+ (lambda (e02705
+ e12704)
+ (list
+ '#(syntax-object let ((top) #(ribcage #(e0 e1) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (list
+ (list
+ '#(syntax-object t ((top) #(ribcage #(e0 e1) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ e02705))
+ (list
+ '#(syntax-object if ((top) #(ribcage #(e0 e1) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ '#(syntax-object t ((top) #(ribcage #(e0 e1) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons
+ e12704
+ '#(syntax-object (t) ((top) #(ribcage #(e0 e1) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))))))+ tmp2703)
+ ((lambda (tmp2706)
+ (if tmp2706
+ (apply
+ (lambda (e02709
+ e12708
+ e22707)
+ (list
+ '#(syntax-object if ((top) #(ribcage #(e0 e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ e02709
+ (cons
+ '#(syntax-object begin ((top) #(ribcage #(e0 e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons
+ e12708
+ e22707))))
+ tmp2706)
+ ((lambda (_2711)
+ (syntax-error
+ x2687))
+ tmp2696)))
+ ($syntax-dispatch
+ tmp2696
+ '(any any
+ .
+ each-any)))))
+ ($syntax-dispatch
+ tmp2696
+ '(any #(free-id
+ #(syntax-object => ((top) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t))))+ any)))))
+ ($syntax-dispatch
+ tmp2696
+ '(any)))))
+ ($syntax-dispatch
+ tmp2696
+ '(#(free-id
+ #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t))))+ any
+ .
+ each-any))))
+ clause2695)
+ ((lambda (tmp2712)
+ ((lambda (rest2713)
+ ((lambda (tmp2714)
+ ((lambda (tmp2715)
+ (if tmp2715
+ (apply
+ (lambda (e02716)
+ (list
+ '#(syntax-object let ((top) #(ribcage #(e0) #((top)) #("i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (list
+ (list
+ '#(syntax-object t ((top) #(ribcage #(e0) #((top)) #("i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ e02716))
+ (list
+ '#(syntax-object if ((top) #(ribcage #(e0) #((top)) #("i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ '#(syntax-object t ((top) #(ribcage #(e0) #((top)) #("i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ '#(syntax-object t ((top) #(ribcage #(e0) #((top)) #("i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ rest2713)))
+ tmp2715)
+ ((lambda (tmp2717)
+ (if tmp2717
+ (apply
+ (lambda (e02719
+ e12718)
+ (list
+ '#(syntax-object let ((top) #(ribcage #(e0 e1) #((top) (top)) #("i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (list
+ (list
+ '#(syntax-object t ((top) #(ribcage #(e0 e1) #((top) (top)) #("i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ e02719))
+ (list
+ '#(syntax-object if ((top) #(ribcage #(e0 e1) #((top) (top)) #("i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ '#(syntax-object t ((top) #(ribcage #(e0 e1) #((top) (top)) #("i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons
+ e12718
+ '#(syntax-object (t) ((top) #(ribcage #(e0 e1) #((top) (top)) #("i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t))))+ rest2713)))
+ tmp2717)
+ ((lambda (tmp2720)
+ (if tmp2720
+ (apply
+ (lambda (e02723
+ e12722
+ e22721)
+ (list
+ '#(syntax-object if ((top) #(ribcage #(e0 e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ e02723
+ (cons
+ '#(syntax-object begin ((top) #(ribcage #(e0 e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons
+ e12722
+ e22721))
+ rest2713))
+ tmp2720)
+ ((lambda (_2725)
+ (syntax-error
+ x2687))
+ tmp2714)))
+ ($syntax-dispatch
+ tmp2714
+ '(any any
+ .
+ each-any)))))
+ ($syntax-dispatch
+ tmp2714
+ '(any #(free-id
+ #(syntax-object => ((top) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ m1 m2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t))))+ any)))))
+ ($syntax-dispatch
+ tmp2714
+ '(any))))
+ clause2695))
+ tmp2712))
+ (f2693
+ (car clauses2694)
+ (cdr clauses2694)))))))
+ f2693)
+ m12691
+ m22690))
+ tmp2689)
+ (syntax-error tmp2688)))
+ ($syntax-dispatch tmp2688 '(any any . each-any))))
+ x2687))
+ '*top*)
+($sc-put-cte
+ '#(syntax-object do ((top) #(ribcage #(do) #((top)) #(do))))
+ (lambda (orig-x2727)
+ ((lambda (tmp2728)
+ ((lambda (tmp2729)
+ (if tmp2729
+ (apply
+ (lambda (_2736 var2735 init2734 step2733 e02732 e12731
+ c2730)
+ ((lambda (tmp2737)
+ ((lambda (tmp2747)
+ (if tmp2747
+ (apply
+ (lambda (step2748)
+ ((lambda (tmp2749)
+ ((lambda (tmp2751)
+ (if tmp2751
+ (apply
+ (lambda ()
+ (list
+ '#(syntax-object let ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i")) #(top-ribcage *top* #t)))+ '#(syntax-object do ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (map list var2735 init2734)
+ (list
+ '#(syntax-object if ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (list
+ '#(syntax-object not ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i")) #(top-ribcage *top* #t)))+ e02732)
+ (cons
+ '#(syntax-object begin ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (append
+ c2730
+ (list
+ (cons
+ '#(syntax-object do ((top) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i")) #(top-ribcage *top* #t)))+ step2748)))))))
+ tmp2751)
+ ((lambda (tmp2756)
+ (if tmp2756
+ (apply
+ (lambda (e12758 e22757)
+ (list
+ '#(syntax-object let ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i")) #(top-ribcage *top* #t)))+ '#(syntax-object do ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (map list
+ var2735
+ init2734)
+ (list
+ '#(syntax-object if ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i")) #(top-ribcage *top* #t)))+ e02732
+ (cons
+ '#(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons
+ e12758
+ e22757))
+ (cons
+ '#(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (append
+ c2730
+ (list
+ (cons
+ '#(syntax-object do ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i")) #(top-ribcage *top* #t)))+ step2748)))))))
+ tmp2756)
+ (syntax-error tmp2749)))
+ ($syntax-dispatch
+ tmp2749
+ '(any . each-any)))))
+ ($syntax-dispatch tmp2749 '())))
+ e12731))
+ tmp2747)
+ (syntax-error tmp2737)))
+ ($syntax-dispatch tmp2737 'each-any)))
+ (map (lambda (v2741 s2740)
+ ((lambda (tmp2742)
+ ((lambda (tmp2743)
+ (if tmp2743
+ (apply (lambda () v2741) tmp2743)
+ ((lambda (tmp2744)
+ (if tmp2744
+ (apply
+ (lambda (e2745) e2745)
+ tmp2744)
+ ((lambda (_2746)
+ (syntax-error orig-x2727))
+ tmp2742)))
+ ($syntax-dispatch tmp2742 '(any)))))
+ ($syntax-dispatch tmp2742 '())))
+ s2740))
+ var2735
+ step2733)))
+ tmp2729)
+ (syntax-error tmp2728)))
+ ($syntax-dispatch
+ tmp2728
+ '(any #(each (any any . any))
+ (any . each-any)
+ .
+ each-any))))
+ orig-x2727))
+ '*top*)
+($sc-put-cte
+ '#(syntax-object quasiquote ((top) #(ribcage #(quasiquote) #((top)) #(quasiquote))))
+ ((lambda ()
+ (letrec ((quasi2764 (lambda (p2900 lev2899)
+ ((lambda (tmp2901)
+ ((lambda (tmp2902)
+ (if tmp2902
+ (apply
+ (lambda (p2903)
+ (if (= lev2899 '0)
+ (list
+ '#(syntax-object "value" ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ p2903)
+ (quasicons2766
+ '#(syntax-object ("quote" unquote) ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ (quasi2764
+ (list p2903)
+ (- lev2899 '1)))))
+ tmp2902)
+ ((lambda (tmp2904)
+ (if tmp2904
+ (apply
+ (lambda (p2905)
+ (quasicons2766
+ '#(syntax-object ("quote" quasiquote) ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ (quasi2764
+ (list p2905)
+ (+ lev2899 '1))))
+ tmp2904)
+ ((lambda (tmp2906)
+ (if tmp2906
+ (apply
+ (lambda (p2908 q2907)
+ ((lambda (tmp2909)
+ ((lambda (tmp2910)
+ (if tmp2910
+ (apply
+ (lambda (p2911)
+ (if (= lev2899
+ '0)
+ (quasilist*2768
+ (map (lambda (tmp2912)
+ (list
+ '#(syntax-object "value" ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ tmp2912))
+ p2911)
+ (quasi2764
+ q2907
+ lev2899))
+ (quasicons2766
+ (quasicons2766
+ '#(syntax-object ("quote" unquote) ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ (quasi2764
+ p2911
+ (- lev2899
+ '1)))
+ (quasi2764
+ q2907
+ lev2899))))
+ tmp2910)
+ ((lambda (tmp2914)
+ (if tmp2914
+ (apply
+ (lambda (p2915)
+ (if (= lev2899
+ '0)
+ (quasiappend2767
+ (map (lambda (tmp2916)
+ (list
+ '#(syntax-object "value" ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ tmp2916))
+ p2915)
+ (quasi2764
+ q2907
+ lev2899))
+ (quasicons2766
+ (quasicons2766
+ '#(syntax-object ("quote" unquote-splicing) ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ (quasi2764
+ p2915
+ (- lev2899
+ '1)))
+ (quasi2764
+ q2907
+ lev2899))))
+ tmp2914)
+ ((lambda (_2918)
+ (quasicons2766
+ (quasi2764
+ p2908
+ lev2899)
+ (quasi2764
+ q2907
+ lev2899)))
+ tmp2909)))
+ ($syntax-dispatch
+ tmp2909
+ '(#(free-id
+ #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t))))+ .
+ each-any)))))
+ ($syntax-dispatch
+ tmp2909
+ '(#(free-id
+ #(syntax-object unquote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t))))+ .
+ each-any))))
+ p2908))
+ tmp2906)
+ ((lambda (tmp2919)
+ (if tmp2919
+ (apply
+ (lambda (x2920)
+ (quasivector2769
+ (vquasi2765
+ x2920
+ lev2899)))
+ tmp2919)
+ ((lambda (p2922)
+ (list
+ '#(syntax-object "quote" ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ p2922))
+ tmp2901)))
+ ($syntax-dispatch
+ tmp2901
+ '#(vector
+ each-any)))))
+ ($syntax-dispatch
+ tmp2901
+ '(any . any)))))
+ ($syntax-dispatch
+ tmp2901
+ '(#(free-id
+ #(syntax-object quasiquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t))))+ any)))))
+ ($syntax-dispatch
+ tmp2901
+ '(#(free-id
+ #(syntax-object unquote ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t))))+ any))))
+ p2900)))
+ (vquasi2765 (lambda (p2883 lev2882)
+ ((lambda (tmp2884)
+ ((lambda (tmp2885)
+ (if tmp2885
+ (apply
+ (lambda (p2887 q2886)
+ ((lambda (tmp2888)
+ ((lambda (tmp2889)
+ (if tmp2889
+ (apply
+ (lambda (p2890)
+ (if (= lev2882 '0)
+ (quasilist*2768
+ (map (lambda (tmp2891)
+ (list
+ '#(syntax-object "value" ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ tmp2891))
+ p2890)
+ (vquasi2765
+ q2886
+ lev2882))
+ (quasicons2766
+ (quasicons2766
+ '#(syntax-object ("quote" unquote) ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ (quasi2764
+ p2890
+ (- lev2882
+ '1)))
+ (vquasi2765
+ q2886
+ lev2882))))
+ tmp2889)
+ ((lambda (tmp2893)
+ (if tmp2893
+ (apply
+ (lambda (p2894)
+ (if (= lev2882
+ '0)
+ (quasiappend2767
+ (map (lambda (tmp2895)
+ (list
+ '#(syntax-object "value" ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ tmp2895))
+ p2894)
+ (vquasi2765
+ q2886
+ lev2882))
+ (quasicons2766
+ (quasicons2766
+ '#(syntax-object ("quote" unquote-splicing) ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ (quasi2764
+ p2894
+ (- lev2882
+ '1)))
+ (vquasi2765
+ q2886
+ lev2882))))
+ tmp2893)
+ ((lambda (_2897)
+ (quasicons2766
+ (quasi2764
+ p2887
+ lev2882)
+ (vquasi2765
+ q2886
+ lev2882)))
+ tmp2888)))
+ ($syntax-dispatch
+ tmp2888
+ '(#(free-id
+ #(syntax-object unquote-splicing ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t))))+ .
+ each-any)))))
+ ($syntax-dispatch
+ tmp2888
+ '(#(free-id
+ #(syntax-object unquote ((top) #(ribcage #(p q) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t))))+ .
+ each-any))))
+ p2887))
+ tmp2885)
+ ((lambda (tmp2898)
+ (if tmp2898
+ (apply
+ (lambda ()
+ '#(syntax-object ("quote" ()) ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t))))+ tmp2898)
+ (syntax-error tmp2884)))
+ ($syntax-dispatch tmp2884 '()))))
+ ($syntax-dispatch tmp2884 '(any . any))))
+ p2883)))
+ (quasicons2766 (lambda (x2865 y2864)
+ ((lambda (tmp2866)
+ ((lambda (tmp2867)
+ (if tmp2867
+ (apply
+ (lambda (x2869 y2868)
+ ((lambda (tmp2870)
+ ((lambda (tmp2871)
+ (if tmp2871
+ (apply
+ (lambda (dy2872)
+ ((lambda (tmp2873)
+ ((lambda (tmp2874)
+ (if tmp2874
+ (apply
+ (lambda (dx2875)
+ (list
+ '#(syntax-object "quote" ((top) #(ribcage #(dx) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ (cons
+ dx2875
+ dy2872)))
+ tmp2874)
+ ((lambda (_2876)
+ (if (null?
+ dy2872)
+ (list
+ '#(syntax-object "list" ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ x2869)
+ (list
+ '#(syntax-object "list*" ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(dy) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ x2869
+ y2868)))
+ tmp2873)))
+ ($syntax-dispatch
+ tmp2873
+ '(#(atom
+ "quote")
+ any))))
+ x2869))
+ tmp2871)
+ ((lambda (tmp2877)
+ (if tmp2877
+ (apply
+ (lambda (stuff2878)
+ (cons
+ '#(syntax-object "list" ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ (cons
+ x2869
+ stuff2878)))
+ tmp2877)
+ ((lambda (tmp2879)
+ (if tmp2879
+ (apply
+ (lambda (stuff2880)
+ (cons
+ '#(syntax-object "list*" ((top) #(ribcage #(stuff) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ (cons
+ x2869
+ stuff2880)))
+ tmp2879)
+ ((lambda (_2881)
+ (list
+ '#(syntax-object "list*" ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ x2869
+ y2868))
+ tmp2870)))
+ ($syntax-dispatch
+ tmp2870
+ '(#(atom
+ "list*")
+ .
+ any)))))
+ ($syntax-dispatch
+ tmp2870
+ '(#(atom "list")
+ .
+ any)))))
+ ($syntax-dispatch
+ tmp2870
+ '(#(atom "quote")
+ any))))
+ y2868))
+ tmp2867)
+ (syntax-error tmp2866)))
+ ($syntax-dispatch tmp2866 '(any any))))
+ (list x2865 y2864))))
+ (quasiappend2767 (lambda (x2851 y2850)
+ ((lambda (tmp2852)
+ ((lambda (tmp2853)
+ (if tmp2853
+ (apply
+ (lambda ()
+ (if (null? x2851)
+ '#(syntax-object ("quote" ()) ((top) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ (if (null? (cdr x2851))
+ (car x2851)
+ ((lambda (tmp2854)
+ ((lambda (tmp2855)
+ (if tmp2855
+ (apply
+ (lambda (p2856)
+ (cons
+ '#(syntax-object "append" ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ p2856))
+ tmp2855)
+ (syntax-error
+ tmp2854)))
+ ($syntax-dispatch
+ tmp2854
+ 'each-any)))
+ x2851))))
+ tmp2853)
+ ((lambda (_2858)
+ (if (null? x2851)
+ y2850
+ ((lambda (tmp2859)
+ ((lambda (tmp2860)
+ (if tmp2860
+ (apply
+ (lambda (p2862
+ y2861)
+ (cons
+ '#(syntax-object "append" ((top) #(ribcage #(p y) #((top) (top)) #("i" "i")) #(ribcage #(_) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ (append
+ p2862
+ (list
+ y2861))))
+ tmp2860)
+ (syntax-error
+ tmp2859)))
+ ($syntax-dispatch
+ tmp2859
+ '(each-any any))))
+ (list x2851 y2850))))
+ tmp2852)))
+ ($syntax-dispatch
+ tmp2852
+ '(#(atom "quote") ()))))
+ y2850)))
+ (quasilist*2768 (lambda (x2847 y2846)
+ ((letrec ((f2848 (lambda (x2849)
+ (if (null? x2849)
+ y2846
+ (quasicons2766
+ (car x2849)
+ (f2848
+ (cdr x2849)))))))
+ f2848)
+ x2847)))
+ (quasivector2769 (lambda (x2817)
+ ((lambda (tmp2818)
+ ((lambda (tmp2819)
+ (if tmp2819
+ (apply
+ (lambda (x2820)
+ (list
+ '#(syntax-object "quote" ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ (list->vector x2820)))
+ tmp2819)
+ ((lambda (_2822)
+ ((letrec ((f2823 (lambda (y2825
+ k2824)
+ ((lambda (tmp2826)
+ ((lambda (tmp2827)
+ (if tmp2827
+ (apply
+ (lambda (y2828)
+ (k2824
+ (map (lambda (tmp2829)
+ (list
+ '#(syntax-object "quote" ((top) #(ribcage #(y) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(y k) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ tmp2829))
+ y2828)))
+ tmp2827)
+ ((lambda (tmp2830)
+ (if tmp2830
+ (apply
+ (lambda (y2831)
+ (k2824
+ y2831))
+ tmp2830)
+ ((lambda (tmp2833)
+ (if tmp2833
+ (apply
+ (lambda (y2835
+ z2834)
+ (f2823
+ z2834
+ (lambda (ls2836)
+ (k2824
+ (append
+ y2835
+ ls2836)))))
+ tmp2833)
+ ((lambda (else2838)
+ ((lambda (tmp2839)
+ ((lambda (t72840)
+ (list
+ '#(syntax-object "list->vector" ((top) #(ribcage #(t7) #(("m" tmp)) #("i")) #(ribcage #(else) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(y k) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ t72840))
+ tmp2839))
+ x2817))
+ tmp2826)))
+ ($syntax-dispatch
+ tmp2826
+ '(#(atom
+ "list*")
+ .
+ #(each+
+ any
+ (any)
+ ()))))))
+ ($syntax-dispatch
+ tmp2826
+ '(#(atom
+ "list")
+ .
+ each-any)))))
+ ($syntax-dispatch
+ tmp2826
+ '(#(atom
+ "quote")
+ each-any))))
+ y2825))))
+ f2823)
+ x2817
+ (lambda (ls2841)
+ ((lambda (tmp2842)
+ ((lambda (tmp2843)
+ (if tmp2843
+ (apply
+ (lambda (t82844)
+ (cons
+ '#(syntax-object "vector" ((top) #(ribcage #(t8) #(("m" tmp)) #("i")) #(ribcage () () ()) #(ribcage #(ls) #((top)) #("i")) #(ribcage #(_) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ t82844))
+ tmp2843)
+ (syntax-error
+ tmp2842)))
+ ($syntax-dispatch
+ tmp2842
+ 'each-any)))
+ ls2841))))
+ tmp2818)))
+ ($syntax-dispatch
+ tmp2818
+ '(#(atom "quote") each-any))))
+ x2817)))
+ (emit2770 (lambda (x2776)
+ ((lambda (tmp2777)
+ ((lambda (tmp2778)
+ (if tmp2778
+ (apply
+ (lambda (x2779)
+ (list
+ '#(syntax-object quote ((top) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ x2779))
+ tmp2778)
+ ((lambda (tmp2780)
+ (if tmp2780
+ (apply
+ (lambda (x2781)
+ ((lambda (tmp2782)
+ ((lambda (tmp2784)
+ (if tmp2784
+ (apply
+ (lambda (t12785)
+ (cons
+ '#(syntax-object list ((top) #(ribcage #(t1) #(("m" tmp)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ t12785))
+ tmp2784)
+ (syntax-error
+ tmp2782)))
+ ($syntax-dispatch
+ tmp2782
+ 'each-any)))
+ (map emit2770 x2781)))
+ tmp2780)
+ ((lambda (tmp2787)
+ (if tmp2787
+ (apply
+ (lambda (x2789 y2788)
+ ((letrec ((f2790 (lambda (x*2791)
+ (if (null?
+ x*2791)
+ (emit2770
+ y2788)
+ ((lambda (tmp2792)
+ ((lambda (tmp2793)
+ (if tmp2793
+ (apply
+ (lambda (t32795
+ t22794)
+ (list
+ '#(syntax-object cons ((top) #(ribcage #(t3 t2) #(("m" tmp) ("m" tmp)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x*) #((top)) #("i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ t32795
+ t22794))
+ tmp2793)
+ (syntax-error
+ tmp2792)))
+ ($syntax-dispatch
+ tmp2792
+ '(any any))))
+ (list
+ (emit2770
+ (car x*2791))
+ (f2790
+ (cdr x*2791))))))))
+ f2790)
+ x2789))
+ tmp2787)
+ ((lambda (tmp2797)
+ (if tmp2797
+ (apply
+ (lambda (x2798)
+ ((lambda (tmp2799)
+ ((lambda (tmp2801)
+ (if tmp2801
+ (apply
+ (lambda (t42802)
+ (cons
+ '#(syntax-object append ((top) #(ribcage #(t4) #(("m" tmp)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ t42802))
+ tmp2801)
+ (syntax-error
+ tmp2799)))
+ ($syntax-dispatch
+ tmp2799
+ 'each-any)))
+ (map emit2770
+ x2798)))
+ tmp2797)
+ ((lambda (tmp2804)
+ (if tmp2804
+ (apply
+ (lambda (x2805)
+ ((lambda (tmp2806)
+ ((lambda (tmp2808)
+ (if tmp2808
+ (apply
+ (lambda (t52809)
+ (cons
+ '#(syntax-object vector ((top) #(ribcage #(t5) #(("m" tmp)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ t52809))
+ tmp2808)
+ (syntax-error
+ tmp2806)))
+ ($syntax-dispatch
+ tmp2806
+ 'each-any)))
+ (map emit2770
+ x2805)))
+ tmp2804)
+ ((lambda (tmp2811)
+ (if tmp2811
+ (apply
+ (lambda (x2812)
+ ((lambda (tmp2813)
+ ((lambda (t62814)
+ (list
+ '#(syntax-object list->vector ((top) #(ribcage #(t6) #(("m" tmp)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))+ t62814))
+ tmp2813))
+ (emit2770
+ x2812)))
+ tmp2811)
+ ((lambda (tmp2815)
+ (if tmp2815
+ (apply
+ (lambda (x2816)
+ x2816)
+ tmp2815)
+ (syntax-error
+ tmp2777)))
+ ($syntax-dispatch
+ tmp2777
+ '(#(atom
+ "value")
+ any)))))
+ ($syntax-dispatch
+ tmp2777
+ '(#(atom
+ "list->vector")
+ any)))))
+ ($syntax-dispatch
+ tmp2777
+ '(#(atom
+ "vector")
+ .
+ each-any)))))
+ ($syntax-dispatch
+ tmp2777
+ '(#(atom "append")
+ .
+ each-any)))))
+ ($syntax-dispatch
+ tmp2777
+ '(#(atom "list*")
+ .
+ #(each+ any (any)
+ ()))))))
+ ($syntax-dispatch
+ tmp2777
+ '(#(atom "list") . each-any)))))
+ ($syntax-dispatch
+ tmp2777
+ '(#(atom "quote") any))))
+ x2776))))
+ (lambda (x2771)
+ ((lambda (tmp2772)
+ ((lambda (tmp2773)
+ (if tmp2773
+ (apply
+ (lambda (_2775 e2774) (emit2770 (quasi2764 e2774 '0)))
+ tmp2773)
+ (syntax-error tmp2772)))
+ ($syntax-dispatch tmp2772 '(any any))))
+ x2771)))))
+ '*top*)
+($sc-put-cte
+ '#(syntax-object unquote ((top) #(ribcage #(unquote) #((top)) #(unquote))))
+ (lambda (x2923) (syntax-error x2923 '"misplaced"))
+ '*top*)
+($sc-put-cte
+ '#(syntax-object unquote-splicing ((top) #(ribcage #(unquote-splicing) #((top)) #(unquote-splicing))))
+ (lambda (x2924) (syntax-error x2924 '"misplaced"))
+ '*top*)
+($sc-put-cte
+ '#(syntax-object quasisyntax ((top) #(ribcage #(quasisyntax) #((top)) #(quasisyntax))))
+ (lambda (x2925)
+ (letrec ((qs2926 (lambda (q2977 n2976 b*2975 k2974)
+ ((lambda (tmp2978)
+ ((lambda (tmp2979)
+ (if tmp2979
+ (apply
+ (lambda (d2980)
+ (qs2926
+ d2980
+ (+ n2976 '1)
+ b*2975
+ (lambda (b*2982 dnew2981)
+ (k2974
+ b*2982
+ (if (eq? dnew2981 d2980)
+ q2977
+ ((lambda (tmp2983)
+ ((lambda (d2984)
+ (cons
+ '#(syntax-object quasisyntax ((top) #(ribcage #(d) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b* dnew) #((top) (top)) #("i" "i")) #(ribcage #(d) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(q n b* k) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (vqs qs) ((top) (top)) ("i" "i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ d2984))
+ tmp2983))
+ dnew2981))))))
+ tmp2979)
+ ((lambda (tmp2985)
+ (if (if tmp2985
+ (apply
+ (lambda (d2986)
+ (not (= n2976 '0)))
+ tmp2985)
+ '#f)
+ (apply
+ (lambda (d2987)
+ (qs2926
+ d2987
+ (- n2976 '1)
+ b*2975
+ (lambda (b*2989 dnew2988)
+ (k2974
+ b*2989
+ (if (eq? dnew2988 d2987)
+ q2977
+ ((lambda (tmp2990)
+ ((lambda (d2991)
+ (cons
+ '#(syntax-object unsyntax ((top) #(ribcage #(d) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b* dnew) #((top) (top)) #("i" "i")) #(ribcage #(d) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(q n b* k) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (vqs qs) ((top) (top)) ("i" "i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ d2991))
+ tmp2990))
+ dnew2988))))))
+ tmp2985)
+ ((lambda (tmp2992)
+ (if (if tmp2992
+ (apply
+ (lambda (d2993)
+ (not (= n2976 '0)))
+ tmp2992)
+ '#f)
+ (apply
+ (lambda (d2994)
+ (qs2926
+ d2994
+ (- n2976 '1)
+ b*2975
+ (lambda (b*2996
+ dnew2995)
+ (k2974
+ b*2996
+ (if (eq? dnew2995
+ d2994)
+ q2977
+ ((lambda (tmp2997)
+ ((lambda (d2998)
+ (cons
+ '#(syntax-object unsyntax-splicing ((top) #(ribcage #(d) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b* dnew) #((top) (top)) #("i" "i")) #(ribcage #(d) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(q n b* k) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (vqs qs) ((top) (top)) ("i" "i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ d2998))
+ tmp2997))
+ dnew2995))))))
+ tmp2992)
+ ((lambda (tmp2999)
+ (if (if tmp2999
+ (apply
+ (lambda (q3000)
+ (= n2976 '0))
+ tmp2999)
+ '#f)
+ (apply
+ (lambda (q3001)
+ ((lambda (tmp3002)
+ ((lambda (tmp3003)
+ (if tmp3003
+ (apply
+ (lambda (t3004)
+ (k2974
+ (cons
+ (list
+ t3004
+ q3001)
+ b*2975)
+ t3004))
+ tmp3003)
+ (syntax-error
+ tmp3002)))
+ ($syntax-dispatch
+ tmp3002
+ '(any))))
+ (generate-temporaries
+ (list
+ q3001))))
+ tmp2999)
+ ((lambda (tmp3005)
+ (if (if tmp3005
+ (apply
+ (lambda (q3007
+ d3006)
+ (= n2976
+ '0))
+ tmp3005)
+ '#f)
+ (apply
+ (lambda (q3009
+ d3008)
+ (qs2926
+ d3008
+ n2976
+ b*2975
+ (lambda (b*3011
+ dnew3010)
+ ((lambda (tmp3012)
+ ((lambda (tmp3014)
+ (if tmp3014
+ (apply
+ (lambda (t3015)
+ (k2974
+ (append
+ (map list
+ t3015
+ q3009)
+ b*3011)
+ ((lambda (tmp3016)
+ ((lambda (d3017)
+ (append
+ t3015
+ d3017))
+ tmp3016))
+ dnew3010)))
+ tmp3014)
+ (syntax-error
+ tmp3012)))
+ ($syntax-dispatch
+ tmp3012
+ 'each-any)))
+ (generate-temporaries
+ q3009)))))
+ tmp3005)
+ ((lambda (tmp3021)
+ (if (if tmp3021
+ (apply
+ (lambda (q3023
+ d3022)
+ (= n2976
+ '0))
+ tmp3021)
+ '#f)
+ (apply
+ (lambda (q3025
+ d3024)
+ (qs2926
+ d3024
+ n2976
+ b*2975
+ (lambda (b*3027
+ dnew3026)
+ ((lambda (tmp3028)
+ ((lambda (tmp3030)
+ (if tmp3030
+ (apply
+ (lambda (t3031)
+ (k2974
+ (append
+ (map (lambda (tmp3041
+ tmp3040)
+ (list
+ (cons
+ tmp3040
+ '(#(syntax-object ... ((top) #(ribcage #(t) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b* dnew) #((top) (top)) #("i" "i")) #(ribcage #(q d) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(q n b* k) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (vqs qs) ((top) (top)) ("i" "i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))))+ tmp3041))
+ q3025
+ t3031)
+ b*3027)
+ ((lambda (tmp3032)
+ ((lambda (tmp3034)
+ (if tmp3034
+ (apply
+ (lambda (m3035)
+ ((lambda (tmp3036)
+ ((lambda (d3037)
+ (append
+ (apply
+ append
+ m3035)
+ d3037))
+ tmp3036))
+ dnew3026))
+ tmp3034)
+ (syntax-error
+ tmp3032)))
+ ($syntax-dispatch
+ tmp3032
+ '#(each
+ each-any))))
+ (map (lambda (tmp3033)
+ (cons
+ tmp3033
+ '(#(syntax-object ... ((top) #(ribcage #(t) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b* dnew) #((top) (top)) #("i" "i")) #(ribcage #(q d) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(q n b* k) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (vqs qs) ((top) (top)) ("i" "i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t))))))+ t3031))))
+ tmp3030)
+ (syntax-error
+ tmp3028)))
+ ($syntax-dispatch
+ tmp3028
+ 'each-any)))
+ (generate-temporaries
+ q3025)))))
+ tmp3021)
+ ((lambda (tmp3042)
+ (if tmp3042
+ (apply
+ (lambda (a3044
+ d3043)
+ (qs2926
+ a3044
+ n2976
+ b*2975
+ (lambda (b*3046
+ anew3045)
+ (qs2926
+ d3043
+ n2976
+ b*3046
+ (lambda (b*3048
+ dnew3047)
+ (k2974
+ b*3048
+ (if (if (eq? anew3045
+ a3044)
+ (eq? dnew3047
+ d3043)
+ '#f)
+ q2977
+ ((lambda (tmp3049)
+ ((lambda (tmp3050)
+ (if tmp3050
+ (apply
+ (lambda (a3052
+ d3051)
+ (cons
+ a3052
+ d3051))
+ tmp3050)
+ (syntax-error
+ tmp3049)))
+ ($syntax-dispatch
+ tmp3049
+ '(any any))))
+ (list
+ anew3045
+ dnew3047)))))))))
+ tmp3042)
+ ((lambda (tmp3053)
+ (if tmp3053
+ (apply
+ (lambda (x3054)
+ (vqs2927
+ x3054
+ n2976
+ b*2975
+ (lambda (b*3056
+ xnew*3055)
+ (k2974
+ b*3056
+ (if ((letrec ((same?3057 (lambda (x*3059
+ xnew*3058)
+ (if (null?
+ x*3059)
+ (null?
+ xnew*3058)
+ (if (not (null?
+ xnew*3058))
+ (if (eq? (car x*3059)
+ (car xnew*3058))
+ (same?3057
+ (cdr x*3059)
+ (cdr xnew*3058))
+ '#f)
+ '#f)))))
+ same?3057)
+ x3054
+ xnew*3055)
+ q2977
+ ((lambda (tmp3061)
+ ((lambda (tmp3062)
+ (if tmp3062
+ (apply
+ (lambda (x3063)
+ (list->vector
+ x3063))
+ tmp3062)
+ (syntax-error
+ tmp3061)))
+ ($syntax-dispatch
+ tmp3061
+ 'each-any)))
+ xnew*3055))))))
+ tmp3053)
+ ((lambda (_3066)
+ (k2974
+ b*2975
+ q2977))
+ tmp2978)))
+ ($syntax-dispatch
+ tmp2978
+ '#(vector
+ each-any)))))
+ ($syntax-dispatch
+ tmp2978
+ '(any .
+ any)))))
+ ($syntax-dispatch
+ tmp2978
+ '((#(free-id
+ #(syntax-object unsyntax-splicing ((top) #(ribcage () () ()) #(ribcage #(q n b* k) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (vqs qs) ((top) (top)) ("i" "i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t))))+ .
+ each-any)
+ .
+ any)))))
+ ($syntax-dispatch
+ tmp2978
+ '((#(free-id
+ #(syntax-object unsyntax ((top) #(ribcage () () ()) #(ribcage #(q n b* k) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (vqs qs) ((top) (top)) ("i" "i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t))))+ .
+ each-any)
+ .
+ any)))))
+ ($syntax-dispatch
+ tmp2978
+ '(#(free-id
+ #(syntax-object unsyntax ((top) #(ribcage () () ()) #(ribcage #(q n b* k) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (vqs qs) ((top) (top)) ("i" "i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t))))+ any)))))
+ ($syntax-dispatch
+ tmp2978
+ '(#(free-id
+ #(syntax-object unsyntax-splicing ((top) #(ribcage () () ()) #(ribcage #(q n b* k) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (vqs qs) ((top) (top)) ("i" "i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t))))+ .
+ any)))))
+ ($syntax-dispatch
+ tmp2978
+ '(#(free-id
+ #(syntax-object unsyntax ((top) #(ribcage () () ()) #(ribcage #(q n b* k) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (vqs qs) ((top) (top)) ("i" "i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t))))+ .
+ any)))))
+ ($syntax-dispatch
+ tmp2978
+ '(#(free-id
+ #(syntax-object quasisyntax ((top) #(ribcage () () ()) #(ribcage #(q n b* k) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (vqs qs) ((top) (top)) ("i" "i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t))))+ .
+ any))))
+ q2977)))
+ (vqs2927 (lambda (x*2942 n2941 b*2940 k2939)
+ (if (null? x*2942)
+ (k2939 b*2940 '())
+ (vqs2927
+ (cdr x*2942)
+ n2941
+ b*2940
+ (lambda (b*2944 xnew*2943)
+ ((lambda (tmp2945)
+ ((lambda (tmp2946)
+ (if (if tmp2946
+ (apply
+ (lambda (q2947)
+ (= n2941 '0))
+ tmp2946)
+ '#f)
+ (apply
+ (lambda (q2948)
+ ((lambda (tmp2949)
+ ((lambda (tmp2951)
+ (if tmp2951
+ (apply
+ (lambda (t2952)
+ (k2939
+ (append
+ (map list
+ t2952
+ q2948)
+ b*2944)
+ (append
+ t2952
+ xnew*2943)))
+ tmp2951)
+ (syntax-error
+ tmp2949)))
+ ($syntax-dispatch
+ tmp2949
+ 'each-any)))
+ (generate-temporaries
+ q2948)))
+ tmp2946)
+ ((lambda (tmp2956)
+ (if (if tmp2956
+ (apply
+ (lambda (q2957)
+ (= n2941 '0))
+ tmp2956)
+ '#f)
+ (apply
+ (lambda (q2958)
+ ((lambda (tmp2959)
+ ((lambda (tmp2961)
+ (if tmp2961
+ (apply
+ (lambda (t2962)
+ (k2939
+ (append
+ (map (lambda (tmp2970
+ tmp2969)
+ (list
+ (cons
+ tmp2969
+ '(#(syntax-object ... ((top) #(ribcage #(t) #((top)) #("i")) #(ribcage #(q) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b* xnew*) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x* n b* k) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (vqs qs) ((top) (top)) ("i" "i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))))+ tmp2970))
+ q2958
+ t2962)
+ b*2944)
+ ((lambda (tmp2963)
+ ((lambda (tmp2965)
+ (if tmp2965
+ (apply
+ (lambda (m2966)
+ (append
+ (apply
+ append
+ m2966)
+ xnew*2943))
+ tmp2965)
+ (syntax-error
+ tmp2963)))
+ ($syntax-dispatch
+ tmp2963
+ '#(each
+ each-any))))
+ (map (lambda (tmp2964)
+ (cons
+ tmp2964
+ '(#(syntax-object ... ((top) #(ribcage #(t) #((top)) #("i")) #(ribcage #(q) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b* xnew*) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x* n b* k) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (vqs qs) ((top) (top)) ("i" "i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t))))))+ t2962))))
+ tmp2961)
+ (syntax-error
+ tmp2959)))
+ ($syntax-dispatch
+ tmp2959
+ 'each-any)))
+ (generate-temporaries
+ q2958)))
+ tmp2956)
+ ((lambda (_2971)
+ (qs2926
+ (car x*2942)
+ n2941
+ b*2944
+ (lambda (b*2973
+ xnew2972)
+ (k2939
+ b*2973
+ (cons
+ xnew2972
+ xnew*2943)))))
+ tmp2945)))
+ ($syntax-dispatch
+ tmp2945
+ '(#(free-id
+ #(syntax-object unsyntax-splicing ((top) #(ribcage () () ()) #(ribcage #(b* xnew*) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x* n b* k) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (vqs qs) ((top) (top)) ("i" "i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t))))+ .
+ each-any)))))
+ ($syntax-dispatch
+ tmp2945
+ '(#(free-id
+ #(syntax-object unsyntax ((top) #(ribcage () () ()) #(ribcage #(b* xnew*) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x* n b* k) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (vqs qs) ((top) (top)) ("i" "i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t))))+ .
+ each-any))))
+ (car x*2942))))))))
+ ((lambda (tmp2928)
+ ((lambda (tmp2929)
+ (if tmp2929
+ (apply
+ (lambda (_2931 x2930)
+ (qs2926
+ x2930
+ '0
+ '()
+ (lambda (b*2933 xnew2932)
+ (if (eq? xnew2932 x2930)
+ (list
+ '#(syntax-object syntax ((top) #(ribcage () () ()) #(ribcage #(b* xnew) #((top) (top)) #("i" "i")) #(ribcage #(_ x) #((top) (top)) #("i" "i")) #(ribcage (vqs qs) ((top) (top)) ("i" "i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ x2930)
+ ((lambda (tmp2934)
+ ((lambda (tmp2935)
+ (if tmp2935
+ (apply
+ (lambda (b2937 x2936)
+ (list
+ '#(syntax-object with-syntax ((top) #(ribcage #(b x) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(b* xnew) #((top) (top)) #("i" "i")) #(ribcage #(_ x) #((top) (top)) #("i" "i")) #(ribcage (vqs qs) ((top) (top)) ("i" "i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ b2937
+ (list
+ '#(syntax-object syntax ((top) #(ribcage #(b x) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(b* xnew) #((top) (top)) #("i" "i")) #(ribcage #(_ x) #((top) (top)) #("i" "i")) #(ribcage (vqs qs) ((top) (top)) ("i" "i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ x2936)))
+ tmp2935)
+ (syntax-error tmp2934)))
+ ($syntax-dispatch
+ tmp2934
+ '(each-any any))))
+ (list b*2933 xnew2932))))))
+ tmp2929)
+ (syntax-error tmp2928)))
+ ($syntax-dispatch tmp2928 '(any any))))
+ x2925)))
+ '*top*)
+($sc-put-cte
+ '#(syntax-object unsyntax ((top) #(ribcage #(unsyntax) #((top)) #(unsyntax))))
+ (lambda (x3067) (syntax-error x3067 '"misplaced"))
+ '*top*)
+($sc-put-cte
+ '#(syntax-object unsyntax-splicing ((top) #(ribcage #(unsyntax-splicing) #((top)) #(unsyntax-splicing))))
+ (lambda (x3068) (syntax-error x3068 '"misplaced"))
+ '*top*)
+($sc-put-cte
+ '#(syntax-object include ((top) #(ribcage #(include) #((top)) #(include))))
+ (lambda (x3069)
+ (letrec ((read-file3070 (lambda (fn3081 k3080)
+ ((lambda (p3082)
+ ((letrec ((f3083 (lambda ()
+ ((lambda (x3084)
+ (if (eof-object?
+ x3084)
+ (begin
+ (close-input-port
+ p3082)
+ '())
+ (cons
+ (datum->syntax-object
+ k3080
+ x3084)
+ (f3083))))
+ (read p3082)))))
+ f3083)))
+ (open-input-file fn3081)))))
+ ((lambda (tmp3071)
+ ((lambda (tmp3072)
+ (if tmp3072
+ (apply
+ (lambda (k3074 filename3073)
+ ((lambda (fn3075)
+ ((lambda (tmp3076)
+ ((lambda (tmp3077)
+ (if tmp3077
+ (apply
+ (lambda (exp3078)
+ (cons
+ '#(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ exp3078))
+ tmp3077)
+ (syntax-error tmp3076)))
+ ($syntax-dispatch tmp3076 'each-any)))
+ (read-file3070 fn3075 k3074)))
+ (syntax-object->datum filename3073)))
+ tmp3072)
+ (syntax-error tmp3071)))
+ ($syntax-dispatch tmp3071 '(any any))))
+ x3069)))
+ '*top*)
+($sc-put-cte
+ '#(syntax-object case ((top) #(ribcage #(case) #((top)) #(case))))
+ (lambda (x3085)
+ ((lambda (tmp3086)
+ ((lambda (tmp3087)
+ (if tmp3087
+ (apply
+ (lambda (_3091 e3090 m13089 m23088)
+ ((lambda (tmp3092)
+ ((lambda (body3119)
+ (list
+ '#(syntax-object let ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (list
+ (list
+ '#(syntax-object t ((top) #(ribcage #(body) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ e3090))
+ body3119))
+ tmp3092))
+ ((letrec ((f3093 (lambda (clause3095 clauses3094)
+ (if (null? clauses3094)
+ ((lambda (tmp3096)
+ ((lambda (tmp3097)
+ (if tmp3097
+ (apply
+ (lambda (e13099
+ e23098)
+ (cons
+ '#(syntax-object begin ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons
+ e13099
+ e23098)))
+ tmp3097)
+ ((lambda (tmp3101)
+ (if tmp3101
+ (apply
+ (lambda (k3104
+ e13103
+ e23102)
+ (list
+ '#(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (list
+ '#(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ '#(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (list
+ '#(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ k3104))
+ (cons
+ '#(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons
+ e13103
+ e23102))))
+ tmp3101)
+ ((lambda (_3107)
+ (syntax-error
+ x3085))
+ tmp3096)))
+ ($syntax-dispatch
+ tmp3096
+ '(each-any
+ any
+ .
+ each-any)))))
+ ($syntax-dispatch
+ tmp3096
+ '(#(free-id
+ #(syntax-object else ((top) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t))))+ any
+ .
+ each-any))))
+ clause3095)
+ ((lambda (tmp3108)
+ ((lambda (rest3109)
+ ((lambda (tmp3110)
+ ((lambda (tmp3111)
+ (if tmp3111
+ (apply
+ (lambda (k3114
+ e13113
+ e23112)
+ (list
+ '#(syntax-object if ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (list
+ '#(syntax-object memv ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ '#(syntax-object t ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (list
+ '#(syntax-object quote ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ k3114))
+ (cons
+ '#(syntax-object begin ((top) #(ribcage #(k e1 e2) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(rest) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(clause clauses) #((top) (top)) #("i" "i")) #(ribcage #(f) #((top)) #("i")) #(ribcage #(_ e m1 m2) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))+ (cons
+ e13113
+ e23112))
+ rest3109))
+ tmp3111)
+ ((lambda (_3117)
+ (syntax-error
+ x3085))
+ tmp3110)))
+ ($syntax-dispatch
+ tmp3110
+ '(each-any
+ any
+ .
+ each-any))))
+ clause3095))
+ tmp3108))
+ (f3093
+ (car clauses3094)
+ (cdr clauses3094)))))))
+ f3093)
+ m13089
+ m23088)))
+ tmp3087)
+ (syntax-error tmp3086)))
+ ($syntax-dispatch tmp3086 '(any any any . each-any))))
+ x3085))
+ '*top*)
+($sc-put-cte
+ '#(syntax-object identifier-syntax ((top) #(ribcage #(identifier-syntax) #((top)) #(identifier-syntax))))
+ (lambda (x3120)
+ ((lambda (tmp3121)
+ ((lambda (tmp3122)
+ (if tmp3122
+ (apply
+ (lambda (dummy3124 e3123)
+ (list
+ '#(syntax-object lambda ((top) #(ribcage #(dummy e) #(("m" top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ '#(syntax-object (x) ((top) #(ribcage #(dummy e) #(("m" top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ (list
+ '#(syntax-object syntax-case ((top) #(ribcage #(dummy e) #(("m" top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ '#(syntax-object x ((top) #(ribcage #(dummy e) #(("m" top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ '()
+ (list
+ '#(syntax-object id ((top) #(ribcage #(dummy e) #(("m" top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ '#(syntax-object (identifier? (syntax id)) ((top) #(ribcage #(dummy e) #(("m" top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ (list
+ '#(syntax-object syntax ((top) #(ribcage #(dummy e) #(("m" top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ e3123))
+ (list
+ '(#(syntax-object _ ((top) #(ribcage #(dummy e) #(("m" top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ #(syntax-object x ((top) #(ribcage #(dummy e) #(("m" top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ #(syntax-object ... ((top) #(ribcage #(dummy e) #(("m" top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t))))+ (list
+ '#(syntax-object syntax ((top) #(ribcage #(dummy e) #(("m" top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ (cons
+ e3123
+ '(#(syntax-object x ((top) #(ribcage #(dummy e) #(("m" top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ #(syntax-object ... ((top) #(ribcage #(dummy e) #(("m" top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t))))))))))+ tmp3122)
+ ((lambda (tmp3125)
+ (if (if tmp3125
+ (apply
+ (lambda (dummy3131 id3130 exp13129 var3128
+ val3127 exp23126)
+ (if (identifier? id3130)
+ (identifier? var3128)
+ '#f))
+ tmp3125)
+ '#f)
+ (apply
+ (lambda (dummy3137 id3136 exp13135 var3134 val3133
+ exp23132)
+ (list
+ '#(syntax-object cons ((top) #(ribcage #(dummy id exp1 var val exp2) #(("m" top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ '#(syntax-object (quote macro!) ((top) #(ribcage #(dummy id exp1 var val exp2) #(("m" top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ (list
+ '#(syntax-object lambda ((top) #(ribcage #(dummy id exp1 var val exp2) #(("m" top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ '#(syntax-object (x) ((top) #(ribcage #(dummy id exp1 var val exp2) #(("m" top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ (list
+ '#(syntax-object syntax-case ((top) #(ribcage #(dummy id exp1 var val exp2) #(("m" top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ '#(syntax-object x ((top) #(ribcage #(dummy id exp1 var val exp2) #(("m" top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ '#(syntax-object (set!) ((top) #(ribcage #(dummy id exp1 var val exp2) #(("m" top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ (list
+ (list
+ '#(syntax-object set! ((top) #(ribcage #(dummy id exp1 var val exp2) #(("m" top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ var3134
+ val3133)
+ (list
+ '#(syntax-object syntax ((top) #(ribcage #(dummy id exp1 var val exp2) #(("m" top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ exp23132))
+ (list
+ (cons
+ id3136
+ '(#(syntax-object x ((top) #(ribcage #(dummy id exp1 var val exp2) #(("m" top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ #(syntax-object ... ((top) #(ribcage #(dummy id exp1 var val exp2) #(("m" top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))))+ (list
+ '#(syntax-object syntax ((top) #(ribcage #(dummy id exp1 var val exp2) #(("m" top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ (cons
+ exp13135
+ '(#(syntax-object x ((top) #(ribcage #(dummy id exp1 var val exp2) #(("m" top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ #(syntax-object ... ((top) #(ribcage #(dummy id exp1 var val exp2) #(("m" top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))))))+ (list
+ id3136
+ (list
+ '#(syntax-object identifier? ((top) #(ribcage #(dummy id exp1 var val exp2) #(("m" top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ (list
+ '#(syntax-object syntax ((top) #(ribcage #(dummy id exp1 var val exp2) #(("m" top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ id3136))
+ (list
+ '#(syntax-object syntax ((top) #(ribcage #(dummy id exp1 var val exp2) #(("m" top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))+ exp13135))))))
+ tmp3125)
+ (syntax-error tmp3121)))
+ ($syntax-dispatch
+ tmp3121
+ '(any (any any)
+ ((#(free-id
+ #(syntax-object set! ((top) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t))))+ any
+ any)
+ any))))))
+ ($syntax-dispatch tmp3121 '(any any))))
+ x3120))
+ '*top*)
--- /dev/null
+++ b/femtolisp/lib/psyntax.ss
@@ -1,0 +1,4295 @@
+;;; Portable implementation of syntax-case
+;;; Extracted from Chez Scheme Version 7.3 (Feb 26, 2007)
+;;; Authors: R. Kent Dybvig, Oscar Waddell, Bob Hieb, Carl Bruggeman
+
+;;; Copyright (c) 1992-2002 Cadence Research Systems
+;;; Permission to copy this software, in whole or in part, to use this
+;;; software for any lawful purpose, and to redistribute this software
+;;; is granted subject to the restriction that all copies made of this
+;;; software must include this copyright notice in full. This software
+;;; is provided AS IS, with NO WARRANTY, EITHER EXPRESS OR IMPLIED,
+;;; INCLUDING BUT NOT LIMITED TO IMPLIED WARRANTIES OF MERCHANTABILITY
+;;; OR FITNESS FOR ANY PARTICULAR PURPOSE. IN NO EVENT SHALL THE
+;;; AUTHORS BE LIABLE FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES OF ANY
+;;; NATURE WHATSOEVER.
+
+;;; Before attempting to port this code to a new implementation of
+;;; Scheme, please read the notes below carefully.
+
+;;; This file defines the syntax-case expander, sc-expand, and a set
+;;; of associated syntactic forms and procedures. Of these, the
+;;; following are documented in The Scheme Programming Language,
+;;; Third Edition (R. Kent Dybvig, MIT Press, 2003), which can be
+;;; found online at http://www.scheme.com/tspl3/. Most are also documented
+;;; in the R4RS and draft R5RS.
+;;;
+;;; bound-identifier=?
+;;; datum->syntax-object
+;;; define-syntax
+;;; fluid-let-syntax
+;;; free-identifier=?
+;;; generate-temporaries
+;;; identifier?
+;;; identifier-syntax
+;;; let-syntax
+;;; letrec-syntax
+;;; syntax
+;;; syntax-case
+;;; syntax-object->datum
+;;; syntax-rules
+;;; with-syntax
+;;;
+;;; All standard Scheme syntactic forms are supported by the expander
+;;; or syntactic abstractions defined in this file. Only the R4RS
+;;; delay is omitted, since its expansion is implementation-dependent.
+
+;;; Also defined are three forms that support modules: module, import,
+;;; and import-only. These are documented in the Chez Scheme User's
+;;; Guide (R. Kent Dybvig, Cadence Research Systems, 1998), which can
+;;; also be found online at http://www.scheme.com/csug/. They are
+;;; described briefly here as well.
+
+;;; All are definitions and may appear where and only where other
+;;; definitions may appear. modules may be named:
+;;;
+;;; (module id (ex ...) defn ... init ...)
+;;;
+;;; or anonymous:
+;;;
+;;; (module (ex ...) defn ... init ...)
+;;;
+;;; The latter form is semantically equivalent to:
+;;;
+;;; (module T (ex ...) defn ... init ...)
+;;; (import T)
+;;;
+;;; where T is a fresh identifier.
+;;;
+;;; In either form, each of the exports in (ex ...) is either an
+;;; identifier or of the form (id ex ...). In the former case, the
+;;; single identifier ex is exported. In the latter, the identifier
+;;; id is exported and the exports ex ... are "implicitly" exported.
+;;; This listing of implicit exports is useful only when id is a
+;;; keyword bound to a transformer that expands into references to
+;;; the listed implicit exports. In the present implementation,
+;;; listing of implicit exports is necessary only for top-level
+;;; modules and allows the implementation to avoid placing all
+;;; identifiers into the top-level environment where subsequent passes
+;;; of the compiler will be unable to deal effectively with them.
+;;;
+;;; Named modules may be referenced in import statements, which
+;;; always take one of the forms:
+;;;
+;;; (import id)
+;;; (import-only id)
+;;;
+;;; id must name a module. Each exported identifier becomes visible
+;;; within the scope of the import form. In the case of import-only,
+;;; all other identifiers become invisible in the scope of the
+;;; import-only form, except for those established by definitions
+;;; that appear textually after the import-only form.
+
+;;; import and import-only also support a variety of identifier
+;;; selection and renaming forms: only, except, add-prefix,
+;;; drop-prefix, rename, and alias.
+;;;
+;;; (import (only m x y))
+;;;
+;;; imports x and y (and nothing else) from m.
+;;;
+;;; (import (except m x y))
+;;;
+;;; imports all of m's imports except for x and y.
+;;;
+;;; (import (add-prefix (only m x y) m:))
+;;;
+;;; imports x and y as m:x and m:y.
+;;;
+;;; (import (drop-prefix m foo:))
+;;;
+;;; imports all of m's imports, dropping the common foo: prefix
+;;; (which must appear on all of m's exports).
+;;;
+;;; (import (rename (except m a b) (m-c c) (m-d d)))
+;;;
+;;; imports all of m's imports except for x and y, renaming c
+;;; m-c and d m-d.
+;;;
+;;; (import (alias (except m a b) (m-c c) (m-d d)))
+;;;
+;;; imports all of m's imports except for x and y, with additional
+;;; aliases m-c for c and m-d for d.
+;;;
+;;; multiple imports may be specified with one import form:
+;;;
+;;; (import (except m1 x) (only m2 x))
+;;;
+;;; imports all of m1's exports except for x plus x from m2.
+
+;;; Another form, meta, may be used as a prefix for any definition and
+;;; causes any resulting variable bindings to be created at expansion
+;;; time. Meta variables (variables defined using meta) are available
+;;; only at expansion time. Meta definitions are often used to create
+;;; data and helpers that can be shared by multiple macros, for example:
+
+;;; (module (alpha beta)
+;;; (meta define key-error
+;;; (lambda (key)
+;;; (syntax-error key "invalid key")))
+;;; (meta define parse-keys
+;;; (lambda (keys)
+;;; (let f ((keys keys) (c #'white) (s 10))
+;;; (syntax-case keys (color size)
+;;; (() (list c s))
+;;; (((color c) . keys) (f #'keys #'c s))
+;;; (((size s) . keys) (f #'keys c #'s))
+;;; ((k . keys) (key-error #'k))))))
+;;; (define-syntax alpha
+;;; (lambda (x)
+;;; (syntax-case x ()
+;;; ((_ (k ...) <other stuff>)
+;;; (with-syntax (((c s) (parse-keys (syntax (k ...)))))
+;;; ---)))))
+;;; (define-syntax beta
+;;; (lambda (x)
+;;; (syntax-case x ()
+;;; ((_ (k ...) <other stuff>)
+;;; (with-syntax (((c s) (parse-keys (syntax (k ...)))))
+;;; ---))))))
+
+;;; As with define-syntax rhs expressions, meta expressions can evaluate
+;;; references only to identifiers whose values are (already) available
+;;; in the compile-time environment, e.g., macros and meta variables.
+;;; They can, however, like define-syntax rhs expressions, build syntax
+;;; objects containing occurrences of any identifiers in their scope.
+
+;;; meta definitions propagate through macro expansion, so one can write,
+;;; for example:
+;;;
+;;; (module (a)
+;;; (meta define-structure (foo x))
+;;; (define-syntax a
+;;; (let ((q (make-foo (syntax 'q))))
+;;; (lambda (x)
+;;; (foo-x q)))))
+;;; a -> q
+;;;
+;;; where define-record is a macro that expands into a set of defines.
+;;;
+;;; It is also sometimes convenient to write
+;;;
+;;; (meta begin defn ...)
+;;;
+;;; or
+;;;
+;;; (meta module {exports} defn ...)+;;;
+;;; to create groups of meta bindings.
+
+;;; Another form, alias, is used to create aliases from one identifier
+;;; to another. This is used primarily to support the extended import
+;;; syntaxes (add-prefix, drop-prefix, rename, and alias).
+
+;;; (let ((x 3)) (alias y x) y) -> 3
+
+;;; The remaining exports are listed below. sc-expand, eval-when, and
+;;; syntax-error are described in the Chez Scheme User's Guide.
+;;;
+;;; (sc-expand datum)
+;;; if datum represents a valid expression, sc-expand returns an
+;;; expanded version of datum in a core language that includes no
+;;; syntactic abstractions. The core language includes begin,
+;;; define, if, lambda, letrec, quote, and set!.
+;;; (eval-when situations expr ...)
+;;; conditionally evaluates expr ... at compile-time or run-time
+;;; depending upon situations
+;;; (syntax-error object message)
+;;; used to report errors found during expansion
+;;; ($syntax-dispatch e p)
+;;; used by expanded code to handle syntax-case matching
+;;; ($sc-put-cte symbol val top-token)
+;;; used to establish top-level compile-time (expand-time) bindings.
+
+;;; The following nonstandard procedures must be provided by the
+;;; implementation for this code to run.
+;;;
+;;; (void)
+;;; returns the implementation's cannonical "unspecified value". The
+;;; following usually works:
+;;;
+;;; (define void (lambda () (if #f #f))).
+;;;
+;;; (andmap proc list1 list2 ...)
+;;; returns true if proc returns true when applied to each element of list1
+;;; along with the corresponding elements of list2 .... The following
+;;; definition works but does no error checking:
+;;;
+;;; (define andmap
+;;; (lambda (f first . rest)
+;;; (or (null? first)
+;;; (if (null? rest)
+;;; (let andmap ((first first))
+;;; (let ((x (car first)) (first (cdr first)))
+;;; (if (null? first)
+;;; (f x)
+;;; (and (f x) (andmap first)))))
+;;; (let andmap ((first first) (rest rest))
+;;; (let ((x (car first))
+;;; (xr (map car rest))
+;;; (first (cdr first))
+;;; (rest (map cdr rest)))
+;;; (if (null? first)
+;;; (apply f (cons x xr))
+;;; (and (apply f (cons x xr)) (andmap first rest)))))))))
+;;;
+;;; (ormap proc list1)
+;;; returns the first non-false return result of proc applied to
+;;; the elements of list1 or false if none. The following definition
+;;; works but does no error checking:
+;;;
+;;; (define ormap
+;;; (lambda (proc list1)
+;;; (and (not (null? list1))
+;;; (or (proc (car list1)) (ormap proc (cdr list1))))))
+;;;
+;;; The following nonstandard procedures must also be provided by the
+;;; implementation for this code to run using the standard portable
+;;; hooks and output constructors. They are not used by expanded code,
+;;; and so need be present only at expansion time.
+;;;
+;;; (eval x)
+;;; where x is always in the form ("noexpand" expr).+;;; returns the value of expr. the "noexpand" flag is used to tell the
+;;; evaluator/expander that no expansion is necessary, since expr has
+;;; already been fully expanded to core forms.
+;;;
+;;; eval will not be invoked during the loading of psyntax.pp. After
+;;; psyntax.pp has been loaded, the expansion of any macro definition,
+;;; whether local or global, results in a call to eval. If, however,
+;;; sc-expand has already been registered as the expander to be used
+;;; by eval, and eval accepts one argument, nothing special must be done
+;;; to support the "noexpand" flag, since it is handled by sc-expand.
+;;;
+;;; (error who format-string why what)
+;;; where who is either a symbol or #f, format-string is always "~a ~s",
+;;; why is always a string, and what may be any object. error should
+;;; signal an error with a message something like
+;;;
+;;; "error in <who>: <why> <what>"
+;;;
+;;; (gensym)
+;;; returns a unique symbol each time it's called. In Chez Scheme, gensym
+;;; returns a symbol with a "globally" unique name so that gensyms that
+;;; end up in the object code of separately compiled files cannot conflict.
+;;; This is necessary only if you intend to support compiled files.
+;;;
+;;; (gensym? x)
+;;; returns #t if x is a gensym, otherwise false.
+;;;
+;;; (putprop symbol key value)
+;;; (getprop symbol key)
+;;; (remprop symbol key)
+;;; key is always a symbol; value may be any object. putprop should
+;;; associate the given value with the given symbol and key in some way
+;;; that it can be retrieved later with getprop. getprop should return
+;;; #f if no value is associated with the given symbol and key. remprop
+;;; should remove the association between the given symbol and key.
+
+;;; When porting to a new Scheme implementation, you should define the
+;;; procedures listed above, load the expanded version of psyntax.ss
+;;; (psyntax.pp, which should be available whereever you found
+;;; psyntax.ss), and register sc-expand as the current expander (how
+;;; you do this depends upon your implementation of Scheme). You may
+;;; change the hooks and constructors defined toward the beginning of
+;;; the code below, but to avoid bootstrapping problems, do so only
+;;; after you have a working version of the expander.
+
+;;; Chez Scheme allows the syntactic form (syntax <template>) to be
+;;; abbreviated to #'<template>, just as (quote <datum>) may be
+;;; abbreviated to '<datum>. The #' syntax makes programs written
+;;; using syntax-case shorter and more readable and draws out the
+;;; intuitive connection between syntax and quote. If you have access
+;;; to the source code of your Scheme system's reader, you might want
+;;; to implement this extension.
+
+;;; If you find that this code loads or runs slowly, consider
+;;; switching to faster hardware or a faster implementation of
+;;; Scheme. In Chez Scheme on a 200Mhz Pentium Pro, expanding,
+;;; compiling (with full optimization), and loading this file takes
+;;; between one and two seconds.
+
+;;; In the expander implementation, we sometimes use syntactic abstractions
+;;; when procedural abstractions would suffice. For example, we define
+;;; top-wrap and top-marked? as
+;;; (define-syntax top-wrap (identifier-syntax '((top))))
+;;; (define-syntax top-marked?
+;;; (syntax-rules ()
+;;; ((_ w) (memq 'top (wrap-marks w)))))
+;;; rather than
+;;; (define top-wrap '((top)))
+;;; (define top-marked?
+;;; (lambda (w) (memq 'top (wrap-marks w))))
+;;; On ther other hand, we don't do this consistently; we define make-wrap,
+;;; wrap-marks, and wrap-subst simply as
+;;; (define make-wrap cons)
+;;; (define wrap-marks car)
+;;; (define wrap-subst cdr)
+;;; In Chez Scheme, the syntactic and procedural forms of these
+;;; abstractions are equivalent, since the optimizer consistently
+;;; integrates constants and small procedures. Some Scheme
+;;; implementations, however, may benefit from more consistent use
+;;; of one form or the other.
+
+
+;;; Implementation notes:
+
+;;; "begin" is treated as a splicing construct at top level and at
+;;; the beginning of bodies. Any sequence of expressions that would
+;;; be allowed where the "begin" occurs is allowed.
+
+;;; "let-syntax" and "letrec-syntax" are also treated as splicing
+;;; constructs, in violation of the R5RS. A consequence is that let-syntax
+;;; and letrec-syntax do not create local contours, as do let and letrec.
+;;; Although the functionality is greater as it is presently implemented,
+;;; we will probably change it to conform to the R5RS. modules provide
+;;; similar functionality to nonsplicing letrec-syntax when the latter is
+;;; used as a definition.
+
+;;; Objects with no standard print syntax, including objects containing
+;;; cycles and syntax objects, are allowed in quoted data as long as they
+;;; are contained within a syntax form or produced by datum->syntax-object.
+;;; Such objects are never copied.
+
+;;; When the expander encounters a reference to an identifier that has
+;;; no global or lexical binding, it treats it as a global-variable
+;;; reference. This allows one to write mutually recursive top-level
+;;; definitions, e.g.:
+;;;
+;;; (define f (lambda (x) (g x)))
+;;; (define g (lambda (x) (f x)))
+;;;
+;;; but may not always yield the intended when the variable in question
+;;; is later defined as a keyword.
+
+;;; Top-level variable definitions of syntax keywords are permitted.
+;;; In order to make this work, top-level define not only produces a
+;;; top-level definition in the core language, but also modifies the
+;;; compile-time environment (using $sc-put-cte) to record the fact
+;;; that the identifier is a variable.
+
+;;; Top-level definitions of macro-introduced identifiers are visible
+;;; only in code produced by the macro. That is, a binding for a
+;;; hidden (generated) identifier is created instead, and subsequent
+;;; references within the macro output are renamed accordingly. For
+;;; example:
+;;;
+;;; (define-syntax a
+;;; (syntax-rules ()
+;;; ((_ var exp)
+;;; (begin
+;;; (define secret exp)
+;;; (define var
+;;; (lambda ()
+;;; (set! secret (+ secret 17))
+;;; secret))))))
+;;; (a x 0)
+;;; (x) => 17
+;;; (x) => 34
+;;; secret => Error: variable secret is not bound
+;;;
+;;; The definition above would fail if the definition for secret
+;;; were placed after the definition for var, since the expander would
+;;; encounter the references to secret before the definition that
+;;; establishes the compile-time map from the identifier secret to
+;;; the generated identifier.
+
+;;; Identifiers and syntax objects are implemented as vectors for
+;;; portability. As a result, it is possible to "forge" syntax
+;;; objects.
+
+;;; The input to sc-expand may contain "annotations" describing, e.g., the
+;;; source file and character position from where each object was read if
+;;; it was read from a file. These annotations are handled properly by
+;;; sc-expand only if the annotation? hook (see hooks below) is implemented
+;;; properly and the operators annotation-expression and annotation-stripped
+;;; are supplied. If annotations are supplied, the proper annotated
+;;; expression is passed to the various output constructors, allowing
+;;; implementations to accurately correlate source and expanded code.
+;;; Contact one of the authors for details if you wish to make use of
+;;; this feature.
+
+;;; Implementation of modules:
+;;;
+;;; The implementation of modules requires that implicit top-level exports
+;;; be listed with the exported macro at some level where both are visible,
+;;; e.g.,
+;;;
+;;; (module M (alpha (beta b))
+;;; (module ((alpha a) b)
+;;; (define-syntax alpha (identifier-syntax a))
+;;; (define a 'a)
+;;; (define b 'b))
+;;; (define-syntax beta (identifier-syntax b)))
+;;;
+;;; Listing of implicit imports is not needed for macros that do not make
+;;; it out to top level, including all macros that are local to a "body".
+;;; (They may be listed in this case, however.) We need this information
+;;; for top-level modules since a top-level module expands into a letrec
+;;; for non-top-level variables and top-level definitions (assignments) for
+;;; top-level variables. Because of the general nature of macro
+;;; transformers, we cannot determine the set of implicit exports from the
+;;; transformer code, so without the user's help, we'd have to put all
+;;; variables at top level.
+;;;
+;;; Each such top-level identifier is given a generated name (gensym).
+;;; When a top-level module is imported at top level, a compile-time
+;;; alias is established from the top-level name to the generated name.
+;;; The expander follows these aliases transparently. When any module is
+;;; imported anywhere other than at top level, the id-var-name of the
+;;; import identifier is set to the id-var-name of the export identifier.
+;;; Since we can't determine the actual labels for identifiers defined in
+;;; top-level modules until we determine which are placed in the letrec
+;;; and which make it to top level, we give each an "indirect" label---a
+;;; pair whose car will eventually contain the actual label. Import does
+;;; not follow the indirect, but id-var-name does.
+;;;
+;;; All identifiers defined within a local module are folded into the
+;;; letrec created for the enclosing body. Visibility is controlled in
+;;; this case and for nested top-level modules by introducing a new wrap
+;;; for each module.
+
+
+;;; Bootstrapping:
+
+;;; When changing syntax-object representations, it is necessary to support
+;;; both old and new syntax-object representations in id-var-name. It
+;;; should be sufficient to redefine syntax-object-expression to work for
+;;; both old and new representations and syntax-object-wrap to return the
+;;; empty-wrap for old representations.
+
+
+;;; The following set of definitions establishes bindings for the
+;;; top-level variables assigned values in the let expression below.
+;;; Uncomment them here and copy them to the front of psyntax.pp if
+;;; required by your system.
+
+; (define $sc-put-cte #f)
+; (define sc-expand #f)
+; (define $make-environment #f)
+; (define environment? #f)
+; (define interaction-environment #f)
+; (define identifier? #f)
+; (define syntax->list #f)
+; (define syntax-object->datum #f)
+; (define datum->syntax-object #f)
+; (define generate-temporaries #f)
+; (define free-identifier=? #f)
+; (define bound-identifier=? #f)
+; (define literal-identifier=? #f)
+; (define syntax-error #f)
+; (define $syntax-dispatch #f)
+
+(let ()
+
+(define-syntax when
+ (syntax-rules ()
+ ((_ test e1 e2 ...) (if test (begin e1 e2 ...)))))
+(define-syntax unless
+ (syntax-rules ()
+ ((_ test e1 e2 ...) (when (not test) (begin e1 e2 ...)))))
+(define-syntax define-structure
+ (lambda (x)
+ (define construct-name
+ (lambda (template-identifier . args)
+ (datum->syntax-object
+ template-identifier
+ (string->symbol
+ (apply string-append
+ (map (lambda (x)
+ (if (string? x)
+ x
+ (symbol->string (syntax-object->datum x))))
+ args))))))
+ (syntax-case x ()
+ ((_ (name id1 ...))
+ (andmap identifier? (syntax (name id1 ...)))
+ (with-syntax
+ ((constructor (construct-name (syntax name) "make-" (syntax name)))
+ (predicate (construct-name (syntax name) (syntax name) "?"))
+ ((access ...)
+ (map (lambda (x) (construct-name x (syntax name) "-" x))
+ (syntax (id1 ...))))
+ ((assign ...)
+ (map (lambda (x)
+ (construct-name x "set-" (syntax name) "-" x "!"))
+ (syntax (id1 ...))))
+ (structure-length
+ (+ (length (syntax (id1 ...))) 1))
+ ((index ...)
+ (let f ((i 1) (ids (syntax (id1 ...))))
+ (if (null? ids)
+ '()
+ (cons i (f (+ i 1) (cdr ids)))))))
+ (syntax (begin
+ (define constructor
+ (lambda (id1 ...)
+ (vector 'name id1 ... )))
+ (define predicate
+ (lambda (x)
+ (and (vector? x)
+ (= (vector-length x) structure-length)
+ (eq? (vector-ref x 0) 'name))))
+ (define access
+ (lambda (x)
+ (vector-ref x index)))
+ ...
+ (define assign
+ (lambda (x update)
+ (vector-set! x index update)))
+ ...)))))))
+
+(define-syntax let-values ; impoverished one-clause version
+ (syntax-rules ()
+ ((_ ((formals expr)) form1 form2 ...)
+ (call-with-values (lambda () expr) (lambda formals form1 form2 ...)))))
+
+(define noexpand "noexpand")
+
+(define-structure (syntax-object expression wrap))
+
+;;; hooks to nonportable run-time helpers
+(begin
+(define-syntax fx+ (identifier-syntax +))
+(define-syntax fx- (identifier-syntax -))
+(define-syntax fx= (identifier-syntax =))
+(define-syntax fx< (identifier-syntax <))
+(define-syntax fx> (identifier-syntax >))
+(define-syntax fx<= (identifier-syntax <=))
+(define-syntax fx>= (identifier-syntax >=))
+
+(define annotation? (lambda (x) #f))
+
+; top-level-eval-hook is used to create "permanent" code (e.g., top-level
+; transformers), so it might be a good idea to compile it
+(define top-level-eval-hook
+ (lambda (x)
+ (eval `(,noexpand ,x))))
+
+; local-eval-hook is used to create "temporary" code (e.g., local
+; transformers), so it might be a good idea to interpret it
+(define local-eval-hook
+ (lambda (x)
+ (eval `(,noexpand ,x))))
+
+(define define-top-level-value-hook
+ (lambda (sym val)
+ (top-level-eval-hook
+ (build-global-definition no-source sym
+ (build-data no-source val)))))
+
+(define error-hook
+ (lambda (who why what)
+ (error who "~a ~s" why what)))
+
+(define put-cte-hook
+ (lambda (symbol val)
+ ($sc-put-cte symbol val '*top*)))
+
+(define get-global-definition-hook
+ (lambda (symbol)
+ (getprop symbol '*sc-expander*)))
+
+(define put-global-definition-hook
+ (lambda (symbol x)
+ (if (not x)
+ (remprop symbol '*sc-expander*)
+ (putprop symbol '*sc-expander* x))))
+
+; if you treat certain bindings (say from environments like ieee or r5rs)
+; read-only, this should return #t for those bindings
+(define read-only-binding?
+ (lambda (symbol)
+ #f))
+
+; should return #f if symbol has no binding for token
+(define get-import-binding
+ (lambda (symbol token)
+ (getprop symbol token)))
+
+; remove binding if x is false
+(define update-import-binding!
+ (lambda (symbol token p)
+ (let ((x (p (get-import-binding symbol token))))
+ (if (not x)
+ (remprop symbol token)
+ (putprop symbol token x)))))
+
+;;; generate-id ideally produces globally unique symbols, i.e., symbols
+;;; unique across system runs, to support separate compilation/expansion.
+;;; Use gensyms if you do not need to support separate compilation/
+;;; expansion or if your system's gensym creates globally unique
+;;; symbols (as in Chez Scheme). Otherwise, use the following code
+;;; as a starting point. session-key should be a unique string for each
+;;; system run to support separate compilation; the default value given
+;;; is satisfactory during initial development only.
+(define generate-id
+ (let ((digits "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!$%&*/:<=>?~_^.+-"))
+ (let ((base (string-length digits)) (session-key "_"))
+ (define make-digit (lambda (x) (string-ref digits x)))
+ (define fmt
+ (lambda (n)
+ (let fmt ((n n) (a '()))
+ (if (< n base)
+ (list->string (cons (make-digit n) a))
+ (let ((r (modulo n base)) (rest (quotient n base)))
+ (fmt rest (cons (make-digit r) a)))))))
+ (let ((n -1))
+ (lambda (name) ; name is #f or a symbol
+ (set! n (+ n 1))
+ (string->symbol (string-append session-key (fmt n))))))))
+)
+
+
+
+;;; output constructors
+(begin
+(define-syntax build-application
+ (syntax-rules ()
+ ((_ ae fun-exp arg-exps)
+ `(,fun-exp . ,arg-exps))))
+
+(define-syntax build-conditional
+ (syntax-rules ()
+ ((_ ae test-exp then-exp else-exp)
+ `(if ,test-exp ,then-exp ,else-exp))))
+
+(define-syntax build-lexical-reference
+ (syntax-rules ()
+ ((_ type ae var)
+ var)))
+
+(define-syntax build-lexical-assignment
+ (syntax-rules ()
+ ((_ ae var exp)
+ `(set! ,var ,exp))))
+
+(define-syntax build-global-reference
+ (syntax-rules ()
+ ((_ ae var)
+ var)))
+
+(define-syntax build-global-assignment
+ (syntax-rules ()
+ ((_ ae var exp)
+ `(set! ,var ,exp))))
+
+(define-syntax build-global-definition
+ (syntax-rules ()
+ ((_ ae var exp)
+ `(define ,var ,exp))))
+
+(define-syntax build-cte-install
+ ; should build a call that has the same effect as calling put-cte-hook
+ (syntax-rules ()
+ ((_ sym exp token) `($sc-put-cte ',sym ,exp ',token))))
+
+(define-syntax build-visit-only
+ ; should mark the result as "visit only" for compile-file
+ ; in implementations that support visit/revisit
+ (syntax-rules ()
+ ((_ exp) exp)))
+
+(define-syntax build-revisit-only
+ ; should mark the result as "revisit only" for compile-file,
+ ; in implementations that support visit/revisit
+ (syntax-rules ()
+ ((_ exp) exp)))
+
+(define-syntax build-lambda
+ (syntax-rules ()
+ ((_ ae vars exp)
+ `(lambda ,vars ,exp))))
+
+(define built-lambda?
+ (lambda (x)
+ (and (pair? x) (eq? (car x) 'lambda))))
+
+(define-syntax build-primref
+ (syntax-rules ()
+ ((_ ae name) name)
+ ((_ ae level name) name)))
+
+(define-syntax build-data
+ (syntax-rules ()
+ ((_ ae exp) `',exp)))
+
+(define build-sequence
+ (lambda (ae exps)
+ (let loop ((exps exps))
+ (if (null? (cdr exps))
+ (car exps)
+ ; weed out leading void calls, assuming ordinary list representation
+ (if (equal? (car exps) '(void))
+ (loop (cdr exps))
+ `(begin ,@exps))))))
+
+(define build-letrec
+ (lambda (ae vars val-exps body-exp)
+ (if (null? vars)
+ body-exp
+ `(letrec ,(map list vars val-exps) ,body-exp))))
+
+(define build-body
+ (lambda (ae vars val-exps body-exp)
+ (build-letrec ae vars val-exps body-exp)))
+
+(define build-top-module
+ ; each type is either global (exported) or local (not exported)
+ ; we produce global definitions and assignments for globals and
+ ; letrec bindings for locals. if you don't need the definitions,
+ ; (just assignments) you can eliminate them. if you wish to
+ ; have your module definitions ordered from left-to-right (ala
+ ; letrec*), you can replace the global var-exps with dummy vars
+ ; and global val-exps with global assignments, and produce a letrec*
+ ; in place of a letrec.
+ (lambda (ae types vars val-exps body-exp)
+ (let-values (((vars defns sets)
+ (let f ((types types) (vars vars))
+ (if (null? types)
+ (values '() '() '())
+ (let ((var (car vars)))
+ (let-values (((vars defns sets) (f (cdr types) (cdr vars))))
+ (if (eq? (car types) 'global)
+ (let ((x (build-lexical-var no-source var)))
+ (values
+ (cons x vars)
+ (cons (build-global-definition no-source var (chi-void)) defns)
+ (cons (build-global-assignment no-source var (build-lexical-reference 'value no-source x)) sets)))
+ (values (cons var vars) defns sets))))))))
+ (if (null? defns)
+ (build-letrec ae vars val-exps body-exp)
+ (build-sequence no-source
+ (append defns
+ (list
+ (build-letrec ae vars val-exps
+ (build-sequence no-source (append sets (list body-exp)))))))))))
+
+(define-syntax build-lexical-var
+ (syntax-rules ()
+ ((_ ae id) (gensym))))
+
+(define-syntax lexical-var? gensym?)
+
+(define-syntax self-evaluating?
+ (syntax-rules ()
+ ((_ e)
+ (let ((x e))
+ (or (boolean? x) (number? x) (string? x) (char? x) (null? x))))))
+)
+
+(define-syntax unannotate
+ (syntax-rules ()
+ ((_ x)
+ (let ((e x))
+ (if (annotation? e)
+ (annotation-expression e)
+ e)))))
+
+(define-syntax no-source (identifier-syntax #f))
+
+(define-syntax arg-check
+ (syntax-rules ()
+ ((_ pred? e who)
+ (let ((x e))
+ (if (not (pred? x)) (error-hook who "invalid argument" x))))))
+
+;;; compile-time environments
+
+;;; wrap and environment comprise two level mapping.
+;;; wrap : id --> label
+;;; env : label --> <element>
+
+;;; environments are represented in two parts: a lexical part and a global
+;;; part. The lexical part is a simple list of associations from labels
+;;; to bindings. The global part is implemented by
+;;; {put,get}-global-definition-hook and associates symbols with+;;; bindings.
+
+;;; global (assumed global variable) and displaced-lexical (see below)
+;;; do not show up in any environment; instead, they are fabricated by
+;;; lookup when it finds no other bindings.
+
+;;; <environment> ::= ((<label> . <binding>)*)
+
+;;; identifier bindings include a type and a value
+
+;;; <binding> ::= <procedure> macro keyword
+;;; (macro . <procedure>) macro keyword
+;;; (deferred . <thunk>) macro keyword w/lazily evaluated transformer
+;;; (macro! . <procedure>) extended identifier macro keyword
+;;; (core . <procedure>) core keyword
+;;; (begin) begin keyword
+;;; (define) define keyword
+;;; (define-syntax) define-syntax keyword
+;;; (local-syntax . <boolean>) let-syntax (#f)/letrec-syntax (#t) keyword
+;;; (eval-when) eval-when keyword
+;;; (set!) set! keyword
+;;; (meta) meta keyword
+;;; ($module-key) $module keyword
+;;; ($import) $import keyword
+;;; ($module . <interface>) modules
+;;; (syntax . (<var> . <level>)) pattern variables
+;;; (global . <symbol>) assumed global variable
+;;; (meta-variable . <symbol>) meta variable
+;;; (lexical . <var>) lexical variables
+;;; (displaced-lexical . #f) id-var-name not found in store
+;;; <level> ::= <nonnegative integer>
+;;; <var> ::= variable returned by build-lexical-var
+
+;;; a macro is a user-defined syntactic-form. a core is a system-defined
+;;; syntactic form. begin, define, define-syntax, let-syntax, letrec-syntax,
+;;; eval-when, and meta are treated specially since they are sensitive to
+;;; whether the form is at top-level and can denote valid internal
+;;; definitions.
+
+;;; a pattern variable is a variable introduced by syntax-case and can
+;;; be referenced only within a syntax form.
+
+;;; any identifier for which no top-level syntax definition or local
+;;; binding of any kind has been seen is assumed to be a global
+;;; variable.
+
+;;; a lexical variable is a lambda- or letrec-bound variable.
+
+;;; a displaced-lexical identifier is a lexical identifier removed from
+;;; it's scope by the return of a syntax object containing the identifier.
+;;; a displaced lexical can also appear when a letrec-syntax-bound
+;;; keyword is referenced on the rhs of one of the letrec-syntax clauses.
+;;; a displaced lexical should never occur with properly written macros.
+
+(define sanitize-binding
+ (lambda (b)
+ (cond
+ ((procedure? b) (make-binding 'macro b))
+ ((binding? b)
+ (and (case (binding-type b)
+ ((core macro macro! deferred) (and (procedure? (binding-value b))))
+ (($module) (interface? (binding-value b)))
+ ((lexical) (lexical-var? (binding-value b)))
+ ((global meta-variable) (symbol? (binding-value b)))
+ ((syntax) (let ((x (binding-value b)))
+ (and (pair? x)
+ (lexical-var? (car x))
+ (let ((n (cdr x)))
+ (and (integer? n) (exact? n) (>= n 0))))))
+ ((begin define define-syntax set! $module-key $import eval-when meta) (null? (binding-value b)))
+ ((local-syntax) (boolean? (binding-value b)))
+ ((displaced-lexical) (eq? (binding-value b) #f))
+ (else #t))
+ b))
+ (else #f))))
+
+(define-syntax make-binding
+ (syntax-rules (quote)
+ ((_ 'type #f) '(type . #f))
+ ((_ type value) (cons type value))))
+(define binding-type car)
+(define binding-value cdr)
+(define set-binding-type! set-car!)
+(define set-binding-value! set-cdr!)
+(define binding? (lambda (x) (and (pair? x) (symbol? (car x)))))
+
+(define-syntax null-env (identifier-syntax '()))
+
+(define extend-env
+ (lambda (label binding r)
+ (cons (cons label binding) r)))
+
+(define extend-env*
+ (lambda (labels bindings r)
+ (if (null? labels)
+ r
+ (extend-env* (cdr labels) (cdr bindings)
+ (extend-env (car labels) (car bindings) r)))))
+
+(define extend-var-env*
+ ; variant of extend-env* that forms "lexical" binding
+ (lambda (labels vars r)
+ (if (null? labels)
+ r
+ (extend-var-env* (cdr labels) (cdr vars)
+ (extend-env (car labels) (make-binding 'lexical (car vars)) r)))))
+
+(define (displaced-lexical? id r)
+ (let ((n (id-var-name id empty-wrap)))
+ (and n
+ (let ((b (lookup n r)))
+ (eq? (binding-type b) 'displaced-lexical)))))
+
+(define displaced-lexical-error
+ (lambda (id)
+ (syntax-error id
+ (if (id-var-name id empty-wrap)
+ "identifier out of context"
+ "identifier not visible"))))
+
+(define lookup*
+ ; x may be a label or a symbol
+ ; although symbols are usually global, we check the environment first
+ ; anyway because a temporary binding may have been established by
+ ; fluid-let-syntax
+ (lambda (x r)
+ (cond
+ ((assq x r) => cdr)
+ ((symbol? x)
+ (or (get-global-definition-hook x) (make-binding 'global x)))
+ (else (make-binding 'displaced-lexical #f)))))
+
+(define lookup
+ (lambda (x r)
+ (define whack-binding!
+ (lambda (b *b)
+ (set-binding-type! b (binding-type *b))
+ (set-binding-value! b (binding-value *b))))
+ (let ((b (lookup* x r)))
+ (when (eq? (binding-type b) 'deferred)
+ (whack-binding! b (make-transformer-binding ((binding-value b)))))
+ b)))
+
+(define make-transformer-binding
+ (lambda (b)
+ (or (sanitize-binding b)
+ (syntax-error b "invalid transformer"))))
+
+(define defer-or-eval-transformer
+ (lambda (eval x)
+ (if (built-lambda? x)
+ (make-binding 'deferred (lambda () (eval x)))
+ (make-transformer-binding (eval x)))))
+
+(define global-extend
+ (lambda (type sym val)
+ (put-cte-hook sym (make-binding type val))))
+
+
+;;; Conceptually, identifiers are always syntax objects. Internally,
+;;; however, the wrap is sometimes maintained separately (a source of
+;;; efficiency and confusion), so that symbols are also considered
+;;; identifiers by id?. Externally, they are always wrapped.
+
+(define nonsymbol-id?
+ (lambda (x)
+ (and (syntax-object? x)
+ (symbol? (unannotate (syntax-object-expression x))))))
+
+(define id?
+ (lambda (x)
+ (cond
+ ((symbol? x) #t)
+ ((syntax-object? x) (symbol? (unannotate (syntax-object-expression x))))
+ ((annotation? x) (symbol? (annotation-expression x)))
+ (else #f))))
+
+(define-syntax id-sym-name
+ (syntax-rules ()
+ ((_ e)
+ (let ((x e))
+ (unannotate (if (syntax-object? x) (syntax-object-expression x) x))))))
+
+(define id-marks
+ (lambda (id)
+ (if (syntax-object? id)
+ (wrap-marks (syntax-object-wrap id))
+ (wrap-marks top-wrap))))
+
+(define id-subst
+ (lambda (id)
+ (if (syntax-object? id)
+ (wrap-subst (syntax-object-wrap id))
+ (wrap-marks top-wrap))))
+
+(define id-sym-name&marks
+ (lambda (x w)
+ (if (syntax-object? x)
+ (values
+ (unannotate (syntax-object-expression x))
+ (join-marks (wrap-marks w) (wrap-marks (syntax-object-wrap x))))
+ (values (unannotate x) (wrap-marks w)))))
+
+;;; syntax object wraps
+
+;;; <wrap> ::= ((<mark> ...) . (<subst> ...))
+;;; <subst> ::= <ribcage> | <shift>
+;;; <ribcage> ::= #((<ex-symname> ...) (<mark> ...) (<label> ...)) ; extensible, for chi-internal/external
+;;; | #(#(<symname> ...) #(<mark> ...) #(<label> ...)) ; nonextensible
+;;; <ex-symname> ::= <symname> | <import token> | <barrier>
+;;; <shift> ::= shift
+;;; <barrier> ::= #f ; inserted by import-only
+;;; <import interface> ::= #<import-interface interface new-marks>
+;;; <token> ::= <generated id>
+
+(define make-wrap cons)
+(define wrap-marks car)
+(define wrap-subst cdr)
+
+
+(define-syntax empty-wrap (identifier-syntax '(())))
+
+(define-syntax top-wrap (identifier-syntax '((top))))
+
+(define-syntax tmp-wrap (identifier-syntax '((tmp)))) ; for generate-temporaries
+
+(define-syntax top-marked?
+ (syntax-rules ()
+ ((_ w) (memq 'top (wrap-marks w)))))
+
+(define-syntax only-top-marked?
+ (syntax-rules ()
+ ((_ id) (same-marks? (wrap-marks (syntax-object-wrap id)) (wrap-marks top-wrap)))))
+
+;;; labels
+
+;;; simple labels must be comparable with "eq?" and distinct from symbols
+;;; and pairs.
+
+;;; indirect labels, which are implemented as pairs, are used to support
+;;; import aliasing for identifiers exported (explictly or implicitly) from
+;;; top-level modules. chi-external creates an indirect label for each
+;;; defined identifier, import causes the pair to be shared with aliases it
+;;; establishes, and chi-top-module whacks the pair to hold the top-level
+;;; identifier name (symbol) if the id is to be placed at top level, before
+;;; expanding the right-hand sides of the definitions in the module.
+
+(module (gen-indirect-label indirect-label? get-indirect-label set-indirect-label!)
+ (define-structure (indirect-label label))
+ (define gen-indirect-label
+ (lambda ()
+ (make-indirect-label (gen-label))))
+ (define get-indirect-label (lambda (x) (indirect-label-label x)))
+ (define set-indirect-label! (lambda (x v) (set-indirect-label-label! x v))))
+
+(define gen-label
+ (lambda () (string #\i)))
+(define label?
+ (lambda (x)
+ (or (string? x) ; normal lexical labels
+ (symbol? x) ; global labels (symbolic names)
+ (indirect-label? x))))
+
+(define gen-labels
+ (lambda (ls)
+ (if (null? ls)
+ '()
+ (cons (gen-label) (gen-labels (cdr ls))))))
+
+(define-structure (ribcage symnames marks labels))
+(define-structure (top-ribcage key mutable?))
+(define-structure (import-interface interface new-marks))
+(define-structure (env top-ribcage wrap))
+
+;;; Marks must be comparable with "eq?" and distinct from pairs and
+;;; the symbol top. We do not use integers so that marks will remain
+;;; unique even across file compiles.
+
+(define-syntax the-anti-mark (identifier-syntax #f))
+
+(define anti-mark
+ (lambda (w)
+ (make-wrap (cons the-anti-mark (wrap-marks w))
+ (cons 'shift (wrap-subst w)))))
+
+(define-syntax new-mark
+ (syntax-rules ()
+ ((_) (string #\m))))
+
+(define barrier-marker #f)
+
+;;; make-empty-ribcage and extend-ribcage maintain list-based ribcages for
+;;; internal definitions, in which the ribcages are built incrementally
+(define-syntax make-empty-ribcage
+ (syntax-rules ()
+ ((_) (make-ribcage '() '() '()))))
+
+(define extend-ribcage!
+ ; must receive ids with complete wraps
+ ; ribcage guaranteed to be list-based
+ (lambda (ribcage id label)
+ (set-ribcage-symnames! ribcage
+ (cons (unannotate (syntax-object-expression id))
+ (ribcage-symnames ribcage)))
+ (set-ribcage-marks! ribcage
+ (cons (wrap-marks (syntax-object-wrap id))
+ (ribcage-marks ribcage)))
+ (set-ribcage-labels! ribcage
+ (cons label (ribcage-labels ribcage)))))
+
+(define import-extend-ribcage!
+ ; must receive ids with complete wraps
+ ; ribcage guaranteed to be list-based
+ (lambda (ribcage new-marks id label)
+ (set-ribcage-symnames! ribcage
+ (cons (unannotate (syntax-object-expression id))
+ (ribcage-symnames ribcage)))
+ (set-ribcage-marks! ribcage
+ (cons (join-marks new-marks (wrap-marks (syntax-object-wrap id)))
+ (ribcage-marks ribcage)))
+ (set-ribcage-labels! ribcage
+ (cons label (ribcage-labels ribcage)))))
+
+(define extend-ribcage-barrier!
+ ; must receive ids with complete wraps
+ ; ribcage guaranteed to be list-based
+ (lambda (ribcage killer-id)
+ (extend-ribcage-barrier-help! ribcage (syntax-object-wrap killer-id))))
+
+(define extend-ribcage-barrier-help!
+ (lambda (ribcage wrap)
+ (set-ribcage-symnames! ribcage
+ (cons barrier-marker (ribcage-symnames ribcage)))
+ (set-ribcage-marks! ribcage
+ (cons (wrap-marks wrap) (ribcage-marks ribcage)))))
+
+(define extend-ribcage-subst!
+ ; ribcage guaranteed to be list-based
+ (lambda (ribcage import-iface)
+ (set-ribcage-symnames! ribcage
+ (cons import-iface (ribcage-symnames ribcage)))))
+
+(define lookup-import-binding-name
+ (lambda (sym marks token new-marks)
+ (let ((new (get-import-binding sym token)))
+ (and new
+ (let f ((new new))
+ (cond
+ ((pair? new) (or (f (car new)) (f (cdr new))))
+ ((symbol? new)
+ (and (same-marks? marks (join-marks new-marks (wrap-marks top-wrap))) new))
+ ((same-marks? marks (join-marks new-marks (wrap-marks (syntax-object-wrap new)))) new)
+ (else #f)))))))
+
+(define store-import-binding
+ (lambda (id token new-marks)
+ (define cons-id
+ (lambda (id x)
+ (if (not x) id (cons id x))))
+ (define weed ; remove existing binding for id, if any
+ (lambda (marks x)
+ (if (pair? x)
+ (if (same-marks? (id-marks (car x)) marks)
+ (weed marks (cdr x))
+ (cons-id (car x) (weed marks (cdr x))))
+ (and x (not (same-marks? (id-marks x) marks)) x))))
+ (let ((id (if (null? new-marks)
+ id
+ (make-syntax-object (id-sym-name id)
+ (make-wrap
+ (join-marks new-marks (id-marks id))
+ (id-subst id))))))
+ (let ((sym (id-sym-name id)))
+ ; no need to record bindings mapping symbol to self, since this
+ ; assumed by default.
+ (unless (eq? id sym)
+ (let ((marks (id-marks id)))
+ (update-import-binding! sym token
+ (lambda (old-binding)
+ (let ((x (weed marks old-binding)))
+ (cons-id
+ (if (same-marks? marks (wrap-marks top-wrap))
+ ; need full id only if more than top-marked.
+ (resolved-id-var-name id)
+ id)
+ x))))))))))
+
+;;; make-binding-wrap creates vector-based ribcages
+(define make-binding-wrap
+ (lambda (ids labels w)
+ (if (null? ids)
+ w
+ (make-wrap
+ (wrap-marks w)
+ (cons
+ (let ((labelvec (list->vector labels)))
+ (let ((n (vector-length labelvec)))
+ (let ((symnamevec (make-vector n)) (marksvec (make-vector n)))
+ (let f ((ids ids) (i 0))
+ (unless (null? ids)
+ (let-values (((symname marks) (id-sym-name&marks (car ids) w)))
+ (vector-set! symnamevec i symname)
+ (vector-set! marksvec i marks)
+ (f (cdr ids) (fx+ i 1)))))
+ (make-ribcage symnamevec marksvec labelvec))))
+ (wrap-subst w))))))
+
+;;; resolved ids contain no unnecessary substitutions or marks. they are
+;;; used essentially as indirects or aliases in modules interfaces.
+(define make-resolved-id
+ (lambda (fromsym marks tosym)
+ (make-syntax-object fromsym
+ (make-wrap marks
+ (list (make-ribcage (vector fromsym) (vector marks) (vector tosym)))))))
+
+(define id->resolved-id
+ (lambda (id)
+ (let-values (((tosym marks) (id-var-name&marks id empty-wrap)))
+ (unless tosym
+ (syntax-error id "identifier not visible for export"))
+ (make-resolved-id (id-sym-name id) marks tosym))))
+
+(define resolved-id-var-name
+ (lambda (id)
+ (vector-ref
+ (ribcage-labels (car (wrap-subst (syntax-object-wrap id))))
+ 0)))
+
+;;; Scheme's append should not copy the first argument if the second is
+;;; nil, but it does, so we define a smart version here.
+(define smart-append
+ (lambda (m1 m2)
+ (if (null? m2)
+ m1
+ (append m1 m2))))
+
+(define join-wraps
+ (lambda (w1 w2)
+ (let ((m1 (wrap-marks w1)) (s1 (wrap-subst w1)))
+ (if (null? m1)
+ (if (null? s1)
+ w2
+ (make-wrap
+ (wrap-marks w2)
+ (join-subst s1 (wrap-subst w2))))
+ (make-wrap
+ (join-marks m1 (wrap-marks w2))
+ (join-subst s1 (wrap-subst w2)))))))
+
+(define join-marks
+ (lambda (m1 m2)
+ (smart-append m1 m2)))
+
+(define join-subst
+ (lambda (s1 s2)
+ (smart-append s1 s2)))
+
+(define same-marks?
+ (lambda (x y)
+ (or (eq? x y)
+ (and (not (null? x))
+ (not (null? y))
+ (eq? (car x) (car y))
+ (same-marks? (cdr x) (cdr y))))))
+
+(define diff-marks
+ (lambda (m1 m2)
+ (let ((n1 (length m1)) (n2 (length m2)))
+ (let f ((n1 n1) (m1 m1))
+ (cond
+ ((> n1 n2) (cons (car m1) (f (- n1 1) (cdr m1))))
+ ((equal? m1 m2) '())
+ (else (error 'sc-expand
+ "internal error in diff-marks: ~s is not a tail of ~s"
+ m1 m2)))))))
+
+(module (top-id-bound-var-name top-id-free-var-name)
+ ;; top-id-bound-var-name is used to look up or establish new top-level
+ ;; substitutions, while top-id-free-var-name is used to look up existing
+ ;; (possibly implicit) substitutions. Implicit substitutions exist
+ ;; for top-marked names in all environments, but we represent them
+ ;; explicitly only on demand.
+ ;;
+ ;; In both cases, we first look for an existing substitution for sym
+ ;; and the given marks. If we find one, we return it. Otherwise, we
+ ;; extend the appropriate top-level environment
+ ;;
+ ;; For top-id-bound-var-name, we extend the environment with a substition
+ ;; keyed by the given marks, so that top-level definitions introduced by
+ ;; a macro are distinct from other top-level definitions for the same
+ ;; name. For example, if macros a and b both introduce definitions and
+ ;; bound references to identifier x, the two x's should be different,
+ ;; i.e., keyed by their own marks.
+ ;;
+ ;; For top-id-free-var-name, we extend the environment with a substition
+ ;; keyed by the top marks, since top-level free identifier references
+ ;; should refer to the existing implicit (top-marked) substitution. For
+ ;; example, if macros a and b both introduce free references to identifier
+ ;; x, they should both refer to the same (global, unmarked) x.
+ ;;
+ ;; If the environment is *top*, we map a symbol to itself
+
+ (define leave-implicit? (lambda (token) (eq? token '*top*)))
+
+ (define new-binding
+ (lambda (sym marks token)
+ (let ((loc (if (and (leave-implicit? token)
+ (same-marks? marks (wrap-marks top-wrap)))
+ sym
+ (generate-id sym))))
+ (let ((id (make-resolved-id sym marks loc)))
+ (store-import-binding id token '())
+ (values loc id)))))
+
+ (define top-id-bound-var-name
+ ; should be called only when top-ribcage is mutable
+ (lambda (sym marks top-ribcage)
+ (let ((token (top-ribcage-key top-ribcage)))
+ (cond
+ ((lookup-import-binding-name sym marks token '()) =>
+ (lambda (id)
+ (if (symbol? id) ; symbol iff marks == (wrap-marks top-wrap)
+ (if (read-only-binding? id)
+ (new-binding sym marks token)
+ (values id (make-resolved-id sym marks id)))
+ (values (resolved-id-var-name id) id))))
+ (else (new-binding sym marks token))))))
+
+ (define top-id-free-var-name
+ (lambda (sym marks top-ribcage)
+ (let ((token (top-ribcage-key top-ribcage)))
+ (cond
+ ((lookup-import-binding-name sym marks token '()) =>
+ (lambda (id) (if (symbol? id) id (resolved-id-var-name id))))
+ ((and (top-ribcage-mutable? top-ribcage)
+ (same-marks? marks (wrap-marks top-wrap)))
+ (let-values (((sym id) (new-binding sym (wrap-marks top-wrap) token)))
+ sym))
+ (else #f))))))
+
+(define id-var-name-loc&marks
+ (lambda (id w)
+ (define search
+ (lambda (sym subst marks)
+ (if (null? subst)
+ (values #f marks)
+ (let ((fst (car subst)))
+ (cond
+ ((eq? fst 'shift) (search sym (cdr subst) (cdr marks)))
+ ((ribcage? fst)
+ (let ((symnames (ribcage-symnames fst)))
+ (if (vector? symnames)
+ (search-vector-rib sym subst marks symnames fst)
+ (search-list-rib sym subst marks symnames fst))))
+ ((top-ribcage? fst)
+ (cond
+ ((top-id-free-var-name sym marks fst) =>
+ (lambda (var-name) (values var-name marks)))
+ (else (search sym (cdr subst) marks))))
+ (else
+ (error 'sc-expand
+ "internal error in id-var-name-loc&marks: improper subst ~s"
+ subst)))))))
+ (define search-list-rib
+ (lambda (sym subst marks symnames ribcage)
+ (let f ((symnames symnames) (i 0))
+ (if (null? symnames)
+ (search sym (cdr subst) marks)
+ (let ((x (car symnames)))
+ (cond
+ ((and (eq? x sym)
+ (same-marks? marks (list-ref (ribcage-marks ribcage) i)))
+ (values (list-ref (ribcage-labels ribcage) i) marks))
+ ((import-interface? x)
+ (let ((iface (import-interface-interface x))
+ (new-marks (import-interface-new-marks x)))
+ (cond
+ ((interface-token iface) =>
+ (lambda (token)
+ (cond
+ ((lookup-import-binding-name sym marks token new-marks) =>
+ (lambda (id)
+ (values
+ (if (symbol? id) id (resolved-id-var-name id))
+ marks)))
+ (else (f (cdr symnames) i)))))
+ (else
+ (let* ((ie (interface-exports iface))
+ (n (vector-length ie)))
+ (let g ((j 0))
+ (if (fx= j n)
+ (f (cdr symnames) i)
+ (let ((id (vector-ref ie j)))
+ (let ((id.sym (id-sym-name id))
+ (id.marks (join-marks new-marks (id-marks id))))
+ (if (help-bound-id=? id.sym id.marks sym marks)
+ (values (lookup-import-label id) marks)
+ (g (fx+ j 1))))))))))))
+ ((and (eq? x barrier-marker)
+ (same-marks? marks (list-ref (ribcage-marks ribcage) i)))
+ (values #f marks))
+ (else (f (cdr symnames) (fx+ i 1)))))))))
+ (define search-vector-rib
+ (lambda (sym subst marks symnames ribcage)
+ (let ((n (vector-length symnames)))
+ (let f ((i 0))
+ (cond
+ ((fx= i n) (search sym (cdr subst) marks))
+ ((and (eq? (vector-ref symnames i) sym)
+ (same-marks? marks (vector-ref (ribcage-marks ribcage) i)))
+ (values (vector-ref (ribcage-labels ribcage) i) marks))
+ (else (f (fx+ i 1))))))))
+ (cond
+ ((symbol? id) (search id (wrap-subst w) (wrap-marks w)))
+ ((syntax-object? id)
+ (let ((sym (unannotate (syntax-object-expression id)))
+ (w1 (syntax-object-wrap id)))
+ (let-values (((name marks) (search sym (wrap-subst w)
+ (join-marks
+ (wrap-marks w)
+ (wrap-marks w1)))))
+ (if name
+ (values name marks)
+ (search sym (wrap-subst w1) marks)))))
+ ((annotation? id) (search (unannotate id) (wrap-subst w) (wrap-marks w)))
+ (else (error-hook 'id-var-name "invalid id" id)))))
+
+(define id-var-name&marks
+ ; this version follows indirect labels
+ (lambda (id w)
+ (let-values (((label marks) (id-var-name-loc&marks id w)))
+ (values (if (indirect-label? label) (get-indirect-label label) label) marks))))
+
+(define id-var-name-loc
+ ; this version doesn't follow indirect labels
+ (lambda (id w)
+ (let-values (((label marks) (id-var-name-loc&marks id w)))
+ label)))
+
+(define id-var-name
+ ; this version follows indirect labels
+ (lambda (id w)
+ (let-values (((label marks) (id-var-name-loc&marks id w)))
+ (if (indirect-label? label) (get-indirect-label label) label))))
+
+;;; free-id=? must be passed fully wrapped ids since (free-id=? x y)
+;;; may be true even if (free-id=? (wrap x w) (wrap y w)) is not.
+
+(define free-id=?
+ (lambda (i j)
+ (and (eq? (id-sym-name i) (id-sym-name j)) ; accelerator
+ (eq? (id-var-name i empty-wrap) (id-var-name j empty-wrap)))))
+
+(define literal-id=?
+ (lambda (id literal)
+ (and (eq? (id-sym-name id) (id-sym-name literal))
+ (let ((n-id (id-var-name id empty-wrap))
+ (n-literal (id-var-name literal empty-wrap)))
+ (or (eq? n-id n-literal)
+ (and (or (not n-id) (symbol? n-id))
+ (or (not n-literal) (symbol? n-literal))))))))
+
+;;; bound-id=? may be passed unwrapped (or partially wrapped) ids as
+;;; long as the missing portion of the wrap is common to both of the ids
+;;; since (bound-id=? x y) iff (bound-id=? (wrap x w) (wrap y w))
+
+(define help-bound-id=?
+ (lambda (i.sym i.marks j.sym j.marks)
+ (and (eq? i.sym j.sym)
+ (same-marks? i.marks j.marks))))
+
+(define bound-id=?
+ (lambda (i j)
+ (help-bound-id=? (id-sym-name i) (id-marks i) (id-sym-name j) (id-marks j))))
+
+;;; "valid-bound-ids?" returns #t if it receives a list of distinct ids.
+;;; valid-bound-ids? may be passed unwrapped (or partially wrapped) ids
+;;; as long as the missing portion of the wrap is common to all of the
+;;; ids.
+
+(define valid-bound-ids?
+ (lambda (ids)
+ (and (let all-ids? ((ids ids))
+ (or (null? ids)
+ (and (id? (car ids))
+ (all-ids? (cdr ids)))))
+ (distinct-bound-ids? ids))))
+
+;;; distinct-bound-ids? expects a list of ids and returns #t if there are
+;;; no duplicates. It is quadratic on the length of the id list; long
+;;; lists could be sorted to make it more efficient. distinct-bound-ids?
+;;; may be passed unwrapped (or partially wrapped) ids as long as the
+;;; missing portion of the wrap is common to all of the ids.
+
+(define distinct-bound-ids?
+ (lambda (ids)
+ (let distinct? ((ids ids))
+ (or (null? ids)
+ (and (not (bound-id-member? (car ids) (cdr ids)))
+ (distinct? (cdr ids)))))))
+
+(define invalid-ids-error
+ ; find first bad one and complain about it
+ (lambda (ids exp class)
+ (let find ((ids ids) (gooduns '()))
+ (if (null? ids)
+ (syntax-error exp) ; shouldn't happen
+ (if (id? (car ids))
+ (if (bound-id-member? (car ids) gooduns)
+ (syntax-error (car ids) "duplicate " class)
+ (find (cdr ids) (cons (car ids) gooduns)))
+ (syntax-error (car ids) "invalid " class))))))
+
+(define bound-id-member?
+ (lambda (x list)
+ (and (not (null? list))
+ (or (bound-id=? x (car list))
+ (bound-id-member? x (cdr list))))))
+
+;;; wrapping expressions and identifiers
+
+(define wrap
+ (lambda (x w)
+ (cond
+ ((and (null? (wrap-marks w)) (null? (wrap-subst w))) x)
+ ((syntax-object? x)
+ (make-syntax-object
+ (syntax-object-expression x)
+ (join-wraps w (syntax-object-wrap x))))
+ ((null? x) x)
+ (else (make-syntax-object x w)))))
+
+(define source-wrap
+ (lambda (x w ae)
+ (wrap (if (annotation? ae)
+ (begin
+ (unless (eq? (annotation-expression ae) x)
+ (error 'sc-expand "internal error in source-wrap: ae/x mismatch"))
+ ae)
+ x)
+ w)))
+
+;;; expanding
+
+(define chi-when-list
+ (lambda (when-list w)
+ ; when-list is syntax'd version of list of situations
+ (map (lambda (x)
+ (cond
+ ((literal-id=? x (syntax compile)) 'compile)
+ ((literal-id=? x (syntax load)) 'load)
+ ((literal-id=? x (syntax visit)) 'visit)
+ ((literal-id=? x (syntax revisit)) 'revisit)
+ ((literal-id=? x (syntax eval)) 'eval)
+ (else (syntax-error (wrap x w) "invalid eval-when situation"))))
+ when-list)))
+
+;;; syntax-type returns five values: type, value, e, w, and ae. The first
+;;; two are described in the table below.
+;;;
+;;; type value explanation
+;;; -------------------------------------------------------------------
+;;; alias none alias keyword
+;;; alias-form none alias expression
+;;; begin none begin keyword
+;;; begin-form none begin expression
+;;; call none any other call
+;;; constant none self-evaluating datum
+;;; core procedure core form (including singleton)
+;;; define none define keyword
+;;; define-form none variable definition
+;;; define-syntax none define-syntax keyword
+;;; define-syntax-form none syntax definition
+;;; displaced-lexical none displaced lexical identifier
+;;; eval-when none eval-when keyword
+;;; eval-when-form none eval-when form
+;;; global name global variable reference
+;;; $import none $import keyword
+;;; $import-form none $import form
+;;; lexical name lexical variable reference
+;;; lexical-call name call to lexical variable
+;;; local-syntax rec? letrec-syntax/let-syntax keyword
+;;; local-syntax-form rec? syntax definition
+;;; meta none meta keyword
+;;; meta-form none meta form
+;;; meta-variable name meta variable
+;;; $module none $module keyword
+;;; $module-form none $module definition
+;;; syntax level pattern variable
+;;; other none anything else
+;;;
+;;; For all forms, e is the form, w is the wrap for e. and ae is the
+;;; (possibly) source-annotated form.
+;;;
+;;; syntax-type expands macros and unwraps as necessary to get to
+;;; one of the forms above.
+
+(define syntax-type
+ (lambda (e r w ae rib)
+ (cond
+ ((symbol? e)
+ (let* ((n (id-var-name e w))
+ (b (lookup n r))
+ (type (binding-type b)))
+ (case type
+ ((macro macro!) (syntax-type (chi-macro (binding-value b) e r w ae rib) r empty-wrap #f rib))
+ (else (values type (binding-value b) e w ae)))))
+ ((pair? e)
+ (let ((first (car e)))
+ (if (id? first)
+ (let* ((n (id-var-name first w))
+ (b (lookup n r))
+ (type (binding-type b)))
+ (case type
+ ((lexical) (values 'lexical-call (binding-value b) e w ae))
+ ((macro macro!)
+ (syntax-type (chi-macro (binding-value b) e r w ae rib)
+ r empty-wrap #f rib))
+ ((core) (values type (binding-value b) e w ae))
+ ((begin) (values 'begin-form #f e w ae))
+ ((alias) (values 'alias-form #f e w ae))
+ ((define) (values 'define-form #f e w ae))
+ ((define-syntax) (values 'define-syntax-form #f e w ae))
+ ((set!) (chi-set! e r w ae rib))
+ (($module-key) (values '$module-form #f e w ae))
+ (($import) (values '$import-form #f e w ae))
+ ((eval-when) (values 'eval-when-form #f e w ae))
+ ((meta) (values 'meta-form #f e w ae))
+ ((local-syntax)
+ (values 'local-syntax-form (binding-value b) e w ae))
+ (else (values 'call #f e w ae))))
+ (values 'call #f e w ae))))
+ ((syntax-object? e)
+ (syntax-type (syntax-object-expression e)
+ r
+ (join-wraps w (syntax-object-wrap e))
+ #f rib))
+ ((annotation? e)
+ (syntax-type (annotation-expression e) r w e rib))
+ ((self-evaluating? e) (values 'constant #f e w ae))
+ (else (values 'other #f e w ae)))))
+
+(define chi-top*
+ (lambda (e r w ctem rtem meta? top-ribcage)
+ (let ((meta-residuals '()))
+ (define meta-residualize!
+ (lambda (x)
+ (set! meta-residuals
+ (cons x meta-residuals))))
+ (let ((e (chi-top e r w ctem rtem meta? top-ribcage meta-residualize! #f)))
+ (build-sequence no-source
+ (reverse (cons e meta-residuals)))))))
+
+(define chi-top-sequence
+ (lambda (body r w ae ctem rtem meta? ribcage meta-residualize!)
+ (build-sequence ae
+ (let dobody ((body body))
+ (if (null? body)
+ '()
+ (let ((first (chi-top (car body) r w ctem rtem meta? ribcage meta-residualize! #f)))
+ (cons first (dobody (cdr body)))))))))
+
+(define chi-top
+ (lambda (e r w ctem rtem meta? top-ribcage meta-residualize! meta-seen?)
+ (let-values (((type value e w ae) (syntax-type e r w no-source top-ribcage)))
+ (case type
+ ((begin-form)
+ (let ((forms (parse-begin e w ae #t)))
+ (if (null? forms)
+ (chi-void)
+ (chi-top-sequence forms r w ae ctem rtem meta? top-ribcage meta-residualize!))))
+ ((local-syntax-form)
+ (let-values (((forms r mr w ae) (chi-local-syntax value e r r w ae)))
+ ; mr should be same as r here
+ (chi-top-sequence forms r w ae ctem rtem meta? top-ribcage meta-residualize!)))
+ ((eval-when-form)
+ (let-values (((when-list forms) (parse-eval-when e w ae)))
+ (let ((ctem (update-mode-set when-list ctem))
+ (rtem (update-mode-set when-list rtem)))
+ (if (and (null? ctem) (null? rtem))
+ (chi-void)
+ (chi-top-sequence forms r w ae ctem rtem meta? top-ribcage meta-residualize!)))))
+ ((meta-form) (chi-top (parse-meta e w ae) r w ctem rtem #t top-ribcage meta-residualize! #t))
+ ((define-syntax-form)
+ (let-values (((id rhs w) (parse-define-syntax e w ae)))
+ (let ((id (wrap id w)))
+ (when (displaced-lexical? id r) (displaced-lexical-error id))
+ (unless (top-ribcage-mutable? top-ribcage)
+ (syntax-error (source-wrap e w ae)
+ "invalid definition in read-only environment"))
+ (let ((sym (id-sym-name id)))
+ (let-values (((valsym bound-id) (top-id-bound-var-name sym (wrap-marks (syntax-object-wrap id)) top-ribcage)))
+ (unless (eq? (id-var-name id empty-wrap) valsym)
+ (syntax-error (source-wrap e w ae)
+ "definition not permitted"))
+ (when (read-only-binding? valsym)
+ (syntax-error (source-wrap e w ae)
+ "invalid definition of read-only identifier"))
+ (ct-eval/residualize2 ctem
+ (lambda ()
+ (build-cte-install
+ bound-id
+ (chi rhs r r w #t)
+ (top-ribcage-key top-ribcage)))))))))
+ ((define-form)
+ (let-values (((id rhs w) (parse-define e w ae)))
+ (let ((id (wrap id w)))
+ (when (displaced-lexical? id r) (displaced-lexical-error id))
+ (unless (top-ribcage-mutable? top-ribcage)
+ (syntax-error (source-wrap e w ae)
+ "invalid definition in read-only environment"))
+ (let ((sym (id-sym-name id)))
+ (let-values (((valsym bound-id) (top-id-bound-var-name sym (wrap-marks (syntax-object-wrap id)) top-ribcage)))
+ (unless (eq? (id-var-name id empty-wrap) valsym)
+ (syntax-error (source-wrap e w ae)
+ "definition not permitted"))
+ (when (read-only-binding? valsym)
+ (syntax-error (source-wrap e w ae)
+ "invalid definition of read-only identifier"))
+ (if meta?
+ (ct-eval/residualize2 ctem
+ (lambda ()
+ (build-sequence no-source
+ (list
+ (build-cte-install bound-id
+ (build-data no-source (make-binding 'meta-variable valsym))
+ (top-ribcage-key top-ribcage))
+ (build-global-definition ae valsym (chi rhs r r w #t))))))
+ ; make sure compile-time definitions occur before we
+ ; expand the run-time code
+ (let ((x (ct-eval/residualize2 ctem
+ (lambda ()
+ (build-cte-install
+ bound-id
+ (build-data no-source (make-binding 'global valsym))
+ (top-ribcage-key top-ribcage))))))
+ (build-sequence no-source
+ (list
+ x
+ (rt-eval/residualize rtem
+ (lambda ()
+ (build-global-definition ae valsym (chi rhs r r w #f)))))))))
+ ))))
+ (($module-form)
+ (let ((ribcage (make-empty-ribcage)))
+ (let-values (((orig id exports forms)
+ (parse-module e w ae
+ (make-wrap (wrap-marks w) (cons ribcage (wrap-subst w))))))
+ (when (displaced-lexical? id r) (displaced-lexical-error (wrap id w)))
+ (unless (top-ribcage-mutable? top-ribcage)
+ (syntax-error orig
+ "invalid definition in read-only environment"))
+ (chi-top-module orig r r top-ribcage ribcage ctem rtem meta? id exports forms meta-residualize!))))
+ (($import-form)
+ (let-values (((orig only? mid) (parse-import e w ae)))
+ (unless (top-ribcage-mutable? top-ribcage)
+ (syntax-error orig
+ "invalid definition in read-only environment"))
+ (ct-eval/residualize2 ctem
+ (lambda ()
+ (let ((binding (lookup (id-var-name mid empty-wrap) null-env)))
+ (case (binding-type binding)
+ (($module) (do-top-import only? top-ribcage mid (interface-token (binding-value binding))))
+ ((displaced-lexical) (displaced-lexical-error mid))
+ (else (syntax-error mid "unknown module"))))))))
+ ((alias-form)
+ (let-values (((new-id old-id) (parse-alias e w ae)))
+ (let ((new-id (wrap new-id w)))
+ (when (displaced-lexical? new-id r) (displaced-lexical-error new-id))
+ (unless (top-ribcage-mutable? top-ribcage)
+ (syntax-error (source-wrap e w ae)
+ "invalid definition in read-only environment"))
+ (let ((sym (id-sym-name new-id)))
+ (let-values (((valsym bound-id) (top-id-bound-var-name sym (wrap-marks (syntax-object-wrap new-id)) top-ribcage)))
+ (unless (eq? (id-var-name new-id empty-wrap) valsym)
+ (syntax-error (source-wrap e w ae)
+ "definition not permitted"))
+ (when (read-only-binding? valsym)
+ (syntax-error (source-wrap e w ae)
+ "invalid definition of read-only identifier"))
+ (ct-eval/residualize2 ctem
+ (lambda ()
+ (build-cte-install
+ (make-resolved-id sym (wrap-marks (syntax-object-wrap new-id)) (id-var-name old-id w))
+ (build-data no-source (make-binding 'do-alias #f))
+ (top-ribcage-key top-ribcage)))))))))
+ (else
+ (when meta-seen? (syntax-error (source-wrap e w ae) "invalid meta definition"))
+ (if meta?
+ (let ((x (chi-expr type value e r r w ae #t)))
+ (top-level-eval-hook x)
+ (ct-eval/residualize3 ctem void (lambda () x)))
+ (rt-eval/residualize rtem
+ (lambda ()
+ (chi-expr type value e r r w ae #f)))))))))
+
+(define flatten-exports
+ (lambda (exports)
+ (let loop ((exports exports) (ls '()))
+ (if (null? exports)
+ ls
+ (loop (cdr exports)
+ (if (pair? (car exports))
+ (loop (car exports) ls)
+ (cons (car exports) ls)))))))
+
+
+(define-structure (interface marks exports token))
+
+;; leaves interfaces unresolved so that indirect labels can be followed.
+;; (can't resolve until indirect labels have their final value)
+(define make-unresolved-interface
+ ; trim out implicit exports
+ (lambda (mid exports)
+ (make-interface
+ (wrap-marks (syntax-object-wrap mid))
+ (list->vector (map (lambda (x) (if (pair? x) (car x) x)) exports))
+ #f)))
+
+(define make-resolved-interface
+ ; trim out implicit exports & resolve others to actual top-level symbol
+ (lambda (mid exports token)
+ (make-interface
+ (wrap-marks (syntax-object-wrap mid))
+ (list->vector (map (lambda (x) (id->resolved-id (if (pair? x) (car x) x))) exports))
+ token)))
+
+(define-structure (module-binding type id label imps val exported))
+(define create-module-binding
+ (lambda (type id label imps val)
+ (make-module-binding type id label imps val #f)))
+
+;;; frobs represent body forms
+(define-structure (frob e meta?))
+
+(define chi-top-module
+ (lambda (orig r mr top-ribcage ribcage ctem rtem meta? id exports forms meta-residualize!)
+ (let ((fexports (flatten-exports exports)))
+ (let-values (((r mr bindings inits)
+ (chi-external ribcage orig
+ (map (lambda (d) (make-frob d meta?)) forms) r mr ctem exports fexports
+ meta-residualize!)))
+ ; identify exported identifiers, create ctdefs
+ (let process-exports ((fexports fexports) (ctdefs (lambda () '())))
+ (if (null? fexports)
+ ; remaining bindings are either identified global vars,
+ ; local vars, or local compile-time entities
+ ; dts: type (local/global)
+ ; dvs & des: define lhs & rhs
+ (let process-locals ((bs bindings) (r r) (dts '()) (dvs '()) (des '()))
+ (if (null? bs)
+ (let ((des (chi-frobs des r mr #f))
+ (inits (chi-frobs inits r mr #f)))
+ (build-sequence no-source
+ (append
+ ; we wait to establish global compile-time definitions so that
+ ; expansion of des use local versions of modules and macros
+ ; in case ctem tells us not to eval ctdefs now. this means that
+ ; local code can use exported compile-time values (modules, macros,
+ ; meta variables) just as it can unexported ones.
+ (ctdefs)
+ (list
+ (ct-eval/residualize2 ctem
+ (lambda ()
+ (let ((sym (id-sym-name id)))
+ (let* ((token (generate-id sym))
+ (b (build-data no-source
+ (make-binding '$module
+ (make-resolved-interface id exports token)))))
+ (let-values (((valsym bound-id)
+ (top-id-bound-var-name sym
+ (wrap-marks (syntax-object-wrap id))
+ top-ribcage)))
+ (unless (eq? (id-var-name id empty-wrap) valsym)
+ (syntax-error orig
+ "definition not permitted"))
+ (when (read-only-binding? valsym)
+ (syntax-error orig
+ "invalid definition of read-only identifier"))
+ (build-cte-install bound-id b
+ (top-ribcage-key top-ribcage)))))))
+ (rt-eval/residualize rtem
+ (lambda ()
+ (build-top-module no-source dts dvs des
+ (if (null? inits)
+ (chi-void)
+ (build-sequence no-source
+ (append inits (list (chi-void))))))))))))
+ (let ((b (car bs)) (bs (cdr bs)))
+ (let ((t (module-binding-type b)))
+ (case (module-binding-type b)
+ ((define-form)
+ (let ((label (get-indirect-label (module-binding-label b))))
+ (if (module-binding-exported b)
+ (let ((var (module-binding-id b)))
+ (process-locals bs r (cons 'global dts) (cons label dvs)
+ (cons (module-binding-val b) des)))
+ (let ((var (gen-var (module-binding-id b))))
+ (process-locals bs
+ ; add lexical bindings only to run-time environment
+ (extend-env label (make-binding 'lexical var) r)
+ (cons 'local dts) (cons var dvs)
+ (cons (module-binding-val b) des))))))
+ ((ctdefine-form define-syntax-form $module-form alias-form) (process-locals bs r dts dvs des))
+ (else (error 'sc-expand-internal "unexpected module binding type ~s" t)))))))
+ (let ((id (car fexports)) (fexports (cdr fexports)))
+ (let loop ((bs bindings))
+ (if (null? bs)
+ ; must be rexport from an imported module
+ (process-exports fexports ctdefs)
+ (let ((b (car bs)) (bs (cdr bs)))
+ ; following formerly used bound-id=?, but free-id=? can prevent false positives
+ ; and is okay since the substitutions have already been applied
+ (if (free-id=? (module-binding-id b) id)
+ (if (module-binding-exported b)
+ (process-exports fexports ctdefs)
+ (let* ((t (module-binding-type b))
+ (label (module-binding-label b))
+ (imps (module-binding-imps b))
+ (fexports (append imps fexports)))
+ (set-module-binding-exported! b #t)
+ (case t
+ ((define-form)
+ (let ((sym (generate-id (id-sym-name id))))
+ (set-indirect-label! label sym)
+ (process-exports fexports ctdefs)))
+ ((ctdefine-form)
+ (let ((b (module-binding-val b)))
+ (process-exports fexports
+ (lambda ()
+ (let ((sym (binding-value b)))
+ (set-indirect-label! label sym)
+ (cons (ct-eval/residualize3 ctem
+ (lambda () (put-cte-hook sym b))
+ (lambda () (build-cte-install sym (build-data no-source b) #f)))
+ (ctdefs)))))))
+ ((define-syntax-form)
+ (let ((sym (generate-id (id-sym-name id))))
+ (process-exports fexports
+ (lambda ()
+ (let ((local-label (get-indirect-label label)))
+ (set-indirect-label! label sym)
+ (cons
+ (ct-eval/residualize3 ctem
+ (lambda () (put-cte-hook sym (car (module-binding-val b))))
+ (lambda () (build-cte-install sym (cdr (module-binding-val b)) #f)))
+ (ctdefs)))))))
+ (($module-form)
+ (let ((sym (generate-id (id-sym-name id)))
+ (exports (module-binding-val b)))
+ (process-exports (append (flatten-exports exports) fexports)
+ (lambda ()
+ (set-indirect-label! label sym)
+ (let ((rest (ctdefs))) ; set indirect labels before resolving
+ (let ((x (make-binding '$module (make-resolved-interface id exports sym))))
+ (cons (ct-eval/residualize3 ctem
+ (lambda () (put-cte-hook sym x))
+ (lambda () (build-cte-install sym (build-data no-source x) #f)))
+ rest)))))))
+ ((alias-form)
+ (process-exports
+ fexports
+ (lambda ()
+ (let ((rest (ctdefs))) ; set indirect labels before resolving
+ (when (indirect-label? label)
+ (unless (symbol? (get-indirect-label label))
+ (syntax-error (module-binding-id b) "unexported target of alias")))
+ rest))))
+ (else (error 'sc-expand-internal "unexpected module binding type ~s" t)))))
+ (loop bs))))))))))))
+
+(define id-set-diff
+ (lambda (exports defs)
+ (cond
+ ((null? exports) '())
+ ((bound-id-member? (car exports) defs) (id-set-diff (cdr exports) defs))
+ (else (cons (car exports) (id-set-diff (cdr exports) defs))))))
+
+(define check-module-exports
+ ; After processing the definitions of a module this is called to verify that the
+ ; module has defined or imported each exported identifier. Because ids in fexports are
+ ; wrapped with the given ribcage, they will contain substitutions for anything defined
+ ; or imported here. These subsitutions can be used by do-import! and do-import-top! to
+ ; provide access to reexported bindings, for example.
+ (lambda (source-exp fexports ids)
+ (define defined?
+ (lambda (e ids)
+ (ormap (lambda (x)
+ (if (import-interface? x)
+ (let ((x.iface (import-interface-interface x))
+ (x.new-marks (import-interface-new-marks x)))
+ (cond
+ ((interface-token x.iface) =>
+ (lambda (token)
+ (lookup-import-binding-name (id-sym-name e) (id-marks e) token x.new-marks)))
+ (else
+ (let ((v (interface-exports x.iface)))
+ (let lp ((i (fx- (vector-length v) 1)))
+ (and (fx>= i 0)
+ (or (let ((id (vector-ref v i)))
+ (help-bound-id=?
+ (id-sym-name id)
+ (join-marks x.new-marks (id-marks id))
+ (id-sym-name e) (id-marks e)))
+ (lp (fx- i 1)))))))))
+ (bound-id=? e x)))
+ ids)))
+ (let loop ((fexports fexports) (missing '()))
+ (if (null? fexports)
+ (unless (null? missing)
+ (syntax-error (car missing)
+ (if (= (length missing) 1)
+ "missing definition for export"
+ "missing definition for multiple exports, including")))
+ (let ((e (car fexports)) (fexports (cdr fexports)))
+ (if (defined? e ids)
+ (loop fexports missing)
+ (loop fexports (cons e missing))))))))
+
+(define check-defined-ids
+ (lambda (source-exp ls)
+ (define vfold
+ (lambda (v p cls)
+ (let ((len (vector-length v)))
+ (let lp ((i 0) (cls cls))
+ (if (fx= i len)
+ cls
+ (lp (fx+ i 1) (p (vector-ref v i) cls)))))))
+ (define conflicts
+ (lambda (x y cls)
+ (if (import-interface? x)
+ (let ((x.iface (import-interface-interface x))
+ (x.new-marks (import-interface-new-marks x)))
+ (if (import-interface? y)
+ (let ((y.iface (import-interface-interface y))
+ (y.new-marks (import-interface-new-marks y)))
+ (let ((xe (interface-exports x.iface)) (ye (interface-exports y.iface)))
+ (if (fx> (vector-length xe) (vector-length ye))
+ (vfold ye
+ (lambda (id cls)
+ (id-iface-conflicts id y.new-marks x.iface x.new-marks cls)) cls)
+ (vfold xe
+ (lambda (id cls)
+ (id-iface-conflicts id x.new-marks y.iface y.new-marks cls)) cls))))
+ (id-iface-conflicts y '() x.iface x.new-marks cls)))
+ (if (import-interface? y)
+ (let ((y.iface (import-interface-interface y))
+ (y.new-marks (import-interface-new-marks y)))
+ (id-iface-conflicts x '() y.iface y.new-marks cls))
+ (if (bound-id=? x y) (cons x cls) cls)))))
+ (define id-iface-conflicts
+ (lambda (id id.new-marks iface iface.new-marks cls)
+ (let ((id.sym (id-sym-name id))
+ (id.marks (join-marks id.new-marks (id-marks id))))
+ (cond
+ ((interface-token iface) =>
+ (lambda (token)
+ (if (lookup-import-binding-name id.sym id.marks token iface.new-marks)
+ (cons id cls)
+ cls)))
+ (else
+ (vfold (interface-exports iface)
+ (lambda (*id cls)
+ (let ((*id.sym (id-sym-name *id))
+ (*id.marks (join-marks iface.new-marks (id-marks *id))))
+ (if (help-bound-id=? *id.sym *id.marks id.sym id.marks)
+ (cons *id cls)
+ cls)))
+ cls))))))
+ (unless (null? ls)
+ (let lp ((x (car ls)) (ls (cdr ls)) (cls '()))
+ (if (null? ls)
+ (unless (null? cls)
+ (let ((cls (syntax-object->datum cls)))
+ (syntax-error source-exp "duplicate definition for "
+ (symbol->string (car cls))
+ " in")))
+ (let lp2 ((ls2 ls) (cls cls))
+ (if (null? ls2)
+ (lp (car ls) (cdr ls) cls)
+ (lp2 (cdr ls2) (conflicts x (car ls2) cls)))))))))
+
+(define chi-external
+ (lambda (ribcage source-exp body r mr ctem exports fexports meta-residualize!)
+ (define return
+ (lambda (r mr bindings ids inits)
+ (check-defined-ids source-exp ids)
+ (check-module-exports source-exp fexports ids)
+ (values r mr bindings inits)))
+ (define get-implicit-exports
+ (lambda (id)
+ (let f ((exports exports))
+ (if (null? exports)
+ '()
+ (if (and (pair? (car exports)) (bound-id=? id (caar exports)))
+ (flatten-exports (cdar exports))
+ (f (cdr exports)))))))
+ (define update-imp-exports
+ (lambda (bindings exports)
+ (let ((exports (map (lambda (x) (if (pair? x) (car x) x)) exports)))
+ (map (lambda (b)
+ (let ((id (module-binding-id b)))
+ (if (not (bound-id-member? id exports))
+ b
+ (create-module-binding
+ (module-binding-type b)
+ id
+ (module-binding-label b)
+ (append (get-implicit-exports id) (module-binding-imps b))
+ (module-binding-val b)))))
+ bindings))))
+ (let parse ((body body) (r r) (mr mr) (ids '()) (bindings '()) (inits '()) (meta-seen? #f))
+ (if (null? body)
+ (return r mr bindings ids inits)
+ (let* ((fr (car body)) (e (frob-e fr)) (meta? (frob-meta? fr)))
+ (let-values (((type value e w ae) (syntax-type e r empty-wrap no-source ribcage)))
+ (case type
+ ((define-form)
+ (let-values (((id rhs w) (parse-define e w ae)))
+ (let* ((id (wrap id w))
+ (label (gen-indirect-label))
+ (imps (get-implicit-exports id)))
+ (extend-ribcage! ribcage id label)
+ (cond
+ (meta?
+ (let* ((sym (generate-id (id-sym-name id)))
+ (b (make-binding 'meta-variable sym)))
+ ; add meta bindings only to meta environment
+ (let ((mr (extend-env (get-indirect-label label) b mr)))
+ (let ((exp (chi rhs mr mr w #t)))
+ (define-top-level-value-hook sym (top-level-eval-hook exp))
+ (meta-residualize!
+ (ct-eval/residualize3 ctem
+ void
+ (lambda () (build-global-definition no-source sym exp))))
+ (parse (cdr body) r mr
+ (cons id ids)
+ (cons (create-module-binding 'ctdefine-form id label imps b) bindings)
+ inits
+ #f)))))
+ (else
+ (parse (cdr body) r mr
+ (cons id ids)
+ (cons (create-module-binding type id label
+ imps (make-frob (wrap rhs w) meta?))
+ bindings)
+ inits
+ #f))))))
+ ((define-syntax-form)
+ (let-values (((id rhs w) (parse-define-syntax e w ae)))
+ (let* ((id (wrap id w))
+ (label (gen-indirect-label))
+ (imps (get-implicit-exports id))
+ (exp (chi rhs mr mr w #t)))
+ (extend-ribcage! ribcage id label)
+ (let ((l (get-indirect-label label)) (b (defer-or-eval-transformer top-level-eval-hook exp)))
+ (parse (cdr body)
+ (extend-env l b r)
+ (extend-env l b mr)
+ (cons id ids)
+ (cons (create-module-binding type id label imps (cons b exp))
+ bindings)
+ inits
+ #f)))))
+ (($module-form)
+ (let* ((*ribcage (make-empty-ribcage))
+ (*w (make-wrap (wrap-marks w) (cons *ribcage (wrap-subst w)))))
+ (let-values (((orig id *exports forms) (parse-module e w ae *w)))
+ (let-values (((r mr *bindings *inits)
+ (chi-external *ribcage orig
+ (map (lambda (d) (make-frob d meta?)) forms)
+ r mr ctem *exports (flatten-exports *exports) meta-residualize!)))
+ (let ((iface (make-unresolved-interface id *exports))
+ (bindings (append *bindings bindings))
+ (inits (append inits *inits))
+ (label (gen-indirect-label))
+ (imps (get-implicit-exports id)))
+ (extend-ribcage! ribcage id label)
+ (let ((l (get-indirect-label label)) (b (make-binding '$module iface)))
+ (parse (cdr body)
+ (extend-env l b r)
+ (extend-env l b mr)
+ (cons id ids)
+ (cons (create-module-binding type id label imps *exports) bindings)
+ inits
+ #f)))))))
+ (($import-form)
+ (let-values (((orig only? mid) (parse-import e w ae)))
+ (let ((mlabel (id-var-name mid empty-wrap)))
+ (let ((binding (lookup mlabel r)))
+ (case (binding-type binding)
+ (($module)
+ (let* ((iface (binding-value binding))
+ (import-iface (make-import-interface iface (import-mark-delta mid iface))))
+ (when only? (extend-ribcage-barrier! ribcage mid))
+ (do-import! import-iface ribcage)
+ (parse (cdr body) r mr
+ (cons import-iface ids)
+ (update-imp-exports bindings (vector->list (interface-exports iface)))
+ inits
+ #f)))
+ ((displaced-lexical) (displaced-lexical-error mid))
+ (else (syntax-error mid "unknown module")))))))
+ ((alias-form)
+ (let-values (((new-id old-id) (parse-alias e w ae)))
+ (let* ((new-id (wrap new-id w))
+ (label (id-var-name-loc old-id w))
+ (imps (get-implicit-exports new-id)))
+ (extend-ribcage! ribcage new-id label)
+ (parse (cdr body) r mr
+ (cons new-id ids)
+ (cons (create-module-binding type new-id label imps #f)
+ bindings)
+ inits
+ #f))))
+ ((begin-form)
+ (parse (let f ((forms (parse-begin e w ae #t)))
+ (if (null? forms)
+ (cdr body)
+ (cons (make-frob (wrap (car forms) w) meta?)
+ (f (cdr forms)))))
+ r mr ids bindings inits #f))
+ ((eval-when-form)
+ (let-values (((when-list forms) (parse-eval-when e w ae)))
+ (parse (if (memq 'eval when-list) ; mode set is implicitly (E)
+ (let f ((forms forms))
+ (if (null? forms)
+ (cdr body)
+ (cons (make-frob (wrap (car forms) w) meta?)
+ (f (cdr forms)))))
+ (cdr body))
+ r mr ids bindings inits #f)))
+ ((meta-form)
+ (parse (cons (make-frob (wrap (parse-meta e w ae) w) #t)
+ (cdr body))
+ r mr ids bindings inits #t))
+ ((local-syntax-form)
+ (let-values (((forms r mr w ae) (chi-local-syntax value e r mr w ae)))
+ (parse (let f ((forms forms))
+ (if (null? forms)
+ (cdr body)
+ (cons (make-frob (wrap (car forms) w) meta?)
+ (f (cdr forms)))))
+ r mr ids bindings inits #f)))
+ (else ; found an init expression
+ (when meta-seen? (syntax-error (source-wrap e w ae) "invalid meta definition"))
+ (let f ((body (cons (make-frob (source-wrap e w ae) meta?) (cdr body))))
+ (if (or (null? body) (not (frob-meta? (car body))))
+ (return r mr bindings ids (append inits body))
+ (begin
+ ; expand and eval meta inits for effect only
+ (let ((x (chi-meta-frob (car body) mr)))
+ (top-level-eval-hook x)
+ (meta-residualize! (ct-eval/residualize3 ctem void (lambda () x))))
+ (f (cdr body)))))))))))))
+
+(define vmap
+ (lambda (fn v)
+ (do ((i (fx- (vector-length v) 1) (fx- i 1))
+ (ls '() (cons (fn (vector-ref v i)) ls)))
+ ((fx< i 0) ls))))
+
+(define vfor-each
+ (lambda (fn v)
+ (let ((len (vector-length v)))
+ (do ((i 0 (fx+ i 1)))
+ ((fx= i len))
+ (fn (vector-ref v i))))))
+
+(define do-top-import
+ (lambda (import-only? top-ribcage mid token)
+ ; silently treat import-only like regular import at top level
+ (build-cte-install mid
+ (build-data no-source
+ (make-binding 'do-import token))
+ (top-ribcage-key top-ribcage))))
+
+(define update-mode-set
+ (let ((table
+ '((L (load . L) (compile . C) (visit . V) (revisit . R) (eval . -))
+ (C (load . -) (compile . -) (visit . -) (revisit . -) (eval . C))
+ (V (load . V) (compile . C) (visit . V) (revisit . -) (eval . -))
+ (R (load . R) (compile . C) (visit . -) (revisit . R) (eval . -))
+ (E (load . -) (compile . -) (visit . -) (revisit . -) (eval . E)))))
+ (lambda (when-list mode-set)
+ (define remq
+ (lambda (x ls)
+ (if (null? ls)
+ '()
+ (if (eq? (car ls) x)
+ (remq x (cdr ls))
+ (cons (car ls) (remq x (cdr ls)))))))
+ (remq '-
+ (apply append
+ (map (lambda (m)
+ (let ((row (cdr (assq m table))))
+ (map (lambda (s) (cdr (assq s row)))
+ when-list)))
+ mode-set))))))
+
+(define initial-mode-set
+ (lambda (when-list compiling-a-file)
+ (apply append
+ (map (lambda (s)
+ (if compiling-a-file
+ (case s
+ ((compile) '(C))
+ ((load) '(L))
+ ((visit) '(V))
+ ((revisit) '(R))
+ (else '()))
+ (case s
+ ((eval) '(E))
+ (else '()))))
+ when-list))))
+
+(define rt-eval/residualize
+ (lambda (rtem thunk)
+ (if (memq 'E rtem)
+ (thunk)
+ (let ((thunk (if (memq 'C rtem)
+ (let ((x (thunk)))
+ (top-level-eval-hook x)
+ (lambda () x))
+ thunk)))
+ (if (memq 'V rtem)
+ (if (or (memq 'L rtem) (memq 'R rtem))
+ (thunk) ; visit-revisit
+ (build-visit-only (thunk)))
+ (if (or (memq 'L rtem) (memq 'R rtem))
+ (build-revisit-only (thunk))
+ (chi-void)))))))
+
+(define ct-eval/residualize2
+ (lambda (ctem thunk)
+ (let ((t #f))
+ (ct-eval/residualize3 ctem
+ (lambda ()
+ (unless t (set! t (thunk)))
+ (top-level-eval-hook t))
+ (lambda () (or t (thunk)))))))
+(define ct-eval/residualize3
+ (lambda (ctem eval-thunk residualize-thunk)
+ (if (memq 'E ctem)
+ (begin (eval-thunk) (chi-void))
+ (begin
+ (when (memq 'C ctem) (eval-thunk))
+ (if (memq 'R ctem)
+ (if (or (memq 'L ctem) (memq 'V ctem))
+ (residualize-thunk) ; visit-revisit
+ (build-revisit-only (residualize-thunk)))
+ (if (or (memq 'L ctem) (memq 'V ctem))
+ (build-visit-only (residualize-thunk))
+ (chi-void)))))))
+
+(define chi-frobs
+ (lambda (frob* r mr m?)
+ (map (lambda (x) (chi (frob-e x) r mr empty-wrap m?)) frob*)))
+
+(define chi-meta-frob
+ (lambda (x mr)
+ (chi (frob-e x) mr mr empty-wrap #t)))
+
+(define chi-sequence
+ (lambda (body r mr w ae m?)
+ (build-sequence ae
+ (let dobody ((body body))
+ (if (null? body)
+ '()
+ (let ((first (chi (car body) r mr w m?)))
+ (cons first (dobody (cdr body)))))))))
+
+(define chi
+ (lambda (e r mr w m?)
+ (let-values (((type value e w ae) (syntax-type e r w no-source #f)))
+ (chi-expr type value e r mr w ae m?))))
+
+(define chi-expr
+ (lambda (type value e r mr w ae m?)
+ (case type
+ ((lexical)
+ (build-lexical-reference 'value ae value))
+ ((core) (value e r mr w ae m?))
+ ((lexical-call)
+ (chi-application
+ (build-lexical-reference 'fun
+ (let ((x (car e)))
+ (if (syntax-object? x) (syntax-object-expression x) x))
+ value)
+ e r mr w ae m?))
+ ((constant) (build-data ae (strip (source-wrap e w ae) empty-wrap)))
+ ((global) (build-global-reference ae value))
+ ((meta-variable)
+ (if m?
+ (build-global-reference ae value)
+ (displaced-lexical-error (source-wrap e w ae))))
+ ((call) (chi-application (chi (car e) r mr w m?) e r mr w ae m?))
+ ((begin-form) (chi-sequence (parse-begin e w ae #f) r mr w ae m?))
+ ((local-syntax-form)
+ (let-values (((forms r mr w ae) (chi-local-syntax value e r mr w ae)))
+ (chi-sequence forms r mr w ae m?)))
+ ((eval-when-form)
+ (let-values (((when-list forms) (parse-eval-when e w ae)))
+ (if (memq 'eval when-list) ; mode set is implicitly (E)
+ (chi-sequence forms r mr w ae m?)
+ (chi-void))))
+ ((meta-form)
+ (syntax-error (source-wrap e w ae) "invalid context for meta definition"))
+ ((define-form)
+ (parse-define e w ae)
+ (syntax-error (source-wrap e w ae) "invalid context for definition"))
+ ((define-syntax-form)
+ (parse-define-syntax e w ae)
+ (syntax-error (source-wrap e w ae) "invalid context for definition"))
+ (($module-form)
+ (let-values (((orig id exports forms) (parse-module e w ae w)))
+ (syntax-error orig "invalid context for definition")))
+ (($import-form)
+ (let-values (((orig only? mid) (parse-import e w ae)))
+ (syntax-error orig "invalid context for definition")))
+ ((alias-form)
+ (parse-alias e w ae)
+ (syntax-error (source-wrap e w ae) "invalid context for definition"))
+ ((syntax)
+ (syntax-error (source-wrap e w ae)
+ "reference to pattern variable outside syntax form"))
+ ((displaced-lexical) (displaced-lexical-error (source-wrap e w ae)))
+ (else (syntax-error (source-wrap e w ae))))))
+
+(define chi-application
+ (lambda (x e r mr w ae m?)
+ (syntax-case e ()
+ ((e0 e1 ...)
+ (build-application ae x
+ (map (lambda (e) (chi e r mr w m?)) (syntax (e1 ...)))))
+ (_ (syntax-error (source-wrap e w ae))))))
+
+(define chi-set!
+ (lambda (e r w ae rib)
+ (syntax-case e ()
+ ((_ id val)
+ (id? (syntax id))
+ (let ((n (id-var-name (syntax id) w)))
+ (let ((b (lookup n r)))
+ (case (binding-type b)
+ ((macro!)
+ (let ((id (wrap (syntax id) w)) (val (wrap (syntax val) w)))
+ (syntax-type (chi-macro (binding-value b)
+ `(,(syntax set!) ,id ,val)
+ r empty-wrap #f rib) r empty-wrap #f rib)))
+ (else
+ (values 'core
+ (lambda (e r mr w ae m?)
+ ; repeat lookup in case we were first expression (init) in
+ ; module or lambda body. we repeat id-var-name as well,
+ ; although this is only necessary if we allow inits to
+ ; preced definitions
+ (let ((val (chi (syntax val) r mr w m?))
+ (n (id-var-name (syntax id) w)))
+ (let ((b (lookup n r)))
+ (case (binding-type b)
+ ((lexical) (build-lexical-assignment ae (binding-value b) val))
+ ((global)
+ (let ((sym (binding-value b)))
+ (when (read-only-binding? n)
+ (syntax-error (source-wrap e w ae)
+ "invalid assignment to read-only variable"))
+ (build-global-assignment ae sym val)))
+ ((meta-variable)
+ (if m?
+ (build-global-assignment ae (binding-value b) val)
+ (displaced-lexical-error (wrap (syntax id) w))))
+ ((displaced-lexical)
+ (displaced-lexical-error (wrap (syntax id) w)))
+ (else (syntax-error (source-wrap e w ae)))))))
+ e w ae))))))
+ (_ (syntax-error (source-wrap e w ae))))))
+
+(define chi-macro
+ (lambda (p e r w ae rib)
+ (define rebuild-macro-output
+ (lambda (x m)
+ (cond ((pair? x)
+ (cons (rebuild-macro-output (car x) m)
+ (rebuild-macro-output (cdr x) m)))
+ ((syntax-object? x)
+ (let ((w (syntax-object-wrap x)))
+ (let ((ms (wrap-marks w)) (s (wrap-subst w)))
+ (make-syntax-object (syntax-object-expression x)
+ (if (and (pair? ms) (eq? (car ms) the-anti-mark))
+ (make-wrap (cdr ms) (cdr s))
+ (make-wrap (cons m ms)
+ (if rib
+ (cons rib (cons 'shift s))
+ (cons 'shift s))))))))
+ ((vector? x)
+ (let* ((n (vector-length x)) (v (make-vector n)))
+ (do ((i 0 (fx+ i 1)))
+ ((fx= i n) v)
+ (vector-set! v i
+ (rebuild-macro-output (vector-ref x i) m)))))
+ ((symbol? x)
+ (syntax-error (source-wrap e w ae)
+ "encountered raw symbol "
+ (symbol->string x)
+ " in output of macro"))
+ (else x))))
+ (rebuild-macro-output
+ (let ((out (p (source-wrap e (anti-mark w) ae))))
+ (if (procedure? out)
+ (out (lambda (id)
+ (unless (identifier? id)
+ (syntax-error id
+ "environment argument is not an identifier"))
+ (lookup (id-var-name id empty-wrap) r)))
+ out))
+ (new-mark))))
+
+(define chi-body
+ (lambda (body outer-form r mr w m?)
+ (let* ((ribcage (make-empty-ribcage))
+ (w (make-wrap (wrap-marks w) (cons ribcage (wrap-subst w))))
+ (body (map (lambda (x) (make-frob (wrap x w) #f)) body)))
+ (let-values (((r mr exprs ids vars vals inits)
+ (chi-internal ribcage outer-form body r mr m?)))
+ (when (null? exprs) (syntax-error outer-form "no expressions in body"))
+ (build-body no-source
+ (reverse vars) (chi-frobs (reverse vals) r mr m?)
+ (build-sequence no-source
+ (chi-frobs (append inits exprs) r mr m?)))))))
+
+(define chi-internal
+ ;; In processing the forms of the body, we create a new, empty wrap.
+ ;; This wrap is augmented (destructively) each time we discover that
+ ;; the next form is a definition. This is done:
+ ;;
+ ;; (1) to allow the first nondefinition form to be a call to
+ ;; one of the defined ids even if the id previously denoted a
+ ;; definition keyword or keyword for a macro expanding into a
+ ;; definition;
+ ;; (2) to prevent subsequent definition forms (but unfortunately
+ ;; not earlier ones) and the first nondefinition form from
+ ;; confusing one of the bound identifiers for an auxiliary
+ ;; keyword; and
+ ;; (3) so that we do not need to restart the expansion of the
+ ;; first nondefinition form, which is problematic anyway
+ ;; since it might be the first element of a begin that we
+ ;; have just spliced into the body (meaning if we restarted,
+ ;; we'd really need to restart with the begin or the macro
+ ;; call that expanded into the begin, and we'd have to give
+ ;; up allowing (begin <defn>+ <expr>+), which is itself
+ ;; problematic since we don't know if a begin contains only
+ ;; definitions until we've expanded it).
+ ;;
+ ;; Subforms of a begin, let-syntax, or letrec-syntax are spliced
+ ;; into the body.
+ ;;
+ ;; outer-form is fully wrapped w/source
+ (lambda (ribcage source-exp body r mr m?)
+ (define return
+ (lambda (r mr exprs ids vars vals inits)
+ (check-defined-ids source-exp ids)
+ (values r mr exprs ids vars vals inits)))
+ (let parse ((body body) (r r) (mr mr) (ids '()) (vars '()) (vals '()) (inits '()) (meta-seen? #f))
+ (if (null? body)
+ (return r mr body ids vars vals inits)
+ (let* ((fr (car body)) (e (frob-e fr)) (meta? (frob-meta? fr)))
+ (let-values (((type value e w ae) (syntax-type e r empty-wrap no-source ribcage)))
+ (case type
+ ((define-form)
+ (let-values (((id rhs w) (parse-define e w ae)))
+ (let ((id (wrap id w)) (label (gen-label)))
+ (cond
+ (meta?
+ (let ((sym (generate-id (id-sym-name id))))
+ (extend-ribcage! ribcage id label)
+ ; add meta bindings only to meta environment
+ ; so visible only to next higher level and beyond
+ (let ((mr (extend-env label (make-binding 'meta-variable sym) mr)))
+ (define-top-level-value-hook sym
+ (top-level-eval-hook (chi rhs mr mr w #t)))
+ (parse (cdr body) r mr (cons id ids) vars vals inits #f))))
+ (else
+ (let ((var (gen-var id)))
+ (extend-ribcage! ribcage id label)
+ ; add lexical bindings only to run-time environment
+ (parse (cdr body)
+ (extend-env label (make-binding 'lexical var) r)
+ mr
+ (cons id ids)
+ (cons var vars)
+ (cons (make-frob (wrap rhs w) meta?) vals)
+ inits
+ #f)))))))
+ ((define-syntax-form)
+ (let-values (((id rhs w) (parse-define-syntax e w ae)))
+ (let ((id (wrap id w))
+ (label (gen-label))
+ (exp (chi rhs mr mr w #t)))
+ (extend-ribcage! ribcage id label)
+ (let ((b (defer-or-eval-transformer local-eval-hook exp)))
+ (parse (cdr body)
+ (extend-env label b r) (extend-env label b mr)
+ (cons id ids) vars vals inits #f)))))
+ (($module-form)
+ (let* ((*ribcage (make-empty-ribcage))
+ (*w (make-wrap (wrap-marks w) (cons *ribcage (wrap-subst w)))))
+ (let-values (((orig id exports forms) (parse-module e w ae *w)))
+ (let-values (((r mr *body *ids *vars *vals *inits)
+ (chi-internal *ribcage orig
+ (map (lambda (d) (make-frob d meta?)) forms)
+ r mr m?)))
+ ; valid bound ids checked already by chi-internal
+ (check-module-exports source-exp (flatten-exports exports) *ids)
+ (let ((iface (make-resolved-interface id exports #f))
+ (vars (append *vars vars))
+ (vals (append *vals vals))
+ (inits (append inits *inits *body))
+ (label (gen-label)))
+ (extend-ribcage! ribcage id label)
+ (let ((b (make-binding '$module iface)))
+ (parse (cdr body)
+ (extend-env label b r) (extend-env label b mr)
+ (cons id ids) vars vals inits #f)))))))
+ (($import-form)
+ (let-values (((orig only? mid) (parse-import e w ae)))
+ (let ((mlabel (id-var-name mid empty-wrap)))
+ (let ((binding (lookup mlabel r)))
+ (case (binding-type binding)
+ (($module)
+ (let* ((iface (binding-value binding))
+ (import-iface (make-import-interface iface (import-mark-delta mid iface))))
+ (when only? (extend-ribcage-barrier! ribcage mid))
+ (do-import! import-iface ribcage)
+ (parse (cdr body) r mr (cons import-iface ids) vars vals inits #f)))
+ ((displaced-lexical) (displaced-lexical-error mid))
+ (else (syntax-error mid "unknown module")))))))
+ ((alias-form)
+ (let-values (((new-id old-id) (parse-alias e w ae)))
+ (let ((new-id (wrap new-id w)))
+ (extend-ribcage! ribcage new-id (id-var-name-loc old-id w))
+ (parse (cdr body) r mr
+ (cons new-id ids)
+ vars
+ vals
+ inits
+ #f))))
+ ((begin-form)
+ (parse (let f ((forms (parse-begin e w ae #t)))
+ (if (null? forms)
+ (cdr body)
+ (cons (make-frob (wrap (car forms) w) meta?)
+ (f (cdr forms)))))
+ r mr ids vars vals inits #f))
+ ((eval-when-form)
+ (let-values (((when-list forms) (parse-eval-when e w ae)))
+ (parse (if (memq 'eval when-list) ; mode set is implicitly (E)
+ (let f ((forms forms))
+ (if (null? forms)
+ (cdr body)
+ (cons (make-frob (wrap (car forms) w) meta?)
+ (f (cdr forms)))))
+ (cdr body))
+ r mr ids vars vals inits #f)))
+ ((meta-form)
+ (parse (cons (make-frob (wrap (parse-meta e w ae) w) #t)
+ (cdr body))
+ r mr ids vars vals inits #t))
+ ((local-syntax-form)
+ (let-values (((forms r mr w ae) (chi-local-syntax value e r mr w ae)))
+ (parse (let f ((forms forms))
+ (if (null? forms)
+ (cdr body)
+ (cons (make-frob (wrap (car forms) w) meta?)
+ (f (cdr forms)))))
+ r mr ids vars vals inits #f)))
+ (else ; found a non-definition
+ (when meta-seen? (syntax-error (source-wrap e w ae) "invalid meta definition"))
+ (let f ((body (cons (make-frob (source-wrap e w ae) meta?) (cdr body))))
+ (if (or (null? body) (not (frob-meta? (car body))))
+ (return r mr body ids vars vals inits)
+ (begin
+ ; expand meta inits for effect only
+ (top-level-eval-hook (chi-meta-frob (car body) mr))
+ (f (cdr body)))))))))))))
+
+(define import-mark-delta
+ ; returns list of marks layered on top of module id beyond those
+ ; cached in the interface
+ (lambda (mid iface)
+ (diff-marks (id-marks mid) (interface-marks iface))))
+
+(define lookup-import-label
+ (lambda (id)
+ (let ((label (id-var-name-loc id empty-wrap)))
+ (unless label
+ (syntax-error id "exported identifier not visible"))
+ label)))
+
+(define do-import!
+ (lambda (import-iface ribcage)
+ (let ((ie (interface-exports (import-interface-interface import-iface))))
+ (if (<= (vector-length ie) 20)
+ (let ((new-marks (import-interface-new-marks import-iface)))
+ (vfor-each
+ (lambda (id)
+ (import-extend-ribcage! ribcage new-marks id
+ (lookup-import-label id)))
+ ie))
+ (extend-ribcage-subst! ribcage import-iface)))))
+
+(define parse-module
+ (lambda (e w ae *w)
+ (define listify
+ (lambda (exports)
+ (if (null? exports)
+ '()
+ (cons (syntax-case (car exports) ()
+ ((ex ...) (listify (syntax (ex ...))))
+ (x (if (id? (syntax x))
+ (wrap (syntax x) *w)
+ (syntax-error (source-wrap e w ae)
+ "invalid exports list in"))))
+ (listify (cdr exports))))))
+ (syntax-case e ()
+ ((_ orig mid (ex ...) form ...)
+ (id? (syntax mid))
+ ; id receives old wrap so it won't be confused with id of same name
+ ; defined within the module
+ (values (syntax orig) (wrap (syntax mid) w) (listify (syntax (ex ...))) (map (lambda (x) (wrap x *w)) (syntax (form ...)))))
+ (_ (syntax-error (source-wrap e w ae))))))
+
+(define parse-import
+ (lambda (e w ae)
+ (syntax-case e ()
+ ((_ orig #t mid)
+ (id? (syntax mid))
+ (values (syntax orig) #t (wrap (syntax mid) w)))
+ ((_ orig #f mid)
+ (id? (syntax mid))
+ (values (syntax orig) #f (wrap (syntax mid) w)))
+ (_ (syntax-error (source-wrap e w ae))))))
+
+(define parse-define
+ (lambda (e w ae)
+ (syntax-case e ()
+ ((_ name val)
+ (id? (syntax name))
+ (values (syntax name) (syntax val) w))
+ ((_ (name . args) e1 e2 ...)
+ (and (id? (syntax name))
+ (valid-bound-ids? (lambda-var-list (syntax args))))
+ (values (wrap (syntax name) w)
+ (cons (syntax lambda) (wrap (syntax (args e1 e2 ...)) w))
+ empty-wrap))
+ ((_ name)
+ (id? (syntax name))
+ (values (wrap (syntax name) w) (syntax (void)) empty-wrap))
+ (_ (syntax-error (source-wrap e w ae))))))
+
+(define parse-define-syntax
+ (lambda (e w ae)
+ (syntax-case e ()
+ ((_ (name id) e1 e2 ...)
+ (and (id? (syntax name)) (id? (syntax id)))
+ (values (wrap (syntax name) w)
+ `(,(syntax lambda) ,(wrap (syntax (id)) w)
+ ,@(wrap (syntax (e1 e2 ...)) w))
+ empty-wrap))
+ ((_ name val)
+ (id? (syntax name))
+ (values (syntax name) (syntax val) w))
+ (_ (syntax-error (source-wrap e w ae))))))
+
+(define parse-meta
+ (lambda (e w ae)
+ (syntax-case e ()
+ ((_ . form) (syntax form))
+ (_ (syntax-error (source-wrap e w ae))))))
+
+(define parse-eval-when
+ (lambda (e w ae)
+ (syntax-case e ()
+ ((_ (x ...) e1 e2 ...)
+ (values (chi-when-list (syntax (x ...)) w) (syntax (e1 e2 ...))))
+ (_ (syntax-error (source-wrap e w ae))))))
+
+(define parse-alias
+ (lambda (e w ae)
+ (syntax-case e ()
+ ((_ new-id old-id)
+ (and (id? (syntax new-id)) (id? (syntax old-id)))
+ (values (syntax new-id) (syntax old-id)))
+ (_ (syntax-error (source-wrap e w ae))))))
+
+(define parse-begin
+ (lambda (e w ae empty-okay?)
+ (syntax-case e ()
+ ((_) empty-okay? '())
+ ((_ e1 e2 ...) (syntax (e1 e2 ...)))
+ (_ (syntax-error (source-wrap e w ae))))))
+
+(define chi-lambda-clause
+ (lambda (e c r mr w m?)
+ (syntax-case c ()
+ (((id ...) e1 e2 ...)
+ (let ((ids (syntax (id ...))))
+ (if (not (valid-bound-ids? ids))
+ (syntax-error e "invalid parameter list in")
+ (let ((labels (gen-labels ids))
+ (new-vars (map gen-var ids)))
+ (values
+ new-vars
+ (chi-body (syntax (e1 e2 ...))
+ e
+ (extend-var-env* labels new-vars r)
+ mr
+ (make-binding-wrap ids labels w)
+ m?))))))
+ ((ids e1 e2 ...)
+ (let ((old-ids (lambda-var-list (syntax ids))))
+ (if (not (valid-bound-ids? old-ids))
+ (syntax-error e "invalid parameter list in")
+ (let ((labels (gen-labels old-ids))
+ (new-vars (map gen-var old-ids)))
+ (values
+ (let f ((ls1 (cdr new-vars)) (ls2 (car new-vars)))
+ (if (null? ls1)
+ ls2
+ (f (cdr ls1) (cons (car ls1) ls2))))
+ (chi-body (syntax (e1 e2 ...))
+ e
+ (extend-var-env* labels new-vars r)
+ mr
+ (make-binding-wrap old-ids labels w)
+ m?))))))
+ (_ (syntax-error e)))))
+
+(define chi-local-syntax
+ (lambda (rec? e r mr w ae)
+ (syntax-case e ()
+ ((_ ((id val) ...) e1 e2 ...)
+ (let ((ids (syntax (id ...))))
+ (if (not (valid-bound-ids? ids))
+ (invalid-ids-error (map (lambda (x) (wrap x w)) ids)
+ (source-wrap e w ae)
+ "keyword")
+ (let ((labels (gen-labels ids)))
+ (let ((new-w (make-binding-wrap ids labels w)))
+ (let ((b* (let ((w (if rec? new-w w)))
+ (map (lambda (x)
+ (defer-or-eval-transformer
+ local-eval-hook
+ (chi x mr mr w #t)))
+ (syntax (val ...))))))
+ (values
+ (syntax (e1 e2 ...))
+ (extend-env* labels b* r)
+ (extend-env* labels b* mr)
+ new-w
+ ae)))))))
+ (_ (syntax-error (source-wrap e w ae))))))
+
+(define chi-void
+ (lambda ()
+ (build-application no-source (build-primref no-source 'void) '())))
+
+(define ellipsis?
+ (lambda (x)
+ (and (nonsymbol-id? x)
+ (literal-id=? x (syntax (... ...))))))
+
+;;; data
+
+;;; strips all annotations from potentially circular reader output.
+
+(define strip-annotation
+ (lambda (x)
+ (cond
+ ((pair? x)
+ (cons (strip-annotation (car x))
+ (strip-annotation (cdr x))))
+ ((annotation? x) (annotation-stripped x))
+ (else x))))
+
+;;; strips syntax-objects down to top-wrap; if top-wrap is layered directly
+;;; on an annotation, strips the annotation as well.
+;;; since only the head of a list is annotated by the reader, not each pair
+;;; in the spine, we also check for pairs whose cars are annotated in case
+;;; we've been passed the cdr of an annotated list
+
+(define strip*
+ (lambda (x w fn)
+ (if (top-marked? w)
+ (fn x)
+ (let f ((x x))
+ (cond
+ ((syntax-object? x)
+ (strip* (syntax-object-expression x) (syntax-object-wrap x) fn))
+ ((pair? x)
+ (let ((a (f (car x))) (d (f (cdr x))))
+ (if (and (eq? a (car x)) (eq? d (cdr x)))
+ x
+ (cons a d))))
+ ((vector? x)
+ (let ((old (vector->list x)))
+ (let ((new (map f old)))
+ (if (andmap eq? old new) x (list->vector new)))))
+ (else x))))))
+
+(define strip
+ (lambda (x w)
+ (strip* x w
+ (lambda (x)
+ (if (or (annotation? x) (and (pair? x) (annotation? (car x))))
+ (strip-annotation x)
+ x)))))
+
+;;; lexical variables
+
+(define gen-var
+ (lambda (id)
+ (let ((id (if (syntax-object? id) (syntax-object-expression id) id)))
+ (if (annotation? id)
+ (build-lexical-var id (annotation-expression id))
+ (build-lexical-var id id)))))
+
+(define lambda-var-list
+ (lambda (vars)
+ (let lvl ((vars vars) (ls '()) (w empty-wrap))
+ (cond
+ ((pair? vars) (lvl (cdr vars) (cons (wrap (car vars) w) ls) w))
+ ((id? vars) (cons (wrap vars w) ls))
+ ((null? vars) ls)
+ ((syntax-object? vars)
+ (lvl (syntax-object-expression vars)
+ ls
+ (join-wraps w (syntax-object-wrap vars))))
+ ((annotation? vars)
+ (lvl (annotation-expression vars) ls w))
+ ; include anything else to be caught by subsequent error
+ ; checking
+ (else (cons vars ls))))))
+
+
+; must precede global-extends
+
+(set! $sc-put-cte
+ (lambda (id b top-token)
+ (define sc-put-module
+ (lambda (exports token new-marks)
+ (vfor-each
+ (lambda (id) (store-import-binding id token new-marks))
+ exports)))
+ (define (put-cte id binding token)
+ (let ((sym (if (symbol? id) id (id-var-name id empty-wrap))))
+ (store-import-binding id token '())
+ (put-global-definition-hook sym
+ ; global binding is assumed; if global pass #f to remove existing binding, if any
+ (if (and (eq? (binding-type binding) 'global)
+ (eq? (binding-value binding) sym))
+ #f
+ binding))))
+ (let ((binding (make-transformer-binding b)))
+ (case (binding-type binding)
+ (($module)
+ (let ((iface (binding-value binding)))
+ (sc-put-module (interface-exports iface) (interface-token iface) '()))
+ (put-cte id binding top-token))
+ ((do-alias) (store-import-binding id top-token '()))
+ ((do-import)
+ ; fake binding: id is module id binding-value is token
+ (let ((token (binding-value b)))
+ (let ((b (lookup (id-var-name id empty-wrap) null-env)))
+ (case (binding-type b)
+ (($module)
+ (let* ((iface (binding-value b))
+ (exports (interface-exports iface)))
+ (unless (eq? (interface-token iface) token)
+ (syntax-error id "import mismatch for module"))
+ (sc-put-module (interface-exports iface) top-token
+ (import-mark-delta id iface))))
+ (else (syntax-error id "unknown module"))))))
+ (else (put-cte id binding top-token))))
+ ))
+
+
+;;; core transformers
+
+(global-extend 'local-syntax 'letrec-syntax #t)
+(global-extend 'local-syntax 'let-syntax #f)
+
+
+(global-extend 'core 'fluid-let-syntax
+ (lambda (e r mr w ae m?)
+ (syntax-case e ()
+ ((_ ((var val) ...) e1 e2 ...)
+ (valid-bound-ids? (syntax (var ...)))
+ (let ((names (map (lambda (x) (id-var-name x w)) (syntax (var ...)))))
+ (for-each
+ (lambda (id n)
+ (case (binding-type (lookup n r))
+ ((displaced-lexical) (displaced-lexical-error (wrap id w)))))
+ (syntax (var ...))
+ names)
+ (let ((b* (map (lambda (x)
+ (defer-or-eval-transformer
+ local-eval-hook
+ (chi x mr mr w #t)))
+ (syntax (val ...)))))
+ (chi-body
+ (syntax (e1 e2 ...))
+ (source-wrap e w ae)
+ (extend-env* names b* r)
+ (extend-env* names b* mr)
+ w
+ m?))))
+ (_ (syntax-error (source-wrap e w ae))))))
+
+(global-extend 'core 'quote
+ (lambda (e r mr w ae m?)
+ (syntax-case e ()
+ ((_ e) (build-data ae (strip (syntax e) w)))
+ (_ (syntax-error (source-wrap e w ae))))))
+
+(global-extend 'core 'syntax
+ (let ()
+ (define gen-syntax
+ (lambda (src e r maps ellipsis? vec?)
+ (if (id? e)
+ (let ((label (id-var-name e empty-wrap)))
+ (let ((b (lookup label r)))
+ (if (eq? (binding-type b) 'syntax)
+ (let-values (((var maps)
+ (let ((var.lev (binding-value b)))
+ (gen-ref src (car var.lev) (cdr var.lev) maps))))
+ (values `(ref ,var) maps))
+ (if (ellipsis? e)
+ (syntax-error src "misplaced ellipsis in syntax form")
+ (values `(quote ,e) maps)))))
+ (syntax-case e ()
+ ((dots e)
+ (ellipsis? (syntax dots))
+ (if vec?
+ (syntax-error src "misplaced ellipsis in syntax template")
+ (gen-syntax src (syntax e) r maps (lambda (x) #f) #f)))
+ ((x dots . y)
+ ; this could be about a dozen lines of code, except that we
+ ; choose to handle (syntax (x ... ...)) forms
+ (ellipsis? (syntax dots))
+ (let f ((y (syntax y))
+ (k (lambda (maps)
+ (let-values (((x maps)
+ (gen-syntax src (syntax x) r
+ (cons '() maps) ellipsis? #f)))
+ (if (null? (car maps))
+ (syntax-error src
+ "extra ellipsis in syntax form")
+ (values (gen-map x (car maps))
+ (cdr maps)))))))
+ (syntax-case y ()
+ ((dots . y)
+ (ellipsis? (syntax dots))
+ (f (syntax y)
+ (lambda (maps)
+ (let-values (((x maps) (k (cons '() maps))))
+ (if (null? (car maps))
+ (syntax-error src
+ "extra ellipsis in syntax form")
+ (values (gen-mappend x (car maps))
+ (cdr maps)))))))
+ (_ (let-values (((y maps) (gen-syntax src y r maps ellipsis? vec?)))
+ (let-values (((x maps) (k maps)))
+ (values (gen-append x y) maps)))))))
+ ((x . y)
+ (let-values (((xnew maps) (gen-syntax src (syntax x) r maps ellipsis? #f)))
+ (let-values (((ynew maps) (gen-syntax src (syntax y) r maps ellipsis? vec?)))
+ (values (gen-cons e (syntax x) (syntax y) xnew ynew)
+ maps))))
+ (#(x1 x2 ...)
+ (let ((ls (syntax (x1 x2 ...))))
+ (let-values (((lsnew maps) (gen-syntax src ls r maps ellipsis? #t)))
+ (values (gen-vector e ls lsnew) maps))))
+ (_ (values `(quote ,e) maps))))))
+
+ (define gen-ref
+ (lambda (src var level maps)
+ (if (fx= level 0)
+ (values var maps)
+ (if (null? maps)
+ (syntax-error src "missing ellipsis in syntax form")
+ (let-values (((outer-var outer-maps) (gen-ref src var (fx- level 1) (cdr maps))))
+ (let ((b (assq outer-var (car maps))))
+ (if b
+ (values (cdr b) maps)
+ (let ((inner-var (gen-var 'tmp)))
+ (values inner-var
+ (cons (cons (cons outer-var inner-var)
+ (car maps))
+ outer-maps))))))))))
+
+ (define gen-append
+ (lambda (x y)
+ (if (equal? y '(quote ()))
+ x
+ `(append ,x ,y))))
+
+ (define gen-mappend
+ (lambda (e map-env)
+ `(apply (primitive append) ,(gen-map e map-env))))
+
+ (define gen-map
+ (lambda (e map-env)
+ (let ((formals (map cdr map-env))
+ (actuals (map (lambda (x) `(ref ,(car x))) map-env)))
+ (cond
+ ((eq? (car e) 'ref)
+ ; identity map equivalence:
+ ; (map (lambda (x) x) y) == y
+ (car actuals))
+ ((andmap
+ (lambda (x) (and (eq? (car x) 'ref) (memq (cadr x) formals)))
+ (cdr e))
+ ; eta map equivalence:
+ ; (map (lambda (x ...) (f x ...)) y ...) == (map f y ...)
+ `(map (primitive ,(car e))
+ ,@(map (let ((r (map cons formals actuals)))
+ (lambda (x) (cdr (assq (cadr x) r))))
+ (cdr e))))
+ (else `(map (lambda ,formals ,e) ,@actuals))))))
+
+ ; 12/12/00: semantic change: we now return original syntax object (e)
+ ; if no pattern variables were found within, to avoid dropping
+ ; source annotations prematurely. the "syntax returns lists" for
+ ; lists in its input guarantee counts only for substructure that
+ ; contains pattern variables
+ (define gen-cons
+ (lambda (e x y xnew ynew)
+ (case (car ynew)
+ ((quote)
+ (if (eq? (car xnew) 'quote)
+ (let ((xnew (cadr xnew)) (ynew (cadr ynew)))
+ (if (and (eq? xnew x) (eq? ynew y))
+ `',e
+ `'(,xnew . ,ynew)))
+ (if (eq? (cadr ynew) '()) `(list ,xnew) `(cons ,xnew ,ynew))))
+ ((list) `(list ,xnew ,@(cdr ynew)))
+ (else `(cons ,xnew ,ynew)))))
+
+ (define gen-vector
+ (lambda (e ls lsnew)
+ (cond
+ ((eq? (car lsnew) 'quote)
+ (if (eq? (cadr lsnew) ls)
+ `',e
+ `(quote #(,@(cadr lsnew)))))
+ ((eq? (car lsnew) 'list) `(vector ,@(cdr lsnew)))
+ (else `(list->vector ,lsnew)))))
+
+
+ (define regen
+ (lambda (x)
+ (case (car x)
+ ((ref) (build-lexical-reference 'value no-source (cadr x)))
+ ((primitive) (build-primref no-source (cadr x)))
+ ((quote) (build-data no-source (cadr x)))
+ ((lambda) (build-lambda no-source (cadr x) (regen (caddr x))))
+ ((map) (let ((ls (map regen (cdr x))))
+ (build-application no-source
+ (if (fx= (length ls) 2)
+ (build-primref no-source 'map)
+ ; really need to do our own checking here
+ (build-primref no-source 2 'map)) ; require error check
+ ls)))
+ (else (build-application no-source
+ (build-primref no-source (car x))
+ (map regen (cdr x)))))))
+
+ (lambda (e r mr w ae m?)
+ (let ((e (source-wrap e w ae)))
+ (syntax-case e ()
+ ((_ x)
+ (let-values (((e maps) (gen-syntax e (syntax x) r '() ellipsis? #f)))
+ (regen e)))
+ (_ (syntax-error e)))))))
+
+
+(global-extend 'core 'lambda
+ (lambda (e r mr w ae m?)
+ (syntax-case e ()
+ ((_ . c)
+ (let-values (((vars body) (chi-lambda-clause (source-wrap e w ae) (syntax c) r mr w m?)))
+ (build-lambda ae vars body))))))
+
+
+(global-extend 'core 'letrec
+ (lambda (e r mr w ae m?)
+ (syntax-case e ()
+ ((_ ((id val) ...) e1 e2 ...)
+ (let ((ids (syntax (id ...))))
+ (if (not (valid-bound-ids? ids))
+ (invalid-ids-error (map (lambda (x) (wrap x w)) ids)
+ (source-wrap e w ae) "bound variable")
+ (let ((labels (gen-labels ids))
+ (new-vars (map gen-var ids)))
+ (let ((w (make-binding-wrap ids labels w))
+ (r (extend-var-env* labels new-vars r)))
+ (build-letrec ae
+ new-vars
+ (map (lambda (x) (chi x r mr w m?)) (syntax (val ...)))
+ (chi-body (syntax (e1 e2 ...)) (source-wrap e w ae) r mr w m?)))))))
+ (_ (syntax-error (source-wrap e w ae))))))
+
+
+(global-extend 'core 'if
+ (lambda (e r mr w ae m?)
+ (syntax-case e ()
+ ((_ test then)
+ (build-conditional ae
+ (chi (syntax test) r mr w m?)
+ (chi (syntax then) r mr w m?)
+ (chi-void)))
+ ((_ test then else)
+ (build-conditional ae
+ (chi (syntax test) r mr w m?)
+ (chi (syntax then) r mr w m?)
+ (chi (syntax else) r mr w m?)))
+ (_ (syntax-error (source-wrap e w ae))))))
+
+
+
+(global-extend 'set! 'set! '())
+
+(global-extend 'alias 'alias '())
+(global-extend 'begin 'begin '())
+
+(global-extend '$module-key '$module '())
+(global-extend '$import '$import '())
+
+(global-extend 'define 'define '())
+
+(global-extend 'define-syntax 'define-syntax '())
+
+(global-extend 'eval-when 'eval-when '())
+
+(global-extend 'meta 'meta '())
+
+(global-extend 'core 'syntax-case
+ (let ()
+ (define convert-pattern
+ ; accepts pattern & keys
+ ; returns syntax-dispatch pattern & ids
+ (lambda (pattern keys)
+ (define cvt*
+ (lambda (p* n ids)
+ (if (null? p*)
+ (values '() ids)
+ (let-values (((y ids) (cvt* (cdr p*) n ids)))
+ (let-values (((x ids) (cvt (car p*) n ids)))
+ (values (cons x y) ids))))))
+ (define cvt
+ (lambda (p n ids)
+ (if (id? p)
+ (if (bound-id-member? p keys)
+ (values (vector 'free-id p) ids)
+ (values 'any (cons (cons p n) ids)))
+ (syntax-case p ()
+ ((x dots)
+ (ellipsis? (syntax dots))
+ (let-values (((p ids) (cvt (syntax x) (fx+ n 1) ids)))
+ (values (if (eq? p 'any) 'each-any (vector 'each p))
+ ids)))
+ ((x dots y ... . z)
+ (ellipsis? (syntax dots))
+ (let-values (((z ids) (cvt (syntax z) n ids)))
+ (let-values (((y ids) (cvt* (syntax (y ...)) n ids)))
+ (let-values (((x ids) (cvt (syntax x) (fx+ n 1) ids)))
+ (values `#(each+ ,x ,(reverse y) ,z) ids)))))
+ ((x . y)
+ (let-values (((y ids) (cvt (syntax y) n ids)))
+ (let-values (((x ids) (cvt (syntax x) n ids)))
+ (values (cons x y) ids))))
+ (() (values '() ids))
+ (#(x ...)
+ (let-values (((p ids) (cvt (syntax (x ...)) n ids)))
+ (values (vector 'vector p) ids)))
+ (x (values (vector 'atom (strip p empty-wrap)) ids))))))
+ (cvt pattern 0 '())))
+
+ (define build-dispatch-call
+ (lambda (pvars exp y r mr m?)
+ (let ((ids (map car pvars)) (levels (map cdr pvars)))
+ (let ((labels (gen-labels ids)) (new-vars (map gen-var ids)))
+ (build-application no-source
+ (build-primref no-source 'apply)
+ (list (build-lambda no-source new-vars
+ (chi exp
+ (extend-env*
+ labels
+ (map (lambda (var level)
+ (make-binding 'syntax `(,var . ,level)))
+ new-vars
+ (map cdr pvars))
+ r)
+ mr
+ (make-binding-wrap ids labels empty-wrap)
+ m?))
+ y))))))
+
+ (define gen-clause
+ (lambda (x keys clauses r mr m? pat fender exp)
+ (let-values (((p pvars) (convert-pattern pat keys)))
+ (cond
+ ((not (distinct-bound-ids? (map car pvars)))
+ (invalid-ids-error (map car pvars) pat "pattern variable"))
+ ((not (andmap (lambda (x) (not (ellipsis? (car x)))) pvars))
+ (syntax-error pat
+ "misplaced ellipsis in syntax-case pattern"))
+ (else
+ (let ((y (gen-var 'tmp)))
+ ; fat finger binding and references to temp variable y
+ (build-application no-source
+ (build-lambda no-source (list y)
+ (let-syntax ((y (identifier-syntax
+ (build-lexical-reference 'value no-source y))))
+ (build-conditional no-source
+ (syntax-case fender ()
+ (#t y)
+ (_ (build-conditional no-source
+ y
+ (build-dispatch-call pvars fender y r mr m?)
+ (build-data no-source #f))))
+ (build-dispatch-call pvars exp y r mr m?)
+ (gen-syntax-case x keys clauses r mr m?))))
+ (list (if (eq? p 'any)
+ (build-application no-source
+ (build-primref no-source 'list)
+ (list (build-lexical-reference no-source 'value x)))
+ (build-application no-source
+ (build-primref no-source '$syntax-dispatch)
+ (list (build-lexical-reference no-source 'value x)
+ (build-data no-source p))))))))))))
+
+ (define gen-syntax-case
+ (lambda (x keys clauses r mr m?)
+ (if (null? clauses)
+ (build-application no-source
+ (build-primref no-source 'syntax-error)
+ (list (build-lexical-reference 'value no-source x)))
+ (syntax-case (car clauses) ()
+ ((pat exp)
+ (if (and (id? (syntax pat))
+ (not (bound-id-member? (syntax pat) keys))
+ (not (ellipsis? (syntax pat))))
+ (let ((label (gen-label))
+ (var (gen-var (syntax pat))))
+ (build-application no-source
+ (build-lambda no-source (list var)
+ (chi (syntax exp)
+ (extend-env label (make-binding 'syntax `(,var . 0)) r)
+ mr
+ (make-binding-wrap (syntax (pat))
+ (list label) empty-wrap)
+ m?))
+ (list (build-lexical-reference 'value no-source x))))
+ (gen-clause x keys (cdr clauses) r mr m?
+ (syntax pat) #t (syntax exp))))
+ ((pat fender exp)
+ (gen-clause x keys (cdr clauses) r mr m?
+ (syntax pat) (syntax fender) (syntax exp)))
+ (_ (syntax-error (car clauses) "invalid syntax-case clause"))))))
+
+ (lambda (e r mr w ae m?)
+ (let ((e (source-wrap e w ae)))
+ (syntax-case e ()
+ ((_ val (key ...) m ...)
+ (if (andmap (lambda (x) (and (id? x) (not (ellipsis? x))))
+ (syntax (key ...)))
+ (let ((x (gen-var 'tmp)))
+ ; fat finger binding and references to temp variable x
+ (build-application ae
+ (build-lambda no-source (list x)
+ (gen-syntax-case x
+ (syntax (key ...)) (syntax (m ...))
+ r mr m?))
+ (list (chi (syntax val) r mr empty-wrap m?))))
+ (syntax-error e "invalid literals list in"))))))))
+
+(put-cte-hook 'module
+ (lambda (x)
+ (define proper-export?
+ (lambda (e)
+ (syntax-case e ()
+ ((id e ...)
+ (and (identifier? (syntax id))
+ (andmap proper-export? (syntax (e ...)))))
+ (id (identifier? (syntax id))))))
+ (with-syntax ((orig x))
+ (syntax-case x ()
+ ((_ (e ...) d ...)
+ (if (andmap proper-export? (syntax (e ...)))
+ (syntax (begin ($module orig anon (e ...) d ...) ($import orig #f anon)))
+ (syntax-error x "invalid exports list in")))
+ ((_ m (e ...) d ...)
+ (identifier? (syntax m))
+ (if (andmap proper-export? (syntax (e ...)))
+ (syntax ($module orig m (e ...) d ...))
+ (syntax-error x "invalid exports list in")))))))
+
+(let ()
+ (define $module-exports
+ (lambda (m r)
+ (let ((b (r m)))
+ (case (binding-type b)
+ (($module)
+ (let* ((interface (binding-value b))
+ (new-marks (import-mark-delta m interface)))
+ (vmap (lambda (x)
+ (let ((id (if (pair? x) (car x) x)))
+ (make-syntax-object
+ (syntax-object->datum id)
+ (let ((marks (join-marks new-marks (wrap-marks (syntax-object-wrap id)))))
+ (make-wrap marks
+ ; the anti mark should always be present at the head
+ ; of new-marks, but we paranoically check anyway
+ (if (eq? (car marks) the-anti-mark)
+ (cons 'shift (wrap-subst top-wrap))
+ (wrap-subst top-wrap)))))))
+ (interface-exports interface))))
+ ((displaced-lexical) (displaced-lexical-error m))
+ (else (syntax-error m "unknown module"))))))
+ (define $import-help
+ (lambda (orig import-only?)
+ (lambda (r)
+ (define difference
+ (lambda (ls1 ls2)
+ (if (null? ls1)
+ ls1
+ (if (bound-id-member? (car ls1) ls2)
+ (difference (cdr ls1) ls2)
+ (cons (car ls1) (difference (cdr ls1) ls2))))))
+ (define prefix-add
+ (lambda (prefix-id)
+ (let ((prefix (symbol->string (syntax-object->datum prefix-id))))
+ (lambda (id)
+ (datum->syntax-object id
+ (string->symbol
+ (string-append prefix
+ (symbol->string (syntax-object->datum id)))))))))
+ (define prefix-drop
+ (lambda (prefix-id)
+ (let ((prefix (symbol->string (syntax-object->datum prefix-id))))
+ (lambda (id)
+ (let ((s (symbol->string (syntax-object->datum id))))
+ (let ((np (string-length prefix)) (ns (string-length s)))
+ (unless (and (>= ns np) (string=? (substring s 0 np) prefix))
+ (syntax-error id (string-append "missing expected prefix " prefix)))
+ (datum->syntax-object id
+ (string->symbol (substring s np ns)))))))))
+ (define gen-mid
+ (lambda (mid)
+ ; introduced module ids must have same marks as original
+ ; for import-only, since the barrier carries the marks of
+ ; the module id
+ (datum->syntax-object mid (generate-id (id-sym-name mid)))))
+ (define (modspec m exports?)
+ (with-syntax ((orig orig) (import-only? import-only?))
+ (syntax-case m (only-for-syntax also-for-syntax
+ only except
+ add-prefix drop-prefix rename alias)
+ ((only m id ...)
+ (andmap identifier? (syntax (id ...)))
+ (let-values (((mid d exports) (modspec (syntax m) #f)))
+ (with-syntax ((d d) (tmid (gen-mid mid)))
+ (values mid
+ (syntax (begin ($module orig tmid (id ...) d) ($import orig import-only? tmid)))
+ (and exports? (syntax (id ...)))))))
+ ((except m id ...)
+ (andmap identifier? (syntax (id ...)))
+ (let-values (((mid d exports) (modspec (syntax m) #t)))
+ (with-syntax ((d d)
+ (tmid (gen-mid mid))
+ ((id ...) (difference exports (syntax (id ...)))))
+ (values mid
+ (syntax (begin ($module orig tmid (id ...) d) ($import orig import-only? tmid)))
+ (and exports? (syntax (id ...)))))))
+ ((add-prefix m prefix-id)
+ (identifier? (syntax prefix-id))
+ (let-values (((mid d exports) (modspec (syntax m) #t)))
+ (with-syntax ((d d)
+ (tmid (gen-mid mid))
+ ((old-id ...) exports)
+ ((tmp ...) (generate-temporaries exports))
+ ((id ...) (map (prefix-add (syntax prefix-id)) exports)))
+ (values mid
+ (syntax (begin ($module orig tmid ((id tmp) ...)
+ ($module orig tmid ((tmp old-id) ...) d (alias tmp old-id) ...)
+ ($import orig import-only? tmid)
+ (alias id tmp) ...)
+ ($import orig import-only? tmid)))
+ (and exports? (syntax (id ...)))))))
+ ((drop-prefix m prefix-id)
+ (identifier? (syntax prefix-id))
+ (let-values (((mid d exports) (modspec (syntax m) #t)))
+ (with-syntax ((d d)
+ (tmid (gen-mid mid))
+ ((old-id ...) exports)
+ ((tmp ...) (generate-temporaries exports))
+ ((id ...) (map (prefix-drop (syntax prefix-id)) exports)))
+ (values mid
+ (syntax (begin ($module orig tmid ((id tmp) ...)
+ ($module orig tmid ((tmp old-id) ...) d (alias tmp old-id) ...)
+ ($import orig import-only? tmid)
+ (alias id tmp) ...)
+ ($import orig import-only? tmid)))
+ (and exports? (syntax (id ...)))))))
+ ((rename m (new-id old-id) ...)
+ (and (andmap identifier? (syntax (new-id ...)))
+ (andmap identifier? (syntax (old-id ...))))
+ (let-values (((mid d exports) (modspec (syntax m) #t)))
+ (with-syntax ((d d)
+ (tmid (gen-mid mid))
+ ((tmp ...) (generate-temporaries (syntax (old-id ...))))
+ ((other-id ...) (difference exports (syntax (old-id ...)))))
+ (values mid
+ (syntax (begin ($module orig tmid ((new-id tmp) ... other-id ...)
+ ($module orig tmid (other-id ... (tmp old-id) ...) d (alias tmp old-id) ...)
+ ($import orig import-only? tmid)
+ (alias new-id tmp) ...)
+ ($import orig import-only? tmid)))
+ (and exports? (syntax (new-id ... other-id ...)))))))
+ ((alias m (new-id old-id) ...)
+ (and (andmap identifier? (syntax (new-id ...)))
+ (andmap identifier? (syntax (old-id ...))))
+ (let-values (((mid d exports) (modspec (syntax m) #t)))
+ (with-syntax ((d d)
+ (tmid (gen-mid mid))
+ ((other-id ...) exports))
+ (values mid
+ (syntax (begin ($module orig tmid ((new-id old-id) ... other-id ...) d (alias new-id old-id) ...)
+ ($import orig import-only? tmid)))
+ (and exports? (syntax (new-id ... other-id ...)))))))
+ ; base cases
+ (mid
+ (identifier? (syntax mid))
+ (values (syntax mid)
+ (syntax ($import orig import-only? mid))
+ (and exports? ($module-exports (syntax mid) r))))
+ ((mid)
+ (identifier? (syntax mid))
+ (values (syntax mid)
+ (syntax ($import orig import-only? mid))
+ (and exports? ($module-exports (syntax mid) r))))
+ (_ (syntax-error m "invalid module specifier")))))
+ (define modspec*
+ (lambda (m)
+ (let-values (((mid d exports) (modspec m #f))) d)))
+ (syntax-case orig ()
+ ((_ m ...)
+ (with-syntax (((d ...) (map modspec* (syntax (m ...)))))
+ (syntax (begin d ...))))))))
+
+ (put-cte-hook 'import
+ (lambda (orig)
+ ($import-help orig #f)))
+
+ (put-cte-hook 'import-only
+ (lambda (orig)
+ ($import-help orig #t)))
+)
+
+;;; To support eval-when, we maintain two mode sets:
+;;;
+;;; ctem (compile-time-expression mode)
+;;; determines whether/when to evaluate compile-time expressions such
+;;; as macro definitions, module definitions, and compile-time
+;;; registration of variable definitions
+;;;
+;;; rtem (run-time-expression mode)
+;;; determines whether/when to evaluate run-time expressions such
+;;; as the actual assignment performed by a variable definition or
+;;; arbitrary top-level expressions
+
+;;; Possible modes in the mode set are:
+;;;
+;;; L (load): evaluate at load time. implies V for compile-time
+;;; expressions and R for run-time expressions.
+;;;
+;;; C (compile): evaluate at compile (file) time
+;;;
+;;; E (eval): evaluate at evaluation (compile or interpret) time
+;;;
+;;; V (visit): evaluate at visit time
+;;;
+;;; R (revisit): evaluate at revisit time
+
+;;; The mode set for the body of an eval-when is determined by
+;;; translating each mode in the old mode set based on the situations
+;;; present in the eval-when form and combining these into a set,
+;;; using the following table. See also update-mode-set.
+
+;;; load compile visit revisit eval
+;;;
+;;; L L C V R -
+;;;
+;;; C - - - - C
+;;;
+;;; V V C V - -
+;;;
+;;; R R C - R -
+;;;
+;;; E - - - - E
+
+;;; When we complete the expansion of a compile or run-time expression,
+;;; the current ctem or rtem determines how the expression will be
+;;; treated. See ct-eval/residualize and rt-eval/residualize.
+
+;;; Initial mode sets
+;;;
+;;; when compiling a file:
+;;;
+;;; initial ctem: (L C)
+;;;
+;;; initial rtem: (L)
+;;;
+;;; when not compiling a file:
+;;;
+;;; initial ctem: (E)
+;;;
+;;; initial rtem: (E)
+;;;
+;;;
+;;; This means that top-level syntactic definitions are evaluated
+;;; immediately after they are expanded, and the expanded definitions
+;;; are also residualized into the object file if we are compiling
+;;; a file.
+
+(set! sc-expand
+ (let ((ctem '(E)) (rtem '(E)))
+ (lambda (x)
+ (let ((env (interaction-environment)))
+ (if (and (pair? x) (equal? (car x) noexpand))
+ (cadr x)
+ (chi-top* x null-env
+ (env-wrap env)
+ ctem rtem #f
+ (env-top-ribcage env)))))))
+
+
+
+(set! $make-environment
+ (lambda (token mutable?)
+ (let ((top-ribcage (make-top-ribcage token mutable?)))
+ (make-env
+ top-ribcage
+ (make-wrap
+ (wrap-marks top-wrap)
+ (cons top-ribcage (wrap-subst top-wrap)))))))
+
+(set! environment?
+ (lambda (x)
+ (env? x)))
+
+
+
+(set! interaction-environment
+ (let ((e ($make-environment '*top* #t)))
+ (lambda () e)))
+
+(set! identifier?
+ (lambda (x)
+ (nonsymbol-id? x)))
+
+(set! datum->syntax-object
+ (lambda (id datum)
+ (arg-check nonsymbol-id? id 'datum->syntax-object)
+ (make-syntax-object
+ datum
+ (syntax-object-wrap id))))
+
+(set! syntax->list
+ (lambda (orig-ls)
+ (let f ((ls orig-ls))
+ (syntax-case ls ()
+ (() '())
+ ((x . r) (cons #'x (f #'r)))
+ (_ (error 'syntax->list "invalid argument ~s" orig-ls))))))
+
+(set! syntax->vector
+ (lambda (v)
+ (syntax-case v ()
+ (#(x ...) (apply vector (syntax->list #'(x ...))))
+ (_ (error 'syntax->vector "invalid argument ~s" v)))))
+
+(set! syntax-object->datum
+ ; accepts any object, since syntax objects may consist partially
+ ; or entirely of unwrapped, nonsymbolic data
+ (lambda (x)
+ (strip x empty-wrap)))
+
+(set! generate-temporaries
+ (let ((n 0))
+ (lambda (ls)
+ (arg-check list? ls 'generate-temporaries)
+ (map (lambda (x)
+ (set! n (+ n 1))
+ (wrap
+ ; unique name to distinguish from other temporaries
+ (string->symbol (string-append "t" (number->string n)))
+ ; unique mark (in tmp-wrap) to distinguish from non-temporaries
+ tmp-wrap))
+ ls))))
+
+(set! free-identifier=?
+ (lambda (x y)
+ (arg-check nonsymbol-id? x 'free-identifier=?)
+ (arg-check nonsymbol-id? y 'free-identifier=?)
+ (free-id=? x y)))
+
+(set! bound-identifier=?
+ (lambda (x y)
+ (arg-check nonsymbol-id? x 'bound-identifier=?)
+ (arg-check nonsymbol-id? y 'bound-identifier=?)
+ (bound-id=? x y)))
+
+(set! literal-identifier=?
+ (lambda (x y)
+ (arg-check nonsymbol-id? x 'literal-identifier=?)
+ (arg-check nonsymbol-id? y 'literal-identifier=?)
+ (literal-id=? x y)))
+
+(set! syntax-error
+ (lambda (object . messages)
+ (for-each (lambda (x) (arg-check string? x 'syntax-error)) messages)
+ (let ((message (if (null? messages)
+ "invalid syntax"
+ (apply string-append messages))))
+ (error-hook #f message (strip object empty-wrap)))))
+
+;;; syntax-dispatch expects an expression and a pattern. If the expression
+;;; matches the pattern a list of the matching expressions for each
+;;; "any" is returned. Otherwise, #f is returned. (This use of #f will
+;;; not work on r4rs implementations that violate the ieee requirement
+;;; that #f and () be distinct.)
+
+;;; The expression is matched with the pattern as follows:
+
+;;; p in pattern: matches:
+;;; () empty list
+;;; any anything
+;;; (p1 . p2) pair (list)
+;;; #(free-id <key>) <key> with literal-identifier=?
+;;; each-any any proper list
+;;; #(each p) (p*)
+;;; #(each+ p1 (p2_1 ...p2_n) p3) (p1* (p2_n ... p2_1) . p3)
+;;; #(vector p) (list->vector p)
+;;; #(atom <object>) <object> with "equal?"
+
+;;; Vector cops out to pair under assumption that vectors are rare. If
+;;; not, should convert to:
+;;; #(vector p) #(p*)
+
+(let ()
+
+(define match-each
+ (lambda (e p w)
+ (cond
+ ((annotation? e)
+ (match-each (annotation-expression e) p w))
+ ((pair? e)
+ (let ((first (match (car e) p w '())))
+ (and first
+ (let ((rest (match-each (cdr e) p w)))
+ (and rest (cons first rest))))))
+ ((null? e) '())
+ ((syntax-object? e)
+ (match-each (syntax-object-expression e)
+ p
+ (join-wraps w (syntax-object-wrap e))))
+ (else #f))))
+
+(define match-each+
+ (lambda (e x-pat y-pat z-pat w r)
+ (let f ((e e) (w w))
+ (cond
+ ((pair? e)
+ (let-values (((xr* y-pat r) (f (cdr e) w)))
+ (if r
+ (if (null? y-pat)
+ (let ((xr (match (car e) x-pat w '())))
+ (if xr
+ (values (cons xr xr*) y-pat r)
+ (values #f #f #f)))
+ (values '() (cdr y-pat) (match (car e) (car y-pat) w r)))
+ (values #f #f #f))))
+ ((annotation? e) (f (annotation-expression e) w))
+ ((syntax-object? e) (f (syntax-object-expression e)
+ (join-wraps w (syntax-object-wrap e))))
+ (else (values '() y-pat (match e z-pat w r)))))))
+
+(define match-each-any
+ (lambda (e w)
+ (cond
+ ((annotation? e)
+ (match-each-any (annotation-expression e) w))
+ ((pair? e)
+ (let ((l (match-each-any (cdr e) w)))
+ (and l (cons (wrap (car e) w) l))))
+ ((null? e) '())
+ ((syntax-object? e)
+ (match-each-any (syntax-object-expression e)
+ (join-wraps w (syntax-object-wrap e))))
+ (else #f))))
+
+(define match-empty
+ (lambda (p r)
+ (cond
+ ((null? p) r)
+ ((eq? p 'any) (cons '() r))
+ ((pair? p) (match-empty (car p) (match-empty (cdr p) r)))
+ ((eq? p 'each-any) (cons '() r))
+ (else
+ (case (vector-ref p 0)
+ ((each) (match-empty (vector-ref p 1) r))
+ ((each+) (match-empty (vector-ref p 1)
+ (match-empty (reverse (vector-ref p 2))
+ (match-empty (vector-ref p 3) r))))
+ ((free-id atom) r)
+ ((vector) (match-empty (vector-ref p 1) r)))))))
+
+(define combine
+ (lambda (r* r)
+ (if (null? (car r*))
+ r
+ (cons (map car r*) (combine (map cdr r*) r)))))
+
+(define match*
+ (lambda (e p w r)
+ (cond
+ ((null? p) (and (null? e) r))
+ ((pair? p)
+ (and (pair? e) (match (car e) (car p) w
+ (match (cdr e) (cdr p) w r))))
+ ((eq? p 'each-any)
+ (let ((l (match-each-any e w))) (and l (cons l r))))
+ (else
+ (case (vector-ref p 0)
+ ((each)
+ (if (null? e)
+ (match-empty (vector-ref p 1) r)
+ (let ((r* (match-each e (vector-ref p 1) w)))
+ (and r* (combine r* r)))))
+ ((free-id) (and (id? e) (literal-id=? (wrap e w) (vector-ref p 1)) r))
+ ((each+)
+ (let-values (((xr* y-pat r)
+ (match-each+ e (vector-ref p 1) (vector-ref p 2)
+ (vector-ref p 3) w r)))
+ (and r (null? y-pat)
+ (if (null? xr*)
+ (match-empty (vector-ref p 1) r)
+ (combine xr* r)))))
+ ((atom) (and (equal? (vector-ref p 1) (strip e w)) r))
+ ((vector)
+ (and (vector? e)
+ (match (vector->list e) (vector-ref p 1) w r))))))))
+
+(define match
+ (lambda (e p w r)
+ (cond
+ ((not r) #f)
+ ((eq? p 'any) (cons (wrap e w) r))
+ ((syntax-object? e)
+ (match*
+ (unannotate (syntax-object-expression e))
+ p
+ (join-wraps w (syntax-object-wrap e))
+ r))
+ (else (match* (unannotate e) p w r)))))
+
+(set! $syntax-dispatch
+ (lambda (e p)
+ (cond
+ ((eq? p 'any) (list e))
+ ((syntax-object? e)
+ (match* (unannotate (syntax-object-expression e))
+ p (syntax-object-wrap e) '()))
+ (else (match* (unannotate e) p empty-wrap '())))))
+))
+
+
+(define-syntax with-syntax
+ (lambda (x)
+ (syntax-case x ()
+ ((_ () e1 e2 ...)
+ (syntax (begin e1 e2 ...)))
+ ((_ ((out in)) e1 e2 ...)
+ (syntax (syntax-case in () (out (begin e1 e2 ...)))))
+ ((_ ((out in) ...) e1 e2 ...)
+ (syntax (syntax-case (list in ...) ()
+ ((out ...) (begin e1 e2 ...))))))))
+
+(define-syntax with-implicit
+ (syntax-rules ()
+ ((_ (tid id ...) e1 e2 ...)
+ (andmap identifier? (syntax (tid id ...)))
+ (begin
+ (unless (identifier? (syntax tid))
+ (syntax-error (syntax tid) "non-identifier with-implicit template"))
+ (with-syntax ((id (datum->syntax-object (syntax tid) 'id)) ...)
+ e1 e2 ...)))))
+
+(define-syntax datum
+ (syntax-rules ()
+ ((_ x) (syntax-object->datum (syntax x)))))
+
+(define-syntax syntax-rules
+ (lambda (x)
+ (define clause
+ (lambda (y)
+ (syntax-case y ()
+ (((keyword . pattern) template)
+ (syntax ((dummy . pattern) (syntax template))))
+ (((keyword . pattern) fender template)
+ (syntax ((dummy . pattern) fender (syntax template))))
+ (_ (syntax-error x)))))
+ (syntax-case x ()
+ ((_ (k ...) cl ...)
+ (andmap identifier? (syntax (k ...)))
+ (with-syntax (((cl ...) (map clause (syntax (cl ...)))))
+ (syntax (lambda (x) (syntax-case x (k ...) cl ...))))))))
+
+(define-syntax or
+ (lambda (x)
+ (syntax-case x ()
+ ((_) (syntax #f))
+ ((_ e) (syntax e))
+ ((_ e1 e2 e3 ...)
+ (syntax (let ((t e1)) (if t t (or e2 e3 ...))))))))
+
+(define-syntax and
+ (lambda (x)
+ (syntax-case x ()
+ ((_ e1 e2 e3 ...) (syntax (if e1 (and e2 e3 ...) #f)))
+ ((_ e) (syntax e))
+ ((_) (syntax #t)))))
+
+(define-syntax let
+ (lambda (x)
+ (syntax-case x ()
+ ((_ ((x v) ...) e1 e2 ...)
+ (andmap identifier? (syntax (x ...)))
+ (syntax ((lambda (x ...) e1 e2 ...) v ...)))
+ ((_ f ((x v) ...) e1 e2 ...)
+ (andmap identifier? (syntax (f x ...)))
+ (syntax ((letrec ((f (lambda (x ...) e1 e2 ...))) f)
+ v ...))))))
+
+(define-syntax let*
+ (lambda (x)
+ (syntax-case x ()
+ ((let* ((x v) ...) e1 e2 ...)
+ (andmap identifier? (syntax (x ...)))
+ (let f ((bindings (syntax ((x v) ...))))
+ (if (null? bindings)
+ (syntax (let () e1 e2 ...))
+ (with-syntax ((body (f (cdr bindings)))
+ (binding (car bindings)))
+ (syntax (let (binding) body)))))))))
+
+(define-syntax cond
+ (lambda (x)
+ (syntax-case x ()
+ ((_ m1 m2 ...)
+ (let f ((clause (syntax m1)) (clauses (syntax (m2 ...))))
+ (if (null? clauses)
+ (syntax-case clause (else =>)
+ ((else e1 e2 ...) (syntax (begin e1 e2 ...)))
+ ((e0) (syntax (let ((t e0)) (if t t))))
+ ((e0 => e1) (syntax (let ((t e0)) (if t (e1 t)))))
+ ((e0 e1 e2 ...) (syntax (if e0 (begin e1 e2 ...))))
+ (_ (syntax-error x)))
+ (with-syntax ((rest (f (car clauses) (cdr clauses))))
+ (syntax-case clause (else =>)
+ ((e0) (syntax (let ((t e0)) (if t t rest))))
+ ((e0 => e1) (syntax (let ((t e0)) (if t (e1 t) rest))))
+ ((e0 e1 e2 ...) (syntax (if e0 (begin e1 e2 ...) rest)))
+ (_ (syntax-error x))))))))))
+
+(define-syntax do
+ (lambda (orig-x)
+ (syntax-case orig-x ()
+ ((_ ((var init . step) ...) (e0 e1 ...) c ...)
+ (with-syntax (((step ...)
+ (map (lambda (v s)
+ (syntax-case s ()
+ (() v)
+ ((e) (syntax e))
+ (_ (syntax-error orig-x))))
+ (syntax (var ...))
+ (syntax (step ...)))))
+ (syntax-case (syntax (e1 ...)) ()
+ (() (syntax (let do ((var init) ...)
+ (if (not e0)
+ (begin c ... (do step ...))))))
+ ((e1 e2 ...)
+ (syntax (let do ((var init) ...)
+ (if e0
+ (begin e1 e2 ...)
+ (begin c ... (do step ...))))))))))))
+
+(define-syntax quasiquote
+ (let ()
+ (define (quasi p lev)
+ (syntax-case p (unquote quasiquote)
+ ((unquote p)
+ (if (= lev 0)
+ #'("value" p)+ (quasicons #'("quote" unquote) (quasi #'(p) (- lev 1)))))+ ((quasiquote p) (quasicons #'("quote" quasiquote) (quasi #'(p) (+ lev 1))))+ ((p . q)
+ (syntax-case #'p (unquote unquote-splicing)
+ ((unquote p ...)
+ (if (= lev 0)
+ (quasilist* #'(("value" p) ...) (quasi #'q lev))+ (quasicons
+ (quasicons #'("quote" unquote) (quasi #'(p ...) (- lev 1)))+ (quasi #'q lev))))
+ ((unquote-splicing p ...)
+ (if (= lev 0)
+ (quasiappend #'(("value" p) ...) (quasi #'q lev))+ (quasicons
+ (quasicons #'("quote" unquote-splicing) (quasi #'(p ...) (- lev 1)))+ (quasi #'q lev))))
+ (_ (quasicons (quasi #'p lev) (quasi #'q lev)))))
+ (#(x ...) (quasivector (vquasi #'(x ...) lev)))
+ (p #'("quote" p))))+ (define (vquasi p lev)
+ (syntax-case p ()
+ ((p . q)
+ (syntax-case #'p (unquote unquote-splicing)
+ ((unquote p ...)
+ (if (= lev 0)
+ (quasilist* #'(("value" p) ...) (vquasi #'q lev))+ (quasicons
+ (quasicons #'("quote" unquote) (quasi #'(p ...) (- lev 1)))+ (vquasi #'q lev))))
+ ((unquote-splicing p ...)
+ (if (= lev 0)
+ (quasiappend #'(("value" p) ...) (vquasi #'q lev))+ (quasicons
+ (quasicons
+ #'("quote" unquote-splicing)+ (quasi #'(p ...) (- lev 1)))
+ (vquasi #'q lev))))
+ (_ (quasicons (quasi #'p lev) (vquasi #'q lev)))))
+ (() #'("quote" ()))))+ (define (quasicons x y)
+ (with-syntax ((x x) (y y))
+ (syntax-case #'y ()
+ (("quote" dy)+ (syntax-case #'x ()
+ (("quote" dx) #'("quote" (dx . dy)))+ (_ (if (null? #'dy) #'("list" x) #'("list*" x y)))))+ (("list" . stuff) #'("list" x . stuff))+ (("list*" . stuff) #'("list*" x . stuff))+ (_ #'("list*" x y)))))+ (define (quasiappend x y)
+ (syntax-case y ()
+ (("quote" ())+ (cond
+ ((null? x) #'("quote" ()))+ ((null? (cdr x)) (car x))
+ (else (with-syntax (((p ...) x)) #'("append" p ...)))))+ (_
+ (cond
+ ((null? x) y)
+ (else (with-syntax (((p ...) x) (y y)) #'("append" p ... y)))))))+ (define (quasilist* x y)
+ (let f ((x x))
+ (if (null? x)
+ y
+ (quasicons (car x) (f (cdr x))))))
+ (define (quasivector x)
+ (syntax-case x ()
+ (("quote" (x ...)) #'("quote" #(x ...)))+ (_
+ (let f ((y x) (k (lambda (ls) #`("vector" #,@ls))))+ (syntax-case y ()
+ (("quote" (y ...)) (k #'(("quote" y) ...)))+ (("list" y ...) (k #'(y ...)))+ (("list*" y ... z) (f #'z (lambda (ls) (k (append #'(y ...) ls)))))+ (else #`("list->vector" #,x)))))))+ (define (emit x)
+ (syntax-case x ()
+ (("quote" x) #''x)+ (("list" x ...) #`(list #,@(map emit #'(x ...))))+ ; could emit list* for 3+ arguments if implementation supports list*
+ (("list*" x ... y)+ (let f ((x* #'(x ...)))
+ (if (null? x*)
+ (emit #'y)
+ #`(cons #,(emit (car x*)) #,(f (cdr x*))))))
+ (("append" x ...) #`(append #,@(map emit #'(x ...))))+ (("vector" x ...) #`(vector #,@(map emit #'(x ...))))+ (("list->vector" x) #`(list->vector #,(emit #'x)))+ (("value" x) #'x)))+ (lambda (x)
+ (syntax-case x ()
+ ; convert to intermediate language, combining introduced (but not
+ ; unquoted source) quote expressions where possible and choosing
+ ; optimal construction code otherwise, then emit Scheme code
+ ; corresponding to the intermediate language forms.
+ ((_ e) (emit (quasi #'e 0)))))))
+
+(define-syntax unquote
+ (lambda (x)
+ (syntax-error x "misplaced")))
+
+(define-syntax unquote-splicing
+ (lambda (x)
+ (syntax-error x "misplaced")))
+
+(define-syntax quasisyntax
+ (lambda (x)
+ (define (qs q n b* k)
+ (syntax-case q (quasisyntax unsyntax unsyntax-splicing)
+ ((quasisyntax . d)
+ (qs #'d (+ n 1) b*
+ (lambda (b* dnew)
+ (k b*
+ (if (eq? dnew #'d)
+ q
+ (with-syntax ((d dnew)) #'(quasisyntax . d)))))))
+ ((unsyntax . d)
+ (not (= n 0))
+ (qs #'d (- n 1) b*
+ (lambda (b* dnew)
+ (k b*
+ (if (eq? dnew #'d)
+ q
+ (with-syntax ((d dnew)) #'(unsyntax . d)))))))
+ ((unsyntax-splicing . d)
+ (not (= n 0))
+ (qs #'d (- n 1) b*
+ (lambda (b* dnew)
+ (k b*
+ (if (eq? dnew #'d)
+ q
+ (with-syntax ((d dnew)) #'(unsyntax-splicing . d)))))))
+ ((unsyntax q)
+ (= n 0)
+ (with-syntax (((t) (generate-temporaries #'(q))))
+ (k (cons #'(t q) b*) #'t)))
+ (((unsyntax q ...) . d)
+ (= n 0)
+ (qs #'d n b*
+ (lambda (b* dnew)
+ (with-syntax (((t ...) (generate-temporaries #'(q ...))))
+ (k (append #'((t q) ...) b*)
+ (with-syntax ((d dnew)) #'(t ... . d)))))))
+ (((unsyntax-splicing q ...) . d)
+ (= n 0)
+ (qs #'d n b*
+ (lambda (b* dnew)
+ (with-syntax (((t ...) (generate-temporaries #'(q ...))))
+ (k (append #'(((t (... ...)) q) ...) b*)
+ (with-syntax ((((m ...) ...) #'((t (... ...)) ...)))
+ (with-syntax ((d dnew)) #'(m ... ... . d))))))))
+ ((a . d)
+ (qs #'a n b*
+ (lambda (b* anew)
+ (qs #'d n b*
+ (lambda (b* dnew)
+ (k b*
+ (if (and (eq? anew #'a) (eq? dnew #'d))
+ q
+ (with-syntax ((a anew) (d dnew)) #'(a . d)))))))))
+ (#(x ...)
+ (vqs #'(x ...) n b*
+ (lambda (b* xnew*)
+ (k b*
+ (if (let same? ((x* #'(x ...)) (xnew* xnew*))
+ (if (null? x*)
+ (null? xnew*)
+ (and (not (null? xnew*))
+ (eq? (car x*) (car xnew*))
+ (same? (cdr x*) (cdr xnew*)))))
+ q
+ (with-syntax (((x ...) xnew*)) #'#(x ...)))))))
+ (_ (k b* q))))
+ (define (vqs x* n b* k)
+ (if (null? x*)
+ (k b* '())
+ (vqs (cdr x*) n b*
+ (lambda (b* xnew*)
+ (syntax-case (car x*) (unsyntax unsyntax-splicing)
+ ((unsyntax q ...)
+ (= n 0)
+ (with-syntax (((t ...) (generate-temporaries #'(q ...))))
+ (k (append #'((t q) ...) b*)
+ (append #'(t ...) xnew*))))
+ ((unsyntax-splicing q ...)
+ (= n 0)
+ (with-syntax (((t ...) (generate-temporaries #'(q ...))))
+ (k (append #'(((t (... ...)) q) ...) b*)
+ (with-syntax ((((m ...) ...) #'((t (... ...)) ...)))
+ (append #'(m ... ...) xnew*)))))
+ (_ (qs (car x*) n b*
+ (lambda (b* xnew)
+ (k b* (cons xnew xnew*))))))))))
+ (syntax-case x ()
+ ((_ x)
+ (qs #'x 0 '()
+ (lambda (b* xnew)
+ (if (eq? xnew #'x)
+ #'(syntax x)
+ (with-syntax (((b ...) b*) (x xnew))
+ #'(with-syntax (b ...) (syntax x))))))))))
+
+(define-syntax unsyntax
+ (lambda (x)
+ (syntax-error x "misplaced")))
+
+(define-syntax unsyntax-splicing
+ (lambda (x)
+ (syntax-error x "misplaced")))
+
+(define-syntax include
+ (lambda (x)
+ (define read-file
+ (lambda (fn k)
+ (let ((p (open-input-file fn)))
+ (let f ()
+ (let ((x (read p)))
+ (if (eof-object? x)
+ (begin (close-input-port p) '())
+ (cons (datum->syntax-object k x) (f))))))))
+ (syntax-case x ()
+ ((k filename)
+ (let ((fn (syntax-object->datum (syntax filename))))
+ (with-syntax (((exp ...) (read-file fn (syntax k))))
+ (syntax (begin exp ...))))))))
+
+(define-syntax case
+ (lambda (x)
+ (syntax-case x ()
+ ((_ e m1 m2 ...)
+ (with-syntax
+ ((body (let f ((clause (syntax m1)) (clauses (syntax (m2 ...))))
+ (if (null? clauses)
+ (syntax-case clause (else)
+ ((else e1 e2 ...) (syntax (begin e1 e2 ...)))
+ (((k ...) e1 e2 ...)
+ (syntax (if (memv t '(k ...)) (begin e1 e2 ...))))
+ (_ (syntax-error x)))
+ (with-syntax ((rest (f (car clauses) (cdr clauses))))
+ (syntax-case clause (else)
+ (((k ...) e1 e2 ...)
+ (syntax (if (memv t '(k ...))
+ (begin e1 e2 ...)
+ rest)))
+ (_ (syntax-error x))))))))
+ (syntax (let ((t e)) body)))))))
+
+(define-syntax identifier-syntax
+ (syntax-rules (set!)
+ ((_ e)
+ (lambda (x)
+ (syntax-case x ()
+ (id (identifier? (syntax id)) (syntax e))
+ ((_ x (... ...)) (syntax (e x (... ...)))))))
+ ((_ (id exp1) ((set! var val) exp2))
+ (and (identifier? (syntax id)) (identifier? (syntax var)))
+ (cons 'macro!
+ (lambda (x)
+ (syntax-case x (set!)
+ ((set! var val) (syntax exp2))
+ ((id x (... ...)) (syntax (exp1 x (... ...))))
+ (id (identifier? (syntax id)) (syntax exp1))))))))
+
--- a/femtolisp/unittest.lsp
+++ b/femtolisp/unittest.lsp
@@ -171,6 +171,13 @@
(assert (equal? (aref iarr 0) 32))
(assert (equal? (aref iarr #int8(3)) 7))
+; gensyms
+(assert (gensym? (gensym)))
+(assert (not (gensym? 'a)))
+(assert (not (eq? (gensym) (gensym))))
+(assert (not (equal? (string (gensym)) (string (gensym)))))
+(let ((gs (gensym))) (assert (eq? gs gs)))
+
; ok, a couple end-to-end tests as well
(define (fib n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))
(assert (equal? (fib 20) 6765))