ref: 7e0665beb50190f4b2c09a9a91fcfbf93ce12668
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