ref: ced312368fdb879811e25a807fb00782c1f25a45
dir: /lib/psyntax-expanded.ss/
;;; 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)
sed: Output line too long
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